dotfiles

init.el (34621B)

---

 ;;; -*- 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.
 
 ;; Rebinding C-h, the gateway to the Self-Documenting Editor's
 ;; defining feature, proved tricky; 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)
 
 (defun my/find-user-file ()
   (interactive)
   (let ((default-directory user-emacs-directory))
    (call-interactively 'find-file)))
 
 ;; 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/" ?🤘)))
   (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)))
 
 (defun my/auto-hscroll-toggle ()
   (interactive)
   ;; Use indices to avoid confusing `if-let*' with nil.
   (if-let* ((values '(nil t current-line))
             (prev (seq-position values auto-hscroll-mode))
             (next (% (1+ prev) (length values))))
       (progn
         (message (concat
                   (propertize (format "%s" (nth prev values)) 'face 'shadow)
                   " → "
                   (propertize (format "%s" (nth next values)) 'face 'bold)))
         (setopt auto-hscroll-mode (nth next values)))
     (error "Unknown value for auto-hscroll-mode: %s" auto-hscroll-mode)))
 
 (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-char (c)
   (interactive (list (read-char-by-name "Codepoint? " t)))
   (my/kill (string c)))
 
 (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."
   '(("h" my/auto-hscroll-toggle)
     ("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/find-map
   "Keymap for finding things."
   '(("u" my/find-user-file)))
 
 (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 (or system clipboard)."
   '(("C" my/kill-char)
     ("d" my/kill-date)
     ("f" my/kill-filename)
     ("W" my/kill-as-html)
     ("|" 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)
     ("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 f") 'my/find-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.
 
 ;; 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
  'flyspell-mode (propertize "🖋️" 'face 'flyspell-incorrect) 'flyspell)
 (delight 'hi-lock-mode nil 'hi-lock)
 (delight 'hs-minor-mode "…" 'hideshow)
 (delight 'mml-mode "📧" 'mml)
 (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 (⌖, ⛶)
 
 (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 "⚙️"))
   (setcar indicator (concat (apply #'propertize icon new-props) " ")))
 
 (setq eglot-menu-string "🦻")
 
 (with-eval-after-load 'flymake
   (let ((indicator (propertize "⚒️" '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))))))
 
 (defvar my/git-commit-use-changelog
   (list 'my/emacs-repo-p))
 
 (defun my/git-commit-maybe-set-changelog-support ()
   (let ((remotes (my/git-upstreams)))
     (when (run-hook-with-args-until-success
            'my/git-commit-use-changelog remotes)
       (git-commit-setup-changelog-support))))
 
 (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
    sentence-end-double-space nil
    fill-nobreak-predicate (cons 'fill-french-nobreak-p fill-nobreak-predicate)))
 
 (defun my/unfroggify ()
   (ispell-change-dictionary "default")
   (setq-local
    colon-double-space t
    sentence-end-double-space t
    fill-nobreak-predicate (remq 'fill-french-nobreak-p fill-nobreak-predicate)))
 
 (define-minor-mode my/frog-mode
   "Croak like a froggy."
   :init-value nil
   :lighter "🐸"
   (if my/frog-mode
       (my/froggify)
     (my/unfroggify)))
 
 (defalias 'my/croak 'my/frog-mode)
 
 ;;;; 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))))
       (my/read "Message-ID" 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))))
 
 ;;;; 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 "wl-copy" nil 0 nil "--type" "text/html")
     (message "Copied:\n\n%s" (buffer-string))))
 
 (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
              rg
              rust-mode
              wgrep)
            (and (< emacs-major-version 29)
                 '(eglot use-package))
            (and (< emacs-major-version 30)
                 '(which-key))))
   :config
   (my/setopt-update-list
    package-archives '(("melpa" . "https://melpa.org/packages/"))))
 
 (use-package emacs
   :custom
   (auto-hscroll-mode 'current-line)
   ;; Disabled until bug#56662 is solved.  Prefer `hl-line-mode'.
   ;; (highlight-nonselected-windows t)
   )
 
 (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 find-dired
   :custom
   (find-ls-option
    ;; The default value (-default-ls) relies on 'find -ls', which
    ;; escapes non-ASCII chars.
    ;; The suggested alternatives (-default-exec, -default-xargs)
    ;; _display_ non-ASCII chars correctly, but ls quotes filenames
    ;; that contain spaces: `dired-get-filename' fails to strip them,
    ;; so they cannot be visited.
    ;; So go for -default-exec, *plus* -N to disable quoting
    ;; altogether.  That takes care of all the edge cases I tested
    ;; (non-ASCII chars, spaces).
    '("-exec ls -Nld {} +" . "-Nld")))
 
 (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
      my/git-commit-maybe-set-changelog-support)
    '(git-commit-setup-changelog-support)))
 
 (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
   :init
   (setq magit-bind-magit-project-status nil)
   :custom
   (magit-define-global-key-bindings nil)
   (magit-diff-refine-hunk t)
   (magit-ediff-dwim-show-on-hunks t)
   (magit-process-apply-ansi-colors t)
   (magit-revision-show-gravatars t)
   :config
   ;; 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))
 
 ;; TODO: completion-eager-*?
 ;; TODO: completion-styles bindings, e.g. completion-ignore-case?
 ;; TODO: completion-category-overrides: motivation for multiple behaviors?
 ;; TODO: mct?
 ;;
 ;; 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)
   ;; TODO: tuck all "compat keys" in one spot; as a minor mode?
   ;;       (i.e. alternatives to <left|right|up|down> for
   ;;       minibuffer-*-completion, *-buffer, *window*-map)
   (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