#+title: Skylar's Emacs Configuration
#+property: header-args:emacs-lisp :tangle config.el :comments link
#+auto_tangle: t

A literate [[https://github.com/doomemacs/doomemacs][Doom Emacs]] configuration. Most of it is Org: GTD, journals, a
magical record kept in the Thelemic manner, flashcards, a blog. Around that
are reading (Calibre, EPUBs), astronomy and astrology, music theory, mail and
chat, and file management (Dirvish, TMSU, restic backups).

It's written for Emacs 31 (pgtk, on Wayland), running as a systemd user
daemon on Arch Linux under the COSMIC desktop. Most of it doesn't care about
any of that, and the sections that do say so.

* Using it
Clone this repository as your Doom directory (=~/.config/doom=, or wherever
=$DOOMDIR= points), then run =doom sync=. Then:

- Personal settings, like your name, accounts and paths, go in a private
  overlay that loads after this file. [[*Private overlay][Private overlay]] lists the settings
  this file expects to find there.
- The commands that need a location (solar times, weather, planetary hours,
  planet positions) read it from =$ASTRO_LAT= and =$ASTRO_LONG=, set in the
  environment Emacs starts with. See [[*Solar times][Solar times]].
- The scripts in [[file:bin/][bin/]] are the terminal halves of a few sections. Each
  section looks for its script on =PATH= first, then in =bin/=.

No section needs every program, and each one says what it uses. Between them
they call: ImageMagick (=magick=), mpv, ffmpegthumbnailer, fluidsynth with a
SoundFont, translate-shell (=trans=), msmtp, mu and mbsync, astrolog, LilyPond,
curl, hunspell with English and German dictionaries, TMSU, restic, jq, and
pass.

* Tangling
Doom loads =config.el=, which is tangled from this file. Saving this file inside
Emacs retangles it through org-auto-tangle. After editing it anywhere else, run
=C-c C-v t= in this buffer, or from the Doom directory:

#+begin_example
emacs --batch -l org --eval '(org-babel-tangle-file "config.org")'
#+end_example

Changes to =init.el= or =packages.el= also need =doom sync=.

The =:comments link= header argument above makes every tangled block carry a
comment pointing back to its heading here, so an error at some line of
=config.el= names the section to open.

* Header
The first block is tangled without a link comment so that the lexical-binding
cookie lands on line one of =config.el=, which is the only place Emacs reads it.
#+begin_src emacs-lisp :comments no
;;; config.el -*- lexical-binding: t; -*-
#+end_src

* Tangle
#+begin_src emacs-lisp
(use-package! org-auto-tangle
  :hook (org-mode . org-auto-tangle-mode))
#+end_src

* Helper scripts
A few sections drive a script of their own: a terminal program first, with
the Emacs side shelling out to it. =my/program= finds one: on =PATH= first, so
an installed or newer copy wins, then in this repository's =bin/=, so they
work straight from a fresh clone.
#+begin_src emacs-lisp
(defun my/program (name)
  "Return the executable NAME, from `exec-path' or this config's bin/ directory.
Signals a `user-error' if it is in neither."
  (or (executable-find name)
      (let ((bundled (expand-file-name (concat "bin/" name) doom-user-dir)))
        (and (file-executable-p bundled) bundled))
      (user-error "%s is not on PATH or in %sbin/" name doom-user-dir)))
#+end_src

* Appearance
** Fonts
=doom-font= sets the monospace font. The serif face is set with
=custom-set-faces!= instead of =doom-variable-pitch-font=, because Doom's font
machinery records an absolute size on the =variable-pitch= face, and an
absolute size there is exactly what breaks zooming: =text-scale-adjust= and
Doom's font-size commands both scale the =default= face, and a face with an
absolute height ignores that. A ratio of 1.3 follows every zoom instead.
=custom-set-faces!= re-applies after each theme load, which auto-dark does
often. The hook covers Doom's own font reloads, which put an absolute size
back.
#+begin_src emacs-lisp
(setq doom-font (font-spec :family "JetBrainsMonoNL Nerd Font" :size 16 :weight 'semi-light))

(custom-set-faces! '(variable-pitch :family "DejaVu Serif" :height 1.3))

(add-hook! 'after-setting-font-hook
  (defun my/variable-pitch-relative-height-h ()
    "Keep `variable-pitch' at a ratio of the default size after Doom font reloads."
    (set-face-attribute 'variable-pitch nil :height 1.3)))

;; Frank Ruehl CLM is the Frank-Rühl book face (1908), the square Hebrew of
;; older printed Qabalah. Its letters only reach JetBrains Mono's x-height, so
;; they're scaled 1.2x to sit between x-height and cap height, which still
;; leaves lines with Hebrew no taller than others. It's part of Culmus
;; (culmus.sourceforge.io). Copying its files into ~/.local/share/fonts is
;; enough; some distribution packages of it also install a fontconfig rule
;; that changes the default Hebrew font in every other program.
(set-fontset-font t 'hebrew (font-spec :family "Frank Ruehl CLM"))
(add-to-list 'face-font-rescale-alist '("Frank Ruehl CLM" . 1.2))

;; Without this, Emacs falls back to whatever font claims the codepoint
;; first, which is rarely one with actual emoji glyphs, hence tofu/mojibake.
;; Any color emoji font works; swap in "Noto Color Emoji" if that's the one
;; installed.
(set-fontset-font t 'emoji (font-spec :family "Apple Color Emoji"))

;; JetBrainsMono has no astrological glyphs, and the fallback for most of
;; them is proportional Noto Sans Symbols (8-11px against a 10px cell), which
;; knocks the planet columns in Org tables out of alignment. DejaVu Sans Mono
;; is a common monospace font that covers ☉, ☽-♇ and ♈-♓.
(dolist (range '(#x2609 (#x263D . #x2653)))
  (set-fontset-font t range (font-spec :family "DejaVu Sans Mono")))

(setq display-line-numbers-type nil)
#+end_src

** Theme
auto-dark follows the system appearance through the desktop portal on D-Bus.
Under the daemon it must not start until the first frame exists, hence the
one-shot hook. =doom-theme= is nil so Doom does not load a theme of its own
first.
#+begin_src emacs-lisp
(use-package! auto-dark
  :defer t
  :init
  (setq! auto-dark-themes '((doom-gruvbox) (doom-gruvbox-light))
         doom-theme nil
         custom-safe-themes t)
  (defun my/auto-dark-init-h ()
    "Enable `auto-dark-mode' once the first frame exists, then unhook."
    (auto-dark-mode +1)
    (remove-hook 'server-after-make-frame-hook #'my/auto-dark-init-h)
    (remove-hook 'after-init-hook #'my/auto-dark-init-h))
  (add-hook (if (daemonp) 'server-after-make-frame-hook 'after-init-hook)
            #'my/auto-dark-init-h -95))
#+end_src

=SPC t t l= and =SPC t t d= switch the whole desktop between light and dark
through =system-theme= (in [[file:bin/][bin/]]), and auto-dark then follows. The script
does this for COSMIC; on another desktop it's the one piece to rewrite.
#+begin_src emacs-lisp
(defun my/system-theme (mode)
  "Run `system-theme' MODE (\"light\" or \"dark\"), without waiting for it."
  (call-process (my/program "system-theme") nil 0 nil mode))

(map! :leader
      :desc "System light mode" "t t l" (cmd! (my/system-theme "light"))
      :desc "System dark mode"  "t t d" (cmd! (my/system-theme "dark")))
#+end_src

** Frames
Transparency works from =default-frame-alist=. The titlebar does not: pgtk
applies =undecorated= while the frame is being created, before its GTK window
exists, so a frame-alist entry is silently lost. The parameter has to be set
after each frame exists, which is what the hooks do. =after-make-frame-functions=
covers every =emacsclient= frame; =emacs-startup-hook= covers the initial frame
when Emacs is not running as a daemon.

Never add =(undecorated . t)= to =default-frame-alist= alongside this: the
setter is a no-op when the old and new values match, so the alist entry would
make the hook do nothing and the titlebar would come back.
#+begin_src emacs-lisp
(add-to-list 'default-frame-alist '(alpha-background . 85))

(defun my/undecorate-frame (&optional frame)
  "Remove the titlebar from FRAME, or from the selected frame.
Runs after frame creation because pgtk ignores `undecorated' set any earlier."
  (set-frame-parameter (or frame (selected-frame)) 'undecorated t))

(add-hook 'after-make-frame-functions #'my/undecorate-frame)
(add-hook 'emacs-startup-hook #'my/undecorate-frame)
#+end_src

** Subprocess environment
=emacs.service= is =WantedBy=default.target=, so the daemon starts as soon as
the systemd user manager does at login, before the desktop session has
exported =WAYLAND_DISPLAY= and friends into the systemd environment. Frames still
work, since each =emacsclient= tells the daemon which display to open, but
every program Emacs starts inherits the daemon's own environment, which has
no =WAYLAND_DISPLAY=. Emacs does add =DISPLAY= from the frame, but under pgtk
that is the Wayland socket name (=wayland-1=), which isn't an X display. So
GUI programs started from Emacs can't open a window: mpv falls back to audio
only, and with =loop-file=inf= in mpv.conf keeps playing it, invisibly. A
later =systemctl --user restart emacs= (=SPC q r=) hides the problem until the
next login.

Each =emacsclient= brings its own environment along as the new frame's
=environment= parameter, so the display variables are copied from there into
the global environment whenever a graphical frame is created. That fixes it
regardless of when the daemon started. Terminal frames are skipped, so an
=emacsclient -t= from somewhere else can't clobber them.
#+begin_src emacs-lisp
(defun my/import-client-display-env-h ()
  "Copy display variables from the new frame's client into `process-environment'.
The daemon may have started before the graphical session exported them."
  (when (display-graphic-p)
    (dolist (var '("WAYLAND_DISPLAY" "DISPLAY" "XDG_SESSION_TYPE" "XDG_CURRENT_DESKTOP"))
      (when-let* ((value (getenv var (selected-frame))))
        (setenv var value)))))

(add-hook 'server-after-make-frame-hook #'my/import-client-display-env-h)
#+end_src

* Splash screen
The tarot spread is generated synchronously on every config load. That is
deliberate: under the daemon nobody is waiting on config load, and the image
has to exist before the first frame draws the dashboard. If it fails, the
dashboard falls back to Doom's banner and the rest of the config still loads.

Card scans tend to be large (2180×3250 for the deck this was written
around), and decoding them is nearly all the cost of a draw. So each card is
resized once into a cache
directory, and every later draw starts from that copy. A drawn card that
isn't cached yet is resized on the spot. A few idle seconds after startup,
background processes resize the rest of the deck, one card at a time, so
only the first startup ever pays for it. With one card there is no montage
at all: the cached card is just copied to the splash path. The cache is
keyed by deck and height, so changing =my/tarot-card-height= starts a new
one. After replacing a deck's images, delete its cache directory.

No card images come with this config: =my/tarot-deck-dir= should name a
directory of them, one image per card, and [[*Tarot][Tarot]] keeps one such directory
per deck under =my/tarot-directory=. Needs ImageMagick (=magick=).

The card listing, shuffle and montage helpers here are shared with
[[*Tarot][Tarot]], which is further down but runs later.
#+begin_src emacs-lisp
(defvar my/tarot-deck-dir (expand-file-name "~/.local/share/tarot/thoth")
  "Directory of tarot card images to draw the dashboard spread from.")

(defvar my/tarot-card-count 1
  "Number of tarot cards to draw for the dashboard spread.")

(defvar my/tarot-card-height 500
  "Height in pixels each tarot card is resized to (magick's -resize geometry).")

(defconst my/tarot-card-regexp "\\`[^.].*\\.\\(?:jpe?g\\|png\\|webp\\)\\'"
  "Matches the file name of a card image. Dotfiles never match.")

(defun my/tarot--cards (dir &optional recursive)
  "List the card images in DIR, and in its subdirectories if RECURSIVE."
  ;; `directory-files' matches case-sensitively whatever `case-fold-search'
  ;; says, so filter here instead of passing it the regexp.
  (let ((case-fold-search t))
    (if recursive
        (directory-files-recursively dir my/tarot-card-regexp)
      (seq-filter (lambda (file)
                    (string-match-p my/tarot-card-regexp (file-name-nondirectory file)))
                  (directory-files dir t)))))

(defun my/tarot--shuffle (list)
  "Return a shuffled copy of LIST (Fisher-Yates)."
  (let ((vec (vconcat list)))
    (dotimes (i (length vec))
      (let* ((j (+ i (random (- (length vec) i))))
             (tmp (aref vec i)))
        (aset vec i (aref vec j))
        (aset vec j tmp)))
    (append vec nil)))

(defun my/tarot--montage (cards output &rest options)
  "Tile CARDS side by side into OUTPUT with ImageMagick.
OPTIONS are extra montage arguments, such as -geometry and -background."
  (unless (executable-find "magick")
    (user-error "ImageMagick (magick) is not installed"))
  (unless (zerop (apply #'call-process "magick" nil nil nil "montage"
                        (append cards
                                (list "-tile" (format "%dx1" (length cards)))
                                options
                                (list output))))
    (user-error "ImageMagick montage failed")))

(defun my/tarot-splash-file ()
  "Path to the generated tarot splash image."
  (expand-file-name "doom-tarot-splash.png"
                    (or (getenv "XDG_CACHE_HOME")
                        (expand-file-name "~/.cache"))))

(defun my/tarot--cache-dir ()
  "Directory holding `my/tarot-deck-dir''s cards resized to `my/tarot-card-height'."
  (expand-file-name (format "tarot/%s-x%d"
                            (file-name-nondirectory (directory-file-name my/tarot-deck-dir))
                            my/tarot-card-height)
                    (or (getenv "XDG_CACHE_HOME")
                        (expand-file-name "~/.cache"))))

(defun my/tarot--cached-card (card)
  "Path of CARD's resized copy in `my/tarot--cache-dir', whether or not it exists yet."
  (expand-file-name (concat (file-name-sans-extension
                             (file-relative-name card my/tarot-deck-dir))
                            ".png")
                    (my/tarot--cache-dir)))

(defun my/tarot--resize-command (card output)
  "The magick command that resizes CARD into OUTPUT."
  (list "magick" card "-resize" (format "x%d" my/tarot-card-height) output))

(defun my/tarot--resize-temp-file ()
  "Make an empty file in `my/tarot--cache-dir' to resize a card into.
A resize writes there and is renamed into place only once it finishes,
so an interrupted one never leaves a truncated card in the cache."
  (make-directory (my/tarot--cache-dir) t)
  (make-temp-file (expand-file-name ".resizing-" (my/tarot--cache-dir)) nil ".png"))

(defun my/tarot--install-resized (tmp card)
  "Move TMP, a finished resize of CARD, to CARD's place in the cache.
Returns that place."
  (let ((cached (my/tarot--cached-card card)))
    (make-directory (file-name-directory cached) t)
    (rename-file tmp cached t)
    cached))

(defun my/tarot--cache-card (card)
  "Return CARD's resized copy, resizing it now if it isn't cached yet."
  (let ((cached (my/tarot--cached-card card)))
    (if (file-exists-p cached)
        cached
      (let* ((tmp (my/tarot--resize-temp-file))
             (command (my/tarot--resize-command card tmp)))
        (unless (zerop (apply #'call-process (car command) nil nil nil (cdr command)))
          (delete-file tmp)
          (user-error "ImageMagick could not resize %s" card))
        (my/tarot--install-resized tmp card)))))

(defun my/tarot--cache-in-background (cards)
  "Resize whichever of CARDS aren't cached yet, one background process at a time.
A card that fails to resize is skipped, so it can't stall the ones after it."
  (when-let* ((pending (seq-remove (lambda (card)
                                     (file-exists-p (my/tarot--cached-card card)))
                                   cards)))
    (let ((card (car pending))
          (tmp (my/tarot--resize-temp-file)))
      (make-process
       :name "tarot-cache" :noquery t
       :command (my/tarot--resize-command card tmp)
       :sentinel (lambda (process _event)
                   (unless (process-live-p process)
                     (if (zerop (process-exit-status process))
                         (my/tarot--install-resized tmp card)
                       (delete-file tmp))
                     (my/tarot--cache-in-background (cdr pending))))))))

(defun my/tarot-generate-splash ()
  "Draw a fresh tarot spread into the dashboard splash image, synchronously."
  (let* ((cards (and (file-directory-p my/tarot-deck-dir)
                     (my/tarot--cards my/tarot-deck-dir t)))
         (chosen (seq-take (my/tarot--shuffle cards) my/tarot-card-count)))
    (cond
     ((null chosen)
      (warn "Tarot splash: no card images found in %s" my/tarot-deck-dir))
     ((not (executable-find "magick"))
      (warn "Tarot splash: magick is not on PATH"))
     (t
      (condition-case err
          (let ((resized (mapcar #'my/tarot--cache-card chosen)))
            (if (cdr resized)
                (my/tarot--montage resized (my/tarot-splash-file)
                                   "-geometry" "+0+0" "-background" "black")
              (copy-file (car resized) (my/tarot-splash-file) t)))
        (error (warn "Tarot splash: %s; keeping the previous image"
                     (error-message-string err))))))))

(my/tarot-generate-splash)

(when (and (file-directory-p my/tarot-deck-dir) (executable-find "magick"))
  (run-with-idle-timer 5 nil #'my/tarot--cache-in-background
                       (my/tarot--cards my/tarot-deck-dir t)))

(setq fancy-splash-image (my/tarot-splash-file))

;; Default padding is (2 . 2) character-heights above/below the banner; the
;; auto-centering only balances raw line count, not the image's actual
;; height, so the image sits a bit low. Shift it up by trimming the top pad...
(setq +dashboard-banner-vertical-padding '(0 . 2))

;; ...and once that pad is gone, nudge it up further by trimming lines
;; straight out of `+dashboard-resize-h''s auto-centering padding, since
;; that's computed from raw line count and can't be fixed by the pad above.
(defvar my/dashboard-extra-lift 3
  "Extra lines to shave off the dashboard's auto-centered top padding.")

(defadvice! my/dashboard-lift-a (&rest _)
  "Shift the dashboard content up by `my/dashboard-extra-lift' lines."
  :after #'+dashboard-resize-h
  (when (get-buffer-window (doom-fallback-buffer) t)
    (with-current-buffer (doom-fallback-buffer)
      (with-silent-modifications
        (save-excursion
          (goto-char (point-min))
          (let ((blank-end (progn (skip-chars-forward "\n") (point))))
            (delete-region (point-min)
                           (min blank-end (+ (point-min) my/dashboard-extra-lift)))))))))

(defun my/tarot-reshuffle-splash ()
  "Draw a new tarot spread and redraw the dashboard."
  (interactive)
  (my/tarot-generate-splash)
  ;; Only the splash image: with no argument this would also flush every
  ;; other cached image, like Org's inline images and image-dired thumbnails.
  (clear-image-cache (my/tarot-splash-file))
  (+dashboard-reload t))
#+end_src

The "loaded N packages in X seconds" line is hidden. Comment out the first
=remove-hook= below to see startup cost again. The shortmenu (the row of
buttons under the banner) is removed too, so the tarot image and the quote
are the only things on the dashboard.
#+begin_src emacs-lisp
(remove-hook '+dashboard-functions #'+dashboard-widget-loaded)
(remove-hook '+dashboard-functions #'+dashboard-widget-shortmenu)

(defface my/dashboard-quote-face
  '((t (:inherit (italic variable-pitch))))
  "Face for dashboard quotes.")

(defvar my/dashboard-quotes
  '("Every man and woman is a star."
    "Do as thou wilt shall be the whole of the law."
    "As above, so below.")
  "Quotes shown at random under the dashboard menu.")

(defun my/dashboard-footer ()
  "Insert a random quote from `my/dashboard-quotes'."
  (let ((line (nth (random (length my/dashboard-quotes)) my/dashboard-quotes)))
    (+dashboard-insert
     (with-temp-buffer
       (insert (propertize " " 'display '(space . (:relative-height 2.0))) "\n")
       (insert (propertize (format "❝ %s ❞" line) 'face 'my/dashboard-quote-face))
       (insert "\n")
       (buffer-string)))))

(remove-hook '+dashboard-functions #'+dashboard-widget-footer)
(add-hook '+dashboard-functions #'my/dashboard-footer :append)
#+end_src

* Org
Files open folded to their top-level headings (a =#+startup:= line in a file
still overrides this).
#+begin_src emacs-lisp
(setq org-directory "~/Documents/org/"
      org-startup-with-inline-images t
      org-startup-folded 'overview
      org-extend-today-until 8)
#+end_src

** Capture defaults
Doom's default templates (=n=, =j=, and the project variants under =p=
and =o=) all end with =%a=, a link back to wherever point was before the
capture started. That link is never used, and there's no way to strip a
placeholder out of a template Doom already built, so the templates are
redefined here verbatim, minus =%a=. (Doom's =t=, "Personal todo", is left
out: that key is the GTD inbox capture instead — see [[*GTD][GTD]].) Everything below this — Vocabulary, Dream, Flashcard —
layers on top with =add-to-list=.

=my/org-capture-hidden-keys= lets a template stay in =org-capture-templates=
(so programmatic lookups like =(org-capture nil "k")= keep working) while
disappearing from the interactive picker. The advice only filters the list
when =org-capture-select-template= is called for the menu (=keys= is nil);
a direct key lookup sees the real list untouched.
#+begin_src emacs-lisp
(defvar my/org-capture-hidden-keys nil
  "Capture template keys to omit from the interactive selection menu.
They remain reachable by calling `org-capture' with the key directly.")

(defun my/org-capture-hide-menu-templates-a (fn &optional keys)
  "Hide templates whose key is in `my/org-capture-hidden-keys' from the
interactive template menu, without affecting direct lookups by KEYS."
  (if keys
      (funcall fn keys)
    (let ((org-capture-templates
           (seq-remove (lambda (template) (member (car template) my/org-capture-hidden-keys))
                       org-capture-templates)))
      (funcall fn keys))))

(after! org-capture
  (advice-add #'org-capture-select-template :around #'my/org-capture-hide-menu-templates-a)

  (setq org-capture-templates
        '(("n" "Personal notes" entry
           (file+headline +org-capture-notes-file "Inbox")
           "* %u %?\n%i" :prepend t)
          ("j" "Journal" entry
           (file+olp+datetree +org-capture-journal-file)
           "* %U %?\n%i" :prepend t)

          ("p" "Templates for projects")
          ("pt" "Project-local todo" entry
           (file+headline +org-capture-project-todo-file "Inbox")
           "* TODO %?\n%i" :prepend t)
          ("pn" "Project-local notes" entry
           (file+headline +org-capture-project-notes-file "Inbox")
           "* %U %?\n%i" :prepend t)
          ("pc" "Project-local changelog" entry
           (file+headline +org-capture-project-changelog-file "Unreleased")
           "* %U %?\n%i" :prepend t)

          ("o" "Centralized templates for projects")
          ("ot" "Project todo" entry
           (function +org-capture-central-project-todo-file)
           "* TODO %?\n %i"
           :heading "Tasks"
           :prepend nil)
          ("on" "Project notes" entry
           (function +org-capture-central-project-notes-file)
           "* %U %?\n %i"
           :heading "Notes"
           :prepend t)
          ("oc" "Project changelog" entry
           (function +org-capture-central-project-changelog-file)
           "* %U %?\n %i"
           :heading "Changelog"
           :prepend t))))
#+end_src

** Vocabulary capture
One template shape for every language. Entries are tagged =:drill:= so
org-drill finds them and the agenda skips them.
#+begin_src emacs-lisp
(defun my/vocab-capture-template (key description file)
  "Return an org-capture template that files a drill vocabulary entry in FILE."
  (list key description 'entry
        (list 'file+headline file "Vocabulary")
        "* Vocab word :drill:\n%^{Word}\n** Answer:\n%^{Definition}\n"))

(after! org-capture
  (dolist (template (list (my/vocab-capture-template "g" "German vocabulary" "german.org")
                          (my/vocab-capture-template "v" "Latin vocabulary" "latin.org")))
    (add-to-list 'org-capture-templates template)))
#+end_src

** Dream journal
The Journal template, minus =%a= (already dropped above), plus a =:dream:=
tag so dreams stay distinguishable from ordinary entries in the same
datetree.
#+begin_src emacs-lisp
(after! org-capture
  (add-to-list 'org-capture-templates
               '("d" "Dream" entry
                 (file+olp+datetree +org-capture-journal-file)
                 "* %U %? :dream:\n%i" :prepend t)))
#+end_src

** Grimoire journal
An entry in the magical record proper: filed into the datetree under
=Journal= in =grimoire.org=, alongside [[*Liber Resh journal][Liber
Resh]]'s adorations rather than in the general journal, so no tag is
needed to tell it apart. Like those, entries go after any already under
that day, so a day's work reads in order.

The title is asked for in the minibuffer, after the time the entry is
for, because the entry opens below a table of the heavens at that time,
the way a magical record is kept: where the Sun and Moon stand and the
Thoth trump of each sign, the Sun's decan and the small card attributed
to it, the Moon's phase, any planet retrograde, the planetary day and
hour, all headed by the Thelemic date -- then the weather, and at its
foot the answers to a few questions asked after the title, about the
sleep, health and mood it was written in and the practice itself (see
below). The same values go in the entry's property
drawer, to search by, and point is left under the table to start
writing. Like Liber Resh's note and properties, both go in through the
template's =:hook= rather than the template string, so none of it is
ever expanded as a template escape.

The trumps and small cards are the Book of Thoth's. A sign's three
decans take three small cards in the suit of its element, which three
depending on its quality -- cardinal signs the Two to Four, fixed the
Five to Seven, mutable the Eight to Ten -- and the planets rule the 36
decans in turn in Chaldean order (=my/planetary-hours-order=), starting
with Mars in the first decan of Aries. So the Two of Wands is Mars in
Aries, the Five of Disks Mercury in Taurus, and so on round to the Ten
of Cups, Mars in Pisces -- checked against the card-by-card text of the
Book of Thoth, which names each card's planet and sign.
#+begin_src emacs-lisp
(require 'diary-lib)                    ; `diary-ordinal-suffix', for "3rd decan"

(defconst my/zodiac-signs
  [("Aries" "♈" "IV The Emperor") ("Taurus" "♉" "V The Hierophant")
   ("Gemini" "♊" "VI The Lovers") ("Cancer" "♋" "VII The Chariot")
   ("Leo" "♌" "XI Lust") ("Virgo" "♍" "IX The Hermit")
   ("Libra" "♎" "VIII Adjustment") ("Scorpio" "♏" "XIII Death")
   ("Sagittarius" "♐" "XIV Art") ("Capricornus" "♑" "XV The Devil")
   ("Aquarius" "♒" "XVII The Star") ("Pisces" "♓" "XVIII The Moon")]
  "The twelve signs from 0° Aries, as (NAME GLYPH ATU) -- ATU being the
sign's Thoth trump.")

(defconst my/thoth-small-cards
  '(("Wands" "Dominion" "Virtue" "Completion" "Strife" "Victory" "Valour"
     "Swiftness" "Strength" "Oppression")
    ("Disks" "Change" "Work" "Power" "Worry" "Success" "Failure"
     "Prudence" "Gain" "Wealth")
    ("Swords" "Peace" "Sorrow" "Truce" "Defeat" "Science" "Futility"
     "Interference" "Cruelty" "Ruin")
    ("Cups" "Love" "Abundance" "Luxury" "Disappointment" "Pleasure" "Debauch"
     "Indolence" "Happiness" "Satiety"))
  "Each suit's Thoth titles for the Two through Ten, the suits in the
elemental order the signs repeat from Aries: Fire, Earth, Air, Water.")

(defconst my/thoth-small-card-numbers
  ["Two" "Three" "Four" "Five" "Six" "Seven" "Eight" "Nine" "Ten"])

(defun my/zodiac-position (longitude)
  "Split ecliptic LONGITUDE into (SIGN DEGREE MINUTE): SIGN an index
into `my/zodiac-signs', DEGREE and MINUTE whole numbers within it."
  ;; Through whole arcminutes, so an astrolog position like 20Lib34
  ;; comes back out as 20°34' instead of a float's 20°33'.
  (let ((minutes (mod (round (* longitude 60)) (* 360 60))))
    (list (/ minutes 1800) (/ (mod minutes 1800) 60) (mod minutes 60))))

(defun my/zodiac-position-string (longitude)
  "Format ecliptic LONGITUDE as e.g. \"20°34' ♎ Libra (Atu VIII Adjustment)\"."
  (pcase-let* ((`(,sign ,degree ,minute) (my/zodiac-position longitude))
               (`(,name ,glyph ,atu) (aref my/zodiac-signs sign)))
    (format "%d°%02d' %s %s (Atu %s)" degree minute glyph name atu)))

(defun my/thoth-decan-string (longitude)
  "Describe the decan containing ecliptic LONGITUDE and its Thoth small
card, e.g. \"Four of Swords (Truce): ♃ Jupiter in ♎ Libra, 3rd decan\"."
  (pcase-let* ((`(,sign ,degree ,_) (my/zodiac-position longitude))
               (decan (/ degree 10))
               (`(,suit . ,titles) (nth (mod sign 4) my/thoth-small-cards))
               (rank (+ (* 3 (mod sign 3)) decan))
               (mars (seq-position my/planetary-hours-order "Mars"
                                   (lambda (pair name) (equal (car pair) name))))
               (`(,ruler . ,ruler-glyph)
                (nth (mod (+ mars (* 3 sign) decan) 7) my/planetary-hours-order))
               (`(,name ,glyph ,_) (aref my/zodiac-signs sign)))
    (format "%s of %s (%s): %s %s in %s %s, %d%s decan"
            (aref my/thoth-small-card-numbers rank) suit (nth rank titles)
            ruler-glyph ruler glyph name
            (1+ decan) (diary-ordinal-suffix (1+ decan)))))
#+end_src

The Moon's phase comes straight from the two longitudes: its elongation
from the Sun, 0° at new and 180° at full, with the lit fraction of the
disk following as (1 - cos elongation) / 2. The name reuses the
[[*Current lunar phase][modeline's eight phases]], but rounded to the
nearest eighth of the cycle rather than floored -- the modeline's bucket
for "Full Moon" only begins at full, where here it's centered on it,
since the record should call the night before a full moon full too.
The emoji are left out: Org aligns a table by rounding each cell's pixel
width to whole columns, so a color emoji that isn't exactly two columns
wide would knock its row's right border out of line -- the same problem
[[*Fonts][Fonts]] solves for the astrological glyphs by drawing them all
from one monospace font.
#+begin_src emacs-lisp
(defun my/moon-phase-string (sun moon)
  "Describe the Moon's phase from SUN and MOON ecliptic longitudes,
e.g. \"Waxing Gibbous, 78% illuminated\"."
  (let* ((elongation (mod (- moon sun) 360.0))
         (phase (aref my/lunar-phases (mod (round (/ elongation 45.0)) 8))))
    (format "%s, %d%% illuminated"
            (cdr phase)
            (round (* 50 (- 1 (cos (degrees-to-radians elongation))))))))
#+end_src

The Thelemic date is the formula the magical record is traditionally
headed with, e.g. =☉ in 20° ♎ : ☽ in 28° ♏ : dies Martis : Anno Vxii=:
the whole degree each luminary has reached in its sign, the civil weekday
in Latin, and the year of the New Aeon. Its years begin at the vernal
equinox, the first Anno 0 at the Equinox of the Gods in 1904, and are
counted in cycles of 22 -- one per Atu -- written as the cycle in capital
Roman numerals followed by the year within it in small ones, with a
literal 0 for either when it's zero. Whether this year's equinox has
passed yet comes from the Sun itself: in January to March it's still in
the signs before Aries until it crosses 0°. =dies= is the calendar day,
so between midnight and sunrise it's a day ahead of the planetary day
recorded alongside it.
#+begin_src emacs-lisp
(defconst my/thelemic-weekdays
  ["Solis" "Lunae" "Martis" "Mercurii" "Jovis" "Veneris" "Saturni"]
  "Latin day names, indexed like `calendar-day-of-week' (Sunday first).")

(defun my/roman-numeral (n)
  "Write N in capital Roman numerals, or \"0\" for zero."
  (if (zerop n)
      "0"
    (let ((result ""))
      (pcase-dolist (`(,value . ,numeral)
                     '((100 . "C") (90 . "XC") (50 . "L") (40 . "XL") (10 . "X")
                       (9 . "IX") (5 . "V") (4 . "IV") (1 . "I")))
        (while (>= n value)
          (setq result (concat result numeral)
                n (- n value))))
      result)))

(defun my/thelemic-date-string (time sun moon)
  "Format TIME as a Thelemic date, given the SUN and MOON ecliptic
longitudes at TIME."
  (pcase-let* ((decoded (decode-time time))
               (year (- (decoded-time-year decoded) 1904
                        (if (and (<= (decoded-time-month decoded) 3) (>= sun 180)) 1 0)))
               (`(,sun-sign ,sun-degree ,_) (my/zodiac-position sun))
               (`(,moon-sign ,moon-degree ,_) (my/zodiac-position moon)))
    (format "☉ in %d° %s : ☽ in %d° %s : dies %s : Anno %s%s"
            sun-degree (nth 1 (aref my/zodiac-signs sun-sign))
            moon-degree (nth 1 (aref my/zodiac-signs moon-sign))
            (aref my/thelemic-weekdays (decoded-time-weekday decoded))
            (my/roman-numeral (/ year 22))
            (downcase (my/roman-numeral (mod year 22))))))
#+end_src

Every row of that table goes in the entry's property drawer as well: the
table is for reading the entry, the drawer for finding it again, since
Org can match an entry on a property -- =PLANETARY_HOUR={Mars}=,
=MOON_PHASE={Full}= -- but not on a table cell. Each row names its
property rather than having one made from its label, so a row can be
renamed without a search losing the entries made before. A few values go in
the drawer alone: each luminary's longitude in decimal degrees, which
everything in the table is worked out from and which compares as a
number (=SUN_LONGITUDE>=210=); and, as in [[*Astronomy journal][Astronomy]],
the moment in =UTC= and the =COORDINATES= the planetary hour was
reckoned for, so the sky can be worked out again from the entry alone,
wherever it was written. The drawer is left folded in the capture
buffer, out of the way of writing.

The rows come from the functions in =my/grimoire-row-functions=, each
called with the capture's own =:default-time= -- the same moment =%U=
puts in the heading -- and returning its rows as (LABEL VALUE PROPERTY),
so recording something more is one more function on the list. The sky
comes from [[*Planet positions][=my/planet-positions--longitudes=]], the
hours from [[*Planetary hours][=my/planetary-hours-at=]], and the
answers from the questions below. Each function fails on its own: with
astrolog missing the planetary hour still gets recorded, and with no
sunrise to count from (or no coordinates) the positions still do, each
only warning about what it left out, since an error out of a =:hook=
would leave the capture buffer half set up.

Liber E has the state of the weather recorded too, and the
[[*Weather][forecast]] the modeline refreshes every half hour already
holds it, so the Weather row is read from there rather than fetched
while the entry is being made. For an entry within an hour and a half
of now, it's wttr.in's current conditions; for one logged a while after
it happened, it's the 3-hour forecast block its time falls in, and says
so. With nothing cached for that time -- offline, or an entry dated
before today, which the forecast doesn't reach back to -- the row is left
out with a warning, like any other.

The hook fills the drawer, which Org puts under the heading, ahead of
point, then inserts the table at =%?= and leaves point after it and a
blank line, which is where the entry gets written. Org only tidies
blank lines when it first places a template, not when the capture is
finished, so =:prepare-finalize= drops whatever blank lines are left
at the end of the entry -- the two under the table, if nothing got
written there. (Not =:before-finalize=: by the time that runs the
capture buffer has been widened, and =point-max= is the end of the whole
file.)
#+begin_src emacs-lisp
(defvar my/grimoire-row-functions
  '(my/grimoire-moment-rows my/grimoire-sky-rows my/grimoire-hour-rows
    my/grimoire-weather-rows my/grimoire-answer-rows)
  "Functions that fill in a Grimoire entry, in order. Each is called
with the capture's time and returns a list of rows (LABEL VALUE
PROPERTY): LABEL and VALUE make a row of the entry's table, and PROPERTY
names a property set to VALUE in its drawer. Either LABEL or PROPERTY
may be nil to leave that half out. A function that signals an error
costs the entry only its own rows, with a warning.")

(defun my/grimoire-moment-rows (time)
  "Return TIME in UTC, and the coordinates the planetary hour is worked
out for, as drawer-only rows for a Grimoire entry."
  (cons (list nil (format-time-string (org-time-stamp-format t t) time t) "UTC")
        (and calendar-latitude calendar-longitude
             (list (list nil (format "%.4f, %.4f" calendar-latitude calendar-longitude)
                         "COORDINATES")))))

(defun my/grimoire-sky-rows (time)
  "Return the Sun and Moon at TIME, and any planet retrograde, as rows
for a Grimoire entry."
  (let* ((longitudes (my/planet-positions--longitudes time))
         (sun (nth 1 (assoc "Sun" longitudes)))
         (moon (nth 1 (assoc "Moon" longitudes)))
         (retrograde
          (mapconcat (lambda (planet)
                       (format "%s %s" (cdr planet) (car planet)))
                     (seq-filter (lambda (planet)
                                   (nth 2 (assoc (car planet) longitudes)))
                                 my/planetary-hours-order)
                     ", ")))
    (append
     (list (list "Thelemic date" (my/thelemic-date-string time sun moon) "THELEMIC_DATE")
           (list "Sun" (my/zodiac-position-string sun) "SUN")
           (list nil (format "%.2f" sun) "SUN_LONGITUDE")
           (list "Decan" (my/thoth-decan-string sun) "DECAN")
           (list "Moon" (my/zodiac-position-string moon) "MOON")
           (list nil (format "%.2f" moon) "MOON_LONGITUDE")
           (list "Moon phase" (my/moon-phase-string sun moon) "MOON_PHASE"))
     (unless (string-empty-p retrograde)
       (list (list "Retrograde" retrograde "RETROGRADE"))))))

(defun my/grimoire-hour-rows (time)
  "Return the planetary day and hour at TIME as rows for a Grimoire entry."
  (pcase-let ((`((,day . ,day-glyph) (,hour . ,hour-glyph) ,number ,night)
               (my/planetary-hours-at time)))
    (list (list "Planetary day" (format "%s %s" day-glyph day) "PLANETARY_DAY")
          (list "Planetary hour"
                (format "%s %s, %d%s hour of the %s"
                        hour-glyph hour number (diary-ordinal-suffix number)
                        (if night "night" "day"))
                "PLANETARY_HOUR"))))

(defun my/grimoire-weather-rows (time)
  "Return the weather at TIME, from the cached wttr.in forecast, as a row
for a Grimoire entry: the current conditions for a TIME within an hour
and a half of now, otherwise the 3-hour forecast block TIME falls in."
  (let* ((current (and (equal (alist-get 'date (car (my/weather-days)))
                              (format-time-string "%Y-%m-%d"))
                       (< (abs (float-time (time-subtract time nil))) 5400)
                       (my/weather-current)))
         (block (and (not current)
                     (seq-find (lambda (entry)
                                 (and (not (time-less-p time (nth 0 entry)))
                                      (time-less-p time (time-add (nth 0 entry) (* 3 3600)))))
                               (my/weather--timeline))))
         (condition (or current (nth 2 block))))
    (unless condition
      (error "No forecast cached for %s" (format-time-string "%Y-%m-%d %H:%M" time)))
    (list (list "Weather"
                (concat (format "%s, %s°F, humidity %s%%, wind %s mph %s"
                                (my/weather--desc condition)
                                ;; Current conditions spell it temp_F, hourly entries tempF.
                                (or (alist-get 'temp_F condition) (alist-get 'tempF condition))
                                (alist-get 'humidity condition)
                                (alist-get 'windspeedMiles condition)
                                (alist-get 'winddir16Point condition))
                        (and block
                             (let ((start (alist-get 'time condition)))
                               (format " (forecast for %s–%s)"
                                       (my/weather--hour-label start)
                                       (my/weather--hour-label
                                        (number-to-string
                                         (mod (+ (string-to-number start) 300) 2400)))))))
                "WEATHER"))))

(defun my/grimoire-answer-rows (_time)
  "Return the answers `my/grimoire-capture-ask' collected, as rows for
the Grimoire entry being captured."
  (org-capture-get :grimoire-answers))

(defun my/grimoire-capture-attach ()
  "Fill in the entry the Grimoire capture template just placed from
`my/grimoire-row-functions': their properties in its drawer, folded,
and a table of the rest at point, leaving point below it to write the
entry."
  (let* ((time (or (org-capture-get :default-time) (current-time)))
         (rows (seq-mapcat (lambda (function)
                             (condition-case err
                                 (funcall function time)
                               (error (warn "Grimoire entry has no rows from `%s': %s"
                                            function (error-message-string err))
                                      nil)))
                           my/grimoire-row-functions)))
    (save-excursion
      (pcase-dolist (`(,_ ,value ,property) rows)
        (when property
          (org-entry-put nil property value)))
      (org-fold-hide-drawer-all))
    (when-let* ((table (seq-filter #'car rows)))
      (let ((start (point)))
        (pcase-dolist (`(,label ,value) table)
          ;; A typed | would end the cell; \vert is Org's escape for it.
          (insert "| " label " | " (string-replace "|" "\\vert{}" value) " |\n"))
        (save-excursion (goto-char start) (org-table-align)))
      (insert "\n"))))

(defun my/grimoire-capture-trim ()
  "Delete the blank lines at the end of the Grimoire entry being captured."
  (save-excursion
    (goto-char (point-max))
    (skip-chars-backward " \t\n")
    (delete-region (point) (point-max))
    ;; Filed above a later heading, the newline ending the entry's last
    ;; line lies just outside the capture's narrowing; filed at the end
    ;; of the file, it's inside it, and was just deleted.
    (unless (eq (save-restriction (widen) (char-after)) ?\n)
      (insert "\n"))))
#+end_src

After the title come the questions in =my/grimoire-questions=, about
the conditions the working happened under. Liber E has the physical and
mental condition of whoever performed an experiment recorded, and in
the practices it sets, the duration of each and -- in dharana -- the
number and nature of the intruding thoughts. So they're Sleep, Health,
Mood, Duration and Intruding thoughts, and another is one more line in
the list. Each answer becomes a row at the foot of the table, after the
sky and the weather, and a property in the drawer. There's no question
for the place: it's almost always home, and the entry says so when it
isn't.

They're all plain text, since last night's sleep or yesterday's mood is
the wrong default for today's -- =M-p= still brings the last answer back
to edit. A question can instead offer its earlier answers as
candidates, latest first, so =RET= repeats the last one and a few
letters pick an older one, with =M-RET= for a new answer that an old one
happens to match, as anywhere in Vertico. A bare =RET= records "Nothing
to report" (=my/grimoire-default-answer=), so an entry with nothing to
say about them -- one that isn't about a practice, say -- costs five
keystrokes. Each question keeps its own minibuffer history, which
savehist carries across restarts.

The questions are asked from a =%()= sexp in the template, which Org
evaluates while filling the template in, before any of it is inserted
into =grimoire.org=. Asked from the =:hook=, a =C-g= would leave the
half-made entry behind in the file, since Org's abort there only kills
the capture buffer. But Org evaluates every =%()= before prompting for
any =%^{}=, so the title can't stay a =%^{Title}= and still come first:
the same function asks for it, returns it for the headline, and leaves
the answers in the capture for the hook to put in the table.

Before any of that, =:time-prompt t= asks when the entry is for, the
same way [[*Astronomy journal][Astronomy]] does: through =org-read-date=
with the calendar popped up, where plain =RET= keeps right now and a
time alone (=14:30=) is that time today. So a working written up a little
after it happened still gets the sky, the hour and the weather of when
it happened, and its own day in the datetree. A date with no time means
its midnight, so an earlier day wants the time as well. The answer is
the =:default-time= the rows are worked out for, and what =%U= puts in
the heading.
#+begin_src emacs-lisp
(defvar my/grimoire-title-history nil
  "Titles given to the Grimoire capture template.")

(defvar my/grimoire-sleep-history nil
  "Answers given to the Grimoire capture template's Sleep question.")

(defvar my/grimoire-health-history nil
  "Answers given to the Grimoire capture template's Health question.")

(defvar my/grimoire-mood-history nil
  "Answers given to the Grimoire capture template's Mood question.")

(defvar my/grimoire-duration-history nil
  "Answers given to the Grimoire capture template's Duration question.")

(defvar my/grimoire-intruding-thoughts-history nil
  "Answers given to the Grimoire capture template's Intruding thoughts question.")

(defvar my/grimoire-default-answer "Nothing to report"
  "What a Grimoire capture question records when answered with a bare RET.")

(defvar my/grimoire-questions
  '(("Sleep" "SLEEP" "Sleep (when, how long, how well)" my/grimoire-sleep-history)
    ("Health" "HEALTH" "Health" my/grimoire-health-history)
    ("Mood" "MOOD" "Mood" my/grimoire-mood-history)
    ("Duration" "DURATION" "Duration of the practice" my/grimoire-duration-history)
    ("Intruding thoughts" "INTRUDING_THOUGHTS" "Intruding thoughts (number and nature)"
     my/grimoire-intruding-thoughts-history))
  "Questions the Grimoire capture template asks after the title, in order,
as (LABEL PROPERTY PROMPT HISTORY RECALL). Each answer is a row LABEL in
the entry's table and the property PROPERTY in its drawer. PROMPT has no
trailing colon; `format-prompt' adds it along with the default. HISTORY
is the question's minibuffer history variable. With RECALL non-nil,
earlier answers are offered as candidates, the latest first, so RET
repeats it; otherwise, and before there are any, RET records
`my/grimoire-default-answer'.")

(defun my/grimoire-capture-ask ()
  "Prompt for a Grimoire entry's title and then `my/grimoire-questions'.
Return the title, for the template's headline, and store the answers
under :grimoire-answers in the capture, as rows for
`my/grimoire-answer-rows'."
  (prog1 (read-string "Title: " nil 'my/grimoire-title-history)
    (org-capture-put
     :grimoire-answers
     (mapcar (pcase-lambda (`(,label ,property ,prompt ,history ,recall))
               (let* ((earlier (and recall
                                    (delete-dups (copy-sequence (symbol-value history)))))
                      (default (or (car earlier) my/grimoire-default-answer))
                      (answer (string-trim
                               (if recall
                                   (completing-read (format-prompt prompt default)
                                                    earlier nil nil nil history default)
                                 (read-string (format-prompt prompt default)
                                              nil history default)))))
                 (list label (if (string-empty-p answer) default answer) property)))
             my/grimoire-questions))))

(after! org-capture
  (add-to-list 'org-capture-templates
               '("m" "Grimoire" entry
                 (file+olp+datetree "grimoire.org" "Journal")
                 "* %U %(my/grimoire-capture-ask)\n%?%i"
                 :time-prompt t
                 :hook my/grimoire-capture-attach
                 :prepare-finalize my/grimoire-capture-trim)))
#+end_src

** Liber Resh journal
One adoration of Liber Resh, filed into the datetree under =Journal= in
=grimoire.org= -- the magical record proper, same as the
[[*Grimoire journal][Grimoire]] template's entries -- and tagged
=:resh:=. Entries go after any already under that day, so the
day's adorations read in order. The
headline names the adoration and its god; the property drawer records the
god, the quarter faced and -- when known -- the time the Sun actually reached
that station, the place and its coordinates, so a late adoration shows up
against its sun time.

Captured by hand (=r= in the capture menu), it asks which adoration this was
and fills in the god and the quarter (North at midnight, South at noon; the
northern-hemisphere reading of the text), with =calendar-latitude=/
=calendar-longitude= as the coordinates, same as
[[*Astronomy journal][Astronomy]].

Another program, such as a phone or desktop app that reminds you of the
adorations, can log one through =my/resh-log= over =emacsclient --eval=,
passing everything it already knows about the adoration. With =:edit= nil the entry files straight away with no
frame shown; with =:edit= t it opens Doom's capture frame
(=+org-capture/open-frame=) with the note already in the body, to be finished
with =C-c C-c= as usual. The app's values are bound in =my/resh-capture-data=
only while the template is being filled in, and the note goes in through the
=:hook= with =insert= rather than through =%i=, so nothing typed in the app is
ever expanded as a template escape.

=:done-file= and =:done-line= let the app tick the adoration off: once the
capture is finalized -- not aborted -- =my/resh-capture-done= appends the
line to that file, which is all the app reads back. It never reads the
journal itself.
#+begin_src emacs-lisp
(defconst my/resh-stations
  '(("Sunrise" "Ra" "East")
    ("Noon" "Ahathoor" "South")
    ("Sunset" "Tum" "West")
    ("Midnight" "Khephra" "North"))
  "The adorations of Liber Resh: station, god, and the quarter faced.")

(defvar my/resh-capture-data nil
  "Plist for the adoration `my/resh-log' is logging, bound only while the
\"r\" capture template is filled in. Nil when capturing by hand.")

(defun my/resh-capture-heading ()
  "Return \"STATION, GOD\" for the Liber Resh capture's headline, prompting
for the station when not called through `my/resh-log'. Stores the full plist
under :resh in the capture for the template's :hook and :after-finalize."
  (let* ((data (or my/resh-capture-data
                   (list :station (completing-read "Adoration: " my/resh-stations nil t))))
         (known (or (assoc (plist-get data :station) my/resh-stations)
                    (user-error "Not an adoration of Liber Resh: %s" (plist-get data :station))))
         (data (append data
                       (list :god (nth 1 known)
                             :quarter (nth 2 known)
                             :coordinates (and calendar-latitude calendar-longitude
                                               (format "%.4f, %.4f" calendar-latitude calendar-longitude))))))
    (org-capture-put :resh data)
    (format "%s, %s" (car known) (nth 1 known))))

(defun my/resh-capture-attach ()
  "Fill in the property drawer of the entry the Liber Resh capture template
just placed, and insert the note passed to `my/resh-log' at point."
  (let ((data (org-capture-get :resh)))
    (save-excursion
      (pcase-dolist (`(,key . ,property) '((:god . "GOD")
                                           (:quarter . "QUARTER")
                                           (:sun-time . "SUN_TIME")
                                           (:place . "PLACE")
                                           (:coordinates . "COORDINATES")))
        (let ((value (plist-get data key)))
          (when (and value (not (string-empty-p value)))
            (org-entry-put nil property value)))))
    (let ((note (plist-get data :note)))
      (when (and note (not (string-blank-p note)))
        (insert (string-trim note))))))

(defun my/resh-capture-done ()
  "Record a finished (not aborted) Liber Resh capture in the :done-file
`my/resh-log' was given, so the app can mark the adoration as logged."
  (let* ((data (org-capture-get :resh))
         (file (plist-get data :done-file))
         (line (plist-get data :done-line)))
    (when (and file line (not org-note-abort))
      (make-directory (file-name-directory file) t)
      (write-region (concat line "\n") nil file t 'silent))))

(defun my/resh-log (&rest data)
  "Log an adoration of Liber Resh through the \"r\" capture template.
DATA is a plist: :station (\"Sunrise\", \"Noon\", \"Sunset\" or
\"Midnight\"), and optionally :sun-time, :place, :coordinates, :note,
:done-file and :done-line. With :edit non-nil, open the capture in a
frame to finish by hand; otherwise file it immediately."
  (let ((my/resh-capture-data data))
    (if (plist-get data :edit)
        (+org-capture/open-frame nil "r")
      (require 'org-capture)
      (let ((org-capture-templates
             (mapcar (lambda (template)
                       (if (equal (car template) "r")
                           (append template '(:immediate-finish t))
                         template))
                     org-capture-templates)))
        (org-capture nil "r"))))
  t)

(after! org-capture
  (add-to-list 'org-capture-templates
               '("r" "Liber Resh" entry
                 (file+olp+datetree "grimoire.org" "Journal")
                 "* %U Resh: %(my/resh-capture-heading) :resh:\n%?"
                 :hook my/resh-capture-attach
                 :after-finalize my/resh-capture-done)))
#+end_src

** Astronomy journal
The Journal template, minus =%a=, tagged =:astronomy:= and carrying a
=COORDINATES= property for where the observation was made. The property
defaults to [[*Solar times][the coordinates =solar= already uses]]
(=calendar-latitude=/=calendar-longitude=), decimal degrees same as they
are, so no conversion happens here either -- but the prompt accepts manual
input too, for an observation made somewhere else.

Observations usually get written down a few minutes after they happened,
so =:time-prompt t= asks for the date and time first, through
=org-read-date= with the calendar popped up and defaulting to today. The
answer picks the datetree day and is what =%U= expands to, so typing just
a time (e.g. =21:40=) logs it today at that time, and plain =RET= keeps
right now.

Org timestamps carry no zone, so the heading's =%U= only means anything
relative to wherever the machine thought it was at capture time. The
=UTC= property records that same moment in UTC as well, so the entry
stays unambiguous after changing timezones -- the heading and datetree
stay local, for reading the journal as the night it was.
=my/astro-log-time= (see [[*Planet positions][Planet positions]])
prefers it over the heading timestamp.

The template's =:hook= then runs
[[*Planet positions][=my/astro-insert-planet-positions=]] on the new
entry, the same way [[*Daily divination][Daily divination]] attaches its
draw and transits -- so the planets' altitude/azimuth table for that
moment and place is already under the drawer while the observation is
being written up. The hook fires after the template is filled in, so the
=UTC= and =COORDINATES= answers are already there for it to read. It runs
inside =save-excursion= to leave point at =%?= on the heading, and an
astrolog failure only warns, since an error out of a =:hook= would leave
the capture buffer half set up.
#+begin_src emacs-lisp
(defun my/astro-capture-utc ()
  "Return the capture's chosen time (the `:time-prompt' answer that
`%U' also expands) as an inactive Org timestamp in UTC."
  (format-time-string (org-time-stamp-format t t)
                      (or (org-capture-get :default-time) (current-time))
                      t))

(defun my/astro-capture-coordinates ()
  "Prompt for the coordinates of an astronomy observation, defaulting to
`calendar-latitude'/`calendar-longitude' when those are set."
  (let ((default (and calendar-latitude calendar-longitude
                      (format "%.4f, %.4f" calendar-latitude calendar-longitude))))
    (read-string (if default
                     (format "Coordinates (default %s): " default)
                   "Coordinates (LAT, LONG): ")
                 nil nil default)))

(defun my/astro-capture-planet-positions ()
  "Insert the planet positions table into the entry the Astronomy capture
template just placed, leaving point where it was. See
`my/astro-insert-planet-positions'."
  (save-excursion
    (condition-case err
        (my/astro-insert-planet-positions)
      (error (warn "Planet positions not inserted: %s"
                   (error-message-string err))))))

(after! org-capture
  (add-to-list 'org-capture-templates
               '("a" "Astronomy" entry
                 (file+olp+datetree +org-capture-journal-file)
                 "* %U %? :astronomy:observation: \n:PROPERTIES:\n:COORDINATES: %(my/astro-capture-coordinates)\n:UTC: %(my/astro-capture-utc)\n:END:\n%i"
                 :prepend t :time-prompt t
                 :hook my/astro-capture-planet-positions)))
#+end_src

=org-extend-today-until= (see [[*Org][Org]]) is exactly what its name says for every other template here --
a late Dream or Journal entry belongs under the day it's subjectively
still part of. An observation logged through the telescope, or a
working performed after midnight, is where that's wrong: =%U= came out
as 23:59 the *previous* day, so
[[*Planet positions][=my/astro-insert-planet-positions=]] computed the
sky for the wrong moment (and a Grimoire entry would timestamp itself a
day early). Advising the two functions that actually consult the
option -- =org-capture-set-target-location= (which day's tree) and
=org-capture-fill-template= (what =%U= expands to) -- and neutralizing
it only when the active template's key is =a=, =m= or =r= scopes the
override to just those templates (a midnight Liber Resh is the same case), leaving every other datetree
capture's late-night behavior untouched.
#+begin_src emacs-lisp
(defun my/capture-no-extend-today-a (fn &rest args)
  "Ignore `org-extend-today-until' for capture templates that want a
late-night entry to file under and timestamp as its real date/time
instead of 23:59 the previous day (currently Astronomy \"a\",
Grimoire \"m\" and Liber Resh \"r\")."
  (if (member (org-capture-get :key) '("a" "m" "r"))
      (let ((org-extend-today-until 0))
        (apply fn args))
    (apply fn args)))

(advice-add #'org-capture-set-target-location :around #'my/capture-no-extend-today-a)
(advice-add #'org-capture-fill-template :around #'my/capture-no-extend-today-a)
#+end_src

** Habits
Doom's org module has no habit flag, so this block is what loads org-habit.
#+begin_src emacs-lisp
(use-package! org-habit
  :after org
  :config
  (setq org-habit-following-days 7
        org-habit-preceding-days 35))
#+end_src

** Drill
Flashcards over the =:drill:= entries. =M-x org-drill= runs a session over the
current file; =org-drill-tree= runs one over just the subtree at point, for
drilling a single study guide (or one section of it) in a file like
=grimoire.org= that holds several. It sits on =S=, for "subtree", rather than
under Doom's =s= subtree menu, where it would be one missed Shift away from
=org-cut-subtree=.
#+begin_src emacs-lisp
(use-package! org-drill
  :commands (org-drill org-drill-resume org-drill-cram org-drill-tree org-drill-directory))

(setq org-agenda-tag-filter-preset '("-drill"))

(map! :map org-mode-map :localleader :desc "Drill" "D" #'org-drill)
(map! :map org-mode-map :localleader :desc "Drill subtree" "S" #'org-drill-tree)
#+end_src

** Flashcard capture
Files under whichever heading is picked with the same completion `org-refile`
uses — the file open when capture started supplies the "current buffer"
candidates, so its headings are offered unprefixed and listed first,
answering closest to a default without actually forcing one. Typing a path
that doesn't exist yet (e.g. =todo.org/Inbox/Flashcards=) creates it after
confirming, which doubles as the fallback location if a file has no refile
targets of its own yet.
#+begin_src emacs-lisp
(defun my/flashcard-capture-target ()
  "Prompt for a refile location for a new flashcard, using the file open
when capture started as the \"current buffer\" refile candidates. Falls
back to Inbox > Flashcards in the todo file if no location is offered."
  (let* ((original (org-capture-get :original-buffer))
         (loc (condition-case nil
                  (org-refile-get-location "Flashcard location" original 'confirm)
                (error nil))))
    (if loc
        (progn
          (set-buffer (find-file-noselect (nth 1 loc)))
          (goto-char (or (nth 3 loc) (point-max))))
      (set-buffer (find-file-noselect (+org-capture-todo-file)))
      (+org--capture-ensure-heading '("Inbox" "Flashcards")))))

(after! org-capture
  (add-to-list 'org-capture-templates
               '("f" "Flashcard" entry
                 (function my/flashcard-capture-target)
                 "* Flashcard :drill:\n\n%?\n** Answer:\n")))
#+end_src

** Custom agenda views
=Public= is the plain agenda view with =:private:= entries also filtered
out, on top of the usual =:drill:= exclusion — for whenever the screen is
shared or shown to someone else. =Journal= lists every headline in
=journal.org= (matched with =LEVEL>0=, since none of them are TODO items
— it's dream/astronomy/divination entries too, not just plain journal
ones), regardless of what's in =org-agenda-files= otherwise. Both are
selectable from the =org-agenda= dispatcher (=M-x org-agenda=, then =p=
or =j=).
#+begin_src emacs-lisp
(setq org-agenda-custom-commands
      '(("p" "Public agenda (excludes :private:)" agenda ""
         ((org-agenda-tag-filter-preset '("-drill" "-private"))))
        ("j" "Journal" tags "LEVEL>0"
         ((org-agenda-files (list (expand-file-name "journal.org" org-directory)))))))
#+end_src

** LaTeX fragments
#+begin_src emacs-lisp
(use-package! org-fragtog
  :hook (org-mode . org-fragtog-mode))
#+end_src

Org highlights LaTeX, entities and sub/superscripts with
=org-do-latex-and-related=, which looks for its next match with no bound: in
a long file with little LaTeX, every chunk font-lock hands it scans on to the
end of the file, so the cost grows with the square of the file's length. In
=grimoire.org= (320 KB) that was over half the time spent folding, unfolding
and moving about. Bounding the search to 10,000 characters past the chunk
leaves the highlighting unchanged; only a LaTeX environment reaching further
than that past a chunk could be missed.
#+begin_src emacs-lisp
(defun my/org-latex-bounded-search-a (fn limit)
  "Keep `org-do-latex-and-related' from searching to the end of the buffer."
  (save-restriction
    (narrow-to-region (point-min) (min (point-max) (+ limit 10000)))
    (funcall fn limit)))
(advice-add #'org-do-latex-and-related :around #'my/org-latex-bounded-search-a)
#+end_src
** Drawing
#+begin_src emacs-lisp
;;; org-draw

(use-package! org-draw
  :commands (org-draw org-draw-edit org-draw-setup)

  :config
  ;; Store drawings in a "figures" directory relative to the Org file.
  (setq org-draw-directory "figures"

        ;; Require a one-time pairing code when connecting a tablet.
        ;; Recommended if you're on a shared Wi-Fi network.
        org-draw-require-pairing t

        ;; Use a fixed port if you want to make firewall/router
        ;; configuration predictable.
        org-draw-port 8777))

#+end_src
** Image attach
=my/org-attach-image= moves an image file into the Org attachment directory
for the heading at point and inserts a link to it there. It defaults to
=~/Downloads/= since that's where screenshots and saved images land.
#+begin_src emacs-lisp
(defun my/org-attach-image (file)
  "Attach FILE to the Org heading at point by moving it, and insert a link to it."
  (interactive (list (read-file-name "Image: " "~/Downloads/" nil t)))
  (require 'org-attach)
  (let ((link (car (org-attach-attach file nil 'mv))))
    (insert "[[" link "]]\n")
    (org-display-inline-images)))

(map! :map org-mode-map :localleader :desc "Attach image" "a i" #'my/org-attach-image)
#+end_src

** Tables
Org pads cells with whole spaces, rounding each character's width to the
nearest column. Hebrew letters aren't a whole number of columns wide (yod is
half of one, shin a little over one), so rows with Hebrew drift by a few
pixels. valign redoes the alignment in pixels with display properties only;
the file text keeps Org's ordinary alignment. Its default size limit of 4000
characters would skip the bigger grimoire tables, and the largest table in
=notes.org= is about 15000.

Separately, =|= is a neutral character to the bidirectional algorithm, so in a
row like =| Aleph א | 1 | 11 |= the numbers after a Hebrew letter join its
right-to-left run, and those cells are drawn in swapped order. Making =|= a
strong left-to-right character keeps every cell in its column, including
where valign doesn't run, such as terminal frames.

valign normally aligns tables as jit-lock shows them, but after org-indent
finishes indenting a buffer (and after a text-scale change) it realigns every
table in the whole buffer at once. Each cell is measured with
=window-text-pixel-size=, which makes font-lock fontify the text it passes
through, so in =grimoire.org= (450 KB) that froze Emacs for minutes, from an
idle timer that fires whenever any Org buffer finishes indenting. Marking the
buffer for refontification instead has jit-lock realign each table when it's
next shown, which is all the whole-buffer pass was for.
#+begin_src emacs-lisp
(use-package! valign
  :hook (org-mode . valign-mode)
  :config
  (setq valign-max-table-size 20000)

  (defun my/valign-realign-lazily-a (&rest _)
    "Realign tables as jit-lock shows them, not the whole buffer at once."
    (when valign-mode
      (jit-lock-refontify)))
  (advice-add #'valign--buffer-advice :override #'my/valign-realign-lazily-a))

(put-char-code-property ?| 'bidi-class 'L)
#+end_src

* GTD
A Getting Things Done workflow on top of [[*Org][Org]]: fast capture into an
inbox, refiling into projects/someday/tickler, GTD-style states and
context tags, and agenda views for daily use and the weekly review.

** Paths
The GTD files (=inbox.org=, =gtd.org=, =someday.org=, =tickler.org=,
=reference.org=) live directly in =org-directory=, same as everything
else — there's no separate GTD subdirectory. =my/gtd-file= centralizes
that so the path isn't repeated across the settings below.
#+begin_src emacs-lisp
(defun my/gtd-file (name)
  "Return the absolute path to the GTD file NAME (in `org-directory')."
  (expand-file-name name org-directory))
#+end_src

** Agenda files
The whole agenda file list lives here, the GTD files and everything else.
=someday.org= and =reference.org= are deliberately left out, so
someday/maybe items and reference material don't clutter daily agenda
views. So are files that hold nothing dated and no TODOs, like
=feeds.org=, =blog.org= and =reading.org=: every agenda build opens and scans
each listed file, whether or not it has anything to show.

=C-c [= and =C-c ]= (add or remove the current file) save their change to
=custom.el=. That loads after this file, but this =setq= runs once Org
loads, which is later still, so it wins. Add or remove files here instead.
#+begin_src emacs-lisp
(after! org
  (setq org-agenda-files
        (mapcar (lambda (file) (expand-file-name file org-directory))
                '("inbox.org" "gtd.org" "tickler.org" "todo.org" "habits.org"
                  "journal.org" "calendar.org" "notes.org" "grimoire.org"
                  "german.org" "latin.org"))))
#+end_src

** TODO keywords
The main sequence becomes GTD states: =NEXT= is the next physical action
on a project, =WAITING= prompts for a note on entry (who/what it's
waiting on), =PROJ= marks a multi-step project heading, and =CANCELLED=
prompts for a note too. Doom's default =STRT/HOLD/IDEA/LOOP/KILL= states
are dropped from this sequence in favor of the above. The checkbox
sequence (=[ ]/[-]/[?]/[X]=, still used by [[*Capture defaults][Personal
notes/other captures]]) and the =OKAY/YES/NO= sequence are left as Doom
set them, except that =NO= moves from =n= to =N=: =NEXT= took =n=, and
fast TODO selection picks the first keyword with a matching key, which
left =NO= with no key at all.
#+begin_src emacs-lisp
(after! org
  (setq org-todo-keywords
        '((sequence "TODO(t)" "NEXT(n)" "WAITING(w@/!)" "PROJ(p)" "|" "DONE(d)" "CANCELLED(c@)")
          (sequence "[ ](T)" "[-](S)" "[?](W)" "|" "[X](D)")
          (sequence "|" "OKAY(o)" "YES(y)" "NO(N)"))
        org-todo-keyword-faces
        '(("NEXT"      . +org-todo-active)
          ("[-]"       . +org-todo-active)
          ("WAITING"   . +org-todo-onhold)
          ("[?]"       . +org-todo-onhold)
          ("PROJ"      . +org-todo-project)
          ("CANCELLED" . +org-todo-cancel)
          ("NO"        . +org-todo-cancel))
        org-log-done 'time))
#+end_src

** Context tags
#+begin_src emacs-lisp
(after! org
  (setq org-tag-alist
        '(("@home"     . ?h)
          ("@computer" . ?c)
          ("@errands"  . ?e)
          ("@phone"    . ?p)
          ("@office"   . ?o))))
#+end_src

** Capture
=t= captures into the GTD inbox, in place of Doom's "Personal todo" (see
[[*Capture defaults][Capture defaults]]). =T= files a tickler entry timestamped with =%U=,
so it shows up for review on the right day.
#+begin_src emacs-lisp
(after! org-capture
  (add-to-list 'org-capture-templates
               '("t" "Todo [inbox]" entry
                 (file "inbox.org")
                 "* TODO %i%?"))
  (add-to-list 'org-capture-templates
               '("T" "Tickler" entry
                 (file "tickler.org")
                 "* %i%?\n%U")))
#+end_src

** Refiling
One-step completion of the full outline path (=file= + no step-completion)
so refiling to e.g. =gtd.org/Projects/Some project= is a single prompt.
Refiling to a heading that doesn't exist yet asks for confirmation first.
#+begin_src emacs-lisp
(after! org
  (setq org-refile-targets
        `((,(my/gtd-file "gtd.org") :maxlevel . 3)
          (,(my/gtd-file "someday.org") :level . 1)
          (,(my/gtd-file "tickler.org") :maxlevel . 2))
        org-refile-use-outline-path 'file
        org-outline-path-complete-in-steps nil
        org-refile-allow-creating-parent-nodes 'confirm))
#+end_src

** GTD agenda views
Added with =add-to-list= rather than a plain =setq= so the existing
[[*Custom agenda views][Public agenda]] command on key =p= survives.
Phone therefore lands on =P= instead of the =p= the GTD spec would
otherwise use.
#+begin_src emacs-lisp
(after! org
  (dolist (cmd '(("n" "Next actions" todo "NEXT")
                  ("h" "At home" tags-todo "@home/NEXT")
                  ("c" "At computer" tags-todo "@computer/NEXT")
                  ("e" "Errands" tags-todo "@errands/NEXT")
                  ("P" "Phone" tags-todo "@phone/NEXT")
                  ("w" "Waiting for" todo "WAITING")
                  ("r" "Weekly review"
                   ((agenda "" ((org-agenda-span 'week)))
                    (todo "NEXT")
                    (todo "WAITING")
                    (todo "PROJ")))))
    (add-to-list 'org-agenda-custom-commands cmd)))
#+end_src

** Stuck projects
A project (a =PROJ= heading under =* Projects= in =gtd.org=, one level
down) is stuck when none of its children are =NEXT=. Dispatched with
=#= from the agenda dispatcher.
#+begin_src emacs-lisp
(after! org
  (setq org-stuck-projects '("+LEVEL=2/PROJ" ("NEXT") nil "")))
#+end_src

** Archiving
Archived items go to a dedicated file rather than each source file's own
=_archive= sibling. Org creates =archive.org= the first time something is
archived into it.
#+begin_src emacs-lisp
(after! org
  (setq org-archive-location (concat (my/gtd-file "archive.org") "::* From %s")))
#+end_src

** Keybindings
#+begin_src emacs-lisp
(map! :leader
      :desc "GTD inbox"            "n g i" (cmd! (find-file (my/gtd-file "inbox.org")))
      :desc "GTD projects/actions" "n g g" (cmd! (find-file (my/gtd-file "gtd.org")))
      :desc "GTD someday"          "n g s" (cmd! (find-file (my/gtd-file "someday.org")))
      :desc "GTD next actions"     "n g n" (cmd! (org-agenda nil "n"))
      :desc "GTD weekly review"    "n g r" (cmd! (org-agenda nil "r")))
#+end_src

* Blog
Posts are top-level headings in =~/Documents/org/blog.org=, in whatever
order they're already in there -- put newest at the top, since neither
export reorders anything. Tag a heading =:draft:= to keep it out of both
outputs; drop the tag and re-publish when it's ready to go out.

=ox-rss= needs each entry stamped with a =:PUBDATE:=, and, since
=org-rss-use-entry-url-as-guid= is turned off below, an =:ID:= to use as
the feed item's guid instead of the post's HTML anchor -- which is
a random string regenerated on every export, and would otherwise make
every post look brand new to feed readers on every re-publish.
=my/blog-stamp-metadata= sets =:PUBDATE:=, =:ID:=, and a =:CUSTOM_ID:=
derived from that id (for a stable in-page anchor too) the first time
a post is published, and leaves them alone after that, so re-publishing
never changes an old post's date, guid, or link.

Org's exporters stay unloaded until the first publish, because
=my/blog-publish= requires =ox-rss= itself. Requiring it as soon as Org
loads would cost every session about 60 ms, for an export that runs only now
and then.
=my/blog-site-directory= is where the two outputs go: the checkout of
whatever site serves them.
#+begin_src emacs-lisp
(defvar my/blog-site-directory nil
  "Directory `my/blog-publish' writes blog.html and blog.rss into.
Nil means no site is set up, and publishing says so.")

(setq org-rss-use-entry-url-as-guid nil)

(defun my/blog-stamp-metadata ()
  "Give every non-draft top-level heading in the current buffer a
:PUBDATE:, :ID:, and :CUSTOM_ID:, unless it already has them. Existing
values are left untouched, so re-publishing a post already on the site
never changes its date, feed guid, or in-page anchor."
  (org-map-entries
   (lambda ()
     (unless (member "draft" (org-element-property :tags (org-element-at-point)))
       (unless (org-entry-get (point) "PUBDATE")
         (org-set-property "PUBDATE" (format-time-string (cdr org-time-stamp-formats))))
       (let ((id (org-id-get-create)))
         (unless (org-entry-get (point) "CUSTOM_ID")
           (org-set-property "CUSTOM_ID" (concat "post-" id))))))
   "LEVEL=1" nil 'comment 'archive))

(defun my/blog-html-headline (headline contents info)
  "Transcode a top-level post HEADLINE for the blog page.
Headings nested inside a post are exported as ordinary HTML."
  (if (> (org-export-get-relative-level headline info) 1)
      (org-export-data-with-backend headline 'html info)
    (let* ((title (org-export-data (org-element-property :title headline) info))
           (anchor (or (org-element-property :CUSTOM_ID headline)
                       (org-export-get-reference headline info)))
           (pubdate (org-element-property :PUBDATE headline))
           (date (and pubdate
                      (format-time-string "%Y-%m-%d" (org-time-string-to-time pubdate)))))
      (format "<h2 id=\"%s\">%s</h2>\n%s%s"
              anchor title
              (if date (format "<p><em>%s</em></p>\n" date) "")
              (or contents "")))))

(defun my/blog-publish ()
  "Export the non-draft posts in blog.org to blog.html and blog.rss in
`my/blog-site-directory'."
  (interactive)
  (unless my/blog-site-directory
    (user-error "Set `my/blog-site-directory' to the site checkout to publish into"))
  (require 'ox-rss)
  (let* ((org-file (expand-file-name "blog.org" org-directory))
         (site-dir (file-name-as-directory (expand-file-name my/blog-site-directory)))
         (html-file (expand-file-name "blog.html" site-dir))
         (rss-file (expand-file-name "blog.rss" site-dir)))
    (with-current-buffer (find-file-noselect org-file)
      (my/blog-stamp-metadata)
      (save-buffer)
      (let ((title (or (cadr (assoc "TITLE" (org-collect-keywords '("TITLE")))) "Blog"))
            ;; Rendered with the Org buffer current, since `with-temp-file'
            ;; below would otherwise make `org-export-as' read from the
            ;; (empty) temp buffer it creates for its body instead.
            (body (org-export-as 'blog-html nil nil t)))
        (with-temp-file html-file
          (insert (format "<h1>%s</h1>\n<hr>\n" title))
          (insert body)))
      (org-export-to-file 'rss rss-file))
    (message "Blog published to %s and %s" html-file rss-file)))

;; A minimal HTML backend for the blog page: like ordinary HTML export,
;; except a top-level post's title gets its publish date shown
;; underneath, and there's no wrapping <div>s, ToC, or preamble to
;; strip via #+OPTIONS. Headings nested inside a post still fall
;; through to plain HTML export. A derived backend can only be
;; registered once its parent is, hence waiting for ox-html.
(after! ox-html
  (org-export-define-derived-backend 'blog-html 'html
    :translate-alist '((headline . my/blog-html-headline))))

(map! :leader :desc "Publish blog" "o u" #'my/blog-publish)
#+end_src

* Tarot
=my/tarot-attach-spread= draws N random cards from a deck directory, tiles them
with ImageMagick, and attaches the result to the heading at point.
=my/tarot-attach-deck-spread= is the part of that which doesn't ask any
questions -- DECK and N are already decided -- so [[*Daily divination][Daily
divination]] can call it straight from a capture template. Listing a deck's
cards, shuffling them and tiling them go through the helpers in
[[*Splash screen][Splash screen]], which draws its own spread the same way.
#+begin_src emacs-lisp
(defcustom my/tarot-directory "~/.local/share/tarot/"
  "Directory containing one subdirectory of card images per deck."
  :type 'directory)

(defun my/tarot--read-deck ()
  "Prompt for a deck under `my/tarot-directory' and return its directory."
  (let ((decks (seq-filter #'file-directory-p
                           (directory-files my/tarot-directory t "\\`[^.]"))))
    (expand-file-name
     (completing-read "Deck: " (mapcar #'file-name-nondirectory decks) nil t)
     my/tarot-directory)))

(defun my/tarot--attach-montage (cards)
  "Tile CARDS into one image, attach it to the Org heading at point, and link it."
  (require 'org-attach)
  (let ((output (make-temp-file "tarot-" nil ".png")))
    (unwind-protect
        (progn
          (my/tarot--montage cards output "-geometry" "x450>+0+0")
          (insert "[[" (car (org-attach-attach output nil 'cp)) "]]\n")
          (org-display-inline-images))
      (delete-file output))))

(defun my/tarot--attach-random (cards n)
  "Attach a spread of N cards drawn at random from CARDS."
  (unless (<= 1 n (length cards))
    (user-error "Pick between 1 and %d cards" (length cards)))
  (my/tarot--attach-montage (seq-take (my/tarot--shuffle cards) n)))

(defun my/tarot-attach-deck-spread (deck n)
  "Attach a random N-card spread from tarot DECK to the Org heading at point.
DECK is a subdirectory name under `my/tarot-directory'."
  (my/tarot--attach-random (my/tarot--cards (expand-file-name deck my/tarot-directory)) n))

(defun my/tarot-attach-spread ()
  "Attach a random spread from a tarot deck to the Org heading at point."
  (interactive)
  (let ((cards (my/tarot--cards (my/tarot--read-deck))))
    (my/tarot--attach-random
     cards (read-number (format "Cards (1-%d): " (length cards)) 3))))

(defun my/tarot-attach-chosen-spread ()
  "Attach a hand-picked spread from a tarot deck to the Org heading at point.
Prompts for a deck, then repeatedly prompts for a card to add to the spread;
finish by pressing RET on an empty prompt or by quitting the prompt (`C-g')."
  (interactive)
  (let* ((deck-dir (my/tarot--read-deck))
         (names (mapcar #'file-name-nondirectory (my/tarot--cards deck-dir)))
         (selected nil)
         (done nil))
    (while (not done)
      (let ((choice (condition-case nil
                        (completing-read
                         (format "Card %d (empty to finish): " (1+ (length selected)))
                         names nil t)
                      (quit ""))))
        (if (string-empty-p choice)
            (setq done t)
          (push (expand-file-name choice deck-dir) selected))))
    (unless selected
      (user-error "No cards selected"))
    (my/tarot--attach-montage (nreverse selected))))

(map! :map org-mode-map :localleader :desc "Tarot spread" "a t" #'my/tarot-attach-spread)
(map! :map org-mode-map :localleader :desc "Tarot spread (chosen)" "a c" #'my/tarot-attach-chosen-spread)
#+end_src

* Astrology
=astro-transits= (in [[file:bin/][bin/]]) renders the current sky against a natal chart
with astrolog: a biwheel image and an ordered transit table. The chart is an
astrolog chart file, =~/.local/share/astrology/natal.dat=, which you make with
astrolog itself; the location is =$ASTRO_LAT=/=$ASTRO_LONG=, as in
[[*Solar times][Solar times]], plus =$ASTRO_ZONE=, the standard-time offset in hours west of
UTC. It is a terminal
program first and stays one — everything below shells out to it via its
=--emacs= flag, which hands back the generated file paths instead of
displaying them, rather than reimplementing its astrolog invocations here.
The =-Tn= table astro-transits hands back is fixed-width text, one aspect per
line, e.g. =1: trans  Saturn (Pis) Tri natal (Can) Sun        - pos 0:44' -
power: 143.58=. The field widths below (planet name in 7 columns, sign in
brackets, a 3-letter aspect, then the natal side in a 10-column field) come
straight from astrolog's own formatting code (=PrintAspect= and
=ChartTransitInfluence= in astrolog's =charts2.cpp=), not from guessing at the
spacing, so they hold as long as that layout does.
#+begin_src emacs-lisp
(defconst my/astro-transit-line-re
  (rx bol (* " ") (group (+ digit)) ": trans "
      (group (= 7 anything)) " "
      (any "(" "[") (group (= 3 alpha)) (any ")" "]") " "
      (group (= 3 alpha)) " natal "
      (any "(" "[") (group (= 3 alpha)) (any ")" "]") " "
      (group (= 10 anything)) " - "
      (group (or "pos" "neg")) " "
      (group (+ (not (any " ")))) " - power: " (* " ")
      (group (+ (any digit "."))))
  "Matches one aspect line of astro-transits' -Tn table.")

(defun my/astro--transit-row (line)
  "Parse a -Tn aspect LINE into a list of Org table cells, or nil if it isn't one."
  (when (string-match my/astro-transit-line-re line)
    ;; Collect every group before trimming any of them: `string-trim' calls
    ;; `string-match' itself, which would clobber LINE's match data mid-loop.
    (mapcar #'string-trim
            (mapcar (lambda (n) (match-string n line)) '(1 2 3 4 6 5 7 8 9)))))

(defun my/astro--insert-transit-table (table-file)
  "Insert TABLE-FILE, astro-transits' table output, at point as an Org table."
  (let (header rows footer)
    (with-temp-buffer
      (insert-file-contents table-file)
      (dolist (line (split-string (buffer-string) "\n"))
        (unless (string-empty-p line)
          (let ((row (my/astro--transit-row line)))
            (cond (row (push row rows))
                  (rows (push line footer))
                  (t (push line header)))))))
    (dolist (line (nreverse header)) (insert line "\n"))
    (insert "\n")
    (let ((start (point)))
      (insert "| # | Transiting | Sign | Aspect | Natal | Sign | Dir | Orb | Power |\n")
      (insert "|-\n")
      (dolist (row (nreverse rows))
        (insert "| " (string-join row " | ") " |\n"))
      (save-excursion (goto-char start) (org-table-align)))
    (insert "\n#+begin_example\n")
    (dolist (line (nreverse footer)) (insert line "\n"))
    (insert "#+end_example\n")))

(defun my/astro-attach-transits ()
  "Attach the current biwheel transit chart and table to the Org heading at point."
  (interactive)
  (require 'org-attach)
  (let (table image)
    (with-temp-buffer
      (unless (zerop (call-process (my/program "astro-transits") nil t nil "--emacs"))
        (user-error "astro-transits failed: %s" (buffer-string)))
      (goto-char (point-min))
      (while (re-search-forward "^\\(TABLE\\|IMAGE\\)=\\(.*\\)$" nil t)
        (if (string= (match-string 1) "TABLE")
            (setq table (match-string 2))
          (setq image (match-string 2)))))
    (unless (and table image (file-exists-p table) (file-exists-p image))
      (user-error "astro-transits did not report chart files"))
    (let ((link (car (org-attach-attach image nil 'mv))))
      (insert "[[" link "]]\n\n")
      (my/astro--insert-transit-table table)
      (delete-file table)
      (org-display-inline-images))))

(map! :map org-mode-map :localleader :desc "Astrology transits" "a z" #'my/astro-attach-transits)
#+end_src

* Daily divination
Ties [[*Tarot][Tarot]] and [[*Astrology][Astrology]] together into one
capture: a single Thoth card draw plus the current transit chart and table,
filed like [[*Dream journal][Dream]] into the journal's datetree and
tagged =:divination:=. The template text itself is just the
headline -- =my/divination-capture-attach= runs as the template's =:hook=,
which fires once the entry skeleton is already in the buffer and point is
sitting at =%?=, so the draw and the transits land inside the entry rather
than needing to be threaded through the template string.
#+begin_src emacs-lisp
(defun my/divination-capture-attach ()
  "Attach a one-card Thoth tarot draw and the current astrology transits
to the entry just placed by the \"Daily divination\" capture template."
  (my/tarot-attach-deck-spread "thoth" 1)
  (my/astro-attach-transits))

(after! org-capture
  (add-to-list 'org-capture-templates
               '("i" "Daily divination" entry
                 (file+olp+datetree +org-capture-journal-file)
                 "* %U Daily divination :divination:\n%?"
                 :prepend t
                 :hook my/divination-capture-attach)))
#+end_src

* Resume
resumel's commands are all autoloaded, so it needs no =use-package!= to
load when one of them is called. What it does need is a leash on its own
autoloaded =org-mode-hook= entry, =resumel-mode--maybe-turn-on=. That
function lives in =resumel-mode.el=, which requires =resumel=, which
requires =ox-latex=. So merely running the hook, in the first Org buffer
of every session, loaded Org's LaTeX and HTML exporters and resumel
itself: about 70 ms, spent even when the buffer had nothing to do with a
resume. The replacement below does the same keyword check that function
does, but before loading anything.
#+begin_src emacs-lisp
(remove-hook 'org-mode-hook #'resumel-mode--maybe-turn-on)

(defun my/resumel-maybe-turn-on-h ()
  "Turn on `resumel-mode' in a buffer with a #+RESUMEL_TEMPLATE: keyword.
Loads resumel only when there is one."
  (when (save-excursion
          (save-match-data
            (goto-char (point-min))
            (re-search-forward "^[ \t]*#\\+RESUMEL_TEMPLATE:" nil t)))
    (require 'resumel-mode)
    (resumel-mode 1)))

(add-hook 'org-mode-hook #'my/resumel-maybe-turn-on-h)
#+end_src

* Reading
** Calibre
#+begin_src emacs-lisp
(use-package! calibredb
  :commands calibredb
  :init
  (map! :leader :desc "Calibre library" "o c" #'calibredb)
  :config
  (setq calibredb-root-dir "~/Documents/calibre"
        calibredb-db-dir (expand-file-name "metadata.db" calibredb-root-dir)
        calibredb-library-alist `((,calibredb-root-dir))
        calibredb-format-nerd-icons t
        calibredb-comment-width 100
        calibredb-title-width 60
        calibredb-id-width 4
        calibredb-size-show t
        calibredb-download-dir "~/Downloads"
        calibredb-fetch-metadata-source-list '("Google" "Amazon.com" "Douban Books")
        calibredb-list-view-image-max-width 600
        calibredb-list-view-image-max-height 600
        calibredb-detail-view-image-max-width 300
        calibredb-detail-view-image-max-height 300)

  (map! :map calibredb-search-mode-map
        :n "q"         #'calibredb-search-quit
        :n "n"         #'calibredb-virtual-library-next
        :n "N"         #'calibredb-library-next
        :n "p"         #'calibredb-virtual-library-previous
        :n "P"         #'calibredb-library-previous
        :n "l"         #'calibredb-virtual-library-list
        :n "o"         #'calibredb-find-file
        :n "O"         #'calibredb-find-file-other-frame
        :n "V"         #'calibredb-open-file-with-default-tool
        :n "v"         #'calibredb-view
        :n "d"         #'calibredb-remove
        :n "D"         #'calibredb-remove-marked-items
        :n "m"         #'calibredb-mark-and-forward
        :n "s"         #'calibredb-set-metadata-dispatch
        :n "e"         #'calibredb-export-dispatch
        :n "a"         #'calibredb-add
        :n "."         #'calibredb-open-dired
        :n ","         #'calibredb-quick-look
        :n "y"         #'calibredb-yank-dispatch
        :n "u"         #'calibredb-unmark-and-forward
        :n "DEL"       #'calibredb-unmark-and-backward
        :n "?"         #'calibredb-dispatch
        :n "/"         #'calibredb-search-live-filter
        :n "j"         #'calibredb-next-entry
        :n "k"         #'calibredb-previous-entry
        :n "M-f"       #'calibredb-toggle-favorite-at-point
        :n "M-x"       #'calibredb-toggle-archive-at-point
        :n "M-h"       #'calibredb-toggle-highlight-at-point
        :n "M-n"       #'calibredb-show-next-entry
        :n "M-p"       #'calibredb-show-previous-entry
        :n "R"         #'calibredb-search-clear-filter
        :n "r"         #'calibredb-search-refresh-and-clear-filter
        :n "<backtab>" #'calibredb-toggle-view
        :n "<tab>"     #'calibredb-toggle-view-at-point
        :n "TAB"       #'calibredb-toggle-view-at-point
        :n "RET"       #'calibredb-find-file)

  (map! :map calibredb-show-mode-map
        :nie "q"   #'calibredb-entry-quit
        :nie "?"   #'calibredb-entry-dispatch
        :nie "RET" #'calibredb-search-ret))

(add-hook! '(calibredb-search-mode-hook calibredb-show-mode-hook)
           #'doom-mark-buffer-as-real-h)
#+end_src

** EPUBs
nov renders EPUBs. shrface gives the rendered HTML org-style headings and
links, in nov and in eww.

Text is set in a column =nov-text-width= columns wide, justified so every
wrapped line ends at the same right margin, and zen centers that column.
Font size and column width both change on the fly, per book:

| Key       | In an EPUB                                 |
|-----------+--------------------------------------------|
| =+= / =-= | bigger / smaller text                      |
| =>= / =<= | wider / narrower column, 5 columns a press |
| ===       | back to the default size and width         |
| =SPC t z= | zen: center the column                     |

EPUBs are zip files and routinely bigger than =large-file-warning-threshold=,
so Emacs would ask before opening every book. They skip that check.
#+begin_src emacs-lisp
(defun my/no-large-file-prompt-for-epub-a (fn size op-type filename &rest args)
  "Open EPUBs without asking, however big they are."
  (unless (string-match-p "\\.epub\\'" filename)
    (apply fn size op-type filename args)))
(advice-add #'abort-if-file-too-large :around #'my/no-large-file-prompt-for-epub-a)

(use-package! shrface
  :defer t
  :config
  (shrface-basic)
  (shrface-trial)
  (setq shrface-href-versatile t))

(use-package! nov
  :mode ("\\.epub\\'" . nov-mode)
  :init
  (add-hook 'nov-mode-hook #'shrface-mode)
  :config
  (require 'shrface)
  (setq nov-text-width 120
        nov-render-html-function #'my/nov-render-html)

  ;; nov signals an error when an EPUB's declared unique identifier cannot be
  ;; resolved, which makes the book unopenable. Return nil instead; such books
  ;; then share one save-place slot, which is a fair trade.
  (defun my/nov-tolerant-unique-identifier-a (orig content)
    (condition-case nil
        (funcall orig content)
      (error nil)))
  (advice-add #'nov-content-unique-identifier
              :around #'my/nov-tolerant-unique-identifier-a)

  (advice-add #'shr-fill-line :around #'my/nov-mark-soft-breaks-a)
  (add-hook 'nov-pre-html-render-hook #'my/nov-mixed-pitch-h)
  (add-hook 'nov-mode-hook #'my/nov-setup-h 90)
  (add-hook 'after-setting-font-hook #'my/nov-font-changed-h)

  (map! :map nov-mode-map
        :n "+" #'text-scale-increase
        :n "-" #'text-scale-decrease
        :n "=" #'my/nov-reset-layout
        :n ">" #'my/nov-widen
        :n "<" #'my/nov-narrow))

(after! eww
  (require 'shrface)
  (add-hook 'eww-after-render-hook #'shrface-mode))
#+end_src

*** Justified text
shr wraps each paragraph itself, breaking it into lines no wider than the
column, which leaves every line a different length. Justifying stretches the
spaces in each of those wrapped lines until it ends exactly at the column's
edge. It only ever puts a =display= width on spaces that are already there:
every character and every newline in the buffer is exactly what shr produced.
That's the difference from justifiers like =justify-kp=, which re-break
paragraphs themselves and can corrupt real books doing it (lists reflowed
into prose, dropped letters, broken wrapping). Nothing here can reflow or lose
text; the worst a mistake could do is leave a line ragged or badly spaced.

shr decides which lines get justified. An advice tags the newlines
=shr-fill-line= inserts when it wraps a line, and only lines ending in one of
those are touched. A paragraph's last line and lines ended by =<br>= (verse,
addresses) keep their own newlines and stay as written. Headings stay ragged
too, and a list item's bullet and indentation are never stretched.

Widths are measured in pixels, in the buffer's real faces, so the serif font,
the zoom level, and mixed-pitch all count. shr overshoots the width it fills to
by up to a character (it keeps a word whose last letter straddles the edge), so
it fills one character short and justifying stretches every line out to the
full width. A line is left ragged only if its gaps would take up more than half
of it (it broke early, before something unbreakable like a long URL), or if it
comes out too wide to fix by squeezing spaces (an inline image, or a URL longer
than the whole line).
#+begin_src emacs-lisp
(defun my/nov-mark-soft-breaks-a (fill-line &rest args)
  "Tag the newlines `shr-fill-line' inserts to wrap a line, in nov buffers.
Those lines are the ones to justify. A paragraph's last line, and lines
ended by <br> or the end of a block, keep untagged newlines."
  (if (not (derived-mode-p 'nov-mode))
      (apply fill-line args)
    (let ((start (point)))
      (apply fill-line args)
      (save-excursion
        (let ((end (point)))
          (goto-char start)
          (while (search-forward "\n" end t)
            (put-text-property (1- (point)) (point) 'my/nov-soft-break t)))))))

(defun my/nov--pixel-width (start end)
  "Width in pixels of the text from START to END, all on one line."
  ;; Without an X limit, the measurement stops at the window's edge.
  (car (window-text-pixel-size nil start end t)))

(defun my/nov--justify-line (bol eol width space-widths)
  "Stretch or squeeze the spaces from BOL to EOL to make the line WIDTH pixels.
SPACE-WIDTHS caches the natural width of a space in each face."
  (let ((text-start (save-excursion
                      ;; Past the indentation and any list bullet.
                      (goto-char (+ bol (or (get-text-property bol 'shr-prefix-length) 0)))
                      (skip-chars-forward " " eol)
                      (point)))
        spaces)
    (unless (text-property-not-all text-start eol 'shrface-headline nil)
      (save-excursion
        (goto-char text-start)
        (while (search-forward " " eol t)
          (unless (get-text-property (1- (point)) 'display)
            (push (1- (point)) spaces))))
      (when spaces
        (let* ((space-width (lambda (pos)
                              (let ((face (get-text-property pos 'face)))
                                (or (gethash face space-widths)
                                    (puthash face (my/nov--pixel-width pos (1+ pos))
                                             space-widths)))))
               (count (length spaces))
               (extra (- width (my/nov--pixel-width bol eol))))
          ;; Leave the line ragged if the gaps would swallow it, or would
          ;; have to shrink below a quarter of a space.
          (when (and (/= extra 0)
                     (< extra (/ width 2))
                     (> extra (- (/ (* 3 count (funcall space-width (car spaces))) 4))))
            (let ((each (floor extra count))
                  (leftover (mod extra count)))
              (dolist (pos (nreverse spaces))
                (put-text-property
                 pos (1+ pos) 'display
                 `(space :width (,(+ (funcall space-width pos) each
                                     (if (> leftover 0) 1 0)))))
                (setq leftover (1- leftover))))))))))

(defun my/nov--justify (width)
  "Justify every line in the buffer that shr wrapped, to WIDTH pixels."
  (let ((space-widths (make-hash-table :test #'equal))
        (pos (point-min)))
    (while (setq pos (text-property-any pos (point-max) 'my/nov-soft-break t))
      (my/nov--justify-line (save-excursion (goto-char pos) (line-beginning-position))
                            pos width space-widths)
      (setq pos (1+ pos)))))

(defvar-local my/nov--rendered-layout nil
  "What the current rendering was laid out for, from `my/nov--layout'.")

(defun my/nov--window ()
  "The window the current nov buffer is laid out for, or nil if it isn't shown."
  (if (eq (window-buffer) (current-buffer))
      (selected-window)
    (get-buffer-window nil t)))

(defun my/nov--call-in-window (fn)
  "Call FN with the window the current buffer is laid out for, selected.
nov renders a book before displaying it, and text can only be measured
in a window, so then borrow the selected one, as shr itself does."
  (if-let* ((window (my/nov--window)))
      (with-selected-window window (funcall fn window))
    (save-window-excursion
      (set-window-dedicated-p nil nil)
      (set-window-buffer nil (current-buffer))
      (funcall fn (selected-window)))))

(defun my/nov--columns (window)
  "Columns to fill text to in WINDOW: `nov-text-width', unless WINDOW is narrower."
  (let* ((fringes (window-fringes window))
         (room (- (window-body-width window)
                  ;; Without fringes, the last column goes to the
                  ;; continuation glyph.
                  (if (and (zerop (car fringes)) (zerop (cadr fringes))) 2 1))))
    (if (integerp nov-text-width) (min nov-text-width room) room)))

(defun my/nov--layout (window)
  "Everything a rendering for WINDOW depends on, besides the book itself."
  (list (my/nov--columns window)
        (frame-char-width (window-frame window))
        ;; Font size and mixed-pitch both live here. Copied, because
        ;; `face-remap-add-relative' edits entries in place.
        (copy-tree face-remapping-alist)))

(defun my/nov-render-html ()
  "Like `nov-render-html', but filled to fit the window, then justified."
  (my/nov--call-in-window
   (lambda (window)
     (let* ((columns (my/nov--columns window))
            (em (string-pixel-width (propertize "M" 'face 'shr-text) (current-buffer))))
       (let ((nov-text-width (- columns (ceiling em (frame-char-width))))
             ;; Measure every line whole, even one wider than the window.
             (truncate-lines t))
         (nov-render-html)
         (my/nov--justify (* columns (frame-char-width))))
       (setq my/nov--rendered-layout (my/nov--layout window))))))
#+end_src

*** Keeping the layout current
A rendering only fits the width, font size and faces it was laid out for. The
column is =nov-text-width= columns, or the window's width if that's narrower,
so a book in a split window is still justified, just narrower. Each rendering
records what it was laid out for, and zooming, changing the column width, or
the window changing size (a split, zen's margins, the frame) re-renders the
chapter if that record no longer matches. The re-render waits until 0.2s after
the last change, so a burst of zooming or resizing re-renders once. It keeps
the same text at the top of the window and at the cursor by counting
non-whitespace characters, which re-wrapping can't change.

nov renders a book from inside =nov-mode= itself, before =nov-mode-hook= runs.
Switched on from that hook, mixed-pitch would change the faces right after
the first rendering had been measured, and every book would be rendered twice
on opening. It's switched on from =nov-pre-html-render-hook=
instead, just before that first rendering.
#+begin_src emacs-lisp
(defun my/nov--text-offset (pos)
  "Number of non-whitespace characters before POS."
  (save-excursion
    (goto-char (point-min))
    (let ((count 0))
      (while (< (point) pos)
        (skip-chars-forward " \t\n\r\f" pos)
        (setq count (+ count (skip-chars-forward "^ \t\n\r\f" pos))))
      count)))

(defun my/nov--text-position (count)
  "Position of the non-whitespace character that COUNT others precede.
The inverse of `my/nov--text-offset'."
  (save-excursion
    (goto-char (point-min))
    (while (and (> count 0) (not (eobp)))
      (skip-chars-forward " \t\n\r\f")
      (let ((moved (skip-chars-forward "^ \t\n\r\f" (min (point-max) (+ (point) count)))))
        (if (zerop moved)
            (goto-char (point-max))
          (setq count (- count moved)))))
    (skip-chars-forward " \t\n\r\f")
    (point)))

(defun my/nov-rerender ()
  "Render the current document again, keeping the same text in view."
  (let* ((window (my/nov--window))
         (start (and window (my/nov--text-offset (window-start window))))
         (pt (my/nov--text-offset (point))))
    (nov-render-document)
    (goto-char (my/nov--text-position pt))
    (when window
      (set-window-start window (save-excursion
                                 (goto-char (my/nov--text-position start))
                                 (line-beginning-position)))
      (set-window-point window (point)))))

(defvar-local my/nov--rerender-timer nil)

(defun my/nov--rerender-if-stale (buffer)
  (when (buffer-live-p buffer)
    (with-current-buffer buffer
      (setq my/nov--rerender-timer nil)
      (when-let* ((window (my/nov--window)))
        (with-selected-window window
          (unless (equal my/nov--rendered-layout (my/nov--layout window))
            (my/nov-rerender)))))))

(defun my/nov--schedule-rerender ()
  "Re-render the current buffer once a burst of changes has settled."
  (when (timerp my/nov--rerender-timer)
    (cancel-timer my/nov--rerender-timer))
  (setq my/nov--rerender-timer
        (run-with-timer 0.2 nil #'my/nov--rerender-if-stale (current-buffer))))

(defun my/nov--window-size-change-h (window)
  (with-current-buffer (window-buffer window)
    (unless (equal my/nov--rendered-layout (my/nov--layout window))
      (my/nov--schedule-rerender))))

(defun my/nov-mixed-pitch-h ()
  "Turn on mixed-pitch before nov's first rendering, not after it."
  (unless (bound-and-true-p mixed-pitch-mode)
    (mixed-pitch-mode 1)))

(defun my/nov-font-changed-h ()
  "Lay nov buffers out again after the frame's font changes size."
  (dolist (buffer (buffer-list))
    (with-current-buffer buffer
      (when (derived-mode-p 'nov-mode)
        (my/nov--fit-zen-width)
        (my/nov--schedule-rerender)))))
#+end_src

*** Zen, font size and width
Zen (writeroom) centers the text by sizing its writing area to fit
=nov-text-width= columns. visual-fill-column counts that width in characters of
the buffer's remapped default face, which mixed-pitch and zooming both change,
rather than in the frame columns =nov-text-width= uses. That mismatch, plus
Doom's zen zooming the text in on entry after nov had already wrapped it for
the old size, makes zen in EPUBs unpredictable. So zen's width is
converted from =nov-text-width= whenever either one changes, with half a column
of slack, rounded up, to survive visual-fill-column's own rounding of the
margins; that keeps the text within a column and a half of true center. In an
EPUB, entering zen leaves the font size alone; =+= and =-= set it.
#+begin_src emacs-lisp
(defun my/nov--fit-zen-width ()
  "Size zen's writing area to hold `nov-text-width' columns."
  (when (integerp nov-text-width)
    (setq-local writeroom-width
                (ceiling (+ (* nov-text-width (frame-char-width))
                            (/ (frame-char-width) 2))
                         (float (window-font-width))))
    (when (bound-and-true-p writeroom-mode)
      (setq-local visual-fill-column-width writeroom-width)
      (when-let* ((window (my/nov--window)))
        (with-selected-window window
          (visual-fill-column-adjust))))))

(defun my/nov--text-scale-h ()
  (my/nov--fit-zen-width)
  (my/nov--schedule-rerender))

(defun my/nov-setup-h ()
  "Keep a nov buffer's layout matched to its window, font size and zen width."
  (setq-local +zen-text-scale 0)
  (my/nov--fit-zen-width)
  (add-hook 'text-scale-mode-hook #'my/nov--text-scale-h nil t)
  (add-hook 'window-size-change-functions #'my/nov--window-size-change-h nil t)
  ;; nov rendered the book before running this hook, so anything earlier
  ;; in it that remapped faces has made that rendering stale.
  (my/nov--call-in-window
   (lambda (window)
     (unless (equal my/nov--rendered-layout (my/nov--layout window))
       (my/nov-rerender)))))

(defun my/nov--set-width (columns)
  (setq-local nov-text-width (max 20 columns))
  (my/nov--fit-zen-width)
  (my/nov--schedule-rerender)
  (message "Text width: %d columns" nov-text-width))

(defun my/nov-widen (&optional n)
  "Widen the text by 5 columns, or N times that."
  (interactive "p")
  (my/nov--set-width (+ nov-text-width (* 5 n))))

(defun my/nov-narrow (&optional n)
  "Narrow the text by 5 columns, or N times that."
  (interactive "p")
  (my/nov-widen (- n)))

(defun my/nov-reset-layout ()
  "Put this book's font size and text width back to the defaults."
  (interactive)
  (kill-local-variable 'nov-text-width)
  (text-scale-set 0)
  (my/nov--fit-zen-width)
  (my/nov--schedule-rerender))
#+end_src

** Mixed pitch
Body text in org, EPUBs, and eww uses the serif family (EPUBs switch mixed-pitch
on themselves; see [[*Keeping the layout current]]). =mixed-pitch-set-height=
stays off: when it is on, mixed-pitch pins absolute heights into buffer-local
face remaps, for the body text and for the code faces it keeps monospace, and
pinned heights ignore zooming. Left off, heights flow from =default= and
=variable-pitch=, so org body text is at the monospace size and EPUB and eww
text at 1.3 times it. For larger org body text that still zooms, add
=(face-remap-add-relative 'default :height 1.3)= to =org-mode-hook=.

Doom's zen module toggles mixed-pitch together with writeroom in the modes it
lists, and would switch it off again on leaving zen, so org-mode comes out of
that list.
#+begin_src emacs-lisp
(use-package! mixed-pitch
  :hook ((org-mode eww-mode) . mixed-pitch-mode))

(setq +zen-mixed-pitch-modes '(adoc-mode rst-mode markdown-mode))

(after! visual-fill-column
  (setq visual-fill-column-adjust-for-text-scale nil))
#+end_src

=visual-fill-column= sizes its margins in columns of the default (monospace)
face, then hands off to Emacs' own word-wrap, which wraps at those margins
using whatever face is actually on screen. With mixed-pitch's serif face
running noticeably wider per character than the monospace one, the same
column count buys far less room than it looks like, so most lines broke
early with one dangling word wrapped onto a line of its own. Scaling
=writeroom-width= (and, for modes where zen switches mixed-pitch on itself,
after writeroom-mode already computed the margins for this same toggle,
=visual-fill-column-width= directly) by the ratio between the two font
widths keeps the same effective reading width regardless of which face is
on screen. =nov-mode= already sets its own correct width from
=nov-text-width= and is left alone.
#+begin_src emacs-lisp
(add-hook 'mixed-pitch-mode-hook
          (defun my/writeroom-scale-width-for-mixed-pitch-h ()
            (when (and mixed-pitch-mode (not (derived-mode-p 'nov-mode)))
              ;; mixed-pitch-mode turns on immediately for every org buffer,
              ;; but writeroom-mode (which defines `writeroom-width') is
              ;; normally only loaded lazily, on first use of zen mode. On
              ;; a fresh daemon, that leaves the variable unbound here,
              ;; which throws mid-hook and silently skips every mode-hook
              ;; function still queued after this one -- including
              ;; `org-modern-mode', which is most of org's highlighting.
              (require 'writeroom-mode)
              (let ((scaled (round (* (default-value 'writeroom-width)
                                       (/ (float (window-font-width nil 'variable-pitch))
                                          (window-font-width nil 'default))))))
                (setq-local writeroom-width scaled)
                (when (bound-and-true-p visual-fill-column-mode)
                  (setq-local visual-fill-column-width scaled))))))
#+end_src

* Dired
Doom already turns on =dired-omit-mode=; this widens what it hides to every
dotfile.
#+begin_src emacs-lisp
(after! dired-x
  (setq dired-omit-files (concat dired-omit-files "\\|^\\..+\\'")))
#+end_src

** Reusing Dirvish's window
Dirvish's root window is dedicated (so its preview pane doesn't get
clobbered by unrelated buffer displays), which means any =find-file=,
=switch-to-buffer=, or =pop-to-buffer= run while that window is selected
gets refused there and falls back to carving out a new, unwanted window
instead of just reusing it - the "weird split" behind
[[*TMSU][my/tmsu-dired-query-dirvish-a]] before it wraps its call in
=dirvish-save-dedication=. That macro is Dirvish's own, and is already
completely general: it only ever touches =(selected-window)= and needs no
active session to be safe to call. =my/dirvish-reusing-window= just makes
it available before Dirvish is necessarily loaded (falling back to a plain
passthrough), so any function anywhere in this file can wrap a
buffer-display call in it, not only Dirvish-aware ones.
#+begin_src emacs-lisp
(defmacro my/dirvish-reusing-window (&rest body)
  "Run BODY with the selected window's dedication temporarily lifted.
A plain passthrough if Dirvish (and its `dirvish-save-dedication') isn't
loaded."
  (declare (indent 0) (debug (&rest form)))
  `(if (fboundp 'dirvish-save-dedication)
       (dirvish-save-dedication ,@body)
     ,@body))
#+end_src

* Backups
=docsync= (in [[file:bin/][bin/]], with its systemd units) backs up the paths in
=~/.config/docsync/include=, minus the patterns in =exclude= beside it, to an
encrypted restic repository on a server, every hour from a systemd user timer.
Its usage message covers setting it up. It is a terminal program first:
everything below either reads those two lists and the script's
state files, or shells out to it, so backups happen whether or not Emacs is
running, and nothing here is needed for them.

** Reading the lists
The lists are read the way the script reads them: comments and blank lines
dropped, include paths relative to =~= unless absolute, and a leading =~/= in an
exclude pattern meaning home. Exclude patterns are restic's own globs, so
=my/docsync--glob-regexp= translates them for the common cases (=*=, =?= and
=**/=); what matters is that a marker in Dired agrees with what restic will
actually skip, which =docsync paths= and a restic dry run can confirm for a
given pair of lists.

The parsed lists are cached against both files' modification times, so the
Dirvish attribute below can ask about every visible line on every redraw for
the price of two =stat= calls.
#+begin_src emacs-lisp
(defun my/docsync--xdg-directory (variable fallback)
  "Return docsync's directory under XDG VARIABLE, worked out as the script does."
  (let ((base (getenv variable)))
    (expand-file-name "docsync" (if (member base '(nil "")) fallback base))))

(defun my/docsync--config-file (name)
  "Return the file NAME in docsync's config directory."
  (expand-file-name name (my/docsync--xdg-directory "XDG_CONFIG_HOME" "~/.config")))

(defun my/docsync--state-file (name)
  "Return the file NAME in docsync's state directory."
  (expand-file-name name (my/docsync--xdg-directory "XDG_STATE_HOME" "~/.local/state")))

(defun my/docsync--list-lines (file)
  "Return FILE's entries without comments, blank lines or surrounding space."
  (when (file-readable-p file)
    (with-temp-buffer
      (insert-file-contents file)
      (seq-remove (lambda (line) (or (string-empty-p line) (string-prefix-p "#" line)))
                  (mapcar #'string-trim (split-string (buffer-string) "\n"))))))

(defun my/docsync--include-path (entry)
  "Return include list ENTRY as the absolute path the script backs up."
  (let ((path (string-remove-prefix "~/" entry)))
    (directory-file-name
     (if (file-name-absolute-p path) path (expand-file-name path "~")))))

(defun my/docsync--glob-regexp (glob)
  "Translate restic exclude pattern GLOB into a regexp body.
As in restic, * and ? stay within one path component and **/ spans any
number of them.  Character classes aren't translated; none of the lists
use them."
  (let ((i 0) (n (length glob)) (parts nil))
    (while (< i n)
      (let ((c (aref glob i)))
        (cond ((and (eq c ?*) (< (1+ i) n) (eq (aref glob (1+ i)) ?*))
               (if (and (< (+ i 2) n) (eq (aref glob (+ i 2)) ?/))
                   (progn (push "\\(?:.*/\\)?" parts) (setq i (+ i 3)))
                 (push ".*" parts) (setq i (+ i 2))))
              ((eq c ?*) (push "[^/]*" parts) (setq i (1+ i)))
              ((eq c ??) (push "[^/]" parts) (setq i (1+ i)))
              (t (push (regexp-quote (string c)) parts) (setq i (1+ i))))))
    (apply #'concat (nreverse parts))))

(defun my/docsync--exclude-matcher (entry)
  "Return (ENTRY . REGEXP) for exclude list ENTRY.
REGEXP matches what restic leaves out for it: the path itself and
everything under it, anchored at the root when ENTRY is absolute (or
starts with ~/), and at any directory boundary otherwise."
  (let* ((home-relative (string-prefix-p "~/" entry))
         (pattern (if home-relative
                      (concat (directory-file-name (expand-file-name "~")) "/"
                              (substring entry 2))
                    entry))
         (anchored (string-prefix-p "/" pattern)))
    (cons entry
          (concat (if anchored "\\`" "/")
                  (my/docsync--glob-regexp (if anchored pattern
                                              (string-remove-prefix "/" pattern)))
                  "\\(?:/.*\\)?\\'"))))

(defvar my/docsync--lists-cache nil
  "(INCLUDE-MTIME EXCLUDE-MTIME INCLUDES EXCLUDES) as last read.")

(defun my/docsync--lists ()
  "Return (INCLUDES EXCLUDES), re-reading the list files when they change.
INCLUDES are absolute paths, EXCLUDES are (ENTRY . REGEXP) conses."
  (let* ((include (my/docsync--config-file "include"))
         (exclude (my/docsync--config-file "exclude"))
         (include-mtime (file-attribute-modification-time (file-attributes include)))
         (exclude-mtime (file-attribute-modification-time (file-attributes exclude))))
    (unless (and my/docsync--lists-cache
                 (equal include-mtime (nth 0 my/docsync--lists-cache))
                 (equal exclude-mtime (nth 1 my/docsync--lists-cache)))
      (setq my/docsync--lists-cache
            (list include-mtime exclude-mtime
                  (mapcar #'my/docsync--include-path (my/docsync--list-lines include))
                  (mapcar #'my/docsync--exclude-matcher (my/docsync--list-lines exclude)))))
    (cddr my/docsync--lists-cache)))

(defun my/docsync--excluded-by (file)
  "Return the exclude list entry that leaves FILE out of backups, if any."
  (car (seq-find (lambda (matcher) (string-match-p (cdr matcher) file))
                 (cadr (my/docsync--lists)))))

(defun my/docsync--covering (file)
  "Return the listed path FILE is backed up as part of, if any."
  (seq-find (lambda (path) (string-prefix-p (file-name-as-directory path) file))
            (car (my/docsync--lists))))

(defun my/docsync-state (file)
  "Return how docsync treats FILE.
`listed' when it's in the include list itself, `inherited' when it's
inside a listed directory, `excluded' when it's inside one but an exclude
pattern leaves it out, `partial' for a directory with listed paths inside,
and nil when backups don't touch it."
  (let ((file (directory-file-name (expand-file-name file)))
        (includes (car (my/docsync--lists))))
    (cond ((member file includes) 'listed)
          ((my/docsync--covering file)
           (if (my/docsync--excluded-by file) 'excluded 'inherited))
          ((seq-some (lambda (path) (string-prefix-p (file-name-as-directory file) path))
                     includes)
           'partial))))
#+end_src

** Changing what's backed up
=my/docsync-toggle= is the one to reach for: the marked files (or the one at
point) go onto the include list, or come off it if they're already there.
Something already backed up as part of a listed directory is refused rather
than listed twice, since what's wanted then is the opposite, leaving it out,
which is =my/docsync-toggle-exclude=. That writes one =~/=-anchored path per
line, and only takes back lines of that shape, so a hand-written pattern like
=~/.gnupg/**/*.lock= is never rewritten from here.

Edits keep the files' comments and order, and append rather than sort, so the
lists stay readable as the plain text the script and git see.

After a change the visible Dired windows are only marked for redisplay:
Dirvish renders its attributes as a window is redisplayed, so the markers
catch up without reverting anything.
#+begin_src emacs-lisp
(defun my/docsync--list-entry (file &optional tilde)
  "Return FILE as the lists write it: relative to ~ when it's under it.
With TILDE the relative form starts with ~/, which the exclude list needs
to tell a path from a pattern that matches anywhere."
  (let ((file (directory-file-name (expand-file-name file)))
        (home (file-name-as-directory (expand-file-name "~"))))
    (if (string-prefix-p home file)
        (concat (if tilde "~/" "") (substring file (length home)))
      file)))

(defun my/docsync--edit-list (name add remove)
  "Append the entries ADD to list NAME and drop the lines in REMOVE.
Lines are compared after trimming, and comments are kept."
  (let ((file (my/docsync--config-file name)))
    (with-temp-buffer
      (when (file-exists-p file) (insert-file-contents file))
      (goto-char (point-min))
      (while (not (eobp))
        (if (member (string-trim (buffer-substring (line-beginning-position)
                                                   (line-end-position)))
                    remove)
            (delete-region (line-beginning-position)
                           (min (point-max) (1+ (line-end-position))))
          (forward-line 1)))
      (goto-char (point-max))
      (unless (or (bobp) (eq (char-before) ?\n)) (insert "\n"))
      (dolist (entry add) (insert entry "\n"))
      (make-directory (file-name-directory file) t)
      (write-region nil nil file nil 'silent)))
  (setq my/docsync--lists-cache nil)
  (my/docsync--redraw)
  (my/docsync--schedule-scan))

(defun my/docsync--redraw ()
  "Redraw the visible Dired windows and mode lines, whose markers may be stale.
Dirvish renders its attributes as a window is redisplayed, so marking the
windows for redisplay is enough; nothing needs reverting."
  (dolist (window (window-list-1 nil 'nomini 'visible))
    (when (with-current-buffer (window-buffer window) (derived-mode-p 'dired-mode))
      (force-window-update window)))
  (force-mode-line-update t))

(defun my/docsync--marked-files ()
  "Return the marked files in this Dired buffer, or the one at point."
  (or (dired-get-marked-files nil nil nil nil t)
      (user-error "No file on this line")))

(defun my/docsync-toggle (files)
  "Start or stop backing up FILES, the marked files or the one at point.
Files that are already listed come off the include list, and the rest go
on it.  A file only backed up as part of a listed directory stays put:
leaving it out is `my/docsync-toggle-exclude's job."
  (interactive (list (my/docsync--marked-files)) dired-mode)
  (let (add remove)
    (dolist (file files)
      (pcase (my/docsync-state file)
        ('listed (push (directory-file-name (expand-file-name file)) remove))
        ((or 'inherited 'excluded)
         (user-error "%s is backed up as part of %s; use exclude to leave it out"
                     (abbreviate-file-name file)
                     (abbreviate-file-name (my/docsync--covering file))))
        (_ (push file add))))
    (my/docsync--edit-list
     "include"
     (mapcar #'my/docsync--list-entry (nreverse add))
     ;; An entry can be written several ways (~/Documents, Documents,
     ;; /home/.../Documents), so drop whichever lines resolve to the file.
     (seq-filter (lambda (line) (member (my/docsync--include-path line) remove))
                 (my/docsync--list-lines (my/docsync--config-file "include"))))
    (message "docsync: %s"
             (string-join
              (delq nil (list (and add (format "backing up %d more" (length add)))
                              (and remove (format "no longer backing up %d" (length remove)))))
              ", "))))

(defun my/docsync-toggle-exclude (files)
  "Leave FILES out of backups, or put them back if they're left out.
FILES are the marked files or the one at point, and must be inside a
listed directory.  Only exclusions this command wrote (one path per line)
can be taken back here; one from a wider pattern has to be edited in the
list itself."
  (interactive (list (my/docsync--marked-files)) dired-mode)
  (let (add remove)
    (dolist (file files)
      (let ((entry (my/docsync--list-entry file t)))
        (pcase (my/docsync-state file)
          ('inherited (push entry add))
          ('excluded
           (let ((by (my/docsync--excluded-by
                      (directory-file-name (expand-file-name file)))))
             (unless (equal by entry)
               (user-error "%s is left out by the pattern %s in the exclude list"
                           (abbreviate-file-name file) by))
             (push entry remove)))
          (_ (user-error "%s isn't inside a backed-up directory"
                         (abbreviate-file-name file))))))
    (my/docsync--edit-list "exclude" (nreverse add) remove)
    (message "docsync: %s"
             (string-join
              (delq nil (list (and add (format "leaving out %d" (length add)))
                              (and remove (format "backing up %d again" (length remove)))))
              ", "))))

(defun my/docsync-edit-include ()
  "Open docsync's include list."
  (interactive)
  (find-file (my/docsync--config-file "include")))

(defun my/docsync-edit-exclude ()
  "Open docsync's exclude list."
  (interactive)
  (find-file (my/docsync--config-file "exclude")))

(defun my/docsync-list ()
  "Show every listed path in one Dired buffer."
  (interactive)
  (let ((paths (seq-filter #'file-exists-p (car (my/docsync--lists)))))
    (unless paths (user-error "docsync: nothing is listed"))
    (my/dirvish-reusing-window
      (dired (cons "/" paths)))
    (rename-buffer "*docsync paths*" t)))
#+end_src

** What's changed since the last snapshot
After every backup the script writes =~/.local/state/docsync/manifest=: each
path in the new snapshot with its type, size and modification time, straight
from =restic ls=. Comparing that with the disk needs neither the repository nor
the network. =find= lists the backed-up trees with the same three facts
(skipping excluded directories whole where the pattern is a plain path), and a
file is changed when its size or modification time differs, new when the
snapshot doesn't have it, and deleted when only the snapshot does, which is
the test restic itself uses to decide what to read again. Every directory
above a difference counts as changed too, so a folder's marker says whether
anything inside it is waiting for the next backup.

The comparison reruns every 30 seconds while a Dired window is on screen, a
second after saving a backed-up file, after the lists change, and as soon as a
backup has rewritten the manifest. =find= runs in the background, and when its
listing is byte for byte the last one, against the same manifest and lists,
nothing else happens, so the usual rescan costs one =find= and a string
comparison.

Modification times keep their nanoseconds on both sides. That takes the second
argument to =parse-iso8601-time-string=; without it every file saved with
sub-second precision looked changed.
#+begin_src emacs-lisp
(autoload 'parse-iso8601-time-string "parse-time")

(defvar my/docsync--manifest-cache nil
  "(MTIME SNAPSHOT TABLE) for the manifest as last read.")

(defun my/docsync--unescape-tsv (field)
  "Undo jq's @tsv escaping in FIELD."
  (if (not (string-search "\\" field))
      field
    (replace-regexp-in-string
     "\\\\\\(.\\)"
     (lambda (match)
       (pcase (match-string 1 match) ("t" "\t") ("n" "\n") ("r" "\r") (char char)))
     field t t)))

(defun my/docsync--manifest ()
  "Return (SNAPSHOT TABLE) for the latest snapshot, re-read when it changes.
SNAPSHOT is its ID, nil before the first backup.  TABLE maps each path
in it to (TYPE SIZE MTIME), TYPE a symbol like `file' or `dir' and MTIME
a float."
  (let* ((file (my/docsync--state-file "manifest"))
         (mtime (file-attribute-modification-time (file-attributes file))))
    (unless (and my/docsync--manifest-cache
                 (equal mtime (car my/docsync--manifest-cache)))
      (let ((table (make-hash-table :test #'equal :size 4096))
            snapshot)
        (when mtime
          (with-temp-buffer
            (insert-file-contents file)
            (goto-char (point-min))
            (when (looking-at "# snapshot \\([0-9a-f]+\\)")
              (setq snapshot (match-string 1)))
            (while (re-search-forward
                    "^\\([a-z]+\\)\t\\([0-9]+\\)\t\\([^\t\n]+\\)\t\\(.*\\)$" nil t)
              (puthash (my/docsync--unescape-tsv (match-string 4))
                       (list (intern (match-string 1))
                             (string-to-number (match-string 2))
                             ;; t keeps the nanoseconds, which restic records
                             (float-time (parse-iso8601-time-string (match-string 3) t)))
                       table))))
        (setq my/docsync--manifest-cache (list mtime snapshot table))))
    (cdr my/docsync--manifest-cache)))

(defvar my/docsync--changes nil
  "Paths that differ from the latest snapshot, nil until first compared.
A hash table from path to `changed', `new' or `deleted'.")

(defvar my/docsync--changed-dirs nil
  "Hash table of every directory above a path in `my/docsync--changes'.")

(defvar my/docsync--last-compared nil
  "(LISTING MANIFEST LISTS) from the last comparison, to skip repeating it.")

(defvar my/docsync--scanned-manifest nil
  "The manifest's modification time when the last comparison started.")

(defvar my/docsync--scan-process nil
  "The running `find' behind `my/docsync-scan', if any.")

(defvar my/docsync--scan-again nil
  "Non-nil when a comparison was asked for while one was running.")

(defvar my/docsync--scan-timer nil
  "Pending timer from `my/docsync--schedule-scan'.")

(defun my/docsync--schedule-scan (&optional delay)
  "Compare with the latest snapshot in DELAY seconds (default 1).
Calls arriving while one is pending fold into it."
  (unless my/docsync--scan-timer
    (setq my/docsync--scan-timer
          (run-at-time (or delay 1) nil
                       (lambda ()
                         (setq my/docsync--scan-timer nil)
                         (my/docsync-scan))))))

(defun my/docsync--check-manifest ()
  "Schedule a comparison if a backup has rewritten the manifest since the last."
  (unless (equal (file-attribute-modification-time
                  (file-attributes (my/docsync--state-file "manifest")))
                 my/docsync--scanned-manifest)
    (my/docsync--schedule-scan 0)))

(defun my/docsync--prune-paths (excludes)
  "Return the absolute paths among EXCLUDES that need no glob matching.
`find' can skip these whole, which keeps it out of large left-out trees."
  (let ((home (file-name-as-directory (expand-file-name "~"))))
    (seq-keep (lambda (matcher)
                (let ((entry (car matcher)))
                  (when (string-prefix-p "~/" entry)
                    (setq entry (concat home (substring entry 2))))
                  (and (string-prefix-p "/" entry)
                       (not (string-match-p "[*?[]" entry))
                       (directory-file-name entry))))
              excludes)))

(defun my/docsync-scan ()
  "Compare the backed-up files with the latest snapshot, in the background.
`find' lists them with their sizes and modification times, which is all
local and takes well under a second; the comparison with the manifest
happens when it's done, and redraws the markers."
  (interactive)
  (if (process-live-p my/docsync--scan-process)
      (setq my/docsync--scan-again t)
    (pcase-let* ((`(,includes ,excludes) (my/docsync--lists))
                 (roots (seq-filter #'file-exists-p includes))
                 (prunes (my/docsync--prune-paths excludes))
                 (output (generate-new-buffer " *docsync-scan*"))
                 (errors (generate-new-buffer " *docsync-scan-errors*")))
      (setq my/docsync--scanned-manifest
            (file-attribute-modification-time
             (file-attributes (my/docsync--state-file "manifest"))))
      (if (null roots)
          (progn (kill-buffer output) (kill-buffer errors)
                 (my/docsync--compare nil nil))
        (setq my/docsync--scan-process
              (make-process
               :name "docsync-scan" :buffer output :stderr errors
               :connection-type 'pipe :noquery t
               :command `("find" ,@roots
                          ,@(when prunes
                              `("(" ,@(cdr (mapcan (lambda (path) (list "-o" "-path" path))
                                                   prunes))
                                ")" "-prune" "-o"))
                          "-printf" "%y\t%s\t%T@\t%p\\0")
               :sentinel
               (lambda (process _event)
                 (unless (process-live-p process)
                   (when (buffer-live-p errors) (kill-buffer errors))
                   (let ((listing (with-current-buffer output (buffer-string))))
                     (kill-buffer output)
                     (my/docsync--compare roots listing))
                   (when my/docsync--scan-again
                     (setq my/docsync--scan-again nil)
                     (my/docsync--schedule-scan 0))))))))))

(defun my/docsync--compare (roots listing)
  "Compare `find' LISTING of ROOTS with the manifest and redraw the markers.
A file is changed when its size or modification time differs from the
snapshot's, which is how restic itself decides what to read again, new
when the snapshot lacks it, and deleted when only the snapshot has it.
Most rescans find nothing new, so an identical listing against the same
manifest and lists returns at once."
  (let ((key (list listing (my/docsync--manifest) (my/docsync--lists))))
    (unless (and my/docsync--changes
                 (equal (car key) (car my/docsync--last-compared))
                 (eq (nth 1 key) (nth 1 my/docsync--last-compared))
                 (eq (nth 2 key) (nth 2 my/docsync--last-compared)))
      (setq my/docsync--last-compared key)
      (my/docsync--compare-1 roots listing))))

(defun my/docsync--compare-1 (roots listing)
  "Do the comparison `my/docsync--compare' describes."
  (let ((manifest (cadr (my/docsync--manifest)))
        (changes (make-hash-table :test #'equal))
        (dirs (make-hash-table :test #'equal))
        (seen (make-hash-table :test #'equal :size 4096)))
    (dolist (record (and listing (split-string listing "\0" t)))
      (let* ((fields (split-string record "\t"))
             (type (nth 0 fields))
             (size (string-to-number (nth 1 fields)))
             (mtime (string-to-number (nth 2 fields)))
             (path (string-join (nthcdr 3 fields) "\t"))
             (was (gethash path manifest)))
        (unless (or (member type '("s" "p")) (my/docsync--excluded-by path))
          (puthash path t seen)
          (cond ((null was) (puthash path 'new changes))
                ((equal type "d")
                 (unless (eq (car was) 'dir) (puthash path 'changed changes)))
                ((not (and (eq (car was) (if (equal type "l") 'symlink 'file))
                           (or (equal type "l") (= size (nth 1 was)))
                           (< (abs (- mtime (nth 2 was))) 1e-5)))
                 (puthash path 'changed changes))))))
    (maphash (lambda (path _)
               (when (and (not (gethash path seen))
                          (seq-some (lambda (root)
                                      (or (equal path root)
                                          (string-prefix-p (file-name-as-directory root) path)))
                                    roots)
                          (not (my/docsync--excluded-by path)))
                 (puthash path 'deleted changes)))
             manifest)
    (maphash (lambda (path _)
               (let ((dir path))
                 (while (not (equal dir "/"))
                   (setq dir (directory-file-name (file-name-directory dir)))
                   (if (gethash dir dirs) (setq dir "/") (puthash dir t dirs)))))
             changes)
    (setq my/docsync--changes changes
          my/docsync--changed-dirs dirs)
    (my/docsync--redraw)))

(defun my/docsync-file-status (file)
  "Return FILE's backup status, the key for its marker.
`saved' when it's backed up and the same as in the latest snapshot,
`changed' when it differs (for a directory, when anything inside does),
`new' when the latest snapshot doesn't have it yet, `partial-saved' or
`partial-changed' for a directory with backed-up paths inside it,
`excluded' when an exclude pattern leaves it out, and nil when backups
don't touch it.  `unknown' until the first comparison is done."
  (let* ((file (directory-file-name (expand-file-name file)))
         (state (my/docsync-state file)))
    (cond ((memq state '(nil excluded)) state)
          ((null my/docsync--changes) 'unknown)
          ((eq state 'partial)
           (if (gethash file my/docsync--changed-dirs) 'partial-changed 'partial-saved))
          ((eq (gethash file my/docsync--changes) 'new) 'new)
          ((or (gethash file my/docsync--changes)
               (gethash file my/docsync--changed-dirs))
           'changed)
          (t 'saved))))

(defun my/docsync-list-changes ()
  "Show what the next backup will pick up, in one Dired buffer.
A new directory is listed instead of everything in it.  Deletions can't
be listed, so they're only counted."
  (interactive)
  (unless my/docsync--changes
    (user-error "docsync: still comparing with the latest snapshot"))
  (let (paths (deleted 0))
    (maphash (lambda (path kind)
               (cond ((eq kind 'deleted) (setq deleted (1+ deleted)))
                     ((not (eq (gethash (directory-file-name (file-name-directory path))
                                        my/docsync--changes)
                               'new))
                      (push path paths))))
             my/docsync--changes)
    (if (null paths)
        (message "docsync: nothing changed since the latest snapshot%s"
                 (if (> deleted 0) (format " but %d deletion(s)" deleted) ""))
      (my/dirvish-reusing-window
        (dired (cons "/" (sort paths #'string<))))
      (rename-buffer "*docsync changes*" t)
      (when (> deleted 0)
        (message "docsync: also %d deletion(s), not listed" deleted)))))

(defvar my/docsync--poll-timer
  (run-with-timer 30 30 (lambda ()
                          (when (seq-some (lambda (window)
                                            (with-current-buffer (window-buffer window)
                                              (derived-mode-p 'dired-mode)))
                                          (window-list-1 nil 'nomini 'visible))
                            (my/docsync-scan))))
  "Compares with the latest snapshot every 30 seconds while Dired is on screen.")

(add-hook 'after-save-hook
          (lambda ()
            (when (and buffer-file-name
                       (memq (my/docsync-state buffer-file-name) '(listed inherited)))
              (my/docsync--schedule-scan))))
#+end_src

** In Dirvish
Each file line gets a marker in a narrow column on the right:

| =✓= | backed up, and the same as in the latest snapshot              |
| =●= | changed since; for a directory, something inside changed or went |
| =+= | new since the latest snapshot                                  |
| =◐= | a directory with backed-up paths inside, green or orange alike |
| =✕= | left out by an exclude pattern                                 |

Lines backups don't touch get blanks, so the size column stays aligned, and
=·= stands in until the first comparison finishes.

The mode line says how long ago the last snapshot landed, from the script's
state files rather than the repository, then how many files differ from it.
The age stays plain while backups are landing and turns =warning= or =error=
once they aren't, with the last run's own words in its tooltip.
#+begin_src emacs-lisp
(defvar my/docsync--last-cache nil
  "(MTIME . (SUCCESS STATUS MESSAGE)) as last read from the state files.")

(defun my/docsync-last-backup ()
  "Return (SUCCESS STATUS MESSAGE) from docsync's state files, or nil.
SUCCESS is the epoch of the last saved snapshot (nil if never), STATUS
the last run's outcome as a symbol (ok, warning, offline or error), and
MESSAGE what it said about it."
  (let* ((result (my/docsync--state-file "last-result"))
         (mtime (file-attribute-modification-time (file-attributes result))))
    (unless (and mtime (equal mtime (car my/docsync--last-cache)))
      (setq my/docsync--last-cache
            (cons mtime
                  (when-let* ((line (car (my/docsync--list-lines result)))
                              (fields (split-string line " " t))
                              ((cdr fields)))
                    (let ((success (car (my/docsync--list-lines
                                         (my/docsync--state-file "last-success")))))
                      (list (and success (string-to-number success))
                            (intern (nth 1 fields))
                            (string-join (nthcdr 2 fields) " ")))))))
    (cdr my/docsync--last-cache)))

(defun my/docsync--age (seconds)
  "Return SECONDS as a short age: 5m, 3h, 2d."
  (cond ((< seconds 3600) (format "%dm" (/ seconds 60)))
        ((< seconds 172800) (format "%dh" (/ seconds 3600)))
        (t (format "%dd" (/ seconds 86400)))))

(defun my/docsync-mode-line ()
  "Return a short mode line note of when docsync last backed up.
It's plain while backups are landing, in `warning' once the last one is
over two hours old or the last run had trouble, and in `error' after a
failed run or a day without a backup.  After it comes how many files
differ from the latest snapshot, when any do."
  (pcase-let* ((`(,success ,status ,msg) (my/docsync-last-backup))
               (age (and success (- (float-time) success)))
               (changes (and my/docsync--changes
                             (hash-table-count my/docsync--changes))))
    (concat
     " "
     (propertize (if age (concat "backup " (my/docsync--age (truncate age))) "no backup")
                 'face (cond ((or (not age) (eq status 'error) (> age 86400)) 'error)
                             ((or (memq status '(warning offline)) (> age 7200)) 'warning))
                 'help-echo (format "docsync: last run %s%s" status
                                    (if (string-empty-p (or msg "")) "" (concat ": " msg))))
     (if (and changes (> changes 0))
         (propertize (format " · %d changed" changes) 'face 'my/docsync-changed
                     'help-echo "Files that differ from the latest snapshot")
       "")
     " ")))
#+end_src

#+begin_src emacs-lisp
(defface my/docsync-saved '((t :inherit success))
  "Face for a backed-up path that hasn't changed since the latest snapshot.")

(defface my/docsync-changed '((t :inherit warning))
  "Face for a backed-up path that differs from the latest snapshot.")

(defface my/docsync-excluded '((t :inherit shadow))
  "Face for a path an exclude pattern leaves out.")

(defvar my/docsync-markers
  '((saved "✓" . my/docsync-saved)
    (changed "●" . my/docsync-changed)
    (new "+" . my/docsync-changed)
    (partial-saved "◐" . my/docsync-saved)
    (partial-changed "◐" . my/docsync-changed)
    (excluded "✕" . my/docsync-excluded)
    (unknown "·" . my/docsync-excluded))
  "Marker and face for each `my/docsync-file-status'.")

(after! dirvish
  (dirvish-define-attribute docsync
    "Whether this file is backed up and changed since; see `my/docsync-markers'."
    :right 2
    :when (not (dirvish-prop :remote))
    :setup (progn (my/docsync--lists) (my/docsync--check-manifest))
    (let* ((marker (alist-get (my/docsync-file-status f-name) my/docsync-markers))
           (str (concat " " (or (car marker) " "))))
      (add-face-text-property 0 (length str) (or hl-face (cdr marker) 'default) t str)
      `(right . ,str)))

  (dirvish-define-mode-line docsync
    "When docsync last backed up."
    (my/docsync-mode-line))

  (add-to-list 'dirvish-attributes 'docsync t)
  (unless (memq 'docsync (plist-get dirvish-mode-line-format :right))
    (setq dirvish-mode-line-format
          (plist-put dirvish-mode-line-format :right
                     (cons 'docsync (plist-get dirvish-mode-line-format :right))))))
#+end_src

** Running it
Both commands stream the script's output into =*docsync*= at the bottom of the
frame. Restic only prints a summary when its output isn't a terminal, so
there's nothing to redraw and a plain process buffer does.
#+begin_src emacs-lisp
(defun my/docsync--show (&rest args)
  "Run docsync with ARGS in the *docsync* buffer, shown at the bottom."
  (let ((buffer (get-buffer-create "*docsync*")))
    (when (get-buffer-process buffer)
      (user-error "docsync is already running in *docsync*"))
    (with-current-buffer buffer
      (special-mode)
      (let ((inhibit-read-only t)) (erase-buffer)))
    (make-process
     :name "docsync" :buffer buffer :connection-type 'pipe
     :command (cons (my/program "docsync") args)
     :filter (lambda (process string)
               (when (buffer-live-p (process-buffer process))
                 (with-current-buffer (process-buffer process)
                   (let ((inhibit-read-only t))
                     (save-excursion (goto-char (point-max)) (insert string))))))
     :sentinel (lambda (process event)
                 (unless (process-live-p process)
                   (message "docsync %s: %s" (car args) (string-trim event))
                   (my/docsync--check-manifest))))
    (display-buffer buffer '((display-buffer-reuse-window display-buffer-at-bottom)
                             (window-height . 12)))))

(defun my/docsync-backup-now ()
  "Take a backup now instead of waiting for the hourly timer."
  (interactive)
  (my/docsync--show "backup"))

(defun my/docsync-status ()
  "Show when docsync last backed up, and its latest snapshots."
  (interactive)
  (my/docsync--show "status"))
#+end_src

** Going back in time
Restoring goes through =restic mount=, which serves every snapshot as a
read-only directory under =$XDG_RUNTIME_DIR/docsync=. That makes old versions
ordinary files: =ediff= compares them, Dired browses them, and =C= copies a
deleted file back out. The mount is started the first time it's wanted and
left up until =my/docsync-unmount= or Emacs exits; =--no-lock= keeps it from
holding off the weekly prune.

=my/docsync-versions= lists a file's distinct versions, telling them apart by
size and modification time (which restic keeps), each labelled with the first
snapshot that has it. =my/docsync-browse= opens the current directory as it was
in a chosen snapshot, walking up to the nearest parent that existed then.

VC is told to stay out of the mount, since it holds copies of Git repositories
(=~/Documents/org=) that it would otherwise try to inspect on every visit.
#+begin_src emacs-lisp
(defvar my/docsync--mount-process nil
  "The `docsync restic mount' process serving snapshots, while it runs.")

(defvar my/docsync--mount-ready nil
  "Non-nil once `my/docsync--mount-process' has said it's serving.")

(defun my/docsync--mount-directory ()
  "Return where snapshots get mounted."
  (expand-file-name "docsync" (or (getenv "XDG_RUNTIME_DIR") temporary-file-directory)))

(defun my/docsync--with-mount (callback)
  "Call CALLBACK with the snapshot mount's directory, mounting it if needed."
  (let ((dir (my/docsync--mount-directory)))
    (cond
     ((and (process-live-p my/docsync--mount-process) my/docsync--mount-ready)
      (funcall callback dir))
     ((process-live-p my/docsync--mount-process)
      (user-error "docsync: still mounting snapshots, try again in a moment"))
     (t
      (make-directory dir t)
      ;; Clear a mount a crashed Emacs left behind, which would otherwise
      ;; make the directory unusable ("Transport endpoint is not connected").
      (call-process "fusermount3" nil nil nil "-uqz" dir)
      (message "docsync: mounting snapshots...")
      (setq my/docsync--mount-ready nil)
      (let ((buffer (generate-new-buffer " *docsync-mount*")))
        (setq my/docsync--mount-process
              (make-process
               :name "docsync-mount" :buffer buffer :connection-type 'pipe
               :command (list (my/program "docsync") "restic" "mount" "--no-lock" dir)
               :filter (lambda (process string)
                         (with-current-buffer (process-buffer process)
                           (goto-char (point-max))
                           (insert string)
                           (when (and (not my/docsync--mount-ready)
                                      (save-excursion
                                        (goto-char (point-min))
                                        (search-forward "Now serving" nil t)))
                             (setq my/docsync--mount-ready t)
                             (message "docsync: snapshots mounted at %s" dir)
                             (run-at-time 0 nil callback dir))))
               :sentinel (lambda (process _event)
                           (unless (process-live-p process)
                             (unless my/docsync--mount-ready
                               (message "docsync: mounting failed: %s"
                                        (with-current-buffer (process-buffer process)
                                          (car (last (split-string (string-trim (buffer-string))
                                                                   "\n"))))))
                             (setq my/docsync--mount-ready nil)
                             (kill-buffer (process-buffer process)))))))))))

(defun my/docsync-unmount ()
  "Unmount the snapshots."
  (interactive)
  (if (process-live-p my/docsync--mount-process)
      (progn (interrupt-process my/docsync--mount-process)
             (message "docsync: snapshots unmounted"))
    (message "docsync: snapshots aren't mounted")))

(add-hook 'kill-emacs-hook
          (lambda () (when (process-live-p my/docsync--mount-process)
                       (interrupt-process my/docsync--mount-process))))

(defun my/docsync--snapshots (mount)
  "Return the snapshot directory names under MOUNT, newest first."
  (sort (directory-files (expand-file-name "snapshots" mount) nil "\\`[0-9]")
        #'string>))

(defun my/docsync--read (prompt candidates)
  "Read one of CANDIDATES, (LABEL . VALUE) conses, keeping their order.
Return the chosen VALUE."
  (let ((choice (completing-read
                 prompt
                 (lambda (string pred action)
                   (if (eq action 'metadata)
                       '(metadata (display-sort-function . identity))
                     (complete-with-action action candidates string pred)))
                 nil t)))
    (cdr (assoc choice candidates))))

(defun my/docsync--snapshot-label (name)
  "Return snapshot directory NAME as a date and time."
  (if (string-match "\\`\\([0-9-]+\\)T\\([0-9]+:[0-9]+\\)" name)
      (concat (match-string 1 name) " " (match-string 2 name))
    name))

(defun my/docsync--versions (mount file)
  "Return FILE's distinct versions in the snapshots under MOUNT, newest first.
Each is (LABEL . PATH), PATH being that version inside the mount, labelled
with the first snapshot that has it.  Versions differ by size or
modification time, which restic keeps as they were."
  (let ((current (file-attributes file)) (seen nil) (versions nil))
    (dolist (name (reverse (my/docsync--snapshots mount)))
      (let* ((path (concat (expand-file-name name (expand-file-name "snapshots" mount)) file))
             (attrs (file-attributes path)))
        (when attrs
          (let ((key (cons (file-attribute-size attrs)
                           (file-attribute-modification-time attrs))))
            (unless (member key seen)
              (push key seen)
              (push (cons (format "%s  %s, modified %s%s"
                                  (my/docsync--snapshot-label name)
                                  (file-size-human-readable (file-attribute-size attrs))
                                  (format-time-string "%F %R" (cdr key))
                                  (if (and current
                                           (equal key (cons (file-attribute-size current)
                                                            (file-attribute-modification-time current))))
                                      "  (same as now)" ""))
                          path)
                    versions))))))
    versions))

(defun my/docsync-versions (file)
  "Pick an earlier version of FILE from the backups and compare or copy it.
For a directory, open the chosen version of it in Dired instead."
  (interactive (list (or (dired-get-filename nil t) (user-error "No file on this line")))
               dired-mode)
  (let ((file (directory-file-name (expand-file-name file))))
    (unless (memq (my/docsync-state file) '(listed inherited))
      (user-error "%s isn't backed up" (abbreviate-file-name file)))
    (my/docsync--with-mount
     (lambda (mount)
       (let* ((versions (or (my/docsync--versions mount file)
                            (user-error "No backed-up versions of %s yet"
                                        (abbreviate-file-name file))))
              (path (my/docsync--read (format "Version of %s: " (file-name-nondirectory file))
                                      versions)))
         (if (file-directory-p path)
             (my/dirvish-reusing-window (dired path))
           (pcase (read-char-choice
                   (format "%s: [e]diff with now, [o]pen, [c]opy beside it as %s.~DATE~ "
                           (file-name-nondirectory file) (file-name-nondirectory file))
                   '(?e ?o ?c))
             (?e (ediff-files path file))
             (?o (my/dirvish-reusing-window (find-file-read-only path)))
             (?c (let ((copy (format "%s.~%s~" file
                                     (format-time-string
                                      "%Y-%m-%dT%H%M"
                                      (file-attribute-modification-time (file-attributes path))))))
                   (copy-file path copy nil t)
                   (dolist (buffer (dired-buffers-for-dir (file-name-directory file)))
                     (with-current-buffer buffer (revert-buffer)))
                   (message "docsync: copied to %s" (abbreviate-file-name copy)))))))))))

(defun my/docsync-browse ()
  "Open this directory as it was in a chosen snapshot.
Deleted files can be copied back out with the usual Dired commands.  If
the directory didn't exist yet in that snapshot, open the nearest parent
that did."
  (interactive)
  (let ((dir (directory-file-name (expand-file-name default-directory))))
    (my/docsync--with-mount
     (lambda (mount)
       (let* ((snapshots (or (my/docsync--snapshots mount)
                             (user-error "docsync: no snapshots yet")))
              (name (my/docsync--read "Snapshot: "
                                      (mapcar (lambda (name)
                                                (cons (my/docsync--snapshot-label name) name))
                                              snapshots)))
              (root (expand-file-name name (expand-file-name "snapshots" mount)))
              (target dir))
         (while (and (not (file-directory-p (concat root target)))
                     (not (equal target "/")))
           (setq target (directory-file-name (file-name-directory target))))
         (my/dirvish-reusing-window (dired (concat root target))))))))

(after! vc
  ;; Don't have VC look for Git repositories inside the read-only mount.
  (setq vc-ignore-dir-regexp
        (format "%s\\|\\`%s" vc-ignore-dir-regexp
                (regexp-quote (file-name-as-directory (my/docsync--mount-directory))))))
#+end_src

** Keys
Under the Dired local leader, beside the media commands, as =SPC m b=.
#+begin_src emacs-lisp
(map! :map dired-mode-map :localleader
      (:prefix ("b" . "backups")
       :desc "Toggle backing up"   "b" #'my/docsync-toggle
       :desc "Toggle excluding"    "x" #'my/docsync-toggle-exclude
       :desc "Back up now"         "s" #'my/docsync-backup-now
       :desc "Changed since backup" "c" #'my/docsync-list-changes
       :desc "Recheck changes"     "r" #'my/docsync-scan
       :desc "Status"              "i" #'my/docsync-status
       :desc "Versions of this"    "v" #'my/docsync-versions
       :desc "Browse a snapshot"   "t" #'my/docsync-browse
       :desc "Unmount snapshots"   "u" #'my/docsync-unmount
       :desc "List backed-up paths" "l" #'my/docsync-list
       :desc "Edit include list"   "e" #'my/docsync-edit-include
       :desc "Edit exclude list"   "E" #'my/docsync-edit-exclude))
#+end_src

* Media thumbnails
=image-dired= already shows a thumbnail grid for a directory, but only for
image files. =my/media-thumbnails= extends the same grid to videos: image
thumbnails still come from image-dired's own cache, video thumbnails are
made with =ffmpegthumbnailer=, and both kinds are inserted into image-dired's
usual thumbnail buffer. That means the normal image-dired keys (motion,
marking, deleting, jumping back to Dired) work unchanged on both. Opening a
video thumbnail launches an external player instead of trying to inline it
as an image, since RET and C-RET otherwise hand the original file straight
to image display code that only understands images. "q" out of a full-size
image goes back to the grid, landing on the same thumbnail. Plain Dired gets
the same treatment: RET on a video file plays it externally instead of
opening it as text.
#+begin_src emacs-lisp
(defcustom my/media-video-extensions
  '("mp4" "mkv" "webm" "avi" "mov" "m4v" "wmv" "flv" "mpg" "mpeg" "ogv")
  "Video file extensions shown alongside images by `my/media-thumbnails'."
  :type '(repeat string))

(defcustom my/media-video-player (or (executable-find "mpv") "xdg-open")
  "Program used to open video files from the `my/media-thumbnails' grid."
  :type 'string)

(defun my/media--video-p (file)
  "Return non-nil if FILE's extension is one of `my/media-video-extensions'."
  (member (downcase (or (file-name-extension file) "")) my/media-video-extensions))

(defun my/media--file-regexp ()
  "Regexp matching both image and video files."
  (concat (image-dired--file-name-regexp)
          "\\|\\.\\(?:" (mapconcat #'regexp-quote my/media-video-extensions "\\|") "\\)\\'"))

(defun my/media--video-thumbnail-file (file)
  "Return a cached thumbnail image for video FILE, creating it if stale."
  (let* ((cache (expand-file-name "video-thumbs" (image-dired-dir)))
         (thumb (expand-file-name (concat (sha1 (expand-file-name file)) ".jpg") cache))
         (attr (file-attributes thumb)))
    (make-directory cache t)
    (when (or (not attr)
              (time-less-p (file-attribute-modification-time attr)
                           (file-attribute-modification-time (file-attributes file))))
      (unless (zerop (call-process "ffmpegthumbnailer" nil nil nil
                                    "-i" file "-o" thumb "-s"
                                    (number-to-string image-dired-thumb-size)))
        (message "ffmpegthumbnailer failed for %s" file)))
    thumb))

(defun my/media--thumbnail-file (file)
  "Return a thumbnail image for FILE, whether it is an image or a video."
  (if (my/media--video-p file)
      (my/media--video-thumbnail-file file)
    (image-dired--get-create-thumbnail-file file)))

(defun my/media-thumbnails (dir)
  "Show a grid of thumbnails for every image and video in DIR.
Uses `image-dired-thumbnail-mode', so the normal image-dired keys select,
mark, and open thumbnails; opening a video plays it with
`my/media-video-player' instead of displaying it as an image."
  (interactive (list (if (derived-mode-p 'dired-mode)
                         default-directory
                       (read-directory-name "Show thumbnails for directory: "))))
  (require 'image-dired)
  (unless (executable-find "ffmpegthumbnailer")
    (user-error "ffmpegthumbnailer is not installed"))
  (let* ((dir (expand-file-name dir))
         (default-directory dir)
         (files (let ((case-fold-search t))
                  (sort (directory-files dir t (my/media--file-regexp)) #'string-lessp)))
         (dired-buf (dired-noselect dir))
         (buf (image-dired-create-thumbnail-buffer)))
    (unless files
      (user-error "No image or video files in %s" dir))
    (with-current-buffer buf
      (let ((inhibit-read-only t))
        (erase-buffer)
        (setq-local image-dired--number-of-thumbnails (length files))
        (dolist (file files)
          (image-dired-insert-thumbnail (my/media--thumbnail-file file) file dired-buf))))
    ;; Line-up must happen after the buffer is displayed: the dynamic method
    ;; measures the window it is showing in to decide thumbnails per row.
    (pop-to-buffer buf)
    (image-dired--line-up-with-method)
    (image-dired--update-header-line)))

;; RET (`image-dired-display-this') and C-RET
;; (`image-dired-thumbnail-display-external') both hand the *original* file
;; to code that only understands images; send videos to an external player
;; instead.
(defun my/media--play-video-a (orig-fn &rest args)
  "Play FILE with `my/media-video-player' if it looks like a video.
Otherwise call ORIG-FN with ARGS. FILE is either the first of ARGS, as
passed to `image-dired-display-image', or, when ARGS is empty, the file
at point, as used by `image-dired-thumbnail-display-external'."
  (let ((file (or (car args) (image-dired-original-file-name))))
    (if (and file (my/media--video-p file))
        (start-process "my/media-video-player" nil my/media-video-player file)
      (apply orig-fn args))))

;; The thumbnail grid and the single-image display buffer are both popups
;; matched by the same "^\*image-dired" rule in the dired module, so they
;; share a slot: opening an image reuses that window instead of splitting,
;; and the grid isn't shown anywhere any more. `quit-window' is supposed to
;; restore whatever the popup replaced, but that's easy to miss when nothing
;; visibly explains how to get back. Make "q" always and explicitly return
;; to the grid, landing on the same thumbnail, instead of relying on that.
(defun my/media-close-image-display ()
  "Close the image display popup and return to the media thumbnail grid."
  (interactive)
  ;; Plain `quit-window' is what Doom's own `+popup/quit-window' works around:
  ;; on a popup it falls back to `switch-to-prev-buffer', which doesn't know
  ;; about the thumbnail grid buried underneath and lands on Dired instead.
  ;; `+popup/close' with FORCE-P bypasses this popup's `:quit nil' and just
  ;; deletes the window, leaving the grid buffer intact to pop back into.
  (+popup/close nil t)
  (when-let* ((buf (get-buffer image-dired-thumbnail-buffer)))
    (pop-to-buffer buf)))

;; Plain Dired (not just the thumbnail grid above) hands RET on a video file
;; to `dired-find-file', which opens it in a buffer as if it were text.
;; Play it with `my/media-video-player' instead.
(defun my/media--dired-find-file-a (orig-fn &rest args)
  "Play the file at point with `my/media-video-player' if it's a video.
Otherwise call ORIG-FN with ARGS."
  (let ((file (dired-get-filename nil t)))
    (if (and file (my/media--video-p file))
        (start-process "my/media-video-player" nil my/media-video-player file)
      (apply orig-fn args))))

(after! dired
  (advice-add #'dired-find-file :around #'my/media--dired-find-file-a))

(after! image-dired
  (advice-add #'image-dired-display-image :around #'my/media--play-video-a)
  (advice-add #'image-dired-thumbnail-display-external :around #'my/media--play-video-a)
  ;; The dired module tries to put this mode in emacs state via
  ;; `set-evil-initial-state!', so that a plain "q" binding below (rather
  ;; than an evil-state-qualified one) is what fires. But it does so under
  ;; the mode's pre-29.1 name, `image-dired-display-image-mode', which is now
  ;; only an obsolete function alias, not the major mode - the real mode is
  ;; `image-dired-image-mode'. Since that's never registered, Evil falls
  ;; back to its parent `image-mode', which evil-collection registers as
  ;; `normal' state, where its own "q" -> `quit-window' binding on
  ;; `image-mode-map' shadows anything bound below. Re-register under the
  ;; current name to actually get emacs state.
  (set-evil-initial-state! 'image-dired-image-mode 'emacs)
  (map! :map image-dired-image-mode-map "q" #'my/media-close-image-display)
  ;; `image-dired-thumbnail-mode' (the grid itself, not the single-image
  ;; popup above) has no explicit initial state, so it falls back to
  ;; `evil-default-state', which happens to be `normal' - the state
  ;; evil-collection's image-dired bindings need, since those are what
  ;; make motion skip the separator between thumbnails instead of
  ;; stopping on it. That fallback is easy to end up not in, e.g. by
  ;; entering the grid buffer with a visual selection already active
  ;; elsewhere, so pin it explicitly rather than relying on the default
  ;; staying `normal' or every entry path leaving the buffer in it.
  (set-evil-initial-state! 'image-dired-thumbnail-mode 'normal))

(map! :map dired-mode-map :localleader "m" #'my/media-thumbnails)
#+end_src

** Slideshow
Plays every image/video file listed in the current Dired buffer with mpv -
marked files if any are marked, otherwise everything in the buffer. That
"everything in the buffer" set comes from walking the buffer's lines rather
than re-reading =default-directory=, so it works the same in a TMSU query
results buffer (whose entries are whatever the query matched, not one
directory's contents) as in plain Dired.
#+begin_src emacs-lisp
(defcustom my/media-slideshow-image-duration 5
  "Seconds each image is shown for during `my/media-slideshow'."
  :type 'number)

(defun my/media--dired-buffer-files ()
  "Return every file listed in the current Dired buffer, marked or not."
  (save-excursion
    (goto-char (point-min))
    (let (files)
      (while (not (eobp))
        (when-let* ((file (dired-get-filename nil t)))
          (push file files))
        (forward-line 1))
      (nreverse files))))

(defun my/media-slideshow (&optional shuffle)
  "Play every image/video file in the current Dired buffer with mpv.
Uses the marked files if any are marked, otherwise every media file listed
in the buffer. With a prefix argument SHUFFLE, play them in random order."
  (interactive "P" dired-mode)
  (unless (executable-find "mpv")
    (user-error "mpv not found"))
  (require 'image-dired)
  (let* ((marked (dired-get-marked-files nil 'marked))
         ;; Built once: `my/media--file-regexp' runs `regexp-opt' every
         ;; time, which across a few thousand files of a big TMSU query
         ;; added up to most of a second.
         (regexp (my/media--file-regexp))
         (case-fold-search t)
         (files (seq-filter (lambda (file) (string-match-p regexp file))
                            (or marked (my/media--dired-buffer-files)))))
    (unless files
      (user-error "No image or video files %s" (if marked "marked" "in buffer")))
    (apply #'start-process "my/media-slideshow" nil "mpv"
           "--fullscreen"
           ;; Overrides this user's `loop-file=inf' in mpv.conf, which
           ;; otherwise loops the first file forever and never advances.
           "--loop-file=no"
           (format "--image-display-duration=%s" my/media-slideshow-image-duration)
           "--loop-playlist"
           (append (when shuffle '("--shuffle"))
                   files))))

(defun my/media-slideshow-shuffle ()
  "Like `my/media-slideshow', but play files in random order."
  (interactive nil dired-mode)
  (my/media-slideshow t))

(map! :map dired-mode-map :localleader
      "s" #'my/media-slideshow
      "S" #'my/media-slideshow-shuffle)
#+end_src

** Collage
Builds a single masonry-style collage image from the current Dired buffer
with =imgcollage= (in [[file:bin/][bin/]], which needs Python and Pillow). Like [[*Slideshow][Slideshow]] above, it uses the marked files if any are marked,
otherwise every file listed in the buffer via `my/media--dired-buffer-files',
so it works the same on a TMSU query results buffer as on plain Dired.
Non-image files among them are silently skipped by =imgcollage= itself.
#+begin_src emacs-lisp
(defun my/media-collage (output)
  "Build a masonry collage from the current Dired buffer's files with imgcollage.
Uses the marked files if any are marked, otherwise every file listed in the
buffer. Prompts for OUTPUT, defaulting to a throwaway name under
`temporary-file-directory' since most collages are just for a quick look,
not a keeper -- edit the prompt to save somewhere permanent instead. Writes
the result to OUTPUT, then takes over the frame to show it: the window
layout Dired had (Dirvish's preview pane included) is saved
before switching away, and restored, along with killing the image buffer,
when `q' is pressed -- bound buffer-locally, as `my/tmsu-dired-query-quit'
binds its own `q', since image-mode is shared with every other image Emacs
displays and a mode-wide rebind would affect all of them."
  (interactive
   (list (read-file-name
          "Collage output: " temporary-file-directory nil nil
          (concat (make-temp-name (expand-file-name "collage-" temporary-file-directory))
                  ".jpg")))
   dired-mode)
  (let* ((program (my/program "imgcollage"))
         (marked (dired-get-marked-files nil 'marked))
         (files (or marked (my/media--dired-buffer-files)))
         (config (current-window-configuration)))
    (unless files
      (user-error "No files %s" (if marked "marked" "in buffer")))
    (let ((buf (get-buffer-create "*imgcollage*")))
      (with-current-buffer buf (erase-buffer))
      (make-process
       :name "imgcollage" :buffer buf
       :command (append (list program) files (list "-o" (expand-file-name output)))
       :sentinel
       (lambda (proc _event)
         (when (memq (process-status proc) '(exit signal))
           (if (zerop (process-exit-status proc))
               (progn
                 (message "imgcollage: wrote %s" output)
                 (my/dirvish-reusing-window
                   (delete-other-windows)
                   (find-file output))
                 (let ((ibuf (current-buffer)))
                   (evil-local-set-key
                    'normal "q"
                    (lambda ()
                      (interactive)
                      (kill-buffer ibuf)
                      (set-window-configuration config)))))
             (progn (message "imgcollage failed, see %s" (buffer-name buf))
                    (my/dirvish-reusing-window (pop-to-buffer buf)))))))
      (message "imgcollage: building collage from %d file(s)..." (length files)))))

(map! :map dired-mode-map :localleader "c" #'my/media-collage)
#+end_src

* Movie grid
A grid of movie posters pulled from a local [[https://radarr.video][Radarr]] (a movie library
manager), living in its own file, =movie-grid.el=, which doesn't tangle from
here. =my/movie-grid-radarr-url= points at it. Built on [[*Media thumbnails][Media thumbnails]] above: each poster is inserted as an
=image-dired= thumbnail whose "original file" is the movie's actual
video file rather than the poster, so the existing advice that sends
video files to mpv on RET/SPC/C-RET fires unchanged, and grid
navigation, marking, and "q" to close all come from image-dired for
free. The API key is read from the =pass= entry
=my/movie-grid-radarr-api-key-entry= (=radarr= by default), so it never
sits in the config.
#+begin_src emacs-lisp
(load! "movie-grid")

(map! :leader :desc "Movie grid" "o M" #'my/movie-grid)
#+end_src

* Synth
=my/synth-play-notes= plays a sequence of MIDI note numbers through a
persistent fluidsynth process: fluidsynth is started once, in its normal
interactive-shell mode (=fluidsynth soundfont.sf2=, no =-i=), and kept alive
between calls, with notes sent to it as ordinary shell commands
(=noteon=/=noteoff=) over its stdin pipe. Timing uses ~run-at-time~ rather
than blocking Emacs, so playback doesn't freeze the UI. The matrix buttons in
[[*Music theory][Music theory]] below are the first caller; anything else
that wants to make a sound -- an ear-trainer, a metronome -- can call
~my/synth-play-notes~ directly.

Requires fluidsynth and a General MIDI SoundFont, such as FluidR3
(=soundfont-fluid= on Arch, =fluid-soundfont-gm= on Debian and Ubuntu).
#+begin_src emacs-lisp
(defcustom my/synth-soundfont
  (seq-find #'file-exists-p '("/usr/share/soundfonts/FluidR3_GM.sf2"
                               "/usr/share/sounds/sf2/FluidR3_GM.sf2"))
  "SoundFont file fluidsynth loads."
  :type '(choice file (const nil)))

(defcustom my/synth-audio-driver "pulseaudio"
  "Audio driver fluidsynth is started with; see `fluidsynth -a help'."
  :type 'string)

(defcustom my/synth-gain 0.6
  "Master gain fluidsynth is started with, 0 < gain < 10."
  :type 'number)

(defcustom my/synth-program 0
  "General MIDI program number (0-127) notes are played on."
  :type 'integer)

(defcustom my/synth-note-duration 0.32
  "Seconds each note in `my/synth-play-notes' occupies, attack to attack."
  :type 'number)

(defvar my/synth--process nil
  "The persistent fluidsynth process notes are sent to.")

(defvar my/synth--timers nil
  "Pending `run-at-time' timers for in-flight `my/synth-play-notes' playback.")

(defun my/synth--send (process command)
  "Send COMMAND, a fluidsynth shell command, to PROCESS if it's still alive."
  (when (process-live-p process)
    (process-send-string process command)))

(defun my/synth--ensure-process ()
  "Return a live fluidsynth process fed via its stdin shell, starting one if needed."
  (unless (process-live-p my/synth--process)
    (unless (executable-find "fluidsynth")
      (user-error "fluidsynth is not installed"))
    (unless (and my/synth-soundfont (file-exists-p my/synth-soundfont))
      (user-error "my/synth-soundfont is unset or missing: %s" my/synth-soundfont))
    (setq my/synth--process
          (make-process
           :name "synth" :buffer "*synth*" :connection-type 'pipe :noquery t
           :command (list "fluidsynth" "-a" my/synth-audio-driver "-n" "-q"
                          "-g" (number-to-string my/synth-gain)
                          my/synth-soundfont))))
  my/synth--process)

(defun my/synth-stop ()
  "Cancel any pending `my/synth-play-notes' playback and silence the synth."
  (interactive)
  (mapc #'cancel-timer my/synth--timers)
  (setq my/synth--timers nil)
  (my/synth--send my/synth--process "cc 0 123 0\n"))

(defun my/synth-play-notes (notes &optional duration)
  "Play NOTES in sequence, one every DURATION seconds (`my/synth-note-duration'
by default). Each element is a MIDI note number 0-127, or nil for a rest.
Cancels any playback already in flight."
  (my/synth-stop)
  (let ((process (my/synth--ensure-process))
        (duration (or duration my/synth-note-duration))
        (i 0))
    (my/synth--send process (format "prog 0 %d\n" my/synth-program))
    (dolist (note notes)
      (when note
        (let ((start (* i duration)))
          (push (run-at-time start nil
                              (lambda ()
                                (my/synth--send process (format "noteon 0 %d 100\n" note))))
                my/synth--timers)
          (push (run-at-time (+ start (* duration 0.9)) nil
                              (lambda ()
                                (my/synth--send process (format "noteoff 0 %d\n" note))))
                my/synth--timers)))
      (setq i (1+ i)))))

(map! :leader :desc "Stop synth" "o S" #'my/synth-stop)
#+end_src

* Music theory
Pitch classes in the 12-tone helpers count from A = 0. =my/mtheory-respell-scale=
works in letter names and counts from C = 0; the two never mix. Helpers with a
double dash are internal.

The matrix buttons below turn each pitch class into a MIDI note at
~my/mtheory-play-octave~ and hand it to [[*Synth][Synth]].
#+begin_src emacs-lisp
(defun my/mtheory--mod12 (n)
  "Reduce N to a pitch class in 0-11."
  (mod n 12))

(defun my/mtheory--pitch-class-to-note (pc)
  "Convert pitch class PC to a note name, counting from A = 0."
  (nth pc '("A" "Bb" "B" "C" "Db" "D" "Eb" "E" "F" "Gb" "G" "Ab")))

(defun my/mtheory--note-to-pitch-class (note)
  "Convert NOTE name to a pitch class, counting from A = 0."
  (cdr (assoc note
              '(("A" . 0) ("Bb" . 1) ("B" . 2) ("C" . 3)
                ("Db" . 4) ("D" . 5) ("Eb" . 6) ("E" . 7)
                ("F" . 8) ("Gb" . 9) ("G" . 10) ("Ab" . 11)))))

(defun my/mtheory--intervals-to-pitch-classes (intervals root)
  "Generate pitch classes by stacking INTERVALS on ROOT."
  (let ((result (list root))
        (current root))
    (dolist (interval intervals)
      (setq current (+ current interval))
      (push (my/mtheory--mod12 current) result))
    (nreverse result)))

(defcustom my/mtheory-play-octave 4
  "Octave (scientific pitch notation, where C4 = middle C) matrix buttons
and `my/mtheory-play-pitch-classes' play in."
  :type 'integer)

(defun my/mtheory--pitch-class-to-midi (pc)
  "Convert pitch class PC (0-11, counting from A = 0) to a MIDI note number
in `my/mtheory-play-octave'."
  (+ (my/mtheory--mod12 (- pc 3)) (* 12 (1+ my/mtheory-play-octave))))

(defun my/mtheory-play-pitch-classes (pcs)
  "Play PCS, a list of pitch classes (0-11, counting from A = 0), through
`my/synth-play-notes'."
  (my/synth-play-notes (mapcar #'my/mtheory--pitch-class-to-midi pcs)))

;; A dedicated link type rather than a plain `elisp:' link so clicking a
;; matrix button doesn't trigger `org-confirm-elisp-link-function' on every
;; click -- that confirmation gate only guards the built-in "elisp" type.
;; Deferred until org loads: at Doom startup config.el runs before Org is
;; necessarily loaded, and `org-link-set-parameters' is void until then.
(after! org
  (org-link-set-parameters
   "synth"
   :follow (lambda (path &optional _arg) (my/mtheory-play-pitch-classes (read path)))))

(defun my/mtheory-12-tone-matrix (row)
  "Insert the 12-tone matrix of ROW at point as an Org table, with play
buttons on all four sides. ROW is read as a Lisp list of the pitch classes
0-11 in any order.

Each data row is a transposition of ROW read left to right (P); the button
to its left plays it forward, the button to its right plays it backward, the
retrograde (R). Each data column is an inversion (I) read top to bottom; the
button above it plays top-to-bottom, the button below plays bottom-to-top,
the retrograde inversion (RI). Buttons play the matrix as generated -- a
hand-edited cell doesn't change what its row/column buttons play."
  (interactive (list (read (read-string "Row: "))))
  (unless (equal (sort (copy-sequence row) #'<) (number-sequence 0 11))
    (user-error "Row must contain each pitch class 0-11 exactly once"))
  (let* ((p0 (mapcar (lambda (x) (my/mtheory--mod12 (- x (car row)))) row))
         (i0 (mapcar (lambda (x) (my/mtheory--mod12 (- x))) p0))
         (matrix (mapcar (lambda (transposition)
                            (mapcar (lambda (p) (my/mtheory--mod12 (+ p transposition))) p0))
                          i0))
         (columns (mapcar (lambda (j) (mapcar (lambda (r) (nth j r)) matrix))
                           (number-sequence 0 11)))
         (button (lambda (glyph pcs) (format "[[synth:%S][%s]]" pcs glyph)))
         (table-start (point)))
    (insert "|   | "
            (mapconcat (lambda (col) (funcall button "▼" col)) columns " | ")
            " |   |\n")
    (insert "|-\n")
    (dolist (r matrix)
      (insert "| " (funcall button "▶" r) " | "
              (mapconcat #'number-to-string r " | ")
              " | " (funcall button "◀" (reverse r)) " |\n"))
    (insert "|-\n")
    (insert "|   | "
            (mapconcat (lambda (col) (funcall button "▲" (reverse col))) columns " | ")
            " |   |\n")
    (save-excursion (goto-char table-start) (org-table-align))))

(defun my/mtheory-table-to-notes ()
  "Convert the Org table at point from pitch classes to note names. Skips
over any [[synth:...][...]] play buttons, whose link path also holds
digits, so it doesn't rewrite the data those buttons play."
  (interactive)
  (let ((end (copy-marker (org-table-end))))
    (save-excursion
      (goto-char (org-table-begin))
      (while (re-search-forward
              "\\[\\[[^]]*\\]\\[[^]]*\\]\\]\\|\\b\\([0-9]+\\)\\b" end t)
        (when-let* ((group (match-string 1)))
          (let ((pc (string-to-number group)))
            (when (< pc 12)
              (replace-match (my/mtheory--pitch-class-to-note pc) t t nil 1))))))
    (set-marker end nil)
    (org-table-align)))

(defun my/mtheory-table-to-pitch-classes ()
  "Convert the Org table at point from note names to pitch classes. Skips
over any [[synth:...][...]] play buttons the same way
`my/mtheory-table-to-notes' does."
  (interactive)
  (let ((end (copy-marker (org-table-end))))
    (save-excursion
      (goto-char (org-table-begin))
      (while (re-search-forward
              "\\[\\[[^]]*\\]\\[[^]]*\\]\\]\\|\\b\\(A\\|Bb\\|B\\|C\\|Db\\|D\\|Eb\\|E\\|F\\|Gb\\|G\\|Ab\\)\\b"
              end t)
        (when-let* ((group (match-string 1)))
          (replace-match (number-to-string
                          (my/mtheory--note-to-pitch-class group))
                         t t nil 1))))
    (set-marker end nil)
    (org-table-align)))

(defun my/mtheory-intervals-to-notes (intervals)
  "Insert an Org table of the INTERVALS pattern in all 12 keys."
  (interactive (list (read (read-string "Intervals: "))))
  (insert (format "#+TITLE: Intervals %S\n\n" intervals))
  (insert "| Notes |\n")
  (insert "|-------|\n")
  (let ((table-start (point)))
    (dotimes (root 12)
      (insert (format "| %s |\n"
                      (mapconcat #'my/mtheory--pitch-class-to-note
                                 (my/mtheory--intervals-to-pitch-classes intervals root)
                                 " "))))
    (save-excursion
      (goto-char table-start)
      (org-table-align))))

(defun my/mtheory-respell-scale ()
  "Respell a scale so each note uses the next letter name; insert it at point.

Examples:
  G A B C D E Gb   -> G A B C D E F#
  A B Db D E Gb Ab -> A B C# D E F# G#"
  (interactive)
  (let* ((input (read-string "Scale: "))
         (notes (split-string input "[ \t]+" t))
         ;; Pitch class for each accepted spelling.
         (pitch-table
          '(("C" . 0)  ("B#" . 0)
            ("C#" . 1) ("Db" . 1)
            ("D" . 2)
            ("D#" . 3) ("Eb" . 3)
            ("E" . 4)  ("Fb" . 4)
            ("F" . 5)  ("E#" . 5)
            ("F#" . 6) ("Gb" . 6)
            ("G" . 7)
            ("G#" . 8) ("Ab" . 8)
            ("A" . 9)
            ("A#" . 10) ("Bb" . 10)
            ("B" . 11) ("Cb" . 11)))
         ;; Given an expected letter and a pitch class, how should it be spelled?
         (spell-table
          '(("C" . ((0 . "C") (1 . "C#")))
            ("D" . ((2 . "D") (3 . "D#")))
            ("E" . ((4 . "E")))
            ("F" . ((5 . "F") (6 . "F#")))
            ("G" . ((7 . "G") (8 . "G#")))
            ("A" . ((9 . "A") (10 . "A#")))
            ("B" . ((11 . "B")))))
         (next-letter
          '(("A" . "B")
            ("B" . "C")
            ("C" . "D")
            ("D" . "E")
            ("E" . "F")
            ("F" . "G")
            ("G" . "A")))
         (result nil)
         (prev-letter nil))
    (dolist (note notes)
      (let* ((letter (substring note 0 1))
             (pitch (cdr (assoc note pitch-table))))
        (unless pitch
          (user-error "Don't know how to parse note %s" note))
        (if (null prev-letter)
            ;; Keep first note exactly as entered.
            (progn
              (push note result)
              (setq prev-letter letter))
          (let* ((expected (cdr (assoc prev-letter next-letter)))
                 (spelling
                  (or (cdr (assoc pitch (cdr (assoc expected spell-table))))
                      note)))
            (push spelling result)
            (setq prev-letter expected)))))
    (insert (mapconcat #'identity (nreverse result) " "))))
#+end_src

* Notation
LilyPond source blocks render to an image of the score, shown inline:
=#+begin_src lilypond :file motif.svg= around =\relative c' { c4 e g c }=,
then =C-c C-c=. The =:file= extension picks the format -- svg, png, pdf or
eps. SVG is the one to use inline: LilyPond draws it in =currentColor=, so the
notes take the face's foreground and follow auto-dark between gruvbox dark and
light, where PNG is always black on white. Blocks are written with English note
names (=cs=, =bf=) instead of LilyPond's default Dutch (=cis=, =bes=); a
block can switch back with =\language "nederlands"=.

Stock ob-lilypond doesn't work with LilyPond 2.26, so
~my/lilypond--process-basic~ replaces how it renders a block. Stock
ob-lilypond crops the image with page settings written into the file, which
2.26 ignores, so every image came out as a full A4 page with the music in the
corner. The crop is passed as command-line options instead, which do work. Stock
ob-lilypond also can't write SVG at all: =:file x.svg= produced =x.png= and a
broken link. LilyPond logs its progress to stderr and Babel pops up anything
it finds there, so only errors are logged.

Three smaller fixes. ob-lilypond only installs its default header arguments
(=:results file=) while running a block, after that block's arguments were read,
so the first block run in each session came back with an empty =#+RESULTS:=; they
are set up front here. It maps blocks to =LilyPond-mode=, the mode's name before
LilyPond 2.24 renamed it, so =C-c '= and in-buffer highlighting got no mode. And
some distributions (Arch, for one) install LilyPond's Emacs mode into
site-lisp, but nothing loads its
=lilypond-init.el=, so the mode is registered here. Its files predate
lexical-binding cookies, which Emacs 31 warns about in a popup the first time
it loads them; those warnings are still logged to =*Warnings*=, but don't
pop up.
#+begin_src emacs-lisp
(autoload 'lilypond-mode "lilypond-mode" "Major mode for editing LilyPond files." t)
(add-to-list 'auto-mode-alist '("\\.i?ly\\'" . lilypond-mode))

(when-let* ((mode-file (locate-library "lilypond-mode")))
  (dolist (file (directory-files (file-name-directory mode-file) t
                                 "\\`lilypond-.*\\.el\\'"))
    (add-to-list 'warning-suppress-types
                 `(files missing-lexbind-cookie ,(abbreviate-file-name file)))))

(setq org-babel-default-header-args:lilypond
      '((:results . "file") (:exports . "results")))

(defcustom my/lilypond-staff-size 20
  "Staff height, in points, lilypond blocks are engraved at; LilyPond's own
default is 20. A block can override it with #(set-global-staff-size N)."
  :type 'number)

(defcustom my/lilypond-png-resolution 200
  "Resolution, in DPI, lilypond blocks with a .png :file render at."
  :type 'integer)

(defun my/lilypond--preamble ()
  "LilyPond source prepended to every lilypond block: English note names, the
staff size, and no indent, titles, headers or footers."
  (format "\\language \"english\"
#(set-global-staff-size %s)
\\paper {
  indent = 0\\mm
  tagline = ##f
  oddHeaderMarkup = ##f
  evenHeaderMarkup = ##f
  oddFooterMarkup = ##f
  evenFooterMarkup = ##f
  bookTitleMarkup = ##f
  scoreTitleMarkup = ##f
}
" my/lilypond-staff-size))

(defun my/lilypond--process-basic (body params)
  "Render lilypond block BODY to its :file, cropped to the music.
Overrides `org-babel-lilypond-process-basic'. The :file extension picks the
format: svg, png, pdf or eps."
  (let* ((out-file (or (cdr (assq :file params))
                       (user-error "lilypond blocks need a :file header argument")))
         (type (downcase (or (file-name-extension out-file) "")))
         (in-file (org-babel-temp-file "lilypond-" ".ly")))
    (with-temp-file in-file
      (insert (my/lilypond--preamble)
              (org-babel-expand-body:lilypond body params)))
    (org-babel-eval
     (string-join
      (list org-babel-lilypond-ly-command
            "--loglevel=ERROR"
            "-dno-use-paper-size-for-page"
            (concat "-dtall-page-formats=" type)
            (pcase type
              ("svg" "-dbackend=svg")
              ("png" (format "--png -dresolution=%d" my/lilypond-png-resolution))
              ("pdf" "--pdf")
              ("eps" "--eps")
              (_ (user-error "Can't render lilypond to .%s; use svg, png, pdf or eps"
                             type)))
            (concat "--output="
                    (shell-quote-argument (file-name-sans-extension out-file)))
            (or (cdr (assq :cmdline params)) "")
            (shell-quote-argument in-file))
      " ")
     "")
    nil))

(after! ob-lilypond
  (setf (alist-get "lilypond" org-src-lang-modes nil nil #'equal) 'lilypond)
  (advice-add 'org-babel-lilypond-process-basic :override
              #'my/lilypond--process-basic))
#+end_src

* Jabber
=C-x C-j= shadows =dired-jump=, which Doom also offers as =SPC o -=. The
disconnect-at-exit hook is added only once jabber has loaded, so quitting Emacs
never loads jabber just to disconnect nothing. =jabber-connect-all= is
autoloaded, so calling it from =doom-after-init-hook= is what actually loads
jabber (and runs the =pass= lookups below) once Doom finishes starting up;
=:bind-keymap= remains as a manual fallback (e.g. after =jabber-disconnect=).

Accounts go in =my/jabber-accounts= as =(JID . PASS-ENTRY)= pairs. With none
set, jabber isn't loaded at startup at all. Each password is read when jabber
loads, through =+pass-get-secret=, like [[*IRC][IRC]]'s: it reads the entry's
first line without a shell, and signals an error if the entry can't be read,
rather than handing jabber an empty password to fail with. That error is
turned into a warning here: an error in =doom-after-init-hook= stops the
daemon from starting at all.
#+begin_src emacs-lisp
(defvar my/jabber-accounts nil
  "XMPP accounts to connect at startup, as (JID . PASS-ENTRY) pairs.
PASS-ENTRY names the password-store entry holding JID's password.")

(defun my/jabber-connect-h ()
  "Connect every account in `my/jabber-accounts', if there are any."
  (when my/jabber-accounts
    (condition-case err
        (jabber-connect-all)
      (error (warn "Jabber: not connecting: %s" (error-message-string err))))))

(use-package! jabber
  :bind-keymap ("C-x C-j" . jabber-global-keymap)
  :init
  (add-hook 'doom-after-init-hook #'my/jabber-connect-h)
  :config
  (setq jabber-account-list
        (mapcar (lambda (account)
                  `(,(car account) (:password . ,(+pass-get-secret (cdr account)))))
                my/jabber-accounts))
  (jabber-modeline-mode 1)
  (add-hook 'kill-emacs-hook #'jabber-disconnect))
#+end_src

* IRC
=SPC o i= (=irc=) connects to every registered network at once, spawning a
dedicated workspace. Networks are registered with =set-irc-server!=, from the
[[*Private overlay][private overlay]], as in the example below. =:sasl-password= must be a function circe can =funcall=
with the host as its argument (see =circe--validate-password=) — a bare
=(+pass-get-secret ...)= form, as circe's own wiki suggests, fails that check,
so it's wrapped in a lambda instead. This defers the =pass= lookup to connect
time rather than interpolating it with =,= into the plist at
=set-irc-server!= time, which would both bake the secret into Emacs state in
plaintext and trigger a GPG passphrase prompt on every Doom startup.
=:sasl-username= isn't run through that same machinery — it's used as a raw
value — so it's just the literal nick rather than a pass lookup.
#+begin_src emacs-lisp :tangle no
(set-irc-server! "irc.libera.chat"
  '(:tls t
    :port 6697
    :nick "yournick"
    :sasl-username "yournick"
    :sasl-password (lambda (_server) (+pass-get-secret "irc/libera.chat"))
    :channels ("#emacs")))
#+end_src

#+begin_src emacs-lisp
(map! :leader :desc "IRC" "o i" #'=irc)
#+end_src

* Spelling
Doom's =+hunspell= flag already selects hunspell; this adds the English and
German dictionaries together. Both =hunspell-en_us= and =hunspell-de= need to
be installed, and a missing one produces a warning instead of a broken config.
#+begin_src emacs-lisp
(after! ispell
  (setq ispell-dictionary "en_US,de_DE")
  (ispell-set-spellchecker-params)
  (condition-case err
      (ispell-hunspell-add-multi-dic ispell-dictionary)
    (error (warn "Hunspell multi-dictionary setup failed: %s"
                 (error-message-string err)))))

(map! :leader :desc "Spell check buffer" "o s" #'ispell)
#+end_src

* Wiktionary
#+begin_src emacs-lisp
(defun my/wiktionary-lookup ()
  "Look up the word at point on Wiktionary in eww."
  (interactive)
  (if-let* ((word (thing-at-point 'word t)))
      (eww-browse-url (format "https://en.wiktionary.org/wiki/%s"
                              (url-hexify-string word)))
    (message "No word at point")))

(map! :leader
      :desc "Wiktionary lookup" "s w" #'my/wiktionary-lookup)
#+end_src

* Translate
Both commands go through translate-shell (=trans=).
#+begin_src emacs-lisp
(defun my/translate (language pair)
  "Translate the region or a prompted LANGUAGE phrase with translate-shell PAIR."
  (unless (executable-find "trans")
    (user-error "translate-shell (trans) is not installed"))
  (let ((text (if (use-region-p)
                  (buffer-substring-no-properties (region-beginning) (region-end))
                (read-string (format "%s: " language)))))
    (with-help-window (format "*%s Translation*" language)
      (with-current-buffer standard-output
        (call-process "trans" nil standard-output nil
                      "-show-original" "n" pair text)))))

(defun my/translate-latin ()
  "Translate the region or a prompted Latin phrase to English."
  (interactive)
  (my/translate "Latin" "la:en"))

(defun my/translate-german ()
  "Translate the region or a prompted German phrase to English."
  (interactive)
  (my/translate "German" "de:en"))

(map! :leader
      :desc "Translate Latin"  "o l" #'my/translate-latin
      :desc "Translate German" "o g" #'my/translate-german)
#+end_src

* Password store
The =:tools pass= module opens entries in a narrow left-side popup
(=:size 0.25=); override it to use the whole frame instead.
#+begin_src emacs-lisp
(map! :leader :desc "Password store" "o p" #'pass)

(after! pass
  (set-popup-rule! "^\\*Password-Store" :ignore t))
#+end_src

* Email
All mail goes out through msmtp. This is set globally rather than inside
=after! mu4e=, because a message composed before mu4e has loaded (=C-x m=, a
=mailto:= link) is plain =message-mode= and would otherwise fall back to
=sendmail-query-once=. That prompt offers "mail client", which hands the
message to =xdg-open= as a =mailto:= URL — and since the desktop's =mailto:=
handler is Emacs itself, the message just reopens in a new Emacs, endlessly.
Setting =send-mail-function= also keeps that prompt from ever appearing.
#+begin_src emacs-lisp
(setq sendmail-program (executable-find "msmtp")
      send-mail-function #'sendmail-send-it
      message-send-mail-function #'message-send-mail-with-sendmail
      message-sendmail-f-is-evil t
      message-sendmail-extra-arguments '("--read-envelope-from"))
#+end_src

Doom's mu4e module sets =message-send-mail-function= back to smtpmail when
mu4e loads, so it's reasserted here. =mu4e-maildir= and the folder names below
point at whatever mbsync writes to (see =~/.config/isyncrc=) — mu only indexes
that tree, it doesn't define it. The maildir is named after
=user-mail-address=, which is read when mu4e loads, so setting the address
anywhere in the config is enough.

This requires the =mu= binary (maildir-utils), which mu4e is bundled with and
which isn't installed via straight/Doom — install it with your system package
manager, then run =mu init --maildir=<path> --my-address=<address>= followed
by =mu index= before mu4e will find any mail.
#+begin_src emacs-lisp
(after! mu4e
  (setq mu4e-maildir (expand-file-name user-mail-address "~/.local/share/mail/")
        message-send-mail-function #'message-send-mail-with-sendmail

        mu4e-drafts-folder "/Drafts"
        mu4e-sent-folder   "/Sent"
        mu4e-trash-folder  "/Trash"
        mu4e-refile-folder "/Archive"))
#+end_src

* Contacts
BBDB (the Insidious Big Brother Database) is a MUA-agnostic contacts store.
Its mu4e support is rudimentary — just =bbdb-initialize='s =mu4e= and
=message= insinuations — but that covers what matters: =:=/=;= in a mu4e
message view display/edit the sender's BBDB record, and =M-TAB= completes
addresses from BBDB while composing (mu4e-compose is =message-mode=
underneath). Kept out of =~/.config/emacs= (a Doom core checkout) so contact
data doesn't sit inside it.
#+begin_src emacs-lisp
(use-package! bbdb
  :after mu4e
  :config
  (setq bbdb-file "~/.local/share/bbdb")
  (bbdb-initialize 'mu4e 'message))

(map! :leader :desc "Contacts" "o b" #'bbdb)
(map! :leader :desc "New contact" "o B" #'bbdb-create)
#+end_src

** Calling
Phone numbers are reached over XMPP rather than a phone line, through the
[[https://cheogram.com][Cheogram]] gateway: each number has a gateway JID, =+<E.164 number>@cheogram.com=,
that texts it. A ten-digit number is taken as North American and gets a
leading 1. =bbdb-dial= (=M-d= on a phone field) calls =browse-url= on a =tel:=
URL by default, same as any =tel:= link Emacs encounters elsewhere (a
rendered HTML email, say); that's redirected to the gateway JID as an =xmpp:=
URI through =xdg-open=, for whichever desktop client handles =xmpp:= (Dino,
via =x-scheme-handler/xmpp= in mimeapps.list).

=M-c= on a phone field is a second option alongside =bbdb-dial='s =M-d=:
skip the external client and open the chat right in jabber.el, over the
account [[*Jabber][configured below]]. =jabber-handle-uri= (from
=jabber-uri.el=) parses the URI and hands it to =jabber-chat-with=, which
picks the account automatically when only one is connected.
#+begin_src emacs-lisp
(defun my/tel-string-to-cheogram-jid (tel-string)
  "Normalize TEL-STRING, tel: prefix optional, to a Cheogram gateway JID."
  (let* ((digits (replace-regexp-in-string "[^0-9]" "" tel-string))
         (digits (if (= (length digits) 10) (concat "1" digits) digits)))
    (format "+%s@cheogram.com" digits)))

(defun my/browse-tel-with-dino (url &rest _args)
  "Open a tel: URL as an xmpp: chat with its Cheogram gateway JID in Dino."
  (browse-url-xdg-open
   (concat "xmpp:" (my/tel-string-to-cheogram-jid url))))

(require 'browse-url)
(add-to-list 'browse-url-handlers (cons "\\`tel:" #'my/browse-tel-with-dino))

(after! (bbdb jabber)
  (defun my/bbdb-jabber-chat (phone)
    "Open PHONE's Cheogram gateway JID as a chat in jabber.el, instead of dialing."
    (interactive (list (bbdb-current-field)))
    (when (eq (car-safe phone) 'name)
      (setq phone (car (bbdb-record-phone (bbdb-current-record)))))
    (when (eq (car-safe phone) 'phone)
      (setq phone (car (cdr phone))))
    (or (bbdb-phone-p phone) (user-error "Not on a phone field"))
    (jabber-handle-uri
     (concat "xmpp:" (my/tel-string-to-cheogram-jid (bbdb-phone-string phone)))))

  (define-key bbdb-mode-map (kbd "M-c") #'my/bbdb-jabber-chat))
#+end_src

* Maps
** osm.el
[[https://github.com/minad/osm][osm.el]] is an OpenStreetMap viewer: place search through Nominatim,
bookmarks, =geo:= Org links, and =osm-route= for a walking route between two
places. =osm-home= defaults to =calendar-latitude=/=calendar-longitude=, which
[[*Solar times][Solar times]] sets from =$ASTRO_LAT=/=$ASTRO_LONG= long before
osm.el loads, so home needs no setting of its own.

=SPC o G= opens osm.el's own prefix map (=h= home, =s= search, =r= route, =j=
jump to a bookmark, ...). The map buffer starts in Emacs state: its one-key
commands (=+=/=-= zoom, =d=, =n=, =c=, =b=, =u=, =l=) are all normal-state
keys too, and evil-collection has nothing for it.

=p= in the map sends the selected pin, or the map's center when nothing is
selected, [[*Sending to the phone][to the phone]]. The place is named from the
same Nominatim reverse lookup =u= and =l= do, through
=osm--fetch-location-data=, which is internal to osm.el.
#+begin_src emacs-lisp
(use-package! osm
  :defer t
  :init
  (map! :leader :desc "Map" "o G" #'osm-prefix-map)
  :config
  (set-evil-initial-state! 'osm-mode 'emacs)
  (map! :map osm-mode-map "p" #'my/osm-send-to-phone))

(defun my/osm-send-to-phone ()
  "Send the selected pin, or else the map's center, to the phone."
  (interactive nil osm-mode)
  (pcase-let ((`(,lat ,lon ,name) (osm--fetch-location-data "Sent to phone")))
    (my/localsend-send-text
     (my/geo-uri lat lon (and name (my/geo-short-label name))))))
#+end_src

** Sending to the phone
The phone runs [[https://localsend.org][LocalSend]]. This machine doesn't need the app, since Emacs
speaks its [[https://github.com/localsend/protocol][HTTP protocol]] through curl. Text sent as a single =text/plain=
file, with the text itself as the file's =preview=, arrives as a message
rather than a download. When the message is one link with no whitespace in
it, the phone offers to open it, in whichever app handles that kind of link:
OsmAnd for =geo:=, the browser for a URL.

LocalSend normally finds devices by multicast, with the other device
connecting back to announce itself, and a firewall that drops incoming
connections (an nftables input policy that only lets SSH in, say) means that
answer never arrives. Instead, the same
=GET /api/localsend/v2/info= that LocalSend itself falls back to goes out to
every address in the Wi-Fi's /24 at once (=curl --parallel=, about a second
in all). The first device to answer as =mobile=, or named
=my/localsend-phone-alias= when that's set, is the phone. The /24 comes from
the Wi-Fi or Ethernet interface's own address, not the default route's,
since a VPN's default route goes through its tunnel; a VPN client then also
has to allow local network access (Mullvad calls it "Local network sharing")
for any of this to reach the LAN.

The phone's address is remembered, and the scan only reruns when nothing
answers there: a phone that randomizes its MAC address per connection, as
GrapheneOS does, may well get a new IP address from the router each time it
rejoins. curl's =num_connects= tells "nothing at that address" (scan again)
apart from a connection that failed partway.

curl reads the request body over a pipe, not the pty =make-process= gives it
by default: through a pty's line discipline, the end of the input never
reached it. The phone's certificate is self-signed, hence =--insecure=, and
nothing pins it, so any device on the same network that calls itself a phone
could receive what's sent.

The phone holds the request open until the message is dealt with there, so
the result shows up in the echo area once it's dismissed or opened.
=SPC o y= sends the region, or else prompts with the =geo:= link or URL at
point as the default.
#+begin_src emacs-lisp
(defvar my/localsend-phone-alias nil
  "The phone's device name in LocalSend, or nil for any phone that answers.")

(defvar my/localsend-pin nil
  "PIN the phone's LocalSend asks senders for, or nil if it asks for none.")

(defvar my/localsend-port 53317
  "Port LocalSend listens on, 53317 unless changed in the app.")

(defvar my/localsend--phone nil
  "IP address where the phone answered the last scan.")

(defun my/localsend--lan-prefix ()
  "Return the first three octets of the Wi-Fi or Ethernet IPv4 address."
  (pcase (seq-find (lambda (iface) (string-match-p "\\`\\(wl\\|en\\|eth\\)" (car iface)))
                   (network-interface-list nil 'ipv4))
    (`(,_ . [,a ,b ,c ,_ ,_]) (format "%d.%d.%d" a b c))
    (_ (user-error "LocalSend: not on a local network"))))

(defun my/localsend--find-phone (prefix dir)
  "Return the phone's IP address among the /info answers saved in DIR.
Each file there is named for the last octet of the PREFIX address that
answered."
  (seq-some
   (lambda (octet)
     (let ((info (ignore-errors
                   (with-temp-buffer
                     (insert-file-contents (expand-file-name octet dir))
                     (json-parse-buffer :object-type 'plist)))))
       (and info
            (if my/localsend-phone-alias
                (equal (plist-get info :alias) my/localsend-phone-alias)
              (equal (plist-get info :deviceType) "mobile"))
            (format "%s.%s" prefix octet))))
   (directory-files dir nil "\\`[0-9]+\\'")))

(defun my/localsend--scan (callback)
  "Look for the phone on the LAN, and call CALLBACK with its IP address."
  (let ((prefix (my/localsend--lan-prefix))
        (dir (make-temp-file "localsend-" t)))
    (message "LocalSend: looking for the phone on %s.0/24..." prefix)
    (make-process
     :name "localsend-scan" :noquery t :connection-type 'pipe
     :command (list "curl" "--silent" "--insecure"
                    "--parallel" "--parallel-max" "254"
                    "--connect-timeout" "1" "--max-time" "3"
                    "--output" (expand-file-name "#1" dir)
                    (format "https://%s.[1-254]:%d/api/localsend/v2/info"
                            prefix my/localsend-port))
     :sentinel
     (lambda (proc _event)
       (unless (process-live-p proc)
         (let ((ip (my/localsend--find-phone prefix dir)))
           (delete-directory dir t)
           (if (not ip)
               (message "LocalSend: no phone answered; is the app open on it?")
             (setq my/localsend--phone ip)
             (funcall callback ip))))))))

(defun my/localsend--send (ip text &optional if-unreachable)
  "Send TEXT as a LocalSend message to the phone at IP.
When nothing answers at IP, call IF-UNREACHABLE instead of reporting it."
  (let* ((size (length (encode-coding-string text 'utf-8)))
         (body (json-serialize
                `(:info (:alias ,(format "Emacs on %s" (system-name))
                         :version "2.1" :deviceModel "Emacs" :deviceType "desktop"
                         :fingerprint ,(md5 (system-name)) :port ,my/localsend-port
                         :protocol "https" :download :false)
                  :files (:message (:id "message" :fileName "message.txt"
                                    :size ,size :fileType "text/plain"
                                    :preview ,text)))))
         (proc
          (make-process
           :name "localsend-send" :noquery t
           :connection-type 'pipe :coding 'binary
           :buffer (generate-new-buffer " *localsend-send*")
           :command (list "curl" "--silent" "--insecure" "--connect-timeout" "2"
                          "--output" "/dev/null"
                          "--write-out" "%{http_code} %{num_connects}"
                          "--header" "Content-Type: application/json"
                          "--data-binary" "@-"
                          (format "https://%s:%d/api/localsend/v2/prepare-upload%s"
                                  ip my/localsend-port
                                  (if my/localsend-pin
                                      (format "?pin=%s" my/localsend-pin)
                                    "")))
           :sentinel
           (lambda (proc _event)
             (unless (process-live-p proc)
               (pcase-let ((`(,code ,connects)
                            (with-current-buffer (process-buffer proc)
                              (split-string (buffer-string)))))
                 (kill-buffer (process-buffer proc))
                 (cond
                  ((and (equal connects "0") if-unreachable)
                   (funcall if-unreachable))
                  ((equal connects "0")
                   (message "LocalSend: nothing answered at %s" ip))
                  (t
                   (message "LocalSend: %s"
                            (pcase code
                              ((or "200" "204") "the phone has it")
                              ("401" "the phone wants a PIN; set `my/localsend-pin'")
                              ("403" "declined on the phone")
                              ("409" "the phone is busy with another transfer")
                              ("000" "lost the connection to the phone")
                              (_ (format "the phone answered HTTP %s" code))))))))))))
    (message "LocalSend: sending to %s..." ip)
    (process-send-string proc body)
    (process-send-eof proc)))

(defun my/localsend-send-text (text)
  "Send TEXT to the phone as a LocalSend message.
Interactively, send the region, or else prompt with the geo: link or
URL at point as the default."
  (interactive
   (list (if (use-region-p)
             (buffer-substring-no-properties (region-beginning) (region-end))
           (let ((default (or (cadr (my/geo-at-point)) (thing-at-point 'url t))))
             (read-string (format-prompt "Send to phone" default) nil nil default)))))
  (when (string-blank-p text)
    (user-error "Nothing to send"))
  (let ((send (lambda (ip) (my/localsend--send ip text))))
    (if my/localsend--phone
        (my/localsend--send my/localsend--phone text
                            (lambda () (my/localsend--scan send)))
      (my/localsend--scan send))))

(map! :leader :desc "Send to phone" "o y" #'my/localsend-send-text)
#+end_src

** geo: links
osm.el registers =geo:= as both an Org link type and a =browse-url= handler,
so following one opens the map. For sending one, =my/geo-at-point= makes a
=geo:= URI at point, bare or as an Org link, an Embark target of its own
type: =SPC a= (or =C-;=) on it, then =RET= or =p= sends it to the phone and
=m= shows it on the map. It goes at the front of =embark-target-finders=, so
a =geo:= Org link is a place first and only then a generic Org link, which
cycling targets still reaches.

The phone gets =geo:LAT,LON?q=LAT,LON(LABEL)=, the form Android map apps read
a pin's name from. The label is percent-encoded, since LocalSend only offers
to open a message with no whitespace in it. An Org link's description becomes the
label, cut down to the place's name (or its house number and street),
because osm.el's link descriptions, like Nominatim's, carry on through the
neighborhood, county, zip code, and country.
#+begin_src emacs-lisp
(defun my/geo-parse (uri)
  "Return (LAT LON LABEL) from geo URI, or nil if it isn't one.
LABEL is the place's name from a `?q=LAT,LON(LABEL)' query, or nil."
  (when (string-match "\\`geo:\\(-?[0-9.]+\\),\\(-?[0-9.]+\\)" uri)
    (list (string-to-number (match-string 1 uri))
          (string-to-number (match-string 2 uri))
          (and (string-match "[?&]q=[^&]*(\\([^)]+\\))" uri)
               (decode-coding-string (url-unhex-string (match-string 1 uri))
                                     'utf-8)))))

(defun my/geo-uri (lat lon &optional label)
  "Return a geo URI for LAT/LON, naming the place LABEL if non-nil."
  (if label
      (format "geo:%.6f,%.6f?q=%.6f,%.6f(%s)"
              lat lon lat lon (url-hexify-string label))
    (format "geo:%.6f,%.6f" lat lon)))

(defun my/geo-short-label (name)
  "Cut NAME, a place's description, down to the place's name.
For a building without one, keep the house number and street. Return
nil when NAME starts with coordinates, osm.el's description of a place
the lookup found nothing for."
  (let ((parts (split-string name ", *" t "[ \t\n]+")))
    (cond ((or (null parts) (string-search "°" (car parts))) nil)
          ((and (cdr parts) (string-match-p "\\`[0-9]+[A-Za-z]?\\'" (car parts)))
           (concat (car parts) " " (cadr parts)))
          (t (car parts)))))

(defun my/geo-normalize (uri &optional label)
  "Rewrite geo URI in the form `my/geo-uri' makes, naming it LABEL if given."
  (pcase-let ((`(,lat ,lon ,query-label) (my/geo-parse uri)))
    (unless lat
      (user-error "Not a geo: URI: %s" uri))
    (my/geo-uri lat lon (let ((name (or label query-label)))
                          (and name (my/geo-short-label name))))))

(defun my/geo-at-point ()
  "Return the geo: URI at point as an Embark target, (geo URI BEG . END).
An Org link's description becomes the place's label."
  (require 'thingatpt)
  (when (or (thing-at-point-looking-at
             "\\[\\[\\(geo:[^]]+\\)]\\(?:\\[\\([^]]+\\)]\\)?]" 500)
            (thing-at-point-looking-at
             "\\(geo:-?[0-9.]+,-?[0-9.]+[^][ \t\n\"<>]*\\)" 200))
    (let ((beg (match-beginning 0))
          (end (match-end 0))
          (uri (match-string-no-properties 1))
          (label (match-string-no-properties 2)))
      `(geo ,(my/geo-normalize uri label) ,beg . ,end))))

(defun my/geo-read-uri (prompt)
  "Read a geo URI with PROMPT, defaulting to the one at point."
  (let ((default (cadr (my/geo-at-point))))
    (read-string (format-prompt prompt default) nil nil default)))

(defun my/geo-send-to-phone (uri)
  "Send the place in geo URI to the phone."
  (interactive (list (my/geo-read-uri "Send place to phone")))
  (my/localsend-send-text (my/geo-normalize uri)))

(defun my/geo-show-on-map (uri)
  "Show the place in geo URI on an osm.el map."
  (interactive (list (my/geo-read-uri "Show place")))
  (pcase-let ((`(,lat ,lon) (or (my/geo-parse uri)
                                (user-error "Not a geo: URI: %s" uri))))
    (osm-url (format "geo:%s,%s;z=17" lat lon))))

(after! embark
  (defvar-keymap my/embark-geo-map
    :doc "Embark actions for geo: links."
    :parent embark-general-map
    "RET" #'my/geo-send-to-phone
    "p" #'my/geo-send-to-phone
    "m" #'my/geo-show-on-map)
  (add-to-list 'embark-keymap-alist '(geo . my/embark-geo-map))
  (add-to-list 'embark-target-finders #'my/geo-at-point))
#+end_src

* RSS
Doom's =(rss +org)= flag sets up elfeed-org and resolves relative file names
against =org-directory=.
#+begin_src emacs-lisp
(setq rmh-elfeed-org-files '("feeds.org"))

(after! elfeed
  (setq elfeed-search-title-max-width 70)
  ;; `elfeed-search-filter' is `:local t' (auto-buffer-local), so a plain
  ;; `setq' here only sets it in whatever buffer is current when elfeed
  ;; loads -- not the *elfeed-search* buffer. Needs `setq-default'.
  (setq-default elfeed-search-filter "@2-week-ago +unread -forums -firehose")
  (map! :map elfeed-search-mode-map "z" #'elfeed-tree))

(map! :leader :desc "Elfeed" "o n" #'elfeed)
#+end_src

Some feeds (Hacker News, other link aggregators) carry no article body of
their own, just an outbound link and a separate comments link. =L= collects
every link elfeed already rendered in the entry buffer -- the =Link:= header
and anything linked from the body -- prompts for one, fetches it, and swaps
the whole buffer to show it. =q= returns to the normal entry instead of
closing it, as long as a fetched link is showing. This is source-agnostic:
it just reads whatever links =shr= put in the buffer, no site-specific
parsing.
#+begin_src emacs-lisp
(after! elfeed
  (defvar-local +elfeed-show-linked-view nil
    "Non-nil while the show buffer displays fetched link content instead of
the entry itself.")

  (defun +elfeed-show--link-candidates ()
    "Collect (LABEL . URL) for every link elfeed rendered in this buffer."
    (let ((links nil) (pos (point-min)))
      (save-excursion
        (while (< pos (point-max))
          (if-let* ((url (get-text-property pos 'shr-url)))
              (let* ((end (or (next-single-property-change pos 'shr-url nil (point-max))
                               (point-max)))
                     (text (string-trim (buffer-substring-no-properties pos end))))
                (unless (or (string-empty-p text) (rassoc url links))
                  (push (cons text url) links))
                (setq pos end))
            (setq pos (or (next-single-property-change pos 'shr-url nil (point-max))
                          (point-max))))))
      (nreverse links)))

  (defun +elfeed-show-browse-link (&optional arg)
    "Prompt for one of this entry's links and replace the buffer with its
fetched content, run through eww's readability filter to strip nav/header/
sitemap boilerplate. Press `q' to return to the normal entry.

A prefix argument toggles two independent options, stacked by how many
times \\[universal-argument] is pressed:
  C-u          show the fetched page as-is, skipping the readability filter
               (useful when readability guts a non-article page, e.g. a
               comment thread, rather than cleaning it up)
  C-u C-u      fetch through `mullvad-exclude curl', bypassing the VPN --
               useful for sites that block Mullvad exit nodes
  C-u C-u C-u  both of the above"
    (interactive "P" elfeed-show-mode)
    (when +elfeed-show-linked-view
      (elfeed-show-refresh)
      (setq +elfeed-show-linked-view nil))
    (let* ((level (if arg (round (log (prefix-numeric-value arg) 4)) 0))
           (raw (/= 0 (logand level 1)))
           (bypass-vpn (/= 0 (logand level 2)))
           (links (+elfeed-show--link-candidates))
           (candidates (mapcar (lambda (l) (cons (format "%s  —  %s" (car l) (cdr l)) (cdr l)))
                                links))
           (choice (completing-read "Open link: " candidates nil t))
           (url (cdr (assoc choice candidates))))
      (message "Fetching %s%s..." url (if bypass-vpn " (via mullvad-exclude)" ""))
      (cl-letf* ((real-start-process (symbol-function 'start-process))
                 ((symbol-function 'start-process)
                  (if bypass-vpn
                      (lambda (name buffer program &rest args)
                        (apply real-start-process name buffer "mullvad-exclude" program args))
                    real-start-process)))
        (elfeed-show--fetch
         (lambda (fetched-url content)
           (let ((inhibit-read-only t)
                 (elfeed-transform-html-functions (unless raw (list #'elfeed-show--readable))))
             (erase-buffer)
             (pcase content
               (:error (insert (propertize (format "Failed to fetch %s\n" fetched-url) 'face 'error)))
               (:fetching (insert (propertize "Fetching...\n" 'face 'italic)))
               ((pred stringp) (elfeed-insert-html content (elfeed-compute-base fetched-url))))
             (goto-char (point-min))
             (setq +elfeed-show-linked-view t)))
         :url url :force t))))

  (defun +elfeed-show-quit ()
    "Return to the normal entry view if a fetched link is showing, otherwise
quit the entry buffer as usual."
    (interactive nil elfeed-show-mode)
    (if +elfeed-show-linked-view
        (progn (elfeed-show-refresh) (setq +elfeed-show-linked-view nil))
      (quit-window)))

  ;; Bound with the `:n' (normal-state) qualifier: elfeed-show-mode runs in
  ;; evil normal state, which falls back to `evil-motion-state-map' for any
  ;; key it doesn't bind itself -- and motion state already claims plain "L"
  ;; for `evil-window-bottom'. A state-qualified `map!' installs into the
  ;; mode's own normal-state override keymap, which evil consults first.
  (map! :map elfeed-show-mode-map
        :n "L" #'+elfeed-show-browse-link
        :n "q" #'+elfeed-show-quit))
#+end_src

* Solar times
The built-in =M-x sunrise-sunset= works offline from these. Coordinates come
from =$ASTRO_LAT=/=$ASTRO_LONG=, the same variables =astro-transits= reads,
as plain signed decimal degrees (north and east positive). For a systemd
user daemon, a file in =~/.config/environment.d/= sets them, e.g.

#+begin_example
ASTRO_LAT=51.4779
ASTRO_LONG=-0.0015
ASTRO_ZONE=0
#+end_example

That's the format =calendar-latitude=/=calendar-longitude= already want, so no
conversion happens here. Astrolog's
own =DD:MMH= format is only needed inside =astro-transits= itself.

=solar-sunrise-sunset= has no autoload of its own, and is normally loaded
only as a side effect of the agenda or diary. [[*Modeline][The modeline]] calls it straight
from a timer at startup, with nothing else guaranteed to have loaded =solar=
by then, so it's required outright.

If Emacs starts without those variables, the coordinates stay nil and
Emacs shows a warning. Then the modeline leaves out the sun, the weather
isn't fetched, and the commands that need a location say so, while the
rest of this file loads as usual.
#+begin_src emacs-lisp
(require 'solar)

(if-let* ((lat (getenv "ASTRO_LAT"))
          (long (getenv "ASTRO_LONG")))
    (setq calendar-latitude (string-to-number lat)
          calendar-longitude (string-to-number long))
  (warn "ASTRO_LAT/ASTRO_LONG are unset: no solar times, weather, or planet positions"))

(defun my/solar-assert-coordinates ()
  "Signal a `user-error' unless `calendar-latitude'/`calendar-longitude' are set."
  (unless (and calendar-latitude calendar-longitude)
    (user-error "No location: ASTRO_LAT/ASTRO_LONG were unset when Emacs started")))
#+end_src

Org's agenda evaluates any =%%(...)= line embedded directly in an agenda file
as a diary sexp entry, so [[file:~/Documents/org/calendar.org][calendar.org]]
can call these without a separate diary file or
=org-agenda-include-diary=. =diary-lunar-phases= already only produces
output on the days a phase actually falls; =lunar-phase-names= is the
built-in hook for putting an emoji on each phase, so it also affects
=M-x calendar-lunar-phases=, not just the agenda.
#+begin_src emacs-lisp
(setq lunar-phase-names '("🌑 New Moon" "🌓 First Quarter Moon"
                           "🌕 Full Moon" "🌗 Last Quarter Moon"))
#+end_src

Sunrise/sunset are built in too, but solar noon and solar midnight aren't, so
=my/solar-times= computes them as the midpoint between sunrise/sunset (and
its antipode) for a given date, defaulting to today, and returns the four
raw decimal hours rather than a formatted string -- the diary sexp below and
[[*Modeline][the modeline's]] more compact rendering both format the same
four numbers differently, so neither owns the formatting.
#+begin_src emacs-lisp
(defun my/solar-times (&optional date)
  "List (SUNRISE SOLAR-NOON SUNSET SOLAR-MIDNIGHT ZONE) for DATE.
Each time is a decimal hour; ZONE is the value `solar-time-string' wants
alongside it. DATE defaults to today. nil if the sun neither rises nor
sets on DATE, as happens near the poles, or if there are no coordinates."
  (when (and calendar-latitude calendar-longitude)
    (pcase-let ((`(,rise ,set ,_) (solar-sunrise-sunset (or date (calendar-current-date)))))
      (when (and rise set)
        (let* ((rise-time (car rise))
               (set-time (car set))
               (zone (cadr rise))
               (noon (/ (+ rise-time set-time) 2)))
          (list rise-time noon set-time (mod (+ noon 12) 24) zone))))))

(defun my/diary-solar-times ()
  "Diary sexp: today's sunrise, solar noon, sunset, and solar midnight."
  (with-no-warnings (defvar date))
  (when (calendar-date-equal date (calendar-current-date))
    (pcase (my/solar-times date)
      (`(,rise ,noon ,set ,midnight ,zone)
       (format "Sunrise %s | Noon %s | Sunset %s | Midnight %s"
               (solar-time-string rise zone)
               (solar-time-string noon zone)
               (solar-time-string set zone)
               (solar-time-string midnight zone))))))
#+end_src

* Planetary hours
The classical hour system divides each day into 24 unequal "planetary
hours" rather than 24 equal clock hours: twelve from sunrise to sunset,
twelve more from that sunset to the next sunrise, each set stretched or
squeezed to fit however much daylight or darkness the day actually has.
Each hour is ruled by one of the seven classical planets, cycling
through them in Chaldean order (slowest to fastest: Saturn, Jupiter,
Mars, Sun, Venus, Mercury, Moon) starting from whichever one rules the
day's first hour -- which is also, not coincidentally, the planet that
gives the day its name.
#+begin_src emacs-lisp
(defconst my/planetary-hours-order
  '(("Saturn" . "♄") ("Jupiter" . "♃") ("Mars" . "♂") ("Sun" . "☉")
    ("Venus" . "♀") ("Mercury" . "☿") ("Moon" . "☽"))
  "The seven classical planets and their glyphs, slowest to fastest, in
the order they take successive turns ruling a planetary hour.")

(defconst my/planetary-hours-day-rulers
  ["Sun" "Moon" "Mars" "Mercury" "Jupiter" "Venus" "Saturn"]
  "Planet ruling a day's first hour, indexed like `calendar-day-of-week'
(Sunday first) -- also that day's own namesake.")
#+end_src

Finding the hour boundaries needs both DATE's own sunrise/sunset and the
*next* day's sunrise, since the twelve night hours run past midnight --
so [[*Solar times][=my/solar-times=]] gets called twice rather than
reimplementing any of its sunrise/sunset math here. Its decimal hours
are clock readings, though, and twice a year the clock jumps between
one sunset and the next sunrise: the night the clocks go back runs an
hour longer than the clock face says, and the night they go forward an
hour shorter. Measured off the clock, every night hour on those two
nights came out five minutes wrong, and the hours around midnight up
to half an hour off. So each sunrise and sunset is turned into the
actual moment it happens first, and the hours are divided up and kept
as moments too. That also tells the two 1:30s apart on the night the
clocks go back, which no clock reading can.
#+begin_src emacs-lisp
(defun my/planetary-hours--moment (date hour)
  "The moment decimal HOUR on DATE's clock comes round, HOUR read the
way `my/solar-times' gives it: local time, DST included."
  (pcase-let ((`(,month ,day ,year) date)
              (seconds (round (* hour 3600))))
    (encode-time (list (% seconds 60) (% (/ seconds 60) 60) (/ seconds 3600)
                       day month year nil -1 nil))))

(defun my/planetary-hours--hours (date)
  "Compute the planetary hours ruling DATE.
Returns a list (SUNRISE SUNSET HOURS), SUNRISE and SUNSET as Lisp
timestamps. HOURS has 24 entries of (FROM TO NAME GLYPH), FROM/TO Lisp
timestamps too. The first twelve entries divide sunrise to sunset
evenly, the last twelve divide that sunset to the following sunrise
evenly, by the time that actually passes rather than what the clock
says, and together they cycle through `my/planetary-hours-order'
starting from the planet that rules DATE's weekday. Signals a
`user-error' if the sun neither rises nor sets on DATE or the day
after, as happens near the poles."
  (my/solar-assert-coordinates)
  (pcase-let*
      ((`(,rise ,_ ,set ,_ ,_)
        (or (my/solar-times date)
            (user-error "The sun neither rises nor sets on %s"
                        (calendar-date-string date t))))
       (next-date (calendar-gregorian-from-absolute
                   (1+ (calendar-absolute-from-gregorian date))))
       (next-rise (or (car (my/solar-times next-date))
                      (user-error "The sun neither rises nor sets on %s"
                                  (calendar-date-string next-date t))))
       (sunrise (my/planetary-hours--moment date rise))
       (sunset (my/planetary-hours--moment date set))
       (next-sunrise (my/planetary-hours--moment next-date next-rise))
       (day-hour (/ (float-time (time-subtract sunset sunrise)) 12))
       (night-hour (/ (float-time (time-subtract next-sunrise sunset)) 12))
       (ruler (aref my/planetary-hours-day-rulers (calendar-day-of-week date)))
       (start (seq-position my/planetary-hours-order ruler
                            (lambda (pair name) (equal (car pair) name))))
       (hours nil))
    (dotimes (i 24)
      (let* ((night (>= i 12))
             (length (if night night-hour day-hour))
             (from (time-add (if night sunset sunrise) (* (mod i 12) length)))
             (planet (nth (mod (+ start i) 7) my/planetary-hours-order)))
        (push (list from (time-add from length) (car planet) (cdr planet)) hours)))
    (list sunrise sunset (nreverse hours))))
#+end_src

=my/planetary-hours= is the interactive entry point: =org-read-date= gives
the same calendar-popup date prompt Org itself uses for timestamps
(defaulting to today, and understanding its relative shorthand like
=+3=), converted to the plain Gregorian date list the rest of this
section works in. The result goes to a =*Planetary Hours*= buffer via
=with-help-window= rather than inserted anywhere, since a day's 24 hours
don't belong on any particular Org heading the way a tarot spread or a
transit chart does.
#+begin_src emacs-lisp
(defun my/planetary-hours--format-time (date time)
  "Format TIME as a clock time the way `solar-time-string' writes a
sunrise, tagged with its date once it has rolled past midnight into the
day after DATE."
  ;; Rounded to the minute before decoding, not by `solar-time-string',
  ;; which would print 11:59:45pm as 12:00pm, and on the wrong date.
  (let* ((decoded (decode-time (time-add time 30)))
         (clock (solar-time-string (+ (decoded-time-hour decoded)
                                      (/ (decoded-time-minute decoded) 60.0))
                                   (format-time-string "%Z" time)))
         (day (list (decoded-time-month decoded) (decoded-time-day decoded)
                    (decoded-time-year decoded))))
    (if (calendar-date-equal day date)
        clock
      (format "%s (%s)" clock (calendar-date-string day t t)))))

(defun my/planetary-hours (date)
  "Show which planet rules each hour of DATE in a `*Planetary Hours*' buffer.
Twelve day hours divide sunrise to sunset evenly, then twelve night
hours divide that sunset to the next sunrise evenly; both halves cycle
through the seven classical planets in Chaldean order, starting from
the planet ruling DATE's weekday. See `my/planetary-hours--hours'."
  (interactive
   (list (let ((decoded (decode-time
                         (org-read-date nil t nil "Planetary hours for date: "))))
           (list (decoded-time-month decoded) (decoded-time-day decoded)
                 (decoded-time-year decoded)))))
  (pcase-let ((`(,sunrise ,sunset ,hours) (my/planetary-hours--hours date)))
    (with-help-window "*Planetary Hours*"
      (princ (format "Planetary hours for %s\n" (calendar-date-string date)))
      (princ (format "Sunrise %s, sunset %s\n"
                     (my/planetary-hours--format-time date sunrise)
                     (my/planetary-hours--format-time date sunset)))
      (dotimes (i 24)
        (cond ((= i 0) (princ "\nDay hours\n"))
              ((= i 12) (princ "\nNight hours\n")))
        (pcase-let ((`(,from ,to ,name ,glyph) (nth i hours)))
          (princ (format "%2d. %s %-8s%s – %s\n"
                        (1+ (mod i 12)) glyph name
                        (my/planetary-hours--format-time date from)
                        (my/planetary-hours--format-time date to))))))))

(map! :leader :desc "Planetary hours" "o h" #'my/planetary-hours)
#+end_src

=my/planetary-hours-at= picks out the single hour ruling a given moment,
for the [[*Grimoire journal][Grimoire]] capture template to record. The
planetary day runs sunrise to sunrise rather than midnight to midnight,
so a moment before that date's sunrise still belongs to the /previous/
date's night hours, whose last few run on into this date's small hours.
With the hours kept as moments, finding TIME among them is a plain
comparison either way.
#+begin_src emacs-lisp
(defun my/planetary-hours-at (time)
  "Return the planetary hour ruling TIME, as (DAY-RULER HOUR-RULER NUMBER NIGHT).
DAY-RULER and HOUR-RULER are (NAME . GLYPH) pairs from
`my/planetary-hours-order'; NUMBER counts 1-12 through the day or night
hours, and NIGHT is non-nil for a night hour. The planetary day begins
at sunrise, so before sunrise TIME falls in the previous date's night.
See `my/planetary-hours--hours'."
  (pcase-let* ((`(,_ ,_ ,_ ,day ,month ,year . ,_) (decode-time time))
               (date (list month day year))
               (`(,sunrise ,_ ,hours) (my/planetary-hours--hours date)))
    (when (time-less-p time sunrise)
      (setq date (calendar-gregorian-from-absolute
                  (1- (calendar-absolute-from-gregorian date)))
            hours (nth 2 (my/planetary-hours--hours date))))
    (let* ((index (or (seq-position hours time
                                    (lambda (entry at) (time-less-p at (nth 1 entry))))
                      23))
           (planet (lambda (entry) (cons (nth 2 entry) (nth 3 entry)))))
      (list (funcall planet (car hours))
            (funcall planet (nth index hours))
            (1+ (mod index 12))
            (>= index 12)))))
#+end_src

* Planet positions
=astrolog='s =-Z= switch lists every object's altitude and azimuth with
respect to the local horizon, one line per body, e.g. =Satu: +51:20'
281:57' (1.00s 0.21e) ...=. Called with just
[[*Solar times][the same coordinates =solar= already uses]] and =-n= for
"right now", that's everything =my/planet-positions= needs for the seven
classical planets -- no natal chart involved, so only
[[*Astrology][the same =-R 11 12 13 14 15= restriction]] that keeps the
transit table clean is needed here too, purely to silence the "SwissEph
file not found" warning those unused asteroid bodies would otherwise
print to stderr.

Two quirks in that raw output are worth recording, since testing them
by hand was the only way to pin either down:
- =-z=/=-z0= must be set /before/ =-n= on the command line -- astrolog
  reads system time against whatever zone is already active when =-n=
  is processed, so a =-n= earlier in the switch list comes out hours
  off.
- The =Azimuth= column isn't a compass bearing. Checked empirically
  against astrolog's own =-Zd= rise/set/culminate times (an object
  sits due south at upper culmination, due east at sunrise, due west
  at sunset): it's degrees measured counterclockwise from due *east*.
  =90 - raw=, wrapped to 0-359, converts it to the usual
  0=N/90=E/180=S/270=W compass bearing.
- Logging a *past* observation (see Astronomy journal positions,
  below) needs astrolog's =-q <month> <day> <year> <time>= switch
  instead of =-n=. =-q= treats =<time>= as a plain civil time in
  whatever =-z= zone is already set, with no further daylight
  adjustment of its own -- so =-z= has to already be the UTC offset
  that held *at that timestamp*, DST included, not always the
  standard-time offset =-z0 0= would otherwise imply. Emacs's
  =(current-time-zone TIME)= already resolves exactly that for any
  moment, so no separate DST calculation is needed here the way
  =astro-transits= (see [[*Astrology][Astrology]]) has to do its own.
#+begin_src emacs-lisp
(defconst my/planet-positions-abbrevs
  '(("Sun" . "Sun") ("Moon" . "Moon") ("Merc" . "Mercury") ("Venu" . "Venus")
    ("Mars" . "Mars") ("Jupi" . "Jupiter") ("Satu" . "Saturn"))
  "Astrolog's 4-column body abbreviations from its -Z chart, to the
full names `my/planetary-hours-order' uses for the same seven
classical planets.")

(defconst my/planet-positions-line-re
  (rx bol (group (= 4 anything)) ": "
      (group (= 7 anything)) " "
      (group (= 7 anything)) " (")
  "Matches one body's line in astrolog's -Z local-horizon chart -- a
4-column abbreviation, then fixed 7-column altitude and azimuth
fields in astrolog's signed, space-padded DD:MM' format.")

(defun my/planet-positions--program ()
  "Return the astrolog executable."
  (or (executable-find "astrolog")
      (user-error "astrolog is not on PATH")))

(defun my/planet-positions--angle (string)
  "Parse an astrolog DD:MM' angle STRING -- optionally signed, and
space-padded in place of a leading zero -- into decimal degrees."
  (let* ((clean (string-replace " " "" string))
         (negative (string-prefix-p "-" clean))
         (digits (string-remove-suffix
                  "'" (replace-regexp-in-string "\\`[+-]" "" clean)))
         (parts (split-string digits ":")))
    (* (if negative -1 1)
       (+ (string-to-number (nth 0 parts))
          (/ (string-to-number (nth 1 parts)) 60.0)))))

(defun my/planet-positions--dms (value positive negative)
  "Format signed decimal-degree VALUE as astrolog's DD:MMH string,
using the POSITIVE/NEGATIVE hemisphere letter for a non-negative/
negative VALUE -- the same layout astro-transits
derives from $ASTRO_LAT/$ASTRO_LONG (see [[*Astrology]]), computed
here directly from `calendar-latitude'/`calendar-longitude' instead."
  (let* ((hemi (if (< value 0) negative positive))
         (abs-value (abs value))
         (d (floor abs-value))
         (m (round (* 60 (- abs-value d)))))
    (when (= m 60) (setq m 0 d (1+ d)))
    (format "%d:%02d%s" d m hemi)))

(defun my/planet-positions--azimuth (raw)
  "Convert astrolog's RAW -Z azimuth (degrees counterclockwise from
due east) to a compass bearing in whole degrees, 0-359 clockwise
from north."
  (mod (round (- 90 raw)) 360))

(defun my/planet-positions--data (&optional time lat long)
  "Run astrolog for TIME (default now) and LAT/LONG decimal degrees
\(default `calendar-latitude'/`calendar-longitude'), returning an
alist of (NAME ALTITUDE AZIMUTH) for the seven classical planets --
ALTITUDE decimal degrees above (positive) or below (negative) the
horizon, AZIMUTH an integer compass bearing 0-359. See
`my/planet-positions-line-re' for the chart astrolog is asked for."
  (unless (and lat long)
    (my/solar-assert-coordinates))
  (let* ((program (my/planet-positions--program))
         ;; `current-time-zone' already resolves the UTC offset that held
         ;; at TIME, DST included, which is exactly what astrolog's -q
         ;; wants as a plain civil time with no further -z0 adjustment --
         ;; see the note above about logging a past observation.
         (west-hours (/ (- (car (current-time-zone time))) 3600))
         (lat-dms (my/planet-positions--dms (or lat calendar-latitude) "N" "S"))
         (long-dms (my/planet-positions--dms (or long calendar-longitude) "E" "W"))
         (date-args
          (if time
              (pcase-let ((`(,_ ,minute ,hour ,day ,month ,year . ,_) (decode-time time)))
                (let* ((period (if (< hour 12) "am" "pm"))
                       (hour12 (let ((h (mod hour 12))) (if (zerop h) 12 h))))
                  (list "-q" (number-to-string month) (number-to-string day)
                        (number-to-string year)
                        (format "%d:%02d%s" hour12 minute period))))
            (list "-n")))
        positions)
    (with-temp-buffer
      (unless (zerop (apply #'call-process program nil t nil
                             (append (list "-zl" long-dms lat-dms
                                           "-z" (number-to-string west-hours) "-z0" "0")
                                     date-args
                                     (list "-Z" "-R" "11" "12" "13" "14" "15"))))
        (user-error "astrolog failed: %s" (buffer-string)))
      (goto-char (point-min))
      (while (re-search-forward my/planet-positions-line-re nil t)
        ;; Collect every group before parsing any of them: the angle
        ;; and label parsing below call `string-match' themselves,
        ;; which would clobber this loop's own match data (see
        ;; `my/astro--transit-row' above for the same gotcha).
        (let ((label (match-string 1))
              (alt-str (match-string 2))
              (az-str (match-string 3)))
          (let ((name (cdr (assoc (string-trim label) my/planet-positions-abbrevs)))
                (altitude (my/planet-positions--angle alt-str))
                (azimuth (my/planet-positions--azimuth
                          (my/planet-positions--angle az-str))))
            (when name (push (list name altitude azimuth) positions))))))
    (nreverse positions)))
#+end_src

=my/planet-positions= is the interactive entry point, listing the same
seven planets in the same order and with the same glyphs as
[[*Planetary hours][=my/planetary-hours=]] (=my/planetary-hours-order=,
Chaldean, slowest to fastest) -- altitude/azimuth right now, rather than
hour rulership across a day.
#+begin_src emacs-lisp
(defun my/planet-positions--format-altitude (deg)
  "Format non-negative decimal degrees DEG as DD°MM'."
  (let* ((d (floor deg)) (m (round (* 60 (- deg d)))))
    (when (= m 60) (setq m 0 d (1+ d)))
    (format "%d°%02d'" d m)))

(defconst my/planet-positions-compass-points
  ["N" "NE" "E" "SE" "S" "SW" "W" "NW"]
  "8-point compass abbreviations, indexed by azimuth / 45, rounded.")

(defun my/planet-positions--lines (positions)
  "Format POSITIONS (see `my/planet-positions--data') as a list of
lines, one per classical planet in the same order and with the same
glyphs as [[*Planetary hours][=my/planetary-hours=]]
\(`my/planetary-hours-order', Chaldean, slowest to fastest), each
showing its altitude above/below the horizon and compass-bearing
azimuth."
  (mapcar
   (lambda (planet)
     (pcase-let* ((`(,name . ,glyph) planet)
                  (`(,_ ,altitude ,azimuth) (assoc name positions)))
       (if altitude
           (format "%s %-8s%s %s horizon, azimuth %3d° %-2s"
                   glyph name
                   (my/planet-positions--format-altitude (abs altitude))
                   (if (>= altitude 0) "above" "below")
                   azimuth
                   (aref my/planet-positions-compass-points
                         (mod (round (/ azimuth 45.0)) 8)))
         (format "%s %-8s(no data)" glyph name))))
   my/planetary-hours-order))

(defun my/planet-positions ()
  "Show each classical planet's current altitude and azimuth in a
`*Planet Positions*' buffer: how far above or below the horizon it
is, and its compass bearing (0-359, 0 north through 90 east, 180
south, 270 west). See `my/planet-positions--data'."
  (interactive)
  (with-help-window "*Planet Positions*"
    (princ (format "Planet positions for %s\n\n"
                   (format-time-string "%Y-%m-%d %H:%M %Z")))
    (dolist (line (my/planet-positions--lines (my/planet-positions--data)))
      (princ line) (princ "\n"))))

(map! :leader :desc "Planet positions" "o P" #'my/planet-positions)
#+end_src

Astronomy journal entries carry their own time and place -- the
=UTC= property (or, in older entries, the =%U= timestamp in the
heading), and the =COORDINATES= property (see
[[*Astronomy journal][Astronomy journal]]) -- so
=my/astro-insert-planet-positions= reruns the same chart for
/that/ moment and place instead of right now, and inserts it under
the heading as an Org table rather than in a =*Planet
Positions*= popup.
#+begin_src emacs-lisp
(defun my/astro-log-time ()
  "Return the Emacs time value of the Astronomy journal entry at point:
its UTC property if it has one, as the capture template sets it,
otherwise the first timestamp on its heading, read as local time the
way `%U' left it in entries from before that property existed."
  (let ((utc (org-entry-get nil "UTC")))
    (if utc
        (let ((decoded (org-parse-time-string utc)))
          (setf (nth 7 decoded) nil   ; DST is meaningless for UTC
                (nth 8 decoded) 0)
          (encode-time decoded))
      (save-excursion
        (org-back-to-heading t)
        (let ((eol (line-end-position)))
          (if (re-search-forward org-ts-regexp-both eol t)
              (org-time-string-to-time (match-string 0))
            (user-error "No timestamp on this heading")))))))

(defun my/astro-log-coordinates ()
  "Return (LAT . LONG) decimal degrees parsed from the COORDINATES
property of the entry at point, as the Astronomy capture template
sets it."
  (let ((value (or (org-entry-get nil "COORDINATES")
                    (user-error "No COORDINATES property on this entry"))))
    (pcase (split-string value "," t "[ \t]+")
      (`(,lat ,long) (cons (string-to-number lat) (string-to-number long)))
      (_ (user-error "COORDINATES property %S is not \"LAT, LONG\"" value)))))

(defun my/planet-positions--rows (positions)
  "Format POSITIONS (see `my/planet-positions--data') as Org table
rows, one list of cell strings per classical planet, in the same
order and with the same fields as `my/planet-positions--lines'."
  (mapcar
   (lambda (planet)
     (pcase-let* ((`(,name . ,glyph) planet)
                  (`(,_ ,altitude ,azimuth) (assoc name positions))
                  (label (format "%s %s" glyph name)))
       (if altitude
           (list label
                 (my/planet-positions--format-altitude (abs altitude))
                 (if (>= altitude 0) "above" "below")
                 (format "%d°" azimuth)
                 (aref my/planet-positions-compass-points
                       (mod (round (/ azimuth 45.0)) 8)))
         (list label "" "" "" ""))))
   my/planetary-hours-order))

(defun my/astro-insert-planet-positions ()
  "Insert the classical planets' altitude/azimuth under the Org entry at
point as an Org table, computed for its own timestamp and COORDINATES
property rather than right now. See `my/astro-log-time' and
`my/astro-log-coordinates'."
  (interactive)
  (let* ((time (my/astro-log-time))
         (coords (my/astro-log-coordinates))
         (rows (my/planet-positions--rows
                (my/planet-positions--data time (car coords) (cdr coords)))))
    (org-back-to-heading t)
    (org-end-of-meta-data t)
    ;; An entry with nothing after its drawer, narrowed the way a
    ;; capture buffer is, ends at :END: with no newline of its own.
    (unless (bolp) (insert "\n"))
    (insert (format "Planet positions for %s\n\n"
                    (format-time-string "%Y-%m-%d %H:%M %Z" time)))
    (let ((start (point)))
      (insert "| Planet | Altitude | Horizon | Azimuth | Direction |\n|-\n")
      (dolist (row rows)
        (insert "| " (string-join row " | ") " |\n"))
      (save-excursion (goto-char start) (org-table-align)))
    (insert "\n")))

(map! :map org-mode-map :localleader :desc "Planet positions" "a h" #'my/astro-insert-planet-positions)
#+end_src

Where the planets stand against the horizon is one question; where they
stand in the zodiac is another, and it's astrolog's default chart listing
rather than =-Z= that answers it -- one line per body, e.g. =Venu:  6Sco17
R - 7:32' ...=: the 4-column abbreviation again, the tropical position as
degree, three-letter sign and minute, then an =R= when the planet is
retrograde. =-R0= followed by the seven classical planets' object numbers
restricts the chart to just those, so no asteroid is computed and no
missing-ephemeris warning gets mixed into the output. Ecliptic longitude
is geocentric and doesn't depend on where on Earth it's asked from, so
no =-zl= location is passed, and the time goes in as UTC (=-z 0 -z0 0=,
again set before =-q=) rather than through a local zone that has to have
its DST worked out first.
#+begin_src emacs-lisp
(defconst my/planet-longitudes-signs
  '("Ari" "Tau" "Gem" "Can" "Leo" "Vir" "Lib" "Sco" "Sag" "Cap" "Aqu" "Pis")
  "Astrolog's three-letter sign abbreviations, in zodiacal order from Aries.")

(defconst my/planet-longitudes-line-re
  (rx bol (group (= 4 anything)) ": "
      (group (= 2 (any " " digit))) (group (= 3 alpha)) (group (= 2 digit))
      " " (group (any " R")))
  "Matches one body's line in astrolog's default chart listing -- the
4-column abbreviation, the position as space-padded degree, sign and
minute, then the retrograde flag.")

(defun my/planet-positions--longitudes (time)
  "Run astrolog for TIME, returning an alist of (NAME LONGITUDE RETROGRADE)
for the seven classical planets -- LONGITUDE tropical ecliptic longitude
in decimal degrees from 0° Aries, RETROGRADE non-nil if the planet is."
  (pcase-let ((`(,_ ,minute ,hour ,day ,month ,year . ,_) (decode-time time t))
              (longitudes nil))
    (with-temp-buffer
      (unless (zerop (call-process (my/planet-positions--program) nil t nil
                                   "-z" "0" "-z0" "0"
                                   "-q" (number-to-string month) (number-to-string day)
                                   (number-to-string year) (format "%d:%02d" hour minute)
                                   "-R0" "1" "2" "3" "4" "5" "6" "7"))
        (user-error "astrolog failed: %s" (buffer-string)))
      (goto-char (point-min))
      (while (re-search-forward my/planet-longitudes-line-re nil t)
        ;; Collected up front, as in `my/planet-positions--data', before
        ;; anything below can clobber the match data.
        (let ((label (match-string 1))
              (degree (string-to-number (match-string 2)))
              (sign (seq-position my/planet-longitudes-signs (match-string 3)))
              (minute (string-to-number (match-string 4)))
              (retrograde (equal (match-string 5) "R")))
          (when-let* ((name (cdr (assoc (string-trim label) my/planet-positions-abbrevs))))
            (push (list name (+ (* 30 sign) degree (/ minute 60.0)) retrograde)
                  longitudes)))))
    (nreverse longitudes)))
#+end_src

* Holiday calendar
[[file:~/Documents/org/calendar.org][calendar.org]] gets one heading per
holiday, each with its own recurring timestamp or =%%(...)= diary sexp
underneath -- the same mechanism [[*Solar times][Solar times]] uses for
lunar phases. A fixed-date holiday just needs a plain timestamp with a
=+1y= repeater; one tied to a moving calendar (equinoxes and solstices, the
Easter cycle, the Hebrew or Islamic calendars) needs actual computation.
Emacs's own =calendar= package already ships that math --
=solar.el=/=holidays.el=/=cal-hebrew.el=/=cal-islam.el= all contain pure,
year-or-date-in-date-out functions for exactly this, normally hidden behind
the interactive calendar's "is this visible in the calendar window" layer.
The functions below call that underlying math directly, so a plain diary
sexp can ask "does today match this year's spring equinox" or "what's
today's Hebrew/Islamic date" without an open calendar buffer.

** Equinoxes and solstices
=solar-equinoxes-solstices-1= is the calendar-window-independent half of
=M-x calendar-solar-equinoxes-solstices=: given a month (3, 6, 9, or 12)
and a year, it returns that quarter's event as a Gregorian date plus a
formatted time string, already adjusted for =calendar-time-zone= and DST
using the coordinates [[*Solar times][Solar times]] sets up. That's exactly
what the equinox/solstice-anchored Sabbats and the Thelemic New Year need,
since both drift by a day or so year to year rather than sitting on a
fixed Gregorian date.
#+begin_src emacs-lisp
(defun my/diary-equinox-solstice (month label)
  "Diary sexp: LABEL on whichever equinox/solstice falls nearest MONTH
(3, 6, 9, or 12) in DATE's year, local to `calendar-latitude'/
`calendar-longitude'."
  (with-no-warnings (defvar date))
  (pcase-let* ((`((,event-date ,description))
                (solar-equinoxes-solstices-1 month (calendar-extract-year date))))
    (when (calendar-date-equal date event-date)
      (format "%s (%s)" label description))))
#+end_src

** The Easter cycle
=holiday-easter-etc-abs= and =holiday-greek-orthodox-easter-abs= are the
pure Gregorian-Easter and Julian-Easter (Pascha) algorithms that
=holiday-easter-etc= and =holiday-greek-orthodox-easter= normally wrap in
calendar-window visibility checks -- called directly, they just want a
year back. Everything else in the liturgical calendar (Ash Wednesday, Palm
Sunday, Pentecost, ...) is a fixed offset from that one date, so a single
function covers the whole cycle for both the Western and Orthodox dates.
#+begin_src emacs-lisp
(require 'holidays)

(defun my/diary-paschal-offset (easter-fn offset label)
  "Diary sexp: LABEL on the day OFFSET days from the Easter/Pascha date
EASTER-FN (`holiday-easter-etc-abs' or `holiday-greek-orthodox-easter-abs')
computes for DATE's year."
  (with-no-warnings (defvar date))
  (when (= (calendar-absolute-from-gregorian date)
           (+ (funcall easter-fn (calendar-extract-year date)) offset))
    label))
#+end_src

** Hebrew calendar
=calendar-hebrew-from-absolute= converts today's date to its Hebrew
equivalent; matching the month and day against a fixed pair (Rosh Hashanah
is always 1 Tishrei) finds the holiday regardless of which Gregorian date
it lands on that year. Hebrew days begin at the preceding sunset -- the
label below says so, since there's no clock for a diary sexp to check.
#+begin_src emacs-lisp
(require 'cal-hebrew)

(defun my/diary-hebrew-holiday (month day label)
  "Diary sexp: LABEL when DATE's Hebrew-calendar equivalent is MONTH/DAY."
  (with-no-warnings (defvar date))
  (let ((hebrew (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian date))))
    (when (and (= (calendar-extract-month hebrew) month)
               (= (calendar-extract-day hebrew) day))
      label)))
#+end_src

** Islamic calendar
Same idea as the Hebrew case above, via =calendar-islamic-from-absolute=.
The Islamic calendar is purely lunar rather than lunisolar, so unlike the
Hebrew and Gregorian calendars its dates drift roughly 11 days earlier
every Gregorian year, with no leap month to correct for it.
#+begin_src emacs-lisp
(require 'cal-islam)

(defun my/diary-islamic-holiday (month day label)
  "Diary sexp: LABEL when DATE's Islamic-calendar equivalent is MONTH/DAY."
  (with-no-warnings (defvar date))
  (let ((islamic (calendar-islamic-from-absolute (calendar-absolute-from-gregorian date))))
    (when (and (= (calendar-extract-month islamic) month)
               (= (calendar-extract-day islamic) day))
      label)))
#+end_src

Neither Hindu nor Theravada Buddhist festivals get a function here --
Emacs's calendar package ships Hebrew, Islamic, Bahai, Chinese, Coptic,
French Revolutionary, Julian, Mayan, and Persian calendars, but no Hindu
one, and correctly placing either requires real astronomical tithi
calculations (solar and lunar ecliptic longitude, not just a fixed
month/day pair). [[file:~/Documents/org/calendar.org][calendar.org]] lists
those with the current cycle's Gregorian date as plain text instead of a
repeating timestamp, flagged as needing a Panchang/Buddhist calendar check
each year.

* Weather
wttr.in already knows how to turn a pair of coordinates into a forecast, so
this reuses =ASTRO_LAT=/=ASTRO_LONG= (see [[*Solar times][Solar times]])
rather than adding a second place to configure where "here" is. Its =j1=
format returns the same data wttr.in's own ASCII-art report is built from,
as plain JSON, which is easier to pick apart than scraping ANSI art.
Temperatures below are Fahrenheit throughout. The same JSON carries Celsius
alongside each one (=temp_C= next to =temp_F=, =mintempC= next to =mintempF=,
and so on), so switching is a matter of field names.
#+begin_src emacs-lisp
(require 'url)

(defconst my/weather-url
  (and calendar-latitude calendar-longitude
       (format "https://wttr.in/%s,%s?format=j1"
               (getenv "ASTRO_LAT") (getenv "ASTRO_LONG")))
  "wttr.in's JSON forecast for the coordinates in `ASTRO_LAT'/`ASTRO_LONG',
or nil if those were unset.")

(defvar my/weather-data nil
  "Parsed j1 response from the last successful `my/weather-refresh', or nil
before the first fetch completes.")
#+end_src

Fetching happens over =url-retrieve= rather than shelling out to curl --
wttr.in is a plain HTTPS JSON endpoint, so there's no external program to
wrap the way [[*Astrology][astro-transits]] wraps astrolog. The callback
always runs, whether or not the request actually succeeded, so a network
hiccup just leaves =my/weather-data= at whatever it was last, rather than
blanking out a forecast that was fine a minute ago. The request is made
silently, since otherwise url.el flashes "Contacting host: wttr.in" in the
echo area on every refresh, and without cookies, since wttr.in has no use
for them. The JSON is parsed straight out of the response buffer, from
where url-http recorded the headers ending.
#+begin_src emacs-lisp
(defun my/weather-refresh (&optional callback)
  "Fetch the current forecast asynchronously into `my/weather-data'.
Runs CALLBACK with no arguments once the fetch completes, whether or not
it succeeded."
  (interactive)
  (unless my/weather-url
    (my/solar-assert-coordinates))
  (url-retrieve
   my/weather-url
   (lambda (status)
     (unwind-protect
         (unless (plist-get status :error)
           (goto-char url-http-end-of-headers)
           (setq my/weather-data
                 (json-parse-buffer :object-type 'alist :array-type 'list)))
       (kill-buffer (current-buffer))
       (when callback (funcall callback))))
   nil t t))
#+end_src

=current_condition= and each day's =hourly= entries share the same
=weatherDesc= shape, so one accessor covers both. It trims the
description too, since wttr.in pads some of them ("Overcast ") with a
trailing space. There's no icon code in
=j1= worth trusting across wttr.in's backends, so the emoji below is just a
keyword match against the description text -- coarse, but the description
strings ("Partly cloudy", "Light rain", ...) are drawn from a short, stable
vocabulary.
#+begin_src emacs-lisp
(defun my/weather--desc (condition)
  "The description string inside a wttr.in CONDITION alist."
  (when-let* ((desc (alist-get 'value (car (alist-get 'weatherDesc condition)))))
    (string-trim desc)))

(defun my/weather--emoji (description)
  "Emoji for wttr.in's DESCRIPTION string, by keyword; ☁️ if nothing matches."
  (let ((d (downcase description)))
    (cond ((string-match-p "thunder" d) "⛈️")
          ((string-match-p "snow\\|sleet\\|blizzard\\|ice" d) "❄️")
          ((string-match-p "rain\\|drizzle\\|shower" d) "🌧️")
          ((string-match-p "fog\\|mist\\|haze" d) "🌫️")
          ((string-match-p "overcast" d) "☁️")
          ((string-match-p "cloud" d) "⛅")
          ((string-match-p "clear\\|sunny" d) "☀️")
          (t "☁️"))))

(defun my/weather-current ()
  "Current-conditions alist from `my/weather-data', or nil."
  (car (alist-get 'current_condition my/weather-data)))

(defun my/weather-days ()
  "This and the next two days' forecast alists from `my/weather-data'."
  (alist-get 'weather my/weather-data))
#+end_src

Each hourly entry's =time= is wttr.in's own encoding -- "0", "300", ...,
"2100", one per 3-hour step from midnight -- rather than a real timestamp,
so it gets its own label formatter, and combining it with its day's =date=
is what makes the blocks comparable to =current-time= at all. A day's
precipitation chance isn't a single field in =j1=; it's the highest
=chanceofrain=/=chanceofsnow= across that day's hourly entries, so that's
a small reduction rather than a straight accessor.
#+begin_src emacs-lisp
(defun my/weather--hour-label (time)
  "12-hour clock label for wttr.in's hourly TIME encoding (\"0\", \"300\",
..., \"2100\", each a 3-hour step from midnight)."
  (let* ((hour (/ (string-to-number time) 100))
         (h12 (let ((h (mod hour 12))) (if (zerop h) 12 h))))
    (format "%d %s" h12 (if (< hour 12) "AM" "PM"))))

(defun my/weather--block-start (date time)
  "Encoded start time of the 3-hour block on DATE (\"YYYY-MM-DD\") named
by wttr.in's hourly TIME encoding (see `my/weather--hour-label')."
  (pcase-let ((`(,y ,m ,d) (mapcar #'string-to-number (split-string date "-"))))
    (encode-time 0 0 (/ (string-to-number time) 100) d m y)))

(defun my/weather--timeline ()
  "Every hourly entry across `my/weather-days', each as a (START DATE
HOUR) list, in chronological order -- START is when that 3-hour block
begins and DATE is the \"YYYY-MM-DD\" it belongs to."
  (seq-mapcat (lambda (day)
                (let ((date (alist-get 'date day)))
                  (mapcar (lambda (hour)
                            (list (my/weather--block-start date (alist-get 'time hour))
                                  date hour))
                          (alist-get 'hourly day))))
              (my/weather-days)))

(defun my/weather--upcoming-hours ()
  "The next eight 3-hour blocks (~24 hours) from `my/weather-data', as
\(DATE HOUR) pairs starting with whichever block covers right now --
rolling into tomorrow once today's remaining blocks run out, rather than
stopping dead at midnight."
  (let ((now (current-time)))
    (mapcar #'cdr
            (seq-take
             (seq-filter (lambda (entry) (time-less-p now (time-add (nth 0 entry) (* 3 3600))))
                         (my/weather--timeline))
             8))))

(defun my/weather--precip-chance (day)
  "Highest chance of rain or snow, as a percentage, across DAY's hourly
entries."
  (seq-max (mapcar (lambda (hour)
                      (max (string-to-number (alist-get 'chanceofrain hour))
                           (string-to-number (alist-get 'chanceofsnow hour))))
                    (alist-get 'hourly day))))
#+end_src

=my/weather-forecast= always refetches rather than showing whatever is
cached -- it's the thing to run when the modeline's figure (stale by up to
half an hour, see [[*Wiring][Wiring]]) isn't good enough. Each day's own
description in the "coming days" section comes from its midday (~12:00)
hourly entry rather than =weather='s own daily summary, which wttr.in
doesn't otherwise provide; the "next 24 hours" section instead walks every
upcoming hourly entry, so the two sections read at different zoom levels
on purpose -- one representative snapshot per future day, full detail for
the day already in progress and whatever of tomorrow falls inside that
24-hour window. A "Today"/"Tomorrow" header marks the point where that
window crosses midnight, since "12 AM" on its own would otherwise read as
if it had looped back to today.
#+begin_src emacs-lisp
(defun my/weather-forecast ()
  "Show current conditions, the next 24 hours, and the next two days'
forecast in a `*Weather*' buffer. Always fetches fresh data -- see
`my/weather-refresh'."
  (interactive)
  (my/weather-refresh
   (lambda ()
     (unless (my/weather-current)
       (user-error "Weather fetch failed"))
     (with-help-window "*Weather*"
       (let* ((current (my/weather-current))
              (desc (my/weather--desc current))
              (days (my/weather-days))
              (today (format-time-string "%Y-%m-%d"))
              (last-date nil))
         (princ (format "%s %s, %s°F (feels like %s°F)\n"
                        (my/weather--emoji desc) desc
                        (alist-get 'temp_F current) (alist-get 'FeelsLikeF current)))
         (princ (format "Humidity %s%%, cloud cover %s%%, wind %s mph %s\n"
                        (alist-get 'humidity current)
                        (alist-get 'cloudcover current)
                        (alist-get 'windspeedMiles current)
                        (alist-get 'winddir16Point current)))
         (princ (format "UV index %s, pressure %s inHg, visibility %s mi\n\n"
                        (alist-get 'uvIndex current)
                        (alist-get 'pressureInches current)
                        (alist-get 'visibilityMiles current)))
         (princ "Next 24 hours\n")
         (pcase-dolist (`(,date ,hour) (my/weather--upcoming-hours))
           (unless (equal date last-date)
             (princ (format "  %s\n" (if (equal date today) "Today" "Tomorrow")))
             (setq last-date date))
           (let ((desc (my/weather--desc hour)))
             (princ (format "    %-5s  %s %-22s %3s°F  rain %s%%\n"
                            (my/weather--hour-label (alist-get 'time hour))
                            (my/weather--emoji desc) desc
                            (alist-get 'tempF hour) (alist-get 'chanceofrain hour)))))
         (princ "\nComing days\n")
         (dolist (day days)
           (let* ((desc (my/weather--desc (nth 4 (alist-get 'hourly day))))
                  (astronomy (car (alist-get 'astronomy day))))
             (princ (format "%s  %s %-22s %s–%s°F  rain %s%%  ↑%s ↓%s\n"
                            (alist-get 'date day) (my/weather--emoji desc) desc
                            (alist-get 'mintempF day) (alist-get 'maxtempF day)
                            (my/weather--precip-chance day)
                            (alist-get 'sunrise astronomy) (alist-get 'sunset astronomy))))))))))

(map! :leader :desc "Weather forecast" "o w" #'my/weather-forecast)
#+end_src

* Modeline
A few small facts belong in the modeline: the moon's current phase, today's
solar times and the current [[*Weather][weather]]. None of them change fast
enough to justify doom-modeline's own segment machinery, so a single string
built ahead of time is stored in =global-mode-string=, which every
doom-modeline layout already renders through its =misc-info= segment — no
need to touch =doom-modeline-def-modeline=. Weather is the odd one out
underneath, though -- see [[*Wiring][Wiring]] for why it gets its own timer
instead of riding along with the others.

Each piece is a function in =my/modeline-segments= that returns a string, or
nil when it has nothing to show. Adding a function to that list (from a
private config, say) adds it to the bar, and it is picked up at the next
minute's redraw, or at once after calling =my/modeline-astro-update=.

Each piece collapses to a single emoji with its detail moved into a
=help-echo= tooltip instead, shown on hover the same way Emacs already does
for the VC branch name or flycheck's indicator. A =|= separates whichever of
them are actually showing, via the usual trick of building the bar from a
list with the missing pieces =delq='d out before =mapconcat= joins what's
left -- an omitted piece just as naturally drops its neighboring separator,
which is what keeps the bar from ever dangling in front of a segment that
returned nil.

Whatever ends up in =global-mode-string= only keeps its text properties --
=help-echo= and =mouse-face= included -- if the /variable holding the
string/ is marked =risky-local-variable=; plain mode-line strings have
those properties stripped otherwise. =display-time-string= carries the same
marker for the same reason, so [[*Wiring][the wiring below]] does too.

The list is defined up here, ahead of the segments, so that anything adding
to it later finds it already bound.
#+begin_src emacs-lisp
(defvar my/modeline-segments
  '(my/lunar-current-phase-emoji
    my/modeline-solar-times-string
    my/modeline-weather-string)
  "Functions whose strings make up `my/modeline-astro-string', in order.
Each is called with no arguments and returns a string, or nil to be left
out of the bar.")
#+end_src

** Current lunar phase
=lunar-phase-names= (set in [[*Solar times][Solar times]]) only names the
four quarter events =diary-lunar-phases= reports on the days they fall. The
modeline wants a phase for every day in between, so this measures elapsed
time since a reference new moon (2000-01-06 18:14 UTC, the usual epoch for
this approximation) against the mean synodic month and buckets the result
into eighths. That's accurate to within a few hours, plenty for a modeline
decoration — =lunar-phase='s own event-based math, the same used by
=diary-lunar-phases= and =lunar-phase-names=, stays the precise source for
the agenda and for the next new/full moon dates below, which want an actual
date rather than a fuzzy bucket.
#+begin_src emacs-lisp
(require 'lunar)

(defconst my/lunar-phases
  [("🌑" . "New Moon") ("🌒" . "Waxing Crescent") ("🌓" . "First Quarter")
   ("🌔" . "Waxing Gibbous") ("🌕" . "Full Moon") ("🌖" . "Waning Gibbous")
   ("🌗" . "Last Quarter") ("🌘" . "Waning Crescent")]
  "The moon's phase, at eighths of the way through its cycle, as (EMOJI . NAME).")
#+end_src

The next new and full moon dates come from walking =lunar-phase= forward a
quarter at a time -- =lunar-index= gives a starting lunation for today, and
each step either lands on the wanted phase or doesn't, in which case the
next one is a quarter-cycle later. At most a few iterations either way,
since new and full are always at most two quarters apart.
#+begin_src emacs-lisp
(defun my/lunar-next-phase (phase-index)
  "The next `lunar-phase' event for PHASE-INDEX (0 new, 2 full) on or after today."
  (let* ((today (calendar-current-date))
         (index (lunar-index today))
         (event (lunar-phase index)))
    (while (or (/= (nth 2 event) phase-index)
               (calendar-date-compare event (list today)))
      (setq index (1+ index)
            event (lunar-phase index)))
    event))

(defun my/lunar-next-events-string ()
  "Next new and full moon dates, soonest first, for the lunar tooltip.
Emoji rather than names, from `my/lunar-phases', and no year -- both are
redundant in a tooltip about the next few weeks."
  (let ((events (list (cons (car (aref my/lunar-phases 0)) (my/lunar-next-phase 0))
                       (cons (car (aref my/lunar-phases 4)) (my/lunar-next-phase 2))))
        (calendar-date-display-form '((if dayname (concat dayname ", ")) monthname " " day)))
    (mapconcat (lambda (e) (format "%s %s" (car e) (calendar-date-string (cadr e))))
               (sort events (lambda (a b) (calendar-date-compare (cdr a) (cdr b))))
               "\n")))
#+end_src

The tooltip itself just stacks the current phase's name over that: the
bucketed approximation for "now," the precise event math for "next."
#+begin_src emacs-lisp
(defun my/lunar-current-phase-emoji ()
  "Emoji for the moon's current phase; its name and the next new/full moon
as a hover tooltip."
  (let* ((synodic-month 29.530588853)
         (reference-new-moon (encode-time 0 14 18 6 1 2000 t))
         (days-elapsed (/ (float-time (time-subtract (current-time) reference-new-moon))
                          86400.0))
         (fraction (mod (/ days-elapsed synodic-month) 1.0))
         (phase (aref my/lunar-phases (min 7 (floor (* fraction 8))))))
    (propertize (car phase)
                'help-echo (concat (cdr phase) "\n" (my/lunar-next-events-string))
                'mouse-face 'mode-line-highlight)))
#+end_src

** Current solar times
[[*Solar times][=my/solar-times=]] hands back four raw decimal hours; the
diary sexp spells them out inline with labels, but the modeline collapses
them behind a single sun and puts the same labelled text in a tooltip
instead, one line per time so it reads like a little popup rather than a
run-on sentence.
#+begin_src emacs-lisp
(defun my/modeline-solar-times-string ()
  "Sun emoji for the modeline, the day's solar times as a hover tooltip."
  (when-let* ((times (my/solar-times)))
    (pcase-let ((`(,rise ,noon ,set ,midnight ,zone) times))
      (propertize
       "☀️"
       'help-echo (format "🌅 Sunrise %s\n☀️ Solar noon %s\n🌇 Sunset %s\n🌃 Solar midnight %s"
                           (solar-time-string rise zone)
                           (solar-time-string noon zone)
                           (solar-time-string set zone)
                           (solar-time-string midnight zone))
       'mouse-face 'mode-line-highlight))))
#+end_src

** Current weather
Mirrors [[*Current solar times][the sun above]]: an icon from
[[*Weather][=my/weather--emoji=]] for the mode line itself, with the numbers
-- current temperature and feel, then today's and the next two days' highs
and lows -- pushed into the tooltip instead. Nil until the first
[[*Wiring][scheduled]] =my/weather-refresh= completes, so it drops out of the
bar rather than showing an empty slot.
#+begin_src emacs-lisp
(defun my/modeline-weather-string ()
  "Weather emoji for the modeline; current conditions and the next two
days' highs/lows as a hover tooltip. Nil until the first `my/weather-refresh'
completes."
  (when-let* ((current (my/weather-current))
              (desc (my/weather--desc current)))
    (propertize
     (my/weather--emoji desc)
     'help-echo (mapconcat
                 #'identity
                 (cons (format "%s, %s°F (feels like %s°F)"
                               desc (alist-get 'temp_F current) (alist-get 'FeelsLikeF current))
                       (mapcar (lambda (day)
                                 (format "%s: %s–%s°F" (alist-get 'date day)
                                         (alist-get 'mintempF day) (alist-get 'maxtempF day)))
                               (my/weather-days)))
                 "\n")
     'mouse-face 'mode-line-highlight)))
#+end_src

** Wiring
=global-mode-string= is a list of mode-line constructs; a symbol placed in it
is re-evaluated on every redisplay — the same mechanism =display-time-mode=
uses for =display-time-string= — so pushing the variable itself in once is
enough, no need to keep re-adding the current string.

Mode-line spec lists have a trap here: a list whose /first/ element is a
bare symbol is read as =(CONDITION THEN [ELSE])=, not as content, so if this
variable ever ended up as the head of =global-mode-string= it would be
silently used as a boolean flag instead of displayed. Jabber, for one, adds
its own entry later, once it has activity to show, and appended after an
otherwise-empty =global-mode-string= it makes the whole thing quietly stop
rendering. =display-time-mode= guards
against this the same way: seed the list with a leading string first, so its
head is always a plain string and everything after it is read as a sequence
to concatenate rather than a condition to test.

The timer mirrors =display-time='s own: =(run-at-time t 60 ...)= starts now
and re-fires every minute on the minute, and =force-mode-line-update= after
each recompute covers the case where nothing else would have triggered a
redraw.

The timer itself lives in a =defvar=, not a bare =run-at-time= call, because
this file gets re-evaluated far more often than Emacs restarts —
=org-auto-tangle= retangles on every save, and reloading the tangled
=config.el= is a normal way to pick that up. =defvar='s init form only runs
the first time the variable is unbound, so re-evaluating this block on a
reload leaves the original timer running instead of starting a second one
alongside it.
=risky-local-variable= is what makes the =help-echo=/=mouse-face= properties
on the lunar and solar emoji actually survive into the displayed mode line,
for the reason given [[*Modeline][above]] -- without it Emacs would strip
them and the tooltips would just silently never show.

Weather is the exception to all of this: it needs an actual network round
trip rather than a pure function of local state, so folding it into the
60-second timer above would mean hitting wttr.in every minute regardless of
whether its answer could plausibly have changed. It gets a second timer
instead, refetching every 30 minutes via [[*Weather][=my/weather-refresh=]],
whose callback is =my/modeline-astro-update= itself -- so the icon updates
as soon as that fetch lands instead of sitting stale for up to a minute
until the fast timer's next tick happens to notice the new
=my/weather-data=.
#+begin_src emacs-lisp
(defvar my/modeline-astro-string ""
  "Modeline string built from `my/modeline-segments'.")
(put 'my/modeline-astro-string 'risky-local-variable t)

(defun my/modeline-astro-update ()
  "Recompute `my/modeline-astro-string' and redraw the modeline."
  (setq my/modeline-astro-string
        (concat " " (mapconcat #'identity
                               (delq nil (mapcar #'funcall my/modeline-segments))
                               " | ")))
  (force-mode-line-update 'all))

(or global-mode-string (setq global-mode-string '("")))
(add-to-list 'global-mode-string 'my/modeline-astro-string 'append)
(my/modeline-astro-update)

(defvar my/modeline-astro-timer
  (run-at-time t 60 #'my/modeline-astro-update)
  "Timer that keeps `my/modeline-astro-string' refreshed every minute.")

(defvar my/weather-refresh-timer
  (when my/weather-url
    (my/weather-refresh #'my/modeline-astro-update)
    (run-at-time 1800 1800 (lambda () (my/weather-refresh #'my/modeline-astro-update))))
  "Timer that refetches `my/weather-data' every 30 minutes, redrawing the
modeline as soon as each fetch completes rather than waiting for the
minute-interval timer above to notice. nil when there is no location to
fetch weather for.")
#+end_src

* Daemon
Doom's default =SPC q r= (=doom/restart=) assumes it owns the daemon's
lifecycle, but this instance runs under the =emacs.service= systemd user
unit, so that command just leaves the unit's process state out of sync.
Restart through =systemctl= instead, then reopen a frame once the new daemon
is ready. The restart-and-reopen script has to run as its own transient unit
via =systemd-run=, not as a plain child process of Emacs: =emacs.service= has
=KillMode=control-group=, so a child would sit in its control group and get
killed along with the daemon before it could reopen anything.
#+begin_src emacs-lisp
(defun my/restart-emacs-daemon ()
  "Restart the Emacs daemon via `systemctl --user restart' and reopen a frame."
  (interactive)
  (call-process "systemd-run" nil 0 nil
                "--user" "--collect" "--"
                "sh" "-c" "systemctl --user restart emacs.service && emacsclient -c"))

(map! :leader :desc "Restart daemon (systemctl)" "q r" #'my/restart-emacs-daemon)
#+end_src

* Claude Code
claude-code.el drives the actual Claude Code CLI inside a terminal buffer, so
it authenticates and bills however that CLI already does, not through a
separate API key. It defaults to the =eat= terminal backend; =vterm= is already
loaded for the [[file:init.el]] =:term= module, so this switches to that instead
of pulling in a second terminal emulator. The command map lives under =C-c c=
rather than the leader key, per upstream's own convention, and does not
collide with anything else here.
#+begin_src emacs-lisp
(use-package! claude-code
  :bind-keymap ("C-c c" . claude-code-command-map)
  :init
  (setq claude-code-terminal-backend 'vterm)
  :config
  (claude-code-mode))
#+end_src

* TMSU
File tagging from dired, plus =tmsu:= links in org. Mounting, tagging, and
querying all live under the =t= prefix in Dirvish's normal-state keymap,
alongside the existing =y= (yank) and =s= (symlink) prefixes from the
=dired= module. =tmsu-dired-rename-repair-mode= keeps tags attached to
files that get renamed or moved from within dired.

=tmsu mount= takes no arguments to list what's currently mounted, in
=db-path TAB at TAB mountpoint= lines; ~my/tmsu-mounts~ parses that for the
unmount and jump-to-mount prompts.

=O= (capital) shows every tag as an overlay with no prompt, where lowercase
=o= prompts for which tags to show. =I= manages tag implications
(=tmsu imply=) so a query like ~instrument~ can stand in for
~saxophone or piano or guitar~; implications apply at query time, so they're
retroactive and don't need existing tags redone. Implied tags only show up
in queries, not in the =o=/=O= overlays or the =e= edit prompt, since those
go through ~tmsu tags --explicit~.

=R= runs ~my/tmsu-repair~ for when tagged files get deleted outside of
dired, which otherwise leaves the database pointing at nothing and
surfaces as =ls= errors inline in query results. It previews
=tmsu repair --pretend= in a buffer and, only on confirmation, reruns
with =--remove= to actually drop those files' tags; declining, or a
clean pretend run, makes no change.

=tmsu-dired-query= normally pops its results into a fresh window with
~pop-to-buffer-same-window~, which Dirvish's root window refuses (it's
dedicated), so Emacs splits a new window instead and the preview pane is
lost. ~my/tmsu-dired-query-dirvish-a~ advises it to temporarily lift that
dedication (via [[*Reusing Dirvish's window][my/dirvish-reusing-window]]) so the query reuses the
current window, then adopts the results buffer into the live Dirvish
session the same way Dirvish adopts any other directory buffer:
~dirvish-prop :dv~/=:attrs=/=:preview-dps=/=:gui= so attribute rendering
and preview dispatch have what they need, ~dirvish--setup-dired~ for the
redisplay/attrs/kill-buffer hooks (this is also what makes
~dirvish--dir-data~ a real hash table instead of nil, which attribute
rendering needs), and ~dv-index~ so the preview pane resolves against
this buffer rather than the one it replaced. It's a no-op outside of
Dirvish. =q= in the results is rebound (after ~dirvish--setup-dired~ would
otherwise remap it to ~dirvish-quit~) to restore the directory the query
came from and kill the results buffer, instead of tearing down the
session. This leans on a few undocumented Dirvish internals (window
dedication, the ~dv~ struct, ~dirvish-prop~, ~dirvish--setup-dired~), read
from Dirvish's own source rather than its public API and confirmed
against a real Dirvish session in batch Emacs, so a future Dirvish update
could still change their behavior.

~dv-index~ is set with ~my/dirvish-set-index~ (=aset= plus
~cl-struct-slot-offset~) rather than =(setf (dv-index dv) ...)=: Dirvish's
~dirvish~ struct doesn't exist yet when this file is compiled, since
Dirvish itself is still lazily deferred at that point, and a =setf= place
expanded under those conditions bakes in a call to a function that never
exists, breaking even once Dirvish has since loaded. Plain function
calls like =aset= don't have this problem since they're resolved by name
each time they run, not fixed at compile time.
#+begin_src emacs-lisp
(defcustom my/tmsu-mount-directory "~/tmsu"
  "Default parent directory offered when prompting for a TMSU mount point."
  :type 'directory)

(defun my/tmsu-mounts ()
  "Return an alist of (MOUNTPOINT . DATABASE) for mounted TMSU filesystems."
  (with-temp-buffer
    (process-file "tmsu" nil t nil "mount")
    (mapcar (lambda (line)
              (let ((fields (split-string line "\t")))
                (cons (car (last fields)) (car fields))))
            (split-string (string-trim (buffer-string)) "\n" t))))

(defun my/tmsu-mount (mountpoint &optional database)
  "Mount a TMSU virtual filesystem at MOUNTPOINT and open it in dired.

With a prefix arg, prompt for a specific DATABASE file; otherwise TMSU's
usual discovery (TMSU_DB, then the nearest .tmsu, then the default
database) applies."
  (interactive
   (list (read-directory-name "Mount point: " my/tmsu-mount-directory)
         (when current-prefix-arg
           (read-file-name "Database: "))))
  (make-directory mountpoint t)
  (let ((args (append (when database (list (file-local-name database)))
                       (list (file-local-name mountpoint)))))
    (unless (zerop (apply #'process-file "tmsu" nil nil nil "mount" args))
      (error "tmsu mount failed")))
  (dired mountpoint))

(defun my/tmsu-mount-dired (mountpoint)
  "Open dired on an already-mounted TMSU virtual filesystem."
  (interactive
   (let ((mounts (my/tmsu-mounts)))
     (unless mounts (user-error "No TMSU filesystems mounted"))
     (list (completing-read "TMSU mount: " mounts nil t))))
  (dired mountpoint))

(defun my/tmsu-unmount (mountpoint)
  "Unmount the TMSU virtual filesystem at MOUNTPOINT."
  (interactive
   (let ((mounts (my/tmsu-mounts)))
     (unless mounts (user-error "No TMSU filesystems mounted"))
     (list (if (cdr mounts)
               (completing-read "Unmount: " mounts nil t)
             (caar mounts)))))
  (unless (zerop (process-file "tmsu" nil nil nil "unmount" (file-local-name mountpoint)))
    (error "tmsu unmount failed"))
  (when-let* ((buf (dired-find-buffer-nocreate (file-name-as-directory mountpoint))))
    (kill-buffer buf))
  (message "Unmounted %s" mountpoint))

(defun my/tmsu-dired-edit-marked ()
  "Edit TMSU tags of each marked file in turn, or the file at point."
  (interactive)
  (dolist (file (dired-get-marked-files))
    (tmsu-edit file)))

(defun my/tmsu-init (dir)
  "Initialize a new TMSU database in DIR.

Safe to run again on a directory that already has one; TMSU leaves
the existing database untouched."
  (interactive (list (if (eq major-mode 'dired-mode)
                         (dired-current-directory)
                       default-directory)))
  (unless (zerop (process-file "tmsu" nil nil nil "init" (file-local-name dir)))
    (error "tmsu init failed"))
  (message "Initialized TMSU database in %s" dir))

(defun my/tmsu-dired-overlay-all ()
  "Show TMSU tag overlays for every tag, without prompting."
  (interactive nil dired-mode)
  (require 'tmsu-dired-overlay)
  (unless (tmsu-database-p)
    (error "No TMSU database"))
  (tmsu-dired-overlay-delete-overlays)
  (tmsu-dired-overlay-create-overlays))

(defun my/tmsu-imply--candidates ()
  "Return the current TMSU tag implications as \"TAG -> IMPL\" strings."
  (with-temp-buffer
    (process-file "tmsu" nil t nil "imply")
    (split-string (string-trim (buffer-string)) "\n" t)))

(defun my/tmsu-imply-list ()
  "Show the current TMSU tag implications in a buffer."
  (interactive)
  (unless (tmsu-database-p)
    (error "No TMSU database"))
  (with-current-buffer (get-buffer-create "*TMSU implications*")
    (erase-buffer)
    (insert (string-join (or (my/tmsu-imply--candidates)
                              (list "No implications defined."))
                          "\n")
            "\n")
    (goto-char (point-min))
    (view-mode 1)
    (pop-to-buffer (current-buffer))))

(defun my/tmsu-imply-create (tag implication)
  "Make TAG imply IMPLICATION for all future TMSU queries."
  (interactive
   (list (completing-read "Tag: " (tmsu-get-tags) nil nil nil 'tmsu-query-history)
         (completing-read "Implies: " (tmsu-get-tags) nil nil nil 'tmsu-query-history)))
  (unless (zerop (process-file "tmsu" nil nil nil "imply" tag implication))
    (error "tmsu imply failed"))
  (message "%s -> %s" tag implication))

(defun my/tmsu-imply-delete (implication)
  "Delete an existing TMSU tag IMPLICATION (a \"TAG -> IMPL\" string)."
  (interactive
   (list (completing-read "Delete implication: " (my/tmsu-imply--candidates) nil t)))
  (let* ((parts (split-string implication "\\s-*->\\s-*"))
         (tag (string-trim (car parts)))
         (impl (string-trim (cadr parts))))
    (unless (zerop (process-file "tmsu" nil nil nil "imply" "--delete" tag impl))
      (error "tmsu imply --delete failed"))
    (message "Deleted: %s -> %s" tag impl)))

(defun my/tmsu-imply ()
  "Create, list, or delete a TMSU tag implication."
  (interactive)
  (unless (tmsu-database-p)
    (error "No TMSU database"))
  (pcase (completing-read "Implication: " '("create" "list" "delete") nil t)
    ("create" (call-interactively #'my/tmsu-imply-create))
    ("list"   (my/tmsu-imply-list))
    ("delete" (call-interactively #'my/tmsu-imply-delete))))

(defun my/tmsu-repair ()
  "Drop TMSU tags left behind by files that no longer exist.

Runs `tmsu repair --pretend' and shows what it found; with nothing to
fix, just reports the database clean. Otherwise asks for confirmation
before re-running with `--remove' to actually drop those files' tags."
  (interactive)
  (unless (tmsu-database-p)
    (error "No TMSU database"))
  (with-current-buffer (get-buffer-create "*TMSU repair*")
    (let ((inhibit-read-only t))
      (erase-buffer)
      (process-file "tmsu" nil t nil "repair" "--pretend")
      (goto-char (point-min)))
    (if (= (point-min) (point-max))
        (progn (message "TMSU database is clean.")
               (kill-buffer))
      (view-mode 1)
      (pop-to-buffer (current-buffer))
      (if (y-or-n-p "Remove tags for the missing files above? ")
          (let ((inhibit-read-only t))
            (erase-buffer)
            (process-file "tmsu" nil t nil "repair" "--remove")
            (goto-char (point-min))
            (message "TMSU database repaired."))
        (quit-window)))))

(use-package! tmsu
  :after dired
  :config
  (tmsu-dired-rename-repair-mode 1))

(use-package! ol-tmsu
  :when (executable-find "tmsu")
  :after org)

(after! (tmsu-dired dirvish)
  (defvar my/tmsu-dired-query-returns (make-hash-table :test 'eq)
    "Buffer -> (DV . OLD-DV-INDEX), keyed by buffer object rather than a
buffer-local variable because `tmsu-dired-query' calls
`kill-all-local-variables' on every refresh, including when reverting its
own results buffer, which would otherwise wipe the saved return state.")

  (defun my/dirvish-set-index (dv index)
    "Set DV's `dv-index' slot to INDEX.

Uses `aset' with `cl-struct-slot-offset' instead of `(setf (dv-index dv)
...)'. Dirvish's `dirvish' struct only exists once Dirvish has loaded,
but this file gets compiled before that happens; a `setf' place expanded
that early bakes in a call to a nonexistent `(setf dv-index)' function
that keeps failing even after Dirvish loads and the struct exists. `aset'
and `cl-struct-slot-offset' are plain functions resolved by name at call
time, so they aren't affected by what was or wasn't loaded at compile
time."
    (aset dv (cl-struct-slot-offset 'dirvish 'index) index))

  (defun my/tmsu-dired-query-quit ()
    "Leave a TMSU query view, restoring the Dirvish directory it came from."
    (interactive)
    (if-let* ((state (gethash (current-buffer) my/tmsu-dired-query-returns))
              (dv (car state))
              (old-index (cdr state))
              (old-buf (cdr old-index))
              ((buffer-live-p old-buf)))
        (let ((qbuf (current-buffer)))
          (my/dirvish-set-index dv old-index)
          (my/dirvish-reusing-window (switch-to-buffer old-buf))
          (kill-buffer qbuf))
      (quit-window)))

  (defun my/tmsu-dired-query-dirvish-a (orig-fn &rest args)
    "Make `tmsu-dired-query' replace the current Dirvish directory in place.

Reuses Dirvish's window and preview layout instead of popping a separate
window, and rebinds `q' in the results buffer to return to the directory
the query was run from. A no-op outside of an active Dirvish session."
    (let* ((dv (dirvish-curr))
           (old-index (and dv (dv-index dv))))
      (if (not dv)
          (apply orig-fn args)
        (my/dirvish-reusing-window (apply orig-fn args))
        (let ((qbuf (current-buffer)))
          (with-current-buffer qbuf
            (dirvish-prop :dv (dv-id dv))
            (dirvish-prop :attrs (dv-attributes dv))
            (dirvish-prop :preview-dps (dv-preview-dispatchers dv))
            (dirvish-prop :gui (display-graphic-p))
            (dirvish-prop :root default-directory)
            (dirvish--setup-dired)
            (add-hook 'kill-buffer-hook
                      (let ((buf qbuf))
                        (lambda () (remhash buf my/tmsu-dired-query-returns)))
                      nil t)
            (unless (gethash qbuf my/tmsu-dired-query-returns)
              (puthash qbuf (cons dv old-index) my/tmsu-dired-query-returns))
            (evil-local-set-key 'normal "q" #'my/tmsu-dired-query-quit))
          (my/dirvish-set-index
           dv (cons (file-name-as-directory (expand-file-name default-directory))
                    qbuf))
          (dirvish--setup-mode-line dv)))))

  (advice-add #'tmsu-dired-query :around #'my/tmsu-dired-query-dirvish-a)

  (map! :map dirvish-mode-map
        (:prefix ("t" . "tmsu")
         :n "m" #'my/tmsu-mount
         :n "u" #'my/tmsu-unmount
         :n "j" #'my/tmsu-mount-dired
         :n "i" #'my/tmsu-init
         :n "a" #'tmsu-dired-tags-add
         :n "r" #'tmsu-dired-tags-remove
         :n "e" #'my/tmsu-dired-edit-marked
         :n "d" #'tmsu-dired-edit-directory
         :n "o" #'tmsu-dired-overlay
         :n "O" #'my/tmsu-dired-overlay-all
         :n "q" #'tmsu-dired-query
         :n "I" #'my/tmsu-imply
         :n "R" #'my/tmsu-repair)))
#+end_src

* Private overlay
Anything personal (names, accounts, paths on one machine, sections not meant
to be shared) lives in =private/config.el=, beside this file, tangled from
=private/config.org= the same way this file is. It loads last, so it can
change any setting above, add to lists like =my/modeline-segments= or
=org-capture-templates=, and define commands of its own. The directory is its
own git repository, ignored by this one, and the config works without it.

The settings this config expects from there:

| Setting                               | Used by                                |
|---------------------------------------+----------------------------------------|
| =user-full-name=, =user-mail-address= | Email (the address names the maildir)  |
| =my/jabber-accounts=                  | Jabber                                 |
| =set-irc-server!= calls               | IRC                                    |
| =my/blog-site-directory=              | Blog                                   |
#+begin_src emacs-lisp
(load! "private/config" doom-user-dir t)
#+end_src