4 files changed, 193 insertions, 94 deletions

@@ -34,11 +34,12 @@
       inhibit-x-resources t)
 (acdw/gc-disable)
 
-(hook-defun post-init-reset after-init-hook
-  (acdw/gc-enable)
-  (dolist (handler file-name-handler-alist)
-    (add-to-list 'orig-file-name-handler-alist handler))
-  (setq file-name-handler-alist orig-file-name-handler-alist))
+(add-hook 'after-init-hook
+          (defun after-init@reset ()
+            (acdw/gc-enable)
+            (dolist (handler file-name-handler-alist)
+              (add-to-list 'orig-file-name-handler-alist handler))
+            (setq file-name-handler-alist orig-file-name-handler-alist)))
 
 ;;; Frame settings
 (setq default-frame-alist               ; Remove most UI
@@ -60,42 +61,41 @@
       inhibit-x-resources t             ; Don't load ~/.Xresources
       )
 
-(hook-defun disable-ui-modes after-init-hook
-  (dolist (mode ;; each mode is of the form (MODE . FRAME-ALIST-VAR)
-           '((tool-bar-mode . tool-bar-lines)
-             (menu-bar-mode . menu-bar-lines)
-             (scroll-bar-mode . vertical-scroll-bars)
-             (horizontal-scroll-bar-mode . horizontal-scroll-bars)
-             ))
-    (let ((setting (alist-get (cdr mode) default-frame-alist)))
-      (when (or (not setting)
-                (= 0 setting))
-        (funcall (car mode) -1)))))
-
-(add-function :after after-focus-change-function
-              (defun acdw/first-frame-setup ()
-                ;; fonts
-                (require 'acdw-fonts)
-                (setq acdw-fonts/monospace (acdw/system
-                                            (:home "DejaVu Sans Mono")
-                                            (:work "Consolas")
-                                            (:other "monospace"))
-                      acdw-fonts/monospace-size 10
-                      acdw-fonts/variable (acdw/system
-                                           (:home "DejaVu Sans")
-                                           (:work "Calibri")
-                                           (:other "sans-serif"))
-                      acdw-fonts/variable-size 12)
-                (acdw-fonts/set)
-                (acdw-fonts/setup-emoji-fonts "Segoe UI Emoji"
-                                              "Noto Color Emoji"
-                                              "Apple Color Emoji"
-                                              "Symbola")
-                ;; fringes
-                (acdw/setup-fringes)
-                ;; only run this once
-                (remove-function after-focus-change-function
-                                 'acdw/first-frame-setup)))
+(add-hook 'after-init-hook
+          (defun after-init@disable-ui-modes ()
+            (dolist (mode ;; each mode is of the form (MODE . FRAME-ALIST-VAR)
+                     '((tool-bar-mode . tool-bar-lines)
+                       (menu-bar-mode . menu-bar-lines)
+                       (scroll-bar-mode . vertical-scroll-bars)
+                       (horizontal-scroll-bar-mode . horizontal-scroll-bars)
+                       ))
+              (let ((setting (alist-get (cdr mode) default-frame-alist)))
+                (when (or (not setting)
+                          (= 0 setting))
+                  (funcall (car mode) -1))))))
+
+(add-hook 'after-make-frame-functions
+          (defun acdw/frame-setup (&rest args)
+            (ignore args)
+            ;; fonts
+            (require 'acdw-fonts)
+            (setq acdw-fonts/monospace (acdw/system
+                                        (:home "DejaVu Sans Mono")
+                                        (:work "Consolas")
+                                        (:other "monospace"))
+                  acdw-fonts/monospace-size 10
+                  acdw-fonts/variable (acdw/system
+                                       (:home "DejaVu Sans")
+                                       (:work "Calibri")
+                                       (:other "sans-serif"))
+                  acdw-fonts/variable-size 12)
+            (acdw-fonts/set)
+            (acdw-fonts/setup-emoji-fonts "Segoe UI Emoji"
+                                          "Noto Color Emoji"
+                                          "Apple Color Emoji"
+                                          "Symbola")
+            ;; fringes
+            (acdw/setup-fringes)))
 
 
 ;;; Bootstrap package manager (`straight.el')
@@ -109,9 +109,10 @@
         (t (mailcap-parse-mailcaps))))
 
 ;;; Composing mail
-(hook-defun setup-message-mode message-mode-hook
-  (flyspell-mode +1)
-  (local-set-key (kbd "TAB") #'bbdb-complete-mail))
+(add-hook 'message-mode-hook
+          (defun message-mode@setup ()
+            (flyspell-mode +1)
+            (local-set-key (kbd "TAB") #'bbdb-complete-mail)))
 
 ;;; Sending mail
 (setq send-mail-function #'smtpmail-send-it
@@ -279,10 +279,12 @@
 
   (:leader "s" eshell-pop-or-quit)
   
-  (hook-defun eshell-setup 'eshell-mode-hook
-    (define-key eshell-mode-map (kbd "C-d") #'eshell-quit-or-delete-char)
-    (when (boundp 'simple-modeline--mode-line)
-      (setq mode-line-format '(:eval simple-modeline--mode-line)))))
+  (add-hook 'eshell-mode-hook
+            (defun eshell-mode@setup ()
+              (define-key eshell-mode-map (kbd "C-d")
+                #'eshell-quit-or-delete-char)
+              (when (boundp 'simple-modeline--mode-line)
+                (setq mode-line-format '(:eval simple-modeline--mode-line))))))
 
 (setup eww
   (:option eww-search-prefix "https://duckduckgo.com/html?q="
@@ -355,6 +357,8 @@
   (:option ibuffer-saved-filter-groups
            '(("default"
               ("dired" (mode . dired-mode))
+              ("elpher" (or (mode . elpher-mode)
+                            (mode . gemini-mode)))
               ("emacs" (or (name . "^\\*scratch\\*$")
                            (name . "^\\*Messages\\*$")))
               ("gnus" (or (mode . message-mode)
@@ -423,9 +427,10 @@
 (setup prog
   (:option smie-indent-basic tab-width)
   
-  (hook-defun auto-fill-prog-mode prog-mode-hook
-    (setq-local comment-auto-fill-only-comments t)
-    (turn-on-auto-fill))
+  (add-hook 'prog-mode-hook
+            (defun prog-mode@auto-fill ()
+              (setq-local comment-auto-fill-only-comments t)
+              (turn-on-auto-fill)))
 
   (:option show-paren-delay 0
            show-paren-style 'mixed
@@ -531,11 +536,12 @@
                                            "Welcome to GNU Emacs.\n\n")
            initial-major-mode 'emacs-lisp-mode)
   
-  (hook-defun immortal-scratch kill-buffer-query-functions
-    (if (eq (current-buffer) (get-buffer "*scratch*"))
-        (progn (bury-buffer)
-               nil)
-      t)))
+  (add-hook 'kill-buffer-query-functions
+            (defun kill-buffer-query@immortal-scratch ()
+              (if (eq (current-buffer) (get-buffer "*scratch*"))
+                  (progn (bury-buffer)
+                         nil)
+                t))))
 
 (setup scrolling
   (:option auto-window-vscroll nil
@@ -678,14 +684,16 @@
   (apheleia-global-mode +1)
 
   ;; Use a dumb formatter on modes that `apheleia' doesn't work for.
-  (hook-defun dumb-auto-format before-save-hook
-    (setq stupid-modes '(makefile-mode
-                         org-mode))    
-    ;; If there's no apheleia formatter for the mode, just indent the buffer.
-    (unless (or (apply #'derived-mode-p stupid-modes)
-                (and (fboundp 'apheleia--get-formatter-command)
-                     (apheleia--get-formatter-command)))
-      (indent-region (point-min) (point-max)))))
+  (add-hook 'before-save-hook
+            (defun before-save@dumb-auto-format ()
+              (setq stupid-modes '(makefile-mode
+                                   org-mode))    
+              ;; If there's no apheleia formatter for the mode, just indent the
+              ;; buffer.
+              (unless (or (apply #'derived-mode-p stupid-modes)
+                          (and (fboundp 'apheleia--get-formatter-command)
+                               (apheleia--get-formatter-command)))
+                (indent-region (point-min) (point-max))))))
 
 (setup (:straight async)
   (autoload 'dired-async-mode "dired-async.el" nil t)
@@ -712,17 +720,17 @@
                    :repo "minad/consult"))
 
   ;; "Sensible" functions
-  (defun consult-sensible-grep ()
+  (defun consult-sensible-grep (&optional arg)
     "Perform `consult-git-grep' if in a git project, otherwise `consult-ripgrep'
 if ripgrep is installed, otherwise `consult-grep'."
     (interactive "P")
-    (cond ((= (vc-backend buffer-file-name) "Git")
+    (cond ((string-equal (vc-backend buffer-file-name) "Git")
            (call-interactively #'consult-git-grep))
           ((executable-find "rg")
            (call-interactively #'consult-ripgrep))
           (t (call-interactively #'consult-grep))))
   
-  (defun consult-sensible-find ()
+  (defun consult-sensible-find (&optional arg)
     "Peform `consult-locate' if locate is installed, otehrwise `consult-find'."
     (interactive "P")
     (cond ((executable-find "locate") (call-interactively #'consult-locate))
@@ -833,9 +841,7 @@ if ripgrep is installed, otherwise `consult-grep'."
    (setup (:straight (gemini-write
                       :host nil
                       :repo "https://alexschroeder.ch/cgit/gemini-write"
-                      :fork
-                      (:repo "https://tildegit.org/acdw/gemini-write"
-                             :branch "main")))
+                      :branch "main"))
      (require 'gemini-write))))
 
 (setup (:straight expand-region)
@@ -943,7 +949,7 @@ if ripgrep is installed, otherwise `consult-grep'."
   (:option org-adapt-indentation nil
            org-catch-invisible-edits 'smart
            org-confirm-babel-evaluate nil
-           org-ellipsis " ⌵"
+           org-ellipsis " …"
            org-export-coding-system 'utf-8-unix
            org-export-headline-levels 8
            org-export-with-section-numbers nil
@@ -986,7 +992,9 @@ if ripgrep is installed, otherwise `consult-grep'."
   (defun setup-paredit-mode ()
     "Correct weirdnesses and set up paredit mode."
     (paredit-mode +1)
-    (define-key lisp-mode-shared-map (kbd "DEL") #'paredit-backward-delete))
+    (let ((map lisp-mode-shared-map))
+      (define-key map (kbd "DEL") #'paredit-backward-delete)
+      (define-key map (kbd "C-M-;") #'comment-or-uncomment-sexp)))
   
   (dolist (mode lispy-modes)
     (add-hook (intern (concat (symbol-name mode) "-hook"))
@@ -28,21 +28,21 @@
     (_ :other))
   "Which computer system is currently being used.")
 
-(defmacro acdw/system (&rest arg)
+(defmacro acdw/system (&rest args)
   "Convenience macro for interfacing with `acdw/system'.
 
-When called without arguments, it returns `acdw/system'.
-When called with one argument, it returns (eq acdw/system ARG).
-When called with multiple arguments, it returns `pcase' over each argument."
+When called without arguments, it returns `acdw/system'.  When
+called with one (symbol) argument, it returns (eq acdw/system
+ARG).  When called with multiple arguments or a list, it returns
+`pcase' over each argument."
   (cond
-   ((not arg) acdw/system)
-   ((not (cdr arg))
-    `(when (eq acdw/system ,(car arg))
-       ,(car arg)))
-   ((cdr arg)
+   ((null args) acdw/system)
+   ((atom (car args))
+    `(when (eq acdw/system ,(car args))
+       ,(car args)))
+   (t
     `(pcase acdw/system
-       ,@arg))
-   (t (error "Wrong argument type: %s" (type-of arg)))))
+       ,@args))))
 
 
 ;;; Utility functions
@@ -65,17 +65,17 @@ When called with multiple arguments, it returns `pcase' over each argument."
         file
       nil)))
 
-(defmacro hook-defun (name hooks &rest forms)
-  "Define a function NAME that executes FORMS, and add it to
-each hook in HOOKS."
-  (declare (indent 2))
-  (let ((func-name (intern (concat "hook-defun-" (symbol-name name))))
-        (hook-list (if (consp hooks) hooks (list hooks)))
-        (hook-defun-add-hook-list))
-    `(progn
-       (defun ,func-name () "Defined by `hook-defun'." ,@forms)
-       ,@(dolist (hook hook-list hook-defun-add-hook-list)
-           (push `(add-hook ',hook #',func-name) hook-defun-add-hook-list)))))
+;; (defmacro hook-defun (name hooks &rest forms)
+;;   "Define a function NAME that executes FORMS, and add it to
+;; each hook in HOOKS."
+;;   (declare (indent 2))
+;;   (let ((func-name (intern (concat "hook-defun-" (symbol-name name))))
+;;         (hook-list (if (consp hooks) hooks (list hooks)))
+;;         (hook-defun-add-hook-list))
+;;     `(progn
+;;        (defun ,func-name () "Defined by `hook-defun'." ,@forms)
+;;        ,@(dolist (hook hook-list hook-defun-add-hook-list)
+;;            (push `(add-hook ',hook #',func-name) hook-defun-add-hook-list)))))
 
 (defun kill-region-or-backward-word (arg)
   "Kill region if active, or backward word if not."
@@ -106,6 +106,96 @@ is unfocused."
      (message "%s... Done." ,message)))
 
 
+;;; Comment-or-uncomment-sexp
+;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
+
+(defun uncomment-sexp (&optional n)
+  "Uncomment a sexp around point."
+  (interactive "P")
+  (let* ((initial-point (point-marker))
+         (inhibit-field-text-motion t)
+         (p)
+         (end (save-excursion
+                (when (elt (syntax-ppss) 4)
+                  (re-search-backward comment-start-skip
+                                      (line-beginning-position)
+                                      t))
+                (setq p (point-marker))
+                (comment-forward (point-max))
+                (point-marker)))
+         (beg (save-excursion
+                (forward-line 0)
+                (while (and (not (bobp))
+                            (= end (save-excursion
+                                     (comment-forward (point-max))
+                                     (point))))
+                  (forward-line -1))
+                (goto-char (line-end-position))
+                (re-search-backward comment-start-skip
+                                    (line-beginning-position)
+                                    t)
+                (ignore-errors
+                  (while (looking-at-p comment-start-skip)
+                    (forward-char -1)))
+                (point-marker))))
+    (unless (= beg end)
+      (uncomment-region beg end)
+      (goto-char p)
+      ;; Indentify the "top-level" sexp inside the comment.
+      (while (and (ignore-errors (backward-up-list) t)
+                  (>= (point) beg))
+        (skip-chars-backward (rx (syntax expression-prefix)))
+        (setq p (point-marker)))
+      ;; Re-comment everything before it. 
+      (ignore-errors
+        (comment-region beg p))
+      ;; And everything after it.
+      (goto-char p)
+      (forward-sexp (or n 1))
+      (skip-chars-forward "\r\n[:blank:]")
+      (if (< (point) end)
+          (ignore-errors
+            (comment-region (point) end))
+        ;; If this is a closing delimiter, pull it up.
+        (goto-char end)
+        (skip-chars-forward "\r\n[:blank:]")
+        (when (eq 5 (car (syntax-after (point))))
+          (delete-indentation))))
+    ;; Without a prefix, it's more useful to leave point where
+    ;; it was.
+    (unless n
+      (goto-char initial-point))))
+
+(defun comment-sexp--raw ()
+  "Comment the sexp at point or ahead of point."
+  (pcase (or (bounds-of-thing-at-point 'sexp)
+             (save-excursion
+               (skip-chars-forward "\r\n[:blank:]")
+               (bounds-of-thing-at-point 'sexp)))
+    (`(,l . ,r)
+     (goto-char r)
+     (skip-chars-forward "\r\n[:blank:]")
+     (save-excursion
+       (comment-region l r))
+     (skip-chars-forward "\r\n[:blank:]"))))
+
+(defun comment-or-uncomment-sexp (&optional n)
+  "Comment the sexp at point and move past it.
+If already inside (or before) a comment, uncomment instead.
+With a prefix argument N, (un)comment that many sexps."
+  (interactive "P")
+  (if (or (elt (syntax-ppss) 4)
+          (< (save-excursion
+               (skip-chars-forward "\r\n[:blank:]")
+               (point))
+             (save-excursion
+               (comment-forward 1)
+               (point))))
+      (uncomment-sexp n)
+    (dotimes (_ (or n 1))
+      (comment-sexp--raw))))
+
+
 ;;; Emacs configuration functions
 
 (defun emacs-git-pull-config (&optional remote branch)