From 7323235bd6c629a323b06f9af695ad40ccc0722e Mon Sep 17 00:00:00 2001 From: Skylar Hill Date: Sat, 11 Nov 2023 02:22:00 -0600 Subject: [PATCH] Indentation fix Plus a couple changes I couldn't be bothered to isolate. --- .dir-locals.el | 186 +++++++++++++++++++++++++++++++++++++++++++ scripts/starvat.in | 52 ++++++------ starvat/handler.scm | 75 +++++++++-------- starvat/listener.scm | 56 ++++++------- 4 files changed, 277 insertions(+), 92 deletions(-) create mode 100644 .dir-locals.el diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..d18e6ba --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,186 @@ +;; Per-directory local variables for GNU Emacs 23 and later. + +((nil + . ((fill-column . 78) + (tab-width . 8) + (sentence-end-double-space . t) + + ;; For use with 'bug-reference-prog-mode'. Extra bug-reference + ;; configuration should be done in your Emacs user configuration file; + ;; refer to (info (guix) The Perfect Setup). + (bug-reference-bug-regexp + . "\\(\\)") + (bug-reference-url-format . "https://issues.guix.gnu.org/%s") + + (eval . (add-to-list 'completion-ignored-extensions ".go")) + + ;; Emacs-Guix + (eval . (setq-local guix-directory + (locate-dominating-file default-directory + ".dir-locals.el"))) + + ;; YASnippet + (eval . (with-eval-after-load + 'yasnippet + (let ((guix-yasnippets + (expand-file-name + "etc/snippets/yas" + (locate-dominating-file default-directory + ".dir-locals.el")))) + (unless (member guix-yasnippets yas-snippet-dirs) + (add-to-list 'yas-snippet-dirs guix-yasnippets) + (yas-reload-all))))) + + ;; Geiser + ;; This allows automatically setting the `geiser-guile-load-path' + ;; variable when using various Guix checkouts (e.g., via git worktrees). + (geiser-repl-per-project-p . t))) + + (c-mode . ((c-file-style . "gnu"))) + (scheme-mode + . + ((indent-tabs-mode . nil) + (eval . (put 'eval-when 'scheme-indent-function 1)) + (eval . (put 'call-with-prompt 'scheme-indent-function 1)) + (eval . (put 'test-assert 'scheme-indent-function 1)) + (eval . (put 'test-assertm 'scheme-indent-function 1)) + (eval . (put 'test-equalm 'scheme-indent-function 1)) + (eval . (put 'test-equal 'scheme-indent-function 1)) + (eval . (put 'test-eq 'scheme-indent-function 1)) + (eval . (put 'call-with-input-string 'scheme-indent-function 1)) + (eval . (put 'call-with-port 'scheme-indent-function 1)) + (eval . (put 'guard 'scheme-indent-function 1)) + (eval . (put 'lambda* 'scheme-indent-function 1)) + (eval . (put 'substitute* 'scheme-indent-function 1)) + (eval . (put 'match-record 'scheme-indent-function 3)) + (eval . (put 'match-record-lambda 'scheme-indent-function 2)) + + ;; TODO: Contribute these to Emacs' scheme-mode. + (eval . (put 'let-keywords 'scheme-indent-function 3)) + + ;; 'modify-inputs' and its keywords. + (eval . (put 'modify-inputs 'scheme-indent-function 1)) + (eval . (put 'replace 'scheme-indent-function 1)) + + ;; 'modify-phases' and its keywords. + (eval . (put 'modify-phases 'scheme-indent-function 1)) + (eval . (put 'replace 'scheme-indent-function 1)) + (eval . (put 'add-before 'scheme-indent-function 2)) + (eval . (put 'add-after 'scheme-indent-function 2)) + + (eval . (put 'modify-services 'scheme-indent-function 1)) + (eval . (put 'with-directory-excursion 'scheme-indent-function 1)) + (eval . (put 'with-file-lock 'scheme-indent-function 1)) + (eval . (put 'with-file-lock/no-wait 'scheme-indent-function 1)) + (eval . (put 'with-profile-lock 'scheme-indent-function 1)) + (eval . (put 'with-writable-file 'scheme-indent-function 2)) + + (eval . (put 'package 'scheme-indent-function 0)) + (eval . (put 'package/inherit 'scheme-indent-function 1)) + (eval . (put 'origin 'scheme-indent-function 0)) + (eval . (put 'build-system 'scheme-indent-function 0)) + (eval . (put 'bag 'scheme-indent-function 0)) + (eval . (put 'graft 'scheme-indent-function 0)) + (eval . (put 'operating-system 'scheme-indent-function 0)) + (eval . (put 'file-system 'scheme-indent-function 0)) + (eval . (put 'manifest-entry 'scheme-indent-function 0)) + (eval . (put 'manifest-pattern 'scheme-indent-function 0)) + (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1)) + (eval . (put 'with-store 'scheme-indent-function 1)) + (eval . (put 'with-external-store 'scheme-indent-function 1)) + (eval . (put 'with-error-handling 'scheme-indent-function 0)) + (eval . (put 'with-mutex 'scheme-indent-function 1)) + (eval . (put 'with-atomic-file-output 'scheme-indent-function 1)) + (eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2)) + (eval . (put 'call-with-decompressed-port 'scheme-indent-function 2)) + (eval . (put 'call-with-gzip-input-port 'scheme-indent-function 1)) + (eval . (put 'call-with-gzip-output-port 'scheme-indent-function 1)) + (eval . (put 'call-with-lzip-input-port 'scheme-indent-function 1)) + (eval . (put 'call-with-lzip-output-port 'scheme-indent-function 1)) + (eval . (put 'signature-case 'scheme-indent-function 1)) + (eval . (put 'emacs-batch-eval 'scheme-indent-function 0)) + (eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1)) + (eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1)) + (eval . (put 'emacs-substitute-variables 'scheme-indent-function 1)) + (eval . (put 'with-derivation-narinfo 'scheme-indent-function 1)) + (eval . (put 'with-derivation-substitute 'scheme-indent-function 2)) + (eval . (put 'with-status-report 'scheme-indent-function 1)) + (eval . (put 'with-status-verbosity 'scheme-indent-function 1)) + (eval . (put 'with-build-handler 'scheme-indent-function 1)) + + (eval . (put 'mlambda 'scheme-indent-function 1)) + (eval . (put 'mlambdaq 'scheme-indent-function 1)) + (eval . (put 'syntax-parameterize 'scheme-indent-function 1)) + (eval . (put 'with-monad 'scheme-indent-function 1)) + (eval . (put 'mbegin 'scheme-indent-function 1)) + (eval . (put 'mwhen 'scheme-indent-function 1)) + (eval . (put 'munless 'scheme-indent-function 1)) + (eval . (put 'mlet* 'scheme-indent-function 2)) + (eval . (put 'mlet 'scheme-indent-function 2)) + (eval . (put 'mparameterize 'scheme-indent-function 2)) + (eval . (put 'run-with-store 'scheme-indent-function 1)) + (eval . (put 'run-with-state 'scheme-indent-function 1)) + (eval . (put 'wrap-program 'scheme-indent-function 1)) + (eval . (put 'wrap-script 'scheme-indent-function 1)) + (eval . (put 'with-imported-modules 'scheme-indent-function 1)) + (eval . (put 'with-extensions 'scheme-indent-function 1)) + (eval . (put 'with-parameters 'scheme-indent-function 1)) + (eval . (put 'let-system 'scheme-indent-function 1)) + (eval . (put 'with-build-variables 'scheme-indent-function 2)) + + (eval . (put 'with-database 'scheme-indent-function 2)) + (eval . (put 'call-with-database 'scheme-indent-function 1)) + (eval . (put 'call-with-transaction 'scheme-indent-function 1)) + (eval . (put 'with-statement 'scheme-indent-function 3)) + (eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1)) + (eval . (put 'call-with-savepoint 'scheme-indent-function 1)) + (eval . (put 'call-with-retrying-savepoint 'scheme-indent-function 1)) + + (eval . (put 'call-with-container 'scheme-indent-function 1)) + (eval . (put 'container-excursion 'scheme-indent-function 1)) + (eval . (put 'eventually 'scheme-indent-function 1)) + + (eval . (put 'call-with-progress-reporter 'scheme-indent-function 1)) + (eval . (put 'with-repository 'scheme-indent-function 2)) + (eval . (put 'with-temporary-git-repository 'scheme-indent-function 2)) + (eval . (put 'with-environment-variables 'scheme-indent-function 1)) + (eval . (put 'with-fresh-gnupg-setup 'scheme-indent-function 1)) + + (eval . (put 'with-paginated-output-port 'scheme-indent-function 1)) + + (eval . (put 'with-shepherd-action 'scheme-indent-function 3)) + + (eval . (put 'with-http-server 'scheme-indent-function 1)) + + ;; This notably allows '(' in Paredit to not insert a space when the + ;; preceding symbol is one of these. + (eval . (modify-syntax-entry ?~ "'")) + (eval . (modify-syntax-entry ?$ "'")) + (eval . (modify-syntax-entry ?+ "'")) + + ;; Emacs 28 changed the behavior of 'lisp-fill-paragraph', which causes the + ;; first line of package descriptions to extrude past 'fill-column', and + ;; somehow that is deemed more correct upstream (see: + ;; https://issues.guix.gnu.org/56197). + (eval . (progn + (require 'lisp-mode) + (defun emacs27-lisp-fill-paragraph (&optional justify) + (interactive "P") + (or (fill-comment-paragraph justify) + (let ((paragraph-start + (concat paragraph-start + "\\|\\s-*\\([(;\"]\\|\\s-:\\|`(\\|#'(\\)")) + (paragraph-separate + (concat paragraph-separate "\\|\\s-*\".*[,\\.]$")) + (fill-column (if (and (integerp emacs-lisp-docstring-fill-column) + (derived-mode-p 'emacs-lisp-mode)) + emacs-lisp-docstring-fill-column + fill-column))) + (fill-paragraph justify)) + ;; Never return nil. + t)) + (setq-local fill-paragraph-function #'emacs27-lisp-fill-paragraph))))) + + (emacs-lisp-mode . ((indent-tabs-mode . nil))) + (texinfo-mode . ((indent-tabs-mode . nil) + (fill-column . 72)))) diff --git a/scripts/starvat.in b/scripts/starvat.in index 6d5f07f..1db1981 100644 --- a/scripts/starvat.in +++ b/scripts/starvat.in @@ -3,13 +3,13 @@ !# (use-modules (config) - (config api) - (config licenses) - (config parser sexp) - (ice-9 sandbox) - (goblins) - (starvat listener) - (starvat handler)) + (config api) + (config licenses) + (config parser sexp) + (ice-9 sandbox) + (goblins) + (starvat listener) + (starvat handler)) (define %configuration (configuration @@ -20,18 +20,18 @@ (license @LICENSE@) (synopsis "A Gemini server based on Spritely's Goblins") (description - "TODO") + "TODO") (keywords - (list - (setting - (name 'resources) - (default `(("localhost" . ,(string-append (getenv "HOME") - "/gemini")))) - (test list?) - (handler eval-in-sandbox)))) + (list + (setting + (name 'resources) + (default `(("localhost" . ,(string-append (getenv "HOME") + "/gemini")))) + (test list?) + (handler eval-in-sandbox)))) (directory (list (path (given "/etc/starvat/") - (eager? #f)) - (in-home ".config/starvat"))) + (eager? #f)) + (in-home ".config/starvat"))) (parser simple-sexp-parser) (generate-cmdtree? #t))) @@ -40,18 +40,16 @@ (define listener-vat (spawn-vat)) (define handler-vat (spawn-vat)) (define listener - (with-vat listener-vat - (spawn ^listener 1965 - (string-append (getenv "HOME") "/localhost.crt") - (string-append (getenv "HOME") "/localhost.key")))) - (display options) - (display (option-ref options 'resources)) + (with-vat listener-vat + (spawn ^listener 1965 + (string-append (getenv "HOME") "/localhost.crt") + (string-append (getenv "HOME") "/localhost.key")))) (define handler - (with-vat handler-vat - (spawn ^handler options))) + (with-vat handler-vat + (spawn ^handler options))) (with-vat listener-vat - ($ listener 'init) - ($ listener 'listen handler))) + ($ listener 'init) + ($ listener 'listen handler))) ;;; Local Variables: ;;; mode: scheme diff --git a/starvat/handler.scm b/starvat/handler.scm index e6035b5..3bc6626 100644 --- a/starvat/handler.scm +++ b/starvat/handler.scm @@ -9,53 +9,52 @@ (define (response-code code) (case code - ((input) "10") - ((sensitive-input) "11") - ((success) "20") - ((redirect-temporary) "30") - ((redirect-permanent) "31") - ((temporary-failure) "40") - ((server-unavailable) "41") - ((cgi-error) "42") - ((proxy-error) "43") - ((slow-down) "44") - ((permanent-failure) "50") - ((not-found) "51") - ((gone) "52") - ((proxy-request-refused) "53") - ((bad-request) "59") - ((client-certificate-required) "60") - ((certificate-not-authorised) "61") - ((certificate-not-valid) "62"))) + ((input) "10") + ((sensitive-input) "11") + ((success) "20") + ((redirect-temporary) "30") + ((redirect-permanent) "31") + ((temporary-failure) "40") + ((server-unavailable) "41") + ((cgi-error) "42") + ((proxy-error) "43") + ((slow-down) "44") + ((permanent-failure) "50") + ((not-found) "51") + ((gone) "52") + ((proxy-request-refused) "53") + ((bad-request) "59") + ((client-certificate-required) "60") + ((certificate-not-authorised) "61") + ((certificate-not-valid) "62"))) (define (resource-dir hostname resources) (define dir (assoc hostname resources)) (if dir - (cdr dir) - #f)) + (cdr dir) + #f)) (define* (build-response code meta #:optional body) (if body - (string-append (response-code code) " " meta "\r\n" body) - (string-append (response-code code) " " meta "\r\n"))) + (string-append (response-code code) " " meta "\r\n" body) + (string-append (response-code code) " " meta "\r\n"))) (define-public (^handler bcom config) (define conf (spawn ^cell config)) (methods ((handle raw-url) - (define url (string->uri raw-url)) - (if (not url) - (build-response 'bad-request "Could not parse URL") - (let ((dir (resource-dir (uri-host url) - (option-ref ($ conf) 'resources)))) - (display dir) - (if (not dir) - (build-response 'not-found "Unknown host") - (if (not (file-exists? (string-append dir - (uri-path url)))) - (build-response 'not-found "Unknown path") - (build-response 'success "text/gemini" - (call-with-input-file - (string-append dir - (uri-path url)) - get-string-all))))))))) + (define url (string->uri raw-url)) + (if (not url) + (build-response 'bad-request "Could not parse URL") + (let ((dir (resource-dir (uri-host url) + (option-ref ($ conf) 'resources)))) + (if (not dir) + (build-response 'not-found "Unknown host") + (if (not (file-exists? (string-append dir + (uri-path url)))) + (build-response 'not-found "Unknown path") + (build-response 'success "text/gemini" + (call-with-input-file + (string-append dir + (uri-path url)) + get-string-all))))))))) diff --git a/starvat/listener.scm b/starvat/listener.scm index 10a999e..7582cf1 100644 --- a/starvat/listener.scm +++ b/starvat/listener.scm @@ -10,9 +10,9 @@ (define* (get-request port #:optional (acc "")) (define next-char (get-char port)) (if (and (eq? next-char #\return) - (eq? (lookahead-char port) #\newline)) - acc - (get-request port (string-append acc (string next-char))))) + (eq? (lookahead-char port) #\newline)) + acc + (get-request port (string-append acc (string next-char))))) (define* (^listener bcom port cert key #:key exposed?) (define current-port (spawn ^cell port)) @@ -25,31 +25,33 @@ (set-session-default-priority! ($ server)) (methods ((set-port new-port) - ($ current-port new-port)) + ($ current-port new-port)) ((set-credentials cert key) - (set-certificate-credentials-x509-key-files! - ($ credentials) cert key x509-certificate-format/pem)) + (set-certificate-credentials-x509-key-files! + ($ credentials) cert key x509-certificate-format/pem)) ((init) - ($ listening-socket - (let ((s (socket PF_INET SOCK_STREAM 0))) - (setsockopt s SOL_SOCKET SO_REUSEADDR 1) - (bind s AF_INET INADDR_ANY ($ current-port)) - (fcntl s F_SETFD FD_CLOEXEC) - (listen s 5) - s))) + ($ listening-socket + (let ((s (socket PF_INET SOCK_STREAM 0))) + (setsockopt s SOL_SOCKET SO_REUSEADDR 1) + (bind s AF_INET INADDR_ANY ($ current-port)) + (fcntl s F_SETFD FD_CLOEXEC) + (listen s 5) + s))) ((listen handler) - (display handler) - (let* ((session (make-session connection-end/server)) - (sock (car (accept ($ listening-socket))))) - (set-session-credentials! session ($ credentials)) - (set-session-default-priority! session) - (set-session-transport-fd! session - (fileno sock)) - (set-port-encoding! sock "UTF-8") - (handshake session) - (define request (get-request (session-record-port session))) - (let-on ((response (<- handler 'handle request))) - (put-string (session-record-port session) response)) - (bye session close-request/rdwr))) + (let* ((session (make-session connection-end/server)) + (sock (car (accept ($ listening-socket)))) + (sess-port (session-record-port session))) + (set-session-credentials! session ($ credentials)) + (set-session-default-priority! session) + (set-session-transport-fd! session + (fileno sock)) + (set-port-encoding! sock "UTF-8") + (handshake session) + (define request (get-request sess-port)) + (on (<- handler 'handle request) + (lambda (response) + (put-string sess-port response))) + (bye session close-request/rdwr) + (close-port sock))) ((close) - (close ($ listening-socket))))) + (close ($ listening-socket)))))