summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorskylar <me@casper>2026-11-01 07:03:26 -0800
committerskylar <me@casper>2026-11-01 07:03:26 -0800
commit070a107873440d62b4519e6d91c2ba739d4b6fa2 (patch)
treeae4e1c3540cdd01b3289ed6f96ec3ea69507f73e
Literate Doom Emacs configuration
config.org tangles to config.el, which loads private/config.el last when it exists. bin/ holds the scripts some sections drive. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
Diffstat
-rw-r--r--.gitignore6
-rw-r--r--README.md10
-rw-r--r--bin/README.md19
-rwxr-xr-xbin/astro-transits75
-rwxr-xr-xbin/docsync314
-rwxr-xr-xbin/imgcollage122
-rw-r--r--bin/photocollage/__init__.py0
-rw-r--r--bin/photocollage/collage.py568
-rw-r--r--bin/photocollage/render.py313
-rwxr-xr-xbin/system-theme29
-rw-r--r--bin/systemd/docsync-backup.service8
-rw-r--r--bin/systemd/docsync-backup.timer10
-rw-r--r--bin/systemd/docsync-check.service8
-rw-r--r--bin/systemd/docsync-check.timer10
-rw-r--r--bin/systemd/docsync-forget.service8
-rw-r--r--bin/systemd/docsync-forget.timer10
-rw-r--r--config.el4652
-rw-r--r--config.org6100
-rw-r--r--init.el220
-rw-r--r--movie-grid.el208
-rw-r--r--packages.el32
-rw-r--r--snippets/org-mode/isotope5
22 files changed, 12727 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..a40d85c
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,6 @@
+# The private overlay is its own repository; see "Private overlay" in config.org.
+/private/
+# Written by Emacs's Customize; nothing here is meant to live there.
+/custom.el
+/nov-places
+__pycache__/
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..01ae7fd
--- /dev/null
+++ b/README.md
@@ -0,0 +1,10 @@
+# Doom Emacs configuration
+
+A literate [Doom Emacs](https://github.com/doomemacs/doomemacs) configuration:
+everything is in [config.org](config.org), which tangles to `config.el`. Most of
+it is Org (GTD, journals, a magical record, flashcards, a blog), with reading,
+astronomy and astrology, music theory, mail and chat, and file management
+around it.
+
+See *Using it* at the top of `config.org` for setup. Scripts that some sections
+drive are in [bin/](bin/).
diff --git a/bin/README.md b/bin/README.md
new file mode 100644
index 0000000..6c32c13
--- /dev/null
+++ b/bin/README.md
@@ -0,0 +1,19 @@
+# bin/
+
+Scripts that sections of `config.org` drive. Each is a terminal program first,
+and the config looks for it on `PATH` before falling back to this directory.
+
+| Script | Used by | Needs |
+|------------------|----------------------------|-----------------------------------------|
+| `astro-transits` | Astrology | astrolog, imv (or `ASTRO_VIEWER`) |
+| `docsync` | Backups | restic, ssh, jq, notify-send |
+| `imgcollage` | Media thumbnails > Collage | Python 3, Pillow |
+| `system-theme` | Appearance > Theme | the COSMIC desktop |
+
+Each script's header or usage message (`docsync help`) says how to set it up.
+`systemd/` holds docsync's user units: copy them to `~/.config/systemd/user/`,
+put `docsync` at `~/.local/bin/docsync`, and enable the three timers.
+
+`photocollage/` is vendored unchanged from
+[PhotoCollage](https://github.com/adrienverge/PhotoCollage) by Adrien Vergé,
+and is licensed GPL-2.0-or-later, as its file headers say.
diff --git a/bin/astro-transits b/bin/astro-transits
new file mode 100755
index 0000000..8455050
--- /dev/null
+++ b/bin/astro-transits
@@ -0,0 +1,75 @@
+#!/usr/bin/env bash
+set -e
+
+# The current sky against a natal chart, with astrolog: an ordered transit
+# table and a biwheel image.
+#
+# ASTRO_LAT, ASTRO_LONG where you are, signed decimal degrees (N and E positive)
+# ASTRO_ZONE your standard (winter) UTC offset in hours west,
+# e.g. 5 for New York, -1 for Berlin
+# ASTRO_NATAL the natal chart, an astrolog chart file
+# (default ~/.local/share/astrology/natal.dat)
+# ASTROLOG astrolog's data directory, holding the Swiss
+# Ephemeris files; without seas_18.se1,
+# Chiron/Ceres/Pallas/Juno/Vesta come out as 0Ari00
+# ASTRO_VIEWER image viewer that stays open until closed (default imv)
+#
+# With --emacs, prints TABLE=path and IMAGE=path instead of showing them.
+
+: "${ASTRO_LAT:?set ASTRO_LAT to your latitude}"
+: "${ASTRO_LONG:?set ASTRO_LONG to your longitude}"
+: "${ASTRO_ZONE:?set ASTRO_ZONE to your standard UTC offset in hours west}"
+NATAL="${ASTRO_NATAL:-$HOME/.local/share/astrology/natal.dat}"
+: "${ASTROLOG:=$HOME/.local/share/astrolog}"
+export ASTROLOG
+[ -f "$NATAL" ] || { echo "astro-transits: no natal chart at $NATAL" >&2; exit 1; }
+
+# astrolog wants coordinates as DD:MMH, not the signed decimal degrees
+# ASTRO_LAT/ASTRO_LONG are stored as.
+to_dms() {
+ awk -v v="$1" -v pos="$2" -v neg="$3" 'BEGIN {
+ h = (v < 0) ? neg : pos
+ v = (v < 0) ? -v : v
+ d = int(v)
+ m = int((v - d) * 60 + 0.5)
+ if (m == 60) { d++; m = 0 }
+ printf "%d:%02d%s", d, m, h
+ }'
+}
+LAT_DMS=$(to_dms "$ASTRO_LAT" N S)
+LONG_DMS=$(to_dms "$ASTRO_LONG" E W)
+
+# ASTRO_ZONE is the standard (winter) UTC offset in hours west; derive
+# whether the current moment is in daylight time by comparing it to
+# the actual local UTC offset right now.
+off=$(date +%z)
+sign=${off:0:1}
+offset_min=$((10#${off:1:2} * 60 + 10#${off:3:2}))
+[ "$sign" = "-" ] && offset_min=$(( -offset_min ))
+standard_min=$(( -ASTRO_ZONE * 60 ))
+if [ "$offset_min" -ne "$standard_min" ]; then DAYLIGHT=1; else DAYLIGHT=0; fi
+
+COMMON_ARGS=(-zl "$LONG_DMS" "$LAT_DMS" -z "$ASTRO_ZONE" -z0 "$DAYLIGHT")
+
+TABLE=$(mktemp --suffix=.txt)
+IMAGE=$(mktemp --suffix=.png)
+
+# --emacs hands back the table/image paths instead of displaying them,
+# so a caller (e.g. Emacs) takes ownership of the files and their
+# cleanup; only clean up here if we fail before handing them off.
+if [ "$1" = "--emacs" ]; then
+ trap 'rm -f "$TABLE" "$IMAGE"' ERR
+else
+ trap 'rm -f "$TABLE" "$IMAGE"' EXIT
+fi
+
+astrolog "${COMMON_ARGS[@]}" -i "$NATAL" -Tn -os "$TABLE" >/dev/null
+astrolog "${COMMON_ARGS[@]}" -y "$NATAL" -X -Xbp -Xo "$IMAGE" >/dev/null
+
+if [ "$1" = "--emacs" ]; then
+ echo "TABLE=$TABLE"
+ echo "IMAGE=$IMAGE"
+else
+ cat "$TABLE"
+ "${ASTRO_VIEWER:-imv}" "$IMAGE"
+fi
diff --git a/bin/docsync b/bin/docsync
new file mode 100755
index 0000000..5f0c19c
--- /dev/null
+++ b/bin/docsync
@@ -0,0 +1,314 @@
+#!/usr/bin/env bash
+set -euo pipefail
+
+CONFIG_DIR="${XDG_CONFIG_HOME:-$HOME/.config}/docsync"
+STATE_DIR="${XDG_STATE_HOME:-$HOME/.local/state}/docsync"
+INCLUDE_FILE="$CONFIG_DIR/include"
+EXCLUDE_FILE="$CONFIG_DIR/exclude"
+
+# The repository is reached over SFTP. $CONFIG_DIR/config sets SSH_HOST to a
+# Host in ~/.ssh/config that logs in without a prompt (a key, BatchMode-safe),
+# and may set REPO_PATH, the repository's path on that host. The password
+# file holds the repository's password, kept in a file so the timer never
+# waits on a prompt; restic's other keys (a paper recovery passphrase, say)
+# still open the repository as usual.
+SSH_HOST=
+REPO_PATH=repo
+# shellcheck source=/dev/null
+[[ -f "$CONFIG_DIR/config" ]] && . "$CONFIG_DIR/config"
+export RESTIC_REPOSITORY="sftp:$SSH_HOST:$REPO_PATH"
+export RESTIC_PASSWORD_FILE="$CONFIG_DIR/restic-password"
+
+# Every docsync snapshot carries this tag, and snapshots are grouped by host
+# and tag rather than by path list, so adding or dropping a path continues the
+# same history (and retention) instead of starting a new one.
+TAG=docsync
+GROUP_BY=host,tags
+
+# Retention for 'docsync forget': every hourly snapshot for two days, then one
+# a day for a month, one a week for a year, and one a month for good.
+KEEP=(--keep-hourly 48 --keep-daily 30 --keep-weekly 52 --keep-monthly unlimited)
+
+# How much of the stored data 'docsync check' downloads and verifies per run.
+CHECK_SUBSET=5%
+
+# Desktop notifications (only when run by a systemd timer): a failure while the
+# server is reachable is worth hearing about soon, being offline only once no
+# backup has landed for a day. At most one notification per window either way.
+ERROR_NOTIFY_EVERY=$((6 * 3600))
+OFFLINE_NOTIFY_AFTER=$((24 * 3600))
+
+usage() {
+ cat <<EOF
+Usage: docsync COMMAND
+
+ backup take a snapshot now (the hourly timer runs this)
+ forget thin out old snapshots and free their space (weekly timer)
+ check verify the repository and $CHECK_SUBSET of its data (monthly timer)
+ status when the last backup landed, and the latest snapshots
+ paths the paths and exclude patterns a backup would use
+ manifest rewrite the list of files in the latest snapshot (backup does this)
+ restic ARGS any restic command against the repository, e.g.
+ docsync restic snapshots
+ docsync restic mount ~/mnt/docsync
+
+Setup, all in $CONFIG_DIR:
+ config shell assignments: SSH_HOST=<a Host in ~/.ssh/config>,
+ and optionally REPO_PATH=<path on it> (default: repo)
+ restic-password the repository's password, mode 600
+ include one path per line, relative to ~ unless it starts with /
+ exclude restic exclude patterns; a leading ~/ means your home
+Blank lines and lines starting with # are ignored in include and exclude.
+Create the repository once with: docsync restic init
+The systemd units beside this script run backup hourly, forget weekly and
+check monthly; they expect it at ~/.local/bin/docsync.
+
+State for other tools (Emacs) is in $STATE_DIR:
+ last-success epoch seconds of the last backup that saved a snapshot
+ last-result "EPOCH STATUS MESSAGE", STATUS one of ok, warning, offline, error
+ missing include paths that didn't exist at the last backup
+ manifest every file in the latest snapshot as TYPE SIZE MTIME PATH,
+ tab-separated (jq @tsv escaping), after a "# snapshot ID TIME"
+ line; Emacs compares it with the disk to mark what's changed
+EOF
+}
+
+die() { echo "docsync: $*" >&2; exit 1; }
+
+now() { date +%s; }
+
+# A list file's entries, without comments, blank lines or surrounding space.
+list_lines() {
+ [[ -f "$1" ]] || return 0
+ sed -e 's/^[[:space:]]*//' -e 's/[[:space:]]*$//' -e '/^#/d' -e '/^$/d' "$1"
+}
+
+include_paths() {
+ local p
+ list_lines "$INCLUDE_FILE" | while IFS= read -r p; do
+ p="${p#\~/}"
+ [[ "$p" == /* ]] || p="$HOME/$p"
+ [[ "$p" == / ]] || p="${p%/}"
+ printf '%s\n' "$p"
+ done
+}
+
+exclude_patterns() {
+ local p
+ list_lines "$EXCLUDE_FILE" | while IFS= read -r p; do
+ [[ "$p" == "~/"* ]] && p="$HOME/${p#\~/}"
+ printf '%s\n' "$p"
+ done
+}
+
+# ---------------------------------------------------------------- state
+
+put_state() { # NAME LINE...
+ if (( $# > 1 )); then printf '%s\n' "${@:2}"; fi > "$STATE_DIR/$1.tmp"
+ mv "$STATE_DIR/$1.tmp" "$STATE_DIR/$1"
+}
+
+get_state() { # NAME DEFAULT
+ if [[ -s "$STATE_DIR/$1" ]]; then head -n1 "$STATE_DIR/$1"; else printf '%s\n' "$2"; fi
+}
+
+notify() { # WINDOW URGENCY MESSAGE
+ [[ -n "${INVOCATION_ID:-}" ]] || return 0
+ local last; last=$(get_state notified 0)
+ (( $(now) - last >= $1 )) || return 0
+ notify-send -a docsync -u "$2" docsync "$3" 2>/dev/null || true
+ put_state notified "$(now)"
+}
+
+# A run that dies mid-operation (the server dropping off during a prune, say)
+# leaves its lock behind, and restic never clears one by itself: every later
+# run would wait out --retry-lock and fail. Without --remove-all, unlock
+# removes only stale locks, ones whose process has exited or that haven't been
+# refreshed for 30 minutes (a running restic refreshes its lock every 5).
+unlock_stale() {
+ restic unlock || true
+}
+
+# A cheap "is the server reachable" probe. With an SFTP-only account, whose
+# forced command answers any login with an SFTP server that exits at EOF, this
+# still returns as soon as the connection is up.
+reachable() {
+ ssh -o BatchMode=yes "$SSH_HOST" true </dev/null >/dev/null 2>&1
+}
+
+# Not a failure (a laptop's network comes and goes, and the next hourly run
+# tries again), so only worth a notification once no backup has landed for a day.
+backup_offline() {
+ put_state last-result "$(now) offline can't reach $SSH_HOST"
+ if (( $(now) - $(get_state last-success 0) >= OFFLINE_NOTIFY_AFTER )); then
+ notify "$OFFLINE_NOTIFY_AFTER" normal "No backup for over a day: can't reach $SSH_HOST."
+ fi
+ echo "docsync: can't reach $SSH_HOST, skipping this backup" >&2
+ exit 0
+}
+
+ago() { # EPOCH
+ local s=$(( $(now) - $1 ))
+ if (( s < 90 )); then echo "just now"
+ elif (( s < 5400 )); then echo "$(( s / 60 )) min ago"
+ elif (( s < 172800 )); then echo "$(( s / 3600 )) h ago"
+ else echo "$(( s / 86400 )) days ago"
+ fi
+}
+
+# ---------------------------------------------------------------- commands
+
+# Every file in the latest snapshot with its size and modification time, so
+# Emacs can tell what has changed since without asking the repository. A
+# failure keeps the old manifest: Emacs then shows more as changed than has,
+# never less.
+cmd_manifest() {
+ mkdir -p "$STATE_DIR"
+ local out="$STATE_DIR/manifest"
+ if restic ls --json --tag "$TAG" latest 2>/dev/null | jq -r '
+ if .struct_type == "snapshot" then "# snapshot \(.id) \(.time)"
+ elif .struct_type == "node" then [.type, (.size // 0), .mtime, .path] | @tsv
+ else empty end' > "$out.tmp"; then
+ mv "$out.tmp" "$out"
+ else
+ rm -f "$out.tmp"
+ echo "docsync: couldn't list the latest snapshot; the manifest is stale" >&2
+ return 1
+ fi
+}
+
+cmd_backup() {
+ mkdir -p "$STATE_DIR"
+ exec 9>"$STATE_DIR/lock"
+ flock -n 9 || { echo "docsync: a backup is already running" >&2; exit 0; }
+
+ [[ -f "$RESTIC_PASSWORD_FILE" ]] ||
+ die "no password file; put the repository's password in $RESTIC_PASSWORD_FILE (mode 600)"
+ [[ -f "$INCLUDE_FILE" ]] || die "nothing to back up: $INCLUDE_FILE is missing"
+
+ # Global, not local: the EXIT trap runs after this function has returned.
+ tmp=$(mktemp -d)
+ trap 'rm -rf "$tmp"' EXIT
+
+ local -a present=() missing=()
+ local p
+ while IFS= read -r p; do
+ if [[ -e "$p" || -L "$p" ]]; then present+=("$p"); else missing+=("$p"); fi
+ done < <(include_paths)
+ put_state missing "${missing[@]}"
+ for p in "${missing[@]}"; do echo "docsync: listed but missing: $p" >&2; done
+
+ if (( ${#present[@]} == 0 )); then
+ put_state last-result "$(now) error none of the listed paths exist"
+ notify "$ERROR_NOTIFY_EVERY" critical "Backup failed: none of the listed paths exist."
+ die "none of the paths in $INCLUDE_FILE exist"
+ fi
+ printf '%s\n' "${present[@]}" > "$tmp/include"
+ exclude_patterns > "$tmp/exclude"
+
+ reachable || backup_offline
+ unlock_stale
+ local rc=0
+ restic backup \
+ --files-from-verbatim "$tmp/include" \
+ --exclude-file "$tmp/exclude" \
+ --exclude-caches \
+ --tag "$TAG" --group-by "$GROUP_BY" \
+ --skip-if-unchanged \
+ --retry-lock 1h \
+ 2>"$tmp/err" || rc=$?
+ # Echoed by bash rather than cat: journald files a line under its unit by
+ # looking up the writing process, and cat has exited by then, so restic's
+ # error would be missing from journalctl --user -u docsync-backup.
+ [[ ! -s "$tmp/err" ]] || printf '%s\n' "$(<"$tmp/err")" >&2
+ local err; err=$(grep -v '^[[:space:]]*$' "$tmp/err" | tail -n1 || true)
+
+ case $rc in
+ 0|3) put_state last-success "$(now)"
+ rm -f "$STATE_DIR/notified"
+ cmd_manifest || true ;;
+ esac
+ case $rc in
+ 0) if (( ${#missing[@]} )); then
+ put_state last-result "$(now) warning ${#missing[@]} listed path(s) missing"
+ notify "$ERROR_NOTIFY_EVERY" normal "Backed up, but ${#missing[@]} listed path(s) no longer exist."
+ else
+ put_state last-result "$(now) ok"
+ fi ;;
+ 3) put_state last-result "$(now) warning some files couldn't be read: $err"
+ notify "$ERROR_NOTIFY_EVERY" normal "Backed up, but some files couldn't be read." ;;
+ *) # Losing the server partway through is being offline, not an error.
+ reachable || backup_offline
+ put_state last-result "$(now) error ${err:-restic exited with $rc}"
+ notify "$ERROR_NOTIFY_EVERY" critical "Backup failed: ${err:-restic exited with $rc}"
+ exit "$rc" ;;
+ esac
+}
+
+# forget and check: on failure under a timer, say so, unless the server dropped
+# off; the next scheduled run clears the stale lock that leaves and starts over.
+maintenance() { # WHAT RESTIC-ARGS...
+ local what=$1; shift
+ unlock_stale
+ if ! restic "$@" --retry-lock 1h; then
+ [[ -n "${INVOCATION_ID:-}" ]] && reachable &&
+ notify-send -a docsync -u critical docsync "docsync $what failed; see journalctl --user -u docsync-$what" 2>/dev/null
+ exit 1
+ fi
+}
+
+cmd_forget() {
+ maintenance forget forget --tag "$TAG" --group-by "$GROUP_BY" "${KEEP[@]}" --prune
+}
+
+cmd_check() {
+ maintenance check check --read-data-subset "$CHECK_SUBSET"
+}
+
+cmd_status() {
+ local last result
+ last=$(get_state last-success "")
+ result=$(get_state last-result "")
+ if [[ -n "$last" ]]; then
+ echo "Last backup: $(date -d "@$last" '+%F %R') ($(ago "$last"))"
+ else
+ echo "Last backup: never"
+ fi
+ if [[ -n "$result" ]]; then
+ read -r when status msg <<<"$result"
+ echo "Last run: $(date -d "@$when" '+%F %R') $status${msg:+: $msg}"
+ fi
+ if [[ -s "$STATE_DIR/missing" ]]; then
+ echo "Missing:"; sed 's/^/ /' "$STATE_DIR/missing"
+ fi
+ echo
+ restic snapshots --tag "$TAG" --group-by "$GROUP_BY" --latest 5 --compact ||
+ echo "(couldn't list snapshots; is $SSH_HOST reachable?)"
+}
+
+cmd_paths() {
+ local p
+ echo "Include:"
+ include_paths | while IFS= read -r p; do
+ if [[ -e "$p" || -L "$p" ]]; then echo " $p"; else echo " $p (missing)"; fi
+ done
+ echo "Exclude:"
+ exclude_patterns | sed 's/^/ /'
+}
+
+case "${1:-}" in
+ backup|forget|check|status|manifest|restic)
+ [[ -n "$SSH_HOST" ]] || die "set SSH_HOST in $CONFIG_DIR/config" ;;
+esac
+
+case "${1:-}" in
+ backup) cmd_backup ;;
+ forget) cmd_forget ;;
+ check) cmd_check ;;
+ status) cmd_status ;;
+ paths) cmd_paths ;;
+ manifest) cmd_manifest ;;
+ restic) shift; exec restic "$@" ;;
+ -h|--help|help|"") usage ;;
+ *) usage >&2; exit 2 ;;
+esac
diff --git a/bin/imgcollage b/bin/imgcollage
new file mode 100755
index 0000000..6211f87
--- /dev/null
+++ b/bin/imgcollage
@@ -0,0 +1,122 @@
+#!/usr/bin/env python3
+"""imgcollage: build a single masonry-style collage image from a folder.
+
+A headless CLI wrapper around the layout/rendering engine from PhotoCollage
+(https://github.com/adrienverge/PhotoCollage, GPL-2.0-or-later). It reuses
+that project's `photocollage.collage` and `photocollage.render` modules
+verbatim (vendored alongside this script) and drives them with the same
+auto-layout heuristic PhotoCollage's GTK app uses (see UserCollage.make_page
+in its gtkgui.py), without needing GTK/pycairo or any GUI at all.
+"""
+import argparse
+import math
+import os
+import random
+import sys
+
+sys.path.insert(0, os.path.dirname(os.path.abspath(__file__)))
+
+from photocollage import collage, render # noqa: E402
+
+IMAGE_EXTS = {".jpg", ".jpeg", ".png", ".bmp", ".tif", ".tiff", ".webp"}
+
+
+def collect_images(paths):
+ files = []
+ skipped = []
+ for p in paths:
+ if os.path.isdir(p):
+ for name in sorted(os.listdir(p)):
+ full = os.path.join(p, name)
+ if os.path.splitext(name)[1].lower() in IMAGE_EXTS:
+ files.append(full)
+ elif os.path.isfile(full):
+ skipped.append(full)
+ elif os.path.splitext(p)[1].lower() in IMAGE_EXTS:
+ files.append(p)
+ else:
+ skipped.append(p)
+ if skipped:
+ print(f"Ignoring {len(skipped)} non-image file(s): "
+ f"{', '.join(os.path.basename(s) for s in skipped)}",
+ file=sys.stderr)
+ return files
+
+
+def auto_no_cols(photolist, ratio):
+ avg_ratio = sum(p.h / p.w for p in photolist) / len(photolist)
+ virtual_no_imgs = 2 * len(photolist)
+ return max(1, int(round(math.sqrt(avg_ratio / ratio * virtual_no_imgs))))
+
+
+def main():
+ ap = argparse.ArgumentParser(
+ description="Arrange a folder of differently-sized images into one "
+ "masonry-style collage image, auto-computing the layout.")
+ ap.add_argument("images", nargs="+",
+ help="image files and/or directories of images")
+ ap.add_argument("-o", "--output", default="collage.jpg",
+ help="output file (default: collage.jpg)")
+ ap.add_argument("-W", "--width", type=int, default=2000,
+ help="output width in px (default: 2000)")
+ ap.add_argument("-H", "--height", type=int, default=1500,
+ help="output height in px (default: 1500)")
+ ap.add_argument("-c", "--cols", type=int, default=0,
+ help="number of columns (default: auto)")
+ ap.add_argument("-b", "--border", type=float, default=1.0,
+ help="border width as %% of poster size (default: 1.0, "
+ "use 0 for no border)")
+ ap.add_argument("--border-color", default="black",
+ help="border color, any PIL-recognized name/hex "
+ "(default: black)")
+ ap.add_argument("--seed", type=int, default=None,
+ help="random seed, for a reproducible layout")
+ args = ap.parse_args()
+
+ if args.seed is not None:
+ random.seed(args.seed)
+
+ filelist = collect_images(args.images)
+ if not filelist:
+ sys.exit("No images found.")
+
+ try:
+ photolist = render.build_photolist(filelist)
+ except render.BadPhoto as e:
+ sys.exit(f"Could not read image: {e.photoname}")
+
+ ratio = args.height / args.width
+ no_cols = args.cols or auto_no_cols(photolist, ratio)
+
+ page = collage.Page(1.0, ratio, no_cols)
+ random.shuffle(photolist)
+ for photo in photolist:
+ page.add_cell(photo)
+ page.adjust()
+
+ enlargement = args.width / page.w
+ page.scale(enlargement)
+
+ errors = []
+
+ task = render.RenderingTask(
+ page,
+ border_width=args.border / 100.0 * max(page.w, page.h),
+ border_color=args.border_color,
+ quality=render.QUALITY_BEST,
+ output_file=args.output,
+ on_fail=errors.append,
+ )
+ task.run() # run synchronously in this thread; no need for start()/join()
+
+ if errors:
+ sys.exit(f"Rendering failed: {errors[0]}")
+
+ if os.path.exists(args.output):
+ print(f"Wrote {args.output} "
+ f"({int(page.w)}x{int(page.h)}, {no_cols} columns, "
+ f"{len(photolist)} images)")
+
+
+if __name__ == "__main__":
+ main()
diff --git a/bin/photocollage/__init__.py b/bin/photocollage/__init__.py
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/bin/photocollage/__init__.py
diff --git a/bin/photocollage/collage.py b/bin/photocollage/collage.py
new file mode 100644
index 0000000..134735b
--- /dev/null
+++ b/bin/photocollage/collage.py
@@ -0,0 +1,568 @@
+# Copyright (C) 2014 Adrien Vergé
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+import random
+
+"""
+Summary of collage objects:
+
+----------------------
+| |
+| |
+| Page | The "Page" object represents the whole page that
+| | will give the final assembled image.
+| |
+----------------------
+
+----------------------
+| | | |
+| |Column| |
+| | |Column| A page is divided into columns.
+|Column| | |
+| | | |
+----------------------
+
+----------------------
+| Cell | Cell | Each column contains cells. When a
+|------| x--|----- CellExtent is located in several columns,
+| Cell |-------------| its "extended" flag is set, and a
+|------| Cell | | CellExtent object is added to the
+| Cell | | Cell | column on the right to reserve the
+---------------------- place.
+
+ ,------> Photo
+ / ,---------> Photo
+----------------------
+| | | Each cell is associated
+|------| | to a photo.
+| |-------------|
+|------| | |----> Photo
+| | | |
+----------------------
+ `----------> Photo
+
+The layout placing process is divided in three phases.
+
+Phase A: Fill columns with photos.
+ Photos are added to columns, one by one, until there are no more photos.
+ Each new photo is put in the smallest column, so as to have balanced
+ columns. If two columns have approximately the same height, a photo can be
+ "extended" to fit two columns. In this case, the "Cell" object is put in
+ the first column, and the second column takes a "CellExtent" object to
+ reserve the taken space.
+
+Phase B: Set all columns to same height.
+ A global common height is computed for all columns, and every of them is
+ stressed or extended to this common length. This can result in a decrease
+ or increase in columns' width.
+
+Phase C: Adapt columns' width.
+ Since cells in a column may have different widths, each column width is set
+ to the smallest width amongst its images.
+
+"""
+
+
+class Photo:
+ def __init__(self, filename, w, h, orientation=0):
+ self.filename = filename
+ self.w = w
+ self.h = h
+ self.orientation = orientation
+ self.offset_w = 0.5
+ self.offset_h = 0.5
+
+ @property
+ def ratio(self):
+ return float(self.h) / float(self.w)
+
+ def move(self, x, y):
+ self.offset_w = self.calculate_new_offset(self.offset_w, x)
+ self.offset_h = self.calculate_new_offset(self.offset_h, y)
+
+ @staticmethod
+ def calculate_new_offset(offset, value):
+ new_offset = offset + value
+ if new_offset < 0:
+ new_offset = 0
+ elif new_offset > 1:
+ new_offset = 1
+ return new_offset
+
+
+class Cell:
+ """Represents a cell in a column
+
+ Properties:
+ <- x -><- w ->
+ ---------------------- ^
+ | | | |y
+ |------| | |
+ | |-------------| v
+ |------| Cell | | ^
+ | | | | |h
+ ---------------------- v
+
+ """
+ def __init__(self, parents, photo):
+ self.parents = parents
+ self.photo = photo
+ self.extent = None
+ self.h = self.w * self.wanted_ratio
+
+ def __repr__(self):
+ """Representation of the cell in ASCII art"""
+ end = "]"
+ if self.extent is not None:
+ end = "--"
+ return "[%d %d%s" % (self.w, self.h, end)
+
+ @property
+ def x(self):
+ return self.parents[0].x
+
+ @property
+ def y(self):
+ """Returns the cell's y coordinate
+
+ It assumes that the cell is in a single column, so it is the previous
+ cell's y + h.
+
+ """
+ prev = None
+ for c in self.parents[0].cells:
+ if self is c:
+ if prev:
+ return prev.y + prev.h
+ return 0
+ prev = c
+
+ @property
+ def w(self):
+ return sum(c.w for c in self.parents)
+
+ @property
+ def ratio(self):
+ return self.h / self.w
+
+ @property
+ def wanted_ratio(self):
+ return self.photo.ratio
+
+ def scale(self, alpha):
+ self.h *= alpha
+
+ def is_extended(self):
+ return hasattr(self, 'extent') and self.extent is not None
+
+ def is_extension(self):
+ return isinstance(self, CellExtent)
+
+ def content_coords(self):
+ """Returns the coordinates of the contained image
+
+ These are computed in order not to loose space, so the content area
+ will always be greater than the cell itself. It is the space taken by
+ the contained image if it wasn't cropped.
+
+ """
+ # If the contained image is too thick to fit
+ if self.wanted_ratio < self.ratio:
+ h = self.h
+ w = self.h / self.wanted_ratio
+ y = self.y
+ x = self.x - (w - self.w) / 2.0
+ # If the contained image is too tall to fit
+ elif self.wanted_ratio > self.ratio:
+ w = self.w
+ h = self.w * self.wanted_ratio
+ x = self.x
+ y = self.y - (h - self.h) / 2.0
+ else:
+ w = self.w
+ h = self.h
+ x = self.x
+ y = self.y
+ return x, y, w, h
+
+ def top_neighbor(self):
+ """Returns the cell above this one"""
+ prev = None
+ for c in self.parents[0].cells:
+ if self is c:
+ return prev
+ prev = c
+
+ def bottom_neighbor(self):
+ """Returns the cell below this one"""
+ prev = None
+ for c in reversed(self.parents[0].cells):
+ if self is c:
+ return prev
+ prev = c
+
+
+class CellExtent(Cell):
+ def __init__(self, cell):
+ self.origin = cell
+ self.origin.extent = self
+
+ def __repr__(self):
+ """Representation of the cell in ASCII art"""
+ return "------]"
+
+ @property
+ def parents(self):
+ return (self.origin.parents[1],)
+
+ @property
+ def photo(self):
+ return self.origin.photo
+
+ @property
+ def y(self):
+ return self.origin.y
+
+ @property
+ def h(self):
+ return self.origin.h
+
+ def scale(self, alpha):
+ pass
+
+
+class Column:
+ """Represents a column in a page
+
+ Properties:
+ <----- x ----><-- w ->
+ ---------------------- ^
+ | | | | |
+ | | | |
+ | | |Column| h
+ | | | |
+ -------| | | |
+ | |------- v
+ --------
+
+ """
+ def __init__(self, parent, w):
+ self.parent = parent
+ self.cells = []
+ self.w = w
+
+ def __repr__(self):
+ """Representation of the column in ASCII art"""
+ return "\n".join(c.__repr__() for c in self.cells)
+
+ @property
+ def h(self):
+ """Returns the column's total height
+
+ This is not simply the sum of its cells heights, because there can be
+ empty spaces between cells.
+
+ """
+ if not self.cells:
+ return 0
+ return self.cells[-1].y + self.cells[-1].h
+
+ @property
+ def x(self):
+ x = 0
+ for c in self.parent.cols:
+ if self is c:
+ break
+ x += c.w
+ return x
+
+ def scale(self, alpha):
+ self.w *= alpha
+ for c in self.cells:
+ c.scale(alpha)
+
+ def left_neighbor(self):
+ """Returns the column on the left of this one"""
+ prev = None
+ for c in self.parent.cols:
+ if self is c:
+ return prev
+ prev = c
+
+ def right_neighbor(self):
+ """Returns the column on the right of this one"""
+ prev = None
+ for c in reversed(self.parent.cols):
+ if self is c:
+ return prev
+ prev = c
+
+ def adjust_height(self, target_h):
+ """Set the column's height to a given value by resizing cells"""
+ # First, make groups of "movable" cells. Since cell extents are not
+ # movable, these groups only contain pure cell objects. We only resize
+ # those groups.
+ class Group:
+ def __init__(self, y):
+ self.y = y
+ self.h = 0
+ self.cells = []
+
+ groups = []
+ groups.append(Group(0))
+ for c in self.cells:
+ # While a cell extent is not reached, keep add cells to the group
+ if not c.is_extension():
+ groups[-1].cells.append(c)
+ else:
+ # Close current group and create a new one
+ groups[-1].h = c.y - groups[-1].y
+ groups.append(Group(c.y + c.h))
+ groups[-1].h = target_h - groups[-1].y
+
+ # Adjust height for each group independently
+ for group in groups:
+ if not group.cells:
+ continue
+ alpha = group.h / sum(c.h for c in group.cells)
+ for c in group.cells:
+ c.h = c.h * alpha
+
+
+class Page:
+ """Represents a whole page
+
+ Properties:
+ <-------- w -------->
+ ---------------------- ^
+ | | |
+ | |
+ | Page | h
+ | |
+ | | |
+ ---------------------- v
+
+ """
+ def __init__(self, w, target_ratio, no_cols):
+ self.target_ratio = target_ratio
+ col_w = float(w)/no_cols
+ self.cols = []
+ for i in range(no_cols):
+ self.cols.append(Column(self, col_w))
+
+ def __repr__(self):
+ """Representation of the page in ASCII art
+
+ Returns something like:
+ [62 52] [125 134-- ------] [62 87]
+ [62 47] [62 66] [125 132-- [62 45]
+ [62 46] ------] [62 49] ------]
+ [62 78] ------] [62 49] [62 45]
+ [125 102-- ------] [62 49] [62 65]
+ [125 135-- [62 85] [62 53]
+ [125 91-- [125 89-- [62 64]
+ ------]
+ """
+ lines = []
+ n = 0
+ end = False
+ while not end:
+ lines.append("")
+ end = True
+ for col in self.cols:
+ cells = col.__repr__().split("\n")
+ w = max(len(cell) for cell in cells)
+ if col != self.cols[-1]:
+ w += 1
+ cell = w * " "
+ if n < len(cells):
+ cell = cells[n] + (w - len(cells[n])) * " "
+ if n < len(cells) - 1:
+ end = False
+ lines[-1] += cell
+ n += 1
+ return "\n".join(lines)
+
+ @property
+ def no_cols(self):
+ return len(self.cols)
+
+ @property
+ def w(self):
+ return sum(c.w for c in self.cols)
+
+ @property
+ def h(self):
+ return max(c.h for c in self.cols)
+
+ @property
+ def ratio(self):
+ return self.h / self.w
+
+ def scale(self, alpha):
+ for c in self.cols:
+ c.scale(alpha)
+
+ def scale_to_fit(self, max_w, max_h=None):
+ if max_h is None or self.w * max_h > self.h * max_w:
+ self.scale(max_w / self.w)
+ else:
+ self.scale(max_h / self.h)
+
+ def next_free_col(self):
+ """Returns the column with lowest height"""
+ minimum = min(c.h for c in self.cols)
+ candidates = []
+ for c in self.cols:
+ if c.h == minimum:
+ candidates.append(c)
+ return random.choice(candidates)
+
+ def add_cell_single_col(self, col, photo):
+ col.cells.append(Cell((col,), photo))
+
+ def add_cell_multi_col(self, col1, col2, photo):
+ cell = Cell((col1, col2), photo)
+ extent = CellExtent(cell)
+ col1.cells.append(cell)
+ col2.cells.append(extent)
+
+ def add_cell(self, photo):
+ """Add a new cell in the best computed place
+
+ If possible, and if it's worth, make a "multiple-column" cell.
+
+ """
+ col = self.next_free_col()
+ left = col.left_neighbor()
+ right = col.right_neighbor()
+ if 2 * random.random() > photo.ratio:
+ if left and abs(col.h - left.h) < 0.5 * col.w:
+ return self.add_cell_multi_col(left, col, photo)
+ elif right and abs(col.h - right.h) < 0.5 * col.w:
+ return self.add_cell_multi_col(col, right, photo)
+
+ self.add_cell_single_col(col, photo)
+
+ def remove_empty_cols(self):
+ i = 0
+ while i < len(self.cols):
+ if len(self.cols[i].cells) == 0:
+ self.cols.pop(i)
+ else:
+ i += 1
+
+ def remove_bottom_holes(self):
+ """Remove holes created by extended cells
+
+ Example (case A):
+ The bottom-right cell should be extended to fill the hole.
+ ---------------------- ----------------------
+ | | | | | | | |
+ | |-------------| | |-------------|
+ |------| | |------| |
+ | |-------------- | |--------------
+ | | | ^ | | ^ | |
+ --------------- hole -------- hole --------
+
+ Example (case B):
+ The bottom cell should be moved under the other extended cell.
+ ---------------------- ----------------------
+ | | | | | | | |
+ |------|-------------| |-------------|------|
+ | | | | | |
+ |--------------------- ---------------------|
+ | | <-- hole hole -> | |
+ --------------- ---------------
+
+ """
+ for col in self.cols:
+ cell = col.cells[-1]
+ if cell == col.cells[0]:
+ continue
+
+ # Case A
+ # If cell is not extended, is below an extended cell and has no
+ # neighbour under the latter, it should be extended.
+ if not cell.is_extended() and not cell.is_extension():
+ # Case A1
+ if cell.top_neighbor().is_extended() \
+ and cell.top_neighbor().extent \
+ .bottom_neighbor() is None:
+ # Extend cell to right
+ extent = CellExtent(cell)
+ col.right_neighbor().cells.append(extent)
+ cell.parents = (col, col.right_neighbor())
+ # Case A2
+ elif cell.top_neighbor().is_extension() \
+ and cell.top_neighbor().origin \
+ .bottom_neighbor() is None:
+ # Extend cell to left
+ col.cells.remove(cell)
+ col.left_neighbor().cells.append(cell)
+ extent = CellExtent(cell)
+ col.cells.append(extent)
+ cell.parents = (col.left_neighbor(), col)
+ # Case B
+ # If cell is extended and one of the cells above is extended too,
+ # the bottom cell should be placed right below the top one.
+ elif cell.is_extended() and cell.extent.bottom_neighbor() is None:
+ # Case B1
+ if cell.extent.top_neighbor().is_extended() \
+ and cell.extent.top_neighbor().extent \
+ .bottom_neighbor() is None:
+ # Move cell to right
+ col.cells.remove(cell)
+ col.right_neighbor().cells.remove(cell.extent)
+ col.right_neighbor().cells.append(cell)
+ col.right_neighbor().right_neighbor().cells \
+ .append(cell.extent)
+ cell.parents = (col.right_neighbor(),
+ col.right_neighbor().right_neighbor())
+ # Case B2
+ elif cell.top_neighbor().is_extension() \
+ and cell.top_neighbor().origin \
+ .bottom_neighbor() is None:
+ # Move cell to left
+ col.cells.remove(cell)
+ col.right_neighbor().cells.remove(cell.extent)
+ col.left_neighbor().cells.append(cell)
+ col.cells.append(cell.extent)
+ cell.parents = (col.left_neighbor(), col)
+
+ def adjust_cols_heights(self):
+ """Set all columns' heights to same value by shrinking them"""
+ target_h = self.w * self.target_ratio
+ for c in self.cols:
+ c.adjust_height(target_h)
+
+ def adjust(self):
+ self.remove_empty_cols()
+ self.remove_bottom_holes()
+ self.adjust_cols_heights()
+
+ def get_cell_at_position(self, x, y):
+ for col in self.cols:
+ if x >= col.x and x < col.x + col.w:
+ for cell in col.cells:
+ if y >= cell.y and y < cell.y + cell.h:
+ if cell.is_extension():
+ return cell.origin
+ return cell
+ return None
+
+ def swap_photos(self, cell1, cell2):
+ cell1.photo, cell2.photo = cell2.photo, cell1.photo
diff --git a/bin/photocollage/render.py b/bin/photocollage/render.py
new file mode 100644
index 0000000..f9b9024
--- /dev/null
+++ b/bin/photocollage/render.py
@@ -0,0 +1,313 @@
+# Copyright (C) 2014 Adrien Vergé
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+import random
+from threading import Thread
+import time
+
+import PIL.Image
+import PIL.ImageDraw
+import PIL.ImageFile
+
+from photocollage.collage import Photo
+
+
+QUALITY_SKEL = 0
+QUALITY_FAST = 1
+QUALITY_BEST = 2
+
+
+# Try to continue even if the input file is corrupted.
+# See issue at https://github.com/adrienverge/PhotoCollage/issues/65
+PIL.ImageFile.LOAD_TRUNCATED_IMAGES = True
+
+
+class PIL_SUPPORTED_EXTS:
+ """File extensions supported by PIL
+
+ Compiled from:
+ - http://pillow.readthedocs.org/en/2.3.0/handbook/image-file-formats.html
+ - https://github.com/python-imaging/Pillow/blob/master/PIL/*ImagePlugin.py
+
+ """
+ RW = {
+ "BMP": ("bmp",),
+ # "EPS": ("ps", "eps",), # doesn't seem to work
+ "GIF": ("gif",),
+ "IM": ("im",),
+ "JPEG": ("jfif", "jpe", "jpg", "jpeg",),
+ "MSP": ("msp",),
+ "PCX": ("pcx",),
+ "PNG": ("png",),
+ "PPM": ("pbm", "pgm", "ppm",),
+ "TGA": ("tga",),
+ "TIFF": ("tif", "tiff",),
+ "WebP": ("webp",),
+ "XBM": ("xbm",),
+ }
+ RO = {
+ "CUR": ("cur",),
+ "DCX": ("dcx",),
+ "FLI": ("fli", "flc",),
+ "FPX": ("fpx",),
+ "GBR": ("gbr",),
+ "ICO": ("ico",),
+ "IPTC/NAA": ("iim",),
+ "PCD": ("pcd",),
+ "PSD": ("psd",),
+ "SGI": ("bw", "rgb", "rgba", "sgi",),
+ "XPM": ("xpm",),
+ }
+ WO = {
+ # "PALM": ("palm",), # doesn't seem to work
+ # "PDF": ("pdf",), # doesn't seem to work
+ }
+
+
+def random_color():
+ r = random.randrange(256)
+ g = random.randrange(256)
+ b = random.randrange(256)
+ if r + g + b > 0.7 * 3 * 256:
+ r -= 50
+ g -= 50
+ b -= 50
+ return (r, g, b)
+
+
+class BadPhoto(Exception):
+ def __init__(self, photoname):
+ self.photoname = photoname
+
+
+def build_photolist(filelist):
+ ret = []
+
+ for name in filelist:
+ try:
+ img = PIL.Image.open(name)
+ except OSError:
+ raise BadPhoto(name)
+ w, h = img.size
+
+ orientation = 0
+ try:
+ exif = img._getexif()
+ if 274 in exif: # orientation tag
+ orientation = exif[274]
+ if orientation == 6 or orientation == 8:
+ w, h = h, w
+ except Exception:
+ pass
+
+ ret.append(Photo(name, w, h, orientation))
+ return ret
+
+
+cache = {}
+
+
+class RenderingTask(Thread):
+ """Execution thread to do the actual poster rendering
+
+ Image computation is a heavy task, that can take several seconds. During
+ this, the program might be unresponding. To avoid this, rendering is done
+ is a separated thread.
+
+ """
+ def __init__(self, page, border_width=0.01, border_color=(0, 0, 0),
+ quality=QUALITY_FAST, output_file=None,
+ on_update=None, on_complete=None, on_fail=None):
+ super().__init__()
+
+ self.page = page
+ self.border_width = border_width
+ self.border_color = border_color
+ self.quality = quality
+
+ self.output_file = output_file
+
+ self.on_update = on_update
+ self.on_complete = on_complete
+ self.on_fail = on_fail
+
+ self.canceled = False
+
+ def abort(self):
+ self.canceled = True
+
+ def draw_skeleton(self, canvas):
+ for col in self.page.cols:
+ for c in col.cells:
+ if c.is_extension():
+ continue
+ color = random_color()
+ x, y, w, h = c.content_coords()
+ xy = (x, y)
+ xY = (x, y + h - 1)
+ Xy = (x + w - 1, y)
+ XY = (x + w - 1, y + h - 1)
+
+ draw = PIL.ImageDraw.Draw(canvas)
+ draw.line(xy + Xy, fill=color)
+ draw.line(xy + xY, fill=color)
+ draw.line(xY + XY, fill=color)
+ draw.line(Xy + XY, fill=color)
+ draw.line(xy + XY, fill=color)
+ draw.line(xY + Xy, fill=color)
+ return canvas
+
+ def draw_borders(self, canvas):
+ if self.border_width == 0:
+ return
+
+ W = self.page.w - 1
+ H = self.page.h - 1
+ border = self.border_width - 1
+ color = self.border_color
+
+ draw = PIL.ImageDraw.Draw(canvas)
+ draw.rectangle((0, 0) + (border, H), color)
+ draw.rectangle((W - border, 0) + (W, H), color)
+ draw.rectangle((0, 0) + (W, border), color)
+ draw.rectangle((0, H - border) + (W, H), color)
+
+ for col in self.page.cols:
+ # Draw horizontal borders
+ for c in col.cells[1:]:
+ xy = (col.x, c.y - border / 2)
+ XY = (col.x + col.w, c.y + border / 2)
+ draw.rectangle(xy + XY, color)
+ # Draw vertical borders
+ if col.x > 0:
+ for c in col.cells:
+ if not c.is_extension():
+ xy = (col.x - border / 2, c.y)
+ XY = (col.x + border / 2, c.y + c.h)
+ draw.rectangle(xy + XY, color)
+ return canvas
+
+ def resize_photo(self, cell, use_cache=False):
+ # If a thumbnail is already in cache, let's use it. But only if it is
+ # bigger than what we need, because we don't want to lose quality.
+ if (use_cache and cell.photo.filename in cache and
+ cache[cell.photo.filename].size[0] >= int(round(cell.w)) and
+ cache[cell.photo.filename].size[1] >= int(round(cell.h))):
+ img = cache[cell.photo.filename].copy()
+ else:
+ img = PIL.Image.open(cell.photo.filename)
+
+ # Rotate image is EXIF says so
+ if cell.photo.orientation == 3:
+ img = img.rotate(180, expand=True)
+ elif cell.photo.orientation == 6:
+ img = img.rotate(270, expand=True)
+ elif cell.photo.orientation == 8:
+ img = img.rotate(90, expand=True)
+
+ if self.quality == QUALITY_FAST:
+ method = PIL.Image.NEAREST
+ else:
+ method = PIL.Image.LANCZOS # renamed from ANTIALIAS in Pillow 10
+
+ shape = img.size[0] * cell.h - img.size[1] * cell.w
+ if shape > 0: # image is too thick
+ img = img.resize((int(round(cell.h * img.size[0] / img.size[1])),
+ int(round(cell.h))), method)
+ elif shape < 0: # image is too tall
+ img = img.resize((int(round(cell.w)),
+ int(round(cell.w * img.size[1] / img.size[0]))),
+ method)
+ else:
+ img = img.resize((int(round(cell.w)), int(round(cell.h))), method)
+
+ # Save this new image to cache (if it is larger than the previous one)
+ if (use_cache and (cell.photo.filename not in cache or
+ cache[cell.photo.filename].size[0] < img.size[0])):
+ cache[cell.photo.filename] = img
+
+ if shape > 0: # image is too thick
+ width_to_crop = img.size[0] - cell.w
+ img = img.crop((
+ int(round(width_to_crop * cell.photo.offset_w)),
+ 0,
+ int(round(img.size[0] - width_to_crop *
+ (1 - cell.photo.offset_w))),
+ int(round(cell.h))
+ ))
+ elif shape < 0: # image is too tall
+ height_to_crop = img.size[1] - cell.h
+ img = img.crop((
+ 0,
+ int(round(height_to_crop * cell.photo.offset_h)),
+ int(round(cell.w)),
+ int(round(img.size[1] - height_to_crop *
+ (1 - cell.photo.offset_h)))
+ ))
+
+ return img
+
+ def paste_photo(self, canvas, cell, img):
+ canvas.paste(img, (int(round(cell.x)), int(round(cell.y))))
+ return canvas
+
+ def run(self):
+ try:
+ canvas = PIL.Image.new(
+ "RGB", (int(self.page.w), int(self.page.h)), "white")
+
+ self.draw_skeleton(canvas)
+ self.draw_borders(canvas)
+
+ if self.quality != QUALITY_SKEL:
+ n = sum([len([cell for cell in col.cells if not
+ cell.is_extension()]) for col in self.page.cols])
+ i = 0.0
+ if self.on_update:
+ self.on_update(canvas, 0.0)
+ last_update = time.time()
+
+ for col in self.page.cols:
+ for c in col.cells:
+ if self.canceled: # someone clicked "abort"
+ return
+
+ if c.is_extension():
+ continue
+
+ img = self.resize_photo(c, use_cache=True)
+ self.paste_photo(canvas, c, img)
+
+ # Only needed for interactive rendering
+ if self.on_update:
+ self.draw_borders(canvas)
+
+ i += 1
+ now = time.time()
+ if self.on_update and now > last_update + 0.1:
+ self.on_update(canvas, i / n)
+ last_update = now
+
+ self.draw_borders(canvas)
+
+ if self.output_file:
+ canvas.save(self.output_file)
+
+ if self.on_complete:
+ self.on_complete(canvas)
+ except Exception as e:
+ if self.on_fail:
+ self.on_fail(e)
diff --git a/bin/system-theme b/bin/system-theme
new file mode 100755
index 0000000..862b243
--- /dev/null
+++ b/bin/system-theme
@@ -0,0 +1,29 @@
+#!/usr/bin/env sh
+# Switch the COSMIC desktop between light and dark mode, and optionally the
+# wallpaper with it: set SYSTEM_THEME_WALLPAPER_DARK and
+# SYSTEM_THEME_WALLPAPER_LIGHT to image files. Emacs's auto-dark follows the
+# desktop's mode on its own. On another desktop, this is the file to rewrite.
+
+COSMIC="${XDG_CONFIG_HOME:-$HOME/.config}/cosmic"
+
+set_wallpaper() {
+ [ -n "$1" ] || return 0
+ wallpaper="$(realpath "$1")" || return 1
+ sed -i 's|^.*source: Path(".*"),$| source: Path("'"$wallpaper"'"),|' \
+ "$COSMIC/com.system76.CosmicBackground/v1/all"
+}
+
+case "$1" in
+ dark)
+ echo "true" > "$COSMIC/com.system76.CosmicTheme.Mode/v1/is_dark"
+ set_wallpaper "${SYSTEM_THEME_WALLPAPER_DARK:-}"
+ ;;
+ light)
+ echo "false" > "$COSMIC/com.system76.CosmicTheme.Mode/v1/is_dark"
+ set_wallpaper "${SYSTEM_THEME_WALLPAPER_LIGHT:-}"
+ ;;
+ *)
+ echo "usage: system-theme dark|light" >&2
+ exit 1
+ ;;
+esac
diff --git a/bin/systemd/docsync-backup.service b/bin/systemd/docsync-backup.service
new file mode 100644
index 0000000..1c83da8
--- /dev/null
+++ b/bin/systemd/docsync-backup.service
@@ -0,0 +1,8 @@
+[Unit]
+Description=docsync: encrypted hourly backup
+
+[Service]
+Type=oneshot
+ExecStart=%h/.local/bin/docsync backup
+Nice=10
+IOSchedulingClass=idle
diff --git a/bin/systemd/docsync-backup.timer b/bin/systemd/docsync-backup.timer
new file mode 100644
index 0000000..0ad450c
--- /dev/null
+++ b/bin/systemd/docsync-backup.timer
@@ -0,0 +1,10 @@
+[Unit]
+Description=docsync: hourly backup
+
+[Timer]
+OnCalendar=hourly
+RandomizedDelaySec=5min
+Persistent=true
+
+[Install]
+WantedBy=timers.target
diff --git a/bin/systemd/docsync-check.service b/bin/systemd/docsync-check.service
new file mode 100644
index 0000000..c577352
--- /dev/null
+++ b/bin/systemd/docsync-check.service
@@ -0,0 +1,8 @@
+[Unit]
+Description=docsync: verify the backup repository
+
+[Service]
+Type=oneshot
+ExecStart=%h/.local/bin/docsync check
+Nice=10
+IOSchedulingClass=idle
diff --git a/bin/systemd/docsync-check.timer b/bin/systemd/docsync-check.timer
new file mode 100644
index 0000000..ae9d03e
--- /dev/null
+++ b/bin/systemd/docsync-check.timer
@@ -0,0 +1,10 @@
+[Unit]
+Description=docsync: monthly repository check
+
+[Timer]
+OnCalendar=monthly
+RandomizedDelaySec=1h
+Persistent=true
+
+[Install]
+WantedBy=timers.target
diff --git a/bin/systemd/docsync-forget.service b/bin/systemd/docsync-forget.service
new file mode 100644
index 0000000..72efeb9
--- /dev/null
+++ b/bin/systemd/docsync-forget.service
@@ -0,0 +1,8 @@
+[Unit]
+Description=docsync: thin out old snapshots and free their space
+
+[Service]
+Type=oneshot
+ExecStart=%h/.local/bin/docsync forget
+Nice=10
+IOSchedulingClass=idle
diff --git a/bin/systemd/docsync-forget.timer b/bin/systemd/docsync-forget.timer
new file mode 100644
index 0000000..548669d
--- /dev/null
+++ b/bin/systemd/docsync-forget.timer
@@ -0,0 +1,10 @@
+[Unit]
+Description=docsync: weekly snapshot thinning
+
+[Timer]
+OnCalendar=weekly
+RandomizedDelaySec=1h
+Persistent=true
+
+[Install]
+WantedBy=timers.target
diff --git a/config.el b/config.el
new file mode 100644
index 0000000..94cf0df
--- /dev/null
+++ b/config.el
@@ -0,0 +1,4652 @@
+;;; config.el -*- lexical-binding: t; -*-
+
+;; [[file:config.org::*Tangle][Tangle:1]]
+(use-package! org-auto-tangle
+ :hook (org-mode . org-auto-tangle-mode))
+;; Tangle:1 ends here
+
+;; [[file:config.org::*Helper scripts][Helper scripts:1]]
+(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)))
+;; Helper scripts:1 ends here
+
+;; [[file:config.org::*Fonts][Fonts:1]]
+(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)
+;; Fonts:1 ends here
+
+;; [[file:config.org::*Theme][Theme:1]]
+(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))
+;; Theme:1 ends here
+
+;; [[file:config.org::*Theme][Theme:2]]
+(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")))
+;; Theme:2 ends here
+
+;; [[file:config.org::*Frames][Frames:1]]
+(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)
+;; Frames:1 ends here
+
+;; [[file:config.org::*Subprocess environment][Subprocess environment:1]]
+(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)
+;; Subprocess environment:1 ends here
+
+;; [[file:config.org::*Splash screen][Splash screen:1]]
+(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))
+;; Splash screen:1 ends here
+
+;; [[file:config.org::*Splash screen][Splash screen:2]]
+(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)
+;; Splash screen:2 ends here
+
+;; [[file:config.org::*Org][Org:1]]
+(setq org-directory "~/Documents/org/"
+ org-startup-with-inline-images t
+ org-startup-folded 'overview
+ org-extend-today-until 8)
+;; Org:1 ends here
+
+;; [[file:config.org::*Capture defaults][Capture defaults:1]]
+(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))))
+;; Capture defaults:1 ends here
+
+;; [[file:config.org::*Vocabulary capture][Vocabulary capture:1]]
+(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)))
+;; Vocabulary capture:1 ends here
+
+;; [[file:config.org::*Dream journal][Dream journal:1]]
+(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)))
+;; Dream journal:1 ends here
+
+;; [[file:config.org::*Grimoire journal][Grimoire journal:1]]
+(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)))))
+;; Grimoire journal:1 ends here
+
+;; [[file:config.org::*Grimoire journal][Grimoire journal:2]]
+(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))))))))
+;; Grimoire journal:2 ends here
+
+;; [[file:config.org::*Grimoire journal][Grimoire journal:3]]
+(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))))))
+;; Grimoire journal:3 ends here
+
+;; [[file:config.org::*Grimoire journal][Grimoire journal:4]]
+(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"))))
+;; Grimoire journal:4 ends here
+
+;; [[file:config.org::*Grimoire journal][Grimoire journal:5]]
+(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)))
+;; Grimoire journal:5 ends here
+
+;; [[file:config.org::*Liber Resh journal][Liber Resh journal:1]]
+(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)))
+;; Liber Resh journal:1 ends here
+
+;; [[file:config.org::*Astronomy journal][Astronomy journal:1]]
+(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)))
+;; Astronomy journal:1 ends here
+
+;; [[file:config.org::*Astronomy journal][Astronomy journal:2]]
+(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)
+;; Astronomy journal:2 ends here
+
+;; [[file:config.org::*Habits][Habits:1]]
+(use-package! org-habit
+ :after org
+ :config
+ (setq org-habit-following-days 7
+ org-habit-preceding-days 35))
+;; Habits:1 ends here
+
+;; [[file:config.org::*Drill][Drill:1]]
+(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)
+;; Drill:1 ends here
+
+;; [[file:config.org::*Flashcard capture][Flashcard capture:1]]
+(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")))
+;; Flashcard capture:1 ends here
+
+;; [[file:config.org::*Custom agenda views][Custom agenda views:1]]
+(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)))))))
+;; Custom agenda views:1 ends here
+
+;; [[file:config.org::*LaTeX fragments][LaTeX fragments:1]]
+(use-package! org-fragtog
+ :hook (org-mode . org-fragtog-mode))
+;; LaTeX fragments:1 ends here
+
+;; [[file:config.org::*LaTeX fragments][LaTeX fragments:2]]
+(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)
+;; LaTeX fragments:2 ends here
+
+;; [[file:config.org::*Drawing][Drawing:1]]
+;;; 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))
+;; Drawing:1 ends here
+
+;; [[file:config.org::*Image attach][Image attach:1]]
+(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)
+;; Image attach:1 ends here
+
+;; [[file:config.org::*Tables][Tables:1]]
+(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)
+;; Tables:1 ends here
+
+;; [[file:config.org::*Paths][Paths:1]]
+(defun my/gtd-file (name)
+ "Return the absolute path to the GTD file NAME (in `org-directory')."
+ (expand-file-name name org-directory))
+;; Paths:1 ends here
+
+;; [[file:config.org::*Agenda files][Agenda files:1]]
+(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"))))
+;; Agenda files:1 ends here
+
+;; [[file:config.org::*keywords][keywords:1]]
+(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))
+;; keywords:1 ends here
+
+;; [[file:config.org::*Context tags][Context tags:1]]
+(after! org
+ (setq org-tag-alist
+ '(("@home" . ?h)
+ ("@computer" . ?c)
+ ("@errands" . ?e)
+ ("@phone" . ?p)
+ ("@office" . ?o))))
+;; Context tags:1 ends here
+
+;; [[file:config.org::*Capture][Capture:1]]
+(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")))
+;; Capture:1 ends here
+
+;; [[file:config.org::*Refiling][Refiling:1]]
+(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))
+;; Refiling:1 ends here
+
+;; [[file:config.org::*GTD agenda views][GTD agenda views:1]]
+(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)))
+;; GTD agenda views:1 ends here
+
+;; [[file:config.org::*Stuck projects][Stuck projects:1]]
+(after! org
+ (setq org-stuck-projects '("+LEVEL=2/PROJ" ("NEXT") nil "")))
+;; Stuck projects:1 ends here
+
+;; [[file:config.org::*Archiving][Archiving:1]]
+(after! org
+ (setq org-archive-location (concat (my/gtd-file "archive.org") "::* From %s")))
+;; Archiving:1 ends here
+
+;; [[file:config.org::*Keybindings][Keybindings:1]]
+(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")))
+;; Keybindings:1 ends here
+
+;; [[file:config.org::*Blog][Blog:1]]
+(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)
+;; Blog:1 ends here
+
+;; [[file:config.org::*Tarot][Tarot:1]]
+(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)
+;; Tarot:1 ends here
+
+;; [[file:config.org::*Astrology][Astrology:1]]
+(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)
+;; Astrology:1 ends here
+
+;; [[file:config.org::*Daily divination][Daily divination:1]]
+(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)))
+;; Daily divination:1 ends here
+
+;; [[file:config.org::*Resume][Resume:1]]
+(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)
+;; Resume:1 ends here
+
+;; [[file:config.org::*Calibre][Calibre:1]]
+(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)
+;; Calibre:1 ends here
+
+;; [[file:config.org::*EPUBs][EPUBs:1]]
+(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))
+;; EPUBs:1 ends here
+
+;; [[file:config.org::*Justified text][Justified text:1]]
+(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))))))
+;; Justified text:1 ends here
+
+;; [[file:config.org::*Keeping the layout current][Keeping the layout current:1]]
+(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)))))
+;; Keeping the layout current:1 ends here
+
+;; [[file:config.org::*Zen, font size and width][Zen, font size and width:1]]
+(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))
+;; Zen, font size and width:1 ends here
+
+;; [[file:config.org::*Mixed pitch][Mixed pitch:1]]
+(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))
+;; Mixed pitch:1 ends here
+
+;; [[file:config.org::*Mixed pitch][Mixed pitch:2]]
+(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))))))
+;; Mixed pitch:2 ends here
+
+;; [[file:config.org::*Dired][Dired:1]]
+(after! dired-x
+ (setq dired-omit-files (concat dired-omit-files "\\|^\\..+\\'")))
+;; Dired:1 ends here
+
+;; [[file:config.org::*Reusing Dirvish's window][Reusing Dirvish's window:1]]
+(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))
+;; Reusing Dirvish's window:1 ends here
+
+;; [[file:config.org::*Reading the lists][Reading the lists:1]]
+(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))))
+;; Reading the lists:1 ends here
+
+;; [[file:config.org::*Changing what's backed up][Changing what's backed up:1]]
+(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)))
+;; Changing what's backed up:1 ends here
+
+;; [[file:config.org::*What's changed since the last snapshot][What's changed since the last snapshot:1]]
+(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))))
+;; What's changed since the last snapshot:1 ends here
+
+;; [[file:config.org::*In Dirvish][In Dirvish:1]]
+(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")
+ "")
+ " ")))
+;; In Dirvish:1 ends here
+
+;; [[file:config.org::*In Dirvish][In Dirvish:2]]
+(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))))))
+;; In Dirvish:2 ends here
+
+;; [[file:config.org::*Running it][Running it:1]]
+(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"))
+;; Running it:1 ends here
+
+;; [[file:config.org::*Going back in time][Going back in time:1]]
+(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))))))
+;; Going back in time:1 ends here
+
+;; [[file:config.org::*Keys][Keys:1]]
+(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))
+;; Keys:1 ends here
+
+;; [[file:config.org::*Media thumbnails][Media thumbnails:1]]
+(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)
+;; Media thumbnails:1 ends here
+
+;; [[file:config.org::*Slideshow][Slideshow:1]]
+(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)
+;; Slideshow:1 ends here
+
+;; [[file:config.org::*Collage][Collage:1]]
+(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)
+;; Collage:1 ends here
+
+;; [[file:config.org::*Movie grid][Movie grid:1]]
+(load! "movie-grid")
+
+(map! :leader :desc "Movie grid" "o M" #'my/movie-grid)
+;; Movie grid:1 ends here
+
+;; [[file:config.org::*Synth][Synth:1]]
+(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)
+;; Synth:1 ends here
+
+;; [[file:config.org::*Music theory][Music theory:1]]
+(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) " "))))
+;; Music theory:1 ends here
+
+;; [[file:config.org::*Notation][Notation:1]]
+(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))
+;; Notation:1 ends here
+
+;; [[file:config.org::*Jabber][Jabber:1]]
+(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))
+;; Jabber:1 ends here
+
+;; [[file:config.org::*IRC][IRC:2]]
+(map! :leader :desc "IRC" "o i" #'=irc)
+;; IRC:2 ends here
+
+;; [[file:config.org::*Spelling][Spelling:1]]
+(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)
+;; Spelling:1 ends here
+
+;; [[file:config.org::*Wiktionary][Wiktionary:1]]
+(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)
+;; Wiktionary:1 ends here
+
+;; [[file:config.org::*Translate][Translate:1]]
+(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)
+;; Translate:1 ends here
+
+;; [[file:config.org::*Password store][Password store:1]]
+(map! :leader :desc "Password store" "o p" #'pass)
+
+(after! pass
+ (set-popup-rule! "^\\*Password-Store" :ignore t))
+;; Password store:1 ends here
+
+;; [[file:config.org::*Email][Email:1]]
+(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"))
+;; Email:1 ends here
+
+;; [[file:config.org::*Email][Email:2]]
+(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"))
+;; Email:2 ends here
+
+;; [[file:config.org::*Contacts][Contacts:1]]
+(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)
+;; Contacts:1 ends here
+
+;; [[file:config.org::*Calling][Calling:1]]
+(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))
+;; Calling:1 ends here
+
+;; [[file:config.org::*osm.el][osm.el:1]]
+(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))))))
+;; osm.el:1 ends here
+
+;; [[file:config.org::*Sending to the phone][Sending to the phone:1]]
+(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)
+;; Sending to the phone:1 ends here
+
+;; [[file:config.org::*geo: links][geo: links:1]]
+(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))
+;; geo: links:1 ends here
+
+;; [[file:config.org::*RSS][RSS:1]]
+(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)
+;; RSS:1 ends here
+
+;; [[file:config.org::*RSS][RSS:2]]
+(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))
+;; RSS:2 ends here
+
+;; [[file:config.org::*Solar times][Solar times:1]]
+(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")))
+;; Solar times:1 ends here
+
+;; [[file:config.org::*Solar times][Solar times:2]]
+(setq lunar-phase-names '("🌑 New Moon" "🌓 First Quarter Moon"
+ "🌕 Full Moon" "🌗 Last Quarter Moon"))
+;; Solar times:2 ends here
+
+;; [[file:config.org::*Solar times][Solar times:3]]
+(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))))))
+;; Solar times:3 ends here
+
+;; [[file:config.org::*Planetary hours][Planetary hours:1]]
+(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.")
+;; Planetary hours:1 ends here
+
+;; [[file:config.org::*Planetary hours][Planetary hours:2]]
+(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))))
+;; Planetary hours:2 ends here
+
+;; [[file:config.org::*Planetary hours][Planetary hours:3]]
+(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)
+;; Planetary hours:3 ends here
+
+;; [[file:config.org::*Planetary hours][Planetary hours:4]]
+(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)))))
+;; Planetary hours:4 ends here
+
+;; [[file:config.org::*Planet positions][Planet positions:1]]
+(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)))
+;; Planet positions:1 ends here
+
+;; [[file:config.org::*Planet positions][Planet positions:2]]
+(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)
+;; Planet positions:2 ends here
+
+;; [[file:config.org::*Planet positions][Planet positions:3]]
+(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)
+;; Planet positions:3 ends here
+
+;; [[file:config.org::*Planet positions][Planet positions:4]]
+(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)))
+;; Planet positions:4 ends here
+
+;; [[file:config.org::*Equinoxes and solstices][Equinoxes and solstices:1]]
+(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))))
+;; Equinoxes and solstices:1 ends here
+
+;; [[file:config.org::*The Easter cycle][The Easter cycle:1]]
+(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))
+;; The Easter cycle:1 ends here
+
+;; [[file:config.org::*Hebrew calendar][Hebrew calendar:1]]
+(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)))
+;; Hebrew calendar:1 ends here
+
+;; [[file:config.org::*Islamic calendar][Islamic calendar:1]]
+(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)))
+;; Islamic calendar:1 ends here
+
+;; [[file:config.org::*Weather][Weather:1]]
+(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.")
+;; Weather:1 ends here
+
+;; [[file:config.org::*Weather][Weather:2]]
+(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))
+;; Weather:2 ends here
+
+;; [[file:config.org::*Weather][Weather:3]]
+(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))
+;; Weather:3 ends here
+
+;; [[file:config.org::*Weather][Weather:4]]
+(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))))
+;; Weather:4 ends here
+
+;; [[file:config.org::*Weather][Weather:5]]
+(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)
+;; Weather:5 ends here
+
+;; [[file:config.org::*Modeline][Modeline:1]]
+(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.")
+;; Modeline:1 ends here
+
+;; [[file:config.org::*Current lunar phase][Current lunar phase:1]]
+(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).")
+;; Current lunar phase:1 ends here
+
+;; [[file:config.org::*Current lunar phase][Current lunar phase:2]]
+(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")))
+;; Current lunar phase:2 ends here
+
+;; [[file:config.org::*Current lunar phase][Current lunar phase:3]]
+(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)))
+;; Current lunar phase:3 ends here
+
+;; [[file:config.org::*Current solar times][Current solar times:1]]
+(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))))
+;; Current solar times:1 ends here
+
+;; [[file:config.org::*Current weather][Current weather:1]]
+(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)))
+;; Current weather:1 ends here
+
+;; [[file:config.org::*Wiring][Wiring:1]]
+(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.")
+;; Wiring:1 ends here
+
+;; [[file:config.org::*Daemon][Daemon:1]]
+(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)
+;; Daemon:1 ends here
+
+;; [[file:config.org::*Claude Code][Claude Code:1]]
+(use-package! claude-code
+ :bind-keymap ("C-c c" . claude-code-command-map)
+ :init
+ (setq claude-code-terminal-backend 'vterm)
+ :config
+ (claude-code-mode))
+;; Claude Code:1 ends here
+
+;; [[file:config.org::*TMSU][TMSU:1]]
+(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)))
+;; TMSU:1 ends here
+
+;; [[file:config.org::*Private overlay][Private overlay:1]]
+(load! "private/config" doom-user-dir t)
+;; Private overlay:1 ends here
diff --git a/config.org b/config.org
new file mode 100644
index 0000000..0e5b6a2
--- /dev/null
+++ b/config.org
@@ -0,0 +1,6100 @@
+#+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
diff --git a/init.el b/init.el
new file mode 100644
index 0000000..45c5ff6
--- /dev/null
+++ b/init.el
@@ -0,0 +1,220 @@
+;;; $DOOMDIR/init.el -*- lexical-binding: t; -*-
+
+;; This file controls what Doom modules are enabled and what order they load
+;; in. Remember to run 'doom sync' after modifying it!
+
+;; NOTE: Press 'SPC h d h' (or 'C-h d h' for non-vim users) to access Doom's
+;; documentation. There you'll find a link to Doom's Module Index where all of
+;; our modules are listed, including what flags they support.
+
+;; NOTE: Move your cursor over a module's name (or its flags) and press 'K' (or
+;; 'C-c c k' for non-vim users) to view its documentation. This works on flags
+;; as well (those symbols that start with a plus).
+;;
+;; Alternatively, press 'gd' (or 'C-c c d') on a module to browse its
+;; directory (for easy access to its source code).
+
+(doom! :input
+ ;;bidi ; (tfel ot) thgir etirw uoy gnipleh
+ ;;chinese
+ ;;japanese
+ ;;layout ; auie,ctsrnm is the superior home row
+
+ :completion
+ ;;company ; the ultimate code completion backend
+ (corfu
+ +orderless) ; complete with cap(f), cape and a flying feather!
+ ;;helm ; the *other* search engine for love and life
+ ;;ido ; the other *other* search engine...
+ ;;ivy ; a search engine for love and life
+ vertico ; the search engine of the future
+
+ :ui
+ ;;deft ; notational velocity for Emacs
+ doom ; what makes DOOM look the way it does
+ dashboard ; a nifty splash screen for Emacs
+ ;;doom-quit ; DOOM quit-message prompts when you quit Emacs
+ (emoji
+ +unicode) ; 🙂
+ hl-todo ; highlight TODO/FIXME/NOTE/DEPRECATED/HACK/REVIEW
+ ;;indent-guides ; highlighted indent columns
+ ;;ligatures ; ligatures and symbols to make your code pretty again
+ ;;minimap ; show a map of the code on the side
+ modeline ; snazzy, Atom-inspired modeline, plus API
+ ;;nav-flash ; blink cursor line after big motions
+ ;;neotree ; a project drawer, like NERDTree for vim
+ ophints ; highlight the region an operation acts on
+ (popup
+ +defaults) ; tame sudden yet inevitable temporary windows
+ smooth-scroll ; So smooth you won't believe it's not butter
+ ;;tabs ; a tab bar for Emacs
+ ;;treemacs ; a project drawer, like neotree but cooler
+ unicode ; extended unicode support for various languages
+ (vc-gutter
+ +pretty) ; vcs diff in the fringe
+ vi-tilde-fringe ; fringe tildes to mark beyond EOB
+ ;;window-select ; visually switch windows
+ workspaces ; tab emulation, persistence & separate workspaces
+ zen ; distraction-free coding or writing
+
+ :editor
+ (evil
+ +everywhere); come to the dark side, we have cookies
+ file-templates ; auto-snippets for empty files
+ fold ; (nigh) universal code folding
+ ;;(format +onsave) ; automated prettiness
+ ;;god ; run Emacs commands without modifier keys
+ ;;lispy ; vim for lisp, for people who don't like vim
+ ;;multiple-cursors ; editing in many places at once
+ ;;objed ; text object editing for the innocent
+ ;;parinfer ; turn lisp into python, sort of
+ ;;rotate-text ; cycle region at point between text candidates
+ snippets ; my elves. They type so I don't have to
+ (whitespace
+ +guess
+ +trim) ; a butler for your whitespace
+ word-wrap ; soft wrapping with language-aware indent
+
+ :emacs
+ (dired +icons +dirvish) ; making dired pretty [functional]
+ electric ; smarter, keyword-based electric-indent
+ ;;eww ; the internet is gross
+ ;;ibuffer ; interactive buffer management
+ tramp ; remote files at your arthritic fingertips
+ undo ; persistent, smarter undo for your inevitable mistakes
+ vc ; version-control and Emacs, sitting in a tree
+
+ :term
+ ;;eshell ; the elisp shell that works everywhere
+ ;;shell ; simple shell REPL for Emacs
+ ;;term ; basic terminal emulator for Emacs
+ vterm ; almost the best terminal emulation in Emacs
+ ;;ghostel ; the best terminal emulation in Emacs
+
+ :checkers
+ syntax ; tasing you for every semicolon you forget
+ (spell
+ +flyspell
+ +hunspell) ; tasing you for misspelling mispelling
+ ;;grammar ; tasing grammar mistake every you make
+
+ :tools
+ ;;ansible
+ ;;biblio ; Writes a PhD for you (citation needed)
+ ;;collab ; buffers with friends
+ ;;debugger ; stepping through code, to help you add bugs
+ ;;direnv
+ ;;docker
+ ;;editorconfig ; let someone else argue about tabs vs spaces
+ ;;ein ; tame Jupyter notebooks with emacs
+ (eval
+ +overlay) ; run code, run (also, repls)
+ (lookup
+ +dictionary
+ +offline) ; navigate your code and its documentation
+ ;;llm ; when I said you needed friends, I didn't mean...
+ ;;(lsp +eglot) ; M-x vscode
+ magit ; a git porcelain for Emacs
+ ;;make ; run make tasks from Emacs
+ pass ; password manager for nerds
+ pdf ; pdf enhancements
+ ;;terraform ; infrastructure as code
+ ;;tmux ; an API for interacting with tmux
+ ;;tree-sitter ; syntax and parsing, sitting in a tree...
+ ;;upload ; map local to remote projects via ssh/ftp
+
+ :os
+ (:if (featurep :system 'macos) macos) ; improve compatibility with macOS
+ ;;tty ; improve the terminal Emacs experience
+
+ :lang
+ ;;ada ; In strong typing we (blindly) trust
+ ;;(agda +local) ; types of types of types of types...
+ ;;beancount ; mind the GAAP
+ ;;(cc +lsp) ; C > C++ == 1
+ clojure ; java with a lisp
+ ;;common-lisp ; if you've seen one lisp, you've seen them all
+ ;;coq ; proofs-as-programs
+ ;;crystal ; ruby at the speed of c
+ ;;csharp ; unity, .NET, and mono shenanigans
+ ;;data ; config/data formats
+ ;;(dart +flutter) ; paint ui and not much else
+ ;;dhall
+ ;;elixir ; erlang done right
+ ;;elm ; care for a cup of TEA?
+ emacs-lisp ; drown in parentheses
+ ;;erlang ; an elegant language for a more civilized age
+ ;;ess ; emacs speaks statistics
+ ;;factor
+ ;;faust ; dsp, but you get to keep your soul
+ ;;fortran ; in FORTRAN, GOD is REAL (unless declared INTEGER)
+ ;;fsharp ; ML stands for Microsoft's Language
+ ;;fstar ; (dependent) types and (monadic) effects and Z3
+ ;;gdscript ; the language you waited for
+ ;;(go +lsp) ; the hipster dialect
+ ;;(graphql +lsp) ; Give queries a REST
+ ;;(haskell +lsp) ; a language that's lazier than I am
+ ;;hy ; readability of scheme w/ speed of python
+ ;;idris ; a language you can depend on
+ json ; At least it ain't XML
+ ;;janet ; Fun fact: Janet is me!
+ ;;(java +lsp) ; the poster child for carpal tunnel syndrome
+ ;;javascript ; all(hope(abandon(ye(who(enter(here))))))
+ ;;julia ; a better, faster MATLAB
+ ;;kotlin ; a better, slicker Java(Script)
+ latex ; writing papers in Emacs has never been so fun
+ ;;lean ; for folks with too much to prove
+ ledger ; be audit you can be
+ lua ; one-based indices? one-based indices
+ markdown ; writing docs for people to ignore
+ ;;nim ; python + lisp at the speed of c
+ ;;nix ; I hereby declare "nix geht mehr!"
+ ;;ocaml ; an objective camel
+ ;;odin ; C, minus its footguns
+ (org
+ +pretty
+ +roam
+ +present
+ +dragndrop) ; organize your plain life in plain text
+ ;;php ; perl's insecure younger brother
+ ;;plantuml ; diagrams for confusing people more
+ ;;graphviz ; diagrams for confusing yourself even more
+ ;;purescript ; javascript, but functional
+ ;;python ; beautiful is better than ugly
+ ;;qt ; the 'cutest' gui framework ever
+ ;;racket ; a DSL for DSLs
+ ;;raku ; the artist formerly known as perl6
+ ;;rest ; Emacs as a REST client
+ ;;rst ; ReST in peace
+ ;;(ruby +rails) ; 1.step {|i| p "Ruby is #{i.even? ? 'love' : 'life'}"}
+ ;;(rust +lsp) ; Fe2O3.unwrap().unwrap().unwrap().unwrap()
+ ;;scad ; trust the preview, regret the render
+ ;;scala ; java, but good
+ ;;(scheme +guile) ; a fully conniving family of lisps
+ sh ; she sells {ba,z,fi}sh shells on the C xor
+ ;;sml
+ ;;solidity ; do you need a blockchain? No.
+ ;;swift ; who asked for emoji variables?
+ ;;terra ; Earth and Moon in alignment for performance.
+ ;;web ; the tubes
+ ;;yaml ; JSON, but readable
+ ;;zig ; C, but simpler
+
+ :email
+ (mu4e +mbsync)
+ ;;(notmuch +org)
+ ;;(wanderlust +gmail)
+
+ :app
+ ;;calendar
+ emms
+ ;;everywhere ; *leave* Emacs!? You must be joking
+ irc ; how neckbeards socialize
+ (rss +org) ; emacs as an RSS reader
+
+ :config
+ ;;literate
+ (default +bindings +smartparens))
+
+;; Must be set before evil loads, which is why it lives here and not in config.org.
+(setq evil-respect-visual-line-mode t)
diff --git a/movie-grid.el b/movie-grid.el
new file mode 100644
index 0000000..96aeecd
--- /dev/null
+++ b/movie-grid.el
@@ -0,0 +1,208 @@
+;;; movie-grid.el -*- lexical-binding: t; -*-
+
+;; A grid of movie posters pulled from Radarr, built on top of
+;; `image-dired-thumbnail-mode' the same way `my/media-thumbnails' is:
+;; each poster is inserted as a thumbnail whose "original file" is the
+;; movie's actual video file rather than the poster itself, so the
+;; existing `my/media--play-video-a' advice (which already fires on RET,
+;; SPC, C-RET, ...) sees a video extension and hands it straight to mpv
+;; instead of trying to display it as an image. Grid navigation, "q" to
+;; close back to the grid, and everything else about the thumbnail
+;; buffer is exactly what `my/media-thumbnails' already gets for free.
+
+(defcustom my/movie-grid-radarr-url "http://localhost:7878"
+ "Base URL of the Radarr instance backing `my/movie-grid'."
+ :type 'string)
+
+(defcustom my/movie-grid-radarr-api-key-entry "radarr"
+ "Password-store entry holding the Radarr API key.
+Found in Radarr under Settings > General > Security. Add it with
+\"pass insert radarr\"."
+ :type 'string)
+
+(defvar my/movie-grid--radarr-api-key nil
+ "Cached Radarr API key, fetched from `password-store' on first use.")
+
+(defun my/movie-grid--radarr-api-key ()
+ "Return the Radarr API key, fetching it from `password-store' once."
+ (or my/movie-grid--radarr-api-key
+ (setq my/movie-grid--radarr-api-key
+ (or (password-store-get my/movie-grid-radarr-api-key-entry)
+ (user-error "No API key in password-store entry %S; run \"pass insert %s\""
+ my/movie-grid-radarr-api-key-entry
+ my/movie-grid-radarr-api-key-entry)))))
+
+(defun my/movie-grid--radarr-get (path)
+ "Return Radarr's JSON response for PATH, parsed into plists."
+ (with-temp-buffer
+ (unless (zerop (call-process "curl" nil t nil "-sf"
+ "-H" (concat "X-Api-Key: " (my/movie-grid--radarr-api-key))
+ (concat my/movie-grid-radarr-url path)))
+ (error "Radarr request to %s failed; is it running at %s?"
+ path my/movie-grid-radarr-url))
+ (goto-char (point-min))
+ (json-parse-buffer :object-type 'plist :array-type 'list :false-object :false)))
+
+(defun my/movie-grid--poster-thumbnail-file (movie)
+ "Return a cached, thumbnail-sized poster image file for MOVIE.
+Downloads and resizes it on first use; later calls reuse the cached
+file, same as `my/media--video-thumbnail-file' does for video frames."
+ (let* ((id (plist-get movie :id))
+ (cache (expand-file-name "movie-posters" (image-dired-dir)))
+ (thumb (expand-file-name (format "%d.jpg" id) cache)))
+ (make-directory cache t)
+ (unless (file-exists-p thumb)
+ (let ((raw (make-temp-file "movie-poster-" nil ".jpg")))
+ (unwind-protect
+ (if (and (zerop (call-process
+ "curl" nil nil nil "-sf"
+ "-H" (concat "X-Api-Key: " (my/movie-grid--radarr-api-key))
+ "-o" raw
+ (format "%s/api/v3/mediacover/%d/poster.jpg"
+ my/movie-grid-radarr-url id)))
+ (zerop (call-process
+ "convert" nil nil nil raw "-resize"
+ (format "%dx%d" image-dired-thumb-size (* 2 image-dired-thumb-size))
+ thumb)))
+ nil
+ (message "movie-grid: failed to fetch poster for %s" (plist-get movie :title)))
+ (delete-file raw))))
+ (and (file-exists-p thumb) thumb)))
+
+(defun my/movie-grid--movies ()
+ "Return Radarr's movies that have a file on disk, sorted by title."
+ (let ((movies (seq-filter (lambda (m) (eq (plist-get m :hasFile) t))
+ (my/movie-grid--radarr-get "/api/v3/movie"))))
+ (sort movies (lambda (a b) (string-lessp (plist-get a :sortTitle)
+ (plist-get b :sortTitle))))))
+
+;; `image-dired-line-up'/`image-dired-line-up-dynamic' can't be reused as-is
+;; once a title needs to go under each poster: they lay out a flat run of
+;; [image][space][image][space]... and, critically, get there by deleting
+;; every non-image character first - any title text inserted after a
+;; thumbnail would just be stripped back out on the next line-up pass. So
+;; the grid below does its own row-by-row layout instead, reusing only the
+;; column-width arithmetic `image-dired-line-up' itself uses for
+;; `:align-to', so poster columns and the title row underneath line up.
+;; Motion still comes entirely from image-dired: `image-dired-forward-image'
+;; and friends just walk character by character until they find something
+;; with the image-dired-thumbnail property, so a title line's worth of
+;; plain text in between is skipped exactly like the usual one-space
+;; separator is, and `image-dired-next-line'/`previous-line' (column-
+;; preserving line motion) work the same as always since each row is still
+;; the two buffer lines image-dired expects a row to advance by: images,
+;; then titles.
+
+(defun my/movie-grid--thumb-width-chars ()
+ "Column width of one poster cell, matching `image-dired-line-up'."
+ (ceiling (/ (+ (* 2 image-dired-thumb-relief)
+ (* 2 image-dired-thumb-margin)
+ (image-dired--thumb-size))
+ (float (frame-char-width)))))
+
+(defun my/movie-grid--columns (thumb-width-chars)
+ "Number of poster columns that fit the window, like `image-dired-line-up-dynamic'."
+ (max 1 (/ (window-body-width (image-dired-thumbnail-window) t)
+ (* thumb-width-chars (frame-char-width)))))
+
+(defun my/movie-grid--insert-row (movies col-width)
+ "Insert one row of MOVIES: a line of posters, then a line of titles.
+Both lines align to the same COL-WIDTH-wide columns. The title text is
+plain, searchable text - not itself an image-dired thumbnail, so it
+doesn't become an extra stop for `image-dired-forward-image' and
+friends - but each title carries a `movie-grid-image-position'
+property pointing back at its own poster's buffer position, so RET
+and C-RET on the title (e.g. after landing there via evil's \"/\")
+still resolve to the right movie; see
+`my/movie-grid--snap-to-thumbnail-a'."
+ (let (positions)
+ (dotimes (col (length movies))
+ (let* ((movie (nth col movies))
+ (video (plist-get (plist-get movie :movieFile) :path))
+ (thumb (my/movie-grid--poster-thumbnail-file movie)))
+ (push (point) positions)
+ (when (and video thumb)
+ (image-dired-insert-thumbnail thumb video nil))
+ (insert (propertize " " 'display `(space :align-to ,(* (1+ col) col-width))))))
+ (setq positions (nreverse positions))
+ (insert "\n")
+ (dotimes (col (length movies))
+ (let* ((movie (nth col movies))
+ (title (plist-get movie :title)))
+ (insert (propertize (truncate-string-to-width title (1- col-width) nil nil "…")
+ 'face 'image-dired-thumb-header-file-name
+ 'movie-grid-image-position (nth col positions)))
+ (insert (propertize " " 'display `(space :align-to ,(* (1+ col) col-width))))))
+ (insert "\n\n")))
+
+;; Landing on a title via evil's native "/" search is the whole point of
+;; having titles at all, but RET (`image-dired-display-this') and C-RET
+;; (`image-dired-thumbnail-display-external') both refuse outright unless
+;; `image-dired-image-at-point-p' is true first, before either gets anywhere
+;; near `image-dired-original-file-name' - so landing on title text and
+;; pressing RET always fails with "No thumbnail at point", regardless of
+;; what properties the title carries. Move point onto the linked poster
+;; first, whenever it's there to move to.
+(defun my/movie-grid--snap-to-thumbnail-a (orig-fn &rest args)
+ "Move point onto the poster for the title at point before calling ORIG-FN."
+ (when-let* (((not (image-dired-image-at-point-p)))
+ (pos (get-text-property (point) 'movie-grid-image-position)))
+ (goto-char pos))
+ (apply orig-fn args))
+
+(advice-add #'image-dired-display-this :around #'my/movie-grid--snap-to-thumbnail-a)
+(advice-add #'image-dired-thumbnail-display-external :around #'my/movie-grid--snap-to-thumbnail-a)
+
+;;;###autoload
+(defun my/movie-grid ()
+ "Show a grid of movie posters from Radarr, with titles underneath.
+Uses `image-dired-thumbnail-mode', so the normal image-dired motion
+keys move around the grid, and RET/SPC/C-RET play the movie under
+point with mpv via the same advice `my/media-thumbnails' relies on for
+video files. Evil's \"/\" searches the titles directly, same as any
+other text in the buffer."
+ (interactive)
+ (require 'image-dired)
+ (unless (executable-find "convert")
+ (user-error "ImageMagick's convert is not installed"))
+ (let* ((movies (my/movie-grid--movies))
+ (buf (image-dired-create-thumbnail-buffer)))
+ (unless movies
+ (user-error "No movies with files found in Radarr"))
+ ;; Pop to the buffer before laying anything out: column count depends
+ ;; on the window this buffer is showing in, via
+ ;; `image-dired-thumbnail-window', which only resolves to something
+ ;; once the buffer is actually displayed somewhere.
+ (pop-to-buffer buf)
+ (let ((inhibit-read-only t)
+ (remaining movies)
+ col-width columns)
+ (erase-buffer)
+ (setq-local image-dired--number-of-thumbnails (length movies))
+ ;; Every thumbnail here has a nil associated-dired-buffer (there's no
+ ;; single flat Dired listing that maps onto a nested
+ ;; movies-in-their-own-folders layout), but `image-dired-forward-image'
+ ;; and friends unconditionally try to mirror point into that buffer
+ ;; after every move when this is on, and error when it isn't there.
+ ;; The feature itself - keeping a split-window Dired in sync - has
+ ;; nothing to sync with here anyway, so just turn it off.
+ (setq-local image-dired-track-movement nil)
+ (setq col-width (my/movie-grid--thumb-width-chars)
+ columns (my/movie-grid--columns col-width))
+ (while remaining
+ (my/movie-grid--insert-row (seq-take remaining columns) col-width)
+ (setq remaining (seq-drop remaining columns))))
+ (goto-char (point-min))
+ (image-dired--update-header-line)
+ ;; `evil-collection''s image-dired bindings (the ones that make motion
+ ;; skip the title/separator text instead of stopping on it) only apply
+ ;; in normal state. `image-dired-thumbnail-mode' buffers should always
+ ;; be in normal state - `set-evil-initial-state!' in the Media
+ ;; thumbnails section says so - but that only fires the first time the
+ ;; major mode is set on a buffer, not on later reuses of this same
+ ;; buffer, so a state that slipped once (e.g. entered from a visual
+ ;; selection elsewhere) would stick around on every subsequent call.
+ (when (fboundp 'evil-normal-state)
+ (evil-normal-state))))
+
+(provide 'movie-grid)
diff --git a/packages.el b/packages.el
new file mode 100644
index 0000000..d7ea364
--- /dev/null
+++ b/packages.el
@@ -0,0 +1,32 @@
+;; -*- no-byte-compile: t; -*-
+;;; $DOOMDIR/packages.el
+;;
+;; Run `doom sync' after changing this file.
+;; mixed-pitch is not listed: Doom's :ui zen module already installs it.
+
+(package! auto-dark)
+(package! nov) ; EPUB rendering
+(package! shrface) ; org-style faces for nov and eww
+(package! calibredb)
+(package! jabber) ; XMPP
+(package! bbdb) ; contacts, wired into mu4e
+(package! osm) ; OpenStreetMap viewer
+(package! org-auto-tangle)
+(package! org-drill) ; flashcards
+(package! org-fragtog)
+(package! valign) ; pixel-aligned Org tables, for Hebrew
+(package! tmsu)
+(package! ol-tmsu)
+(package! org-draw)
+(package! ox-rss) ; blog -> RSS export
+
+;; GitHub recipes are pinned so `doom upgrade' cannot move them unexpectedly.
+(package! resumel
+ :recipe (:host github :repo "barryridge/resumel"
+ :files ("*.el" "*.org" "templates"))
+ :pin "9e1ecad25781c8507854aa63cb1637eb4bdd8373")
+
+(package! claude-code
+ :recipe (:host github :repo "stevemolitor/claude-code.el"
+ :files ("*.el" (:exclude "images/*")))
+ :pin "03199df8b3a1e9cd4857f0851f7a912ba524aff3")
diff --git a/snippets/org-mode/isotope b/snippets/org-mode/isotope
new file mode 100644
index 0000000..76eb040
--- /dev/null
+++ b/snippets/org-mode/isotope
@@ -0,0 +1,5 @@
+# -*- mode: snippet -*-
+# name: isotope notation
+# key: isotope
+# --
+\${}^{12}_{6}\mathrm{C}\$
generated by cgit v1.2.3 (git 2.46.0) at 2026-11-02 11:21:07 +0000