Achieve XDG compliance

… sort of.  Emacs apps will stuff all manner of transient state under
user-emacs-directory by default, so full XDG compliance would probably
involve customizing them all to instead use ~/.cache but 🤷

1 files changed, 1018 insertions, 0 deletions

diff --git a/.config/emacs/init.el b/.config/emacs/init.el
new file mode 100644
index 0000000..9d4cd34
--- /dev/null
+++ b/.config/emacs/init.el
@@ -0,0 +1,1018 @@
+;;; -*- lexical-binding: t -*-
+
+;;; "Custom"ization & theming.
+
+;; Trying to migrate to use-package instead of Custom's serialized
+;; forms.  It's a long-term project; until that's done, start by
+;; setting and loading the `custom-file'.
+(setq custom-file (file-name-concat user-emacs-directory "custom.el"))
+(load custom-file)
+
+;; Compatibility shim for setopt.
+(if (fboundp 'setopt)
+    (defalias 'my/setopt 'setopt)
+  (defmacro my/setopt (&rest pairs)
+    `(let ((pairs (quote ,pairs)))
+       (while pairs
+         (customize-set-variable (pop pairs) (pop pairs))))))
+
+;; Helper for customizing list options.
+;;
+;; None of Emacs's customization tools (Custom, setopt, use-package)
+;; can be told "add this element, take those two away": I need to "set
+;; in stone" an exhaustive list that will make me (1) scratch my head
+;; a few months later when I try to remember which of those items I
+;; deliberately added vs which were part of the default list (2) miss
+;; out on additions to the default list, unless I cautiously audit
+;; every release of every package.
+;;
+;; Examples: erc-modules, git-commit-setup-hook, package-archives.
+(defmacro my/setopt-update-list (l to-add &optional to-remove)
+  `(my/setopt ,l (thread-first
+                   ,l (seq-union ,to-add) (seq-difference ,to-remove))))
+
+(load-theme 'eighters t)
+
+;;; Key bindings.
+
+;; C-h is a special snowflake in many situations; this is the most
+;; reliable way I found to consistently get C-h to do what DEL does.
+;;
+;; Likewise, C-M-h is re-bound by some major modes (CC, Python, Perl),
+;; so this is the simplest way I know of to make sure C-M-h sticks as
+;; "backward-kill-word".
+;;
+;; Same story with M-h (mark-paragraph) which gets re-bound by eg
+;; markdown-mode and nxml-mode.
+(define-key input-decode-map (kbd "C-h") (kbd "DEL"))
+(define-key input-decode-map (kbd "C-M-h") (kbd "M-DEL"))
+
+(global-set-key (kbd "C-x C-b") 'ibuffer)
+
+(when (< emacs-major-version 28)
+  (defun my/other-window (count &optional all-frames)
+    (interactive "p")
+    (let ((repeat-map (make-sparse-keymap)))
+      (define-key repeat-map [?o] #'other-window)
+      (set-transient-map repeat-map t)
+      (other-window count all-frames)))
+  (global-set-key (kbd "C-x o") #'my/other-window))
+
+;; Hopefully these will be easier to remember than TeX commands:
+
+(quail-define-package
+ "my/symbols" "UTF-8" "𝒰" t
+ "Input arbitrary Unicode symbols with other arbitrary symbols.")
+
+(pcase-dolist
+    (`(,key ,translation)
+     '(;; Punctuation
+       ("..." ?…)
+       ;; Math symbols
+       ("~~" ?≈) ("~~=" ?≊) ("~==" ?≅) ("~=" ?≃)
+       ("==" ?≡) ("^=" ?≙) (":=" ?≔)
+       ("<=" ?≤) (">=" ?≥)
+       ("-->" ?→) ("-/>" ?↛) ("==>" ?⇒) ("=/>" ?⇏)
+       ("<--" ?←) ("</-" ?↚) ("<==" ?⇐) ("</=" ?⇍)
+       ("<->" ?↔) ("<=>" ?⇔)
+       ;; Emojis
+       ("\\o/" ?🙌) ("\\m/" ?🤘)
+       ;; Pictograms
+       ("/!\\" ?⚠)))
+  (quail-defrule key translation "my/symbols"))
+
+(defmacro my/make-input-toggle (input-method)
+  (let ((fsym (intern (format "my/toggle-input-%s" input-method)))
+        ;; Unfortunately, by default `help-make-xrefs' does not try to
+        ;; cross-reference input methods, as `help-xref-mule-regexp'
+        ;; is nil.  This can be worked around by setting this variable
+        ;; to `help-xref-mule-regexp-template'.
+        (doc (format "Toggle `%s' input method." input-method)))
+    `(defun ,fsym ()
+       ,doc
+       (interactive)
+       ;; `current-input-method' is a string; if INPUT-METHOD is a
+       ;; symbol, neither eq, eql nor equal would return t.
+       (if (string= current-input-method ',input-method)
+           (deactivate-input-method)
+         (set-input-method ',input-method t)))))
+
+(defun my/set-tab-width (&optional arg)
+  (interactive "P")
+  (let ((new-width (cond (arg (prefix-numeric-value arg))
+                         ((= tab-width 4) 8)
+                         (4)))
+        (old-width tab-width))
+    ;; TODO: for some reason, set-variable takes effect immediately,
+    ;; but setq(-local)? do not: I need to move the cursor before tabs
+    ;; are re-drawn.
+    (set-variable 'tab-width new-width)
+    (message "changed from %s to %s" old-width new-width)))
+
+(defvar-local my/centered-width 'fill-column)
+(defvar-local my/centered-set-right-margin nil)
+
+(defun my/centered--before-split (&optional _size window-to-split)
+  (let ((windows (if (frame-root-window-p window-to-split)
+                     (window-list)
+                   (list window-to-split))))
+    (dolist (w windows)
+      (when (buffer-local-value 'my/centered-mode (window-buffer w))
+        (set-window-margins w nil nil)))))
+
+(defun my/centered--around-splittable (splittable window &optional horizontal)
+  (if (and horizontal
+           (buffer-local-value 'my/centered-mode (window-buffer window)))
+    (let ((margins (window-margins window)))
+      (set-window-margins window nil nil)
+      (prog1
+          (funcall splittable window horizontal)
+        (apply 'set-window-margins window margins)))
+    (funcall splittable window horizontal)))
+
+(advice-add 'split-window-right :before 'my/centered--before-split)
+(advice-add 'window-splittable-p :around 'my/centered--around-splittable)
+
+(define-minor-mode my/centered-mode
+  "Update margins to keep content centered."
+  :init-value nil
+  (if my/centered-mode
+      (progn
+        (add-hook 'window-state-change-functions 'my/centered-set-margins nil t)
+        (dolist (win (get-buffer-window-list))
+          (my/centered-set-margins win)))
+    (remove-hook 'window-state-change-functions 'my/centered-set-margins t)
+    (dolist (win (get-buffer-window-list))
+      (set-window-margins win nil))))
+
+(defun my/centered-set-margins (window)
+  (with-current-buffer (window-buffer window)
+    (let* ((target-body-width
+            (cond
+             ((symbolp my/centered-width)
+              (symbol-value my/centered-width))
+             ((integerp my/centered-width)
+              my/centered-width)))
+           (adjustable-width
+            (- (window-total-width window)
+               (+ (fringe-columns 'left) (fringe-columns 'right))))
+           (left-margin
+            (when (> adjustable-width target-body-width)
+              (/ (- adjustable-width target-body-width) 2)))
+           (right-margin (and my/centered-set-right-margin
+                              left-margin)))
+      (set-window-margins window left-margin right-margin))))
+
+(defun my/kill (stuff)
+  (kill-new stuff)
+  (message "%s" stuff))
+
+;; TODO: my/kill-where
+;; * filename
+;;   * absolute, project-relative (w/o project), namespace-relative, base
+;; * function
+;; * line number
+;; * public URL
+
+;; TODO: my/kill-cite
+;; * prefix: nil, >, |
+;; * indent
+;; * attribution: see my/kill-where
+;;   * concise: "(manual) Node", "manual(7)"
+;;   * executable: (info "(manual) Node"), "man 7 manual"
+;;   * <https://somewhe.re/manual.html#node>
+
+(defun my/read (prompt default)
+  (read-string (format-prompt prompt default) nil nil default))
+
+(defvar my/run-strip-newline t
+  "Whether `my/run' will remove a trailing newline from a command's output.")
+
+(defun my/run (program &rest args)
+  "Return output from 'PROGRAM [ARGS…]'.
+Raise a user error if the command fails.  Heed `my/run-strip-newline'."
+  (with-temp-buffer
+    (let* ((status (apply 'call-process program nil t nil args))
+           (output (buffer-string)))
+      (if (eq status 0)
+          (if my/run-strip-newline
+              (string-remove-suffix "\n" output)
+            output)
+        (user-error "%s returned %d:\n%s" program status output)))))
+
+(defun my/kill-command (program &rest args)
+  "Send output from PROGRAM to kill-ring.
+See `my/run' for details, e.g. status handling and output massaging."
+  (my/kill (apply 'my/run program args)))
+
+(defun my/kill-date (date format)
+  (interactive
+   (if current-prefix-arg
+       (list (my/read "Date spec?" "today")
+             (my/read "Format?" "%F"))
+     (list "today" "%F")))
+  (my/kill-command "date" (concat "-d" date) (concat "+" format)))
+
+(defun my/kill-filename ()
+  (interactive)
+  (my/kill (or (buffer-file-name) default-directory)))
+
+(defun my/kill-pipe-region (command)
+  (interactive (list (read-shell-command "Shell command on region: ")))
+  (let ((input (funcall region-extract-function nil)))
+    (with-temp-buffer
+      (insert input)
+      (call-process-region (point-min) (point-max) shell-file-name
+                           t t nil shell-command-switch command)
+      (my/kill (buffer-string)))))
+
+(defun my/kill-shell (command)
+  "Send output from COMMAND to kill-ring.
+Meant for interactive prompting for full commands passed to a shell.
+For Lisp use, prefer `my/kill-command', where arguments are passed via a
+list and require no escaping."
+  (interactive (list (read-shell-command "Shell command: ")))
+  (with-temp-buffer
+    (call-process-shell-command command nil t)
+    (my/kill (buffer-string))))
+
+(defun my/shell-command-help (command)
+  (interactive
+   (list (read-shell-command "Show --help for: ")))
+  (let* ((command--help (concat command " --help"))
+         (help-buf (get-buffer-create (format "*%s*" command--help))))
+    (shell-command (concat command--help) help-buf)
+    (display-buffer help-buf)))
+
+(defun my/magit-project ()
+  (interactive)
+  (require 'project)
+  (magit-status (project-prompt-project-dir)))
+
+(defun my/magit-toggle-margin-date ()
+  (interactive)
+  (let ((do-message
+         (lambda (old new)
+           (message
+            "%s ⇒ %s"
+            (propertize old 'face 'shadow)
+            (propertize new 'face 'bold)))))
+    (apply do-message (if magit-log-margin-show-committer-date
+                          '("commit" "author") '("author" "commit")))
+    (setq magit-log-margin-show-committer-date
+          (not magit-log-margin-show-committer-date))
+    (revert-buffer)))
+
+(defmacro my/define-prefix-command (name doc bindings)
+  (declare (indent defun))
+  `(defvar ,name
+     (let ((map (define-prefix-command ',name)))
+       (pcase-dolist (`(,key ,fun) ,bindings)
+         (define-key map key fun))
+       map)
+     ,doc))
+
+(my/define-prefix-command my/buffer-map
+  "Keymap for buffer manipulation commands."
+  '(("b" bury-buffer)
+    ("g" revert-buffer)
+    ("r" rename-buffer)))
+
+(my/define-prefix-command my/display-map
+  "Keymap for display-related commands."
+  '(("c" my/centered-mode)
+    ("l" hl-line-mode)
+    ("n" display-line-numbers-mode)
+    ("t" toggle-truncate-lines)
+    ("v" visual-line-mode)))
+
+(my/define-prefix-command my/editing-map
+  "Keymap for toggling editing features."
+  '(("f" auto-fill-mode)))
+
+(my/define-prefix-command my/magit-map
+  "Keymap for Magit commands."
+  '(("d" my/magit-toggle-margin-date)
+    ("f" magit-file-dispatch)
+    ("g" magit-status)
+    ("p" my/magit-project)
+    ("x" magit-dispatch)
+    ("\C-f" magit-find-file)))
+
+(my/define-prefix-command my/input-map
+  "Keymap for input methods shortcuts."
+  `(("e" ,(my/make-input-toggle emoji))
+    ("t" ,(my/make-input-toggle TeX))
+    ("u" ,(my/make-input-toggle my/symbols))))
+
+(my/define-prefix-command my/kill-map
+  "Keymap for adding things to the kill ring."
+  '(("d" my/kill-date)
+    ("f" my/kill-filename)
+    ("|" my/kill-pipe-region)
+    ("!" my/kill-shell)))
+
+(my/define-prefix-command my/manual-map
+  "Keymap for reading manuals."
+  '(("h" my/shell-command-help)
+    ("i" info-display-manual)
+    ("m" man)
+    ("s" shortdoc-display-group)))
+
+(my/define-prefix-command my/whitespace-map
+  "Keymap for whitespace-related commands."
+  '(("c" whitespace-cleanup)
+    ("f" page-break-lines-mode)
+    ("m" whitespace-mode)
+    ("t" my/set-tab-width)))
+
+;; C-c [[:alpha:]] is reserved for users - let's make good use of it.
+
+(global-set-key (kbd "C-c b") 'my/buffer-map)
+(global-set-key (kbd "C-c c") 'compile)
+(global-set-key (kbd "C-c d") 'my/display-map)
+(global-set-key (kbd "C-c e") 'my/editing-map)
+(global-set-key (kbd "C-c g") 'my/magit-map)
+(global-set-key (kbd "C-c i") 'my/input-map)
+(global-set-key (kbd "C-c k") 'my/kill-map)
+(global-set-key (kbd "C-c m") 'my/manual-map)
+(global-set-key (kbd "C-c w") 'my/whitespace-map)
+
+(rg-enable-default-bindings)            ; Uses the C-c s prefix.
+
+;; What's life without a little risk?
+(setq disabled-command-function nil)
+
+;;; Window management.
+
+;; Bindings ala Terminator
+(when window-system
+  (global-set-key (kbd "C-S-o") 'split-window-below)
+  (global-set-key (kbd "C-S-e") 'split-window-right)
+  (global-set-key (kbd "C-+") 'text-scale-adjust)
+  (global-set-key (kbd "C--") 'text-scale-adjust)
+  (global-set-key (kbd "C-0") 'text-scale-adjust)
+  (global-set-key (kbd "C-S-<up>") 'enlarge-window)
+  (global-set-key (kbd "C-S-<down>") 'shrink-window)
+  (global-set-key (kbd "C-S-<right>") 'enlarge-window-horizontally)
+  (global-set-key (kbd "C-S-<left>") 'shrink-window-horizontally))
+
+;;; Lighters.
+
+(defun my/symbol-as-icon (c)
+  ;; By default, Emacs 28 uses color fonts for characters from (1) the
+  ;; 'emoji script (2) the 'symbol script, when followed by VS-16.
+  ;; Meanwhile, Emacs 27 knows how to display color fonts, but (1) it
+  ;; has no 'emoji script (2) it doesn't know what to do with VS-16.
+  ;; Bottomline: on Emacs 28, explicitly ask for the emoji
+  ;; presentation with VS-16; on older emacsen, just use the
+  ;; character, and rely on a blanket fontset rule to prefer color
+  ;; fonts for the whole 'symbol script.
+  (apply 'string `(,c ,@(when (>= emacs-major-version 28)
+                          '(?\N{VARIATION SELECTOR-16})))))
+
+;; So long, Will Mengarini.
+(delight 'abbrev-mode nil 'abbrev)
+(delight 'auto-fill-function "⏎" t)
+(delight 'auto-revert-mode "⟳" 'autorevert)
+(delight 'auto-revert-tail-mode "⤓" 'autorevert)
+(delight 'footnote-mode "¹" 'footnote)
+(delight 'flyspell-mode (propertize (my/symbol-as-icon ?🖋)
+                                    'face 'flyspell-incorrect)
+         'flyspell)
+(delight 'hi-lock-mode nil 'hi-lock)
+(delight 'hs-minor-mode "…" 'hideshow)
+(delight 'mml-mode "📧" 'mml)
+(delight 'page-break-lines-mode nil 'page-break-lines)
+(delight 'scroll-lock-mode "📜" 'scroll-lock)
+(delight 'text-scale-mode
+         '(:eval (if (>= text-scale-mode-amount 0) "🗚" "🗛"))
+         'face-remap)
+(delight 'visual-line-mode nil t)
+(delight 'with-editor-mode "⸎" 'with-editor)
+;; TODO: Narrow (⌖, ⛶)
+
+(if (< emacs-major-version 27)
+    (delight 'compilation-in-progress
+             (propertize "⚙" 'face 'compilation-mode-line-run)
+             'compile)
+  (let* ((indicator (alist-get 'compilation-in-progress mode-line-modes))
+         (old-props (text-properties-at 0 (car indicator)))
+         (face '(:inverse-video t :inherit compilation-mode-line-run))
+         (new-props (append `(face ,face) old-props))
+         (icon (my/symbol-as-icon ?⚙)))
+    (setcar indicator (concat (apply #'propertize icon new-props) " "))))
+
+(setq eglot-menu-string "🦻")
+
+(with-eval-after-load 'flymake
+  (let ((indicator (propertize (my/symbol-as-icon ?⚒) 'face 'flymake-error)))
+    ;; Prefer customizing the string instead delight'ing, as flymake
+    ;; slaps a bunch of helpful properties on top of the lighter,
+    ;; which delight would strip.
+    (if (boundp 'flymake-mode-line-lighter)
+        (setq flymake-mode-line-lighter indicator)
+      (delight 'flymake-mode indicator 'flymake))))
+
+;;; Version control.
+
+(defvar my/git-commit-fill-columns
+  '((my/emacs-repo-p . 63)))
+
+(defun my/git-upstreams ()
+  ;; TODO: memoize, perhaps?
+  (seq-uniq
+   (seq-keep
+    (lambda (remote-desc)
+      (and (string-match "\\`.*\t\\(.*\\) (fetch)\\'" remote-desc)
+           (match-string 1 remote-desc)))
+    (process-lines "git" "remote" "-v"))))
+
+(cl-defun my/git-commit-maybe-set-fill-column ()
+  (let ((remotes (my/git-upstreams)))
+    (pcase-dolist (`(,pred . ,column) my/git-commit-fill-columns)
+      (when (funcall pred remotes)
+        (cl-return-from my/git-commit-maybe-set-fill-column
+          (setq fill-column column))))))
+
+(defun my/revision-at-point ()
+  (cond
+   ((derived-mode-p 'magit-mode)
+    (magit-branch-or-commit-at-point))
+   ((derived-mode-p 'vc-git-log-view-mode)
+    (log-view-current-tag))
+   ((derived-mode-p 'vc-annotate-mode)
+    (car (vc-annotate-extract-revision-at-line)))))
+
+(defun my/describe-revision (rev)
+  "Format a Git revision in a format suitable for changelogs."
+  (interactive
+   (list (my/read "Revision" (my/revision-at-point))))
+  (my/kill-command
+   "git" "show" "--no-patch" "--date=short" "--format=%cd \"%s\" (%h)" rev))
+
+;;; Major modes configuration.
+
+(defun my/c-modes-hook ()
+  (c-set-style "bsd")
+  (c-set-offset 'arglist-close 0))
+
+(add-hook 'c-mode-common-hook 'my/c-modes-hook)
+
+(defun my/calendar-iso-week (year month day)
+  ;; NIH version of `calendar-intermonth-text''s serving suggestion.
+  (propertize
+   (format-time-string "%V" (encode-time (list 0 0 0 day month year)))
+   'font-lock-face 'eighters-date))
+
+(defun my/compilation-notify (buffer results)
+  (let* ((title (buffer-name buffer))
+         (status (if (string-equal results "finished\n") "success" "failure"))
+         (icon (format "%s/icons/compilation-%s.png" user-emacs-directory status)))
+    (require 'notifications)
+    (notifications-notify :title title :body results :app-icon icon :timeout 3000)))
+
+(add-to-list 'compilation-finish-functions 'my/compilation-notify)
+
+(defun my/make-tabless (f)
+  "Make a function which will run F with `indent-tabs-mode' disabled."
+  (lambda ()
+    (:documentation (format "Run `%s' with `indent-tabs-mode' set to nil." f))
+    (interactive)
+    (let ((indent-tabs-mode nil))
+      (call-interactively f))))
+
+(defun my/makefile-hook ()
+  ;; I would rather align backslashes with spaces rather than tabs;
+  ;; however, I would also like indent-tabs-mode to remain non-nil.
+  (local-set-key (kbd "C-c C-\\") (my/make-tabless 'makefile-backslash-region))
+  (local-set-key (kbd "M-q") (my/make-tabless 'fill-paragraph)))
+
+(add-hook 'makefile-mode-hook 'my/makefile-hook)
+
+(defun my/shell-hook ()
+  (setq truncate-lines nil)
+  (setq-local recenter-positions '(top middle bottom)))
+
+(add-to-list 'ibuffer-saved-filter-groups
+             '("my/ibuffer-groups"
+               ("REPL"
+                (or (derived-mode . comint-mode)
+                    (mode . lisp-interaction-mode)))
+               ("Programming" (derived-mode . prog-mode))
+               ("Folders" (mode . dired-mode))
+               ("Messaging"
+                (or (mode . erc-mode)
+                    (mode . message-mode)
+                    (derived-mode . gnus-mode)))
+               ("Documentation"
+                (or (mode . Info-mode)
+                    (mode . Man-mode)
+                    (mode . help-mode)))
+               ("Version control"
+                (or (derived-mode . magit-mode)
+                    (name . "\\`\\*vc")))))
+
+(add-hook 'ibuffer-mode-hook
+          (lambda ()
+            (ibuffer-switch-to-saved-filter-groups "my/ibuffer-groups")))
+
+;;; Development helpers.
+(defun my/emacs-repo-p (upstreams)
+  "Guess whether we are working in the Emacs repository.
+UPSTREAMS is a list of fetch URLs."
+  (member "https://git.savannah.gnu.org/git/emacs.git" upstreams))
+
+(defun my/emacs-run-testcase ()
+  (interactive)
+  (require 'which-func)
+  (let* ((emacs-root (project-root (project-current)))
+         (testfile (file-name-sans-extension
+                    (file-relative-name
+                     buffer-file-name (file-name-concat
+                                       emacs-root "test"))))
+         (cores (num-processors 'all))
+         (options
+          `(("SELECTOR"                   . ,(which-function))
+            ("TEST_BACKTRACE_LINE_LENGTH" . nil)))
+         (options-list
+          (seq-map
+           (lambda (opt) (format "%s=%s" (car opt) (cdr opt)))
+           options))
+         (compile-command
+          (format "make -j%s && make -C test %s %s"
+                  cores testfile (string-join options-list " "))))
+    (call-interactively 'project-compile)))
+
+;;; Helper functions and miscellaneous settings.
+
+;;;; French quick toggle.
+(defun my/froggify ()
+  (ispell-change-dictionary "fr")
+  (setq-local colon-double-space nil)
+  (setq-local sentence-end-double-space nil)
+  (setq-local fill-nobreak-predicate
+              (cons 'fill-french-nobreak-p fill-nobreak-predicate))
+  (setq-local my/froggified t))
+
+(defun my/unfroggify ()
+  (ispell-change-dictionary "default")
+  (setq-local colon-double-space t)
+  (setq-local sentence-end-double-space t)
+  (setq-local fill-nobreak-predicate
+              (remq 'fill-french-nobreak-p fill-nobreak-predicate))
+  (setq-local my/froggified nil))
+
+(defun my/croak ()
+  (interactive)
+  (if (and (boundp 'my/froggified) my/froggified)
+      (my/unfroggify)
+    (my/froggify)))
+
+;;;; Mailing lists utilities.
+(defun my/kill-message-id ()
+  (interactive)
+  (my/kill (mail-header-message-id (gnus-summary-article-header))))
+
+(defun my/describe-message (id url)
+  (my/kill (format "%s\n%s\n"
+                   (if (string-prefix-p "<" id)
+                       id
+                     (format "<%s>" id))
+                   url)))
+
+(defun my/describe-message-id (list id)
+  "Format references from the Message-ID of a gnu.org list."
+  (interactive
+   (list
+    (read-string "List: ")            ; TODO: default to current list.
+    (let ((default-id
+            (mail-header-message-id (gnus-summary-article-header))))
+      (read-string (format-prompt "Message-ID" default-id)
+                   nil nil default-id))))
+  (with-current-buffer
+      (url-retrieve-synchronously
+       (concat
+        ;; For some reason, literal "+" chars cause the search to fail.
+        ;; Escape them.
+        "https://lists.gnu.org/archive/cgi-bin/namazu.cgi"
+        "?query=%2Bmessage-id:"
+        (replace-regexp-in-string "\\+" "%2B" id)
+        "&submit=Search!"
+        "&idxname=" list))
+    (search-forward-regexp
+     (rx "<a href=\""
+         (group "/archive/html/" (literal list) "/"
+                (+ (any "0-9-")) "/msg" (+ (any "0-9")) ".html")
+         "\">"))
+    (let ((url (concat "https://lists.gnu.org" (match-string 1))))
+      (my/describe-message id url))))
+
+(defun my/describe-message-url (url)
+  "Format references from an article archived on MHonArc."
+  (interactive
+   (list
+    (let ((default (or (thing-at-point 'url)
+                       (and (derived-mode-p 'eww-mode)
+                            (shr-url-at-point nil)))))
+      (read-string (format-prompt "URL" default) nil nil default))))
+  (with-current-buffer (url-retrieve-synchronously url)
+    (search-forward-regexp "^<!--X-Message-Id: \\(.+\\) -->$")
+    (let ((id (xml-substitute-numeric-entities (match-string 1))))
+      (my/describe-message id url))))
+
+;;;; Font stuff 🤷🤦.
+(when (= emacs-major-version 27)
+  ;; Emacs 27 added support for color fonts, but the default fontset
+  ;; did not use any such font for emoji.
+  (set-fontset-font t 'symbol "Noto Color Emoji" nil 'prepend)
+  ;; Make sure the default font does not get overzealous: ⚠⚙.
+  ;; For Emacs 28, prefer VS-16: ⚠️⚙️.
+  (setq use-default-font-for-symbols nil))
+
+;;;; Frame title.
+(defun my/project-root ()
+  (and-let* ((project (project-current)))
+    (project-root project)))
+
+(defun my/project-name ()
+  (and-let* ((root (my/project-root))
+             ;; Home is under VC to track dotfile changes.  Not a
+             ;; "project" I want shown in the UI though.
+             ((not (file-equal-p root "~"))))
+    (file-name-nondirectory (directory-file-name root))))
+
+(defun my/connection-name ()
+  (let ((method (file-remote-p default-directory 'method)))
+    (pcase method
+      ;; No method: nil.
+      ('nil method)
+      ;; sudo(edit): just "METHOD".
+      ((pred (string-match-p "sudo")) method)
+      ;; Default: "METHOD:HOST".
+      (_ (format "%s:%s" method (file-remote-p default-directory 'host))))))
+
+(defun my/frame-title-format ()
+  (let ((prefix
+         ;; Messing with match data during redisplay is dangerous
+         ;; (cf. bug#33697).
+         (save-match-data
+           ;; For some reason, calling filename-parsing functions
+           ;; while TRAMP is busy opens the gates to Infinite
+           ;; Minibuffer Recursion Hell.  Cautiously side-step that.
+           (or
+            (my/connection-name)
+            (my/project-name)))))
+    (concat (when prefix (format "[%s] " prefix))
+            "%b")))
+
+(setq frame-title-format '(:eval (my/frame-title-format)))
+
+;;;; Clipboard interaction.
+(defun my/kill-as-html (text markup)
+  (interactive
+   (list (buffer-substring (region-beginning) (region-end))
+         (or (alist-get major-mode '((markdown-mode . "markdown")
+                                     (org-mode . "org")
+                                     (rst-mode . "rst")))
+             (let ((default "plain"))
+               (read-string (format-prompt "Convert from:" default)
+                            nil nil default)))))
+  ;; TODO: make this a transient to easily (un)set pandoc extensions.
+  (with-temp-buffer
+    (call-process-region text nil "pandoc" nil t nil
+                         "--from" markup "--to" "html")
+    ;; TODO: could `gui-set-selection' help here?  The docstring makes
+    ;; it sound like passing a value with a 'text/html property set to
+    ;; the HTML string should work, but empirically it doesn't.
+    ;; Maybe look into `selection-converter-alist'.
+    (call-process-region nil nil "xclip" nil nil nil
+                         "-selection" "clipboard" "-target" "text/html")))
+
+(defun my/yank-from-html (html markup)
+  (interactive
+   (list
+    (gui-get-selection 'CLIPBOARD 'text/html)
+    (or (alist-get major-mode '((markdown-mode . "markdown")
+                                (org-mode . "org")
+                                (rst-mode . "rst")))
+        (let ((default "plain"))
+          (read-string (format-prompt "Convert to:" default)
+                       nil nil default)))))
+  ;; TODO: make this a transient to easily (un)set
+  ;; * extensions
+  ;; * switches (--wrap)
+  ;; * filters (remove all attributes)
+  (let* ((disabled-html-extensions (list
+                                    "native_divs"
+                                    "native_spans"
+                                    ))
+         (disabled-markup-extensions (list
+                                      ;; "smart"
+                                      ))
+         (html-spec
+          (funcall 'string-join `("html" ,@disabled-html-extensions) "-"))
+         (markup-spec
+          (funcall 'string-join `(,markup ,@disabled-markup-extensions) "-")))
+    (call-process-region html nil "pandoc" nil t t
+                         "--wrap=none"
+                         "--from" html-spec "--to" markup-spec)))
+
+;;;; Miscellany.
+(setq-default paragraph-start (concat "[ 	]*- \\|" paragraph-start))
+
+(defun my/screenshot (output)
+  (interactive
+   (list
+    (let ((default (format-time-string "/tmp/Emacs-Screenshot-%F-%T.pdf")))
+      (read-file-name (format-prompt "Output?" default) nil default))))
+  (let ((data (x-export-frames))
+        (buf (find-file output)))
+    (insert data)
+    (save-buffer)
+    (kill-buffer buf)))
+
+;; Trying out use-package.
+
+(use-package use-package
+  :custom
+  (use-package-always-defer t))
+
+(use-package package
+  :custom
+  (package-selected-packages
+   (append '(auctex
+             debbugs
+             delight
+             diff-hl
+             elisp-benchmarks
+             forge
+             gnus-mock
+             magit
+             markdown-mode
+             page-break-lines
+             rg
+             rust-mode
+             wgrep)
+           (when (< emacs-major-version 29)
+             '(eglot use-package))
+           (when (< emacs-major-version 30)
+             '(which-key))))
+  :config
+  (my/setopt-update-list
+   package-archives '(("melpa" . "https://melpa.org/packages/"))))
+
+(use-package calendar
+  :custom
+  (calendar-intermonth-text '(my/calendar-iso-week year month day))
+  (calendar-today-visible-hook '(calendar-mark-today))
+  (calendar-week-start-day 1))
+
+(use-package diff-hl
+  :custom
+  (diff-hl-flydiff-mode t)
+  (global-diff-hl-mode t)
+
+  ;; FIXME: Adding to these hooks _here_ clobbers them, i.e. they end
+  ;; up containing (a) the diff-hl functions (b) whatever functions
+  ;; their libraries add dynamically (c) *none* of the functions
+  ;; included in the defcustom's default value.
+  ;;
+  ;; Therefore, set these hooks up in the :config form _for the
+  ;; libraries that define these hooks_, so that (presumably) the
+  ;; default values for these hooks are loaded *before* adding the
+  ;; diff-hl functions.
+  ;;
+  ;; :hook
+  ;; ((dired-mode . diff-hl-dired-mode-unless-remote)
+  ;;  (magit-pre-refresh . diff-hl-magit-pre-refresh)
+  ;;  (magit-post-refresh . diff-hl-magit-post-refresh))
+  )
+
+(use-package dired
+  :custom
+  (dired-kill-when-opening-new-dired-buffer t)
+  (dired-listing-switches "-al -Fhv --group-directories-first")
+  :config
+  (add-hook 'dired-mode-hook 'diff-hl-dired-mode-unless-remote))
+
+(use-package dired-aux
+  :custom
+  (dired-vc-rename-file t))
+
+(use-package ediff
+  :custom
+  (ediff-merge-split-window-function 'split-window-vertically)
+  (ediff-split-window-function 'split-window-horizontally)
+  (ediff-window-setup-function 'ediff-setup-windows-plain))
+
+(use-package eldoc
+  :delight "📖")
+
+(use-package erc
+  :custom
+  (erc-log-channels-directory
+   (concat user-emacs-directory "erc/logs"))
+  (erc-log-write-after-insert t)
+  (erc-log-write-after-send t)
+  (erc-notifications-icon
+   (concat data-directory "images/icons/hicolor/scalable/apps/emacs.svg"))
+  (erc-prompt-for-nickserv-password nil)
+  (erc-prompt-for-password nil)
+  (erc-use-auth-source-for-nickserv-password t)
+  (erc-user-full-name 'user-full-name)
+  ;; Timestamps are a mess.
+  ;;
+  ;; The default `left-and-right' tries to keep timestamps flush right
+  ;; either with hard-spacing or with :align-to; both cause jank when
+  ;; splitting windows or rescaling faces.  The default `left' does
+  ;; not do the separate-date-and-time thing.
+  ;;
+  ;; It may be possible to define my own function to do the
+  ;; date-if-changed-then-time-if-changed thing, but that would
+  ;; require a lot of cargo-culting of erc-stamp.el which, as of
+  ;; 30.0.50, makes this look more complex than I have patience for:
+  ;; an obsolete variable (`erc-stamp-prepend-date-stamps-p'), an
+  ;; internal minor mode (`erc-stamp--date-mode'), lots of text
+  ;; properties ('field, 'invisible)…
+  ;;
+  ;; The options below seem like the least bad compromise, even though
+  ;; they yield a huge left margin interrupted by continuation lines;
+  ;; `erc-fill-wrap' _should_ help with those, except it causes
+  ;; impromptu recentering.  `visual-wrap' could help here.
+  (erc-insert-timestamp-function 'erc-insert-timestamp-left)
+  (erc-timestamp-format "[%F %H:%M] ")
+  :config
+  (my/setopt-update-list erc-modules '(log notifications stamp track) '(fill))
+  (my/setopt-update-list erc-track-exclude-types '("JOIN" "PART" "QUIT")))
+
+(use-package forge
+  ;; Auto-load after Magit, to ensure `f n' works.
+  :after magit
+  ;; We have `use-package-always-defer' set, so `:after' does nothing
+  ;; unless we also set `:demand' (xref GH#572):
+  :demand t)
+
+(use-package generic-x
+  :demand t
+  :custom
+  (generic-extras-enable-list
+   '(etc-fstab-generic-mode
+     etc-modules-conf-generic-mode
+     etc-passwd-generic-mode
+     etc-services-generic-mode
+     etc-sudoers-generic-mode
+     hosts-generic-mode
+     pkginfo-generic-mode
+     resolve-conf-generic-mode
+     x-resource-generic-mode)))
+
+(use-package git-commit
+  :config
+  (my/setopt-update-list
+   git-commit-setup-hook '(git-commit-turn-on-flyspell
+                           my/git-commit-maybe-set-fill-column)))
+
+(use-package gnus
+  :custom
+  ;; Only set file locations here; let gnus-init-file do the heavy
+  ;; lifting.
+  (gnus-home-directory (file-name-concat user-emacs-directory "gnus"))
+  (gnus-init-file  (file-name-concat user-emacs-directory "gnus" "init.el")))
+
+(use-package isearch
+  :delight "🔍"
+  :custom
+  (isearch-allow-scroll t)
+  (isearch-lazy-count t)
+  (search-default-mode 'char-fold-to-regexp))
+
+(use-package magit
+  :custom
+  (magit-define-global-key-bindings nil)
+  (magit-diff-refine-hunk t)
+  (magit-ediff-dwim-show-on-hunks t)
+  (magit-revision-show-gravatars t)
+  :config
+  (setq magit-process-finish-apply-ansi-colors t)
+  ;; See `diff-hl' form for rationale.
+  (add-hook 'magit-pre-refresh-hook 'diff-hl-magit-pre-refresh)
+  (add-hook 'magit-post-refresh-hook 'diff-hl-magit-post-refresh))
+
+(use-package magit-blame
+  :delight "👉")
+
+(use-package markdown-mode
+  :custom
+  (markdown-asymmetric-header t)
+  (markdown-command "pandoc -s")
+  (markdown-enable-math t)
+  (markdown-header-scaling t)
+  (markdown-indent-on-enter 'indent-and-new-item))
+
+(use-package message
+  :custom
+  (message-confirm-send t))
+
+;; Gripes:
+;; - underused keys: C-M-i, C-j
+;; - (minibuffer-)choose-completion ignore completion-no-auto-exit
+;;   when the candidate is a directory: the candidate is inserted in
+;;   the minibuffer and the user does *not* exit the minibuffer.
+;;
+;; In minibuffer:
+;; - TAB            complete, or show/update completions
+;; - TAB²           jump to completions
+;; - C-M-n, C-M-p   highlight candidate (without changing minibuffer)
+;; - RET, C-j       accept minibuffer input
+;; - M-RET          accept highlighted candidate
+;; - C-u M-RET      insert highlighted candidate (without accepting)
+;;
+;; In completions:
+;; - n, TAB, p      highlight candidate (without changing minibuffer)
+;; - RET            accept highlighted candidate
+;; - C-u RET        insert highlighted candidate in minibuffer (without accepting)
+;; - C-g, q         back to minibuffer
+(use-package minibuffer
+  :config
+  (setq completion-ignore-case t)
+  (define-key completion-in-region-mode-map (kbd "C-M-n") 'minibuffer-next-completion)
+  (define-key completion-in-region-mode-map (kbd "C-M-p") 'minibuffer-previous-completion)
+  (define-key minibuffer-mode-map (kbd "C-M-n") 'minibuffer-next-completion)
+  (define-key minibuffer-mode-map (kbd "C-M-p") 'minibuffer-previous-completion)
+  :custom
+  (completion-auto-help 'visible)
+  (completion-auto-select 'second-tab)
+  (completion-pcm-leading-wildcard t)
+  (completion-show-help nil)
+  (completions-detailed t)
+  (completions-format 'one-column)
+  (completions-group t)
+  (completions-max-height 10)
+  (minibuffer-completion-auto-choose nil)
+  (read-buffer-completion-ignore-case t)
+  (read-file-name-completion-ignore-case t))
+
+(use-package org
+  :config
+  (when (version< org-version "9.4")
+    (define-key org-mode-map (kbd "C-j") 'org-return)
+    (define-key org-mode-map (kbd "RET") 'org-return-indent))
+  :custom
+  (org-edit-src-content-indentation 0)
+  (org-ellipsis "…")
+  (org-fontify-done-headline nil)
+  (org-fontify-quote-and-verse-blocks t)
+  (org-goto-interface 'outline-path-completion)
+  (org-startup-indented t)
+  (org-use-extra-keys t)
+  (org-use-speed-commands t)
+  ;; Make org-refile a bit more eager.
+  (org-outline-path-complete-in-steps nil)
+  (org-refile-targets '((nil . (:maxlevel . 10))))
+  (org-refile-use-outline-path t))
+
+(use-package org-indent
+  :delight "»")
+
+(use-package paren
+  :custom
+  (show-paren-mode t)
+  (show-paren-predicate t))
+
+(use-package python
+  :custom
+  (python-fill-docstring-style 'pep-257-nn)
+  (python-forward-sexp-function nil)
+  (python-indent-def-block-scale 1))
+
+(use-package shell
+  :config
+  (setq shell-font-lock-keywords nil)
+  (add-hook 'shell-mode-hook 'my/shell-hook))
+
+(use-package shr
+  :custom
+  ;; Prefer visual-line-mode, which refills text automatically when
+  ;; the window width changes.
+  (shr-fill-text nil))
+
+(use-package which-key
+  :custom
+  (which-key-dont-use-unicode nil)
+  (which-key-idle-delay 0.5)
+  (which-key-mode t)
+  :delight)
+
+(use-package whitespace
+  :config
+  (my/setopt-update-list whitespace-style nil '(lines missing-newline-at-eof))
+  :delight
+  ;; FIXME: without :demand t, enabling whitespace-mode in a diff
+  ;; buffer first causes diff-mode's settings to be applied globally.
+  :demand t)
+
+;;; TODO:
+;; * decruftify mode-line (e.g. remove superflous parens).
+;; * teach some modes to give better names to their buffers to reduce
+;;   clobbering: info, occur