diff options
70 files changed, 4073 insertions, 242 deletions
@@ -5,6 +5,7 @@ /.coverage/ flycheck_* projectile-bookmarks.eld +projectile-frecency.eld /fontaine-latest-state.eld /recentf /backups/ @@ -55,6 +56,7 @@ auto-save-list/ /browser-choice.el /calendar-sync.local.el /signal-config.local.el +/google-keep.local.el /client_secret_491339091045-sjje1r54s22vn2ugh45khndjafp89vto.apps.googleusercontent.com.json # reveal.js local clone (managed by scripts/setup-reveal.sh) @@ -16,6 +16,8 @@ # make compile - Byte-compile all modules # make compile-file FILE= - Byte-compile one file with the project load path # make lint - Run all linters (checkdoc, package-lint, elisp-lint) +# make bootstrap - Install every package headlessly (fresh machine) +# make telega-image - Build the telega-server container image # make profile - Profile Emacs startup performance # make clean - Remove test artifacts and compiled files # make clean-compiled - Remove .elc/.eln files only @@ -54,7 +56,7 @@ EMACS_TEST = $(EMACS_BATCH) -L $(TEST_DIR) -L $(MODULE_DIR) .PHONY: help targets test test-all test-unit test-integration test-file test-name \ test-bash theme-studio-test theme-studio-check theme-studio-coverage theme-studio-gen theme-studio-open theme-studio-theme theme-studio-theme-load theme-studio-theme-reload deploy-wip \ benchmark coverage coverage-summary coverage-clean \ - validate-parens validate-modules compile compile-file lint profile \ + validate-parens validate-modules compile compile-file lint bootstrap telega-image profile \ task-sorted \ clean clean-compiled clean-tests reset @@ -100,6 +102,8 @@ help: @echo " make lint - Run all linters (checkdoc, package-lint, elisp-lint)" @echo "" @echo " Utilities:" + @echo " make bootstrap - Install every package headlessly (fresh machine)" + @echo " make telega-image - Build the telega-server container image" @echo " make profile - Profile Emacs startup performance" @echo " make clean - Remove test artifacts and compiled files" @echo " make clean-compiled - Remove .elc/.eln files only" @@ -452,6 +456,19 @@ lint: # Utility Targets # ============================================================================ +bootstrap: + @bash scripts/bootstrap-packages.sh + +# telega-server container image. Built locally from a digest-pinned upstream +# base plus the library upstream forgot (see docker/telega-server/Dockerfile). +# The tag here is the source of truth: `cj/telega-docker-image' in +# modules/telega-config.el must name the same one, and a test holds them equal. +TELEGA_IMAGE = cj/telega-server:1.8.66-glycin + +telega-image: + @docker build -t $(TELEGA_IMAGE) docker/telega-server + @echo "built $(TELEGA_IMAGE)" + profile: @echo "Profiling Emacs startup..." @if [ -f "$(EMACS_HOME)/early-init.el" ]; then \ diff --git a/custom/elpa-mirror.el b/custom/elpa-mirror.el index 777293e2..a17d0c5f 100644 --- a/custom/elpa-mirror.el +++ b/custom/elpa-mirror.el @@ -1,4 +1,4 @@ -;;; elpa-mirror.el --- Create local package repository from installed packages +;;; elpa-mirror.el --- Create local package repository from installed packages -*- lexical-binding: t -*- ;; Copyright (C) 2014-2020 Chen Bin diff --git a/docker/telega-server/Dockerfile b/docker/telega-server/Dockerfile new file mode 100644 index 00000000..6bd2c579 --- /dev/null +++ b/docker/telega-server/Dockerfile @@ -0,0 +1,16 @@ +# telega-server image for modules/telega-config.el. Build with `make telega-image'. +# +# Upstream's zevlg/telega-server:latest ships tdlib 1.8.66 (the floor the +# current telega package demands) but its telega-server binary fails to start: +# libgdk_pixbuf needs libglycin-2.so.0 and the image doesn't carry it. Known +# open bug: https://github.com/zevlg/telega.el/issues/596. This derived image +# adds the one missing package and nothing else. +# +# The base is pinned by digest, not tag, so a rebuild on another machine gets +# the same upstream layers. libglycin itself is deliberately not version +# pinned: Alpine's repos keep only the current build of a package, so an exact +# `libglycin=X-rN' fails the build the day it rotates, which is worse than one +# layer differing between machines. When #596 is fixed upstream, point +# `cj/telega-docker-image' back at a registry digest and delete this file. +FROM zevlg/telega-server@sha256:aa7e79c4e9587c84065782df9399653fb1a967078b08ec1ded77738d4c2d70ad +RUN apk add --no-cache libglycin diff --git a/docs/design/2026-08-03-ambience-audio-handoff.org b/docs/design/2026-08-03-ambience-audio-handoff.org new file mode 100644 index 00000000..045e44ad --- /dev/null +++ b/docs/design/2026-08-03-ambience-audio-handoff.org @@ -0,0 +1,79 @@ +#+TITLE: Ambience audio — build notes and source findings +#+AUTHOR: Craig Jennings +#+DATE: 2026-08-03 + +Build notes for the ambient audio the music config plays. The audio itself +is not tracked here; it lives at =~/documents/sounds/ambience/= and the +playlist reaches it by relative path. This file is the technique and the +measurements, which are the parts worth keeping. + +* What these are + +Three 1-hour ambient tracks built 2026-08-03: + + cafe-1h 29 MB cafe murmur only + rain-1h 25 MB rain only + rain-plus-cafe65-1h 43 MB both, cafe at 65% of the rain + +* How they were built + +Sources are two short loops — cafe at 1:50 and rain at 2:32, both 24 kHz +stereo at 56-64 kbps. + +The two pure tracks are =ffmpeg -stream_loop= with =-c copy=, so they carry +no second-generation encoding loss: bit-identical to the source repeated +about thirty times. Only the mix is re-encoded (libmp3lame 96k, 24 kHz to +match source). + +The mix is rain at unity and cafe at =volume=0.65=, combined with +=amix=normalize=0=. + +*The =normalize=0= is the part to remember.* =amix= normalizes by default, +which halves both inputs and throws the 65% ratio away — the thing you were +setting is silently discarded and the output still sounds plausible. + +Verified after building: peak -1.1 dBTP (no clipping), mean -23.3 dB. + +=cafe-1h= is 3599.26s rather than 3600 because a stream copy cuts on an MP3 +frame boundary. I took the lossless copy over the last 0.74s. + +* A better-sounding source set exists + +There is also a set built from openly-licensed field recordings, at +=~/documents/sounds/ambience/cc0-*.mp3= — rain from "Lluvia En Riumors" +(CC0 1.0, 18:08, lossless FLAC source) and cafe from "Cafe, Aldeburgh, UK" +via radio aporee (Public Domain Mark 1.0, 17:33, 320 kbps). + +They sound better than the short loops for a structural reason: 44.1 kHz +throughout, and an hour needs about four passes rather than thirty, so there +is far less audible repetition. + +** Open thread — that set's rain is too percussive + +It was recorded on hard pavement, so you hear drop impacts you would never +hear from inside a cafe. + +Measured: its energy above 2 kHz sits only 0.4 dB below full-band, against +-19.9 dB for a real rain-through-a-window recording. + +Filtering the pavement rain to match does not work — it strips to sparse +thumps, because that recording's rain character lives almost entirely above +1 kHz. The fix is a different source recorded indoors, which is unresolved. + +Relevant if a rain-only mode ever gets built. + +* Note on the loop periods + +Measured separately when the 15-minute loops were cut: the periods are exact +rather than estimated, because the files are literal stream-copy repeats, so +the period is found by locating where the byte stream repeats. cafe is +109.680s (4570 frames), rain is 151.584s (6316 frames). + +gcd(4570, 6316) = 2 frames, so the two layers coincide only every 14,432,060 +frames — 96.2 hours. No practical length wraps both cleanly, which is why the +15-minute mix uses a 3s equal-power (qsin) crossfade folding its tail over its +head so F(0) = F(L), rather than a naive cut. + +Measured across the wrap against the typical adjacent sample step inside the +file: a naive 900s cut gives 4875 against 248 (19.7x, an audible click); the +crossfaded version gives 236 against 229 (1.03x). diff --git a/docs/design/2026-08-23-telega-docker-pin-tdlib-mismatch.org b/docs/design/2026-08-23-telega-docker-pin-tdlib-mismatch.org new file mode 100644 index 00000000..6428e8c1 --- /dev/null +++ b/docs/design/2026-08-23-telega-docker-pin-tdlib-mismatch.org @@ -0,0 +1,261 @@ +#+TITLE: telega-server is dead on velox: the docker image pin went stale when the package updated +#+AUTHOR: Craig Jennings +#+DATE: 2026-08-23 + +* Summary + +Telegram has been an unscannable channel on velox since 2026-08-19. Two triage +sweeps (08-21 and 08-23) recorded it as a scan failure and both blamed a missing +docker image. That diagnosis was wrong. The real cause is a version mismatch +between =modules/telega-config.el='s digest pin and the telega package MELPA +installed on 2026-08-18. It is reproducible, it is silent, and ratio is one +package upgrade from the same failure. + +Everything below was measured on velox on 2026-08-23, with ratio checked over +tailscale for comparison. + +* What actually happens + +=telega-server= starts fine. The container runs, tdlib initialises, and telega.el +completes a handshake with it: the server log shows five =setOption= requests +arriving from telega.el (language, =use_storage_optimizer=, =ignore_file_names=). +About eleven milliseconds later telega.el sends =close= and the client unwinds +cleanly: requests aborted, =authorizationStateClosing=, +=authorizationStateClosed=, =Td::hangup=, =Stop Td=. + +The trigger is in =telega-tdlib-events.el= around line 1306. When tdlib reports +its =:version= option, telega compares it against =telega-tdlib-min-version= and, +if the server is older, does this: + +#+begin_src emacs-lisp +(warn version-error-msg) +;; Finally stop processing events from telega-server +(telega-server-kill) +(error version-error-msg) +#+end_src + +The numbers: + +| where | value | +|----------------------------------------------------+--------| +| tdlib in the pinned image | 1.8.64 | +| =telega-tdlib-min-version= in telega-20260817.621 | 1.8.66 | + +1.8.64 < 1.8.66, so telega kills its own server on every launch. + +* The timeline is exact + +- =elpa/telega-20260817.621/= is dated 2026-08-18 11:14. The package updated, + and that build raised =telega-tdlib-min-version= from 1.8.64 to 1.8.66. +- =~/.telega/telega-server.log= holds at least six launch attempts across + 2026-08-19 15:20, 08-20 10:50, 08-21 15:10 and 08-23 10:50 (the count grows by + one each time I reproduce it). Every one reaches + =authorizationStateWaitTdlibParameters= and then closes. Not one ever reaches + =WaitPhoneNumber=, let alone Ready. +- The first failure is the day after the package update. Nothing else changed. + +The digest pin is +=zevlg/telega-server@sha256:a4b88e029ba381eca7c37c9618c9e3ad73aa9db2097fe07a0c6684d40d32b84e=, +an image built 2026-06-05. It was correct for the July package and is wrong for +this one. + +* Two things I got wrong first, worth recording + +The image is present. I reported it missing on 08-21 and again on 08-23, on the +strength of =docker images= showing only the slack-mcp container. That output +lies here: the newer docker CLI's default listing (the =IMAGE / DISK USAGE / +CONTENT SIZE= format) only shows tagged images, and an image pulled by digest has +no =RepoTags=. =docker images -a --digests= shows it plainly: + +: zevlg/telega-server <none> sha256:a4b88e02... db0e011ad225 2 months ago 312MB + +If a probe needs to know whether an image is on a machine, =docker image inspect +<ref>= is the honest check. =docker images= isn't. + +The image also works. I ran the exact command telega builds +(=telega-docker-run-cmd=) by hand. tdlib 1.8.64 came up, created a client, and sat +at =authorizationStateWaitTdlibParameters= waiting for telega.el, which is +correct behaviour. There's nothing wrong with the container. + +* Why nothing told me, and what I still don't know about that + +I first wrote this up as "the death alert is structurally unable to fire because +=telega-server-kill= is orderly, so the exit status is zero." That was wrong, and +the evidence that refutes it was already in front of me: the daemon's +=*Messages*= holds =[125]telega-server: exited abnormally with code 125=, and +=telega-server--sentinel= prints that line only from its non-zero-exit branch. +=telega-server-kill= works by killing the process buffer, not by a clean close, +so the process exits 125. =cj/--telega-server-death-p= returns t for any non-zero +integer, and the =:after= advice on the sentinel then runs +=notify fail "Telegram: telega-server died" ... --persist=. + +So the notification path was armed and should have paged me on every one of +those launches. I didn't see one. I can't reconstruct why from here: the +daemon's process table from those days is gone, so whether =notify= ran and I +dismissed it, or the =notify= script was absent in the days after the 08-13 +rebuild, or the advice hadn't been installed in that daemon, is unmeasured. +Worth a controlled reproduction with the daemon watched, rather than another +guess. + +Two things did fail as described. The =(warn ...)= goes to =*Warnings*=, which I +never look at in a daemon driven by =emacsclient=. And =(telega t)= still returns +=started= regardless, so a caller checking the return value learns nothing; only +=(telega-server-live-p)= a moment later tells the truth. + +* ratio is fine today and breaks on its next package upgrade + +| | velox | ratio | +|------------------------------------------------+---------------------+----------------------| +| telega package | telega-20260817.621 | telega-20260706.2147 | +| =telega-tdlib-min-version= | 1.8.66 | 1.8.64 | +| pinned image (a4b88e, tdlib 1.8.64) | present | present | +| =zevlg/telega-server:latest= (aa7e79c4) | absent (pulled later, see below) | present | +| =~/.telega/td.binlog= | absent | 1.5 MB, written 08-16 | +| =~/.telega/db.sqlite= | absent | 14.7 MB | + +ratio's package still wants 1.8.64, which is exactly what the pinned image +carries, which is why Telegram still works there. It's one =package-upgrade +telega= away from the identical silent failure. Worth fixing before that happens +rather than after. + +* Second, separate problem on velox: there is no Telegram session + +=~/.telega/= on velox holds only an empty =cache/= and =temp/=, both dated +2026-08-19 15:26, the first failed attempt. No =td.binlog=, no =db.sqlite=. The +account state was lost in the 2026-08-13 rebuild and never restored (the same +rebuild that wiped the Signal identity, which I recovered from the pre-reinstall +backup). + +So fixing the image pin gets telega to start on velox. It will then sit at +=WaitPhoneNumber= and need interactive auth (phone number plus verification code) +inside =M-x telega=. That can't be done headlessly. The pre-reinstall backup is +worth checking for =~/.telega= before re-authing from scratch, since restoring +the binlog would keep the existing session rather than minting a new device. + +* The obvious fix doesn't work + +The mechanical fix would be to move =cj/telega-docker-image= to a digest whose +tdlib is >= 1.8.66. The obvious candidate is =zevlg/telega-server:latest=, which +ratio already holds at +=sha256:aa7e79c4e9587c84065782df9399653fb1a967078b08ec1ded77738d4c2d70ad=. + +I read the tdlib version straight out of the shared library in both images on +ratio, where both are present: + +| image | libtdjson | +|------------------------+-----------------------| +| =a4b88e02= (pinned) | =libtdjson.so.1.8.64= | +| =aa7e79c4= (=:latest=) | =libtdjson.so.1.8.66= | + +The version floor is satisfied by =:latest=, but the image is broken: +=docker run --rm zevlg/telega-server:latest telega-server -h= exits 127 with 32 +lines of linker failure, beginning + +: Error loading shared library libglycin-2.so.0: No such file or directory (needed by /usr/lib/libgdk_pixbuf-2.0.so.0) + +It reproduced identically on velox after I pulled the image there, so it's the +image and not one machine. My first read blamed the failure on having overridden +the container entrypoint. That's not it: the image has no entrypoint +(=ENTRYPOINT=null=, =CMD=["/bin/bash"]=), and the same invocation against the +pinned image runs and prints =Version 1.2.0, with appindicator, with zlib=. + +** It's a known, open upstream bug + +[[https://github.com/zevlg/telega.el/issues/596][zevlg/telega.el issue #596]], +"docker image zevlg/telega-server:latest missing libglycin (-2.so.0)", opened +2026-08-11 by akovalenko. Still open, no maintainer response, no official fix. + +Docker Hub carries only three tags for =zevlg/telega-server=: =latest= (pushed +2026-07-23, digest =aa7e79c4=), =arm64= (2025-02-03) and =1.8.0= (2021-12-31). +So there's no =1.8.66= tag to pin to instead, and "pin to latest" and "pin to the +broken image" are the same action. + +** The workaround works, verified locally + +The two-line derived image from issue #596: + +#+begin_src dockerfile +FROM zevlg/telega-server:latest +RUN apk add --no-cache libglycin +#+end_src + +Built on velox as =telega-server-glycin:test=: + +- =apk add libglycin= resolves cleanly (150 packages, 155.6 MiB). +- =telega-server -h= prints =Version 1.2.0, with appindicator, with zlib=. It runs. +- =/usr/lib/libtdjson.so.1.8.66=, satisfying telega-20260817.621's floor. + +* What remains a decision rather than a measurement + +1. A locally-built image has no =RepoDigest=, so =cj/telega-docker-image= would + degrade from a digest pin to a tag reference, losing the guarantee that pin + exists to give. +2. It's fleet-local. ratio needs the same image built there (or a registry to + pull from), or it breaks on its next =package-upgrade telega=. +3. The alternative is pinning the telega package back to =20260706.2147=. That + keeps the working upstream image and the digest pin, and stops the + auto-upgrade that caused this, at the cost of freezing telega until #596 is + fixed. +4. Either way velox has no Telegram session, so it lands at =WaitPhoneNumber= + and needs interactive auth that can't be done headlessly. + +I haven't decided yet. Two related pieces of hardening are worth doing whichever +way it goes: + +- The pin's own docstring already ties it to "this telega's + =telega-tdlib-min-version=", so the coupling was understood, but nothing + enforces it and the package updates on its own schedule. A launch-time + assertion comparing the running server's reported tdlib version against + =telega-tdlib-min-version=, reported through =notify= rather than =warn=, + catches the whole class. =tests/test-telega-config--docker-pin.el= is the + natural home for a test that the pin and the installed package's floor agree. +- A controlled reproduction of the silent death with the daemon watched, to + find out why the armed notification wasn't seen (previous section). + +* Decision (2026-08-25): derived image, built from a Dockerfile in this repo + +I went with the derived image, in a form that keeps most of what the digest +pin gave. Three things settled it: + +- The derived image (tdlib 1.8.66) satisfies both machines' current packages: + velox's telega wants 1.8.66 and ratio's wants 1.8.64, and telega accepts + anything at or above its floor. The package pin would have worked only on + velox, and only after copying =elpa/telega-20260706.2147= over from ratio. +- package.el has no version pin and MELPA serves only its latest build, so + "pin the package back" is a copied directory plus the hope that nobody runs + =package-upgrade= again. Nothing enforces it. +- The pre-reinstall backup on the NAS holds velox's =~/.telega= (td.binlog + and db.sqlite from 2026-07-05), so a working image plus that directory may + restore the session without a phone re-auth. + +The shape: =docker/telega-server/Dockerfile= (FROM pinned to the upstream +digest, plus =apk add libglycin=), =make telega-image= builds it under +=cj/telega-server:1.8.66-glycin=, =cj/telega-docker-image= defaults to that +tag, and =cj/telega= refuses to launch with a "run make telega-image" message +when the image isn't built, so a fresh machine gets a pointer instead of a +confusing registry pull failure. The digest guarantee lives in the +Dockerfile's FROM line; a test holds the defcustom default equal to the +Makefile's tag. When #596 is fixed upstream, the pin goes back to a registry +digest and the Dockerfile goes. + +Not done here: the launch-time tdlib-version assertion, and the controlled +reproduction of the unseen death notification. Both are filed. + +* Reproducing it + +#+begin_src sh +# the image is there, despite what `docker images` shows +docker images -a --digests | grep telega +docker image inspect zevlg/telega-server@sha256:a4b88e029ba381eca7c37c9618c9e3ad73aa9db2097fe07a0c6684d40d32b84e >/dev/null && echo present + +# the version floor vs what the image ships +grep -E 'defconst telega-tdlib-(min|max)-version' ~/.emacs.d/elpa/telega-*/telega.el + +# repeated identical failures, no Ready among them +grep -c 'authorizationStateClosed' ~/.telega/telega-server.log +grep 'Receive request 6: close' ~/.telega/telega-server.log + +# the broken upstream image, and the derived one that works +docker run --rm zevlg/telega-server:latest telega-server -h; echo "exit $?" +docker run --rm telega-server-glycin:test telega-server -h; echo "exit $?" +#+end_src diff --git a/docs/specs/2026-07-06-radio-browser-lookup-spec.org b/docs/specs/2026-07-06-radio-browser-lookup-spec.org index c65de850..89251418 100644 --- a/docs/specs/2026-07-06-radio-browser-lookup-spec.org +++ b/docs/specs/2026-07-06-radio-browser-lookup-spec.org @@ -162,7 +162,7 @@ Add cj/music-radio-search (query -> search -> completing-read multi-select -> wr * Readiness dimensions - Data model & ownership: a station plist (uuid, name, url, codec, bitrate, tags, country, votes, clickcount) derived from the API; the .m3u file is generated and owned by Craig once written. No local cache in v1. -- Errors, empty states & failure: named user-errors — no server reachable, empty results, cancelled selection, write failure (naming the file). No silent data loss; overwrite reuses the existing cj/confirm-strong prompt from create-radio-station. +- Errors, empty states & failure: named user-errors — no server reachable, empty results, cancelled selection, write failure (naming the file). No silent data loss; overwrite reuses the existing cj/confirm-destructive prompt from create-radio-station. - Security & privacy: no credentials. The only outbound data is the search query and a User-Agent to a public API. No sensitive data logged. - Observability: the command messages the server used, the result count, and each file written. Search is one short synchronous call; if it ever feels slow, a "Searching radio-browser…" message covers it. - Performance & scale: result sets bounded by an explicit limit (default ~30). One GET per search. No scaling concern. diff --git a/early-init.el b/early-init.el index d59f0a8b..8d4eb268 100644 --- a/early-init.el +++ b/early-init.el @@ -253,6 +253,18 @@ early-init.el.") ;;(require 'use-package-ensure) ; Needed for :ensure to work (setq use-package-always-ensure t) ; Auto-install packages +;; A dead download must not abort startup. `use-package-ensure-elpa' already +;; warns and carries on when an install fails, but it guards with +;; `condition-case-unless-debug', which does nothing while `debug-on-error' is +;; set -- and it is set above, deliberately, so init errors are loud. The two +;; collide: one file-error from an ELPA host stopped a fresh install in place +;; with a third of the config loaded. This module takes over +;; `use-package-ensure-function' so the debugger is inhibited for the install +;; alone, retries a transient failure, and reports what is missing once startup +;; finishes. The load-path form matches init.el's so add-to-list dedups it. +(add-to-list 'load-path (concat user-emacs-directory "modules/")) +(require 'package-resilience) + ;; Keep the GNU ELPA signing keys current so signature verification doesn't ;; start failing when the archive key expires (the usual reason verification ;; gets turned off). Failure is non-fatal so a clean-machine bootstrap or an diff --git a/githooks/pre-commit b/githooks/pre-commit index a87bedf8..2be98c79 100755 --- a/githooks/pre-commit +++ b/githooks/pre-commit @@ -15,7 +15,12 @@ cd "$REPO_ROOT" || exit 1 # AKIA[0-9A-Z]{16} matches any mixed-case 20-char run, which random base64 in an # embedded image blob hits ~6% of the time per 100KB and blocks real commits. # Only the keyword=value patterns need -i. -SECRET_PATTERNS_CS='(AKIA[0-9A-Z]{16}|sk-[a-zA-Z0-9_-]{20,}|-----BEGIN (RSA|DSA|EC|OPENSSH|PGP)( PRIVATE)?( KEY| KEY BLOCK)?-----)' +# +# The sk- pattern is anchored on a word boundary: unanchored it matched inside +# any hyphenated identifier ending in sk- (task-, risk-, disk-) with 20 more +# word characters, which blocked a commit on an elisp assertion naming +# task-missing-last-reviewed. A real key always starts its token. +SECRET_PATTERNS_CS='(AKIA[0-9A-Z]{16}|\bsk-[a-zA-Z0-9_-]{20,}|-----BEGIN (RSA|DSA|EC|OPENSSH|PGP)( PRIVATE)?( KEY| KEY BLOCK)?-----)' SECRET_PATTERNS_CI='(api[_-]?key|api[_-]?secret|auth[_-]?token|secret[_-]?key|bearer[_-]?token|access[_-]?token|password)[[:space:]]*[:=][[:space:]]*["'"'"'][^"'"'"']{16,}["'"'"']' # Read the diff on its own so a git failure is distinguishable from "grep @@ -160,7 +160,12 @@ (require 'music-config) ;; games-config: deferred (load-graph Phase 4). malyon / 2048-game autoload ;; their own commands via package.el; games-config only supplies malyon's config, -;; so load it when malyon loads rather than requiring it at startup. +;; so load it when malyon loads rather than requiring it at startup. The two +;; use-package forms exist so `use-package-always-ensure' installs the packages +;; on a fresh machine: nothing else declares them, and a8571eff's removal left +;; both absent after the 2026-08-13 reinstall. :defer t keeps them unloaded. +(use-package malyon :defer t :commands (malyon)) +(use-package 2048-game :defer t :commands (2048-game)) (with-eval-after-load 'malyon (require 'games-config)) (require 'takuzu-config) ;; Takuzu (Binairo) puzzle on M-x takuzu; package in ~/code/takuzu diff --git a/modules/agenda-query.el b/modules/agenda-query.el index 5a185076..c98b7fb7 100644 --- a/modules/agenda-query.el +++ b/modules/agenda-query.el @@ -575,18 +575,28 @@ entry spans its day and a point event has zero width. See json)) (defun cj/agenda-render-cache-update () - "Write today's agenda to `cj/agenda-render-cache-file' for the renderer. + "Write the agenda around today to `cj/agenda-render-cache-file'. -The window is the whole local day, midnight to day close, so it is 23 or 25 -hours long on a DST changeover rather than a flat 24. Returns the path. +The window is three whole local days: yesterday's midnight through tomorrow's +day close. A consumer drawing a rolling window centred on now needs entries +from either side of midnight, and a single calendar day leaves it with nothing +to draw for the part of its span that falls outside today -- half the surface, +late in the evening. Three days covers any rolling span up to a full day +either way, and the consumer filters to what it actually draws. + +Day boundaries are computed rather than assumed, so the span is 71, 72 or 73 +hours across a DST changeover rather than a flat 72. Returns the path. Safe to call repeatedly and from a timer: it only reads org files, creates the cache directory if needed, and replaces the file by rename, so a reader on its own schedule never sees a partial write." (interactive) (let* ((d (decode-time (time-convert nil 'integer))) - (start (cj/--agenda-query-epoch 0 0 0 (nth 3 d) (nth 4 d) (nth 5 d))) - (end (cj/--agenda-query-day-close (nth 3 d) (nth 4 d) (nth 5 d)))) + (day (nth 3 d)) (month (nth 4 d)) (year (nth 5 d)) + ;; Out-of-range day fields normalize, so day 0 is last month's last + ;; day and day+1 rolls the month or year without special cases. + (start (cj/--agenda-query-epoch 0 0 0 (1- day) month year)) + (end (cj/--agenda-query-day-close (1+ day) month year))) (make-directory (file-name-directory cj/agenda-render-cache-file) t) (cj/agenda-render-json start end cj/agenda-render-cache-file) (when (called-interactively-p 'interactive) diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index d504f246..5338e7d7 100644 --- a/modules/calendar-sync.el +++ b/modules/calendar-sync.el @@ -87,10 +87,22 @@ calendar feed URLs." "Sync interval in minutes. Default: 60 minutes (1 hour).") -(defvar calendar-sync-auto-start t - "Whether to automatically start calendar sync when module loads. -If non-nil, sync starts automatically when calendar-sync is loaded. -If nil, user must manually call `calendar-sync-start'.") +(defvar calendar-sync-auto-start nil + "Whether the editor arms its own periodic sync when this module loads. + +Off by default: the calendar-sync.timer systemd unit owns the schedule now, +running scripts/calendar-sync-run every ten minutes whether or not Emacs is +up. Leaving the in-editor timer armed as well would give two owners writing +the same org files and the same state file, with no coordination between +them. + +Set to t to hand the schedule back to the editor -- the deferred start at the +end of this file still works, and `calendar-sync-start' and +`calendar-sync-now' remain available on demand either way. + +The tradeoff this default accepts: a checkout whose timer has never been +enabled does not sync on its own. Enabling the unit is a one-time step per +machine, alongside symlinking it into ~/.config/systemd/user.") (defvar calendar-sync-user-emails '("craigmartinjennings@gmail.com" "craig.jennings@deepsat.com" "c@cjennings.net") @@ -215,16 +227,27 @@ calendar files do not block the interactive Emacs thread. Skips a calendar whose previous sync is still in flight, so a timer tick that fires before a slow fetch finishes does not launch a second overlapping sync for -the same calendar." +the same calendar. + +A synchronous failure is contained here and recorded against this calendar +alone. The async callbacks record their own failures, but they never run when +the error lands before a process starts -- resolving a `:secret-host' feed +reads authinfo.gpg, which signals outright on a cold gpg-agent. Uncontained, +that first error aborted the whole loop and the remaining calendars never +synced." (let ((name (plist-get calendar :name))) - (cond - ((calendar-sync--syncing-p name) - (calendar-sync--log-silently - "calendar-sync: [%s] sync already in flight; skipping overlapping tick" name)) - ((eq (plist-get calendar :fetcher) 'api) - (calendar-sync--sync-calendar-api calendar)) - (t - (calendar-sync--sync-calendar-ics calendar))))) + (if (calendar-sync--syncing-p name) + (calendar-sync--log-silently + "calendar-sync: [%s] sync already in flight; skipping overlapping tick" name) + (condition-case err + (if (eq (plist-get calendar :fetcher) 'api) + (calendar-sync--sync-calendar-api calendar) + (calendar-sync--sync-calendar-ics calendar)) + (error + (let ((reason (error-message-string err))) + (calendar-sync--log-silently + "calendar-sync: [%s] Sync error: %s" name reason) + (calendar-sync--mark-sync-failed name reason))))))) (defun calendar-sync--require-calendars () "Return non-nil if calendars are configured, else warn and return nil." @@ -297,6 +320,96 @@ When called non-interactively with nil, syncs all calendars." (message "calendar-sync status:\n%s" (string-join (nreverse status-lines) "\n"))))) +;;; Batch entry point + +;; `emacs --batch' exits the moment its top-level form returns, and this +;; pipeline is asynchronous end to end -- curl in one process, the org +;; conversion in a second batch Emacs. So `calendar-sync-now' is the wrong +;; entry point for a timer: it returns as soon as the fetches are launched, +;; and batch Emacs would exit and kill both children mid-flight, having +;; written nothing and reported success. +;; +;; The batch path therefore starts the sync and then blocks on the same +;; per-calendar state the interactive session keeps. Nothing new tracks +;; completion -- the pipeline's own record of what finished is the signal. + +(defvar calendar-sync--batch-poll-seconds 0.2 + "Seconds `calendar-sync--batch-wait' blocks per iteration. +Short enough that the wait ends promptly once the last child exits, long +enough that the loop is not a spin. Rebound in tests.") + +(defvar calendar-sync-batch-timeout 300 + "Seconds `calendar-sync-batch-run' waits for every calendar to settle. +Covers a `calendar-sync-fetch-timeout' fetch plus the org conversion, with +room to spare: the calendars run in parallel, so this is not a per-calendar +budget.") + +(defun calendar-sync--batch-results (names) + "Return one (NAME . STATUS) pair per calendar in NAMES, in that order. +A calendar with no state entry reads `never' rather than nil, so one that +never started still counts when the failures are tallied." + (mapcar (lambda (name) + (cons name + (or (plist-get (calendar-sync--get-calendar-state name) :status) + 'never))) + names)) + +(defun calendar-sync--batch-failures (results) + "Return the rows of RESULTS that did not finish cleanly. +Only `ok' passes. `error' failed outright, `syncing' means the wait expired +with the fetch still in flight, and `never' means the sync never started -- +in all three the org file on disk is not the calendar's current contents, +which is the staleness the timer exists to prevent." + (seq-remove (lambda (row) (eq (cdr row) 'ok)) results)) + +(defun calendar-sync--batch-wait (names timeout) + "Block until no calendar in NAMES is syncing, or TIMEOUT seconds elapse. +Return non-nil when every calendar settled, nil when the timeout expired +first. `accept-process-output' is also what lets the fetch and conversion +sentinels run, so this loop drives the pipeline as well as waiting on it." + (let ((deadline (+ (float-time) timeout))) + (while (and (seq-some #'calendar-sync--syncing-p names) + (< (float-time) deadline)) + (accept-process-output nil calendar-sync--batch-poll-seconds)) + (not (seq-some #'calendar-sync--syncing-p names)))) + +;;;###autoload +(defun calendar-sync-batch-run (&optional timeout) + "Sync every configured calendar, blocking until all of them finish. +Return the (NAME . STATUS) rows. TIMEOUT defaults to +`calendar-sync-batch-timeout'. + +This is the entry point for the systemd timer. Prefer `calendar-sync-now' +in an interactive session, where returning immediately is the point." + (unless (calendar-sync--require-calendars) + (error "calendar-sync: no calendars configured")) + (let ((names (calendar-sync--calendar-names))) + (calendar-sync--sync-all-calendars) + (calendar-sync--batch-wait names (or timeout calendar-sync-batch-timeout)) + (calendar-sync--batch-results names))) + +;;;###autoload +(defun calendar-sync-batch-run-and-report () + "Run a batch sync, print one line per calendar, and return an exit code. +0 when every calendar synced, 1 otherwise. Written for +scripts/calendar-sync-run, which turns the code into the process's own exit +status so systemd records a failed sync instead of swallowing it. + +A failed row carries its recorded `:last-error'. The interactive failure +path logs the reason to *Messages', which batch Emacs discards at exit, so +without this the journal shows only `error' — no way to tell a cold +gpg-agent from a revoked feed token or a dead network without re-running the +sync by hand." + (let* ((results (calendar-sync-batch-run)) + (failures (calendar-sync--batch-failures results))) + (dolist (row results) + (let ((reason (unless (eq (cdr row) 'ok) + (plist-get (calendar-sync--get-calendar-state (car row)) + :last-error)))) + (princ (format "%s: %s%s\n" (car row) (cdr row) + (if reason (format " — %s" reason) ""))))) + (if failures 1 0))) + ;;; Timer management (defun calendar-sync--sync-timer-function () @@ -405,6 +518,11 @@ Syncs all calendars immediately, then every `calendar-sync-interval-minutes'." ;; Defer auto-sync until calendar data is first needed. ;; +;; Dormant unless `calendar-sync-auto-start' is turned back on -- the systemd +;; timer owns the schedule now. Kept because the reasoning below still holds +;; for anyone who hands the schedule back to the editor, and because it is the +;; only safe shape for an in-editor start. +;; ;; The :secret-host feed URLs live in authinfo.gpg, and BOTH the immediate sync ;; and every periodic timer tick resolve them. Calling `calendar-sync-start' at ;; load (immediate sync + recurring timer) therefore decrypts authinfo.gpg right @@ -412,6 +530,11 @@ Syncs all calendars immediately, then every `calendar-sync-interval-minutes'." ;; after a reboot). Defer the whole start to the first org-agenda use, so the ;; unlock happens when the user actually asks for calendar data. A manual ;; `calendar-sync-start' / `calendar-sync-now' still works on demand. +;; +;; That deferral is also what made the timer necessary: hanging the start on +;; `org-agenda-mode-hook' means a session where the agenda is never opened +;; never syncs at all, which after a reboot is every session until the first +;; agenda call. The batch path has no such trigger to miss. (defun calendar-sync--auto-start-on-first-agenda () "Start auto-sync on the first org-agenda use, then remove this hook. One-shot: deferring `calendar-sync-start' until the agenda is first built keeps a diff --git a/modules/config-utilities.el b/modules/config-utilities.el index 4332f407..62fc29d0 100644 --- a/modules/config-utilities.el +++ b/modules/config-utilities.el @@ -196,27 +196,27 @@ Returns the count of files deleted." count user-emacs-directory))) (keymap-set cj/debug-config-keymap "c d" 'cj/delete-emacs-home-compiled-files) -(defun cj/compile-this-elisp-buffer () - "Compile the current .el: prefer native (.eln), else .elc. Message if neither." - (interactive) - (unless (and buffer-file-name (string-match-p "\\.el\\'" buffer-file-name)) - (user-error "Not visiting a .el file")) - (save-buffer) - (let ((file buffer-file-name)) +(defun cj/--compile-elisp-file (file &optional available-p) + "Compile FILE: prefer async native, then sync native, then byte-compile. +AVAILABLE-P decides which compilers exist; it defaults to `fboundp'. It is +a parameter so tests can force each branch without redefining `fboundp': +an `fset' on that subr pulls in comp-run and bytecomp, whose own `defun' +of `byte-compile-file' then lands on top of any test double." + (let ((available-p (or available-p #'fboundp))) (cond ;; Native compilation (async preferred) - ((fboundp 'native-compile-async) + ((funcall available-p 'native-compile-async) (native-compile-async file) (message "Queued native compilation for %s" file)) ;; Native compilation (sync, if async not available) - ((fboundp 'native-compile) + ((funcall available-p 'native-compile) (condition-case err (progn (native-compile file) (message "Native-compiled %s" file)) (error (message "Native compile failed: %s" (error-message-string err))))) ;; Byte-compile fallback - ((fboundp 'byte-compile-file) + ((funcall available-p 'byte-compile-file) (let ((out (byte-compile-file file))) (if out (message "Byte-compiled -> %s" out) @@ -224,6 +224,14 @@ Returns the count of files deleted." ;; Neither facility available (t (message "No compilation available (no native-compile, no byte-compile)"))))) + +(defun cj/compile-this-elisp-buffer () + "Compile the current .el: prefer native (.eln), else .elc. Message if neither." + (interactive) + (unless (and buffer-file-name (string-match-p "\\.el\\'" buffer-file-name)) + (user-error "Not visiting a .el file")) + (save-buffer) + (cj/--compile-elisp-file buffer-file-name)) (keymap-set cj/debug-config-keymap "c ." 'cj/compile-this-elisp-buffer) ;; --------------------------- Information Reporting --------------------------- diff --git a/modules/custom-buffer-file.el b/modules/custom-buffer-file.el index 0ca06cf9..fdcc4d2f 100644 --- a/modules/custom-buffer-file.el +++ b/modules/custom-buffer-file.el @@ -59,7 +59,7 @@ (declare-function mm-insert-part "mm-decode") (declare-function mm-destroy-parts "mm-decode") (require 'external-open) ;; for cj/xdg-open, cj/open-this-file-with -(require 'system-lib) ;; cj/confirm-strong (overwrite confirms), used below +(require 'system-lib) ;; cj/confirm-destructive (overwrite confirms), used below ;; cj/kill-buffer-and-window and cj/kill-other-window-buffer defined in undead-buffers.el (declare-function cj/kill-buffer-and-window "undead-buffers") @@ -168,7 +168,7 @@ When called interactively, prompts for confirmation if target file exists." (condition-case _ (cj/--move-buffer-and-file dir nil) (file-already-exists - (if (cj/confirm-strong (format "File %s exists; overwrite? " target)) + (if (cj/confirm-destructive (format "File %s exists; overwrite? " target)) (cj/--move-buffer-and-file dir t) (message "File not moved")))))) @@ -208,7 +208,7 @@ When called interactively, prompts for confirmation if target file exists." (condition-case err (cj/--rename-buffer-and-file new-name nil) (file-already-exists - (if (cj/confirm-strong (format "File %s exists; overwrite? " new-name)) + (if (cj/confirm-destructive (format "File %s exists; overwrite? " new-name)) (cj/--rename-buffer-and-file new-name t) (message "File not renamed"))) (error diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el index edbb0b35..6c849198 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -590,6 +590,7 @@ no popup frame is live." ("ps" ,(concat pix-dir "/screenshots/") "pictures screenshots") ("px" ,pix-dir "pictures directory") ("wp" ,(concat pix-dir "/wallpaper/") "pictures wallpaper") + ("wv" ,(concat videos-dir "wallpaper/") "wallpaper videos") ("fp" "/ftp:android@192.168.86.13#2221:/" "phone ftp (android)") ("rcj" "/sshx:cjennings@cjennings.net:~" "remote c@cjennings.net") ("rtl" "/sshx:cjennings@truenas.local:~" "remote cjennings@truenas.local") diff --git a/modules/dwim-shell-config.el b/modules/dwim-shell-config.el index 54272fd5..12908f51 100644 --- a/modules/dwim-shell-config.el +++ b/modules/dwim-shell-config.el @@ -22,7 +22,7 @@ ;;; Code: (require 'cl-lib) -(require 'system-lib) ;; cj/confirm-strong (permanent file destruction confirm) +(require 'system-lib) ;; cj/confirm-destructive (permanent file destruction confirm) (require 'external-open) ;; cj/xdg-open, called to open conversion output files ;; Function declarations (lazily-loaded packages and sibling modules). @@ -765,7 +765,7 @@ switching off the .7z format to gpg-wrapped tar." Uses =shred -u= so the file is unlinked after overwriting, matching the \"delete\" the command name and prompt promise." (interactive) - (when (cj/confirm-strong "This will permanently destroy files. Continue? ") + (when (cj/confirm-destructive "This will permanently destroy files. Continue? ") (dwim-shell-command-on-marked-files "Secure delete" "shred -vfzu -n 3 '<<f>>'" diff --git a/modules/eat-config.el b/modules/eat-config.el index 01d0fbe6..f764848e 100644 --- a/modules/eat-config.el +++ b/modules/eat-config.el @@ -415,7 +415,8 @@ terminal. ai-term's agent buffers are managed separately via M-SPC." ;; Carried over from the ghostel era for the EAT agent terminals (ai-term). ;; Agents run EAT over tmux, so copy-mode is tmux's own copy-mode -- the same UX ;; ghostel-over-tmux had. C-<up> enters it and scrolls up in one stroke; C-; x c -;; enters it via the menu, and C-; x h grabs the whole pane history into a buffer. +;; enters it via the menu, C-; x h grabs the whole pane history into a buffer, +;; and C-; x d detaches the tmux client without going through its prefix. (declare-function cj/register-prefix-map "keybindings") (declare-function eat-emacs-mode "eat") @@ -585,6 +586,20 @@ scrollback) and moves point to the start of the line." (eat-emacs-mode) (beginning-of-line))) +(defun cj/term-tmux-detach () + "Detach the tmux client from inside an agent terminal. +Writes tmux's prefix and the detach key (C-b d) straight into the pty, the +same path `cj/term-copy-mode-dwim' uses for C-b [. A keyboard C-b inside +the Claude Code pane has been observed to land as stray text instead of +reaching tmux as a prefix (root cause not yet pinned down), so the string +path is the reliable one. Outside tmux it writes +nothing and says so, since C-b d typed into a plain shell is just a control +character." + (interactive) + (if (cj/term--in-tmux-p) + (cj/--term-send-string "\C-bd") + (message "cj/term-tmux-detach: not attached to tmux"))) + (defun cj/term--tmux-pane-in-copy-mode-p (pane-id) "Return non-nil when tmux PANE-ID is currently displaying a mode. tmux's `pane_in_mode' is 1 while a pane is in any mode; copy-mode is the only @@ -613,13 +628,15 @@ pty; without tmux, moves point up in EAT's emacs-mode buffer." (cj/term-copy-mode-dwim)) (forward-line -1))))) -;; The C-; x terminal prefix (copy-mode, tmux history, the F12 toggle). C-<up> +;; The C-; x terminal prefix (copy-mode, tmux detach, tmux history, the F12 +;; toggle). C-<up> ;; enters copy-mode + scrolls in one stroke; bound in EAT's semi-char map so it ;; reaches Emacs from inside an agent terminal. (defvar-keymap cj/term-map :doc "Personal terminal command map.") (cj/register-prefix-map "x" cj/term-map) (keymap-set cj/term-map "c" #'cj/term-copy-mode-dwim) +(keymap-set cj/term-map "d" #'cj/term-tmux-detach) (keymap-set cj/term-map "h" #'cj/term-tmux-history) (keymap-set cj/term-map "t" #'cj/term-toggle) diff --git a/modules/google-keep-config.el b/modules/google-keep-config.el index 1738fa6e..c0a5374f 100644 --- a/modules/google-keep-config.el +++ b/modules/google-keep-config.el @@ -46,6 +46,27 @@ Unset until the one-time setup is done; `cj/keep-refresh' warns when nil." :type 'string :group 'cj/keep) +(defcustom cj/keep-local-config-file + (expand-file-name "google-keep.local.el" user-emacs-directory) + "Machine-local Keep config loaded when readable. +The intended place for `cj/keep-python' (a machine-local venv path) and +`cj/keep-email' -- gitignored, same shape as calendar-sync.local.el." + :type 'file + :group 'cj/keep) + +(defun cj/keep--load-local-config () + "Load the machine-local Keep config when available. +Return non-nil when the file loaded cleanly, nil when it is absent or +broken; a broken file is reported via `message', never signaled." + (when (file-readable-p cj/keep-local-config-file) + (condition-case err + (load cj/keep-local-config-file nil t) + (error + (message "google-keep: Failed to load local config %s: %s" + (abbreviate-file-name cj/keep-local-config-file) + (error-message-string err)) + nil)))) + (defvar cj/keep--bridge-script (expand-file-name "scripts/google-keep/keep-bridge.py" user-emacs-directory) "Path to the gkeepapi bridge script.") @@ -202,6 +223,10 @@ Returns the note count." (keymap-global-set "C-c k" cj/keep-prefix-map) +;; Machine-local settings (venv interpreter, email) load before the +;; interpreter warning below, so a venv path set locally is what gets checked. +(cj/keep--load-local-config) + ;; Warn at load if the interpreter is missing; gkeepapi/token failures surface ;; at refresh time via the bridge's stderr reason token. (cj/executable-find-or-warn cj/keep-python "Google Keep bridge" 'google-keep-config) diff --git a/modules/music-config.el b/modules/music-config.el index 233bae72..47863e41 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -31,7 +31,7 @@ (require 'user-constants) (require 'keybindings) ;; provides cj/custom-keymap (require 'cj-window-toggle-lib) ;; side-window size memory (F10 toggle) -(require 'system-lib) ;; cj/confirm-strong (overwrite confirms) +(require 'system-lib) ;; cj/confirm-destructive (overwrite confirms) ;; Declare these foreign package vars special so `let'-binding them below ;; compiles as a dynamic bind, not a dead lexical local -- otherwise emms / @@ -677,18 +677,39 @@ M3U-FILE should be an existing, writable M3U file path." (unless (file-writable-p m3u-file) (error "M3U file is not writable: %s" m3u-file)) - ;; Convert absolute path to relative path from music root - (let ((relative-path (if (file-name-absolute-p track-path) - (file-relative-name track-path cj/music-root) - track-path))) - ;; Determine if we need a leading newline - (let ((needs-prefix-newline nil) - (file-size (file-attribute-size (file-attributes m3u-file)))) - (when (> file-size 0) - ;; Read the last character of the file to check if it ends with newline - (with-temp-buffer - (insert-file-contents m3u-file nil (max 0 (1- file-size)) file-size) - (setq needs-prefix-newline (not (= (char-after (point-min)) ?\n))))) + ;; Relative when the track sits under the playlist's own directory, absolute + ;; otherwise. + ;; + ;; The base is the playlist rather than `cj/music-root' because that is what + ;; both readers resolve against -- `cj/music--m3u-file-tracks' and EMMS's + ;; `emms-source-playlist-parse-m3u'. Inside the music root the two are the + ;; same directory, which is why basing on the root went unnoticed: it only + ;; wrote an unresolvable line once a playlist lived somewhere else. + ;; + ;; Falling back to absolute keeps a cross-tree reference readable, and it + ;; survives the playlist being moved again. A playlist in the mpd directory + ;; pointing into ~/music would otherwise carry a four-level ../ chain that + ;; breaks the moment anything moves. + (let* ((dir (file-name-directory m3u-file)) + (relative-path + (if (not (file-name-absolute-p track-path)) + track-path + (let ((rel (file-relative-name track-path dir))) + (if (string-prefix-p "../" rel) track-path rel))))) + ;; Does the file need a separating newline first? Read the content and look + ;; at its last character, rather than seeking to a byte offset derived from + ;; `file-attributes'. That call does not follow symlinks, so on a + ;; stow-deployed playlist it measures the link string instead of the file: + ;; every symlinked playlist read the wrong byte and gained a blank line per + ;; append, and where the link string was the longer of the two the range fell + ;; outside the file entirely and the append died on a nil `char-after'. + ;; Playlists are small text files, so reading one is cheaper than being + ;; clever about offsets. + (let ((needs-prefix-newline + (with-temp-buffer + (insert-file-contents m3u-file) + (and (> (buffer-size) 0) + (/= (char-before (point-max)) ?\n))))) ;; Append the track with proper newline handling (with-temp-buffer @@ -833,7 +854,7 @@ reloaded playlist keeps its display name and cover art." (when (string-empty-p (string-trim chosen)) (user-error "Playlist name cannot be empty")) (when (and (file-exists-p full) - (not (cj/confirm-strong (format "Overwrite %s? " filename)))) + (not (cj/confirm-destructive (format "Overwrite %s? " filename)))) (user-error "Aborted saving playlist")) (make-directory dir t) (cj/music--write-playlist-file full tracks entries) @@ -875,7 +896,7 @@ clears its file association." (let ((file (cj/music--select-m3u-file "Delete playlist: "))) (if (not file) (message "Playlist deletion cancelled") - (unless (cj/confirm-strong (format "Delete playlist %s? " + (unless (cj/confirm-destructive (format "Delete playlist %s? " (file-name-nondirectory file))) (user-error "Aborted deleting playlist")) (cj/music--delete-playlist-file file) diff --git a/modules/org-config.el b/modules/org-config.el index a9fc4811..55fdf1d0 100644 --- a/modules/org-config.el +++ b/modules/org-config.el @@ -16,6 +16,7 @@ ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap (used in :init below) +(require 'user-constants) ;; provides cj/org-todo-keywords (used in :config) ;; Declare org variables and functions used before org is loaded so this module ;; byte-compiles standalone. Plain `defvar' (no value) marks the symbol special @@ -284,10 +285,9 @@ a no-op identical-state transition (see `cj/org--noop-state-log-p')." "All org-todo related settings are grouped and set in this function." ;; logging task creation, task start, and task resolved states - (setq org-todo-keywords '((sequence "TODO(t)" "PROJECT(p)" "DOING(i)" - "WAITING(w)" "VERIFY(v)" "STALLED(s)" - "DELEGATED(x)" "|" - "FAILED(f!)" "DONE(d!)" "CANCELLED(c!)"))) + ;; Defined in user-constants so a batch Emacs can load the sequence without + ;; this module's package dependencies. See `cj/org-todo-keywords'. + (setq org-todo-keywords cj/org-todo-keywords) ;; Keyword and priority faces are defined and wired in org-faces-config.el ;; (loaded just after this module): each keyword and priority maps to its own diff --git a/modules/package-resilience.el b/modules/package-resilience.el new file mode 100644 index 00000000..d81eeec0 --- /dev/null +++ b/modules/package-resilience.el @@ -0,0 +1,369 @@ +;;; package-resilience.el --- Survive failed package installs at startup -*- lexical-binding: t -*- + +;;; Commentary: +;; A transient package download must not abort init. +;; +;; `use-package-ensure-elpa' already handles a failed install correctly: it +;; wraps `package-install' in `condition-case-unless-debug', and on error it +;; warns and carries on. That guard does nothing whenever `debug-on-error' is +;; non-nil, and early-init.el sets `debug-on-error' for the whole of startup so +;; my own config errors are loud. The two settings collide. On a fresh +;; install one dead download — a file-error from an ELPA host — escaped into +;; the debugger and stopped init in place, leaving a third of the config +;; loaded and hooks pointing at packages that were never installed. +;; +;; I keep both behaviors by narrowing the loud-errors setting rather than +;; dropping it: package installation runs with the debugger inhibited, +;; everything else in init still gets it. A package that will not install is +;; recorded and reported at the end of startup instead of stopping it. + +;;; Code: + +(require 'cl-lib) +(require 'package) +(require 'seq) +(require 'use-package-ensure) + +(defgroup cj/package-resilience nil + "Keep a failed package install from aborting Emacs startup." + :group 'cj + :prefix "cj/package-") + +(defcustom cj/package-install-retries 2 + "How many extra attempts a failed package install gets. +Retries exist for transient network failures, which is the common case on a +fresh install pulling every package over the wire." + :type 'integer + :group 'cj/package-resilience) + +(defcustom cj/package-install-retry-delay 2 + "Seconds to wait between package install attempts." + :type 'number + :group 'cj/package-resilience) + +(defcustom cj/package-install-retry-budget 60 + "Seconds this session may spend retrying installs, in total. +Retrying is worth it for a transient failure, which fails alone. A machine +that is simply offline fails every package instead, and without a ceiling the +per-package retry cost would be paid ~190 times over — trading the abort this +module removes for a startup that appears to hang. Once the budget is spent +each package still gets its one attempt, and still gets recorded." + :type 'number + :group 'cj/package-resilience) + +(defcustom cj/package-install-failure-limit 5 + "Consecutive failed installs after which this session stops attempting more. +The retry budget bounds retrying, but not the first attempt, and the first +attempt is where the cost lives when a machine is entirely offline: nothing +populates `package-archive-contents', so `use-package-ensure-elpa' runs a full +`package-refresh-contents' across every configured archive before each install +fails. Paid once per package across ~190 packages, that is a startup that +looks hung. Failures this many times in a row mean the network is gone rather +than one package being unlucky, so the rest are recorded without being tried." + :type 'integer + :group 'cj/package-resilience) + +(defvar cj/failed-package-installs nil + "Archive packages that did not install during this session.") + +(defvar cj/failed-source-package-installs nil + "Packages declared with `:vc' that did not install during this session. +Kept apart from `cj/failed-package-installs' because `package-install' cannot +recover them: some are on no archive at all, and one that happens to be on an +archive would be recovered as the archive build rather than the source +checkout that was asked for, silently and permanently.") + +(defvar cj/--package-retry-spent 0.0 + "Seconds spent retrying package installs so far this session.") + +(defvar cj/--package-consecutive-failures 0 + "How many packages have failed to install in a row.") + +;; ------------------------------ Resolving names ------------------------------ + +(defun cj/--package-as-symbol (name) + "Return NAME as a symbol, whether it arrives as a symbol or a string. +This mirrors `use-package-as-symbol' without depending on use-package-core +being loaded at the point early-init installs this." + (if (symbolp name) name (intern name))) + +(defun cj/--package-ensure-packages (name args) + "Return the package symbols a use-package form requests. +NAME is the form's name and ARGS the values of its :ensure keywords, in the +shape `use-package-ensure-elpa' receives them: t means the form's own name, a +symbol names another package, a cons cell is a pinned (PACKAGE . ARCHIVE), and +nil requests nothing." + (delq nil + (mapcar (lambda (ensure) + (let ((package (if (eq ensure t) + (cj/--package-as-symbol name) + ensure))) + (if (consp package) (car package) package))) + args))) + +(defun cj/--package-ensure-missing (name args) + "Return the packages NAME's :ensure ARGS request that are not installed." + (seq-remove #'package-installed-p (cj/--package-ensure-packages name args))) + +(defun cj/--package-any-retryable-p (packages) + "Return non-nil when some of PACKAGES is one an archive actually carries. +A name no archive has heard of will not appear on a retry either, so retrying +it only spends another refresh on a typo." + (seq-some (lambda (package) (assq package package-archive-contents)) packages)) + +;; -------------------------------- Installing --------------------------------- + +(defun cj/--package-ensure-once (name args state no-refresh) + "Make one install attempt for NAME's :ensure ARGS, with STATE and NO-REFRESH. +Binding `debug-on-error' to nil re-arms the `condition-case-unless-debug' +inside `use-package-ensure-elpa', which early-init's loud-errors setting +otherwise disables. The editing hooks are silenced because installing a +package generates autoloads by visiting .el files: a hook belonging to a +package that failed earlier would run there and break unrelated installs." + (let ((debug-on-error nil) + (find-file-hook nil) + (prog-mode-hook nil) + (lisp-data-mode-hook nil) + (emacs-lisp-mode-hook nil)) + (use-package-ensure-elpa name args state no-refresh))) + +(defun cj/--package-retry-budget-left-p () + "Return non-nil while this session may still spend time retrying installs." + (< cj/--package-retry-spent cj/package-install-retry-budget)) + +(defun cj/--package-ensure-retry (name args state no-refresh) + "Retry NAME's missing :ensure ARGS, passing STATE and NO-REFRESH through. +Stops once the session's retry budget is spent, or once nothing still missing +is carried by an archive." + (let ((left cj/package-install-retries)) + (while (and (> left 0) + (cj/--package-retry-budget-left-p) + (cj/--package-any-retryable-p (cj/--package-ensure-missing name args))) + (setq left (1- left)) + (let ((start (float-time))) + (sleep-for cj/package-install-retry-delay) + (cj/--package-ensure-once name args state no-refresh) + (setq cj/--package-retry-spent + (+ cj/--package-retry-spent (- (float-time) start))))))) + +(defun cj/--package-record-one (package) + "Record PACKAGE as one that did not install." + (when package + (cl-pushnew package cj/failed-package-installs))) + +(defun cj/--package-record-source-one (package) + "Record PACKAGE as a source install that did not complete." + (when package + (cl-pushnew package cj/failed-source-package-installs))) + +(defun cj/--package-record-failures (name args) + "Record any of NAME's :ensure ARGS that are still not installed." + (dolist (package (cj/--package-ensure-missing name args)) + (cj/--package-record-one package))) + +(defun cj/--package-giving-up-p () + "Return non-nil once enough installs have failed in a row to stop trying." + (>= cj/--package-consecutive-failures cj/package-install-failure-limit)) + +(defun cj/--package-note-outcome (name args) + "Count NAME's :ensure ARGS outcome toward the consecutive-failure run." + (if (cj/--package-ensure-missing name args) + (setq cj/--package-consecutive-failures + (1+ cj/--package-consecutive-failures)) + (setq cj/--package-consecutive-failures 0))) + +(defun cj/package-ensure (name args state &optional no-refresh) + "Install NAME's :ensure ARGS without letting a failure abort startup. +STATE and NO-REFRESH are passed through to `use-package-ensure-elpa'. This is +the value of `use-package-ensure-function'; see this file's commentary for why +the stock one cannot survive `debug-on-error'. + +A form whose packages are already present is left alone entirely, so it neither +costs anything nor tells us whether the network is up." + (cond + ((null (cj/--package-ensure-missing name args)) nil) + ((cj/--package-giving-up-p) (cj/--package-record-failures name args)) + (t + (cj/--package-ensure-once name args state no-refresh) + (cj/--package-ensure-retry name args state no-refresh) + (cj/--package-note-outcome name args) + (cj/--package-record-failures name args)))) + +;; ------------------------- Packages installed from source -------------------- + +;; A `:vc' form routes around everything above: use-package nulls :ensure +;; whenever :vc is present (use-package-ensure.el, `use-package-handler/:ensure'), +;; so `use-package-ensure-function' is never consulted. And +;; `use-package-vc-install' carries no error handling of its own, so a failed +;; clone signals straight into init under the loud-errors setting -- the +;; original bug, through a second door. A fresh machine without credentials +;; for the git host yet is exactly the case this module exists for, so the +;; clone gets the same treatment: quiet context, recorded, counted. + +(defun cj/--package-vc-install-once (orig arg local-path) + "Call ORIG with ARG and LOCAL-PATH, surviving a failed clone. +Returns non-nil when the clone worked. Unlike the :ensure path there is no +upstream `condition-case' to re-arm, so this supplies one." + (let ((debug-on-error nil) + (find-file-hook nil) + (prog-mode-hook nil) + (lisp-data-mode-hook nil) + (emacs-lisp-mode-hook nil)) + (condition-case err + (progn (funcall orig arg local-path) t) + (error + (display-warning + 'cj/package-resilience + (format "Failed to install %s from source: %s" + (car arg) (error-message-string err)) + :error) + nil)))) + +(defun cj/--package-vc-install-guard (orig arg &optional local-path) + "Around-advice for `use-package-vc-install', called as ORIG. +ARG is (NAME OPTIONS REVISION) and LOCAL-PATH is passed through." + (let ((package (car arg))) + (cond + ;; Already present: ORIG no-ops, and it would tell us nothing about + ;; whether the host is reachable, so the failure run is left alone. + ((and package (package-installed-p package)) + (funcall orig arg local-path)) + ((cj/--package-giving-up-p) + (cj/--package-record-source-one package)) + (t + (cj/--package-vc-install-once orig arg local-path) + (if (and package (package-installed-p package)) + (setq cj/--package-consecutive-failures 0) + (cj/--package-record-source-one package) + (setq cj/--package-consecutive-failures + (1+ cj/--package-consecutive-failures))))))) + +;; --------------------------------- Recovery ---------------------------------- + +(defun cj/package-still-missing () + "Return the recorded failures that are still not installed. +A package that failed on its own `use-package' form is often installed a +moment later as some other package's dependency, so the recorded list +overstates the damage until it is re-checked against reality." + ;; `append' does not copy its last argument and `delete-dups' splices + ;; destructively, so without the copy this read would edit + ;; `cj/failed-source-package-installs' in place -- and it runs from the + ;; startup report, where losing a record silently is the worst place for it. + (seq-remove #'package-installed-p + (delete-dups + (append cj/failed-package-installs + (copy-sequence cj/failed-source-package-installs))))) + +(defun cj/--package-install-quietly (package) + "Attempt to install PACKAGE. Return non-nil if it is installed afterward." + (unless (package-installed-p package) + (let ((debug-on-error nil) + (find-file-hook nil) + (prog-mode-hook nil) + (lisp-data-mode-hook nil) + (emacs-lisp-mode-hook nil)) + (condition-case err + (package-install package) + (error (message "package-resilience: %s still failing: %s" + package (error-message-string err)))))) + (package-installed-p package)) + +(defun cj/--package-retry-pass () + "Try every package in `cj/failed-package-installs' once. +Return how many were installed on this pass." + (let ((installed 0)) + ;; Only the archive list. Source packages are kept out of it entirely, so + ;; no filter is needed here -- and a filter would be actively wrong: on a + ;; first boot before the network came up nothing has populated + ;; `package-archive-contents', so screening on it would skip every recorded + ;; package and make this command a silent no-op in the case it exists for. + ;; `package-install' populates the archives itself when it needs to. + (dolist (package (copy-sequence cj/failed-package-installs)) + (when (cj/--package-install-quietly package) + (setq cj/failed-package-installs + (delq package cj/failed-package-installs)) + (setq installed (1+ installed)))) + installed)) + +(defun cj/retry-failed-package-installs () + "Install everything that failed earlier, passing over the set until it settles. +A failed package leaves hooks that break other installs, so one package +succeeding can unblock others. Passes repeat while any pass installs +something, which also terminates: a pass that installs nothing ends it." + (interactive) + ;; Asking for a retry asserts the network may be back, so clear the run that + ;; stopped this session attempting installs in the first place. + (setq cj/--package-consecutive-failures 0) + (while (> (cj/--package-retry-pass) 0)) + (when (called-interactively-p 'interactive) + (let ((missing (cj/package-still-missing))) + (message (if missing + (format "Still missing: %s" + (mapconcat #'symbol-name missing " ")) + "All packages installed."))))) + +(defun cj/report-failed-package-installs () + "Warn about packages that failed to install, naming every one of them. +Only packages that are still absent are named; one that arrived later as +another package's dependency is not a failure the user needs to act on." + (let* ((missing (cj/package-still-missing)) + (source (seq-filter (lambda (p) + (memq p cj/failed-source-package-installs)) + missing)) + (archive (seq-difference missing source))) + (when missing + (display-warning + 'cj/package-resilience + (concat + (format "%d package(s) are missing: %s +Startup continued without them, so features they back are missing." + (length missing) (mapconcat #'symbol-name missing ", ")) + ;; Two different recoveries, so name which packages each one covers. + ;; Sending the user to the retry command for a source package wastes + ;; their time every startup: it cannot install one. + (when archive + (format " +Run M-x cj/retry-failed-package-installs for: %s" + (mapconcat #'symbol-name archive ", "))) + (when source + (format " +These install from source, so they need working credentials for the git host +and then 'make bootstrap': %s" + (mapconcat #'symbol-name source ", "))) + (when (cj/--package-giving-up-p) + (format " +Installing stopped after %d failures in a row, so most of these were never +attempted. Check the network and your credentials for the git host." + cj/package-install-failure-limit))) + :error)))) + +;; -------------------------------- Bootstrap ---------------------------------- + +(defun cj/package-bootstrap-batch () + "Entry point for the bootstrap script: retry, report, and exit. +Loading init.el in batch installs whatever `use-package' asks for; this retries +anything that pass missed and turns the outcome into an exit status the shell +can loop on. Exits 0 when nothing is missing, 1 otherwise." + (cj/retry-failed-package-installs) + (let ((missing (cj/package-still-missing))) + (if missing + (progn + (message "package-bootstrap: %d missing: %s" + (length missing) + (mapconcat #'symbol-name missing " ")) + (kill-emacs 1)) + (message "package-bootstrap: all packages installed") + (kill-emacs 0)))) + +;; --------------------------------- Wiring ------------------------------------ + +(setq use-package-ensure-function #'cj/package-ensure) + +;; Named function, never a lambda: an anonymous advice cannot be removed by +;; reference, so a live daemon would keep running it after the form is deleted. +(advice-add 'use-package-vc-install :around #'cj/--package-vc-install-guard) + +(add-hook 'emacs-startup-hook #'cj/report-failed-package-installs 90) + +(provide 'package-resilience) +;;; package-resilience.el ends here diff --git a/modules/prog-general.el b/modules/prog-general.el index 77ff88a5..e9586a97 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -119,9 +119,11 @@ REGEXP must be a string or an rx form." ;; Manages tree-sitter grammars. Install is 'prompt, never t: with t, ;; merely opening a file could trigger a network download and a compiler -;; build mid-edit. Batch/test runs never load treesit-auto (no package -;; init), so they can never install. Fresh-machine bootstrap is the -;; explicit `cj/install-treesit-grammars' command below. +;; build mid-edit. `make test' runs with no package init and so never +;; loads treesit-auto, but a test file that calls `package-initialize' +;; itself does load it, and a tree-sitter mode then prompts for a missing +;; grammar; such tests must skip on `treesit-ready-p'. Fresh-machine +;; bootstrap is the explicit `cj/install-treesit-grammars' command below. (defun cj/treesit-auto-pin-go-revision (recipes) "Pin the Go grammar revision in treesit-auto RECIPES. Return the updated Go recipe, or nil when RECIPES has no Go entry. diff --git a/modules/system-commands.el b/modules/system-commands.el index edc6339d..08a1be5d 100644 --- a/modules/system-commands.el +++ b/modules/system-commands.el @@ -39,7 +39,7 @@ ;; require keeps the module loadable on its own (tests, byte-compile) rather ;; than relying on init.el's load order. (require 'host-environment) -;; `system-lib' provides `cj/confirm-strong', used at runtime by the `strong' +;; `system-lib' provides `cj/confirm-destructive', used at runtime by the `strong' ;; confirm branch of `cj/system-cmd' for irreversible actions (shutdown/reboot). (require 'system-lib) (eval-when-compile (require 'subr-x)) @@ -76,10 +76,11 @@ If CMD is deemed dangerous, ask for confirmation." (label (nth 2 resolved))) (let ((confirm (and sym (get sym 'cj/system-confirm)))) (cond - ;; Strong confirm for irreversible actions (shutdown, reboot): - ;; require an explicit "yes", so a stray RET/space can't trigger them. + ;; Strong confirm for irreversible actions (shutdown, reboot): one + ;; keystroke, but with no default, so a stray RET/space can't trigger + ;; them and type-ahead is discarded before the read. ((eq confirm 'strong) - (unless (cj/confirm-strong (format "Really run %s (%s)? " label cmdstr)) + (unless (cj/confirm-destructive (format "Really run %s (%s)? " label cmdstr)) (user-error "Aborted"))) ;; Quick (Y/n) confirm for recoverable actions (logout, suspend). (confirm @@ -96,9 +97,11 @@ If CMD is deemed dangerous, ask for confirmation." (defmacro cj/defsystem-command (name var cmdstr &optional confirm) "Define VAR with CMDSTR and interactive command NAME to run it. -CONFIRM controls the confirmation prompt: t for a quick (Y/n) prompt, -the symbol `strong' for an explicit yes-or-no-p (used for irreversible -actions like shutdown and reboot), nil for no confirmation." +CONFIRM controls the confirmation prompt: t for a quick (Y/n) prompt where +RET and space mean yes, the symbol `strong' for `cj/confirm-destructive' +\(used for irreversible actions like shutdown and reboot), nil for no +confirmation. Both are one keystroke; the difference is that `strong' has +no default, so RET and space re-prompt rather than confirming." (declare (indent defun)) `(progn (defvar ,var ,cmdstr) diff --git a/modules/system-defaults.el b/modules/system-defaults.el index 9b4652e8..47bd1505 100644 --- a/modules/system-defaults.el +++ b/modules/system-defaults.el @@ -89,6 +89,30 @@ indicate the warning was handled." (advice-add 'display-warning :before-until #'cj/log-comp-warning) +;; ------------------ Deferred Daemon Warnings vs. Frame Creation ----------------- + +;; Emacs 31's warnings.el defers warnings raised during daemon startup: it puts +;; a one-shot closure on `after-make-frame-functions' holding the *Warnings* +;; buffer object and calls `warning--display-buffer' on it when the first +;; client frame is made. If that buffer died in between, `display-buffer' +;; signals inside `make-frame', server.el reports "-window-system-unsupported", +;; and emacsclient retries on $DISPLAY -- the first frame of the session +;; silently opens on XWayland. Keeping *Warnings* alive is the root fix +;; (undead-buffers.el); this guard is the backstop, so no future buffer sweep +;; can break frame creation the same way. The function only exists from +;; Emacs 31; advising an undefined symbol is harmless and takes effect once +;; warnings.el defines it. + +(defun cj/warning--display-buffer-if-live (orig buffer) + "Call ORIG with BUFFER only when it names or is a live buffer. +Around advice for `warning--display-buffer'. BUFFER may be a buffer object +or a buffer name, like `display-buffer' accepts. Return nil when skipped." + (let ((buf (and buffer (get-buffer buffer)))) + (when (buffer-live-p buf) + (funcall orig buf)))) + +(advice-add 'warning--display-buffer :around #'cj/warning--display-buffer-if-live) + ;; ---------------------------------- Unicode ---------------------------------- (set-locale-environment "en_US.UTF-8") @@ -227,8 +251,9 @@ appears only once per session." (setq ad-redefinition-action 'accept) ;; silence warnings about advised functions getting redefined. (setq large-file-warning-threshold nil) ;; open files regardless of size (setq use-short-answers t) ;; single-key y/n for ordinary yes-or-no-p prompts - ;; (irreversible actions use `cj/confirm-strong', which - ;; forces a typed "yes" by binding this nil for that call) + ;; (irreversible actions use `cj/confirm-destructive', + ;; also one key, but it ignores RET and space so a stray + ;; keystroke re-prompts instead of confirming) (setq auto-revert-verbose nil) ;; turn off auto revert messages (setq custom-safe-themes t) ;; treat all themes as safe (stop asking) (setq server-client-instructions nil) ;; I already know what to do when done with the frame diff --git a/modules/system-lib.el b/modules/system-lib.el index 54e20b74..c6021c9c 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -8,7 +8,8 @@ ;; Eager reason: low-level helpers (executable lookup, process output, silent ;; logging) used by many eager modules during startup. ;; Top-level side effects: none. -;; Runtime requires: none (auth-source loaded on demand inside the helper). +;; Runtime requires: none at load (auth-source is required on demand inside +;; `cj/auth-source-secret-value', so the cost lands only on callers that use it). ;; Direct test load: yes (pure helpers; batch-safe). ;; ;; This module provides low-level system utility functions for checking @@ -125,21 +126,51 @@ This does so without echoing in the minibuffer." With USER, also match on the login. Resolves a function-valued secret \(the netrc backend returns the secret as a function\) by calling it. Callers that must have a secret layer their own error on top." + ;; Loaded here rather than at the top of the file, so a module that merely + ;; requires system-lib does not pay for auth-source. It has to be loaded + ;; *somewhere*, though: `declare-function' only quiets the byte-compiler. + ;; An interactive Emacs always has auth-source in by the time anyone calls + ;; here, which hid the omission until a batch `-Q' sync tried to resolve a + ;; `:secret-host' feed and died on a void `auth-source-search'. + ;; + ;; Guarded on `fboundp' rather than calling `require' unconditionally: a + ;; bare require re-loads auth-source.el over whatever is already in place, + ;; which replaces a caller's stubbed `auth-source-search' mid-call and sends + ;; a test that meant to fake the lookup out to the real authinfo instead. + (unless (fboundp 'auth-source-search) + (require 'auth-source)) (let* ((spec (append (list :host host :require '(:secret) :max 1) (when user (list :user user)))) (secret (plist-get (car (apply #'auth-source-search spec)) :secret))) (if (functionp secret) (funcall secret) secret))) -;; ---------------------------- Strong Confirmation ---------------------------- +;; -------------------------- Destructive Confirmation ------------------------- -(defun cj/confirm-strong (prompt) - "Ask PROMPT, requiring a full typed \"yes\" or \"no\" answer. -For irreversible actions -- file destruction, overwrites, power-off. The -global default makes `yes-or-no-p' a single keystroke (`use-short-answers' -is t); this binds it to nil for the one call so the prompt demands the -long-form answer, keeping a stray RET or space from confirming." - (let ((use-short-answers nil)) - (yes-or-no-p prompt))) +(defun cj/confirm-destructive (prompt) + "Ask PROMPT for an irreversible action. Return non-nil for yes. + +One keystroke, y or n. Nothing else answers: a stray RET or space +re-prompts rather than confirming, so the accidental-confirm protection +survives without the answer costing four keystrokes. + +Pending input is discarded first, and that line is load-bearing. +`read-char-choice' reads from the input queue, so without it a keystroke +typed before the prompt appeared would confirm a shutdown or a file +deletion instantly. The typed-\"yes\" form this replaced absorbed such a +key harmlessly, and dropping the guard without replacing it would have +traded a rare annoyance for a rare catastrophe. + +This used to demand a typed \"yes\", and that was a worse trade than it +looked. On 2026-07-31 one such prompt went unanswered -- a second agent +session held the selected window while the prompt waited in another frame, +so keystrokes went to a terminal instead of the minibuffer, and the session +was killed with buffers unsaved. A single keystroke does not make a prompt +reachable when focus is elsewhere; C-g is still the escape either way. What +it changes is the cost of the situation, and losing unsaved buffers is a far +bigger hazard than a mis-keyed confirm." + (discard-input) + (eq ?y (downcase (read-char-choice (concat prompt "(y or n) ") + '(?y ?Y ?n ?N))))) (defun cj/--font-lock-global-modes-excluding (current mode) "Return CURRENT `font-lock-global-modes' with MODE added to the exclusion. diff --git a/modules/telega-config.el b/modules/telega-config.el index 5a20d430..b9b80481 100644 --- a/modules/telega-config.el +++ b/modules/telega-config.el @@ -18,9 +18,10 @@ ;; ;; TDLib (Telegram Database Library) runs in a docker container via ;; `telega-use-docker' so a fresh-clone install does not need a -;; system-level TDLib build. =scripts/setup-telega.sh= prepares the -;; container the first time; afterwards telega.el reattaches -;; automatically. +;; system-level TDLib build. The image is built locally from +;; =docker/telega-server/Dockerfile= with =make telega-image= (see the +;; pin section below for why it is not pulled from the registry); +;; =scripts/setup-telega.sh= covers the rest of a fresh clone. ;; ;; First-run auth (phone number + Telegram verification code) is ;; interactive and happens inside `M-x telega'. This module does not @@ -68,20 +69,29 @@ ;; telega picks its container image in `telega-docker--image-name', which only ;; pins to a version tag when `telega-tdlib-min-version' equals ;; `telega-tdlib-max-version' and the version ends in ".0". Here min is -;; "1.8.64" and max is nil, so that test never passes and the image is always +;; "1.8.66" and max is nil, so that test never passes and the image is always ;; "zevlg/telega-server:latest" -- a floating tag. The elpa package is fixed ;; at whatever version was installed, so the server can be replaced underneath ;; a static elisp without anything announcing it. ;; -;; Pinning by digest names one immutable image. Set to nil to hand the choice -;; back to telega. +;; The pin used to be a registry digest. It became a local tag on 2026-08-25: +;; the telega package raised its tdlib floor to 1.8.66, and upstream's only +;; image at that version fails to start (libglycin missing, +;; zevlg/telega.el#596). docker/telega-server/Dockerfile derives a working +;; image from that upstream digest plus the one missing package, and +;; `make telega-image' builds it under the tag below. The digest guarantee +;; now lives in the Dockerfile's FROM line; the Makefile owns the tag and a +;; test holds this default equal to it. Set to nil to hand the choice back +;; to telega. (defcustom cj/telega-docker-image - "zevlg/telega-server@sha256:a4b88e029ba381eca7c37c9618c9e3ad73aa9db2097fe07a0c6684d40d32b84e" + "cj/telega-server:1.8.66-glycin" "Container image reference for `telega-server', or nil for telega's default. -Pin by digest rather than tag: a tag can be re-pushed upstream, a digest -cannot. The default is the image carrying libtdjson 1.8.64, which matches -this telega's `telega-tdlib-min-version'." +The default names the image `make telega-image' builds locally from +docker/telega-server/Dockerfile, whose base is pinned by upstream digest. +It must match TELEGA_IMAGE in the Makefile; `cj/telega' refuses to launch +when the image is not present, since docker would otherwise try to pull a +local-only tag from the registry and fail confusingly." :type '(choice (const :tag "Let telega infer the image" nil) (string :tag "Image reference")) :group 'telega-docker) @@ -175,6 +185,21 @@ into telega's sentinel and abort its status handling and relogin path." (with-eval-after-load 'telega-server (advice-add 'telega-server--sentinel :after #'cj/--telega-server-notify-death)) +(defun cj/--telega-docker-image-present-p (image) + "Return non-nil when IMAGE exists in the local docker image store. +Uses `docker image inspect' rather than `docker images': the listing hides +digest-pulled and untagged images, and this check exists because that +listing lied once. Any failure (docker absent, daemon down) reads as +not-present, which routes the user to the same make target." + (condition-case nil + (zerop (call-process "docker" nil nil nil "image" "inspect" image)) + (error nil))) + +(defun cj/--telega-missing-image-message (image) + "Return the user-facing message for a pinned IMAGE that is not built yet." + (format "telega-server image %s is not built -- run `make telega-image' in %s" + image (abbreviate-file-name user-emacs-directory))) + (defun cj/telega () "Launch telega.el with a helpful message when it isn't installed yet. @@ -183,14 +208,22 @@ stale MELPA archive index can't take startup down with a 404. The trade-off: a fresh clone needs a one-time install before this launcher works. Without this wrapper, the autoload stub fails with the cryptic =Cannot open load file: telega=; with it, the user gets -pointed at =scripts/setup-telega.sh= and the manual fallback." +pointed at =scripts/setup-telega.sh= and the manual fallback. + +When `cj/telega-docker-image' is set, the image must already be built: +it is a local tag, so a missing one would send docker to the registry +for something that was never there. The check is skipped with no pin, +where telega infers and pulls its own image." (interactive) - (if (or (featurep 'telega) - (locate-library "telega")) - (telega) + (unless (or (featurep 'telega) + (locate-library "telega")) (user-error (concat "telega not installed -- run scripts/setup-telega.sh, " - "or `M-x package-install RET telega'")))) + "or `M-x package-install RET telega'"))) + (let ((image (cj/--telega-docker-pinned-image))) + (when (and image (not (cj/--telega-docker-image-present-p image))) + (user-error "%s" (cj/--telega-missing-image-message image)))) + (telega)) (cj/register-command "T" #'cj/telega) diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el index e5b8dc00..e6574a0e 100644 --- a/modules/undead-buffers.el +++ b/modules/undead-buffers.el @@ -31,7 +31,25 @@ (defvar cj/undead-buffer-list '("*scratch*" "*EMMS-Playlist*" "*Messages*" "*ert*" - "*AI-Assistant*") + "*AI-Assistant*" + ;; *Warnings* stays alive because Emacs 31's warnings.el defers daemon + ;; startup warnings into an `after-make-frame-functions' closure that + ;; holds this buffer object until the first client frame. The startup + ;; sweep in `cj/dashboard-only' used to kill it; the closure then failed + ;; inside `make-frame', server.el reported the window system as + ;; unsupported, and emacsclient silently retried on $DISPLAY, so the first + ;; frame of every 31.1 session opened on XWayland. I bury it instead, the + ;; same choice desktop.el makes in `desktop-clear-preserve-buffers'. + "*Warnings*" + ;; The async native-compile log stays alive for the same reason, one + ;; buffer over. comp-run parks every compile worker on this buffer and + ;; the worker's sentinel reads it back before starting the next job. + ;; The startup sweep killed it, which SIGHUPs every :noquery worker under + ;; it; each sentinel then died in `with-current-buffer' on the dead + ;; buffer and `comp--run-async-workers' never ran again, so the queue + ;; sat stranded for the life of the daemon, nothing was ever cached, and + ;; every boot re-ran the same compile storm at the first frame. + "*Async-native-compile-log*") "Buffer names to bury instead of killing (exact match).") (defvar cj/undead-buffer-regexps nil diff --git a/modules/user-constants.el b/modules/user-constants.el index 570b142f..ec387930 100644 --- a/modules/user-constants.el +++ b/modules/user-constants.el @@ -275,5 +275,23 @@ and portable across different machines." ;; bare `(require 'user-constants)' (tests, byte-compile, batch) stays ;; side-effect-free. +(defconst cj/org-todo-keywords + '((sequence "TODO(t)" "PROJECT(p)" "DOING(i)" + "WAITING(w)" "VERIFY(v)" "STALLED(s)" + "DELEGATED(x)" "|" + "FAILED(f!)" "DONE(d!)" "CANCELLED(c!)")) + "The TODO keyword sequence, kept where a batch Emacs can reach it. + +`org-config' sets `org-todo-keywords' from this, and so does any batch process +that has to read the org files the way the editor does. It lives here rather +than in `org-config' because that module loads through `use-package' and needs +packages a batch run has no reason to install. + +The duplication this avoids is not cosmetic. A reader that does not know +DOING is a keyword does not merely mislabel it: org stops parsing the headline +as a task at all, so the keyword and the priority cookie stay glued to the +front of the title and the entry reads as not-done regardless of its real +state.") + (provide 'user-constants) ;;; user-constants.el ends here diff --git a/modules/video-audio-recording.el b/modules/video-audio-recording.el index 10c10854..65a8612f 100644 --- a/modules/video-audio-recording.el +++ b/modules/video-audio-recording.el @@ -300,6 +300,41 @@ Changes take effect on the next recording (not the current one)." (cj/register-prefix-map "r" cj/record-map) +;; Fast chords for the two toggles, alongside C-; r v and C-; r a. F9 is free: +;; ai-term vacated the F9 family when its swap moved to M-SPC, and +;; `test-ai-term-f9-family-removed-globally' keeps it vacated. Both commands +;; still take a prefix argument, so C-u F9 prompts for the recording location. +(keymap-global-set "<f9>" #'cj/video-recording-toggle) +(keymap-global-set "S-<f9>" #'cj/audio-recording-toggle) + +(defvar eat-mode-map) +(defvar eat-semi-char-mode-map) +(defvar eat-char-mode-map) +(defvar eat-eshell-char-mode-map) + +;; EAT builds each input mode's keymap from key categories, and which categories +;; a mode claims is what decides whether a chord reaches Emacs at all. +;; +;; Semi-char mode -- the default, and where every agent buffer sits -- is built +;; from :ascii, :arrow and :navigation. It never claims function keys, so F9 +;; already fell through to the global map. The semi-char entry below is +;; belt-and-braces rather than the fix, which is why it reads as redundant. +;; +;; Char mode is the one that swallows F9. It adds :function, binding f1 through +;; f63 to eat-self-input, and it is a minor mode, so its map outranks +;; eat-mode-map. Without an entry here the pair splits in the worst possible +;; way: :function claims only the unmodified keys, so S-F9 would toggle audio in +;; a char-mode buffer while F9 went to the program under the cursor. That is a +;; recording you believe you started and didn't. +;; +;; Claiming both costs a char-mode program the use of F9. I would rather pay +;; that than ship a toggle that works for audio and silently fails for video. +(with-eval-after-load 'eat + (dolist (map (list eat-semi-char-mode-map eat-mode-map + eat-char-mode-map eat-eshell-char-mode-map)) + (keymap-set map "<f9>" #'cj/video-recording-toggle) + (keymap-set map "S-<f9>" #'cj/audio-recording-toggle))) + (with-eval-after-load 'which-key (which-key-add-key-based-replacements "C-; r" "recording menu" diff --git a/modules/weather-config.el b/modules/weather-config.el index 84920776..ea137578 100644 --- a/modules/weather-config.el +++ b/modules/weather-config.el @@ -28,6 +28,13 @@ ;; :vc (:url "git@cjennings.net:emacs-wttrin.git" ;; :branch "release/0.4.0" ;; :rev :newest) + ;; wttrin declares xterm-color in its own Package-Requires, but nothing here + ;; reads that header: `:load-path' keeps package.el out of the picture, and + ;; use-package suppresses the `use-package-always-ensure' default whenever + ;; `:load-path' is present. The dependency came free under the `:vc' form + ;; above and stopped when the local checkout took over. Naming the package + ;; here installs it without disturbing the checkout. + :ensure xterm-color :demand t ;; REQUIRED: mode-line must start at Emacs startup :preface ;; Change this to t to enable debug logging diff --git a/scripts/agenda-render-cache b/scripts/agenda-render-cache new file mode 100755 index 00000000..b1e4d490 --- /dev/null +++ b/scripts/agenda-render-cache @@ -0,0 +1,50 @@ +#!/usr/bin/env bash +# Write the agenda render cache for an external renderer. +# +# Runs a batch Emacs rather than talking to the daemon, because the surface +# that reads the cache has to keep working while Emacs is down -- and +# emacsclient is exactly the thing that cannot. Nothing here touches a running +# Emacs, so it is safe to fire from a timer alongside an active session. +# +# The agenda file list is resolved the same way the editor resolves it, by +# loading the config's own resolver rather than restating the list here. A +# second copy of that list would drift the first time a calendar source is +# added. +# +# Usage: agenda-render-cache +# Env: EMACS_D -- config directory (default ~/.emacs.d) +# EMACS -- emacs binary (default emacs) +# AGENDA_RENDER_FILES -- colon-separated org files to read instead of +# the configured agenda list. Lets a caller ask +# about a known set, and lets the tests run +# against a fixture rather than whatever happens +# to be on the machine's real agenda today. + +set -euo pipefail + +EMACS_D="${EMACS_D:-$HOME/.emacs.d}" +EMACS="${EMACS:-emacs}" + +if [ ! -d "$EMACS_D/modules" ]; then + echo "agenda-render-cache: no modules directory at $EMACS_D/modules" >&2 + exit 1 +fi + +# -Q keeps the daemon's init out of it: this needs three modules, not a full +# editor. load-prefer-newer stops a stale .elc from answering for changed +# source, which would silently write yesterday's logic. +exec "$EMACS" --batch -Q \ + --eval '(setq load-prefer-newer t)' \ + -L "$EMACS_D/modules" \ + --eval '(progn + (require (quote user-constants)) + (require (quote org-agenda-config)) + (setq org-todo-keywords cj/org-todo-keywords) + (require (quote agenda-query)) + (setq org-agenda-files + (let ((override (getenv "AGENDA_RENDER_FILES"))) + (if (and override (not (string-empty-p override))) + (split-string override ":" t) + (cj/--org-agenda-scan-files)))) + (princ (cj/agenda-render-cache-update)) + (terpri))' diff --git a/scripts/bootstrap-packages.sh b/scripts/bootstrap-packages.sh new file mode 100755 index 00000000..9ba9fc69 --- /dev/null +++ b/scripts/bootstrap-packages.sh @@ -0,0 +1,133 @@ +#!/usr/bin/env bash +# +# Install every package this config asks for, headlessly, before first launch. +# +# On a fresh machine init.el pulls ~190 packages over the network one at a +# time. A single dead download used to abort startup outright; +# modules/package-resilience.el now records the failure and lets init finish, +# and this script is what turns that into a completed install: load init.el in +# batch, retry whatever is still missing, and repeat while progress is being +# made. Doing it here rather than in a GUI session means a fresh install never +# meets the debugger. +# +# Usage: scripts/bootstrap-packages.sh +# Exit: 0 when every package is installed, non-zero otherwise. +# +# Environment: +# EMACS emacs binary to use (default: emacs) +# BOOTSTRAP_PASSES maximum passes over the set (default: 4) +# BOOTSTRAP_TIMEOUT seconds allowed per pass (default: 1800) +# +# Note: a pass loads the whole config in batch, so every :config block runs +# headlessly. stdin is closed and each pass is bounded by a timeout so a +# prompt or a hung network fetch fails the pass instead of stalling forever. + +set -uo pipefail + +emacs_bin="${EMACS:-emacs}" +max_passes="${BOOTSTRAP_PASSES:-4}" +pass_timeout="${BOOTSTRAP_TIMEOUT:-1800}" + +emacs_dir="${BOOTSTRAP_DIR:-$(cd "$(dirname "${BASH_SOURCE[0]}")/.." && pwd)}" +log_dir="$(mktemp -d -t emacs-bootstrap-XXXXXX)" + +cleanup() { rm -rf "$log_dir"; } +trap cleanup EXIT + +# --batch implies -q, which skips early-init.el. That file is where the package +# archives, use-package-always-ensure, and package-resilience all live, so a +# pass that loaded only init.el would install almost nothing and would not even +# have cj/package-bootstrap-batch defined. Load both, in the order a real +# startup does. user-emacs-directory is set first so the pass bootstraps the +# checkout this script lives in rather than whatever $HOME/.emacs.d happens to +# be. +load_form="$(cat <<EOF +(progn + (setq load-prefer-newer t) + (setq user-emacs-directory "${emacs_dir}/") + (setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) + (load (expand-file-name "early-init.el" user-emacs-directory) nil t) + (load (expand-file-name "init.el" user-emacs-directory) nil t) + (cj/package-bootstrap-batch)) +EOF +)" + +echo "bootstrap: installing packages for $emacs_dir" +echo "bootstrap: up to $max_passes passes, ${pass_timeout}s each" + +# use-package calls its ensure function at macro-expansion time when a file is +# being byte-compiled, and emits no runtime call at all. So a pass that loads +# .elc files installs nothing and would still exit 0 -- a false pass, the same +# shape as every other gate in this repo that was green because it never ran. +# Refuse rather than warn: there is no use for a bootstrap that cannot install, +# and a warning above a success line is read as a success. A genuinely fresh +# machine has no .elc and never sees this. +# Every directory the config puts on its load-path, not just modules/, since a +# use-package form anywhere in them would be consumed the same way. +if compgen -G "$emacs_dir/modules/*.elc" >/dev/null 2>&1 \ + || compgen -G "$emacs_dir/custom/*.elc" >/dev/null 2>&1 \ + || compgen -G "$emacs_dir/assets/*.elc" >/dev/null 2>&1 \ + || compgen -G "$emacs_dir/*.elc" >/dev/null 2>&1; then + echo "bootstrap: REFUSING - byte-compiled modules are present." >&2 + echo "bootstrap: use-package consumes :ensure at compile time, so a pass over" >&2 + echo "bootstrap: .elc files installs nothing and would report success anyway." >&2 + echo "bootstrap: run 'make clean-compiled' first, then bootstrap." >&2 + exit 2 +fi + +pass=1 +passes_run=0 +status=1 +while [ "$pass" -le "$max_passes" ]; do + log="$log_dir/pass-$pass.log" + echo "bootstrap: pass $pass of $max_passes ..." + + timeout "$pass_timeout" "$emacs_bin" --batch \ + --eval "$load_form" </dev/null >"$log" 2>&1 + status=$? + passes_run=$((passes_run + 1)) + + case "$status" in + 0) + echo "bootstrap: every package is installed (pass $pass)" + break + ;; + 1) + # Exit 1 is only meaningful when the pass actually said what is + # missing. Anything else exiting 1 is a different failure, and + # retrying it four times then blaming packages would be a lie. + if grep -E '^package-bootstrap: [0-9]+ missing:' "$log"; then + : # another pass can clear them; installing one unblocks others + else + echo "bootstrap: pass $pass exited 1 without reporting missing packages" >&2 + tail -30 "$log" >&2 + break + fi + ;; + 124) + echo "bootstrap: pass $pass hit the ${pass_timeout}s timeout" >&2 + tail -20 "$log" >&2 + ;; + *) + # init itself failed for some reason other than a missing package. + echo "bootstrap: pass $pass failed to load init (exit $status)" >&2 + tail -30 "$log" >&2 + break + ;; + esac + + pass=$((pass + 1)) +done + +if [ "$status" -ne 0 ]; then + echo "bootstrap: FAILED after $passes_run pass(es)" >&2 + # No pass ran at all when the ceiling is zero, and the glob would then match + # nothing and print a tail error over the real message. + if [ "$passes_run" -gt 0 ]; then + echo "bootstrap: tail of the last pass follows" >&2 + tail -30 "$log" >&2 + fi + exit "$status" +fi + +exit 0 diff --git a/scripts/calendar-sync-run b/scripts/calendar-sync-run new file mode 100755 index 00000000..12181b8d --- /dev/null +++ b/scripts/calendar-sync-run @@ -0,0 +1,63 @@ +#!/usr/bin/env bash +# Sync every configured calendar from its .ics feed, once, and wait for it. +# +# Runs a batch Emacs rather than talking to the daemon, for the same reason +# agenda-render-cache does: the org files this writes feed the agenda, waybar +# and the projected wallpaper, and none of those should go stale because the +# editor happens to be down. Nothing here touches a running Emacs, so it is +# safe to fire from a timer alongside an active session. +# +# Why a script at all: calendar-sync used to start its hourly timer from +# `org-agenda-mode-hook', so a session where the agenda was never opened never +# synced at all. That is not a rare corner -- it is every reboot until the +# first agenda call. The timer owns the schedule now, and the editor's own +# auto-start is off. +# +# The exit code is the point. `calendar-sync-batch-run-and-report' waits for +# every calendar to leave the syncing state and returns non-zero if any did +# not land, so a failed fetch shows up in `systemctl --user status' instead of +# being swallowed. +# +# Usage: calendar-sync-run +# Env: EMACS_D -- config directory (default ~/.emacs.d) +# EMACS -- emacs binary (default emacs) +# CALENDAR_SYNC_CONFIG -- private config file holding the calendar +# list, instead of the configured default. +# CALENDAR_SYNC_STATE -- sync-state file, instead of the configured +# default. Lets a test run without writing +# the real session's persisted state. +# CALENDAR_SYNC_TIMEOUT -- seconds to wait for all calendars to settle. + +set -euo pipefail + +EMACS_D="${EMACS_D:-$HOME/.emacs.d}" +EMACS="${EMACS:-emacs}" + +if [ ! -d "$EMACS_D/modules" ]; then + echo "calendar-sync-run: no modules directory at $EMACS_D/modules" >&2 + exit 1 +fi + +# The overrides are set before the module loads on purpose: the private config +# is read at load time, and `defvar'/`defcustom' both leave an already-bound +# value alone. This is the same seam the in-editor conversion worker uses. +pre="" +if [ -n "${CALENDAR_SYNC_CONFIG:-}" ]; then + pre="$pre (setq calendar-sync-private-config-file \"$CALENDAR_SYNC_CONFIG\")" +fi +if [ -n "${CALENDAR_SYNC_STATE:-}" ]; then + pre="$pre (setq calendar-sync--state-file \"$CALENDAR_SYNC_STATE\")" +fi +if [ -n "${CALENDAR_SYNC_TIMEOUT:-}" ]; then + pre="$pre (setq calendar-sync-batch-timeout $CALENDAR_SYNC_TIMEOUT)" +fi + +# -Q keeps the daemon's init out of it: this needs the calendar-sync modules, +# not a full editor. load-prefer-newer stops a stale .elc from answering for +# changed source, which would silently sync with yesterday's logic. +exec "$EMACS" --batch -Q \ + --eval "(progn (setq load-prefer-newer t)$pre)" \ + -L "$EMACS_D/modules" \ + --eval '(progn + (require (quote calendar-sync)) + (kill-emacs (calendar-sync-batch-run-and-report)))' diff --git a/scripts/setup-telega.sh b/scripts/setup-telega.sh index 9a8c0d02..351f98ba 100755 --- a/scripts/setup-telega.sh +++ b/scripts/setup-telega.sh @@ -7,8 +7,8 @@ # - Verifies docker is installed and the daemon is responsive. # - Verifies the user can talk to docker without sudo (group membership). # - Pulls the telega-server image if a public one is configured (env var -# `TELEGA_DOCKER_IMAGE'); otherwise prints the in-Emacs build command -# (`M-x telega-server-build') for the user to run once. +# `TELEGA_DOCKER_IMAGE'); otherwise points at `make telega-image', which +# builds the pinned image from docker/telega-server/Dockerfile. # - Installs the `telega' Emacs package via package.el if it isn't # already in package-user-dir. modules/telega-config.el uses # `:ensure nil' (a stale MELPA index can 404 and take startup down @@ -52,10 +52,10 @@ pull_or_announce_image() { if [[ -z "$TELEGA_DOCKER_IMAGE" ]]; then cat <<EOF → no public image configured (set TELEGA_DOCKER_IMAGE to override) - build the telega-server image once from inside Emacs: - M-x telega-server-build - telega.el handles the docker build under the hood when - \`telega-use-docker' is t (set in modules/telega-config.el). + build the telega-server image once from the repo's Dockerfile: + make telega-image + modules/telega-config.el pins \`cj/telega-docker-image' to the tag + that target builds (docker/telega-server/Dockerfile). EOF return 0 fi diff --git a/systemd/agenda-render-cache.service b/systemd/agenda-render-cache.service new file mode 100644 index 00000000..0fe08533 --- /dev/null +++ b/systemd/agenda-render-cache.service @@ -0,0 +1,14 @@ +[Unit] +Description=Write the agenda render cache for external surfaces +# Deliberately no dependency on emacs.service or graphical-session.target. +# The whole point is that the cache stays current while Emacs is down, so the +# writer is a batch Emacs that needs neither the daemon nor a compositor. +Documentation=file:%h/.emacs.d/modules/agenda-query.el + +[Service] +Type=oneshot +ExecStart=%h/.emacs.d/scripts/agenda-render-cache +# One run is about a second of CPU. Cap it well above that so a wedged run is +# killed rather than left holding the timer. +TimeoutStartSec=120 +Nice=10 diff --git a/systemd/agenda-render-cache.timer b/systemd/agenda-render-cache.timer new file mode 100644 index 00000000..71a6d662 --- /dev/null +++ b/systemd/agenda-render-cache.timer @@ -0,0 +1,17 @@ +[Unit] +Description=Refresh the agenda render cache every 5 minutes + +[Timer] +# OnCalendar rather than OnUnitActiveSec, because Persistent= only has an +# effect on calendar timers (systemd.timer(5)). A monotonic schedule silently +# ignores it, so a machine that slept through several intervals would come back +# to a stale file with nothing to trigger a catch-up -- and the surface reading +# it cannot tell stale from correct. +OnCalendar=*:0/5 +Persistent=true +# A cold boot should not wait for the next wall-clock slot. +OnBootSec=1min +AccuracySec=30s + +[Install] +WantedBy=timers.target diff --git a/systemd/calendar-sync.service b/systemd/calendar-sync.service new file mode 100644 index 00000000..0d70de57 --- /dev/null +++ b/systemd/calendar-sync.service @@ -0,0 +1,17 @@ +[Unit] +Description=Sync calendars from their .ics feeds into org +# Deliberately no dependency on emacs.service or graphical-session.target. +# The point of moving this out of the editor is that calendars stay current +# while Emacs is down, so the writer is a batch Emacs that needs neither the +# daemon nor a compositor. +Documentation=file:%h/.emacs.d/modules/calendar-sync.el + +[Service] +Type=oneshot +ExecStart=%h/.emacs.d/scripts/calendar-sync-run +# The script waits for every calendar to settle, bounded by +# calendar-sync-batch-timeout (300s). Cap the unit above that so the script's +# own timeout reports a named failure per calendar, rather than systemd +# killing it first and leaving only "timeout". +TimeoutStartSec=360 +Nice=10 diff --git a/systemd/calendar-sync.timer b/systemd/calendar-sync.timer new file mode 100644 index 00000000..71278f20 --- /dev/null +++ b/systemd/calendar-sync.timer @@ -0,0 +1,18 @@ +[Unit] +Description=Sync calendars into org every 10 minutes + +[Timer] +# OnCalendar rather than OnUnitActiveSec, because Persistent= only has an +# effect on calendar timers (systemd.timer(5)). A monotonic schedule silently +# ignores it, so a machine that slept through several intervals would come +# back to stale calendar files with nothing to trigger a catch-up. +OnCalendar=*:0/10 +Persistent=true +# A cold boot should not wait for the next wall-clock slot. This is the case +# the whole change exists for: before the timer, a reboot meant no calendar +# sync at all until the agenda happened to be opened. +OnBootSec=2min +AccuracySec=30s + +[Install] +WantedBy=timers.target diff --git a/tests/test-agenda-query--render.el b/tests/test-agenda-query--render.el index 1f7232f2..da5c3f60 100644 --- a/tests/test-agenda-query--render.el +++ b/tests/test-agenda-query--render.el @@ -26,6 +26,9 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'agenda-query) +;; Supplies `cj/org-todo-keywords', the vocabulary the batch writer sets and +;; the editor's org config reads. +(require 'user-constants) (defun test-aq-render--epoch (min hour day month year) "Return the epoch for local MIN HOUR DAY MONTH YEAR." @@ -136,10 +139,50 @@ The renderer parses the same shape whether or not anything is scheduled." (let ((org-agenda-files nil)) (should (equal "[]" (cj/agenda-render-json 1785474000 1785477600))))) +;;; ---------- the batch reader has to know the keyword vocabulary ---------- + +(ert-deftest test-agenda-render-normal-custom-keyword-is-parsed () + "Normal: a config keyword is recognised, so it leaves the title. + +The batch writer runs without the editor's init, so it has to set +`org-todo-keywords' itself. When it does not, org stops parsing the headline +as a task at all: DOING and the priority cookie stay glued to the front of the +title and the row reads as having no keyword. That is a wrong answer that +still parses as JSON, which is the worst kind." + (let ((org-todo-keywords cj/org-todo-keywords)) + (test-aq-render--with-agenda-file + "* DOING [#A] Justin Johns advisor projects\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (let ((row (car rows))) + (should (equal "Justin Johns advisor projects" (alist-get 't row))) + (should (equal "DOING" (alist-get 'keyword row))))))) + +(ert-deftest test-agenda-render-boundary-unknown-keyword-stays-in-title () + "Boundary: with stock keywords the same headline degrades visibly. + +Pinning the failure mode, not endorsing it. This is what the surface showed +before the batch writer learned the vocabulary, and it is why the test above +exists." + ;; No priority cookie in this fixture. org 9.8 (Emacs 31.1) parses the + ;; cookie with `org-priority-regexp' under `looking-at', and that regexp's + ;; lazy `.*?' prefix swallows everything between the stars and the cookie, + ;; unknown keyword included. A cookie here would test org's bug rather than + ;; the vocabulary gap this test pins. + (let ((org-todo-keywords '((sequence "TODO" "|" "DONE")))) + (test-aq-render--with-agenda-file + "* DOING Justin Johns advisor projects\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (let ((row (car rows))) + (should (string-prefix-p "DOING" (alist-get 't row))) + (should-not (equal "DOING" (alist-get 'keyword row))))))) + ;;; ---------- the cache writer ---------- (ert-deftest test-agenda-render-normal-cache-update-writes-today () - "Normal: the cache writer covers the whole local day and creates its dir. + "Normal: the cache writer covers three whole local days and creates its dir. + +Yesterday's midnight through tomorrow's day close. A consumer drawing a +rolling window centred on now needs both sides of midnight: with a single +calendar day, the part of its span outside today has nothing to draw, which +late in the evening is half the surface. This is the function that actually ships the feature, so it gets its own coverage rather than riding on the tests for the profile beneath it. The @@ -161,19 +204,23 @@ or the next 24 from now, would still produce a plausible-looking file." (cj/agenda-render-cache-update))) (should (file-exists-p cj/agenda-render-cache-file)) (let* ((window (car windows)) - (d (decode-time (car window)))) + (start (decode-time (car window))) + (now (decode-time))) ;; Opens at local midnight... - (should (= 0 (nth 2 d))) - (should (= 0 (nth 1 d))) - (should (= 0 (nth 0 d))) - ;; ...and closes one second before the next. + (should (= 0 (nth 2 start))) + (should (= 0 (nth 1 start))) + (should (= 0 (nth 0 start))) + ;; ...on yesterday, and closes at the end of tomorrow. + (should (= (car window) + (cj/--agenda-query-epoch + 0 0 0 (1- (nth 3 now)) (nth 4 now) (nth 5 now)))) (should (= (cdr window) - (1- (cj/--agenda-query-epoch - 0 0 0 (1+ (nth 3 d)) (nth 4 d) (nth 5 d))))) - ;; It is today's day, not an arbitrary one. - (should (equal (list (nth 3 d) (nth 4 d) (nth 5 d)) - (let ((now (decode-time))) - (list (nth 3 now) (nth 4 now) (nth 5 now))))))) + (cj/--agenda-query-day-close + (1+ (nth 3 now)) (nth 4 now) (nth 5 now)))) + ;; Three whole days, give or take an hour at a DST changeover. + (let ((hours (/ (- (cdr window) (car window)) 3600.0))) + (should (>= hours 70.9)) + (should (<= hours 73.1))))) (delete-directory dir t)))) (ert-deftest test-agenda-render-boundary-cache-update-is-idempotent () diff --git a/tests/test-agenda-render-cache.bats b/tests/test-agenda-render-cache.bats new file mode 100644 index 00000000..3e949c16 --- /dev/null +++ b/tests/test-agenda-render-cache.bats @@ -0,0 +1,131 @@ +#!/usr/bin/env bats +# Tests for scripts/agenda-render-cache — the batch writer behind the timer. +# +# The elisp tests cover the query and the row shape. What only a shell test +# can cover is the thing that actually broke: the script runs a batch Emacs +# with -Q, so none of the editor's configuration is loaded, and anything it +# forgets to set up degrades silently rather than erroring. The first version +# wrote a file that parsed fine and was wrong, because org did not know DOING +# was a keyword and left it glued to the front of every title. +# +# Two isolation rules, both learned the hard way: +# +# EMACS_D points at THIS checkout, not $HOME/.emacs.d. Without it the script +# under test runs the installed config's elisp, so a broken tree passes. +# +# AGENDA_RENDER_FILES points at a fixture written here. Asserting over the +# machine's real agenda makes the result depend on what Craig happens to have +# scheduled today: the keyword assertion only bites if some entry carries a +# keyword, and on an empty agenda every all() assertion passes over an empty +# list. The fixture makes the failure mode reachable every run. + +setup() { + SCRIPT="${BATS_TEST_DIRNAME}/../scripts/agenda-render-cache" + export EMACS_D="${BATS_TEST_DIRNAME}/.." + export XDG_CACHE_HOME="${BATS_TEST_TMPDIR}/cache" + OUT="${XDG_CACHE_HOME}/settings/agenda.json" + + FIXTURE="${BATS_TEST_TMPDIR}/fixture.org" + TODAY="$(date +%Y-%m-%d)" + DOW="$(date +%a)" + { + printf '* DOING [#A] Advisor projects\nSCHEDULED: <%s %s 09:00>\n' "$TODAY" "$DOW" + printf '* TODO Standup\nSCHEDULED: <%s %s 10:00-10:15>\n' "$TODAY" "$DOW" + printf '* Lunch\n<%s %s 12:00-13:00>\n' "$TODAY" "$DOW" + printf '* VERIFY [#B] Check the render\nDEADLINE: <%s %s 17:00>\n' "$TODAY" "$DOW" + } > "$FIXTURE" + export AGENDA_RENDER_FILES="$FIXTURE" +} + +# Every assertion below runs through this, so an empty result can never pass +# vacuously — all() over an empty list is true, which is how a writer that +# produced nothing would look like a writer that produced correct rows. +assert_json() { + python3 -c " +import json, sys +rows = json.load(open(sys.argv[1])) +assert isinstance(rows, list), 'not a JSON array' +assert len(rows) == 4, 'expected 4 fixture rows, got %d' % len(rows) +$1 +" "$OUT" +} + +@test "the script is executable" { + [ -x "$SCRIPT" ] +} + +@test "writes a parseable JSON array and creates its directory" { + run "$SCRIPT" + [ "$status" -eq 0 ] + [ -f "$OUT" ] + run assert_json "pass" + [ "$status" -eq 0 ] +} + +@test "every row carries the three keys the renderer reads" { + run "$SCRIPT" + [ "$status" -eq 0 ] + run assert_json " +assert all({'s','e','t'} <= set(r) for r in rows), 'missing s/e/t' +assert all(isinstance(r['s'], int) and isinstance(r['e'], int) for r in rows), 'non-integer instant' +assert all(r['e'] >= r['s'] for r in rows), 'negative duration' +" + [ "$status" -eq 0 ] +} + +@test "instants are milliseconds, not seconds" { + run "$SCRIPT" + [ "$status" -eq 0 ] + # Seconds since 1970 are 10 digits; milliseconds are 13. + run assert_json "assert all(len(str(r['s'])) == 13 for r in rows), 'looks like seconds'" + [ "$status" -eq 0 ] +} + +@test "titles do not carry the TODO keyword vocabulary" { + run "$SCRIPT" + [ "$status" -eq 0 ] + # The regression this file exists for. The fixture carries DOING, TODO and + # VERIFY entries plus two priority cookies, so a script that has not set + # org-todo-keywords fails here every run rather than only on days when + # Craig happens to have such an entry. + run assert_json " +KEYWORDS = {'TODO','PROJECT','DOING','WAITING','VERIFY','STALLED', + 'DELEGATED','FAILED','DONE','CANCELLED'} +bad = [r['t'] for r in rows if r['t'].split(' ')[0] in KEYWORDS] +assert not bad, 'keyword left in title: %r' % bad +cookie = [r['t'] for r in rows if r['t'].startswith('[#')] +assert not cookie, 'priority cookie left in title: %r' % cookie +assert sorted(r['t'] for r in rows) == [ + 'Advisor projects', 'Check the render', 'Lunch', 'Standup'] +" + [ "$status" -eq 0 ] +} + +@test "keyword and completion state survive the batch environment" { + run "$SCRIPT" + [ "$status" -eq 0 ] + run assert_json " +by_title = {r['t']: r for r in rows} +assert by_title['Advisor projects']['keyword'] == 'DOING', by_title['Advisor projects'] +assert by_title['Check the render']['keyword'] == 'VERIFY' +assert by_title['Lunch']['keyword'] is None +assert all(r['done'] is False for r in rows) +assert by_title['Check the render']['type'] == 'deadline' +" + [ "$status" -eq 0 ] +} + +@test "replaces an existing file rather than appending" { + mkdir -p "$(dirname "$OUT")" + printf 'stale garbage that is not json at all\n' > "$OUT" + run "$SCRIPT" + [ "$status" -eq 0 ] + run assert_json "pass" + [ "$status" -eq 0 ] +} + +@test "fails loudly when the config directory is missing" { + run env EMACS_D="${BATS_TEST_TMPDIR}/nonexistent" "$SCRIPT" + [ "$status" -ne 0 ] + [[ "$output" == *"no modules directory"* ]] +} diff --git a/tests/test-bootstrap-packages.bats b/tests/test-bootstrap-packages.bats new file mode 100644 index 00000000..7e511152 --- /dev/null +++ b/tests/test-bootstrap-packages.bats @@ -0,0 +1,142 @@ +#!/usr/bin/env bats +# Tests for scripts/bootstrap-packages.sh — the headless package installer. +# +# The elisp tests cover what happens inside one Emacs. What only a shell test +# can cover is the pass loop: whether a run that reports packages still missing +# gets another pass, whether a run that converges stops early, and whether a +# broken init breaks out instead of burning every pass on the same failure. +# +# Every test drives a fake emacs whose exit statuses are scripted, so no test +# touches the network, the real elpa directory, or a real Emacs. The script +# honours $EMACS, which is the seam these hang on. + +setup() { + SCRIPT="${BATS_TEST_DIRNAME}/../scripts/bootstrap-packages.sh" + BIN="${BATS_TEST_TMPDIR}/bin" + COUNTER="${BATS_TEST_TMPDIR}/attempts" + mkdir -p "$BIN" + echo 0 >"$COUNTER" + export BOOTSTRAP_PASSES=3 + export BOOTSTRAP_TIMEOUT=30 + # Point the script at a scratch config dir rather than the real checkout, so + # the byte-compiled-modules check reads fixture state instead of whatever + # this working tree happens to have compiled. + export BOOTSTRAP_DIR="${BATS_TEST_TMPDIR}/emacsd" + mkdir -p "$BOOTSTRAP_DIR/modules" +} + +# Write a fake emacs that exits with the given statuses in order, repeating the +# last one once the list runs out. Status 1 also prints the "still missing" +# line the real cj/package-bootstrap-batch prints, so the script's grep is +# exercised rather than assumed. +fake_emacs() { + { + echo '#!/usr/bin/env bash' + echo "n=\$(cat '$COUNTER')" + echo "n=\$((n + 1))" + echo "echo \$n >'$COUNTER'" + echo "statuses=($*)" + echo 'idx=$((n - 1))' + echo 'last=$((${#statuses[@]} - 1))' + echo '[ $idx -gt $last ] && idx=$last' + echo 'status=${statuses[$idx]}' + echo '[ "$status" -eq 1 ] && echo "package-bootstrap: 2 missing: foo bar"' + echo 'exit $status' + } >"$BIN/emacs" + chmod +x "$BIN/emacs" + export EMACS="$BIN/emacs" +} + +attempts() { cat "$COUNTER"; } + +@test "normal: a clean first pass succeeds and stops there" { + fake_emacs 0 + run bash "$SCRIPT" + [ "$status" -eq 0 ] + [ "$(attempts)" -eq 1 ] + [[ "$output" == *"every package is installed"* ]] +} + +@test "normal: a pass reporting missing packages is retried until it converges" { + fake_emacs 1 0 + run bash "$SCRIPT" + [ "$status" -eq 0 ] + [ "$(attempts)" -eq 2 ] + [[ "$output" == *"2 missing: foo bar"* ]] +} + +@test "error: packages that never install exhaust the passes and fail" { + fake_emacs 1 + run bash "$SCRIPT" + [ "$status" -eq 1 ] + [ "$(attempts)" -eq 3 ] + [[ "$output" == *"FAILED"* ]] +} + +@test "error: exit 1 without a missing-packages line is not blamed on packages" { + # The fake exits 1 silently, which is any other failure, not a short install. + { + echo '#!/usr/bin/env bash' + echo "n=\$(cat '$COUNTER'); echo \$((n + 1)) >'$COUNTER'" + echo 'exit 1' + } >"$BIN/emacs" + chmod +x "$BIN/emacs" + export EMACS="$BIN/emacs" + run bash "$SCRIPT" + [ "$status" -eq 1 ] + [ "$(attempts)" -eq 1 ] + [[ "$output" == *"without reporting missing packages"* ]] +} + +@test "error: a broken init breaks out instead of burning every pass" { + fake_emacs 255 + run bash "$SCRIPT" + [ "$status" -eq 255 ] + [ "$(attempts)" -eq 1 ] + [[ "$output" == *"failed to load init"* ]] +} + +@test "boundary: a timed-out pass is reported and still retried" { + fake_emacs 124 0 + run bash "$SCRIPT" + [ "$status" -eq 0 ] + [ "$(attempts)" -eq 2 ] + [[ "$output" == *"timeout"* ]] +} + +@test "boundary: the pass ceiling is honoured" { + export BOOTSTRAP_PASSES=1 + fake_emacs 1 + run bash "$SCRIPT" + [ "$status" -eq 1 ] + [ "$(attempts)" -eq 1 ] +} + +@test "error: a byte-compiled tree is refused rather than passed vacuously" { + touch "$BOOTSTRAP_DIR/modules/foo.elc" + fake_emacs 0 + run bash "$SCRIPT" + [ "$status" -eq 2 ] + [ "$(attempts)" -eq 0 ] + [[ "$output" == *"REFUSING"* ]] + [[ "$output" == *"clean-compiled"* ]] + [[ "$output" != *"every package is installed"* ]] +} + +@test "boundary: a zero pass ceiling fails cleanly without a tail error" { + export BOOTSTRAP_PASSES=0 + fake_emacs 0 + run bash "$SCRIPT" + [ "$status" -ne 0 ] + [ "$(attempts)" -eq 0 ] + [[ "$output" != *"cannot open"* ]] + [[ "$output" == *"FAILED after 0 pass"* ]] +} + +@test "boundary: recovery on the final allowed pass still succeeds" { + export BOOTSTRAP_PASSES=3 + fake_emacs 1 1 0 + run bash "$SCRIPT" + [ "$status" -eq 0 ] + [ "$(attempts)" -eq 3 ] +} diff --git a/tests/test-calendar-sync--batch-failures.el b/tests/test-calendar-sync--batch-failures.el new file mode 100644 index 00000000..3190be21 --- /dev/null +++ b/tests/test-calendar-sync--batch-failures.el @@ -0,0 +1,47 @@ +;;; test-calendar-sync--batch-failures.el --- Batch failure filter tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; `calendar-sync--batch-failures' picks the rows that did not finish cleanly. +;; The batch runner's exit code is derived from it, and systemd reads that exit +;; code, so the rule is deliberately strict: only `ok' passes. A calendar left +;; `syncing' at the timeout, or one that never started, is a failure -- both +;; states mean the org file on disk is not the calendar's current contents, +;; which is exactly the silent staleness the timer exists to prevent. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calendar-sync) + +(ert-deftest test-calendar-sync-batch-failures-keeps-only-non-ok () + "Normal: an errored calendar is returned and a healthy one is not." + (should (equal (calendar-sync--batch-failures + '(("google" . ok) ("proton" . error))) + '(("proton" . error))))) + +(ert-deftest test-calendar-sync-batch-failures-all-ok-is-empty () + "Normal: a fully successful run reports no failures." + (should (equal (calendar-sync--batch-failures + '(("google" . ok) ("proton" . ok))) + '()))) + +(ert-deftest test-calendar-sync-batch-failures-empty-input-is-empty () + "Boundary: no rows in, no rows out." + (should (equal (calendar-sync--batch-failures '()) '()))) + +(ert-deftest test-calendar-sync-batch-failures-timeout-counts-as-failure () + "Error: a calendar still `syncing' when the wait expired is a failure. +Its org file was not rewritten, so reporting success would hide the staleness." + (should (equal (calendar-sync--batch-failures + '(("google" . ok) ("proton" . syncing))) + '(("proton" . syncing))))) + +(ert-deftest test-calendar-sync-batch-failures-never-counts-as-failure () + "Error: a calendar that never started is a failure, not a skip." + (should (equal (calendar-sync--batch-failures '(("google" . never))) + '(("google" . never))))) + +(provide 'test-calendar-sync--batch-failures) +;;; test-calendar-sync--batch-failures.el ends here diff --git a/tests/test-calendar-sync--batch-report.el b/tests/test-calendar-sync--batch-report.el new file mode 100644 index 00000000..12811200 --- /dev/null +++ b/tests/test-calendar-sync--batch-report.el @@ -0,0 +1,89 @@ +;;; test-calendar-sync--batch-report.el --- Batch report output tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; `calendar-sync-batch-run-and-report' is what the systemd timer runs, so its +;; printed rows are the only record that survives the process. Batch Emacs +;; discards *Messages* at exit, which is where the interactive failure path +;; logs its reason -- so a failed row has to carry its recorded `:last-error' +;; in the printed output or the journal shows "error" with no way to tell a +;; cold gpg-agent from a revoked feed token or a dead network. + +;;; Code: + +(require 'ert) +(require 'cl-lib) ;; cl-letf; calendar-sync pulls it in transitively, don't rely on that + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calendar-sync) + +(defun test-calendar-sync-batch-report--capture (states results) + "Return the report's printed output for STATES and RESULTS. +STATES is an alist of NAME . PLIST seeded into the state table; RESULTS is +what `calendar-sync-batch-run' is stubbed to return, so the report is +exercised without driving a real sync." + (let ((calendar-sync--calendar-states (make-hash-table :test 'equal))) + (dolist (entry states) + (puthash (car entry) (cdr entry) calendar-sync--calendar-states)) + (cl-letf (((symbol-function 'calendar-sync-batch-run) + (lambda (&rest _) results))) + (with-output-to-string + (calendar-sync-batch-run-and-report))))) + +;;; Normal + +(ert-deftest test-calendar-sync-batch-report-failed-row-carries-its-reason () + "Normal: a failed calendar prints the recorded `:last-error' reason. +Without it the journal records only \"error\", and the operator cannot tell a +cold gpg-agent from a revoked token without re-running the sync by hand." + (let ((out (test-calendar-sync-batch-report--capture + '(("google" . (:status error :last-error "Decryption failed")) + ("proton" . (:status ok))) + '(("google" . error) ("proton" . ok))))) + (should (string-match-p "google: error" out)) + (should (string-match-p "Decryption failed" out)))) + +(ert-deftest test-calendar-sync-batch-report-ok-row-stays-bare () + "Normal: a calendar that synced prints its status and nothing more. +A stale `:last-error' from an earlier failure must not be appended to a row +that succeeded this run." + (let ((out (test-calendar-sync-batch-report--capture + '(("google" . (:status ok :last-error "Decryption failed"))) + '(("google" . ok))))) + (should (string-match-p "google: ok" out)) + (should-not (string-match-p "Decryption failed" out)))) + +;;; Boundary + +(ert-deftest test-calendar-sync-batch-report-failure-without-reason-still-prints () + "Boundary: a failed row with no recorded reason prints its status alone. +`never' and `syncing' never record a `:last-error', so the reason lookup has +to tolerate nil rather than printing \"nil\" or signalling." + (let ((out (test-calendar-sync-batch-report--capture + '(("google" . (:status syncing))) + '(("google" . syncing) ("absent" . never))))) + (should (string-match-p "google: syncing" out)) + (should (string-match-p "absent: never" out)) + (should-not (string-match-p "nil" out)))) + +;;; Error + +(defun test-calendar-sync-batch-report--exit-code (results) + "Return the report's exit code for RESULTS, discarding its printed output." + (let ((calendar-sync--calendar-states (make-hash-table :test 'equal))) + (cl-letf (((symbol-function 'calendar-sync-batch-run) + (lambda (&rest _) results))) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (calendar-sync-batch-run-and-report)))))) + +(ert-deftest test-calendar-sync-batch-report-exit-code-tracks-failures () + "Error: the return value becomes the process exit code, so it stays 1 on any +non-ok row and 0 only when every calendar synced. Appending the reason to the +printed line must not disturb it." + (should (equal 1 (test-calendar-sync-batch-report--exit-code '(("google" . error))))) + (should (equal 1 (test-calendar-sync-batch-report--exit-code + '(("google" . ok) ("proton" . never))))) + (should (equal 0 (test-calendar-sync-batch-report--exit-code '(("google" . ok)))))) + +(provide 'test-calendar-sync--batch-report) +;;; test-calendar-sync--batch-report.el ends here diff --git a/tests/test-calendar-sync--batch-results.el b/tests/test-calendar-sync--batch-results.el new file mode 100644 index 00000000..03ee2aee --- /dev/null +++ b/tests/test-calendar-sync--batch-results.el @@ -0,0 +1,59 @@ +;;; test-calendar-sync--batch-results.el --- Batch result collection tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; `calendar-sync--batch-results' reads the per-calendar state table and +;; returns one (NAME . STATUS) pair per requested calendar. The batch runner +;; turns that into an exit code, so a calendar that never reached the table at +;; all has to read as `never' rather than nil -- a nil status would compare +;; equal to nothing and quietly drop out of the failure count. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calendar-sync) + +(defun test-calendar-sync-batch-results--with-states (states body) + "Run BODY with STATES (an alist of NAME . PLIST) in the state table." + (let ((calendar-sync--calendar-states (make-hash-table :test 'equal))) + (dolist (entry states) + (puthash (car entry) (cdr entry) calendar-sync--calendar-states)) + (funcall body))) + +(ert-deftest test-calendar-sync-batch-results-reports-each-status () + "Normal: every requested calendar comes back with its recorded status." + (test-calendar-sync-batch-results--with-states + '(("google" . (:status ok)) + ("proton" . (:status error :last-error "boom"))) + (lambda () + (should (equal (calendar-sync--batch-results '("google" "proton")) + '(("google" . ok) ("proton" . error))))))) + +(ert-deftest test-calendar-sync-batch-results-empty-names-is-empty () + "Boundary: no calendars requested yields no rows, not an error." + (test-calendar-sync-batch-results--with-states + '(("google" . (:status ok))) + (lambda () + (should (equal (calendar-sync--batch-results '()) '()))))) + +(ert-deftest test-calendar-sync-batch-results-missing-calendar-reads-never () + "Error: a calendar absent from the state table reads `never', never nil. +A nil status would drop out of the failure count and report success for a +calendar that never ran." + (test-calendar-sync-batch-results--with-states + '(("google" . (:status ok))) + (lambda () + (should (equal (calendar-sync--batch-results '("google" "absent")) + '(("google" . ok) ("absent" . never))))))) + +(ert-deftest test-calendar-sync-batch-results-preserves-request-order () + "Boundary: rows come back in the order asked for, not hash order." + (test-calendar-sync-batch-results--with-states + '(("a" . (:status ok)) ("b" . (:status ok)) ("c" . (:status ok))) + (lambda () + (should (equal (mapcar #'car (calendar-sync--batch-results '("c" "a" "b"))) + '("c" "a" "b")))))) + +(provide 'test-calendar-sync--batch-results) +;;; test-calendar-sync--batch-results.el ends here diff --git a/tests/test-calendar-sync--batch-wait.el b/tests/test-calendar-sync--batch-wait.el new file mode 100644 index 00000000..7deee5e1 --- /dev/null +++ b/tests/test-calendar-sync--batch-wait.el @@ -0,0 +1,68 @@ +;;; test-calendar-sync--batch-wait.el --- Batch wait-loop tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; The sync pipeline is asynchronous end to end: curl runs in one process and +;; the org conversion in a second batch Emacs. Under `emacs --batch' the +;; process exits as soon as the top-level form returns, killing both children +;; mid-flight -- a run that does nothing and reports success. +;; +;; `calendar-sync--batch-wait' is what stops that: it blocks until every +;; calendar has left the `syncing' state, or until the timeout expires. These +;; tests drive it with a stubbed state predicate, so the loop's exit conditions +;; are covered without a live network fetch. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calendar-sync) + +(ert-deftest test-calendar-sync-batch-wait-returns-when-nothing-in-flight () + "Normal: with no calendar syncing the wait returns success immediately." + (let ((polls 0)) + (cl-letf (((symbol-function 'calendar-sync--syncing-p) (lambda (_) nil)) + ((symbol-function 'accept-process-output) + (lambda (&rest _) (setq polls (1+ polls))))) + (should (calendar-sync--batch-wait '("google" "proton") 5)) + (should (= polls 0))))) + +(ert-deftest test-calendar-sync-batch-wait-blocks-until-settled () + "Normal: the wait polls while a sync is in flight and returns once it lands." + (let ((remaining 3) + (polls 0)) + (cl-letf (((symbol-function 'calendar-sync--syncing-p) + (lambda (_) (> remaining 0))) + ((symbol-function 'accept-process-output) + (lambda (&rest _) + (setq polls (1+ polls)) + (setq remaining (1- remaining))))) + (should (calendar-sync--batch-wait '("google") 5)) + (should (= polls 3))))) + +(ert-deftest test-calendar-sync-batch-wait-empty-names-returns-immediately () + "Boundary: no calendars to wait on settles at once." + (let ((polls 0)) + (cl-letf (((symbol-function 'accept-process-output) + (lambda (&rest _) (setq polls (1+ polls))))) + (should (calendar-sync--batch-wait '() 5)) + (should (= polls 0))))) + +(ert-deftest test-calendar-sync-batch-wait-times-out-when-stuck () + "Error: a sync that never settles returns nil once the timeout expires. +Returning nil is what lets the runner exit non-zero instead of reporting a +success it cannot vouch for." + (let ((calendar-sync--batch-poll-seconds 0.01)) + (cl-letf (((symbol-function 'calendar-sync--syncing-p) (lambda (_) t)) + ((symbol-function 'accept-process-output) (lambda (&rest _) nil))) + (should-not (calendar-sync--batch-wait '("google") 0.05))))) + +(ert-deftest test-calendar-sync-batch-wait-zero-timeout-does-not-hang () + "Boundary: a zero timeout returns at once rather than looping forever." + (cl-letf (((symbol-function 'calendar-sync--syncing-p) (lambda (_) t)) + ((symbol-function 'accept-process-output) (lambda (&rest _) nil))) + (should-not (calendar-sync--batch-wait '("google") 0)))) + +(provide 'test-calendar-sync--batch-wait) +;;; test-calendar-sync--batch-wait.el ends here diff --git a/tests/test-calendar-sync--sync-dispatch.el b/tests/test-calendar-sync--sync-dispatch.el index 22deeef0..9b12b167 100644 --- a/tests/test-calendar-sync--sync-dispatch.el +++ b/tests/test-calendar-sync--sync-dispatch.el @@ -77,5 +77,44 @@ than crashing." (should (equal (list cal) ics-calls)) (should (null api-calls))))) +(ert-deftest test-calendar-sync--sync-dispatch-error-leaf-signal-is-contained () + "Error: a syncer that signals marks the calendar failed instead of propagating. + +Resolving a `:secret-host' feed reads authinfo.gpg, and a cold gpg-agent makes +that signal a `file-error' before any process starts — so the failure arrives +synchronously, where the async callbacks that normally record a failure never +run." + (let ((failed '()) + (calendar-sync--calendar-states (make-hash-table :test 'equal))) + (cl-letf (((symbol-function 'calendar-sync--sync-calendar-ics) + (lambda (_) (signal 'file-error '("Decryption failed")))) + ((symbol-function 'calendar-sync--mark-sync-failed) + (lambda (name reason) (push (cons name reason) failed)))) + (calendar-sync--sync-calendar + '(:name "google" :url "https://x/y.ics" :file "/tmp/c.org")) + (should (equal "google" (car (car failed))))))) + +(ert-deftest test-calendar-sync--sync-all-continues-past-a-failing-calendar () + "Error: one calendar's synchronous failure does not stop the ones after it. + +This is the whole cost of leaving the signal uncontained: on a machine whose +feeds resolve through authinfo, the first calendar's decryption error aborted +the entire run, so calendars that would have synced fine never got the chance." + (let ((synced '()) + (calendar-sync--calendar-states (make-hash-table :test 'equal)) + (calendar-sync-calendars + '((:name "bad" :url "https://x/a.ics" :file "/tmp/a.org") + (:name "good" :url "https://x/b.ics" :file "/tmp/b.org")))) + (cl-letf (((symbol-function 'calendar-sync--sync-calendar-ics) + (lambda (cal) + (if (equal (plist-get cal :name) "bad") + (signal 'file-error '("Decryption failed")) + (push (plist-get cal :name) synced)))) + ((symbol-function 'calendar-sync--mark-sync-failed) + (lambda (&rest _) nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (calendar-sync--sync-all-calendars) + (should (equal '("good") synced))))) + (provide 'test-calendar-sync--sync-dispatch) ;;; test-calendar-sync--sync-dispatch.el ends here diff --git a/tests/test-calendar-sync-run.bats b/tests/test-calendar-sync-run.bats new file mode 100644 index 00000000..da817060 --- /dev/null +++ b/tests/test-calendar-sync-run.bats @@ -0,0 +1,116 @@ +#!/usr/bin/env bats +# Tests for scripts/calendar-sync-run — the batch syncer behind the timer. +# +# The elisp tests cover the wait loop and the result tally with the state +# predicate stubbed. What only a shell test can cover is the thing that makes +# the whole script necessary: the sync pipeline is asynchronous end to end +# (curl in one process, the org conversion in a second batch Emacs), and a +# batch Emacs exits as soon as its top-level form returns. A version that +# launches the fetch and returns would exit zero, write nothing, and look +# exactly like a success. Every assertion here that checks the output file +# exists is really asserting that the script waited. +# +# Isolation rules, mirroring test-agenda-render-cache.bats: +# +# EMACS_D points at THIS checkout, so a broken tree cannot pass by running +# the installed config's elisp. +# +# CALENDAR_SYNC_CONFIG and CALENDAR_SYNC_STATE point at fixtures, so the run +# neither reads Craig's real feed URLs nor writes his persisted sync state. +# +# The feed is a file:// URL served to the script's own curl. That keeps the +# test hermetic -- no network, no live calendar -- while still exercising the +# real fetch path rather than a stub. + +setup() { + SCRIPT="${BATS_TEST_DIRNAME}/../scripts/calendar-sync-run" + export EMACS_D="${BATS_TEST_DIRNAME}/.." + export CALENDAR_SYNC_STATE="${BATS_TEST_TMPDIR}/state.el" + export CALENDAR_SYNC_TIMEOUT=120 + + OUT="${BATS_TEST_TMPDIR}/testcal.org" + ICS="${BATS_TEST_TMPDIR}/feed.ics" + TODAY="$(date +%Y%m%d)" + + cat > "$ICS" <<-EOF + BEGIN:VCALENDAR + VERSION:2.0 + PRODID:-//bats//test//EN + BEGIN:VEVENT + UID:bats-fixture-1 + DTSTART:${TODAY}T140000Z + DTEND:${TODAY}T150000Z + SUMMARY:Batch Fixture Event + END:VEVENT + END:VCALENDAR + EOF + + write_config "file://${ICS}" +} + +# The calendar list is normally private config; the test writes its own so the +# feed URL is a local file and the output lands in the temp dir. +write_config() { + export CALENDAR_SYNC_CONFIG="${BATS_TEST_TMPDIR}/config.el" + cat > "$CALENDAR_SYNC_CONFIG" <<-EOF + (setq calendar-sync-calendars + (list (list :name "testcal" :url "$1" :file "${OUT}"))) + EOF +} + +@test "the script is executable" { + [ -x "$SCRIPT" ] +} + +@test "waits for the async pipeline and writes the org file" { + run "$SCRIPT" + [ "$status" -eq 0 ] + # The file existing at all is the assertion: it is written by a grandchild + # process, so a script that did not wait would have exited before this. + [ -f "$OUT" ] + grep -q "Batch Fixture Event" "$OUT" +} + +@test "reports the calendar and its status on stdout" { + run "$SCRIPT" + [ "$status" -eq 0 ] + [[ "$output" == *"testcal: ok"* ]] +} + +@test "a failed fetch exits non-zero so systemd records it" { + write_config "file://${BATS_TEST_TMPDIR}/does-not-exist.ics" + run "$SCRIPT" + [ "$status" -ne 0 ] + [ ! -f "$OUT" ] +} + +@test "a failed fetch names the calendar rather than failing silently" { + write_config "file://${BATS_TEST_TMPDIR}/does-not-exist.ics" + run "$SCRIPT" + [[ "$output" == *"testcal"* ]] + [[ "$output" != *"testcal: ok"* ]] +} + +@test "a failed fetch prints why, not just that it failed" { + # The interactive path logs the reason to *Messages*, which batch Emacs + # discards at exit. Without the reason on stdout the journal shows only + # "error" -- no way to tell a cold gpg-agent from a revoked feed token. + write_config "file://${BATS_TEST_TMPDIR}/does-not-exist.ics" + run "$SCRIPT" + [[ "$output" == *"testcal: error"* ]] + [[ "$output" == *"Fetch failed"* ]] +} + +@test "refuses to run against a checkout with no modules directory" { + EMACS_D="${BATS_TEST_TMPDIR}/empty" run "$SCRIPT" + [ "$status" -ne 0 ] + [[ "$output" == *"no modules directory"* ]] +} + +@test "does not write the real session's sync state" { + run "$SCRIPT" + [ "$status" -eq 0 ] + # The state override is honoured, so a timer run cannot corrupt or race + # the interactive session's persisted state. + [ -f "$CALENDAR_SYNC_STATE" ] +} diff --git a/tests/test-calibredb-epub-config.el b/tests/test-calibredb-epub-config.el index 7afc58f3..0e430a4e 100644 --- a/tests/test-calibredb-epub-config.el +++ b/tests/test-calibredb-epub-config.el @@ -16,6 +16,11 @@ (package-initialize) (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'calibredb-epub-config) +;; Load calibredb before any test stubs its functions with `cl-letf'. The +;; module's jump path calls `(require 'calibredb)' inside the body; if the +;; package is still an autoload at that point, the real `defun' lands on top of +;; the stub and the test runs the real command against the real library. +(require 'calibredb) (require 'nov nil t) ; for the nov-mode-map keybinding test; harmless if absent (declare-function cj/nov--text-width "calibredb-epub-config" (total-cols)) diff --git a/tests/test-config-utilities--compile-this-elisp-buffer.el b/tests/test-config-utilities--compile-this-elisp-buffer.el index a06440ab..f1a442b4 100644 --- a/tests/test-config-utilities--compile-this-elisp-buffer.el +++ b/tests/test-config-utilities--compile-this-elisp-buffer.el @@ -1,10 +1,14 @@ ;;; test-config-utilities--compile-this-elisp-buffer.el --- Tests for cj/compile-this-elisp-buffer -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for `cj/compile-this-elisp-buffer'. The function dispatches -;; among native-compile-async, native-compile (sync), and -;; byte-compile-file based on which is fboundp. Tests force each -;; branch by mocking fboundp at the boundary. +;; Tests for `cj/compile-this-elisp-buffer' and its helper +;; `cj/--compile-elisp-file'. The helper dispatches among +;; native-compile-async, native-compile (sync), and byte-compile-file based +;; on an AVAILABLE-P predicate that defaults to `fboundp'. Tests force each +;; branch by passing the predicate, never by redefining `fboundp': an `fset' +;; on that subr autoloads comp-run, which requires bytecomp, whose `defun' of +;; `byte-compile-file' replaces any test double installed earlier in the same +;; `cl-letf' (Emacs 30.2 hid this because ert happened to preload bytecomp). ;;; Code: @@ -14,6 +18,10 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'config-utilities) +(defun test-config-utilities--available (&rest syms) + "Return a predicate that reports only SYMS as available compilers." + (lambda (sym) (memq sym syms))) + (defmacro test-config-utilities--with-elisp-buffer (path &rest body) "Run BODY in a temp buffer visiting PATH (a .el file path). Skips the interactive `save-buffer' so tests stay free of disk side @@ -24,72 +32,108 @@ effects." (cl-letf (((symbol-function 'save-buffer) (lambda (&rest _) nil))) ,@body))) +;; -- the interactive wrapper ------------------------------------------------- + (ert-deftest test-config-utilities-compile-buffer-not-elisp-raises () "Error: a buffer whose file isn't .el raises `user-error'." (test-config-utilities--with-elisp-buffer "/tmp/not-elisp.txt" (should-error (cj/compile-this-elisp-buffer) :type 'user-error))) -(ert-deftest test-config-utilities-compile-buffer-no-buffer-file-name-raises () - "Error: a buffer with no `buffer-file-name' raises `user-error'." +(ert-deftest test-config-utilities-compile-buffer-no-file-raises () + "Boundary: a buffer visiting no file raises `user-error' rather than +passing nil to the compiler." (with-temp-buffer - (setq buffer-file-name nil) (should-error (cj/compile-this-elisp-buffer) :type 'user-error))) +(ert-deftest test-config-utilities-compile-buffer-saves-then-delegates () + "Normal: the wrapper saves the buffer and hands its file to the helper." + (let (saved compiled) + (with-temp-buffer + (setq buffer-file-name "/tmp/some.el") + (cl-letf (((symbol-function 'save-buffer) (lambda (&rest _) (setq saved t))) + ((symbol-function 'cj/--compile-elisp-file) + (lambda (file &optional _) (setq compiled file)))) + (cj/compile-this-elisp-buffer))) + (should saved) + (should (equal compiled "/tmp/some.el")))) + +;; -- the helper's dispatch --------------------------------------------------- + (ert-deftest test-config-utilities-compile-buffer-prefers-native-async () "Normal: `native-compile-async' is preferred when available." (let (called-with) - (test-config-utilities--with-elisp-buffer "/tmp/some.el" - (cl-letf (((symbol-function 'fboundp) - (lambda (sym) - (memq sym '(native-compile-async native-compile byte-compile-file)))) - ((symbol-function 'native-compile-async) - (lambda (file) (setq called-with file))) - ((symbol-function 'native-compile) - (lambda (_) (error "should not call sync native-compile"))) - ((symbol-function 'byte-compile-file) - (lambda (&rest _) (error "should not call byte-compile-file")))) - (cj/compile-this-elisp-buffer) - (should (equal called-with "/tmp/some.el")))))) + (cl-letf (((symbol-function 'native-compile-async) + (lambda (file) (setq called-with file))) + ((symbol-function 'native-compile) + (lambda (_) (error "should not call sync native-compile"))) + ((symbol-function 'byte-compile-file) + (lambda (&rest _) (error "should not call byte-compile-file")))) + (cj/--compile-elisp-file + "/tmp/some.el" + (test-config-utilities--available 'native-compile-async 'native-compile + 'byte-compile-file)) + (should (equal called-with "/tmp/some.el"))))) (ert-deftest test-config-utilities-compile-buffer-falls-back-to-sync-native () "Normal: `native-compile' is used when async isn't available." (let (called-with) - (test-config-utilities--with-elisp-buffer "/tmp/some.el" - (cl-letf (((symbol-function 'fboundp) - (lambda (sym) (memq sym '(native-compile byte-compile-file)))) - ((symbol-function 'native-compile) - (lambda (file) (setq called-with file))) - ((symbol-function 'byte-compile-file) - (lambda (&rest _) (error "should not call byte-compile-file")))) - (cj/compile-this-elisp-buffer) - (should (equal called-with "/tmp/some.el")))))) + (cl-letf (((symbol-function 'native-compile) + (lambda (file) (setq called-with file))) + ((symbol-function 'byte-compile-file) + (lambda (&rest _) (error "should not call byte-compile-file")))) + (cj/--compile-elisp-file + "/tmp/some.el" + (test-config-utilities--available 'native-compile 'byte-compile-file)) + (should (equal called-with "/tmp/some.el"))))) (ert-deftest test-config-utilities-compile-buffer-falls-back-to-byte-compile () "Normal: `byte-compile-file' is used when neither native option is available." (let (called-with) - (test-config-utilities--with-elisp-buffer "/tmp/some.el" - (cl-letf (((symbol-function 'fboundp) - (lambda (sym) (eq sym 'byte-compile-file))) - ((symbol-function 'byte-compile-file) - (lambda (file &rest _) (setq called-with file) "/tmp/some.elc"))) - (cj/compile-this-elisp-buffer) - (should (equal called-with "/tmp/some.el")))))) + (cl-letf (((symbol-function 'byte-compile-file) + (lambda (file &rest _) (setq called-with file) "/tmp/some.elc"))) + (cj/--compile-elisp-file + "/tmp/some.el" + (test-config-utilities--available 'byte-compile-file)) + (should (equal called-with "/tmp/some.el"))))) + +(ert-deftest test-config-utilities-compile-buffer-reports-when-nothing-available () + "Boundary: with no compiler available the helper only messages, calling none." + (let (captured) + (cl-letf (((symbol-function 'native-compile-async) + (lambda (&rest _) (error "should not call native-compile-async"))) + ((symbol-function 'native-compile) + (lambda (&rest _) (error "should not call native-compile"))) + ((symbol-function 'byte-compile-file) + (lambda (&rest _) (error "should not call byte-compile-file"))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq captured (apply #'format fmt args))))) + (cj/--compile-elisp-file "/tmp/some.el" (test-config-utilities--available))) + (should (string-match-p "No compilation available" captured)))) (ert-deftest test-config-utilities-compile-buffer-handles-sync-native-error () "Error: a sync `native-compile' that signals is caught and reported. -Asserts no error escapes by running the function and checking that the +Asserts no error escapes by running the helper and checking that the message captured contains the failure prefix." - (test-config-utilities--with-elisp-buffer "/tmp/some.el" - (let (captured) - (cl-letf (((symbol-function 'fboundp) - (lambda (sym) (memq sym '(native-compile byte-compile-file)))) - ((symbol-function 'native-compile) - (lambda (_) (error "boom"))) - ((symbol-function 'message) - (lambda (fmt &rest args) - (setq captured (apply #'format fmt args))))) - (cj/compile-this-elisp-buffer)) - (should (string-match-p "Native compile failed" captured))))) + (let (captured) + (cl-letf (((symbol-function 'native-compile) + (lambda (_) (error "boom"))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq captured (apply #'format fmt args))))) + (cj/--compile-elisp-file + "/tmp/some.el" + (test-config-utilities--available 'native-compile 'byte-compile-file))) + (should (string-match-p "Native compile failed" captured)))) + +(ert-deftest test-config-utilities-compile-buffer-default-predicate-is-fboundp () + "Normal: with no predicate the helper consults `fboundp', so on a real +Emacs it reaches whichever compiler exists rather than the no-compiler +message." + (let (captured) + (cl-letf (((symbol-function 'native-compile-async) (lambda (&rest _) nil)) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq captured (apply #'format fmt args))))) + (cj/--compile-elisp-file "/tmp/some.el")) + (should (string-match-p "Queued native compilation" captured)))) (provide 'test-config-utilities--compile-this-elisp-buffer) ;;; test-config-utilities--compile-this-elisp-buffer.el ends here diff --git a/tests/test-custom-buffer-file-move-buffer-and-file.el b/tests/test-custom-buffer-file-move-buffer-and-file.el index 8331db5c..b3d78ccf 100644 --- a/tests/test-custom-buffer-file-move-buffer-and-file.el +++ b/tests/test-custom-buffer-file-move-buffer-and-file.el @@ -884,11 +884,17 @@ (with-temp-file source-file (insert "new")) (find-file source-file) - ;; Mock yes-or-no-p to capture that it was called - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (prompt) + ;; The overwrite confirm goes through `cj/confirm-destructive', which + ;; reads a single key rather than a typed yes. Mock the key read, not + ;; `yes-or-no-p' -- mocking the latter would pass whether or not the + ;; prompt happened at all. + (cl-letf (((symbol-function 'read-char-choice) + (lambda (&rest _) (setq prompted t) - t)) + ?y)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) + (error "overwrite confirm must not demand a typed yes"))) ((symbol-function 'read-directory-name) (lambda (&rest _) target-dir))) (call-interactively #'cj/move-buffer-and-file) @@ -907,11 +913,14 @@ (with-temp-file source-file (insert "new")) (find-file source-file) - ;; Mock yes-or-no-p to capture if it was called - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (prompt) - (setq prompted t) - t)) + ;; Both prompt paths are mocked, not just the old one. Watching + ;; `yes-or-no-p' alone would make this assertion unfalsifiable now + ;; that the confirm reads a key instead: it would pass whether the + ;; prompt was correctly skipped or merely moved. + (cl-letf (((symbol-function 'read-char-choice) + (lambda (&rest _) (setq prompted t) ?y)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) (setq prompted t) t)) ((symbol-function 'read-directory-name) (lambda (&rest _) target-dir))) (call-interactively #'cj/move-buffer-and-file) diff --git a/tests/test-custom-buffer-file-rename-buffer-and-file.el b/tests/test-custom-buffer-file-rename-buffer-and-file.el index 1eb61f1b..019fad8c 100644 --- a/tests/test-custom-buffer-file-rename-buffer-and-file.el +++ b/tests/test-custom-buffer-file-rename-buffer-and-file.el @@ -923,11 +923,17 @@ (with-temp-file new-file (insert "existing")) (find-file old-file) - ;; Mock yes-or-no-p to capture that it was called - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (prompt) + ;; The overwrite confirm goes through `cj/confirm-destructive', which + ;; reads a single key rather than a typed yes. Mock the key read, not + ;; `yes-or-no-p' -- mocking the latter would pass whether or not the + ;; prompt happened at all. + (cl-letf (((symbol-function 'read-char-choice) + (lambda (&rest _) (setq prompted t) - t)) + ?y)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) + (error "overwrite confirm must not demand a typed yes"))) ((symbol-function 'read-string) (lambda (&rest _) "new.txt"))) (call-interactively #'cj/rename-buffer-and-file) diff --git a/tests/test-google-keep-config--local-config.el b/tests/test-google-keep-config--local-config.el new file mode 100644 index 00000000..18769c5a --- /dev/null +++ b/tests/test-google-keep-config--local-config.el @@ -0,0 +1,52 @@ +;;; test-google-keep-config--local-config.el --- Tests for the Keep machine-local config loader -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/keep--load-local-config, the loader for the gitignored +;; machine-local google-keep.local.el (venv interpreter path, account email) — +;; the same shape calendar-sync uses for calendar-sync.local.el. + +;;; Code: + +(require 'ert) +(require 'google-keep-config) + +(ert-deftest test-google-keep-local-config-loads-readable-file () + "Normal: a readable local config file is loaded and its settings apply." + (let ((file (make-temp-file "keep-local-" nil ".el"))) + (unwind-protect + (progn + (with-temp-file file + (insert "(setq test-google-keep--local-marker 'loaded)")) + (defvar test-google-keep--local-marker nil) + (setq test-google-keep--local-marker nil) + (let ((cj/keep-local-config-file file)) + (should (cj/keep--load-local-config)) + (should (eq test-google-keep--local-marker 'loaded)))) + (delete-file file)))) + +(ert-deftest test-google-keep-local-config-missing-file-is-quiet () + "Boundary: an absent local config file is a silent no-op, no error." + (let ((cj/keep-local-config-file "/nonexistent/google-keep.local.el")) + (should-not (cj/keep--load-local-config)))) + +(ert-deftest test-google-keep-local-config-broken-file-does-not-signal () + "Error: a local config file with a broken form is caught and reported, +never propagated as a load-time error." + (let ((file (make-temp-file "keep-local-broken-" nil ".el")) + (messages nil)) + (unwind-protect + (progn + (with-temp-file file + (insert "(error \"deliberately broken local config\")")) + (let ((cj/keep-local-config-file file)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (push (apply #'format fmt args) messages) + nil))) + (should-not (cj/keep--load-local-config))) + (should (seq-find (lambda (m) (string-match-p "google-keep.*local config" m)) + messages)))) + (delete-file file)))) + +(provide 'test-google-keep-config--local-config) +;;; test-google-keep-config--local-config.el ends here diff --git a/tests/test-init-defer-games.el b/tests/test-init-defer-games.el index f3ec94de..4f349908 100644 --- a/tests/test-init-defer-games.el +++ b/tests/test-init-defer-games.el @@ -42,5 +42,36 @@ load failed to define malyon." (should (featurep 'games-config)) (should (equal malyon-stories-directory "/tmp/games-defer-test/text.games/")))) +(defun test-init-defer-games--declaration-installs-p (init package) + "Return non-nil when INIT (init.el's text) declares PACKAGE in an installing form. +A `use-package' form that carries `:ensure nil' or `:load-path' does not +install (use-package suppresses `use-package-always-ensure' for both), so +the check rejects those rather than accepting any form that names the package." + (and (string-match (format "^(use-package %s\\b\\([^\n]*\\))[ \t]*$" + (regexp-quote package)) + init) + (let ((args (match-string 1 init))) + (not (string-match-p ":ensure nil\\|:load-path" args))))) + +(ert-deftest test-init-defer-games-init-declares-both-packages () + "Normal: init.el declares malyon and 2048-game in forms that install them. +`use-package-always-ensure' is the installer for these two. a8571eff dropped +the declarations along with the eager require, and both packages silently +vanished on the next rebuild while every other test still passed." + (let ((init (with-temp-buffer + (insert-file-contents (expand-file-name "init.el" default-directory)) + (buffer-string)))) + (should (test-init-defer-games--declaration-installs-p init "malyon")) + (should (test-init-defer-games--declaration-installs-p init "2048-game")))) + +(ert-deftest test-init-defer-games-declaration-check-rejects-non-installing-forms () + "Boundary: the declaration check refuses forms use-package would not install." + (should-not (test-init-defer-games--declaration-installs-p + "(use-package malyon :ensure nil :defer t)\n" "malyon")) + (should-not (test-init-defer-games--declaration-installs-p + "(use-package malyon :load-path \"~/x\" :defer t)\n" "malyon")) + (should (test-init-defer-games--declaration-installs-p + "(use-package malyon :defer t :commands (malyon))\n" "malyon"))) + (provide 'test-init-defer-games) ;;; test-init-defer-games.el ends here diff --git a/tests/test-integration-recurring-events.el b/tests/test-integration-recurring-events.el index 8339d167..44ddfb00 100644 --- a/tests/test-integration-recurring-events.el +++ b/tests/test-integration-recurring-events.el @@ -24,13 +24,22 @@ ;;; Setup and Teardown +(defvar test-integration-recurring-events--saved-tz nil + "The TZ in force before setup pinned it, restored by teardown.") + (defun test-integration-recurring-events-setup () - "Setup for recurring events integration tests." - nil) + "Setup for recurring events integration tests. +Pins TZ to America/Chicago: the fixtures are TZID=America/Chicago and the +assertions expect that zone's local rendering (\"Sat 10:30-11:00\"), so on +any other machine zone the pipeline's correct conversion reads as a failure. +`setenv' on TZ also calls `set-time-zone-rule', which is what the time +functions actually consult." + (setq test-integration-recurring-events--saved-tz (getenv "TZ")) + (setenv "TZ" "America/Chicago")) (defun test-integration-recurring-events-teardown () - "Teardown for recurring events integration tests." - nil) + "Teardown for recurring events integration tests: restore the machine TZ." + (setenv "TZ" test-integration-recurring-events--saved-tz)) ;;; Test Data diff --git a/tests/test-music-config--append-track-to-m3u-file.el b/tests/test-music-config--append-track-to-m3u-file.el index be0cbd8e..cc40438c 100644 --- a/tests/test-music-config--append-track-to-m3u-file.el +++ b/tests/test-music-config--append-track-to-m3u-file.el @@ -39,7 +39,8 @@ "Append to brand new empty M3U file." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect - (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (let* ((cj/music-root (cj/create-test-base-dir)) + (m3u-file (cj/create-temp-test-file "test-playlist-")) (track-path (expand-file-name "artist/song.mp3" cj/music-root)) (expected-relative "artist/song.mp3")) (cj/music--append-track-to-m3u-file track-path m3u-file) @@ -53,6 +54,7 @@ (test-music-config--append-track-to-m3u-file-setup) (unwind-protect (let* ((existing-content "first.mp3\n") + (cj/music-root (cj/create-test-base-dir)) (m3u-file (cj/create-temp-test-file-with-content existing-content "test-playlist-")) (track-path (expand-file-name "second.mp3" cj/music-root)) (expected-relative "second.mp3")) @@ -68,6 +70,7 @@ (test-music-config--append-track-to-m3u-file-setup) (unwind-protect (let* ((existing-content "first.mp3") + (cj/music-root (cj/create-test-base-dir)) (m3u-file (cj/create-temp-test-file-with-content existing-content "test-playlist-")) (track-path (expand-file-name "second.mp3" cj/music-root)) (expected-relative "second.mp3")) @@ -82,7 +85,8 @@ "Multiple appends to same file all succeed (allows duplicates)." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect - (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (let* ((cj/music-root (cj/create-test-base-dir)) + (m3u-file (cj/create-temp-test-file "test-playlist-")) (track1 (expand-file-name "track1.mp3" cj/music-root)) (track2 (expand-file-name "track2.mp3" cj/music-root)) (track1-duplicate (expand-file-name "track1.mp3" cj/music-root)) @@ -98,13 +102,157 @@ (concat rel1 "\n" rel2 "\n" rel1 "\n")))))) (test-music-config--append-track-to-m3u-file-teardown))) +;;; Normal Cases: round-trip with the reader + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-round-trips-through-the-reader () + "Normal: the same-directory case round-trips through the reader. +A positive control only. With the playlist and the music root in one +directory both candidate bases produce the same string, so this passes +against the old writer too — the discriminating cases are the two tests +below, which put the bases at different depths." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (cj/music-root base) + (m3u-file (cj/create-temp-test-file "test-playlist-")) + (track-path (expand-file-name "artist/song.mp3" base))) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (should (equal (cj/music--m3u-file-tracks m3u-file) + (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-round-trips-outside-the-music-root () + "Normal/regression: a playlist living outside `cj/music-root' round-trips. +This is the case the old writer got wrong. It based every relative path on +`cj/music-root' wherever the playlist sat, while the reader resolved against +the playlist's directory. Inside the music root the two coincide, which is +why the defect stayed invisible until a playlist moved out of it." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + ;; The layout mirrors the real one: playlists/ and audio/ are siblings + ;; under mpd/, and the music root is a separate tree at a different depth. + ;; The depth difference is load-bearing -- put the music root alongside + ;; playlists/ instead and both bases yield the same relative path, so the + ;; test passes against the broken writer and proves nothing. + (let* ((base (cj/create-test-base-dir)) + (playlists (expand-file-name "mpd/playlists/" base)) + (audio (expand-file-name "mpd/audio/" base)) + (cj/music-root (expand-file-name "music/" base)) + (m3u-file (expand-file-name "ambience.m3u" playlists)) + (track-path (expand-file-name "rain-loop.mp3" audio))) + (make-directory playlists t) + (make-directory audio t) + (make-directory cj/music-root t) + (with-temp-buffer (write-file m3u-file)) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (should (equal (cj/music--m3u-file-tracks m3u-file) + (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-under-playlist-dir-is-relative () + "Normal: a track under the playlist's directory is written relative to it. +The music root sits at a different depth on purpose. Put it alongside the +playlist directory instead and both candidate bases produce the same string, +so the assertion would hold against a writer using either one." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (playlists (expand-file-name "mpd/playlists/" base)) + (cj/music-root (expand-file-name "music/" base)) + (m3u-file (expand-file-name "album.m3u" playlists)) + (track-path (expand-file-name "sub/song.mp3" playlists))) + (make-directory (expand-file-name "sub/" playlists) t) + (make-directory cj/music-root t) + (with-temp-buffer (write-file m3u-file)) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) "sub/song.mp3\n"))) + (should (equal (cj/music--m3u-file-tracks m3u-file) (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-sibling-dir-is-absolute () + "Normal: a track outside the playlist's directory is written absolute. +A sibling would otherwise come out as \"../audio/x.mp3\". Absolute is the +convention for cross-tree references here, and it survives the playlist being +moved again later, which a ../ chain does not." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (playlists (expand-file-name "mpd/playlists/" base)) + (audio (expand-file-name "mpd/audio/" base)) + (cj/music-root (expand-file-name "music/" base)) + (m3u-file (expand-file-name "ambience.m3u" playlists)) + (track-path (expand-file-name "rain-loop.mp3" audio))) + (make-directory playlists t) + (make-directory audio t) + (make-directory cj/music-root t) + (with-temp-buffer (write-file m3u-file)) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) (concat track-path "\n")))) + (should (equal (cj/music--m3u-file-tracks m3u-file) (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-deep-parent-chain-goes-absolute () + "Normal: a track several levels away is written absolute, not as a ../ chain. +This is the case the absolute fallback exists for. A four-level chain is +unreadable and breaks the moment the playlist moves, so distance from the +playlist is exactly when an absolute path earns its keep." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (playlists (expand-file-name "a/b/c/playlists/" base)) + (cj/music-root (expand-file-name "music/" base)) + (m3u-file (expand-file-name "deep.m3u" playlists)) + (track-path (expand-file-name "faraway/song.mp3" base))) + (make-directory playlists t) + (make-directory (expand-file-name "faraway/" base) t) + (make-directory cj/music-root t) + (with-temp-buffer (write-file m3u-file)) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + ;; Four hops up (playlists -> c -> b -> a -> base) would be the + ;; relative form; the writer declines it and emits the absolute path. + (should (string= (buffer-string) (concat track-path "\n")))) + (should (equal (cj/music--m3u-file-tracks m3u-file) + (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + ;;; Boundary Cases +(ert-deftest test-music-config--append-track-to-m3u-file-boundary-dotdot-named-dir-stays-relative () + "Boundary: a directory whose name merely begins with two dots stays relative. +This is the input the relative-vs-absolute test actually turns on. The check +looks for a leading \"../\", so a real subdirectory named \"..hidden\" is under +the playlist and must not be mistaken for an escape. Loosening the check to +\"..\" would break exactly this case and nothing else in the suite would catch +it." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (playlists (expand-file-name "mpd/playlists/" base)) + (cj/music-root (expand-file-name "music/" base)) + (m3u-file (expand-file-name "p.m3u" playlists)) + (track-path (expand-file-name "..hidden/song.mp3" playlists))) + (make-directory (expand-file-name "..hidden/" playlists) t) + (make-directory cj/music-root t) + (with-temp-buffer (write-file m3u-file)) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) "..hidden/song.mp3\n"))) + (should (equal (cj/music--m3u-file-tracks m3u-file) (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + (ert-deftest test-music-config--append-track-to-m3u-file-boundary-very-long-path-appends-successfully () "Append very long track path without truncation." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect - (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (let* ((cj/music-root (cj/create-test-base-dir)) + (m3u-file (cj/create-temp-test-file "test-playlist-")) ;; Create a relative path that's ~450 chars long (relative-path (concat (make-string 440 ?a) "/song.mp3")) (track-path (expand-file-name relative-path cj/music-root))) @@ -119,7 +267,8 @@ "Append path with unicode characters preserves UTF-8 encoding." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect - (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (let* ((cj/music-root (cj/create-test-base-dir)) + (m3u-file (cj/create-temp-test-file "test-playlist-")) (relative-path "中文/artist-名前/song🎵.mp3") (track-path (expand-file-name relative-path cj/music-root))) (cj/music--append-track-to-m3u-file track-path m3u-file) @@ -132,7 +281,8 @@ "Append path with spaces and special characters." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect - (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (let* ((cj/music-root (cj/create-test-base-dir)) + (m3u-file (cj/create-temp-test-file "test-playlist-")) (relative-path "Artist Name/Album (2024)/01 - Song's Title [Remix].mp3") (track-path (expand-file-name relative-path cj/music-root))) (cj/music--append-track-to-m3u-file track-path m3u-file) @@ -146,6 +296,7 @@ (test-music-config--append-track-to-m3u-file-setup) (unwind-protect (let* ((existing-content "#EXTM3U\n#EXTINF:-1,Radio Station\nhttp://stream.url/radio\n") + (cj/music-root (cj/create-test-base-dir)) (m3u-file (cj/create-temp-test-file-with-content existing-content "test-playlist-")) (relative-path "local-track.mp3") (track-path (expand-file-name relative-path cj/music-root))) @@ -156,6 +307,73 @@ (concat existing-content relative-path "\n"))))) (test-music-config--append-track-to-m3u-file-teardown))) +;;; Boundary Cases: symlinked playlists + +(defun test-music-config--append--make-symlinked-playlist (base content link-depth) + "Create a playlist whose deployed path is a symlink, and return that path. +CONTENT is written to the real file. LINK-DEPTH controls how long the link +string is, which is the whole point: `file-attributes' does not follow +symlinks, so a writer sizing the file that way reads the length of the link +rather than the content." + (let* ((deployed (expand-file-name "deployed/" base)) + (deep (expand-file-name (mapconcat #'identity + (make-list link-depth "longdirname") + "/") + base)) + (real (expand-file-name "p.m3u" deep)) + (link (expand-file-name "p.m3u" deployed))) + (make-directory deep t) + (make-directory deployed t) + (with-temp-buffer (insert content) (write-file real)) + (make-symbolic-link (file-relative-name real deployed) link t) + link)) + +(ert-deftest test-music-config--append-track-to-m3u-file-boundary-symlink-longer-than-content () + "Boundary: appending to a symlinked playlist whose link string is longer than +its content must not signal. Sizing the file with `file-attributes' returns +the link's length, so the read range falls outside the file, nothing is +inserted, and `char-after' hands nil to a numeric comparison. Measured on the +real deployed set: 31 of 100 symlinked playlists are in this state." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (m3u-file (test-music-config--append--make-symlinked-playlist + base "https://example.com/s.mp3\n" 8)) + (track-path (expand-file-name "song.mp3" (file-name-directory m3u-file)))) + (should (> (file-attribute-size (file-attributes m3u-file)) + (file-attribute-size (file-attributes (file-truename m3u-file))))) + (cj/music--append-track-to-m3u-file track-path m3u-file) + ;; The seeded line is a stream URL, which the reader passes through, so + ;; both entries come back. + (should (equal (cj/music--m3u-file-tracks m3u-file) + (list "https://example.com/s.mp3" track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-boundary-symlink-no-spurious-blank-line () + "Boundary: a symlinked playlist already ending in a newline gains no blank line. +The trailing-newline probe reads a byte chosen from the wrong size, so it +misreads a terminated file as unterminated and prepends a newline. All 100 +symlinked playlists in the deployed set read the wrong byte this way." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + ;; Content deliberately longer than the link string, so the misread byte + ;; still lands inside the file. That separates this from the sibling test + ;; above: here the probe reads a valid but wrong byte and silently + ;; misjudges, rather than reading past the end and signalling. + (let* ((base (cj/create-test-base-dir)) + (content (mapconcat (lambda (i) (format "track-%03d-with-a-longish-name.mp3" i)) + (number-sequence 1 12) "\n")) + (m3u-file (test-music-config--append--make-symlinked-playlist + base (concat content "\n") 2)) + (track-path (expand-file-name "second.mp3" (file-name-directory m3u-file)))) + (should (< (file-attribute-size (file-attributes m3u-file)) + (file-attribute-size (file-attributes (file-truename m3u-file))))) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) (concat content "\nsecond.mp3\n"))))) + (test-music-config--append-track-to-m3u-file-teardown))) + ;;; Error Cases (ert-deftest test-music-config--append-track-to-m3u-file-error-nonexistent-file-signals-error () @@ -172,6 +390,9 @@ "Signal error when M3U file is read-only." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect + ;; No `cj/music-root' rebinding here: the writable-p guard signals before + ;; any path computation runs, so binding it would imply a dependency the + ;; read-only path does not have. (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) (track-path "/home/user/music/song.mp3")) ;; Make file read-only diff --git a/tests/test-package-resilience.el b/tests/test-package-resilience.el new file mode 100644 index 00000000..d5fdde4a --- /dev/null +++ b/tests/test-package-resilience.el @@ -0,0 +1,504 @@ +;;; test-package-resilience.el --- Tests for surviving failed package installs -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for package-resilience.el, which keeps a failed package download from +;; aborting init. The regression these guard is concrete: early-init.el sets +;; `debug-on-error' during startup so config errors are loud, and that disarms +;; the `condition-case-unless-debug' inside `use-package-ensure-elpa', so one +;; transient download error dropped a fresh install into the debugger with two +;; thirds of the config unloaded. +;; +;; The fakes below stand in for the package archive so no test touches the +;; network or the real elpa directory. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'package-resilience) + +;;; ------------------------------- Fake registry ------------------------------- + +(defvar test-pkg-res--installed nil + "Package symbols the fake registry considers installed.") + +(defvar test-pkg-res--install-log nil + "Packages `package-install' was called with, newest first.") + +(defvar test-pkg-res--failures nil + "Alist of (PACKAGE . N): the next N install attempts for PACKAGE signal.") + +(defvar test-pkg-res--dynamic-state nil + "Captured dynamic state at each `package-install' call, newest first.") + +(defun test-pkg-res--should-fail-p (package) + "Return non-nil when this attempt at PACKAGE should signal, and count it." + (let ((cell (assq package test-pkg-res--failures))) + (when (and cell (> (cdr cell) 0)) + (setcdr cell (1- (cdr cell))) + t))) + +(defun test-pkg-res--install (package) + "Fake `package-install' for PACKAGE: record the call, then fail or install." + (push package test-pkg-res--install-log) + (push (list :debug-on-error debug-on-error + :find-file-hook find-file-hook + :prog-mode-hook prog-mode-hook + :lisp-data-mode-hook lisp-data-mode-hook + :emacs-lisp-mode-hook emacs-lisp-mode-hook) + test-pkg-res--dynamic-state) + (if (test-pkg-res--should-fail-p package) + (signal 'file-error (list "https://elpa.example.invalid/x.tar" "No Data")) + (push package test-pkg-res--installed))) + +(defmacro test-pkg-res--with-registry (available installed failures &rest body) + "Run BODY against a fake package registry. +AVAILABLE lists package symbols the archives carry, INSTALLED those already +installed, and FAILURES is an alist of (PACKAGE . N) attempts that signal." + (declare (indent 3) (debug t)) + `(let ((test-pkg-res--installed (copy-sequence ,installed)) + (test-pkg-res--install-log nil) + (test-pkg-res--failures (copy-tree ,failures)) + (test-pkg-res--dynamic-state nil) + (cj/failed-package-installs nil) + (cj/failed-source-package-installs nil) + (cj/package-install-retry-delay 0) + ;; Both of these accumulate across a whole session by design, so a + ;; test that leaves them set changes what a later test does: an + ;; unbound failure counter tripped the circuit breaker and three + ;; install tests stopped installing anything at all. + (cj/--package-retry-spent 0.0) + (cj/--package-consecutive-failures 0) + (package-archive-contents (mapcar #'list ,available))) + (cl-letf (((symbol-function 'package-installed-p) + (lambda (pkg &rest _) (and (memq pkg test-pkg-res--installed) t))) + ((symbol-function 'package-install) + (lambda (pkg &rest _) (test-pkg-res--install pkg))) + ((symbol-function 'package-refresh-contents) (lambda (&rest _) nil)) + ((symbol-function 'package-read-all-archive-contents) (lambda (&rest _) nil)) + ((symbol-function 'sleep-for) (lambda (&rest _) nil))) + ,@body))) + +;;; --------------------------- Resolving :ensure args -------------------------- + +(ert-deftest test-package-resilience-packages-resolves-t-to-name () + "Normal: an :ensure of t resolves to the use-package form's own name." + (should (equal '(foo) (cj/--package-ensure-packages 'foo '(t))))) + +(ert-deftest test-package-resilience-packages-resolves-explicit-symbol () + "Normal: an explicit :ensure symbol names a different package." + (should (equal '(bar) (cj/--package-ensure-packages 'foo '(bar))))) + +(ert-deftest test-package-resilience-packages-nil-ensure-is-empty () + "Boundary: :ensure nil requests no package at all." + (should (equal '() (cj/--package-ensure-packages 'foo '(nil))))) + +(ert-deftest test-package-resilience-packages-unwraps-pinned-cons () + "Boundary: a pinned (PACKAGE . ARCHIVE) cell resolves to the package symbol." + (should (equal '(bar) (cj/--package-ensure-packages 'foo '((bar . "melpa")))))) + +(ert-deftest test-package-resilience-packages-accepts-string-name () + "Boundary: a use-package form named with a string still resolves to a symbol." + (should (equal '(foo) (cj/--package-ensure-packages "foo" '(t))))) + +(ert-deftest test-package-resilience-packages-handles-several-ensures () + "Boundary: several :ensure keywords resolve to several packages." + (should (equal '(bar baz) (cj/--package-ensure-packages 'foo '(bar baz))))) + +;;; ------------------------------ Installing ---------------------------------- + +(ert-deftest test-package-resilience-installs-missing-package () + "Normal: a missing package is installed and nothing is recorded as failed." + (test-pkg-res--with-registry '(foo) '() '() + (cj/package-ensure 'foo '(t) nil) + (should (equal '(foo) test-pkg-res--install-log)) + (should (memq 'foo test-pkg-res--installed)) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-skips-installed-package () + "Normal: an already-installed package is never downloaded again." + (test-pkg-res--with-registry '(foo) '(foo) '() + (cj/package-ensure 'foo '(t) nil) + (should-not test-pkg-res--install-log) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-survives-failure-under-debug-on-error () + "Error: a failed install is recorded, not signalled, even with debug-on-error. +This is the regression: `condition-case-unless-debug' inside use-package does +not catch while `debug-on-error' is non-nil, so a transient download error +aborted init in place." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (let ((debug-on-error t)) + (cj/package-ensure 'foo '(t) nil) + (should (memq 'foo cj/failed-package-installs)) + (should-not (memq 'foo test-pkg-res--installed))))) + +(ert-deftest test-package-resilience-retries-transient-failure () + "Error: a download that fails once and then succeeds installs on the retry." + (test-pkg-res--with-registry '(foo) '() '((foo . 1)) + (cj/package-ensure 'foo '(t) nil) + (should (= 2 (length test-pkg-res--install-log))) + (should (memq 'foo test-pkg-res--installed)) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-stops-after-configured-retries () + "Boundary: a package that always fails is attempted retries-plus-one times." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (let ((cj/package-install-retries 2)) + (cj/package-ensure 'foo '(t) nil) + (should (= 3 (length test-pkg-res--install-log))) + (should (memq 'foo cj/failed-package-installs))))) + +(ert-deftest test-package-resilience-does-not-retry-unknown-package () + "Boundary: a package no archive carries is attempted once, then recorded. +Retrying a name the archives have never heard of only burns refreshes." + (test-pkg-res--with-registry '() '() '((foo . 999)) + (let ((cj/package-install-retries 2)) + (cj/package-ensure 'foo '(t) nil) + (should (= 1 (length test-pkg-res--install-log))) + (should (memq 'foo cj/failed-package-installs))))) + +(ert-deftest test-package-resilience-inhibits-editing-hooks-during-install () + "Error: editing hooks are silenced while a package installs. +Installation generates autoloads by visiting .el files, so a hook belonging to +a package that failed earlier would otherwise break unrelated installs." + (test-pkg-res--with-registry '(foo) '() '() + (let ((find-file-hook '(ignore)) + (prog-mode-hook '(ignore)) + (lisp-data-mode-hook '(ignore)) + (emacs-lisp-mode-hook '(ignore))) + (cj/package-ensure 'foo '(t) nil) + (let ((seen (car test-pkg-res--dynamic-state))) + (should-not (plist-get seen :find-file-hook)) + (should-not (plist-get seen :prog-mode-hook)) + (should-not (plist-get seen :lisp-data-mode-hook)) + (should-not (plist-get seen :emacs-lisp-mode-hook)) + (should-not (plist-get seen :debug-on-error)))))) + +(ert-deftest test-package-resilience-records-each-failure-once () + "Boundary: repeated ensure calls for one package record it a single time." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (cj/package-ensure 'foo '(t) nil) + (cj/package-ensure 'foo '(t) nil) + (should (equal '(foo) cj/failed-package-installs)))) + +;;; ------------------------------ Retry budget --------------------------------- + +(ert-deftest test-package-resilience-budget-caps-retrying () + "Boundary: with the retry budget spent, a failure gets its one attempt only. +An offline machine fails every package, so an uncapped per-package retry would +turn the abort this module removes into a startup that appears to hang." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (let ((cj/package-install-retries 2) + (cj/--package-retry-spent 999.0)) + (cj/package-ensure 'foo '(t) nil) + (should (= 1 (length test-pkg-res--install-log))) + (should (memq 'foo cj/failed-package-installs))))) + +(ert-deftest test-package-resilience-budget-still-records-failures () + "Boundary: a package skipped for budget is still recorded and reportable." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (let ((cj/--package-retry-spent 999.0)) + (cj/package-ensure 'foo '(t) nil) + (should (equal '(foo) (cj/package-still-missing)))))) + +(ert-deftest test-package-resilience-budget-accrues-across-packages () + "Error: retry time spent on one package counts against the next one's budget. +The budget is per session, not per package, which is what bounds a machine +offline for all ~190 of them. The clock is advanced ten seconds per reading so +the accrual is real rather than an artifact of a mocked sleep." + (test-pkg-res--with-registry '(foo bar) '() '((foo . 999) (bar . 999)) + (let ((cj/package-install-retries 2) + (cj/package-install-retry-budget 15.0) + (cj/--package-retry-spent 0.0) + (clock 0.0)) + (cl-letf (((symbol-function 'float-time) + (lambda (&rest _) (setq clock (+ clock 10.0))))) + (cj/package-ensure 'foo '(t) nil) + (cj/package-ensure 'bar '(t) nil)) + ;; foo: one attempt plus two retries, spending 20s. bar: one attempt, + ;; because foo already overspent the shared budget. + (should (= 4 (length test-pkg-res--install-log))) + (should (> cj/--package-retry-spent cj/package-install-retry-budget))))) + +;;; ----------------------------- Circuit breaker ------------------------------- + +(ert-deftest test-package-resilience-stops-attempting-after-failure-run () + "Error: enough failures in a row and later packages are recorded untried. +Offline, nothing populates the archive list, so every single attempt pays a +full `package-refresh-contents' before failing. Across ~190 packages that is +the dominant cost, and no retry ceiling bounds it." + (test-pkg-res--with-registry '(a b c) '() '((a . 999) (b . 999) (c . 999)) + (let ((cj/package-install-retries 0) + (cj/package-install-failure-limit 2)) + (cj/package-ensure 'a '(t) nil) + (cj/package-ensure 'b '(t) nil) + (cj/package-ensure 'c '(t) nil) + ;; a and b were tried; c was not, because the run had already reached 2. + (should (equal '(b a) test-pkg-res--install-log)) + (should (memq 'c cj/failed-package-installs))))) + +(ert-deftest test-package-resilience-failure-run-resets-on-success () + "Boundary: one success clears the run, so an unlucky package is not fatal. +The breaker exists to detect a dead network, not to give up after N scattered +failures across an otherwise healthy install." + (test-pkg-res--with-registry '(a b c) '() '((a . 999) (c . 999)) + (let ((cj/package-install-retries 0) + (cj/package-install-failure-limit 2)) + (cj/package-ensure 'a '(t) nil) ; fails, run = 1 + (cj/package-ensure 'b '(t) nil) ; succeeds, run = 0 + (cj/package-ensure 'c '(t) nil) ; fails, run = 1, still under the limit + (should (equal '(c b a) test-pkg-res--install-log))))) + +(ert-deftest test-package-resilience-installed-package-does-not-clear-run () + "Boundary: a package that was already present tells us nothing about the net. +Counting it as a success would reset the run on every built-in-backed form and +the breaker would never trip on an offline machine." + (test-pkg-res--with-registry '(a b c) '(b) '((a . 999) (c . 999)) + (let ((cj/package-install-retries 0) + (cj/package-install-failure-limit 2)) + (cj/package-ensure 'a '(t) nil) ; fails, run = 1 + (cj/package-ensure 'b '(t) nil) ; already installed, untouched + (cj/package-ensure 'c '(t) nil) ; fails, run = 2 + (should (equal '(c a) test-pkg-res--install-log)) + (should (cj/--package-giving-up-p))))) + +;;; --------------------- Packages installed from source (:vc) ------------------ + +(defun test-pkg-res--vc-orig (fails) + "Return a fake `use-package-vc-install' that signals when FAILS is non-nil." + (lambda (arg &optional _local-path) + (push (car arg) test-pkg-res--install-log) + (if fails + (signal 'error (list "Cloning failed: Permission denied (publickey)")) + (push (car arg) test-pkg-res--installed)))) + +(ert-deftest test-package-resilience-vc-install-succeeds-quietly () + "Normal: a working source install is not recorded as a failure." + (test-pkg-res--with-registry '() '() '() + (cj/--package-vc-install-guard (test-pkg-res--vc-orig nil) '(gloss nil nil)) + (should (memq 'gloss test-pkg-res--installed)) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-vc-install-survives-failed-clone () + "Error: a failed clone is recorded, not signalled, even with debug-on-error. +`:vc' forms route around `use-package-ensure-function' entirely and +`use-package-vc-install' has no error handling, so without this guard a fresh +machine lacking credentials for the git host aborts init exactly as before." + (test-pkg-res--with-registry '() '() '() + (let ((debug-on-error t)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig t) '(gloss nil nil)) + (should (memq 'gloss cj/failed-source-package-installs)) + (should (memq 'gloss (cj/package-still-missing))) + ;; Never the archive list: `package-install' cannot recover a source + ;; package, and for one that also exists on an archive it would install + ;; the archive build instead of the checkout that was asked for. + (should-not (memq 'gloss cj/failed-package-installs)) + (should-not (memq 'gloss test-pkg-res--installed))))) + +(ert-deftest test-package-resilience-vc-failure-counts-toward-breaker () + "Error: a failed clone counts toward the consecutive-failure run. +No credentials means every source package fails, the same shape as no network." + (test-pkg-res--with-registry '() '() '() + (let ((cj/package-install-failure-limit 2)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig t) '(gloss nil nil)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig t) '(chime nil nil)) + (should (cj/--package-giving-up-p))))) + +(ert-deftest test-package-resilience-vc-skipped-once-breaker-tripped () + "Boundary: with the breaker tripped a source install is recorded untried." + (test-pkg-res--with-registry '() '() '() + (let ((cj/--package-consecutive-failures 99)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig t) '(gloss nil nil)) + (should-not test-pkg-res--install-log) + (should (memq 'gloss cj/failed-source-package-installs))))) + +(ert-deftest test-package-resilience-vc-installed-package-passes-through () + "Boundary: an already-installed source package neither counts nor records. +It says nothing about whether the git host is reachable, so treating it as a +success would reset the run and stop the breaker ever tripping." + (test-pkg-res--with-registry '() '(gloss) '() + (let ((cj/--package-consecutive-failures 3)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig nil) '(gloss nil nil)) + (should (= 3 cj/--package-consecutive-failures)) + (should-not cj/failed-package-installs)))) + +(ert-deftest test-package-resilience-vc-success-clears-failure-run () + "Boundary: a clone that works clears the run, like any other install." + (test-pkg-res--with-registry '() '() '() + (let ((cj/--package-consecutive-failures 3)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig nil) '(gloss nil nil)) + (should (= 0 cj/--package-consecutive-failures))))) + +;;; --------------------------------- Retrying ---------------------------------- + +(ert-deftest test-package-resilience-retry-clears-recovered-package () + "Normal: retrying installs a package that is now reachable and clears it." + (test-pkg-res--with-registry '(foo) '() '() + (setq cj/failed-package-installs '(foo)) + (cj/retry-failed-package-installs) + (should (memq 'foo test-pkg-res--installed)) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-retry-converges-on-cascade () + "Boundary: a package installable only on a later pass still converges. +A failed package leaves hooks that break other installs, so recovery has to +keep passing over the set until a pass installs nothing new." + (test-pkg-res--with-registry '(foo bar) '() '((bar . 1)) + (setq cj/failed-package-installs '(foo bar)) + (cj/retry-failed-package-installs) + (should (memq 'foo test-pkg-res--installed)) + (should (memq 'bar test-pkg-res--installed)) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-retry-leaves-source-packages-alone () + "Boundary: retrying never runs `package-install' on a source package. +It cannot recover one, and for a source package that also exists on an archive +it would install the archive build instead of the checkout that was declared, +leaving `package-installed-p' true and the source install permanently skipped." + (test-pkg-res--with-registry '(gloss) '() '() + (setq cj/failed-source-package-installs '(gloss)) + (cj/retry-failed-package-installs) + (should-not test-pkg-res--install-log) + (should (equal '(gloss) (cj/package-still-missing))))) + +(ert-deftest test-package-resilience-retry-works-with-empty-archive-list () + "Error: recovery still attempts installs when no archive list is loaded yet. +This is the case the command exists for: a laptop that booted before its wifi +came up has an empty `package-archive-contents', and screening recorded +packages against it would make the command a silent no-op right when the user +finally has a network. `package-install' populates the archives itself." + (test-pkg-res--with-registry '() '() '() + (setq cj/failed-package-installs '(foo bar)) + (should-not package-archive-contents) + (cj/retry-failed-package-installs) + (should (equal '(bar foo) test-pkg-res--install-log)) + (should-not (cj/package-still-missing)))) + +(ert-deftest test-package-resilience-retry-terminates-when-impossible () + "Error: a package that can never install terminates the loop and stays listed." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (setq cj/failed-package-installs '(foo)) + (cj/retry-failed-package-installs) + (should (equal '(foo) cj/failed-package-installs)))) + +(ert-deftest test-package-resilience-retry-with-nothing-failed-is-quiet () + "Boundary: retrying an empty failure set installs nothing." + (test-pkg-res--with-registry '(foo) '() '() + (setq cj/failed-package-installs nil) + (cj/retry-failed-package-installs) + (should-not test-pkg-res--install-log))) + +;;; -------------------------------- Reporting ---------------------------------- + +(ert-deftest test-package-resilience-report-is-silent-when-clean () + "Normal: a run with no failed installs raises no warning." + (test-pkg-res--with-registry '() '() '() + (let ((warned nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (&rest _) (setq warned t)))) + (cj/report-failed-package-installs) + (should-not warned))))) + +(ert-deftest test-package-resilience-still-missing-does-not-mutate-records () + "Error: reading the missing set leaves both record lists intact. +`append' does not copy its last argument and `delete-dups' splices, so the +obvious spelling edits `cj/failed-source-package-installs' in place. Reading a +value must not destroy it, least of all from the startup report." + (test-pkg-res--with-registry '() '() '() + (setq cj/failed-package-installs '(foo shared)) + (setq cj/failed-source-package-installs '(gloss shared chime)) + (cj/package-still-missing) + (should (equal '(foo shared) cj/failed-package-installs)) + (should (equal '(gloss shared chime) cj/failed-source-package-installs)))) + +(ert-deftest test-package-resilience-report-omits-package-installed-since () + "Boundary: a package that arrived later as a dependency is not reported. +It failed on its own use-package form, so it is on the recorded list, but it is +present now and there is nothing for the user to do about it." + (test-pkg-res--with-registry '(foo bar) '(foo) '() + (setq cj/failed-package-installs '(foo bar)) + (should (equal '(bar) (cj/package-still-missing))) + (let ((message-text nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (_type msg &rest _) (setq message-text msg)))) + (cj/report-failed-package-installs) + (should (string-match-p "bar" message-text)) + (should-not (string-match-p "foo" message-text)))))) + +(ert-deftest test-package-resilience-report-silent-when-all-arrived-since () + "Boundary: recorded failures that are all installed now raise no warning." + (test-pkg-res--with-registry '(foo) '(foo) '() + (setq cj/failed-package-installs '(foo)) + (let ((warned nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (&rest _) (setq warned t)))) + (cj/report-failed-package-installs) + (should-not warned))))) + +(ert-deftest test-package-resilience-report-says-when-it-stopped-early () + "Error: a tripped breaker is said out loud, so untried is not read as failed. +Most of a long list would never have been attempted, and reporting those as +install failures would send the user hunting for ~185 individual problems." + (test-pkg-res--with-registry '(foo) '() '() + (setq cj/failed-package-installs '(foo)) + (let ((cj/--package-consecutive-failures 99) + (message-text nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (_type msg &rest _) (setq message-text msg)))) + (cj/report-failed-package-installs) + (should (string-match-p "never" message-text)) + ;; Names both causes: a run of failures is a dead network or missing + ;; credentials, and the message should not pick one. + (should (string-match-p "network" message-text)) + (should (string-match-p "credentials" message-text)))))) + +(ert-deftest test-package-resilience-report-omits-early-stop-when-not-tripped () + "Boundary: an ordinary failure is not dressed up as a machine being offline." + (test-pkg-res--with-registry '(foo) '() '() + (setq cj/failed-package-installs '(foo)) + (let ((cj/--package-consecutive-failures 0) + (message-text nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (_type msg &rest _) (setq message-text msg)))) + (cj/report-failed-package-installs) + (should-not (string-match-p "never" message-text)))))) + +(ert-deftest test-package-resilience-report-warns-and-names-failures () + "Error: failed installs raise one warning that names every package." + (test-pkg-res--with-registry '(foo bar) '() '() + (setq cj/failed-package-installs '(foo bar)) + (let ((message-text nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (_type msg &rest _) (setq message-text msg)))) + (cj/report-failed-package-installs) + (should message-text) + (should (string-match-p "foo" message-text)) + (should (string-match-p "bar" message-text)))))) + +;;; ---------------------------------- Wiring ----------------------------------- + +;; The guard tests above call the functions directly, which says nothing about +;; whether they are actually reachable from a real startup. If use-package +;; renamed either seam, every test above would still pass while the whole +;; module sat dead -- this repo's recurring failure, a gate that was green +;; because it never ran. + +(ert-deftest test-package-resilience-is-wired-to-use-package () + "Normal: loading the module actually takes over both use-package seams. +`advice-member-p' answers yes for advice attached to a symbol that was never +defined, so it alone would still pass if upstream renamed the function and left +the advice on a dead symbol. That rename is the whole scenario this test +exists for, hence the `fboundp'." + (should (eq use-package-ensure-function #'cj/package-ensure)) + (should (fboundp 'use-package-vc-install)) + (should (advice-member-p #'cj/--package-vc-install-guard + 'use-package-vc-install))) + +(ert-deftest test-package-resilience-reports-at-startup () + "Normal: the end-of-startup report is on `emacs-startup-hook'." + (should (memq #'cj/report-failed-package-installs + (default-value 'emacs-startup-hook)))) + +(provide 'test-package-resilience) +;;; test-package-resilience.el ends here diff --git a/tests/test-prog-general-yas-activation.el b/tests/test-prog-general-yas-activation.el index d6ea42cd..d9ae76e3 100644 --- a/tests/test-prog-general-yas-activation.el +++ b/tests/test-prog-general-yas-activation.el @@ -122,7 +122,11 @@ produces the marker block." "Boundary: <cj + expand in python-ts-mode (a tree-sitter prog-mode-derived mode) produces the marker block. Verifies the snippet reaches modern tree-sitter modes through fundamental-mode inheritance." - (skip-unless (fboundp 'python-ts-mode)) + ;; `python-ts-mode' prompts to install a missing grammar, which a batch run + ;; cannot answer, so skip on the grammar rather than on the mode's existence. + (skip-unless (and (fboundp 'python-ts-mode) + (require 'treesit nil t) + (treesit-ready-p 'python t))) (should (string= (test-prog-general--expand-cj-in-mode #'python-ts-mode) test-prog-general--cj-expected))) diff --git a/tests/test-setup-telega.bats b/tests/test-setup-telega.bats index 3282b9e1..518ecc7b 100644 --- a/tests/test-setup-telega.bats +++ b/tests/test-setup-telega.bats @@ -57,11 +57,11 @@ setup() { # --------------------------- pull_or_announce_image ----------------------- -@test "pull_or_announce_image: announces the in-Emacs build when no image is set" { +@test "pull_or_announce_image: points at make telega-image when no image is set" { TELEGA_DOCKER_IMAGE="" run pull_or_announce_image [ "$status" -eq 0 ] - [[ "$output" == *"M-x telega-server-build"* ]] + [[ "$output" == *"make telega-image"* ]] } @test "pull_or_announce_image: pulls when TELEGA_DOCKER_IMAGE is set" { diff --git a/tests/test-system-commands-resolve-and-run.el b/tests/test-system-commands-resolve-and-run.el index 7e5146b1..3dae8cda 100644 --- a/tests/test-system-commands-resolve-and-run.el +++ b/tests/test-system-commands-resolve-and-run.el @@ -85,26 +85,34 @@ (put 'test-sc-confirm-cmd 'cj/system-confirm nil))) (ert-deftest test-system-cmd-strong-confirm-decline-aborts () - "Boundary: a strong-confirm var uses yes-or-no-p; declining aborts and -does not run the command." + "Boundary: a strong-confirm var asks a single y/n; declining aborts and +does not run the command. + +The strong path used to demand a typed \"yes\", and this test used to assert +that by erroring if `read-char-choice' was called at all. It now asserts the +opposite, because a long-form prompt is only as safe as it is answerable: on +2026-07-31 one became unanswerable when a second agent session held the +selected window, and the Emacs session had to be killed with buffers unsaved. +What survives the change is the part that mattered -- the prompt still has no +default, so RET and space re-prompt rather than confirming a shutdown." (defvar test-sc-strong-cmd "test-strong-cmd") (put 'test-sc-strong-cmd 'cj/system-confirm 'strong) (unwind-protect - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil)) - ((symbol-function 'read-char-choice) - (lambda (&rest _) (error "strong confirm must not use read-char-choice"))) + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?n)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) (error "strong confirm must not demand a typed yes"))) ((symbol-function 'start-process-shell-command) (lambda (&rest _) (error "shouldn't run")))) (should-error (cj/system-cmd 'test-sc-strong-cmd) :type 'user-error)) (put 'test-sc-strong-cmd 'cj/system-confirm nil))) (ert-deftest test-system-cmd-strong-confirm-accept-runs () - "Normal: a strong-confirm var runs the command when yes-or-no-p returns t." + "Normal: a strong-confirm var runs the command on a single y." (defvar test-sc-strong-cmd-2 "echo strong") (put 'test-sc-strong-cmd-2 'cj/system-confirm 'strong) (let (cmd-line) (unwind-protect - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y)) ((symbol-function 'start-process-shell-command) (lambda (_name _buf c) (setq cmd-line c) 'fake-proc)) ((symbol-function 'set-process-query-on-exit-flag) #'ignore) @@ -114,6 +122,29 @@ does not run the command." (put 'test-sc-strong-cmd-2 'cj/system-confirm nil)) (should (string-match-p "echo strong" cmd-line)))) +(ert-deftest test-system-cmd-strong-confirm-rejects-stray-keys () + "Boundary: the strong prompt offers only y and n, so a stray RET or space +cannot confirm an irreversible command. + +This is the protection the typed-\"yes\" form existed for, kept while the +answer became a single keystroke. Asserted on the accepted-character set +handed to `read-char-choice' rather than on the prompt text, because the set +is what actually decides." + (defvar test-sc-strong-cmd-3 "echo strong") + (put 'test-sc-strong-cmd-3 'cj/system-confirm 'strong) + (let (chars) + (unwind-protect + (cl-letf (((symbol-function 'read-char-choice) + (lambda (_prompt cs &rest _) (setq chars cs) ?n)) + ((symbol-function 'start-process-shell-command) + (lambda (&rest _) (error "shouldn't run")))) + (should-error (cj/system-cmd 'test-sc-strong-cmd-3) :type 'user-error)) + (put 'test-sc-strong-cmd-3 'cj/system-confirm nil)) + (should (equal (sort (copy-sequence chars) #'<) '(?N ?Y ?n ?y))) + (should-not (memq ?\r chars)) + (should-not (memq ?\n chars)) + (should-not (memq ?\s chars)))) + ;;; cj/system-cmd--emacs-service-available-p (ert-deftest test-system-cmd-service-available-true-on-zero-exit () diff --git a/tests/test-system-defaults--warning-display-dead-buffer.el b/tests/test-system-defaults--warning-display-dead-buffer.el new file mode 100644 index 00000000..48c7797e --- /dev/null +++ b/tests/test-system-defaults--warning-display-dead-buffer.el @@ -0,0 +1,103 @@ +;;; test-system-defaults--warning-display-dead-buffer.el --- Dead-buffer guard on deferred warnings -*- lexical-binding: t; -*- + +;;; Commentary: +;; Emacs 31.1's warnings.el defers daemon-startup warnings into a one-shot +;; `after-make-frame-functions' closure that calls `warning--display-buffer' +;; on the first client frame with the *Warnings* buffer object it captured at +;; warning time. If anything killed that buffer in between, `display-buffer' +;; signals inside `make-frame', server.el swallows the error as +;; "-window-system-unsupported", and emacsclient silently retries on $DISPLAY: +;; the session's first frame lands on XWayland. +;; +;; The root fix keeps *Warnings* alive (undead-buffers.el). This is the +;; defense in depth: `cj/warning--display-buffer-if-live' wraps +;; `warning--display-buffer' so a dead buffer is skipped rather than passed +;; on. Load happens once in the shared sandbox (testutil-system-defaults.el); +;; `warning--display-buffer' only exists from Emacs 31, so the end-to-end case +;; skips on older builds while the pure-function cases always run. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(require 'testutil-system-defaults) + +(test-system-defaults--with-load-environment + (test-system-defaults--load)) + +(defun test-system-defaults--recording-orig () + "Return (ORIG . CALLS) where ORIG records every argument into CALLS." + (let ((calls (list nil))) + (cons (lambda (buffer) + (push buffer (car calls)) + 'displayed) + calls))) + +;;; Normal Cases + +(ert-deftest test-system-defaults-warning-guard-passes-live-buffer-through () + "Normal: a live buffer reaches the original and its value is returned." + (let* ((rec (test-system-defaults--recording-orig)) + (buf (generate-new-buffer " *warning-guard-live*"))) + (unwind-protect + (progn + (should (eq 'displayed + (cj/warning--display-buffer-if-live (car rec) buf))) + (should (equal (list buf) (car (cdr rec))))) + (kill-buffer buf)))) + +(ert-deftest test-system-defaults-warning-guard-is-installed () + "Normal: loading system-defaults installs the guard on the deferred display. +From Emacs 31 the advised symbol must actually be defined: pending advice on +an undefined symbol would still count as installed, so a rename upstream +would otherwise silently disable the backstop." + (should (advice-member-p #'cj/warning--display-buffer-if-live + 'warning--display-buffer)) + (when (>= emacs-major-version 31) + (should (fboundp 'warning--display-buffer)))) + +(ert-deftest test-system-defaults-warning-guard-resolves-live-buffer-name () + "Normal: a live buffer's name is resolved and passed through as the buffer." + (let* ((rec (test-system-defaults--recording-orig)) + (buf (generate-new-buffer " *warning-guard-named*"))) + (unwind-protect + (progn + (should (eq 'displayed + (cj/warning--display-buffer-if-live + (car rec) (buffer-name buf)))) + (should (equal (list buf) (car (cdr rec))))) + (kill-buffer buf)))) + +;;; Boundary Cases + +(ert-deftest test-system-defaults-warning-guard-skips-killed-buffer () + "Boundary: a killed buffer never reaches the original; result is nil." + (let* ((rec (test-system-defaults--recording-orig)) + (buf (generate-new-buffer " *warning-guard-dead*"))) + (kill-buffer buf) + (should-not (cj/warning--display-buffer-if-live (car rec) buf)) + (should-not (car (cdr rec))))) + +(ert-deftest test-system-defaults-warning-guard-end-to-end-dead-buffer-does-not-signal () + "Boundary: the real deferred display survives a dead buffer. +Mirrors the live failure: a string condition in `display-buffer-alist' is +what `buffer-match-p' tripped over when the buffer name came back nil." + (skip-unless (fboundp 'warning--display-buffer)) + (let ((buf (generate-new-buffer "*Warnings*")) + (display-buffer-alist '(("^ \\*test-guard\\*" display-buffer-no-window)))) + (kill-buffer buf) + (should-not (warning--display-buffer buf)))) + +;;; Error Cases + +(ert-deftest test-system-defaults-warning-guard-rejects-non-buffer () + "Error: nil, or a name that resolves to no buffer, is skipped without a signal." + (let ((rec (test-system-defaults--recording-orig)) + (missing " *warning-guard-no-such-buffer*")) + (when (get-buffer missing) (kill-buffer missing)) + (should-not (cj/warning--display-buffer-if-live (car rec) nil)) + (should-not (cj/warning--display-buffer-if-live (car rec) missing)) + (should-not (car (cdr rec))))) + +(provide 'test-system-defaults--warning-display-dead-buffer) +;;; test-system-defaults--warning-display-dead-buffer.el ends here diff --git a/tests/test-system-defaults-functions.el b/tests/test-system-defaults-functions.el index 4b647166..09bf9f2a 100644 --- a/tests/test-system-defaults-functions.el +++ b/tests/test-system-defaults-functions.el @@ -55,6 +55,12 @@ ;; so it doesn't leak into a shared batch session. `make test-name' loads ;; every test file into one Emacs; a leaked cwd there breaks the relative ;; loads of every file that follows. +;; Declared special before the `let' below binds it: this file is lexical, +;; so without the defvar the binding is a lexical local, and use-package's +;; own `defcustom' then fails with "Defining as dynamic an already lexical +;; var" (fatal at load since 31.1 moved the defcustom to autoload time). +(defvar use-package-always-ensure) + (let ((default-directory default-directory) (use-package-always-ensure nil)) (cl-letf (((symbol-function 'server-running-p) (lambda (&rest _) t)) diff --git a/tests/test-system-lib-auth-source-secret-value.el b/tests/test-system-lib-auth-source-secret-value.el index ec526cec..27a2696b 100644 --- a/tests/test-system-lib-auth-source-secret-value.el +++ b/tests/test-system-lib-auth-source-secret-value.el @@ -63,5 +63,44 @@ Captures the call args in `test-ass--args'." (test-ass--with-search (list (list :host "h")) (should (null (cj/auth-source-secret-value "h"))))) +;;; Error + +(ert-deftest test-auth-source-secret-value-loads-auth-source-when-absent () + "Error: with `auth-source-search' unavailable, the helper loads auth-source. + +Under `emacs --batch -Q' nothing else pulls auth-source in, so a helper +carrying only a `declare-function' dies with a void-function on the first +lookup. An interactive Emacs hides this completely -- something in init +always has auth-source loaded by the time anyone calls here -- which is why +it surfaced only on the batch calendar sync, and only on the machine whose +feeds resolve through `:secret-host' rather than an inline URL. + +The stubbed `require' installs the entry point the way loading auth-source.el +would, so the call can complete and the return value is checked too." + (let ((required nil)) + (cl-letf (((symbol-function 'auth-source-search) nil) + ((symbol-function 'require) + (lambda (feature &rest _) + (push feature required) + (fset 'auth-source-search + (lambda (&rest _) (list (list :secret "loaded")))) + feature))) + (should (equal "loaded" (cj/auth-source-secret-value "h"))) + (should (memq 'auth-source required))))) + +(ert-deftest test-auth-source-secret-value-does-not-reload-when-present () + "Error: an available `auth-source-search' is used as-is, never re-required. + +An unconditional `require' re-loads auth-source.el over whatever is in place, +replacing a caller's stub mid-call -- which sent a test that meant to fake the +lookup out to the real authinfo, where it hung for twelve seconds on gpg." + (let ((required nil)) + (cl-letf (((symbol-function 'require) + (lambda (feature &rest _) (push feature required) feature)) + ((symbol-function 'auth-source-search) + (lambda (&rest _) (list (list :secret "stubbed"))))) + (should (equal "stubbed" (cj/auth-source-secret-value "h"))) + (should-not (memq 'auth-source required))))) + (provide 'test-system-lib-auth-source-secret-value) ;;; test-system-lib-auth-source-secret-value.el ends here diff --git a/tests/test-system-lib-confirm-destructive.el b/tests/test-system-lib-confirm-destructive.el new file mode 100644 index 00000000..4fc96e21 --- /dev/null +++ b/tests/test-system-lib-confirm-destructive.el @@ -0,0 +1,141 @@ +;;; test-system-lib-confirm-destructive.el --- Tests for cj/confirm-destructive -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for `cj/confirm-destructive', the confirmation used for +;; irreversible actions: file destruction, overwrites, power-off. +;; +;; The contract has two halves, and they pull against each other: +;; +;; 1. One keystroke. This replaced a typed-"yes" prompt on 2026-07-31, after +;; one became unanswerable -- a second agent session held the selected +;; window while the prompt waited in another frame, so keystrokes went to a +;; terminal and the Emacs session had to be killed with buffers unsaved. A +;; long-form prompt is only as safe as it is answerable. +;; +;; 2. No default. Only y and n answer. A stray RET or space re-prompts +;; instead of confirming, which is the accidental-confirm protection the +;; long form existed for, and it survives the change. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'system-lib) + +;;; Normal Cases + +(ert-deftest test-system-lib-confirm-destructive-returns-t-on-y () + "Normal: a y answer confirms." + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y))) + (should (eq (cj/confirm-destructive "Really? ") t)))) + +(ert-deftest test-system-lib-confirm-destructive-returns-nil-on-n () + "Normal: an n answer declines." + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?n))) + (should (eq (cj/confirm-destructive "Really? ") nil)))) + +;;; Boundary Cases + +(ert-deftest test-system-lib-confirm-destructive-accepts-uppercase () + "Boundary: a capital Y confirms and a capital N declines, so the answer +does not depend on the shift key or caps lock." + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?Y))) + (should (eq (cj/confirm-destructive "Really? ") t))) + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?N))) + (should (eq (cj/confirm-destructive "Really? ") nil)))) + +(ert-deftest test-system-lib-confirm-destructive-offers-only-y-and-n () + "Boundary: RET, space and every other key are refused. + +This is the protection that justified the old typed-\"yes\" form, kept now +that the answer is a single keystroke. Asserted on the character set handed +to `read-char-choice', which is what actually decides, rather than on the +prompt text, which only describes." + (let (chars) + (cl-letf (((symbol-function 'read-char-choice) + (lambda (_prompt cs &rest _) (setq chars cs) ?n))) + (cj/confirm-destructive "Really? ")) + (should (equal (sort (copy-sequence chars) #'<) '(?N ?Y ?n ?y))) + (should-not (memq ?\r chars)) + (should-not (memq ?\n chars)) + (should-not (memq ?\s chars)))) + +(ert-deftest test-system-lib-confirm-destructive-is-single-keystroke () + "Boundary: it never routes through `yes-or-no-p'. + +The regression this file guards. Binding `use-short-answers' to nil for the +call, which is what the old implementation did, is exactly the shape that +produced an unanswerable prompt." + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) (error "must not demand a typed yes")))) + (should (eq (cj/confirm-destructive "Really? ") t)))) + +(ert-deftest test-system-lib-confirm-destructive-ignores-short-answer-setting () + "Boundary: the answer is one key whether or not `use-short-answers' is set. +The global default is t, but nothing about this prompt should depend on it." + (dolist (setting '(t nil)) + (let ((use-short-answers setting)) + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) (error "must not demand a typed yes")))) + (should (eq (cj/confirm-destructive "Really? ") t)))))) + +(ert-deftest test-system-lib-confirm-destructive-discards-type-ahead () + "Boundary: pending input is discarded before the key is read. + +The regression that made this necessary. `read-char-choice' reads the input +queue, so a key typed before the prompt appeared would answer it: a queued y +would confirm a shutdown or a file deletion instantly. The typed-\"yes\" +form absorbed such a key harmlessly, so dropping it without this guard would +have traded a rare annoyance for a rare catastrophe. + +Asserted on ordering, since that is the whole property: the discard has to +happen before the read, not merely somewhere in the function." + (let ((events '())) + (cl-letf (((symbol-function 'discard-input) + (lambda (&rest _) (push 'discard events) nil)) + ((symbol-function 'read-char-choice) + (lambda (&rest _) (push 'read events) ?y))) + (should (eq (cj/confirm-destructive "Really? ") t))) + (should (equal (nreverse events) '(discard read))))) + +;;; Error Cases + +(ert-deftest test-system-lib-confirm-destructive-declines-on-other-char () + "Error: anything that is not y or n declines rather than confirming. + +`read-char-choice' normally loops until it gets a listed character, but it +can return outside the set -- `read-char-from-minibuffer' yields RET when the +minibuffer result is empty. On an irreversible action the safe reading of an +unexpected answer is no." + (dolist (ch (list ?\r ?\n ?\s ?q ?\C-m)) + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ch))) + (should-not (cj/confirm-destructive "Really? "))))) + +(ert-deftest test-system-lib-confirm-destructive-propagates-quit () + "Error: C-g aborts the caller rather than reading as a confirmation. +Swallowing the quit here would turn an abort into a yes on an irreversible +action." + (cl-letf (((symbol-function 'read-char-choice) + (lambda (&rest _) (signal 'quit nil)))) + ;; `should-error' cannot express this: quit is not an error, so ERT lets + ;; it through and reports the test as QUIT rather than passed. Catching + ;; it here is what makes the assertion a real pass or fail. + (should (eq 'quit (condition-case nil + (progn (cj/confirm-destructive "Really? ") + 'returned-normally) + (quit 'quit)))))) + +(ert-deftest test-system-lib-confirm-destructive-prompt-shows-choices () + "Error: the prompt names the keys that answer, so an unfamiliar prompt is +not a guessing game." + (let (prompt) + (cl-letf (((symbol-function 'read-char-choice) + (lambda (p &rest _) (setq prompt p) ?n))) + (cj/confirm-destructive "Delete everything? ")) + (should (string-match-p "Delete everything\\?" prompt)) + (should (string-match-p "y or n" prompt)))) + +(provide 'test-system-lib-confirm-destructive) +;;; test-system-lib-confirm-destructive.el ends here diff --git a/tests/test-system-lib-confirm-strong.el b/tests/test-system-lib-confirm-strong.el deleted file mode 100644 index 26c00822..00000000 --- a/tests/test-system-lib-confirm-strong.el +++ /dev/null @@ -1,37 +0,0 @@ -;;; test-system-lib-confirm-strong.el --- Tests for cj/confirm-strong -*- lexical-binding: t; -*- - -;;; Commentary: -;; ERT tests for `cj/confirm-strong', the typed-"yes" confirmation used for -;; irreversible actions. The behavior under test is the long-form guarantee: -;; the prompt demands a typed yes/no even when the global single-key default -;; (`use-short-answers') is in effect. - -;;; Code: - -(require 'ert) -(require 'cl-lib) -(require 'system-lib) - -(ert-deftest test-system-lib-confirm-strong-returns-t-on-yes () - "Normal: passes a t answer through from `yes-or-no-p'." - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))) - (should (eq (cj/confirm-strong "Really? ") t)))) - -(ert-deftest test-system-lib-confirm-strong-returns-nil-on-no () - "Normal: passes a nil answer through from `yes-or-no-p'." - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil))) - (should (eq (cj/confirm-strong "Really? ") nil)))) - -(ert-deftest test-system-lib-confirm-strong-forces-long-form () - "Boundary: binds `use-short-answers' to nil for the call even when it is -globally t, so the irreversible prompt requires a typed yes/no regardless of -the single-key default." - (let ((use-short-answers t) - (seen 'unset)) - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (&rest _) (setq seen use-short-answers) t))) - (cj/confirm-strong "Really? ") - (should (eq seen nil))))) - -(provide 'test-system-lib-confirm-strong) -;;; test-system-lib-confirm-strong.el ends here diff --git a/tests/test-telega-config--docker-pin.el b/tests/test-telega-config--docker-pin.el index 894dbfdd..8f5b62bd 100644 --- a/tests/test-telega-config--docker-pin.el +++ b/tests/test-telega-config--docker-pin.el @@ -5,9 +5,15 @@ ;; ;; telega infers its image from `telega-tdlib-min-version' and only pins to a ;; version tag when min and max versions are equal and the version ends in -;; ".0". This config has min "1.8.64" and max nil, so the inference always +;; ".0". This config has min "1.8.66" and max nil, so the inference always ;; falls through to "zevlg/telega-server:latest" -- a moving tag that can ;; swap the server out from under a fixed elisp version without notice. +;; +;; Since 2026-08-25 the pin names an image built locally from +;; docker/telega-server/Dockerfile (upstream's image is missing a shared +;; library, zevlg/telega.el#596). Three files have to agree on that image: +;; the defcustom default, the Makefile's build tag, and the Dockerfile's +;; digest-pinned base. The tests below hold them together. ;;; Code: @@ -17,6 +23,18 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'telega-config) +(defun test-telega-config--file-string (relative) + "Return the contents of RELATIVE under `user-emacs-directory'." + (with-temp-buffer + (insert-file-contents (expand-file-name relative user-emacs-directory)) + (buffer-string))) + +(defun test-telega-config--pin-default () + "Return the defcustom's shipped default, not the live value. +Customizing the pin (including to nil) is not a test failure; only +changing the shipped default is." + (eval (car (get 'cj/telega-docker-image 'standard-value)) t)) + ;; -- cj/--telega-docker-pinned-image ----------------------------------------- (ert-deftest test-telega-config-pin-returns-configured-reference () @@ -77,17 +95,118 @@ name, so this stays a reversible setting." "Normal: the advice is a named function so it can be removed by reference." (should (fboundp 'cj/--telega-docker-image-name))) -(ert-deftest test-telega-config-pin-default-is-a-digest-reference () - "Normal: the shipped default pins by digest, not by a floating tag. -A tag pin (:latest, or even a version tag upstream can re-push) still -moves; a digest names one immutable image. - -Reads the defcustom's standard value rather than the live variable, so -customizing the pin (including to nil, handing the choice back to telega) -is not a test failure -- only changing the shipped default is." - (let ((default (eval (car (get 'cj/telega-docker-image 'standard-value)) t))) +;; -- the shipped default and the files it depends on ------------------------- + +(ert-deftest test-telega-config-pin-default-matches-makefile-build-tag () + "Normal: the default pin is exactly the tag `make telega-image' builds. +The image is built locally, so the pin is a tag rather than a registry +digest. The Makefile owns the tag; the defcustom must name the same one +or a fresh machine builds an image telega never looks for." + (let ((makefile (test-telega-config--file-string "Makefile"))) + (should (string-match "^TELEGA_IMAGE[ \t]*[?:]?=[ \t]*\\([^ \t\n]+\\)" makefile)) + (should (equal (test-telega-config--pin-default) + (match-string 1 makefile))))) + +(ert-deftest test-telega-config-pin-default-is-a-local-tag-not-a-digest () + "Boundary: the default is a plain tag, with no registry digest suffix. +A locally built image has no RepoDigest, so a digest reference here could +never resolve." + (let ((default (test-telega-config--pin-default))) (should (stringp default)) - (should (string-match-p "@sha256:[0-9a-f]\\{64\\}\\'" default)))) + (should (string-match-p "\\`[a-z0-9./-]+:[A-Za-z0-9._-]+\\'" default)) + (should-not (string-match-p "@sha256:" default)))) + +(ert-deftest test-telega-config-dockerfile-pins-base-image-by-digest () + "Normal: the Dockerfile's base is an immutable upstream digest. +This is where the digest guarantee the old pin gave now lives. A tag in +the FROM line would let upstream swap the base under a rebuild." + (let ((dockerfile (test-telega-config--file-string "docker/telega-server/Dockerfile"))) + (should (string-match-p + "^FROM zevlg/telega-server@sha256:[0-9a-f]\\{64\\}[ \t]*$" + dockerfile)))) + +(ert-deftest test-telega-config-dockerfile-adds-the-missing-library () + "Normal: the Dockerfile installs libglycin, the whole reason it exists. +Upstream's image fails to start without it (zevlg/telega.el#596)." + (let ((dockerfile (test-telega-config--file-string "docker/telega-server/Dockerfile"))) + (should (string-match-p "^RUN apk add .*libglycin" dockerfile)))) + +;; -- cj/--telega-docker-image-present-p (the docker boundary) ---------------- +;; Exercised against a fake `docker' executable on a private exec-path rather +;; than by mocking `call-process' (a subr; see the native-comp mocking gotcha). + +(defun test-telega-config--with-fake-docker (exit-code thunk) + "Call THUNK with a fake `docker' on `exec-path' that exits EXIT-CODE." + (let* ((dir (make-temp-file "fake-docker-" t)) + (script (expand-file-name "docker" dir))) + (unwind-protect + (progn + (with-temp-file script + (insert (format "#!/bin/sh\nexit %d\n" exit-code))) + (set-file-modes script #o700) + (let ((exec-path (list dir))) + (funcall thunk))) + (delete-directory dir t)))) + +(ert-deftest test-telega-config-image-present-p-true-when-inspect-succeeds () + "Normal: `docker image inspect' exiting 0 means the image is present." + (test-telega-config--with-fake-docker 0 + (lambda () (should (cj/--telega-docker-image-present-p "cj/telega-server:x"))))) + +(ert-deftest test-telega-config-image-present-p-nil-when-inspect-fails () + "Boundary: a non-zero exit (no such image) reads as not present." + (test-telega-config--with-fake-docker 1 + (lambda () (should-not (cj/--telega-docker-image-present-p "cj/telega-server:x"))))) + +(ert-deftest test-telega-config-image-present-p-nil-without-docker () + "Error: with no docker on `exec-path', the helper returns nil instead of +signalling, so the launcher can still route the user to the make target." + (let ((exec-path nil)) + (should-not (cj/--telega-docker-image-present-p "cj/telega-server:x")))) + +;; -- cj/telega refuses to launch against a missing local image --------------- + +(ert-deftest test-telega-config-missing-image-message-names-image-and-target () + "Normal: the message names the missing image and the make target that builds it." + (let ((msg (cj/--telega-missing-image-message "cj/telega-server:x"))) + (should (string-match-p "cj/telega-server:x" msg)) + (should (string-match-p "make telega-image" msg)))) + +(ert-deftest test-telega-config-launcher-errors-when-pinned-image-is-absent () + "Error: with a pin set and no such image, `cj/telega' stops with the make hint. +Without this, docker fails to pull a local-only tag and the error names a +registry the image was never meant to come from." + (let ((cj/telega-docker-image "cj/telega-server:x") + (launched nil)) + (cl-letf (((symbol-function 'locate-library) (lambda (&rest _) "telega.el")) + ((symbol-function 'cj/--telega-docker-image-present-p) (lambda (_) nil)) + ((symbol-function 'telega) (lambda (&rest _) (setq launched t)))) + (let ((err (should-error (cj/telega) :type 'user-error))) + (should (string-match-p "make telega-image" (cadr err)))) + (should-not launched)))) + +(ert-deftest test-telega-config-launcher-runs-when-pinned-image-is-present () + "Normal: with the pinned image present, `cj/telega' launches telega." + (let ((cj/telega-docker-image "cj/telega-server:x") + (launched nil)) + (cl-letf (((symbol-function 'locate-library) (lambda (&rest _) "telega.el")) + ((symbol-function 'cj/--telega-docker-image-present-p) (lambda (_) t)) + ((symbol-function 'telega) (lambda (&rest _) (setq launched t)))) + (cj/telega) + (should launched)))) + +(ert-deftest test-telega-config-launcher-skips-image-check-without-a-pin () + "Boundary: with no pin, telega infers and pulls its own image; no check runs." + (let ((cj/telega-docker-image nil) + (checked nil) + (launched nil)) + (cl-letf (((symbol-function 'locate-library) (lambda (&rest _) "telega.el")) + ((symbol-function 'cj/--telega-docker-image-present-p) + (lambda (_) (setq checked t) nil)) + ((symbol-function 'telega) (lambda (&rest _) (setq launched t)))) + (cj/telega) + (should-not checked) + (should launched)))) (provide 'test-telega-config--docker-pin) ;;; test-telega-config--docker-pin.el ends here diff --git a/tests/test-telega-config.el b/tests/test-telega-config.el index d8aaeb4d..54a601c9 100644 --- a/tests/test-telega-config.el +++ b/tests/test-telega-config.el @@ -45,6 +45,10 @@ stub's cryptic load-file failure." (let (called) (cl-letf (((symbol-function 'featurep) (lambda (sym &optional _sub) (eq sym 'telega))) + ;; The pinned image is a local build; treat it as present so + ;; this test stays about delegation, not the image check. + ((symbol-function 'cj/--telega-docker-image-present-p) + (lambda (_) t)) ((symbol-function 'telega) (lambda (&rest _) (setq called t)))) (cj/telega)) diff --git a/tests/test-term-tmux-detach.el b/tests/test-term-tmux-detach.el new file mode 100644 index 00000000..9bd94776 --- /dev/null +++ b/tests/test-term-tmux-detach.el @@ -0,0 +1,62 @@ +;;; test-term-tmux-detach.el --- Tests for cj/term-tmux-detach -*- lexical-binding: t; -*- + +;;; Commentary: +;; A keyboard C-b inside the Claude Code pane does not reach tmux as a prefix +;; (it lands as stray text), so detaching needs the same pty string path +;; `cj/term-copy-mode-dwim' uses for C-b [. These tests pin that path and +;; the no-tmux fallback. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'package) + +;; Same shape as test-term-tmux-history.el: `make test' runs with no +;; package-initialize, so eat has to be made loadable here before eat-config. +(setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) +(package-initialize) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(setq load-prefer-newer t) +(require 'eat) +(require 'eat-config) + +(ert-deftest test-eat-config-tmux-detach-sends-prefix-and-d-when-attached () + "Normal: with tmux attached, the command writes C-b d into the pty, nothing else." + (let ((sent nil)) + (cl-letf (((symbol-function 'cj/term--in-tmux-p) (lambda () t)) + ((symbol-function 'cj/--term-send-string) (lambda (s) (push s sent)))) + (cj/term-tmux-detach) + (should (equal sent '("\C-bd")))))) + +(ert-deftest test-eat-config-tmux-detach-does-nothing-without-tmux () + "Boundary: with no tmux client, nothing is written and the user is told why. +Writing C-b d into a plain shell would type a control character into it." + (let ((sent nil) + (told nil)) + (cl-letf (((symbol-function 'cj/term--in-tmux-p) (lambda () nil)) + ((symbol-function 'cj/--term-send-string) (lambda (s) (push s sent))) + ((symbol-function 'message) (lambda (fmt &rest args) + (setq told (apply #'format fmt args))))) + (cj/term-tmux-detach) + (should-not sent) + (should (string-match-p "tmux" told))))) + +(ert-deftest test-eat-config-tmux-detach-survives-dead-process () + "Error: with tmux reported attached but no live pty, the command returns +without signalling. `cj/--term-send-string' already guards on +`process-live-p'; this pins that the detach path relies on it rather than +calling `process-send-string' directly." + (with-temp-buffer + (cl-letf (((symbol-function 'cj/term--in-tmux-p) (lambda () t))) + (should-not (condition-case err + (progn (cj/term-tmux-detach) nil) + (error err)))))) + +(ert-deftest test-eat-config-tmux-detach-bound-on-term-map () + "Normal: the command sits on the terminal map next to copy-mode (\"c\")." + (should (eq (keymap-lookup cj/term-map "d") #'cj/term-tmux-detach))) + +(provide 'test-term-tmux-detach) +;;; test-term-tmux-detach.el ends here diff --git a/tests/test-undead-buffers--native-comp-log-undead.el b/tests/test-undead-buffers--native-comp-log-undead.el new file mode 100644 index 00000000..dee9a134 --- /dev/null +++ b/tests/test-undead-buffers--native-comp-log-undead.el @@ -0,0 +1,92 @@ +;;; test-undead-buffers--native-comp-log-undead.el --- the native-comp log survives the sweep -*- lexical-binding: t; -*- + +;;; Commentary: +;; Async native compilation parks every worker process on one buffer, +;; `comp-async-buffer-name' (*Async-native-compile-log*), and the worker's +;; sentinel reads that buffer back before it starts the next job. Killing +;; the buffer sends SIGHUP to every worker under it (they are :noquery, so +;; nothing asks), each sentinel then dies in `with-current-buffer' on the +;; dead buffer, and `comp--run-async-workers' is never called again: the +;; queue is stranded for the life of the daemon and nothing is ever cached. +;; +;; `cj/dashboard-only' on `emacs-startup-hook' runs +;; `cj/kill-all-other-buffers-and-windows', which is exactly such a sweep, +;; and in a real daemon `dashboard-insert-startupify-lists' has already +;; created *dashboard* on `after-init-hook', so the sweep branch is the one +;; that runs. These tests pin the log buffer to the undead list so the +;; sweep buries it and the workers live. The fixture puts a live :noquery +;; process on the buffer, because that is the state the bug needs; a plain +;; buffer would survive a kill-and-recreate just the same. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'undead-buffers) + +(defconst test-undead--comp-log "*Async-native-compile-log*") + +(defun test-undead--make-sleeper (buffer) + "Start a quiet, long-lived process attached to BUFFER and return it." + (make-process :name "test-undead-sleeper" :buffer buffer + :command '("sleep" "30") :noquery t)) + +(defun test-undead--settle () + "Let any signal the sweep sent land before liveness is observed." + (let ((deadline (+ (float-time) 0.3))) + (while (< (float-time) deadline) + (accept-process-output nil 0.05)))) + +;;; Normal Cases + +(ert-deftest test-undead-buffers-native-comp-log-is-undead-by-default () + "Normal: the module's default list makes the async-compile log bury-only." + (should (member test-undead--comp-log cj/undead-buffer-list)) + (should (cj/--buffer-undead-p test-undead--comp-log))) + +(ert-deftest test-undead-buffers-native-comp-log-name-matches-comp-run () + "Normal: the pinned name is the one comp-run actually uses. +A rename upstream would silently reopen the bug, so pin it to the variable." + (skip-unless (require 'comp-run nil t)) + (should (equal comp-async-buffer-name test-undead--comp-log))) + +(ert-deftest test-undead-buffers-native-comp-log-workers-survive-sweep () + "Normal: a worker parked on the log buffer is still running after the sweep. +The positive control is an ordinary process buffer, which the sweep kills +out from under its process -- that is what happened to the workers without +the undead entry. The control's process is not asserted dead: killing the +buffer sends SIGHUP, and a launching shell that ignores SIGHUP (nohup) hands +that disposition down, so its death is not deterministic across harnesses." + (skip-unless (executable-find "sleep")) + (delete-other-windows) + (let* ((main (current-buffer)) + (existing (get-buffer test-undead--comp-log)) + (log (or existing (get-buffer-create test-undead--comp-log))) + (victim (generate-new-buffer "*test-sweep-victim*")) + (worker (test-undead--make-sleeper log)) + (control (test-undead--make-sleeper victim))) + (unwind-protect + (progn + (cj/kill-all-other-buffers-and-windows) + (test-undead--settle) + (should (buffer-live-p main)) + (should (buffer-live-p log)) + (should (process-live-p worker)) + (should-not (buffer-live-p victim))) + (when (process-live-p worker) (delete-process worker)) + (when (process-live-p control) (delete-process control)) + (when (buffer-live-p victim) (kill-buffer victim)) + ;; Only remove what this test created. `kill-buffer' the function is + ;; not the remapped command, so the undead list doesn't apply. + (when (and (not existing) (buffer-live-p log)) (kill-buffer log)) + (delete-other-windows)))) + +;;; Boundary Cases + +(ert-deftest test-undead-buffers-native-comp-log-match-is-exact () + "Boundary: only the exact name is undead; a uniquified copy is not." + (should-not (cj/--buffer-undead-p "*Async-native-compile-log*<2>")) + (should-not (cj/--buffer-undead-p " *Async-native-compile-log*"))) + +(provide 'test-undead-buffers--native-comp-log-undead) +;;; test-undead-buffers--native-comp-log-undead.el ends here diff --git a/tests/test-undead-buffers--warnings-undead.el b/tests/test-undead-buffers--warnings-undead.el new file mode 100644 index 00000000..858dbf76 --- /dev/null +++ b/tests/test-undead-buffers--warnings-undead.el @@ -0,0 +1,63 @@ +;;; test-undead-buffers--warnings-undead.el --- *Warnings* survives the buffer sweep -*- lexical-binding: t; -*- + +;;; Commentary: +;; Emacs 31.1's warnings.el defers daemon-startup warnings into a one-shot +;; `after-make-frame-functions' closure that holds the *Warnings* buffer +;; object and displays it on the first client frame. Killing that buffer +;; during startup leaves the closure holding a dead buffer, `display-buffer' +;; then signals inside `make-frame', server.el reports the window system as +;; unsupported, and emacsclient silently retries on $DISPLAY -- the first +;; frame of the session lands on XWayland instead of Wayland. +;; +;; `cj/dashboard-only' on `emacs-startup-hook' runs +;; `cj/kill-all-other-buffers-and-windows', which is exactly such a sweep. +;; These tests pin *Warnings* to the undead list so the sweep buries it +;; instead of killing it. Error-path coverage of the predicate itself (a nil +;; or non-string name) lives in test-undead-buffers--buffer-undead-p.el. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'undead-buffers) + +;;; Normal Cases + +(ert-deftest test-undead-buffers-warnings-is-undead-by-default () + "Normal: the module's default list makes *Warnings* bury-only." + (should (member "*Warnings*" cj/undead-buffer-list)) + (should (cj/--buffer-undead-p "*Warnings*"))) + +(ert-deftest test-undead-buffers-warnings-survives-kill-all-other-buffers () + "Normal: the startup sweep buries *Warnings* rather than killing it. +This is the sweep `cj/dashboard-only' runs from `emacs-startup-hook'." + (delete-other-windows) + (unwind-protect + (let* ((main (current-buffer)) + (existing (get-buffer "*Warnings*")) + (warnings (or existing (get-buffer-create "*Warnings*"))) + (victim (generate-new-buffer "*test-sweep-victim*"))) + (unwind-protect + (progn + (cj/kill-all-other-buffers-and-windows) + (should (buffer-live-p main)) + (should (buffer-live-p warnings)) + (should-not (buffer-live-p victim))) + (when (buffer-live-p victim) (kill-buffer victim)) + ;; Only remove what this test created. `kill-buffer' the function + ;; is not the remapped command, so the undead list doesn't apply. + (when (and (not existing) (buffer-live-p warnings)) + (kill-buffer warnings)))) + (delete-other-windows))) + +;;; Boundary Cases + +(ert-deftest test-undead-buffers-warnings-match-is-exact () + "Boundary: only the exact name is undead; a uniquified *Warnings*<2> is not. +The list matches exact names, so a second warnings buffer made by +`generate-new-buffer' is an ordinary buffer to the sweep." + (should-not (cj/--buffer-undead-p "*Warnings*<2>")) + (should-not (cj/--buffer-undead-p " *Warnings*"))) + +(provide 'test-undead-buffers--warnings-undead) +;;; test-undead-buffers--warnings-undead.el ends here diff --git a/tests/test-video-audio-recording--keybindings.el b/tests/test-video-audio-recording--keybindings.el new file mode 100644 index 00000000..cdb6493a --- /dev/null +++ b/tests/test-video-audio-recording--keybindings.el @@ -0,0 +1,130 @@ +;;; test-video-audio-recording--keybindings.el --- recording toggle keybinding placement -*- lexical-binding: t; -*- + +;;; Commentary: +;; The two recording toggles get a fast chord alongside the C-; r prefix: F9 +;; starts/stops video, S-F9 starts/stops audio. +;; +;; Reaching them from inside an EAT buffer turns on which key categories each +;; input mode claims. Semi-char mode -- the default, and where agent buffers +;; sit -- is built from (:ascii :arrow :navigation) and never claims function +;; keys, so F9 already fell through to the global map there. Char mode adds +;; :function, binding f1 through f63 to `eat-self-input', and it is a minor +;; mode, so its map outranks `eat-mode-map'. The char-mode entries are the +;; load-bearing ones; the semi-char entry is belt-and-braces. +;; +;; :function claims only the unmodified keys, which is why getting this wrong +;; split the pair rather than breaking it outright: S-F9 toggled audio in a +;; char-mode buffer while F9 went to the program under the cursor. +;; +;; These tests require eat first so the module's `with-eval-after-load' fires. +;; The char-mode cases resolve through `key-binding' in a fixture that +;; reproduces minor-mode precedence, because reading a binding back out of the +;; map the module just wrote proves nothing about which map wins on a keypress. + +;;; Code: + +(require 'ert) +(require 'package) + +(setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) +(package-initialize) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'eat) +(require 'video-audio-recording) + +;;; Normal + +(ert-deftest test-video-audio-recording-f9-bound-globally () + "Normal: F9 toggles video recording, S-F9 toggles audio recording." + (should (eq (lookup-key (current-global-map) (kbd "<f9>")) + #'cj/video-recording-toggle)) + (should (eq (lookup-key (current-global-map) (kbd "S-<f9>")) + #'cj/audio-recording-toggle))) + +(ert-deftest test-video-audio-recording-f9-bound-in-eat-semi-char-mode-map () + "Normal: both chords are bound in `eat-semi-char-mode-map'. +Redundant rather than load-bearing: semi-char is built without :function, so a +function key already falls through to the global map. Asserted anyway so the +entry cannot be dropped silently while the comment explaining it stays." + (should (eq (keymap-lookup eat-semi-char-mode-map "<f9>") + #'cj/video-recording-toggle)) + (should (eq (keymap-lookup eat-semi-char-mode-map "S-<f9>") + #'cj/audio-recording-toggle))) + +(ert-deftest test-video-audio-recording-f9-bound-in-eat-mode-map () + "Normal: both chords are bound in `eat-mode-map', the major-mode map every +EAT buffer carries regardless of input mode." + (should (eq (keymap-lookup eat-mode-map "<f9>") + #'cj/video-recording-toggle)) + (should (eq (keymap-lookup eat-mode-map "S-<f9>") + #'cj/audio-recording-toggle))) + +(ert-deftest test-video-audio-recording-f9-bound-in-eat-char-mode-maps () + "Normal: both chords are bound in the two char-mode maps. +Char mode is built with EAT's :function category, which binds f1 through f63 +to `eat-self-input'. These entries are what override that." + (dolist (map (list eat-char-mode-map eat-eshell-char-mode-map)) + (should (eq (keymap-lookup map "<f9>") #'cj/video-recording-toggle)) + (should (eq (keymap-lookup map "S-<f9>") #'cj/audio-recording-toggle)))) + +;;; Boundary + +(ert-deftest test-video-audio-recording-f9-chords-are-distinct () + "Boundary: the shifted and unshifted chords resolve to different commands. +A copy-paste binding both to the same toggle would satisfy every +binding-is-present assertion above, so assert the difference directly." + (should-not (eq (lookup-key (current-global-map) (kbd "<f9>")) + (lookup-key (current-global-map) (kbd "S-<f9>"))))) + +(defun test-video-audio-recording--in-char-mode (body) + "Run BODY in a buffer wired the way a live EAT char-mode buffer is. +`eat--char-mode' is a minor mode, so its map is consulted ahead of the +major-mode map. Reproducing that ordering is the point: reading a binding +back out of the map the module just wrote proves nothing about which map wins +when a key is actually pressed." + (with-temp-buffer + (use-local-map eat-mode-map) + (let ((minor-mode-overriding-map-alist + (list (cons 'eat--char-mode eat-char-mode-map))) + (eat--char-mode t)) + (funcall body)))) + +(ert-deftest test-video-audio-recording-f9-resolves-in-char-mode () + "Boundary: both chords resolve to the toggles through the real precedence +chain in a char-mode buffer. Before this override F9 resolved to +`eat-self-input' and went to the program under the cursor, while S-F9 reached +Emacs — so the pair silently split, audio recording and video not." + (test-video-audio-recording--in-char-mode + (lambda () + (should (eq (key-binding (kbd "<f9>")) #'cj/video-recording-toggle)) + (should (eq (key-binding (kbd "S-<f9>")) #'cj/audio-recording-toggle))))) + +;;; Error + +(ert-deftest test-video-audio-recording-char-mode-fixture-really-is-char-mode () + "Error (positive control): the char-mode fixture genuinely puts EAT's map in +front. F8 sits in the same :function category as F9 and this module never +touches it, so it must still reach `eat-self-input'. If it resolves anywhere +else the fixture is inert, and the resolution test above would pass without +ever consulting `eat-char-mode-map' — which is precisely how the first cut of +this file missed that F9 was being swallowed there." + (test-video-audio-recording--in-char-mode + (lambda () + (should (eq (key-binding (kbd "<f8>")) #'eat-self-input))))) + +(ert-deftest test-video-audio-recording-f9-targets-are-commands () + "Error: a key bound to a non-interactive function fails at press time with a +`commandp' error rather than at load, so assert both targets are real commands." + (should (commandp (lookup-key (current-global-map) (kbd "<f9>")))) + (should (commandp (lookup-key (current-global-map) (kbd "S-<f9>"))))) + +(ert-deftest test-video-audio-recording-prefix-bindings-still-reachable () + "Error/regression (positive control): the fast chords must not disturb the +C-; r prefix path. Without this, deleting the prefix map outright would leave +every assertion above green." + (should (eq (keymap-lookup cj/record-map "v") #'cj/video-recording-toggle)) + (should (eq (keymap-lookup cj/record-map "a") #'cj/audio-recording-toggle)) + (should (eq (keymap-lookup cj/custom-keymap "r") cj/record-map))) + +(provide 'test-video-audio-recording--keybindings) +;;; test-video-audio-recording--keybindings.el ends here |