path: root/.config/emacs/init.el

;;; -*- 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)
  (require 'notifications)
  (notifications-notify
   :title (buffer-name buffer)
   :body results
   :app-icon (if (equal results "finished\n")
                 'compilation-success 'compilation-failure)
   :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