diff options
147 files changed, 4966 insertions, 1979 deletions
@@ -108,3 +108,5 @@ todo.org # Claude Code: task archive (follows todo file privacy) /archive/task-archive.org +takuzu-stats.eld +/working/ diff --git a/archive/README.org b/archive/README.org new file mode 100644 index 00000000..e292065a --- /dev/null +++ b/archive/README.org @@ -0,0 +1,71 @@ +#+TITLE: Archive — Retired Modules +#+AUTHOR: Craig Jennings + +* What this is + +The pasture upstate. Modules that were once part of the config but are no +longer loaded, kept here instead of deleted so they can be read, mined for +ideas, or brought back later. + +Nothing in this directory is on the Emacs =load-path=, and nothing in the +active config requires anything here. Retiring a file means moving it here and +removing whatever orphaned reference kept pointing at it. Restoring one means +moving it back to =modules/= or =custom/= and re-adding its =require= (or +=use-package=) in =init.el=. + +The directory is tracked in git, so every retired file stays retrievable from +history even after it moves again. + +* The rule this directory enforces + +Every =.el= file *outside* this directory should be of active use — required, +loaded, or otherwise reached by the running config. If a file is never touched, +loaded, or referenced, it belongs here. The candidate list is generated by a +reachability sweep from =init.el= (transitive =require= closure), then checked +by hand for the cases pure requires miss: =use-package= with =:load-path=, +autoloads, and vendored copies shadowed by a package-manager install. + +* Layout + +Retired files keep their origin directory so a restore is a straight move back: + +- =archive/modules/= — retired first-party modules +- =archive/custom/= — retired vendored third-party files +- =archive/tests/= — tests belonging to retired modules +- =archive/gptel/= — the gptel feature subtree, retired as a unit + +* Inventory + +** archive/modules/ + +- =show-kill-ring.el= — kill-ring viewer bound to M-S-k. Its =require= was + dropped in b785a19d and consult-yank-pop covers the same need. Retiring it + also removed the orphaned M-K -> M-S-k translation in =keyboard-compat.el=, + which had been leaving M-K a dead key. +- =duet-config.el= — no reference anywhere in the config. +- =mu4e-org-contacts-setup.el= — nothing requires it; its featurep gate would + be nil at init in any case. The live mu4e contacts wiring lives in + =mu4e-org-contacts-integration.el=. +- =signal-config.el= — the in-Emacs Signal client (forked signel at + =~/code/signel= + signal-cli), retired whole on Craig's call 2026-07-14: + agents drive Signal via signal-cli / signal-mcp, so the interactive Emacs + client earns no keep. The fork repo itself is untouched. Its seven test + files moved to =archive/tests/= with it (=test-signal-config*.el=, + =test-signel-*.el=). The spec record is + =docs/specs/signal-client-spec.org= (IMPLEMENTED, then retired). + +** archive/custom/ + +- =eplot.el= — vendored plotting package, unreferenced. +- =profile-dotemacs.el= — startup-profiling tool, unreferenced. +- =titlecase.el= + =titlecase-data.el= — the duckwork/titlecase.el package, + superseded by =custom-case.el='s own =cj/title-case-region=. +- =edit-indirect.el= — a vendored copy of the MELPA package that + =text-config.el= installs (its =use-package= carries no =:ensure nil=). With + this copy off the =load-path=, the MELPA copy loads, which is the intended + one. + +** archive/gptel/ + +The gptel AI-assistant feature, retired as a whole subtree (modules, tests, +tools, custom, and its spec docs) when the config moved off gptel. diff --git a/custom/edit-indirect.el b/archive/custom/edit-indirect.el index 307f9695..307f9695 100644 --- a/custom/edit-indirect.el +++ b/archive/custom/edit-indirect.el diff --git a/custom/eplot.el b/archive/custom/eplot.el index c00a3e31..c00a3e31 100644 --- a/custom/eplot.el +++ b/archive/custom/eplot.el diff --git a/custom/profile-dotemacs.el b/archive/custom/profile-dotemacs.el index 8baee47b..8baee47b 100644 --- a/custom/profile-dotemacs.el +++ b/archive/custom/profile-dotemacs.el diff --git a/custom/titlecase-data.el b/archive/custom/titlecase-data.el index 7415a210..7415a210 100644 --- a/custom/titlecase-data.el +++ b/archive/custom/titlecase-data.el diff --git a/custom/titlecase.el b/archive/custom/titlecase.el index 319befef..319befef 100644 --- a/custom/titlecase.el +++ b/archive/custom/titlecase.el diff --git a/modules/duet-config.el b/archive/modules/duet-config.el index 2dc7ad2e..2dc7ad2e 100644 --- a/modules/duet-config.el +++ b/archive/modules/duet-config.el diff --git a/modules/mu4e-org-contacts-setup.el b/archive/modules/mu4e-org-contacts-setup.el index bfb9b1f2..bfb9b1f2 100644 --- a/modules/mu4e-org-contacts-setup.el +++ b/archive/modules/mu4e-org-contacts-setup.el diff --git a/modules/show-kill-ring.el b/archive/modules/show-kill-ring.el index e65d48b5..e65d48b5 100644 --- a/modules/show-kill-ring.el +++ b/archive/modules/show-kill-ring.el diff --git a/modules/signal-config.el b/archive/modules/signal-config.el index edb7d0dc..a1ec7933 100644 --- a/modules/signal-config.el +++ b/archive/modules/signal-config.el @@ -143,6 +143,9 @@ BODY is formatted by `cj/signal--format-notify-body'. Installed as (if script (apply #'start-process "signel-notify" nil script "info" title text (unless cj/signel-notify-sound (list "--silent"))) + ;; notifications.el is not autoloaded; load it on the first fallback. + (unless (fboundp 'notifications-notify) + (require 'notifications)) (notifications-notify :title title :body text))))) ;;; signel — fork integration @@ -199,10 +202,27 @@ time." (declare-function signel--send-rpc "signel" (method params &optional target-buffer success-callback)) (defvar cj/signel--contact-cache nil - "Cached `(LABEL . RECIPIENT)' alist for the contact picker. + "Contact-picker cache: nil (cold), `empty', or a `(LABEL . RECIPIENT)' alist. Populated by `cj/signel--fetch-contacts' on first invocation (or after a -`cj/signel-refresh-contacts'), and cleared on `signel-stop' / restart so -a stale list can't survive a reconnect. In-memory only.") +`cj/signel-refresh-contacts'). A fetched-and-empty account caches the +symbol `empty' rather than nil, so it reads as warm and the picker does +not re-run its blocking fetch on every open -- read through +`cj/signel--cached-contacts'. Cleared back to cold by +`cj/signel--clear-contact-cache', advised onto `signel-stop' so a stale +list can't survive a reconnect. In-memory only.") + +(defun cj/signel--clear-contact-cache (&rest _) + "Return the contact cache to cold (nil) so the next picker refetches. +Advised `:after' `signel-stop': a relink or reconnect may change the +contact list, so a cache from the previous connection must not survive." + (setq cj/signel--contact-cache nil)) + +(advice-add 'signel-stop :after #'cj/signel--clear-contact-cache) + +(defun cj/signel--cached-contacts () + "Return the cached contact alist, treating the `empty' sentinel as none." + (unless (eq cj/signel--contact-cache 'empty) + cj/signel--contact-cache)) (defcustom cj/signel-fetch-timeout 3.0 "Seconds the picker blocks on `accept-process-output' for a cold-cache fetch. @@ -249,8 +269,10 @@ fires a void-variable error before the autoload would trigger." Issues a `listContacts' RPC and registers a success callback that runs the result through `cj/signal--parse-contacts' (the verified parser) and stores the resulting `(LABEL . RECIPIENT)' alist in the cache. An empty -result populates the cache as nil; a failure goes through the dispatch -error path and never invokes the callback, so the prior cache survives. +result caches the `empty' sentinel -- nil would read as a cold cache and +re-run the picker's blocking fetch on every open. A failure goes +through the dispatch error path and never invokes the callback, so the +prior cache survives. AFTER-CALLBACK, when non-nil, is invoked with no arguments after the cache has been populated -- the picker uses this to unblock its @@ -258,7 +280,8 @@ bounded-wait on cold caches." (signel--send-rpc "listContacts" nil nil (lambda (result) - (setq cj/signel--contact-cache (cj/signal--parse-contacts result)) + (setq cj/signel--contact-cache + (or (cj/signal--parse-contacts result) 'empty)) (when after-callback (funcall after-callback))))) (defun cj/signel-refresh-contacts () @@ -306,7 +329,7 @@ opens the chosen recipient in `signel-chat'." "Signal contact fetch timed out after %.1fs; try again or run M-x cj/signel-refresh-contacts (see *signel-log* for detail)" cj/signel-fetch-timeout)))) (let* ((note-self (cons "Note to Self" signel-account)) - (candidates (cons note-self cj/signel--contact-cache)) + (candidates (cons note-self (cj/signel--cached-contacts))) (table (lambda (string pred action) (if (eq action 'metadata) `(metadata diff --git a/tests/test-show-kill-ring--insert-item.el b/archive/tests/test-show-kill-ring--insert-item.el index a29ca75e..a29ca75e 100644 --- a/tests/test-show-kill-ring--insert-item.el +++ b/archive/tests/test-show-kill-ring--insert-item.el diff --git a/archive/tests/test-signal-config--contact-cache.el b/archive/tests/test-signal-config--contact-cache.el new file mode 100644 index 00000000..720e0c3a --- /dev/null +++ b/archive/tests/test-signal-config--contact-cache.el @@ -0,0 +1,61 @@ +;;; test-signal-config--contact-cache.el --- Contact-cache lifecycle tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; The picker's contact cache has two lifecycle bugs from the 2026-06 config +;; audit: (1) its docstring promised clearing on signel-stop but nothing +;; cleared it, so a stale list survived a relink/reconnect; (2) a +;; fetched-and-empty list was cached as nil, indistinguishable from a cold +;; cache, so a zero-contact account re-ran the blocking fetch (up to +;; `cj/signel-fetch-timeout') on every picker open. The fix names the empty +;; state with an `empty' sentinel and clears the cache via a named function +;; advised onto `signel-stop'. +;; +;; Boundary mocks only (the RPC send, the prompt); the cache logic runs +;; real. The ensure-started branches the audit called untested were +;; already covered in test-signal-config.el -- that claim was stale. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'signal-config) + +;;; ------------------------- clear-on-stop (F1) ------------------------------ + +(ert-deftest test-signal-config-clear-contact-cache-resets () + "Normal: the clear function empties the cache back to cold (nil)." + (let ((cj/signel--contact-cache '(("Al (+1)" . "+1")))) + (cj/signel--clear-contact-cache) + (should (null cj/signel--contact-cache)))) + +(ert-deftest test-signal-config-clear-contact-cache-advises-stop () + "Normal: `signel-stop' carries the clear advice, so the docstring's +\"cleared on stop/restart\" promise is real." + (should (advice-member-p #'cj/signel--clear-contact-cache 'signel-stop))) + +;;; ------------------------- empty sentinel (F2) ------------------------------ + +(ert-deftest test-signal-config-fetch-empty-caches-sentinel () + "Boundary: a fetched-and-empty list caches the `empty' sentinel, not nil. +nil means cold cache; without the sentinel a zero-contact account re-ran +the blocking fetch on every picker open." + (let ((cj/signel--contact-cache nil) + (captured-callback nil)) + (cl-letf (((symbol-function 'signel--send-rpc) + (lambda (_method _params _buf callback) + (setq captured-callback callback)))) + (cj/signel--fetch-contacts) + (funcall captured-callback '())) + (should (eq cj/signel--contact-cache 'empty)))) + +(ert-deftest test-signal-config-cached-contacts-unwraps-sentinel () + "Normal: the cache reader returns the alist, and nil for the sentinel." + (let ((cj/signel--contact-cache '(("Al (+1)" . "+1")))) + (should (equal (cj/signel--cached-contacts) '(("Al (+1)" . "+1"))))) + (let ((cj/signel--contact-cache 'empty)) + (should (null (cj/signel--cached-contacts))))) + +(provide 'test-signal-config--contact-cache) +;;; test-signal-config--contact-cache.el ends here diff --git a/tests/test-signal-config-notify.el b/archive/tests/test-signal-config-notify.el index 1a772289..1a772289 100644 --- a/tests/test-signal-config-notify.el +++ b/archive/tests/test-signal-config-notify.el diff --git a/tests/test-signal-config.el b/archive/tests/test-signal-config.el index 7556efdb..f8bf4410 100644 --- a/tests/test-signal-config.el +++ b/archive/tests/test-signal-config.el @@ -251,9 +251,12 @@ and stores the (LABEL . RECIPIENT) alist in `cj/signel--contact-cache'." (should (equal cj/signel--contact-cache '(("Alice (+15555550100)" . "+15555550100")))))) -(ert-deftest test-signal-config-fetch-contacts-empty-result-clears-cache () - "Boundary: an empty listContacts result populates the cache as nil, -distinct from a failure path (which never invokes the success callback)." +(ert-deftest test-signal-config-fetch-contacts-empty-result-caches-sentinel () + "Boundary: an empty listContacts result caches the `empty' sentinel. +nil would read as a cold cache and re-run the picker's blocking fetch on +every open; the sentinel marks warm-but-empty. Still distinct from a +failure path, which never invokes the success callback. (This test +formerly pinned the nil behavior -- the 2026-06 audit's F2 bug.)" (let (sent-callback) (cl-letf (((symbol-function 'signel--send-rpc) (lambda (_method _params _target callback) @@ -261,7 +264,7 @@ distinct from a failure path (which never invokes the success callback)." (setq cj/signel--contact-cache '(("stale" . "+10000000000"))) (cj/signel--fetch-contacts) (funcall sent-callback [])) - (should-not cj/signel--contact-cache))) + (should (eq cj/signel--contact-cache 'empty)))) ;;; cj/signel-refresh-contacts diff --git a/tests/test-signel-cancel-input.el b/archive/tests/test-signel-cancel-input.el index b2a7ef89..b2a7ef89 100644 --- a/tests/test-signel-cancel-input.el +++ b/archive/tests/test-signel-cancel-input.el diff --git a/tests/test-signel-input-preservation.el b/archive/tests/test-signel-input-preservation.el index e8ce4ddb..e8ce4ddb 100644 --- a/tests/test-signel-input-preservation.el +++ b/archive/tests/test-signel-input-preservation.el diff --git a/tests/test-signel-notify-function.el b/archive/tests/test-signel-notify-function.el index e3d97af5..e3d97af5 100644 --- a/tests/test-signel-notify-function.el +++ b/archive/tests/test-signel-notify-function.el diff --git a/tests/test-signel-rpc-dispatch.el b/archive/tests/test-signel-rpc-dispatch.el index 5ae023d6..5ae023d6 100644 --- a/tests/test-signel-rpc-dispatch.el +++ b/archive/tests/test-signel-rpc-dispatch.el diff --git a/docs/design/2026-07-10-curated-help-menu-survey.org b/docs/design/2026-07-10-curated-help-menu-survey.org new file mode 100644 index 00000000..a7469ac1 --- /dev/null +++ b/docs/design/2026-07-10-curated-help-menu-survey.org @@ -0,0 +1,96 @@ +#+TITLE: Survey — where a curated "?" help menu makes sense +#+AUTHOR: Craig Jennings +#+DATE: 2026-07-10 + +* What this is + +The mechanical half of the "=?= = curated help menu" convention task. It reports, +per mode, whether =?= is free, whether =H= is free, and what the package already +ships. It changes no keybinding and makes no per-mode recommendation, because which +commands belong in a curated menu is a taste call. + +The reference implementation is calibredb (=modules/calibredb-epub-config.el:129-131=): +=?= runs =cj/calibredb-menu=, a curated transient of the frequent workflows, and =H= +runs the package's own =calibredb-dispatch=. + +* Method + +Bindings were read from the live keymaps, not from source, because a package's +=define-key= calls and its =:bind= forms don't always agree with what ends up in the +map. + +The probe ran in a throwaway =emacs --batch= with =package-initialize=, not in the +running daemon, for two reasons. Probing =calibredb-search-mode-map= or +=mu4e-headers-mode-map= in the daemon would force-load those packages into a live +session. And a batch Emacs reports the *package's* defaults rather than the defaults +plus Craig's config, which is the question being asked: what does the package ship? + +=mu4e= is not an ELPA package. It installs with =mu= into +=/usr/share/emacs/site-lisp/mu4e=, so it needed an explicit =load-path= entry. + +* The table + +=FREE= means the key is unbound in that mode's map. + +| Mode | =?= | =H= | Ships a dispatch? | +|---------------+--------------------------------+---------------------------+------------------------| +| calibredb | =cj/calibredb-menu= (curated) | =calibredb-dispatch= | yes, moved to =H= | +|---------------+--------------------------------+---------------------------+------------------------| +| nov | FREE | FREE | no | +|---------------+--------------------------------+---------------------------+------------------------| +| eat | FREE | FREE | no | +|---------------+--------------------------------+---------------------------+------------------------| +| elfeed-search | FREE | FREE | no | +|---------------+--------------------------------+---------------------------+------------------------| +| elfeed-show | FREE | FREE | no | +|---------------+--------------------------------+---------------------------+------------------------| +| dired/dirvish | =dired-summary= | =dired-do-hardlink= | no (summary is a | +| | | | one-line echo) | +|---------------+--------------------------------+---------------------------+------------------------| +| magit-status | =magit-dispatch= | =magit-describe-section= | yes, already on =?= | +|---------------+--------------------------------+---------------------------+------------------------| +| pdf-view | =describe-mode= | =pdf-view-fit-height-...= | no | +|---------------+--------------------------------+---------------------------+------------------------| +| org-agenda | =org-agenda-show-the-flagging- | =org-agenda-holidays= | no | +| | note= | | | +|---------------+--------------------------------+---------------------------+------------------------| +| mu4e-headers | =mu4e-headers-mark-for-unread= | =mu4e-display-manual= | no | +|---------------+--------------------------------+---------------------------+------------------------| + +* What the table shows + +Four modes have both keys free: nov, eat, elfeed-search, elfeed-show. Nothing has to +be displaced to adopt the convention there. These are the cheap ones. + +Three modes bind =?= to something small. =dired-summary= echoes a one-line key +reminder. =pdf-view= sends =?= to =describe-mode=. =org-agenda= puts a +flagging-note command on it. In each case the convention would displace a command of +low value, but it is a displacement and needs a decision. + +=mu4e-headers= is the awkward one. Its =?= is =mu4e-headers-mark-for-unread=, a real +editing command in the marking family (=u=, =d=, =!=). Rebinding it would break +muscle memory for an operation that mutates mail state. Its =H= is already +=mu4e-display-manual=. + +=magit= is the counterexample worth noting. It already does exactly what the +convention proposes: =?= opens =magit-dispatch=, its own curated transient. The +convention is not new, it is magit's habit, generalized. Magit needs no change. + +=dirvish= inherits =dired-mode-map=, so a change there lands on plain dired too. + +* Caveats + +The probe reads package defaults. Craig's own config may rebind =?= in a mode after +the package loads, and the batch probe would not see it. A grep for =?=-rebinding in +=modules/*.el= found only the calibredb case, so the table should hold, but a mode +whose config binds =?= inside a =:config= block reached by a path the grep missed +would not show up. + +=signel= and =pearl= are in the task's candidate list and are absent from the table. +Neither was probeable: they are local checkouts, not ELPA packages, and loading them +in batch pulls in dependencies the probe deliberately avoided. + +* The decisions this leaves + +For each mode, whether a curated =?= menu is worth its cost, and if so, which +commands go in it. That is the taste call, and the reason this survey stops here. diff --git a/docs/design/2026-07-10-ledger-config-audit.org b/docs/design/2026-07-10-ledger-config-audit.org new file mode 100644 index 00000000..ff969d78 --- /dev/null +++ b/docs/design/2026-07-10-ledger-config-audit.org @@ -0,0 +1,146 @@ +#+TITLE: Ledger config audit — correctness and guardrail gaps +#+AUTHOR: Craig Jennings +#+DATE: 2026-07-10 + +* Scope + +The correctness half of the ledger guardrail work. It audits +=modules/ledger-config.el= (71 lines, no test file before today) and reports what's +wrong and what's missing. It designs no guardrails, because those choices are +Craig's. + +Characterization tests for the behavior that exists now landed alongside this note +at =tests/test-ledger-config.el=. + +The stakes set the bar. This is a financial file, and Craig's stated goal for the +follow-on work is "enough guardrails that it's hard to make a costly mistake." + +* Findings + +** F1. The linting doesn't run. Nothing checks unbalanced transactions. + +FIXED 2026-07-10. =flycheck-config.el= now hooks =flycheck-mode= to =ledger-mode=. +Verified end to end on an unbalanced fixture: flycheck reports "Transaction does not +balance" with the =$10.00= remainder. The finding is kept below as the record of +what was wrong. + +The module's own commentary says it provides "flycheck linting." + +=flycheck-ledger= is loaded (=ledger-config.el:59-60=) and registers the =ledger= +checker. But =flycheck-mode= is never enabled in a ledger buffer. +=flycheck-config.el:47= hooks =flycheck-mode= to exactly two modes: + +#+begin_src elisp +:hook ((sh-mode emacs-lisp-mode) . flycheck-mode) +#+end_src + +There is no =global-flycheck-mode= anywhere in the config. Verified against a real +=ledger-mode= buffer in the running daemon: =major-mode= is =ledger-mode=, +=flycheck-checkers= contains =ledger=, and =flycheck-mode= is =nil=. + +So an unbalanced transaction, a malformed date, and a typo'd account name all +produce no warning. The guardrail Craig believes he has is not connected. + +This is the finding that matters. Everything below is smaller. + +** F2. Every save silently reorders the entire file. + +=cj/ledger--clean-before-save= runs =ledger-mode-clean-buffer= on +=before-save-hook= (=ledger-config.el:32-40=), with =cj/ledger-clean-on-save= +defaulting to =t=. + +=ledger-mode-clean-buffer= (=ledger-mode.el:226=) is not a formatter. Its own +docstring says "Indent, remove multiple line feeds and sort the buffer," and its +body calls, in order: =untabify=, =ledger-sort-buffer=, =ledger-post-align-postings=, +=ledger-mode-remove-extra-lines=. + +=ledger-sort-buffer= (=ledger-sort.el:106=) sorts the whole buffer by date, from +=point-min= to =point-max= unless the file carries explicit sort markers. + +So every =C-x C-s= rewrites the transaction order of a financial file. The task +asked whether clean-on-save "ever reorders or rewrites in a surprising way." It +reorders, every time, by design of the upstream function. + +*Accepted 2026-07-10, on inspection of the sort key.* The reordering is +chronological and nothing else. =ledger-sort-startkey= (=ledger-sort.el:62=) builds +its key from the first ten characters of a transaction's opening line, the ISO date, +through =ledger-parse-iso-date= and =float-time=. Payee, amount, and account never +enter the key. =sort-subr= uses Emacs's stable sort, so transactions sharing a date +keep the order they were typed in. + +The scope is bounded on request: =ledger-sort-buffer= narrows to the region between +=; Ledger-mode: Start sort= and =; Ledger-mode: End sort= marker comments when the +file carries them, and only falls back to the whole buffer when it doesn't. + +So a save sorts by date, stably, over a region the file can choose. Craig accepts +that. The finding stays recorded because "clean-on-save" still reads as whitespace +tidying, and the next person to meet this function should know it sorts. + +** F3. The demoted error hides a partial rewrite, not just a message. + +The clean is wrapped in =with-demoted-errors= so "a malformed buffer still saves" +(=ledger-config.el:34-37=). + +The comment is accurate about the save. It is misleading about the buffer. The +operations inside =ledger-mode-clean-buffer= run in sequence and mutate as they go. +An error raised by =ledger-post-align-postings= or by the =search-forward= that +restores point (=ledger-mode.el:239=) happens *after* =ledger-sort-buffer= has +already reordered everything. Nothing rolls back. + +The result is a file that saved, in a state neither the user nor the cleaner +intended, with a message in the echo area that scrolls away. + +** F4. Reconcile has no confirmation, and clears whole transactions. + +=ledger-clear-whole-transactions= is =t= (=ledger-config.el:43=), so a reconcile +marks entire transactions cleared rather than individual postings. Combined with no +confirmation step anywhere in the module, a stray keypress in a reconcile buffer +mutates the ledger file. + +This is upstream behavior, not a bug in this module. It is named here because the +follow-on guardrail work asked about "reconcile safety" and this is what reconcile +safety currently amounts to. + +* What is not a problem + +Worth recording so the guardrail work doesn't chase it. + +- *company-ledger's global backend is correctly scoped.* =ledger-config.el:68= does + =(add-to-list 'company-backends 'company-ledger)= globally, which looks like it + would offer ledger completions everywhere. It doesn't: the backend's own =prefix= + command (=company-ledger.el:110-111=) returns nil unless the buffer is + =beancount-mode= or derives from =ledger-mode=. +- *The reports pass =--strict=.* All five entries in =ledger-reports= + (=ledger-config.el:48-52=) use =--strict=, so a report over a file with an + undeclared account errors rather than silently inventing one. This is a real + guardrail and it is on. +- *The missing-binary check is at the right place.* =cj/executable-find-or-warn= + runs at =:config= (=ledger-config.el:54=), so a missing =ledger= CLI warns at load + rather than failing cryptically inside a report. +- *The clean-on-save hook is installed buffer-locally* (=ledger-config.el:40=), not + globally. Pinned by a test. + +* Gaps, as a list + +1. +No linting reaches ledger buffers (F1).+ Fixed 2026-07-10. +2. No confirmation before the date-sort on save (F2). Accepted: the sort is + chronological and stable. +3. No rollback when that rewrite fails partway (F3). +4. No confirmation before reconcile mutates the file (F4). +5. No validation that a save leaves the file balanced. +6. No test coverage before today. + +* What this note deliberately does not do + +It designs no guardrails. Whether a clean that fails should roll back, and what +shape a reconcile confirmation takes, are preference calls about Craig's own +accounting workflow. Those belong to the ledger guardrail UX task. + +The one finding that wasn't a preference call was F1: turning flycheck on in ledger +buffers restored a guardrail the module already claimed to have. That was a defect, +not a design choice, and it is fixed. + +F2 was resolved by reading the sort key rather than by changing code. What remains +for the guardrail task is F3 (no rollback when a clean fails partway) and F4 (no +confirmation before reconcile), plus the open question of whether a save should +verify the file still balances. diff --git a/docs/design/2026-07-10-org-module-ownership.org b/docs/design/2026-07-10-org-module-ownership.org new file mode 100644 index 00000000..5717b66f --- /dev/null +++ b/docs/design/2026-07-10-org-module-ownership.org @@ -0,0 +1,138 @@ +#+TITLE: Org module ownership and load boundaries +#+AUTHOR: Craig Jennings +#+DATE: 2026-07-10 + +* Why this note exists + +The Org workflow is spread across sixteen modules with overlapping +responsibilities. The code works. What's missing is a map: which module owns which +behavior, what each one adds to a shared variable, and in what order they load. + +Future load-order work needs that map. Four modules add capture templates, four +touch =org-agenda-files=, and five register org-protocol handlers. None of that is +wrong, but none of it is written down either, so the only way to answer "who sets +this?" is to grep. + +This is a description of what is, not a proposal. Where the map turned up something +that looks like a defect, it's flagged at the bottom rather than fixed here. + +* The modules + +Every Org module declares =Layer=, =Category=, and =Load shape= in its commentary +header. The layer numbers below come from those headers, not from this note. + +| Module | Layer | Owns | +|------------------------------+-------+---------------------------------------------------------| +| =org-faces-config.el= | 2 | Agenda keyword and priority faces, plus their -dim | +| | | variants for unfocused windows | +|------------------------------+-------+---------------------------------------------------------| +| =org-config.el= | 3 | Base org-mode settings, the org keymap, tag alignment | +|------------------------------+-------+---------------------------------------------------------| +| =org-agenda-config.el= | 3 | Agenda views, task tracking, notifications; loads | +| | | =org-agenda-config-debug= on demand | +|------------------------------+-------+---------------------------------------------------------| +| =org-capture-config.el= | 3 | The base capture templates and their dispatch keys | +|------------------------------+-------+---------------------------------------------------------| +| =org-refile-config.el= | 3 | Refile targets and the cached target list | +|------------------------------+-------+---------------------------------------------------------| +| =org-roam-config.el= | 3 | Roam database, capture, and its agenda-file additions | +|------------------------------+-------+---------------------------------------------------------| +| =org-contacts-config.el= | 3 | Contacts storage and its capture template | +|------------------------------+-------+---------------------------------------------------------| +| =org-babel-config.el= | 3 | Source-block languages and tempo templates | +|------------------------------+-------+---------------------------------------------------------| +| =org-export-config.el= | 3 | Export backends and their defaults | +|------------------------------+-------+---------------------------------------------------------| +| =org-spec-links.el= | 3 | Resolves =[[id:]]= links into project spec docs | +|------------------------------+-------+---------------------------------------------------------| +| =hugo-config.el= | 3 | ox-hugo blog publishing (=C-; h=) | +|------------------------------+-------+---------------------------------------------------------| +| =org-drill-config.el= | 4 | Spaced repetition, its own refile targets | +|------------------------------+-------+---------------------------------------------------------| +| =org-noter-config.el= | 4 | PDF and EPUB annotation | +|------------------------------+-------+---------------------------------------------------------| +| =org-reveal-config.el= | 4 | reveal.js presentations (=C-; p=) | +|------------------------------+-------+---------------------------------------------------------| +| =org-webclipper.el= | 4 | org-protocol web clipping into roam | +|------------------------------+-------+---------------------------------------------------------| +| =quick-video-capture.el= | 4 | Video download via an org-protocol bookmark | +|------------------------------+-------+---------------------------------------------------------| + +* Shared variables and who writes to them + +This is the part grep answers slowly and a table answers fast. Each of these +variables is appended to by more than one module. + +** =org-capture-templates= — four writers + +=org-capture-config.el= establishes the base set. =org-contacts-config.el=, +=org-webclipper.el=, and =quick-video-capture.el= each append their own. Dispatch +keys must not collide across all four, which is why +=tests/test-org-capture-templates-integrity.el= exists: it loads the cleanly +loadable capture modules, applies their additions, and asserts no two templates +share a key. + +That test is the enforcement mechanism for a boundary no single module can see. + +** =org-agenda-files= — four writers + +=org-agenda-config.el= sets the base list. =org-roam-config.el= adds roam files. +=config-utilities.el= manipulates it, and =org-agenda-config-debug.el= reads it for +diagnostics. + +** org-protocol handlers — five registrars + +=org-config.el=, =org-capture-config.el=, =org-drill-config.el=, +=org-webclipper.el=, and =quick-video-capture.el= all touch org-protocol. The +handlers are keyed by protocol name, so collisions are possible in principle and +nothing checks for them today. + +** =org-refile-targets= — two writers + +=org-refile-config.el= owns the general targets. =org-drill-config.el= adds its +own, because drill files are refile destinations but not agenda files. + +* Load order + +=init.el= loads the Org stack at lines 130 through 145, in this order: base config, +faces, agenda, babel, capture, contacts, drill, export, hugo, reveal, refile, roam, +spec-links, webclipper, noter. + +The order is deliberate in two places. =org-config= precedes everything because it +establishes the keymap the rest bind into. =org-faces-config= precedes +=org-agenda-config= because the agenda renders with those faces. + +One module sits outside that block. =quick-video-capture.el= loads at line 106, +twenty-four lines before =org-config=, because it is grouped with the media modules +rather than the Org modules. It nonetheless appends to =org-capture-templates=. It +works because the append is a plain =add-to-list= against a variable org-mode has +not yet claimed, but the grouping means a reader looking for "who adds capture +templates" in the Org block will not find it. + +* Load shape + +Every Org module declares =Load shape: eager=. Nothing in the Org stack defers. + +This is the single largest fact about the Org workflow's startup cost, and it is +worth stating plainly rather than leaving implicit across sixteen headers. Layer-4 +modules (drill, noter, reveal, webclipper, video capture) are optional features by +their own classification, and all five load eagerly on every launch. + +Whether that matters is a measurement question, not an argument, and this note does +not make it. It records the fact so the question can be asked. + +* Observations for follow-up + +These turned up while mapping. None is fixed here. + +1. =modules/org-config.el.faces.bak= is tracked in git (25KB). It appears to be a + leftover from the 2026-06-14 face-stripping work. A =.bak= file in =modules/= + is not loaded, but it is on the load-path's directory and will confuse the next + reader. +2. =org-agenda-config-debug.el= carries no =Layer= / =Category= / =Load shape= + header, unlike every other module. It loads conditionally from + =org-agenda-config.el:42= when =cj/debug-modules= names it, so its absence from + =init.el= is by design, not an orphan. +3. Nothing checks org-protocol handler collisions the way the capture-template test + checks key collisions. Five modules register handlers. +4. Every Layer-4 Org module loads eagerly despite being classified optional. diff --git a/docs/specs/2026-07-06-fancy-music-player-ui-spec.org b/docs/specs/2026-07-06-fancy-music-player-ui-spec.org index b3b4c614..44fd8a00 100644 --- a/docs/specs/2026-07-06-fancy-music-player-ui-spec.org +++ b/docs/specs/2026-07-06-fancy-music-player-ui-spec.org @@ -4,10 +4,11 @@ #+TODO: TODO | DONE #+TODO: DRAFT READY DOING | IMPLEMENTED SUPERSEDED CANCELLED -* DOING Fancy music-player UI +* IMPLEMENTED Fancy music-player UI :PROPERTIES: :ID: af4f2688-ce7d-43f5-82e5-595a603e2593 :END: +- 2026-07-09 Thu @ 17:50:32 -0500 — Craig ran the Phase-3 visual VERIFY and found no issues: hero cover art, serif title, amber accents, advancing bar, on-air marker, and the plain-text fallback all pass. All three phases built and pushed. DOING -> IMPLEMENTED. - 2026-07-06 Mon @ 15:14:06 -0500 — spec-response Phase 6: decomposed into 3 build tasks + flip-to-IMPLEMENTED under the todo.org parent (stamped :SPEC_ID: af4f2688), Phase-3 visual VERIFY filed. READY -> DOING. - 2026-07-06 Mon @ 15:14:06 -0500 — spec-response: all 7 findings dispositioned (5 accept, 2 modify, 0 reject), Review findings [7/7]. Both blockers resolved and folded in. Decisions [5/5], no blocking open → Ready. DRAFT -> READY. - 2026-07-06 Mon @ 15:14:06 -0500 — spec-review: Not ready. Decisions [5/5] but Review findings [0/7], two :blocking: (progress-bar data source undefined; row rendering overloads cj/music--track-description). Stays DRAFT until dispositioned. @@ -15,7 +16,7 @@ - 2026-07-06 Mon @ 14:38:15 -0500 — drafted. * Metadata -| Status | doing | +| Status | implemented | |----------+-------------------------------------------------------------------| | Owner | Craig Jennings | |----------+-------------------------------------------------------------------| 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 637ec4f0..c65de850 100644 --- a/docs/specs/2026-07-06-radio-browser-lookup-spec.org +++ b/docs/specs/2026-07-06-radio-browser-lookup-spec.org @@ -4,10 +4,12 @@ #+TODO: TODO | DONE #+TODO: DRAFT READY DOING | IMPLEMENTED SUPERSEDED CANCELLED -* DOING Radio-browser lookup +* IMPLEMENTED Radio-browser lookup :PROPERTIES: :ID: 4839b2c8-0552-4029-9e0f-4bf69b9a4dcd :END: +- 2026-07-09 Thu @ 17:50:32 -0500 — Craig ran the queue-first VERIFY (n / t / m picks, save on v, file-playlist save unchanged, empty and offline searches) and found no issues. DOING -> IMPLEMENTED. +- 2026-07-08 Wed @ 10:16:25 -0500 — model revision (Craig): queue-first, save-on-request. The lookup (and the manual m creator) no longer writes .m3u files at pick time; picked stations become url tracks in the queue (name/uuid/favicon as track properties) and play immediately. Saving is the normal playlist save (moved to w — the earlier S binding was shadowed by emms-stop): an all-stream queue saves into the MPD playlist dir, the plain station name pre-fills the prompt (the "-Radio" filename suffix is retired), and a custom .m3u emitter writes the station metadata back out so load round-trips names and cover art. First pick names a multi-station save. Still DOING. - 2026-07-06 Mon @ 14:04:53 -0500 — build UX changes (Craig, during Phase 2 verify): pulled tag search from vNext into v1; the feature is a Radio row in the playlist buffer (n: by name, t: by tag, m: enter manually) rather than one command on S; single mode moved off t to s and emms-stop off s to S; created filenames carry a "-Radio" suffix. Still DOING. - 2026-07-06 Mon @ 13:08:32 -0500 — spec-response Phase 6: decomposed into build tasks in todo.org (parent stamped :SPEC_ID:); READY -> DOING. Build under way. - 2026-07-06 Mon @ 13:01:55 -0500 — spec-response: all 7 findings dispositioned (6 accept/modify, 1 resolved via new Decision 5); decisions [5/5], findings [7/7]. No blocking finding remains; readiness rubric re-run on the expanded spec passes. DRAFT -> READY. Awaiting Craig's go to decompose into build tasks (spec-response Phase 6, flips READY -> DOING). @@ -16,7 +18,7 @@ - 2026-07-06 Mon @ 10:01:27 -0500 — drafted. * Metadata -| Status | doing | +| Status | implemented | |----------+-------------------------------------------------------------------| | Owner | Craig Jennings | |----------+-------------------------------------------------------------------| diff --git a/docs/specs/2026-07-10-org-workflow-doctor-spec.org b/docs/specs/2026-07-10-org-workflow-doctor-spec.org new file mode 100644 index 00000000..b7f5db6c --- /dev/null +++ b/docs/specs/2026-07-10-org-workflow-doctor-spec.org @@ -0,0 +1,260 @@ +#+TITLE: Org workflow doctor — Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-07-10 +#+TODO: TODO | DONE +#+TODO: DRAFT READY DOING | IMPLEMENTED SUPERSEDED CANCELLED + +* CANCELLED Org workflow doctor +:PROPERTIES: +:ID: c0e06025-a3b8-4238-a9a0-07f9e55913f4 +:END: +- 2026-07-10 Fri @ 05:58:00 -0500 — CANCELLED. The feature has no job. Craig asked what the doctor buys when it refuses to install anything, and the answer is nothing that isn't already there. Every external binary is already guarded at its point of use, with a clear message: hugo-config guards hugo and the file-manager opener, org-webclipper guards pandoc, org-export-config guards zathura, and ox-pandoc guards itself upstream (ox-pandoc.el:1533, 1970). Package availability surfaces at load or first use. Path checks were the only genuinely new capability, and a startup warning about a missing org-dir contradicts this spec's own goal of keeping startup quiet, while an on-demand check nobody remembers to run is worth roughly nothing. DRAFT -> CANCELLED. +- 2026-07-10 Fri @ 00:29:10 -0500 — drafted. + +* Postmortem + +The spec cleared spec-create's Phase 0 bar narrowly, and that was the signal to stop +and ask what the feature bought over the mechanisms already in the tree. It wasn't +taken. + +The =Reuse & lost opportunities= dimension exists to catch exactly this. It was +filled in, it named =cj/executable-find-or-warn=, and it dismissed the helper in one +clause for warning as a side effect. Warning as a side effect is the feature. The +dimension was answered without being used. + +Three claims in the surrounding audit came from grepping for a helper's *name* rather +than reading for the *behavior*, and all three were wrong: the org modules were said +not to guard their binaries when they guard them at the point of use, which is the +better place. Reading corrected the claim each time. + +The one real finding this line of work produced landed elsewhere and stands: ledger +buffers were never linted, fixed in 55b85754. + +* Metadata +| Status | cancelled | +|----------+----------------------------------------------------------| +| Owner | Craig Jennings | +|----------+----------------------------------------------------------| +| Reviewer | Craig Jennings | +|----------+----------------------------------------------------------| +| Related | [[file:../../todo.org][todo.org]] — "Add an Org workflow health check command" | +|----------+----------------------------------------------------------| + +* Summary + +A single on-demand command, =cj/org-workflow-doctor=, that checks whether the Org +workflow's prerequisites are actually present: the files and directories it reads +and writes, the external programs it shells out to, and the optional packages it +defers loading. It reports what it found and never changes anything. + +Today a missing prerequisite surfaces at command time, in whatever shape the first +module to trip over it happens to produce. The doctor moves that discovery to a +moment the user chose. + +* Problem / Context + +#+begin_quote +*Correction, 2026-07-10.* The premise below is false and the body is left intact as +the record of the mistake. Every external binary *is* checked, at its point of use: +=hugo-config= guards hugo and the file-manager opener, =org-webclipper= guards +pandoc, =org-export-config= guards zathura, and =ox-pandoc= guards itself upstream. +The claim came from grepping for =cj/executable-find-or-warn= by name instead of +reading the modules for the behavior. See the Postmortem above. +#+end_quote + +The Org workflow spans many modules, and each depends on some mix of a personal +path (=org-dir=, =roam-dir=), an external binary (pandoc, hugo), and an optional +package that loads lazily (=org-noter=, =org-web-tools=). None of those +dependencies is checked anywhere. + +When one is missing, the failure appears wherever the first module happens to hit +it. A missing =contacts-file= surfaces as a capture template erroring mid-capture. +An absent pandoc surfaces as a shell command returning nothing useful. The user +learns about a broken prerequisite at the least convenient moment, and the message +rarely names the prerequisite. + +Nothing about this is hard. It just isn't anywhere, and the checks are scattered +across modules that each know only their own corner. + +* Goals and Non-Goals + +** Goals +- One command reports the health of every Org workflow prerequisite. +- The check never mutates user data. It reads, it does not create or repair. +- The result is structured data, so it is unit-testable and can be rendered to + either the echo area or a buffer without recomputing. +- Startup stays quiet. Nothing runs unless asked. + +** Non-Goals +- It will not fix anything. No creating a missing directory, no installing a + package, no offering to. A doctor that repairs is a different, riskier command. +- It will not check every package in the config, only the Org workflow's. +- It will not run on a timer, a hook, or at startup. +- It will not be a general config linter. The scope is the Org workflow. + +** Scope tiers +- v1: the seven paths, the two external binaries, the six optional packages, a + structured result, and a rendering to a buffer. +- Out of scope: repair actions, non-Org prerequisites, scheduled runs. +- vNext: a =--fix= variant that offers to create missing directories after + confirmation; checking that =org-agenda-files= entries all resolve. + +* Design + +** For the caller + +=M-x cj/org-workflow-doctor= opens a report buffer listing every prerequisite with +its status. A prerequisite is =ok=, =missing=, or =skipped= (checked something the +user hasn't configured). With a prefix argument the command reports a one-line +summary to the echo area instead, for a quick "is anything broken?" glance. + +Nothing on disk changes. Running it twice produces the same report. + +** For the implementer + +The command splits in two, per the interactive-versus-internal rule. + +=cj/org-workflow--check= is pure with respect to user data: it probes the +environment and returns a list of plists, one per prerequisite, each carrying +=:name=, =:kind= (=path= / =executable= / =package=), =:status= and =:detail=. It +takes no arguments and prompts for nothing, so a test can call it directly against +a temp =user-emacs-directory= and assert on the structure. + +=cj/org-workflow-doctor= is the thin interactive wrapper: call the internal, +render the result, done. + +*** The probe each kind uses + +Paths are checked with =file-exists-p= against the variable's value, and reported +=skipped= when the variable is unbound or nil rather than =missing= — an unset +=cj/hugo-content-org-dir= means the user doesn't publish with Hugo, which is not a +fault. + +Executables are checked with =executable-find=. + +Packages are the one place a naive implementation gets it wrong, and this is the +decision the spec exists to record. The obvious probe is =featurep=, and it is +incorrect here: this config defers loading, so =featurep= returns nil for a package +that is installed and perfectly healthy. Probed on 2026-07-10, =org-noter= and +=org-web-tools= both report =(featurep) => nil= while =(locate-library) => t=. A +doctor built on =featurep= would report a false failure for precisely the packages +the config is designed to load lazily, which is worse than no doctor: it teaches +the user to ignore it. + +=locate-library= answers the question actually being asked, which is "can this load +when something needs it?" rather than "has it loaded already?". + +* Alternatives considered + +*** Probe packages with =featurep= +- Good, because: it is the first thing that comes to mind and costs nothing. +- Bad, because: it reports false failures for every lazily-loaded package, which is + most of them. Verified, not theorised. +- Neutral, because: it would be correct in a config that loads everything eagerly. + +*** Check prerequisites at startup instead of on demand +- Good, because: the user learns about a broken prerequisite before they need it. +- Bad, because: it costs startup time on every launch to answer a question asked a + few times a year, and it puts warnings in front of a user who didn't ask. +- Neutral, because: a doctor command can be run from a startup hook later if the + cost turns out to be trivial. + +*** Have each module check its own prerequisites +- Good, because: the check lives next to the thing that needs it. +- Bad, because: this is the status quo, and the problem is that the checks don't + compose into an answer to "is my Org workflow healthy?". +- Neutral, because: the doctor doesn't prevent a module from also checking. + +* Decisions [2/2] + +** DONE Probe optional packages with =locate-library=, not =featurep= +Context: the config loads Org packages lazily, so a healthy package is routinely +unloaded. Probed 2026-07-10: =org-noter= and =org-web-tools= are both +=featurep=-nil and =locate-library=-non-nil. + +Decision: we will probe package availability with =locate-library=. + +Consequences: the doctor answers "can this load?", which is the question that +matters, and it stops reporting false failures for deferred packages. Harder: the +doctor cannot distinguish "installed but broken on load" from "installed and fine", +because it deliberately does not load anything. That is the right trade for a +read-only check, and a load error surfaces at use time anyway. + +** DONE An unset optional path reports =skipped=, not =missing= +Context: not every user of this config publishes with Hugo or uses reveal.js. An +unbound or nil =cj/hugo-content-org-dir= is a configuration choice, not a fault. + +Decision: we will report =skipped= when a path variable is unbound or nil, and +=missing= only when it holds a value that does not resolve on disk. + +Consequences: the report stays honest, so a clean report means something. Harder: +the status vocabulary grows a third value, and the renderer has to distinguish +three states rather than two. + +* Implementation phases + +1. *The internal, with tests.* =cj/org-workflow--check= plus its three probe + helpers (path, executable, package). Tests drive real state: a temp directory + that exists and one that doesn't, an executable that resolves and a nonsense + name, a library that locates and one that doesn't. Tree is working; nothing is + bound to a key yet. +2. *The renderer and the command.* =cj/org-workflow-doctor=, the report buffer, and + the prefix-argument echo-area summary. Tests cover the rendering of a synthetic + result list, not the environment. + +* Acceptance criteria + +- =cj/org-workflow--check= returns one plist per prerequisite, each with =:name=, + =:kind=, =:status= and =:detail=. +- A path variable holding a resolving directory reports =ok=; one holding a + nonexistent path reports =missing=; one unbound or nil reports =skipped=. +- =org-noter= and =org-web-tools= report =ok= on this machine despite being + unloaded. This is the regression the spec exists to prevent. +- Running the command twice leaves the filesystem byte-identical. +- The command is absent from every hook and timer. + +* Readiness dimensions + +- *Data model & ownership* — the result is generated, ephemeral, and owned by the + command. Nothing persists. +- *Errors, empty states & failure* — a probe that throws is caught per-prerequisite + and reported as =missing= with the error text as =:detail=, so one bad probe + cannot abort the report. +- *Security & privacy* — the report prints paths from the user's config. It stays + in a local buffer and is never written to disk or transmitted. +- *Observability* — the report is the observability. +- *Performance & scale* — fifteen probes, all local filesystem stats. No concern. +- *Reuse & lost opportunities* — =executable-find= and =locate-library= are the + platform's answers; nothing is reimplemented. =cj/executable-find-or-warn= + (=system-lib.el=) exists but warns as a side effect, which a read-only check must + not do, so the doctor calls =executable-find= directly. +- *Architecture fit* — a new module, =modules/org-workflow-doctor.el=, requiring + nothing but the variables it probes. It must not require the Org modules, or + probing them would load them and defeat the lazy-loading it is checking. +- *Config surface* — none in v1. The prerequisite list is a defconst. +- *Documentation plan* — module commentary, plus the keybinding if one is added. +- *Dev tooling* — the existing =make test= covers it. No new target. +- *Rollout, compatibility & rollback* — additive, read-only, deletable. N/A. +- *External APIs & deps* — none. Both binaries were verified present on 2026-07-10 + (=/usr/bin/pandoc=, =/usr/bin/hugo=), and their absence is the case under test. + +* Risks, rabbit holes, and drawbacks + +The rabbit hole is scope. "Check the Org workflow's prerequisites" slides easily +into "lint the whole config", and from there into "offer to fix what it finds". The +non-goals exist to hold that line. If the doctor is useful, a =--fix= variant is a +separate spec with a separate risk profile, because a command that creates +directories is no longer read-only. + +The smaller risk is the prerequisite list going stale as modules change. A doctor +that checks the wrong things is worse than none, since it reports health that isn't +real. The defconst lives next to the probes so it is at least easy to find. + +* Review and iteration history + +** 2026-07-10 Fri @ 00:29:10 -0500 — Craig Jennings — Author +What: drafted the spec. +Why: the task is feature-level, so the speedrun's per-item disposition rule +delivers a spec rather than an implementation. +Artifacts: this file. Probed the live daemon for the seven paths, both binaries, +and the six packages; the =featurep= finding drove the first decision. diff --git a/docs/specs/gloss-spec.org b/docs/specs/gloss-spec.org deleted file mode 100644 index 06a7bf50..00000000 --- a/docs/specs/gloss-spec.org +++ /dev/null @@ -1,323 +0,0 @@ -#+TITLE: Design — gloss (Glossary Lookup with Online-Sourced Selection) -#+DATE: 2026-04-28 -#+TODO: TODO | DONE -#+TODO: DRAFT READY DOING | IMPLEMENTED SUPERSEDED CANCELLED - -* DOING Design — gloss (Glossary Lookup with Online-Sourced Selection) -:PROPERTIES: -:ID: 295f9969-ccef-4df9-945b-9e08d8069daf -:END: -- 2026-07-04 Sat @ 15:30:41 -0500 — retrofitted to status-heading convention; keyword DOING from existing :STATUS: doing - -* Problem - -A personal glossary inside Emacs, modelled on the existing =quick-sdcv= UX (=C-h d=) but for self-curated terms rather than packaged dictionaries. =C-h g= prompts for a term (defaulting to word-at-point), looks it up in a single git-tracked org file, and shows the definition in a side buffer that =q= dismisses. On a local miss, the package fetches candidate definitions from an online source, lets the user pick one, and saves it with provenance. The same org file feeds =org-drill= for spaced-repetition study. - -The pain point: domain jargon — government acronyms, technical terms, philosophy vocabulary, project-specific names — doesn't live in any general dictionary, so existing tools like =quick-sdcv= can't help. A personal glossary that grows by use (encounter term → save it once → it's permanently looked-up-able and study-card-able) closes that gap. - -* Non-Goals - -The following are explicitly out of scope for v1. Each is a defensible v2+ topic on its own. - -- *Multi-language support.* English only. Wiktionary returns French/Latin/etc. — v1 ignores everything but the =en= key. -- *Synonyms, cross-references, related terms.* Even when the upstream source returns them, v1 stores only the picked definition. -- *Audio pronunciation.* Not fetched, not played. -- *Etymology, usage notes, parsed examples.* Discarded during HTML strip. -- *Multiple glossaries / domain separation.* One file, one glossary. -- *Backup or sync infrastructure.* Delegated to git on whatever path =gloss-file= points at. -- *Org-drill scheduling control.* The exporter prepares entries; =org-drill= itself runs unmodified. - -In scope (kept after triage): edit-in-place via =C-h g e=, which jumps to the source file at the entry's heading. - -* Approaches Considered - -Six approaches evaluated during brainstorm. Three conventional, three tail samples for diversity. - -** Recommended: Layered multi-module package - -Five =.el= files, each owning one concern: =gloss-core= (data), =gloss-fetch= (network), =gloss-display= (UI), =gloss-drill= (drill export), =gloss= (orchestration entry point). Each layer mocks at its own natural boundary; no layer mocks another layer's internals. - -*Why this over the alternatives.* The codebase already prefers layering — =coverage-core= + =coverage-elisp= split, Hugo pure-helpers + interactive wrappers, LSP file-watch defvar + function. The four concerns (data, fetch, display, drill) have genuinely different test boundaries (file I/O, HTTP, mode UI, =org-element=). Mixing them in one file would force overmocking, which the project's testing rules flag as a smell. The package is also public-style — clear module boundaries reward cold readers. - -*What's traded away.* About 30 minutes more structural setup at the start, in exchange for boilerplate that may never pay off if the package stays personal forever. Cheap trade against the testing and reading wins. - -** Rejected: Single-file quick-sdcv-clone - -One =.el= file (~400 lines) covering all four concerns. Simplest path, lowest dependency footprint, but everything (data, HTTP, mode definition, drill) cohabits a single namespace. Test isolation gets awkward; refactor cost grows when one piece needs replacing. - -** Rejected: Backend-pluggable registry - -A =glossary-backend= protocol covering both local-org and online sources, with =lookup= / =save= / =list= operations. Local and online become interchangeable backends. Real future-proofing, but for v1 with two backends and probably never a third, the protocol is overkill — YAGNI risk. The forward-compat shape we did adopt (the =gloss-fetch-sources= registry, see Architecture) gets the same benefit at a fraction of the design weight, scoped only to where source variety is real. - -** Rejected: quick-sdcv + generated StarDict - -Round-trip the org file through StarDict format on save; reuse =quick-sdcv='s UI verbatim. Reuses 100% of an existing UI but loses provenance metadata in the round-trip, fights drill (which reads org, not StarDict), and forces a binary intermediate format for what should be a plain-text data store. - -** Rejected: Org-roam node per term - -Each entry is its own =org-roam= node. Free fuzzy/exact title search, free backlinks. But it's a heavy dependency for an otherwise self-contained package, file-explodes (1000 terms = 1000 files), and contradicts the locked single-file storage decision. - -** Rejected: Lazy-reactive minor mode - -Passive recognition — =gloss-mode= scans buffer text for known terms, underlines them, hover/click reveals definitions. Different and arguably more-natural mental model, but it reframes the brief (active =C-h g= lookup is what was asked for) and doesn't naturally support online fallback or auto-add. Probably belongs as a v3 feature on top of the layered architecture, not as the architecture itself. - -* Design - -** Architecture - -Five =.el= files: - -#+begin_example -gloss-core.el data layer — org file I/O + in-memory cache -gloss-fetch.el network layer — Wiktionary REST + HTML strip -gloss-display.el UI layer — side buffer + picker -gloss-drill.el drill export — :drill: tag + twosided property -gloss.el entry point — defcustoms, prefix keymap, user commands -#+end_example - -*Public API by layer.* - -=gloss-core=: =gloss-core-lookup TERM=, =gloss-core-save TERM DEFINITION SOURCE=, =gloss-core-list=, =gloss-core-find-buffer-position TERM=. - -=gloss-fetch=: =gloss-fetch-definitions TERM= → =(:ok DEFS) | (:empty :no-defs SOURCES :failed SOURCES)=. Internally a registry: =gloss-fetch--sources= alist (source-symbol → fetcher function), walked in order per the user-facing =gloss-fetch-sources= defcustom. - -=gloss-display=: =gloss-display-show-entry TERM BODY=, =gloss-display-pick-definition TERM DEFINITIONS=. Defines =gloss-mode= (derived from =special-mode=, =q= quits). - -=gloss-drill=: =gloss-drill-export-all=, =gloss-drill-untag-all=. Operates on the org file via =org-element=. - -=gloss=: =defcustom gloss-file= (path), =gloss-prefix-map= for =C-h g=, user commands =gloss-lookup=, =gloss-add=, =gloss-edit=, =gloss-fetch-online=, =gloss-drill-export=. - -** Data Flow - -*Shapes.* - -A definition (in flight from fetch through display to save) is a plist: - -#+begin_src emacs-lisp -(:source wiktionary :text "Reference to something earlier in the discourse...") -#+end_src - -An entry (saved in cache and on disk) is a plist: - -#+begin_src emacs-lisp -(:term "anaphora" - :body "Reference to something earlier in the discourse..." - :source wiktionary - :added "2026-04-28" - :marker #<marker at 1247 in gloss.org>) -#+end_src - -The cache is a hash table, term-string → entry-plist. The org file is the source of truth; the cache is a read-side index. - -*Lookup flow (=C-h g=).* - -1. Read input — word-at-point if available, else minibuffer prompt. -2. =gloss-core-lookup TERM=. Cache loaded if cold. -3. Hit → =gloss-display-show-entry=. Done. -4. Miss → silent fall-through to =gloss-fetch-definitions TERM=. -5. Orchestrate on result: - - 0 definitions or all-failures → side buffer message (see Error Handling). - - 1 definition → auto-save via =gloss-core-save=, then =gloss-display-show-entry=. - - >1 definitions → =gloss-display-pick-definition= → user picks → =gloss-core-save= → =gloss-display-show-entry=. - -*Add flow (=C-h g a=).* - -=gloss-add= prompts for term and body (small temp buffer for multi-line body, =C-c C-c= accepts). =gloss-core-save TERM BODY 'manual=. Then =gloss-display-show-entry=. - -*Edit flow (=C-h g e=).* - -=gloss-edit= resolves the term to a buffer position via =gloss-core-find-buffer-position=. Opens the org file at that heading in the *source* buffer (not the side buffer). User edits inline. On save, the buffer-local =after-save-hook= refreshes the cache for that single term. - -*Drill export (=C-h g D=).* - -=gloss-drill-export-all= walks the org file via =org-element=, ensures every term heading has =:drill:= tag and =:DRILL_CARD_TYPE: twosided= property. =M-x org-drill= runs the session — gloss does not wrap or invoke =org-drill= itself. - -** Persistence - -*File shape.* Single org file at =gloss-file= (default: =(expand-file-name "gloss.org" (or org-directory user-emacs-directory))=). One =* term= heading per entry, alphabetical order maintained on insert. Each entry has a =:PROPERTIES:= drawer with =:SOURCE:= and =:ADDED:=. Body is plain text immediately under the heading. - -#+begin_example -#+TITLE: Glossary -#+STARTUP: showall - -* anaphora -:PROPERTIES: -:SOURCE: wiktionary -:ADDED: 2026-04-28 -:END: -Reference to something earlier in the discourse... - -* SBIR -:PROPERTIES: -:SOURCE: wiktionary -:ADDED: 2026-04-28 -:END: -Initialism of Small Business Innovation Research... -#+end_example - -After =gloss-drill-export-all=, the heading line gains a =:drill:= tag and the properties drawer gains =:DRILL_CARD_TYPE: twosided=. - -*Cache lifecycle.* Hash table loaded lazily on first lookup of the session. Populated by reading =gloss-file= once and parsing with =org-element-parse-buffer=. Subsequent lookups hit the cache directly. - -*Cache invalidation.* Four triggers, in order of cost: - -1. =gloss-core-save= mutates the cache directly when it writes. -2. *mtime check on every lookup.* =file-attributes= the file before each =gloss-core-lookup= returns; if mtime > cached-mtime, reload before answering. Sub-millisecond cost; catches every out-of-band edit (other Emacs session, =git pull=, hand-edit, =sed=). -3. =gloss-edit='s buffer-local =after-save-hook= updates the single edited term immediately; overlaps with #2 but doesn't wait for the next lookup. -4. Manual =gloss-reload= command — nuclear option for paranoia. - -=file-notify-add-watch= rejected: platform-specific backend, async callback complicates the model, mtime path is already sub-millisecond. - -*Write strategy.* Append-on-add via direct buffer editing (=find-file-noselect=, insert at the alphabetically-correct heading position, save, kill the buffer if not previously open). No journal, no temp file — org-mode's =auto-save-mode= and the user's git tracking provide durability. Single-user, single-Emacs assumed; concurrent access isn't a concern. - -*Alphabetical order.* Maintained on insert via case-insensitive string compare. Cheap; the file stays diff-clean (only the inserted block changes). - -** Error Handling - -*Per-source status taxonomy.* Five internal values; three user-facing rollups. - -#+begin_src emacs-lisp -;; Internal per-source result: -(:source SYM :status STATUS :reason STRING) - -;; STATUS values: -;; :ok :defs (def1 def2 ...) — success -;; :no-defs — server reached, term not there (HTTP 404 or empty 200) -;; :unreachable — network problem (DNS, refused, timeout) -;; :server-error — HTTP 5xx, malformed JSON, schema mismatch, HTTP 4xx other than 404/429 -;; :rate-limited — HTTP 429 -#+end_src - -*=:reason= strings* carry the technical detail (=timeout (5s)=, =HTTP 503=, =malformed JSON: ...=) and land in =*gloss-debug*=. They are never user-facing. - -*User-facing rollup.* =gloss-fetch-definitions= aggregates per-source results into: - -#+begin_src emacs-lisp -(:ok DEFS) ;; any source returned >=1 def -(:empty :no-defs (...) :failed (...)) ;; everything else -#+end_src - -=:failed= unions =:unreachable=, =:server-error=, =:rate-limited=. - -| Result shape | Message | -|-------------------------------------------+--------------------------------------------------------------------| -| Every source =:no-defs=, none failed | "No definition for X in Wiktionary." | -| Every source failed, none =:no-defs= | "Couldn't reach Wiktionary." | -| Mix of =:no-defs= and failures | "No definition in Wiktionary; couldn't reach DictionaryAPI." | -| Any =:ok= with defs | Silent on others — picker shows what came back | - -When v2 starts surfacing =:rate-limited= regularly, the rollup wording will gain a third visible category. v1 with no-key Wiktionary doesn't need it. - -*libxml as a precondition, not a per-source failure.* First time =gloss-fetch-definitions= runs, probe =(libxml-parse-html-region 1 1)= on a temp buffer. If unavailable, online fetching is disabled package-wide for the session with a one-shot =user-error=: "Online fetch requires Emacs built with libxml2; manual add still works." Subsequent online attempts in the session short-circuit to that message. - -*Partial-success on per-sense HTML failures.* If libxml is available but fails on a specific sense's content, drop that sense and return the rest. Source status stays =:ok= with N-1 entries; the dropped sense logs to =*gloss-debug*=. A single bad sense doesn't poison the whole source. - -*Storage failures.* First call creates =gloss-file= and any missing parent directory with a =#+TITLE: Glossary= header. Permission denied raises =user-error= naming the path. Corrupt org file (=org-element-parse-buffer= raises) preserves the existing cache and surfaces "glossary file corrupt at line N; cache not refreshed" — operations fall back to the stale cache until the user fixes the file and runs =gloss-reload=. Term collision (saving an existing term) prompts: replace, append-with-separator, or cancel. - -*Drill.* =org-drill= checked via =featurep= before export runs. If absent: =user-error= with install hint. - -*User cancellations.* =C-g= during the picker → no save, side buffer shows the local-miss state. Empty term input from =gloss-add= → re-prompt once, then abort silently. Cancelled at the term-collision prompt → no write. - -** Testing - -Per-function test files; three categories (Normal/Boundary/Error) per function. TDD by default. Real production code via =require=, never inlined. - -*=gloss-core=.* Temp files + real =org-element-parse-buffer=. No mocking — exercises the actual file I/O and parser. - -#+begin_example -test-gloss-core--lookup.el -test-gloss-core--save.el -test-gloss-core--invalidate-on-mtime.el -test-gloss-core--corrupt-file-preserves-cache.el -test-gloss-core--alphabetical-insert.el -test-gloss-core--first-call-creates-file.el -#+end_example - -*=gloss-fetch=.* =cl-letf= mock on =url-retrieve-synchronously=, injecting canned response buffers. Captured Wiktionary fixtures in =tests/fixtures/wiktionary-*.json= — real responses for SBIR, anaphora, API, frozen once, replayed forever. - -#+begin_example -test-gloss-fetch--definitions-200-returns-ok.el -test-gloss-fetch--definitions-404-returns-no-defs.el -test-gloss-fetch--definitions-500-returns-server-error.el -test-gloss-fetch--definitions-timeout-returns-unreachable.el -test-gloss-fetch--strip-html.el -test-gloss-fetch--multi-source-walks-registry.el -test-gloss-fetch--libxml-probe.el -#+end_example - -*=gloss-display=.* The candidate-formatting helper =gloss-display--format-candidate PLIST → "[wiktionary] text..."= is pure → full N/B/E coverage. =gloss-display-show-entry= and =gloss-mode= get one smoke test each (Emacs already tests =switch-to-buffer= and major-mode definition). - -#+begin_example -test-gloss-display--format-candidate.el -test-gloss-display--show-entry-smoke.el -#+end_example - -*=gloss-drill=.* Temp file + real =org-element=. Tests assert tag/property changes on entries. - -#+begin_example -test-gloss-drill--export-all-tags-untagged.el -test-gloss-drill--export-all-skips-already-tagged.el -test-gloss-drill--export-all-no-orgdrill-installed.el -test-gloss-drill--untag-all.el -#+end_example - -*=gloss=.* The orchestration policy =gloss--orchestrate-fetch-result RESULT → SYMBOL= is a pure pattern-matcher. Tested with shaped inputs covering every result variant. - -#+begin_example -test-gloss--orchestrate-fetch-result.el -#+end_example - -*Integration tests.* Three small ones, each with a docstring naming participants per project convention. - -#+begin_example -test-integration-gloss-lookup-flow-local-hit.el -test-integration-gloss-lookup-flow-online-fall-through.el -test-integration-gloss-lookup-flow-online-failure.el -#+end_example - -*Coverage targets.* 90%+ on =gloss-core=, =gloss-fetch=, =gloss-drill=, and pure helpers in =gloss-display= / =gloss=. 70%+ on display mode-glue. Overall ≥80%. - -** Observability - -*=*gloss-debug*= log buffer.* Off until =gloss-debug= defcustom is non-nil, or session-only =gloss-toggle-debug= flips it. One timestamped, layer-prefixed line per significant event. - -#+begin_example -2026-04-28 11:14:02 [fetch:wiktionary] GET /API → 200, 12 senses -2026-04-28 11:14:02 [fetch:wiktionary] sense 7 HTML parse failed, dropping -2026-04-28 11:14:02 [core] cache hit for "anaphora" -2026-04-28 11:14:09 [core] mtime change detected, reloading cache (47 terms) -2026-04-28 11:14:11 [save] "API" → wiktionary, 11 alts not saved -#+end_example - -Per-source statuses from Error Handling land here verbatim. No personal data beyond user-supplied terms. - -*=*Messages*= for user-facing events.* Saves, picker-shown, "no definition found" messages — short single-line =message= calls, persisted in =*Messages*= via Emacs idiom. Strict separation: =*Messages*= for things the user did or asked for; =*gloss-debug*= for everything else. - -*Inspection commands.* - -- =gloss-list-terms= — completing-read over every term in the cache. Pick one to jump to it. -- =gloss-stats= — small buffer summarizing total terms, breakdown by =:source=, count of drill-tagged entries, file size, cache mtime. - -No metrics export, no telemetry, no profiling hooks — v3 territory if the package ever needs them. - -* Open Questions (will become ADRs) - -Each was decided during the brainstorm. Listed for traceability; each becomes an ADR in the gloss repo's =docs/decisions/=. - -- [ ] *ADR-1: storage path default* → =(expand-file-name "gloss.org" (or org-directory user-emacs-directory))=. Rationale: respects the user's existing =org-directory= convention; falls back gracefully. -- [ ] *ADR-2: auto-fetch on local miss* → silent fall-through with graceful network-failure path. Rationale: y/n prompt is yes 99% of the time and an annoyance the other 1%; the offline case is better handled by detecting the failure than by pre-asking permission. -- [ ] *ADR-3: drill direction* → =:DRILL_CARD_TYPE: twosided=. Rationale: tests both recognition and recall over time without doubling the deck. -- [ ] *ADR-4: HTML strip strategy* → =libxml-parse-html-region= (plain text only, no italic/bold preservation). Rationale: more robust than regex on edge cases; libxml2 is standard on Linux/Mac; ~30 lines. - -* Next Steps - -1. *Scaffold the repo.* =~/code/gloss= with the claude-template structure: =.ai/= and =todo.org= and =inbox/= gitignored, =Makefile= for tests/lint/compile, =README.org= placeholder, =LICENSE=, package skeleton (=gloss.el= with package-header autoload entry). -2. *Set up remotes.* Bare repo on cjennings.net at =/var/cjennings/git/gloss.git/= with the existing post-receive hook pattern that mirrors to =github.com/cjennings/gloss=. -3. *Decompose into todo.org tasks.* One TODO per layer, in implementation order: core → fetch → display → drill → entry-point → integration tests → README. Each task carries its acceptance criteria from this design. -4. *Implement v1 layer by layer*, TDD per project rules. Run =/start-work= once per task. -5. *First-week shakedown.* Use the package on real terms for a week. File issues against any rough edges as v1.1 tasks. -6. *Record the four ADRs* in =docs/decisions/= once the repo exists. - -* Status - -Draft. Pending: repo scaffold, ADR records, implementation. diff --git a/docs/specs/init-load-graph-spec.org b/docs/specs/init-load-graph-spec.org index 0feebfc9..33ed0d34 100644 --- a/docs/specs/init-load-graph-spec.org +++ b/docs/specs/init-load-graph-spec.org @@ -8,6 +8,7 @@ :PROPERTIES: :ID: e1fd137e-e164-42f4-a658-f4d32fbe3228 :END: +- 2026-07-10 Fri @ 22:50:03 -0500 — reconciled the programming target to shipped decisions: generic LSP policy consolidated under =prog-general= (not =prog-lsp=, which was folded in and deleted, commit dfdb3580), and tree-sitter auto-install gated to ='prompt=. Both were owned items of this spec; recording the outcome, keyword stays DOING for the remaining load-graph work. - 2026-07-04 Sat @ 15:30:41 -0500 — retrofitted to status-heading convention; keyword DOING from existing :STATUS: doing * Status @@ -312,7 +313,7 @@ Category key: | =video-audio-recording= | O/D/S | command-loaded | External process/device probing only on command. | | =transcription-config= | O/D/P | command-loaded | Auth/process workflow. | | =weather-config= | O/D/P | command-loaded | Optional command. | -| =prog-general= | C/P/S | eager or hooks | Projectile, treesit policy, LSP ownership concerns. | +| =prog-general= | C/P/S | eager or hooks | Projectile, treesit 'prompt, sole LSP policy owner. | | =test-runner= | C/L | eager command entry | Test keymap and project-scoped state. | | =vc-config= | C/P | eager command entry | Magit/git keymap; clone command hardening separate. | | =flycheck-config= | C/P | hooks | General linting. | @@ -320,7 +321,6 @@ Category key: | =prog-c= | D/P | mode-loaded | C hooks and compile command. | | =prog-go= | D/P | mode-loaded | Go hooks/LSP. | | =prog-lisp= | D/P | mode-loaded | Lisp package config. | -| =prog-lsp= | C/P | package policy owner | Should consolidate generic LSP policy. | | =prog-shell= | D/P/S | mode-loaded | after-save executable hook should be opt-in or scoped. | | =prog-python= | D/P | mode-loaded | Python hooks/LSP. | | =prog-webdev= | D/P | mode-loaded | Webdev modes/LSP. | @@ -603,15 +603,20 @@ Programming target: - Keep generic programming defaults and F-key command entry points available. - Load language-specific modules by major mode. -- Consolidate generic LSP policy under =prog-lsp=. - - Move to =prog-lsp=: global LSP toggles such as =lsp-idle-delay=, - =lsp-log-io=, =lsp-enable-folding=, =lsp-enable-snippet=, - =lsp-headerline-breadcrumb-enable=, and file-watch ignore lists. - - Keep per-language: server client settings such as - =lsp-clients-clangd-args= and =lsp-pyright-*=, plus language-mode hook - wiring. -- Tree-sitter grammar auto-install is always on; the project policy is global - allow. =treesit-auto-install= is =t= without per-language conditionals. +- Generic LSP policy is consolidated under =prog-general= (done 2026-07-10, commit + dfdb3580). The original plan named =prog-lsp= as owner, but that module was + required by nothing and never loaded, so its config was dead; folding it into the + module that actually loads (=prog-general=) and deleting it was the working fix. + - In =prog-general=: global LSP toggles such as =lsp-idle-delay=, =lsp-log-io=, + =lsp-enable-folding=, =lsp-enable-snippet=, the quiet-UI toggles, and the + file-watch ignore list. + - Kept per-language: server client settings such as =lsp-clients-clangd-args= and + =lsp-pyright-*=, plus the =lsp-deferred= language-mode hook wiring. + - Remaining: several language modules call =lsp-deferred= from both a local setup + function and a package hook; collapse each to one hook path per language. +- Tree-sitter grammar auto-install is gated to ='prompt= (done). Batch/test runs never + auto-install, and =cj/install-treesit-grammars= is the explicit bootstrap for a new + machine. Org target: @@ -625,9 +630,10 @@ Org target: =cj-cache.el= extraction is owned by utility-consolidation Phase 5 and may follow. -The =prog-lsp= consolidation and tree-sitter policy decisions are owned by this -load-graph project. Utility consolidation owns reusable helper extraction, not -programming policy. +The LSP consolidation and tree-sitter policy decisions are owned by this +load-graph project. Both landed 2026-07-10 (LSP under =prog-general=, tree-sitter at +='prompt=). Utility consolidation owns reusable helper extraction, not programming +policy. Exit criteria: diff --git a/docs/specs/messenger-unification-spec.org b/docs/specs/messenger-unification-spec.org index c92ba1a7..7847fd04 100644 --- a/docs/specs/messenger-unification-spec.org +++ b/docs/specs/messenger-unification-spec.org @@ -8,6 +8,7 @@ :PROPERTIES: :ID: 4bfc2011-8ffc-4765-8886-91df12141171 :END: +- 2026-07-14 Tue @ 01:10:00 -0500 — premise shift: the signel client was retired to archive/ (agents drive Signal via signal-cli), so the registry example, the "signel remains the running reference" language, and the backend list all need a rewrite before this leaves DRAFT — the live in-Emacs backends are now telega and Slack, with smoke (~/code/smoke) still the future native adopter. Also landed since the 06-11 survey: slack-config gained signel-shape notification hardening (c69f2f56) and telega notifications are on (5bc5ef7a), so the shared cj/messenger-notify extraction has two live call sites ready. - 2026-07-04 Sat @ 15:30:41 -0500 — retrofitted to status-heading convention; keyword DRAFT from existing :STATUS: not-started (held open for more ideas) * Problem diff --git a/docs/specs/signal-client-spec.org b/docs/specs/signal-client-spec.org index 13f67115..56c9ea1a 100644 --- a/docs/specs/signal-client-spec.org +++ b/docs/specs/signal-client-spec.org @@ -3,10 +3,12 @@ #+TODO: TODO | DONE #+TODO: DRAFT READY DOING | IMPLEMENTED SUPERSEDED CANCELLED -* DOING Design: Signal client in Emacs (forked signel) +* IMPLEMENTED Design: Signal client in Emacs (forked signel) :PROPERTIES: :ID: 0cabd6ee-c458-47b5-a8af-3ee054b25821 :END: +- 2026-07-14 Tue @ 01:10:00 -0500 — RETIRED from the config (Craig's call, ~an hour after the IMPLEMENTED flip): agents drive Signal via signal-cli / signal-mcp, so the interactive in-Emacs client earns no keep. signal-config.el and its seven test files moved to archive/ (see archive/README.org); the C-; M prefix unregistered; the ~/code/signel fork repo untouched. Keyword stays IMPLEMENTED as the honest record of what was built. +- 2026-07-14 Tue @ 01:01:32 -0500 — IMPLEMENTED (Craig's call): v1 is shipped and in daily use — forked signel engine, contact picker with cached contacts (lifecycle hardened 703b4841 / 1296cc45), notifications with sound gating and script-with-fallback delivery, bottom-30% window rule. Next-generation client work belongs to the smoke project (~/code/smoke, its own architecture spec), which the messenger-unification spec designates as the ground-up replacement; signal-config.el stays the running reference until smoke reaches parity. - 2026-07-04 Sat @ 15:30:41 -0500 — retrofitted to status-heading convention; keyword DOING from existing :STATUS: doing * Problem @@ -78,7 +78,6 @@ (require 'slack-config) ;; slack client via emacs-slack (require 'pearl-config) ;; Linear.app issue tracking via pearl (deepsat + craigjennings) (require 'telega-config) ;; telegram client via telega.el (TDLib in docker) -(require 'signal-config) ;; signal client via forked signel + signal-cli (require 'eshell-config) ;; emacs shell configuration (require 'eat-config) ;; EAT terminal + the F12 dock-and-remember toggle (require 'ai-term) ;; in-Emacs Claude launcher (vertical-split EAT terminal) @@ -162,6 +161,7 @@ ;; 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. (with-eval-after-load 'malyon (require 'games-config)) +(require 'takuzu-config) ;; Takuzu (Binairo) puzzle on M-x takuzu; package in ~/code/takuzu ;; ------------------------------- Misc Modules -------------------------------- diff --git a/modules/ai-term-backend-eat.el b/modules/ai-term-backend-eat.el index 9a166ff8..be84ef25 100644 --- a/modules/ai-term-backend-eat.el +++ b/modules/ai-term-backend-eat.el @@ -100,7 +100,7 @@ typed into a bare shell. Returns the poll timer." (cancel-timer timer)))))) timer)) -(defun cj/--ai-term-show-or-create (dir name) +(defun cj/--ai-term-show-or-create (dir name &optional agent-command) "Show or create the AI-term buffer for project DIR with buffer NAME. If a buffer named NAME exists with a live process, display it. If @@ -108,6 +108,10 @@ the buffer exists but its process is dead, kill it and recreate. If no such buffer exists, create a new EAT terminal in DIR and send the project's tmux launch command (see `cj/--ai-term-launch-command') so the same project basename reattaches across Emacs restarts. +AGENT-COMMAND, when non-nil, is the full agent launch command for a +fresh session (the multi-backend picker's choice); nil falls back to +`cj/ai-term-agent-command'. A reattach ignores it (`tmux new-session +-A' attaches without running the command). EAT runs a plain shell with no auto-tmux hook, so the named `tmux new-session -A' launch command is the only thing that starts the @@ -148,7 +152,7 @@ buffer." (with-current-buffer buf (cj/--ai-term-apply-accent buf) (cj/--ai-term-send-string - buf (concat (cj/--ai-term-launch-command dir) "\n"))) + buf (concat (cj/--ai-term-launch-command dir agent-command) "\n"))) (when fresh (cj/--ai-term-schedule-color buf (cj/--ai-term-project-color dir))) (display-buffer buf) diff --git a/modules/ai-term-sessions.el b/modules/ai-term-sessions.el index 99585a70..fab6b0a6 100644 --- a/modules/ai-term-sessions.el +++ b/modules/ai-term-sessions.el @@ -157,7 +157,7 @@ looked up in SESSIONS, so the lossy whitespace->hyphen transform in `cj/--ai-term-tmux-session-name' never needs reversing." (and (member (cj/--ai-term-tmux-session-name dir) sessions) t)) -(defun cj/--ai-term-launch-command (dir) +(defun cj/--ai-term-launch-command (dir &optional agent-command) "Return the shell command line that runs the AI tool in a project tmux session. Uses `tmux new-session -A' so a second toggle on the same project reattaches @@ -167,9 +167,12 @@ comes from `cj/--ai-term-tmux-session-name'; the first window is named window auto-names after its command and the two read distinctly. The shell command run on first creation is - <cj/ai-term-agent-command>; exec bash + <agent command>; exec bash so the tmux window survives the AI command exiting -- the session stays -alive with a bare bash prompt for recovery, and reattach works the same way." +alive with a bare bash prompt for recovery, and reattach works the same way. +AGENT-COMMAND overrides `cj/ai-term-agent-command' for the fresh-session +case (the multi-backend picker passes the chosen runtime's command); on a +reattach `tmux new-session -A' ignores the command either way." (let ((session (cj/--ai-term-tmux-session-name dir)) (start-dir (expand-file-name dir))) ;; Pass the inner shell-command-string through `shell-quote-argument' @@ -184,7 +187,8 @@ alive with a bare bash prompt for recovery, and reattach works the same way." (shell-quote-argument cj/ai-term-tmux-window-name) (shell-quote-argument start-dir) (shell-quote-argument - (concat cj/ai-term-agent-command "; exec bash"))))) + (concat (or agent-command cj/ai-term-agent-command) + "; exec bash"))))) (defun cj/--ai-term-kill-tmux-session (session) "Kill the tmux SESSION via `tmux kill-session -t SESSION'. diff --git a/modules/ai-term.el b/modules/ai-term.el index e0706abb..9d7be47e 100644 --- a/modules/ai-term.el +++ b/modules/ai-term.el @@ -46,10 +46,24 @@ (defcustom cj/ai-term-agent-command "claude \"Read .ai/protocols.org and follow all instructions.\"" - "Shell command sent to a fresh AI-term to start the agent. + "Shell command for the default (\"claude\") agent runtime. -The default invokes the Claude Code CLI; set it to whatever terminal -agent you run (aider, an open-source LLM TUI, etc.)." +Sent to a fresh AI-term when no other runtime is picked; also the +fallback when launch paths bypass the runtime picker (e.g. attaching a +detached session, where the command is ignored anyway). Non-Claude +runtimes compose their commands from `cj/ai-term-agent-prompt' instead +-- see `cj/--ai-term-runtime-command'." + :type 'string + :group 'ai-term) + +(defcustom cj/ai-term-agent-prompt + "Read .ai/protocols.org and follow all instructions." + "Opening instructions passed to non-Claude agent runtimes. + +Claude, Codex, and codex --oss all take the opening instructions as a +positional prompt, so this one string serves every runtime; only the +command in front of it varies (the \"claude\" runtime carries its full +line in `cj/ai-term-agent-command' for backward compatibility)." :type 'string :group 'ai-term) @@ -240,6 +254,80 @@ without firing real `display-buffer' or `quit-window' calls." (car buffers)))) (t '(pick-project)))))))) +;; ------------------------- Agent runtime selection --------------------------- +;; A fresh session can run Claude, Codex (ChatGPT), or a local model through +;; codex --oss (ollama). Runtime names and launch strings mirror the rulesets +;; bin/ai launcher so the two launchers stay one mental model: "claude", +;; "codex", "local:<model>". The choice list itself comes from +;; `ai --print-runtimes' when that launcher is installed (single source of +;; truth, including the live ollama model scan with its own timeout); without +;; it a static claude/codex list stands in. + +(defun cj/--ai-term-runtime-command (runtime) + "Return the full agent shell command for RUNTIME. +RUNTIME is \"claude\" (or nil, both meaning `cj/ai-term-agent-command' +verbatim), \"codex\", or \"local:<model>\" for an ollama model via +codex --oss. The non-Claude commands append `cj/ai-term-agent-prompt' +as the positional opening prompt. An unknown RUNTIME signals a +`user-error' rather than launching something half-formed. The explicit +--local-provider flag is deliberate: setting the provider through +config.toml silently does nothing (rulesets, 2026-07-13)." + (cond + ((or (null runtime) (equal runtime "claude")) + cj/ai-term-agent-command) + ((equal runtime "codex") + (concat "codex " (shell-quote-argument cj/ai-term-agent-prompt))) + ((string-prefix-p "local:" runtime) + (let ((model (substring runtime (length "local:")))) + (when (string-empty-p model) + (user-error "Agent runtime %s names no ollama model" runtime)) + (concat "codex --oss --local-provider=ollama -m " + (shell-quote-argument model) " " + (shell-quote-argument cj/ai-term-agent-prompt)))) + (t (user-error "Unknown agent runtime: %s" runtime)))) + +(defun cj/--ai-term-parse-runtime-lines (output) + "Parse `ai --print-runtimes' OUTPUT into an alist of (NAME . LABEL). +Each line is \"NAME — LABEL\"; blank lines and lines without the +separator are dropped, so a stray warning in the output degrades to a +shorter list instead of a parse error." + (delq nil + (mapcar (lambda (line) + (when (string-match "\\`\\(.+?\\) — \\(.+\\)\\'" line) + (cons (match-string 1 line) (match-string 2 line)))) + (split-string output "\n" t)))) + +(defun cj/--ai-term-runtime-choices () + "Return the agent runtime choices as an alist of (NAME . LABEL). +Shells out to `ai --print-runtimes' when the launcher is installed -- +that keeps the two launchers' lists identical and reuses its live +ollama scan (which carries its own dead-server timeout). When the +launcher is absent, errors, or prints nothing parseable, a static +claude-first list stands in." + (or (when-let* ((ai (executable-find "ai"))) + (with-temp-buffer + (when (eq 0 (ignore-errors + (process-file ai nil t nil "--print-runtimes"))) + (cj/--ai-term-parse-runtime-lines (buffer-string))))) + '(("claude" . "Claude Code") + ("codex" . "ChatGPT (Codex CLI)")))) + +(defun cj/--ai-term-pick-runtime () + "Prompt for the agent runtime of a fresh session; RET picks the first. +The first choice is claude, so launching a project stays Enter-Enter +for the common case. Labels annotate the candidates." + (let* ((choices (cj/--ai-term-runtime-choices)) + (default (caar choices))) + (completing-read + (format "Agent runtime (default %s): " default) + (cj/completion-table-annotated + 'ai-term-runtime + (lambda (cand) + (when-let* ((label (cdr (assoc cand choices)))) + (format " %s" label))) + choices) + nil t nil nil default))) + (defun cj/ai-term-pick-project (&optional arg) "Pick an AI-agent project and open or reuse its EAT terminal. @@ -254,12 +342,25 @@ With prefix ARG, display the buffer without selecting its window. Bound to C-; a s -- always shows the project picker, even when an agent buffer is currently displayed. +A genuinely fresh launch (no live agent buffer AND no surviving tmux +session) also asks which agent runtime to run -- claude, codex, or a +local model; RET keeps claude, so the common case stays Enter-Enter. +Reattaches and redisplays never ask: the session already runs whatever +it runs. + EAT renders in terminal frames as well as GUI frames, so this launches from either." (interactive "P") (let* ((dir (cj/--ai-term-pick-project)) (name (cj/--ai-term-buffer-name dir)) - (buf (cj/--ai-term-show-or-create dir name))) + (existing (get-buffer name)) + (fresh (and (not (and existing + (cj/--ai-term-process-live-p existing))) + (not (cj/--ai-term-session-active-p + dir (cj/--ai-term-live-tmux-sessions))))) + (command (when fresh + (cj/--ai-term-runtime-command (cj/--ai-term-pick-runtime)))) + (buf (cj/--ai-term-show-or-create dir name command))) (unless arg (let ((win (get-buffer-window buf))) (when win (select-window win)))) diff --git a/modules/auto-dim-config.el b/modules/auto-dim-config.el index efae5341..faa4101c 100644 --- a/modules/auto-dim-config.el +++ b/modules/auto-dim-config.el @@ -23,6 +23,14 @@ ;; terminal background, so -- unlike the old ghostel/vterm engines, which baked ;; color per-terminal with no per-window hook -- they follow the per-window ;; dimmed background like any other buffer. +;; +;; One caveat, so nobody chases it through this alist: ANSI-coloured spans in a +;; terminal keep their colour when dimmed. EAT attaches those as anonymous face +;; plists carrying a literal foreground, e.g. (:foreground "#AFD7FF" :inherit +;; (eat-term-font-0)), and `face-remap-add-relative' only reaches named faces. +;; There is no face name to add below. Reaching them would need an overlay +;; (whose face outranks a text property), not a remap. Background and uncoloured +;; text still dim, which is close enough; this is deliberate, not an oversight. ;;; Code: @@ -75,6 +83,76 @@ focus cue on a split-displayed dashboard, accepted as a fair trade." (font-lock-builtin-face . (auto-dim-other-buffers . nil)) (font-lock-preprocessor-face . (auto-dim-other-buffers . nil)) (font-lock-warning-face . (auto-dim-other-buffers . nil)) + ;; Faces that sit AHEAD of a mapped face in a face list and outrank it, so + ;; the text under them stayed lit until each was named here: a table header + ;; renders as (org-table-header org-table), a TODO line as + ;; (org-faces-todo org-level-3). tests/test-auto-dim-config.el walks a + ;; fontified org buffer and fails when a built-in org face is left out. + (org-table-header . (auto-dim-other-buffers . nil)) + (org-formula . (auto-dim-other-buffers . nil)) + (org-checkbox . (auto-dim-other-buffers . nil)) + (org-checkbox-statistics-done . (auto-dim-other-buffers . nil)) + (org-headline-done . (auto-dim-other-buffers . nil)) + (org-drill-visible-cloze-face . (auto-dim-other-buffers . nil)) + ;; org-indent inherits org-hide, so its foreground IS the background: that + ;; is what makes indent prefixes invisible. -hide face, never the flat dim. + (org-indent . (auto-dim-other-buffers-hide . nil)) + ;; org-superstar draws heading stars and list bullets, and puts its own face + ;; ahead of the org face beneath, so a star renders as + ;; (org-superstar-header-bullet org-level-1) and outranks the dimmed level. + ;; Without these three, bullets are the last thing left lit in a dimmed window. + (org-superstar-header-bullet . (auto-dim-other-buffers . nil)) + (org-superstar-item . (auto-dim-other-buffers . nil)) + (org-superstar-first . (auto-dim-other-buffers . nil)) + ;; org-superstar-leading takes the -hide face, not the flat dim: its + ;; foreground IS the background colour, which is what keeps hidden leading + ;; stars invisible. Flat-dimming it would reveal them. Same as org-hide. + (org-superstar-leading . (auto-dim-other-buffers-hide . nil)) + ;; The built-in link faces, distinct from org-link below. They fontify + ;; links in help, info, and customize buffers. Both carry :underline t, + ;; which survives the relative remap, so a dimmed link still reads as one. + (link . (auto-dim-other-buffers . nil)) + (link-visited . (auto-dim-other-buffers . nil)) + ;; Org structure faces flat-dim like font-lock rather than getting + ;; -dim variants: the active theme gives org-level-1..8 one shared + ;; foreground and no height or weight, so there is no level-by-colour + ;; signal to preserve. The remap is relative, so org-link keeps its + ;; underline and the heading stars / org-indent keep conveying depth. + ;; That premise is theme-dependent -- a theme that colours heading + ;; levels distinctly would make the flat dim discard real signal, and + ;; those levels would then want -dim variants like the keywords below. + (org-level-1 . (auto-dim-other-buffers . nil)) + (org-level-2 . (auto-dim-other-buffers . nil)) + (org-level-3 . (auto-dim-other-buffers . nil)) + (org-level-4 . (auto-dim-other-buffers . nil)) + (org-level-5 . (auto-dim-other-buffers . nil)) + (org-level-6 . (auto-dim-other-buffers . nil)) + (org-level-7 . (auto-dim-other-buffers . nil)) + (org-level-8 . (auto-dim-other-buffers . nil)) + (org-link . (auto-dim-other-buffers . nil)) + (org-tag . (auto-dim-other-buffers . nil)) + ;; org-todo and org-priority are deliberately absent: they are keyword + ;; class, like the org-faces-* set below, and flat-dimming them would + ;; erase the status colour those -dim variants exist to preserve. + ;; Document header: #+TITLE:, #+AUTHOR:, #+ARCHIVE: and their values. + (org-document-title . (auto-dim-other-buffers . nil)) + (org-document-info . (auto-dim-other-buffers . nil)) + (org-document-info-keyword . (auto-dim-other-buffers . nil)) + (org-meta-line . (auto-dim-other-buffers . nil)) + ;; Inline markup and source blocks. + (org-code . (auto-dim-other-buffers . nil)) + (org-verbatim . (auto-dim-other-buffers . nil)) + (org-block-begin-line . (auto-dim-other-buffers . nil)) + (org-block-end-line . (auto-dim-other-buffers . nil)) + ;; Drawers, properties, and planning lines. + (org-drawer . (auto-dim-other-buffers . nil)) + (org-special-keyword . (auto-dim-other-buffers . nil)) + (org-property-value . (auto-dim-other-buffers . nil)) + (org-date . (auto-dim-other-buffers . nil)) + ;; Tables and the fold indicator. + (org-table . (auto-dim-other-buffers . nil)) + (org-table-row . (auto-dim-other-buffers . nil)) + (org-ellipsis . (auto-dim-other-buffers . nil)) ;; Org TODO-keyword + priority faces dim to their own -dim variant ;; (a darker shade of the same colour) rather than the flat gray, so ;; a dimmed window's keywords stay recognizable. Faces are defined diff --git a/modules/calendar-sync-recurrence.el b/modules/calendar-sync-recurrence.el index 72576a6f..2689cdd6 100644 --- a/modules/calendar-sync-recurrence.el +++ b/modules/calendar-sync-recurrence.el @@ -193,21 +193,30 @@ Handles both simple values and values with parameters like TZID." (when (and event-str (stringp event-str) (not (string-empty-p event-str))) (let ((exdates '()) (pos 0)) - ;; Find all EXDATE lines + ;; Find all EXDATE lines. One line may carry several comma-separated + ;; datetimes (RFC 5545); split them so each is excluded individually. + ;; Capture the match end BEFORE split-string: its internal matching + ;; clobbers the match data, and reading (match-end 0) afterwards made + ;; pos jump backwards to a comma offset inside the value -- re-matching + ;; the same line forever and growing the list until the OOM killer + ;; intervened (took two agent sessions down on 2026-07-13). (while (string-match "^EXDATE[^:\n]*:\\([^\n]+\\)" event-str pos) - (push (match-string 1 event-str) exdates) - (setq pos (match-end 0))) + (let ((line-end (match-end 0))) + (dolist (val (split-string (match-string 1 event-str) "," t)) + (push val exdates)) + (setq pos line-end))) (nreverse exdates)))) (defun calendar-sync--get-exdate-line (event-str exdate-value) "Find the full EXDATE line containing EXDATE-VALUE from EVENT-STR. Returns the complete line like -`EXDATE;TZID=America/New_York:20260210T130000'. -Returns nil if not found." +`EXDATE;TZID=America/New_York:20260210T130000'. Matches the value anywhere +in the value list, so a comma-separated line's shared TZID reaches every +value on it. Returns nil if not found." (when (and event-str (stringp event-str) exdate-value) - (let ((pattern (format "^\\(EXDATE[^:]*:%s\\)" (regexp-quote exdate-value)))) + (let ((pattern (format "^EXDATE[^:\n]*:[^\n]*%s" (regexp-quote exdate-value)))) (when (string-match pattern event-str) - (match-string 1 event-str))))) + (match-string 0 event-str))))) (defalias 'calendar-sync--parse-exdate #'calendar-sync--parse-ics-datetime "Parse EXDATE value. See `calendar-sync--parse-ics-datetime'.") diff --git a/modules/calendar-sync-source.el b/modules/calendar-sync-source.el index 15c91c59..10dea66e 100644 --- a/modules/calendar-sync-source.el +++ b/modules/calendar-sync-source.el @@ -138,39 +138,25 @@ Checks `cj/debug-modules' for symbol `calendar-sync' or t (all)." ;;; .ics Fetch -(defun calendar-sync--fetch-ics (url callback) - "Fetch .ics file from URL asynchronously using curl. -Calls CALLBACK with the .ics content as string (normalized to Unix line endings) -or nil on error. CALLBACK signature: (lambda (content) ...). - -The fetch happens asynchronously and doesn't block Emacs. The callback is -invoked when the fetch completes, either successfully or with an error." - (condition-case err - (let ((buffer (generate-new-buffer " *calendar-sync-curl*"))) - (make-process - :name "calendar-sync-curl" - :buffer buffer - :command (list "curl" "-s" "-L" "--fail" - "--connect-timeout" "10" - "--max-time" (number-to-string calendar-sync-fetch-timeout) - url) - :sentinel - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (let ((buf (process-buffer process))) - (when (buffer-live-p buf) - (let ((content - (with-current-buffer buf - (if (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)) - (calendar-sync--normalize-line-endings (buffer-string)) - (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" (string-trim event)) - nil)))) - (kill-buffer buf) - (funcall callback content)))))))) - (error - (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) - (funcall callback nil)))) +(defun calendar-sync--fetch-sentinel-finish (success event temp-file buffer callback) + "Finish an async .ics fetch. +SUCCESS is non-nil when curl exited cleanly, EVENT the process event +string, TEMP-FILE the curl output path, BUFFER the process buffer, and +CALLBACK the continuation. On success CALLBACK receives TEMP-FILE (the +caller owns deleting it); on failure the error is logged, TEMP-FILE is +removed, and CALLBACK receives nil. Extracted from the sentinel so the +success, failure, and cleanup branches are unit-testable without a live +curl process." + (when (buffer-live-p buffer) + (unless success + (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" + (string-trim event))) + (kill-buffer buffer)) + (if success + (funcall callback temp-file) + (when (file-exists-p temp-file) + (delete-file temp-file)) + (funcall callback nil))) (defun calendar-sync--fetch-ics-file (url callback) "Fetch .ics from URL to a temp file asynchronously. @@ -190,19 +176,10 @@ owns deleting the temp file after a successful callback." :sentinel (lambda (process event) (when (memq (process-status process) '(exit signal)) - (let ((buf (process-buffer process)) - (success (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)))) - (when (buffer-live-p buf) - (unless success - (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" - (string-trim event))) - (kill-buffer buf)) - (if success - (funcall callback temp-file) - (when (file-exists-p temp-file) - (delete-file temp-file)) - (funcall callback nil))))))) + (calendar-sync--fetch-sentinel-finish + (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0)) + event temp-file (process-buffer process) callback))))) (error (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) (funcall callback nil)))) diff --git a/modules/config-utilities.el b/modules/config-utilities.el index 72427ef9..4332f407 100644 --- a/modules/config-utilities.el +++ b/modules/config-utilities.el @@ -131,12 +131,18 @@ Signals `user-error' if METHOD-SYMBOL is nil or not fboundp." ;;; ----------------------------- Config Compilation ---------------------------- +(defun cj/--native-comp-p () + "Return non-nil when native compilation is available on this build. +Detected with `native-comp-available-p', not `boundp' of the async function: +`native-compile-async' is a function, so `boundp' is always nil." + (and (fboundp 'native-comp-available-p) (native-comp-available-p))) + (defun cj/--recompile-emacs-home (dir &optional native-p) "Delete all .elc/.eln files under DIR, then recompile. NATIVE-P chooses native compilation when non-nil, byte otherwise. -Also removes the eln (native) or elc (byte) cache directory. +Also removes the eln-cache (native) or elc (byte) cache directory. Returns the compilation method used: \\='native or \\='byte." - (let ((elt-dir (expand-file-name (if native-p "eln" "elc") dir))) + (let ((elt-dir (expand-file-name (if native-p "eln-cache" "elc") dir))) (message "Deleting all compiled files in %s" dir) (dolist (file (directory-files-recursively dir "\\(\\.elc\\|\\.eln\\)$")) (delete-file file)) @@ -157,7 +163,7 @@ Returns the compilation method used: \\='native or \\='byte." "Delete all compiled files in the Emacs home before recompiling. Recompile natively when supported, otherwise fall back to byte compilation." (interactive) - (let* ((native (boundp 'native-compile-async)) + (let* ((native (cj/--native-comp-p)) (mode-word (if native "native" "byte"))) (if (yes-or-no-p (format "Please confirm recursive %s recompilation of %s: " diff --git a/modules/custom-buffer-file.el b/modules/custom-buffer-file.el index 25555b53..0ca06cf9 100644 --- a/modules/custom-buffer-file.el +++ b/modules/custom-buffer-file.el @@ -51,8 +51,13 @@ (declare-function ps-print-buffer-with-faces "ps-print") (declare-function ps-print-region-with-faces "ps-print") -;; mm-decode for email viewing (mm-handle-type is a macro, needs early require) -(require 'mm-decode) +;; mm-handle-type is a macro used in `cj/--email-handle-is-type-p', so mm-decode +;; is only needed at compile time here; `cj/view-email-in-buffer' requires it at +;; runtime before any mm-* call, so the eager startup require is unnecessary. +(eval-when-compile (require 'mm-decode)) +(declare-function mm-dissect-buffer "mm-decode") +(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 @@ -236,13 +241,16 @@ blast-radius operation on this map. The VC path is not double-prompted: (cj/--delete-buffer-and-file)))))) (defun cj/copy-link-to-buffer-file () - "Copy the full file:// path of the current buffer's source file to the kill ring." + "Copy the full file:// path of the current buffer's source file to the kill ring. +Signal a `user-error' when the buffer is not visiting a file, matching the +other copy commands in this module." (interactive) (let ((file-path (buffer-file-name))) - (when file-path - (setq file-path (concat "file://" file-path)) - (kill-new file-path) - (message "Copied file link to kill ring: %s" file-path)))) + (unless file-path + (user-error "Buffer is not visiting a file")) + (setq file-path (concat "file://" file-path)) + (kill-new file-path) + (message "Copied file link to kill ring: %s" file-path))) (defvar cj/buffer-source-functions '((eww-mode . (lambda () (eww-current-url))) @@ -941,19 +949,24 @@ Signals an error if: (let* ((handle (mm-dissect-buffer t)) (displayable-part (cj/--email-find-displayable-part handle)) (buffer-name (format "*Email: %s*" (file-name-nondirectory buffer-file-name)))) - (unless displayable-part - (user-error "No displayable content found in email")) - (with-current-buffer (get-buffer-create buffer-name) - (let ((inhibit-read-only t)) - (erase-buffer) - (mm-insert-part displayable-part) - (goto-char (point-min)) - (when (cj/--email-handle-is-type-p displayable-part "text/html") - (shr-render-region (point-min) (point-max))) - (goto-char (point-min)) - (special-mode))) - (mm-destroy-parts handle) - (switch-to-buffer buffer-name))) + ;; `mm-dissect-buffer' allocates handles that must be freed even when we + ;; bail out early (no displayable part), so destroy them from the cleanup + ;; form rather than after the body. + (unwind-protect + (progn + (unless displayable-part + (user-error "No displayable content found in email")) + (with-current-buffer (get-buffer-create buffer-name) + (let ((inhibit-read-only t)) + (erase-buffer) + (mm-insert-part displayable-part) + (goto-char (point-min)) + (when (cj/--email-handle-is-type-p displayable-part "text/html") + (shr-render-region (point-min) (point-max))) + (goto-char (point-min)) + (special-mode))) + (switch-to-buffer buffer-name)) + (mm-destroy-parts handle)))) ;; --------------------------- Buffer And File Keymap -------------------------- diff --git a/modules/custom-case.el b/modules/custom-case.el index 87622695..dde2d6c1 100644 --- a/modules/custom-case.el +++ b/modules/custom-case.el @@ -49,13 +49,14 @@ (downcase-region (car bounds) (cdr bounds)) (user-error "No symbol at point"))))) -(defun cj/--title-case-capitalize-word-p (word is-first prev-word-end word-skip chars-skip-reset) +(defun cj/--title-case-capitalize-word-p (word is-first is-last prev-word-end word-skip chars-skip-reset) "Return non-nil when WORD at point should be capitalized in title case. Point is at WORD's first character. WORD is capitalized when it is the first -word (IS-FIRST), is not a minor skip word (in WORD-SKIP), or immediately follows -a skip-reset character (one of CHARS-SKIP-RESET: : ! ?), reached by skipping -blanks back to PREV-WORD-END." +word (IS-FIRST) or the last word (IS-LAST), is not a minor skip word (in +WORD-SKIP), or immediately follows a skip-reset character (one of +CHARS-SKIP-RESET: : ! ? .), reached by skipping blanks back to PREV-WORD-END." (or is-first + is-last (not (member word word-skip)) (save-excursion (and (not (zerop (skip-chars-backward "[:blank:]" prev-word-end))) @@ -67,22 +68,30 @@ Title case is a capitalization convention where major words are capitalized, and most minor words are lowercase. Nouns, verbs (including linking verbs), adjectives, adverbs,pronouns, and all words of four letters or more are considered major words. Short (i.e., three letters or fewer) conjunctions, -short prepositions, and all articles are considered minor words." +short prepositions, and all articles are considered minor words. The first +and last words are always capitalized, and a word following a sentence-ending +period (or a colon, exclamation mark, or question mark) restarts +capitalization even when it is a minor word." (interactive) (let ((beg nil) (end nil) (prev-word-end nil) - ;; Allow capitals for skip characters after this, so: - ;; Warning: An Example - ;; Capitalizes the `An'. - (chars-skip-reset '(?: ?! ??)) + (last-word-start nil) + ;; Restart capitalization for a minor word after one of these, so + ;; "Warning: An Example" capitalizes the "An" and a sentence-ending + ;; period capitalizes the next word ("End. The Next"). + (chars-skip-reset '(?: ?! ?? ?.)) ;; Don't capitalize characters directly after these. e.g. - ;; "Foo-bar" or "Foo\bar" or "Foo's". + ;; "Foo-bar" or "Foo\bar" or "Foo's". A period is here too, so + ;; "3.14" and "foo.bar" are left alone; a period followed by a + ;; blank still restarts via `chars-skip-reset' above. (chars-separator '(?\\ ?- ?' ?.)) (word-chars "[:alnum:]") + ;; "is" and other linking verbs are major words, so they are not in + ;; this minor-word skip list. (word-skip (list "a" "an" "and" "as" "at" "but" "by" - "for" "if" "in" "is" "nor" "of" + "for" "if" "in" "nor" "of" "on" "or" "so" "the" "to" "yet")) (is-first t)) (cond @@ -92,6 +101,15 @@ short prepositions, and all articles are considered minor words." (t (setq beg (line-beginning-position)) (setq end (line-end-position)))) + ;; The last word is always capitalized in title case, so find its start + ;; once: from END, skip back over any trailing non-word chars, then over + ;; the word itself. + (setq last-word-start + (save-excursion + (goto-char end) + (skip-chars-backward (concat "^" word-chars) beg) + (skip-chars-backward word-chars beg) + (point))) (save-excursion ;; work on uppercased text (e.g., headlines) by downcasing first (downcase-region beg end) @@ -112,7 +130,8 @@ short prepositions, and all articles are considered minor words." (unless (string-equal c-orig c-up) (let ((word (buffer-substring-no-properties (point) word-end))) (when (cj/--title-case-capitalize-word-p - word is-first prev-word-end word-skip chars-skip-reset) + word is-first (= (point) last-word-start) + prev-word-end word-skip chars-skip-reset) (delete-region (point) (1+ (point))) (insert c-up)))))) (goto-char word-end) diff --git a/modules/custom-comments.el b/modules/custom-comments.el index a2604a55..73d29b0c 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -35,19 +35,19 @@ ;; ------------------------------ Comment Reformat ----------------------------- (defun cj/comment-reformat () - "Reformat commented text into a single paragraph." + "Reformat the commented text in the active region into a single paragraph. +Signal a `user-error' when no region is active." (interactive) - (if mark-active - (let ((beg (region-beginning)) - (end (copy-marker (region-end))) - (orig-fill-column fill-column)) - (uncomment-region beg end) - (setq fill-column (- fill-column 3)) - (cj/join-line-or-region) - (comment-region beg end) - (setq fill-column orig-fill-column ))) - ;; if no region - (message "No region was selected. Select the comment lines to reformat.")) + (unless (use-region-p) + (user-error "No region selected: select the comment lines to reformat")) + (let ((beg (region-beginning)) + (end (copy-marker (region-end))) + ;; Dynamically narrow the fill target for the join, then let it + ;; restore itself -- an error mid-join no longer strands fill-column. + (fill-column (- fill-column 3))) + (uncomment-region beg end) + (cj/join-line-or-region) + (comment-region beg end))) ;; ======================== Comment Generation Functions ======================= @@ -95,6 +95,14 @@ LENGTH is the total width of the line." text-length (if (> text-length 0) 2 0)) ; spaces around text 2)) + ;; The right side fills the exact remaining width so the line always + ;; reaches LENGTH. Keying this off text-length parity (as before) left + ;; even-length and empty text two columns short, misaligning stacked + ;; dividers of differing text lengths. + (right-space (- available-width + text-length + (if (> text-length 0) 2 0) + space-on-each-side)) (min-space 2)) ;; Validate we have enough space (when (< space-on-each-side min-space) @@ -108,10 +116,8 @@ LENGTH is the total width of the line." ;; Text with spaces (when (> text-length 0) (insert " " text " ")) - ;; Right decoration (handle odd-length text) - (dotimes (_ (if (= (% text-length 2) 0) - (- space-on-each-side 1) - space-on-each-side)) + ;; Right decoration -- fills the exact remaining width so the line reaches LENGTH. + (dotimes (_ right-space) (insert decoration-char)) ;; Comment end (when (not (string-empty-p cmt-end)) diff --git a/modules/custom-datetime.el b/modules/custom-datetime.el index 0528688c..52e8c2b3 100644 --- a/modules/custom-datetime.el +++ b/modules/custom-datetime.el @@ -51,7 +51,7 @@ See `format-time-string' for possible replacements.") ;; ------------------------------- Sortable Time ------------------------------- -(defvar sortable-time-format "%I:%M:%S %p %Z " +(defvar sortable-time-format "%H:%M:%S %Z " "Format string used by `cj/insert-sortable-time'. See `format-time-string' for possible replacements.") diff --git a/modules/custom-line-paragraph.el b/modules/custom-line-paragraph.el index d29d4125..5d96fe41 100644 --- a/modules/custom-line-paragraph.el +++ b/modules/custom-line-paragraph.el @@ -46,7 +46,10 @@ (when (> (line-number-at-pos) 1) (join-line)) (end-of-line) - (newline))) + ;; Only add a newline at end of buffer. Doing it unconditionally left a + ;; stray blank line when joining a line in the middle of the buffer. + (when (eobp) + (newline)))) (defun cj/join-paragraph () "Join all lines in the current paragraph using `cj/join-line-or-region'." @@ -67,18 +70,27 @@ produce malformed output silently." (> (length comment-start) 0)))) (user-error "Cannot comment in %s: no comment syntax defined" major-mode)) - (let* ((b (if (region-active-p) (region-beginning) (line-beginning-position))) - (e (if (region-active-p) (region-end) (line-end-position))) - (lines (split-string (buffer-substring-no-properties b e) "\n"))) + ;; Normalize the bounds to whole lines: extend to the start of the first + ;; line and the end of the last line the region touches. The old open-line + ;; loop mishandled a region ending mid-line or at beginning-of-line, either + ;; splitting a line or duplicating a stray empty line. + (let* ((rb (if (region-active-p) (region-beginning) (point))) + (re (if (region-active-p) (region-end) (point))) + (beg (save-excursion (goto-char rb) (line-beginning-position))) + (end (save-excursion + (goto-char re) + ;; A region ending exactly at beginning-of-line does not + ;; include that line, so step back to the previous line's end. + (when (and (> re rb) (bolp)) + (backward-char)) + (line-end-position))) + (text (buffer-substring-no-properties beg end))) (save-excursion - (goto-char e) - (dolist (line lines) - (open-line 1) - (forward-line 1) - (insert line) - ;; If the COMMENT prefix argument is non-nil, comment the inserted text - (when comment - (comment-region (line-beginning-position) (line-end-position))))))) + (goto-char end) + (insert "\n" text) + ;; Comment the freshly-inserted copy when the COMMENT prefix arg is set. + (when comment + (comment-region (1+ end) (point)))))) (defun cj/remove-duplicate-lines-region-or-buffer () "Remove duplicate lines in the region or buffer, keeping the first occurrence. @@ -175,9 +187,9 @@ If not on a delimiter, show a message. Respects the current syntax table." (cb (char-before)) ;; Check if on opening paren (open-p (and ca (eq (char-syntax ca) ?\())) - ;; Check if on or just after closing paren - (close-p (or (and ca (eq (char-syntax ca) ?\))) - (and cb (eq (char-syntax cb) ?\)))))) + ;; On a closing paren (point sits on it) vs just after one. + (on-close-p (and ca (eq (char-syntax ca) ?\)))) + (after-close-p (and cb (eq (char-syntax cb) ?\))))) (cond ;; Jump forward from opening (open-p @@ -185,12 +197,19 @@ If not on a delimiter, show a message. Respects the current syntax table." (forward-sexp) (scan-error (message "No matching delimiter: %s" (error-message-string err))))) - ;; Jump backward from closing - (close-p - (condition-case err - (backward-sexp) - (scan-error - (message "No matching delimiter: %s" (error-message-string err))))) + ;; Jump backward from closing to its matching opener. When point is ON + ;; the closer, step past it first so `backward-sexp' spans the whole + ;; expression to the opener rather than the last inner sexp. Restore + ;; point if the delimiter is unmatched. + ((or on-close-p after-close-p) + (let ((start (point))) + (condition-case err + (progn + (when on-close-p (forward-char)) + (backward-sexp)) + (scan-error + (goto-char start) + (message "No matching delimiter: %s" (error-message-string err)))))) ;; Not on delimiter (t (message "Point is not on a delimiter."))))) diff --git a/modules/custom-ordering.el b/modules/custom-ordering.el index 4dc5bff8..71477948 100644 --- a/modules/custom-ordering.el +++ b/modules/custom-ordering.el @@ -145,8 +145,15 @@ START and END identify the active region." START and END define the region to operate on. Returns the transformed string without modifying the buffer." (cj/--ordering-validate-region start end) - (let ((lines (split-string (buffer-substring start end) "\n"))) - (mapconcat #'identity (nreverse lines) "\n"))) + ;; Strip a trailing newline before splitting so it doesn't become a spurious + ;; empty line (which reversing would float to the top); reattach it after. + ;; Internal blank lines are preserved. + (let* ((raw (buffer-substring start end)) + (trailing-newline (string-suffix-p "\n" raw)) + (body (if trailing-newline (substring raw 0 -1) raw)) + (lines (split-string body "\n"))) + (concat (mapconcat #'identity (nreverse lines) "\n") + (if trailing-newline "\n" "")))) (defun cj/reverse-lines (start end) "Reverse the order of lines in region between START and END. @@ -164,20 +171,28 @@ ZERO-PAD when non-nil pads numbers with zeros for alignment. Example with 100 lines: \"001\", \"002\", ..., \"100\". Returns the transformed string without modifying the buffer." (cj/--ordering-validate-region start end) - (let* ((lines (split-string (buffer-substring start end) "\n")) + ;; Strip a trailing newline before splitting so it doesn't become a spurious + ;; extra numbered empty line; reattach it after. Internal blank lines are + ;; preserved and numbered. + (let* ((raw (buffer-substring start end)) + (trailing-newline (string-suffix-p "\n" raw)) + (body (if trailing-newline (substring raw 0 -1) raw)) + (lines (split-string body "\n")) (line-count (length lines)) (width (if zero-pad (length (number-to-string line-count)) 1)) (format-spec (if zero-pad (format "%%0%dd" width) "%d"))) - (mapconcat - (lambda (pair) - (let* ((num (car pair)) - (line (cdr pair)) - (num-str (format format-spec num))) - (concat (replace-regexp-in-string "N" num-str format-string) line))) - (cl-loop for line in lines - for i from 1 - collect (cons i line)) - "\n"))) + (concat + (mapconcat + (lambda (pair) + (let* ((num (car pair)) + (line (cdr pair)) + (num-str (format format-spec num))) + (concat (replace-regexp-in-string "N" num-str format-string) line))) + (cl-loop for line in lines + for i from 1 + collect (cons i line)) + "\n") + (if trailing-newline "\n" "")))) (defun cj/number-lines (start end format-string zero-pad) "Number lines in region between START and END with custom format. diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 4d72347d..12d2deaf 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -180,9 +180,14 @@ Returns the indented text without modifying the buffer." (defun cj/indent-lines-in-region-or-buffer (count use-tabs) "Indent each line in region or buffer by COUNT characters. -COUNT is the number of characters to indent (default 4). -USE-TABS when non-nil (prefix argument) uses tabs instead of spaces." - (interactive "p\nP") +COUNT is the numeric prefix argument, defaulting to 4 with no prefix. +USE-TABS non-nil indents with tabs instead of spaces; interactively it +follows the buffer's `indent-tabs-mode', so the prefix argument is free to +mean the count. Call it from Lisp with an explicit USE-TABS to override." + (interactive (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 4) + indent-tabs-mode)) (let* ((bounds (cj/--region-or-buffer-bounds)) (start-pos (car bounds)) (end-pos (cdr bounds)) @@ -224,9 +229,11 @@ Returns the dedented text without modifying the buffer." (defun cj/dedent-lines-in-region-or-buffer (count) "Remove up to COUNT leading whitespace characters from each line. -COUNT is the number of characters to remove (default 4). +COUNT is the numeric prefix argument, defaulting to 4 with no prefix. Works on region if active, otherwise entire buffer." - (interactive "p") + (interactive (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 4))) (let* ((bounds (cj/--region-or-buffer-bounds)) (start-pos (car bounds)) (end-pos (cdr bounds)) diff --git a/modules/dashboard-config.el b/modules/dashboard-config.el index 53f19b72..d5aa501d 100644 --- a/modules/dashboard-config.el +++ b/modules/dashboard-config.el @@ -68,7 +68,6 @@ (declare-function cj/erc-switch-to-buffer-with-completion "erc-config") (declare-function cj/telega "telega-config") (declare-function cj/slack-start "slack-config") -(declare-function cj/signel-message "signal-config") (declare-function cj/kill-all-other-buffers-and-windows "undead-buffers") ;; External package commands invoked by launchers. @@ -149,15 +148,15 @@ Adjust this if the title doesn't appear centered under the banner image.") (list "i" #'nerd-icons-faicon "nf-fa-comments" "IRC" "Emacs Relay Chat" (lambda () (cj/erc-switch-to-buffer-with-completion))) (list "G" #'nerd-icons-faicon "nf-fa-telegram" "Telegram" "Telega Telegram Client" (lambda () (cj/telega))) (list "s" #'nerd-icons-faicon "nf-fa-slack" "Slack" "Slack Client" (lambda () (cj/slack-start))) - (list "l" #'nerd-icons-octicon "nf-oct-issue_tracks" "Linear" "Linear Issue Tracker" (lambda () (pearl-list-issues))) - (list "S" #'nerd-icons-mdicon "nf-md-message" "Signal" "Signal Messenger" (lambda () (cj/signel-message)))) + (list "l" #'nerd-icons-octicon "nf-oct-issue_tracks" "Linear" "Linear Issue Tracker" (lambda () (pearl-list-issues)))) "Dashboard launcher table: (KEY ICON-FN ICON-NAME LABEL TOOLTIP ACTION). Drives both `dashboard-navigator-buttons' and the dashboard-mode-map keys.") -(defconst cj/dashboard--row-sizes '(5 4 3 3) +(defconst cj/dashboard--row-sizes '(5 4 3 2) "Navigator row lengths. Must sum to the number of `cj/dashboard--launchers'. -The top row carries Weather alongside the core tools; the last row groups -Slack, Linear, and Signal together.") +The top row carries Weather alongside the core tools; the last row pairs +Slack and Linear. (Signal left the table when the signel client was +retired to archive/ -- agents drive Signal via signal-cli.)") (defun cj/dashboard--navigator-button (l) "Build a `dashboard-navigator-buttons' entry from launcher L." diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el index 0e22dcee..ef41ab33 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -589,6 +589,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") + ("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") ("rtt" "/sshx:cjennings@truenas:~" "remote cjennings@truenas (tailscale)") diff --git a/modules/eat-config.el b/modules/eat-config.el index e5b8f0c5..01d0fbe6 100644 --- a/modules/eat-config.el +++ b/modules/eat-config.el @@ -110,6 +110,102 @@ not recognize (which would later trip (cl-assert charset) on write)." (with-eval-after-load 'eat (advice-add 'eat--t-set-charset :filter-args #'cj/--eat-charset-never-nil)) +;; EAT 0.9.4 XTWINOPS gap. tmux 3.7b has native Sixel but refuses to emit it +;; until it learns the client's cell pixel size, which it asks for with the +;; XTWINOPS window-size requests CSI 14 t (text area in pixels), CSI 16 t (cell +;; size in pixels) and CSI 18 t (text area in characters). EAT's parser +;; (eat--t-handle-output) has no `t' case, so it silently drops these -- tmux +;; never learns the geometry and images never render. We can't add the parser +;; clause without forking the vendored 541-line pcase (see the charset note +;; above), so answer the query from a `:before' advice instead: eat--t-handle-output +;; is called inside (eat--t-with-env terminal ...), which dynamically binds +;; eat--t-term, so the advice can read the live display + cell dimensions and +;; write the report back through the terminal's own input function. The reply +;; format matches EAT's existing XTSMGRAPHICS reply (same char-width/height and +;; display fields). Verified live on ratio 2026-07-13: images render and +;; persist across window switches, scrolling, and resizing. An upstream-shaped +;; patch (a real parser clause) is kept locally for a PR to akib/emacs-eat. +;; The advice does NOT become a no-op when upstream +;; ships that clause: it runs :before the parser and scans raw output, so +;; queries always survive to it, and two answerers means tmux gets a double +;; reply -- it treats the second as unrequested input and forwards the raw +;; escape bytes into the pane as keystrokes (this killed an agent session on +;; 2026-07-13 when a second patched parser was live in the daemon). The +;; advice-add is therefore guarded: it installs only while EAT itself cannot +;; answer, and stays out the day the upstream clause (which defines +;; eat--t-send-window-size-report) lands. + +(declare-function eat--t-handle-output "eat") +(declare-function eat--t-term-display "eat") +(declare-function eat--t-term-input-fn "eat") +(declare-function eat--t-term-char-width "eat") +(declare-function eat--t-term-char-height "eat") +(declare-function eat--t-disp-width "eat") +(declare-function eat--t-disp-height "eat") +(defvar eat--t-term) + +(defun cj/--eat-xtwinops-report (n cols rows char-width char-height) + "Return the XTWINOPS reply string for window-size request N, or nil. +COLS and ROWS are the display size in characters; CHAR-WIDTH and +CHAR-HEIGHT are the pixel size of one cell. N is 14 (text area in +pixels), 16 (cell size in pixels), or 18 (text area in characters); any +other N returns nil so the request goes unanswered." + (pcase n + (14 (format "\e[4;%d;%dt" (* rows char-height) (* cols char-width))) + (16 (format "\e[6;%d;%dt" char-height char-width)) + (18 (format "\e[8;%d;%dt" rows cols)))) + +(defun cj/--eat-xtwinops-queries (output) + "Return the XTWINOPS request numbers found in terminal OUTPUT, in order. +Matches only the bare CSI 14/16/18 t window-size requests EAT drops -- a +parametrized form (e.g. CSI 3 ; 14 t) or a different CSI t op (e.g. the +CSI 24 t resize) is not one we answer and is left alone. Returns nil +when OUTPUT carries no such request. OUTPUT is one pty chunk, so a +query split across two reads would be missed; in practice tmux writes +the few-byte query atomically, so it arrives whole." + (let ((start 0) (found '())) + (while (string-match "\e\\[\\(14\\|16\\|18\\)t" output start) + (push (string-to-number (match-string 1 output)) found) + (setq start (match-end 0))) + (nreverse found))) + +(defun cj/--eat-send-window-size-report (n) + "Answer XTWINOPS window-size request N on the current EAT terminal. +Runs with `eat--t-term' dynamically bound (inside `eat--t-with-env'), +reads the live display and cell dimensions, and writes the report back +through the terminal's own input function. A request number EAT does +not report on (`cj/--eat-xtwinops-report' returns nil) is ignored." + (let* ((disp (eat--t-term-display eat--t-term)) + (reply (cj/--eat-xtwinops-report + n + (eat--t-disp-width disp) + (eat--t-disp-height disp) + (eat--t-term-char-width eat--t-term) + (eat--t-term-char-height eat--t-term)))) + (when reply + (funcall (eat--t-term-input-fn eat--t-term) eat--t-term reply)))) + +(defun cj/--eat-answer-xtwinops (output) + "`:before' advice for `eat--t-handle-output'. +Answer every XTWINOPS window-size request in OUTPUT that EAT 0.9.4 would +otherwise drop, so tmux learns the cell pixel size it needs before it +will emit Sixel. Runs inside `eat--t-with-env', so `eat--t-term' is +bound for the responder." + (mapc #'cj/--eat-send-window-size-report (cj/--eat-xtwinops-queries output))) + +(defun cj/--eat-xtwinops-advice-needed-p () + "Return non-nil when EAT itself cannot answer XTWINOPS window-size queries. +EAT 0.9.4 has no CSI t parser clause, so the advice must answer them. +An EAT that ships the clause defines `eat--t-send-window-size-report' +(the function the upstream-shaped parser patch adds); with that present +the advice must stay out, or every query gets two replies and tmux +types the second one's raw bytes into the pane." + (not (fboundp 'eat--t-send-window-size-report))) + +(with-eval-after-load 'eat + (when (cj/--eat-xtwinops-advice-needed-p) + (advice-add 'eat--t-handle-output :before #'cj/--eat-answer-xtwinops))) + ;; ------------------------------- eat package --------------------------------- (defun cj/--eat-clear-mode-line-process () diff --git a/modules/flycheck-config.el b/modules/flycheck-config.el index 2a5a5e74..ad762b3b 100644 --- a/modules/flycheck-config.el +++ b/modules/flycheck-config.el @@ -44,15 +44,21 @@ :defer t :commands (flycheck-list-errors cj/flycheck-list-errors) - :hook ((sh-mode emacs-lisp-mode) . flycheck-mode) + ;; ledger-mode is here, not in ledger-config.el, so this list stays the one + ;; answer to "where is flycheck turned on?". flycheck-ledger registers a + ;; `ledger' checker but never enables the mode, so before this hook existed an + ;; unbalanced transaction in a ledger file produced no warning at all. + :hook ((sh-mode emacs-lisp-mode ledger-mode) . flycheck-mode) :bind (:map cj/custom-keymap ("?" . cj/flycheck-list-errors)) :custom - ;; Only disable these two Checkdoc warnings; leave all others intact. - (checkdoc-arguments - '(("sentence-end-double-space" nil) - ("warn-escape" nil))) + ;; No checkdoc suppression here: the old `checkdoc-arguments' entry named a + ;; variable that doesn't exist (checkdoc has no such option and this + ;; flycheck runs checkdoc via a fixed subprocess form), so it never + ;; suppressed anything. Removing it changes no behavior; if specific + ;; checkdoc warnings need silencing, that's a new feature against + ;; `flycheck-emacs-lisp-checkdoc-form'. ;; Modeline customization (rendered via mode-line-format in modeline-config.el). ;; The count portion picks up `error' / `warning' faces because ;; `flycheck-mode-line-color' stays t (the default). diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index b73bfdf3..ebe4898e 100644 --- a/modules/flyspell-and-abbrev.el +++ b/modules/flyspell-and-abbrev.el @@ -197,9 +197,10 @@ Without prefix argument, it's created in the global abbrev table. Press C-' repeatedly to step through misspellings one at a time." (interactive "P") (cj/--require-spell-checker) - ;; Run flyspell-buffer only if buffer hasn't been checked yet - (unless (bound-and-true-p flyspell-mode) - (flyspell-buffer)) + ;; Enable Flyspell for the buffer type so the mode sticks and the buffer is + ;; scanned once. A bare flyspell-buffer here never turned the mode on, so + ;; the guard never tripped and every C-' press re-scanned the whole buffer. + (cj/flyspell-on-for-buffer-type) (let ((misspelled-word (cj/flyspell-goto-previous-misspelling (point)))) (if (not misspelled-word) diff --git a/modules/font-config.el b/modules/font-config.el index 3aa3d80f..e5afb361 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -210,6 +210,15 @@ the fontset repeatedly is harmless, so it can be called from ;; ---------------------------------- Emojify ---------------------------------- ;; converts emoji identifiers into emojis; allows for easy emoji entry. +(defvar emojify-display-style) ;; emojify's, forward-declared for the helper + +(defun cj/set-emojify-display-style () + "Set `emojify-display-style' to `image' on a graphical frame, else `unicode'. +Image emoji only render on a GUI frame. In daemon mode no GUI frame exists when +emojify loads, so this runs per-frame from `server-after-make-frame-hook'; +otherwise the value would latch to `unicode' and GUI frames never get images." + (setq emojify-display-style (if (env-gui-p) 'image 'unicode))) + (use-package emojify :defer 1 :hook ((erc-mode . emojify-mode)) @@ -221,7 +230,11 @@ the fontset repeatedly is harmless, so it can be called from :config (setq emojify-show-help nil) (setq emojify-point-entered-behaviour 'uncover) - (setq emojify-display-style (if (env-gui-p) 'image 'unicode)) + ;; In daemon mode `env-gui-p' is nil at :config time (no GUI frame yet), so + ;; recompute the display style per-frame; otherwise set it now. + (if (daemonp) + (add-hook 'server-after-make-frame-hook #'cj/set-emojify-display-style) + (cj/set-emojify-display-style)) (setq emojify-emoji-styles '(ascii unicode github)) ;; Disable emojify in programming modes @@ -242,21 +255,24 @@ the fontset repeatedly is harmless, so it can be called from (let ((font-list (font-family-list))) (setq font-list (cl-remove-duplicates (cl-sort font-list 'string-lessp :key 'downcase))) (with-current-buffer "*Available Fonts*" - (erase-buffer) - (dolist (font-family font-list) - (insert (propertize (concat font-family) 'face '(font-lock-keyword-face (:weight bold)))) - (insert (concat "\n"(propertize "Regular: "))) - (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") - 'face `((:family, font-family)))) - (insert (concat "\n" (propertize "Bold: "))) - (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") - 'face `((:family, font-family :weight bold)))) - (insert (concat "\n" (propertize "Italic: "))) - (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") - 'face `((:family, font-family :slant italic)))) - (insert (concat "\n\n")))) - (move-to-window-line 0) - (special-mode))) + ;; The buffer is left in `special-mode' (read-only) after the first call, + ;; so re-running must relax read-only to erase and rewrite it. + (let ((inhibit-read-only t)) + (erase-buffer) + (dolist (font-family font-list) + (insert (propertize (concat font-family) 'face '(font-lock-keyword-face (:weight bold)))) + (insert (concat "\n"(propertize "Regular: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family)))) + (insert (concat "\n" (propertize "Bold: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family :weight bold)))) + (insert (concat "\n" (propertize "Italic: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family :slant italic)))) + (insert (concat "\n\n")))) + (move-to-window-line 0) + (special-mode)))) (keymap-global-set "C-z F" #'cj/display-available-fonts) diff --git a/modules/keybindings.el b/modules/keybindings.el index 3e51b2dd..5d0262ed 100644 --- a/modules/keybindings.el +++ b/modules/keybindings.el @@ -153,8 +153,6 @@ Errors if VAR is unbound, not a non-empty string, or the file does not exist." ;; is armed everywhere. cj/modeline-reset repairs a hijacked buffer. (keymap-global-unset "<f2>") ;; 2C-command prefix (keymap-global-unset "C-x 6") ;; 2C-command prefix (same map) -(keymap-global-unset "C-x C-f") ;; find-file-read-only -(keymap-global-set "C-x C-f" #'find-file) (keymap-global-set "C-z" (make-sparse-keymap)) ;; replace suspend-frame with prefix map (keymap-global-unset "M-o") ;; facemenu-mode diff --git a/modules/keyboard-compat.el b/modules/keyboard-compat.el index 9395b9c8..73138ca5 100644 --- a/modules/keyboard-compat.el +++ b/modules/keyboard-compat.el @@ -45,8 +45,11 @@ This runs after init to override any package settings." (define-key input-decode-map "\eOC" [right]) (define-key input-decode-map "\eOD" [left]))) -;; Run after init completes to override any package settings -(add-hook 'emacs-startup-hook #'cj/keyboard-compat-terminal-setup) +;; `input-decode-map' is terminal-local, and a daemon's `emacs-startup-hook' +;; runs once with no tty, so a startup-hook registration never reaches the +;; `emacsclient -t' frames that need it. `tty-setup-hook' runs for each new +;; tty frame (daemon and non-daemon alike), which is where the decodings belong. +(add-hook 'tty-setup-hook #'cj/keyboard-compat-terminal-setup) ;; Icon-rendering functions return blank on terminal frames so unicode ;; artifacts don't show up. The check runs per call against the selected @@ -95,8 +98,7 @@ Meta+Shift+letter triggers M-S-letter keybindings." (define-key key-translation-map (kbd "M-D") (kbd "M-S-d")) (define-key key-translation-map (kbd "M-I") (kbd "M-S-i")) (define-key key-translation-map (kbd "M-C") (kbd "M-S-c")) - (define-key key-translation-map (kbd "M-B") (kbd "M-S-b")) - (define-key key-translation-map (kbd "M-K") (kbd "M-S-k")))) + (define-key key-translation-map (kbd "M-B") (kbd "M-S-b")))) ;; In daemon mode, no frame exists at startup so env-gui-p returns nil. ;; Use server-after-make-frame-hook to set up translations when the first diff --git a/modules/keyboard-macros.el b/modules/keyboard-macros.el index 4e801096..bca36eed 100644 --- a/modules/keyboard-macros.el +++ b/modules/keyboard-macros.el @@ -43,7 +43,7 @@ ;;; Code: (require 'subr-x) ;; for string-trim -(eval-when-compile (require 'user-constants)) +(require 'user-constants) ;; for macros-file, read at runtime (defvar cj/macros-loaded nil "Whether saved keyboard macros have been loaded from file.") @@ -130,15 +130,7 @@ With prefix arg, open the macros file for editing after saving." (keymap-global-set "C-<f3>" #'cj/kbd-macro-start-or-end) (keymap-global-set "<f3>" #'call-last-kbd-macro) (keymap-global-set "M-<f3>" #'cj/save-maybe-edit-macro) - (keymap-global-set "s-<f3>" #'cj/open-macros-file) - (add-hook 'kill-emacs-hook #'cj/save-last-kbd-macro-on-exit)) - -;; Add hook to save any unnamed macros on exit if desired -(defun cj/save-last-kbd-macro-on-exit () - "Save the last keyboard macro before exiting Emacs if it's not saved." - (when last-kbd-macro - (when (y-or-n-p "Save last keyboard macro before exiting? ") - (call-interactively #'cj/save-maybe-edit-macro)))) + (keymap-global-set "s-<f3>" #'cj/open-macros-file)) ;; Auto-call setup after init (if after-init-time diff --git a/modules/local-repository.el b/modules/local-repository.el index e3c7a227..0f2c981c 100644 --- a/modules/local-repository.el +++ b/modules/local-repository.el @@ -6,72 +6,28 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P. ;; Load shape: eager. -;; Eager reason: none; local package mirror commands can autoload. +;; Eager reason: none; the mirror-refresh command can autoload. ;; Top-level side effects: none. ;; Runtime requires: elpa-mirror when updating the mirror. ;; Direct test load: yes. ;; -;; Adds the checked-in local package archive to package-archives with high -;; priority, and provides a command to refresh that archive from installed -;; packages via elpa-mirror. +;; Provides a command to refresh the checked-in local package archive from the +;; installed packages via elpa-mirror. Adding that archive to package-archives +;; is owned by early-init.el (see `localrepo-location'); this module only +;; refreshes it. ;;; Code: (require 'elpa-mirror nil t) ;; optional; cj/update-localrepo-repository fails at call-time if absent (declare-function elpamr-create-mirror-for-installed "elpa-mirror") - -;; ------------------------------ Utility Function ----------------------------- - - -(defun localrepo--car-member (value list) - "Check if VALUE exists as the car of any cons cell in LIST." - (member value (mapcar #'car list))) - -;; ------------------------------- Customizations ------------------------------ - -(defgroup localrepo nil - "Local last-known-good package repository." - :group 'package) - -(defcustom localrepo-repository-id "localrepo" - "The name used to identify the local repository internally. - -Used for the package-archive and package-archive-priorities lists." - :type 'string - :group 'localrepo) - -(defcustom localrepo-repository-priority 100 - "The value for the local repository in the package-archive-priority list. - -A higher value means higher priority. If you want your local packages to be -preferred, this must be a higher number than any other repositories." - :type 'integer - :group 'localrepo) - -(defcustom localrepo-repository-location - (concat user-emacs-directory "/.localrepo") - "The location of the local repository. - -It's a good idea to keep this with the rest of your configuration files and -keep them in source control." - :type 'directory - :group 'localrepo) +(defvar localrepo-location) ;; defconst in early-init.el: the archive path (defun cj/update-localrepo-repository () - "Update the local repository with currently installed packages." + "Update the local repository with currently installed packages. +Targets `localrepo-location', the archive path early-init.el sets up." (interactive) - (elpamr-create-mirror-for-installed localrepo-repository-location t)) - -(defun localrepo-initialize () -"Add the repository to the package archives, then gives it a high priority." - (unless (localrepo--car-member localrepo-repository-id package-archives) - (add-to-list 'package-archives - (cons localrepo-repository-id localrepo-repository-location))) - - (unless (localrepo--car-member localrepo-repository-id package-archive-priorities) - (add-to-list 'package-archive-priorities - (cons localrepo-repository-id localrepo-repository-priority)))) + (elpamr-create-mirror-for-installed localrepo-location t)) (provide 'local-repository) ;;; local-repository.el ends here. diff --git a/modules/lorem-optimum.el b/modules/lorem-optimum.el index 8aa96345..14f1d666 100644 --- a/modules/lorem-optimum.el +++ b/modules/lorem-optimum.el @@ -219,8 +219,22 @@ Builds and caches the keys list lazily if not already cached." (message "Lorem-optimum learned from file: %s" file)) (defun cj/lipsum (n) - "Return N words of lorem ipsum." - (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum"))) + "Return N words of lorem ipsum. +Interactively, prompt for N and echo the generated words. + +Signal a `user-error' when the Markov chain is empty (for example when the +training file `cj/lipsum-default-file' is missing). Without this, callers +such as `cj/lipsum-insert' would insert nil and raise a cryptic wrong-type +error far from the cause. Train the chain with `cj/lipsum-learn-file', +`cj/lipsum-learn-buffer', or `cj/lipsum-learn-region', or restore the file." + (interactive "nNumber of words: ") + (let ((text (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum")))) + (unless (and (stringp text) (not (string-empty-p text))) + (user-error "Lorem-optimum chain is empty; train it with cj/lipsum-learn-file or restore %s" + cj/lipsum-default-file)) + (when (called-interactively-p 'any) + (message "%s" text)) + text)) (defun cj/lipsum-insert (n) "Insert N words of lorem ipsum at point." diff --git a/modules/mail-config.el b/modules/mail-config.el index 297e70d4..b410bf1b 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -127,8 +127,17 @@ transport details in debug buffers." "mbsync" "mu4e mail synchronization" 'mail-config))) (concat (shell-quote-argument mbsync) " -a"))) +(defun cj/mail--send-mail-unavailable (&rest _) + "Signal a descriptive error: no mail transport is configured. +Installed as the send function when msmtp is absent, so a send attempt +explains itself instead of dying with \"invalid function: nil\" (the +top-level defvar pre-empts message.el's default)." + (user-error "Cannot send mail: msmtp not found -- install msmtp to enable sending")) + (defun cj/mail-configure-smtpmail () - "Configure SMTP mail transport when msmtp is available." + "Configure SMTP mail transport when msmtp is available. +With msmtp absent, install `cj/mail--send-mail-unavailable' on both send +variables so the failure at send time names the missing transport." (setq smtpmail-debug-info cj/smtpmail-debug-enabled) (if-let ((msmtp (cj/executable-find-or-warn "msmtp" "SMTP mail sending" 'mail-config))) @@ -136,7 +145,9 @@ transport details in debug buffers." send-mail-function 'message-send-mail-with-sendmail message-send-mail-function 'message-send-mail-with-sendmail message-sendmail-envelope-from 'header) - (setq sendmail-program nil))) + (setq sendmail-program nil + send-mail-function #'cj/mail--send-mail-unavailable + message-send-mail-function #'cj/mail--send-mail-unavailable))) ;; -------------------- HarfBuzz Crash Fix: Disable Composition --------------- ;; Disable auto-composition in mu4e headers to prevent SIGSEGV from HarfBuzz @@ -229,9 +240,6 @@ Prompts user for the action when executing." (setq mu4e-context-policy 'pick-first) ;; start with the first (default) context (setq mu4e-headers-auto-update nil) ;; updating headers buffer on email is too jarring (setq mu4e-root-maildir mail-dir) ;; root directory for all email accounts - (with-suppressed-warnings ((obsolete mu4e-maildir) - (free-vars mu4e-maildir)) - (setq mu4e-maildir mail-dir)) ;; same as above (for newer mu4e) (setq mu4e-sent-messages-behavior 'delete) ;; don't save to "Sent", IMAP does this already (setq mu4e-show-images t) ;; show embedded images ;; (setq mu4e-update-interval 600) ;; check for new mail every 10 minutes (600 seconds) @@ -243,9 +251,6 @@ Prompts user for the action when executing." ;; This will be automatically disabled when org-msg is active (setq mu4e-compose-format-flowed t) - (with-suppressed-warnings ((obsolete mu4e-html2text-command) - (free-vars mu4e-html2text-command)) - (setq mu4e-html2text-command 'mu4e-shr2text)) ;; email conversion to html via shr2text (setq mu4e-mu-binary (executable-find "mu")) (setq mu4e-get-mail-command (cj/mail--mbsync-command)) ;; command to sync mail (with-suppressed-warnings ((obsolete mu4e-user-mail-address-list) @@ -257,22 +262,15 @@ Prompts user for the action when executing." ;; ------------------------------ Mu4e Contexts ------------------------------ + ;; cmail (cjennings.net) is listed first deliberately: `pick-first' makes it + ;; the startup context, matching cmail's primary role everywhere else in the + ;; config (shortcuts, bookmarks, refile). Gmail-first here made gmail the + ;; silent default for the first compose. (mu4e-starred-folder was dropped: + ;; it isn't a mu4e variable, so it never had an effect -- flagged searches + ;; use flag:flagged.) (setq mu4e-contexts (list (make-mu4e-context - :name "gmail.com" - :match-func - (lambda (msg) - (when msg - (string-prefix-p "/gmail" (mu4e-message-field msg :maildir)))) - :vars '((user-mail-address . "craigmartinjennings@gmail.com") - (user-full-name . "Craig Jennings") - (mu4e-drafts-folder . "/gmail/Drafts") - (mu4e-sent-folder . "/gmail/Sent") - (mu4e-starred-folder . "/gmail/Starred") - (mu4e-trash-folder . "/gmail/Trash"))) - - (make-mu4e-context :name "cjennings.net" :match-func (lambda (msg) @@ -285,6 +283,18 @@ Prompts user for the action when executing." (mu4e-trash-folder . "/cmail/Trash"))) (make-mu4e-context + :name "gmail.com" + :match-func + (lambda (msg) + (when msg + (string-prefix-p "/gmail" (mu4e-message-field msg :maildir)))) + :vars '((user-mail-address . "craigmartinjennings@gmail.com") + (user-full-name . "Craig Jennings") + (mu4e-drafts-folder . "/gmail/Drafts") + (mu4e-sent-folder . "/gmail/Sent") + (mu4e-trash-folder . "/gmail/Trash"))) + + (make-mu4e-context :name "deepsat.com" :match-func (lambda (msg) @@ -294,7 +304,6 @@ Prompts user for the action when executing." (user-full-name . "Craig Jennings") (mu4e-drafts-folder . "/dmail/Drafts") (mu4e-sent-folder . "/dmail/Sent") - (mu4e-starred-folder . "/dmail/Starred") (mu4e-trash-folder . "/dmail/Trash"))))) ;; Refile target is computed per message (see `cj/mu4e--refile-folder'), not @@ -348,25 +357,11 @@ Prompts user for the action when executing." ;; ------------------------------ HTML Settings ------------------------------ ;; also see org-msg below - - ;; Prefer HTML over plain text when both are available - (with-suppressed-warnings ((obsolete mu4e-view-prefer-html) - (free-vars mu4e-view-prefer-html)) - (setq mu4e-view-prefer-html t)) - - ;; Use a better HTML renderer with more control - (with-suppressed-warnings ((obsolete mu4e-html2text-command) - (free-vars mu4e-html2text-command)) - (setq mu4e-html2text-command - (cond - ;; Best option: pandoc (if available) - ((executable-find "pandoc") - "pandoc -f html -t plain --reference-links") - ;; Good option: w3m (better tables/formatting) - ((executable-find "w3m") - "w3m -dump -T text/html -cols 72 -o display_link_number=true") - ;; Fallback: built-in shr - (t 'mu4e-shr2text)))) + ;; + ;; The view is shr-based since mu4e 1.7; the old knobs + ;; (mu4e-view-prefer-html, mu4e-html2text-command and its pandoc/w3m + ;; renderer selection) are obsolete and ignored on 1.14, so they were + ;; dropped. HTML display is governed by the shr settings below. ;; Configure shr (built-in HTML renderer) for better display (setq shr-use-colors nil) ; Don't use colors in terminal @@ -407,10 +402,12 @@ Echoes the effective state so there's no guessing what a refresh did." (message "Remote images: %s (this message only)" (if (equal gnus-blocked-images "http") "blocked" "shown"))) - ;; first letter is the keybinding + ;; first letter is the keybinding. No save-attachment action here: + ;; mu4e-view-save-attachments reads MIME parts from the view buffer (and + ;; takes no message argument), so it cannot work from headers -- open the + ;; message and save from the view instead. (setq mu4e-headers-actions - '(("asave attachment" . mu4e-view-save-attachments) - ("csave contact" . mu4e-action-add-org-contact) + '(("csave contact" . mu4e-action-add-org-contact) ("ssearch for sender" . cj/search-for-sender) ("tshow this thread" . mu4e-action-show-thread) ("vview in browser" . mu4e-action-view-in-browser))) @@ -483,12 +480,18 @@ INBOX maildir." (defun cj/--mail-make-account-map (account) "Build a mu4e navigation keymap for ACCOUNT (a maildir account name). Keys i/u/s/l run the inbox/unread/flagged/large searches from -`cj/--mail-account-search-queries', each scoped to ACCOUNT." +`cj/--mail-account-search-queries', each scoped to ACCOUNT. Each command +requires mu4e first: these maps register eagerly at startup, but +`mu4e-search' has no autoload cookie, so a nav key pressed before mu4e's +first launch would otherwise signal void-function. With the feature +loaded, mu4e itself starts the server on demand." (let ((map (make-sparse-keymap))) (dolist (entry (cj/--mail-account-search-queries account) map) (let ((query (cdr entry))) (keymap-set map (car entry) - (lambda () (interactive) (mu4e-search query)))))))) + (lambda () (interactive) + (require 'mu4e) + (mu4e-search query)))))))) ;; ---------------------------------- Org-Msg ---------------------------------- ;; user composes org mode; recipient receives html @@ -577,10 +580,12 @@ Keys i/u/s/l run the inbox/unread/flagged/large searches from ;; turn on org-msg in all compose buffers (org-msg-mode +1)) -(advice-add #'mu4e-compose-reply - :after (lambda (&rest _) (org-msg-edit-mode))) -(advice-add #'mu4e-compose-wide-reply - :after (lambda (&rest _) (org-msg-edit-mode))) +;; No reply advice here: org-msg-post-setup runs on mu4e-compose-mode-hook for +;; every compose (replies included) and applies `org-msg-default-alternatives' +;; itself. The old unconditional org-msg-edit-mode :after advice on the two +;; reply commands forced org-msg onto text-only replies, defeating the +;; (reply-to-text . (text)) alternative above and re-running a major mode +;; org-msg had already set up. ;; which-key labels (with-eval-after-load 'which-key diff --git a/modules/markdown-config.el b/modules/markdown-config.el index 815bb3fb..1d4a8b74 100644 --- a/modules/markdown-config.el +++ b/modules/markdown-config.el @@ -108,8 +108,21 @@ Starts the simple-httpd listener automatically when it isn't already running." ;; stub doesn't collide with this file's own definition of the command ;; (that collision is the "defined multiple times" byte-compile warning). ;; Same key as compile, for consistency. +(defun cj/markdown-toggle-view () + "Toggle the current Markdown buffer between edit and read-only view. +Handles the gfm variants too. The cond checks the most-derived mode +first, since the view modes derive from their edit modes." + (interactive) + (cond + ((derived-mode-p 'markdown-view-mode) (markdown-mode)) + ((derived-mode-p 'gfm-view-mode) (gfm-mode)) + ((derived-mode-p 'gfm-mode) (gfm-view-mode)) + ((derived-mode-p 'markdown-mode) (markdown-view-mode)))) + (with-eval-after-load 'markdown-mode - (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview)) + (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview) + (keymap-set markdown-mode-map "C-c C-x v" #'cj/markdown-toggle-view) + (keymap-set markdown-view-mode-map "C-c C-x v" #'cj/markdown-toggle-view)) (provide 'markdown-config) ;;; markdown-config.el ends here diff --git a/modules/mu4e-attachments.el b/modules/mu4e-attachments.el index 6c2be6fb..56b96b87 100644 --- a/modules/mu4e-attachments.el +++ b/modules/mu4e-attachments.el @@ -100,11 +100,21 @@ size; an unknown candidate annotates as nil so marginalia shows nothing." (require 'mu4e-mime-parts))) (defun cj/mu4e--save-attachment-part (part directory) - "Save attachment PART to DIRECTORY and return the final path." + "Save attachment PART to DIRECTORY and return the final path. +Signals a `user-error' when PART's MIME handle is stale: a handle's car +is the buffer holding the part's bytes, and viewing another message kills +it, so saving through it would error deep in mm-decode or write another +message's content. The staleness check runs before +`cj/mu4e--ensure-attachment-save-functions', like the no-handle check." (let ((handle (plist-get part :handle))) (unless handle (user-error "Attachment has no MIME handle: %s" (or (plist-get part :filename) "<unnamed>"))) + (when (and (consp handle) + (bufferp (car handle)) + (not (buffer-live-p (car handle)))) + (user-error "Attachment %s is stale (the message view changed) -- reopen the message and save again" + (or (plist-get part :filename) "<unnamed>"))) (cj/mu4e--ensure-attachment-save-functions) (let* ((path (funcall mu4e-uniquify-save-file-name-function (mu4e-join-paths directory diff --git a/modules/mu4e-org-contacts-integration.el b/modules/mu4e-org-contacts-integration.el index 6062b8cf..fc0a7325 100644 --- a/modules/mu4e-org-contacts-integration.el +++ b/modules/mu4e-org-contacts-integration.el @@ -22,6 +22,7 @@ ;; isolation doesn't warn about free variables / undefined functions; the ;; actual definitions live where named. (eval-when-compile (defvar contacts-file)) ; user-constants.el +(defvar mu4e-compose-complete-addresses) ; mu4e-compose.el (lazy) (declare-function cj/get-all-contact-emails ; org-contacts-config.el "org-contacts-config" ()) @@ -157,10 +158,10 @@ This bypasses the completion-at-point system for direct selection." ;; Setup hooks for org-msg-edit-mode (HTML email composition) (with-eval-after-load 'org-msg (add-hook 'org-msg-edit-mode-hook #'cj/mu4e-org-contacts-compose-setup)) - - ;; Remove any existing mu4e completion setup - (remove-hook 'mu4e-compose-mode-hook #'mu4e--compose-setup-completion) - + + ;; No hook surgery on mu4e--compose-setup-completion: mu4e 1.14 calls it + ;; directly during compose setup (never via this hook), and it is already + ;; gated by the `mu4e-compose-complete-addresses' nil above. (message "mu4e org-contacts integration activated")) (defun cj/deactivate-mu4e-org-contacts-integration () @@ -170,11 +171,11 @@ This bypasses the completion-at-point system for direct selection." ;; Remove our hooks (remove-hook 'mu4e-compose-mode-hook #'cj/mu4e-org-contacts-compose-setup) (remove-hook 'org-msg-edit-mode-hook #'cj/mu4e-org-contacts-compose-setup) - - ;; Re-enable mu4e's built-in completion if desired + + ;; Re-enable mu4e's built-in completion: the var is enough, since mu4e's + ;; compose setup calls its completion function directly, gated on this. (setq mu4e-compose-complete-addresses t) - (add-hook 'mu4e-compose-mode-hook #'mu4e--compose-setup-completion) - + (message "mu4e org-contacts integration deactivated")) (provide 'mu4e-org-contacts-integration) diff --git a/modules/music-config.el b/modules/music-config.el index ea66df8e..3559930b 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -16,13 +16,20 @@ ;; ;; The playlist keymap intentionally follows ncmpcpp where it maps cleanly, with ;; EMMS-specific additions for M3U editing and consume mode. +;; +;; The player has two render paths. In a graphical frame with `cj/music-fancy-ui' +;; on (the default), it draws the fancy hi-fi surface: a now-playing hero with +;; cover art (station favicon / sibling album art / a shipped vinyl placeholder, +;; cached under data/music-art/), a serif title, and a block progress bar that +;; advances from mpv's percent-pos while a file plays. A TTY frame, or the +;; toggle off, falls back to the plain text player (names, a dim glyph, a thin +;; status line). `cj/music-clear-art-cache' empties the art cache. ;;; Code: (require 'subr-x) (require 'user-constants) (require 'keybindings) ;; provides cj/custom-keymap -(require 'cj-window-geometry-lib) ;; cj/preferred-dock-direction (F10 dock side) (require 'cj-window-toggle-lib) ;; side-window size memory (F10 toggle) (require 'system-lib) ;; cj/confirm-strong (overwrite confirms) @@ -30,7 +37,6 @@ ;; compiles as a dynamic bind, not a dead lexical local -- otherwise emms / ;; orderless never see the binding (the lexical-binding foreign-special-var trap). (defvar orderless-smart-case) -(defvar emms-source-playlist-ask-before-overwrite) (defvar emms-playlist-buffer-p) (defvar emms-playlist-buffer) (defvar emms-random-playlist) @@ -56,6 +62,44 @@ (defface cj/music-keyhint-face '((t :inherit shadow)) "Key hints in the playlist header.") +;; Fancy-render faces (Phase 3). Amber comes from the themed `warning' face so +;; the active theme (dupre) owns the color; the serif family is applied at +;; render time from `cj/music-title-family'. +(defface cj/music-title-face '((t :inherit cj/music-header-value-face :weight bold)) + "Now-playing title in the fancy player.") +(defface cj/music-subtitle-face '((t :inherit shadow)) + "Now-playing subtitle (station or album) in the fancy player.") +(defface cj/music-bar-fill-face '((t :inherit warning)) + "Filled portion of the fancy progress bar (amber).") +(defface cj/music-bar-empty-face '((t :inherit shadow)) + "Empty portion of the fancy progress bar.") + +(defgroup cj/music nil + "Personal EMMS music-player tweaks." + :group 'emms) + +(defcustom cj/music-fancy-ui t + "When non-nil and the frame is graphical, render the fancy hi-fi player: +cover art, a serif now-playing hero, and a progress bar. Nil, or a TTY frame, +falls back to the plain text player (names, a dim glyph, a thin status line)." + :type 'boolean + :group 'cj/music) + +(defcustom cj/music-title-family + (if (boundp 'cj/nov-reading-font-family) cj/nov-reading-font-family "Merriweather") + "Serif family for the fancy now-playing title, mirroring the nov reading view." + :type 'string + :group 'cj/music) + +(defvar cj/music-hero-size 96 + "Pixel height of the now-playing hero cover image.") +(defvar cj/music-thumb-size 22 + "Pixel height of a playlist row's cover thumbnail.") +(defvar cj/music-bar-width 24 + "Cell width of the now-playing progress bar.") +(defvar cj/music-bar-interval 1 + "Seconds between progress-bar redraws while a track is playing and visible.") + ;; Foreign functions used lazily after their packages load. (declare-function emms-playlist-mode "emms-playlist-mode") (declare-function emms-playlist-track-at "emms-playlist-mode") @@ -63,11 +107,15 @@ (declare-function emms-track-name "emms") (declare-function emms-track-type "emms") (declare-function emms-track-get "emms") +(declare-function emms-track "emms") +(declare-function emms-track-set "emms") (declare-function emms-track-simple-description "emms") (declare-function emms-playlist-current-selected-track "emms") (declare-function emms-playlist-select "emms") +(declare-function emms-playlist-selected-track "emms") (declare-function emms-playlist-clear "emms") -(declare-function emms-playlist-save "emms-source-playlist") +(declare-function emms-playlist-insert-track "emms") +(declare-function emms-stop "emms") (declare-function emms-start "emms") (declare-function emms-random "emms") (declare-function emms-next "emms") @@ -179,6 +227,30 @@ A no-op when nothing is playing or the socket is gone, so it never errors." (accept-process-output proc 0.1)) (delete-process proc)))))) +(defun cj/music--mpv-get-property (prop) + "Query the mpv IPC socket for PROP and return its value, or nil. +Reads the reply (unlike `cj/music--mpv-command', which only sends), so the +progress bar can read percent-pos. Blocks briefly, so call it off redisplay." + (when (file-exists-p cj/music--mpv-socket) + (ignore-errors + (let ((out "") proc) + (setq proc (make-network-process + :name "cj-music-mpv-get" :family 'local + :service cj/music--mpv-socket :noquery t + :filter (lambda (_p s) (setq out (concat out s))))) + (unwind-protect + (progn + (process-send-string + proc (format "{\"command\":[\"get_property\",\"%s\"]}\n" prop)) + (accept-process-output proc 0.2) + (cl-loop for line in (split-string out "\n" t) + for obj = (ignore-errors + (json-parse-string line :object-type 'plist + :null-object nil)) + when (and obj (plist-member obj :data)) + return (plist-get obj :data))) + (delete-process proc)))))) + (defun cj/music-seek-forward () "Seek `cj/music-seek-seconds' seconds forward in the current track." (interactive) @@ -279,18 +351,22 @@ modification date so marginalia can show them." tracks)))) (nreverse tracks))))) -(defun cj/music--playlist-tracks () - "Return list of track names from current EMMS playlist buffer." +(defun cj/music--playlist-track-objects () + "Return the track objects from the current EMMS playlist buffer, in order." (let ((tracks '())) (with-current-buffer (cj/music--ensure-playlist-buffer) (save-excursion (goto-char (point-min)) (while (not (eobp)) (when-let ((track (emms-playlist-track-at (point)))) - (push (emms-track-name track) tracks)) + (push track tracks)) (forward-line 1)))) (nreverse tracks))) +(defun cj/music--playlist-tracks () + "Return list of track names from current EMMS playlist buffer." + (mapcar #'emms-track-name (cj/music--playlist-track-objects))) + (defun cj/music--dedup-m3u-files (paths) "Return (BASENAME . PATH) conses for PATHS, first occurrence of a basename winning. Pure helper: since `cj/music--get-m3u-files' scans `cj/music-m3u-roots' in order, @@ -317,10 +393,6 @@ collision the earlier directory wins." (mapcar (lambda (pair) (file-name-sans-extension (car pair))) (cj/music--get-m3u-files))) -(defun cj/music--safe-filename (name) - "Return NAME made filesystem-safe by replacing bad chars with underscores." - (replace-regexp-in-string "[^a-zA-Z0-9_-]" "_" name)) - (defun cj/music--playlist-modified-p () "Return non-nil if current playlist differs from its associated M3U file." (and cj/music-playlist-file @@ -467,23 +539,103 @@ Replaces current playlist." (message "Loaded playlist: %s" choice-name))) +(defun cj/music--m3u-track-lines (track entries) + "The .m3u lines for TRACK. +A file track is its bare absolute path. A url track carries its station +metadata — an #EXTINF label plus #RADIOBROWSERUUID / #RADIOBROWSERFAVICON when +known — read from the track's properties first, then its ENTRIES metadata (a +loaded legacy playlist has entries but no properties), so a saved station +keeps its display name and cover art on reload." + (let ((name (emms-track-name track))) + (if (not (eq (emms-track-type track) 'url)) + (concat name "\n") + (let* ((meta (cdr (assoc name entries))) + (label (or (emms-track-get track 'info-title) + (plist-get meta :name) + (cj/music--tidy-host name))) + (uuid (or (emms-track-get track 'radio-uuid) + (plist-get meta :uuid))) + (favicon (or (emms-track-get track 'radio-favicon) + (plist-get meta :favicon)))) + (concat + (if (and (stringp uuid) (not (string-empty-p uuid))) + (format "#RADIOBROWSERUUID:%s\n" uuid) + "") + (if (and (stringp favicon) (not (string-empty-p favicon))) + (format "#RADIOBROWSERFAVICON:%s\n" + (replace-regexp-in-string "[\r\n]+" " " favicon)) + "") + (format "#EXTINF:-1,%s\n" + (replace-regexp-in-string "[\r\n]+" " " label)) + name "\n"))))) + +(defun cj/music--m3u-text (tracks entries) + "The full .m3u file text for TRACKS, station metadata from ENTRIES. +The stock EMMS m3u writer emits bare URLs; this emitter writes the comment +lines `cj/music--m3u-entries' parses, so save -> load round-trips." + (concat "#EXTM3U\n" + (mapconcat (lambda (tr) (cj/music--m3u-track-lines tr entries)) + tracks ""))) + +(defun cj/music--write-playlist-file (path tracks entries) + "Write TRACKS to PATH as .m3u text, station metadata from ENTRIES. +Refreshes the radio metadata cache since a new .m3u just landed." + (with-temp-file path + (insert (cj/music--m3u-text tracks entries))) + (cj/music--refresh-radio-name-map)) + +(defun cj/music--save-default-name (tracks file entries) + "The name the save prompt should offer. +FILE (the playlist's associated .m3u) wins when present. Otherwise the first +url track's station name — its title property, else its #EXTINF label from +ENTRIES. Nil when neither applies (the caller falls back to a timestamp)." + (if file + (file-name-sans-extension (file-name-nondirectory file)) + (cl-loop for tr in tracks + when (eq (emms-track-type tr) 'url) + thereis (or (emms-track-get tr 'info-title) + (plist-get (cdr (assoc (emms-track-name tr) entries)) + :name))))) + +(defun cj/music--save-directory (tracks) + "Directory a saved playlist targets. +An all-stream queue is a radio playlist and saves into +`cj/music-radio-save-dir'; anything else saves into `cj/music-m3u-root'." + (if (and tracks + (cl-every (lambda (tr) (eq (emms-track-type tr) 'url)) tracks)) + cj/music-radio-save-dir + cj/music-m3u-root)) + (defun cj/music-playlist-save () - "Save current EMMS playlist to a file in cj/music-m3u-root. -Offers completion over existing names but allows new names." + "Save the current EMMS playlist to an .m3u file. +An all-stream queue saves into `cj/music-radio-save-dir' (the radio playlist +home); anything else saves into `cj/music-m3u-root'. A queue of freshly +looked-up stations pre-fills the first station's name in the prompt; a +playlist with an associated file keeps that file's name as the default. +Station metadata (name, uuid, favicon) is written with each stream so a +reloaded playlist keeps its display name and cover art." (interactive) - (let* ((existing (cj/music--get-m3u-basenames)) - (default-name (if cj/music-playlist-file - (file-name-sans-extension (file-name-nondirectory cj/music-playlist-file)) - (format-time-string "playlist-%Y%m%d-%H%M%S"))) - (chosen (completing-read "Save playlist as: " existing nil nil nil nil default-name)) + (let* ((tracks (cj/music--playlist-track-objects)) + (entries (cj/music--radio-metadata)) + (existing (cj/music--get-m3u-basenames)) + (assoc-file (with-current-buffer (cj/music--ensure-playlist-buffer) + cj/music-playlist-file)) + (prefill (and (null assoc-file) + (cj/music--save-default-name tracks nil entries))) + (default-name (or (cj/music--save-default-name tracks assoc-file entries) + (format-time-string "playlist-%Y%m%d-%H%M%S"))) + (chosen (completing-read "Save playlist as: " existing nil nil + prefill nil default-name)) (filename (if (string-suffix-p ".m3u" chosen) chosen (concat chosen ".m3u"))) - (full (expand-file-name filename cj/music-m3u-root))) + (dir (cj/music--save-directory tracks)) + (full (expand-file-name filename dir))) + (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)))) (user-error "Aborted saving playlist")) - (with-current-buffer (cj/music--ensure-playlist-buffer) - (let ((emms-source-playlist-ask-before-overwrite nil)) - (emms-playlist-save 'm3u full))) + (make-directory dir t) + (cj/music--write-playlist-file full tracks entries) (cj/music--sync-playlist-file full) (message "Saved playlist: %s" filename))) @@ -520,8 +672,9 @@ Offers completion over existing names but allows new names." (let ((path cj/music-playlist-file)) (when (cj/music--playlist-modified-p) (when (yes-or-no-p "Playlist modified. Save before editing? ") - (let ((emms-source-playlist-ask-before-overwrite nil)) - (emms-playlist-save 'm3u path)))) + (cj/music--write-playlist-file path + (cj/music--playlist-track-objects) + (cj/music--radio-metadata)))) ;; Re-validate existence before opening (if (file-exists-p path) (find-file-other-window path) @@ -624,40 +777,22 @@ Intended for use on `emms-player-finished-hook'." (defvar cj/music-playlist-window-height 0.3 "Default fraction of frame height for the F10 music playlist side window. -Used when the playlist docks at the bottom and hasn't been resized and -toggled off this session; after that, the toggled-off height is remembered -in `cj/--music-playlist-height'.") - -(defvar cj/music-playlist-window-width 0.4 - "Default fraction of frame width for the F10 music playlist side window. -Used when the playlist docks as a right-side column (see -`cj/--music-playlist-side') and hasn't been resized this session; after -that the toggled-off width is remembered in `cj/--music-playlist-width'.") +Used when the playlist hasn't been resized and toggled off this session; +after that, the toggled-off height is remembered in +`cj/--music-playlist-height'.") (defvar cj/--music-playlist-height nil - "Last height fraction the playlist was toggled off at while docked bottom. + "Last height fraction the playlist was toggled off at. nil means fall back to `cj/music-playlist-window-height'. In-memory only -- resets each Emacs session.") -(defvar cj/--music-playlist-width nil - "Last width fraction the playlist was toggled off at while docked right. -nil means fall back to `cj/music-playlist-window-width'. In-memory only -- -resets each Emacs session.") - -(defun cj/--music-playlist-side () - "Return the side the F10 playlist should dock on: `right' or `bottom'. -Docks as a right-side column only when a side-by-side split would leave -both panes at least `cj/window-dock-min-columns' wide (the playlist's -share is `cj/music-playlist-window-width'); otherwise docks at the bottom. -See `cj/preferred-dock-direction'." - (if (eq (cj/preferred-dock-direction (frame-width) - cj/music-playlist-window-width) - 'right) - 'right - 'bottom)) - (defun cj/music-playlist-toggle () "Toggle the EMMS playlist buffer in a bottom side window. +The playlist always docks at the bottom, whatever the frame's shape. It +used to dock as a right-side column on a wide frame (via +`cj/preferred-dock-direction'), which split a wide frame three ways -- +unexpected often enough that Craig retired the rule (2026-07-09). + The window opens at `cj/music-playlist-window-height'; if it has been resized and toggled off this session, it reopens at that remembered height." (interactive) @@ -666,28 +801,15 @@ resized and toggled off this session, it reopens at that remembered height." (win (and buffer (get-buffer-window buffer)))) (if win (progn - ;; Capture the resized size into the var matching the window's - ;; actual side, so width and height memories stay independent. - ;; Guard the parameter lookup: a dead or non-window WIN (the - ;; capture helpers tolerate one) must not error here. - (let ((side (if (window-live-p win) - (or (window-parameter win 'window-side) 'bottom) - 'bottom))) - (if (memq side '(left right)) - (cj/side-window-capture-size win side 'cj/--music-playlist-width) - (cj/side-window-capture-size win 'bottom 'cj/--music-playlist-height))) + (cj/side-window-capture-size win 'bottom 'cj/--music-playlist-height) (delete-window win) (message "Playlist window closed")) (progn (cj/emms--setup) (setq buffer (cj/music--ensure-playlist-buffer)) - (let* ((side (cj/--music-playlist-side)) - (right (eq side 'right))) - (setq win (cj/side-window-display - buffer side - (if right 'cj/--music-playlist-width 'cj/--music-playlist-height) - (if right cj/music-playlist-window-width - cj/music-playlist-window-height)))) + (setq win (cj/side-window-display + buffer 'bottom 'cj/--music-playlist-height + cj/music-playlist-window-height)) (select-window win) (with-current-buffer buffer (if (and (fboundp 'emms-playlist-current-selected-track) @@ -744,19 +866,25 @@ Dirs added recursively." ;;; EMMS setup and keybindings ;; Music/EMMS keymap +(defvar-keymap cj/music-radio-map + :doc "Radio prefix: mirrors the playlist buffer's n/t/m radio row." + "n" #'cj/music-radio-search-by-name + "t" #'cj/music-radio-search-by-tag + "m" #'cj/music-create-radio-station) + (defvar-keymap cj/music-map - :doc "Keymap for music commands" + :doc "Keymap for music commands (all lowercase, chord-friendly)" "m" #'cj/music-playlist-toggle - "M" #'cj/music-playlist-show + "v" #'cj/music-playlist-show "a" #'cj/music-fuzzy-select-and-add - "R" #'cj/music-create-radio-station + "r" cj/music-radio-map "SPC" #'emms-pause "s" #'emms-stop "n" #'cj/music-next "p" #'cj/music-previous "g" #'emms-playlist-mode-go - "Z" #'emms-shuffle - "r" #'emms-toggle-repeat-playlist + "u" #'emms-shuffle + "l" #'emms-toggle-repeat-playlist "t" #'emms-toggle-repeat-track "z" #'emms-toggle-random-playlist "x" #'cj/music-toggle-consume) @@ -766,16 +894,19 @@ Dirs added recursively." (which-key-add-key-based-replacements "C-; m" "music menu" "C-; m m" "toggle playlist" - "C-; m M" "show playlist" + "C-; m v" "show playlist" "C-; m a" "add music" - "C-; m R" "create radio" + "C-; m r" "+radio" + "C-; m r n" "radio by name" + "C-; m r t" "radio by tag" + "C-; m r m" "radio manual entry" "C-; m SPC" "pause" "C-; m s" "stop" "C-; m n" "next track" "C-; m p" "previous track" "C-; m g" "goto playlist" - "C-; m Z" "shuffle" - "C-; m r" "repeat playlist" + "C-; m u" "shuffle" + "C-; m l" "repeat playlist" "C-; m t" "repeat track" "C-; m z" "random" "C-; m x" "consume")) @@ -913,15 +1044,25 @@ fontless frame never shows a tofu box." (if stream "»" "•")))) (defun cj/music--row-string (track) - "Playlist row for TRACK: a dim type glyph, the display name, and the meta -right-aligned to the window edge with a resize-safe :align-to space. + "Playlist row for TRACK: a lead glyph or cover thumbnail, the display name, +and the meta right-aligned to the window edge with a resize-safe :align-to +space. In the fancy render the lead is a thumbnail and the name is serif. This is `emms-track-description-function'." (let* ((name (cj/music--display-name track (cj/music--radio-name-map))) - (glyph (cj/music--type-glyph track)) - (meta (cj/music--format-meta track))) + (meta (cj/music--format-meta track)) + (fancy (cj/music--fancy-p)) + (lead (if-let* ((fancy) + (img (cj/music--image (cj/music-art--for-track track) + cj/music-thumb-size))) + (propertize " " 'display img) + (cj/music--type-glyph track))) + (label (if fancy + (propertize name 'face (list :family cj/music-title-family + :inherit 'cj/music-title-face)) + name))) (if (string-empty-p meta) - (concat glyph " " name) - (concat glyph " " name + (concat lead " " label) + (concat lead " " label (propertize " " 'display `(space :align-to (- right ,(1+ (length meta))))) (propertize meta 'face 'cj/music-keyhint-face))))) @@ -934,65 +1075,148 @@ duration for a timed file, empty otherwise." (let ((d (cj/music--format-duration (emms-track-get track 'info-playing-time)))) (if d (format " %s" d) "")))) +;; ------------------------------ Fancy render --------------------------------- +;; The GUI hero (cover image + serif title + bar) and thumbnailed serif rows, +;; gated on a graphical frame + `cj/music-fancy-ui'. Cover art comes from the +;; non-blocking `cj/music-art--for-track' (defined with the art layer below). + +(defun cj/music--fancy-p () + "Non-nil when the fancy render applies: a graphical frame with the +`cj/music-fancy-ui' toggle on. Decided per redisplay, so a TTY frame and a GUI +frame in the same session can differ." + (and cj/music-fancy-ui (display-graphic-p))) + +(defun cj/music--image (path height) + "Image spec for PATH scaled to HEIGHT px, or nil when it can't be displayed +\(no image support, an unreadable file, an unavailable format)." + (when (and path (file-readable-p path)) + (ignore-errors + (create-image path nil nil :height height :ascent 'center)))) + +(defun cj/music--bar-string (fill width) + "Render a WIDTH-cell block progress bar with FILL filled cells. +FILL `indeterminate' (a live stream) renders an on-air marker instead." + (if (eq fill 'indeterminate) + (propertize "◉ on air" 'face 'cj/music-subtitle-face) + (let ((n (max 0 (min fill width)))) + (concat (propertize (make-string n ?█) 'face 'cj/music-bar-fill-face) + (propertize (make-string (- width n) ?░) + 'face 'cj/music-bar-empty-face))))) + +(defun cj/music--current-bar (track) + "The progress bar for TRACK: a stream is indeterminate; a file fills from +mpv's percent-pos." + (if (eq (emms-track-type track) 'url) + (cj/music--bar-string 'indeterminate cj/music-bar-width) + (let ((pct (cj/music--mpv-get-property "percent-pos"))) + (cj/music--bar-string + (cj/music--bar-fill (and (numberp pct) pct) 100 cj/music-bar-width) + cj/music-bar-width)))) + +(defun cj/music--hero-header (track) + "Fancy now-playing hero for TRACK: cover image, serif amber title, subtitle, +and the progress bar, stacked vertically." + (let* ((img (cj/music--image (cj/music-art--for-track track) cj/music-hero-size)) + (title (cj/music--display-name track (cj/music--radio-name-map))) + (sub (if (eq (emms-track-type track) 'url) + "radio" + (or (emms-track-get track 'info-album) "")))) + (concat + (if img (concat (propertize " " 'display img) "\n") "") + (propertize title 'face (list :family cj/music-title-family + :inherit 'cj/music-title-face)) + "\n" + (if (string-empty-p sub) + "" + (concat (propertize sub 'face 'cj/music-subtitle-face) "\n")) + (cj/music--current-bar track) + "\n"))) + ;; Multi-line header overlay (defvar-local cj/music--header-overlay nil "Overlay displaying the playlist header.") -(defun cj/music--header-text () - "Build a multi-line header string for the playlist buffer overlay." - (let* ((pl-name (if cj/music-playlist-file - (file-name-sans-extension - (file-name-nondirectory cj/music-playlist-file)) - "Untitled")) - (track-count (count-lines (point-min) (point-max))) - (now-playing (cond - ((not emms-player-playing-p) "Stopped") - (emms-player-paused-p "Paused") - (t (let ((track (emms-playlist-current-selected-track))) - (if track - (concat (cj/music--display-name - track (cj/music--radio-name-map)) - (cj/music--now-playing-suffix track)) - "Playing"))))) - (mode-indicator - (lambda (key label active) - (let ((face (if active 'cj/music-mode-on-face 'cj/music-mode-off-face))) - (propertize (format "[%s] %s" key label) 'face face))))) +(defun cj/music--playlist-string () + "The \"Playlist : NAME (N)\" header line." + (let ((pl-name (if cj/music-playlist-file + (file-name-sans-extension + (file-name-nondirectory cj/music-playlist-file)) + "Untitled")) + (track-count (count-lines (point-min) (point-max)))) + (concat (propertize "Playlist" 'face 'cj/music-header-face) + (propertize " : " 'face 'cj/music-header-face) + (propertize (format "%s (%d)" pl-name track-count) + 'face 'cj/music-header-value-face) + "\n"))) + +(defun cj/music--controls-string () + "The Mode / Keys / Radio control lines and the closing full-width rule. +The rule uses a resize-safe :align-to span, not a hardcoded character count." + (let ((mode-indicator + (lambda (key label active) + (let ((face (if active 'cj/music-mode-on-face 'cj/music-mode-off-face))) + (propertize (format "[%s] %s" key label) 'face face))))) (concat - (propertize "Playlist" 'face 'cj/music-header-face) - (propertize " : " 'face 'cj/music-header-face) - (propertize (format "%s (%d)" pl-name track-count) 'face 'cj/music-header-value-face) - "\n" - (propertize "Current " 'face 'cj/music-header-face) - (propertize " : " 'face 'cj/music-header-face) - (propertize now-playing 'face 'cj/music-header-value-face) - "\n" (propertize "Mode " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) - (funcall mode-indicator "r" "repeat" (bound-and-true-p emms-repeat-playlist)) - " " - (funcall mode-indicator "s" "single" (bound-and-true-p emms-repeat-track)) - " " - (funcall mode-indicator "z" "random" (bound-and-true-p emms-random-playlist)) - " " - (funcall mode-indicator "x" "consume" cj/music-consume-mode) - "\n" + (funcall mode-indicator "r" "repeat" (bound-and-true-p emms-repeat-playlist)) " " + (funcall mode-indicator "s" "single" (bound-and-true-p emms-repeat-track)) " " + (funcall mode-indicator "z" "random" (bound-and-true-p emms-random-playlist)) " " + (funcall mode-indicator "x" "consume" cj/music-consume-mode) "\n" (propertize "Keys " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) - (propertize "a:add c:clear L:load S:stop SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" - 'face 'cj/music-keyhint-face) - "\n" + (propertize "a:add c:clear L:load v:save S:stop SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" + 'face 'cj/music-keyhint-face) "\n" (propertize "Radio " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) (propertize "n:by name t:by tag m:enter manually" - 'face 'cj/music-keyhint-face) - "\n" - ;; A full-width rule under the header, resize-safe (redisplay recomputes - ;; the :align-to span rather than a hardcoded character count). + 'face 'cj/music-keyhint-face) "\n" (propertize " " 'face '(:strike-through t :inherit shadow) 'display '(space :align-to right)) "\n\n"))) +(defun cj/music--current-track () + "The selected track when one is playing or paused, else nil." + (and emms-player-playing-p + (ignore-errors (emms-playlist-current-selected-track)))) + +(defun cj/music--text-header () + "The plain text header: Playlist, Current, then the controls." + (let ((now (cond ((not emms-player-playing-p) "Stopped") + (emms-player-paused-p "Paused") + (t (let ((track (cj/music--current-track))) + (if track + (concat (cj/music--display-name + track (cj/music--radio-name-map)) + (cj/music--now-playing-suffix track)) + "Playing")))))) + (concat (cj/music--playlist-string) + (propertize "Current " 'face 'cj/music-header-face) + (propertize " : " 'face 'cj/music-header-face) + (propertize now 'face 'cj/music-header-value-face) "\n" + (cj/music--controls-string)))) + +(defun cj/music--fancy-header () + "The fancy header: Playlist, the now-playing hero when a track plays, then +the controls." + (let ((track (cj/music--current-track))) + (concat (cj/music--playlist-string) + (if track + (cj/music--hero-header track) + (concat (propertize "Current " 'face 'cj/music-header-face) + (propertize " : " 'face 'cj/music-header-face) + (propertize (if emms-player-paused-p "Paused" "Stopped") + 'face 'cj/music-header-value-face) + "\n")) + (cj/music--controls-string)))) + +(defun cj/music--header-text () + "Build the playlist header overlay string: fancy in a graphical frame with +`cj/music-fancy-ui' on, plain text otherwise." + (if (cj/music--fancy-p) + (cj/music--fancy-header) + (cj/music--text-header))) + (defun cj/music--update-header () "Insert or update the multi-line header overlay in the playlist buffer." (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) @@ -1004,6 +1228,43 @@ duration for a timed file, empty otherwise." (overlay-put cj/music--header-overlay 'before-string (cj/music--header-text))))) +;; Progress-bar redraw timer and cover-art pre-warm (Phase 3). +(defvar cj/music--bar-timer nil + "Repeating timer redrawing the progress bar while a track plays.") + +(defun cj/music--bar-tick () + "Redraw the header when the player buffer is visible and a track is playing. +The timer keeps running while idle/paused; it just skips the redraw." + (when (and emms-player-playing-p (not emms-player-paused-p) + (get-buffer-window cj/music-playlist-buffer-name t)) + (cj/music--update-header))) + +(defun cj/music--start-bar-timer (&rest _) + "Start the progress-bar redraw timer if it is not already running." + (unless cj/music--bar-timer + (setq cj/music--bar-timer + (run-at-time t cj/music-bar-interval #'cj/music--bar-tick)))) + +(defun cj/music--stop-bar-timer (&rest _) + "Stop the progress-bar redraw timer." + (when cj/music--bar-timer + (cancel-timer cj/music--bar-timer) + (setq cj/music--bar-timer nil))) + +(defun cj/music--do-prewarm-art () + "Fetch the current track's cover art, then refresh the header so the fetched +art replaces the placeholder. Blocks on the network; runs off an idle timer." + (when-let ((track (cj/music--current-track))) + (when (cj/music-art--ensure track) + (cj/music--update-header)))) + +(defun cj/music--prewarm-art (&rest _) + "Schedule a cover-art fetch for the current track during idle, so a slow +fetch never blocks playback start (the emms-player-started-hook). A no-op +unless fancy." + (when (cj/music--fancy-p) + (run-with-idle-timer 0.2 nil #'cj/music--do-prewarm-art))) + (defvar-local cj/music--bg-remap-cookie nil "Cookie for the active-window background face remapping.") @@ -1076,6 +1337,13 @@ duration for a timed file, empty otherwise." (add-hook 'emms-player-finished-hook #'cj/music--update-header) (add-hook 'emms-playlist-cleared-hook #'cj/music--update-header) + ;; Fancy render: run the bar timer only across a playing span, and pre-warm + ;; the current track's cover art off the redisplay path. + (add-hook 'emms-player-started-hook #'cj/music--start-bar-timer) + (add-hook 'emms-player-started-hook #'cj/music--prewarm-art) + (add-hook 'emms-player-stopped-hook #'cj/music--stop-bar-timer) + (add-hook 'emms-player-finished-hook #'cj/music--stop-bar-timer) + ;; Refresh header immediately when toggling modes (dolist (fn '(emms-toggle-repeat-playlist emms-toggle-repeat-track @@ -1113,7 +1381,7 @@ duration for a timed file, empty otherwise." ("L" . cj/music-playlist-load) ("E" . cj/music-playlist-edit) ("g" . cj/music-playlist-reload) - ("S" . cj/music-playlist-save) + ("v" . cj/music-playlist-save) ;; Track reordering ("S-<up>" . emms-playlist-mode-shift-track-up) ("S-<down>" . emms-playlist-mode-shift-track-down) @@ -1129,7 +1397,10 @@ duration for a timed file, empty otherwise." ;;; Radio station creation (defun cj/music-create-radio-station (name url) - "Create a radio station M3U playlist with NAME and URL in cj/music-m3u-root." + "Queue and play a radio station from a hand-entered NAME and URL. +The station becomes a url track in the playlist (NAME as its title) and +playback starts. Nothing is written to disk — save the queue with the normal +playlist save, where NAME pre-fills the prompt." (interactive (list (read-string "Radio station name: ") (read-string "Stream URL: "))) @@ -1137,25 +1408,21 @@ duration for a timed file, empty otherwise." (user-error "Radio station name cannot be empty")) (when (string-empty-p url) (user-error "Stream URL cannot be empty")) - (let* ((safe (cj/music--safe-filename name)) - (file (expand-file-name (concat safe "_Radio.m3u") cj/music-m3u-root)) - (content (format "#EXTM3U\n#EXTINF:-1,%s\n%s\n" name url))) - (when (and (file-exists-p file) - (not (cj/confirm-strong (format "Overwrite %s? " (file-name-nondirectory file))))) - (user-error "Aborted creating radio station")) - (with-temp-file file - (insert content)) - (cj/music--refresh-radio-name-map) - (message "Created radio station: %s" (file-name-nondirectory file)))) + (cj/emms--setup) + (cj/music-radio--enqueue-and-play + (list (cj/music-radio--station-track (list :name name :url url)))) + (message "Queued radio station: %s" name)) ;; The manual name+URL creator is bound to m in the radio row below (see the ;; with-eval-after-load block near the radio-browser lookup), not R. ;; --------------------------- Radio-browser Lookup ---------------------------- -;; Search radio-browser.info and turn a selection into a playable radio .m3u. -;; Spec: docs/specs/2026-07-06-radio-browser-lookup-spec.org. The pure pieces -;; (parse / emit / format / filename) carry the tests; the network GET and the -;; interactive command are exercised live. +;; Search radio-browser.info and queue a selection as playing url tracks, each +;; carrying its station metadata as track properties. Nothing is written at +;; pick time; the playlist save writes the metadata back out as .m3u comment +;; lines. Spec: docs/specs/2026-07-06-radio-browser-lookup-spec.org. The +;; pure pieces (parse / track-build / format) carry the tests; the network GET +;; and the interactive command are exercised live. (require 'url) @@ -1171,11 +1438,8 @@ The project asks clients to identify themselves.") "Maximum number of stations a radio-browser search returns.") (defvar cj/music-radio-save-dir (expand-file-name "~/.local/share/mpd/playlists/") - "Directory new radio-browser stations are written to (the radio home).") - -(defvar cj/music-radio-filename-suffix "-Radio" - "Suffix appended to a created station's basename, before the .m3u extension. -Marks a lookup-created station in the playlist directory.") + "Directory radio playlists are saved to (the radio home). +The playlist save targets it when every track in the queue is a stream.") (defun cj/music-radio--parse-search (json-text) "Parse a radio-browser JSON-TEXT array into a list of station plists. @@ -1193,29 +1457,43 @@ clear message instead of a stack trace." (cond ((and (stringp r) (not (string-empty-p r))) r) ((and (stringp u) (not (string-empty-p u))) u)))) -(defun cj/music-radio--station-m3u (st) - "Return the .m3u file text for station ST, or nil when it has no stream URL. -Matches the existing radio files: #EXTM3U, an optional #RADIOBROWSERUUID line, -#EXTINF:1,<name>, and the stream URL." - (let* ((url (cj/music-radio--station-url st)) - ;; Strip newlines so an unexpected multi-line name can't inject extra - ;; m3u lines; the API returns single-line names, but it's external data. - (name (replace-regexp-in-string "[\r\n]+" " " - (or (plist-get st :name) "Radio"))) - (uuid (plist-get st :stationuuid)) - (favicon (plist-get st :favicon))) - (when url - (concat "#EXTM3U\n" - (if (and (stringp uuid) (not (string-empty-p uuid))) - (format "#RADIOBROWSERUUID:%s\n" uuid) - "") - ;; Capture the favicon at creation so the cover-art layer needs - ;; no byuuid lookup later; same newline-strip guard as the name. - (if (and (stringp favicon) (not (string-empty-p favicon))) - (format "#RADIOBROWSERFAVICON:%s\n" - (replace-regexp-in-string "[\r\n]+" " " favicon)) - "") - (format "#EXTINF:1,%s\n%s\n" name url))))) +(defun cj/music-radio--station-track (st) + "Return an EMMS url track for station ST, or nil when it has no stream URL. +The track carries the station name as `info-title' plus `radio-uuid' and +`radio-favicon' properties, so display names and cover art need no .m3u on +disk; the playlist save writes the same metadata back out as comment lines. +Newlines in the external name/favicon are flattened so they can't inject +extra .m3u lines at save time." + (when-let ((url (cj/music-radio--station-url st))) + (let ((track (emms-track 'url url)) + (name (replace-regexp-in-string "[\r\n]+" " " + (or (plist-get st :name) "Radio"))) + (uuid (plist-get st :stationuuid)) + (favicon (plist-get st :favicon))) + (emms-track-set track 'info-title name) + (when (and (stringp uuid) (not (string-empty-p uuid))) + (emms-track-set track 'radio-uuid uuid)) + (when (and (stringp favicon) (not (string-empty-p favicon))) + (emms-track-set track 'radio-favicon + (replace-regexp-in-string "[\r\n]+" " " favicon))) + track))) + +(defun cj/music-radio--enqueue-and-play (tracks) + "Append TRACKS to the playlist buffer and play the first of them. +Interrupts whatever is playing; the rest of the queue is left in place. A nil +TRACKS is a no-op." + (when tracks + (cj/emms--setup) + (with-current-buffer (cj/music--ensure-playlist-buffer) + (let ((first-pos nil)) + (save-excursion + (dolist (tr tracks) + (goto-char (point-max)) + (unless first-pos (setq first-pos (point))) + (emms-playlist-insert-track tr))) + (emms-playlist-select first-pos))) + (when emms-player-playing-p (emms-stop)) + (emms-start))) (defun cj/music-radio--tags-snippet (tags n) "Return the first N comma-separated TAGS as a trimmed display string. @@ -1235,15 +1513,6 @@ Variant B: codec, bitrate, country, votes, and the first few tags." (tags (cj/music-radio--tags-snippet (plist-get st :tags) 3))) (format "%-4s %-5s %-2s ♥%d %s" codec bitrate cc votes tags))) -(defun cj/music-radio--disambiguate-name (name uuid taken) - "Return a filesystem-safe basename for NAME, unique against the TAKEN list. -On a collision, append a short fragment of UUID. Pure helper: keeps two -same-named stations picked in one search from overwriting each other." - (let ((base (cj/music--safe-filename name))) - (if (member base taken) - (concat base "_" (substring (or uuid "x") 0 (min 8 (length (or uuid "x"))))) - base))) - (defun cj/music-radio--search-url (server query &optional field) "Build the radio-browser station-search URL for QUERY against SERVER. FIELD is the search field: \"name\" (default) or \"tag\"." @@ -1301,29 +1570,6 @@ to one station. Pure helper." (puthash disp t seen) (push (cons disp st) out))))) -(defun cj/music-radio--write-stations (stations dir) - "Write each station in STATIONS as an .m3u into DIR. -Skips a station with no stream URL and disambiguates a filename that collides -with an already-written one this run. Returns a plist (:written PATHS :skipped -NAMES). Creates DIR when absent." - (make-directory dir t) - (let ((taken '()) (written '()) (skipped '())) - (dolist (st stations) - (let ((m3u (cj/music-radio--station-m3u st))) - (if (not m3u) - (push (or (plist-get st :name) "(unnamed)") skipped) - (let* ((base (cj/music-radio--disambiguate-name - (or (plist-get st :name) "Radio") - (plist-get st :stationuuid) taken)) - (path (expand-file-name - (concat base cj/music-radio-filename-suffix ".m3u") dir))) - (push base taken) - (with-temp-file path (insert m3u)) - (push path written))))) - ;; New .m3u files landed, so the cached url->label map is stale. - (when written (cj/music--refresh-radio-name-map)) - (list :written (nreverse written) :skipped (nreverse skipped)))) - (defun cj/music-radio--completion-table (candidates) "Completion table over CANDIDATES carrying the Variant-B marginalia affix." (lambda (string pred action) @@ -1364,21 +1610,17 @@ selection order; each pick is removed from the pool so it can't be chosen twice. (setq pool (delq cell pool)))))) (nreverse chosen))) -(defun cj/music-radio--play (paths) - "Play the first .m3u in PATHS immediately (interrupting), enqueue the rest." - (when paths - (emms-play-playlist (car paths)) - (dolist (p (cdr paths)) - (emms-add-playlist p)))) - (defun cj/music-radio--search-and-play (query field) - "Search radio-browser for QUERY on FIELD, pick stations, then create and play. + "Search radio-browser for QUERY on FIELD, pick stations, then queue and play. FIELD is \"name\" or \"tag\". Lists matching stations (annotated with codec, -bitrate, country, votes, and tags), lets you pick several one at a time, writes -each as an .m3u into `cj/music-radio-save-dir', then plays the selection through -mpv (interrupting whatever was playing)." +bitrate, country, votes, and tags), lets you pick several one at a time, adds +each to the playlist as a url track carrying its station metadata, and plays +the first pick (interrupting whatever was playing). Nothing is written to +disk; save the queue with the normal playlist save, where the station name +pre-fills the prompt." (when (string-empty-p (string-trim query)) (user-error "Empty search")) + (cj/emms--setup) (let* ((stations (cj/music-radio--search query field)) (candidates (cj/music-radio--candidates stations))) (unless candidates @@ -1386,31 +1628,30 @@ mpv (interrupting whatever was playing)." (let ((chosen (cj/music-radio--pick-loop candidates))) (unless chosen (user-error "No stations selected")) - (let* ((result (cj/music-radio--write-stations chosen cj/music-radio-save-dir)) - (written (plist-get result :written)) - (skipped (plist-get result :skipped))) - (when written - (cj/music-radio--play written)) - (message "Created %d station%s%s%s" - (length written) - (if (= (length written) 1) "" "s") + (let ((tracks (delq nil (mapcar #'cj/music-radio--station-track chosen))) + (skipped (cl-loop for st in chosen + unless (cj/music-radio--station-url st) + collect (or (plist-get st :name) "(unnamed)")))) + (cj/music-radio--enqueue-and-play tracks) + (message "Queued %d station%s%s%s" + (length tracks) + (if (= (length tracks) 1) "" "s") (if skipped (format ", skipped %d with no URL (%s)" (length skipped) (string-join skipped ", ")) "") - (if written + (if tracks (format " — playing %s" - (file-name-sans-extension - (file-name-nondirectory (car written)))) + (emms-track-get (car tracks) 'info-title)) "")))))) (defun cj/music-radio-search-by-name (query) - "Search radio-browser.info by station name, then create and play a selection." + "Search radio-browser.info by station name, then queue and play a selection." (interactive "sRadio search (name): ") (cj/music-radio--search-and-play query "name")) (defun cj/music-radio-search-by-tag (tag) - "Search radio-browser.info by tag/genre, then create and play a selection." + "Search radio-browser.info by tag/genre, then queue and play a selection." (interactive "sRadio search (tag): ") (cj/music-radio--search-and-play tag "tag")) @@ -1436,23 +1677,28 @@ file hash. Gitignored runtime state; `cj/music-clear-art-cache' empties it.") (defun cj/music-art--cache-key (track &optional entries) "Stable cache-file basename (no extension) for TRACK. -A url with a #RADIOBROWSERUUID in ENTRIES keys on the uuid so a station shares -one cached logo; any other url keys on a hash of its address; a file keys on a -hash of its path." +A url with a station uuid — the track's `radio-uuid' property, else a +#RADIOBROWSERUUID in ENTRIES — keys on the uuid so a station shares one cached +logo; any other url keys on a hash of its address; a file keys on a hash of +its path." (let ((name (emms-track-name track))) (if (eq (emms-track-type track) 'url) - (let ((uuid (plist-get (cdr (assoc name entries)) :uuid))) + (let ((uuid (or (emms-track-get track 'radio-uuid) + (plist-get (cdr (assoc name entries)) :uuid)))) (if (and (stringp uuid) (not (string-empty-p uuid))) uuid (concat "url-" (sha1 name)))) (concat "file-" (sha1 name))))) (defun cj/music-art--favicon-url (track &optional entries) - "Direct favicon image URL for a url TRACK from its captured -#RADIOBROWSERFAVICON, or nil. A station with only a uuid resolves via a byuuid -lookup elsewhere; a file track has no favicon URL." + "Direct favicon image URL for a url TRACK, or nil. +The track's `radio-favicon' property wins, then its captured +#RADIOBROWSERFAVICON from ENTRIES. A station with only a uuid resolves via a +byuuid lookup elsewhere; a file track has no favicon URL." (when (eq (emms-track-type track) 'url) - (let ((fav (plist-get (cdr (assoc (emms-track-name track) entries)) :favicon))) + (let ((fav (or (emms-track-get track 'radio-favicon) + (plist-get (cdr (assoc (emms-track-name track) entries)) + :favicon)))) (and (stringp fav) (not (string-empty-p fav)) fav)))) (defun cj/music-art--valid-image-p (data) @@ -1526,9 +1772,10 @@ when there is nothing to fetch." (unless (cj/music-art--cached-file key) (when (eq (emms-track-type track) 'url) (let ((fav (or (cj/music-art--favicon-url track entries) - (let ((uuid (plist-get (cdr (assoc (emms-track-name track) - entries)) - :uuid))) + (let ((uuid (or (emms-track-get track 'radio-uuid) + (plist-get (cdr (assoc (emms-track-name track) + entries)) + :uuid)))) (and (stringp uuid) (not (string-empty-p uuid)) (cj/music-art--byuuid-favicon uuid)))))) (and fav (cj/music-art--fetch-to-cache fav key))))))) diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index 207c286e..d4407b28 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -50,10 +50,10 @@ :demand t :config (setq org-agenda-prefix-format '((agenda . " %i %-25:c%?-12t% s") - (timeline . " % s") (todo . " %i %-25:c") (tags . " %i %-12:c") (search . " %i %-12:c"))) + (setq org-agenda-timegrid-use-ampm t) ;; show the agenda time grid in 12-hour am/pm (setq org-agenda-dim-blocked-tasks 'invisible) (setq org-agenda-skip-scheduled-if-done nil) (setq org-agenda-remove-tags t) diff --git a/modules/org-babel-config.el b/modules/org-babel-config.el index 79661013..51919da1 100644 --- a/modules/org-babel-config.el +++ b/modules/org-babel-config.el @@ -173,8 +173,5 @@ session when working in trusted files, and back on when done." ;; requires ob-racket, not yet in repositories ;; (add-to-list 'org-structure-template-alist '("sicp" . "src racket :lang sicp")) -;; drop Org’s default footnote list at the end -(setq org-html-footnote-separator "") - (provide 'org-babel-config) ;;; org-babel-config.el ends here. diff --git a/modules/org-capture-config.el b/modules/org-capture-config.el index 292e26a7..b7250f1e 100644 --- a/modules/org-capture-config.el +++ b/modules/org-capture-config.el @@ -157,6 +157,8 @@ re-scanning large target files after the first successful lookup." (interactive) (user-error "Key disabled during capture -- finalize with C-c C-c or abort with C-c C-k")) +(defvar org-capture-mode-map) + (with-eval-after-load 'org-capture (dolist (key '("<f1>" "<f10>" "<f11>" "<f12>" "M-SPC")) (keymap-set org-capture-mode-map key #'cj/--org-capture-blocked-key))) @@ -381,10 +383,10 @@ A popup still mid-capture has capture UI and is not reapable, so it is spared." (defun cj/org-capture-reap-popup-frames () "Delete every quick-capture popup frame that no longer shows capture UI. Reaps across ALL frames, not just the selected one: a capture that finalizes, -aborts, or errors while the daemon's selected frame is something else (the common -multi-frame case) still cleans up its \"org-capture\" popup, while a popup -mid-capture is spared. Never deletes the last remaining frame. Safe to call -anytime — bound to nothing, run via M-x when a stray popup needs clearing." +aborts, or errors while the daemon's selected frame is something else (the +common multi-frame case) still cleans up its \"org-capture\" popup, while a +popup mid-capture is spared. Never deletes the last remaining frame. Safe to +call anytime — bound to nothing, run via M-x when a stray popup needs clearing." (interactive) (dolist (f (frame-list)) (when (and (frame-live-p f) @@ -395,9 +397,7 @@ anytime — bound to nothing, run via M-x when a stray popup needs clearing." (window-list f 'no-minibuf)))) (delete-frame f)))) -;; Reap on every capture exit. `remove-hook' first so a live module reload swaps -;; the retired narrow (selected-frame) handler for this one without leaving both. -(remove-hook 'org-capture-after-finalize-hook #'cj/org-capture--delete-popup-frame) +;; Reap on every capture exit. (add-hook 'org-capture-after-finalize-hook #'cj/org-capture-reap-popup-frames) ;; The popup opens a fresh emacsclient frame still showing the daemon's last @@ -437,6 +437,55 @@ never split the small floating frame." '(cj/org-capture--popup-display-condition cj/org-capture--display-sole-window)) +;; A fresh "org-capture" popup opens showing the daemon's last buffer (see the +;; comment above), and only the capture UI + the reap-on-finalize hook clear it. +;; If a capture aborts before its UI paints (a C-g, an erroring template, a path +;; that skips `cj/quick-capture'), the popup lingers showing whatever was current +;; -- and if that was a live terminal (an eat/vterm Claude Code buffer), eat +;; sizes the terminal to that small popup window and clamps the real frame down +;; to the popup's rows. These two guards keep the popup from ever holding a +;; size-sensitive live buffer: it only ever shows capture UI or *scratch*. + +(defun cj/org-capture--neutralize-frame (frame) + "Point every non-capture-UI window of the \"org-capture\" popup FRAME at +*scratch*. Capture UI (the *Org Select* menu, a CAPTURE-* buffer) is spared, so +this never disturbs a live capture; it only evicts a stray live buffer (the +daemon's last buffer on open, or a buffer restored on abort) that would +otherwise mirror the popup's size onto its source buffer. Idempotent: a window +already on *scratch* is left alone, so it can't loop through the +`window-buffer-change-functions' it fires." + (when (and (frame-live-p frame) + (equal (frame-parameter frame 'name) "org-capture")) + (dolist (w (window-list frame 'no-minibuf)) + (let ((name (buffer-name (window-buffer w)))) + (unless (or (cj/org-capture--popup-sole-window-p "org-capture" name) + (equal name "*scratch*")) + (set-window-buffer w (get-buffer-create "*scratch*"))))))) + +;; Guard 1 (root cause): neutralize the popup the instant it is created, before +;; any capture UI paints, so it never opens mirroring the daemon's last buffer. +(defun cj/org-capture--neutralize-new-frame (frame) + "Neutralize a freshly-made \"org-capture\" popup FRAME on creation. +See `cj/org-capture--neutralize-frame'." + (cj/org-capture--neutralize-frame frame)) + +(add-hook 'after-make-frame-functions #'cj/org-capture--neutralize-new-frame) + +;; Guard 2 (safety net): catch any path the finalize reap misses. If a live +;; buffer is displayed in the popup after creation (an aborted capture restoring +;; the previous buffer, a stray `switch-to-buffer'), evict it at once. +(defun cj/org-capture--neutralize-on-buffer-change (frame-or-window) + "Neutralize the \"org-capture\" popup after any buffer change in FRAME-OR-WINDOW. +`window-buffer-change-functions' passes a frame (global hook) or a window +(buffer-local); handle both." + (let ((frame (if (windowp frame-or-window) + (window-frame frame-or-window) + frame-or-window))) + (cj/org-capture--neutralize-frame frame))) + +(add-hook 'window-buffer-change-functions + #'cj/org-capture--neutralize-on-buffer-change) + ;; The desktop quick-capture popup is launched globally (no browser selection, ;; no mu4e message, no pdf/epub buffer), so the context-dependent templates make ;; no sense there. `cj/quick-capture' captures a single Task straight into the diff --git a/modules/org-contacts-config.el b/modules/org-contacts-config.el index 944d75c1..39ff9910 100644 --- a/modules/org-contacts-config.el +++ b/modules/org-contacts-config.el @@ -170,29 +170,40 @@ Added: %U" (require 'system-lib) +(defun cj/--org-contacts-collect (buffer) + "Return an alist of (NAME POSITION INFO) for the contact headings in BUFFER. +NAME is the heading text, POSITION its buffer position, and INFO the +EMAIL or PHONE property value (or nil)." + (with-current-buffer buffer + (org-map-entries + (lambda () + (list (nth 4 (org-heading-components)) + (point) + (or (org-entry-get nil "EMAIL") + (org-entry-get nil "PHONE")))) + nil nil))) + (defun cj/org-contacts-find () - "Find and open a contact." + "Find a contact and jump to its heading. +Collect the contact headings before prompting, so cancelling the prompt +leaves point where it was, and jump to the selected heading's stored +position instead of a text search that could land inside another entry." (interactive) - (find-file contacts-file) - (goto-char (point-min)) - (let* ((alist (org-map-entries - (lambda () - (cons (nth 4 (org-heading-components)) - (or (org-entry-get nil "EMAIL") - (org-entry-get nil "PHONE")))) - nil (list contacts-file))) + (let* ((buf (find-file-noselect contacts-file)) + (alist (cj/--org-contacts-collect buf)) (contact (completing-read "Find contact: " (cj/completion-table-annotated 'contact (lambda (cand) - (let ((info (cdr (assoc cand alist)))) + (let ((info (nth 2 (assoc cand alist)))) (when (and info (> (length info) 0)) (concat " " (propertize info 'face 'completions-annotations))))) - alist)))) - (goto-char (point-min)) - (search-forward contact) + alist) + nil t))) + (switch-to-buffer buf) + (goto-char (nth 1 (assoc contact alist))) (org-fold-show-entry) (org-reveal))) diff --git a/modules/org-drill-config.el b/modules/org-drill-config.el index 29f6130a..f53f36b9 100644 --- a/modules/org-drill-config.el +++ b/modules/org-drill-config.el @@ -134,25 +134,42 @@ With a prefix arg OTHER-DIR, prompt for the directory instead of `drill-dir'." ;; --------------------------------- Org Drill --------------------------------- -(use-package org-drill - ;; :vc (:url "git@cjennings.net:org-drill.git" - ;; :branch "main" - ;; :rev :newest) - :load-path "~/code/org-drill" ;; local dev checkout — switch back to :vc above when done - :after (org org-capture) - :demand t - :commands (org-drill org-drill-resume) - :custom - (org-drill-leech-failure-threshold 50 "leech cards = 50 wrong answers") - (org-drill-leech-method 'warn "leech cards show warnings") - (org-drill-use-visible-cloze-face-p t "cloze text shows up in a different font") - (org-drill-hide-item-headings-p t "don't show heading text") - (org-drill-maximum-items-per-session 100 "drill sessions end after 100 cards") - (org-drill-maximum-duration 30 "each drill session can last up to 30 mins") - (org-drill-add-random-noise-to-intervals-p t "vary the days to repetition slightly") - (org-drill-text-size-during-session 24 "24-point font for comfortable reading") - (org-drill-use-variable-pitch t "variable-pitch font for readability") - (org-drill-hide-modeline-during-session t "hide the modeline for a cleaner display")) +(defconst cj/org-drill-dev-checkout (expand-file-name "org-drill" "~/code/") + "Local org-drill development checkout, preferred when it exists.") + +(defun cj/--org-drill-source-keywords (&optional checkout) + "Return the use-package source keywords for org-drill. +With CHECKOUT (default `cj/org-drill-dev-checkout') an existing directory, +load from it via :load-path. Otherwise install from upstream via :vc, so +drill still loads on a machine without the dev checkout (bare :load-path + +:demand t would fail to load there)." + (let ((dir (or checkout cj/org-drill-dev-checkout))) + (if (file-directory-p dir) + (list :load-path dir) + (list :vc '(:url "git@cjennings.net:org-drill.git" + :branch "main" + :rev :newest))))) + +;; `use-package' keywords must be literals at macro-expansion, so the +;; source keyword is spliced in through `eval' at load time (same idiom as +;; the computed flycheck checker path elsewhere in the config). +(eval + `(use-package org-drill + ,@(cj/--org-drill-source-keywords) + :after (org org-capture) + :demand t + :commands (org-drill org-drill-resume) + :custom + (org-drill-leech-failure-threshold 50 "leech cards = 50 wrong answers") + (org-drill-leech-method 'warn "leech cards show warnings") + (org-drill-use-visible-cloze-face-p t "cloze text shows up in a different font") + (org-drill-hide-item-headings-p t "don't show heading text") + (org-drill-maximum-items-per-session 100 "drill sessions end after 100 cards") + (org-drill-maximum-duration 30 "each drill session can last up to 30 mins") + (org-drill-add-random-noise-to-intervals-p t "vary the days to repetition slightly") + (org-drill-text-size-during-session 24 "24-point font for comfortable reading") + (org-drill-use-variable-pitch t "variable-pitch font for readability") + (org-drill-hide-modeline-during-session t "hide the modeline for a cleaner display"))) (provide 'org-drill-config) ;;; org-drill-config.el ends here. diff --git a/modules/org-export-config.el b/modules/org-export-config.el index 5a6f09fc..c3d3294c 100644 --- a/modules/org-export-config.el +++ b/modules/org-export-config.el @@ -20,7 +20,6 @@ ;; - HTML: Web publishing with HTML5 support ;; - Markdown: README files and web content ;; - ODT: Office documents for LibreOffice/MS Word -;; - Texinfo: GNU documentation and Info files ;; ;; Extended via Pandoc: ;; - Additional formats: DOCX, self-contained HTML5 @@ -28,7 +27,7 @@ ;; ;; Key features: ;; - UTF-8 encoding enforced across all backends -;; - Subtree export as default scope +;; - Buffer export as default scope ;; ;; Note: reveal.js presentations are handled by org-reveal-config.el (C-; p) ;; @@ -68,17 +67,8 @@ :config (setq org-html-postamble nil) (setq org-html-html5-fancy t) - (setq org-html-head-include-default-style nil)) - - -(use-package ox-texinfo - :ensure nil ; Built into Org - :defer t - :after ox - :config - (setq org-texinfo-coding-system 'utf-8) - (setq org-texinfo-default-class "info") - (add-to-list 'org-export-backends 'texinfo)) + (setq org-html-head-include-default-style nil) + (setq org-html-footnote-separator "")) ;; no separator between adjacent footnote refs (use-package ox-pandoc :defer t diff --git a/modules/org-reveal-config.el b/modules/org-reveal-config.el index be702bf7..f842680b 100644 --- a/modules/org-reveal-config.el +++ b/modules/org-reveal-config.el @@ -8,9 +8,10 @@ ;; Load shape: eager. ;; Eager reason: none; presentation export is a command-loaded deferral ;; candidate for Phase 4. -;; Top-level side effects: package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). -;; Direct test load: yes. +;; Top-level side effects: registers a presentation prefix keymap under +;; cj/custom-keymap; package configuration via use-package. +;; Runtime requires: keybindings. +;; Direct test load: yes (requires keybindings explicitly). ;; ;; Integrates ox-reveal for creating reveal.js presentations from Org files. ;; @@ -28,6 +29,8 @@ ;;; Code: +(require 'keybindings) ;; cj/register-prefix-map, cj/custom-keymap + ;; Forward declarations for byte-compiler (ox-reveal loaded via use-package) (defvar org-reveal-root) (defvar org-reveal-single-file) @@ -238,17 +241,25 @@ reveal.js headers pre-filled." ;; -------------------------------- Keybindings -------------------------------- -(global-set-key (kbd "C-; p SPC") #'cj/reveal-present) -(global-set-key (kbd "C-; p e") #'cj/reveal-export) -(global-set-key (kbd "C-; p p") #'cj/reveal-preview-start) -(global-set-key (kbd "C-; p s") #'cj/reveal-preview-stop) -(global-set-key (kbd "C-; p h") #'cj/reveal-insert-header) -(global-set-key (kbd "C-; p H") #'cj/reveal-remove-headers) -(global-set-key (kbd "C-; p n") #'cj/reveal-new) +;; A registered prefix keymap, not raw `global-set-key' chains: binding +;; "C-; p ..." directly depends on keybindings.el having already made "C-;" +;; a live prefix (otherwise "non-prefix key" errors), while +;; `cj/register-prefix-map' binds into `cj/custom-keymap' with no load-order +;; dependency beyond requiring keybindings. +(defvar-keymap cj/reveal-map + :doc "Keymap for reveal.js presentation commands." + "SPC" #'cj/reveal-present + "e" #'cj/reveal-export + "p" #'cj/reveal-preview-start + "s" #'cj/reveal-preview-stop + "h" #'cj/reveal-insert-header + "H" #'cj/reveal-remove-headers + "n" #'cj/reveal-new) + +(cj/register-prefix-map "p" cj/reveal-map "presentations") (with-eval-after-load 'which-key (which-key-add-key-based-replacements - "C-; p" "presentations" "C-; p SPC" "present current buffer" "C-; p e" "export & open" "C-; p p" "start live preview" diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index eca867df..867f2d99 100644 --- a/modules/org-roam-config.el +++ b/modules/org-roam-config.el @@ -34,7 +34,6 @@ ;; External variables, declared special so byte-compilation doesn't treat them ;; as free references/assignments. Owned by org and org-roam-dailies. -(defvar org-agenda-timegrid-use-ampm) (defvar org-roam-dailies-map) (defvar org-last-state) @@ -77,30 +76,27 @@ FILETAGS and TITLE must sit on separate lines so Org parses the :unnarrowed t) ("v" "v2mom" plain - (file ,(concat user-emacs-directory "org-roam-templates/v2mom.org")) + (file ,(concat roam-dir "templates/v2mom.org")) :if-new (file+head "%<%Y%m%d%H%M%S>-${slug}.org" "") :unnarrowed t) ("r" "recipe" plain - (file ,(concat user-emacs-directory "org-roam-templates/recipe.org")) + (file ,(concat roam-dir "templates/recipe.org")) :if-new (file+head "recipes/%<%Y%m%d%H%M%S>-${slug}.org" "") :unnarrowed t) ("t" "topic" plain - (file ,(concat user-emacs-directory "org-roam-templates/topic.org")) + (file ,(concat roam-dir "templates/topic.org")) :if-new (file+head "%<%Y%m%d%H%M%S>-${slug}.org" "") :unnarrowed t))) :bind (("C-c n l" . org-roam-buffer-toggle) ("C-c n f" . org-roam-node-find) - ("C-c n p" . cj/org-roam-find-node-project) ("C-c n i" . org-roam-node-insert) - ("C-c n w" . cj/org-roam-find-node-webclip) :map org-mode-map ("C-M-i" . completion-at-point)) :config ;; org-log-done is set once in org-config.el (cj/org-todo-settings). - (setq org-agenda-timegrid-use-ampm t) ;; Don't build the org-refile targets cache here. org-refile-config.el ;; already schedules it on a 5s idle timer; doing it in org-roam's :config @@ -209,10 +205,17 @@ created in that subdirectory of `org-roam-directory'." (interactive) (cj/org-roam-find-node "Recipe" "r" (concat roam-dir "templates/recipe.org") "recipes/")) + +(defun cj/org-roam-find-node-project () + "List nodes of type \"Project\" in completing read for selection or creation." + (interactive) + (cj/org-roam-find-node "Project" "p" (concat roam-dir "templates/project.org"))) + ;; Bound after their defuns (not in the use-package :bind) so the byte-compiler ;; doesn't see both a :bind autoload and the real defun as two definitions. (keymap-global-set "C-c n r" #'cj/org-roam-find-node-recipe) (keymap-global-set "C-c n t" #'cj/org-roam-find-node-topic) +(keymap-global-set "C-c n p" #'cj/org-roam-find-node-project) ;; ---------------------- Org Capture After Finalize Hook ---------------------- @@ -394,36 +397,6 @@ cut stays undoable. A confirmation prompt guards large subtrees (see (org-roam-db-sync) (message "'%s' moved to a new org-roam node (%s)." title filename)))) -;; TASK: Need to decide keybindings before implementation and testing -;; (use-package consult-org-roam -;; :ensure t -;; :after org-roam -;; :init -;; (require 'consult-org-roam) -;; ;; Activate the minor mode -;; (consult-org-roam-mode 1) -;; :custom -;; ;; Use `ripgrep' for searching with `consult-org-roam-search' -;; (consult-org-roam-grep-func #'consult-ripgrep) -;; ;; Configure a custom narrow key for `consult-buffer' -;; (consult-org-roam-buffer-narrow-key ?r) -;; ;; Display org-roam buffers right after non-org-roam buffers -;; ;; in consult-buffer (and not down at the bottom) -;; (consult-org-roam-buffer-after-buffers t) -;; :config -;; ;; Eventually suppress previewing for certain functions -;; (consult-customize -;; consult-org-roam-forward-links -;; :preview-key "M-.") -;; :bind -;; ;; Define some convenient keybindings as an addition -;; ("C-c n e" . consult-org-roam-file-find) -;; ("C-c n b" . consult-org-roam-backlinks) -;; ("C-c n B" . consult-org-roam-backlinks-recursive) -;; ("C-c n l" . consult-org-roam-forward-links) -;; ("C-c n r" . consult-org-roam-search)) - - ;; which-key labels (with-eval-after-load 'which-key (which-key-add-key-based-replacements @@ -434,7 +407,6 @@ cut stays undoable. A confirmation prompt guards large subtrees (see "C-c n r" "roam find recipe" "C-c n t" "roam find topic" "C-c n i" "roam insert node" - "C-c n w" "roam find webclip" "C-c n I" "roam insert immediate" "C-c n d" "roam dailies menu")) diff --git a/modules/org-webclipper.el b/modules/org-webclipper.el index 40ceada7..217aecfa 100644 --- a/modules/org-webclipper.el +++ b/modules/org-webclipper.el @@ -186,22 +186,6 @@ Return the yanked content as a string so templates can insert it." ;; extract the webpage content from the kill ring (car kill-ring))) -;; ----------------------------- Webclipper Keymap ----------------------------- - -;; keymaps shouldn't be required for webclipper -;; Setup keymaps -;; -;; (defun cj/webclipper-setup-keymaps () -;; "Setup webclipper keymaps." -;; (define-prefix-command 'cj/webclipper-map nil -;; "Keymap for weblipper operations.") -;; (define-key cj/custom-keymap "c" 'cj/webclipper-map) -;; (define-key cj/webclipper-map "n" 'cj/move-org-branch-to-roam)) - -;; ;; Call keymap setup if cj/custom-keymap is already defined -;; (when (boundp 'cj/custom-keymap) -;; (cj/webclipper-setup-keymaps)) - ;; Register protocol handler early for external calls (with-eval-after-load 'org-protocol (unless (assoc "webclip" org-protocol-protocol-alist) @@ -211,9 +195,5 @@ Return the yanked content as a string so templates can insert it." :function cj/org-protocol-webclip :kill-client t)))) -;; (with-eval-after-load 'cj/custom-keymap -;; (require 'org-webclipper) -;; (cj/webclipper-setup-keymaps)) - (provide 'org-webclipper) ;;; org-webclipper.el ends here diff --git a/modules/prog-general.el b/modules/prog-general.el index 831f43cb..89771cbf 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -409,46 +409,129 @@ defer to `electric-pair-default-inhibit' for any other CHAR." (setq ws-butler-convert-leading-tabs-or-spaces t)) ;; ------------------------------------ LSP ------------------------------------ -;; Language Server Protocol for intelligent code completion and navigation -;; Works with multiple languages: C, Python, Go, Rust, JavaScript, etc. - -;; Forward declarations for LSP variables +;; Language Server Protocol for intelligent code completion and navigation. +;; Single owner of generic LSP policy (prog-lsp.el folded in and removed +;; 2026-07-10). Language-specific server variables and the lsp-deferred mode +;; hooks stay in the per-language modules. Reference for what to turn off: +;; https://emacs-lsp.github.io/lsp-mode/tutorials/how-to-turn-off/ + +;; Forward declarations for byte-compile. lsp-mode's defcustoms aren't loaded +;; under `make test' (no package-initialize) and use-package defers the package +;; via :commands, so these vars are unknown at compile time without declaring. +(defvar lsp-mode-map) +(defvar eldoc-documentation-functions) +(defvar lsp-file-watch-ignored-directories) +(defvar lsp-enable-remote) +(defvar lsp-auto-guess-root) +(defvar lsp-restart) (defvar lsp-idle-delay) (defvar lsp-log-io) (defvar lsp-enable-folding) +(defvar lsp-enable-imenu) (defvar lsp-enable-snippet) +(defvar lsp-enable-symbol-highlighting) +(defvar lsp-enable-on-type-formatting) +(defvar lsp-signature-auto-activate) +(defvar lsp-signature-render-documentation) +(defvar lsp-modeline-code-actions-enable) +(defvar lsp-modeline-diagnostics-enable) (defvar lsp-headerline-breadcrumb-enable) +(defvar lsp-semantic-tokens-enable) (defvar lsp-completion-provider) (defvar lsp-completion-show-detail) (defvar lsp-completion-show-kind) +(declare-function lsp-eldoc-function "lsp-mode") + +;; File-watch ignore patterns. lsp-mode prompts when a workspace exceeds +;; `lsp-file-watch-threshold' (1000) directories. Real source repos cross that +;; once node_modules, build outputs, and language caches are counted. These +;; extend the lsp-mode defaults (.git, .svn, .idea, ...) instead of replacing +;; them. A buffer-local override via `.dir-locals.el' doesn't work: lsp-mode +;; reads the global value at workspace init, not the buffer-local one, so the +;; defaults live here globally. +(defvar cj/lsp-file-watch-ignored-extras + '("[/\\\\]node_modules\\'" + "[/\\\\]\\.ruff_cache\\'" + "[/\\\\]dist\\'" + "[/\\\\]coverage\\'" + "[/\\\\]test-results\\'" + "[/\\\\]playwright-report\\'" + "[/\\\\]tf[/\\\\]\\.terraform\\'" + "[/\\\\]__pycache__\\'" + "[/\\\\]\\.venv\\'" + "[/\\\\]venv\\'" + "[/\\\\]\\.pytest_cache\\'" + "[/\\\\]\\.mypy_cache\\'" + "[/\\\\]target\\'") + "Build/cache directory patterns to add to `lsp-file-watch-ignored-directories'. +Each entry is an Emacs regex matching a path ending in the named directory.") + +(defun cj/lsp--add-file-watch-ignored-extras () + "Append `cj/lsp-file-watch-ignored-extras' to lsp-mode's ignore list. +Idempotent — `add-to-list' skips patterns already present." + (dolist (pattern cj/lsp-file-watch-ignored-extras) + (add-to-list 'lsp-file-watch-ignored-directories pattern))) + +(defun cj/lsp--remove-eldoc-provider-global () + "Remove lsp-mode's provider from the global `eldoc-documentation-functions'. +Run once after lsp-mode loads. The previous per-buffer removal raced +lsp's own buffer-local add: the buffer-local remove fired before lsp +populated the buffer-local hook (lsp inherits the global default and +mutates from there), so the buffer-local hook ended up holding the +provider anyway. Removing globally before lsp ever attaches a buffer +makes the absence stick for every subsequent lsp-managed buffer." + (remove-hook 'eldoc-documentation-functions #'lsp-eldoc-function)) (use-package lsp-mode :commands (lsp lsp-deferred) + :bind (:map lsp-mode-map + ("C-c d" . lsp-describe-thing-at-point) + ("C-c a" . lsp-execute-code-action)) :custom (lsp-keymap-prefix "C-c l") ;; LSP commands under C-c l prefix + :init + (setq lsp-enable-remote nil) ;; Don't start LSP on TRAMP files (slow, prompts for root) :config - ;; Performance optimizations - (setq lsp-idle-delay 0.1) + ;; Quiet, performance-first policy + (setq lsp-idle-delay 0.5) (setq lsp-log-io nil) + (setq lsp-auto-guess-root t) + (setq lsp-restart 'auto-restart) (setq lsp-enable-folding nil) - (setq lsp-enable-snippet t) + (setq lsp-enable-imenu nil) + (setq lsp-enable-snippet nil) + (setq lsp-enable-symbol-highlighting nil) + (setq lsp-enable-on-type-formatting nil) + (setq lsp-signature-auto-activate nil) + (setq lsp-signature-render-documentation nil) + (setq lsp-modeline-code-actions-enable nil) + (setq lsp-modeline-diagnostics-enable nil) (setq lsp-headerline-breadcrumb-enable nil) - - ;; Improve completion + (setq lsp-semantic-tokens-enable nil) + (setq read-process-output-max (* 1024 1024)) ;; 1MB + ;; Completion (setq lsp-completion-provider :capf) (setq lsp-completion-show-detail t) - (setq lsp-completion-show-kind t)) + (setq lsp-completion-show-kind t) + ;; Strip lsp's global eldoc provider once (see the helper for the race note). + (cj/lsp--remove-eldoc-provider-global) + (cj/lsp--add-file-watch-ignored-extras)) (use-package lsp-ui :after lsp-mode :commands lsp-ui-mode :custom - (lsp-ui-doc-enable t) + (lsp-ui-doc-enable nil) (lsp-ui-doc-position 'at-point) (lsp-ui-doc-delay 0.5) + (lsp-ui-doc-header t) + (lsp-ui-doc-include-signature t) + (lsp-ui-doc-border (face-foreground 'default)) (lsp-ui-sideline-enable t) (lsp-ui-sideline-show-diagnostics t) (lsp-ui-sideline-show-hover nil) + (lsp-ui-sideline-show-code-actions nil) + (lsp-ui-sideline-delay 0.05) (lsp-ui-peek-enable t) (lsp-ui-peek-show-directory t)) diff --git a/modules/prog-json.el b/modules/prog-json.el index e7abd182..66f4c5f2 100644 --- a/modules/prog-json.el +++ b/modules/prog-json.el @@ -62,9 +62,14 @@ back to the built-in `json-pretty-print-buffer-ordered'." ;; interactive jq queries against JSON buffers (use-package jq-mode - :defer t - :bind (:map json-ts-mode-map - ("C-c C-q" . jq-interactively))) + :defer t) + +;; Bind on json-ts-mode's own map, keyed to its load. The old +;; :bind (:map json-ts-mode-map ...) inside the jq-mode use-package deferred +;; the binding to jq-mode's load -- which nothing triggered, so the key was +;; dead. jq-interactively is autoloaded, so pressing the key loads jq-mode. +(with-eval-after-load 'json-ts-mode + (keymap-set json-ts-mode-map "C-c C-q" #'jq-interactively)) (provide 'prog-json) ;;; prog-json.el ends here. diff --git a/modules/prog-lisp.el b/modules/prog-lisp.el index ba568c9c..16740507 100644 --- a/modules/prog-lisp.el +++ b/modules/prog-lisp.el @@ -119,8 +119,12 @@ (use-package package-lint :commands (package-lint-current-buffer package-lint-batch-and-exit)) +;; Load when flycheck does. The old `:after (flycheck package-lint)' never +;; fired: nothing loads package-lint on its own (it is flycheck-package's +;; dependency, pulled in by its require), so the setup silently never ran +;; and elisp buffers never got the package-lint checker. (use-package flycheck-package - :after (flycheck package-lint) + :after flycheck :config (flycheck-package-setup)) diff --git a/modules/prog-lsp.el b/modules/prog-lsp.el deleted file mode 100644 index 1c74bcc1..00000000 --- a/modules/prog-lsp.el +++ /dev/null @@ -1,110 +0,0 @@ -;;; prog-lsp.el --- Setup for LSP Mode -*- lexical-binding: t; coding: utf-8; -*- -;; author: Craig Jennings <c@cjennings.net> - -;;; Commentary: - -;; good reference as to what to enable/disable in lsp-mode -;; https://emacs-lsp.github.io/lsp-mode/tutorials/how-to-turn-off/ - -;;; Code: - -;; Forward declarations for byte-compile and let-binding under lexical scope. -;; Real definitions are lsp-mode's defcustoms. -(defvar eldoc-documentation-functions) -(defvar lsp-file-watch-ignored-directories) -(defvar lsp-enable-remote) - -(declare-function lsp-eldoc-function "lsp-mode") - -;;;;; --------------------- File-Watch Ignore Patterns --------------------- -;; lsp-mode prompts when a workspace exceeds `lsp-file-watch-threshold' (1000) -;; directories. Real source repos cross that line easily once node_modules, -;; build outputs, and language caches are counted. These patterns extend the -;; lsp-mode defaults (.git, .svn, .idea, ...) instead of replacing them, so the -;; built-in VC/IDE excludes still apply. Buffer-local overrides via -;; `.dir-locals.el' don't work — lsp-mode reads the global value at workspace -;; init, not the buffer-local one. Hence: global defaults here. - -(defvar cj/lsp-file-watch-ignored-extras - '("[/\\\\]node_modules\\'" - "[/\\\\]\\.ruff_cache\\'" - "[/\\\\]dist\\'" - "[/\\\\]coverage\\'" - "[/\\\\]test-results\\'" - "[/\\\\]playwright-report\\'" - "[/\\\\]tf[/\\\\]\\.terraform\\'" - "[/\\\\]__pycache__\\'" - "[/\\\\]\\.venv\\'" - "[/\\\\]venv\\'" - "[/\\\\]\\.pytest_cache\\'" - "[/\\\\]\\.mypy_cache\\'" - "[/\\\\]target\\'") - "Build/cache directory patterns to add to `lsp-file-watch-ignored-directories'. -Each entry is an Emacs regex matching a path ending in the named directory.") - -(defun cj/lsp--add-file-watch-ignored-extras () - "Append `cj/lsp-file-watch-ignored-extras' to lsp-mode's ignore list. -Idempotent — `add-to-list' skips patterns already present." - (dolist (pattern cj/lsp-file-watch-ignored-extras) - (add-to-list 'lsp-file-watch-ignored-directories pattern))) - -(defun cj/lsp--remove-eldoc-provider-global () - "Remove lsp-mode's provider from the global `eldoc-documentation-functions'. -Run once after lsp-mode loads. The previous per-buffer removal raced -lsp's own buffer-local add: the buffer-local remove fired before lsp -populated the buffer-local hook (lsp inherits the global default and -mutates from there), so the buffer-local hook ended up holding the -provider anyway. Removing globally before lsp ever attaches a buffer -makes the absence stick for every subsequent lsp-managed buffer." - (remove-hook 'eldoc-documentation-functions #'lsp-eldoc-function)) - -;;;;; ---------------------------- LSP Mode --------------------------- - -(use-package lsp-mode - :hook - ((c-mode c++-mode go-mode js-mode js-jsx-mode typescript-mode python-mode web-mode) . lsp-deferred) - :commands (lsp) - :bind (:map lsp-mode-map - ("C-c d" . lsp-describe-thing-at-point) - ("C-c a" . lsp-execute-code-action)) - :bind-keymap ("C-c L" . lsp-command-map) - :init - (setq lsp-enable-remote nil) ;; Don't start LSP on TRAMP files (slow, prompts for project root) - :config - (setq lsp-auto-guess-root t) - (setq lsp-log-io nil) - (setq lsp-restart 'auto-restart) - (setq lsp-enable-symbol-highlighting nil) - (setq lsp-enable-on-type-formatting nil) - (setq lsp-signature-auto-activate nil) - (setq lsp-signature-render-documentation nil) - ;; Strip lsp-mode's eldoc provider from the GLOBAL hook value once, - ;; not per buffer. See `cj/lsp--remove-eldoc-provider-global' for - ;; why per-buffer racing didn't stick. - (cj/lsp--remove-eldoc-provider-global) - (setq lsp-modeline-code-actions-enable nil) - (setq lsp-modeline-diagnostics-enable nil) - (setq lsp-headerline-breadcrumb-enable nil) - (setq lsp-semantic-tokens-enable nil) - (setq lsp-enable-folding nil) - (setq lsp-enable-imenu nil) - (setq lsp-enable-snippet nil) - (setq read-process-output-max (* 1024 1024)) ;; 1MB - (setq lsp-idle-delay 0.5) - (cj/lsp--add-file-watch-ignored-extras)) - -;;;;; ----------------------------- LSP UI ---------------------------- - -(use-package lsp-ui - :after lsp-mode - :commands lsp-ui-mode - :config - (setq lsp-ui-doc-enable nil) - (setq lsp-ui-doc-header t) - (setq lsp-ui-doc-include-signature t) - (setq lsp-ui-doc-border (face-foreground 'default)) - (setq lsp-ui-sideline-show-code-actions nil) ;; turn off code actions in sidebar - (setq lsp-ui-sideline-delay 0.05)) - -(provide 'prog-lsp) -;;; prog-lsp.el ends here diff --git a/modules/prog-python.el b/modules/prog-python.el index 6354bd90..91670ec0 100644 --- a/modules/prog-python.el +++ b/modules/prog-python.el @@ -69,9 +69,12 @@ Install with: pip install mypy") (setq-local indent-tabs-mode nil) ;; disable tab characters (electric-pair-local-mode t) ;; match delimiters automatically (buffer-local) - ;; Enable LSP if available + ;; Enable LSP if available. lsp-pyright is required here, inside the + ;; guard, so a pyright-less machine never loads it and never sees the + ;; LSP attach prompt the guard exists to prevent. (when (and (fboundp 'lsp-deferred) (executable-find pyright-path)) + (require 'lsp-pyright nil t) (lsp-deferred))) (defun cj/--python-mypy-command (target) @@ -111,8 +114,12 @@ Overrides default prog-mode keybindings with Python-specific commands." (use-package python :ensure nil ;; built-in :hook + ;; Both variants: treesit-auto falls back to classic python-mode when the + ;; grammar is unavailable, and that fallback should keep the same setup. ((python-ts-mode . cj/python-setup) - (python-ts-mode . cj/python-mode-keybindings)) + (python-ts-mode . cj/python-mode-keybindings) + (python-mode . cj/python-setup) + (python-mode . cj/python-mode-keybindings)) :custom (python-shell-interpreter "python3") :config @@ -126,10 +133,12 @@ Overrides default prog-mode keybindings with Python-specific commands." ;; Python-specific LSP configuration via pyright ;; Core LSP setup is in prog-general.el +;; No :hook here: the old unguarded (require 'lsp-pyright) + (lsp-deferred) +;; lambda ran on every python-ts buffer, so pyright-less machines got the +;; LSP attach prompt cj/python-setup's guard exists to prevent. The guarded +;; branch in cj/python-setup owns the require and the attach. (use-package lsp-pyright - :hook (python-ts-mode . (lambda () - (require 'lsp-pyright) - (lsp-deferred)))) + :defer t) ;; ----------------------------------- Poetry ---------------------------------- ;; virtual environments and dependencies diff --git a/modules/prog-training.el b/modules/prog-training.el index 41f3053b..d38208ee 100644 --- a/modules/prog-training.el +++ b/modules/prog-training.el @@ -17,6 +17,7 @@ ;;; Code: +(defvar code-dir) ;; user-constants.el; read lazily in leetcode's :config ;; ----------------------------- Exercism ---------------------------- @@ -33,9 +34,9 @@ :defer t :commands (leetcode) :bind ("C-h L" . leetcode) - :custom - (url-debug t) :config + ;; No (url-debug t) here: that was a debugging leftover, and it turned on + ;; GLOBAL url.el request logging for the whole session once leetcode loaded. (setq leetcode-prefer-language "golang") (setq leetcode-directory (concat code-dir "/leetcode")) (setq leetcode-save-solutions t)) diff --git a/modules/selection-framework.el b/modules/selection-framework.el index 7f7f9a47..8e3ee252 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -41,7 +41,9 @@ (vertico-cycle t) ; Cycle through candidates (vertico-count 10) ; Number of candidates to display (vertico-resize nil) ; Don't resize the minibuffer - (vertico-sort-function #'vertico-sort-history-alpha) ; History first, then alphabetical + ;; Sorting is owned by `vertico-prescient-mode' (frecency). A + ;; `vertico-sort-function' set here is overridden inside every vertico + ;; session, so it is omitted rather than left as dead config. :bind (:map vertico-map ("C-j" . vertico-next) ("C-k" . vertico-previous) diff --git a/modules/slack-config.el b/modules/slack-config.el index adf38804..9eb9f838 100644 --- a/modules/slack-config.el +++ b/modules/slack-config.el @@ -52,6 +52,7 @@ (defvar slack-message-custom-notifier) (defvar slack-teams) +(declare-function notifications-notify "notifications") (declare-function slack-buffer-add-reaction-to-message "slack-buffer") (declare-function slack-buffer-latest-ts "slack-buffer") (declare-function slack-buffer-team "slack-buffer") @@ -207,6 +208,46 @@ Errors if called outside a Slack message buffer." :around #'cj/slack--safe-reaction-echo-description)) ;; ----------------------------- Notifications --------------------------------- +;; Mirrors signel's notification hardening (body truncation, sound gating, +;; script-with-fallback delivery). The shared cj/messenger-notify extraction +;; that collapses the two copies belongs to the messenger-unification task. + +(defcustom cj/slack-notify-sound nil + "When non-nil, Slack notifications play the notify script's sound. +Nil (the default) passes --silent so the toast is visual only." + :type 'boolean + :group 'slack) + +(defconst cj/slack--notify-body-max 120 + "Maximum character length of a desktop-notification body. +Longer message text truncates to this length ending in an ellipsis; +the full text is always in the Slack buffer.") + +(defun cj/slack--format-notify-body (text) + "Collapse whitespace in TEXT and truncate it for a notification body. +Whitespace runs (including newlines) become single spaces, the result +is trimmed, and anything over `cj/slack--notify-body-max' characters +truncates to that length with a trailing ellipsis." + (let ((flat (string-trim (replace-regexp-in-string "[ \t\n\r]+" " " text)))) + (if (<= (length flat) cj/slack--notify-body-max) + flat + (concat (substring flat 0 (1- cj/slack--notify-body-max)) "…")))) + +(defun cj/slack--send-notification (title body) + "Deliver a desktop notification with TITLE and BODY. +Routes through the external notify script when it is on PATH (type +info, sound gated by `cj/slack-notify-sound'), falling back to +`notifications-notify' otherwise. Previously a missing script made +`start-process' error inside the caller's condition-case, so the +notification silently vanished." + (let ((script (executable-find "notify"))) + (if script + (apply #'start-process "slack-notify" nil script "info" title body + (unless cj/slack-notify-sound (list "--silent"))) + ;; notifications.el is not autoloaded; load it on the first fallback. + (unless (fboundp 'notifications-notify) + (require 'notifications)) + (notifications-notify :title title :body body)))) (defun cj/slack-notify (message room team) "Send desktop notification for DMs and @mentions only. @@ -218,18 +259,17 @@ swallows exceptions via `websocket-try-callback'." (when (and (not (slack-message-minep message team)) (or (slack-im-p room) (slack-message-mentioned-p message team))) - (let ((title (format "Slack: %s" (slack-room-display-name room team))) - (body (or (slack-message-body message team) ""))) - (start-process "slack-notify" nil - "notify" "info" title body))) + (cj/slack--send-notification + (format "Slack: %s" (slack-room-display-name room team)) + (cj/slack--format-notify-body + (or (slack-message-body message team) "")))) (error (message "cj/slack-notify error: %S" err)))) (defun cj/slack-test-notify () "Send a test desktop notification to verify the notify pipeline works." (interactive) (condition-case err - (start-process "slack-notify-test" nil - "notify" "info" "Slack: Test" "Notification pipeline works") + (cj/slack--send-notification "Slack: Test" "Notification pipeline works") (error (message "cj/slack-test-notify error: %S" err)))) (defun cj/slack-mark-read-and-bury () diff --git a/modules/system-utils.el b/modules/system-utils.el index e779026a..58325d06 100644 --- a/modules/system-utils.el +++ b/modules/system-utils.el @@ -92,7 +92,7 @@ detached from Emacs." output-buffer (format "%s %s" command (shell-quote-argument file))) (message "Running %s on %s..." - (file-name-nondirectory file) command))))) + command (file-name-nondirectory file)))))) ;;; ------------------------------ Server Shutdown ------------------------------ diff --git a/modules/takuzu-config.el b/modules/takuzu-config.el new file mode 100644 index 00000000..470aaec8 --- /dev/null +++ b/modules/takuzu-config.el @@ -0,0 +1,17 @@ +;;; takuzu-config.el --- Takuzu (Binairo) game configuration -*- lexical-binding: t -*- + +;;; Commentary: +;; Wire the standalone takuzu game package (developed at ~/code/takuzu). +;; Play with M-x takuzu. Switch to :vc once it is published on GitHub. + +;;; Code: + +(use-package takuzu + :load-path "~/code/takuzu" + :commands (takuzu) + :custom + (takuzu-default-size 6) + (takuzu-default-difficulty 'easy)) + +(provide 'takuzu-config) +;;; takuzu-config.el ends here diff --git a/modules/telega-config.el b/modules/telega-config.el index 0ae5116b..acc9e482 100644 --- a/modules/telega-config.el +++ b/modules/telega-config.el @@ -54,7 +54,14 @@ :ensure nil :commands (telega) :custom - (telega-use-docker t)) + (telega-use-docker t) + :config + ;; Without this, incoming Telegram messages are invisible unless their + ;; buffer is on screen -- telega ships desktop notifications but leaves + ;; the mode off by default. Runs at telega load (M-x telega), respects + ;; telega's own per-chat mute settings. From the 2026-06 config audit; + ;; routing through a shared messenger notifier is the unification task. + (telega-notifications-mode 1)) (defun cj/telega () "Launch telega.el with a helpful message when it isn't installed yet. diff --git a/modules/test-runner.el b/modules/test-runner.el index e05145e4..7f157f1c 100644 --- a/modules/test-runner.el +++ b/modules/test-runner.el @@ -239,7 +239,10 @@ Returns: \\='success if added successfully, Second value is the relative filename if successful." (cond ((null filepath) (cons 'no-file nil)) - ((not (string-prefix-p (file-truename testdir) (file-truename filepath))) + ;; Route through the helper: it appends the trailing slash, so a sibling + ;; sharing the directory's name prefix (tests-old/ against tests/) is + ;; rejected. A bare `string-prefix-p' on the truenames accepts it. + ((not (cj/test--file-in-directory-p filepath testdir)) (cons 'not-in-testdir nil)) (t (let ((relative (file-relative-name filepath testdir))) diff --git a/modules/text-config.el b/modules/text-config.el index dd7bd3ca..a65002a8 100644 --- a/modules/text-config.el +++ b/modules/text-config.el @@ -69,7 +69,7 @@ ;; edit selection in new buffer, C-c to finish; replaces with modifications (use-package edit-indirect - :bind ("M-S-i" . edit-indirect-region)) ;; was M-I + :bind ("M-I" . edit-indirect-region)) ;; ------------------------------ Prettify Symbols ----------------------------- ;; replacing the word l-a-m-b-d-a with a symbol, just because @@ -118,8 +118,8 @@ everything else, such as `lambda', use the standard boundary check." ;; an easy way to enter diacritical marks (use-package accent - :commands accent-company - :bind ("C-`" . accent-company)) + :commands accent-menu + :bind ("C-`" . accent-menu)) (provide 'text-config) ;;; text-config.el ends here diff --git a/modules/tramp-config.el b/modules/tramp-config.el index f2bc8457..95fa83db 100644 --- a/modules/tramp-config.el +++ b/modules/tramp-config.el @@ -26,6 +26,7 @@ ;; Silence byte-compiler "assignment to free variable" warnings for vars ;; defined by lazily-loaded packages (tramp, dirtrack, magit). These are ;; only set inside the use-package :config block, after the package loads. +(defvar ange-ftp-try-passive-mode) (defvar tramp-copy-size-limit) (defvar tramp-use-ssh-controlmaster-options) (defvar tramp-cleanup-idle-time) @@ -147,5 +148,11 @@ ;; Cleanup TRAMP buffers when idle (every 15 min) (setq tramp-cleanup-idle-time 900)) +;; FTP (ange-ftp) settings — TRAMP's /ftp: method delegates to ange-ftp. +;; Passive mode is required for servers that can't open a data connection +;; back to this machine (NAT, phone FTP servers); active mode hangs on LIST. +(with-eval-after-load 'ange-ftp + (setq ange-ftp-try-passive-mode t)) + (provide 'tramp-config) ;;; tramp-config.el ends here diff --git a/modules/ui-config.el b/modules/ui-config.el index fbc3d91c..9ac6faec 100644 --- a/modules/ui-config.el +++ b/modules/ui-config.el @@ -29,9 +29,6 @@ ;; (i.e., read-only, overwrite, normal) ;; – Option to customize cursor shape with 'cj/set-cursor-type' -;; • Icons -;; – Load and enable 'nerd-icons' for UI glyphs - ;; Customize the transparency and cursor color options at the top of this file. ;;; Code: @@ -116,11 +113,5 @@ When `cj/enable-transparency' is nil, reset alpha to fully opaque." ;; burst when entering read-only buffers like EPUBs or vterm). (blink-cursor-mode -1) -;; --------------------------------- Nerd Icons -------------------------------- -;; use icons from nerd fonts in the Emacs UI - -(use-package nerd-icons - :defer t) - (provide 'ui-config) ;;; ui-config.el ends here diff --git a/modules/ui-theme.el b/modules/ui-theme.el index 499e71a4..b3cdc634 100644 --- a/modules/ui-theme.el +++ b/modules/ui-theme.el @@ -88,8 +88,14 @@ If FILENAME isn't readable, return nil." (string-trim (buffer-string))))) (defun cj/theme-write-file-contents (content filename) - "Write CONTENT to FILENAME. -If FILENAME isn't writeable, return nil. If successful, return t." + "Write CONTENT to FILENAME, creating its parent directory if absent. +On a fresh machine the `persist/' directory doesn't exist yet, and +`file-writable-p' returns nil for a file inside a missing directory, so the +write would silently fail. If FILENAME still isn't writeable, return nil. +If successful, return t." + (let ((dir (file-name-directory filename))) + (when (and dir (not (file-directory-p dir))) + (ignore-errors (make-directory dir t)))) (when (file-writable-p filename) (condition-case err (progn diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el index cbd2c0d7..21a04de9 100644 --- a/modules/undead-buffers.el +++ b/modules/undead-buffers.el @@ -65,7 +65,10 @@ regexp in `cj/undead-buffer-regexps'." cj/undead-buffer-regexps)))) (defun cj/kill-buffer-or-bury-alive (buffer) - "Kill BUFFER or bury it if it's in `cj/undead-buffer-list'." + "Kill BUFFER, or bury it when it is in `cj/undead-buffer-list'. +With a prefix argument (e.g. \\`C-u'), instead add BUFFER's name to +`cj/undead-buffer-list' and report it, so the buffer is buried rather than +killed on later kill attempts." (interactive "bBuffer to kill or bury: ") (with-current-buffer buffer (if current-prefix-arg @@ -97,12 +100,15 @@ Undead-buffers are buffers in `cj/undead-buffer-list'." ;; Keybinding moved to custom-buffer-file.el (C-; b k) (defun cj/kill-other-window () - "Delete the next window and kill or bury its buffer." + "Delete the next window and kill or bury its buffer. +Signal a `user-error' in a single-window frame, where there is no other +window and acting would kill the buffer being viewed." (interactive) + (when (one-window-p) + (user-error "No other window")) (other-window 1) (let ((buf (current-buffer))) - (unless (one-window-p) - (delete-window)) + (delete-window) (cj/kill-buffer-or-bury-alive buf))) (keymap-global-set "M-S-o" #'cj/kill-other-window) diff --git a/modules/video-audio-recording-capture.el b/modules/video-audio-recording-capture.el index 41b72ebd..5e7860fc 100644 --- a/modules/video-audio-recording-capture.el +++ b/modules/video-audio-recording-capture.el @@ -76,9 +76,13 @@ is killed externally." (cj/recording--start-failed-p (- (float-time) start) cj/recording-start-fail-threshold)) ;; Died almost immediately and the user didn't stop it: wf-recorder - ;; couldn't grab the screen. Say so instead of silently clearing, - ;; so Craig isn't left blind-retrying (which bursts fragment files). - (message "Video recording failed to start (wf-recorder couldn't grab the screen). Try again.") + ;; couldn't grab the screen. Delete the ~0.5s stub file the failed + ;; start wrote (it would otherwise litter the recordings directory + ;; and get swept up by *.mkv globs downstream), then say so instead + ;; of silently clearing, so Craig isn't left blind-retrying. + (progn + (cj/recording--delete-failed-start-stub process) + (message "Video recording failed to start (wf-recorder couldn't grab the screen). Try again.")) (message "Video recording stopped: %s" (string-trim event)))))) (force-mode-line-update t))) @@ -129,6 +133,15 @@ launching too soon loses the grab and produces a ~0.5s fragment file." A failed wf-recorder start exits almost immediately; a real recording does not." (< elapsed threshold)) +(defun cj/recording--delete-failed-start-stub (process) + "Delete the stub output file a failed video start left behind. +Reads the output path from PROCESS's `cj-output-file' property (stamped +by `cj/ffmpeg-record-video'). A no-op when the property is absent (a +process started before the property existed) or the file never hit disk." + (let ((file (process-get process 'cj-output-file))) + (when (and file (file-exists-p file)) + (delete-file file)))) + ;;; Dependency Checks (defun cj/recording-check-ffmpeg () @@ -332,8 +345,10 @@ Uses wf-recorder on Wayland, x11grab on X11." (set-process-query-on-exit-flag cj/video-recording-ffmpeg-process nil) (set-process-sentinel cj/video-recording-ffmpeg-process #'cj/recording-process-sentinel) ;; Stamp the start time so the sentinel can tell a ~0.5s failed start - ;; (wf-recorder couldn't grab the screen) from a normal recording. + ;; (wf-recorder couldn't grab the screen) from a normal recording, and + ;; the output path so the failed-start branch can delete the stub file. (process-put cj/video-recording-ffmpeg-process 'cj-start-time (float-time)) + (process-put cj/video-recording-ffmpeg-process 'cj-output-file filename) (force-mode-line-update t) (message "Started video recording to %s (%s, mic: %.1fx, system: %.1fx)." filename diff --git a/org-roam-templates/recipe.org b/org-roam-templates/recipe.org deleted file mode 100644 index ed395be1..00000000 --- a/org-roam-templates/recipe.org +++ /dev/null @@ -1,17 +0,0 @@ -#+TITLE: ${title} -#+CATEGORY: ${title} -#+FILETAGS: Recipe -#+STARTUP: showall - -${title} - -* Mise En Place - - -* Execution - - -* Notes - - -* Nutrition diff --git a/org-roam-templates/topic.org b/org-roam-templates/topic.org deleted file mode 100644 index 40a09f79..00000000 --- a/org-roam-templates/topic.org +++ /dev/null @@ -1,7 +0,0 @@ -#+TITLE: ${title} -#+CATEGORY: ${title} -#+FILETAGS: Topic - -* ${title} - - diff --git a/org-roam-templates/v2mom.org b/org-roam-templates/v2mom.org deleted file mode 100644 index 0316299d..00000000 --- a/org-roam-templates/v2mom.org +++ /dev/null @@ -1,40 +0,0 @@ -#+TITLE: ${title} -#+CATEGORY: ${title} -#+FILETAGS: V2MOM - -* Vision -_What do you want to achieve?_ - - -* Values -_What's important about it? What are the principles and beliefs that guide it?_ - -1. -2. -3. - -* Methods -_How will you get it done? What are the key initiatives and actions?_ - -1. -2. -3. -4. -5. - -* Obstacles -_What might prevent success? What challenges must be overcome?_ - -1. - - Mitigation: -2. - - Mitigation: -3. - - Mitigation: - -* Measures -_How will you know when you've succeeded? What are the key metrics?_ - -1. -2. -3. diff --git a/tests/test-ai-term--runtime.el b/tests/test-ai-term--runtime.el new file mode 100644 index 00000000..7644e468 --- /dev/null +++ b/tests/test-ai-term--runtime.el @@ -0,0 +1,136 @@ +;;; test-ai-term--runtime.el --- Tests for the ai-term runtime selection -*- lexical-binding: t; -*- + +;;; Commentary: +;; Multi-backend launch: a fresh agent session can run Claude, Codex, or a +;; local model through codex --oss (ollama). The runtime names and launch +;; strings mirror the rulesets bin/ai launcher so the two stay one mental +;; model: "claude", "codex", and "local:<model>". +;; +;; Pure pieces tested here: +;; - `cj/--ai-term-runtime-command' maps a runtime name to the full shell +;; command (agent CLI + the shared opening prompt). +;; - `cj/--ai-term-parse-runtime-lines' parses `ai --print-runtimes' output +;; into (NAME . LABEL) choices. +;; - `cj/--ai-term-runtime-choices' shells out to `ai' at its boundary +;; (mocked here) and falls back to the static list when `ai' is absent. +;; The interactive picker is a thin completing-read wrapper and is not +;; tested (Interactive vs Internal split). + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-term) + +;;; ------------------------- runtime -> command ------------------------------ + +(ert-deftest test-ai-term-runtime-command-claude-is-agent-command () + "Normal: \"claude\" (and nil) return `cj/ai-term-agent-command' verbatim." + (let ((cj/ai-term-agent-command "claude \"do the thing\"")) + (should (equal (cj/--ai-term-runtime-command "claude") + "claude \"do the thing\"")) + (should (equal (cj/--ai-term-runtime-command nil) + "claude \"do the thing\"")))) + +(ert-deftest test-ai-term-runtime-command-codex-composes-prompt () + "Normal: \"codex\" is the codex CLI plus the shared opening prompt." + (let ((cj/ai-term-agent-prompt "read the protocols")) + (should (equal (cj/--ai-term-runtime-command "codex") + (concat "codex " (shell-quote-argument "read the protocols")))))) + +(ert-deftest test-ai-term-runtime-command-local-model () + "Normal: \"local:<model>\" runs codex --oss against that ollama model. +The model is shell-quoted, and POSIX `shell-quote-argument' backslash-escapes +the colons, so the assertion matches the quoted form." + (let ((cj/ai-term-agent-prompt "read the protocols")) + (let ((cmd (cj/--ai-term-runtime-command "local:gpt-oss:120b"))) + (should (string-prefix-p "codex --oss --local-provider=ollama -m " cmd)) + (should (string-match-p + (regexp-quote (shell-quote-argument "gpt-oss:120b")) cmd)) + (should (string-suffix-p (shell-quote-argument "read the protocols") cmd))))) + +(ert-deftest test-ai-term-runtime-command-boundary-empty-model () + "Boundary: \"local:\" with no model is rejected, not launched half-formed." + (should-error (cj/--ai-term-runtime-command "local:") :type 'user-error)) + +(ert-deftest test-ai-term-runtime-command-error-unknown-runtime () + "Error: an unknown runtime name signals a `user-error' naming it." + (should-error (cj/--ai-term-runtime-command "gemini") :type 'user-error) + (condition-case err + (cj/--ai-term-runtime-command "gemini") + (user-error (should (string-match-p "gemini" (cadr err)))))) + +;;; --------------------------- choice-list parsing --------------------------- + +(ert-deftest test-ai-term-parse-runtime-lines-normal () + "Normal: `ai --print-runtimes' lines parse into (NAME . LABEL) pairs." + (should (equal (cj/--ai-term-parse-runtime-lines + "claude — Claude Code\ncodex — ChatGPT (Codex CLI)\nlocal:gpt-oss:120b — ollama\n") + '(("claude" . "Claude Code") + ("codex" . "ChatGPT (Codex CLI)") + ("local:gpt-oss:120b" . "ollama"))))) + +(ert-deftest test-ai-term-parse-runtime-lines-boundary-junk () + "Boundary: blank lines and lines without a separator are dropped." + (should (equal (cj/--ai-term-parse-runtime-lines + "\nclaude — Claude Code\nwarning: something\n\n") + '(("claude" . "Claude Code"))))) + +(ert-deftest test-ai-term-parse-runtime-lines-boundary-empty () + "Boundary: empty output parses to nil." + (should (null (cj/--ai-term-parse-runtime-lines "")))) + +;;; ------------------------------ choice list -------------------------------- + +(ert-deftest test-ai-term-runtime-choices-uses-ai-launcher () + "Normal: when the `ai' launcher exists, its runtime list is the choice list." + (cl-letf (((symbol-function 'executable-find) + (lambda (prog &rest _) (when (equal prog "ai") "/usr/bin/ai"))) + ((symbol-function 'process-file) + (lambda (_prog _infile buffer _display &rest _args) + (with-current-buffer (cond ((eq buffer t) (current-buffer)) + ((consp buffer) (car buffer)) + (t buffer)) + (insert "claude — Claude Code\nlocal:q — ollama\n")) + 0))) + (should (equal (cj/--ai-term-runtime-choices) + '(("claude" . "Claude Code") ("local:q" . "ollama")))))) + +(ert-deftest test-ai-term-runtime-choices-fallback-without-ai () + "Boundary: with no `ai' launcher, the static claude-first list stands." + (cl-letf (((symbol-function 'executable-find) (lambda (&rest _) nil))) + (let ((choices (cj/--ai-term-runtime-choices))) + (should (equal (caar choices) "claude")) + (should (assoc "codex" choices))))) + +(ert-deftest test-ai-term-runtime-choices-error-ai-fails () + "Error: a nonzero exit from `ai' falls back instead of erroring." + (cl-letf (((symbol-function 'executable-find) + (lambda (prog &rest _) (when (equal prog "ai") "/usr/bin/ai"))) + ((symbol-function 'process-file) (lambda (&rest _) 1))) + (should (equal (caar (cj/--ai-term-runtime-choices)) "claude")))) + +;;; --------------------- launch command takes an override -------------------- + +(ert-deftest test-ai-term-launch-command-runtime-override () + "Normal: an explicit agent command is embedded instead of the default. +The inner command is shell-quoted by the launch builder, so the assertion +matches the quoted form." + (let ((cj/ai-term-agent-command "claude default")) + (let ((cmd (cj/--ai-term-launch-command "/tmp/proj" "codex prompted"))) + (should (string-match-p + (regexp-quote (shell-quote-argument "codex prompted; exec bash")) + cmd)) + (should-not (string-match-p "claude" cmd))))) + +(ert-deftest test-ai-term-launch-command-no-override-falls-back () + "Boundary: without an override the configured agent command is used." + (let ((cj/ai-term-agent-command "claude default")) + (should (string-match-p + (regexp-quote (shell-quote-argument "claude default; exec bash")) + (cj/--ai-term-launch-command "/tmp/proj"))))) + +(provide 'test-ai-term--runtime) +;;; test-ai-term--runtime.el ends here diff --git a/tests/test-auto-dim-config.el b/tests/test-auto-dim-config.el index 2686b88f..12435fa0 100644 --- a/tests/test-auto-dim-config.el +++ b/tests/test-auto-dim-config.el @@ -35,6 +35,210 @@ (when (fboundp 'auto-dim-other-buffers-mode) (auto-dim-other-buffers-mode -1)))) +(defconst test-auto-dim--flat-dimmed-org-faces + (append (mapcar (lambda (n) (intern (format "org-level-%d" n))) + (number-sequence 1 8)) + '(org-link org-tag + ;; Document header: #+TITLE:, #+AUTHOR:, #+ARCHIVE: and their values. + org-document-title org-document-info org-document-info-keyword + org-meta-line + ;; Inline markup and blocks. + org-code org-verbatim org-block-begin-line org-block-end-line + ;; Drawers, properties, planning lines. + org-drawer org-special-keyword org-property-value org-date + ;; Tables and the fold indicator. + org-table org-table-row org-ellipsis)) + "Org faces that must flat-dim to the `auto-dim-other-buffers' face. +These carry structure, not status: nothing about them needs to stay +readable in a window the user is not looking at. Excluded on purpose are +`org-todo' and `org-priority' (keyword class -- see the -dim variant test +below) and `org-hide' (needs `auto-dim-other-buffers-hide' so folded text +stays hidden).") + +(defconst test-auto-dim--flat-dimmed-link-faces + '(link link-visited) + "Built-in link faces that must flat-dim, distinct from `org-link'. +They fontify links in help, info, and customize buffers. Both carry +`:underline t', which survives the relative remap, so a dimmed link still +reads as a link.") + +(defconst test-auto-dim--flat-dimmed-superstar-faces + '(org-superstar-header-bullet org-superstar-item org-superstar-first) + "org-superstar faces that must flat-dim. +org-superstar puts its own face ahead of the org face beneath, so a heading +star renders as (org-superstar-header-bullet org-level-1) and wins over the +dimmed org-level-1. Without these, bullets stay lit in an unfocused window +even though every face under them dims. +`org-superstar-leading' is excluded on purpose -- see the test below.") + +(defconst test-auto-dim--hide-class-faces + '(org-hide org-superstar-leading org-indent) + "Faces whose foreground IS the background colour. +That is what makes them invisible. They take `auto-dim-other-buffers-hide', +never the flat dim, which would paint them visible grey.") + +(defconst test-auto-dim--no-foreground-faces + '(bold italic underline) + "Faces that carry no foreground, even through inheritance. +They set weight, slant or underline only, so text wearing them takes its +colour from `default', which is already remapped. They need no entry and +must not gain one, or the alist grows entries that do nothing.") + +(defconst test-auto-dim--keyword-dim-variants + '((org-faces-todo . org-faces-todo-dim) + (org-faces-doing . org-faces-doing-dim) + (org-faces-priority-a . org-faces-priority-a-dim)) + "Sample of keyword faces that must keep dedicated -dim variants.") + +(ert-deftest test-auto-dim-config-org-structure-faces-flat-dim () + "Normal: org heading, link, and tag faces remap to the flat dim face." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (dolist (face test-auto-dim--flat-dimmed-org-faces) + (let ((entry (assq face auto-dim-other-buffers-affected-faces))) + (should entry) + (should (eq 'auto-dim-other-buffers (car (cdr entry)))) + (should (null (cdr (cdr entry))))))) + +(ert-deftest test-auto-dim-config-link-faces-flat-dim () + "Normal: the built-in `link' and `link-visited' faces flat-dim. +Without these, links in help, info, and customize buffers stay lit while +the rest of an unfocused window fades. `org-link' is a separate face and +is covered above." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (dolist (face test-auto-dim--flat-dimmed-link-faces) + (let ((entry (assq face auto-dim-other-buffers-affected-faces))) + (should entry) + (should (eq 'auto-dim-other-buffers (car (cdr entry)))) + (should (null (cdr (cdr entry))))))) + +(ert-deftest test-auto-dim-config-link-underline-survives-the-remap () + "Boundary: the dim face sets no `:underline', so the link cue survives. +A relative remap layers the dim face over the base face, so an underline +the dim face does not specify falls through from `link'. If the theme ever +gives `auto-dim-other-buffers' an `:underline', dimmed links stop looking +like links and this test says so." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (should (eq 'unspecified + (face-attribute 'auto-dim-other-buffers :underline nil nil)))) + +(ert-deftest test-auto-dim-config-superstar-bullets-flat-dim () + "Normal: org-superstar's heading stars and list bullets flat-dim. +They were the last thing left lit in an unfocused org window." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (dolist (face test-auto-dim--flat-dimmed-superstar-faces) + (let ((entry (assq face auto-dim-other-buffers-affected-faces))) + (should entry) + (should (eq 'auto-dim-other-buffers (car (cdr entry)))) + (should (null (cdr (cdr entry))))))) + +(ert-deftest test-auto-dim-config-superstar-leading-uses-hide-face () + "Error: `org-superstar-leading' takes the -hide face, never the flat dim. +Its foreground is the background colour, which is what keeps hidden leading +stars invisible. Flat-dimming it would give them the dim face's visible grey +and reveal stars the user chose to hide. Same contract as `org-hide'." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (should-not (memq 'org-superstar-leading + test-auto-dim--flat-dimmed-superstar-faces)) + (let ((entry (assq 'org-superstar-leading auto-dim-other-buffers-affected-faces))) + (should entry) + (should (eq 'auto-dim-other-buffers-hide (car (cdr entry)))))) + +(ert-deftest test-auto-dim-config-hide-class-faces-use-hide-face () + "Error: every background-coloured face takes the -hide face. +`org-hide', `org-superstar-leading' and `org-indent' all resolve to the +background colour, which is what keeps folded text, leading stars and indent +prefixes invisible. Flat-dimming any of them reveals what the user hid." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (dolist (face test-auto-dim--hide-class-faces) + (let ((entry (assq face auto-dim-other-buffers-affected-faces))) + (should entry) + (should (eq 'auto-dim-other-buffers-hide (car (cdr entry))))))) + +(ert-deftest test-auto-dim-config-no-org-face-left-unmapped () + "Boundary: a fontified org buffer uses no face we forgot to handle. +Four rounds of this bug all had the same shape: a face nobody enumerated, +sitting ahead of a mapped face in a face list and outranking it. This walks +a representative buffer, collects every face it actually uses (including the +`line-prefix' and `wrap-prefix' org-indent hangs its faces on), and fails on +anything that is neither mapped nor deliberately excluded. + +Built-in org only. org-superstar and org-drill are elpa packages, and the +test run has no `package-initialize', so their faces are pinned by name in +the tests above instead." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (require 'org) + (let ((used (make-hash-table :test #'eq)) + (allowed (append test-auto-dim--no-foreground-faces + ;; Keyword class: deliberately unmapped so status stays + ;; readable in an unfocused window. Pinned by + ;; test-auto-dim-config-todo-priority-faces-not-flat-dimmed. + '(org-todo org-priority) + (mapcar #'car auto-dim-other-buffers-affected-faces)))) + (with-temp-buffer + (insert "#+TITLE: T\n#+AUTHOR: A\n\n* H1 :tag:\n** TODO [#A] task\n" + "DEADLINE: <2026-07-10 Fri>\n:PROPERTIES:\n:K: v\n:END:\n" + "Body ~verbatim~ =code= [[https://x.org][link]].\n" + "| a | b |\n|---+---|\n| 1 | 2 |\n" + "#+begin_src sh\necho hi\n#+end_src\n" + "- [X] done item\n") + (org-mode) + (font-lock-ensure) + (let ((p (point-min))) + (while (< p (point-max)) + (dolist (f (let ((v (get-text-property p 'face))) + (if (listp v) v (list v)))) + (when (and f (symbolp f)) (puthash f t used))) + (dolist (prop '(line-prefix wrap-prefix)) + (let ((s (get-text-property p prop))) + (when (stringp s) + (dolist (f (let ((v (get-text-property 0 'face s))) + (if (listp v) v (list v)))) + (when (and f (symbolp f)) (puthash f t used)))))) + (setq p (1+ p))))) + (let (unmapped) + (maphash (lambda (face _v) + (unless (memq face allowed) (push face unmapped))) + used) + (should (equal nil (sort unmapped #'string<)))))) + +(ert-deftest test-auto-dim-config-keyword-faces-keep-dim-variants () + "Boundary: org TODO-keyword faces keep dedicated -dim variants, not flat dim. +Keyword status is scanned across unfocused windows, so it earns a variant; +heading colour does not. Guards the flat-dim change from over-reaching." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (dolist (pair test-auto-dim--keyword-dim-variants) + (let ((entry (assq (car pair) auto-dim-other-buffers-affected-faces))) + (should entry) + (should (eq (cdr pair) (car (cdr entry))))))) + +(ert-deftest test-auto-dim-config-todo-priority-faces-not-flat-dimmed () + "Boundary: `org-todo' and `org-priority' are never flat-dimmed. +They are keyword class. Dimming them would erase the status colour the +-dim variants exist to preserve, so they stay out of the flat-dim set." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (dolist (face '(org-todo org-priority)) + (should-not (memq face test-auto-dim--flat-dimmed-org-faces)) + (let ((entry (assq face auto-dim-other-buffers-affected-faces))) + (should-not (and entry (eq 'auto-dim-other-buffers (car (cdr entry)))))))) + +(ert-deftest test-auto-dim-config-org-hide-uses-hide-face () + "Boundary: `org-hide' remaps to the -hide face, not the flat dim face. +Flat-dimming it would give folded text a visible foreground." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (let ((entry (assq 'org-hide auto-dim-other-buffers-affected-faces))) + (should entry) + (should (eq 'auto-dim-other-buffers-hide (car (cdr entry)))))) + (ert-deftest test-auto-dim-config-never-dim-dashboard-exempts-dashboard () "Normal: the *dashboard* buffer is exempt from dimming." (skip-unless (file-directory-p test-auto-dim--fork)) diff --git a/tests/test-calendar-sync--get-exdates.el b/tests/test-calendar-sync--get-exdates.el index 3283bbae..981a1857 100644 --- a/tests/test-calendar-sync--get-exdates.el +++ b/tests/test-calendar-sync--get-exdates.el @@ -103,6 +103,35 @@ END:VEVENT")) (should (= 1 (length result))) (should (string= "20260210T130000" (car result)))))) +(ert-deftest test-calendar-sync--get-exdates-boundary-comma-separated-returns-all () + "Boundary: comma-separated EXDATE values on one line are each returned. +RFC 5545 permits multiple datetimes per EXDATE line; missing the split +drops those exclusions, so cancelled instances resurrect in the agenda." + (let ((event "BEGIN:VEVENT +DTSTART:20260203T130000 +RRULE:FREQ=WEEKLY;BYDAY=TU +EXDATE:20260210T130000,20260217T130000,20260224T130000 +SUMMARY:Weekly Meeting +END:VEVENT")) + (let ((result (calendar-sync--get-exdates event))) + (should (= 3 (length result))) + (should (member "20260210T130000" result)) + (should (member "20260217T130000" result)) + (should (member "20260224T130000" result))))) + +(ert-deftest test-calendar-sync--get-exdates-boundary-comma-separated-with-tzid () + "Boundary: comma-separated EXDATE values sharing a TZID are each returned." + (let ((event "BEGIN:VEVENT +DTSTART;TZID=America/New_York:20260203T130000 +RRULE:FREQ=WEEKLY;BYDAY=TU +EXDATE;TZID=America/New_York:20260210T130000,20260217T130000 +SUMMARY:Weekly Meeting +END:VEVENT")) + (let ((result (calendar-sync--get-exdates event))) + (should (= 2 (length result))) + (should (member "20260210T130000" result)) + (should (member "20260217T130000" result))))) + ;;; Error Cases (ert-deftest test-calendar-sync--get-exdates-error-empty-string-returns-nil () diff --git a/tests/test-calendar-sync-source-fetch-sentinel.el b/tests/test-calendar-sync-source-fetch-sentinel.el new file mode 100644 index 00000000..0b7ba1cf --- /dev/null +++ b/tests/test-calendar-sync-source-fetch-sentinel.el @@ -0,0 +1,72 @@ +;;; test-calendar-sync-source-fetch-sentinel.el --- Tests for the fetch sentinel -*- lexical-binding: t; -*- + +;;; Commentary: +;; calendar-sync--fetch-sentinel-finish is the extracted tail of the async +;; .ics fetch sentinel. The async-worker tests stub the whole fetch, so its +;; success, failure, and temp-file-cleanup branches were never exercised. +;; These tests drive the helper directly with fake success/failure inputs, +;; no live curl process. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'calendar-sync) + +(ert-deftest test-calendar-sync-fetch-sentinel-success-passes-temp-file () + "Normal: on success the callback gets the temp file and it is not deleted." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (buffer (generate-new-buffer " *cs-test*")) + (got 'unset)) + (unwind-protect + (progn + (calendar-sync--fetch-sentinel-finish + t "finished\n" temp-file buffer (lambda (r) (setq got r))) + (should (equal got temp-file)) + (should (file-exists-p temp-file)) + (should-not (buffer-live-p buffer))) + (when (file-exists-p temp-file) (delete-file temp-file)) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest test-calendar-sync-fetch-sentinel-failure-deletes-and-passes-nil () + "Error: on failure the temp file is deleted and the callback gets nil." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (buffer (generate-new-buffer " *cs-test*")) + (got 'unset) + (logged nil)) + (unwind-protect + (cl-letf (((symbol-function 'calendar-sync--log-silently) + (lambda (&rest _) (setq logged t)))) + (calendar-sync--fetch-sentinel-finish + nil "exited abnormally with code 22\n" temp-file buffer + (lambda (r) (setq got r))) + (should (null got)) + (should-not (file-exists-p temp-file)) + (should logged) + (should-not (buffer-live-p buffer))) + (when (file-exists-p temp-file) (delete-file temp-file)) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest test-calendar-sync-fetch-sentinel-failure-tolerates-missing-temp-file () + "Boundary: failure with the temp file already gone does not error." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (got 'unset)) + (delete-file temp-file) + (cl-letf (((symbol-function 'calendar-sync--log-silently) #'ignore)) + (calendar-sync--fetch-sentinel-finish + nil "failed\n" temp-file nil (lambda (r) (setq got r))) + (should (null got))))) + +(ert-deftest test-calendar-sync-fetch-sentinel-tolerates-dead-buffer () + "Boundary: a already-dead process buffer is not touched on success." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (got 'unset)) + (unwind-protect + (progn + (calendar-sync--fetch-sentinel-finish + t "finished\n" temp-file nil (lambda (r) (setq got r))) + (should (equal got temp-file))) + (when (file-exists-p temp-file) (delete-file temp-file))))) + +(provide 'test-calendar-sync-source-fetch-sentinel) +;;; test-calendar-sync-source-fetch-sentinel.el ends here diff --git a/tests/test-config-utilities--recompile-emacs-home.el b/tests/test-config-utilities--recompile-emacs-home.el index 18d17f96..da364e24 100644 --- a/tests/test-config-utilities--recompile-emacs-home.el +++ b/tests/test-config-utilities--recompile-emacs-home.el @@ -81,20 +81,29 @@ Returns the temp dir path." (should-not (file-exists-p (expand-file-name "sub/c.elc" dir)))) (delete-directory dir t)))) -(ert-deftest test-config-utilities-recompile-removes-eln-dir-on-native-path () - "Boundary: the native path removes the eln cache directory when present." +(ert-deftest test-config-utilities-recompile-removes-eln-cache-dir-on-native-path () + "Boundary: the native path removes the eln-cache directory when present. +The native cache is eln-cache/, not eln/, so that is the directory to clear." (let ((dir (test-config-utilities--make-recompile-fixture)) - (eln-dir nil)) + (eln-cache-dir nil)) (unwind-protect (progn - (setq eln-dir (expand-file-name "eln" dir)) - (make-directory eln-dir) - (with-temp-file (expand-file-name "stale.eln" eln-dir) (insert "")) + (setq eln-cache-dir (expand-file-name "eln-cache" dir)) + (make-directory eln-cache-dir) + (with-temp-file (expand-file-name "stale.eln" eln-cache-dir) (insert "")) (cl-letf (((symbol-function 'native-compile-async) (lambda (&rest _) nil))) (cj/--recompile-emacs-home dir t)) - (should-not (file-exists-p eln-dir))) + (should-not (file-exists-p eln-cache-dir))) (delete-directory dir t)))) +(ert-deftest test-config-utilities-native-comp-detection-not-boundp () + "Regression: native-comp detection must not test `boundp' of the async +function -- native-compile-async is a function, so `boundp' is always nil and +native compilation would never be selected. On a native-comp build, detection +returns non-nil." + (when (and (fboundp 'native-comp-available-p) (native-comp-available-p)) + (should (cj/--native-comp-p)))) + (ert-deftest test-config-utilities-recompile-removes-elc-dir-on-byte-path () "Boundary: the byte path removes the elc cache directory when present." (let ((dir (test-config-utilities--make-recompile-fixture)) diff --git a/tests/test-custom-buffer-file--view-email-in-buffer.el b/tests/test-custom-buffer-file--view-email-in-buffer.el index 99e0e44d..b0209b78 100644 --- a/tests/test-custom-buffer-file--view-email-in-buffer.el +++ b/tests/test-custom-buffer-file--view-email-in-buffer.el @@ -13,6 +13,7 @@ ;;; Code: (require 'ert) +(require 'cl-lib) (require 'testutil-general) (require 'custom-buffer-file) @@ -233,5 +234,24 @@ Note: shr may insert newlines between words for wrapping." (kill-buffer))) (test-email--teardown))) +(ert-deftest test-custom-buffer-file--view-email-no-displayable-destroys-handle () + "Error: the MIME handle is destroyed even when no displayable part is found. +The `user-error' fires before cleanup, so without `unwind-protect' the dissected +handle leaks." + (test-email--setup) + (unwind-protect + (let ((eml-file (test-email--create-eml-file test-email--image-only)) + (destroy-called nil)) + (with-current-buffer (find-file-noselect eml-file) + (let ((real (symbol-function 'mm-destroy-parts))) + (cl-letf (((symbol-function 'mm-destroy-parts) + (lambda (handle) + (setq destroy-called t) + (funcall real handle)))) + (should-error (cj/view-email-in-buffer) :type 'user-error))) + (should destroy-called) + (kill-buffer))) + (test-email--teardown))) + (provide 'test-custom-buffer-file--view-email-in-buffer) ;;; test-custom-buffer-file--view-email-in-buffer.el ends here diff --git a/tests/test-custom-buffer-file-copy-link-to-buffer-file.el b/tests/test-custom-buffer-file-copy-link-to-buffer-file.el index 262968d6..5ee57b3a 100644 --- a/tests/test-custom-buffer-file-copy-link-to-buffer-file.el +++ b/tests/test-custom-buffer-file-copy-link-to-buffer-file.el @@ -4,7 +4,8 @@ ;; Tests for the cj/copy-link-to-buffer-file function from custom-buffer-file.el ;; ;; This function copies the full file:// path of the current buffer's file to -;; the kill ring. For non-file buffers, it does nothing (no error). +;; the kill ring. For non-file buffers, it signals a user-error, matching its +;; sibling copy commands. ;;; Code: @@ -58,12 +59,12 @@ (test-copy-link-teardown))) (ert-deftest test-copy-link-non-file-buffer () - "Should do nothing for non-file buffer without error." + "Error: a non-file buffer signals `user-error' and leaves the kill ring alone." (test-copy-link-setup) (unwind-protect (with-temp-buffer (setq kill-ring nil) - (cj/copy-link-to-buffer-file) + (should-error (cj/copy-link-to-buffer-file) :type 'user-error) (should (null kill-ring))) (test-copy-link-teardown))) @@ -195,13 +196,13 @@ (test-copy-link-teardown))) (ert-deftest test-copy-link-scratch-buffer () - "Should do nothing for *scratch* buffer." + "Error: the *scratch* buffer (no file) signals `user-error'." (test-copy-link-setup) (unwind-protect (progn (setq kill-ring nil) (with-current-buffer "*scratch*" - (cj/copy-link-to-buffer-file) + (should-error (cj/copy-link-to-buffer-file) :type 'user-error) (should (null kill-ring)))) (test-copy-link-teardown))) diff --git a/tests/test-custom-case-title-case-region.el b/tests/test-custom-case-title-case-region.el index 383ae927..82b4966a 100644 --- a/tests/test-custom-case-title-case-region.el +++ b/tests/test-custom-case-title-case-region.el @@ -60,16 +60,17 @@ an active region, and return the result." "The Art of War"))) (ert-deftest test-custom-case-title-case-region-normal-all-minor-words () - "All minor words in the skip list should be lowercased in mid-sentence." + "All minor words in the skip list should be lowercased in mid-sentence. +\"is\" is a linking verb, so it is a major word and is capitalized." (should (equal (test-title-case--on-string "go a an and as at but by for if in is nor of on or so the to yet go") - "Go a an and as at but by for if in is nor of on or so the to yet Go"))) + "Go a an and as at but by for if in Is nor of on or so the to yet Go"))) (ert-deftest test-custom-case-title-case-region-normal-four-letter-words-capitalized () "Words of four or more letters should always be capitalized. -Note: 'is' is explicitly in the minor word list, so it stays lowercase." +\"is\" is a linking verb (a major word), so it is capitalized too." (should (equal (test-title-case--on-string "this is from that with over") - "This is From That With Over"))) + "This Is From That With Over"))) (ert-deftest test-custom-case-title-case-region-normal-allcaps-input () "All-caps input should be downcased first, then title-cased." @@ -94,7 +95,16 @@ Note: 'is' is explicitly in the minor word list, so it stays lowercase." (ert-deftest test-custom-case-title-case-region-normal-question-resets () "Word immediately after a question mark should be capitalized, even if minor." (should (equal (test-title-case--on-string "really? the answer is no") - "Really? The Answer is No"))) + "Really? The Answer Is No"))) + +(ert-deftest test-custom-case-title-case-region-normal-last-word-capitalized () + "The last word is always capitalized, even a minor one." + (should (equal (test-title-case--on-string "the art of") "The Art Of"))) + +(ert-deftest test-custom-case-title-case-region-normal-period-restarts () + "A word after a sentence-ending period should be capitalized." + (should (equal (test-title-case--on-string "one. the next sentence") + "One. The Next Sentence"))) (ert-deftest test-custom-case-title-case-region-normal-hyphenated-word () "Second part of a hyphenated word should NOT be capitalized." @@ -141,7 +151,7 @@ Note: 'is' is explicitly in the minor word list, so it stays lowercase." (ert-deftest test-custom-case-title-case-region-boundary-unicode-words () "Unicode characters should pass through without error." (should (equal (test-title-case--on-string "the café is nice") - "The Café is Nice"))) + "The Café Is Nice"))) (ert-deftest test-custom-case-title-case-region-boundary-numbers-in-text () "Numbers mixed with text should not break title casing." diff --git a/tests/test-custom-comments-comment-inline-border.el b/tests/test-custom-comments-comment-inline-border.el index 78e86035..305a2c7a 100644 --- a/tests/test-custom-comments-comment-inline-border.el +++ b/tests/test-custom-comments-comment-inline-border.el @@ -120,6 +120,16 @@ Returns the buffer string for assertions." (let ((result (test-inline-border-at-column 0 ";;" "" "=" "" 10))) (should (string-match-p ";" result)))) +(ert-deftest test-inline-border-elisp-fills-exact-width-all-parities () + "Boundary: even, odd, and empty text all fill LENGTH exactly. +Even-length and empty text used to come out two columns short because the +right decoration count keyed off text-length parity instead of the remaining +width, so stacked dividers of differing text lengths misaligned." + (dolist (text '("" "X" "EVEN" "ODD" "Header")) + (let* ((result (test-inline-border-at-column 0 ";;" "" "=" text 50)) + (line (string-trim-right result "\n"))) + (should (= 50 (length line)))))) + (ert-deftest test-inline-border-elisp-text-centering-even () "Should center text properly with even length." (let ((result (test-inline-border-at-column 0 ";;" "" "=" "EVEN" 70))) diff --git a/tests/test-custom-comments-comment-reformat.el b/tests/test-custom-comments-comment-reformat.el index 83248aee..91b7dfe3 100644 --- a/tests/test-custom-comments-comment-reformat.el +++ b/tests/test-custom-comments-comment-reformat.el @@ -146,19 +146,12 @@ Insert CONTENT-BEFORE, select all, run cj/comment-reformat, verify EXPECTED-AFTE (should (string-match-p ";; Start line 1.*Start line 2" (buffer-string))))) (ert-deftest test-comment-reformat-elisp-no-region-active () - "Should show message when no region selected." + "Should signal `user-error' when no region is selected." (with-temp-buffer (emacs-lisp-mode) (insert ";; Comment line") (deactivate-mark) - (let ((message-log-max nil) - (messages '())) - ;; Capture messages - (cl-letf (((symbol-function 'message) - (lambda (format-string &rest args) - (push (apply #'format format-string args) messages)))) - (cj/comment-reformat) - (should (string-match-p "No region was selected" (car messages))))))) + (should-error (cj/comment-reformat) :type 'user-error))) (ert-deftest test-comment-reformat-elisp-read-only-buffer () "Should signal error in read-only buffer." diff --git a/tests/test-custom-datetime-all-methods.el b/tests/test-custom-datetime-all-methods.el index 62b421bd..1f31c6c4 100644 --- a/tests/test-custom-datetime-all-methods.el +++ b/tests/test-custom-datetime-all-methods.el @@ -54,9 +54,10 @@ (should (string-match-p "14:30:45" result)))) (ert-deftest test-custom-datetime-all-methods-normal-sortable-time () - "cj/insert-sortable-time should insert time with AM/PM and timezone." + "cj/insert-sortable-time should insert 24-hour time so it sorts lexically." (let ((result (test-datetime--run #'cj/insert-sortable-time))) - (should (string-match-p "02:30:45 PM" result)))) + (should (string-match-p "14:30:45" result)) + (should-not (string-match-p "PM" result)))) (ert-deftest test-custom-datetime-all-methods-normal-readable-time () "cj/insert-readable-time should insert short time with AM/PM." diff --git a/tests/test-custom-line-paragraph-duplicate-line-or-region.el b/tests/test-custom-line-paragraph-duplicate-line-or-region.el index 84f5bc2d..9e501086 100644 --- a/tests/test-custom-line-paragraph-duplicate-line-or-region.el +++ b/tests/test-custom-line-paragraph-duplicate-line-or-region.el @@ -327,6 +327,40 @@ (should (> (length (buffer-string)) (length "line one\nline two\nline three")))) (test-duplicate-line-or-region-teardown))) +(ert-deftest test-duplicate-line-or-region-mid-line-bounds-duplicate-whole-lines () + "A region ending mid-line duplicates every whole line it touches, no splits. +The old open-line loop split the mid-line-ending line instead." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "aaa\nbbb\nccc") + (transient-mark-mode 1) + (goto-char (point-min)) + (forward-char 1) ; mid first line + (set-mark (point)) + (forward-line 1) + (forward-char 2) ; mid second line + (activate-mark) + (cj/duplicate-line-or-region) + (should (string= "aaa\nbbb\naaa\nbbb\nccc" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-ends-at-bol-no-extra-empty-line () + "A region ending at beginning-of-line duplicates only the fully-included lines. +The old open-line loop duplicated a stray empty line here." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "aaa\nbbb\nccc") + (transient-mark-mode 1) + (goto-char (point-min)) + (set-mark (point)) + (forward-line 2) ; region "aaa\nbbb\n", ends at bol of ccc + (activate-mark) + (cj/duplicate-line-or-region) + (should (string= "aaa\nbbb\naaa\nbbb\nccc" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + (ert-deftest test-duplicate-line-or-region-trailing-whitespace () "Should preserve trailing whitespace." (test-duplicate-line-or-region-setup) diff --git a/tests/test-custom-line-paragraph-join-line-or-region.el b/tests/test-custom-line-paragraph-join-line-or-region.el index f8738910..5d421683 100644 --- a/tests/test-custom-line-paragraph-join-line-or-region.el +++ b/tests/test-custom-line-paragraph-join-line-or-region.el @@ -62,8 +62,8 @@ (should (string-match-p "line one line two" (buffer-string)))) (test-join-line-or-region-teardown))) -(ert-deftest test-join-line-or-region-no-region-adds-newline-after-join () - "Without region, should add newline after joining." +(ert-deftest test-join-line-or-region-no-region-adds-newline-at-end-of-buffer () + "Without region, joining the last line adds a trailing newline at end of buffer." (test-join-line-or-region-setup) (unwind-protect (with-temp-buffer @@ -73,6 +73,20 @@ (should (string-suffix-p "\n" (buffer-string)))) (test-join-line-or-region-teardown))) +(ert-deftest test-join-line-or-region-no-region-mid-buffer-no-blank-line () + "Without region, joining a non-last line must not insert a blank line. +The trailing newline belongs only at end of buffer; adding it unconditionally +left a stray blank line between the joined line and the rest of the buffer." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (forward-line 1) ; point on "line two", not the last line + (cj/join-line-or-region) + (should (string= "line one line two\nline three" (buffer-string)))) + (test-join-line-or-region-teardown))) + (ert-deftest test-join-line-or-region-with-region-joins-all-lines () "With region, should join all lines in region." (test-join-line-or-region-setup) diff --git a/tests/test-custom-line-paragraph-jump-to-matching-paren.el b/tests/test-custom-line-paragraph-jump-to-matching-paren.el index 31853da6..bd24faed 100644 --- a/tests/test-custom-line-paragraph-jump-to-matching-paren.el +++ b/tests/test-custom-line-paragraph-jump-to-matching-paren.el @@ -83,11 +83,11 @@ POINT-POSITION is 1-indexed (1 = first character)." ;;; Normal Cases - Backward Jump (Closing to Opening) (ert-deftest test-jump-paren-backward-simple () - "Should jump backward from closing paren to opening paren." + "Should jump from a closing paren to its matching opening paren." ;; Text: "(hello)" ;; Start at position 7 (on closing paren) - ;; Should end at position 2 (after opening paren) - (should (= 2 (test-jump-to-matching-paren "(hello)" 7)))) + ;; Should end at position 1 (the matching opening paren) + (should (= 1 (test-jump-to-matching-paren "(hello)" 7)))) (ert-deftest test-jump-paren-backward-nested () "Should jump backward over nested parens from after outer closing." @@ -97,11 +97,11 @@ POINT-POSITION is 1-indexed (1 = first character)." (should (= 1 (test-jump-to-matching-paren "(foo (bar))" 12)))) (ert-deftest test-jump-paren-backward-inner-nested () - "Should jump backward from inner closing paren." + "Should jump from an inner closing paren to its matching inner opener." ;; Text: "(foo (bar))" ;; Start at position 10 (on inner closing paren) - ;; Should end at position 7 (after inner opening paren) - (should (= 7 (test-jump-to-matching-paren "(foo (bar))" 10)))) + ;; Should end at position 6 (the matching inner opening paren) + (should (= 6 (test-jump-to-matching-paren "(foo (bar))" 10)))) (ert-deftest test-jump-bracket-backward () "Should jump backward from after closing bracket." @@ -145,11 +145,11 @@ POINT-POSITION is 1-indexed (1 = first character)." (should (= 1 (test-jump-to-matching-paren "(hello" 1)))) (ert-deftest test-jump-paren-unmatched-closing () - "Should move to beginning from unmatched closing paren." + "Should stay put on an unmatched closing paren (no matching opener)." ;; Text: "hello)" ;; Start at position 6 (on closing paren with no opening) - ;; backward-sexp with unmatched closing paren goes to beginning - (should (= 1 (test-jump-to-matching-paren "hello)" 6)))) + ;; There is no matching opener, so point is restored and stays at 6 + (should (= 6 (test-jump-to-matching-paren "hello)" 6)))) ;;; Boundary Cases - Empty Delimiters @@ -161,11 +161,11 @@ POINT-POSITION is 1-indexed (1 = first character)." (should (= 3 (test-jump-to-matching-paren "()" 1)))) (ert-deftest test-jump-paren-empty-backward () - "Should stay put when on closing paren of empty parens." + "Should jump from the closing paren of empty parens to its opener." ;; Text: "()" ;; Start at position 2 (on closing paren) - ;; backward-sexp from closing of empty parens gives an error, so stays at 2 - (should (= 2 (test-jump-to-matching-paren "()" 2)))) + ;; Should end at position 1 (the matching opening paren) + (should (= 1 (test-jump-to-matching-paren "()" 2)))) ;;; Boundary Cases - Multiple Delimiter Types diff --git a/tests/test-custom-ordering-number-lines.el b/tests/test-custom-ordering-number-lines.el index adda84f0..142e5561 100644 --- a/tests/test-custom-ordering-number-lines.el +++ b/tests/test-custom-ordering-number-lines.el @@ -122,9 +122,10 @@ Returns the transformed string." (should (string= result "1. ")))) (ert-deftest test-number-lines-empty-lines () - "Should number empty lines." + "Should number empty lines, treating the final newline as a terminator. +The old split counted the trailing newline as a spurious third line." (let ((result (test-number-lines "\n\n" "N. " nil))) - (should (string= result "1. \n2. \n3. ")))) + (should (string= result "1. \n2. \n")))) (ert-deftest test-number-lines-with-existing-numbers () "Should number lines that already have content." diff --git a/tests/test-custom-ordering-reverse-lines.el b/tests/test-custom-ordering-reverse-lines.el index 3c71362d..5b8c01ac 100644 --- a/tests/test-custom-ordering-reverse-lines.el +++ b/tests/test-custom-ordering-reverse-lines.el @@ -86,9 +86,11 @@ Returns the transformed string." (should (string= result "b\n\na")))) (ert-deftest test-reverse-lines-trailing-newline () - "Should handle trailing newline." + "Should reverse the lines and preserve the trailing newline. +The old split dropped the trailing newline into a leading empty line, +producing \"\\nline2\\nline1\"." (let ((result (test-reverse-lines "line1\nline2\n"))) - (should (string= result "\nline2\nline1")))) + (should (string= result "line2\nline1\n")))) (ert-deftest test-reverse-lines-only-newlines () "Should reverse lines that are only newlines." diff --git a/tests/test-custom-text-enclose-indent.el b/tests/test-custom-text-enclose-indent.el index e9042d35..f37d1800 100644 --- a/tests/test-custom-text-enclose-indent.el +++ b/tests/test-custom-text-enclose-indent.el @@ -43,6 +43,35 @@ Returns the transformed string." Returns the transformed string." (cj/--dedent-lines text count)) +;;; Interactive default resolution (the prefix-arg decoupling fix) + +(ert-deftest test-indent-lines-interactive-no-prefix-is-four-spaces () + "Interactive: no prefix indents by 4, spaces when `indent-tabs-mode' is nil. +The old \"p\\nP\" spec defaulted count to 1 and forced tabs on any prefix." + (with-temp-buffer + (setq-local indent-tabs-mode nil) + (insert "line") + (let ((current-prefix-arg nil)) + (call-interactively #'cj/indent-lines-in-region-or-buffer)) + (should (string= " line" (buffer-string))))) + +(ert-deftest test-indent-lines-interactive-follows-indent-tabs-mode () + "Interactive: tabs-vs-spaces follows `indent-tabs-mode', not the prefix arg." + (with-temp-buffer + (setq-local indent-tabs-mode t) + (insert "line") + (let ((current-prefix-arg nil)) + (call-interactively #'cj/indent-lines-in-region-or-buffer)) + (should (string= "\t\t\t\tline" (buffer-string))))) + +(ert-deftest test-dedent-lines-interactive-no-prefix-is-four () + "Interactive: no prefix removes up to 4 leading whitespace characters." + (with-temp-buffer + (insert " line") ; eight leading spaces + (let ((current-prefix-arg nil)) + (call-interactively #'cj/dedent-lines-in-region-or-buffer)) + (should (string= " line" (buffer-string))))) + ;;; Indent Tests - Normal Cases with Spaces (ert-deftest test-indent-single-line-4-spaces () diff --git a/tests/test-dashboard-config-launchers.el b/tests/test-dashboard-config-launchers.el index 53c46caa..76fbcc42 100644 --- a/tests/test-dashboard-config-launchers.el +++ b/tests/test-dashboard-config-launchers.el @@ -28,20 +28,21 @@ ;; Telegram moved from "g" to "G" so "g" is free for dashboard refresh. ;; Signal ("S") added as the 14th launcher. ;; Weather ("w") added after Agenda as the 15th launcher (top-row daily glance). -(defconst test-dash--keys '("c" "d" "t" "a" "w" "r" "b" "f" "m" "e" "i" "G" "s" "l" "S")) +(defconst test-dash--keys '("c" "d" "t" "a" "w" "r" "b" "f" "m" "e" "i" "G" "s" "l")) ;; ----------------------------- launcher table -------------------------------- (ert-deftest test-dashboard-launchers-keys-in-order () - "Normal: 15 launchers with the expected keys in display order." - (should (= 15 (length cj/dashboard--launchers))) + "Normal: 14 launchers with the expected keys in display order. +(Signal left the table when the signel client was retired to archive/.)" + (should (= 14 (length cj/dashboard--launchers))) (should (equal test-dash--keys (mapcar (lambda (l) (nth 0 l)) cj/dashboard--launchers)))) (ert-deftest test-dashboard-launchers-labels-in-order () "Normal: labels in display order (Telegram and Slack reordered so Slack sits next to Linear on the last navigator row)." (should (equal '("Code" "Files" "Terminal" "Agenda" "Weather" "Feeds" "Books" - "Flashcards" "Music" "Email" "IRC" "Telegram" "Slack" "Linear" "Signal") + "Flashcards" "Music" "Email" "IRC" "Telegram" "Slack" "Linear") (mapcar (lambda (l) (nth 3 l)) cj/dashboard--launchers)))) (ert-deftest test-dashboard-row-sizes-cover-all-launchers () @@ -51,9 +52,9 @@ next to Linear on the last navigator row)." ;; --------------------------- navigator rows ---------------------------------- -(ert-deftest test-dashboard-navigator-rows-grouped-5-4-3-3 () - "Normal: navigator derives rows per `cj/dashboard--row-sizes' (5 4 3 3), with -Weather joining the top row and Slack, Linear, and Signal sharing the last row." +(ert-deftest test-dashboard-navigator-rows-grouped-5-4-3-2 () + "Normal: navigator derives rows per `cj/dashboard--row-sizes' (5 4 3 2), with +Weather joining the top row and Slack and Linear pairing on the last row." (cl-letf (((symbol-function 'nerd-icons-faicon) (lambda (n &rest _) (concat "I:" n))) ((symbol-function 'nerd-icons-devicon) (lambda (n &rest _) (concat "I:" n))) ((symbol-function 'nerd-icons-mdicon) (lambda (n &rest _) (concat "I:" n))) @@ -62,10 +63,10 @@ Weather joining the top row and Slack, Linear, and Signal sharing the last row." ((symbol-function 'nerd-icons-wicon) (lambda (n &rest _) (concat "I:" n)))) (let ((rows (cj/dashboard--navigator-rows))) (should (= 4 (length rows))) - (should (equal '(5 4 3 3) (mapcar #'length rows))) + (should (equal '(5 4 3 2) (mapcar #'length rows))) (should (equal '("Code" "Files" "Terminal" "Agenda" "Weather") (mapcar (lambda (b) (nth 1 b)) (nth 0 rows)))) - (should (equal '("Slack" "Linear" "Signal") + (should (equal '("Slack" "Linear") (mapcar (lambda (b) (nth 1 b)) (nth 3 rows)))) (let ((btn (car (car rows)))) ; (icon label tooltip action nil " " "") (should (string= "I:nf-fa-code" (nth 0 btn))) @@ -100,7 +101,6 @@ Weather joining the top row and Slack, Linear, and Signal sharing the last row." ((symbol-function 'cj/slack-start) (lambda (&rest _) (push 'slack calls))) ((symbol-function 'cj/telega) (lambda (&rest _) (push 'tg calls))) ((symbol-function 'pearl-list-issues) (lambda (&rest _) (push 'linear calls))) - ((symbol-function 'cj/signel-message) (lambda (&rest _) (push 'signal calls))) ;; wttrin is invoked via `call-interactively', so the stub must be ;; a command -- a plain variadic lambda masked the real arity bug. ((symbol-function 'wttrin) (lambda (&rest _) (interactive) (push 'weather calls)))) @@ -112,9 +112,8 @@ Weather joining the top row and Slack, Linear, and Signal sharing the last row." (should (memq 'linear calls)) (should (memq 'm-toggle calls)) (should (memq 'm-load calls)) - (should (memq 'signal calls)) (should (memq 'weather calls)) - (should (= 16 (length calls)))))) ; 15 keys, Music fires two + (should (= 15 (length calls)))))) ; 14 keys, Music fires two (provide 'test-dashboard-config-launchers) ;;; test-dashboard-config-launchers.el ends here diff --git a/tests/test-eat-config--xtwinops.el b/tests/test-eat-config--xtwinops.el new file mode 100644 index 00000000..29f87f2f --- /dev/null +++ b/tests/test-eat-config--xtwinops.el @@ -0,0 +1,120 @@ +;;; test-eat-config--xtwinops.el --- Tests for the EAT XTWINOPS window-size reply -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for the XTWINOPS (CSI <n> t) window-size responder. eat 0.9.4 +;; has no CSI <n> t handler, so it silently drops the window-size requests +;; tmux 3.7b sends to learn the cell pixel size it needs before it will emit +;; Sixel -- images then never render inside EAT. The module answers three +;; requests: 14 (text area in pixels), 16 (cell size in pixels), 18 (text area +;; in characters). +;; +;; Two pure pieces carry the logic and are tested here directly: +;; - `cj/--eat-xtwinops-report' computes the reply string from the display and +;; cell dimensions. +;; - `cj/--eat-xtwinops-queries' extracts the request numbers from a chunk of +;; terminal output. +;; The thin accessor glue (`cj/--eat-send-window-size-report', which reads the +;; live `eat--t-term' struct) is verified in the running daemon, since eat's +;; structs are not loadable under `make test' (no package-initialize). The +;; detector's dispatch is tested against a recording stub of the responder. + +;;; Code: + +(require 'ert) + +;; Stub keymap dep before loading the module (matches the other module tests). +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'eat-config) + +;;; --------------------------- reply computation ---------------------------- + +(ert-deftest test-eat-config-xtwinops-report-normal-14-text-area-pixels () + "Normal: request 14 reports text-area size in pixels (rows*ch by cols*cw)." + ;; 80x24 chars, 10x20 px cells -> height 24*20=480, width 80*10=800. + (should (equal (cj/--eat-xtwinops-report 14 80 24 10 20) + "\e[4;480;800t"))) + +(ert-deftest test-eat-config-xtwinops-report-normal-16-cell-pixels () + "Normal: request 16 reports the cell size in pixels (height then width)." + (should (equal (cj/--eat-xtwinops-report 16 80 24 10 20) + "\e[6;20;10t"))) + +(ert-deftest test-eat-config-xtwinops-report-normal-18-text-area-chars () + "Normal: request 18 reports the text-area size in characters (rows then cols)." + (should (equal (cj/--eat-xtwinops-report 18 80 24 10 20) + "\e[8;24;80t"))) + +(ert-deftest test-eat-config-xtwinops-report-boundary-unit-cells () + "Boundary: with eat's default 1x1 px cells, pixel dims equal the char dims." + (should (equal (cj/--eat-xtwinops-report 14 80 24 1 1) "\e[4;24;80t")) + (should (equal (cj/--eat-xtwinops-report 16 80 24 1 1) "\e[6;1;1t"))) + +(ert-deftest test-eat-config-xtwinops-report-error-unknown-request-is-nil () + "Error: any request number other than 14/16/18 returns nil (unanswered)." + (should (null (cj/--eat-xtwinops-report 15 80 24 10 20))) + (should (null (cj/--eat-xtwinops-report 24 80 24 10 20))) + (should (null (cj/--eat-xtwinops-report nil 80 24 10 20)))) + +;;; ----------------------------- query detection ---------------------------- + +(ert-deftest test-eat-config-xtwinops-queries-normal-single () + "Normal: a lone CSI 14 t query is detected." + (should (equal (cj/--eat-xtwinops-queries "\e[14t") '(14)))) + +(ert-deftest test-eat-config-xtwinops-queries-normal-embedded-multiple () + "Normal: several queries embedded in other output are returned in order." + (should (equal (cj/--eat-xtwinops-queries "foo\e[14tbar\e[18tbaz\e[16t") + '(14 18 16)))) + +(ert-deftest test-eat-config-xtwinops-queries-boundary-none () + "Boundary: output with no XTWINOPS query returns nil, including empty." + (should (null (cj/--eat-xtwinops-queries ""))) + (should (null (cj/--eat-xtwinops-queries "hello\e[0m\e[2J")))) + +(ert-deftest test-eat-config-xtwinops-queries-error-unhandled-ops-ignored () + "Error: CSI t ops we do not answer (and parametrized forms) are not matched. +`\\e[24t' is a resize op, `\\e[3;14t' carries a leading param -- neither is the +bare CSI 14/16/18 t we answer, so both are ignored." + (should (null (cj/--eat-xtwinops-queries "\e[24t"))) + (should (null (cj/--eat-xtwinops-queries "\e[3;14t"))) + (should (null (cj/--eat-xtwinops-queries "\e[114t")))) + +;;; --------------------------- advice-needed guard -------------------------- + +(ert-deftest test-eat-config-xtwinops-advice-needed-normal-eat-0-9-4 () + "Normal: on eat 0.9.4 (no upstream CSI t clause) the advice is needed." + ;; The upstream parser clause defines `eat--t-send-window-size-report'; + ;; 0.9.4 does not, so it must be unbound here. + (should-not (fboundp 'eat--t-send-window-size-report)) + (should (cj/--eat-xtwinops-advice-needed-p))) + +(ert-deftest test-eat-config-xtwinops-advice-needed-boundary-upstream-ships () + "Boundary: once upstream defines the parser clause, the advice must NOT +install -- both would answer and tmux gets a double reply." + (cl-letf (((symbol-function 'eat--t-send-window-size-report) #'ignore)) + (should-not (cj/--eat-xtwinops-advice-needed-p)))) + +;;; ------------------------- detector dispatch (seam) ----------------------- + +(ert-deftest test-eat-config-xtwinops-answer-dispatches-once-per-query () + "Integration: the detector calls the responder once per query, in order. +Mocks only our own responder seam (`cj/--eat-send-window-size-report'); the +detector under test does the real query extraction." + (let ((calls '())) + (cl-letf (((symbol-function 'cj/--eat-send-window-size-report) + (lambda (n) (push n calls)))) + (cj/--eat-answer-xtwinops "\e[14t\e[16t\e[18t")) + (should (equal (nreverse calls) '(14 16 18))))) + +(ert-deftest test-eat-config-xtwinops-answer-no-query-no-call () + "Boundary: output with no query never calls the responder." + (let ((called nil)) + (cl-letf (((symbol-function 'cj/--eat-send-window-size-report) + (lambda (_n) (setq called t)))) + (cj/--eat-answer-xtwinops "no query here\e[2J")) + (should-not called))) + +(provide 'test-eat-config--xtwinops) +;;; test-eat-config--xtwinops.el ends here diff --git a/tests/test-flycheck-config-ledger-hook.el b/tests/test-flycheck-config-ledger-hook.el new file mode 100644 index 00000000..e9444b71 --- /dev/null +++ b/tests/test-flycheck-config-ledger-hook.el @@ -0,0 +1,31 @@ +;;; test-flycheck-config-ledger-hook.el --- flycheck reaches ledger buffers -*- lexical-binding: t; -*- + +;;; Commentary: +;; `flycheck-ledger' registers a `ledger' checker, but a checker only runs where +;; `flycheck-mode' is on. Until 2026-07-10 flycheck-config enabled the mode in +;; `sh-mode' and `emacs-lisp-mode' only, and no `global-flycheck-mode' existed, so +;; an unbalanced transaction in a ledger file produced no warning at all. +;; +;; These tests pin the hook, not the checker. Whether the `ledger' checker itself +;; works is flycheck-ledger's problem; whether it ever gets a chance to run is ours. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'flycheck-config) + +(ert-deftest test-flycheck-config-enables-flycheck-in-ledger-buffers () + "Normal: opening a ledger buffer turns `flycheck-mode' on. +Without this, `flycheck-ledger' is loaded, its checker is registered, and +nothing ever lints a financial file." + (should (memq #'flycheck-mode (default-value 'ledger-mode-hook)))) + +(ert-deftest test-flycheck-config-keeps-its-existing-mode-hooks () + "Boundary: adding ledger doesn't displace the modes flycheck already covered." + (should (memq #'flycheck-mode (default-value 'sh-mode-hook))) + (should (memq #'flycheck-mode (default-value 'emacs-lisp-mode-hook)))) + +(provide 'test-flycheck-config-ledger-hook) +;;; test-flycheck-config-ledger-hook.el ends here diff --git a/tests/test-flyspell-and-abbrev.el b/tests/test-flyspell-and-abbrev.el index ef8cc637..3b494d5e 100644 --- a/tests/test-flyspell-and-abbrev.el +++ b/tests/test-flyspell-and-abbrev.el @@ -97,5 +97,27 @@ (cj/flyspell-on-for-buffer-type))) (should mode-called))) +;; --------------------------- cj/flyspell-then-abbrev ------------------------- + +(ert-deftest test-flyspell-then-abbrev-enables-mode-not-bare-rescan () + "Regression: cj/flyspell-then-abbrev routes the initial scan through +cj/flyspell-on-for-buffer-type, which enables flyspell-mode so it sticks. +The bare flyspell-buffer it replaced never turned the mode on, so the guard +never tripped and every C-' press re-scanned the whole buffer (O(buffer) per +keypress in large files)." + (let (on-called scan-called) + (cl-letf (((symbol-function 'cj/--require-spell-checker) #'ignore) + ((symbol-function 'cj/flyspell-on-for-buffer-type) + (lambda () (setq on-called t))) + ((symbol-function 'flyspell-buffer) + (lambda (&rest _) (setq scan-called t))) + ((symbol-function 'cj/flyspell-goto-previous-misspelling) + (lambda (&rest _) nil))) + (with-temp-buffer + (text-mode) + (cj/flyspell-then-abbrev nil))) + (should on-called) + (should-not scan-called))) + (provide 'test-flyspell-and-abbrev) ;;; test-flyspell-and-abbrev.el ends here diff --git a/tests/test-font-config.el b/tests/test-font-config.el index 393a7758..4df2b41a 100644 --- a/tests/test-font-config.el +++ b/tests/test-font-config.el @@ -93,5 +93,47 @@ ((symbol-function 'set-fontset-font) (lambda (&rest _) t))) (should (progn (cj/setup-emoji-fontset) t)))) +;;; cj/set-emojify-display-style + +(defvar emojify-display-style) + +(ert-deftest test-font-config-emojify-display-style-image-on-gui () + "Normal: on a GUI frame the emoji display style is `image'." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((emojify-display-style nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda (&rest _) t))) + (cj/set-emojify-display-style) + (should (eq emojify-display-style 'image))))) + +(ert-deftest test-font-config-emojify-display-style-unicode-without-gui () + "Boundary: without a GUI the emoji display style is `unicode'." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((emojify-display-style nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda (&rest _) nil))) + (cj/set-emojify-display-style) + (should (eq emojify-display-style 'unicode))))) + +;;; cj/display-available-fonts + +(ert-deftest test-font-config-display-available-fonts-second-call-no-error () + "Error: a second invocation does not signal on the read-only buffer." + (skip-unless test-font-config--available) + (require 'font-config) + (cl-letf (((symbol-function 'font-family-list) + (lambda (&rest _) '("Fixture Font A" "Fixture Font B")))) + (unwind-protect + (progn + (cj/display-available-fonts) + ;; The first call ends in `special-mode' (read-only); the second must + ;; not signal when it erases and rewrites the buffer. + (cj/display-available-fonts) + (with-current-buffer "*Available Fonts*" + (should (> (buffer-size) 0)) + (should buffer-read-only))) + (when (get-buffer "*Available Fonts*") + (kill-buffer "*Available Fonts*"))))) + (provide 'test-font-config) ;;; test-font-config.el ends here diff --git a/tests/test-keyboard-compat-setup.el b/tests/test-keyboard-compat-setup.el index 1c5cd434..a23e24e1 100644 --- a/tests/test-keyboard-compat-setup.el +++ b/tests/test-keyboard-compat-setup.el @@ -61,6 +61,14 @@ string can return a meta-prefix event count rather than nil.)" (cj/keyboard-compat-terminal-setup) (should (equal input-decode-map (make-sparse-keymap))))) +(ert-deftest test-keyboard-compat-terminal-setup-on-tty-setup-hook () + "Normal: terminal setup is registered on `tty-setup-hook', which runs for each +new tty frame. `input-decode-map' is terminal-local, so `emacs-startup-hook' +\(once, at daemon start, with no tty) leaves every later `emacsclient -t' frame +without the arrow-key decodings. The GUI half already frame-scopes itself." + (should (memq 'cj/keyboard-compat-terminal-setup tty-setup-hook)) + (should-not (memq 'cj/keyboard-compat-terminal-setup emacs-startup-hook))) + ;; -------------------------- cj/keyboard-compat-gui-setup --------------------- (defmacro test-kbc--gui (gui-p &rest body) @@ -71,18 +79,20 @@ string can return a meta-prefix event count rather than nil.)" ,@body))) (defconst test-kbc--meta-shift-letters - '(?o ?m ?y ?f ?w ?e ?l ?r ?v ?h ?t ?z ?u ?d ?i ?c ?b ?k) - "The 18 letters whose M-<UPPER> form is translated to M-S-<lower> in GUI mode.") + '(?o ?m ?y ?f ?w ?e ?l ?r ?v ?h ?t ?z ?u ?d ?i ?c ?b) + "The 17 letters whose M-<UPPER> form is translated to M-S-<lower> in GUI mode.") (ert-deftest test-keyboard-compat-gui-setup-translates-spot-checks () - "Normal: in GUI mode, M-O -> M-S-o and M-K -> M-S-k (sampled)." + "Normal: in GUI mode, M-O -> M-S-o and M-B -> M-S-b (sampled). +M-K is no longer translated: show-kill-ring, its only consumer, was retired." (test-kbc--gui t (cj/keyboard-compat-gui-setup) (should (equal (lookup-key key-translation-map (kbd "M-O")) (kbd "M-S-o"))) - (should (equal (lookup-key key-translation-map (kbd "M-K")) (kbd "M-S-k"))) - (should (equal (lookup-key key-translation-map (kbd "M-D")) (kbd "M-S-d"))))) + (should (equal (lookup-key key-translation-map (kbd "M-B")) (kbd "M-S-b"))) + (should (equal (lookup-key key-translation-map (kbd "M-D")) (kbd "M-S-d"))) + (should-not (lookup-key key-translation-map (kbd "M-K"))))) -(ert-deftest test-keyboard-compat-gui-setup-translates-all-eighteen () +(ert-deftest test-keyboard-compat-gui-setup-translates-all-seventeen () "Normal: every documented M-<UPPER> maps to its M-S-<lower> form." (test-kbc--gui t (cj/keyboard-compat-gui-setup) diff --git a/tests/test-ledger-config.el b/tests/test-ledger-config.el new file mode 100644 index 00000000..5224c184 --- /dev/null +++ b/tests/test-ledger-config.el @@ -0,0 +1,70 @@ +;;; test-ledger-config.el --- Characterization tests for ledger-config -*- lexical-binding: t; -*- + +;;; Commentary: +;; Captures the behavior ledger-config.el has today, before any guardrail work +;; changes it. See docs/design/2026-07-10-ledger-config-audit.org for the audit +;; these tests pin. +;; +;; The clean-on-save helpers are defined in the `use-package' `:preface', which +;; use-package emits unconditionally, so they exist under `make test' even though +;; ledger-mode itself never loads there (no `package-initialize' in the test run). +;; +;; `ledger-mode-clean-buffer' is stubbed: it is the boundary this config delegates +;; to, and it rewrites the whole buffer. What these tests pin is whether our hook +;; calls it, not what it does. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ledger-config) + +(ert-deftest test-ledger-config-clean-before-save-cleans-when-enabled () + "Normal: with `cj/ledger-clean-on-save' set, the save hook cleans the buffer." + (let ((called 0) + (cj/ledger-clean-on-save t)) + (cl-letf (((symbol-function 'ledger-mode-clean-buffer) + (lambda (&rest _) (setq called (1+ called))))) + (cj/ledger--clean-before-save)) + (should (= 1 called)))) + +(ert-deftest test-ledger-config-clean-before-save-skips-when-disabled () + "Boundary: with `cj/ledger-clean-on-save' nil, the save hook does nothing." + (let ((called 0) + (cj/ledger-clean-on-save nil)) + (cl-letf (((symbol-function 'ledger-mode-clean-buffer) + (lambda (&rest _) (setq called (1+ called))))) + (cj/ledger--clean-before-save)) + (should (= 0 called)))) + +(ert-deftest test-ledger-config-clean-before-save-demotes-errors () + "Error: a failing clean does not signal, so the file still saves. +This is the current contract. It also means a clean that fails partway +leaves the buffer in whatever state it reached, because nothing rolls back." + (let ((cj/ledger-clean-on-save t) + (inhibit-message t)) + (cl-letf (((symbol-function 'ledger-mode-clean-buffer) + (lambda (&rest _) (error "boom")))) + (should (progn (cj/ledger--clean-before-save) t))))) + +(ert-deftest test-ledger-config-enable-clean-on-save-is-buffer-local () + "Normal: the hook installs buffer-locally, not globally." + (let ((global-before (default-value 'before-save-hook))) + (with-temp-buffer + (cj/ledger--enable-clean-on-save) + (should (memq #'cj/ledger--clean-before-save before-save-hook)) + (should-not (memq #'cj/ledger--clean-before-save + (default-value 'before-save-hook)))) + (should (equal global-before (default-value 'before-save-hook))))) + +(ert-deftest test-ledger-config-clean-on-save-defaults-on () + "Normal: clean-on-save ships enabled. +Pinned because the audit questions whether a whole-buffer sort belongs on +every save of a financial file. If that default flips, this test should +fail and be updated deliberately." + (should (eq t (default-value 'cj/ledger-clean-on-save)))) + +(provide 'test-ledger-config) +;;; test-ledger-config.el ends here diff --git a/tests/test-local-repository--car-member.el b/tests/test-local-repository--car-member.el deleted file mode 100644 index 30ae58c6..00000000 --- a/tests/test-local-repository--car-member.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; test-local-repository--car-member.el --- Tests for localrepo--car-member -*- lexical-binding: t -*- - -;;; Commentary: -;; Tests for `localrepo--car-member' in local-repository.el — the predicate -;; localrepo-initialize uses to check whether an archive id is already -;; registered in package-archives / package-archive-priorities. - -;;; Code: - -(require 'ert) -(require 'local-repository) - -;;; Normal Cases - -(ert-deftest test-local-repository-localrepo--car-member-found () - "Normal: VALUE present as a car returns the matching tail (non-nil)." - (should (equal (localrepo--car-member 'b '((a . 1) (b . 2) (c . 3))) - '(b c)))) - -(ert-deftest test-local-repository-localrepo--car-member-not-found () - "Normal: VALUE absent from every car returns nil." - (should-not (localrepo--car-member 'z '((a . 1) (b . 2))))) - -(ert-deftest test-local-repository-localrepo--car-member-string-car () - "Normal: car comparison uses `equal', so string keys match by value." - (should (localrepo--car-member "localrepo" - '(("gnu" . "url1") ("localrepo" . "url2"))))) - -;;; Boundary Cases - -(ert-deftest test-local-repository-localrepo--car-member-empty-list () - "Boundary: an empty list never matches." - (should-not (localrepo--car-member 'a nil))) - -(ert-deftest test-local-repository-localrepo--car-member-single-match () - "Boundary: a single-element list whose car matches returns non-nil." - (should (localrepo--car-member 'only '((only . 1))))) - -(ert-deftest test-local-repository-localrepo--car-member-single-no-match () - "Boundary: a single-element list whose car differs returns nil." - (should-not (localrepo--car-member 'x '((only . 1))))) - -(ert-deftest test-local-repository-localrepo--car-member-nil-value-with-nil-car () - "Boundary: a nil VALUE matches a cons whose car is nil." - (should (localrepo--car-member nil '((nil . 1) (a . 2))))) - -(ert-deftest test-local-repository-localrepo--car-member-nil-value-no-nil-car () - "Boundary: a nil VALUE with no nil car returns nil." - (should-not (localrepo--car-member nil '((a . 1) (b . 2))))) - -;;; Error Cases - -(ert-deftest test-local-repository-localrepo--car-member-non-cons-element () - "Error: a non-cons element makes `car' signal wrong-type-argument." - (should-error (localrepo--car-member 'x '(1 2)) :type 'wrong-type-argument)) - -(provide 'test-local-repository--car-member) -;;; test-local-repository--car-member.el ends here diff --git a/tests/test-local-repository.el b/tests/test-local-repository.el new file mode 100644 index 00000000..132f8dc4 --- /dev/null +++ b/tests/test-local-repository.el @@ -0,0 +1,32 @@ +;;; test-local-repository.el --- Tests for the local-repository update command -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/update-localrepo-repository' refreshes the checked-in local package +;; archive at `localrepo-location' (owned by early-init.el) via elpa-mirror. +;; The elpa-mirror call is mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'local-repository) + +;; localrepo-location is a defconst in early-init.el, which `make test' never +;; loads. Declare it special here so the `let' below binds it dynamically and +;; the module reads that value. +(defvar localrepo-location nil) + +(ert-deftest test-local-repository-update-targets-early-init-location () + "Normal: the mirror update targets `localrepo-location', the single archive +path early-init.el owns, not a divergent module-local copy." + (let ((localrepo-location "/tmp/test-localrepo/") + (captured nil)) + (cl-letf (((symbol-function 'elpamr-create-mirror-for-installed) + (lambda (dir &rest _) (setq captured dir)))) + (cj/update-localrepo-repository) + (should (equal captured "/tmp/test-localrepo/"))))) + +(provide 'test-local-repository) +;;; test-local-repository.el ends here diff --git a/tests/test-lorem-optimum.el b/tests/test-lorem-optimum.el index f928c972..b7d97a8e 100644 --- a/tests/test-lorem-optimum.el +++ b/tests/test-lorem-optimum.el @@ -253,5 +253,26 @@ an empty string, not an error." (let ((cj/lipsum-chain (cj/markov-chain-create))) (should (equal "" (cj/lipsum-title))))) +;;; cj/lipsum entry point + +(ert-deftest test-lipsum-returns-string-with-populated-chain () + "Normal: cj/lipsum returns a non-empty string when the chain is trained." + (let ((cj/lipsum-chain + (test-learn "Lorem ipsum dolor sit amet consectetur adipiscing elit"))) + (let ((result (cj/lipsum 5))) + (should (stringp result)) + (should (> (length result) 0))))) + +(ert-deftest test-lipsum-empty-chain-signals-user-error () + "Error: cj/lipsum on an empty chain signals a user-error naming the fix, +rather than returning nil and letting cj/lipsum-insert do (insert nil), +which raises a cryptic wrong-type error far from the cause." + (let ((cj/lipsum-chain (cj/markov-chain-create))) + (should-error (cj/lipsum 5) :type 'user-error))) + +(ert-deftest test-lipsum-is-interactive-command () + "Normal: cj/lipsum is a command, as its Commentary (M-x cj/lipsum) advertises." + (should (commandp 'cj/lipsum))) + (provide 'test-lorem-optimum) ;;; test-lorem-optimum.el ends here diff --git a/tests/test-mail-config--account-search-queries.el b/tests/test-mail-config--account-search-queries.el index 9f1b6b3e..02a74692 100644 --- a/tests/test-mail-config--account-search-queries.el +++ b/tests/test-mail-config--account-search-queries.el @@ -38,9 +38,12 @@ (ert-deftest test-mail-make-account-map-closures-capture-distinct-queries () "Normal: each binding runs its own account-scoped search (no closure leak). -mu4e-search is mocked to capture the query each command passes." +mu4e-search is mocked to capture the query each command passes; require is +mocked so the commands' mu4e load never pulls the real package in batch." (let ((searched '())) - (cl-letf (((symbol-function 'mu4e-search) + (cl-letf (((symbol-function 'require) + (lambda (feature &rest _) feature)) + ((symbol-function 'mu4e-search) (lambda (q) (push q searched)))) (let ((map (cj/--mail-make-account-map "dmail"))) (funcall (keymap-lookup map "i")) @@ -49,5 +52,20 @@ mu4e-search is mocked to capture the query each command passes." (should (member "maildir:/dmail/INBOX AND flag:unread AND NOT flag:trashed" searched)))) +(ert-deftest test-mail-make-account-map-loads-mu4e-before-search () + "Error: a nav command loads mu4e before it calls `mu4e-search'. +The C-; e maps register eagerly at startup, but `mu4e-search' carries no +autoload cookie, so a nav key pressed before mu4e's first launch signaled +void-function. The command must require mu4e first, then search." + (let ((events '())) + (cl-letf (((symbol-function 'require) + (lambda (feature &rest _) (push (list :require feature) events) feature)) + ((symbol-function 'mu4e-search) + (lambda (q) (push (list :search q) events)))) + (funcall (keymap-lookup (cj/--mail-make-account-map "cmail") "i"))) + (should (equal (nreverse events) + '((:require mu4e) + (:search "maildir:/cmail/INBOX")))))) + (provide 'test-mail-config--account-search-queries) ;;; test-mail-config--account-search-queries.el ends here diff --git a/tests/test-mail-config-transport.el b/tests/test-mail-config-transport.el index 0240102a..9329ac70 100644 --- a/tests/test-mail-config-transport.el +++ b/tests/test-mail-config-transport.el @@ -66,6 +66,23 @@ EXECUTABLES is an alist of program name strings to executable paths." (should (equal test-mail-config--warnings '((mail-config . "msmtp not found; SMTP mail sending unavailable"))))))) +(ert-deftest test-mail-config-transport-msmtp-missing-sets-descriptive-fallback () + "Error: with msmtp absent, the send functions get a descriptive fallback. +The old behavior left `message-send-mail-function' nil (the top-level defvar +pre-empts message.el's default), so the first send died with \"invalid +function: nil\". The fallback must be installed on both send variables and +must signal a `user-error' that names msmtp." + (test-mail-config--with-executables nil + (let (send-mail-function message-send-mail-function) + (cj/mail-configure-smtpmail) + (should (eq send-mail-function #'cj/mail--send-mail-unavailable)) + (should (eq message-send-mail-function #'cj/mail--send-mail-unavailable)) + (should-error (cj/mail--send-mail-unavailable) :type 'user-error) + (condition-case err + (cj/mail--send-mail-unavailable) + (user-error + (should (string-match-p "msmtp" (cadr err)))))))) + (ert-deftest test-mail-config-transport-mbsync-present-builds-command () "When mbsync exists, build the mu4e sync command." (test-mail-config--with-executables '(("mbsync" . "/usr/bin/mbsync")) diff --git a/tests/test-mu4e-attachments.el b/tests/test-mu4e-attachments.el index 0a780977..986c2746 100644 --- a/tests/test-mu4e-attachments.el +++ b/tests/test-mu4e-attachments.el @@ -75,6 +75,56 @@ so this fails the same way whether or not mu4e's MIME support is loadable." (should-error (cj/mu4e--save-attachment-part part "/downloads") :type 'user-error))) +(ert-deftest test-mu4e-attachments-save-part-errors-on-stale-handle () + "Error: a handle whose MIME buffer was killed fails with a clear error. +The selection buffer captures handles when it opens; a real MIME handle's +car is the buffer holding the part's bytes, and viewing another message +kills it. Saving through it must signal a `user-error' naming the file, +not die in `mm-save-part-to-file' (or save another message's bytes)." + (let* ((dead (generate-new-buffer "stale-mime-part")) + (part (test-mu4e-attachments--part "invoice.pdf" 3 (list dead)))) + (kill-buffer dead) + (should-error (cj/mu4e--save-attachment-part part "/downloads") + :type 'user-error) + (condition-case err + (cj/mu4e--save-attachment-part part "/downloads") + (user-error (should (string-match-p "invoice\\.pdf" (cadr err))))))) + +(ert-deftest test-mu4e-attachments-save-part-live-buffer-handle-saves () + "Normal: a handle whose MIME buffer is alive saves normally." + (let* ((live (generate-new-buffer "live-mime-part")) + (part (test-mu4e-attachments--part "invoice.pdf" 3 (list live))) + (mu4e-uniquify-save-file-name-function #'identity) + saved) + (unwind-protect + (cl-letf (((symbol-function 'mu4e-join-paths) + (lambda (&rest pieces) (mapconcat #'identity pieces "/"))) + ((symbol-function 'mm-save-part-to-file) + (lambda (_handle path) (setq saved path)))) + (should (equal (cj/mu4e--save-attachment-part part "/downloads") + "/downloads/invoice.pdf")) + (should (equal saved "/downloads/invoice.pdf"))) + (kill-buffer live)))) + +(ert-deftest test-mu4e-attachments-save-parts-mid-batch-failure-propagates () + "Error: a mid-batch save failure propagates; earlier parts stay saved. +Characterizes the batch path: no silent skip of the failing part, and the +files already written are not rolled back." + (let ((parts (list (test-mu4e-attachments--part "a.pdf" 1) + (test-mu4e-attachments--part "b.pdf" 2) + (test-mu4e-attachments--part "c.pdf" 3))) + (saved '())) + (cl-letf (((symbol-function 'cj/mu4e--save-attachment-part) + (lambda (part _dir) + (let ((name (plist-get part :filename))) + (when (equal name "b.pdf") + (user-error "Stale handle: %s" name)) + (push name saved) + name)))) + (should-error (cj/mu4e--save-attachment-parts parts "/downloads") + :type 'user-error)) + (should (equal (nreverse saved) '("a.pdf"))))) + (ert-deftest test-mu4e-attachments-save-all-prompts-once () "Normal: the save-all command prompts for a directory once and saves all parts." (let ((parts (list (test-mu4e-attachments--part "a.pdf" 1) diff --git a/tests/test-music-config--art-cache-key.el b/tests/test-music-config--art-cache-key.el index 0ef82a21..bc869808 100644 --- a/tests/test-music-config--art-cache-key.el +++ b/tests/test-music-config--art-cache-key.el @@ -50,5 +50,20 @@ (should (string= (cj/music-art--cache-key track entries) (concat "url-" (sha1 url)))))) +(ert-deftest test-music-config--art-cache-key-normal-track-property () + "Normal: a queued lookup station carries its uuid as a track property and +needs no entries at all." + (let ((track (emms-track 'url "https://ck4.example.net/live"))) + (emms-track-set track 'radio-uuid "prop-uuid") + (should (string= (cj/music-art--cache-key track nil) "prop-uuid")))) + +(ert-deftest test-music-config--art-cache-key-normal-property-beats-entries () + "Normal: the track property wins over a conflicting entries uuid." + (let* ((url "https://ck5.example.net/live") + (track (emms-track 'url url)) + (entries (list (list url :name "X" :uuid "entries-uuid" :favicon nil)))) + (emms-track-set track 'radio-uuid "prop-uuid") + (should (string= (cj/music-art--cache-key track entries) "prop-uuid")))) + (provide 'test-music-config--art-cache-key) ;;; test-music-config--art-cache-key.el ends here diff --git a/tests/test-music-config--art-favicon-url.el b/tests/test-music-config--art-favicon-url.el index d9759ab3..9e7b92f8 100644 --- a/tests/test-music-config--art-favicon-url.el +++ b/tests/test-music-config--art-favicon-url.el @@ -48,5 +48,22 @@ (let ((track (emms-track 'file "/music/x.flac"))) (should (null (cj/music-art--favicon-url track nil))))) +(ert-deftest test-music-config--art-favicon-url-normal-track-property () + "Normal: a queued lookup station carries its favicon as a track property." + (let ((track (emms-track 'url "https://fp.example.net/live"))) + (emms-track-set track 'radio-favicon "https://fp.example.net/icon.png") + (should (string= (cj/music-art--favicon-url track nil) + "https://fp.example.net/icon.png")))) + +(ert-deftest test-music-config--art-favicon-url-normal-property-beats-entries () + "Normal: the track property wins over a conflicting entries favicon." + (let* ((url "https://fp2.example.net/live") + (track (emms-track 'url url)) + (entries (list (list url :name "X" :uuid nil + :favicon "https://entries.example/e.png")))) + (emms-track-set track 'radio-favicon "https://prop.example/p.png") + (should (string= (cj/music-art--favicon-url track entries) + "https://prop.example/p.png")))) + (provide 'test-music-config--art-favicon-url) ;;; test-music-config--art-favicon-url.el ends here diff --git a/tests/test-music-config--bar-string.el b/tests/test-music-config--bar-string.el new file mode 100644 index 00000000..bb6ac96f --- /dev/null +++ b/tests/test-music-config--bar-string.el @@ -0,0 +1,50 @@ +;;; test-music-config--bar-string.el --- Tests for the block progress bar -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for `cj/music--bar-string': render a WIDTH-cell block bar from a +;; filled-cell count (from `cj/music--bar-fill'), or an "on air" marker when the +;; fill is `indeterminate' (a live stream with no duration). Face-carrying +;; text; the tests assert the rendered length and content, not the faces. +;; +;;; Code: + +(require 'ert) + +(defvar-keymap cj/custom-keymap :doc "Stub keymap for testing") + +(let ((emms-dir (car (file-expand-wildcards + (expand-file-name "elpa/emms-*" user-emacs-directory))))) + (when emms-dir (add-to-list 'load-path emms-dir))) + +(require 'emms) +(require 'music-config) + +(ert-deftest test-music-config--bar-string-normal-half () + "Normal: 10 of 20 cells filled renders a 20-cell bar." + (let ((s (substring-no-properties (cj/music--bar-string 10 20)))) + (should (= (length s) 20)) + (should (= (cl-count ?█ s) 10)) + (should (= (cl-count ?░ s) 10)))) + +(ert-deftest test-music-config--bar-string-boundary-empty () + "Boundary: zero fill is all empty cells." + (let ((s (substring-no-properties (cj/music--bar-string 0 20)))) + (should (= (cl-count ?█ s) 0)) + (should (= (cl-count ?░ s) 20)))) + +(ert-deftest test-music-config--bar-string-boundary-full () + "Boundary: full fill is all filled cells." + (let ((s (substring-no-properties (cj/music--bar-string 20 20)))) + (should (= (cl-count ?█ s) 20)) + (should (= (cl-count ?░ s) 0)))) + +(ert-deftest test-music-config--bar-string-indeterminate-on-air () + "Error/indeterminate: a stream renders an on-air marker, not a bar." + (let ((s (substring-no-properties (cj/music--bar-string 'indeterminate 20)))) + (should (string-match-p "on air" s)) + (should (= (cl-count ?█ s) 0)))) + +(provide 'test-music-config--bar-string) +;;; test-music-config--bar-string.el ends here diff --git a/tests/test-music-config--m3u-text.el b/tests/test-music-config--m3u-text.el new file mode 100644 index 00000000..14c9f2bf --- /dev/null +++ b/tests/test-music-config--m3u-text.el @@ -0,0 +1,93 @@ +;;; test-music-config--m3u-text.el --- playlist .m3u emitter tests -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; The custom .m3u emitter behind playlist save. The stock EMMS m3u writer +;; emits bare URLs, which would throw away a station's name/uuid/favicon on +;; save; this emitter writes the same #EXTINF / #RADIOBROWSERUUID / +;; #RADIOBROWSERFAVICON lines the parser (`cj/music--m3u-entries') reads, so +;; save -> load round-trips a station's display name and cover-art metadata. +;; Metadata comes from track properties first, the m3u-scan entries as +;; fallback (a loaded legacy playlist has entries but no properties). + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module. +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(let ((emms-dir (car (file-expand-wildcards + (expand-file-name "elpa/emms-*" user-emacs-directory))))) + (when emms-dir (add-to-list 'load-path emms-dir))) + +(require 'emms) +(require 'music-config) + +(declare-function cj/music--m3u-text "music-config" (tracks entries)) +(declare-function cj/music-radio--station-track "music-config" (st)) + +(ert-deftest test-music-m3u-text-normal-file-track-bare-path () + "Normal: a file track is a bare absolute path under the #EXTM3U header." + (let ((text (cj/music--m3u-text (list (emms-track 'file "/music/a.flac")) nil))) + (should (string-prefix-p "#EXTM3U\n" text)) + (should (string-match-p "^/music/a\\.flac$" text)))) + +(ert-deftest test-music-m3u-text-normal-url-track-from-properties () + "Normal: a url track with properties emits uuid, favicon, EXTINF, and url." + (let* ((track (cj/music-radio--station-track + '(:name "Groove Salad" :url "https://ck.somafm.com/gs" + :stationuuid "uuid-1" :favicon "https://somafm.com/i.png"))) + (text (cj/music--m3u-text (list track) nil))) + (should (string-match-p "^#RADIOBROWSERUUID:uuid-1$" text)) + (should (string-match-p "^#RADIOBROWSERFAVICON:https://somafm\\.com/i\\.png$" text)) + (should (string-match-p "^#EXTINF:-1,Groove Salad$" text)) + (should (string-match-p "^https://ck\\.somafm\\.com/gs$" text)))) + +(ert-deftest test-music-m3u-text-normal-url-track-from-entries-fallback () + "Normal: a propertyless url track (a loaded legacy playlist) resolves its +metadata from the ENTRIES alist." + (let* ((url "https://legacy.example/stream") + (track (emms-track 'url url)) + (entries (list (list url :name "Legacy FM" :uuid "uuid-9" + :favicon "https://legacy.example/f.ico"))) + (text (cj/music--m3u-text (list track) entries))) + (should (string-match-p "^#RADIOBROWSERUUID:uuid-9$" text)) + (should (string-match-p "^#EXTINF:-1,Legacy FM$" text)))) + +(ert-deftest test-music-m3u-text-boundary-url-track-no-metadata () + "Boundary: a url track with neither properties nor entries still gets an +EXTINF label (the tidied host) and no uuid/favicon lines." + (let ((text (cj/music--m3u-text + (list (emms-track 'url "https://ice6.somafm.com/live")) nil))) + (should (string-match-p "^#EXTINF:-1,somafm\\.com$" text)) + (should-not (string-match-p "RADIOBROWSERUUID" text)) + (should-not (string-match-p "RADIOBROWSERFAVICON" text)))) + +(ert-deftest test-music-m3u-text-normal-mixed-order-preserved () + "Normal: a mixed queue keeps its track order in the file." + (let* ((f (emms-track 'file "/music/b.mp3")) + (u (cj/music-radio--station-track '(:name "S" :url "https://s.example/x"))) + (text (cj/music--m3u-text (list f u) nil))) + (should (< (string-match "^/music/b\\.mp3$" text) + (string-match "^https://s\\.example/x$" text))))) + +(ert-deftest test-music-m3u-text-round-trip-through-parser () + "Normal: the parser recovers name, uuid, and favicon from emitted text." + (let* ((track (cj/music-radio--station-track + '(:name "Round Trip" :url "https://rt.example/s" + :stationuuid "uuid-rt" :favicon "https://rt.example/f.png"))) + (entries (cj/music--m3u-entries (cj/music--m3u-text (list track) nil))) + (meta (cdr (assoc "https://rt.example/s" entries)))) + (should (equal (plist-get meta :name) "Round Trip")) + (should (equal (plist-get meta :uuid) "uuid-rt")) + (should (equal (plist-get meta :favicon) "https://rt.example/f.png")))) + +(ert-deftest test-music-m3u-text-boundary-empty-playlist-header-only () + "Boundary: an empty track list is just the #EXTM3U header." + (should (equal (cj/music--m3u-text nil nil) "#EXTM3U\n"))) + +(provide 'test-music-config--m3u-text) +;;; test-music-config--m3u-text.el ends here diff --git a/tests/test-music-config--playlist-dock.el b/tests/test-music-config--playlist-dock.el new file mode 100644 index 00000000..69d24cc3 --- /dev/null +++ b/tests/test-music-config--playlist-dock.el @@ -0,0 +1,74 @@ +;;; test-music-config--playlist-dock.el --- Tests for the F10 playlist dock -*- lexical-binding: t; -*- + +;;; Commentary: +;; The F10 playlist always docks at the bottom, whatever the frame's shape. +;; It used to pick `right' on a wide frame via `cj/preferred-dock-direction', +;; which produced an unwanted three-way split on a wide terminal. +;; +;; `cj/side-window-display' is the window-system boundary here, so it is the +;; thing stubbed (an ordinary defun -- safe to `cl-letf', unlike the frame-* +;; subrs). Stubbing it lets these tests assert what the toggle *asks for* +;; without needing a live frame under `--batch'. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'music-config) + +(defmacro test-music-dock--with-captured-side (captured &rest body) + "Run BODY with the playlist display path stubbed, recording its args in CAPTURED. +CAPTURED is set to a plist of :side, :size-var and :default-size." + (declare (indent 1)) + `(let ((buffer (generate-new-buffer " *test-playlist*"))) + (unwind-protect + (cl-letf (((symbol-function 'cj/emms--setup) (lambda (&rest _) nil)) + ((symbol-function 'cj/music--ensure-playlist-buffer) + (lambda (&rest _) buffer)) + ((symbol-function 'emms-playlist-mode-center-current) + (lambda (&rest _) nil)) + ((symbol-function 'cj/side-window-display) + (lambda (_buf side size-var default-size) + (setq ,captured (list :side side :size-var size-var + :default-size default-size)) + (selected-window)))) + ,@body) + (kill-buffer buffer)))) + +(ert-deftest test-music-config-playlist-toggle-docks-bottom-on-wide-frame () + "Normal: a wide frame still docks the playlist at the bottom. +A wide frame used to dock right, splitting the frame three ways." + (let (captured) + (test-music-dock--with-captured-side captured + (cl-letf (((symbol-function 'frame-width) (lambda (&rest _) 400))) + (cj/music-playlist-toggle))) + (should (eq 'bottom (plist-get captured :side))))) + +(ert-deftest test-music-config-playlist-toggle-docks-bottom-on-narrow-frame () + "Boundary: a narrow frame docks at the bottom, as it always did." + (let (captured) + (test-music-dock--with-captured-side captured + (cl-letf (((symbol-function 'frame-width) (lambda (&rest _) 40))) + (cj/music-playlist-toggle))) + (should (eq 'bottom (plist-get captured :side))))) + +(ert-deftest test-music-config-playlist-toggle-uses-height-memory () + "Normal: the bottom dock carries the height fraction and its memory var." + (let (captured) + (test-music-dock--with-captured-side captured + (cj/music-playlist-toggle)) + (should (eq 'cj/--music-playlist-height (plist-get captured :size-var))) + (should (= cj/music-playlist-window-height (plist-get captured :default-size))))) + +(ert-deftest test-music-config-playlist-dock-has-no-width-knobs () + "Error: the right-dock width variables are gone, not merely unused. +A stale `cj/music-playlist-window-width' would read as a live knob that +silently does nothing." + (should-not (boundp 'cj/music-playlist-window-width)) + (should-not (boundp 'cj/--music-playlist-width)) + (should-not (fboundp 'cj/--music-playlist-side))) + +(provide 'test-music-config--playlist-dock) +;;; test-music-config--playlist-dock.el ends here diff --git a/tests/test-music-config--playlist-side.el b/tests/test-music-config--playlist-side.el deleted file mode 100644 index f4969469..00000000 --- a/tests/test-music-config--playlist-side.el +++ /dev/null @@ -1,45 +0,0 @@ -;;; test-music-config--playlist-side.el --- Tests for the F10 dock-side helper -*- lexical-binding: t; -*- - -;;; Commentary: -;; `cj/--music-playlist-side' maps the shared dock rule's verdict to a -;; `display-buffer-in-side-window' side: `right' stays `right', anything -;; else becomes `bottom'. The decision itself lives in -;; `cj/preferred-dock-direction' (tested in test-cj-window-geometry-lib.el); -;; here we stub it (an ordinary defun -- safe to `cl-letf', unlike the -;; frame-* subrs) to prove the mapping and that the width fraction is -;; passed through. - -;;; Code: - -(require 'ert) -(require 'cl-lib) - -(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) -(require 'music-config) - -(ert-deftest test-music-config--playlist-side-right-verdict-is-right () - "Normal: a `right' verdict from the dock rule docks the playlist right." - (cl-letf (((symbol-function 'cj/preferred-dock-direction) - (lambda (&rest _) 'right))) - (should (eq (cj/--music-playlist-side) 'right)))) - -(ert-deftest test-music-config--playlist-side-below-verdict-is-bottom () - "Normal: a `below' verdict maps to the `bottom' side window." - (cl-letf (((symbol-function 'cj/preferred-dock-direction) - (lambda (&rest _) 'below))) - (should (eq (cj/--music-playlist-side) 'bottom)))) - -(ert-deftest test-music-config--playlist-side-passes-width-fraction () - "Normal: the playlist's width fraction reaches the dock rule." - (let ((cj/music-playlist-window-width 0.4) - captured) - (cl-letf (((symbol-function 'cj/preferred-dock-direction) - (lambda (cols frac &rest _) - (setq captured (list cols frac)) - 'below))) - (cj/--music-playlist-side) - (should (= (nth 1 captured) 0.4)) - (should (integerp (nth 0 captured)))))) - -(provide 'test-music-config--playlist-side) -;;; test-music-config--playlist-side.el ends here diff --git a/tests/test-music-config--radio-station-track.el b/tests/test-music-config--radio-station-track.el new file mode 100644 index 00000000..5816c776 --- /dev/null +++ b/tests/test-music-config--radio-station-track.el @@ -0,0 +1,135 @@ +;;; test-music-config--radio-station-track.el --- station->track + enqueue tests -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; The queue-first radio model: a picked station becomes an EMMS url track +;; carrying its metadata as track properties (info-title, radio-uuid, +;; radio-favicon) instead of being written to an .m3u. Covers the pure +;; station->track builder and the enqueue-and-play buffer mechanics (with +;; playback mocked at the EMMS boundary). + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +;; Stub dependencies before loading the module. +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(let ((emms-dir (car (file-expand-wildcards + (expand-file-name "elpa/emms-*" user-emacs-directory))))) + (when emms-dir (add-to-list 'load-path emms-dir))) + +(require 'emms) +(require 'music-config) + +(declare-function cj/music-radio--station-track "music-config" (st)) +(declare-function cj/music-radio--enqueue-and-play "music-config" (tracks)) + +;;; --------------------------- station-track ----------------------------------- + +(ert-deftest test-music-radio-station-track-normal () + "Normal: a full station plist yields a url track with all three properties." + (let ((track (cj/music-radio--station-track + '(:name "Adroit Jazz Underground" + :url_resolved "https://icecast.walmradio.com:8443/jazz" + :stationuuid "ea8059be-d119" + :favicon "https://walmradio.com/icon.png")))) + (should (eq (emms-track-type track) 'url)) + (should (equal (emms-track-name track) "https://icecast.walmradio.com:8443/jazz")) + (should (equal (emms-track-get track 'info-title) "Adroit Jazz Underground")) + (should (equal (emms-track-get track 'radio-uuid) "ea8059be-d119")) + (should (equal (emms-track-get track 'radio-favicon) "https://walmradio.com/icon.png")))) + +(ert-deftest test-music-radio-station-track-no-url-is-nil () + "Error: a station with no stream URL yields nil, not a broken track." + (should-not (cj/music-radio--station-track '(:name "No URL" :url_resolved "" :url "")))) + +(ert-deftest test-music-radio-station-track-boundary-no-name () + "Boundary: a nameless station falls back to \"Radio\" for its title." + (let ((track (cj/music-radio--station-track '(:url "https://s.example/live")))) + (should (equal (emms-track-get track 'info-title) "Radio")))) + +(ert-deftest test-music-radio-station-track-boundary-newline-name-stripped () + "Boundary: newlines in an external station name are flattened to spaces." + (let ((track (cj/music-radio--station-track + '(:name "Line\nBreak" :url "https://s.example/live")))) + (should (equal (emms-track-get track 'info-title) "Line Break")))) + +(ert-deftest test-music-radio-station-track-boundary-empty-uuid-favicon-absent () + "Boundary: empty-string uuid/favicon are treated as absent, not stored." + (let ((track (cj/music-radio--station-track + '(:name "X" :url "https://s.example/live" :stationuuid "" :favicon "")))) + (should-not (emms-track-get track 'radio-uuid)) + (should-not (emms-track-get track 'radio-favicon)))) + +;;; ------------------------- enqueue-and-play ---------------------------------- + +(defmacro test-music-radio--with-playlist (&rest body) + "Run BODY with a fresh, uniquely named playlist buffer and playback mocked." + `(let* ((cj/music-playlist-buffer-name + (generate-new-buffer-name "*test-radio-enqueue*")) + (emms-player-playing-p nil) + (started 0) (stopped 0)) + (unwind-protect + (cl-letf (((symbol-function 'emms-start) + (lambda () (setq started (1+ started)))) + ((symbol-function 'emms-stop) + (lambda () (setq stopped (1+ stopped))))) + ,@body) + (when (get-buffer cj/music-playlist-buffer-name) + (kill-buffer cj/music-playlist-buffer-name))))) + +(ert-deftest test-music-radio-enqueue-and-play-normal-appends-and-plays () + "Normal: tracks land in the playlist buffer in order; the first is selected +and playback starts." + (test-music-radio--with-playlist + (let ((t1 (cj/music-radio--station-track '(:name "One" :url "https://one.example/a"))) + (t2 (cj/music-radio--station-track '(:name "Two" :url "https://two.example/b")))) + (cj/music-radio--enqueue-and-play (list t1 t2)) + (with-current-buffer cj/music-playlist-buffer-name + (let ((names '())) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when-let ((tr (emms-playlist-track-at (point)))) + (push (emms-track-name tr) names)) + (forward-line 1))) + (should (equal (nreverse names) + '("https://one.example/a" "https://two.example/b")))) + (should (equal (emms-track-name (emms-playlist-selected-track)) + "https://one.example/a"))) + (should (= started 1))))) + +(ert-deftest test-music-radio-enqueue-and-play-boundary-appends-after-existing () + "Boundary: an existing queue is kept; new tracks append and the first NEW +track is the one selected." + (test-music-radio--with-playlist + (let ((old (cj/music-radio--station-track '(:name "Old" :url "https://old.example/x"))) + (new (cj/music-radio--station-track '(:name "New" :url "https://new.example/y")))) + (cj/music-radio--enqueue-and-play (list old)) + (cj/music-radio--enqueue-and-play (list new)) + (with-current-buffer cj/music-playlist-buffer-name + (should (equal (emms-track-name (emms-playlist-selected-track)) + "https://new.example/y")))))) + +(ert-deftest test-music-radio-enqueue-and-play-interrupts-current-playback () + "Normal: when something is playing, enqueue stops it before starting." + (test-music-radio--with-playlist + (let ((emms-player-playing-p t) + (tr (cj/music-radio--station-track '(:name "Z" :url "https://z.example/s")))) + (cj/music-radio--enqueue-and-play (list tr)) + (should (= stopped 1)) + (should (= started 1))))) + +(ert-deftest test-music-radio-enqueue-and-play-boundary-nil-is-no-op () + "Boundary: an empty track list does nothing — no buffer churn, no playback." + (test-music-radio--with-playlist + (cj/music-radio--enqueue-and-play nil) + (should (= started 0)) + (should (= stopped 0)))) + +(provide 'test-music-config--radio-station-track) +;;; test-music-config--radio-station-track.el ends here diff --git a/tests/test-music-config--radio.el b/tests/test-music-config--radio.el index 56a9c2dc..3923a599 100644 --- a/tests/test-music-config--radio.el +++ b/tests/test-music-config--radio.el @@ -3,11 +3,12 @@ ;; Author: Craig Jennings <c@cjennings.net> ;; ;;; Commentary: -;; Phase 1 of the radio-browser lookup (spec docs/specs/2026-07-06-radio-browser-lookup-spec.org): -;; the pure pieces behind the search command. Parsing a recorded JSON response, -;; picking a station's stream URL, emitting the .m3u, formatting the marginalia -;; annotation (Variant B: codec/bitrate/country/votes/tags), disambiguating a -;; colliding filename, and building the search URL. The network GET and the +;; The pure pieces behind the radio-browser search command (spec +;; docs/specs/2026-07-06-radio-browser-lookup-spec.org): parsing a recorded +;; JSON response, picking a station's stream URL, formatting the marginalia +;; annotation (Variant B: codec/bitrate/country/votes/tags), and building the +;; search URL. The station->track builder and the queue mechanics live in +;; test-music-config--radio-station-track.el; the network GET and the ;; interactive command are exercised in the daemon, not here. ;;; Code: @@ -22,10 +23,8 @@ (declare-function cj/music-radio--parse-search "music-config" (json-text)) (declare-function cj/music-radio--station-url "music-config" (st)) -(declare-function cj/music-radio--station-m3u "music-config" (st)) (declare-function cj/music-radio--tags-snippet "music-config" (tags n)) (declare-function cj/music-radio--format-candidate "music-config" (st)) -(declare-function cj/music-radio--disambiguate-name "music-config" (name uuid taken)) (declare-function cj/music-radio--search-url "music-config" (server query)) (defconst test-music-radio--fixture @@ -62,49 +61,20 @@ ;;; --------------------------- station-url ------------------------------------ (ert-deftest test-music-radio-station-url-resolved () - "Normal: url_resolved is preferred." + "Normal: url_resolved wins when present." (should (equal (cj/music-radio--station-url (test-music-radio--first)) "https://icecast.walmradio.com:8443/jazz"))) (ert-deftest test-music-radio-station-url-fallback-to-url () - "Boundary: empty url_resolved falls back to url." + "Boundary: an empty url_resolved falls back to url." (should (equal (cj/music-radio--station-url - '(:url_resolved "" :url "http://example.test/stream")) - "http://example.test/stream"))) + '(:url_resolved "" :url "http://fallback.test/stream")) + "http://fallback.test/stream"))) (ert-deftest test-music-radio-station-url-none () "Error: neither url_resolved nor url yields nil." (should-not (cj/music-radio--station-url '(:url_resolved "" :url "")))) -;;; --------------------------- station-m3u ------------------------------------ - -(ert-deftest test-music-radio-station-m3u-shape () - "Normal: the .m3u carries #EXTM3U, the UUID, #EXTINF, and the stream URL." - (let ((m3u (cj/music-radio--station-m3u (test-music-radio--first)))) - (should (string-prefix-p "#EXTM3U\n" m3u)) - (should (string-match-p "#RADIOBROWSERUUID:ea8059be-d119-4de3-b27b-0d9bd6aedb17" m3u)) - (should (string-match-p "#EXTINF:1,Adroit Jazz Underground" m3u)) - (should (string-match-p "https://icecast.walmradio.com:8443/jazz" m3u)))) - -(ert-deftest test-music-radio-station-m3u-no-url-is-nil () - "Error: a station with no usable stream URL emits nil (not a broken file)." - (should-not (cj/music-radio--station-m3u '(:name "Broken" :url_resolved "" :url "")))) - -(ert-deftest test-music-radio-station-m3u-captures-favicon () - "Normal: a station with a favicon writes a #RADIOBROWSERFAVICON line so the -cover-art layer needs no lookup later." - (let ((m3u (cj/music-radio--station-m3u - '(:name "Art Radio" :url_resolved "https://art.example/live" - :stationuuid "u-art" :favicon "https://cdn.example/art.png")))) - (should (string-match-p "#RADIOBROWSERFAVICON:https://cdn.example/art.png" m3u)))) - -(ert-deftest test-music-radio-station-m3u-no-favicon-omits-line () - "Boundary: a station with an empty favicon writes no #RADIOBROWSERFAVICON line." - (let ((m3u (cj/music-radio--station-m3u - '(:name "Plain" :url_resolved "https://plain.example/live" - :stationuuid "u-plain" :favicon "")))) - (should-not (string-match-p "#RADIOBROWSERFAVICON" m3u)))) - ;;; --------------------------- tags-snippet ----------------------------------- (ert-deftest test-music-radio-tags-snippet-takes-first-n () @@ -126,21 +96,6 @@ cover-art layer needs no lookup later." (should (string-match-p "174208" ann)) (should (string-match-p "bebop" ann)))) -;;; --------------------------- disambiguate-name ------------------------------ - -(ert-deftest test-music-radio-disambiguate-name-unique () - "Normal: a name not already taken keeps its safe basename." - (should (equal (cj/music-radio--disambiguate-name "Jazz Radio" "uuid1234" '()) - "Jazz_Radio"))) - -(ert-deftest test-music-radio-disambiguate-name-collision () - "Boundary: a colliding name gets a UUID fragment appended, making it unique." - (let ((first (cj/music-radio--disambiguate-name "Jazz Radio" "aaaabbbbcccc" '()))) - (should (equal first "Jazz_Radio")) - (should-not (equal (cj/music-radio--disambiguate-name "Jazz Radio" "aaaabbbbcccc" - (list first)) - first)))) - ;;; --------------------------- search-url ------------------------------------- (ert-deftest test-music-radio-search-url-encodes-query-and-limit () @@ -158,7 +113,6 @@ cover-art layer needs no lookup later." (should-not (string-match-p "name=ambient" u)))) (declare-function cj/music-radio--candidates "music-config" (stations)) -(declare-function cj/music-radio--write-stations "music-config" (stations dir)) ;;; --------------------------- candidates (dedup) ----------------------------- @@ -180,41 +134,5 @@ cover-art layer needs no lookup later." (should (= (length cands) 2)) (should (= (length (delete-dups (copy-sequence keys))) 2)))) -;;; --------------------------- write-stations --------------------------------- - -(ert-deftest test-music-radio-write-stations-writes-and-skips () - "Normal + Error: a station with a URL is written; one with no URL is skipped and named." - (let ((dir (make-temp-file "radio-write-" t))) - (unwind-protect - (let* ((stations (list (test-music-radio--first) - '(:name "No URL Here" :url_resolved "" :url ""))) - (result (cj/music-radio--write-stations stations dir))) - (should (= (length (plist-get result :written)) 1)) - (should (member "No URL Here" (plist-get result :skipped))) - (should (file-exists-p (car (plist-get result :written))))) - (delete-directory dir t)))) - -(ert-deftest test-music-radio-write-stations-radio-suffix () - "Normal: a written filename carries the -Radio suffix before .m3u." - (let ((dir (make-temp-file "radio-write-" t))) - (unwind-protect - (let* ((result (cj/music-radio--write-stations (list (test-music-radio--first)) dir)) - (path (car (plist-get result :written)))) - (should (string-suffix-p "-Radio.m3u" path)) - (should (string-match-p "Adroit_Jazz_Underground-Radio\\.m3u\\'" path))) - (delete-directory dir t)))) - -(ert-deftest test-music-radio-write-stations-collision-writes-two-files () - "Boundary: two same-named stations in one run write two distinct files, no overwrite." - (let ((dir (make-temp-file "radio-write-" t))) - (unwind-protect - (let* ((stations '((:name "Same Name" :url_resolved "http://a.test/s" :stationuuid "aaaa1111") - (:name "Same Name" :url_resolved "http://b.test/s" :stationuuid "bbbb2222"))) - (result (cj/music-radio--write-stations stations dir)) - (written (plist-get result :written))) - (should (= (length written) 2)) - (should-not (equal (nth 0 written) (nth 1 written)))) - (delete-directory dir t)))) - (provide 'test-music-config--radio) ;;; test-music-config--radio.el ends here diff --git a/tests/test-music-config--safe-filename.el b/tests/test-music-config--safe-filename.el deleted file mode 100644 index 8105ee15..00000000 --- a/tests/test-music-config--safe-filename.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; test-music-config--safe-filename.el --- Tests for filename sanitization -*- coding: utf-8; lexical-binding: t; -*- -;; -;; Author: Craig Jennings <c@cjennings.net> -;; -;;; Commentary: -;; Unit tests for cj/music--safe-filename function. -;; Tests the pure helper that sanitizes filenames by replacing invalid chars. -;; -;; Test organization: -;; - Normal Cases: Valid filenames unchanged, spaces replaced -;; - Boundary Cases: Special chars, unicode, slashes, consecutive invalid chars -;; - Error Cases: Nil input -;; -;;; Code: - -(require 'ert) - -;; Stub missing dependencies before loading music-config -(defvar-keymap cj/custom-keymap - :doc "Stub keymap for testing") - -;; Load production code -(require 'music-config) - -;;; Normal Cases - -(ert-deftest test-music-config--safe-filename-normal-alphanumeric-unchanged () - "Validate alphanumeric filename remains unchanged." - (should (string= (cj/music--safe-filename "MyPlaylist123") - "MyPlaylist123"))) - -(ert-deftest test-music-config--safe-filename-normal-with-hyphens-unchanged () - "Validate filename with hyphens remains unchanged." - (should (string= (cj/music--safe-filename "my-playlist-name") - "my-playlist-name"))) - -(ert-deftest test-music-config--safe-filename-normal-with-underscores-unchanged () - "Validate filename with underscores remains unchanged." - (should (string= (cj/music--safe-filename "my_playlist_name") - "my_playlist_name"))) - -(ert-deftest test-music-config--safe-filename-normal-spaces-replaced () - "Validate spaces are replaced with underscores." - (should (string= (cj/music--safe-filename "My Favorite Songs") - "My_Favorite_Songs"))) - -;;; Boundary Cases - -(ert-deftest test-music-config--safe-filename-boundary-special-chars-replaced () - "Validate special characters are replaced with underscores." - (should (string= (cj/music--safe-filename "playlist@#$%^&*()") - "playlist_________"))) - -(ert-deftest test-music-config--safe-filename-boundary-unicode-replaced () - "Validate unicode characters are replaced with underscores." - (should (string= (cj/music--safe-filename "中文歌曲") - "____"))) - -(ert-deftest test-music-config--safe-filename-boundary-mixed-valid-invalid () - "Validate mixed valid and invalid characters." - (should (string= (cj/music--safe-filename "Rock & Roll") - "Rock___Roll"))) - -(ert-deftest test-music-config--safe-filename-boundary-dots-replaced () - "Validate dots are replaced with underscores." - (should (string= (cj/music--safe-filename "my.playlist.name") - "my_playlist_name"))) - -(ert-deftest test-music-config--safe-filename-boundary-slashes-replaced () - "Validate slashes are replaced with underscores." - (should (string= (cj/music--safe-filename "folder/file") - "folder_file"))) - -(ert-deftest test-music-config--safe-filename-boundary-consecutive-invalid-chars () - "Validate consecutive invalid characters each become underscores." - (should (string= (cj/music--safe-filename "test!!!name") - "test___name"))) - -(ert-deftest test-music-config--safe-filename-boundary-empty-string-unchanged () - "Validate empty string remains unchanged." - (should (string= (cj/music--safe-filename "") - ""))) - -(ert-deftest test-music-config--safe-filename-boundary-only-invalid-chars () - "Validate string with only invalid characters becomes all underscores." - (should (string= (cj/music--safe-filename "!@#$%") - "_____"))) - -;;; Error Cases - -(ert-deftest test-music-config--safe-filename-error-nil-input-signals-error () - "Validate nil input signals error." - (should-error (cj/music--safe-filename nil) - :type 'wrong-type-argument)) - -(provide 'test-music-config--safe-filename) -;;; test-music-config--safe-filename.el ends here diff --git a/tests/test-music-config--save-helpers.el b/tests/test-music-config--save-helpers.el new file mode 100644 index 00000000..ffb0a477 --- /dev/null +++ b/tests/test-music-config--save-helpers.el @@ -0,0 +1,90 @@ +;;; test-music-config--save-helpers.el --- save default-name + directory tests -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; The pure helpers behind the queue-first save flow: which name the save +;; prompt pre-fills (`cj/music--save-default-name') and which directory the +;; file lands in (`cj/music--save-directory'). An all-stream queue saves into +;; the radio playlist home (`cj/music-radio-save-dir'); anything else saves +;; into `cj/music-m3u-root'. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module. +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(let ((emms-dir (car (file-expand-wildcards + (expand-file-name "elpa/emms-*" user-emacs-directory))))) + (when emms-dir (add-to-list 'load-path emms-dir))) + +(require 'emms) +(require 'music-config) + +(declare-function cj/music--save-default-name "music-config" (tracks file entries)) +(declare-function cj/music--save-directory "music-config" (tracks)) +(declare-function cj/music-radio--station-track "music-config" (st)) + +;;; --------------------------- save-default-name ------------------------------- + +(ert-deftest test-music-save-default-name-normal-associated-file-wins () + "Normal: an associated playlist file names the save, station or not." + (let ((tr (cj/music-radio--station-track '(:name "S" :url "https://s.example/x")))) + (should (equal (cj/music--save-default-name (list tr) "/pl/jazz.m3u" nil) + "jazz")))) + +(ert-deftest test-music-save-default-name-normal-station-title () + "Normal: with no file, the first url track's station name pre-fills." + (let ((tr (cj/music-radio--station-track + '(:name "Groove Salad" :url "https://gs.example/x")))) + (should (equal (cj/music--save-default-name (list tr) nil nil) + "Groove Salad")))) + +(ert-deftest test-music-save-default-name-normal-first-url-track-wins () + "Normal: a file track ahead of the station doesn't block the station name; +the first URL track with a name wins." + (let ((f (emms-track 'file "/music/a.flac")) + (tr (cj/music-radio--station-track + '(:name "Second Pick" :url "https://sp.example/x")))) + (should (equal (cj/music--save-default-name (list f tr) nil nil) + "Second Pick")))) + +(ert-deftest test-music-save-default-name-normal-entries-fallback () + "Normal: a propertyless url track resolves its name from ENTRIES." + (let* ((url "https://legacy.example/s") + (tr (emms-track 'url url)) + (entries (list (list url :name "Legacy FM" :uuid nil :favicon nil)))) + (should (equal (cj/music--save-default-name (list tr) nil entries) + "Legacy FM")))) + +(ert-deftest test-music-save-default-name-boundary-no-candidates-nil () + "Boundary: no file, no url tracks -> nil (caller falls back to a timestamp)." + (should-not (cj/music--save-default-name + (list (emms-track 'file "/music/a.flac")) nil nil)) + (should-not (cj/music--save-default-name nil nil nil))) + +;;; ---------------------------- save-directory --------------------------------- + +(ert-deftest test-music-save-directory-normal-all-streams-radio-dir () + "Normal: an all-stream queue saves into the radio playlist dir." + (let ((u1 (emms-track 'url "https://a.example/1")) + (u2 (emms-track 'url "https://b.example/2"))) + (should (equal (cj/music--save-directory (list u1 u2)) + cj/music-radio-save-dir)))) + +(ert-deftest test-music-save-directory-normal-mixed-goes-to-m3u-root () + "Normal: any non-stream track routes the save to the music playlist root." + (let ((u (emms-track 'url "https://a.example/1")) + (f (emms-track 'file "/music/a.flac"))) + (should (equal (cj/music--save-directory (list u f)) + cj/music-m3u-root)))) + +(ert-deftest test-music-save-directory-boundary-empty-goes-to-m3u-root () + "Boundary: an empty queue defaults to the music playlist root." + (should (equal (cj/music--save-directory nil) cj/music-m3u-root))) + +(provide 'test-music-config--save-helpers) +;;; test-music-config--save-helpers.el ends here diff --git a/tests/test-music-config-create-radio-station.el b/tests/test-music-config-create-radio-station.el index 1f4365a4..7d9adbed 100644 --- a/tests/test-music-config-create-radio-station.el +++ b/tests/test-music-config-create-radio-station.el @@ -1,153 +1,130 @@ -;;; test-music-config-create-radio-station.el --- Tests for radio station creation -*- coding: utf-8; lexical-binding: t; -*- +;;; test-music-config-create-radio-station.el --- Tests for manual radio-station entry -*- coding: utf-8; lexical-binding: t; -*- ;; ;; Author: Craig Jennings <c@cjennings.net> ;; ;;; Commentary: -;; Unit tests for cj/music-create-radio-station function. -;; Tests M3U file creation for radio stations with stream URLs. +;; Unit tests for cj/music-create-radio-station under the queue-first model: +;; a hand-entered name + URL becomes a url track in the playlist queue (with +;; the name as its title property) and playback starts. Nothing is written +;; to disk — saving is the normal playlist-save flow. ;; ;; Test organization: -;; - Normal Cases: Standard creation, EXTM3U format, safe filename -;; - Boundary Cases: Unicode name, complex URL, overwrite confirmed -;; - Error Cases: Empty name, empty URL, overwrite declined -;; +;; - Normal Cases: track queued with title, playback started, no file written +;; - Boundary Cases: unicode name preserved verbatim +;; - Error Cases: empty name, empty URL + ;;; Code: (require 'ert) -(require 'testutil-general) +(require 'cl-lib) ;; Stub missing dependencies before loading music-config (defvar-keymap cj/custom-keymap :doc "Stub keymap for testing") -;; Load production code -(require 'music-config) - -;;; Setup & Teardown +(let ((emms-dir (car (file-expand-wildcards + (expand-file-name "elpa/emms-*" user-emacs-directory))))) + (when emms-dir (add-to-list 'load-path emms-dir))) -(defun test-music-config-create-radio-station-setup () - "Setup test environment with temp directory for M3U output." - (cj/create-test-base-dir) - (cj/create-test-subdirectory "radio-playlists")) +(require 'emms) +(require 'music-config) -(defun test-music-config-create-radio-station-teardown () - "Clean up test environment." - (cj/delete-test-base-dir)) +(defmacro test-music-create-radio--with-env (&rest body) + "Run BODY with a fresh playlist buffer, playback mocked, messages captured." + `(let* ((cj/music-playlist-buffer-name + (generate-new-buffer-name "*test-create-radio*")) + (emms-player-playing-p nil) + (started 0) (msg nil)) + (ignore started msg) + (unwind-protect + (cl-letf (((symbol-function 'emms-start) + (lambda () (setq started (1+ started)))) + ((symbol-function 'emms-stop) #'ignore) + ((symbol-function 'message) + (lambda (fmt &rest args) + (when fmt (setq msg (apply #'format fmt args)))))) + ,@body) + (when (get-buffer cj/music-playlist-buffer-name) + (kill-buffer cj/music-playlist-buffer-name))))) + +(defun test-music-create-radio--queued-tracks () + "Track objects currently in the test playlist buffer." + (let ((tracks '())) + (with-current-buffer cj/music-playlist-buffer-name + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when-let ((tr (emms-playlist-track-at (point)))) + (push tr tracks)) + (forward-line 1)))) + (nreverse tracks))) ;;; Normal Cases -(ert-deftest test-music-config-create-radio-station-normal-creates-m3u-file () - "Creating a radio station produces an M3U file in the music root." - (let ((test-dir (test-music-config-create-radio-station-setup))) - (unwind-protect - (let ((cj/music-m3u-root test-dir)) - (cj/music-create-radio-station "Jazz FM" "http://stream.jazzfm.com/radio") - (let ((expected-file (expand-file-name "Jazz_FM_Radio.m3u" test-dir))) - (should (file-exists-p expected-file)))) - (test-music-config-create-radio-station-teardown)))) - -(ert-deftest test-music-config-create-radio-station-normal-extm3u-format () - "Created file contains EXTM3U header, EXTINF with station name, and URL." - (let ((test-dir (test-music-config-create-radio-station-setup))) +(ert-deftest test-music-config-create-radio-station-normal-queues-track () + "Normal: name+url queues a url track carrying the name, and playback starts." + (test-music-create-radio--with-env + (cj/music-create-radio-station "Jazz FM" "http://stream.jazzfm.com/radio") + (let ((tracks (test-music-create-radio--queued-tracks))) + (should (= (length tracks) 1)) + (should (eq (emms-track-type (car tracks)) 'url)) + (should (equal (emms-track-name (car tracks)) "http://stream.jazzfm.com/radio")) + (should (equal (emms-track-get (car tracks) 'info-title) "Jazz FM"))) + (should (= started 1)) + (should (string-match-p "Jazz FM" msg)))) + +(ert-deftest test-music-config-create-radio-station-normal-writes-no-file () + "Normal: nothing lands on disk — saving is the playlist-save flow's job." + (let ((tmp (file-name-as-directory (make-temp-file "cj-radio-nofile-" t)))) (unwind-protect - (let ((cj/music-m3u-root test-dir)) - (cj/music-create-radio-station "Jazz FM" "http://stream.jazzfm.com/radio") - (let ((content (with-temp-buffer - (insert-file-contents - (expand-file-name "Jazz_FM_Radio.m3u" test-dir)) - (buffer-string)))) - (should (string-match-p "^#EXTM3U" content)) - (should (string-match-p "#EXTINF:-1,Jazz FM" content)) - (should (string-match-p "http://stream.jazzfm.com/radio" content)))) - (test-music-config-create-radio-station-teardown)))) - -(ert-deftest test-music-config-create-radio-station-normal-safe-filename () - "Station name with special characters produces filesystem-safe filename." - (let ((test-dir (test-music-config-create-radio-station-setup))) - (unwind-protect - (let ((cj/music-m3u-root test-dir)) - (cj/music-create-radio-station "Rock & Roll 101.5" "http://example.com/stream") - ;; Spaces and special chars replaced with underscores - (let ((expected-file (expand-file-name "Rock___Roll_101_5_Radio.m3u" test-dir))) - (should (file-exists-p expected-file)))) - (test-music-config-create-radio-station-teardown)))) + (test-music-create-radio--with-env + (let ((cj/music-m3u-root tmp) + (cj/music-radio-save-dir tmp)) + (cj/music-create-radio-station "NPR" "https://example.test/stream") + (should-not (directory-files tmp nil "\\.m3u\\'")))) + (delete-directory tmp t)))) ;;; Boundary Cases -(ert-deftest test-music-config-create-radio-station-boundary-unicode-name-safe-filename () - "Unicode station name produces safe filename while preserving name in EXTINF." - (let ((test-dir (test-music-config-create-radio-station-setup))) - (unwind-protect - (let ((cj/music-m3u-root test-dir)) - (cj/music-create-radio-station "Klassik Radio" "http://example.com/stream") - ;; Name is all ASCII-safe, so filename uses it directly - (should (file-exists-p (expand-file-name "Klassik_Radio_Radio.m3u" test-dir))) - ;; Original name preserved in EXTINF inside the file - (let ((content (with-temp-buffer - (insert-file-contents - (expand-file-name "Klassik_Radio_Radio.m3u" test-dir)) - (buffer-string)))) - (should (string-match-p "Klassik Radio" content)))) - (test-music-config-create-radio-station-teardown)))) - -(ert-deftest test-music-config-create-radio-station-boundary-url-with-query-params () - "Complex URL with query parameters preserved in file content." - (let ((test-dir (test-music-config-create-radio-station-setup))) - (unwind-protect - (let ((cj/music-m3u-root test-dir) - (url "https://stream.example.com/radio?format=mp3&quality=320&token=abc123")) - (cj/music-create-radio-station "Test Radio" url) - (let ((content (with-temp-buffer - (insert-file-contents - (expand-file-name "Test_Radio_Radio.m3u" test-dir)) - (buffer-string)))) - (should (string-match-p (regexp-quote url) content)))) - (test-music-config-create-radio-station-teardown)))) - -(ert-deftest test-music-config-create-radio-station-boundary-overwrite-confirmed () - "Overwriting existing file when user confirms succeeds." - (let ((test-dir (test-music-config-create-radio-station-setup))) - (unwind-protect - (let ((cj/music-m3u-root test-dir)) - ;; Create initial file - (cj/music-create-radio-station "MyRadio" "http://old.url/stream") - (let ((file (expand-file-name "MyRadio_Radio.m3u" test-dir))) - (should (file-exists-p file)) - ;; Overwrite with user confirming - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) - (cj/music-create-radio-station "MyRadio" "http://new.url/stream")) - ;; File should now contain new URL - (let ((content (with-temp-buffer - (insert-file-contents file) - (buffer-string)))) - (should (string-match-p "http://new.url/stream" content)) - (should-not (string-match-p "http://old.url/stream" content))))) - (test-music-config-create-radio-station-teardown)))) +(ert-deftest test-music-config-create-radio-station-boundary-unicode-name () + "Boundary: a unicode name is kept verbatim on the track (no filename munging)." + (test-music-create-radio--with-env + (cj/music-create-radio-station "Café Del Mar ☕" "https://cafe.example/stream") + (should (equal (emms-track-get (car (test-music-create-radio--queued-tracks)) + 'info-title) + "Café Del Mar ☕")))) + +;;; Keymap + +(ert-deftest test-music-config-radio-map-prefix-mirrors-playlist-keys () + "Normal: C-; m r is a radio prefix whose n/t/m mirror the playlist buffer." + (let ((map (lookup-key cj/music-map "r"))) + (should (keymapp map)) + (should (eq (lookup-key map "n") 'cj/music-radio-search-by-name)) + (should (eq (lookup-key map "t") 'cj/music-radio-search-by-tag)) + (should (eq (lookup-key map "m") 'cj/music-create-radio-station)))) + +(ert-deftest test-music-config-menu-map-lowercase-keys () + "Normal: the menu's former uppercase keys live on lowercase homes, and the +playlist buffer saves on v." + (should (eq (lookup-key cj/music-map "v") 'cj/music-playlist-show)) + (should (eq (lookup-key cj/music-map "u") 'emms-shuffle)) + (should (eq (lookup-key cj/music-map "l") 'emms-toggle-repeat-playlist)) + (should-not (lookup-key cj/music-map "R")) + (should-not (lookup-key cj/music-map "M")) + (should-not (lookup-key cj/music-map "Z")) + (should (eq (lookup-key emms-playlist-mode-map "v") 'cj/music-playlist-save)) + (should-not (eq (lookup-key emms-playlist-mode-map "w") 'cj/music-playlist-save))) ;;; Error Cases (ert-deftest test-music-config-create-radio-station-error-empty-name-signals-user-error () - "Empty station name signals user-error." - (should-error (cj/music-create-radio-station "" "http://example.com/stream") - :type 'user-error)) + "Error: empty name signals user-error." + (should-error (cj/music-create-radio-station "" "https://x") :type 'user-error)) (ert-deftest test-music-config-create-radio-station-error-empty-url-signals-user-error () - "Empty URL signals user-error." - (should-error (cj/music-create-radio-station "Test Radio" "") - :type 'user-error)) - -(ert-deftest test-music-config-create-radio-station-error-overwrite-declined-signals-user-error () - "Declining overwrite signals user-error." - (let ((test-dir (test-music-config-create-radio-station-setup))) - (unwind-protect - (let ((cj/music-m3u-root test-dir)) - ;; Create initial file - (cj/music-create-radio-station "MyRadio" "http://old.url/stream") - ;; Decline overwrite - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) nil))) - (should-error (cj/music-create-radio-station "MyRadio" "http://new.url/stream") - :type 'user-error))) - (test-music-config-create-radio-station-teardown)))) + "Error: empty URL signals user-error." + (should-error (cj/music-create-radio-station "NPR" "") :type 'user-error)) (provide 'test-music-config-create-radio-station) ;;; test-music-config-create-radio-station.el ends here diff --git a/tests/test-music-config-more-commands.el b/tests/test-music-config-more-commands.el index c351c1f1..530aa379 100644 --- a/tests/test-music-config-more-commands.el +++ b/tests/test-music-config-more-commands.el @@ -9,7 +9,9 @@ ;; cj/music-playlist-edit ;; cj/music-playlist-toggle ;; cj/music-playlist-show -;; cj/music-create-radio-station +;; +;; cj/music-create-radio-station lives in +;; test-music-config-create-radio-station.el. ;;; Code: @@ -17,12 +19,21 @@ (require 'cl-lib) (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module. +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(let ((emms-dir (car (file-expand-wildcards + (expand-file-name "elpa/emms-*" user-emacs-directory))))) + (when emms-dir (add-to-list 'load-path emms-dir))) + +(require 'emms) (require 'music-config) ;; Top-level defvars so let-binds reach the dynamic var under lexical ;; scope. (defvar cj/music-playlist-file nil) -(defvar emms-source-playlist-ask-before-overwrite t) ;;; cj/music-playlist-load @@ -56,28 +67,87 @@ ;;; cj/music-playlist-save -(ert-deftest test-music-playlist-save-writes-fresh-name () - "Normal: save with a fresh name writes via emms-playlist-save." - (let* ((tmp (file-name-as-directory (make-temp-file "cj-music-save-" t))) - (cj/music-m3u-root tmp) - saved-args msg) - (unwind-protect - (cl-letf (((symbol-function 'cj/music--get-m3u-basenames) - (lambda () nil)) - ((symbol-function 'completing-read) - (lambda (&rest _) "fresh")) - ((symbol-function 'cj/music--ensure-playlist-buffer) - (lambda () (current-buffer))) - ((symbol-function 'emms-playlist-save) - (lambda (fmt path) (setq saved-args (list fmt path)))) - ((symbol-function 'cj/music--sync-playlist-file) #'ignore) - ((symbol-function 'message) - (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) - (cj/music-playlist-save)) - (delete-directory tmp t)) - (should (equal (car saved-args) 'm3u)) - (should (string-match-p "fresh\\.m3u\\'" (cadr saved-args))) - (should (string-match-p "Saved playlist" msg)))) +(defmacro test-music-save--with-env (&rest body) + "Run BODY with a fresh playlist buffer and temp save directories. +Binds TMP-M3U and TMP-RADIO (both cleaned up) and captures completing-read's +INITIAL argument in CR-INITIAL." + `(let* ((cj/music-playlist-buffer-name + (generate-new-buffer-name "*test-save*")) + (tmp-m3u (file-name-as-directory (make-temp-file "cj-save-m3u-" t))) + (tmp-radio (file-name-as-directory (make-temp-file "cj-save-radio-" t))) + (cj/music-m3u-root tmp-m3u) + (cj/music-radio-save-dir tmp-radio) + (cr-initial 'unset)) + (ignore cr-initial) + (unwind-protect + (cl-letf (((symbol-function 'message) #'ignore) + ((symbol-function 'completing-read) + (lambda (_prompt _coll &optional _pred _req initial _hist def &rest _) + (setq cr-initial initial) + (or initial def "fallback")))) + ,@body) + (when (get-buffer cj/music-playlist-buffer-name) + (kill-buffer cj/music-playlist-buffer-name)) + (delete-directory tmp-m3u t) + (delete-directory tmp-radio t)))) + +(defun test-music-save--queue (tracks) + "Put TRACKS into the (fresh) test playlist buffer." + (with-current-buffer (cj/music--ensure-playlist-buffer) + (save-excursion + (goto-char (point-max)) + (dolist (tr tracks) + (emms-playlist-insert-track tr))))) + +(ert-deftest test-music-playlist-save-station-queue-prefills-and-targets-radio-dir () + "Normal: an all-stream queue pre-fills the station name and saves into the +radio dir with the station metadata written." + (test-music-save--with-env + (let ((tr (emms-track 'url "https://gs.example/stream"))) + (emms-track-set tr 'info-title "Groove Salad") + (emms-track-set tr 'radio-uuid "uuid-gs") + (test-music-save--queue (list tr))) + (cj/music-playlist-save) + (should (equal cr-initial "Groove Salad")) + (let ((file (expand-file-name "Groove Salad.m3u" tmp-radio))) + (should (file-exists-p file)) + (with-temp-buffer + (insert-file-contents file) + (let ((text (buffer-string))) + (should (string-match-p "^#EXTINF:-1,Groove Salad$" text)) + (should (string-match-p "^#RADIOBROWSERUUID:uuid-gs$" text)) + (should (string-match-p "^https://gs\\.example/stream$" text))))) + (should-not (directory-files tmp-m3u nil "\\.m3u\\'")))) + +(ert-deftest test-music-playlist-save-file-queue-targets-m3u-root-no-prefill () + "Normal: a file queue saves into the music root with no station pre-fill." + (test-music-save--with-env + (test-music-save--queue (list (emms-track 'file "/music/a.flac"))) + (cj/music-playlist-save) + (should-not cr-initial) + (should (= (length (directory-files tmp-m3u nil "\\.m3u\\'")) 1)) + (should-not (directory-files tmp-radio nil "\\.m3u\\'")))) + +(ert-deftest test-music-playlist-save-associated-file-name-wins-over-station () + "Normal: a queue with an associated playlist file defaults to that name, +even when it contains stations." + (test-music-save--with-env + (let ((tr (emms-track 'url "https://gs.example/stream"))) + (emms-track-set tr 'info-title "Groove Salad") + (test-music-save--queue (list tr))) + (with-current-buffer (cj/music--ensure-playlist-buffer) + (setq cj/music-playlist-file (expand-file-name "morning.m3u" tmp-radio))) + (cj/music-playlist-save) + (should-not cr-initial) + (should (file-exists-p (expand-file-name "morning.m3u" tmp-radio))))) + +(ert-deftest test-music-playlist-save-error-empty-name () + "Error: an empty name at the prompt signals user-error, not a hidden .m3u." + (test-music-save--with-env + (test-music-save--queue (list (emms-track 'url "https://x.example/s"))) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) ""))) + (should-error (cj/music-playlist-save) :type 'user-error)) + (should-not (directory-files tmp-radio nil "m3u")))) ;;; cj/music-playlist-edit @@ -138,36 +208,5 @@ (should (eq switched buf)) (should msg))) -;;; cj/music-create-radio-station - -(ert-deftest test-music-create-radio-station-writes-m3u () - "Normal: with name+url, an EXTM3U-style file is written into music-m3u-root." - (let* ((tmp (file-name-as-directory (make-temp-file "cj-music-radio-" t))) - (cj/music-m3u-root tmp) - msg) - (unwind-protect - (progn - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) - (cj/music-create-radio-station "NPR" "https://example.test/stream")) - (let ((file (expand-file-name "NPR_Radio.m3u" tmp))) - (should (file-exists-p file)) - (with-temp-buffer - (insert-file-contents file) - (let ((text (buffer-string))) - (should (string-match-p "#EXTM3U" text)) - (should (string-match-p "NPR" text)) - (should (string-match-p "https://example.test/stream" text)))))) - (delete-directory tmp t)) - (should (string-match-p "Created radio station" msg)))) - -(ert-deftest test-music-create-radio-station-rejects-empty-name () - "Error: an empty name is rejected with user-error." - (should-error (cj/music-create-radio-station "" "https://x") :type 'user-error)) - -(ert-deftest test-music-create-radio-station-rejects-empty-url () - "Error: an empty URL is rejected with user-error." - (should-error (cj/music-create-radio-station "NPR" "") :type 'user-error)) - (provide 'test-music-config-more-commands) ;;; test-music-config-more-commands.el ends here diff --git a/tests/test-org-capture-config--neutralize.el b/tests/test-org-capture-config--neutralize.el new file mode 100644 index 00000000..4a03830a --- /dev/null +++ b/tests/test-org-capture-config--neutralize.el @@ -0,0 +1,136 @@ +;;; test-org-capture-config--neutralize.el --- Popup neutralize-guard tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the "org-capture" popup neutralize guards. The popup frame opens +;; showing the daemon's last buffer; if a capture aborts before its UI paints, +;; the popup lingers on that buffer, and a live eat/vterm terminal shown there +;; clamps the real frame to the popup's rows. The guards repoint every +;; non-capture-UI window of the popup at *scratch*: one fires on frame creation +;; (after-make-frame-functions), one on any buffer change +;; (window-buffer-change-functions). +;; +;; The tests drive the real batch frame (renamed to "org-capture" and restored +;; in cleanup, the same idiom as the popup-window integration test) rather than +;; mocking frame primitives. `window-buffer-change-functions' only runs during +;; redisplay, so the module's own hook cannot fire mid-test in batch. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'org) +(require 'org-capture) +(require 'user-constants) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-capture-config) + +(defmacro test-neutralize--with-popup-frame (buffer-name &rest body) + "Run BODY with the batch frame named \"org-capture\" showing BUFFER-NAME. +The frame name reverts to auto-naming and the test buffer is killed +afterward. BODY sees the buffer bound to `buf'." + (declare (indent 1)) + `(let ((buf (get-buffer-create ,buffer-name))) + (unwind-protect + (progn + (set-frame-parameter nil 'name "org-capture") + (delete-other-windows) + (set-window-buffer (selected-window) buf) + ,@body) + ;; Restore to nil, not the saved name: the batch frame's auto name is + ;; "F1", and Emacs refuses to set F<num>-shaped names explicitly. + ;; nil reverts to auto-naming (same idiom as the popup-window test). + (set-frame-parameter nil 'name nil) + (when (buffer-live-p buf) (kill-buffer buf))))) + +;;; cj/org-capture--neutralize-frame + +(ert-deftest test-org-capture-config-neutralize-frame-evicts-plain-buffer () + "Normal: a non-capture-UI buffer in the popup frame is repointed to *scratch*." + (test-neutralize--with-popup-frame "neutralize-plain.org" + (cj/org-capture--neutralize-frame (selected-frame)) + (should (equal (buffer-name (window-buffer (selected-window))) + "*scratch*")))) + +(ert-deftest test-org-capture-config-neutralize-frame-spares-capture-buffer () + "Normal: a CAPTURE-* buffer is capture UI and stays put." + (test-neutralize--with-popup-frame "CAPTURE-neutralize.org" + (cj/org-capture--neutralize-frame (selected-frame)) + (should (eq (window-buffer (selected-window)) buf)))) + +(ert-deftest test-org-capture-config-neutralize-frame-spares-select-menu () + "Normal: the *Org Select* template menu is capture UI and stays put." + (test-neutralize--with-popup-frame "*Org Select*" + (cj/org-capture--neutralize-frame (selected-frame)) + (should (eq (window-buffer (selected-window)) buf)))) + +(ert-deftest test-org-capture-config-neutralize-frame-scratch-untouched () + "Boundary: a window already on *scratch* is left alone (idempotent)." + (let ((scratch (get-buffer-create "*scratch*"))) + (unwind-protect + (progn + (set-frame-parameter nil 'name "org-capture") + (delete-other-windows) + (set-window-buffer (selected-window) scratch) + (cj/org-capture--neutralize-frame (selected-frame)) + (should (eq (window-buffer (selected-window)) scratch)) + ;; Second pass is also a no-op. + (cj/org-capture--neutralize-frame (selected-frame)) + (should (eq (window-buffer (selected-window)) scratch))) + (set-frame-parameter nil 'name nil)))) + +(ert-deftest test-org-capture-config-neutralize-frame-other-frame-untouched () + "Boundary: a frame not named \"org-capture\" is never neutralized." + (let ((buf (get-buffer-create "neutralize-other-frame.org"))) + (unwind-protect + (progn + (set-frame-parameter nil 'name "some-other-frame") + (delete-other-windows) + (set-window-buffer (selected-window) buf) + (cj/org-capture--neutralize-frame (selected-frame)) + (should (eq (window-buffer (selected-window)) buf))) + (set-frame-parameter nil 'name nil) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest test-org-capture-config-neutralize-frame-dead-input-no-error () + "Error: nil and non-frame inputs are ignored without raising." + (should-not (cj/org-capture--neutralize-frame nil)) + (should-not (cj/org-capture--neutralize-frame 'not-a-frame))) + +;;; cj/org-capture--neutralize-new-frame (Guard 1 wrapper) + +(ert-deftest test-org-capture-config-neutralize-new-frame-delegates () + "Normal: the frame-creation wrapper neutralizes the popup frame." + (test-neutralize--with-popup-frame "neutralize-new-frame.org" + (cj/org-capture--neutralize-new-frame (selected-frame)) + (should (equal (buffer-name (window-buffer (selected-window))) + "*scratch*")))) + +;;; cj/org-capture--neutralize-on-buffer-change (Guard 2 wrapper) + +(ert-deftest test-org-capture-config-neutralize-on-buffer-change-window-arg () + "Normal: a window argument resolves to its frame and neutralizes it. +`window-buffer-change-functions' passes a window when buffer-local." + (test-neutralize--with-popup-frame "neutralize-window-arg.org" + (cj/org-capture--neutralize-on-buffer-change (selected-window)) + (should (equal (buffer-name (window-buffer (selected-window))) + "*scratch*")))) + +(ert-deftest test-org-capture-config-neutralize-on-buffer-change-frame-arg () + "Normal: a frame argument passes straight through. +`window-buffer-change-functions' passes a frame when global." + (test-neutralize--with-popup-frame "neutralize-frame-arg.org" + (cj/org-capture--neutralize-on-buffer-change (selected-frame)) + (should (equal (buffer-name (window-buffer (selected-window))) + "*scratch*")))) + +;;; Hook wiring + +(ert-deftest test-org-capture-config-neutralize-hooks-registered () + "Normal: both guards are installed on their hooks at module load." + (should (memq #'cj/org-capture--neutralize-new-frame + after-make-frame-functions)) + (should (memq #'cj/org-capture--neutralize-on-buffer-change + window-buffer-change-functions))) + +(provide 'test-org-capture-config--neutralize) +;;; test-org-capture-config--neutralize.el ends here diff --git a/tests/test-org-contacts-config-find.el b/tests/test-org-contacts-config-find.el new file mode 100644 index 00000000..60a5e713 --- /dev/null +++ b/tests/test-org-contacts-config-find.el @@ -0,0 +1,72 @@ +;;; test-org-contacts-config-find.el --- Tests for cj/org-contacts-find -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/org-contacts-find collects contact headings (name, position, and the +;; EMAIL/PHONE annotation) before prompting, then jumps to the selected +;; heading's stored position. These tests pin the collector helper and a +;; command-level smoke test: the jump must land on the heading, never on a +;; body line that merely mentions the name. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'org) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-contacts-config) + +;;; cj/--org-contacts-collect + +(ert-deftest test-org-contacts-collect-returns-name-position-info () + "Normal: collector returns heading name, heading position, and EMAIL/PHONE." + (with-temp-buffer + (org-mode) + (insert "* Alice\n:PROPERTIES:\n:EMAIL: alice@example.com\n:END:\n" + "some body text mentioning Bob\n" + "* Bob\n:PROPERTIES:\n:PHONE: 555-1234\n:END:\n") + (let* ((alist (cj/--org-contacts-collect (current-buffer))) + (alice (assoc "Alice" alist)) + (bob (assoc "Bob" alist))) + (should (equal (length alist) 2)) + (should (equal (nth 2 alice) "alice@example.com")) + (should (equal (nth 2 bob) "555-1234")) + ;; positions land on the headings, not the body line that mentions Bob + (should (save-excursion (goto-char (nth 1 alice)) (looking-at "\\* Alice"))) + (should (save-excursion (goto-char (nth 1 bob)) (looking-at "\\* Bob")))))) + +(ert-deftest test-org-contacts-collect-empty-buffer-returns-nil () + "Boundary: a buffer with no headings yields an empty alist." + (with-temp-buffer + (org-mode) + (should (null (cj/--org-contacts-collect (current-buffer)))))) + +(ert-deftest test-org-contacts-collect-heading-without-props-has-nil-info () + "Error: a heading with no EMAIL or PHONE yields nil info." + (with-temp-buffer + (org-mode) + (insert "* Carol\n") + (let ((alist (cj/--org-contacts-collect (current-buffer)))) + (should (equal (nth 2 (assoc "Carol" alist)) nil))))) + +;;; cj/org-contacts-find + +(ert-deftest test-org-contacts-find-jumps-to-heading-not-body () + "Normal: selecting a contact jumps to its heading, not a body mention." + (let ((contacts-file (make-temp-file "org-contacts-test-" nil ".org"))) + (unwind-protect + (progn + (with-temp-file contacts-file + (insert "* Alice\n:PROPERTIES:\n:EMAIL: alice@example.com\n:END:\n" + "note: call Bob about Alice\n" + "* Bob\n:PROPERTIES:\n:PHONE: 555-1234\n:END:\n")) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "Bob")) + ((symbol-function 'org-fold-show-entry) #'ignore) + ((symbol-function 'org-reveal) #'ignore)) + (cj/org-contacts-find) + (should (looking-at "\\* Bob")))) + (delete-file contacts-file)))) + +(provide 'test-org-contacts-config-find) +;;; test-org-contacts-config-find.el ends here diff --git a/tests/test-org-drill-config-source.el b/tests/test-org-drill-config-source.el new file mode 100644 index 00000000..ccda99ef --- /dev/null +++ b/tests/test-org-drill-config-source.el @@ -0,0 +1,31 @@ +;;; test-org-drill-config-source.el --- Tests for org-drill source selection -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--org-drill-source-keywords decides how use-package obtains org-drill: +;; a local dev checkout via :load-path when it exists, otherwise the upstream +;; repo via :vc. Without this, a machine lacking the checkout hits :demand t +;; against a nonexistent :load-path and drill fails to load entirely. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-drill-config) + +(ert-deftest test-org-drill-source-keywords-uses-load-path-when-checkout-exists () + "Normal: an existing checkout directory selects :load-path." + (let ((dir (make-temp-file "org-drill-checkout-" t))) + (unwind-protect + (should (equal (cj/--org-drill-source-keywords dir) + (list :load-path dir))) + (delete-directory dir t)))) + +(ert-deftest test-org-drill-source-keywords-falls-back-to-vc-when-absent () + "Error: a missing checkout falls back to a :vc install spec." + (let ((kws (cj/--org-drill-source-keywords "/nonexistent/org-drill-xyz"))) + (should (eq (car kws) :vc)) + (should (plist-get (nth 1 kws) :url)))) + +(provide 'test-org-drill-config-source) +;;; test-org-drill-config-source.el ends here diff --git a/tests/test-org-reveal-config-keymap.el b/tests/test-org-reveal-config-keymap.el new file mode 100644 index 00000000..17a21b19 --- /dev/null +++ b/tests/test-org-reveal-config-keymap.el @@ -0,0 +1,38 @@ +;;; test-org-reveal-config-keymap.el --- Tests for org-reveal-config prefix keymap -*- lexical-binding: t; -*- + +;;; Commentary: +;; The presentation commands are reached through `cj/reveal-map', a prefix +;; keymap registered under "C-; p" via `cj/register-prefix-map'. These +;; tests pin that structure so the module can't silently regress to raw +;; `global-set-key' calls (which carry a hidden load-order dependency on +;; keybindings.el establishing "C-;" as a prefix first). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'keybindings) +(require 'org-reveal-config) + +(ert-deftest test-org-reveal-config-reveal-map-is-a-keymap () + "Normal: `cj/reveal-map' is a keymap." + (should (keymapp cj/reveal-map))) + +(ert-deftest test-org-reveal-config-reveal-map-bindings () + "Normal: each presentation command is reachable under `cj/reveal-map'." + (dolist (pair '(("SPC" . cj/reveal-present) + ("e" . cj/reveal-export) + ("p" . cj/reveal-preview-start) + ("s" . cj/reveal-preview-stop) + ("h" . cj/reveal-insert-header) + ("H" . cj/reveal-remove-headers) + ("n" . cj/reveal-new))) + (should (eq (keymap-lookup cj/reveal-map (car pair)) (cdr pair))))) + +(ert-deftest test-org-reveal-config-reveal-map-registered-under-p () + "Normal: `cj/reveal-map' is registered under \"p\" in `cj/custom-keymap'." + (should (eq (keymap-lookup cj/custom-keymap "p") cj/reveal-map))) + +(provide 'test-org-reveal-config-keymap) +;;; test-org-reveal-config-keymap.el ends here diff --git a/tests/test-org-roam-config-tag-and-find.el b/tests/test-org-roam-config-tag-and-find.el index f98d8af0..97a7a683 100644 --- a/tests/test-org-roam-config-tag-and-find.el +++ b/tests/test-org-roam-config-tag-and-find.el @@ -147,6 +147,17 @@ ;; The 4th arg is the subdir (should (equal (nth 3 args) "recipes/")))) +(ert-deftest test-org-roam-find-node-project-delegates-to-find-node () + "Normal: `find-node-project' uses Project tag, 'p' key, project.org template." + (let ((args nil)) + (cl-letf (((symbol-function 'cj/org-roam-find-node) + (lambda (&rest a) (setq args a)))) + (cj/org-roam-find-node-project)) + (should (equal (car args) "Project")) + (should (equal (cadr args) "p")) + ;; The 3rd arg is the template file, under the canonical roam-dir/templates/. + (should (string-suffix-p "templates/project.org" (nth 2 args))))) + ;;; cj/org-roam-node-insert-immediate (ert-deftest test-org-roam-node-insert-immediate-rebinds-templates-and-calls-insert () diff --git a/tests/test-prog-general-lsp.el b/tests/test-prog-general-lsp.el new file mode 100644 index 00000000..e61e9a17 --- /dev/null +++ b/tests/test-prog-general-lsp.el @@ -0,0 +1,148 @@ +;;; test-prog-general-lsp.el --- LSP config + helper tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the LSP configuration in prog-general.el, the single owner of +;; generic LSP policy (prog-lsp.el was folded in and removed 2026-07-10). +;; +;; Two layers: +;; - Load-time invariants that hold the moment the config loads, before any +;; server starts: lsp-enable-remote stays nil (so TRAMP files don't auto-start +;; a slow LSP), and no mode accrues a duplicate lsp-deferred entry. +;; - The pure helpers cj/lsp--add-file-watch-ignored-extras and +;; cj/lsp--remove-eldoc-provider-global, exercised directly with Normal / +;; Boundary / Error cases. +;; +;; The quiet-UI :config defaults (snippet off, symbol highlighting off, +;; idle-delay 0.5, ...) are deferred to lsp-mode's own load (see the make-test +;; no-package-initialize note in CLAUDE.md), so they aren't asserted here; the +;; daemon verifies them. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'use-package) + +;; Declare lsp-mode's defcustom / eldoc's hook as special so `let' binds them +;; dynamically. Real definitions load only when lsp-mode / eldoc activate; in +;; the test environment these provide the value cells the helpers read through. +(defvar lsp-file-watch-ignored-directories nil) +(defvar eldoc-documentation-functions nil) + +(defun lsp-eldoc-function (&rest _args) + "Stub lsp-mode Eldoc function for tests.") + +(require 'prog-general) + +;;; Load-time invariants + +(ert-deftest test-prog-general-lsp-enable-remote-nil () + "Normal: lsp-enable-remote is nil so LSP never auto-starts on TRAMP files." + (should (boundp 'lsp-enable-remote)) + (should (null lsp-enable-remote))) + +(ert-deftest test-prog-general-lsp-no-duplicate-mode-hook () + "Boundary: a mode never holds more than one lsp-deferred entry. +The per-language modules add lsp-deferred to their own mode hooks; add-hook +dedups identical symbols, and this pins that invariant so a future non-symbol +\(lambda) addition that breaks it gets caught." + (dolist (hook '(c-mode-hook python-mode-hook go-ts-mode-hook)) + (when (boundp hook) + (should (>= 1 (cl-count 'lsp-deferred (symbol-value hook))))))) + +;;; File-watch ignore helper — Normal + +(ert-deftest test-prog-general-lsp-file-watch-adds-all-patterns () + "Normal: every entry from `cj/lsp-file-watch-ignored-extras' lands in the list." + (let ((lsp-file-watch-ignored-directories nil)) + (cj/lsp--add-file-watch-ignored-extras) + (should (= (length lsp-file-watch-ignored-directories) + (length cj/lsp-file-watch-ignored-extras))) + (dolist (pattern cj/lsp-file-watch-ignored-extras) + (should (member pattern lsp-file-watch-ignored-directories))))) + +(ert-deftest test-prog-general-lsp-file-watch-extends-not-replaces () + "Normal: pre-existing entries (lsp-mode defaults) are preserved." + (let ((lsp-file-watch-ignored-directories + '("[/\\\\]\\.git\\'" "[/\\\\]\\.svn\\'" "[/\\\\]\\.idea\\'"))) + (cj/lsp--add-file-watch-ignored-extras) + (should (member "[/\\\\]\\.git\\'" lsp-file-watch-ignored-directories)) + (should (member "[/\\\\]\\.svn\\'" lsp-file-watch-ignored-directories)) + (should (member "[/\\\\]\\.idea\\'" lsp-file-watch-ignored-directories)) + (dolist (pattern cj/lsp-file-watch-ignored-extras) + (should (member pattern lsp-file-watch-ignored-directories))))) + +(ert-deftest test-prog-general-lsp-file-watch-key-patterns-present () + "Normal: specific expected directory names appear in the constant." + (dolist (name '("node_modules" "target" "__pycache__" ".venv" "venv" + "dist" "coverage" "test-results" "playwright-report" + ".terraform" ".ruff_cache" ".pytest_cache" ".mypy_cache")) + (should (cl-some (lambda (p) (string-match-p (regexp-quote name) p)) + cj/lsp-file-watch-ignored-extras)))) + +;;; File-watch ignore helper — Boundary + +(ert-deftest test-prog-general-lsp-file-watch-idempotent () + "Boundary: calling twice leaves each pattern present exactly once." + (let ((lsp-file-watch-ignored-directories nil)) + (cj/lsp--add-file-watch-ignored-extras) + (cj/lsp--add-file-watch-ignored-extras) + (should (= (length lsp-file-watch-ignored-directories) + (length cj/lsp-file-watch-ignored-extras))) + (dolist (pattern cj/lsp-file-watch-ignored-extras) + (should (= 1 (cl-count pattern lsp-file-watch-ignored-directories + :test #'equal)))))) + +(ert-deftest test-prog-general-lsp-file-watch-all-patterns-non-empty () + "Boundary: every pattern is a non-empty string." + (dolist (pattern cj/lsp-file-watch-ignored-extras) + (should (stringp pattern)) + (should (not (string-empty-p pattern))))) + +(ert-deftest test-prog-general-lsp-file-watch-all-patterns-valid-regex () + "Boundary: every pattern compiles as a valid Emacs regex." + (dolist (pattern cj/lsp-file-watch-ignored-extras) + (condition-case err + ;; string-match-p compiles the regex; invalid syntax raises invalid-regexp. + (string-match-p pattern "/some/sample/path") + (invalid-regexp + (ert-fail (format "Invalid regex %S: %s" + pattern (error-message-string err))))))) + +;;; File-watch ignore helper — Error + +(ert-deftest test-prog-general-lsp-file-watch-non-list-target () + "Error: non-list target value triggers `add-to-list' wrong-type-argument." + (let ((lsp-file-watch-ignored-directories "not-a-list")) + (should-error (cj/lsp--add-file-watch-ignored-extras) + :type 'wrong-type-argument))) + +;;; Eldoc provider helper + +(ert-deftest test-prog-general-lsp-eldoc-provider-removed-globally () + "Normal: remove lsp-mode's Eldoc provider from the global hook value. +The per-buffer removal this replaced raced lsp-mode's own buffer-local hook +population; removing globally before any LSP buffer attaches makes the absence +stick for every subsequent lsp-managed buffer." + (let ((eldoc-documentation-functions + (list #'lsp-eldoc-function 'eldoc-documentation-default))) + (cj/lsp--remove-eldoc-provider-global) + (should-not (memq #'lsp-eldoc-function eldoc-documentation-functions)) + (should (memq 'eldoc-documentation-default eldoc-documentation-functions)))) + +(ert-deftest test-prog-general-lsp-eldoc-provider-removal-idempotent () + "Boundary: re-running the removal after the provider is gone is a no-op." + (let ((eldoc-documentation-functions '(eldoc-documentation-default))) + (cj/lsp--remove-eldoc-provider-global) + (cj/lsp--remove-eldoc-provider-global) + (should (equal eldoc-documentation-functions + '(eldoc-documentation-default))))) + +(ert-deftest test-prog-general-lsp-no-obsolete-eldoc-hook-reference () + "Regression: prog-general should not reference obsolete `lsp-eldoc-hook'." + (with-temp-buffer + (insert-file-contents (expand-file-name "modules/prog-general.el" user-emacs-directory)) + (should-not (re-search-forward "\\_<lsp-eldoc-hook\\_>" nil t)))) + +(provide 'test-prog-general-lsp) +;;; test-prog-general-lsp.el ends here diff --git a/tests/test-prog-lsp--add-file-watch-ignored-extras.el b/tests/test-prog-lsp--add-file-watch-ignored-extras.el deleted file mode 100644 index 9b71cab8..00000000 --- a/tests/test-prog-lsp--add-file-watch-ignored-extras.el +++ /dev/null @@ -1,116 +0,0 @@ -;;; test-prog-lsp--add-file-watch-ignored-extras.el --- Tests for cj/lsp--add-file-watch-ignored-extras -*- lexical-binding: t; -*- - -;;; Commentary: -;; Tests for cj/lsp--add-file-watch-ignored-extras in prog-lsp.el. -;; The function adds project-agnostic build/cache directory patterns to -;; `lsp-file-watch-ignored-directories' without replacing lsp-mode's -;; defaults. Patterns are sourced from `cj/lsp-file-watch-ignored-extras'. - -;;; Code: - -(require 'ert) -(require 'cl-lib) - -;; Declare lsp-mode's defcustom as a special variable so `let' binds it -;; dynamically. Real definition is lsp-mode's; loaded only when use-package -;; activates lsp-mode. In the test environment, this stub provides the value -;; cell `add-to-list' needs. -(defvar lsp-file-watch-ignored-directories nil) -(defvar eldoc-documentation-functions nil) - -(defun lsp-eldoc-function (&rest _args) - "Stub lsp-mode Eldoc function for tests.") - -(require 'prog-lsp) - -;;; Normal Cases - -(ert-deftest test-prog-lsp--add-file-watch-ignored-extras-normal-adds-all-patterns () - "Normal: every entry from `cj/lsp-file-watch-ignored-extras' lands in the list." - (let ((lsp-file-watch-ignored-directories nil)) - (cj/lsp--add-file-watch-ignored-extras) - (should (= (length lsp-file-watch-ignored-directories) - (length cj/lsp-file-watch-ignored-extras))) - (dolist (pattern cj/lsp-file-watch-ignored-extras) - (should (member pattern lsp-file-watch-ignored-directories))))) - -(ert-deftest test-prog-lsp--add-file-watch-ignored-extras-normal-extends-not-replaces () - "Normal: pre-existing entries (lsp-mode defaults) are preserved." - (let ((lsp-file-watch-ignored-directories - '("[/\\\\]\\.git\\'" "[/\\\\]\\.svn\\'" "[/\\\\]\\.idea\\'"))) - (cj/lsp--add-file-watch-ignored-extras) - (should (member "[/\\\\]\\.git\\'" lsp-file-watch-ignored-directories)) - (should (member "[/\\\\]\\.svn\\'" lsp-file-watch-ignored-directories)) - (should (member "[/\\\\]\\.idea\\'" lsp-file-watch-ignored-directories)) - (dolist (pattern cj/lsp-file-watch-ignored-extras) - (should (member pattern lsp-file-watch-ignored-directories))))) - -(ert-deftest test-prog-lsp--add-file-watch-ignored-extras-normal-key-patterns-present () - "Normal: specific expected directory names appear in the constant." - (dolist (name '("node_modules" "target" "__pycache__" ".venv" "venv" - "dist" "coverage" "test-results" "playwright-report" - ".terraform" ".ruff_cache" ".pytest_cache" ".mypy_cache")) - (should (cl-some (lambda (p) (string-match-p (regexp-quote name) p)) - cj/lsp-file-watch-ignored-extras)))) - -;;; Boundary Cases - -(ert-deftest test-prog-lsp--add-file-watch-ignored-extras-boundary-idempotent () - "Boundary: calling twice doesn't duplicate entries." - (let ((lsp-file-watch-ignored-directories nil)) - (cj/lsp--add-file-watch-ignored-extras) - (cj/lsp--add-file-watch-ignored-extras) - (should (= (length lsp-file-watch-ignored-directories) - (length cj/lsp-file-watch-ignored-extras))))) - -(ert-deftest test-prog-lsp--add-file-watch-ignored-extras-boundary-all-patterns-non-empty () - "Boundary: every pattern is a non-empty string." - (dolist (pattern cj/lsp-file-watch-ignored-extras) - (should (stringp pattern)) - (should (not (string-empty-p pattern))))) - -(ert-deftest test-prog-lsp--add-file-watch-ignored-extras-boundary-all-patterns-valid-regex () - "Boundary: every pattern compiles as a valid Emacs regex." - (dolist (pattern cj/lsp-file-watch-ignored-extras) - (condition-case err - ;; string-match-p compiles the regex; invalid syntax raises invalid-regexp. - (string-match-p pattern "/some/sample/path") - (invalid-regexp - (ert-fail (format "Invalid regex %S: %s" - pattern (error-message-string err))))))) - -;;; Error Cases - -(ert-deftest test-prog-lsp--add-file-watch-ignored-extras-error-non-list-target () - "Error: non-list target value triggers `add-to-list' wrong-type-argument." - (let ((lsp-file-watch-ignored-directories "not-a-list")) - (should-error (cj/lsp--add-file-watch-ignored-extras) - :type 'wrong-type-argument))) - -(ert-deftest test-prog-lsp--remove-eldoc-provider-global-removes-from-default () - "Normal: remove lsp-mode's Eldoc provider from the global hook value. -The per-buffer removal that this replaced raced lsp-mode's own buffer- -local hook population; removing globally before any LSP buffer attaches -makes the absence stick for every subsequent lsp-managed buffer." - (let ((eldoc-documentation-functions - '(lsp-eldoc-function eldoc-documentation-default))) - (cj/lsp--remove-eldoc-provider-global) - (should-not (memq #'lsp-eldoc-function eldoc-documentation-functions)) - (should (memq 'eldoc-documentation-default eldoc-documentation-functions)))) - -(ert-deftest test-prog-lsp--remove-eldoc-provider-global-is-idempotent () - "Boundary: re-running the removal after the provider is gone is a no-op." - (let ((eldoc-documentation-functions '(eldoc-documentation-default))) - (cj/lsp--remove-eldoc-provider-global) - (cj/lsp--remove-eldoc-provider-global) - (should (equal eldoc-documentation-functions - '(eldoc-documentation-default))))) - -(ert-deftest test-prog-lsp--module-no-obsolete-lsp-eldoc-hook-reference () - "Regression: prog-lsp should not reference obsolete `lsp-eldoc-hook'." - (with-temp-buffer - (insert-file-contents (expand-file-name "modules/prog-lsp.el" user-emacs-directory)) - (should-not (re-search-forward "\\_<lsp-eldoc-hook\\_>" nil t)))) - -(provide 'test-prog-lsp--add-file-watch-ignored-extras) -;;; test-prog-lsp--add-file-watch-ignored-extras.el ends here diff --git a/tests/test-prog-lsp.el b/tests/test-prog-lsp.el deleted file mode 100644 index 7e38111d..00000000 --- a/tests/test-prog-lsp.el +++ /dev/null @@ -1,66 +0,0 @@ -;;; test-prog-lsp.el --- Startup smoke test for LSP config resolution -*- lexical-binding: t; -*- - -;;; Commentary: -;; A narrow smoke test of prog-lsp.el, the central LSP module. It pins the -;; invariants that should hold the moment the config loads, before any server -;; starts: lsp-enable-remote stays nil (so TRAMP files don't auto-start a slow -;; LSP), the file-watch-ignore defaults live in one idempotent place, the eldoc -;; provider is stripped from the global hook, and a mode never accrues a -;; duplicate lsp-deferred entry. The generic :config defaults are deferred to -;; lsp-mode's own load (see the make-test no-package-initialize note in -;; CLAUDE.md), so this tests the top-level :init and helper surface, which runs. - -;;; Code: - -(require 'ert) -(require 'cl-lib) -(require 'use-package) -(require 'prog-lsp) - -;; lsp-mode's defcustom isn't loaded under make test, and prog-lsp's bare -;; `(defvar lsp-file-watch-ignored-directories)' only marks it special within -;; that file's unit. Declare it special here too so the `let' bindings below -;; bind dynamically (the helper reads it through the symbol via add-to-list). -(defvar lsp-file-watch-ignored-directories nil) - -(ert-deftest test-prog-lsp-enable-remote-nil () - "Normal: lsp-enable-remote is nil so LSP never auto-starts on TRAMP files." - (should (boundp 'lsp-enable-remote)) - (should (null lsp-enable-remote))) - -(ert-deftest test-prog-lsp-file-watch-adds-extras () - "Normal: the build/cache ignore patterns get appended to lsp's watch-ignore list." - (let ((lsp-file-watch-ignored-directories '("[/\\\\]\\.git\\'"))) - (cj/lsp--add-file-watch-ignored-extras) - (dolist (pattern cj/lsp-file-watch-ignored-extras) - (should (member pattern lsp-file-watch-ignored-directories))) - (should (member "[/\\\\]\\.git\\'" lsp-file-watch-ignored-directories)))) - -(ert-deftest test-prog-lsp-file-watch-idempotent () - "Boundary: adding the extras twice leaves each pattern present exactly once." - (let ((lsp-file-watch-ignored-directories '())) - (cj/lsp--add-file-watch-ignored-extras) - (cj/lsp--add-file-watch-ignored-extras) - (dolist (pattern cj/lsp-file-watch-ignored-extras) - (should (= 1 (cl-count pattern lsp-file-watch-ignored-directories - :test #'equal)))))) - -(ert-deftest test-prog-lsp-eldoc-provider-removed-globally () - "Normal: the global eldoc provider is stripped so lsp can't reattach it." - (let ((eldoc-documentation-functions - (list #'lsp-eldoc-function #'ignore))) - (cj/lsp--remove-eldoc-provider-global) - (should-not (memq 'lsp-eldoc-function eldoc-documentation-functions)) - (should (memq 'ignore eldoc-documentation-functions)))) - -(ert-deftest test-prog-lsp-no-duplicate-mode-hook () - "Boundary: a mode prog-lsp wires never holds more than one lsp-deferred entry. -prog-lsp and the per-language modules both add lsp-deferred for some modes; -add-hook dedups identical symbols, and this pins that invariant so a future -non-symbol (lambda) addition that breaks it gets caught." - (dolist (hook '(c-mode-hook python-mode-hook go-ts-mode-hook)) - (when (boundp hook) - (should (>= 1 (cl-count 'lsp-deferred (symbol-value hook))))))) - -(provide 'test-prog-lsp) -;;; test-prog-lsp.el ends here diff --git a/tests/test-prog-python--lsp-guard.el b/tests/test-prog-python--lsp-guard.el new file mode 100644 index 00000000..071e1ca9 --- /dev/null +++ b/tests/test-prog-python--lsp-guard.el @@ -0,0 +1,64 @@ +;;; test-prog-python--lsp-guard.el --- Python LSP guard tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; The config audit found lsp-pyright's unguarded :hook lambda calling +;; (require 'lsp-pyright) + (lsp-deferred) on every python-ts buffer, so +;; pyright-less machines got the LSP attach prompt that cj/python-setup's +;; guard exists to prevent. The guarded branch now owns the require and +;; the attach, and both classic and treesit modes run the same setup. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'prog-python) + +(defmacro test-python-guard--setup (pyright-found &rest body) + "Run `cj/python-setup' with pyright presence set to PYRIGHT-FOUND. +Records requires into `required' and lsp attaches into `attached'; +BODY sees both. Package minor modes are stubbed at their boundary." + (declare (indent 1)) + `(let ((required '()) (attached nil)) + (cl-letf (((symbol-function 'company-mode) #'ignore) + ((symbol-function 'flyspell-prog-mode) #'ignore) + ((symbol-function 'superword-mode) #'ignore) + ((symbol-function 'executable-find) + (lambda (&rest _) ,pyright-found)) + ((symbol-function 'require) + (lambda (feature &rest _) (push feature required) feature)) + ((symbol-function 'lsp-deferred) + (lambda () (setq attached t)))) + (with-temp-buffer + (cj/python-setup)) + ,@body))) + +(ert-deftest test-prog-python-setup-pyright-absent-no-lsp () + "Error: without pyright, setup neither loads lsp-pyright nor attaches." + (test-python-guard--setup nil + (should-not (memq 'lsp-pyright required)) + (should-not attached))) + +(ert-deftest test-prog-python-setup-pyright-present-attaches () + "Normal: with pyright on PATH, setup loads lsp-pyright then attaches." + (test-python-guard--setup "/usr/bin/pyright" + (should (memq 'lsp-pyright required)) + (should attached))) + +(ert-deftest test-prog-python-hooks-cover-both-mode-variants () + "Normal: classic and treesit python modes both run the same setup." + (dolist (hook '(python-mode-hook python-ts-mode-hook)) + (should (memq #'cj/python-setup (symbol-value hook))) + (should (memq #'cj/python-mode-keybindings (symbol-value hook))))) + +(ert-deftest test-prog-python-no-anonymous-hook-lambdas () + "Boundary: no anonymous lambda remains on the python hooks. +The audit's unguarded lsp-pyright lambda was anonymous; symbols only +means every hook entry is a named, greppable function." + (dolist (hook '(python-mode-hook python-ts-mode-hook)) + (dolist (fn (symbol-value hook)) + (should (symbolp fn))))) + +(provide 'test-prog-python--lsp-guard) +;;; test-prog-python--lsp-guard.el ends here diff --git a/tests/test-slack-config--notify.el b/tests/test-slack-config--notify.el new file mode 100644 index 00000000..d830ae29 --- /dev/null +++ b/tests/test-slack-config--notify.el @@ -0,0 +1,113 @@ +;;; test-slack-config--notify.el --- Slack notification hardening tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; The config audit found `cj/slack-notify' missing signel's hardening: no +;; body truncation (giant toasts), no whitespace collapse, no sound gating, +;; and no `notifications-notify' fallback when the notify script is absent +;; (the raw `start-process' error was swallowed by the condition-case, so +;; the notification silently vanished). This mirrors signel's shape in +;; place; the shared cj/messenger-notify extraction belongs to the +;; messenger-unification task. +;; +;; The slack package's own predicates (`slack-im-p', `slack-message-minep', +;; `slack-message-mentioned-p') are package boundaries and are mocked; the +;; formatter and routing logic run real. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'slack-config) + +;;; ------------------------------ body formatter ----------------------------- + +(ert-deftest test-slack-config-format-notify-body-collapses-whitespace () + "Normal: whitespace runs (including newlines) become single spaces." + (should (equal (cj/slack--format-notify-body "a b\nc\t\td") + "a b c d"))) + +(ert-deftest test-slack-config-format-notify-body-truncates-long () + "Boundary: text over the max truncates to max length ending in an ellipsis." + (let ((long (make-string 500 ?x))) + (let ((formatted (cj/slack--format-notify-body long))) + (should (= (length formatted) cj/slack--notify-body-max)) + (should (string-suffix-p "…" formatted))))) + +(ert-deftest test-slack-config-format-notify-body-empty () + "Boundary: empty and whitespace-only input format to the empty string." + (should (equal (cj/slack--format-notify-body "") "")) + (should (equal (cj/slack--format-notify-body " \n\t ") ""))) + +;;; ----------------------------- delivery routing ---------------------------- + +(ert-deftest test-slack-config-send-notification-script-silent-by-default () + "Normal: with the notify script on PATH and sound off, --silent is passed." + (let ((argv nil) (cj/slack-notify-sound nil)) + (cl-letf (((symbol-function 'executable-find) + (lambda (prog &rest _) (when (equal prog "notify") "/bin/notify"))) + ((symbol-function 'start-process) + (lambda (_name _buf &rest args) (setq argv args)))) + (cj/slack--send-notification "Slack: general" "hello")) + (should (equal argv '("/bin/notify" "info" "Slack: general" "hello" "--silent"))))) + +(ert-deftest test-slack-config-send-notification-sound-enabled () + "Boundary: with sound enabled, --silent is not passed." + (let ((argv nil) (cj/slack-notify-sound t)) + (cl-letf (((symbol-function 'executable-find) + (lambda (prog &rest _) (when (equal prog "notify") "/bin/notify"))) + ((symbol-function 'start-process) + (lambda (_name _buf &rest args) (setq argv args)))) + (cj/slack--send-notification "Slack: general" "hello")) + (should (equal argv '("/bin/notify" "info" "Slack: general" "hello"))))) + +(ert-deftest test-slack-config-send-notification-fallback-without-script () + "Error: with no notify script, delivery falls back to notifications-notify." + (let ((fallback nil)) + (cl-letf (((symbol-function 'executable-find) (lambda (&rest _) nil)) + ((symbol-function 'notifications-notify) + (lambda (&rest args) (setq fallback args)))) + (cj/slack--send-notification "Slack: general" "hello")) + (should (equal (plist-get fallback :title) "Slack: general")) + (should (equal (plist-get fallback :body) "hello")))) + +;;; --------------------------- predicate wiring ------------------------------ + +(defmacro test-slack-notify--with-message (minep im-p mentioned-p &rest body) + "Run BODY with the slack package predicates mocked to the given values. +Also mocks room/body accessors and captures delivery into `sent'." + (declare (indent 3)) + `(let ((sent nil)) + (cl-letf (((symbol-function 'slack-message-minep) (lambda (&rest _) ,minep)) + ((symbol-function 'slack-im-p) (lambda (&rest _) ,im-p)) + ((symbol-function 'slack-message-mentioned-p) (lambda (&rest _) ,mentioned-p)) + ((symbol-function 'slack-room-display-name) (lambda (&rest _) "general")) + ((symbol-function 'slack-message-body) (lambda (&rest _) "the message")) + ((symbol-function 'cj/slack--send-notification) + (lambda (title body) (setq sent (list title body))))) + (cj/slack-notify 'msg 'room 'team) + ,@body))) + +(ert-deftest test-slack-config-notify-dm-notifies () + "Normal: a DM from someone else raises a notification." + (test-slack-notify--with-message nil t nil + (should (equal sent '("Slack: general" "the message"))))) + +(ert-deftest test-slack-config-notify-mention-notifies () + "Normal: an @mention in a channel raises a notification." + (test-slack-notify--with-message nil nil t + (should (equal sent '("Slack: general" "the message"))))) + +(ert-deftest test-slack-config-notify-own-message-silent () + "Boundary: your own message never notifies, even in a DM." + (test-slack-notify--with-message t t t + (should-not sent))) + +(ert-deftest test-slack-config-notify-plain-channel-silent () + "Boundary: a channel message with no mention stays silent." + (test-slack-notify--with-message nil nil nil + (should-not sent))) + +(provide 'test-slack-config--notify) +;;; test-slack-config--notify.el ends here diff --git a/tests/test-test-runner.el b/tests/test-test-runner.el index 0ff66f7f..6854b72e 100644 --- a/tests/test-test-runner.el +++ b/tests/test-test-runner.el @@ -152,6 +152,25 @@ FILES is an alist of relative test filenames to file contents." (should (eq (car result) 'not-in-testdir))) (test-testrunner-teardown)) +(ert-deftest test-testrunner-focus-add-file-shared-prefix-sibling-rejected () + "Boundary: a sibling directory sharing the test dir's name prefix is outside it. +`/tmp/x/tests-old/f.el' starts with `/tmp/x/tests' as a string, but it is not +in `/tmp/x/tests'. A raw `string-prefix-p' on the two truenames accepts it; +comparing against the directory with a trailing slash rejects it." + (test-testrunner-setup) + (let* ((testdir (file-truename test-testrunner--temp-dir)) + (sibling (concat (directory-file-name testdir) "-old")) + (filepath (expand-file-name "test-foo.el" sibling))) + (unwind-protect + (progn + (make-directory sibling t) + (with-temp-file filepath (insert ";; not in the test dir\n")) + (let ((result (cj/test--do-focus-add-file + filepath test-testrunner--temp-dir '()))) + (should (eq (car result) 'not-in-testdir)))) + (when (file-directory-p sibling) (delete-directory sibling t)))) + (test-testrunner-teardown)) + (ert-deftest test-testrunner-focus-add-file-already-focused () "Should detect already focused file." (test-testrunner-setup) diff --git a/tests/test-text-config.el b/tests/test-text-config.el index 96935e1b..82dfe05e 100644 --- a/tests/test-text-config.el +++ b/tests/test-text-config.el @@ -37,5 +37,18 @@ standard boundary check." (should (eq (cj/prettify-compose-block-markers-p start end "lambda") (prettify-symbols-default-compose-p start end "lambda")))))) +(ert-deftest test-text-config-edit-indirect-bound-on-reachable-key () + "Error/regression: edit-indirect-region is bound on M-I -- the event +Meta+Shift+i actually produces -- not the unreachable M-S-i, which no +keypress generates so it silently fell through to M-i tab-to-tab-stop." + (should (eq (key-binding (kbd "M-I")) #'edit-indirect-region)) + (should-not (eq (key-binding (kbd "M-S-i")) #'edit-indirect-region))) + +(ert-deftest test-text-config-accent-uses-completion-agnostic-backend () + "Regression: C-` invokes accent-menu, which reads through the minibuffer +and so survives a Company->Corfu migration, rather than accent-company, +whose company backend would break silently once Company is gone." + (should (eq (key-binding (kbd "C-`")) #'accent-menu))) + (provide 'test-text-config) ;;; test-text-config.el ends here diff --git a/tests/test-ui-theme-persistence.el b/tests/test-ui-theme-persistence.el index 02bb105a..250b606b 100644 --- a/tests/test-ui-theme-persistence.el +++ b/tests/test-ui-theme-persistence.el @@ -32,6 +32,19 @@ "modus-vivendi"))) (delete-file file)))) +(ert-deftest test-ui-theme-write-file-contents-creates-missing-parent-dir () + "Boundary: writing into a not-yet-existing directory creates it first. +On a fresh machine `persist/' does not exist, and `file-writable-p' returns nil +for a file inside a missing directory, so the write must create the parent." + (let* ((sandbox (make-temp-file "ui-theme-sandbox-" t)) + (file (expand-file-name "persist/emacs-theme" sandbox))) + (unwind-protect + (progn + (should-not (file-directory-p (file-name-directory file))) + (should (cj/theme-write-file-contents "modus-vivendi" file)) + (should (equal (cj/theme-read-file-contents file) "modus-vivendi"))) + (delete-directory sandbox t)))) + (ert-deftest test-ui-theme-write-file-contents-uses-write-region () "Theme persistence should write directly instead of visiting the file." (let ((file (make-temp-file "ui-theme-write-region-")) diff --git a/tests/test-undead-buffers-kill-other-window.el b/tests/test-undead-buffers-kill-other-window.el index e9371a0f..000ada9b 100644 --- a/tests/test-undead-buffers-kill-other-window.el +++ b/tests/test-undead-buffers-kill-other-window.el @@ -66,8 +66,9 @@ ;;; Boundary Cases -(ert-deftest test-kill-other-window-single-window-should-only-kill-buffer () - "With single window, should only kill the current buffer." +(ert-deftest test-kill-other-window-single-window-signals-no-other-window () + "Error: with a single window, signal `user-error' and kill nothing. +There is no other window, so acting would kill the buffer being viewed." (test-kill-other-window-setup) (unwind-protect (let ((buf (generate-new-buffer "*test-single-other*"))) @@ -75,9 +76,9 @@ (progn (switch-to-buffer buf) (should (one-window-p)) - (cj/kill-other-window) + (should-error (cj/kill-other-window) :type 'user-error) (should (one-window-p)) - (should-not (buffer-live-p buf))) + (should (buffer-live-p buf))) (when (buffer-live-p buf) (kill-buffer buf)))) (test-kill-other-window-teardown))) diff --git a/tests/test-video-audio-recording-process-sentinel.el b/tests/test-video-audio-recording-process-sentinel.el index 92fb3f0d..d733e46f 100644 --- a/tests/test-video-audio-recording-process-sentinel.el +++ b/tests/test-video-audio-recording-process-sentinel.el @@ -190,5 +190,157 @@ (should (null cj/audio-recording-ffmpeg-process)))) (test-sentinel-teardown))) +;;; Failed-Start Stub Deletion +;; +;; On Wayland a wf-recorder that fails to grab the compositor capture +;; still writes a ~500KB, ~0.5s stub .mkv before dying. The sentinel +;; detects the failed start (exit sooner than +;; `cj/recording-start-fail-threshold' without a user stop); these tests +;; pin that it also deletes the stub file stamped on the process as the +;; `cj-output-file' property — and that normal stops and user stops +;; never delete anything. + +(defun test-sentinel--make-exited-process () + "Return a real process that has already exited. +Drives the sentinel with a genuinely dead process so `process-status' +and the process plist behave for real instead of through mocks." + (let ((proc (make-process :name "test-sentinel-exited" + :command '("true") + :sentinel #'ignore))) + (while (process-live-p proc) + (accept-process-output proc 0.05)) + proc)) + +(defun test-sentinel--make-stub-file () + "Create and return a temp file standing in for the stub .mkv." + (make-temp-file "test-sentinel-stub-" nil ".mkv" "stub-content")) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-failed-start-deletes-stub () + "Normal: a failed video start deletes the stub output file." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process)) + (stub (test-sentinel--make-stub-file))) + (unwind-protect + (progn + (setq cj/video-recording-ffmpeg-process proc) + ;; Exited immediately after its start time — a failed start. + (process-put proc 'cj-start-time (float-time)) + (process-put proc 'cj-output-file stub) + (cj/recording-process-sentinel proc "exited abnormally\n") + (should-not (file-exists-p stub))) + (when (file-exists-p stub) (delete-file stub)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-failed-start-still-messages () + "Normal: the failed-start branch still reports the failure to the user." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process)) + (stub (test-sentinel--make-stub-file)) + (failure-messaged nil)) + (unwind-protect + (progn + (setq cj/video-recording-ffmpeg-process proc) + (process-put proc 'cj-start-time (float-time)) + (process-put proc 'cj-output-file stub) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (let ((msg (apply #'format fmt args))) + (when (string-match-p "failed to start" msg) + (setq failure-messaged t)))))) + (cj/recording-process-sentinel proc "exited abnormally\n")) + (should failure-messaged)) + (when (file-exists-p stub) (delete-file stub)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-long-run-keeps-file () + "Normal: a recording that ran past the threshold keeps its output file." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process)) + (stub (test-sentinel--make-stub-file))) + (unwind-protect + (progn + (setq cj/video-recording-ffmpeg-process proc) + ;; Ran well past the fail threshold — a real recording. + (process-put proc 'cj-start-time + (- (float-time) + (* 10 cj/recording-start-fail-threshold))) + (process-put proc 'cj-output-file stub) + (cj/recording-process-sentinel proc "finished\n") + (should (file-exists-p stub))) + (when (file-exists-p stub) (delete-file stub)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-boundary-user-stop-keeps-file () + "Boundary: a quick user stop (cj-stopping) never deletes the file." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process)) + (stub (test-sentinel--make-stub-file))) + (unwind-protect + (progn + (setq cj/video-recording-ffmpeg-process proc) + ;; Quick exit, but the user asked for it. + (process-put proc 'cj-start-time (float-time)) + (process-put proc 'cj-stopping t) + (process-put proc 'cj-output-file stub) + (cj/recording-process-sentinel proc "finished\n") + (should (file-exists-p stub))) + (when (file-exists-p stub) (delete-file stub)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-boundary-missing-stub-no-error () + "Boundary: failed start whose stub never hit disk signals no error." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process))) + (setq cj/video-recording-ffmpeg-process proc) + (process-put proc 'cj-start-time (float-time)) + (process-put proc 'cj-output-file "/nonexistent/dir/never-written.mkv") + ;; Must not signal even though the file is absent. + (cj/recording-process-sentinel proc "exited abnormally\n") + (should (null cj/video-recording-ffmpeg-process))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-error-nil-output-property-no-error () + "Error: failed start with no cj-output-file property signals no error. +Covers processes started before the property existed (a live daemon +mid-upgrade) — the sentinel degrades to the old message-only path." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process))) + (setq cj/video-recording-ffmpeg-process proc) + (process-put proc 'cj-start-time (float-time)) + ;; No cj-output-file property at all. + (cj/recording-process-sentinel proc "exited abnormally\n") + (should (null cj/video-recording-ffmpeg-process))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-start-stamps-output-file () + "Normal: `cj/ffmpeg-record-video' stamps cj-output-file on the process." + (test-sentinel-setup) + (unwind-protect + (let ((cj/recording-mic-device "test-mic-device") + (cj/recording-system-device "test-monitor-device") + (cj/recording-mic-boost 2.0) + (cj/recording-system-volume 1.0)) + (cl-letf (((symbol-function 'cj/recording--wayland-p) (lambda () nil)) + ((symbol-function 'cj/recording--validate-system-audio) + (lambda () nil)) + ((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _command) + (make-process :name "fake-video" :command '("sleep" "1000"))))) + (cj/ffmpeg-record-video "/tmp/video-recordings/") + (let ((output-file (process-get cj/video-recording-ffmpeg-process + 'cj-output-file))) + (should (stringp output-file)) + (should (string-suffix-p ".mkv" output-file)) + (should (string-prefix-p "/tmp/video-recordings/" output-file)))) + (when cj/video-recording-ffmpeg-process + (ignore-errors (delete-process cj/video-recording-ffmpeg-process)))) + (test-sentinel-teardown))) + (provide 'test-video-audio-recording-process-sentinel) ;;; test-video-audio-recording-process-sentinel.el ends here |