diff options
260 files changed, 13782 insertions, 1671 deletions
diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 00000000..fd4eb2ad --- /dev/null +++ b/.gitattributes @@ -0,0 +1,2 @@ +# Unified diff context lines can carry a required trailing space marker. +working/**/*.patch whitespace=-blank-at-eol @@ -5,6 +5,7 @@ /.coverage/ flycheck_* projectile-bookmarks.eld +/fontaine-latest-state.eld /recentf /backups/ auto-save-list/ @@ -109,4 +110,6 @@ todo.org # Claude Code: task archive (follows todo file privacy) /archive/task-archive.org takuzu-stats.eld -/working/ + +# disposable project-local scratch; active task artifacts live in versioned working/ +/temp/ 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 44fd8a00..832a9dfa 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 @@ -102,7 +102,7 @@ Pure pieces (name resolution, the m3u-label extraction, the bar-fill computation ** DONE Serif title face - Owner / by-when: Craig / before Phase 3 - Context: the fancy titles want a serif variable-pitch face, theme-owned. -- Decision: We will add a defcustom for the title family defaulting to the nov reading view's serif (cj/nov-reading-font-family, currently "Merriweather") and a theme-owned face the dupre theme colors. +- Decision: We will add a defcustom for the title family defaulting to the shared Reading font profile's serif (currently "Merriweather") and a theme-owned face the dupre theme colors. - Consequences: easier — one knob, consistent with the nov-reading typography choice; harder — another face to register in theme-studio if we want it tunable there (deferred). ** DONE Progress bar rendering and cadence diff --git a/docs/specs/2026-07-06-radio-browser-lookup-spec.org b/docs/specs/2026-07-06-radio-browser-lookup-spec.org index c65de850..89251418 100644 --- a/docs/specs/2026-07-06-radio-browser-lookup-spec.org +++ b/docs/specs/2026-07-06-radio-browser-lookup-spec.org @@ -162,7 +162,7 @@ Add cj/music-radio-search (query -> search -> completing-read multi-select -> wr * Readiness dimensions - Data model & ownership: a station plist (uuid, name, url, codec, bitrate, tags, country, votes, clickcount) derived from the API; the .m3u file is generated and owned by Craig once written. No local cache in v1. -- Errors, empty states & failure: named user-errors — no server reachable, empty results, cancelled selection, write failure (naming the file). No silent data loss; overwrite reuses the existing cj/confirm-strong prompt from create-radio-station. +- Errors, empty states & failure: named user-errors — no server reachable, empty results, cancelled selection, write failure (naming the file). No silent data loss; overwrite reuses the existing cj/confirm-destructive prompt from create-radio-station. - Security & privacy: no credentials. The only outbound data is the search query and a User-Agent to a public API. No sensitive data logged. - Observability: the command messages the server used, the result count, and each file written. Search is one short synchronous call; if it ever feels slow, a "Searching radio-browser…" message covers it. - Performance & scale: result sets bounded by an explicit limit (default ~30). One GET per search. No scaling concern. diff --git a/docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org b/docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org new file mode 100644 index 00000000..497131dc --- /dev/null +++ b/docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org @@ -0,0 +1,405 @@ +#+TITLE: org-agenda fullscreen frame — Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-07-17 +#+TODO: TODO | DONE +#+TODO: DRAFT READY DOING | IMPLEMENTED SUPERSEDED CANCELLED + +* SUPERSEDED org-agenda fullscreen frame +:PROPERTIES: +:ID: 7705c94b-9bb7-47d8-9828-e9584172c54f +:END: +- 2026-07-27 Mon @ 13:57 -0500 — SUPERSEDED. Craig replaced the whole design with a separate Emacs process that shows the agenda, toggles fullscreen on a key, and refreshes itself every five minutes. This reverses the "Not a separate OS process" non-goal below: the daemon frame bought live shared state, but paid for it with a default-deny read-only policy, engage-routing, auto-dim suspension, and a marker-cloning failure path — machinery that only existed because the agenda shared a process with the working frames. A separate process needs none of it. =modules/org-agenda-frame.el= and its two test files were deleted and =S-<f8>= returned to =cj/org-agenda-refresh-files=. +- 2026-07-20 Mon @ 15:33 -0500 — post-implementation correction: dropped =(fullscreen . fullboth)= from the spawned frame. Craig's "fullscreen" meant a normal frame at its full tiled position, not a compositor-wide fullscreen; the frame is now a plain =make-frame= that a tiling WM (Hyprland) places side by side with the working frame. The engage-routing and focus logic are unchanged and now matter more (open a task in the adjacent working pane). The spec's "fullscreen" wording and filename are retained as historical; read them as "dedicated tiled frame". Covered by =test-org-agenda-frame-parameters-normal-tiled-frame=. +- 2026-07-20 Mon @ 14:10 -0500 — IMPLEMENTED. Built both phases in =modules/org-agenda-frame.el= (58 ERT tests, full suite green, byte-compile clean, full init loads clean, live-reloaded into the daemon with all wiring confirmed). Phase 1: frame lookup/predicate/working-frame routing, the =F= today-anchored 7-day view + registration, the default-deny =cj/agenda-frame-mode= (allowlist + two message classes + menu removal + finalize re-enable), transactional spawn/raise/delete/toggle, engage routing, sticky/close lifecycle. Phase 2: the 5-min wall-clock =org-agenda-redo= timer with the window/focus contract, duplicate-timer prevention, deterministic point restoration, the frame-owned last-good snapshot with cloned markers + failure overlay + report-once latch, and the public =cj/agenda-frame-toggle= on =S-<f8>= with the force-rescan moved to =C-M-<f8>=. The compositor fullscreen/focus and real-redo behaviors are a residual manual check (VERIFY filed under Manual testing). +- 2026-07-20 Mon @ 13:30 -0500 — DOING. Decomposed into build tasks (Phase 1, Phase 2, flip-to-IMPLEMENTED) under the fullscreen-frame PROJECT in todo.org; =:SPEC_ID:= stamped. Building Phase 1. +- 2026-07-20 Mon @ 13:26 -0500 — READY (Craig accepted for build). Folded Codex's marker-clone finding (all 28 findings, 13 decisions resolved). Craig's call: build v1 now; the Hyprland-window variant is vNext once the in-Emacs frame proves out. Decomposing into build tasks next. +- 2026-07-20 Mon @ 13:07 -0500 — spec-review (Codex): still DRAFT. The two prior responses close their stated behavior gaps, but Org invalidates the old agenda's marker objects during redo; the specified shallow property-bearing snapshot therefore restores dead =org-marker=/=org-hd-marker= links after a failed rebuild. One blocking marker-cloning/ownership finding added. +- 2026-07-20 Mon @ 12:59 -0500 — spec-response: both fifth-pass findings dispositioned. Enumerated the full default-deny allowlist + honest keys/mouse enforcement boundary (menu removed, M-x out of contract); made failed-redo a complete retryable state (frame-owned snapshot with Org properties, explicit policy re-enable on the error path, overlay header, rebuild from =org-redo-cmd=). Findings [27/27]; Decisions [13/13]. Stays DRAFT pending Codex re-review. +- 2026-07-20 Mon @ 12:47 -0500 — spec-review (Codex): still DRAFT. The structural response closes the prior eight findings, but two blockers remain: the default-deny minor-mode map neither defines its actual allowlist nor covers menu/M-x invocation, and failed-redo rollback does not restore a complete policy-enabled, retryable agenda state. +- 2026-07-20 Mon @ 12:29 -0500 — renamed the file =…-dock-mode-spec.org= → =…-org-agenda-fullscreen-frame-spec.org= to match the design; inbound links in todo.org and .ai/notes.org updated. The ":ID:" is unchanged. +- 2026-07-20 Mon @ 12:26 -0500 — spec-response: all 8 fourth-pass findings dispositioned. Root fix: replaced keymap enumeration with a default-deny =cj/agenda-frame-mode= policy (re-enabled by a finalize hook so redo can't strip it), frame-owned timer/failure state, sticky-kill-on-close, failed-redo snapshot restore, non-interactive Phase 1, synced ERT. Decisions now 13; findings [25/25]. Stays DRAFT pending Codex re-review. +- 2026-07-20 Mon @ 12:11 -0500 — spec-review (Codex): still DRAFT. Detail-complete re-review found eight blocking gaps beneath the resolved values: Phase 1 remains callable through M-x; mutation, display-opening, view-change, and manual-redo command classes are incomplete; Org redo discards dedicated buffer-local policy/state; sticky reopen can show stale content; failed-redo display state is undefined; and the ERT surface does not cover the expanded contracts. +- 2026-07-20 Mon @ 12:02 -0500 — spec-response: all 7 third-pass findings dispositioned (accepted; 4 with a chosen value). Key =F=, current-window, cached build on spawn, read-only command policy, source-opening routing, retry-report-once refresh, unbound-Phase-1 then binding-in-Phase-2, deterministic point tie-break. Decisions now 12; findings [17/17]. Stays DRAFT pending Codex re-review. +- 2026-07-20 Mon @ 11:29 -0500 — spec-review (Codex): still DRAFT. A stricter second implementation-readiness pass found seven blocking choices still deferred to implementation: agenda command identity/window setup, initial source-list preparation, the permitted command surface, non-RET/TAB display routing, timer-failure recovery, phase exposure, and refresh point tie-breaking. +- 2026-07-20 Mon @ 10:22 -0500 — spec-response: all 10 findings dispositioned (accepted; 2 with a chosen behavior). Design, Decisions (now 10), phases (now 2), acceptance, and the test surface updated. Stays DRAFT pending a re-review to confirm the blockers are closed. +- 2026-07-20 Mon @ 10:12 -0500 — spec-review (Codex): demoted READY → DRAFT. Independent code-grounded re-review found six blocking gaps in date anchoring, exit/buffer lifecycle, working-frame fallback, phase safety, refresh context, and automated test coverage; three non-blocking implementation details also need definition. +- 2026-07-20 Mon @ 09:53 -0500 — spec-review: READY. All 8 decisions resolved; code read confirmed the F8 bindings and display rule. One non-blocking finding recorded (the frame view needs its own custom-command entry). Ready to decompose the 3 phases. +- 2026-07-20 Mon @ 09:45 -0500 — redesigned: a dedicated fullscreen frame replaces the right-side side-window dock. All eight design decisions resolved (see Decisions). The design is a fullscreen agenda frame, not a side dock; the file was later renamed to match. +- 2026-07-17 Fri @ 19:34:07 -0500 — drafted. + +* Metadata +| Status | superseded | +|----------+------------------------------------------------| +| Owner | Craig Jennings | +|----------+------------------------------------------------| +| Reviewer | Codex | +|----------+------------------------------------------------| +| Related | [[file:../../todo.org][fullscreen-frame task (Emacs Open Work)]] | +|----------+------------------------------------------------| + +* Summary + +A dedicated fullscreen Emacs frame that shows the agenda. One key spawns (or raises) a frame of the running daemon, fullscreened, displaying the next seven days of schedule and tasks, refreshing itself every few minutes. Inside that frame focus stays on the agenda. The point is a standing, always-current agenda surface you can throw on its own workspace or monitor, one keystroke away, without the agenda ever stealing the frame you work in. + +* Problem / Context + +The normal agenda (=<f8>=, =cj/main-agenda-display=) opens below-selected at 75% of the frame (=cj/org-agenda-window-height=, applied through =cj/--org-agenda-display-rule=). That's a modal, take-over-the-frame view: you summon it, read it, dismiss it, and go back to work. There's no way to keep the schedule and task list glanceable while working, and no live refresh, so an agenda left open drifts stale (the now-line and freshly-synced calendar events don't move). + +Craig wants a second, non-modal surface: the agenda living in its own fullscreen frame, current and ready to engage, so it can sit on a separate workspace or monitor while the working frames stay untouched. This is a distinct mode from the existing full-view agenda, not a replacement for it. + +* Goals and Non-Goals + +** Goals +- A dedicated fullscreen frame of the running daemon showing the seven-day schedule and task list, wholly separate from the working frames. +- Live: the frame refreshes on a few-minute cadence so the now-line and synced events stay current. It shares the daemon's state, so calendar-sync results and buffer edits are already reflected. +- One key to spawn, raise, and close it. +- Focus stays on the agenda inside that frame; engaging a task opens the file in the working frame, not over the agenda. + +** Non-Goals +- Not a replacement for the existing =<f8>= full-view agenda — that stays as is. +- Not a separate OS process. It's a frame of the running daemon (chosen for live shared state over an isolated second Emacs). It therefore dies with the daemon, which is acceptable. +- Not a capture/scratch surface in v1. Whether an agenda surface should double as a scratchpad is a separate exploration (see the [#D] task); v1 is read + engage only. +- Not a startup auto-open. The frame is spawned on demand by its key; there is no auto-open defcustom. +- Not a redesign of agenda content or faces — it reuses org-agenda's rendering. + +** Scope tiers +- v1: a spawn/raise/close command bound to =S-<f8>=; a fullscreen frame; a seven-day agenda view filling it; focus held on the agenda; jump-to-task routed to the working frame; a frame-scoped refresh timer; the force-refresh keybinding move. +- Out of scope: the scratchpad surface; a separate-process agenda; persisting frame state across daemon restarts. +- vNext: scratchpad exploration (its own task); richer view tuning once the mode is in daily use; if the fullscreen frame proves out, reimplement as a Hyprland-managed window with its own keybinding — an external launcher replacing the in-Emacs =S-<f8>= spawn (Craig, 2026-07-20). v1 stays the in-Emacs frame. + +* Design + +The agenda lives in its own frame of the running daemon, created with =make-frame= carrying a marker parameter (=(cj/agenda-frame . t)=) so the toggle can find, raise, or delete it. (The frame was originally spawned =(fullscreen . fullboth)=; that was dropped 2026-07-20 so a tiling WM places it side by side with the working frame rather than covering the whole output — see the status history.) Sharing the daemon means the frame sees the same live state as every working frame: calendar-sync writes, unsaved buffer edits, and the current now-line are all already there, so "live" needs only a periodic redo, not a reload. + +For the user, the interface is one key. =S-<f8>= toggles the frame: spawn it fullscreen if none exists, raise and select it if it exists but isn't focused, delete it if it's the selected frame. The current occupant of =S-<f8>= (=cj/org-agenda-refresh-files=, the manual force-rescan shipped in 17ae3e2a) moves to =C-M-<f8>=, keeping the whole force-refresh idea in the F8 family. + +Inside the agenda frame, focus stays on the agenda. The frame holds a single window showing the seven-day agenda buffer, so point rests there by construction. Engaging a task (=RET=/=TAB= on an agenda line) opens the target file in the working frame and raises it; the agenda frame is never chosen as the display target, so it keeps showing the agenda. In the working frame (the one that launched it, and every other frame) there are no such restrictions — normal behavior throughout. + +For the implementer, these pieces compose: + +1. A toggle command that spawns, raises, or deletes the marked frame. Spawn is transactional: create the fullscreen frame, run the cached non-forced =(cj/build-org-agenda-list)= (the same prep =cj/main-agenda-display= does at :380-391, so a frame spawned early after daemon startup isn't the base-files-only agenda), build and display the dedicated agenda buffer, install the frame-local routing, and start the timer. If any step fails after =make-frame= succeeds — including a build failure — cancel the timer, delete the partial frame and buffer, leave the original working frame selected, and report =Agenda frame: <operation> failed: <cause>=. Delete removes the frame and stops the timer. The frame carries the =cj/agenda-frame= marker so the command locates it among the daemon's frames. + +2. A dedicated seven-day agenda view, defined as its own =org-agenda-custom-commands= key =F= (the existing top-level key at =org-agenda-config.el:344= is =d=, so =F= is collision-free), with =org-agenda-sticky= and =(org-agenda-window-setup 'current-window)= bound in that command's *local* settings. =org-agenda-sticky= local gives Org a distinct =*Org Agenda(F)*= buffer without touching the ordinary =<f8>= behavior; =current-window= keeps the view in the frame's sole window (Org 9.7.11 defaults =org-agenda-window-setup= to =reorganize-frame=, which would split the new frame). The span is anchored to today, not the week: =(org-agenda-span 7)= plus =(org-agenda-start-day "0d")= and =(org-agenda-start-on-weekday nil)= (=org-agenda-list= otherwise anchors any seven-day span to Monday in Org 9.7.11; the daily command uses the same pair at :347-349). No separate TODO block — the span surfaces scheduled work; unscheduled-priority surfacing is a vNext question. + +3. A read-only command policy by *default-deny, not enumeration*. The dedicated buffer runs a minor mode =cj/agenda-frame-mode= whose keymap binds =[t]= (the catch-all) to a denial handler, so every *key or mouse* command not on an explicit allowlist is intercepted by one fallthrough — the whole keymap is covered, and a future Org binding is denied by default. The enforcement boundary is keys and mouse, stated honestly: a minor-mode map can't intercept an Agenda-menu item or a direct =M-x=, so the mode also *removes the Agenda menu-bar* in the dedicated buffer (no menu path to a mutation), and direct =M-x org-agenda-…= is explicitly *out of contract* — typing the command name is a deliberate bypass of a read-only surface, like editing a read-only buffer under =inhibit-read-only=. The complete allowlist is: (a) navigation — =org-agenda-next-line=/=-previous-line=, =org-agenda-next-item=/=-previous-item=, the arrow keys, =C-n=/=C-p=, =C-v=/=M-v= scroll, =M-<=/=M->=, and =C-g=; (b) engage/open — =RET=/=TAB= (=org-agenda-switch-to=/=org-agenda-goto=), mouse-2 (=org-agenda-goto-mouse=), =C-c C-o= (=org-agenda-open-link=), each routed to the working frame — the MRU live non-agenda frame at engagement time, or a new normal (non-fullscreen) frame when none exists — never into the agenda frame; and (c) the frame's own controls — =S-<f8>= toggle, =C-M-<f8>= force-rescan, =q=/=Q=/=x= close, and =r= (remapped to the safe-redo wrapper, below). Everything else is denied with a one-line message: source mutations (TODO-state, tags, priority, effort, schedule/deadline, refile, archive, kill, bulk, and any other) and buffer-opening/preview/follow commands that would split or replace the frame (=SPC=/=DEL=, mouse-3, =C-c C-x b=, clock-goto, follow mode) show =Agenda frame is read-only — press RET to edit in your working frame=; and view-changing commands that would break the today-anchored span (=d=/=w=/=y=, =f=/=b=, =j=, =g=) show =Agenda frame is fixed to the 7-day view=. The one exception is =r= (manual redo): it's allowlisted but remapped to the frame's own safe-redo wrapper (the manual version of the timer tick), so a manual refresh takes the same failure-latched, focus-safe path. The dedicated view also binds =org-agenda-start-with-follow-mode= nil locally, so a non-nil global default can't turn follow mode on at buffer creation. Because =org-agenda-redo= rebuilds through =org-agenda-mode=, which runs =kill-all-local-variables=, the mode is re-enabled after every build by =org-agenda-finalize-hook= gated on the frame's =cj/agenda-frame= marker (a frame parameter, which survives the buffer reset) — so the refresh never strips the policy. =q=/=Q=/=x= delete the marked frame and cancel its timer, and closing the frame (by any path) also kills the =*Org Agenda(F)*= sticky buffer, so the next spawn regenerates fresh rather than reusing stale sticky content; killing the dedicated buffer deletes the frame too, so no orphan fullscreen frame survives. + +4. A frame-scoped refresh timer: =org-agenda-redo= on the dedicated buffer every 5 minutes, wall-clock aligned, started on spawn and cancelled on delete/kill, with a live-frame/live-buffer guard and duplicate-timer prevention. The callback runs with the dedicated agenda window selected for the redo's dynamic extent, restores the prior selected frame and window afterward, and never calls an input-focus function — so a tick while Craig works in another frame neither errors on an out-of-range =window-start= nor steals focus. Point restoration is deterministic: restore the same-=org-marker= occurrence closest to the old agenda line (one marker can appear twice, e.g. a scheduled and a deadline line); if the marker is gone, clamp the old line number into the rebuilt buffer's range; on a header line move to the first agenda item; an empty view leaves point at buffer start. On a failed redo the timer keeps running and retries on the next scheduled tick — a transient failure shouldn't kill live refresh — and the failure is reported once per consecutive-failure run (naming the next action: =C-M-<f8>= force-rescan or re-spawn), with the next successful tick clearing the failure state. Because =org-agenda-redo= erases the buffer before it rebuilds and =org-agenda-mode= would strip the policy, the callback keeps a *frame-owned last-good snapshot* — the buffer text with its =org-redo-cmd=/=org-lprops= properties, point, window-start, and any active filter/identity — captured from the last successful build, undecorated. Markers get special handling: =org-agenda-reset-markers= nulls the old =org-marker=/=org-hd-marker= objects during a rebuild, so the snapshot must not keep them by reference — it *clones* each agenda marker into a snapshot-owned live marker (=copy-marker= into the unchanged source buffer) and reinstalls the clones on restore, so =RET=/=TAB= still resolve to the right source line; the clones are released when a successful build replaces the snapshot or the frame closes, so repeated failures don't leak markers. On a redo error it restores that snapshot verbatim, *explicitly re-enables =cj/agenda-frame-mode=* (the finalize hook runs only on success, so the error path must reinstate the policy or the frame would be left unrestricted), and shows the "refresh failed (=C-M-<f8>= to force-rescan)" line as an *overlay*, not inserted text — so the Org properties aren't corrupted and consecutive failures don't accumulate headers. The next tick then redoes from the preserved =org-redo-cmd= (a real rebuild, not a no-op off an error header); a success removes the overlay and replaces the snapshot. So the frame is never blank, never unrestricted, and always retryable — =RET= and navigation keep working on the restored snapshot. A thin wrapper suppresses =org-agenda-redo='s routine "Rebuilding..." chatter but lets that one failure message through. =redo= re-reads file contents, not the file list — a new project's todo.org still needs the manual force-rescan. + +** Not a prototype-pipeline UI + +=ui-prototyping.md='s research → five-prototype → iterate process governs bespoke visual surfaces (panels, multi-control widgets, SVG faceplates). This frame is org-agenda's existing text rendering shown fullscreen; the layout question ("where does it go?") is answered in a sentence (its own fullscreen frame). So the prototype pipeline is intentionally skipped. The open questions here were behavioral (frame vs process, view span, focus, jump routing, auto-open), not visual-layout, and they're settled in the Decisions below. + +* Alternatives Considered + +** Dedicated fullscreen frame of the daemon (chosen) +- Good, because it shares the daemon's live state: calendar-sync, open buffers, and edits are already reflected, so "live" costs only a periodic redo. +- Good, because it's genuinely separate from the working frames — it can sit on its own workspace or monitor and never steals working space. +- Neutral, because it dies with the daemon (no cross-restart persistence). Acceptable for v1. + +** A separate Emacs process +- Good, because it's fully isolated and survives a daemon restart. +- Bad, because it doesn't share the daemon's in-memory state — it reads the org files from disk and only reflects what's been saved. The "always current, shares live edits" goal argues against it, so it was rejected in favor of a frame. + +** A right-side side-window dock (the prior draft's design) +- Good, because it lives in the working frame and is protected from =delete-other-windows=. +- Bad, because it isn't what Craig wants: it shares the working frame rather than standing alone, it's bounded to a dock width that crowds the working area, and it can't move to its own workspace or monitor. Superseded by the fullscreen frame. + +** A normal split window +- Good, because it's the least new machinery. +- Bad, because it isn't protected, has no clean "this is the agenda surface" identity, and takes over the working frame. This is what the current 0.75 rule already gives and what the frame needs to be different from. + +** Global "refresh any visible agenda" timer +- Good, because it would also refresh the =<f8>= full view when left open. +- Bad, because it has no clean lifecycle — it has to poll for visible agenda buffers and decide when to stop. The frame-scoped timer starts and stops with the frame, which is simpler and matches the feature's boundary. + +* Decisions [13/13] + +** DONE Dedicated fullscreen frame as the display mechanism +- Context: the surface must stand wholly apart from the working frames, be placeable on its own workspace or monitor, and stay live. +- Decision: We display the agenda in a dedicated frame of the running daemon, created with =make-frame= + =(fullscreen . fullboth)= and a =cj/agenda-frame= marker parameter. A frame (not a separate process) so it shares the daemon's live state. +- Consequences: easier — live state, no reload, full isolation from working frames. Harder — it dies with the daemon; frame lookup and lifecycle must be explicit. + +** DONE Launch/toggle on S-<f8>; force-refresh moves to C-M-<f8> +- Context: =S-<f8>= currently runs =cj/org-agenda-refresh-files= (shipped 17ae3e2a); Craig wants =S-<f8>= to spawn/raise/close the agenda frame. +- Decision: =S-<f8>= toggles the agenda frame (spawn if none, raise+select if unfocused, delete if selected). =cj/org-agenda-refresh-files= rebinds to =C-M-<f8>=, keeping both in the F8 family. +- Consequences: easier — one gesture, next to the other agenda keys. Harder — one existing binding moves; the docstring/family comment needs updating. + +** DONE View: the seven-day agenda span alone +- Context: "the day's work visible" is a composite; how many days, and whether to append a TODO block. +- Decision: the frame shows a seven-day agenda span (=org-agenda-span= 7) as one =org-agenda-custom-commands= entry, with no separate prioritized TODO block. The span already surfaces scheduled work. +- Consequences: easier — one custom-command entry, no block composition to tune. Harder — unscheduled priorities aren't surfaced; that's a vNext tuning question if it turns out to matter. + +** DONE Focus stays on the agenda inside the frame +- Context: opening or working the agenda frame should keep point on the agenda, not scatter into other buffers; the launching frame stays unrestricted. +- Decision: the agenda frame holds a single window on the agenda buffer and point rests there; no focus restrictions apply to any other frame. +- Consequences: easier — the frame is unambiguous to use. Harder — anything that would open a buffer in the frame must be routed elsewhere (see jump-to-task). + +** DONE Jump-to-task opens the file in the working frame +- Context: engaging a task from a fullscreen agenda must not replace the agenda with the target file. +- Decision: =RET=/=TAB= on an agenda line opens the target file in the working frame (the most-recently-selected non-agenda frame) and raises it; the agenda frame keeps showing the agenda. +- Consequences: easier — the agenda frame is genuinely "ready to engage" and stays pure. Harder — needs deliberate =org-agenda-window-setup= / =display-buffer= handling so the agenda frame is never the jump target (the likeliest rabbit hole). + +** DONE Frame-scoped refresh via org-agenda-redo, wall-clock aligned +- Context: the frame must stay current (now-line, synced events) without re-scanning the file list or churning a timer when it's closed. +- Decision: run =org-agenda-redo= on the agenda buffer every 5 minutes aligned to the :00/:05/:10 mark, started on spawn and cancelled on delete/kill. Not a file-list rebuild — that's the manual force-rescan. +- Consequences: easier — cheap, self-scoped, picks up content changes. Harder — a brand-new project's todo.org won't appear until a manual force-rescan or the 24h cache TTL lapses. + +** DONE No startup auto-open +- Context: the frame could spawn automatically on daemon start. +- Decision: no auto-open. The frame is spawned on demand by =S-<f8>=; there is no auto-open defcustom. +- Consequences: easier — no startup coupling, no small-frame-at-startup edge case, one fewer knob. Harder — none; a standing frame is one keystroke away. + +** DONE Not a separate process — a frame of the daemon +- Context: "its own Emacs" could mean an isolated process or a frame of the running daemon. +- Decision: a frame of the daemon, for live shared state (calendar-sync, edits, now-line). A separate process would only reflect saved-to-disk state. +- Consequences: easier — always current, zero duplicated config load. Harder — no cross-restart persistence; the frame is gone after a daemon restart and re-spawned by its key. + +** DONE Frame-local exit and buffer-kill semantics +- Context: =S-<f8>= is the intended close, but Org's =q=/=Q=/=x= and a buffer-kill can otherwise leave the sole-window fullscreen frame alive on an unrelated buffer. +- Decision: =q=/=Q=/=x= in the agenda frame delete the marked frame and cancel its timer; killing the dedicated agenda buffer deletes the frame too. Ordinary agenda buffers in other frames are unaffected. +- Consequences: easier — the frame can never strand on a non-agenda buffer. Harder — needs frame-local key remaps and a buffer-kill hook scoped to the dedicated buffer. + +** DONE Working-frame target and no-frame fallback +- Context: "the most-recently-selected non-agenda frame" is the intent; the launch frame may be gone, several may exist, or the agenda frame may be the only live frame. +- Decision: engage targets the MRU live non-agenda frame at engagement time; when none exists, create a normal (non-fullscreen) frame and open there. The engage action never falls back into the agenda frame. +- Consequences: easier — a deterministic target in every frame state. Harder — the deleted-launch, multiple-frame, and no-frame cases each need explicit handling and tests. + +** DONE Read-only policy by default-deny, not enumeration +- Context: enumerating =org-agenda-mode-map= command-by-command can't converge (a review always finds a missed key), and =org-agenda-redo='s =kill-all-local-variables= would strip a buffer-local policy on every refresh. +- Decision: a minor mode =cj/agenda-frame-mode= with a =[t]= catch-all denial handler shadows =org-agenda-mode-map= — only an enumerated allowlist (navigation, the engage/open keys routed to the working frame, and the frame's own controls =S-<f8>=/=C-M-<f8>=/=q=/=Q=/=x=/=r=) is permitted; every other key/mouse command shows a read-only or fixed-view message. The enforcement boundary is keys and mouse: the mode removes the Agenda menu-bar in the buffer, and direct =M-x= is out of contract. The mode is re-enabled after each build by =org-agenda-finalize-hook= gated on the frame's =cj/agenda-frame= marker (and by the failed-redo error path), so redo can't strip it. +- Consequences: easier — one rule covers the whole keymap and survives refresh, with nothing to enumerate or keep in sync. Harder — the allowlist and the two message classes (read-only vs fixed-view) need explicit definition and tests. + +** DONE Sticky buffer and failed-redo display lifecycle +- Context: closing the frame left the command-local sticky =*Org Agenda(F)*= buffer alive (a reopen would reuse stale content), and =org-agenda-redo= erases the buffer before rebuilding (a failed redo would show blank/partial). +- Decision: closing the frame by any path also kills the =*Org Agenda(F)*= buffer, so the next spawn regenerates fresh. The refresh keeps a frame-owned last-good snapshot (buffer text with =org-redo-cmd=/=org-lprops=, point, window-start, filter/identity — undecorated; agenda markers *cloned* via =copy-marker= since =org-agenda-reset-markers= nulls the originals on rebuild); a failed redo restores it verbatim, re-enables the policy explicitly, and shows the failure as an overlay; the next tick rebuilds from the preserved =org-redo-cmd=. The clones are released on the next success or on close. The frame is never blank, unrestricted, or non-retryable. +- Consequences: easier — reopen is always current and a failed refresh degrades to stale-but-readable. Harder — the close paths must kill the sticky buffer, and the callback carries a pre-redo snapshot. + +** DONE Refresh-failure recovery: retry, report once +- Context: a failed =org-agenda-redo= tick needs a defined recovery, not "cancel or retry". +- Decision: keep the timer running and retry on the next scheduled tick; report the failure once per consecutive-failure run, naming the next action (=C-M-<f8>= force-rescan or re-spawn); the next successful tick clears the failure state. +- Consequences: easier — a transient failure doesn't kill live refresh, and the user isn't spammed. Harder — needs a small failure-state latch across ticks. + +* Review findings [28/28] + +** DONE Frame view needs its own custom-command entry (avoid the span-8 collision) +=modules/org-agenda-config.el:344-348= already sets =org-agenda-custom-commands= with a =(org-agenda-span 8)= entry. The frame view must be its own custom-command key rather than reusing or editing the existing span-8 entry, and =org-agenda-sticky= is bound in that command's local settings, not globally, so Org derives the dedicated =*Org Agenda(KEY)*= buffer without changing the ordinary =<f8>= behavior. +Response (accept): folded into Design piece 2. + +** DONE Seven-day view is week-anchored, not next-seven-days +=org-agenda-span= 7 alone anchors to Monday in Org 9.7.11 (=org-agenda-start-on-weekday= defaults to 1). The frame command adds =(org-agenda-start-day "0d")= and =(org-agenda-start-on-weekday nil)= (the same pair the daily command uses at :347-349) so the range is today..today+6. +Response (accept): folded into Design piece 2; acceptance criterion added (midweek starts today, ends six days later). + +** DONE Agenda exit paths can abandon the dedicated frame +=q=/=Q=/=x= and a buffer-kill could otherwise leave the sole-window fullscreen frame alive on an unrelated buffer. +Response (accept): added a Decision (frame-local exit + buffer-kill semantics), folded into Design piece 3, and added two acceptance criteria. + +** DONE Working-frame target and fallback are undefined +The launch frame may be gone, several working frames may exist, or the agenda frame may be the only live frame. +Response (accept, with a chosen behavior): target the MRU live non-agenda frame at engagement time; when none exists, create a normal (non-fullscreen) frame and open there (chose Codex's create-a-frame option over a user-facing refusal, so engage always succeeds). Added a Decision, folded into Design piece 3, and added the three frame-state acceptance cases. + +** DONE Phase 1 exposed a frame that violates v1 invariants +The former Phase 1 exposed a fullscreen frame before the sticky buffer and jump routing existed, which is a broken intermediate state. +Response (accept, with a chosen restructure): merged the former Phase 1+2 into a single Phase 1 that ships the dedicated sticky view plus full frame-local navigation/exit routing, so the first user-reachable state is fully isolated. Phases are now 2, not 3. + +** DONE Refresh callback lacks a window-and-focus contract +=org-agenda-redo= reads selected-window state (=window-start=), so a bare =with-current-buffer= tick from another frame can miscalculate or error. +Response (accept): folded into Design piece 4 (select the agenda window for the redo's extent, restore the prior frame/window, no input-focus calls) with an acceptance criterion. + +** DONE Frame and timer test surface is understated +The repo already tests these boundaries (=tests/test-dirvish-config-popup.el= mocks frame lookup/focus/delete; =tests/test-ai-term--project-color.el= drives timer callbacks + a dead-buffer case), so "not cleanly unit-testable" was wrong. +Response (accept): rewrote the Dev-tooling readiness dimension to require ERT coverage across frame lookup, spawn/raise/close, keybindings, sticky-buffer identity, the today-anchored settings, RET/TAB/exit routing, the MRU + no-frame fallback, timer alignment, duplicate-timer prevention, every cancellation path, dead frame/buffer guards, and silent-success/visible-failure behavior, with a live-daemon checklist only for compositor fullscreen/focus. + +** DONE Refresh point-preservation semantics are ambiguous +=org-agenda-redo= preserves a line number, not the same item when lines shift. +Response (accept): folded into Design piece 4 (restore the same =org-marker= when it exists, else clamp to the nearest valid line); Phase 2 carries it. + +** DONE Silent timer conflicts with org-agenda-redo messages +=org-agenda-redo= emits "Rebuilding..." chatter on every run. +Response (accept): folded into Design piece 4 (a wrapper suppresses routine success chatter, surfaces a failure once, and cancels/retries the stale timer); Observability updated; acceptance criterion added. + +** DONE Spawn failure cleanup and error message are undefined +A failure after =make-frame= could leave an orphan frame and partial state. +Response (accept): made spawn transactional in Design piece 1 (on failure: cancel the timer, delete the partial frame/buffer, restore the working frame, report =Agenda frame: <operation> failed: <cause>=); Errors dimension and an acceptance criterion added. + +** DONE Dedicated view identity and window setup remain placeholders +The custom-command key and =org-agenda-window-setup= value are observable behavior, and the Org 9.7.11 default (=reorganize-frame=) would split the frame. +Response (accept): chose key =F= (existing top-level key is =d=) and =(org-agenda-window-setup 'current-window)=, both in the command's local settings; folded into Design piece 2 with an acceptance criterion. + +** DONE Initial agenda-file preparation is undefined +Spawning early after startup could show the base-files-only agenda, since the project-file list is built by an idle timer and =cj/main-agenda-display= calls =cj/build-org-agenda-list= first (:380-391). +Response (accept): spawn runs the cached non-forced =(cj/build-org-agenda-list)= before rendering, and a build failure is part of the transactional spawn (Design piece 1); early-start acceptance criterion added. + +** DONE Read-and-engage command surface conflicts with Org's mutation keys +=org-agenda-mode-map= exposes source-mutating keys the "read + engage only" non-goal doesn't want. +Response (accept, resolved from the existing non-goal): source-mutating keys (TODO-state, schedule/deadline, refile, archive, kill, bulk) are remapped to a read-only message; engage (=RET=) reaches the file to edit it. Added a Decision (read-only command policy), folded into Design piece 3, acceptance criterion added. + +** DONE Source-opening routes beyond RET and TAB are unaccounted for +=SPC=/=DEL= preview, mouse-2, =C-c C-o=, and follow mode can also show source or split the frame. +Response (accept): defined the full class — =RET=/=TAB=/mouse-2/=C-c C-o= route to the working frame; =SPC=/=DEL= and follow mode are disabled in the dedicated buffer. Folded into Design piece 3 (and the read-only-policy Decision); invariant acceptance criterion added. + +** DONE Refresh failure recovery still contains an unresolved branch +"Cancels or safely retries" is two different user-visible outcomes. +Response (accept, chose retry): the timer keeps running and retries next tick; the failure is reported once per consecutive-failure run (naming =C-M-<f8>= / re-spawn), and the next success clears the state. Added a Decision (refresh-failure recovery), folded into Design piece 4, acceptance criterion added. + +** DONE Phase 1 exposes a non-live version of a live feature +The former Phase 1 bound =S-<f8>= before the timer (the "live" contract) existed, shipping a static intermediate. +Response (accept, chose defer-the-binding): Phase 1 now builds the command unbound (reachable only from ERT/=M-x=); Phase 2 adds the timer and only then binds =S-<f8>= and moves the force-rescan. No user-reachable intermediate is non-live. Phases and an acceptance criterion updated. + +** DONE Refresh point restoration lacks duplicate and fallback rules +A source marker can occur twice, and "nearest" was undefined. +Response (accept): restore the same-marker occurrence closest to the old agenda line; if the marker is gone, clamp the old line number into range; header line → first item; empty view → buffer start. Folded into Design piece 4, acceptance criterion added. + +** DONE Phase 1 is still user-reachable through M-x +Phase 1's body made the toggle an interactive command, so =M-x= could still open the non-live intermediate. +Response (accept): Phase 1 now builds only non-interactive helpers (=cj/--agenda-frame-*=); no =interactive= command exists until Phase 2, so it's reachable only from ERT. Phases + acceptance criterion updated. + +** DONE Read-only mutation policy is not exhaustive +Enumerating blocked mutations misses many keys (tags, priority, effort, clock, capture, =C-c C-c=, the menu). +Response (accept, resolved structurally): replaced the denylist with a *default-deny* policy — the =cj/agenda-frame-mode= keymap shadows =org-agenda-mode-map= and permits only a small allowlist; every unlisted command (all mutations, present and future) is denied with the read-only message. Nothing to enumerate. Design piece 3 + the Decision rewritten. + +** DONE Frame-isolation policy omits buffer-opening commands and initial follow state +mouse-3, =C-c C-x b=, clock-goto, calendar, and non-nil =org-agenda-start-with-follow-mode= could still split/replace the frame. +Response (accept): the same default-deny allowlist covers every buffer-opening command (denied unless allowlisted); the dedicated view binds =org-agenda-start-with-follow-mode= nil locally. Folded into Design piece 3. + +** DONE View-changing and manual-redo commands have no dedicated-frame policy +=d=/=w=/=y=, =f=/=b=, =j=, =r=, =g= had no policy against the fixed today-anchored view. +Response (accept, chose fixed view): the seven-day view is fixed — view-changers are denied with a =fixed to the 7-day view= message; =r= is remapped to the frame's safe-redo wrapper (manual version of the timer tick) so a manual refresh uses the failure-latched path; =g= is denied (it targets other buffers). Design piece 3 + acceptance criterion. + +** DONE Org redo discards dedicated buffer-local policy and state +=org-agenda-redo= → =org-agenda-mode= runs =kill-all-local-variables=, stripping a buffer-local map and any buffer-local timer/failure state. +Response (accept): =cj/agenda-frame-mode= is re-enabled after every build by =org-agenda-finalize-hook= gated on the frame's =cj/agenda-frame= marker (a frame parameter, which survives the reset), and the timer/failure state is frame-owned, not buffer-local — so redo can't strip either. Design piece 3 (policy) + Decision; acceptance criterion for policy-survives-redo. + +** DONE Sticky close and reopen freshness is undefined +Closing left the command-local sticky =*Org Agenda(F)*= buffer alive, so a reopen reused stale content. +Response (accept, chose kill-on-close): every close path also kills the sticky buffer, so the next spawn regenerates fresh. Added to Design piece 3 and the buffer-lifecycle Decision; close→change→reopen acceptance criterion. + +** DONE Failed-redo display state is undefined +=org-agenda-redo= erases before rebuilding, so a failure could leave the frame blank/partial. +Response (accept, chose last-known-good): the callback snapshots the last-good buffer before redoing and, on error, restores it with a "refresh failed" header; the frame is never blank/half-built, and the next success replaces it. Design piece 4 + the buffer-lifecycle Decision; acceptance criterion. + +** DONE Required ERT surface was not synchronized with the new contracts +The Dev-tooling dimension still listed the older surface. +Response (accept): expanded it to require ERT for the cached-build early-start, the default-deny policy (denied + allowed keys, both message classes), the policy surviving a redo, sticky kill-on-close / fresh reopen, the failed-redo snapshot restore, the deterministic marker cases, and the Phase-1 no-interactive-entry boundary; only compositor fullscreen/focus stays on the live-daemon checklist. + +** DONE Default-deny does not yet define or enforce the actual interactive surface +The allowlist wasn't concrete (lifecycle keys, =C-g=, scrolling absent), and a minor-mode map can't intercept the Agenda menu or a direct =M-x=, so "every command is intercepted" overclaimed. +Response (accept): enumerated the complete allowlist in Design piece 3 (navigation with concrete commands + =C-g=, engage/open routed to the working frame, and the frame's own controls =S-<f8>=/=C-M-<f8>=/=q=/=Q=/=x=/=r=), and chose the honest enforcement boundary — keys/mouse via the =[t]= catch-all, the Agenda menu-bar removed in the buffer, and direct =M-x= explicitly out of contract. Decision + acceptance updated. + +** DONE Failed-redo rollback is not yet a complete retryable agenda state +The error path didn't re-enable the policy (finalize runs only on success), and the snapshot didn't promise Org properties / point/window/filter / an undecorated copy — so =RET= and the next rebuild weren't guaranteed. +Response (accept): defined a frame-owned last-good snapshot (text + =org-redo-cmd=/=org-lprops=/markers + point/window/filter, undecorated); the error path restores it verbatim, explicitly re-enables =cj/agenda-frame-mode=, and shows the failure as an *overlay* (no header accumulation, no property corruption); the next tick rebuilds from the preserved =org-redo-cmd=. Design piece 4 + the buffer-lifecycle Decision; acceptance for failure-before-finalize, failure→failure, and failure→retry updated. + +** DONE Failed-redo snapshots retain markers only by shallow reference +=org-agenda-reset-markers= nulls the old =org-marker=/=org-hd-marker= objects during rebuild, so a text-property copy holds dead markers and =RET=/=TAB= break after a failed restore. +Response (accept): the snapshot *clones* each agenda marker into a snapshot-owned live marker (=copy-marker= into the unchanged source buffer) and reinstalls the clones on restore, so engage/navigation resolve to the right source line; the clones are released on the next successful build or on frame close, so repeated failures don't leak markers. Design piece 4 + the buffer-lifecycle Decision; ERT covers fail-after-reset → restored-marker targets → repeat → success → clones released. + +* Implementation phases + +** Phase 1 — Frame, view, and routing (private helpers, not user-reachable) +Build the mechanism as *non-interactive* helpers (=cj/--agenda-frame-spawn/-raise/-delete/-toggle=, =cj/agenda-frame-mode=): transactional spawn (cached =(cj/build-org-agenda-list)=, fullscreen =make-frame= + =fullboth= + the =cj/agenda-frame= marker, the dedicated =F= today-anchored seven-day view with =(org-agenda-window-setup 'current-window)= + local sticky), the default-deny read-only policy + source-opening routing to the working frame (MRU live non-agenda frame, or a new normal frame when none exists), and =q=/=Q=/=x=/buffer-kill close that also kills the sticky buffer. No =interactive= command exists yet, so the mechanism is reachable only from ERT — not =M-x=, not a key. Do NOT bind =S-<f8>= and do NOT move the force-rescan. Clean stop: the frame, view, and policy are correct and tested; nothing user-visible changed. + +** Phase 2 — Refresh timer + public command +Add the frame-scoped 5-minute wall-clock =org-agenda-redo= timer (window/focus contract, duplicate-timer prevention, dead frame/buffer guard, deterministic point restoration, retry-and-report-once failure recovery with the pre-redo snapshot restore, message-suppressing wrapper). Then wrap =cj/--agenda-frame-toggle= in the public interactive =cj/agenda-frame-toggle=, bind it to =S-<f8>=, and move =cj/org-agenda-refresh-files= to =C-M-<f8>=. The public gesture appears only when the feature is complete and live — the first user-reachable state is the finished feature. + +* Acceptance criteria +- [ ] =S-<f8>= spawns a fullscreen agenda frame; pressing it from that frame closes it; pressing it from a working frame raises it. +- [ ] =C-M-<f8>= runs the force-rescan (=cj/org-agenda-refresh-files=); =S-<f8>= no longer does. +- [ ] The agenda frame shows a seven-day span and keeps focus on the agenda. +- [ ] Opening a file from an agenda line (=RET=) shows the file in the working frame and raises it; the agenda frame remains on the agenda. +- [ ] A midweek invocation starts today and ends six days later (not Monday-anchored). +- [ ] =q=, =Q=, and =x= in the agenda frame close the frame and cancel its timer; ordinary =<f8>= agenda buffers are unaffected. +- [ ] Killing the dedicated agenda buffer deletes the frame (no orphan fullscreen frame). +- [ ] =RET= with the launch frame deleted, with multiple working frames, and with no working frame each opens the file outside the agenda frame (creating a normal frame in the last case). +- [ ] The frame refreshes on the wall-clock 5-minute mark while open, and no timer runs after it's closed. +- [ ] A refresh tick while another frame is active neither errors nor changes focus. +- [ ] The refresh timer is silent on success and surfaces a failure once with an actionable message. +- [ ] A spawn failure after =make-frame= leaves no orphan frame or timer and reports the failure. +- [ ] Deleting the frame (or killing its buffer) cancels the timer without erroring. +- [ ] The view uses key =F= with =current-window= — the frame stays a single window (no split). +- [ ] A frame spawned right after daemon startup shows the full project agenda (the cached build ran), not the base-files-only view. +- [ ] A source-mutating key (TODO-state, schedule, refile, archive, kill) in the frame shows the read-only message and edits nothing; =SPC=/=DEL= and follow mode don't split the frame; mouse-2 and =C-c C-o= open in the working frame. +- [ ] A failed refresh keeps the timer, reports once per consecutive-failure run, and the next successful tick clears the failure state. +- [ ] Point restoration: a duplicate source marker restores the occurrence nearest the old line; a missing marker clamps the old line into range; header-line and empty-view cases are handled. +- [ ] A denied command in the frame (a mutation, a view-changer like =w=/=d=, a splitting preview) shows the right read-only/fixed-view message and does not act; an allowlisted command (navigation, =RET= engage) works. +- [ ] After a refresh tick (=org-agenda-redo=), a denied command is still blocked — the policy survives =kill-all-local-variables=. +- [ ] Closing the frame kills the =*Org Agenda(F)*= sticky buffer; the next spawn shows fresh content, not the stale sticky buffer. +- [ ] A redo error restores the last-good buffer with a "refresh failed" header; the frame is never blank or half-built. +- [ ] The Agenda menu-bar is absent in the frame; every allowlisted key (=C-g=, scroll, navigation, the lifecycle keys) works and every other key shows the message. +- [ ] After a failed redo the policy is still active (a denied key is still blocked) and =RET=/navigation still work on the restored snapshot with point/filter preserved. +- [ ] Failure → failure shows one overlay and one message (no header/overlay accumulation); failure → success removes the overlay and rebuilds from =org-redo-cmd=. +- [ ] After a failed redo the restored snapshot's cloned markers point at the right source lines (=RET=/=TAB= resolve correctly); on the next success or on close the clones are released (no marker leak across repeated failures). +- [ ] Phase 1 exposes no interactive command — the mechanism is reachable only from ERT (no =M-x=, no key); =S-<f8>= and the =C-M-<f8>= move appear only in Phase 2. +- [ ] The normal =<f8>= full-view agenda is unchanged. + +* Readiness dimensions +- Data model & ownership: N/A — the frame reads existing agenda files; it authors nothing. Refresh is display-only. +- Errors, empty states & failure: an empty agenda renders as org's normal empty agenda in the frame. A frame/buffer killed out from under the timer must cancel the timer rather than error on the next tick — a live-frame/live-buffer guard in the callback. A spawn that fails after =make-frame= is transactional: cancel the timer, delete the partial frame/buffer, restore the working frame, and report =Agenda frame: <operation> failed: <cause>=. +- Security & privacy: N/A — no credentials, no new data surface. +- Observability: the frame is its own visible state; the refresh wrapper is quiet on success and surfaces a failure once with an actionable message. +- Performance & scale: =redo= is cheap and already the manual-refresh path; a 5-minute cadence on one buffer is negligible. The file-list scan (the expensive path) is deliberately not on the tick. +- Reuse & lost opportunities: reuses =make-frame=, =org-agenda-custom-commands=, =org-agenda-sticky=, =org-agenda-redo=, and the F8 family. No new rendering. +- Architecture fit & weak points: integrates at =make-frame= + a frame parameter, the agenda display call, and the F8 keymap. Weak point: jump-to-task display routing across frames; timer lifecycle tied to frame deletion is the other watch point. +- Config surface: the seven-day custom-command view is the one implicit knob. No width, no auto-open flag (both removed by the redesign). +- Documentation plan: an entry in the keybinding/agenda notes; docstrings on the toggle command. No user-facing README beyond that. +- Dev tooling: existing =make test= / byte-compile / live-reload. ERT covers frame lookup, spawn/raise/close, the =S-<f8>=/=C-M-<f8>= rebind, distinct sticky-buffer identity, the today-anchored seven-day settings, the cached-build early-start, the =RET=/=TAB=/mouse/=C-c C-o= engage routing and the MRU + no-frame fallback, the default-deny policy (the full allowlist works including =C-g=/scroll/lifecycle keys, representative denied keys show the right message, the Agenda menu-bar is absent), the policy surviving an =org-agenda-redo= (re-enabled by the finalize hook) and being re-enabled on the failed-redo error path, sticky-buffer kill on close and a fresh reopen, the failed-redo snapshot restore (policy active, =RET=/nav work, point/filter preserved, one overlay across consecutive failures, rebuild-from-=org-redo-cmd= on retry), timer alignment, duplicate-timer prevention, every cancellation path, dead frame/buffer guards, and silent-success/visible-failure behavior — the repo already tests these boundaries (=tests/test-dirvish-config-popup.el= mocks frame lookup/focus/delete; =tests/test-ai-term--project-color.el= drives timer callbacks + a dead-buffer case). One live-daemon checklist covers compositor fullscreen/focus; manual verification supplements, not replaces, the ERT surface. +- Rollout, compatibility & rollback: additive. The one compatibility touch is the =S-<f8>= rebind (force-refresh moves to =C-M-<f8>=). Rollback is removing the command and the binding; nothing persisted changes. +- External APIs & deps: N/A — all built-in Emacs/org. + +* Risks, Rabbit Holes, and Drawbacks +- Jump-to-task display routing across frames is the likeliest rabbit hole: getting =RET= to reliably open in the working frame (not the agenda frame) across =org-agenda-window-setup= values and single-frame states can take fiddling. Dodge: pin the agenda buffer's window-setup and target the file's =display-buffer= at a non-agenda frame explicitly. +- Frame lifecycle: closing or killing the frame must cancel the timer; a killed frame must not error on tick. Dodge: guard the callback and hang cancellation off =delete-frame-functions= / buffer-kill. +- Daemon-only lifetime: the frame is gone after a daemon restart. Accepted (re-spawn by key); noted so it isn't mistaken for a bug. + +* Review and iteration history +** 2026-07-20 Mon @ 13:26:53 -0500 — Claude Code (emacs-d) — responder +- What: dispositioned Codex's sixth-pass marker finding — the snapshot now clones agenda markers (=copy-marker=) instead of holding them by reference, since =org-agenda-reset-markers= nulls the originals on rebuild; restore reinstalls the clones (so =RET=/=TAB= resolve), and they're released on the next success or on close. Added the vNext note (Hyprland-managed window with its own keybind, once the in-Emacs frame proves out). All 28 findings and 13 decisions resolved. Craig accepted the spec for build, so flipped =DRAFT= → =READY=. +- Why: the marker fix is a real correctness point (a text-property copy holds dead markers). With it folded, the spec is behavior-complete; Craig's call is to build v1 rather than run further review rounds. +- Artifacts: all Review findings DONE [28/28]; Decisions [13/13]; status =READY=, mirror =ready=. Six review/response rounds total; the default-deny structural pivot (12:26) was the turning point. +** 2026-07-20 Mon @ 13:07:58 -0500 — Codex (emacs-d) — reviewer +- What: re-ran the full readiness gate after all 27 prior findings were dispositioned. Verdict: Not ready. Added one blocking finding: a failed-redo snapshot must clone or reconstruct live agenda markers rather than retain shallow text-property references. +- Why: Org 9.7.11 calls =org-agenda-reset-markers= during regeneration, moving the old =org-marker=/=org-hd-marker= objects to nil. Emacs text-property snapshots retain those same objects, so the promised verbatim restore cannot support =RET=/=TAB= after a failed rebuild without an explicit marker-copy and cleanup contract. +- Artifacts: this spec's =Review findings [27/28]=. Source checks: =org-agenda-redo=, =org-agenda-prepare=, =org-agenda-reset-markers=, =org-agenda-new-marker=, and =org-agenda-goto= in installed Emacs 30.2 / Org 9.7.11; a batch check confirmed the snapshot property and source property hold the same marker object and both become dead after reset. +** 2026-07-20 Mon @ 12:59:00 -0500 — Claude Code (emacs-d) — responder +- What: dispositioned both of Codex's fifth-pass findings. (1) Enumerated the complete default-deny allowlist (navigation commands + =C-g= + scroll, engage/open routed out, and the frame's own controls =S-<f8>=/=C-M-<f8>=/=q=/=Q=/=x=/=r=) and set the honest enforcement boundary — keys/mouse via the =[t]= catch-all, the Agenda menu-bar removed in the buffer, direct =M-x= out of contract (dropped the overclaim that "every command" is intercepted). (2) Made the failed-redo rollback a complete retryable state: a frame-owned last-good snapshot carrying Org properties (=org-redo-cmd=/=org-lprops=/markers), point/window/filter, undecorated; the error path restores it and *explicitly re-enables the policy* (finalize only runs on success), shows the failure as an *overlay* (no accumulation, no property corruption), and the next tick rebuilds from the preserved =org-redo-cmd=. +- Why: Codex accepted the default-deny structure but flagged the two absolute claims it hadn't yet backed — the map can't cover the menu/M-x, and a text-only snapshot doesn't guarantee a re-enabled, retryable agenda. Both are now bounded by an explicit contract. +- Artifacts: all Review findings DONE [27/27]; Decisions [13/13] (the read-only and buffer-lifecycle Decisions were tightened, not added). Status stays DRAFT pending Codex's re-review. +** 2026-07-20 Mon @ 12:47:44 -0500 — Codex (emacs-d) — reviewer +- What: verified the renamed spec and all 25 resolved findings against installed Org's key dispatch, finalize, redo, and text-property behavior. Verdict: Not ready. Added two blocking findings: the default-deny map's exact/enforced interaction boundary and the failed-redo snapshot's policy-enabled, metadata-preserving retry contract. +- Why: the new structural design closes the earlier enumeration and sticky-lifecycle problems, but its remaining absolute claims exceed what a minor-mode map and a text-only rollback guarantee. Both gaps would make the implementer choose observable behavior and could leave the frame unrestricted or permanently stale after a failed refresh. +- Artifacts: this spec's =Review findings [25/27]=. Source checks: =org-agenda-mode-map=, =org-agenda-mode=, =org-agenda-finalize=, =org-agenda-redo=, and the =org-redo-cmd=/=org-lprops= text-property flow in installed Emacs 30.2 / Org 9.7.11. Filename/location precondition passes after the tracked rename. +** 2026-07-20 Mon @ 12:26:29 -0500 — Claude Code (emacs-d) — responder +- What: dispositioned all 8 of Codex's fourth-pass findings — accepted every one. The key change is structural: replaced the command-by-command enumeration (which the prior two rounds proved can't converge against a ~100-entry keymap) with a *default-deny* policy — a =cj/agenda-frame-mode= minor mode shadows =org-agenda-mode-map= and permits only a small allowlist, so all mutations / buffer-openers / view-changers are denied in one rule (closes findings 2, 3, 4). Re-enabled via =org-agenda-finalize-hook= keyed on the frame marker so =org-agenda-redo='s =kill-all-local-variables= can't strip it, with timer/failure state frame-owned (finding 5). Close kills the sticky buffer (finding 6); failed redo restores a pre-redo snapshot (finding 7); Phase 1 is non-interactive helpers only (finding 1); the ERT surface is synced (finding 8). Fixed the 7-day view, remapped =r= to the safe wrapper, bound follow-mode nil locally. Rewrote the read-only Decision to default-deny and added one (buffer/failed-redo lifecycle) — 13 Decisions. +- Why: the fourth review showed the earlier responses were enumerating a keymap instead of stating a policy — the root cause of the round-over-round regress. Default-deny covers the whole map in one rule and terminates. +- Artifacts: all Review findings DONE [25/25]; Decisions [13/13]. Status stays DRAFT pending Codex's re-review. +** 2026-07-20 Mon @ 12:11:31 -0500 — Codex (emacs-d) — reviewer +- What: verified all 17 prior findings against the current repo and installed Org, then traced every agenda command/lifecycle path through regeneration and sticky reuse. Verdict: Not ready. Added eight blocking findings covering the still-interactive Phase 1, incomplete mutation/display/view/manual-redo policies, loss of dedicated local state on redo, stale sticky reopen, failed-redo display state, and the unsynchronized ERT matrix. +- Why: the chosen values from the prior response are viable, but implementation would still require behavior and state-ownership decisions. In particular, Org's full keymap is broader than the enumerated commands, =org-agenda-mode= resets the local map during every redo, and command-local sticky agendas reuse a closed buffer without regenerating it. +- Artifacts: this spec's =Review findings [17/25]=. Source checks: =org-agenda-mode-map=, =org-agenda-mode=, =org-agenda-prepare=, =org-agenda-use-sticky-p=, =org-agenda-redo=, =org-agenda-goto-calendar=, =org-agenda-tree-to-indirect-buffer=, and =org-agenda-clock-goto= in installed Emacs 30.2 / Org 9.7.11; current hooks and display rules in =modules/org-agenda-config.el=. +** 2026-07-20 Mon @ 12:02:00 -0500 — Claude Code (emacs-d) — responder +- What: dispositioned all 7 of Codex's third-pass findings — accepted every one; four carried a chosen behavior. View identity: key =F= + =(org-agenda-window-setup 'current-window)=. Command policy: source-mutating keys read-only-remapped, all source-opening keys routed to the working frame, preview/follow disabled. Refresh failure: retry + report-once-per-run. Phase safety: Phase 1 builds the command unbound, Phase 2 adds the timer and the =S-<f8>= binding. Also pinned the cached-build-on-spawn and the point-restoration tie-break. Added three Decisions (read-only policy, refresh-failure recovery, plus the earlier two = now 12), and expanded acceptance criteria. +- Why: Craig's strict gate — no behavior decision deferred to implementation. Codex's third pass named seven still-open keymap/lifecycle choices against the installed Org 9.7.11; each is now pinned with a concrete value. +- Artifacts: all Review findings DONE [17/17]; Decisions [12/12]. The read-only mutation policy was resolved from the existing "read + engage only" non-goal, not a fresh product call — flip it if in-agenda mutation was actually wanted. Status stays DRAFT pending Codex's re-review. +** 2026-07-20 Mon @ 11:29:33 -0500 — Codex (emacs-d) — reviewer +- What: re-ran the authoritative code-grounded review after all 10 earlier findings were dispositioned. Verdict: Not ready. Added seven blocking findings covering the exact dedicated-command identity/window setup, initial agenda-file preparation, read-versus-mutate command policy, source-opening commands beyond =RET=/=TAB=, refresh-failure recovery, safe phase exposure, and deterministic point restoration. +- Why: Craig set the stricter gate that no behavior decision may be deferred to implementation. The revised spec closes the earlier findings, but still contains explicit alternatives and conflicts with the installed Org keymap and this repo's deferred agenda-file initialization. +- Artifacts: this spec's =Review findings [10/17]=. Source checks: =modules/org-agenda-config.el:186-220,344-391,431-433= and =org-agenda-mode-map=, =org-agenda-prepare-window=, =org-agenda-goto=, =org-agenda-open-link=, and =org-agenda-show-and-scroll-up= in installed Emacs 30.2 / Org 9.7.11. +** 2026-07-20 Mon @ 10:22:00 -0500 — Claude Code (emacs-d) — responder +- What: dispositioned all 10 of Codex's findings — accepted every one, two with a chosen behavior. Working-frame fallback: the MRU live non-agenda frame, creating a normal frame when none exists (Codex's create-a-frame option over a refusal). Phase safety: merged the former Phase 1+2 into one isolated Phase 1 so no broken intermediate state ships. Folded the resolutions into Design (transactional spawn, today-anchored sticky seven-day view, frame-local navigation/exit routing, refresh window/focus contract + message wrapper + org-marker restore), added two Decisions (exit semantics, working-frame fallback), cut to 2 phases, and expanded the acceptance criteria and the Dev-tooling test surface. +- Why: Codex's code-grounded re-review found six blocking gaps the first (my) review missed — week anchoring, exit lifecycle, working-frame fallback, phase safety, refresh window context, and the understated test surface. Each needed the spec to specify behavior it had left implicit. +- Artifacts: all Review findings DONE [10/10]; Decisions [10/10]. Status stays DRAFT pending a re-review to confirm the responses close the blockers. +** 2026-07-20 Mon @ 10:12:30 -0500 — Codex (emacs-d) — reviewer +- What: independently re-ran the full spec-review against =modules/org-agenda-config.el=, its ERT coverage, relevant frame/timer precedent, and the installed Emacs 30.2 / Org 9.7.11 source. Verdict: Not ready. Added six blocking and three non-blocking findings; retained the prior non-blocking custom-command finding. +- Why: the first review checked the local F8 premises but did not trace Org's seven-day anchoring, sticky exit behavior, cross-frame jump boundaries, selected-window dependency during redo, phase-by-phase safety, or the repository's existing frame/timer test patterns. Those gaps would force implementation decisions or ship broken intermediate behavior. +- Artifacts: this spec's =Review findings [0/10]=; lifecycle demoted =READY= → =DRAFT= and Metadata mirrored to =draft=. Source checks: =org-agenda-list=, =org-agenda-quit=, =org-agenda-redo=, =org-agenda-switch-to=, and =org-agenda-goto= in Org 9.7.11. +** 2026-07-20 Mon @ 09:53:02 -0500 — Claude Code (emacs-d) — reviewer +- What: spec-review of the redesigned spec. Verdict READY. Read =modules/org-agenda-config.el= first — confirmed =cj/org-agenda-refresh-files= is bound to =S-<f8>= (:232), the =cj/--org-agenda-display-rule= / =cj/org-agenda-window-height= 0.75 rule (:27-37), and =<f8>= = =cj/main-agenda-display= (:392), so the rebind and override premises hold. All 8 decisions resolved (cookie complete); phases decompose cleanly into 3 sessions; no blocking finding. One non-blocking finding recorded: the frame's seven-day view needs its own custom-command entry (the code already has a span-8 entry). +- Why: gate the DRAFT → READY transition before decomposing the build. The reworked design has no unverified API assumptions (all built-in Emacs/org) and no data/security surface. +- Artifacts: this spec's Review findings [0/1]; flipped status heading DRAFT → READY and the Metadata mirror. +** 2026-07-20 Mon @ 09:45:00 -0500 — Craig Jennings — redesign +- What: replaced the right-side side-window dock with a dedicated fullscreen frame of the daemon. Resolved all eight decisions: fullscreen frame (not side window, not separate process), =S-<f8>= toggle, seven-day span, focus-on-agenda, jump-to-task opens in the working frame, frame-scoped 5-min redo, no startup auto-open. +- Why: Craig wants a standing, fullscreen agenda surface placeable on its own workspace/monitor, sharing the daemon's live state, rather than a dock bounded to the working frame. +- Artifacts: this spec; the dock-mode task in todo.org (Emacs Open Work). +** 2026-07-17 Fri @ 19:34:07 -0500 — Craig Jennings — author +- What: initial draft (right-side side-window dock). +- Why: dock mode had four-plus open design questions and real trade-offs; settling them on paper before code. +- Artifacts: dock-mode task in todo.org (Emacs Open Work); supersedes the folded "auto-refresh every 5 min" roam item. diff --git a/docs/specs/ai-kb-spec.org b/docs/specs/ai-kb-spec.org index b35b3ac6..6d973b94 100644 --- a/docs/specs/ai-kb-spec.org +++ b/docs/specs/ai-kb-spec.org @@ -19,7 +19,7 @@ In scope: Step 1 (store + contract/CLI + global rule + provisioning) and Step 2 * Scope decision: memory store, not (yet) an LLM Wiki -ai-kb v1 is a *global, durable, cross-project memory store* for AI coding agents (Claude Code today; agent-neutral by contract): org-roam nodes holding lessons, principles, Craig's preferences, reusable procedures, and durable observations. It is the concrete first slice of the broader "org-roam as agent memory" vision in [[file:agentic-knowledgebase.org][agentic-knowledgebase.org]]. +ai-kb v1 is a *global, durable, cross-project memory store* for AI coding agents (Claude Code today; agent-neutral by contract): org-roam nodes holding lessons, principles, Craig's preferences, reusable procedures, and durable observations. It is the concrete first slice of the broader "org-roam as agent memory" vision in [[file:../design/agentic-knowledgebase.org][agentic-knowledgebase.org]]. It is *not* a Karpathy-style LLM Wiki in v1. That pattern — immutable =raw/= sources, compiled =wiki/= synthesis pages, =schema.org=, source hashes, and full ingest/query/lint pipelines — is a larger product whose value is *grounding compiled knowledge in re-checkable sources*. v1 adopts the one piece that pays off immediately: a =raw/= capture for *external* sources (see [[*Grounding external sources][Grounding external sources]]). The rest of that machinery is the documented evolution path (see [[*vNext][vNext]]); v1's structure is chosen so it can grow that way without a rewrite. diff --git a/docs/specs/keybinding-console-safety-spec.org b/docs/specs/keybinding-console-safety-spec.org index c7d1baf7..5fd7d52c 100644 --- a/docs/specs/keybinding-console-safety-spec.org +++ b/docs/specs/keybinding-console-safety-spec.org @@ -4,14 +4,15 @@ #+TODO: TODO | DONE #+TODO: DRAFT READY DOING | IMPLEMENTED SUPERSEDED CANCELLED -* DOING Keymap Consolidation — Spec +* READY Keymap Consolidation — Spec :PROPERTIES: :ID: 540bf06b-16b8-46c6-b459-c40d1b9c795d :END: +- 2026-07-21 Tue @ 07:07 -0500 — DOING → READY: the DOING was a legacy :STATUS: retrofit with no build tasks ever decomposed, and the primary work has not started (the key-translation layer is still live in keyboard-compat.el, M-S- bindings global). READY is the honest state: design settled per Path 2, awaiting decomposition. Flipped in the 2026-07-21 board review with Craig. - 2026-07-04 Sat @ 15:30:41 -0500 — retrofitted to status-heading convention; keyword DOING from existing :STATUS: doing * Metadata -| Status | doing | +| Status | ready | |----------+--------------------------------------------------------------------| | Owner | Craig Jennings | |----------+--------------------------------------------------------------------| @@ -572,7 +573,7 @@ source module. - M-S-o — cj/kill-other-window — kill the other window's buffer and close it — undead-buffers.el - M-S-m — cj/kill-all-other-buffers-and-windows — close all other windows, kill their buffers — undead-buffers.el - M-S-y — yank-media — paste an image/media object from the clipboard — keybindings.el -- M-S-f — fontaine-set-preset — switch the font preset — font-config.el +- M-S-f — cj/fontaine-select-profile — switch the workflow font profile — font-config.el - M-S-w — wttrin — show the weather report — weather-config.el - M-S-e — eww — open the EWW web browser — eww-config.el - M-S-l — cj/switch-themes — select/cycle the theme — ui-theme.el diff --git a/docs/specs/theme-studio-package-faces-spec.org b/docs/specs/theme-studio-package-faces-spec.org index 4390f0fc..6e431dd5 100644 --- a/docs/specs/theme-studio-package-faces-spec.org +++ b/docs/specs/theme-studio-package-faces-spec.org @@ -552,7 +552,7 @@ generalized face-control helper, package style kept inside the package object, - *Why:* The direction is coherent and the first-round decisions are folded in, but v1 now depends on behavior that is not yet implementable from the current static generator without a defined inventory and state/export contract. -- *Artifacts:* [[file:theme-studio-package-faces-spec-review.org][theme-studio-package-faces-spec-review.org]] +- *Artifacts:* =theme-studio-package-faces-spec-review.org= ** 2026-06-07 Sun @ 18:28:02 -0500 — Claude Code (emacs-d) — responder - *What:* Ran spec-response against the Codex review. Added Implementation diff --git a/docs/specs/theme-studio-palette-generator-spec.org b/docs/specs/theme-studio-palette-generator-spec.org index 2d8fc5c6..ab84894c 100644 --- a/docs/specs/theme-studio-palette-generator-spec.org +++ b/docs/specs/theme-studio-palette-generator-spec.org @@ -278,7 +278,7 @@ Use the existing Theme Studio test stack: - Manual Chrome pass on at least one dark palette and one light palette. * References / Appendix -- [[file:design/theme-studio-color-harmony.org][theme-studio color harmony explainer]] +- [[file:../design/theme-studio-color-harmony.org][theme-studio color harmony explainer]] - [[id:15db8ae3-fc14-49f3-9ed5-d5ff59790904][perceptual color metrics spec]] - [[file:theme-studio-palette-ramps-spec.org][palette ramps and contrast safety spec]] - [[file:theme-studio-palette-columns-spec.org][palette columns spec]] diff --git a/docs/specs/theme-studio-perceptual-color-metrics-spec.org b/docs/specs/theme-studio-perceptual-color-metrics-spec.org index 233632a5..f84bc5bb 100644 --- a/docs/specs/theme-studio-perceptual-color-metrics-spec.org +++ b/docs/specs/theme-studio-perceptual-color-metrics-spec.org @@ -510,7 +510,7 @@ Modified or rejected recommendations only; everything else in the Codex review values or make that second chromatic fixture optional. - *Why:* The implementation is otherwise ready-shaped, but APCA math and numeric fixtures need a single authoritative source before coding starts. -- *Artifacts:* [[file:theme-studio-perceptual-color-metrics-spec-review.org][theme-studio-perceptual-color-metrics-spec-review.org]] +- *Artifacts:* =theme-studio-perceptual-color-metrics-spec-review.org= ** 2026-06-08 Mon @ 13:19:15 -0500 — Claude Code — responder - *What changed:* Processed Codex's second pass. Accepted all three findings, no diff --git a/docs/specs/theme-studio-semantic-theme-architecture-spec.org b/docs/specs/theme-studio-semantic-theme-architecture-spec.org index cab75712..cc46d336 100644 --- a/docs/specs/theme-studio-semantic-theme-architecture-spec.org +++ b/docs/specs/theme-studio-semantic-theme-architecture-spec.org @@ -258,8 +258,8 @@ Rollout should keep the current flat output path as the default and add a separa * References / Appendix - Modus Themes source: [[https://github.com/protesilaos/modus-themes][github.com/protesilaos/modus-themes]] -- Current converter: [[file:../scripts/theme-studio/build-theme.el][scripts/theme-studio/build-theme.el]] -- Current Theme Studio README: [[file:../scripts/theme-studio/README.md][scripts/theme-studio/README.md]] +- Current converter: [[file:../../scripts/theme-studio/build-theme.el][scripts/theme-studio/build-theme.el]] +- Current Theme Studio README: [[file:../../scripts/theme-studio/README.md][scripts/theme-studio/README.md]] - Package-face model spec: [[id:8f37a1fd-cfd3-4b25-92e5-772468092bdc][theme-studio-package-faces-spec.org]] * Review and iteration history diff --git a/githooks/pre-commit b/githooks/pre-commit index 909cde22..a87bedf8 100755 --- a/githooks/pre-commit +++ b/githooks/pre-commit @@ -5,15 +5,37 @@ set -u REPO_ROOT="$(git rev-parse --show-toplevel)" -cd "$REPO_ROOT" +cd "$REPO_ROOT" || exit 1 # --- 1. Secret scan --- # Patterns for common credentials. Scans only added lines in the staged diff. -SECRET_PATTERNS='(AKIA[0-9A-Z]{16}|sk-[a-zA-Z0-9_-]{20,}|-----BEGIN (RSA|DSA|EC|OPENSSH|PGP)( PRIVATE)?( KEY| KEY BLOCK)?-----|(api[_-]?key|api[_-]?secret|auth[_-]?token|secret[_-]?key|bearer[_-]?token|access[_-]?token|password)[[:space:]]*[:=][[:space:]]*["'"'"'][^"'"'"']{16,}["'"'"'])' +# +# Two passes because case-sensitivity differs. AWS keys are uppercase, sk- keys +# lowercase, PEM headers fixed, so those match case-SENSITIVELY: under -i, +# AKIA[0-9A-Z]{16} matches any mixed-case 20-char run, which random base64 in an +# embedded image blob hits ~6% of the time per 100KB and blocks real commits. +# Only the keyword=value patterns need -i. +SECRET_PATTERNS_CS='(AKIA[0-9A-Z]{16}|sk-[a-zA-Z0-9_-]{20,}|-----BEGIN (RSA|DSA|EC|OPENSSH|PGP)( PRIVATE)?( KEY| KEY BLOCK)?-----)' +SECRET_PATTERNS_CI='(api[_-]?key|api[_-]?secret|auth[_-]?token|secret[_-]?key|bearer[_-]?token|access[_-]?token|password)[[:space:]]*[:=][[:space:]]*["'"'"'][^"'"'"']{16,}["'"'"']' -secret_hits="$(git diff --cached -U0 --diff-filter=AM \ - | grep '^+' | grep -v '^+++' \ - | grep -iEn "$SECRET_PATTERNS" || true)" +# Read the diff on its own so a git failure is distinguishable from "grep +# matched nothing". Both end in a non-zero status, but only one of them means +# there is nothing to scan; piping them together and swallowing the result with +# `|| true` made a broken git look like a clean commit — the scan searched an +# empty string, found nothing, and the secret went in. +if ! staged_diff="$(git diff --cached -U0 --diff-filter=AM)"; then + echo "pre-commit: cannot read the staged diff — refusing to skip the secret scan" >&2 + exit 1 +fi + +# The greps keep their `|| true`: exiting 1 on no match is their normal result. +added_lines="$(printf '%s\n' "$staged_diff" | grep '^+' | grep -v '^+++' || true)" + +cs_hits="$(printf '%s\n' "$added_lines" | grep -nE "$SECRET_PATTERNS_CS" || true)" +ci_hits="$(printf '%s\n' "$added_lines" | grep -niE "$SECRET_PATTERNS_CI" || true)" +# awk dedupes lines both passes matched, keeping first-seen order. +secret_hits="$(printf '%s\n%s' "$cs_hits" "$ci_hits" \ + | grep -v '^[[:space:]]*$' | awk '!seen[$0]++' || true)" if [ -n "$secret_hits" ]; then echo "pre-commit: potential secret in staged changes:" >&2 @@ -25,7 +47,14 @@ if [ -n "$secret_hits" ]; then fi # --- 2. Paren check on staged .el files --- -staged_el="$(git diff --cached --name-only --diff-filter=AM | grep '\.el$' || true)" +# Same split as the secret scan above: a git failure must not read as "no files +# staged", which would skip the language check silently. +if ! staged_names="$(git diff --cached --name-only --diff-filter=AM)"; then + echo "pre-commit: cannot read the staged file list — refusing to skip the check" >&2 + exit 1 +fi + +staged_el="$(printf '%s\n' "$staged_names" | grep '\.el$' || true)" if [ -n "$staged_el" ]; then paren_fail="" @@ -129,6 +129,7 @@ (require 'org-config) ;; basic org-mode settings (require 'org-faces-config) ;; custom themeable faces for agenda keywords + priorities (require 'org-agenda-config) ;; agenda, task tracking, and notifications +(require 'agenda-query) ;; agenda window as JSON for external renderers (require 'org-babel-config) ;; org-mode prog blocks; literate programming (require 'org-capture-config) (require 'org-contacts-config) ;; fully integrated org-mode contacts management diff --git a/modules/agenda-query.el b/modules/agenda-query.el new file mode 100644 index 00000000..c98b7fb7 --- /dev/null +++ b/modules/agenda-query.el @@ -0,0 +1,607 @@ +;;; agenda-query.el --- Agenda window as JSON for external renderers -*- lexical-binding: t; coding: utf-8; -*- +;; author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; +;; Layer: 3 (Domain Workflow). +;; Category: D/S. +;; Load shape: eager module, lazy dependencies. +;; Eager reason: the entry point must exist for a headless emacsclient --eval. +;; Org is required at call time, so loading the BYTE-COMPILED module costs no +;; startup; loading it from source pays the eval-when-compile requires below. +;; Top-level side effects: none once compiled. +;; Runtime requires: org, org-element, org-agenda, calendar -- all deferred. +;; Direct test load: yes. +;; +;; Answers "what is on the agenda between these two instants" as JSON, so a +;; renderer running outside Emacs can draw it. Both entry points read +;; `org-agenda-files' and leave every buffer unmodified. +;; +;; Two output profiles over one query. `cj/agenda-window-json' is canonical: +;; epoch seconds, descriptive field names, and a null end where the source has +;; no range. `cj/agenda-render-json' adds what the wallpaper renderer reads -- +;; s and e in epoch MILLISECONDS, t for the title, and an end every row can +;; actually be drawn with. `cj/agenda-render-cache-update' writes that profile +;; for today to `cj/agenda-render-cache-file'. +;; +;; Epoch seconds at the boundary is the load-bearing interface choice. It takes +;; timezone out of the contract entirely: the consumer does its own zoneinfo +;; conversion, and nothing downstream needs to know org's timestamps are naive +;; local time. DST changeovers stop being a special case for the same reason. +;; +;; The window predicate is intersection, not containment: an event is in the +;; window when it is running at any point during it, so a 23:00-01:00 event +;; belongs to both days it touches. An all-day entry's extent is its whole day. + +;;; Code: + +;; Compile-time only, so the byte-compiler sees org's functions while a plain +;; load of this file still pulls in nothing. +(eval-when-compile + (require 'org) + (require 'org-element) + (require 'org-agenda) + (require 'calendar)) + +(declare-function org-element--property "org-element-ast") +(declare-function org-element-map "org-element") +(declare-function org-element-parse-buffer "org-element") +(declare-function org-element-type "org-element-ast") +(declare-function org-entry-get "org") +(declare-function org-agenda--timestamp-to-absolute "org-agenda") +(declare-function org-agenda-files "org") +(declare-function org-get-agenda-file-buffer "org") +(declare-function calendar-gregorian-from-absolute "calendar") +(declare-function calendar-absolute-from-gregorian "calendar") + +(defconst cj/agenda-query-max-window-seconds (* 366 24 60 60) + "Widest window `cj/agenda-window-json' will answer, in seconds. + +A guard against a units mistake rather than a policy limit. The consumers are +Python and JavaScript, and `Date.now' returns MILLISECONDS -- passing that +unconverted asks for a window tens of thousands of years wide, which builds +millions of rows and wedges the Emacs daemon Craig is working in. Failing +loudly costs a renderer one bad frame; the alternative costs him his editor.") + +(defconst cj/agenda-query-epoch-floor -2208988800 + "Earliest epoch second `cj/agenda-window-json' accepts (1900-01-01).") + +(defconst cj/agenda-query-epoch-ceiling 7258118400 + "Latest epoch second `cj/agenda-window-json' accepts (2200-01-01). + +Width alone does not catch the units mistake. Passing `Date.now()' for BOTH +bounds an hour apart is a plausible-looking 41-day window made of milliseconds, +which sails past the width cap and answers with timestamps in the year 58549. +Bounding the magnitude catches that shape, while still spanning any date an +agenda could legitimately hold.") + +(defun cj/--agenda-query-load-org () + "Load org at call time. +Kept off the top level so requiring this module costs nothing at startup -- +the entry point runs headless, long after Emacs is up. Idempotent." + (require 'org) + (require 'org-element) + (require 'org-agenda) + (require 'calendar)) + +;;; ---------- time helpers ---------- + +(defun cj/--agenda-query-epoch (sec min hour day month year) + "Return the epoch second for local time SEC MIN HOUR DAY MONTH YEAR. +Out-of-range fields normalize, so day 32 of July is the 1st of August." + (time-convert (encode-time (list sec min hour day month year nil -1 nil)) + 'integer)) + +(defun cj/--agenda-query-day-close (day month year) + "Return the last epoch second of the local day DAY MONTH YEAR. +Reached through the following midnight rather than by adding 86400, so a DST +changeover day is 23 or 25 hours long as it actually is." + (1- (cj/--agenda-query-epoch 0 0 0 (1+ day) month year))) + +(defun cj/--agenda-query-epoch-to-absolute (epoch) + "Return the absolute day number containing EPOCH, in local time." + (let ((d (decode-time epoch))) + (calendar-absolute-from-gregorian (list (nth 4 d) (nth 3 d) (nth 5 d))))) + +(defun cj/--agenda-query-day-close-of (absolute) + "Return the last epoch second of the ABSOLUTE day number." + (let ((g (calendar-gregorian-from-absolute absolute))) + (cj/--agenda-query-day-close (nth 1 g) (nth 0 g) (nth 2 g)))) + +(defun cj/--agenda-query-at-time-on (absolute hour minute) + "Return the epoch of HOUR:MINUTE local on the ABSOLUTE day number." + (let ((g (calendar-gregorian-from-absolute absolute))) + (cj/--agenda-query-epoch 0 minute hour (nth 1 g) (nth 0 g) (nth 2 g)))) + +;;; ---------- timestamp bounds ---------- + +(defun cj/--agenda-query-timestamp-bounds (timestamp) + "Return a bounds plist for org-element TIMESTAMP, or nil when it is nil. + +Keys are :start, :end, :all-day and :effective-end, all epoch seconds except +:all-day. :end is nil when the source carries no range at all; where the +source does carry one, an all-day range's end is the close of its last day, +since a day is its own extent. :effective-end is what the window predicate +uses: the explicit end, or an all-day entry's day close, or a timed point +event's own instant. + +One deliberate divergence from org's literal parse: org records +<2026-07-31 Fri 23:00-01:00> with its end on the SAME day, which would put the +end 22 hours before the start. A negative duration is useless to any +consumer, so an end that precedes its start is read as crossing midnight." + (when timestamp + (let* ((y0 (org-element-property :year-start timestamp)) + (m0 (org-element-property :month-start timestamp)) + (d0 (org-element-property :day-start timestamp)) + (h0 (org-element-property :hour-start timestamp)) + (mi0 (org-element-property :minute-start timestamp)) + (y1 (org-element-property :year-end timestamp)) + (m1 (org-element-property :month-end timestamp)) + (d1 (org-element-property :day-end timestamp)) + (h1 (org-element-property :hour-end timestamp)) + (mi1 (org-element-property :minute-end timestamp)) + (all-day (null h0)) + (start (cj/--agenda-query-epoch 0 (or mi0 0) (or h0 0) d0 m0 y0)) + (ranged (or (not (equal (list y0 m0 d0) (list y1 m1 d1))) + (and h1 (not (equal (list h0 mi0) (list h1 mi1)))))) + (same-day (equal (list y0 m0 d0) (list y1 m1 d1))) + (end (when ranged + (if all-day + ;; A reversed all-day range (a typo, or a bad ICS + ;; import) would otherwise report an end days before + ;; its start, and the negative extent would drop the + ;; entry from the very window it opens in. + (let ((e (cj/--agenda-query-day-close d1 m1 y1))) + (and (>= e start) e)) + (let ((e (cj/--agenda-query-epoch + 0 (or mi1 0) (or h1 0) d1 m1 y1))) + ;; Roll only a SAME-DAY range: that is the shape org + ;; records for <23:00-01:00>. Rolling a genuinely + ;; reversed multi-day range would just shift a wrong + ;; date by a day and leave it wrong. + (when (and same-day (< e start)) + (setq e (cj/--agenda-query-epoch + 0 (or mi1 0) (or h1 0) (1+ d1) m1 y1))) + ;; A range that still ends before it starts is + ;; malformed. Report the entry as a point rather than + ;; hand a consumer a negative-duration bar. + (and (>= e start) e)))))) + (list :start start + :end end + :all-day (and all-day t) + :effective-end (or end + (if all-day + (cj/--agenda-query-day-close d0 m0 y0) + start)))))) + +(defun cj/--agenda-query-repeater-cookie (timestamp) + "Return TIMESTAMP's raw repeater cookie as a string, or nil when it has none." + (when timestamp + (let ((type (org-element-property :repeater-type timestamp)) + (value (org-element-property :repeater-value timestamp)) + (unit (org-element-property :repeater-unit timestamp))) + (when (and type value unit) + (concat (pcase type + ('cumulate "+") + ('catch-up "++") + ('restart ".+") + (_ "+")) + (number-to-string value) + (pcase unit + ('hour "h") ('day "d") ('week "w") + ('month "m") ('year "y") (_ ""))))))) + +;;; ---------- window intersection and repeat expansion ---------- + +(defun cj/--agenda-query-intersects-p (start effective-end win-start win-end) + "Return non-nil when START..EFFECTIVE-END overlaps WIN-START..WIN-END." + (and (>= effective-end win-start) + (<= start win-end))) + +(defun cj/--agenda-query-occurrence-on (day base bounds) + "Return the (START . END) cons and effective end for an occurrence on DAY. + +DAY is an absolute day number, BASE the base occurrence's own absolute day, +and BOUNDS its `cj/--agenda-query-timestamp-bounds' plist. Returns a plist +of :start, :end and :effective-end. + +Every field is rebuilt from calendar dates rather than by adding the base's +duration in seconds. A fixed offset is wrong across a DST boundary: an +all-day occurrence on a 25-hour day would end an hour early, and on a 23-hour +day it would spill into the next." + (let* ((start (plist-get bounds :start)) + (end (plist-get bounds :end)) + (all-day (plist-get bounds :all-day)) + (decoded (decode-time start)) + (span (if end + (- (cj/--agenda-query-epoch-to-absolute end) base) + 0)) + (occ-start (cj/--agenda-query-at-time-on + day (nth 2 decoded) (nth 1 decoded))) + (occ-end (when end + (if all-day + (cj/--agenda-query-day-close-of (+ day span)) + (let ((de (decode-time end))) + (cj/--agenda-query-at-time-on + (+ day span) (nth 2 de) (nth 1 de))))))) + (list :start occ-start + :end occ-end + :effective-end (or occ-end + (if all-day + (cj/--agenda-query-day-close-of day) + occ-start))))) + +(defun cj/--agenda-query-repeat-occurrences (timestamp bounds win-start win-end) + "Return every occurrence of repeating TIMESTAMP inside the window. + +BOUNDS is its `cj/--agenda-query-timestamp-bounds' plist. Each candidate day +is offered to `org-agenda--timestamp-to-absolute', which is org's own repeater +arithmetic -- so an occurrence lands exactly where Craig's agenda shows it +rather than where a reimplementation would put it. A day is an occurrence +when org maps it to itself. + +All three repeater styles expand from the base timestamp, including `.+': +org rewrites a restart repeater's base when the task is completed, so for an +open task the base already IS the last repeat. + +The scan starts before the window by the event's own day span, so an +occurrence that began earlier and is still running is found -- the same +intersects-not-contains rule the non-repeating path follows. + +Repeats are resolved at day granularity, matching org's agenda: an hourly +repeater therefore contributes one row per day rather than one per hour. + +Returns one cons per occurrence, oldest first. One row per occurrence is +deliberate -- a count is derivable from rows, rows are not derivable from a +count." + (cj/--agenda-query-load-org) + (let* ((raw (org-element-property :raw-value timestamp)) + (start (plist-get bounds :start)) + (end (plist-get bounds :end)) + (base-day (cj/--agenda-query-epoch-to-absolute start)) + (span (if end + (- (cj/--agenda-query-epoch-to-absolute end) base-day) + 0)) + (first-day (- (cj/--agenda-query-epoch-to-absolute win-start) + (1+ (max span 0)))) + (last-day (cj/--agenda-query-epoch-to-absolute win-end)) + (results '())) + (dotimes (offset (max 0 (1+ (- last-day first-day)))) + (let* ((day (+ first-day offset)) + (hit (when (>= day base-day) + (catch :skip + (org-agenda--timestamp-to-absolute raw day 'future))))) + (when (and (integerp hit) (= hit day)) + (let ((occ (cj/--agenda-query-occurrence-on day base-day bounds))) + (when (cj/--agenda-query-intersects-p + (plist-get occ :start) (plist-get occ :effective-end) + win-start win-end) + (push (cons (plist-get occ :start) (plist-get occ :end)) + results)))))) + (nreverse results))) + +(defun cj/--agenda-query-occurrences (timestamp win-start win-end) + "Return TIMESTAMP's (START . END) epoch conses inside the window. +END is nil for an occurrence the source gave no range. A non-repeating +timestamp yields at most one cons; a repeating one yields every occurrence." + (let ((bounds (cj/--agenda-query-timestamp-bounds timestamp))) + (when (and bounds (<= win-start win-end)) + (if (cj/--agenda-query-repeater-cookie timestamp) + (cj/--agenda-query-repeat-occurrences timestamp bounds win-start win-end) + (when (cj/--agenda-query-intersects-p (plist-get bounds :start) + (plist-get bounds :effective-end) + win-start win-end) + (list (cons (plist-get bounds :start) (plist-get bounds :end)))))))) + +;;; ---------- collecting events from a buffer ---------- + +(defun cj/--agenda-query-ancestor-headline (element) + "Return the nearest headline ancestor of ELEMENT, or nil when there is none." + (let ((node element)) + (while (and node (not (eq (org-element-type node) 'headline))) + (setq node (org-element-property :parent node))) + node)) + +(defun cj/--agenda-query-visible-p (headline) + "Return non-nil unless HEADLINE sits in an archived or commented subtree. + +Org's agenda skips both, and this query is only useful to the extent it +agrees with the agenda Craig actually sees. Ancestors count: archiving or +commenting a parent takes its whole subtree off the agenda." + (let ((node headline) + (visible t)) + (while (and node visible) + (when (eq (org-element-type node) 'headline) + (when (or (org-element-property :archivedp node) + (org-element-property :commentedp node)) + (setq visible nil))) + (setq node (org-element-property :parent node))) + visible)) + +(defun cj/--agenda-query-active-p (timestamp) + "Return non-nil when TIMESTAMP is active -- the kind org agendas show. +Inactive stamps and diary sexps are excluded: the first never reaches an +agenda, and the second cannot be reduced to a plain instant." + (memq (org-element-property :type timestamp) '(active active-range))) + +(defun cj/--agenda-query-title (headline) + "Return HEADLINE's title as display text. + +`:raw-value' already drops the keyword, priority cookie and tags, but keeps +org link syntax verbatim -- a captured web item arrives as +\"[[https://…][Tracking your habits]]\". Org's own agenda shows the +description, and a renderer has no business parsing org markup, so the link +is reduced here." + (let ((raw (or (org-element-property :raw-value headline) ""))) + (if (fboundp 'org-link-display-format) + (org-link-display-format raw) + raw))) + +(defun cj/--agenda-query-event (headline file type timestamp occurrence) + "Build one JSON-ready event alist. +HEADLINE supplies the title and completion state, FILE the source path, TYPE +the string \"scheduled\", \"deadline\" or \"timestamp\", TIMESTAMP the repeater +cookie, and OCCURRENCE the (START . END) epochs this row renders." + (let* ((begin (org-element-property :begin headline)) + (keyword (org-element-property :todo-keyword headline)) + (location (org-entry-get begin "LOCATION")) + (organizer (org-entry-get begin "ORGANIZER")) + (repeater (cj/--agenda-query-repeater-cookie timestamp)) + (bounds (cj/--agenda-query-timestamp-bounds timestamp))) + ;; Keys are symbols because `json-serialize' requires that of an alist. + (list (cons 'title (cj/--agenda-query-title headline)) + (cons 'start (car occurrence)) + (cons 'end (or (cdr occurrence) :null)) + (cons 'all-day (if (plist-get bounds :all-day) t :false)) + (cons 'type type) + (cons 'file file) + (cons 'keyword (or keyword :null)) + (cons 'done (if (eq (org-element-property :todo-type headline) 'done) + t :false)) + (cons 'repeater (or repeater :null)) + (cons 'location (or location :null)) + (cons 'organizer (or organizer :null))))) + +(defun cj/--agenda-query-collect (headline file type timestamp win-start win-end) + "Return every event row TIMESTAMP contributes, or nil." + (when (and timestamp + (cj/--agenda-query-active-p timestamp) + (cj/--agenda-query-visible-p headline)) + (mapcar (lambda (occurrence) + (cj/--agenda-query-event headline file type timestamp occurrence)) + (cj/--agenda-query-occurrences timestamp win-start win-end)))) + +(defun cj/--agenda-query-buffer-events (buffer file win-start win-end) + "Return the event rows BUFFER contributes for the window, tagged with FILE. + +Reads three kinds of timestamp, because org stores them two different ways. +SCHEDULED and DEADLINE are properties on the entry's `planning' element, NOT +children in the parse tree -- so the obvious implementation, mapping over +\\='timestamp, silently returns neither. It does not error; it just omits the +two entry kinds an agenda is mostly made of. Do not simplify this back into a +single `org-element-map' over \\='timestamp. Body timestamps are collected +separately, skipping any whose parent is a planning element so nothing is +counted twice." + (cj/--agenda-query-load-org) + (with-current-buffer buffer + (let ((tree (org-element-parse-buffer)) + (events '())) + ;; SCHEDULED and DEADLINE, read off the planning element. + (dolist (planning (org-element-map tree 'planning #'identity)) + (let ((headline (cj/--agenda-query-ancestor-headline planning))) + (when headline + (dolist (spec (list (cons "scheduled" :scheduled) + (cons "deadline" :deadline))) + (setq events + (nconc events + (cj/--agenda-query-collect + headline file (car spec) + (org-element-property (cdr spec) planning) + win-start win-end))))))) + ;; Plain active timestamps in entry bodies. + (dolist (timestamp (org-element-map tree 'timestamp #'identity)) + (unless (eq (org-element-type (org-element-property :parent timestamp)) + 'planning) + (let ((headline (cj/--agenda-query-ancestor-headline timestamp))) + (when headline + (setq events + (nconc events + (cj/--agenda-query-collect + headline file "timestamp" timestamp + win-start win-end))))))) + events))) + +;;; ---------- output ---------- + +(defun cj/--agenda-query-sort (events) + "Return EVENTS ordered by start, then title, so output is deterministic." + (sort (copy-sequence events) + (lambda (a b) + (let ((sa (alist-get 'start a)) + (sb (alist-get 'start b))) + (if (= sa sb) + (string< (alist-get 'title a) (alist-get 'title b)) + (< sa sb)))))) + +(defun cj/--agenda-query-drawable-end (event) + "Return EVENT's end as something a renderer can draw, in epoch seconds. + +The canonical row reports a null end when the source has no range, which is +faithful but not drawable. Here an all-day entry's extent is its whole day and +a timed point event's is the instant itself, so every row has a width -- even +if that width is zero. Derived from the row, so this stays a pure function of +canonical output." + (let ((start (alist-get 'start event)) + (end (alist-get 'end event))) + (cond + ((integerp end) end) + ((eq t (alist-get 'all-day event)) + (let ((d (decode-time start))) + (cj/--agenda-query-day-close (nth 3 d) (nth 4 d) (nth 5 d)))) + (t start)))) + +(defun cj/--agenda-query-render-row (event) + "Return EVENT in the renderer's contract, adding s, e and t. + +The renderer reads s and e as epoch MILLISECONDS and t as the title; it takes +everything else and drops it before drawing. The canonical fields are kept +alongside rather than replaced, so one file serves both the renderer and any +consumer reading the documented shape. Milliseconds live only in s and e -- +`start' and `end' stay seconds, and the two never mix within a key." + (append (list (cons 's (* 1000 (alist-get 'start event))) + (cons 'e (* 1000 (cj/--agenda-query-drawable-end event))) + (cons 't (alist-get 'title event))) + event)) + +(defun cj/--agenda-query-write-atomically (path text) + "Write TEXT to PATH through a temp file and a rename, returning PATH. + +The rename is why this matters: the renderer reads on a timer, so a partially +written file would be a parse error on a live surface. Replacing the file in +one step also makes it its own cache -- when Emacs is down the reader still +gets the last good answer instead of a truncated one. + +The temp file is created 0600 by `make-temp-file', so the mode is reset after +the rename; otherwise a reader running as anyone else could not open it. The +mask is 666, not `default-file-modes' alone -- that is 777 minus the umask, so +using it directly would publish the JSON world-EXECUTABLE." + (let* ((path (expand-file-name path)) + (dir (file-name-directory path)) + (temp (make-temp-file (expand-file-name ".agenda-query-" dir)))) + (unwind-protect + (progn + (let ((coding-system-for-write 'utf-8)) + (write-region text nil temp nil 'silent)) + (rename-file temp path t) + (set-file-modes path (logand #o666 (default-file-modes))) + (setq temp nil)) + (when (and temp (file-exists-p temp)) + (delete-file temp))) + path)) + +(defun cj/agenda-window-json (start-epoch end-epoch &optional out-path) + "Return the agenda between START-EPOCH and END-EPOCH as a JSON string. + +Both bounds are epoch SECONDS, inclusive. An event is included when it is +running at any point in the window, so an event that started before +START-EPOCH counts while it is still in progress. + +Each element of the returned array carries: title (keyword, priority cookie +and tags already stripped), start, end (null when the source has no range), +all-day, type (\"scheduled\", \"deadline\" or \"timestamp\"), file, keyword, +done, repeater (the raw cookie, or null), location and organizer. Absent +values are JSON null rather than omitted, so the shape is stable to parse. + +A repeating entry contributes one row per occurrence inside the window. + +With OUT-PATH, also write the JSON there atomically, leaving the previous +contents intact if anything fails. Reads `org-agenda-files' and modifies no +buffer, so it is safe to call on a timer or over emacsclient --eval. + +Signals when either bound falls outside 1900-2200, or when the window is wider +than `cj/agenda-query-max-window-seconds'. Both checks exist to surface a +milliseconds-for-seconds mistake, which otherwise answers with dates in the +year 58549 or builds millions of rows." + (let ((json (json-serialize + (vconcat (cj/--agenda-query-events start-epoch end-epoch))))) + (when out-path + (cj/--agenda-query-write-atomically out-path json)) + json)) + +(defun cj/--agenda-query-events (start-epoch end-epoch) + "Return the sorted event rows between START-EPOCH and END-EPOCH. +Shared by both output profiles; the callers do their own writing." + (unless (numberp start-epoch) + (signal 'wrong-type-argument (list 'numberp start-epoch))) + (unless (numberp end-epoch) + (signal 'wrong-type-argument (list 'numberp end-epoch))) + (cj/--agenda-query-load-org) + (let* ((win-start (floor start-epoch)) + (win-end (floor end-epoch)) + (events '())) + (dolist (bound (list win-start win-end)) + (unless (and (>= bound cj/agenda-query-epoch-floor) + (<= bound cj/agenda-query-epoch-ceiling)) + (user-error + "Agenda bound %s is outside 1900-2200; expected epoch SECONDS (milliseconds?)" + bound))) + (when (> (- win-end win-start) cj/agenda-query-max-window-seconds) + (user-error + "Agenda window spans %d days; bounds are epoch SECONDS (milliseconds?)" + (/ (- win-end win-start) 86400))) + (when (<= win-start win-end) + (dolist (file (org-agenda-files)) + (when (file-readable-p file) + (let ((buffer (org-get-agenda-file-buffer file))) + (when buffer + (setq events + (nconc events + (cj/--agenda-query-buffer-events + buffer file win-start win-end)))))))) + (cj/--agenda-query-sort events))) + +(defconst cj/agenda-render-cache-file + (expand-file-name + "settings/agenda.json" + (let ((xdg (getenv "XDG_CACHE_HOME"))) + ;; An empty XDG_CACHE_HOME is set-but-useless; `or' would take it and + ;; resolve the whole path relative to whatever the cwd happens to be. + (if (and xdg (not (string-empty-p xdg))) + xdg + (expand-file-name ".cache" (or (getenv "HOME") "~"))))) + "Where the wallpaper renderer reads the day from. + +A stable path is load-bearing on both sides. Because the file is only ever +replaced by a rename, the renderer keeps drawing the last good answer while +Emacs is down, which makes this file its own cache.") + +(defun cj/agenda-render-json (start-epoch end-epoch &optional out-path) + "Return the agenda between START-EPOCH and END-EPOCH in the renderer's shape. + +Bounds are epoch SECONDS, as everywhere else here. Each row carries the +canonical fields plus the three the renderer reads: s and e as epoch +MILLISECONDS, and t as the title. The renderer works in milliseconds +throughout, and converting once here beats converting in three places there. + +Every row has a drawable e, even where the canonical end is null: an all-day +entry spans its day and a point event has zero width. See +`cj/--agenda-query-drawable-end'." + (let ((json (json-serialize + (vconcat (mapcar #'cj/--agenda-query-render-row + (cj/--agenda-query-events start-epoch + end-epoch)))))) + (when out-path + (cj/--agenda-query-write-atomically out-path json)) + json)) + +(defun cj/agenda-render-cache-update () + "Write the agenda around today to `cj/agenda-render-cache-file'. + +The window is three whole local days: yesterday's midnight through tomorrow's +day close. A consumer drawing a rolling window centred on now needs entries +from either side of midnight, and a single calendar day leaves it with nothing +to draw for the part of its span that falls outside today -- half the surface, +late in the evening. Three days covers any rolling span up to a full day +either way, and the consumer filters to what it actually draws. + +Day boundaries are computed rather than assumed, so the span is 71, 72 or 73 +hours across a DST changeover rather than a flat 72. Returns the path. + +Safe to call repeatedly and from a timer: it only reads org files, creates the +cache directory if needed, and replaces the file by rename, so a reader on its +own schedule never sees a partial write." + (interactive) + (let* ((d (decode-time (time-convert nil 'integer))) + (day (nth 3 d)) (month (nth 4 d)) (year (nth 5 d)) + ;; Out-of-range day fields normalize, so day 0 is last month's last + ;; day and day+1 rolls the month or year without special cases. + (start (cj/--agenda-query-epoch 0 0 0 (1- day) month year)) + (end (cj/--agenda-query-day-close (1+ day) month year))) + (make-directory (file-name-directory cj/agenda-render-cache-file) t) + (cj/agenda-render-json start end cj/agenda-render-cache-file) + (when (called-interactively-p 'interactive) + (message "Agenda render cache written to %s" cj/agenda-render-cache-file)) + cj/agenda-render-cache-file)) + +(provide 'agenda-query) +;;; agenda-query.el ends here diff --git a/modules/ai-term-backend-eat.el b/modules/ai-term-backend-eat.el index be84ef25..906abd00 100644 --- a/modules/ai-term-backend-eat.el +++ b/modules/ai-term-backend-eat.el @@ -100,8 +100,11 @@ typed into a bare shell. Returns the poll timer." (cancel-timer timer)))))) timer)) -(defun cj/--ai-term-show-or-create (dir name &optional agent-command) +(defun cj/--ai-term-show-or-create (dir name &optional agent-command sessions) "Show or create the AI-term buffer for project DIR with buffer NAME. +SESSIONS, when non-nil, is a pre-fetched +`cj/--ai-term-live-tmux-sessions' list threaded from the caller so the +launch path pays for the tmux subprocess once. If a buffer named NAME exists with a live process, display it. If the buffer exists but its process is dead, kill it and recreate. If @@ -135,7 +138,8 @@ buffer." ;; session gets the project /color injected below; a reattach carries ;; whatever color the running Claude already has. (let ((fresh (not (cj/--ai-term-session-active-p - dir (cj/--ai-term-live-tmux-sessions))))) + dir (or sessions + (cj/--ai-term-live-tmux-sessions)))))) ;; `eat' switches to its buffer in the selected window before our ;; display-buffer-alist rule can route it; `save-window-excursion' ;; reverts that, and the explicit display-buffer below routes the buffer @@ -159,12 +163,14 @@ buffer." buf)))))) ;; In EAT's semi-char mode, keys not bound in `eat-semi-char-mode-map' are -;; forwarded to the pty. M-SPC (swap to the next agent) must reach Emacs from -;; inside an agent buffer, so bind it in that map -- no exception-list or rebuild +;; forwarded to the pty. The swap-to-next chords must reach Emacs from inside +;; an agent buffer, so bind them in that map -- no exception-list or rebuild ;; dance like ghostel needed. C-; is already bound there (eat-config), so the ;; C-; a family resolves through the global prefix without extra wiring. +;; M-SPC cycles attached agents only; M-S-SPC cycles all (attaching a detached). (with-eval-after-load 'eat - (keymap-set eat-semi-char-mode-map "M-SPC" #'cj/ai-term-next)) + (keymap-set eat-semi-char-mode-map "M-SPC" #'cj/ai-term-next-attached) + (keymap-set eat-semi-char-mode-map "M-S-SPC" #'cj/ai-term-next)) (provide 'ai-term-backend-eat) ;;; ai-term-backend-eat.el ends here diff --git a/modules/ai-term-display.el b/modules/ai-term-display.el index b78a2638..fdb2b7ed 100644 --- a/modules/ai-term-display.el +++ b/modules/ai-term-display.el @@ -248,10 +248,13 @@ or a layout split on the other axis), so the chain falls through to nil when the edge window is dedicated -- those are not ours to replace. Records the displaced buffer through `display-buffer-record-window' -\(type `reuse') before swapping, so the native `quit-restore-window' -called at toggle-off puts that buffer back into the slot instead of -deleting the window -- toggling swaps the slot's buffer between the -displaced buffer and the agent, never changing the window count. +\(type `reuse') before swapping. Toggle-off does NOT put that buffer +back: `cj/--ai-term-toggle-off' deletes the agent's window outright in +multi-window layouts, because the slot's `quit-restore' parameter goes +stale when several agents share it (see its docstring). The displaced +buffer stays alive and reachable through normal buffer switching; the +record call just keeps the window's `quit-restore' parameter accurate +for native `quit-window' paths outside the toggle. Runs after `cj/--ai-term-reuse-existing-agent', so an agent already on screen has been handled already; the window reused here always holds a diff --git a/modules/ai-term-sessions.el b/modules/ai-term-sessions.el index fab6b0a6..57d735d1 100644 --- a/modules/ai-term-sessions.el +++ b/modules/ai-term-sessions.el @@ -65,6 +65,20 @@ the start so names like \"foo agent [bar]\" do not match." (buffer-live-p buffer) (string-prefix-p cj/--ai-term-name-prefix (buffer-name buffer)))) +(defun cj/--ai-term-buffer-basename (buffer) + "Return the project basename embedded in BUFFER's AI-term name, or nil. + +The buffer name is \"agent [<basename>]\" (see +`cj/--ai-term-buffer-name') and never changes for the buffer's life, +unlike `default-directory', which ghostel retargets via OSC 7 every time +the shell cds. Teardown paths must key tmux-session lookups off this, +not the directory, or a close after a cd kills the wrong aiv- session. +Returns nil when BUFFER is not a live AI-term buffer." + (when (cj/--ai-term-buffer-p buffer) + (let ((name (buffer-name buffer))) + (when (string-suffix-p "]" name) + (substring name (length cj/--ai-term-name-prefix) -1))))) + (defun cj/--ai-term-agent-buffers () "Return the live AI-term buffers in `buffer-list' order. @@ -107,6 +121,23 @@ which the step materializes by attaching." (lambda (a b) (string< (cj/--ai-term-buffer-name a) (cj/--ai-term-buffer-name b)))))) +(defun cj/--ai-term-attached-agent-dirs () + "Return project dirs that have a live agent BUFFER (attached only). + +Like `cj/--ai-term-active-agent-dirs' but excludes detached tmux +sessions with no Emacs buffer -- this is the queue `cj/ai-term-next-attached' +\(M-SPC) steps through, so the fast chord stays among agents already on +screen. Detached sessions are reachable only via `cj/ai-term-next' +\(M-S-SPC). Sorted by agent buffer name for a stable rotation." + (let ((live-names (mapcar #'buffer-name (cj/--ai-term-agent-buffers)))) + (sort + (seq-filter + (lambda (dir) + (member (cj/--ai-term-buffer-name dir) live-names)) + (cj/--ai-term-candidates)) + (lambda (a b) + (string< (cj/--ai-term-buffer-name a) (cj/--ai-term-buffer-name b)))))) + (defun cj/--ai-term-tmux-session-name (dir) "Return the tmux session name for project directory DIR. @@ -320,8 +351,11 @@ the metadata keeps the order ALIST was built in." (cycle-sort-function . identity)) (complete-with-action action alist string predicate)))) -(defun cj/--ai-term-pick-project () +(defun cj/--ai-term-pick-project (&optional sessions) "Prompt for an AI-agent project; return its absolute path. +SESSIONS, when non-nil, is a pre-fetched result of +`cj/--ai-term-live-tmux-sessions', so a caller that already paid for the +tmux subprocess can thread it through instead of spawning another. Candidates come from `cj/--ai-term-candidates', ordered by `cj/--ai-term-sort-candidates' so projects with a live tmux session @@ -337,7 +371,7 @@ Signals `user-error' when no candidates exist." (append cj/ai-term-project-roots cj/ai-term-container-roots) ", "))) - (let* ((sessions (cj/--ai-term-live-tmux-sessions)) + (let* ((sessions (or sessions (cj/--ai-term-live-tmux-sessions))) (sorted (cj/--ai-term-sort-candidates candidates sessions)) (display-alist (mapcar (lambda (p) diff --git a/modules/ai-term.el b/modules/ai-term.el index 9d7be47e..52494c18 100644 --- a/modules/ai-term.el +++ b/modules/ai-term.el @@ -351,16 +351,18 @@ 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)) + ;; One tmux fetch per launch: the same list feeds the picker's sorting, + ;; the fresh check here, and show-or-create's own fresh check. + (let* ((sessions (cj/--ai-term-live-tmux-sessions)) + (dir (cj/--ai-term-pick-project sessions)) (name (cj/--ai-term-buffer-name dir)) (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))))) + (not (cj/--ai-term-session-active-p dir sessions)))) (command (when fresh (cj/--ai-term-runtime-command (cj/--ai-term-pick-runtime)))) - (buf (cj/--ai-term-show-or-create dir name command))) + (buf (cj/--ai-term-show-or-create dir name command sessions))) (unless arg (let ((win (get-buffer-window buf))) (when win (select-window win)))) @@ -400,18 +402,22 @@ C-; a k closes an agent via `cj/ai-term-close'." (defun cj/--ai-term-close-buffer (buffer) "Gracefully tear down AI-term BUFFER: tmux session, then buffer. -Derives the tmux session name from BUFFER's `default-directory' (the -project dir the terminal was created in) and kills it so the agent -process stops. When BUFFER is shown, swaps its window to a non-agent -buffer (the working file) rather than deleting the window -- closing an -agent must not collapse the user's window layout; the hide toggle is -what collapses the split. Then kills BUFFER (suppressing the +Derives the tmux session name from BUFFER's immutable name (\"agent +[<basename>]\") and kills it so the agent process stops. The name, not +`default-directory', is the reliable key: ghostel retargets the +directory via OSC 7 as the shell cds, so a directory-derived name after +a cd misses the real session (orphaning the agent) or collides with a +different aiv- session. When BUFFER is shown, swaps its window to a +non-agent buffer (the working file) rather than deleting the window -- +closing an agent must not collapse the user's window layout; the hide +toggle is what collapses the split. Then kills BUFFER (suppressing the process-still-running prompt -- the session is already down). No-op when BUFFER isn't an AI-term buffer." (when (cj/--ai-term-buffer-p buffer) (cj/--ai-term-kill-tmux-session (cj/--ai-term-tmux-session-name - (buffer-local-value 'default-directory buffer))) + (or (cj/--ai-term-buffer-basename buffer) + (buffer-local-value 'default-directory buffer)))) (let ((win (get-buffer-window buffer))) (when (window-live-p win) (cj/--ai-term-swap-to-working-buffer win))) @@ -454,26 +460,18 @@ interrupt work in progress. Bound to C-; a k." ;; ------------------------- Step to the next agent ---------------------------- -(defun cj/ai-term-next () - "Step to the next open AI-term agent in the queue. - -The queue is every active agent ordered by buffer name -- a stable -rotation, unaffected by which agent was most recently selected. Active -means a live agent buffer (attached) OR a live tmux session with no Emacs -buffer (detached); stepping onto a detached agent attaches it (recreates -its terminal, which reattaches the session). When an agent window is on -screen, swap it to the next agent (wrapping after the last) and select it. -When no agent is displayed but agents exist, show the first. When none -are open, open the project picker to launch the first agent rather than -erroring. When the sole agent is already focused, echo that there are -no other ai-terms to switch to instead of swapping to itself. - -Bound to M-SPC. Unlike C-; a a (toggle the most-recent agent on/off), this -is the \"switch among existing agents\" surface; C-; a s opens the project -picker and C-; a k closes an agent." - (interactive) - (let* ((dirs (cj/--ai-term-active-agent-dirs)) - (win (cj/--ai-term-displayed-agent-window)) +(defun cj/--ai-term-step-among (dirs) + "Step to the next AI-term agent among DIRS, an ordered active-dir list. + +Shared body for `cj/ai-term-next' (all active agents) and +`cj/ai-term-next-attached' (attached agents only). When an agent window +is on screen, swap it to the next agent in DIRS (wrapping after the last) +and select it: a live attached agent swaps buffer-only, a detached one is +materialized by `cj/--ai-term-show-or-create'. When DIRS is empty, open +the project picker rather than erroring, so the swap key doubles as a +start-an-agent key. When the sole eligible agent is already focused, echo +that there is nowhere else to go instead of swapping to itself." + (let* ((win (cj/--ai-term-displayed-agent-window)) (current-name (and win (buffer-name (window-buffer win)))) (current-dir (and current-name (seq-find (lambda (d) @@ -482,8 +480,8 @@ picker and C-; a k closes an agent." (next-dir (cj/--ai-term-next-agent-dir current-dir dirs))) (cond ((not next-dir) - ;; No agents open: launch the first via the project picker instead of - ;; erroring, so the swap key doubles as a "start an agent" key. + ;; No eligible agents: launch the first via the project picker instead + ;; of erroring, so the swap key doubles as a "start an agent" key. (cj/ai-term-pick-project)) ;; Sole agent, already focused: the rotation wraps back to the same ;; agent, so a swap would be a silent no-op. Say there's nowhere to @@ -508,16 +506,49 @@ picker and C-; a k closes an agent." (let ((w (get-buffer-window name))) (when w (select-window w))))))))) +(defun cj/ai-term-next () + "Step to the next open AI-term agent -- attached or detached. + +The queue is every active agent ordered by buffer name -- a stable +rotation, unaffected by which agent was most recently selected. Active +means a live agent buffer (attached) OR a live tmux session with no Emacs +buffer (detached); stepping onto a detached agent attaches it (recreates +its terminal, which reattaches the session). + +Bound to M-S-SPC (and C-; a n). For a chord that stays among the agents +already on screen, use `cj/ai-term-next-attached' (M-SPC). Unlike C-; a a +\(toggle the most-recent agent on/off), this is the \"switch among existing +agents\" surface; C-; a s opens the project picker and C-; a k closes an +agent." + (interactive) + (cj/--ai-term-step-among (cj/--ai-term-active-agent-dirs))) + +(defun cj/ai-term-next-attached () + "Step to the next ATTACHED AI-term agent -- live Emacs buffers only. + +Cycles only agents currently on screen (a live agent buffer), skipping +detached tmux sessions. Use `cj/ai-term-next' (M-S-SPC) to include +detached sessions and attach them. When no agent is attached, opens the +project picker. + +Bound to M-SPC -- the fast \"swap to the next visible agent\" chord." + (interactive) + (cj/--ai-term-step-among (cj/--ai-term-attached-agent-dirs))) + ;; ai-term lives under the C-; a prefix (vacated when gptel was archived). -;; The frequent "swap to the next agent" also gets M-SPC for a fast chord. +;; The frequent "swap to the next agent" gets M-SPC (attached only) for a fast +;; chord, with M-S-SPC to include detached sessions. (defvar-keymap cj/ai-term-keymap :doc "Keymap for ai-term agent commands (C-; a)." "a" #'cj/ai-term ;; toggle the most-recent agent on/off "s" #'cj/ai-term-pick-project ;; select / launch via the project picker - "n" #'cj/ai-term-next ;; swap to the next open agent + "n" #'cj/ai-term-next ;; swap to the next open agent (all) "k" #'cj/ai-term-close) ;; kill the current agent (cj/register-prefix-map "a" cj/ai-term-keymap "ai-term") -(keymap-global-set "M-SPC" #'cj/ai-term-next) +;; M-SPC cycles only attached agents (on-screen); M-S-SPC cycles all, attaching +;; a detached tmux session when it lands on one. +(keymap-global-set "M-SPC" #'cj/ai-term-next-attached) +(keymap-global-set "M-S-SPC" #'cj/ai-term-next) (with-eval-after-load 'which-key (which-key-add-key-based-replacements @@ -526,7 +557,8 @@ picker and C-; a k closes an agent." "C-; a s" "select / launch" "C-; a n" "next agent" "C-; a k" "kill agent" - "M-SPC" "ai-term: next agent")) + "M-SPC" "ai-term: next attached" + "M-S-SPC" "ai-term: next (all)")) ;; ------------------- Wrap-it-up teardown + shutdown ------------------------- ;; @@ -547,11 +579,16 @@ A defcustom so development and tests can stub it instead of powering off (defun cj/ai-term-quit (&optional project) "Tear down PROJECT's AI-term: kill its tmux session, buffer, and restore layout. PROJECT is a project basename (as the rulesets Stop hook passes) or a directory; -nil means the current project (`default-directory'). Kills the `aiv-<name>' -tmux session (taking the agent process with it), then, when the agent buffer is -live, swaps its window back to the working buffer and kills it. Idempotent and -safe headless: a session or buffer already gone is a no-op, not an error." - (let* ((key (or project default-directory)) +nil means the current project -- the current agent buffer's embedded basename +when called from inside one (immune to the OSC 7 `default-directory' drift a +cd in the agent shell causes), else `default-directory'. Kills the +`aiv-<name>' tmux session (taking the agent process with it), then, when the +agent buffer is live, swaps its window back to the working buffer and kills +it. Idempotent and safe headless: a session or buffer already gone is a +no-op, not an error." + (let* ((key (or project + (cj/--ai-term-buffer-basename (current-buffer)) + default-directory)) (session (cj/--ai-term-tmux-session-name key)) (buffer (get-buffer (cj/--ai-term-buffer-name key)))) (cj/--ai-term-kill-tmux-session session) diff --git a/modules/auth-config.el b/modules/auth-config.el index c2df244b..c862e916 100644 --- a/modules/auth-config.el +++ b/modules/auth-config.el @@ -26,6 +26,7 @@ ;; below. oauth2-auto is required at runtime inside the advised function; these ;; declarations satisfy the byte-compiler without forcing an eager load. (declare-function oauth2-auto--compute-id "oauth2-auto") +(declare-function plstore-open "plstore") (declare-function plstore-get "plstore") (declare-function plstore-close "plstore") (defvar oauth2-auto--plstore-cache) diff --git a/modules/auto-dim-config.el b/modules/auto-dim-config.el index faa4101c..980d301f 100644 --- a/modules/auto-dim-config.el +++ b/modules/auto-dim-config.el @@ -58,7 +58,11 @@ focus cue on a split-displayed dashboard, accepted as a fair trade." ;; Emacs loses focus -- on Hyprland focus moves to other apps constantly, ;; and the ai-term agents live in their own windows. (auto-dim-other-buffers-dim-on-focus-out nil) - (auto-dim-other-buffers-dim-on-switch-to-minibuffer t) + ;; Entering the minibuffer leaves dimming exactly as it was -- a dim window + ;; stays dim, a lit one stays lit. With this at t, the window being worked + ;; in went dark on every minibuffer prompt, since selecting the minibuffer + ;; deselects it and the dim follows selection. + (auto-dim-other-buffers-dim-on-switch-to-minibuffer nil) :config ;; Remap these faces to auto-dim-other-buffers (pure-black background + ;; faded gray foreground, defined in the theme) in non-selected windows. diff --git a/modules/browser-config.el b/modules/browser-config.el index 564e7a27..4571c1d9 100644 --- a/modules/browser-config.el +++ b/modules/browser-config.el @@ -143,7 +143,23 @@ Persists the choice for future sessions." ('save-failed (message "Failed to save browser choice")) ('invalid-plist (message "Invalid browser configuration")))))))) -;; Initialize: Load saved choice or use first available browser +(defun cj/--preferred-default-browser (browsers) + "Return the browser plist to adopt as the first-run default from BROWSERS. + +Prefers the first entry with a non-nil :executable -- a real external +browser -- and falls back to the first entry overall when none is +installed. Built-in browsers carry a nil :executable and so are always +\"available\", which put EWW at the head of `cj/discover-browsers' on +every machine. Taking the head therefore opened every link in the text +browser on a fresh checkout even with Chrome installed, until the user +happened to run `cj/choose-browser'. EWW stays reachable as the +deliberate fallback when nothing external is on PATH. + +Returns nil for an empty BROWSERS list." + (or (seq-find (lambda (b) (plist-get b :executable)) browsers) + (car browsers))) + +;; Initialize: Load saved choice or use the preferred available browser (defun cj/--do-initialize-browser () "Initialize browser configuration. Returns: (cons \\='loaded browser-plist) if saved choice was loaded, @@ -153,10 +169,10 @@ Returns: (cons \\='loaded browser-plist) if saved choice was loaded, (let ((saved-choice (cj/load-browser-choice))) (if saved-choice (cons 'loaded saved-choice) - ;; No saved choice - try to set first available browser + ;; No saved choice - adopt the preferred available browser (let ((browsers (cj/discover-browsers))) (if browsers - (cons 'first-available (car browsers)) + (cons 'first-available (cj/--preferred-default-browser browsers)) (cons 'no-browsers nil)))))) (defun cj/initialize-browser () diff --git a/modules/calendar-sync-ics.el b/modules/calendar-sync-ics.el index 9c1b005b..7fecce10 100644 --- a/modules/calendar-sync-ics.el +++ b/modules/calendar-sync-ics.el @@ -188,6 +188,22 @@ Monday = 1, Sunday = 7." (dow (nth 6 decoded))) ; 0 = Sunday, 1 = Monday, etc. (if (= dow 0) 7 dow))) +(defun calendar-sync--nth-weekday-of-month (year month weekday n) + "Return the day-of-month of the Nth WEEKDAY in YEAR/MONTH, or nil. +WEEKDAY is 1-7 (Monday = 1), matching `calendar-sync--date-weekday'. +Positive N counts from the start of the month (1 = first); negative N +counts from the end (-1 = last). Returns nil when the month has no such +occurrence (a 5th Friday most months), or when N is zero." + (when (and (integerp n) (not (zerop n))) + (let* ((first-dow (calendar-sync--date-weekday (list year month 1))) + (first-day (1+ (mod (- weekday first-dow) 7))) + (next-month (calendar-sync--add-months (list year month 1) 1)) + (last-day (nth 2 (calendar-sync--add-days next-month -1))) + (total (1+ (/ (- last-day first-day) 7))) + (index (if (> n 0) n (+ total n 1)))) + (when (and (>= index 1) (<= index total)) + (+ first-day (* 7 (1- index))))))) + (defun calendar-sync--add-days (date days) "Add DAYS to DATE (year month day). Returns new (year month day). @@ -564,18 +580,30 @@ would push the last day BEFORE the start and emit a backwards range." ;;; Single Event Parsing +(defun calendar-sync--event-cancelled-p (event-str) + "Return non-nil when EVENT-STR carries STATUS:CANCELLED. +This is the VEVENT's own STATUS property (RFC 5545 3.8.1.11), not the +user's attendee PARTSTAT. Matching is case-insensitive." + (let ((status (calendar-sync--get-property event-str "STATUS"))) + (and status (string= (upcase status) "CANCELLED")))) + (defun calendar-sync--parse-event (event-str) "Parse single VEVENT string EVENT-STR into plist. Returns plist with :uid :summary :description :location :start :end :attendees :organizer :url :status. Returns nil if event lacks required fields (DTSTART, SUMMARY). Skips events with RECURRENCE-ID (individual instances of recurring events -are handled separately via exception collection). +are handled separately via exception collection) and events whose own +STATUS is CANCELLED -- a cancelled meeting must not render, and a +cancelled series master kills its whole series because RRULE expansion +builds its base event through this function. Handles TZID-qualified timestamps by converting to local time. Cleans text fields (description, location, summary) via `calendar-sync--clean-text'." - ;; Skip individual instances of recurring events (they're collected as exceptions) - (unless (calendar-sync--get-property event-str "RECURRENCE-ID") + ;; Skip individual instances of recurring events (they're collected as + ;; exceptions) and cancelled events (they must not render). + (unless (or (calendar-sync--get-property event-str "RECURRENCE-ID") + (calendar-sync--event-cancelled-p event-str)) (let* ((uid (calendar-sync--get-property event-str "UID")) (summary (calendar-sync--clean-text (calendar-sync--get-property event-str "SUMMARY"))) diff --git a/modules/calendar-sync-recurrence.el b/modules/calendar-sync-recurrence.el index 1cb25636..9ef12ce5 100644 --- a/modules/calendar-sync-recurrence.el +++ b/modules/calendar-sync-recurrence.el @@ -90,6 +90,9 @@ dropped by `calendar-sync--filter-declined'." (list :recurrence-id (calendar-sync--localize-parsed-datetime recurrence-id-parsed recurrence-id-is-utc recurrence-id-tzid) :recurrence-id-raw recurrence-id + ;; A cancelled override removes its occurrence downstream + ;; rather than rescheduling it. + :cancelled (calendar-sync--event-cancelled-p event-str) :start start-parsed :end end-parsed :summary summary @@ -164,24 +167,30 @@ Compares year, month, day, hour, minute." "Apply EXCEPTIONS to OCCURRENCES list. OCCURRENCES is list of event plists from RRULE expansion. EXCEPTIONS is hash table from `calendar-sync--collect-recurrence-exceptions'. -Returns new list with matching occurrences replaced by exception times." +Returns new list with matching occurrences replaced by exception times. +A cancelled exception (STATUS:CANCELLED override) removes its occurrence +from the list instead of overriding it." (if (or (null occurrences) (null exceptions)) occurrences - (mapcar - (lambda (occurrence) - (let* ((uid (plist-get occurrence :uid)) - (uid-exceptions (and uid (gethash uid exceptions)))) - (if (null uid-exceptions) - occurrence - ;; Check if any exception matches this occurrence - (let ((matching-exception - (cl-find-if (lambda (exc) - (calendar-sync--occurrence-matches-exception-p occurrence exc)) - uid-exceptions))) - (if matching-exception - (calendar-sync--apply-single-exception occurrence matching-exception) - occurrence))))) - occurrences))) + (delq nil + (mapcar + (lambda (occurrence) + (let* ((uid (plist-get occurrence :uid)) + (uid-exceptions (and uid (gethash uid exceptions)))) + (if (null uid-exceptions) + occurrence + ;; Check if any exception matches this occurrence + (let ((matching-exception + (cl-find-if (lambda (exc) + (calendar-sync--occurrence-matches-exception-p occurrence exc)) + uid-exceptions))) + (cond + ((null matching-exception) occurrence) + ;; Cancelled instance: drop it entirely. + ((plist-get matching-exception :cancelled) nil) + (t (calendar-sync--apply-single-exception + occurrence matching-exception))))))) + occurrences)))) ;;; EXDATE (Excluded Date) Handling @@ -291,7 +300,9 @@ OCCURRENCE-DATE should be a list (year month day hour minute second)." (defun calendar-sync--parse-rrule (rrule-str) "Parse RRULE string into plist. -Returns plist with :freq :interval :byday :until :count." +Returns plist with :freq :interval :byday :bysetpos :bymonth :until :count. +BYMONTH keeps only the first value of a comma-separated list -- feeds in +practice emit a single month there." (let ((parts (split-string rrule-str ";")) (result '())) (dolist (part parts) @@ -302,6 +313,8 @@ Returns plist with :freq :interval :byday :until :count." ("FREQ" (setq result (plist-put result :freq (intern (downcase value))))) ("INTERVAL" (setq result (plist-put result :interval (string-to-number value)))) ("BYDAY" (setq result (plist-put result :byday (split-string value ",")))) + ("BYSETPOS" (setq result (plist-put result :bysetpos (string-to-number value)))) + ("BYMONTH" (setq result (plist-put result :bymonth (string-to-number value)))) ("UNTIL" (setq result (plist-put result :until (calendar-sync--parse-timestamp value)))) ("COUNT" (setq result (plist-put result :count (string-to-number value)))))))) ;; Set defaults @@ -389,18 +402,149 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (calendar-sync--log-silently "calendar-sync: WARNING: Hit max iterations (%d) expanding weekly event" max-iterations)) (nreverse occurrences))) +(defun calendar-sync--parse-byday-entry (entry) + "Parse a single RRULE BYDAY ENTRY into a cons (ORDINAL . WEEKDAY). +ENTRY is a string like \"2WE\" (2nd Wednesday), \"-1TU\" (last Tuesday), +or \"SU\" (bare weekday). ORDINAL is nil for a bare weekday. WEEKDAY is +1-7 (Monday = 1). Returns nil for unparseable input." + (when (and (stringp entry) + (string-match "\\`\\(-?[0-9]+\\)?\\([A-Z][A-Z]\\)\\'" entry)) + (let ((ordinal (match-string 1 entry)) + (weekday (calendar-sync--weekday-to-number (match-string 2 entry)))) + (when weekday + (cons (and ordinal (string-to-number ordinal)) weekday))))) + +(defun calendar-sync--byday-days-in-month (year month byday-entries bysetpos) + "Return the sorted day-of-month list BYDAY-ENTRIES select in YEAR/MONTH. +An entry with an ordinal (\"2WE\") resolves directly via +`calendar-sync--nth-weekday-of-month'. A bare entry (\"SU\") expands to +every matching weekday in the month. When BYSETPOS is non-nil it then +selects one day from the combined set (1-based; negative counts from the +end), per RFC 5545 3.8.5.3. Months with no match return nil." + (let ((days '())) + (dolist (entry byday-entries) + (let ((parsed (calendar-sync--parse-byday-entry entry))) + (when parsed + (let ((ordinal (car parsed)) + (weekday (cdr parsed))) + (if ordinal + (let ((day (calendar-sync--nth-weekday-of-month year month weekday ordinal))) + (when day (push day days))) + (let ((n 1) day) + (while (setq day (calendar-sync--nth-weekday-of-month year month weekday n)) + (push day days) + (setq n (1+ n))))))))) + (setq days (sort (delete-dups days) #'<)) + (if (and bysetpos days) + (let* ((total (length days)) + (index (if (> bysetpos 0) bysetpos (+ total bysetpos 1)))) + (if (and (>= index 1) (<= index total)) + (list (nth (1- index) days)) + '())) + days))) + +(defun calendar-sync--expand-monthly-byday (base-event rrule range) + "Expand a monthly nth-weekday (BYDAY) recurring event. +BASE-EVENT is the event plist, RRULE is parsed rrule (carrying :byday and +optionally :bysetpos), RANGE is date range. Steps month by month from +DTSTART's month, landing each occurrence on the day its BYDAY rule selects +-- never on DTSTART's day-of-month." + (let* ((start (plist-get base-event :start)) + (interval (plist-get rrule :interval)) + (byday (plist-get rrule :byday)) + (bysetpos (plist-get rrule :bysetpos)) + (until (plist-get rrule :until)) + (count (plist-get rrule :count)) + (occurrences '()) + (month-anchor (list (nth 0 start) (nth 1 start) 1)) + (start-day (nth 2 start)) + (first-month t) + (num-generated 0) + (range-end-time (cadr range)) + (max-iterations 1000) + (iterations 0)) + (when (<= interval 0) + (error "Invalid RRULE interval: %s (must be > 0)" interval)) + (while (and (< iterations max-iterations) + (or count until + (time-less-p (calendar-sync--date-to-time month-anchor) range-end-time)) + (or (not count) (< num-generated count)) + ;; A month starting after UNTIL can't contain an occurrence + ;; on-or-before it (UNTIL is inclusive, RFC 5545 3.3.10). + (or (not until) (calendar-sync--date-on-or-before-p month-anchor until))) + (setq iterations (1+ iterations)) + (dolist (day (calendar-sync--byday-days-in-month + (nth 0 month-anchor) (nth 1 month-anchor) byday bysetpos)) + (let* ((occurrence-date (list (nth 0 month-anchor) (nth 1 month-anchor) day)) + (occurrence-datetime (append occurrence-date (nthcdr 3 start)))) + ;; The series starts at DTSTART: skip earlier days in the first month. + (unless (and first-month (< day start-day)) + (when (or (not until) (calendar-sync--date-on-or-before-p occurrence-date until)) + (when (or (not count) (< num-generated count)) + (setq num-generated (1+ num-generated)) + (when (calendar-sync--date-in-range-p occurrence-datetime range) + (push (calendar-sync--create-occurrence base-event occurrence-datetime) + occurrences))))))) + (setq first-month nil) + (setq month-anchor (calendar-sync--add-months month-anchor interval))) + (when (>= iterations max-iterations) + (calendar-sync--log-silently + "calendar-sync: WARNING: Hit max iterations (%d) expanding monthly BYDAY event" + max-iterations)) + (nreverse occurrences))) + (defun calendar-sync--expand-monthly (base-event rrule range) "Expand monthly recurring event. -BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." - (calendar-sync--expand-simple-recurrence - base-event rrule range #'calendar-sync--add-months)) +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. +A rule with BYDAY (nth weekday, e.g. 2WE, -1TU, or SU with BYSETPOS) +expands via `calendar-sync--expand-monthly-byday'; a plain rule steps +DTSTART's day-of-month, skipping months without that day." + (if (plist-get rrule :byday) + (calendar-sync--expand-monthly-byday base-event rrule range) + (calendar-sync--expand-simple-recurrence + base-event rrule range #'calendar-sync--next-monthly-date))) + +(defun calendar-sync--next-monthly-date (date interval) + "Step DATE forward INTERVAL months, skipping months without DATE's day. +A plain FREQ=MONTHLY on the 31st must skip short months (RFC 5545): +`calendar-sync--add-months' keeps day-of-month verbatim, so Jan 31 would +step to Feb 31, which encode-time normalizes into a phantom Mar 3 +occurrence. Bounded so a pathological input can't loop forever." + (require 'time-date) + (let ((next (calendar-sync--add-months date interval)) + (day (nth 2 date)) + (guard 0)) + (while (and (< guard 100) + (> day (date-days-in-month (nth 0 next) (nth 1 next)))) + (setq guard (1+ guard)) + (setq next (calendar-sync--add-months next interval))) + next)) + +(defun calendar-sync--expand-yearly-byday (base-event rrule range) + "Expand a yearly nth-weekday event (e.g. BYMONTH=3;BYDAY=2SU). +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. +Reuses the monthly BYDAY expander with a 12-month step, anchored on +:bymonth (falling back to DTSTART's month)." + (let* ((start (plist-get base-event :start)) + (month (or (plist-get rrule :bymonth) (nth 1 start))) + (sched-event (plist-put (copy-sequence base-event) :start + (append (list (nth 0 start) month (nth 2 start)) + (nthcdr 3 start)))) + (sched-rrule (plist-put (copy-sequence rrule) :interval + (* 12 (or (plist-get rrule :interval) 1))))) + (calendar-sync--expand-monthly-byday sched-event sched-rrule range))) (defun calendar-sync--expand-yearly (base-event rrule range) "Expand yearly recurring event. -BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." - (calendar-sync--expand-simple-recurrence - base-event rrule range - (lambda (date interval) (calendar-sync--add-months date (* 12 interval))))) +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. +A rule with BYDAY (the DST clock-change shape, BYMONTH=n;BYDAY=nWD) +expands via `calendar-sync--expand-yearly-byday'; a plain rule repeats +DTSTART's calendar date." + (if (plist-get rrule :byday) + (calendar-sync--expand-yearly-byday base-event rrule range) + (calendar-sync--expand-simple-recurrence + base-event rrule range + (lambda (date interval) (calendar-sync--add-months date (* 12 interval)))))) (defun calendar-sync--expand-recurring-event (event-str range) "Expand recurring event EVENT-STR into individual occurrences within RANGE. diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index 804d71fa..d504f246 100644 --- a/modules/calendar-sync.el +++ b/modules/calendar-sync.el @@ -300,16 +300,28 @@ When called non-interactively with nil, syncs all calendars." ;;; Timer management (defun calendar-sync--sync-timer-function () - "Function called by sync timer. -Checks for timezone changes and triggers re-sync if detected." - (when (calendar-sync--timezone-changed-p) - (let ((old-tz (calendar-sync--format-timezone-offset - calendar-sync--last-timezone-offset)) - (new-tz (calendar-sync--format-timezone-offset - (calendar-sync--current-timezone-offset)))) - (message "calendar-sync: Timezone change detected (%s → %s), re-syncing..." - old-tz new-tz))) - (calendar-sync--sync-all-calendars)) + "Function called by the hourly sync timer. +Checks for timezone changes and triggers re-sync if detected. + +The body is wrapped so a signal — from the timezone check or the sync +fan-out — is caught and logged rather than propagated: this runs from a +`run-at-time' timer, and an unguarded error would repeat on every tick, +once an hour, indefinitely. The timezone-change notice goes to the silent +log, not the echo area, since an hourly timer must not spam `message'." + (condition-case err + (progn + (when (calendar-sync--timezone-changed-p) + (let ((old-tz (calendar-sync--format-timezone-offset + calendar-sync--last-timezone-offset)) + (new-tz (calendar-sync--format-timezone-offset + (calendar-sync--current-timezone-offset)))) + (calendar-sync--log-silently + "calendar-sync: Timezone change detected (%s → %s), re-syncing..." + old-tz new-tz))) + (calendar-sync--sync-all-calendars)) + (error + (calendar-sync--log-silently + "calendar-sync: sync timer error: %s" (error-message-string err))))) ;;;###autoload (defun calendar-sync-start () diff --git a/modules/calibredb-epub-config.el b/modules/calibredb-epub-config.el index b03d83ed..27fa6369 100644 --- a/modules/calibredb-epub-config.el +++ b/modules/calibredb-epub-config.el @@ -205,22 +205,14 @@ Adjust it live with `cj/nov-widen-text' and `cj/nov-narrow-text'.") (defvar cj/nov-margin-step 2 "Percentage points each `cj/nov-widen-text'/`cj/nov-narrow-text' press changes.") -;; Prevent magic-fallback-mode-alist from opening epub as archive-mode -;; Advise set-auto-mode to force nov-mode for .epub files before magic-fallback runs -(defun cj/force-nov-mode-for-epub (orig-fun &rest args) - "Force nov-mode for .epub files, bypassing archive-mode detection." - (if (and buffer-file-name - (string-match-p "\\.epub\\'" buffer-file-name)) - (progn - (unless (featurep 'nov) - (require 'nov nil t)) - ;; Call nov-mode if available, otherwise fallback to default behavior - (if (fboundp 'nov-mode) - (nov-mode) - (apply orig-fun args))) - (apply orig-fun args))) - -(advice-add 'set-auto-mode :around #'cj/force-nov-mode-for-epub) +;; .epub reaches nov-mode through auto-mode-alist -- nov's use-package :mode +;; below registers "\\.epub\\'" there, and `set-auto-mode' consults +;; auto-mode-alist before magic-fallback-mode-alist, so the zip container never +;; reaches the archive-mode fallback. An :around advice on `set-auto-mode' used +;; to force this and was pure overhead: set-auto-mode runs on every file visit, +;; so it added a frame and a failure surface to every file of every type. +;; Verified live before removal -- a real zip-format .epub opened in nov-mode +;; both with the advice and without it. ;; Define helper functions before use-package so they're available for hooks (defun cj/forward-paragraph-and-center () @@ -519,8 +511,7 @@ computed column based on the window text area width." (goto-char (point-min)) ;; Work in the selected window showing this buffer (if any). (when-let* ((win (get-buffer-window (current-buffer) t)) - (col-width (window-body-width win)) ;; columns - (col-px (* col-width (window-font-width win)))) + (col-width (window-body-width win))) ;; columns (while (let ((m (text-property-search-forward 'display nil (lambda (_ p) (and (consp p) (eq (car-safe p) 'image)))))) diff --git a/modules/coverage-core.el b/modules/coverage-core.el index e8f7a474..c320651d 100644 --- a/modules/coverage-core.el +++ b/modules/coverage-core.el @@ -220,7 +220,7 @@ empty hash table. Malformed hunk headers are skipped silently." "Return the merge-base between HEAD and BASE." (let ((merge-base (string-trim (cj/git-output-or-error "merge-base" "HEAD" base)))) - (unless (not (string-empty-p merge-base)) + (when (string-empty-p merge-base) (user-error "git merge-base HEAD %s returned no commit" base)) merge-base)) diff --git a/modules/custom-buffer-file.el b/modules/custom-buffer-file.el index 0ca06cf9..fdcc4d2f 100644 --- a/modules/custom-buffer-file.el +++ b/modules/custom-buffer-file.el @@ -59,7 +59,7 @@ (declare-function mm-insert-part "mm-decode") (declare-function mm-destroy-parts "mm-decode") (require 'external-open) ;; for cj/xdg-open, cj/open-this-file-with -(require 'system-lib) ;; cj/confirm-strong (overwrite confirms), used below +(require 'system-lib) ;; cj/confirm-destructive (overwrite confirms), used below ;; cj/kill-buffer-and-window and cj/kill-other-window-buffer defined in undead-buffers.el (declare-function cj/kill-buffer-and-window "undead-buffers") @@ -168,7 +168,7 @@ When called interactively, prompts for confirmation if target file exists." (condition-case _ (cj/--move-buffer-and-file dir nil) (file-already-exists - (if (cj/confirm-strong (format "File %s exists; overwrite? " target)) + (if (cj/confirm-destructive (format "File %s exists; overwrite? " target)) (cj/--move-buffer-and-file dir t) (message "File not moved")))))) @@ -208,7 +208,7 @@ When called interactively, prompts for confirmation if target file exists." (condition-case err (cj/--rename-buffer-and-file new-name nil) (file-already-exists - (if (cj/confirm-strong (format "File %s exists; overwrite? " new-name)) + (if (cj/confirm-destructive (format "File %s exists; overwrite? " new-name)) (cj/--rename-buffer-and-file new-name t) (message "File not renamed"))) (error diff --git a/modules/custom-case.el b/modules/custom-case.el index dde2d6c1..c203cd9e 100644 --- a/modules/custom-case.el +++ b/modules/custom-case.el @@ -62,6 +62,61 @@ CHARS-SKIP-RESET: : ! ? .), reached by skipping blanks back to PREV-WORD-END." (and (not (zerop (skip-chars-backward "[:blank:]" prev-word-end))) (memq (char-before (point)) chars-skip-reset))))) +(defconst cj/--title-case-reset-chars '(?: ?! ?? ?.) + "Characters that restart capitalization for the following word. +So \"Warning: An Example\" capitalizes the \"An\" and a sentence-ending +period capitalizes the next word (\"End. The Next\").") + +(defconst cj/--title-case-separator-chars '(?\\ ?- ?' ?.) + "Characters whose following character is never capitalized. +Covers \"Foo-bar\", \"Foo\\bar\", and \"Foo's\". The period keeps +\"3.14\" and \"foo.bar\" untouched; a period followed by a blank still +restarts capitalization via `cj/--title-case-reset-chars'.") + +(defconst cj/--title-case-minor-words + '("a" "an" "and" "as" "at" "but" "by" + "for" "if" "in" "nor" "of" + "on" "or" "so" "the" "to" "yet") + "Minor words kept lowercase mid-title. +\"is\" and other linking verbs are major words, so they are not here.") + +(defconst cj/--title-case-word-chars "[:alnum:]" + "skip-chars set that constitutes a word for title-casing.") + +(defun cj/--title-case-region-bounds () + "Return (BEG . END) for the active region, else the current line." + (if (region-active-p) + (cons (region-beginning) (region-end)) + (cons (line-beginning-position) (line-end-position)))) + +(defun cj/--title-case-last-word-start (beg end) + "Return the start position of the last word in BEG..END. +The last word is always capitalized in title case, so it is located once: +from END, skip back over trailing non-word characters, then the word." + (save-excursion + (goto-char end) + (skip-chars-backward (concat "^" cj/--title-case-word-chars) beg) + (skip-chars-backward cj/--title-case-word-chars beg) + (point))) + +(defun cj/--title-case-maybe-capitalize (word-end end is-first last-word-start prev-word-end) + "Capitalize the character at point when title-case rules call for it. +Point sits on a word's first character, WORD-END past its last. END bounds +the operation; IS-FIRST, LAST-WORD-START, and PREV-WORD-END feed +`cj/--title-case-capitalize-word-p'. Modifies the buffer in place." + (unless (or (>= (point) end) + (memq (char-before (point)) cj/--title-case-separator-chars)) + (let* ((c-orig (char-to-string (char-after (point)))) + (c-up (capitalize c-orig))) + (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 (= (point) last-word-start) + prev-word-end cj/--title-case-minor-words + cj/--title-case-reset-chars) + (delete-region (point) (1+ (point))) + (insert c-up))))))) + (defun cj/title-case-region () "Capitalize the region in title case format. Title case is a capitalization convention where major words are capitalized, @@ -73,43 +128,13 @@ 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) - (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". 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" "nor" "of" - "on" "or" "so" "the" "to" "yet")) - (is-first t)) - (cond - ((region-active-p) - (setq beg (region-beginning)) - (setq end (region-end))) - (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))) + (let* ((bounds (cj/--title-case-region-bounds)) + (beg (car bounds)) + (end (cdr bounds)) + (last-word-start (cj/--title-case-last-word-start beg end)) + (word-chars cj/--title-case-word-chars) + (prev-word-end nil) + (is-first t)) (save-excursion ;; work on uppercased text (e.g., headlines) by downcasing first (downcase-region beg end) @@ -123,17 +148,8 @@ capitalization even when it is a minor word." (save-excursion (skip-chars-forward word-chars end) (point)))) - (unless (or (>= (point) end) - (memq (char-before (point)) chars-separator)) - (let* ((c-orig (char-to-string (char-after (point)))) - (c-up (capitalize c-orig))) - (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 (= (point) last-word-start) - prev-word-end word-skip chars-skip-reset) - (delete-region (point) (1+ (point))) - (insert c-up)))))) + (cj/--title-case-maybe-capitalize + word-end end is-first last-word-start prev-word-end) (goto-char word-end) (setq is-first nil)))))) diff --git a/modules/custom-comments.el b/modules/custom-comments.el index 73d29b0c..2e77af5a 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -72,6 +72,18 @@ is the line-opening prologue shared by the divider and inline-border emitters." (when (equal cmt-start ";") (insert cmt-start)) (insert " ")) +(defun cj/--comment-read-syntax () + "Return the buffer's comment syntax as a cons (COMMENT-START . COMMENT-END). +Falls back to prompting for the start when the buffer has none, and to an +empty end string. The single source of the resolution that was previously +copied into each command wrapper." + (cons (if (and (boundp 'comment-start) comment-start) + comment-start + (read-string "Comment start character(s): ")) + (if (and (boundp 'comment-end) comment-end) + comment-end + ""))) + ;; ----------------------------- Inline Border --------------------------------- (defun cj/--comment-inline-border (cmt-start cmt-end decoration-char text length) @@ -129,12 +141,9 @@ LENGTH is the total width of the line." DECORATION-CHAR defaults to \"#\" if not provided. Uses the lesser of `fill-column\\=' or 80 for line length." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (or decoration-char "#")) (text (capitalize (string-trim (read-from-minibuffer "Comment: ")))) (length (min fill-column 80))) @@ -157,12 +166,9 @@ delegates to `cj/--comment-padded-divider' with PADDING 0." "Insert a simple divider comment banner. Prompts for decoration character, text, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default =): " nil nil "=")) (text (read-string "Comment text: ")) (length-option (completing-read "Comment length: " @@ -200,8 +206,13 @@ PADDING is the number of spaces before the text." (if (string-empty-p cmt-end) 0 (1+ (length cmt-end)))))) (when (< length min-length) (error "Length %d is too small to generate comment (minimum %d)" length min-length)) + ;; Mirror every term the emit path adds: the prologue also inserts a + ;; doubled semicolon (elisp) and a trailing space that this budget used + ;; to omit, rendering dividers LENGTH+2 (elisp) or LENGTH+1 wide. (let* ((available-width (- length current-column-pos (length cmt-start) + (if (equal cmt-start ";") 1 0) ; doubled semicolon + 1 ; space after comment-start (if (string-empty-p cmt-end) 0 (1+ (length cmt-end))))) (line (make-string available-width (string-to-char decoration-char)))) ;; Top line @@ -232,12 +243,9 @@ PADDING is the number of spaces before the text." "Insert a padded divider comment banner. Prompts for decoration character, text, padding, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default =): " nil nil "=")) (text (read-string "Comment text: ")) (padding (string-to-number (read-string "Padding spaces (default 2): " nil nil "2"))) @@ -333,12 +341,9 @@ LENGTH is the total width of each line." "Insert a 3-line comment box with centered text. Prompts for decoration character, text, and uses `fill-column' for length." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default -): " nil nil "-")) (text (capitalize (string-trim (read-from-minibuffer "Comment: ")))) (length (min fill-column 80))) @@ -361,12 +366,9 @@ text, so it delegates to `cj/--comment-box-emit' with HEAVY non-nil." "Insert a heavy box comment with blank lines around centered text. Prompts for decoration character, text, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default *): " nil nil "*")) (text (read-string "Comment text: ")) (length-option (completing-read "Comment length: " @@ -444,12 +446,9 @@ BOX-STYLE is either \\='single or \\='double for line style." "Insert a unicode box comment. Prompts for text, box style, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (text (read-string "Comment text: ")) (box-style (intern (completing-read "Comment box style: " '("single" "double") diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 12d2deaf..3c33dcad 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -126,18 +126,27 @@ active, otherwise the entire buffer." (cons (region-beginning) (region-end)) (cons (point-min) (point-max)))) -(defun cj/append-to-lines-in-region-or-buffer (str) - "Append STR to the end of each line in the region or entire buffer." - (interactive "sEnter string to append: ") +(defun cj/--replace-region-or-buffer (transform) + "Replace the region (or whole buffer) with TRANSFORM applied to its text. +TRANSFORM takes the current text and returns the replacement. The +replacement is computed before anything is deleted, so a TRANSFORM error +leaves the buffer untouched. Point lands at the start of the replaced +span. The shared delete/goto/insert tail of the line-transform commands." (let* ((bounds (cj/--region-or-buffer-bounds)) (start-pos (car bounds)) (end-pos (cdr bounds)) (text (buffer-substring start-pos end-pos)) - (insertion (cj/--append-to-lines text str))) + (insertion (funcall transform text))) (delete-region start-pos end-pos) (goto-char start-pos) (insert insertion))) +(defun cj/append-to-lines-in-region-or-buffer (str) + "Append STR to the end of each line in the region or entire buffer." + (interactive "sEnter string to append: ") + (cj/--replace-region-or-buffer + (lambda (text) (cj/--append-to-lines text str)))) + (defun cj/--prepend-to-lines (text prefix) "Internal implementation: Prepend PREFIX to each line in TEXT. TEXT is the string containing one or more lines. @@ -158,14 +167,8 @@ Returns the transformed string without modifying the buffer." (defun cj/prepend-to-lines-in-region-or-buffer (str) "Prepend STR to the beginning of each line in the region or entire buffer." (interactive "sEnter string to prepend: ") - (let* ((bounds (cj/--region-or-buffer-bounds)) - (start-pos (car bounds)) - (end-pos (cdr bounds)) - (text (buffer-substring start-pos end-pos)) - (insertion (cj/--prepend-to-lines text str))) - (delete-region start-pos end-pos) - (goto-char start-pos) - (insert insertion))) + (cj/--replace-region-or-buffer + (lambda (text) (cj/--prepend-to-lines text str)))) (defun cj/--indent-lines (text count use-tabs) "Internal implementation: Indent each line in TEXT by COUNT characters. @@ -188,14 +191,8 @@ mean the count. Call it from Lisp with an explicit USE-TABS to override." (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)) - (text (buffer-substring start-pos end-pos)) - (insertion (cj/--indent-lines text count use-tabs))) - (delete-region start-pos end-pos) - (goto-char start-pos) - (insert insertion))) + (cj/--replace-region-or-buffer + (lambda (text) (cj/--indent-lines text count use-tabs)))) (defun cj/--dedent-lines (text count) "Internal implementation: Remove up to COUNT leading characters from each line. @@ -234,14 +231,8 @@ Works on region if active, otherwise entire buffer." (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)) - (text (buffer-substring start-pos end-pos)) - (insertion (cj/--dedent-lines text count))) - (delete-region start-pos end-pos) - (goto-char start-pos) - (insert insertion))) + (cj/--replace-region-or-buffer + (lambda (text) (cj/--dedent-lines text count)))) ;; Text enclosure keymap (defvar-keymap cj/enclose-map diff --git a/modules/dashboard-config.el b/modules/dashboard-config.el index d5aa501d..c7ff39dc 100644 --- a/modules/dashboard-config.el +++ b/modules/dashboard-config.el @@ -73,6 +73,7 @@ ;; External package commands invoked by launchers. (declare-function mu4e "mu4e") (declare-function pearl-list-issues "pearl") +(declare-function wttrin "wttrin") ;; ------------------------ Dashboard Bookmarks Override ----------------------- ;; overrides the bookmark insertion from the dashboard package to provide an @@ -84,38 +85,47 @@ (defvar dashboard-bookmarks-item-format "%s" "Format to use when showing the base of the file name.") -;; `el' is bound dynamically by dashboard's section-insertion machinery, which the -;; override below plugs into. Declare it so the byte-compiler reads the -;; references as that special variable rather than a free variable. The name is -;; dashboard's, not ours, so the missing-prefix lint is suppressed rather than -;; renamed (renaming would break the dynamic binding dashboard supplies). -(with-suppressed-warnings ((lexical el)) - (defvar el)) - -(defun dashboard-insert-bookmarks (list-size) - "Add the list of LIST-SIZE items of bookmarks." - (require 'bookmark) - (dashboard-insert-section - "Bookmarks:" - (dashboard-subseq (bookmark-all-names) list-size) - list-size - 'bookmarks - (dashboard-get-shortcut 'bookmarks) - `(lambda (&rest _) (bookmark-jump ,el)) - (if-let* ((filename el) - (path (bookmark-get-filename el)) - (path-shorten (dashboard-shorten-path path 'bookmarks))) - (cl-case dashboard-bookmarks-show-path - (`align - (unless dashboard--bookmarks-cache-item-format - (let* ((len-align (dashboard--align-length-by-type 'bookmarks)) - (new-fmt (dashboard--generate-align-format - dashboard-bookmarks-item-format len-align))) - (setq dashboard--bookmarks-cache-item-format new-fmt))) - (format dashboard--bookmarks-cache-item-format filename path-shorten)) - (`nil filename) - (t (format dashboard-bookmarks-item-format filename path-shorten))) - el))) +;; No `(defvar el)' here on purpose. `el' is the per-item variable that +;; dashboard's `dashboard-insert-section' macro binds inside its own expansion; +;; the override's forms below reference it within that binding. Declaring `el' +;; special (as an earlier attempt did) is what CREATED a byte-compile warning -- +;; it turned the macro's ordinary lexical binding into one that "shadows the +;; dynamic variable el". Left lexical, the references resolve inside the +;; expansion and the compile is clean. + +;; The override body uses the `dashboard-insert-section' MACRO, so it must be +;; known when this module byte-compiles or the call compiles as a plain +;; function call that evaluates `el' eagerly -- void-variable at render time. +(eval-when-compile (require 'dashboard-widgets nil t)) + +;; Registered after dashboard-widgets, not as a bare top-level defun: the +;; use-package below reloads dashboard-widgets, which would clobber an eager +;; override. Same shape as the banner-title override further down. +(with-eval-after-load 'dashboard-widgets + (defun dashboard-insert-bookmarks (list-size) + "Add the list of LIST-SIZE items of bookmarks." + (require 'bookmark) + (dashboard-insert-section + "Bookmarks:" + (dashboard-subseq (bookmark-all-names) list-size) + list-size + 'bookmarks + (dashboard-get-shortcut 'bookmarks) + `(lambda (&rest _) (bookmark-jump ,el)) + (if-let* ((filename el) + (path (bookmark-get-filename el)) + (path-shorten (dashboard-shorten-path path 'bookmarks))) + (cl-case dashboard-bookmarks-show-path + (`align + (unless dashboard--bookmarks-cache-item-format + (let* ((len-align (dashboard--align-length-by-type 'bookmarks)) + (new-fmt (dashboard--generate-align-format + dashboard-bookmarks-item-format len-align))) + (setq dashboard--bookmarks-cache-item-format new-fmt))) + (format dashboard--bookmarks-cache-item-format filename path-shorten)) + (`nil filename) + (t (format dashboard-bookmarks-item-format filename path-shorten))) + el)))) ;; ------------------------- Banner Title Centering Fix ------------------------ ;; The default centering can be off due to font width calculations. diff --git a/modules/dev-fkeys.el b/modules/dev-fkeys.el index 80b43600..c760e392 100644 --- a/modules/dev-fkeys.el +++ b/modules/dev-fkeys.el @@ -82,13 +82,25 @@ recognized markers both return nil." ;; ---------- Action handlers ---------- +(defun cj/--f4-install-once-hook (buffer then-fn) + "Install a one-shot buffer-local compilation finish hook in BUFFER. +Installing in the compilation buffer itself (rather than globally) +means a quit before the compile starts, or an unrelated concurrent +compile, can never fire the chained THEN-FN. No-op when BUFFER is not +a live buffer." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (add-hook 'compilation-finish-functions + (cj/--f4-make-once-hook then-fn) nil t)))) + (defun cj/--f4-compile-and-run-impl () "Run `projectile-compile-project', then `projectile-run-project' on success. -Installs a one-shot `compilation-finish-functions' hook to chain the run." - (add-hook 'compilation-finish-functions - (cj/--f4-make-once-hook - (lambda () (projectile-run-project nil)))) - (projectile-compile-project nil)) +Chains the run via a one-shot finish hook installed buffer-locally in +the compilation buffer projectile returns." + (let ((result (projectile-compile-project nil))) + (cj/--f4-install-once-hook + (cj/--projectile-compilation-buffer result) + (lambda () (projectile-run-project nil))))) (defun cj/--f4-dispatch (action) "Route ACTION (a symbol from `cj/--f4-candidates') to its handler. @@ -109,24 +121,26 @@ command (prompted-and-cached by projectile) drives the build." (let ((clean-cmd (cj/--f4-derive-clean-cmd root))) (unless clean-cmd (user-error "Clean + Rebuild: no clean command for this project type")) - (add-hook 'compilation-finish-functions - (cj/--f4-make-once-hook - (lambda () (projectile-compile-project nil)))) - (let ((default-directory root)) - (compile clean-cmd)))) + (let* ((default-directory root) + (buffer (compile clean-cmd))) + (cj/--f4-install-once-hook + buffer (lambda () (projectile-compile-project nil)))))) ;; ---------- One-shot compilation-finish hook ---------- (defun cj/--f4-make-once-hook (then-fn) "Build a one-shot `compilation-finish-functions' hook that chains THEN-FN. The returned lambda removes itself from `compilation-finish-functions' on -first invocation regardless of status, then calls THEN-FN only if the -status string starts with \"finished\" (the convention used by compile.el -for a successful compile)." +first invocation regardless of status — from both the global value and +the running buffer's local value, so it is one-shot wherever it was +installed — then calls THEN-FN only if the status string starts with +\"finished\" (the convention used by compile.el for a successful +compile)." (let (hook) (setq hook (lambda (_buf status) (remove-hook 'compilation-finish-functions hook) + (remove-hook 'compilation-finish-functions hook t) (when (and (stringp status) (string-prefix-p "finished" status)) (funcall then-fn)))) @@ -350,9 +364,10 @@ TypeScript / JavaScript and unknown languages return nil." (if (string-empty-p rel-dir) "./" (format "./%s" rel-dir))))) - ('typescript + ((or 'typescript 'javascript) ;; Prefer vitest when present on PATH, fall back to jest otherwise. - ;; Both runners take a path argument and accept relative paths. + ;; Both runners take a path argument and accept relative paths, and + ;; both run JS test files the same way they run TS ones. (let ((runner (or (and (executable-find "vitest") "vitest") (and (executable-find "jest") "jest") "jest"))) ; reasonable default for stack traces diff --git a/modules/diff-config.el b/modules/diff-config.el index 0c09b951..75911587 100644 --- a/modules/diff-config.el +++ b/modules/diff-config.el @@ -40,7 +40,6 @@ :custom (ediff-window-setup-function 'ediff-setup-windows-plain) (ediff-split-window-function 'split-window-horizontally) - (ediff-diff-options "-w") (ediff-highlight-all-diffs nil) :bind-keymap ("C-c D" . cj/ediff-map) :init diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el index ef41ab33..edbb0b35 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -8,8 +8,8 @@ ;; Load shape: eager. ;; Eager reason: none; file manager, a command/hook-loaded deferral candidate. ;; Top-level side effects: three add-hook, package configuration via use-package. -;; Runtime requires: user-constants, system-utils, host-environment, system-lib, -;; external-open-lib. +;; Runtime requires: user-constants, system-utils, external-open, +;; host-environment, system-lib, external-open-lib. ;; Direct test load: yes. ;; ;; Enhanced file management via Dirvish (modern dired replacement) with icons, @@ -34,7 +34,8 @@ ;;; Code: (require 'user-constants) ;; code-dir, music-dir, pix-dir et al. used at load time -(require 'system-utils) ;; cj/xdg-open, cj/open-file-with-command bound to keys +(require 'system-utils) ;; cj/open-file-with-command bound to keys +(require 'external-open) ;; cj/xdg-open bound to keys ("o" and OS-handler fallback) (require 'host-environment) (require 'system-lib) (require 'external-open-lib) diff --git a/modules/dwim-shell-config.el b/modules/dwim-shell-config.el index e8790a48..12908f51 100644 --- a/modules/dwim-shell-config.el +++ b/modules/dwim-shell-config.el @@ -7,7 +7,7 @@ ;; Load shape: eager. ;; Eager reason: none; Dired/Dirvish shell commands can load by command. ;; Top-level side effects: package configuration via use-package. -;; Runtime requires: cl-lib, system-lib. +;; Runtime requires: cl-lib, system-lib, external-open. ;; Direct test load: yes. ;; ;; Configures dwim-shell-command actions for marked Dired/Dirvish files: @@ -22,7 +22,8 @@ ;;; Code: (require 'cl-lib) -(require 'system-lib) ;; cj/confirm-strong (permanent file destruction confirm) +(require 'system-lib) ;; cj/confirm-destructive (permanent file destruction confirm) +(require 'external-open) ;; cj/xdg-open, called to open conversion output files ;; Function declarations (lazily-loaded packages and sibling modules). (declare-function dwim-shell-command-on-marked-files "dwim-shell-command") @@ -222,7 +223,7 @@ not apply to). Signals a `user-error' when a used second count is negative." :utils "convert")) (defun cj/dwim-shell-commands-flip-image-vertically () - "Horizontally flip image(s)." + "Vertically flip image(s)." (interactive) (dwim-shell-command-on-marked-files "Image vertical flip" @@ -764,7 +765,7 @@ switching off the .7z format to gpg-wrapped tar." Uses =shred -u= so the file is unlinked after overwriting, matching the \"delete\" the command name and prompt promise." (interactive) - (when (cj/confirm-strong "This will permanently destroy files. Continue? ") + (when (cj/confirm-destructive "This will permanently destroy files. Continue? ") (dwim-shell-command-on-marked-files "Secure delete" "shred -vfzu -n 3 '<<f>>'" diff --git a/modules/elfeed-config.el b/modules/elfeed-config.el index dbc7e4a4..f4feef3a 100644 --- a/modules/elfeed-config.el +++ b/modules/elfeed-config.el @@ -142,30 +142,6 @@ (elfeed-search-update--force) (goto-char (point-min))) -;; ----------------------------- Extract Stream URL ---------------------------- -;; TASK: Is this method reused anywhere here or in another file? - -(defun cj/extract-stream-url (url format) - "Extract the direct stream URL from URL using yt-dlp with FORMAT. -Returns the stream URL or nil on failure." - (unless (executable-find "yt-dlp") - (error "The program yt-dlp is not installed or not in PATH")) - (let* ((format-args (if format - (list "-f" format) - nil)) - (cmd-args (append '("yt-dlp" "-q" "-g") - format-args - (list url))) - (output (with-temp-buffer - (let ((exit-code (apply #'call-process - (car cmd-args) nil t nil - (cdr cmd-args)))) - (if (zerop exit-code) - (string-trim (buffer-string)) - nil))))) - (when (and output (string-match-p "^https?://" output)) - output))) - ;; -------------------------- Elfeed Core Processing --------------------------- (defun cj/elfeed-process-entries (action-fn action-name &optional skip-error-handling) diff --git a/modules/erc-config.el b/modules/erc-config.el index 57d4eb56..afcb3901 100644 --- a/modules/erc-config.el +++ b/modules/erc-config.el @@ -38,6 +38,7 @@ ;; without forcing an eager require. ;; Functions provided by the erc package. +(defvar erc-server-process) (declare-function erc-buffer-list "erc") (declare-function erc-server-process-alive "erc") (declare-function erc-server-or-unjoined-channel-buffer-p "erc") diff --git a/modules/external-open.el b/modules/external-open.el index 811c32c2..f7f09816 100644 --- a/modules/external-open.el +++ b/modules/external-open.el @@ -142,6 +142,18 @@ Logs output and exit code to buffer *external-open.log*." ;; ------------------------------- Open File With ------------------------------ +(defun cj/--open-with-argv (command file) + "The argv list to open FILE with the user-typed COMMAND. +COMMAND may carry arguments (\"mpv --fs\"); `split-string-and-unquote' +splits it so a double-quoted argument survives as one word. FILE is +appended as the final element, so paths with spaces or shell +metacharacters never meet a shell. Signals a `user-error' when COMMAND +is empty or whitespace." + (let ((argv (split-string-and-unquote command))) + (unless argv + (user-error "No program given")) + (append argv (list file)))) + (defun cj/open-this-file-with (command) "Open this buffer's file with COMMAND, detached from Emacs." (interactive "MOpen with program: ") @@ -152,12 +164,12 @@ Logs output and exit code to buffer *external-open.log*." ;; Windows: launch via ShellExecute so the child isn't tied to Emacs. ((env-windows-p) (w32-shell-execute "open" command (format "\"%s\"" file))) - ;; POSIX: disown with nohup + background. No child remains. + ;; POSIX: argv launch, DESTINATION 0 detaches with no shell in between. (t - (call-process-shell-command - (format "nohup %s %s >/dev/null 2>&1 &" - command (shell-quote-argument file)) - nil 0))))) + (let ((argv (cj/--open-with-argv command file))) + (unless (executable-find (car argv)) + (user-error "Program not found: %s" (car argv))) + (apply #'call-process (car argv) nil 0 nil (cdr argv))))))) ;; -------------------------- Open Videos On Repeat ---------------------------- @@ -185,6 +197,11 @@ blocks Emacs." (if (env-windows-p) (w32-shell-execute "open" cj/video-open-command (mapconcat (lambda (a) (format "\"%s\"" a)) args " ")) + ;; Guard like `cj/open-this-file-with': this fires via the find-file + ;; advice, so a missing player must fail with a clear message, not an + ;; opaque call-process error mid-visit. + (unless (executable-find cj/video-open-command) + (user-error "Program not found: %s" cj/video-open-command)) (apply #'call-process cj/video-open-command nil 0 nil args)))) ;; -------------------- Open Files With Default File Handler ------------------- diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index ebe4898e..d0cdd09c 100644 --- a/modules/flyspell-and-abbrev.el +++ b/modules/flyspell-and-abbrev.el @@ -73,8 +73,10 @@ ;; personal directory goes with sync'd files (setq ispell-personal-dictionary (concat org-dir "aspell-personal-dictionary")) - ;; skip code blocks in org mode - (add-to-list 'ispell-skip-region-alist '("^#+BEGIN_SRC" . "^#+END_SRC"))) + ;; Skip code blocks in org mode. The # must be literal and the + escaped: + ;; "#+" in regex means one-or-more #, which matches no real begin_src line, + ;; so ispell used to spell-check inside every org code block. + (add-to-list 'ispell-skip-region-alist '("^#\\+BEGIN_SRC" . "^#\\+END_SRC"))) (use-package flyspell :ensure nil ;; built-in diff --git a/modules/font-config.el b/modules/font-config.el index e5afb361..e4549c95 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -8,12 +8,12 @@ ;; Load shape: eager. ;; Eager reason: first-frame font setup and font keybindings. ;; Top-level side effects: font keys, font checks, package config. -;; Runtime requires: host-environment, keybindings. +;; Runtime requires: host-environment, font-profiles, keybindings. ;; Direct test load: yes. ;; -;; Configures fontaine presets, text scaling keys, icon/emoji fonts, and -;; programming ligatures. Presets are applied per frame so daemon clients get -;; the intended fixed/variable pitch sizes. +;; Configures task-oriented Fontaine profiles, text scaling keys, icon/emoji +;; fonts, and programming ligatures. The selected profile is global, persists +;; across restarts, and applies to every daemon frame without per-frame resets. ;; ;; Also carries font-rendering safeguards for known HarfBuzz/font-cache crashes ;; triggered by emoji and Arabic shaping in this setup. @@ -21,6 +21,7 @@ ;;; Code: (require 'host-environment) +(require 'font-profiles) (require 'keybindings) ;; establishes the C-z prefix used for "C-z F" below (defvar text-scale-mode-step) @@ -50,106 +51,156 @@ (#xFE70 . #xFEFF))) ;; Arabic Presentation Forms-B (set-char-table-range composition-function-table range nil))) -;; ----------------------- Font Family And Size Selection ---------------------- -;; preset your fixed and variable fonts, then apply them to text as a set +;; ------------------------- Workflow Font Profiles ---------------------------- +;; Each choice is a complete destination. Font size adjustments within one +;; buffer remain on C-+/C--; Fontaine owns the global workflow typography. + +(defconst cj/fontaine-profile-order + cj/font-profile-order + "Fontaine profiles in picker order.") + +(defconst cj/fontaine-profile-names + '((everyday . "Everyday") + (writing . "Writing") + (reading . "Reading") + (coding-xs . "Coding XS") + (coding-m . "Coding M") + (coding-l . "Coding L") + (coding-xl . "Coding XL") + (presentation . "Presentation")) + "Human names for Fontaine workflow profiles.") + +(defconst cj/fontaine-profile-fonts + '((everyday . "Berkeley Mono + Lexend") + (writing . "Berkeley Mono + Merriweather") + (reading . "Merriweather") + (coding-xs . "Berkeley Mono") + (coding-m . "Berkeley Mono") + (coding-l . "Berkeley Mono") + (coding-xl . "Berkeley Mono") + (presentation . "Berkeley Mono + Lexend")) + "Human-readable font combinations for Fontaine workflow profiles.") + +(defconst cj/fontaine-profile-heights + (mapcar (lambda (profile) + (cons profile + (plist-get (cj/font-profile-properties profile) + :default-height))) + cj/fontaine-profile-order) + "Default face heights for Fontaine workflow profiles.") + +(defconst cj/fontaine-ui-family "BerkeleyMono Nerd Font" + "Font family reserved for the mode line, echo area, and minibuffer.") + +(defvar fontaine-current-preset) +(defvar fontaine-preset-history) +(defvar fontaine-presets) +(defvar enable-theme-functions) +(defvar cj/fontaine-profile-history nil + "Minibuffer history for `cj/fontaine-select-profile'.") + +(declare-function fontaine-mode "fontaine") +(declare-function fontaine-restore-latest-preset "fontaine") +(declare-function fontaine-set-preset "fontaine") +(declare-function face-remap-set-base "face-remap") + +(defun cj/fontaine-profile-p (profile) + "Return non-nil when PROFILE is a configured workflow profile." + (cj/font-profile-p profile)) + +(defun cj/fontaine-profile-label (profile) + "Return the complete picker label for PROFILE." + (when (cj/fontaine-profile-p profile) + (format "%s — %s · %d pt" + (alist-get profile cj/fontaine-profile-names) + (alist-get profile cj/fontaine-profile-fonts) + (/ (alist-get profile cj/fontaine-profile-heights) 10)))) + +(defun cj/fontaine-profile-candidates () + "Return complete labels for all Fontaine workflow profiles." + (mapcar #'cj/fontaine-profile-label cj/fontaine-profile-order)) + +(defun cj/fontaine-profile-from-label (label) + "Return the workflow profile represented by LABEL, or nil." + (seq-find (lambda (profile) + (equal label (cj/fontaine-profile-label profile))) + cj/fontaine-profile-order)) + +(defun cj/fontaine-profile-annotation (candidate) + "Mark CANDIDATE when it represents the active Fontaine profile." + (if (eq (cj/fontaine-profile-from-label candidate) + fontaine-current-preset) + " current" + "")) + +(defun cj/fontaine-apply-profile (profile) + "Apply workflow PROFILE and record it for Fontaine persistence." + (unless (cj/fontaine-profile-p profile) + (user-error "Unknown font profile: %s" profile)) + (add-to-history 'fontaine-preset-history (symbol-name profile)) + (fontaine-set-preset profile)) + +(defun cj/fontaine-select-profile () + "Select and apply one complete Fontaine workflow profile." + (interactive) + (let* ((candidates (cj/fontaine-profile-candidates)) + (default (cj/fontaine-profile-label + (if (cj/fontaine-profile-p fontaine-current-preset) + fontaine-current-preset + 'everyday))) + (completion-extra-properties + '(:annotation-function cj/fontaine-profile-annotation)) + (choice (completing-read "Font profile: " candidates nil t + nil 'cj/fontaine-profile-history default))) + (cj/fontaine-apply-profile (cj/fontaine-profile-from-label choice)))) + +(defun cj/fontaine-restored-or-default-profile () + "Return the saved Fontaine profile, or the `everyday' fallback." + (let ((restored (fontaine-restore-latest-preset))) + (if (cj/fontaine-profile-p restored) restored 'everyday))) + +(defalias 'cj/fontaine-profile-properties #'cj/font-profile-properties) +(defalias 'cj/fontaine-remap-buffer-to-profile #'cj/font-profile-remap-buffer) + +(defun cj/fontaine-remap-ui-buffer () + "Keep the current minibuffer or echo-area buffer in Berkeley Mono." + (face-remap-set-base + 'default `(:family ,cj/fontaine-ui-family))) + +(defun cj/fontaine-keep-ui-chrome-monospace (&rest _ignored) + "Keep mode-line, minibuffer, and echo-area chrome in Berkeley Mono." + (dolist (face '(mode-line mode-line-active mode-line-inactive + minibuffer-prompt)) + (when (facep face) + (set-face-attribute face nil :family cj/fontaine-ui-family))) + (dolist (name '(" *Echo Area 0*" " *Echo Area 1*")) + (when-let* ((buffer (get-buffer name))) + (with-current-buffer buffer + (cj/fontaine-remap-ui-buffer))))) + +;; Fontaine 3 is global rather than frame-specific. Remove the retired hooks +;; as well as omitting them below, so a live module reload migrates cleanly. +(remove-hook 'server-after-make-frame-hook #'cj/apply-font-settings-to-frame) +(remove-hook 'delete-frame-functions #'cj/cleanup-frame-list) (use-package fontaine :demand t :bind - ("M-S-f" . fontaine-set-preset) ;; was M-F, overrides forward-word + ("M-S-f" . cj/fontaine-select-profile) ;; was M-F, overrides forward-word :config (setq fontaine-presets - `( - (default - :default-family "BerkeleyMono Nerd Font" - :default-weight regular - :default-height ,(if (env-laptop-p) 130 140) - :fixed-pitch-family nil ;; falls back to :default-family - :fixed-pitch-weight nil ;; falls back to :default-weight - :fixed-pitch-height 1.0 - :variable-pitch-family "Lexend" - :variable-pitch-weight regular - :variable-pitch-height 1.0) - (FiraCode - :default-family "FiraCode Nerd Font Mono" - :variable-pitch-family "Merriweather" - :variable-pitch-weight light) - (Hack - :default-family "Hack Nerd Font Mono" - :variable-pitch-family "Hack Nerd Font Mono") - (BerkeleyMono - :default-family "Berkeley Mono" - :variable-pitch-family "Charis SIL") - (FiraCode-Literata - :default-family "Fira Code Nerd Font" - :variable-pitch-family "Literata") - (24-point-font - :default-height 240) - (20-point-font - :default-height 200) - (16-point-font - :default-height 160) - (14-point-font - :default-height 140) - (13-point-font - :default-height 130) - (12-point-font - :default-height 120) - (11-point-font - :default-height 110) - (10-point-font - :default-height 100) - (t ;; shared fallback properties go here - :default-family "FiraCode Nerd Font Mono" - :default-weight regular - :default-height 120 - :fixed-pitch-family nil ;; falls back to :default-family - :fixed-pitch-weight nil ;; falls back to :default-weight - :fixed-pitch-height 1.0 - :fixed-pitch-serif-family nil ;; falls back to :default-family - :fixed-pitch-serif-weight nil ;; falls back to :default-weight - :fixed-pitch-serif-height 1.0 - :variable-pitch-family "Merriweather" - :variable-pitch-weight light - :variable-pitch-height 1.0 - :bold-family nil ;; use whatever the underlying face has - :bold-weight bold - :italic-family nil - :italic-slant italic - :line-spacing nil)))) - -;; Track which frames have had fonts applied -(defvar cj/fontaine-configured-frames nil - "List of frames that have had fontaine configuration applied.") - -(declare-function fontaine-set-preset "fontaine") - -(defun cj/apply-font-settings-to-frame (&optional frame) - "Apply font settings to FRAME if not already configured. -If FRAME is nil, uses the selected frame." - (let ((target-frame (or frame (selected-frame)))) - (unless (member target-frame cj/fontaine-configured-frames) - (with-selected-frame target-frame - (when (env-gui-p) - (fontaine-set-preset 'default) - (push target-frame cj/fontaine-configured-frames)))))) - -(defun cj/cleanup-frame-list (frame) - "Remove FRAME from the configured frames list when deleted." - (setq cj/fontaine-configured-frames - (delq frame cj/fontaine-configured-frames))) - -(with-eval-after-load 'fontaine - ;; Handle daemon mode and regular mode - (if (daemonp) - (progn - ;; Apply to each new frame in daemon mode - (add-hook 'server-after-make-frame-hook #'cj/apply-font-settings-to-frame) - ;; Clean up deleted frames from tracking list - (add-hook 'delete-frame-functions #'cj/cleanup-frame-list)) - ;; Apply immediately in non-daemon mode - (when (env-gui-p) - (cj/apply-font-settings-to-frame)))) + (append (copy-tree cj/font-profile-definitions) + (list (cons t (copy-sequence + cj/font-profile-shared-properties))))) + (fontaine-mode 1) + (add-hook 'fontaine-set-preset-hook + #'cj/fontaine-keep-ui-chrome-monospace) + (add-hook 'enable-theme-functions + #'cj/fontaine-keep-ui-chrome-monospace) + (add-hook 'minibuffer-setup-hook #'cj/fontaine-remap-ui-buffer) + (cj/fontaine-keep-ui-chrome-monospace) + (when (or (daemonp) (env-gui-p)) + (cj/fontaine-apply-profile (cj/fontaine-restored-or-default-profile)))) ;; ----------------------------- Font Install Check ---------------------------- ;; convenience function to indicate whether a font is available by name. diff --git a/modules/font-profiles.el b/modules/font-profiles.el new file mode 100644 index 00000000..a2c40562 --- /dev/null +++ b/modules/font-profiles.el @@ -0,0 +1,116 @@ +;;; font-profiles.el --- Shared Workflow Font Profile Data -*- lexical-binding: t; coding: utf-8; -*- +;; author: Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 1 (Foundation). +;; Category: F/L. +;; Load shape: library. +;; Top-level side effects: none. +;; Runtime requires: host-environment. +;; Direct test load: yes. +;; +;; Owns the effective font properties shared by the global Fontaine adapter and +;; buffer-local mode adapters such as nov-reading. Consumers can therefore use +;; the same named profile without making a global Fontaine selection. + +;;; Code: + +(require 'host-environment) + +(declare-function face-remap-add-relative "face-remap") + +(defconst cj/font-profile-shared-properties + `(:default-family "BerkeleyMono Nerd Font" + :default-weight regular + :default-height ,(if (env-laptop-p) 130 140) + :fixed-pitch-family nil + :fixed-pitch-weight nil + :fixed-pitch-height 1.0 + :fixed-pitch-serif-family nil + :fixed-pitch-serif-weight nil + :fixed-pitch-serif-height 1.0 + :variable-pitch-family "Lexend" + :variable-pitch-weight regular + :variable-pitch-height 1.0 + :bold-family nil + :bold-weight bold + :italic-family nil + :italic-slant italic + :line-spacing nil) + "Properties shared by every workflow font profile unless overridden.") + +(defconst cj/font-profile-definitions + '((everyday) + (writing + :default-height 140 + :variable-pitch-family "Merriweather" + :variable-pitch-weight light) + (reading + :default-family "Merriweather" + :default-height 140 + :fixed-pitch-family "Merriweather" + :fixed-pitch-serif-family "Merriweather" + :variable-pitch-family "Merriweather") + (coding-xs + :default-height 110 + :variable-pitch-family "BerkeleyMono Nerd Font") + (coding-m + :default-height 130 + :variable-pitch-family "BerkeleyMono Nerd Font") + (coding-l + :default-height 140 + :variable-pitch-family "BerkeleyMono Nerd Font") + (coding-xl + :default-height 160 + :variable-pitch-family "BerkeleyMono Nerd Font") + (presentation + :default-height 200)) + "Profile-specific font properties in user-facing order.") + +(defconst cj/font-profile-order + (mapcar #'car cj/font-profile-definitions) + "Workflow font profiles in user-facing order.") + +(defun cj/font-profile-p (profile) + "Return non-nil when PROFILE is a configured workflow font profile." + (memq profile cj/font-profile-order)) + +(defun cj/font-profile-properties (profile) + "Return effective font properties for workflow PROFILE." + (let ((entry (assq profile cj/font-profile-definitions))) + (unless entry + (user-error "Unknown font profile: %s" profile)) + (append (cdr entry) cj/font-profile-shared-properties))) + +(defun cj/font-profile-remap-buffer (profile &optional height) + "Apply PROFILE's face families buffer-locally and return remap cookies. +When HEIGHT is non-nil, use it for every remapped face instead of the profile's +configured heights. No global face or Fontaine state is changed." + (let ((properties (cj/font-profile-properties profile)) + (cookies nil)) + (dolist (face-property '((default + :default-family :default-height) + (fixed-pitch + :fixed-pitch-family :fixed-pitch-height) + (fixed-pitch-serif + :fixed-pitch-serif-family + :fixed-pitch-serif-height) + (variable-pitch + :variable-pitch-family + :variable-pitch-height))) + (pcase-let ((`(,face ,family-property ,height-property) + face-property)) + (let ((family (or (plist-get properties family-property) + (and (memq face '(fixed-pitch fixed-pitch-serif)) + (plist-get properties :default-family)))) + (face-height (or height + (plist-get properties height-property)))) + (when family + (push (face-remap-add-relative + face :family family :height face-height) + cookies))))) + (nreverse cookies))) + +(provide 'font-profiles) +;;; font-profiles.el ends here diff --git a/modules/help-utils.el b/modules/help-utils.el index 9792841a..2709ac45 100644 --- a/modules/help-utils.el +++ b/modules/help-utils.el @@ -65,24 +65,40 @@ ;; on Arch: yay (or whatever your AUR package manager is) -S arch-wiki-docs ;; browse the arch wiki topics offline +(defvar cj/arch-wiki-html-dir "/usr/share/doc/arch-wiki/html/en" + "Directory holding the offline ArchWiki HTML copies. +Populated by the arch-wiki-docs package on Arch systems.") + +(defun cj/--arch-wiki-topics (dir) + "Return an alist of (BASENAME . FULLPATH) for ArchWiki topics under DIR. + +Returns nil when DIR does not exist rather than signaling. This is the +whole point of the helper: `directory-files' raises file-missing on an +absent directory, and the caller's \"is arch-wiki-docs installed?\" hint +sat below that call, so on the one machine state the hint was written for +it could never be reached." + (when (file-directory-p dir) + (mapcar (lambda (f) (cons (file-name-base f) f)) + (directory-files dir t "\\.html\\'")))) + (defun cj/local-arch-wiki-search () "Prompt for an ArchWiki topic and open its local HTML copy in EWW. -Looks for “*.html” files under \"/usr/share/doc/arch-wiki/html/en\", -lets you complete on their basenames, and displays the chosen file -with `eww-browse-url'. If no file is found, reminds you to install +Looks for “*.html” files under `cj/arch-wiki-html-dir', lets you complete +on their basenames, and displays the chosen file with `eww-browse-url'. +If the directory is missing or empty, reminds you to install arch-wiki-docs." (interactive) - (let* ((dir "/usr/share/doc/arch-wiki/html/en") - (full-filenames (directory-files dir t "\\.html\\'")) - (basenames (mapcar 'file-name-base full-filenames)) - (chosen (completing-read "Choose an ArchWiki Topic: " basenames))) - (if (member chosen basenames) - (let* ((idx (cl-position chosen basenames :test 'equal)) - (fullname (nth idx full-filenames)) - (url (concat "file://" fullname))) - (eww-browse-url url)) - (message "File not found! Is arch-wiki-docs installed?")))) + (let ((topics (cj/--arch-wiki-topics cj/arch-wiki-html-dir))) + (if (null topics) + (message "No ArchWiki topics in %s. Is arch-wiki-docs installed?" + cj/arch-wiki-html-dir) + (let* ((chosen (completing-read "Choose an ArchWiki Topic: " + (mapcar #'car topics))) + (fullname (cdr (assoc chosen topics)))) + (if fullname + (eww-browse-url (concat "file://" fullname)) + (message "No ArchWiki topic named %s" chosen)))))) (keymap-global-set "C-h A" #'cj/local-arch-wiki-search) (provide 'help-utils) diff --git a/modules/host-environment.el b/modules/host-environment.el index 0afb39cb..1c33e342 100644 --- a/modules/host-environment.el +++ b/modules/host-environment.el @@ -138,15 +138,13 @@ find /usr/share/zoneinfo -type f ! -name `posixrules' \\ (defun cj/detect-system-timezone () "Detect the system timezone in IANA format (e.g., `America/Los_Angeles'). -Tries multiple methods in order of reliability: -1. File comparison of /etc/localtime with zoneinfo database -2. Environment variable TZ -3. /etc/timezone file contents -4. /etc/localtime symlink target" +Tries the cheap methods first and the exhaustive scan last: +1. Environment variable TZ (most explicit if set) +2. /etc/timezone file contents (Debian/Ubuntu) +3. /etc/localtime symlink target (O(1) on symlinked systems) +4. File comparison of /etc/localtime against the zoneinfo database + (reads hundreds of files; only needed when localtime is a copy)" (or - ;; Compare file contents (reliable on Arch/modern systems) - (cj/match-localtime-to-zoneinfo) - ;; Environment variable (most explicit if set) (getenv "TZ") @@ -156,12 +154,15 @@ Tries multiple methods in order of reliability: (insert-file-contents "/etc/timezone") (string-trim (buffer-string)))) - ;; Method 4: Parse symlink (fallback for older systems) + ;; Parse the symlink -- O(1), answers on any symlinked /etc/localtime (when (file-symlink-p "/etc/localtime") (let ((target (file-truename "/etc/localtime"))) (when (string-match ".*/zoneinfo/\\(.+\\)" target) (match-string 1 target)))) + ;; Compare file contents -- the last resort for a copied /etc/localtime + (cj/match-localtime-to-zoneinfo) + ;; Default to nil if detection fails nil)) diff --git a/modules/httpd-config.el b/modules/httpd-config.el index 1a2a5c61..a3ae0fac 100644 --- a/modules/httpd-config.el +++ b/modules/httpd-config.el @@ -5,8 +5,9 @@ ;; ;; Layer: 4 (Optional). ;; Category: O/D/P. -;; Load shape: eager. -;; Eager reason: none; local web server, a command-loaded deferral candidate. +;; Load shape: deferred. +;; Defer reason: impatient-mode requires simple-httpd on demand; nothing +;; needs the server (or its www/ root) at startup. ;; Top-level side effects: package configuration via use-package. ;; Runtime requires: none. ;; Direct test load: yes. @@ -17,14 +18,15 @@ ;;;; -------------------------- Simple-Httpd ------------------------- (use-package simple-httpd - :defer 1 + :defer t :preface (defconst cj/httpd-wwwdir (concat user-emacs-directory "www")) (defun cj/httpd-check-or-create-wwwdir () (unless (file-exists-p cj/httpd-wwwdir) (make-directory cj/httpd-wwwdir))) - :init (cj/httpd-check-or-create-wwwdir) :config + ;; Create the doc root only when the server package actually loads. + (cj/httpd-check-or-create-wwwdir) (setq httpd-root cj/httpd-wwwdir) (setq httpd-show-backtrace-when-error t) (setq httpd-serve-files t)) diff --git a/modules/hugo-config.el b/modules/hugo-config.el index b26398c6..36f9e07a 100644 --- a/modules/hugo-config.el +++ b/modules/hugo-config.el @@ -28,6 +28,7 @@ (require 'user-constants) (require 'host-environment) (require 'system-lib) ;; completion table + file annotator +(require 'keybindings) ;; cj/register-prefix-map, cj/custom-keymap ;; --------------------------------- Constants --------------------------------- @@ -247,14 +248,18 @@ to /var/www/cjennings/, so a successful push is the deploy." ;; -------------------------------- Keybindings -------------------------------- -(global-set-key (kbd "C-; h n") #'cj/hugo-new-post) -(global-set-key (kbd "C-; h e") #'cj/hugo-export-post) -(global-set-key (kbd "C-; h o") #'cj/hugo-open-blog-dir) -(global-set-key (kbd "C-; h O") #'cj/hugo-open-blog-dir-external) -(global-set-key (kbd "C-; h d") #'cj/hugo-open-draft) -(global-set-key (kbd "C-; h D") #'cj/hugo-toggle-draft) -(global-set-key (kbd "C-; h p") #'cj/hugo-preview) -(global-set-key (kbd "C-; h P") #'cj/hugo-publish) +(defvar-keymap cj/hugo-keymap + :doc "Keymap for Hugo blog commands" + "n" #'cj/hugo-new-post + "e" #'cj/hugo-export-post + "o" #'cj/hugo-open-blog-dir + "O" #'cj/hugo-open-blog-dir-external + "d" #'cj/hugo-open-draft + "D" #'cj/hugo-toggle-draft + "p" #'cj/hugo-preview + "P" #'cj/hugo-publish) + +(cj/register-prefix-map "h" cj/hugo-keymap) (with-eval-after-load 'which-key (which-key-add-key-based-replacements diff --git a/modules/jumper.el b/modules/jumper.el index 1fbd1293..bfafe08b 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -194,6 +194,10 @@ Returns: \\='no-locations if no locations stored, locations)) (choice (completing-read "Jump to: " locations nil t)) (idx (cdr (assoc choice locations)))) + ;; A UI that permits empty input (no vertico) yields a choice with no + ;; entry; nil would crash the index arithmetic downstream. + (unless idx + (user-error "No matching location")) (jumper--do-jump-to-location idx) (message "Jumped to location"))))) @@ -230,7 +234,8 @@ Returns: \\='no-locations if no locations stored, (jumper--location-candidates)) (locations (cons (cons "Cancel" -1) locations)) (choice (completing-read "Remove location: " locations nil t)) - (idx (cdr (assoc choice locations)))) + ;; Empty input (no matching entry) cancels, same as picking Cancel. + (idx (or (cdr (assoc choice locations)) -1))) (pcase (jumper--do-remove-location idx) ('cancelled (message "Operation cancelled")) ('t (message "Location removed")))))) diff --git a/modules/media-utils.el b/modules/media-utils.el index 1abbc1b2..7047411f 100644 --- a/modules/media-utils.el +++ b/modules/media-utils.el @@ -119,8 +119,67 @@ stream URL (see the :needs-stream-url flag in `cj/media-players')." ;; ---------------------- Playing Via Default Media Player --------------------- +(defun cj/media--yt-dlp-argv (url formats) + "The argv to resolve URL's stream address: yt-dlp [-f FORMATS] -g URL. +FORMATS is a prioritized list of yt-dlp format codes, or nil for the +default. URL stays one verbatim argv element, so it never meets a shell." + (append (list "yt-dlp") + (when formats (list "-f" (string-join formats "/"))) + (list "-g" url))) + +(defun cj/media--stream-urls (output) + "The non-empty lines of yt-dlp -g OUTPUT, surrounding whitespace trimmed." + (split-string output "\n" t "[ \t\r]+")) + +(defun cj/media--play-argv (command args urls) + "The argv to play URLS with COMMAND. +ARGS is the player's raw option string from `cj/media-players' (nil for +none); it splits with `split-string-and-unquote' so a quoted option +survives as one word." + (append (list command) + (and args (split-string-and-unquote args)) + urls)) + +(defun cj/media--resolve-stream-urls (url formats) + "Resolve URL to direct stream URLs with a synchronous yt-dlp -g capture. +FORMATS is the player's format-preference list. Only stdout is parsed +for URLs -- yt-dlp's warnings go to stderr, captured separately for the +error message. Signals an error when yt-dlp exits non-zero or resolves +nothing." + (let ((err-file (make-temp-file "yt-dlp-stderr"))) + (unwind-protect + (with-temp-buffer + (let* ((argv (cj/media--yt-dlp-argv url formats)) + (exit (apply #'call-process (car argv) nil + (list t err-file) nil (cdr argv)))) + (unless (and (integerp exit) (zerop exit)) + (error "yt-dlp failed (exit %s): %s" exit + (string-trim + (with-temp-buffer + (insert-file-contents err-file) + (buffer-string))))) + (or (cj/media--stream-urls (buffer-string)) + (error "yt-dlp resolved no stream URL for %s" url)))) + (delete-file err-file)))) + +(defun cj/media--play-sentinel (url-display) + "A process sentinel reporting playback of URL-DISPLAY. +Messages success or failure and reaps the process buffer once the +player finishes or exits." + (lambda (proc event) + (cond + ((string-match-p "finished" event) + (message "✓ Finished playing: %s" url-display)) + ((string-match-p "exited abnormally" event) + (message "✗ Playback failed: %s" url-display))) + (when (string-match-p "finished\\|exited" event) + (kill-buffer (process-buffer proc))))) + (defun cj/media-play-it (url) - "Play the URL with the configured media player in an async process." + "Play the URL with the configured media player in an async process. +A player flagged :needs-stream-url gets the URL resolved first via a +synchronous yt-dlp -g capture (blocks briefly); the player then launches +with a plain argv list -- no shell anywhere in the pipeline." (let* ((player-config (alist-get cj/default-media-player cj/media-players)) (command (plist-get player-config :command)) (args (plist-get player-config :args)) @@ -131,56 +190,52 @@ stream URL (see the :needs-stream-url flag in `cj/media-players')." (unless (executable-find command) (error "%s is not installed or not in PATH" player-name)) + (when needs-stream-url + (unless (executable-find "yt-dlp") + (error "The program yt-dlp is not installed or not in PATH"))) - (let* ((buffer-name (format "*%s: %s*" player-name url-display)) - (shell-command - (if needs-stream-url - ;; Use shell substitution with yt-dlp - (let ((format-string (if yt-dlp-formats - (format "-f %s" - (mapconcat #'shell-quote-argument - yt-dlp-formats - "/")) - ""))) - (format "%s %s $(%s %s -g %s)" - command - (or args "") - "yt-dlp" - format-string - (shell-quote-argument url))) - ;; Direct playback without yt-dlp - (format "%s %s %s" - command - (or args "") - (shell-quote-argument url))))) + (let* ((urls (if needs-stream-url + (progn + (message "Resolving stream URL: %s" url-display) + (cj/media--resolve-stream-urls url yt-dlp-formats)) + (list url))) + (argv (cj/media--play-argv command args urls)) + (buffer-name (format "*%s: %s*" player-name url-display))) (message "Playing with %s: %s" player-name url-display) - (cj/log-silently "DEBUG: Executing: %s" shell-command) - - (let ((process (start-process-shell-command - player-name - buffer-name - shell-command))) - (set-process-sentinel - process - (lambda (proc event) - (cond - ((string-match-p "finished" event) - (message "✓ Finished playing: %s" url-display)) - ((string-match-p "exited abnormally" event) - (message "✗ Playback failed: %s" url-display) - (with-current-buffer (process-buffer proc) - (goto-char (point-min)) - (when (re-search-forward "ERROR:" nil t) - (cj/log-silently "DEBUG: yt-dlp error: %s" - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position))))))) - (when (string-match-p "finished\\|exited" event) - (kill-buffer (process-buffer proc))))))))) + (cj/log-silently "DEBUG: Executing: %s" (string-join argv " ")) + + (let ((process (apply #'start-process player-name buffer-name argv))) + (set-process-sentinel process (cj/media--play-sentinel url-display)))))) ;; ------------------------- Media-Download Via yt-dlp ------------------------- +(defun cj/media--yt-dl-message (event url-display) + "Return the message for tsp EVENT on URL-DISPLAY, or nil when it reports nothing. + +Reports queueing, not completion, and the distinction is the point. +`cj/yt-dl-it' launches \"tsp yt-dlp ...\", and tsp enqueues the job and +exits immediately, so this sentinel fires on tsp's exit rather than +yt-dlp's. A clean exit proves the job was accepted by the spooler and +nothing more, so claiming the download finished would be a guess that is +wrong whenever yt-dlp fails minutes later. Check the spooler with +\"tsp\" for real download status." + (cond + ((string-match-p "finished" event) + (format "✓ Queued for download: %s" url-display)) + ((string-match-p "exited abnormally" event) + (format "✗ Could not queue download: %s" url-display)))) + +(defun cj/media--yt-dl-sentinel (url-display) + "A process sentinel reporting the queueing of URL-DISPLAY. +Messages per `cj/media--yt-dl-message' and reaps the process buffer once +tsp finishes or exits." + (lambda (proc event) + (when-let ((msg (cj/media--yt-dl-message event url-display))) + (message "%s" msg)) + (when (string-match-p "finished\\|exited" event) + (kill-buffer (process-buffer proc))))) + (defun cj/yt-dl-it (url) "Downloads the URL in an async shell." (unless (executable-find "yt-dlp") @@ -194,16 +249,8 @@ stream URL (see the :needs-stream-url flag in `cj/media-players')." (process (start-process "yt-dlp" buffer-name "tsp" "yt-dlp" "--add-metadata" "-ic" "-o" output-template url))) - (message "Started download: %s" url-display) - (set-process-sentinel process - (lambda (proc event) - (cond - ((string-match-p "finished" event) - (message "✓ Finished downloading: %s" url-display)) - ((string-match-p "exited abnormally" event) - (message "✗ Download failed: %s" url-display))) - (when (string-match-p "finished\\|exited" event) - (kill-buffer (process-buffer proc))))))) + (message "Queueing download: %s" url-display) + (set-process-sentinel process (cj/media--yt-dl-sentinel url-display)))) (provide 'media-utils) ;;; media-utils.el ends here. diff --git a/modules/mu4e-org-contacts-integration.el b/modules/mu4e-org-contacts-integration.el index fc0a7325..a143bdc4 100644 --- a/modules/mu4e-org-contacts-integration.el +++ b/modules/mu4e-org-contacts-integration.el @@ -60,13 +60,10 @@ In email header fields (To, Cc, Bcc), complete using org-contacts. Elsewhere, perform the default TAB action." (interactive) (cond - ;; In email header fields, use completion-at-point + ;; In email header fields, use completion-at-point (it both starts a new + ;; completion and cycles an in-progress one, so no mode check is needed). ((mail-abbrev-in-expansion-header-p) - (if (and (boundp 'completion-in-region-mode) completion-in-region-mode) - ;; If we're already in completion mode, cycle through candidates - (completion-at-point) - ;; Start new completion - (completion-at-point))) + (completion-at-point)) ;; In org-msg-edit-mode body, use org-cycle ((and (eq major-mode 'org-msg-edit-mode) (not (mail-abbrev-in-expansion-header-p))) diff --git a/modules/music-config.el b/modules/music-config.el index 3559930b..92b04782 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -31,7 +31,7 @@ (require 'user-constants) (require 'keybindings) ;; provides cj/custom-keymap (require 'cj-window-toggle-lib) ;; side-window size memory (F10 toggle) -(require 'system-lib) ;; cj/confirm-strong (overwrite confirms) +(require 'system-lib) ;; cj/confirm-destructive (overwrite confirms) ;; Declare these foreign package vars special so `let'-binding them below ;; compiles as a dynamic bind, not a dead lexical local -- otherwise emms / @@ -86,7 +86,9 @@ falls back to the plain text player (names, a dim glyph, a thin status line)." :group 'cj/music) (defcustom cj/music-title-family - (if (boundp 'cj/nov-reading-font-family) cj/nov-reading-font-family "Merriweather") + (if (fboundp 'cj/font-profile-properties) + (plist-get (cj/font-profile-properties 'reading) :default-family) + "Merriweather") "Serif family for the fancy now-playing title, mirroring the nov reading view." :type 'string :group 'cj/music) @@ -306,7 +308,9 @@ Directories are suffixed with /; files are plain. Hidden dirs/files skipped." "Completion table for CANDIDATES preserving order and case-insensitive match. Tags the `cj-music-file' category and annotates each candidate (a path relative to `cj/music-root', with a trailing slash for directories) with its size and -modification date so marginalia can show them." +modification date so marginalia can show them. The category is registered +with marginalia (builtin) so the annotations render right-aligned." + (cj/completion-ensure-marginalia-align 'cj-music-file) (let ((annotate (cj/completion-file-annotator (lambda (c) (expand-file-name @@ -322,19 +326,177 @@ modification date so marginalia can show them." (completion-ignore-case . t)) (complete-with-action action candidates string pred))))) +(defun cj/music--playlist-open-position (buffer) + "Return where point should land when the playlist BUFFER is displayed. +The beginning of the playing track's line when a song is playing (during +playback the selected track is the playing one), else the top of the +list. Keying off the selected track alone is wrong: EMMS keeps a stale +selection while stopped, which used to open the playlist deep in the list +at whatever played last." + (with-current-buffer buffer + (if (and (boundp 'emms-player-playing-p) emms-player-playing-p + (boundp 'emms-playlist-selected-marker) + (markerp emms-playlist-selected-marker) + (marker-position emms-playlist-selected-marker) + (eq (marker-buffer emms-playlist-selected-marker) (current-buffer))) + (save-excursion + (goto-char emms-playlist-selected-marker) + (line-beginning-position)) + (point-min)))) + +(defun cj/music--playlist-land-point (win buffer) + "Move WIN's point in BUFFER per the open-position rule and settle the view. +When a song is playing its row lands in the window's upper third, so the +upcoming tracks fill the space below it. When stopped, the view starts at +the top of the list. Point sits at the beginning of its line either way, +so the row reads left-to-right from its number." + (let ((pos (cj/music--playlist-open-position buffer))) + (set-window-point win pos) + (if (> pos (with-current-buffer buffer (point-min))) + (with-selected-window win + (with-current-buffer buffer + (recenter (max 1 (/ (window-body-height) 3))))) + (set-window-start win pos)))) + +(defun cj/music--pin-point-to-bol () + "Keep the playlist cursor in the number gutter (column 0). +The rows are rendered track lines, not editable text: the cursor's home is +the number, and operations on a track (kill, shift, play) act on its row +wherever point sits. Vertical motion over thumbnails and the stretch-space +that right-aligns the metadata drifts point to arbitrary visual columns +(usually line end), so this runs on the buffer-local `post-command-hook' +and snaps every landing back to the row start. An active isearch owns +point until it ends; the snap lands when the search exits." + (unless (or (bolp) (bound-and-true-p isearch-mode)) + (beginning-of-line)) + (cj/music--highlight-current-number)) + +(defvar-local cj/music--renumber-timer nil + "Pending idle timer for the playlist row renumber, or nil.") + +;; Forward declaration: the real `defvar-local' is a few defuns below, next to +;; the highlight helper that owns it. Declared special here so the setq in this +;; function compiles as a dynamic binding, not a free-variable warning. +(defvar cj/music--current-number-overlay) + +(defun cj/music--renumber-rows (&optional buffer) + "Number every playlist row in BUFFER (default: current buffer) via overlays. +Each non-blank line gets an \"NNN \" before-string so the cursor stays +visible when it sits on a cover-art thumbnail and the row's position in +the list is readable at a glance. Overlays rebuild from scratch, so the +numbering survives kills, inserts, and reorders; the buffer text itself is +untouched (EMMS owns it). A dead BUFFER is a silent no-op, since the +debounce timer can outlive the playlist buffer." + (let ((buf (or buffer (current-buffer)))) + (when (buffer-live-p buf) + (with-current-buffer buf + (remove-overlays (point-min) (point-max) 'cj-music-row-number t) + (save-excursion + (goto-char (point-min)) + (let ((n 0)) + (while (not (eobp)) + (unless (looking-at-p "[ \t]*$") + (setq n (1+ n)) + ;; Span one char rather than zero: `overlays-in' (and so + ;; `remove-overlays') can miss an empty overlay sitting + ;; exactly at the region start. + (let ((ov (make-overlay (line-beginning-position) + (1+ (line-beginning-position))))) + (overlay-put ov 'cj-music-row-number t) + ;; Outrank the header overlay (priority 100): both anchor + ;; strings at position 1 on row 1, and without this the + ;; row's number renders above the header block instead of + ;; beside its own track. + (overlay-put ov 'priority 200) + (overlay-put ov 'before-string + (cj/music--number-string (format "%3d " n) nil)))) + (forward-line 1)))) + ;; The rebuild deleted the marked overlay; re-mark the current row. + (setq cj/music--current-number-overlay nil) + (cj/music--highlight-current-number))))) + +(defvar-local cj/music--current-number-overlay nil + "The number overlay currently rendered as the you-are-here mark, or nil.") + +(defun cj/music--number-string (text current) + "Build the number-gutter display string from TEXT. +CURRENT non-nil renders it inverse video (the you-are-here mark). The +single place the gutter string's properties live: the face, and the +cursor property that makes redisplay draw the cursor on the number +instead of invisibly on the album art after it." + (propertize text + 'face (if current + '(:inherit cj/music-keyhint-face :inverse-video t) + 'cj/music-keyhint-face) + 'cursor t)) + +(defun cj/music--set-number-face (ov current) + "Re-render number overlay OV's string; CURRENT non-nil marks it inverse. +Keeps the text, swaps only the rendering (see `cj/music--number-string')." + (let ((s (overlay-get ov 'before-string))) + (overlay-put ov 'before-string + (cj/music--number-string (substring-no-properties s) current)))) + +(defun cj/music--highlight-current-number () + "Render the current row's number in inverse video, restoring the last one. +The block cursor draws only in the selected window, and the playlist dock +is glanced at from other windows constantly, so the number itself carries +the you-are-here mark -- visible whether or not the window has focus." + (let ((ov (seq-find (lambda (o) (overlay-get o 'cj-music-row-number)) + (overlays-in (line-beginning-position) + (min (1+ (line-beginning-position)) (point-max)))))) + (unless (eq ov cj/music--current-number-overlay) + (when (and (overlayp cj/music--current-number-overlay) + (overlay-buffer cj/music--current-number-overlay)) + (cj/music--set-number-face cj/music--current-number-overlay nil)) + (setq cj/music--current-number-overlay ov) + (when ov + (cj/music--set-number-face ov t))))) + +(defun cj/music--schedule-renumber (&rest _) + "Debounced renumber of the current playlist buffer after a text change. +Wired buffer-locally into `after-change-functions' by +`cj/music--ensure-playlist-buffer'; the idle delay coalesces a burst of +inserts or kills into one renumber pass." + (when (timerp cj/music--renumber-timer) + (cancel-timer cj/music--renumber-timer)) + (setq cj/music--renumber-timer + (run-with-idle-timer 0.2 nil #'cj/music--renumber-rows (current-buffer)))) + (defun cj/music--ensure-playlist-buffer () "Ensure EMMS playlist buffer exists and is in playlist mode. Return buffer." (let ((buffer (get-buffer-create cj/music-playlist-buffer-name))) (with-current-buffer buffer (unless (eq major-mode 'emms-playlist-mode) (emms-playlist-mode)) - (setq emms-playlist-buffer-p t)) + (setq emms-playlist-buffer-p t) + ;; Row numbering: renumber after every playlist change, debounced. + (add-hook 'after-change-functions #'cj/music--schedule-renumber nil t) + ;; The highlighted row stays findable even when the cursor sits on + ;; album art (pairs with the row-number prefixes). + (hl-line-mode 1) + ;; Gutter cursor: point lives at the row start (the number column). + (add-hook 'post-command-hook #'cj/music--pin-point-to-bol nil t) + ;; Logical-line motion: the multi-line header overlay string at + ;; position 1 otherwise absorbs next-line from the top row (vertical + ;; motion walks the header's screen lines, which all map back to the + ;; same buffer position, so arrows look dead). Rows are one logical + ;; line each; visual movement buys nothing here. + (setq-local line-move-visual nil) + ;; Sticky header: re-anchor the header block at the window start on + ;; every scroll, so it stays frozen while the list scrolls under it. + (add-hook 'window-scroll-functions #'cj/music--stick-header nil t)) + (cj/music--renumber-rows buffer) ;; Set this as the current EMMS playlist buffer (setq emms-playlist-buffer buffer) buffer)) (defun cj/music--m3u-file-tracks (m3u-file) - "Return list of absolute track paths from M3U-FILE. Ignore # comment lines." + "Return list of absolute track paths from M3U-FILE. Ignore # comment lines. +Stream URLs pass through untouched; a local path must carry an accepted +music extension (`cj/music--valid-file-p') -- old playlists saved before +directory adds were filtered can carry cover.jpg lines, and loading one +would put the cover right back in the playlist." (when (and m3u-file (file-exists-p m3u-file)) (with-temp-buffer (insert-file-contents m3u-file) @@ -344,11 +506,12 @@ modification date so marginalia can show them." (while (re-search-forward "^[^#].*$" nil t) (let ((line (string-trim (match-string 0)))) (unless (string-empty-p line) - (push (if (or (file-name-absolute-p line) - (string-match-p "\\`\\(https?\\|mms\\)://" line)) - line - (expand-file-name line dir)) - tracks)))) + (let* ((url-p (string-match-p "\\`\\(https?\\|mms\\)://" line)) + (path (cond (url-p line) + ((file-name-absolute-p line) line) + (t (expand-file-name line dir))))) + (when (or url-p (cj/music--valid-file-p path)) + (push path tracks)))))) (nreverse tracks))))) (defun cj/music--playlist-track-objects () @@ -435,17 +598,51 @@ Returns the full path to the selected file, or nil if cancelled." (unless (string= choice "(Cancel)") (cdr (assoc choice m3u-files))))) +(defun cj/music--delete-playlist-file (path) + "Delete the playlist file at PATH. +Signals a `user-error' when PATH is nil or missing. When the playlist +buffer's associated file is PATH, the association is cleared (the in-memory +queue is untouched). Refreshes the radio metadata cache since an .m3u just +left the roots." + (unless (and path (file-exists-p path)) + (user-error "Playlist file does not exist: %s" + (if path (file-name-nondirectory path) "nil"))) + (delete-file path) + (with-current-buffer (cj/music--ensure-playlist-buffer) + (when (equal cj/music-playlist-file path) + (setq cj/music-playlist-file nil))) + (cj/music--refresh-radio-name-map)) + ;;; Commands: add/select +(defun cj/music--music-files-recursive (directory) + "Return sorted absolute paths of the music files under DIRECTORY. +Only files passing `cj/music--valid-file-p' (the accepted extensions in +`cj/music-file-extensions') come back; hidden files and hidden +directories are skipped. This is the filter the directory-add commands +route through -- handing the raw tree to EMMS added every file it found, +so cover art and liner notes ended up as playlist rows." + (sort (seq-filter #'cj/music--valid-file-p + (directory-files-recursively + directory "\\`[^.]" nil + (lambda (dir) + (not (string-prefix-p "." (file-name-nondirectory dir)))))) + #'string-lessp)) + (defun cj/music-add-directory-recursive (directory) - "Add all music files under DIRECTORY recursively to the EMMS playlist." + "Add all music files under DIRECTORY recursively to the EMMS playlist. +Only files with accepted music extensions are added; cover art and other +non-music files in album directories stay out." (interactive (list (read-directory-name "Add directory recursively: " cj/music-root nil t))) (unless (file-directory-p directory) (user-error "Not a directory: %s" directory)) (cj/music--ensure-playlist-buffer) - (emms-add-directory-tree directory) - (message "Added recursively: %s" directory)) + (let ((files (cj/music--music-files-recursive directory))) + (dolist (f files) + (emms-add-file f)) + (message "Added %d music file%s from %s" + (length files) (if (= (length files) 1) "" "s") directory))) (defun cj/music-fuzzy-select-and-add () @@ -597,6 +794,10 @@ ENTRIES. Nil when neither applies (the caller falls back to a timestamp)." (plist-get (cdr (assoc (emms-track-name tr) entries)) :name))))) +;; Forward declaration: the real `defvar' lives with the radio config block far +;; below. Declared special here so this reference compiles clean. +(defvar cj/music-radio-save-dir) + (defun cj/music--save-directory (tracks) "Directory a saved playlist targets. An all-stream queue is a radio playlist and saves into @@ -632,7 +833,7 @@ reloaded playlist keeps its display name and cover art." (when (string-empty-p (string-trim chosen)) (user-error "Playlist name cannot be empty")) (when (and (file-exists-p full) - (not (cj/confirm-strong (format "Overwrite %s? " filename)))) + (not (cj/confirm-destructive (format "Overwrite %s? " filename)))) (user-error "Aborted saving playlist")) (make-directory dir t) (cj/music--write-playlist-file full tracks entries) @@ -664,6 +865,23 @@ reloaded playlist keeps its display name and cover art." (message "Reloaded playlist: %s" name))) +(defun cj/music-delete-playlist () + "Delete an .m3u playlist file after strong confirmation. +Candidates are the playlists `cj/music-playlist-load' offers -- every +directory in `cj/music-m3u-roots' (the local library and MPD's playlist +dir). Deleting the loaded playlist's file keeps the in-memory queue but +clears its file association." + (interactive) + (let ((file (cj/music--select-m3u-file "Delete playlist: "))) + (if (not file) + (message "Playlist deletion cancelled") + (unless (cj/confirm-destructive (format "Delete playlist %s? " + (file-name-nondirectory file))) + (user-error "Aborted deleting playlist")) + (cj/music--delete-playlist-file file) + (message "Deleted playlist: %s" (file-name-nondirectory file))))) + + (defun cj/music-playlist-edit () "Open the playlist's M3U file in other window, prompting to save if modified." (interactive) @@ -775,11 +993,13 @@ Intended for use on `emms-player-finished-hook'." ) -(defvar cj/music-playlist-window-height 0.3 +(defvar cj/music-playlist-window-height 0.5 "Default fraction of frame height for the F10 music playlist side window. -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'.") +Half the frame, so a playlist of real length shows enough rows (a third +still read too short in practice). 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' -- but only when it's at +least this default (see the discard in `cj/music-playlist-toggle').") (defvar cj/--music-playlist-height nil "Last height fraction the playlist was toggled off at. @@ -802,6 +1022,13 @@ resized and toggled off this session, it reopens at that remembered height." (if win (progn (cj/side-window-capture-size win 'bottom 'cj/--music-playlist-height) + ;; Remember enlargements only. Window churn (another side window + ;; opening) squeezes the dock, and remembering the squeeze reopens + ;; it too short on every later toggle. A deliberate shrink is the + ;; rare case; losing it costs one resize. + (when (and (numberp cj/--music-playlist-height) + (< cj/--music-playlist-height cj/music-playlist-window-height)) + (setq cj/--music-playlist-height nil)) (delete-window win) (message "Playlist window closed")) (progn @@ -811,11 +1038,7 @@ resized and toggled off this session, it reopens at that remembered height." 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) - (emms-playlist-current-selected-track)) - (emms-playlist-mode-center-current) - (goto-char (point-min)))) + (cj/music--playlist-land-point win buffer) (let ((count (with-current-buffer buffer (count-lines (point-min) (point-max))))) (message (if (> count 0) @@ -833,7 +1056,9 @@ Initializes EMMS if needed." (when buffer-exists (with-current-buffer cj/music-playlist-buffer-name (setq has-content (> (point-max) (point-min))))) - (switch-to-buffer (cj/music--ensure-playlist-buffer)) + (let ((buffer (cj/music--ensure-playlist-buffer))) + (switch-to-buffer buffer) + (cj/music--playlist-land-point (selected-window) buffer)) (cond ((not emms-was-loaded) (message "EMMS started. Current playlist empty")) ((and buffer-exists has-content) (message "EMMS running. Displaying current playlist")) @@ -848,9 +1073,10 @@ Dirs added recursively." (unless (derived-mode-p 'dired-mode) (user-error "This command must be run in a Dired buffer")) (cj/music--ensure-playlist-buffer) - (let ((files (if (use-region-p) - (dired-get-marked-files) - (list (dired-get-file-for-visit))))) + ;; dired-get-marked-files already honors m-marks, an active region, or the + ;; file at point; gating it behind use-region-p silently dropped all but + ;; the point file whenever files were marked without a region. + (let ((files (dired-get-marked-files))) (when (null files) (user-error "No files selected")) (dolist (file files) @@ -1160,12 +1386,12 @@ The rule uses a resize-safe :align-to span, not a hardcoded character count." (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 "1" "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 v:save S:stop SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" + (propertize "a:add c:clear L:load s:save D:delete 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) @@ -1217,14 +1443,51 @@ the controls." (cj/music--fancy-header) (cj/music--text-header))) +(defun cj/music--header-anchor-position () + "Return the position the header overlay should anchor at right now. +The start of the displaying window when the playlist is shown (so the +header stays at the top of the window while the list scrolls under it), +else the top of the buffer. Searches all frames -- the refresh timer can +run with any frame selected, and missing a window on another frame would +anchor at the buffer top and yank a scrolled header back." + (if-let ((win (get-buffer-window (current-buffer) t))) + (max (point-min) (min (window-start win) (point-max))) + (point-min))) + +(defun cj/music--stick-header (win start) + "Re-anchor the header overlay at START, WIN's new display start. +Runs on the buffer-local `window-scroll-functions', so every scroll pins +the header block to the top of the window and the track list scrolls +beneath it. Converges: an already-anchored header is a no-op, so the +redisplay this move triggers doesn't loop. Always returns nil." + (with-current-buffer (window-buffer win) + (when (and (overlayp cj/music--header-overlay) + (overlay-buffer cj/music--header-overlay) + (integer-or-marker-p start)) + (let ((pos (max (point-min) (min start (point-max))))) + (unless (= (overlay-start cj/music--header-overlay) pos) + (move-overlay cj/music--header-overlay pos pos)))) + nil)) + +(defun cj/music--refresh-header-after-toggle (&rest _) + "Refresh the playlist header after a repeat/random/consume toggle. +Named (not an anonymous lambda) so the :config reload can advice-remove +it before re-adding -- anonymous advice stacks a copy per reload." + (cj/music--update-header)) + (defun cj/music--update-header () - "Insert or update the multi-line header overlay in the playlist buffer." + "Insert or update the multi-line header overlay in the playlist buffer. +Anchors at the displaying window's start (see +`cj/music--header-anchor-position') -- the refresh timer calls this every +second, and re-anchoring at the buffer top would yank the sticky header +away whenever the list is scrolled." (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) (with-current-buffer buf (unless cj/music--header-overlay (setq cj/music--header-overlay (make-overlay (point-min) (point-min))) (overlay-put cj/music--header-overlay 'priority 100)) - (move-overlay cj/music--header-overlay (point-min) (point-min)) + (let ((pos (cj/music--header-anchor-position))) + (move-overlay cj/music--header-overlay pos pos)) (overlay-put cj/music--header-overlay 'before-string (cj/music--header-text))))) @@ -1344,19 +1607,22 @@ unless fancy." (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 + ;; Refresh header immediately when toggling modes. Named advice with a + ;; remove-then-add guard (like the emms-playlist-clear advice above): + ;; an anonymous lambda can't be advice-removed and stacks a copy on every + ;; :config reload, firing the refresh N times per toggle. (dolist (fn '(emms-toggle-repeat-playlist emms-toggle-repeat-track emms-toggle-random-playlist cj/music-toggle-consume)) - (advice-add fn :after (lambda (&rest _) (cj/music--update-header)))) + (advice-remove fn #'cj/music--refresh-header-after-toggle) + (advice-add fn :after #'cj/music--refresh-header-after-toggle)) :bind (:map emms-playlist-mode-map ;; Playback ("p" . emms-playlist-mode-go) ("SPC" . emms-pause) - ("s" . emms-stop) ("n" . cj/music-next) (">" . cj/music-next) ("P" . cj/music-previous) @@ -1379,9 +1645,9 @@ unless fancy." ("c" . cj/music-playlist-clear) ("C" . cj/music-playlist-clear) ("L" . cj/music-playlist-load) + ("D" . cj/music-delete-playlist) ("E" . cj/music-playlist-edit) ("g" . cj/music-playlist-reload) - ("v" . cj/music-playlist-save) ;; Track reordering ("S-<up>" . emms-playlist-mode-shift-track-up) ("S-<down>" . emms-playlist-mode-shift-track-down) @@ -1434,6 +1700,15 @@ On a connection failure the client falls back to a host from /json/servers.") "User-Agent sent with radio-browser requests. The project asks clients to identify themselves.") +(defvar cj/music-radio-tag-limit 500 + "Maximum number of tags fetched from radio-browser for tag completion. +The /json/tags endpoint is fetched ordered by station count, so the limit +keeps the popular tags and drops the long tail of one-station noise tags.") + +(defvar cj/music-radio--tags-cache nil + "Session cache of radio-browser tag names, or nil before the first fetch. +A failed fetch leaves it nil so the next tag search retries.") + (defvar cj/music-radio-search-limit 30 "Maximum number of stations a radio-browser search returns.") @@ -1504,14 +1779,16 @@ TAGS is a comma-separated string or nil; nil or empty yields the empty string." (defun cj/music-radio--format-candidate (st) "Marginalia annotation for station ST. -Variant B: codec, bitrate, country, votes, and the first few tags." +Variant B: codec, bitrate, country, votes, and the first few tags. Every +field pads to a fixed width (votes included) so the listing reads as +aligned columns across stations." (let ((codec (or (plist-get st :codec) "")) (bitrate (let ((b (plist-get st :bitrate))) (if (and (integerp b) (> b 0)) (format "%dk" b) ""))) (cc (or (plist-get st :countrycode) "")) (votes (or (plist-get st :votes) 0)) (tags (cj/music-radio--tags-snippet (plist-get st :tags) 3))) - (format "%-4s %-5s %-2s ♥%d %s" codec bitrate cc votes tags))) + (format "%-4s %-5s %-2s %-7s %s" codec bitrate cc (format "♥%d" votes) tags))) (defun cj/music-radio--search-url (server query &optional field) "Build the radio-browser station-search URL for QUERY against SERVER. @@ -1571,23 +1848,21 @@ to one station. Pure helper." (push (cons disp st) out))))) (defun cj/music-radio--completion-table (candidates) - "Completion table over CANDIDATES carrying the Variant-B marginalia affix." + "Completion table over CANDIDATES carrying the Variant-B annotation. +Tagged `cj-radio-station' and registered with marginalia (builtin), so the +codec/bitrate/country/votes/tags annotation renders right-aligned like the +stock categories. The \"[done]\" sentinel has no station and annotates as +nil rather than a bogus zero row." + (cj/completion-ensure-marginalia-align 'cj-radio-station) (lambda (string pred action) (if (eq action 'metadata) `(metadata (category . cj-radio-station) - (affixation-function - . ,(lambda (cands) - (mapcar (lambda (c) - (let ((st (cdr (assoc c candidates)))) - ;; The "[done]" sentinel has no station, so it gets - ;; no annotation rather than a bogus "0" row. - (list c "" (if st - (concat " " - (propertize (cj/music-radio--format-candidate st) - 'face 'completions-annotations)) - "")))) - cands)))) + (annotation-function + . ,(lambda (c) + (when-let ((st (cdr (assoc c candidates)))) + (concat " " (propertize (cj/music-radio--format-candidate st) + 'face 'completions-annotations)))))) (complete-with-action action (mapcar #'car candidates) string pred)))) (defun cj/music-radio--pick-loop (candidates) @@ -1617,8 +1892,10 @@ 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)) +pre-fills the prompt. QUERY is trimmed of surrounding whitespace first -- +a stray trailing space otherwise reaches the API as %20 and matches nothing." + (setq query (string-trim query)) + (when (string-empty-p query) (user-error "Empty search")) (cj/emms--setup) (let* ((stations (cj/music-radio--search query field)) @@ -1650,9 +1927,44 @@ pre-fills the prompt." (interactive "sRadio search (name): ") (cj/music-radio--search-and-play query "name")) +(defun cj/music-radio--tags-url (server) + "Build the radio-browser tag-list URL against SERVER. +Ordered by station count descending so the limit keeps the popular tags." + (format "https://%s/json/tags?order=stationcount&reverse=true&limit=%d" + server cj/music-radio-tag-limit)) + +(defun cj/music-radio--parse-tags (json-text) + "Parse a radio-browser JSON-TEXT tag array into a clean list of tag names. +Names come back whitespace-trimmed with empties and duplicates dropped -- +the source data is user-generated and carries all three. Signals +`user-error' on unreadable JSON (via `cj/music-radio--parse-search')." + (let ((names '())) + (dolist (tag (cj/music-radio--parse-search json-text)) + (let ((name (string-trim (or (plist-get tag :name) "")))) + (unless (or (string-empty-p name) (member name names)) + (push name names)))) + (nreverse names))) + +(defun cj/music-radio--available-tags () + "Return cached radio-browser tag names, fetching once per session. +Returns nil when the fetch or parse fails, leaving the cache empty so a +later call retries; the tag prompt then falls back to free-form input." + (or cj/music-radio--tags-cache + (setq cj/music-radio--tags-cache + (ignore-errors + (when-let ((body (cj/music-radio--http-get + (cj/music-radio--tags-url cj/music-radio-server)))) + (cj/music-radio--parse-tags body)))))) + (defun cj/music-radio-search-by-tag (tag) - "Search radio-browser.info by tag/genre, then queue and play a selection." - (interactive "sRadio search (tag): ") + "Search radio-browser.info by tag/genre, then queue and play a selection. +The prompt completes over the popular tags fetched from radio-browser +\(cached per session), so you pick from tags that exist instead of +guessing. Free-form input still works for an unlisted tag, and the prompt +degrades to plain input when the tag fetch fails." + (interactive + (list (completing-read "Radio search (tag): " + (cj/music-radio--available-tags)))) (cj/music-radio--search-and-play tag "tag")) ;; ------------------------------- Cover art ----------------------------------- @@ -1789,14 +2101,15 @@ when there is nothing to fetch." (message "Cleared music art cache: %s" cj/music-art-cache-dir)) ;; Radio row in the playlist buffer: n = search by name, t = search by tag, -;; m = enter a station by hand. This moves the "single" mode toggle off t to s -;; and emms-stop off s to S (see the header's Mode/Keys/Radio rows). +;; m = enter a station by hand. Single-track mode is on 1 and s saves the +;; playlist; stop was dropped (SPC/pause covers it). These run after +;; use-package's :map, so they win (see the header's Mode/Keys/Radio rows). (with-eval-after-load 'emms (keymap-set emms-playlist-mode-map "n" #'cj/music-radio-search-by-name) (keymap-set emms-playlist-mode-map "t" #'cj/music-radio-search-by-tag) (keymap-set emms-playlist-mode-map "m" #'cj/music-create-radio-station) - (keymap-set emms-playlist-mode-map "s" #'emms-toggle-repeat-track) - (keymap-set emms-playlist-mode-map "S" #'emms-stop)) + (keymap-set emms-playlist-mode-map "1" #'emms-toggle-repeat-track) + (keymap-set emms-playlist-mode-map "s" #'cj/music-playlist-save)) (provide 'music-config) ;;; music-config.el ends here diff --git a/modules/nov-reading.el b/modules/nov-reading.el index 636a2f53..3af8721c 100644 --- a/modules/nov-reading.el +++ b/modules/nov-reading.el @@ -10,7 +10,7 @@ ;; keymap reference; the faces must exist for theme-studio's inventory too. ;; Top-level side effects: defface x9 (3 palettes + per-palette heading/link), ;; defcustoms, a defgroup, a defvar. -;; Runtime requires: none (face-remap and text-scale are built in). +;; Runtime requires: font-profiles (shared workflow profile data). ;; Direct test load: yes. ;; ;; A small theme layer on top of the stock `nov' package (no fork): how an EPUB @@ -20,8 +20,9 @@ ;; - Reading palette -- the background + foreground, as sepia / dark / light, ;; each a face the dupre theme / theme-studio own (registered as the ;; "nov-reading" bespoke app in theme-studio's face_data.py). -;; - Typography -- a serif family and a base height, with +/-/= adjusting the -;; page font size live via a buffer-local text-scale on top of the base. +;; - Typography -- the shared Reading font profile and a nov-specific base +;; height, with +/-/= adjusting the page font size live via a buffer-local +;; text-scale on top of the base. ;; The live size is remembered globally, so every book opens where you left ;; it; "=" returns to the base height. ;; @@ -31,6 +32,8 @@ ;;; Code: +(require 'font-profiles) + (defgroup cj/nov-reading nil "Reading-view theming for nov-mode EPUBs." :group 'cj) @@ -194,9 +197,9 @@ Interactively prompts among `cj/nov-reading-palettes' plus \"none\"." ;; ------------------------------- Typography ---------------------------------- -(defcustom cj/nov-reading-font-family "Merriweather" - "Variable-pitch serif family for the EPUB reading view." - :type 'string +(defcustom cj/nov-reading-profile 'reading + "Shared font profile applied buffer-locally to the EPUB reading view." + :type 'symbol :group 'cj/nov-reading) (defcustom cj/nov-reading-text-height 180 @@ -214,6 +217,9 @@ returns to this base." A single integer: the buffer-local `text-scale-mode-amount' the +/-/= keys last set, applied on top of `cj/nov-reading-text-height' when a book opens.") +(defvar-local cj/nov--typography-remap-cookies nil + "Face-remap cookies for the shared font profile in this nov buffer.") + (defun cj/nov-reading--parse-text-scale (s) "Parse S (a string or nil) as an integer text-scale offset; 0 when invalid. Surrounding whitespace is tolerated; non-integer content yields 0." @@ -239,15 +245,11 @@ Creates the data directory when absent." (insert (number-to-string amount)))) (defun cj/nov-reading-apply-typography () - "Apply the reading family and base height buffer-local. -Remaps `variable-pitch', `default', and `fixed-pitch' so nov's shr output reads -as a comfortably-sized serif page." - (face-remap-add-relative 'variable-pitch - :family cj/nov-reading-font-family :height 1.0) - (face-remap-add-relative 'default - :family cj/nov-reading-font-family - :height cj/nov-reading-text-height) - (face-remap-add-relative 'fixed-pitch :height cj/nov-reading-text-height)) + "Apply the shared reading profile at nov's base height buffer-locally." + (mapc #'face-remap-remove-relative cj/nov--typography-remap-cookies) + (setq cj/nov--typography-remap-cookies + (cj/font-profile-remap-buffer + cj/nov-reading-profile cj/nov-reading-text-height))) (defun cj/nov-reading-text-bigger () "Increase the page font size and remember it across books and sessions." diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index 632184e5..20714d5d 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -20,21 +20,25 @@ ;; keep normal agenda opens fast. ;;; Code: +(require 'seq) (require 'user-constants) (require 'system-lib) (require 'cj-cache-lib) -(defcustom cj/org-agenda-window-height 0.75 - "Fraction of the selected frame used for the org agenda window." - :type 'number - :group 'org-agenda) - (defun cj/--org-agenda-display-rule () - "Return the display-buffer rule for the org agenda buffer." - `("\\*Org Agenda\\*" - (display-buffer-reuse-mode-window display-buffer-below-selected) - (dedicated . t) - (window-height . ,cj/org-agenda-window-height))) + "Return the display-buffer rule for the org agenda buffer. +`display-buffer-full-frame' gives the agenda the whole frame rather than a +fraction of it, so the view is a surface you read rather than a strip you +squint at. `org-agenda-restore-windows-after-quit' (set below) is what +makes that non-destructive: quitting the agenda puts the previous window +layout back. + +The window is deliberately not `dedicated': with the agenda owning the only +window, a dedicated one leaves `org-agenda-switch-to' (RET on an item) with +nowhere to put the file, and it splits or opens a frame instead of simply +replacing the agenda." + '("\\*Org Agenda\\*" + (display-buffer-reuse-mode-window display-buffer-full-frame))) ;; Load debug functions if enabled (when (or (eq cj/debug-modules t) @@ -65,7 +69,12 @@ ;; that reaches `org-agenda-files' another way. (setq org-agenda-skip-unavailable-files t) - ;; display the agenda from the bottom + ;; The agenda takes the whole frame, so quitting it has to give the previous + ;; window layout back -- otherwise every F8 costs the arrangement of windows + ;; that were up when it was pressed. + (setq org-agenda-restore-windows-after-quit t) + + ;; display the agenda across the whole frame (add-to-list 'display-buffer-alist (cj/--org-agenda-display-rule)) @@ -75,6 +84,89 @@ (local-set-key (kbd "s-<left>") #'org-agenda-todo-previousset)))) +;; ---------------------------- Agenda Auto-Refresh ---------------------------- +;; A full-frame agenda is meant to be left up and glanced at, so it has to stay +;; current on its own: the now-line moves, and calendar-sync writes new events +;; into the agenda files behind it. One repeating timer rebuilds whichever +;; agenda is actually on screen. + +(defcustom cj/org-agenda-refresh-seconds 300 + "Cadence, in seconds, of the org-agenda auto-refresh. +The timer fires on wall-clock multiples of this value, so the default 300 +refreshes on the :00/:05/:10 marks rather than five minutes after whenever +the agenda happened to open." + :type 'integer + :group 'org-agenda) + +(defvar cj/--org-agenda-refresh-timer nil + "The repeating auto-refresh timer, or nil when auto-refresh is stopped.") + +(declare-function org-agenda-redo "org-agenda" (&optional all)) + +(defun cj/--org-agenda-seconds-to-next-mark (time period) + "Return seconds from TIME to the next wall-clock multiple of PERIOD. +TIME is any Emacs time value; PERIOD is a positive number of seconds, so +300 gives the :00/:05 marks. A TIME landing exactly on a mark returns a +full PERIOD rather than zero, so the timer never fires twice back to back." + (unless (and (numberp period) (> period 0)) + (error "Refresh period must be a positive number of seconds: %S" period)) + (let ((remainder (mod (floor (float-time time)) period))) + (if (zerop remainder) period (- period remainder)))) + +(defun cj/--org-agenda-refresh-window () + "Return a live window displaying an org-agenda buffer, or nil. +Only a visible agenda is worth rebuilding: an off-screen one costs the same +full rescan and shows it to nobody, and it will be rebuilt on the next tick +after it comes back into view." + (seq-find (lambda (window) + (with-current-buffer (window-buffer window) + (derived-mode-p 'org-agenda-mode))) + (window-list-1 nil 'nomini 'visible))) + +(defun cj/--org-agenda-auto-refresh () + "Rebuild the on-screen agenda, leaving point on the line it was on. +Does nothing when no agenda is displayed. + +The body is wrapped in `condition-case' deliberately. This runs from a +repeating timer, where an unguarded signal resignals on every tick and +buries Emacs in identical backtraces -- the failure mode that made +calendar-sync's hourly timer unusable. A failed rebuild is logged and the +timer keeps its cadence." + (condition-case err + (when-let* ((window (cj/--org-agenda-refresh-window))) + (with-selected-window window + (let ((line (line-number-at-pos))) + (org-agenda-redo) + (goto-char (point-min)) + (forward-line (1- line))))) + (error + (cj/log-silently + (format "org-agenda auto-refresh failed: %s" (error-message-string err)))))) + +(defun cj/org-agenda-auto-refresh-start () + "Start the wall-clock-aligned agenda auto-refresh timer. +Cancels any existing timer first, so re-loading this module into a running +daemon replaces the ticker rather than stacking a second one." + (interactive) + (cj/org-agenda-auto-refresh-stop) + (setq cj/--org-agenda-refresh-timer + (run-at-time (cj/--org-agenda-seconds-to-next-mark + (current-time) cj/org-agenda-refresh-seconds) + cj/org-agenda-refresh-seconds + #'cj/--org-agenda-auto-refresh))) + +(defun cj/org-agenda-auto-refresh-stop () + "Cancel the agenda auto-refresh timer. A no-op when already stopped." + (interactive) + (when (timerp cj/--org-agenda-refresh-timer) + (cancel-timer cj/--org-agenda-refresh-timer)) + (setq cj/--org-agenda-refresh-timer nil)) + +;; Arm at load. Skipped under `noninteractive' so a batch test run doesn't +;; carry a live repeating timer it has nothing to refresh. +(unless noninteractive + (cj/org-agenda-auto-refresh-start)) + ;; ----------------------- Project-name Category Override --------------------- ;; The default `org-category' for a todo.org buffer is "todo" (the filename ;; without extension), which renders as "todo:" in every agenda `%c' column @@ -107,24 +199,41 @@ nil so the org default category applies." (defun cj/--org-set-todo-category () "Set buffer-local `org-category' to the project name for a todo.org buffer. -Runs from `org-mode-hook'. Only overrides when `org-category' is still -the default-from-filename (\"todo\"), so an explicit `#+CATEGORY:' in -the file keeps precedence." +Runs from `org-mode-hook'. Only overrides when nothing has set +`org-category', so an explicit `#+CATEGORY:' in the file keeps precedence. + +The nil test is the whole guard, and it took a while to get right. Org does +not assign the filename fallback to `org-category': with no `#+CATEGORY:' the +variable stays nil and `org-get-category' derives \"todo\" at read time. An +earlier version guarded on `(string= \"todo\" org-category)', which is a state +org never produces, so this hook did nothing from the day it shipped." (when (and buffer-file-name (boundp 'org-category) - (stringp org-category) - (string= "todo" org-category)) + (null org-category)) (when-let* ((project (cj/--org-todo-category-from-file buffer-file-name))) (setq-local org-category project)))) -(add-hook 'org-mode-hook #'cj/--org-set-todo-category) +;; Depth -100 so this runs FIRST, and it is load-bearing. `org-get-category' +;; resolves a deferred `:CATEGORY' that the org-element cache then holds, so any +;; hook that reads the category before this one freezes "todo" in that cache and +;; leaves the `setq-local' below inert -- `org-category' reads correct while the +;; agenda still shows "todo". `add-hook' prepends by default, so without the +;; depth every hook added later would run earlier, and three already do. +(add-hook 'org-mode-hook #'cj/--org-set-todo-category -100) ;; ------------------------ Org Agenda File List Cache ------------------------- ;; Cache agenda file list to avoid expensive directory scanning on every view. ;; The TTL+building cache lifecycle is provided by `cj-cache.el'. -(defvar cj/--org-agenda-files-cache (cj/cache-make :ttl 3600) - "Cache state for the agenda files list. See `cj-cache.el'.") +(defvar cj/--org-agenda-files-cache (cj/cache-make :ttl 86400) + "Cache state for the agenda files list. See `cj-cache.el'. + +TTL is 24h. The cache holds only the file *list* (which files are agenda +files), never their contents -- task edits and completions are re-read on +every agenda build/redo regardless of cache age. The list only changes when +a project directory with a todo.org is created or removed, which is rare, so a +long TTL costs little; use `cj/org-agenda-refresh-files' (S-<f8>) to force a +re-scan the moment a new project is added.") ;; ------------------------ Add Files To Org Agenda List ----------------------- ;; Checks immediate subdirectories of DIRECTORY for todo.org files and adds @@ -216,9 +325,13 @@ improves performance from several seconds to instant." "Force rebuild of agenda files cache. Use this after adding new projects or todo.org files. -Bypasses cache and scans directories from scratch." +Bypasses cache and scans directories from scratch. + +Bound to S-<f8>, the force-rebuild sibling of the F8 agenda family +\(<f8> display, s-<f8> all files, C-<f8> single project, M-<f8> this buffer)." (interactive) (cj/build-org-agenda-list 'force-rebuild)) +(global-set-key (kbd "S-<f8>") #'cj/org-agenda-refresh-files) (defun cj/todo-list-all-agenda-files () "Displays an \\='org-agenda\\=' todo list. diff --git a/modules/org-config.el b/modules/org-config.el index a9fc4811..55fdf1d0 100644 --- a/modules/org-config.el +++ b/modules/org-config.el @@ -16,6 +16,7 @@ ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap (used in :init below) +(require 'user-constants) ;; provides cj/org-todo-keywords (used in :config) ;; Declare org variables and functions used before org is loaded so this module ;; byte-compiles standalone. Plain `defvar' (no value) marks the symbol special @@ -284,10 +285,9 @@ a no-op identical-state transition (see `cj/org--noop-state-log-p')." "All org-todo related settings are grouped and set in this function." ;; logging task creation, task start, and task resolved states - (setq org-todo-keywords '((sequence "TODO(t)" "PROJECT(p)" "DOING(i)" - "WAITING(w)" "VERIFY(v)" "STALLED(s)" - "DELEGATED(x)" "|" - "FAILED(f!)" "DONE(d!)" "CANCELLED(c!)"))) + ;; Defined in user-constants so a batch Emacs can load the sequence without + ;; this module's package dependencies. See `cj/org-todo-keywords'. + (setq org-todo-keywords cj/org-todo-keywords) ;; Keyword and priority faces are defined and wired in org-faces-config.el ;; (loaded just after this module): each keyword and priority maps to its own diff --git a/modules/org-refile-config.el b/modules/org-refile-config.el index 5f826cac..d94e4965 100644 --- a/modules/org-refile-config.el +++ b/modules/org-refile-config.el @@ -185,6 +185,25 @@ ARG DEFAULT-BUFFER RFLOC and MSG parameters passed to org-refile." ;; --------------------------------- Org Refile -------------------------------- +(declare-function org-save-all-org-buffers "org") + +(defun cj/org-refile--save-all-buffers (&rest _) + "Save every open Org buffer. Installed as `:after' advice on `org-refile'. +Named (not an anonymous lambda) so the :config reload can `advice-remove' +it by reference and a test can assert its installation." + (org-save-all-org-buffers)) + +(defun cj/org-refile--ensure-targets-in-org-mode (&rest _) + "Put every string-named refile target buffer into `org-mode' first. +Installed as `:before' advice on `org-refile-get-targets'. Fixes targets +opened before Org loaded getting stuck in `fundamental-mode'. A non-string +target car (a function or symbol spec) is skipped. Named for the same +remove-by-reference and testability reasons as the save helper above." + (dolist (target org-refile-targets) + (let ((file (car target))) + (when (stringp file) + (cj/org-refile-ensure-org-mode file))))) + (use-package org-refile :ensure nil ;; built-in :defer .5 @@ -193,20 +212,14 @@ ARG DEFAULT-BUFFER RFLOC and MSG parameters passed to org-refile." ("C-c C-w" . cj/org-refile) ("C-c w" . cj/org-refile-in-file)) :config - ;; save all open org buffers after a refile is complete - (advice-add 'org-refile :after - (lambda (&rest _) - (org-save-all-org-buffers))) - - ;; Ensure refile target buffers are in org-mode before processing - ;; Fixes issue where buffers opened before org loaded get stuck in fundamental-mode - (advice-add 'org-refile-get-targets :before - (lambda (&rest _) - "Ensure all refile target buffers are in org-mode." - (dolist (target org-refile-targets) - (let ((file (car target))) - (when (stringp file) - (cj/org-refile-ensure-org-mode file))))))) + ;; Install both advices by named-function reference with a remove-then-add + ;; guard. Anonymous lambdas here couldn't be `advice-remove'd (deleting the + ;; advice from source left a live daemon still running it) and couldn't be + ;; tested; the named helpers above are both. + (advice-remove 'org-refile #'cj/org-refile--save-all-buffers) + (advice-add 'org-refile :after #'cj/org-refile--save-all-buffers) + (advice-remove 'org-refile-get-targets #'cj/org-refile--ensure-targets-in-org-mode) + (advice-add 'org-refile-get-targets :before #'cj/org-refile--ensure-targets-in-org-mode)) (provide 'org-refile-config) ;;; org-refile-config.el ends here. diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index 867f2d99..e8d003e0 100644 --- a/modules/org-roam-config.el +++ b/modules/org-roam-config.el @@ -30,6 +30,10 @@ ;; Declared special so the `let'-binding in `cj/org-roam-copy-todo-to-today' ;; compiles as a dynamic bind, not a dead lexical local -- otherwise the custom ;; capture template never reaches org-roam-dailies (the foreign-special-var trap). +;; Declared special so cj/org-roam-node-insert-immediate's let-binding is +;; dynamic under lexical-binding; without it the byte-compiled let is a dead +;; lexical binding and :immediate-finish never reaches org-roam-node-insert. +(defvar org-roam-capture-templates) (defvar org-roam-dailies-capture-templates) ;; External variables, declared special so byte-compilation doesn't treat them diff --git a/modules/prog-c.el b/modules/prog-c.el index 728df018..29a341d5 100644 --- a/modules/prog-c.el +++ b/modules/prog-c.el @@ -8,8 +8,9 @@ ;; Load shape: eager. ;; Eager reason: none necessary; currently eager but should load by C major mode ;; (Phase 6 deferral candidate). -;; Top-level side effects: six add-hook, package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). +;; Top-level side effects: six add-hook, package configuration via use-package; +;; warns at load if clangd or clang-format is missing. +;; Runtime requires: system-lib. ;; Direct test load: yes. ;; ;; Modern C programming environment with LSP, tree-sitter, debugging, and formatting. @@ -59,6 +60,14 @@ (defvar clang-format-path "clang-format" "Path to clang-format executable.") +;; Warn at load time when a C tool is missing. The clang-format block +;; below gates on `:if (executable-find ...)', which evaluates once at +;; startup — an absent binary silently disables the format key until the +;; next restart, so this warn is the only visible trace. +(require 'system-lib) ; for cj/executable-find-or-warn +(cj/executable-find-or-warn clangd-path "clangd LSP" 'prog-c) +(cj/executable-find-or-warn clang-format-path "C formatting" 'prog-c) + ;; -------------------------------- C Mode Setup ------------------------------- ;; preferences for C programming following common conventions diff --git a/modules/prog-general.el b/modules/prog-general.el index 89771cbf..77ff88a5 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -39,6 +39,7 @@ ;;; Code: (require 'user-constants) ;; code-dir, projects-dir, snippets-dir +(require 'cl-lib) (defvar display-line-numbers-type) (defvar outline-minor-mode-map) @@ -57,6 +58,7 @@ (declare-function dired-get-filename "dired") (declare-function global-treesit-auto-mode "treesit-auto") (declare-function treesit-auto-add-to-auto-mode-alist "treesit-auto") +(declare-function treesit-auto-install-all "treesit-auto") (declare-function treesit-auto-recipe-lang "treesit-auto") (declare-function highlight-indent-guides-mode "highlight-indent-guides") (declare-function electric-pair-default-inhibit "elec-pair") @@ -120,19 +122,27 @@ REGEXP must be a string or an rx form." ;; build mid-edit. Batch/test runs never load treesit-auto (no package ;; init), so they can never install. Fresh-machine bootstrap is the ;; explicit `cj/install-treesit-grammars' command below. +(defun cj/treesit-auto-pin-go-revision (recipes) + "Pin the Go grammar revision in treesit-auto RECIPES. +Return the updated Go recipe, or nil when RECIPES has no Go entry. +Discover the `revision' slot at runtime because treesit-auto is not loaded +when this file's `use-package' form is macro-expanded." + (when-let ((go-recipe + (cl-find-if + (lambda (recipe) + (eq (treesit-auto-recipe-lang recipe) 'go)) + recipes))) + (aset go-recipe + (cl-struct-slot-offset 'treesit-auto-recipe 'revision) + "v0.19.1") + go-recipe)) + (use-package treesit-auto :custom (treesit-auto-install 'prompt) :config - (require 'cl-lib) ;; Pin Go grammar to v0.19.1 for compatibility with Emacs 30.2 font-lock queries - (let* ((go-idx (cl-position-if (lambda (recipe) - (eq (treesit-auto-recipe-lang recipe) 'go)) - treesit-auto-recipe-list)) - (go-recipe (and go-idx (nth go-idx treesit-auto-recipe-list)))) - (when go-recipe - ;; Directly modify the slot value using aset (struct fields are vectors internally) - (aset go-recipe 6 "v0.19.1"))) ; slot 6 is :revision + (cj/treesit-auto-pin-go-revision treesit-auto-recipe-list) (treesit-auto-add-to-auto-mode-alist 'all) (global-treesit-auto-mode)) diff --git a/modules/prog-go.el b/modules/prog-go.el index 7faf92a0..630b725c 100644 --- a/modules/prog-go.el +++ b/modules/prog-go.el @@ -8,8 +8,9 @@ ;; Load shape: eager. ;; Eager reason: none necessary; currently eager but should load by Go major ;; mode (Phase 6 deferral candidate). -;; Top-level side effects: package configuration via use-package (hooks via :hook). -;; Runtime requires: none (configures packages via use-package). +;; Top-level side effects: package configuration via use-package (hooks via +;; :hook); adds ~/go/bin to exec-path; warns at load if gopls is missing. +;; Runtime requires: system-lib. ;; Direct test load: yes. ;; ;; Configuration for Go programming using go-ts-mode (tree-sitter based). @@ -29,14 +30,25 @@ ;;; Code: +(require 'system-lib) ; for cj/executable-find-or-warn + (defvar go-bin-path (expand-file-name "~/go/bin") "Path to Go binaries directory. This is where tools like goimports and staticcheck are installed.") +;; Register the Go bin directory before the gopls check below: go tools +;; install there, so probing PATH without it would warn about a gopls +;; that is in fact present. +(add-to-list 'exec-path go-bin-path) + (defvar gopls-path "gopls" "Path to gopls (Go language server). Install with: go install golang.org/x/tools/gopls@latest") +;; Warn at load time if gopls is missing rather than waiting for the +;; first Go buffer to silently skip the LSP attach. +(cj/executable-find-or-warn gopls-path "gopls LSP" 'prog-go) + (defvar dlv-path "dlv" "Path to Delve debugger. Install with: go install github.com/go-delve/delve/cmd/dlv@latest") @@ -113,11 +125,14 @@ Overrides default prog-mode keybindings with Go-specific commands." ;; never ran. Autoload gofmt so the first format pulls go-mode and its :config. :commands (gofmt) :hook ((go-ts-mode . cj/go-setup) - (go-ts-mode . cj/go-mode-keybindings)) + (go-ts-mode . cj/go-mode-keybindings) + ;; Classic-mode fallback: same setup when the Go grammar is + ;; unavailable and the buffer lands in go-mode. + (go-mode . cj/go-setup) + (go-mode . cj/go-mode-keybindings)) :mode (("\\.go\\'" . go-ts-mode) ;; .go files use go-ts-mode ("go\\.mod\\'" . go-mod-ts-mode)) ;; go.mod uses go-mod-ts-mode :config - (add-to-list 'exec-path go-bin-path) ;; Use goimports for formatting (adds/removes imports automatically) (setq gofmt-command "goimports")) diff --git a/modules/prog-shell.el b/modules/prog-shell.el index 3ed51da1..7c0972f0 100644 --- a/modules/prog-shell.el +++ b/modules/prog-shell.el @@ -9,8 +9,9 @@ ;; Eager reason: none necessary; currently eager but should load by shell major ;; mode (Phase 6 deferral candidate). ;; Top-level side effects: five add-hook, including an after-save executable hook -;; the spec flags as needing opt-in/scoping; package config via use-package. -;; Runtime requires: none (configures packages via use-package). +;; the spec flags as needing opt-in/scoping; package config via use-package; +;; warns at load for missing shell tools. +;; Runtime requires: system-lib. ;; Direct test load: yes. ;; ;; Modern shell scripting environment with LSP, tree-sitter, linting, and formatting. @@ -65,6 +66,15 @@ Install with: sudo pacman -S shfmt") "Path to shellcheck executable. Install with: sudo pacman -S shellcheck") +;; Warn at load time when a shell tool is missing. The shfmt and +;; flycheck blocks below gate on `:if (executable-find ...)', which +;; evaluates once at startup — an absent tool silently disables that +;; setup until the next restart, so this warn is the only visible trace. +(require 'system-lib) ; for cj/executable-find-or-warn +(cj/executable-find-or-warn bash-language-server-path "bash LSP" 'prog-shell) +(cj/executable-find-or-warn shfmt-path "shell formatting" 'prog-shell) +(cj/executable-find-or-warn shellcheck-path "shell linting" 'prog-shell) + ;; ------------------------------- Shell Script Setup ------------------------------ ;; preferences for shell scripting diff --git a/modules/prog-webdev.el b/modules/prog-webdev.el index b228d0cc..f305c65d 100644 --- a/modules/prog-webdev.el +++ b/modules/prog-webdev.el @@ -18,6 +18,7 @@ ;; ;; Installation: ;; sudo pacman -S typescript-language-server typescript prettier +;; sudo pacman -S vscode-html-languageserver # LSP in web-mode buffers ;; ;; Features: ;; - Tree-sitter: Syntax highlighting for TS, TSX, JS (via treesit-auto) @@ -52,6 +53,10 @@ Install with: sudo pacman -S typescript-language-server") "Path to prettier executable. Install with: sudo pacman -S prettier") +(defvar html-language-server-path "vscode-html-language-server" + "Path to the HTML language server executable used in web-mode buffers. +Install with: sudo pacman -S vscode-html-languageserver") + ;; Warn at load time if prettier is missing rather than waiting for the ;; first format-on-save to fail mid-edit. (cj/executable-find-or-warn prettier-path "prettier formatter" 'prog-webdev) @@ -59,8 +64,8 @@ Install with: sudo pacman -S prettier") ;; ------------------------------ Web Dev Setup -------------------------------- ;; shared setup for TypeScript, JavaScript, and TSX modes -(defun cj/webdev-setup () - "Set up common preferences for web development buffers." +(defun cj/--webdev-prefs () + "Apply the shared buffer-local preferences for web development buffers." (company-mode) (flyspell-prog-mode) (superword-mode) @@ -68,13 +73,27 @@ Install with: sudo pacman -S prettier") (setq-local tab-width 2) (setq-local standard-indent 2) (setq-local indent-tabs-mode nil) - (electric-pair-local-mode t) + (electric-pair-local-mode t)) + +(defun cj/webdev-setup () + "Set up common preferences for TypeScript/JavaScript buffers." + (cj/--webdev-prefs) ;; Enable LSP if available (when (and (fboundp 'lsp-deferred) (executable-find ts-language-server-path)) (lsp-deferred))) +(defun cj/web-mode-setup () + "Set up preferences for web-mode (HTML template) buffers. +Same shared preferences as the TS/JS modes, but the LSP attach is +guarded on the HTML language server rather than the TypeScript one, so +machines without it stay silent instead of prompting." + (cj/--webdev-prefs) + (when (and (fboundp 'lsp-deferred) + (executable-find html-language-server-path)) + (lsp-deferred))) + (defun cj/--webdev-format-args (file) "Return the prettier argv list that formats FILE's contents on stdin. No shell quoting is needed: the args are passed to prettier directly @@ -121,6 +140,11 @@ Detects the file type automatically from the filename." ((js-ts-mode . cj/webdev-setup) (js-ts-mode . cj/webdev-keybindings))) +;; Classic-mode fallback: when the JS grammar is unavailable the buffer +;; lands in js-mode; give it the same setup as the tree-sitter modes. +(add-hook 'js-mode-hook #'cj/webdev-setup) +(add-hook 'js-mode-hook #'cj/webdev-keybindings) + ;; ----------------------------------- LSP ------------------------------------- ;; TypeScript/JavaScript LSP configuration ;; Core LSP setup is in prog-general.el @@ -145,7 +169,8 @@ Detects the file type automatically from the filename." (web-mode-code-indent-offset 2) (web-mode-engines-alist '(("django" . "\\.html\\'"))) :mode ("\\.html?$" . web-mode) - :hook (web-mode . cj/webdev-keybindings)) + :hook ((web-mode . cj/web-mode-setup) + (web-mode . cj/webdev-keybindings))) (provide 'prog-webdev) ;;; prog-webdev.el ends here. diff --git a/modules/restclient-config.el b/modules/restclient-config.el index 0511eddb..497f54d0 100644 --- a/modules/restclient-config.el +++ b/modules/restclient-config.el @@ -8,7 +8,7 @@ ;; Load shape: eager. ;; Eager reason: none; API exploration, a command-loaded deferral candidate. ;; Top-level side effects: package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). +;; Runtime requires: keybindings (C-; R prefix registration). ;; Direct test load: yes. ;; ;; Integrates restclient.el for interactive API exploration from within Emacs. @@ -23,6 +23,8 @@ ;;; Code: +(require 'keybindings) ;; cj/register-prefix-map + ;; --------------------------------- Constants --------------------------------- (defvar cj/restclient-data-dir (expand-file-name "data/" user-emacs-directory) @@ -61,12 +63,15 @@ ;; -------------------------------- Keybindings -------------------------------- -(global-set-key (kbd "C-; R n") #'cj/restclient-new-buffer) -(global-set-key (kbd "C-; R o") #'cj/restclient-open-file) +(defvar-keymap cj/restclient-map + :doc "Keymap for restclient operations" + "n" #'cj/restclient-new-buffer + "o" #'cj/restclient-open-file) + +(cj/register-prefix-map "R" cj/restclient-map "REST client") (with-eval-after-load 'which-key (which-key-add-key-based-replacements - "C-; R" "REST client" "C-; R n" "new scratch buffer" "C-; R o" "open .rest file")) diff --git a/modules/selection-framework.el b/modules/selection-framework.el index 8e3ee252..47fbf7c7 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -225,7 +225,7 @@ ("C-p" . company-select-previous)) :custom (company-backends '(company-capf company-files company-keywords)) - (company-idle-delay 2) + (company-idle-delay 4) (company-minimum-prefix-length 2) (company-show-numbers t) (company-tooltip-align-annotations t) diff --git a/modules/slack-config.el b/modules/slack-config.el index 9eb9f838..e0ad5b75 100644 --- a/modules/slack-config.el +++ b/modules/slack-config.el @@ -197,7 +197,10 @@ so the Slack buffer stays usable." "Add a reaction to the current Slack message using a curated shortlist. Errors if called outside a Slack message buffer." (interactive) - (let ((buf (or slack-current-buffer + ;; boundp guard: the defvar above declares the var with no value, so it is + ;; void until slack.el loads -- a bare read on a cold call would signal + ;; void-variable instead of this friendly error. + (let ((buf (or (and (boundp 'slack-current-buffer) slack-current-buffer) (user-error "Not in a Slack buffer")))) (when-let* ((team (slack-buffer-team buf)) (reaction (cj/slack-select-reaction team))) diff --git a/modules/system-commands.el b/modules/system-commands.el index de5e8853..08a1be5d 100644 --- a/modules/system-commands.el +++ b/modules/system-commands.el @@ -39,7 +39,7 @@ ;; require keeps the module loadable on its own (tests, byte-compile) rather ;; than relying on init.el's load order. (require 'host-environment) -;; `system-lib' provides `cj/confirm-strong', used at runtime by the `strong' +;; `system-lib' provides `cj/confirm-destructive', used at runtime by the `strong' ;; confirm branch of `cj/system-cmd' for irreversible actions (shutdown/reboot). (require 'system-lib) (eval-when-compile (require 'subr-x)) @@ -76,10 +76,11 @@ If CMD is deemed dangerous, ask for confirmation." (label (nth 2 resolved))) (let ((confirm (and sym (get sym 'cj/system-confirm)))) (cond - ;; Strong confirm for irreversible actions (shutdown, reboot): - ;; require an explicit "yes", so a stray RET/space can't trigger them. + ;; Strong confirm for irreversible actions (shutdown, reboot): one + ;; keystroke, but with no default, so a stray RET/space can't trigger + ;; them and type-ahead is discarded before the read. ((eq confirm 'strong) - (unless (cj/confirm-strong (format "Really run %s (%s)? " label cmdstr)) + (unless (cj/confirm-destructive (format "Really run %s (%s)? " label cmdstr)) (user-error "Aborted"))) ;; Quick (Y/n) confirm for recoverable actions (logout, suspend). (confirm @@ -96,9 +97,11 @@ If CMD is deemed dangerous, ask for confirmation." (defmacro cj/defsystem-command (name var cmdstr &optional confirm) "Define VAR with CMDSTR and interactive command NAME to run it. -CONFIRM controls the confirmation prompt: t for a quick (Y/n) prompt, -the symbol `strong' for an explicit yes-or-no-p (used for irreversible -actions like shutdown and reboot), nil for no confirmation." +CONFIRM controls the confirmation prompt: t for a quick (Y/n) prompt where +RET and space mean yes, the symbol `strong' for `cj/confirm-destructive' +\(used for irreversible actions like shutdown and reboot), nil for no +confirmation. Both are one keystroke; the difference is that `strong' has +no default, so RET and space re-prompt rather than confirming." (declare (indent defun)) `(progn (defvar ,var ,cmdstr) @@ -115,8 +118,21 @@ actions like shutdown and reboot), nil for no confirmation." ;; directly: logind emits the Lock signal, hypridle catches it and runs its ;; lock_cmd (hyprlock), the same path idle/before-sleep locking already uses. ;; X11 machines keep slock. -(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd - (if (env-wayland-p) "loginctl lock-session" "slock")) +;; +;; Unlike its siblings, the locker is resolved at COMMAND time, not baked into +;; the defvar at load: a daemon started before WAYLAND_DISPLAY reaches its +;; environment would freeze the locker to slock forever, and Lock would then +;; fail silently on Wayland. `lockscreen-cmd' stays as an override knob. +(defvar lockscreen-cmd nil + "Explicit lock command, overriding session-type resolution when non-nil.") + +(defun cj/system-cmd-lock () + "Lock the session, resolving the locker from the live session type. +Runs `lockscreen-cmd' when set; otherwise `loginctl lock-session' on +Wayland and slock on X11, decided per call via `env-wayland-p'." + (interactive) + (cj/system-cmd (or lockscreen-cmd + (if (env-wayland-p) "loginctl lock-session" "slock")))) (cj/defsystem-command cj/system-cmd-suspend suspend-cmd "systemctl suspend" t) (cj/defsystem-command cj/system-cmd-shutdown shutdown-cmd "systemctl poweroff" strong) (cj/defsystem-command cj/system-cmd-reboot reboot-cmd "systemctl reboot" strong) diff --git a/modules/system-defaults.el b/modules/system-defaults.el index 7f369a5e..d9ec1878 100644 --- a/modules/system-defaults.el +++ b/modules/system-defaults.el @@ -55,6 +55,10 @@ (expand-file-name "comp-warnings.log" user-emacs-directory) "File where native-comp warnings will be appended.") +(defvar cj/comp-warnings-log-max-bytes (* 512 1024) + "Cap on `comp-warnings-log' size. Once it exceeds this, the log is reset +before the next write, so native-comp warnings can't grow it without bound.") + (defun cj/log-comp-warning (type message &rest args) "Log native-comp warnings of TYPE with MESSAGE & ARGS. Log to buffer `comp-warnings-log'. Suppress warnings from appearing in the @@ -62,13 +66,24 @@ Log to buffer `comp-warnings-log'. Suppress warnings from appearing in the timestamp to the file specified by `comp-warnings-log'. Return non-nil to indicate the warning was handled." (when (memq 'comp (if (listp type) type (list type))) - (with-temp-buffer - (insert (format-time-string "[%Y-%m-%d %H:%M:%S] ")) - (insert (if (stringp message) - (apply #'format message args) - (format "%S %S" message args))) - (insert "\n") - (append-to-file (point-min) (point-max) comp-warnings-log)) + ;; Reset the log if it has grown past the cap, so async comp warnings can't + ;; grow it without bound. + (when (ignore-errors + (> (or (file-attribute-size (file-attributes comp-warnings-log)) 0) + cj/comp-warnings-log-max-bytes)) + (ignore-errors (delete-file comp-warnings-log))) + ;; Guard the write: this runs as `:before-until' advice on `display-warning', + ;; so a signal here (an unwritable log path) would propagate out and break + ;; warning display for every async comp notice. Swallow the failure; the + ;; warning stays suppressed either way. + (ignore-errors + (with-temp-buffer + (insert (format-time-string "[%Y-%m-%d %H:%M:%S] ")) + (insert (if (stringp message) + (apply #'format message args) + (format "%S %S" message args))) + (insert "\n") + (append-to-file (point-min) (point-max) comp-warnings-log))) ;; Return non-nil to tell `display-warning' “we handled it.” t)) @@ -212,8 +227,9 @@ appears only once per session." (setq ad-redefinition-action 'accept) ;; silence warnings about advised functions getting redefined. (setq large-file-warning-threshold nil) ;; open files regardless of size (setq use-short-answers t) ;; single-key y/n for ordinary yes-or-no-p prompts - ;; (irreversible actions use `cj/confirm-strong', which - ;; forces a typed "yes" by binding this nil for that call) + ;; (irreversible actions use `cj/confirm-destructive', + ;; also one key, but it ignores RET and space so a stray + ;; keystroke re-prompts instead of confirming) (setq auto-revert-verbose nil) ;; turn off auto revert messages (setq custom-safe-themes t) ;; treat all themes as safe (stop asking) (setq server-client-instructions nil) ;; I already know what to do when done with the frame diff --git a/modules/system-lib.el b/modules/system-lib.el index f1049c02..bde53d82 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -130,16 +130,33 @@ Callers that must have a secret layer their own error on top." (secret (plist-get (car (apply #'auth-source-search spec)) :secret))) (if (functionp secret) (funcall secret) secret))) -;; ---------------------------- Strong Confirmation ---------------------------- +;; -------------------------- Destructive Confirmation ------------------------- -(defun cj/confirm-strong (prompt) - "Ask PROMPT, requiring a full typed \"yes\" or \"no\" answer. -For irreversible actions -- file destruction, overwrites, power-off. The -global default makes `yes-or-no-p' a single keystroke (`use-short-answers' -is t); this binds it to nil for the one call so the prompt demands the -long-form answer, keeping a stray RET or space from confirming." - (let ((use-short-answers nil)) - (yes-or-no-p prompt))) +(defun cj/confirm-destructive (prompt) + "Ask PROMPT for an irreversible action. Return non-nil for yes. + +One keystroke, y or n. Nothing else answers: a stray RET or space +re-prompts rather than confirming, so the accidental-confirm protection +survives without the answer costing four keystrokes. + +Pending input is discarded first, and that line is load-bearing. +`read-char-choice' reads from the input queue, so without it a keystroke +typed before the prompt appeared would confirm a shutdown or a file +deletion instantly. The typed-\"yes\" form this replaced absorbed such a +key harmlessly, and dropping the guard without replacing it would have +traded a rare annoyance for a rare catastrophe. + +This used to demand a typed \"yes\", and that was a worse trade than it +looked. On 2026-07-31 one such prompt went unanswered -- a second agent +session held the selected window while the prompt waited in another frame, +so keystrokes went to a terminal instead of the minibuffer, and the session +was killed with buffers unsaved. A single keystroke does not make a prompt +reachable when focus is elsewhere; C-g is still the escape either way. What +it changes is the cost of the situation, and losing unsaved buffers is a far +bigger hazard than a mis-keyed confirm." + (discard-input) + (eq ?y (downcase (read-char-choice (concat prompt "(y or n) ") + '(?y ?Y ?n ?N))))) (defun cj/--font-lock-global-modes-excluding (current mode) "Return CURRENT `font-lock-global-modes' with MODE added to the exclusion. @@ -164,6 +181,22 @@ contributes its own modes regardless of load order." (setq font-lock-global-modes (cj/--font-lock-global-modes-excluding font-lock-global-modes mode)))) +;; Declared special here for the compiler; marginalia owns the defvar. +(defvar marginalia-annotator-registry) + +(defun cj/completion-ensure-marginalia-align (category) + "Register CATEGORY with marginalia as builtin-annotated, once. +A custom completion category bypasses marginalia entirely, so the table's +own annotation function renders unaligned even with `marginalia-align' +set. A builtin registry entry tells marginalia to use the table's +annotation function inside its aligned field, so custom annotations line +up like every stock category. A category that already has an entry is +left alone (someone chose its annotators deliberately). Silent no-op +when marginalia isn't loaded." + (when (and (boundp 'marginalia-annotator-registry) + (not (assq category marginalia-annotator-registry))) + (push (list category 'builtin 'none) marginalia-annotator-registry))) + (defun cj/completion-table (category collection) "Return a completion table over COLLECTION tagged with completion CATEGORY. COLLECTION is anything `completing-read' accepts (list, alist, obarray, hash @@ -180,7 +213,9 @@ the candidates match one; marginalia then annotates them with no further work." "Like `cj/completion-table' but also attach ANNOTATE as the annotation function. ANNOTATE is called with a candidate string and returns its annotation suffix, or nil. Use this for a custom CATEGORY that marginalia has no built-in annotator -for: marginalia falls back to the table's own annotation function." +for; the category is registered with marginalia (builtin) so ANNOTATE's output +renders right-aligned like stock annotations." + (cj/completion-ensure-marginalia-align category) (lambda (string predicate action) (if (eq action 'metadata) `(metadata (category . ,category) diff --git a/modules/telega-config.el b/modules/telega-config.el index acc9e482..5a20d430 100644 --- a/modules/telega-config.el +++ b/modules/telega-config.el @@ -48,6 +48,7 @@ ;;; Code: (require 'keybindings) +(require 'system-lib) ; cj/log-silently, used by the death alert (use-package telega :defer t @@ -63,6 +64,117 @@ ;; routing through a shared messenger notifier is the unification task. (telega-notifications-mode 1)) +;; --------------------------- telega Docker Image Pin ------------------------- +;; telega picks its container image in `telega-docker--image-name', which only +;; pins to a version tag when `telega-tdlib-min-version' equals +;; `telega-tdlib-max-version' and the version ends in ".0". Here min is +;; "1.8.64" and max is nil, so that test never passes and the image is always +;; "zevlg/telega-server:latest" -- a floating tag. The elpa package is fixed +;; at whatever version was installed, so the server can be replaced underneath +;; a static elisp without anything announcing it. +;; +;; Pinning by digest names one immutable image. Set to nil to hand the choice +;; back to telega. + +(defcustom cj/telega-docker-image + "zevlg/telega-server@sha256:a4b88e029ba381eca7c37c9618c9e3ad73aa9db2097fe07a0c6684d40d32b84e" + "Container image reference for `telega-server', or nil for telega's default. +Pin by digest rather than tag: a tag can be re-pushed upstream, a digest +cannot. The default is the image carrying libtdjson 1.8.64, which matches +this telega's `telega-tdlib-min-version'." + :type '(choice (const :tag "Let telega infer the image" nil) + (string :tag "Image reference")) + :group 'telega-docker) + +(defun cj/--telega-docker-pinned-image () + "Return the configured image pin, or nil when none is usable. +A blank or non-string setting yields nil rather than reaching the docker +command line, where it would fail in a way that looks unrelated to this." + (when (stringp cj/telega-docker-image) + (let ((pin (string-trim cj/telega-docker-image))) + (unless (string-empty-p pin) pin)))) + +(defun cj/--telega-docker-image-name (orig-fun &rest args) + "Return the pinned telega-server image, else call ORIG-FUN with ARGS. +`:around' advice on `telega-docker--image-name', so clearing the pin +restores telega's own inference instead of breaking the image name." + (or (cj/--telega-docker-pinned-image) + (apply orig-fun args))) + +(with-eval-after-load 'telega-util + (advice-add 'telega-docker--image-name :around #'cj/--telega-docker-image-name)) + +;; ------------------------- telega-server Death Alert ------------------------- +;; telega's own sentinel reports an abnormal server exit with `message', which +;; scrolls out of the echo area unseen. That is how a dead server reads as a +;; quiet Telegram: the scan stops partway and the unscanned chats look like +;; chats with nothing in them. It has happened twice (2026-07-10, 2026-07-27), +;; caught both times only because something downstream noticed. A desktop +;; notification makes the death itself visible. + +(declare-function notifications-notify "notifications") + +(defun cj/--telega-server-death-p (status) + "Return non-nil when exit STATUS means the server died abnormally. +Any non-zero integer counts, which covers both a non-zero exit code and a +fatal signal number (`process-exit-status' reports SIGSEGV as 11). A +non-integer STATUS returns nil rather than signalling: this runs inside +telega's sentinel, where an error would abort telega's own cleanup." + (and (integerp status) + (not (zerop status)))) + +(defun cj/--telega-server-exit-status (proc) + "Return PROC's exit status, or nil when it can't be determined. +Guarded because the sentinel hands over whatever process object it has, +and a bad one must not break telega's status handling." + (condition-case nil + (and (processp proc) (process-exit-status proc)) + (error nil))) + +(defun cj/--telega-server-death-body (status event) + "Build the notification body for a server death with STATUS and EVENT. +EVENT is the sentinel's event string, which carries a trailing newline that +would render as dead space in a desktop notification." + (let ((detail (string-trim (or event "")))) + (concat (format "telega-server died (status %s). " status) + (unless (string-empty-p detail) (concat detail ". ")) + "Telegram coverage is down until it restarts."))) + +(defun cj/--telega-server-send-notification (title body) + "Deliver a desktop notification with TITLE and BODY. +Prefers the external notify script (persistent, so it waits rather than +auto-dismissing while away), falling back to `notifications-notify'. +Mirrors `cj/slack--send-notification'." + (let ((script (executable-find "notify"))) + (if script + (start-process "telega-death-notify" nil script "fail" title body "--persist") + (unless (fboundp 'notifications-notify) + (require 'notifications)) + (notifications-notify :title title :body body)))) + +(defun cj/--telega-server-notify-death (proc event) + "Notify when the telega-server PROC dies abnormally. EVENT is its event string. +Installed as `:after' advice on `telega-server--sentinel'. Silent on a +clean exit, so quitting telega deliberately never pages. + +The whole body is guarded: a notifier failure here would otherwise escape +into telega's sentinel and abort its status handling and relogin path." + (condition-case err + (let ((status (cj/--telega-server-exit-status proc))) + (when (cj/--telega-server-death-p status) + (cj/--telega-server-send-notification + "Telegram: telega-server died" + (cj/--telega-server-death-body status event)))) + (error + (cj/log-silently + (format "telega death notify failed: %s" (error-message-string err)))))) + +;; Named, never a lambda: anonymous advice can't be `advice-remove'd by +;; reference, so a live daemon keeps running it after the source stops +;; installing it. +(with-eval-after-load 'telega-server + (advice-add 'telega-server--sentinel :after #'cj/--telega-server-notify-death)) + (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 7f157f1c..6cb35275 100644 --- a/modules/test-runner.el +++ b/modules/test-runner.el @@ -139,9 +139,11 @@ if not found or not in a project." (t cj/test-global-directory)))))) (defun cj/test--get-test-files () - "Return list of test file names (without path) in test directory." + "Return list of test file names (without path) in test directory. +Returns nil when no test directory is available (outside a project +with `cj/test-global-directory' unset)." (let ((dir (cj/test--get-test-directory))) - (when (file-directory-p dir) + (when (and dir (file-directory-p dir)) (mapcar #'file-name-nondirectory (directory-files dir t "^test-.*\\.el$"))))) @@ -169,6 +171,8 @@ Returns: (cons \\='success loaded-count) on success, (interactive) (cj/test--ensure-test-dir-in-load-path) (let ((dir (cj/test--get-test-directory))) + (unless dir + (user-error "No test directory: not in a project and cj/test-global-directory is unset")) (unless (file-directory-p dir) (user-error "Test directory %s does not exist" dir)) (let ((test-files (directory-files dir t "^test-.*\\.el$"))) @@ -200,11 +204,12 @@ Returns: \\='success if added successfully, (cj/test--ensure-test-dir-in-load-path) (let* ((focused-files (cj/test--current-focused-files)) (dir (cj/test--get-test-directory)) - (available-files (when (file-directory-p dir) + (available-files (when (and dir (file-directory-p dir)) (mapcar #'file-name-nondirectory (directory-files dir t "^test-.*\\.el$"))))) (if (null available-files) - (user-error "No test files found in %s" dir) + (user-error "No test files found in %s" + (or dir "any test directory (not in a project)")) (let* ((unfocused-files (cl-set-difference available-files focused-files :test #'string=)) diff --git a/modules/tramp-config.el b/modules/tramp-config.el index 95fa83db..1c8a8ab9 100644 --- a/modules/tramp-config.el +++ b/modules/tramp-config.el @@ -77,9 +77,10 @@ ;; Cache remote file attributes for better performance (setq remote-file-name-inhibit-cache nil) - ;; Don't check for modified buffers before revert - ;; to avoid unnecessary remote operations - (setq revert-without-query '(".*")) + ;; Skip the revert confirmation for remote files only, to avoid + ;; unnecessary remote round-trips. Scoped to the TRAMP path regexp so + ;; local files keep their normal revert prompt. + (setq revert-without-query (list tramp-file-name-regexp)) ;; Refresh buffers when needed rather than automatically (setq auto-revert-remote-files nil) @@ -120,21 +121,8 @@ ;; Default transfer method (use scp for most efficient transfer) (setq tramp-default-method "scp") - ;; Use different methods based on host/domain patterns - (add-to-list 'tramp-methods - '("sshfast" - (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") - ("-e" "none") ("-t" "-t") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-connection-timeout 10))) - ;; Remote shell and project settings - ;; Support for Docker containers - (add-to-list 'tramp-remote-path 'tramp-own-remote-path) + ;; Extend the remote PATH (tramp-own-remote-path already added above) (add-to-list 'tramp-remote-path "/usr/local/bin") (add-to-list 'tramp-remote-path "/usr/local/sbin") diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el index 21a04de9..e5b8dc00 100644 --- a/modules/undead-buffers.el +++ b/modules/undead-buffers.el @@ -96,7 +96,10 @@ Undead-buffers are buffers in `cj/undead-buffer-list'." (let ((buf (current-buffer))) (unless (one-window-p) (delete-window)) - (cj/kill-buffer-or-bury-alive buf))) + ;; The delegate reads current-prefix-arg; a C-u meant for this wrapper + ;; must not flip it into add-to-undead-list mode. + (let ((current-prefix-arg nil)) + (cj/kill-buffer-or-bury-alive buf)))) ;; Keybinding moved to custom-buffer-file.el (C-; b k) (defun cj/kill-other-window () @@ -109,7 +112,8 @@ window and acting would kill the buffer being viewed." (other-window 1) (let ((buf (current-buffer))) (delete-window) - (cj/kill-buffer-or-bury-alive buf))) + (let ((current-prefix-arg nil)) + (cj/kill-buffer-or-bury-alive buf)))) (keymap-global-set "M-S-o" #'cj/kill-other-window) (defun cj/kill-other-window-buffer () @@ -123,7 +127,8 @@ split is preserved. Buffers in `cj/undead-buffer-list' are buried." (if (one-window-p) (user-error "No other window") (with-selected-window (next-window) - (cj/kill-buffer-or-bury-alive (current-buffer))))) + (let ((current-prefix-arg nil)) + (cj/kill-buffer-or-bury-alive (current-buffer)))))) ;; Keybinding in custom-buffer-file.el (C-; b K) (defun cj/kill-all-other-buffers-and-windows () @@ -131,8 +136,9 @@ split is preserved. Buffers in `cj/undead-buffer-list' are buried." (interactive) (save-some-buffers nil #'cj/undead-buffer-p) (delete-other-windows) - (mapc #'cj/kill-buffer-or-bury-alive - (delq (current-buffer) (buffer-list)))) + (let ((current-prefix-arg nil)) + (mapc #'cj/kill-buffer-or-bury-alive + (delq (current-buffer) (buffer-list))))) (keymap-global-set "M-S-m" #'cj/kill-all-other-buffers-and-windows) ;; was M-M (provide 'undead-buffers) diff --git a/modules/user-constants.el b/modules/user-constants.el index 570b142f..ec387930 100644 --- a/modules/user-constants.el +++ b/modules/user-constants.el @@ -275,5 +275,23 @@ and portable across different machines." ;; bare `(require 'user-constants)' (tests, byte-compile, batch) stays ;; side-effect-free. +(defconst cj/org-todo-keywords + '((sequence "TODO(t)" "PROJECT(p)" "DOING(i)" + "WAITING(w)" "VERIFY(v)" "STALLED(s)" + "DELEGATED(x)" "|" + "FAILED(f!)" "DONE(d!)" "CANCELLED(c!)")) + "The TODO keyword sequence, kept where a batch Emacs can reach it. + +`org-config' sets `org-todo-keywords' from this, and so does any batch process +that has to read the org files the way the editor does. It lives here rather +than in `org-config' because that module loads through `use-package' and needs +packages a batch run has no reason to install. + +The duplication this avoids is not cosmetic. A reader that does not know +DOING is a keyword does not merely mislabel it: org stops parsing the headline +as a task at all, so the keyword and the priority cookie stay glued to the +front of the title and the entry reads as not-done regardless of its real +state.") + (provide 'user-constants) ;;; user-constants.el ends here diff --git a/modules/vc-config.el b/modules/vc-config.el index 60fcaeb8..3da9266f 100644 --- a/modules/vc-config.el +++ b/modules/vc-config.el @@ -37,9 +37,13 @@ (defvar forge-pull-notifications) (defvar forge-topic-list-limit) +;; External package variables (buffer-local hunk list from git-gutter). +(defvar git-gutter:diffinfos) + ;; External package functions (from lazily-loaded packages). (declare-function git-gutter:next-hunk "git-gutter") (declare-function git-gutter:previous-hunk "git-gutter") +(declare-function git-gutter-hunk-start-line "git-gutter") (declare-function git-timemachine--start "git-timemachine") (declare-function git-timemachine--revisions "git-timemachine") (declare-function git-timemachine-show-revision "git-timemachine") @@ -100,8 +104,7 @@ (use-package git-timemachine :commands (git-timemachine - git-timemachine-show-revision - git-timemachine-show-selected-revision) + git-timemachine-show-revision) :init (defun cj/git-timemachine-show-selected-revision () "Displays git revisions of file in chronological order adding metadata." @@ -157,13 +160,33 @@ (forge-create-issue) (user-error "Not in a forge repository"))) +(defun cj/--git-gutter-hunk-candidates (start-lines) + "Build completion candidates for hunk START-LINES in the current buffer. +Each candidate is a cons of a \"LINE: text\" label and the line number." + (mapcar (lambda (line) + (cons (format "%4d: %s" line + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + line)) + start-lines)) + (defun cj/goto-git-gutter-diff-hunks () - "Jump to git-gutter diff hunks using consult. -Searches for lines starting with + or - (diff markers) and allows -interactive selection to jump to any changed line in the buffer." + "Jump to a git-gutter hunk in the current buffer chosen with completion." (interactive) (require 'git-gutter) - (consult-line "^[+\\-]")) + (let ((candidates (cj/--git-gutter-hunk-candidates + (mapcar #'git-gutter-hunk-start-line + (and (boundp 'git-gutter:diffinfos) + git-gutter:diffinfos))))) + (unless candidates + (user-error "No git-gutter hunks in this buffer")) + (let ((line (cdr (assoc (completing-read "Hunk: " candidates nil t) + candidates)))) + (goto-char (point-min)) + (forward-line (1- line))))) ;; ------------------------------ Git Clone Clipboard ----------------------------- ;; Quick git clone from clipboard URL @@ -180,6 +203,33 @@ scp form." (last (car (last (split-string trimmed "[/:]" t))))) (and last (file-name-sans-extension last)))) +(defun cj/--git-clone-open (clone-dir) + "Open CLONE-DIR's README when one exists, else `dired' the directory." + (let ((readme (seq-find + (lambda (file) + (string-match-p "\\`README" (upcase file))) + (directory-files clone-dir)))) + (if readme + (find-file (expand-file-name readme clone-dir)) + (dired clone-dir)))) + +(defun cj/--git-clone-make-sentinel (url clone-dir) + "Return a sentinel reporting the git clone of URL into CLONE-DIR. +On a zero exit the sentinel announces success and opens the clone; on +any other exit or a signal it surfaces the process buffer." + (lambda (process _event) + (when (memq (process-status process) '(exit signal)) + (if (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + (progn + (message "Cloned %s into %s" url clone-dir) + (cj/--git-clone-open clone-dir)) + (let ((buf (process-buffer process))) + (when (buffer-live-p buf) + (pop-to-buffer buf)) + (message "git clone of %s failed (status %s)" + url (process-exit-status process))))))) + (defun cj/git-clone-clipboard-url (url target-dir) "Clone git repository from clipboard URL to TARGET-DIR. @@ -187,11 +237,13 @@ With no prefix argument: uses first directory in `cj/git-clone-dirs'. With \\[universal-argument]: choose from `cj/git-clone-dirs'. With \\[universal-argument] \\[universal-argument]: choose any directory. -Clones with a direct `git' process (no shell), into a path derived -robustly from URL. Aborts with a clear message when the clipboard is -empty, the target is not a writable directory, the destination already -exists, or `git' exits non-zero. After a successful clone, opens the -repository's README if found, else `dired's the clone." +Clones with a direct asynchronous `git' process (no shell, no frozen +frames), into a path derived robustly from URL. Aborts with a clear +message when the clipboard is empty, the target is not a writable +directory, or the destination already exists. The process sentinel +reports the result: on success it opens the repository's README if +found (else `dired's the clone); on failure it surfaces the process +buffer." (interactive (list (current-kill 0) ;; Get URL from clipboard (cond @@ -219,21 +271,14 @@ repository's README if found, else `dired's the clone." (when (file-exists-p clone-dir) (user-error "Clone destination already exists: %s" clone-dir)) (message "Cloning %s into %s..." url clone-dir) - ;; Direct process, no shell. `--' stops option parsing so a URL - ;; beginning with `-' can't be read as a git flag. - (let ((status (call-process "git" nil "*git-clone*" nil - "clone" "--" url clone-dir))) - (unless (zerop status) - (pop-to-buffer "*git-clone*") - (user-error "git clone failed (exit %d); see *git-clone*" status))) - ;; Find and open README - (let ((readme (seq-find - (lambda (file) - (string-match-p "\\`README" (upcase file))) - (directory-files clone-dir)))) - (if readme - (find-file (expand-file-name readme clone-dir)) - (dired clone-dir)))))) + ;; Direct async process, no shell, so no emacsclient frame blocks + ;; for the duration of the clone. `--' stops option parsing so a + ;; URL beginning with `-' can't be read as a git flag. + (make-process + :name "git-clone" + :buffer "*git-clone*" + :command (list "git" "clone" "--" url clone-dir) + :sentinel (cj/--git-clone-make-sentinel url clone-dir))))) ;; -------------------------------- Difftastic --------------------------------- ;; Structural diffs for better git change visualization @@ -243,7 +288,7 @@ repository's README if found, else `dired's the clone." :defer t :commands (difftastic-magit-diff difftastic-magit-show) :bind (:map magit-blame-read-only-mode-map - ("D" . difftastic-magit-show) + ("D" . difftastic-magit-diff) ("S" . difftastic-magit-show)) :config (eval-after-load 'magit-diff diff --git a/modules/video-audio-recording-capture.el b/modules/video-audio-recording-capture.el index 5e7860fc..a56a5906 100644 --- a/modules/video-audio-recording-capture.el +++ b/modules/video-audio-recording-capture.el @@ -56,6 +56,10 @@ Checks if process is actually alive, not just if variable is set." ;;; Process Lifecycle (Sentinel and Graceful Shutdown) +;; Forward declaration: the real `defvar' is defined below with the other +;; recording thresholds. Declared special here so this reference compiles clean. +(defvar cj/recording-start-fail-threshold) + (defun cj/recording-process-sentinel (process event) "Sentinel for recording processes — handles unexpected exits. PROCESS is the ffmpeg shell process, EVENT describes what happened. @@ -147,8 +151,7 @@ process started before the property existed) or the file never hit disk." (defun cj/recording-check-ffmpeg () "Check if ffmpeg is available. Error if not found." (unless (executable-find "ffmpeg") - (user-error "Ffmpeg not found. Install with: sudo pacman -S ffmpeg") - nil) + (user-error "Ffmpeg not found. Install with: sudo pacman -S ffmpeg")) t) (defun cj/recording--wayland-p () @@ -159,8 +162,7 @@ process started before the property existed) or the file never hit disk." "Check if wf-recorder is available (needed for Wayland video capture)." (if (executable-find "wf-recorder") t - (user-error "wf-recorder not found. Install with: sudo pacman -S wf-recorder") - nil)) + (user-error "wf-recorder not found. Install with: sudo pacman -S wf-recorder"))) ;;; Device Acquisition and Validation diff --git a/modules/video-audio-recording-devices.el b/modules/video-audio-recording-devices.el index 375a81cf..8adcd347 100644 --- a/modules/video-audio-recording-devices.el +++ b/modules/video-audio-recording-devices.el @@ -272,54 +272,6 @@ Returns the selected device name, or signals user-error if cancelled." (user-error "Device setup cancelled")) device)) -(defun cj/recording-group-devices-by-hardware () - "Group audio sources by physical hardware device. -Returns alist of (friendly-name . (mic-source . monitor-source)). -Only includes devices that have BOTH a mic and a monitor source, -since recording needs both to capture your voice and system audio." - (let ((sources (cj/recording-parse-sources)) - (devices (make-hash-table :test 'equal)) - (result nil)) - ;; Group sources by base device name (hardware identifier) - (dolist (source sources) - (let* ((device (nth 0 source)) - ;; Extract hardware ID — the unique part identifying the physical device. - ;; Different device types use different naming conventions in PulseAudio. - (base-name (cond - ;; USB devices: extract usb-XXXXX-XX part - ((string-match "\\.\\(usb-[^.]+\\-[0-9]+\\)\\." device) - (match-string 1 device)) - ;; Built-in (PCI) devices: extract pci-XXXXX part - ((string-match "\\.\\(pci-[^.]+\\)\\." device) - (match-string 1 device)) - ;; Bluetooth devices: extract and normalize MAC address - ;; (input uses colons, output uses underscores) - ((string-match "bluez_\\(?:input\\|output\\)\\.\\([^.]+\\)" device) - (replace-regexp-in-string "_" ":" (match-string 1 device))) - (t device))) - (is-monitor (string-match-p "\\.monitor$" device)) - (device-entry (gethash base-name devices))) - (unless device-entry - (setf device-entry (cons nil nil)) - (puthash base-name device-entry devices)) - (if is-monitor - (setcdr device-entry device) - (setcar device-entry device)))) - - ;; Convert hash table to alist with user-friendly names - (maphash (lambda (base-name pair) - (when (and (car pair) (cdr pair)) - (let ((friendly-name - (cond - ((string-match-p "usb.*[Jj]abra" base-name) "Jabra SPEAK 510 USB") - ((string-match-p "^usb-" base-name) "USB Audio Device") - ((string-match-p "^pci-" base-name) "Built-in Audio") - ((string-match-p "^[0-9A-Fa-f:]+$" base-name) "Bluetooth Headset") - (t base-name)))) - (push (cons friendly-name pair) result)))) - devices) - (nreverse result))) - (defun cj/recording-select-device (prompt device-type) "Interactively select an audio device. PROMPT is shown to user. DEVICE-TYPE is \\='mic or \\='monitor for filtering. diff --git a/modules/wrap-up.el b/modules/wrap-up.el index e28ba845..6901901f 100644 --- a/modules/wrap-up.el +++ b/modules/wrap-up.el @@ -23,12 +23,12 @@ "Bury comint and compilation buffers." (dolist (buf (buffer-list)) (with-current-buffer buf + ;; Byte-compilation output arrives in `emacs-lisp-compilation-mode', + ;; which derives from `compilation-mode' and so is covered by that clause. (when (or (derived-mode-p 'comint-mode) (derived-mode-p 'compilation-mode) (derived-mode-p 'debugger-mode) - (derived-mode-p 'elisp-compile-mode) - (derived-mode-p 'messages-buffer-mode) - ) ;; byte-compilations + (derived-mode-p 'messages-buffer-mode)) (bury-buffer))))) (defun cj/bury-buffers-after-delay () diff --git a/scripts/agenda-render-cache b/scripts/agenda-render-cache new file mode 100755 index 00000000..b1e4d490 --- /dev/null +++ b/scripts/agenda-render-cache @@ -0,0 +1,50 @@ +#!/usr/bin/env bash +# Write the agenda render cache for an external renderer. +# +# Runs a batch Emacs rather than talking to the daemon, because the surface +# that reads the cache has to keep working while Emacs is down -- and +# emacsclient is exactly the thing that cannot. Nothing here touches a running +# Emacs, so it is safe to fire from a timer alongside an active session. +# +# The agenda file list is resolved the same way the editor resolves it, by +# loading the config's own resolver rather than restating the list here. A +# second copy of that list would drift the first time a calendar source is +# added. +# +# Usage: agenda-render-cache +# Env: EMACS_D -- config directory (default ~/.emacs.d) +# EMACS -- emacs binary (default emacs) +# AGENDA_RENDER_FILES -- colon-separated org files to read instead of +# the configured agenda list. Lets a caller ask +# about a known set, and lets the tests run +# against a fixture rather than whatever happens +# to be on the machine's real agenda today. + +set -euo pipefail + +EMACS_D="${EMACS_D:-$HOME/.emacs.d}" +EMACS="${EMACS:-emacs}" + +if [ ! -d "$EMACS_D/modules" ]; then + echo "agenda-render-cache: no modules directory at $EMACS_D/modules" >&2 + exit 1 +fi + +# -Q keeps the daemon's init out of it: this needs three modules, not a full +# editor. load-prefer-newer stops a stale .elc from answering for changed +# source, which would silently write yesterday's logic. +exec "$EMACS" --batch -Q \ + --eval '(setq load-prefer-newer t)' \ + -L "$EMACS_D/modules" \ + --eval '(progn + (require (quote user-constants)) + (require (quote org-agenda-config)) + (setq org-todo-keywords cj/org-todo-keywords) + (require (quote agenda-query)) + (setq org-agenda-files + (let ((override (getenv "AGENDA_RENDER_FILES"))) + (if (and override (not (string-empty-p override))) + (split-string override ":" t) + (cj/--org-agenda-scan-files)))) + (princ (cj/agenda-render-cache-update)) + (terpri))' diff --git a/scripts/remote-repository-reset.sh b/scripts/remote-repository-reset.sh deleted file mode 100755 index e9a243a8..00000000 --- a/scripts/remote-repository-reset.sh +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/sh -# Craig Jennings -# post archsetup step to reset remote upstream repositories on emacs -# configuration and doftiles. - -cd ~/emacs.d/ -git remote remove origin -git remote add github git@github.com:cjennings/dotemacs.git -git remote add origin git@cjennings.net:dotemacs.git -git branch -M main -git push -u origin main - - -cd ~/.dotfiles/ -git remote remove origin -git remote add github git@github.com:cjennings/dotfiles.git -git remote add origin git@cjennings.net:dotfiles.git -git branch -M main -git push -u origin main diff --git a/systemd/agenda-render-cache.service b/systemd/agenda-render-cache.service new file mode 100644 index 00000000..0fe08533 --- /dev/null +++ b/systemd/agenda-render-cache.service @@ -0,0 +1,14 @@ +[Unit] +Description=Write the agenda render cache for external surfaces +# Deliberately no dependency on emacs.service or graphical-session.target. +# The whole point is that the cache stays current while Emacs is down, so the +# writer is a batch Emacs that needs neither the daemon nor a compositor. +Documentation=file:%h/.emacs.d/modules/agenda-query.el + +[Service] +Type=oneshot +ExecStart=%h/.emacs.d/scripts/agenda-render-cache +# One run is about a second of CPU. Cap it well above that so a wedged run is +# killed rather than left holding the timer. +TimeoutStartSec=120 +Nice=10 diff --git a/systemd/agenda-render-cache.timer b/systemd/agenda-render-cache.timer new file mode 100644 index 00000000..71a6d662 --- /dev/null +++ b/systemd/agenda-render-cache.timer @@ -0,0 +1,17 @@ +[Unit] +Description=Refresh the agenda render cache every 5 minutes + +[Timer] +# OnCalendar rather than OnUnitActiveSec, because Persistent= only has an +# effect on calendar timers (systemd.timer(5)). A monotonic schedule silently +# ignores it, so a machine that slept through several intervals would come back +# to a stale file with nothing to trigger a catch-up -- and the surface reading +# it cannot tell stale from correct. +OnCalendar=*:0/5 +Persistent=true +# A cold boot should not wait for the next wall-clock slot. +OnBootSec=1min +AccuracySec=30s + +[Install] +WantedBy=timers.target diff --git a/tests/test-agenda-query--bounds.el b/tests/test-agenda-query--bounds.el new file mode 100644 index 00000000..9ee423e7 --- /dev/null +++ b/tests/test-agenda-query--bounds.el @@ -0,0 +1,169 @@ +;;; test-agenda-query--bounds.el --- Tests for timestamp bounds -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/--agenda-query-timestamp-bounds', which turns an org-element +;; timestamp into epoch bounds for the JSON query. +;; +;; The contract under test: +;; - :start is the epoch of the timestamp's start. +;; - :end is the epoch of an explicit range end, or nil when the source has no +;; range. A null end is information the consumer cannot re-derive, so it is +;; never filled in with a guess. +;; - :all-day is t when the timestamp carries no hour. +;; - :effective-end is what the window predicate uses: the explicit end, or for +;; an all-day entry the end of its last day, or for a timed point event the +;; start itself. This is the "treat the day as its extent" rule, kept out of +;; :end so the reported shape stays faithful to the source. +;; +;; Helpers carry a file-unique prefix on purpose: the editor hook loads every +;; agenda-query test file into ONE process, so a shared helper name here would +;; silently redefine its namesake in a sibling file. + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-element) +(require 'org-agenda) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'agenda-query) + +(defun test-aq-bounds--epoch (sec min hour day month year) + "Return the epoch second for the local time SEC MIN HOUR DAY MONTH YEAR." + (time-convert (encode-time (list sec min hour day month year nil -1 nil)) + 'integer)) + +(defun test-aq-bounds--of (raw) + "Parse timestamp string RAW and return its bounds plist." + (cj/--agenda-query-timestamp-bounds (org-timestamp-from-string raw))) + +;;; Normal Cases + +(ert-deftest test-agenda-query-bounds-normal-timed-range () + "Normal: a same-day timed range reports both ends and is not all-day." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 23:00-23:30>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 23 31 7 2026))) + (should (equal (plist-get b :end) + (test-aq-bounds--epoch 0 30 23 31 7 2026))) + (should-not (plist-get b :all-day)) + (should (equal (plist-get b :effective-end) (plist-get b :end))))) + +(ert-deftest test-agenda-query-bounds-normal-timed-point () + "Normal: a timed point event has no end, and its extent is the instant." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 14:00>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 14 31 7 2026))) + (should-not (plist-get b :end)) + (should-not (plist-get b :all-day)) + (should (equal (plist-get b :effective-end) (plist-get b :start))))) + +;;; Boundary Cases + +(ert-deftest test-agenda-query-bounds-boundary-all-day-extent () + "Boundary: an all-day entry reports no end but extends over its whole day." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 31 7 2026))) + (should-not (plist-get b :end)) + (should (plist-get b :all-day)) + ;; One second short of the next midnight -- the day is the extent. + (should (equal (plist-get b :effective-end) + (1- (test-aq-bounds--epoch 0 0 0 1 8 2026)))))) + +(ert-deftest test-agenda-query-bounds-boundary-multi-day-all-day () + "Boundary: a multi-day all-day range ends at the close of its last day." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri>--<2026-08-02 Sun>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 31 7 2026))) + (should (plist-get b :all-day)) + (should (equal (plist-get b :end) + (1- (test-aq-bounds--epoch 0 0 0 3 8 2026)))) + (should (equal (plist-get b :effective-end) (plist-get b :end))))) + +(ert-deftest test-agenda-query-bounds-boundary-midnight-start () + "Boundary: an explicit 00:00 is a timed event, not an all-day one." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 00:00>"))) + (should-not (plist-get b :all-day)) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 31 7 2026))))) + +(ert-deftest test-agenda-query-bounds-boundary-dst-spring-forward () + "Boundary: a timestamp on a DST changeover day still resolves to one epoch. +US DST began 2026-03-08. The interface is epoch seconds precisely so the +consumer never has to know the source timestamps are naive local time." + (let ((b (test-aq-bounds--of "<2026-03-08 Sun 13:00>"))) + (should (integerp (plist-get b :start))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 13 8 3 2026))))) + +(ert-deftest test-agenda-query-bounds-boundary-dst-day-is-23-hours () + "Boundary: the day-extent rule follows real clock time, not a fixed 86400. +2026-03-08 loses an hour, so its all-day extent is one second short of 23 +hours. Adding a constant day would overshoot into the next day." + (let ((b (test-aq-bounds--of "<2026-03-08 Sun>"))) + (should (equal (plist-get b :effective-end) + (1- (test-aq-bounds--epoch 0 0 0 9 3 2026)))) + (should (= (- (plist-get b :effective-end) (plist-get b :start)) + (1- (* 23 3600)))))) + +(ert-deftest test-agenda-query-bounds-boundary-same-day-range-crosses-midnight () + "Boundary: a range whose end precedes its start is read as crossing midnight. + +Org records <2026-07-31 Fri 23:00-01:00> with day-end EQUAL to day-start, so +reading it literally puts the end 22 hours before the start. A negative +duration is meaningless to a renderer, and the row would also vanish from the +very window it belongs to, since its effective end would sit before the +window opens." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 23:00-01:00>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 23 31 7 2026))) + (should (equal (plist-get b :end) + (test-aq-bounds--epoch 0 0 1 1 8 2026))) + (should (> (plist-get b :end) (plist-get b :start))) + (should (= (- (plist-get b :end) (plist-get b :start)) (* 2 3600))))) + +(ert-deftest test-agenda-query-bounds-boundary-reversed-multi-day-range () + "Boundary: a genuinely reversed multi-day range reports no end at all. + +The midnight roll is scoped to same-day ranges, which is the shape org uses +for <23:00-01:00>. Rolling a reversed multi-day range would shift a wrong +date by one day and leave it still wrong, so instead the entry is reported as +a point -- a consumer can draw that, where a negative-duration bar is +meaningless." + (let ((b (test-aq-bounds--of "<2026-08-02 Sun 09:00>--<2026-07-31 Fri 08:00>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 9 2 8 2026))) + (should-not (plist-get b :end)) + (should (equal (plist-get b :effective-end) (plist-get b :start))))) + +(ert-deftest test-agenda-query-bounds-boundary-reversed-all-day-range () + "Boundary: a reversed ALL-DAY range also reports no end. + +The same malformed shape as the timed case, and the same consequence if it +slips through: the negative extent would sit before the start, so the entry +would vanish from the very day it opens on. A typo or a bad ICS import +produces this." + (let ((b (test-aq-bounds--of "<2026-08-05 Wed>--<2026-08-01 Sat>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 5 8 2026))) + (should-not (plist-get b :end)) + ;; Falls back to its own day, so it still appears on 5 August. + (should (> (plist-get b :effective-end) (plist-get b :start))))) + +;;; Error Cases + +(ert-deftest test-agenda-query-bounds-error-inactive-still-computes () + "Error: bounds are purely arithmetic -- filtering inactive stamps is a +separate concern, so an inactive timestamp still yields usable bounds." + (let ((b (test-aq-bounds--of "[2026-07-31 Fri 09:00]"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 9 31 7 2026))))) + +(ert-deftest test-agenda-query-bounds-error-nil-timestamp () + "Error: a nil timestamp yields nil rather than signaling." + (should-not (cj/--agenda-query-timestamp-bounds nil))) + +(provide 'test-agenda-query--bounds) +;;; test-agenda-query--bounds.el ends here diff --git a/tests/test-agenda-query--occurrences.el b/tests/test-agenda-query--occurrences.el new file mode 100644 index 00000000..4fa73a0c --- /dev/null +++ b/tests/test-agenda-query--occurrences.el @@ -0,0 +1,242 @@ +;;; test-agenda-query--occurrences.el --- Tests for window + repeats -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/--agenda-query-occurrences' and the repeater cookie helper. +;; +;; Two behaviors under test: +;; +;; 1. The window predicate is intersection, not containment. An event running +;; across the window's start edge is in the window -- on a live surface it is +;; the thing currently happening. +;; +;; 2. A repeating entry contributes one row per occurrence inside the window, +;; expanded through org's own arithmetic. The base timestamp of a long-lived +;; repeater sits far in the past, so returning it raw would put a task that is +;; genuinely due today outside the window entirely. + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-element) +(require 'org-agenda) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'agenda-query) + +(defun test-agenda-query-occ--epoch (min hour day month year) + "Return the epoch for local MIN HOUR DAY MONTH YEAR." + (time-convert (encode-time (list 0 min hour day month year nil -1 nil)) + 'integer)) + +(defun test-agenda-query-occ--of (raw start end) + "Return occurrences of timestamp string RAW within START..END." + (cj/--agenda-query-occurrences (org-timestamp-from-string raw) start end)) + +(defun test-agenda-query-occ--starts (raw start end) + "Return just the start epochs of RAW's occurrences within START..END." + (mapcar #'car (test-agenda-query-occ--of raw start end))) + +;;; ---------- repeater cookie ---------- + +(ert-deftest test-agenda-query-cookie-normal-all-three-styles () + "Normal: each repeater style round-trips to its raw cookie." + (should (equal "+1d" (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed +1d>")))) + (should (equal "++2w" (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed ++2w>")))) + (should (equal ".+3m" (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed .+3m>"))))) + +(ert-deftest test-agenda-query-cookie-boundary-none () + "Boundary: a plain timestamp has no cookie, and nil is not a cookie." + (should-not (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed>"))) + (should-not (cj/--agenda-query-repeater-cookie nil))) + +;;; ---------- window predicate ---------- + +(ert-deftest test-agenda-query-occ-normal-inside-window () + "Normal: an event wholly inside the window is returned once, with its end." + (let* ((win-start (test-agenda-query-occ--epoch 0 8 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 18 31 7 2026)) + (occ (test-agenda-query-occ--of "<2026-07-31 Fri 09:00-10:00>" + win-start win-end))) + (should (= 1 (length occ))) + (should (equal (caar occ) (test-agenda-query-occ--epoch 0 9 31 7 2026))) + (should (equal (cdar occ) (test-agenda-query-occ--epoch 0 10 31 7 2026))))) + +(ert-deftest test-agenda-query-occ-boundary-overlaps-start-edge () + "Boundary: an event that began before the window but is still running is in. +This is the 23:00-01:00 case -- the whole reason the predicate is intersects +rather than starts-inside." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 1 8 2026)) + (win-end (test-agenda-query-occ--epoch 0 23 1 8 2026))) + (should (= 1 (length (test-agenda-query-occ--of + "<2026-07-31 Fri 23:00>--<2026-08-01 Sat 01:00>" + win-start win-end)))))) + +(ert-deftest test-agenda-query-occ-boundary-touches-edge-exactly () + "Boundary: an event ending exactly at the window start is still included." + (let* ((win-start (test-agenda-query-occ--epoch 0 10 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 18 31 7 2026))) + (should (= 1 (length (test-agenda-query-occ--of + "<2026-07-31 Fri 09:00-10:00>" win-start win-end)))))) + +(ert-deftest test-agenda-query-occ-boundary-all-day-covers-window () + "Boundary: an all-day entry covers any window inside its day." + (let* ((win-start (test-agenda-query-occ--epoch 0 13 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 30 13 31 7 2026)) + (occ (test-agenda-query-occ--of "<2026-07-31 Fri>" win-start win-end))) + (should (= 1 (length occ))) + ;; No range in the source, so no end is invented. + (should-not (cdar occ)))) + +(ert-deftest test-agenda-query-occ-boundary-outside-window () + "Boundary: an event finishing before the window opens is excluded." + (let* ((win-start (test-agenda-query-occ--epoch 0 12 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 18 31 7 2026))) + (should-not (test-agenda-query-occ--of "<2026-07-31 Fri 09:00-10:00>" + win-start win-end)))) + +;;; ---------- repeat expansion ---------- + +(ert-deftest test-agenda-query-occ-normal-daily-repeat-reaches-today () + "Normal: a daily repeater based a month back yields today's occurrence. +Returning the raw base date would put a task genuinely due today far outside +the window -- this is the failure the expansion exists to prevent." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (starts (test-agenda-query-occ--starts "<2026-07-01 Wed 09:00 +1d>" + win-start win-end))) + (should (equal starts (list (test-agenda-query-occ--epoch 0 9 31 7 2026)))))) + +(ert-deftest test-agenda-query-occ-normal-repeat-preserves-duration () + "Normal: an expanded occurrence keeps the base timestamp's duration." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (occ (car (test-agenda-query-occ--of "<2026-07-01 Wed 09:00-10:30 +1d>" + win-start win-end)))) + (should occ) + (should (equal (car occ) (test-agenda-query-occ--epoch 0 9 31 7 2026))) + (should (equal (cdr occ) (test-agenda-query-occ--epoch 30 10 31 7 2026))))) + +(ert-deftest test-agenda-query-occ-boundary-one-row-per-occurrence () + "Boundary: a window wider than the interval yields a row per occurrence. +A count is derivable from rows; rows are not derivable from a count, so the +row form is what the query returns." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 27 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (starts (test-agenda-query-occ--starts "<2026-07-01 Wed 09:00 +1d>" + win-start win-end))) + (should (= 5 (length starts))) + (should (equal starts + (list (test-agenda-query-occ--epoch 0 9 27 7 2026) + (test-agenda-query-occ--epoch 0 9 28 7 2026) + (test-agenda-query-occ--epoch 0 9 29 7 2026) + (test-agenda-query-occ--epoch 0 9 30 7 2026) + (test-agenda-query-occ--epoch 0 9 31 7 2026)))))) + +(ert-deftest test-agenda-query-occ-boundary-weekly-lands-on-its-day () + "Boundary: a weekly repeater yields only the days it actually falls on. +2026-07-01 is a Wednesday, so within Mon 27 -- Fri 31 July only Wed 29 counts." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 27 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (starts (test-agenda-query-occ--starts "<2026-07-01 Wed 09:00 +1w>" + win-start win-end))) + (should (equal starts (list (test-agenda-query-occ--epoch 0 9 29 7 2026)))))) + +(ert-deftest test-agenda-query-occ-boundary-restart-style-expands () + "Boundary: a .+ repeater expands from its base like any other style. + +Org rewrites a restart repeater's base timestamp when the task is completed, +so for an open task the base IS the last repeat and base-relative expansion is +what the agenda shows. All three styles agree here." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (expected (list (test-agenda-query-occ--epoch 0 9 31 7 2026)))) + (dolist (raw '("<2026-07-01 Wed 09:00 +1d>" + "<2026-07-01 Wed 09:00 ++1d>" + "<2026-07-01 Wed 09:00 .+1d>")) + (should (equal expected + (test-agenda-query-occ--starts raw win-start win-end)))))) + +(ert-deftest test-agenda-query-occ-boundary-repeat-not-yet-started () + "Boundary: a repeater whose base is after the window yields nothing." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026))) + (should-not (test-agenda-query-occ--starts "<2026-12-01 Tue 09:00 +1d>" + win-start win-end)))) + +(ert-deftest test-agenda-query-occ-boundary-zero-value-repeater () + "Boundary: org treats a zero-value repeater as void, so it behaves as a +plain timestamp -- absent when its base is outside the window, and present +exactly once when the base is inside it. + +Both halves are asserted deliberately. The absent half alone would also pass +against an implementation with no repeater support at all, which makes it no +evidence about zero-value handling." + (should-not (test-agenda-query-occ--starts + "<2026-07-01 Wed 09:00 +0d>" + (test-agenda-query-occ--epoch 0 0 31 7 2026) + (test-agenda-query-occ--epoch 59 23 31 7 2026))) + (should (equal (list (test-agenda-query-occ--epoch 0 9 1 7 2026)) + (test-agenda-query-occ--starts + "<2026-07-01 Wed 09:00 +0d>" + (test-agenda-query-occ--epoch 0 0 1 7 2026) + (test-agenda-query-occ--epoch 59 23 1 7 2026))))) + +(ert-deftest test-agenda-query-occ-boundary-repeat-in-progress-at-window-start () + "Boundary: a repeating event that began before the window and is still +running is returned. + +The non-repeating path honors intersects-not-contains; the repeating path has +to as well. Scanning only days inside the window misses this, because the +occurrence's own day starts earlier: a nightly 22:00-02:00 job is the thing +actually happening at 03:00, and a renderer that drops it shows an empty slot +during the event." + (let ((raw "<2026-07-01 Wed 22:00 +1d>--<2026-07-02 Thu 02:00>")) + (should (= 1 (length (test-agenda-query-occ--of + raw + (test-agenda-query-occ--epoch 0 0 31 7 2026) + (test-agenda-query-occ--epoch 0 6 31 7 2026))))) + ;; The same occurrence seen from inside its own evening. + (should (= 1 (length (test-agenda-query-occ--of + raw + (test-agenda-query-occ--epoch 0 21 31 7 2026) + (test-agenda-query-occ--epoch 0 23 31 7 2026))))))) + +(ert-deftest test-agenda-query-occ-boundary-repeat-extent-follows-dst () + "Boundary: an all-day repeat's extent is recomputed per occurrence day. + +US DST ends 2026-11-01, making that day 25 hours long. Carrying the base +day's length forward as a fixed number of seconds leaves the occurrence +ending an hour early, so a window late on that day sees nothing while the +identical non-repeating entry is found." + (let ((win-start (test-agenda-query-occ--epoch 30 23 1 11 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 1 11 2026))) + (should (= 1 (length (test-agenda-query-occ--of "<2026-07-01 Wed +1d>" + win-start win-end)))) + ;; The non-repeating control: same day, same window, must agree. + (should (= 1 (length (test-agenda-query-occ--of "<2026-11-01 Sun>" + win-start win-end)))))) + +;;; ---------- error cases ---------- + +(ert-deftest test-agenda-query-occ-error-inverted-window () + "Error: a window whose start is after its end matches nothing. +Without the guard the intersection test passes for any long-running event, +which would silently return rows for a nonsense request." + (let* ((win-start (test-agenda-query-occ--epoch 0 18 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 8 31 7 2026))) + (should-not (test-agenda-query-occ--of "<2026-07-31 Fri 09:00-10:00>" + win-start win-end)) + (should-not (test-agenda-query-occ--of "<2026-07-01 Wed 09:00 +1d>" + win-start win-end)))) + +(ert-deftest test-agenda-query-occ-error-nil-timestamp () + "Error: a nil timestamp yields no occurrences rather than signaling." + (should-not (cj/--agenda-query-occurrences nil 0 100))) + +(provide 'test-agenda-query--occurrences) +;;; test-agenda-query--occurrences.el ends here diff --git a/tests/test-agenda-query--render.el b/tests/test-agenda-query--render.el new file mode 100644 index 00000000..48d28773 --- /dev/null +++ b/tests/test-agenda-query--render.el @@ -0,0 +1,275 @@ +;;; test-agenda-query--render.el --- Tests for the renderer profile -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/agenda-render-json' and the row transform behind it. +;; +;; The renderer reads three keys — s and e as epoch MILLISECONDS, t as the +;; title — and drops everything else before drawing. Two things therefore have +;; to hold, and both are asserted rather than assumed: +;; +;; 1. s and e really are milliseconds. A seconds-for-milliseconds slip puts +;; every bar in 1970 and the surface renders empty, which looks exactly like +;; "Emacs isn't writing the file". +;; 2. Every row has a drawable e. The canonical profile reports null where the +;; source has no range, and null is not a width. +;; +;; Helpers carry a file-unique prefix: the editor hook loads every +;; agenda-query test file into ONE process. + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-element) +(require 'org-agenda) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'agenda-query) +;; Supplies `cj/org-todo-keywords', the vocabulary the batch writer sets and +;; the editor's org config reads. +(require 'user-constants) + +(defun test-aq-render--epoch (min hour day month year) + "Return the epoch for local MIN HOUR DAY MONTH YEAR." + (time-convert (encode-time (list 0 min hour day month year nil -1 nil)) + 'integer)) + +(defmacro test-aq-render--with-agenda-file (text &rest body) + "Write TEXT to a temp agenda file and run BODY with `rows' bound. +`rows' is the parsed render-profile output for all of 2026-07-31." + (declare (indent 1)) + `(let* ((dir (make-temp-file "agenda-render-" t)) + (file (expand-file-name "todo.org" dir))) + (unwind-protect + (progn + (with-temp-file file (insert ,text)) + (let* ((org-agenda-files (list file)) + (rows (append (json-parse-string + (cj/agenda-render-json + (test-aq-render--epoch 0 0 31 7 2026) + (test-aq-render--epoch 59 23 31 7 2026)) + :object-type 'alist) + nil))) + ,@body)) + (dolist (buffer (buffer-list)) + (when (equal (buffer-file-name buffer) file) (kill-buffer buffer))) + (delete-directory dir t)))) + +;;; Normal Cases + +(ert-deftest test-agenda-render-normal-emits-milliseconds () + "Normal: s and e are epoch milliseconds, not seconds. + +The renderer works in milliseconds throughout. Sending seconds puts every bar +in January 1970, which draws as an empty surface — indistinguishable from the +file never being written." + (test-aq-render--with-agenda-file + "* Standup\nSCHEDULED: <2026-07-31 Fri 09:00-09:30>\n" + (let ((row (car rows))) + (should (= (alist-get 's row) + (* 1000 (test-aq-render--epoch 0 9 31 7 2026)))) + (should (= (alist-get 'e row) + (* 1000 (test-aq-render--epoch 30 9 31 7 2026)))) + ;; Sanity on the magnitude: milliseconds since 1970 are 13 digits now. + (should (= 13 (length (number-to-string (alist-get 's row)))))))) + +(ert-deftest test-agenda-render-normal-title-is-t () + "Normal: the title is carried as t, the key the renderer reads." + (test-aq-render--with-agenda-file + "* TODO [#A] Standup with Nerses :work:\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (equal "Standup with Nerses" (alist-get 't (car rows)))))) + +(ert-deftest test-agenda-render-normal-canonical-fields-survive () + "Normal: the canonical fields ride along, since the consumer drops its own. +One file serves both the renderer and anything reading the documented shape." + (test-aq-render--with-agenda-file + "* DONE Standup\nSCHEDULED: <2026-07-31 Fri 09:00-09:30>\n" + (let ((row (car rows))) + (should (equal "Standup" (alist-get 'title row))) + (should (eq t (alist-get 'done row))) + (should (equal "scheduled" (alist-get 'type row))) + ;; start stays SECONDS while s is milliseconds; the units never mix + ;; within a key. + (should (= (alist-get 'start row) (/ (alist-get 's row) 1000)))))) + +;;; Boundary Cases + +(ert-deftest test-agenda-render-boundary-all-day-spans-its-day () + "Boundary: an all-day entry gets a drawable e covering its whole day. +Canonically its end is null, and null is not something a renderer can draw." + (test-aq-render--with-agenda-file + "* TODO Water plants\nSCHEDULED: <2026-07-31 Fri>\n" + (let ((row (car rows))) + (should (eq :null (alist-get 'end row))) + (should (= (alist-get 's row) + (* 1000 (test-aq-render--epoch 0 0 31 7 2026)))) + (should (= (alist-get 'e row) + (* 1000 (1- (test-aq-render--epoch 0 0 1 8 2026)))))))) + +(ert-deftest test-agenda-render-boundary-point-event-has-zero-width () + "Boundary: a timed point event ends where it starts rather than at null. +Zero width is a marker the renderer can decide how to draw; null is a crash or +a silently dropped row." + (test-aq-render--with-agenda-file + "* Reminder\n<2026-07-31 Fri 14:00>\n" + (let ((row (car rows))) + (should (eq :null (alist-get 'end row))) + (should (= (alist-get 'e row) (alist-get 's row)))))) + +(ert-deftest test-agenda-render-boundary-every-row-is-drawable () + "Boundary: across a mixed day, every row has integer s and e with e >= s. +This is the invariant the surface depends on, so it is asserted over the whole +set rather than one row at a time." + (test-aq-render--with-agenda-file + (concat "* TODO All day\nSCHEDULED: <2026-07-31 Fri>\n" + "* Point\n<2026-07-31 Fri 14:00>\n" + "* Ranged\n<2026-07-31 Fri 15:00-16:30>\n" + "* TODO Deadline day\nDEADLINE: <2026-07-31 Fri 17:00>\n") + (should (= 4 (length rows))) + (dolist (row rows) + (should (integerp (alist-get 's row))) + (should (integerp (alist-get 'e row))) + (should (>= (alist-get 'e row) (alist-get 's row))) + (should (stringp (alist-get 't row)))))) + +(ert-deftest test-agenda-render-boundary-empty-is-array () + "Boundary: an empty day is an empty array, not null. +The renderer parses the same shape whether or not anything is scheduled." + (let ((org-agenda-files nil)) + (should (equal "[]" (cj/agenda-render-json 1785474000 1785477600))))) + +;;; ---------- the batch reader has to know the keyword vocabulary ---------- + +(ert-deftest test-agenda-render-normal-custom-keyword-is-parsed () + "Normal: a config keyword is recognised, so it leaves the title. + +The batch writer runs without the editor's init, so it has to set +`org-todo-keywords' itself. When it does not, org stops parsing the headline +as a task at all: DOING and the priority cookie stay glued to the front of the +title and the row reads as having no keyword. That is a wrong answer that +still parses as JSON, which is the worst kind." + (let ((org-todo-keywords cj/org-todo-keywords)) + (test-aq-render--with-agenda-file + "* DOING [#A] Justin Johns advisor projects\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (let ((row (car rows))) + (should (equal "Justin Johns advisor projects" (alist-get 't row))) + (should (equal "DOING" (alist-get 'keyword row))))))) + +(ert-deftest test-agenda-render-boundary-unknown-keyword-stays-in-title () + "Boundary: with stock keywords the same headline degrades visibly. + +Pinning the failure mode, not endorsing it. This is what the surface showed +before the batch writer learned the vocabulary, and it is why the test above +exists." + (let ((org-todo-keywords '((sequence "TODO" "|" "DONE")))) + (test-aq-render--with-agenda-file + "* DOING [#A] Justin Johns advisor projects\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (string-prefix-p "DOING" (alist-get 't (car rows))))))) + +;;; ---------- the cache writer ---------- + +(ert-deftest test-agenda-render-normal-cache-update-writes-today () + "Normal: the cache writer covers three whole local days and creates its dir. + +Yesterday's midnight through tomorrow's day close. A consumer drawing a +rolling window centred on now needs both sides of midnight: with a single +calendar day, the part of its span outside today has nothing to draw, which +late in the evening is half the surface. + +This is the function that actually ships the feature, so it gets its own +coverage rather than riding on the tests for the profile beneath it. The +window assertion is the point: a writer that quietly covered the last hour, +or the next 24 from now, would still produce a plausible-looking file." + (let* ((dir (make-temp-file "agenda-cache-" t)) + ;; A path two levels deep, so directory creation is exercised. + (cj/agenda-render-cache-file + (expand-file-name "settings/agenda.json" dir)) + (org-agenda-files nil) + (windows '())) + (unwind-protect + (cl-letf (((symbol-function 'cj/agenda-render-json) + (lambda (start end &optional out) + (push (cons start end) windows) + (when out (cj/--agenda-query-write-atomically out "[]")) + "[]"))) + (should (equal cj/agenda-render-cache-file + (cj/agenda-render-cache-update))) + (should (file-exists-p cj/agenda-render-cache-file)) + (let* ((window (car windows)) + (start (decode-time (car window))) + (now (decode-time))) + ;; Opens at local midnight... + (should (= 0 (nth 2 start))) + (should (= 0 (nth 1 start))) + (should (= 0 (nth 0 start))) + ;; ...on yesterday, and closes at the end of tomorrow. + (should (= (car window) + (cj/--agenda-query-epoch + 0 0 0 (1- (nth 3 now)) (nth 4 now) (nth 5 now)))) + (should (= (cdr window) + (cj/--agenda-query-day-close + (1+ (nth 3 now)) (nth 4 now) (nth 5 now)))) + ;; Three whole days, give or take an hour at a DST changeover. + (let ((hours (/ (- (cdr window) (car window)) 3600.0))) + (should (>= hours 70.9)) + (should (<= hours 73.1))))) + (delete-directory dir t)))) + +(ert-deftest test-agenda-render-boundary-cache-update-is-idempotent () + "Boundary: writing twice leaves one file and no temp litter." + (let* ((dir (make-temp-file "agenda-cache-" t)) + (cj/agenda-render-cache-file (expand-file-name "agenda.json" dir)) + (org-agenda-files nil)) + (unwind-protect + (progn + (cj/agenda-render-cache-update) + (cj/agenda-render-cache-update) + (should (equal '("agenda.json") + (directory-files + dir nil directory-files-no-dot-files-regexp)))) + (delete-directory dir t)))) + +;;; Error Cases + +(ert-deftest test-agenda-render-error-cache-update-unwritable-parent () + "Error: an unwritable cache location signals rather than failing silently. +A silent failure here looks identical to an empty agenda on the surface." + (let* ((dir (make-temp-file "agenda-cache-ro-" t)) + (cj/agenda-render-cache-file + (expand-file-name "settings/agenda.json" dir)) + (org-agenda-files nil)) + (unwind-protect + (progn + (set-file-modes dir #o500) + (should-error (cj/agenda-render-cache-update))) + (set-file-modes dir #o700) + (delete-directory dir t)))) + +(ert-deftest test-agenda-render-error-bounds-are-still-seconds () + "Error: the render profile takes SECONDS in, even though it emits +milliseconds. The direction of conversion is one-way and the input guards +still apply, so a caller passing milliseconds is told rather than answered." + (let ((org-agenda-files nil) + (ms 1785474000000)) + (should-error (cj/agenda-render-json ms (+ ms 3600000)) :type 'user-error))) + +;;; Back to Normal Cases -- the profile's own writer + +(ert-deftest test-agenda-render-normal-writes-out-path () + "Normal: with an out-path the render profile writes it atomically." + (let* ((dir (make-temp-file "agenda-render-out-" t)) + (out (expand-file-name "agenda.json" dir)) + (org-agenda-files nil)) + (unwind-protect + (progn + (cj/agenda-render-json 1785474000 1785477600 out) + (should (file-exists-p out)) + (with-temp-buffer + (insert-file-contents out) + (should (equal "[]" (buffer-string)))) + (should (zerop (logand (file-modes out) #o111)))) + (delete-directory dir t)))) + +(provide 'test-agenda-query--render) +;;; test-agenda-query--render.el ends here diff --git a/tests/test-agenda-query.el b/tests/test-agenda-query.el new file mode 100644 index 00000000..4b6b0dc1 --- /dev/null +++ b/tests/test-agenda-query.el @@ -0,0 +1,381 @@ +;;; test-agenda-query.el --- Tests for the agenda JSON query -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/--agenda-query-buffer-events', `cj/agenda-window-json' and the +;; atomic writer. +;; +;; The load-bearing test here is the SCHEDULED/DEADLINE one. Org stores +;; planning timestamps as properties on a `planning' element rather than as +;; children in the parse tree, so the obvious implementation -- mapping over +;; \='timestamp -- returns neither, silently. A fixture without a SCHEDULED +;; entry would pass against that broken implementation, so every fixture that +;; matters carries one. +;; +;; Helpers carry a file-unique prefix on purpose: the editor hook loads every +;; agenda-query test file into ONE process, so a shared helper name here would +;; silently redefine its namesake in a sibling file. + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-element) +(require 'org-agenda) +(require 'seq) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'agenda-query) + +(defun test-aq-json--epoch (min hour day month year) + "Return the epoch for local MIN HOUR DAY MONTH YEAR." + (time-convert (encode-time (list 0 min hour day month year nil -1 nil)) + 'integer)) + +(defun test-aq-json--day-window () + "Return the window covering all of 2026-07-31 as a cons." + (cons (test-aq-json--epoch 0 0 31 7 2026) + (test-aq-json--epoch 59 23 31 7 2026))) + +(defmacro test-aq-json--with-org (text &rest body) + "Parse TEXT in an org-mode buffer and run BODY with `events' bound. +`events' holds the rows the buffer contributes for all of 2026-07-31." + (declare (indent 1)) + `(with-temp-buffer + (insert ,text) + (org-mode) + (let* ((window (test-aq-json--day-window)) + (events (cj/--agenda-query-buffer-events + (current-buffer) "/tmp/fixture.org" + (car window) (cdr window)))) + ,@body))) + +(defun test-aq-json--field (event key) + "Return EVENT's KEY, a symbol." + (alist-get key event)) + +(defun test-aq-json--of-type (events type) + "Return the EVENTS whose type is TYPE." + (seq-filter (lambda (e) (equal type (test-aq-json--field e 'type))) events)) + +(defmacro test-aq-json--with-agenda-file (text &rest body) + "Write TEXT to a temp agenda file and run BODY with `file' and `window' bound. +Kills the visited buffer afterwards so the run leaves no state behind." + (declare (indent 1)) + `(let* ((dir (make-temp-file "agenda-query-" t)) + (file (expand-file-name "todo.org" dir)) + (window (test-aq-json--day-window))) + (unwind-protect + (progn + (with-temp-file file (insert ,text)) + (let ((org-agenda-files (list file))) + ,@body)) + (dolist (buffer (buffer-list)) + (when (equal (buffer-file-name buffer) file) (kill-buffer buffer))) + (delete-directory dir t)))) + +;;; ---------- the planning-property trap ---------- + +(ert-deftest test-agenda-query-normal-scheduled-and-deadline-are-found () + "Normal: SCHEDULED and DEADLINE both reach the output. + +These are properties on the planning element, not children in the parse tree. +An implementation that maps over \='timestamp returns the body stamp only and +drops these two silently -- so this asserts they are present, not merely that +the count is right." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00> DEADLINE: <2026-07-31 Fri 17:00>\nBody <2026-07-31 Fri 14:00>\n" + (should (= 1 (length (test-aq-json--of-type events "scheduled")))) + (should (= 1 (length (test-aq-json--of-type events "deadline")))) + (should (= 1 (length (test-aq-json--of-type events "timestamp")))) + (should (equal (test-aq-json--epoch 0 9 31 7 2026) + (test-aq-json--field + (car (test-aq-json--of-type events "scheduled")) 'start))) + (should (equal (test-aq-json--epoch 0 17 31 7 2026) + (test-aq-json--field + (car (test-aq-json--of-type events "deadline")) 'start))))) + +(ert-deftest test-agenda-query-normal-scheduled-alone-is-found () + "Normal: an entry whose only timestamp is SCHEDULED still produces a row. +The positive control for the trap: with no body timestamp to mask it, a broken +implementation returns nothing at all here." + (test-aq-json--with-org + "* TODO Water plants\nSCHEDULED: <2026-07-31 Fri>\n" + (should (= 1 (length events))) + (should (equal "scheduled" (test-aq-json--field (car events) 'type))))) + +;;; ---------- field content ---------- + +(ert-deftest test-agenda-query-normal-title-is-stripped () + "Normal: the title carries no keyword, priority cookie or tags." + (test-aq-json--with-org + "* TODO [#A] Standup with Nerses :work:urgent:\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (equal "Standup with Nerses" + (test-aq-json--field (car events) 'title))))) + +(ert-deftest test-agenda-query-normal-title-renders-org-links () + "Normal: an org link in the title becomes its description text. + +Craig's captured web items carry link syntax in the headline, so this is not +hypothetical -- his live agenda has one today. A wallpaper showing +\"[[https://…][Tracking your habits]]\" is a bug the consumer cannot fix +without parsing org markup." + (test-aq-json--with-org + "* TODO [[https://orgmode.org/x][Tracking your habits]]\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (equal "Tracking your habits" + (test-aq-json--field (car events) 'title)))) + ;; A bare link has no description, so its target is the best available text. + (test-aq-json--with-org + "* TODO [[https://orgmode.org/x]]\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (equal "https://orgmode.org/x" + (test-aq-json--field (car events) 'title))))) + +(ert-deftest test-agenda-query-normal-location-and-organizer () + "Normal: LOCATION and ORGANIZER properties reach the row." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n:PROPERTIES:\n:LOCATION: Room 3\n:ORGANIZER: Nerses\n:END:\n" + (should (equal "Room 3" (test-aq-json--field (car events) 'location))) + (should (equal "Nerses" (test-aq-json--field (car events) 'organizer))))) + +(ert-deftest test-agenda-query-normal-completion-state () + "Normal: a closed entry reports done true and keeps its raw keyword. +Without this a DONE task carrying today's SCHEDULED renders as an upcoming +event, and the error compounds over a working day." + (test-aq-json--with-org + "* DONE Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (eq t (test-aq-json--field (car events) 'done))) + (should (equal "DONE" (test-aq-json--field (car events) 'keyword))))) + +(ert-deftest test-agenda-query-boundary-open-task-is-not-done () + "Boundary: an open task reports done false, not null or missing." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (eq :false (test-aq-json--field (car events) 'done))) + (should (equal "TODO" (test-aq-json--field (car events) 'keyword))))) + +(ert-deftest test-agenda-query-boundary-plain-headline-has-null-keyword () + "Boundary: an entry with no keyword reports null rather than an empty string." + (test-aq-json--with-org + "* Lunch\n<2026-07-31 Fri 12:00-13:00>\n" + (should (eq :null (test-aq-json--field (car events) 'keyword))) + (should (eq :false (test-aq-json--field (car events) 'done))))) + +(ert-deftest test-agenda-query-boundary-repeater-cookie-in-row () + "Boundary: a repeating entry carries its raw cookie so the consumer can mark it." + (test-aq-json--with-org + "* TODO Water plants\nSCHEDULED: <2026-07-01 Wed 09:00 +1d>\n" + (should (= 1 (length events))) + (should (equal "+1d" (test-aq-json--field (car events) 'repeater))) + (should (equal (test-aq-json--epoch 0 9 31 7 2026) + (test-aq-json--field (car events) 'start))))) + +(ert-deftest test-agenda-query-boundary-absent-fields-are-null () + "Boundary: absent optional values are null, so the shape stays stable." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri>\n" + (let ((event (car events))) + (should (eq :null (test-aq-json--field event 'end))) + (should (eq :null (test-aq-json--field event 'location))) + (should (eq :null (test-aq-json--field event 'organizer))) + (should (eq :null (test-aq-json--field event 'repeater))) + (should (eq t (test-aq-json--field event 'all-day)))))) + +;;; ---------- selection ---------- + +(ert-deftest test-agenda-query-boundary-inactive-excluded () + "Boundary: an inactive timestamp never reaches an agenda, so it is excluded." + (test-aq-json--with-org + "* Note\nLogged [2026-07-31 Fri 10:00]\n" + (should-not events))) + +(ert-deftest test-agenda-query-boundary-nested-headlines-not-double-counted () + "Boundary: a child's timestamp belongs to the child alone. +Collecting per-headline by mapping a headline's whole subtree would attribute +each child stamp to every ancestor too." + (test-aq-json--with-org + "* Parent\nSCHEDULED: <2026-07-31 Fri 09:00>\n** Child\nSCHEDULED: <2026-07-31 Fri 11:00>\n" + (should (= 2 (length events))) + (should (equal '("Parent" "Child") + (mapcar (lambda (e) (test-aq-json--field e 'title)) events))))) + +(ert-deftest test-agenda-query-boundary-archived-and-commented-excluded () + "Boundary: archived and commented subtrees are skipped, as org's agenda does. +A query that disagrees with the agenda Craig sees is worse than one returning +less, and both of these are off his agenda." + (test-aq-json--with-org + (concat "* Archived thing :ARCHIVE:\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + "* COMMENT Commented\nSCHEDULED: <2026-07-31 Fri 10:00>\n" + "* Live\nSCHEDULED: <2026-07-31 Fri 11:00>\n") + (should (equal '("Live") + (mapcar (lambda (e) (test-aq-json--field e 'title)) events))))) + +(ert-deftest test-agenda-query-boundary-archive-applies-to-children () + "Boundary: archiving a parent takes its whole subtree off the agenda." + (test-aq-json--with-org + (concat "* Parent :ARCHIVE:\n** Child\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + "* Live\nSCHEDULED: <2026-07-31 Fri 11:00>\n") + (should (equal '("Live") + (mapcar (lambda (e) (test-aq-json--field e 'title)) events))))) + +(ert-deftest test-agenda-query-boundary-outside-window-excluded () + "Boundary: an entry on another day contributes nothing." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-08-15 Sat 09:00>\n" + (should-not events))) + +(ert-deftest test-agenda-query-boundary-empty-buffer () + "Boundary: an empty buffer yields no rows." + (test-aq-json--with-org "" (should-not events))) + +;;; ---------- error cases ---------- + +(ert-deftest test-agenda-query-error-diary-sexp-is-skipped () + "Error: a diary sexp timestamp cannot expand to an instant, and is skipped +without signaling -- one unusable entry must not fail the whole query." + (test-aq-json--with-org + "* Floating\n<%%(diary-float t 3 3)>\n* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (= 1 (length events))) + (should (equal "Standup" (test-aq-json--field (car events) 'title))))) + +(ert-deftest test-agenda-query-error-headline-without-timestamp () + "Error: an entry with no timestamp at all contributes nothing." + (test-aq-json--with-org "* TODO Someday\nJust prose.\n" + (should-not events))) + +;;; ---------- JSON output ---------- + +(ert-deftest test-agenda-query-normal-json-round-trips () + "Normal: the output parses as JSON and preserves the fields. +Booleans arrive as real JSON booleans and absent values as null, so the +consumer can test on them rather than string-matching." + (test-aq-json--with-agenda-file + "* DONE Standup\nSCHEDULED: <2026-07-31 Fri 09:00-09:30>\n" + (let* ((json (cj/agenda-window-json (car window) (cdr window))) + (parsed (json-parse-string json :object-type 'alist))) + (should (= 1 (length parsed))) + (let ((event (aref parsed 0))) + (should (equal "Standup" (alist-get 'title event))) + (should (eq t (alist-get 'done event))) + (should (eq :false (alist-get 'all-day event))) + (should (equal file (alist-get 'file event))) + (should (eq :null (alist-get 'repeater event))) + (should (equal (test-aq-json--epoch 30 9 31 7 2026) + (alist-get 'end event))))))) + +(ert-deftest test-agenda-query-boundary-json-empty-is-array () + "Boundary: an empty result is an empty JSON array, never null. +The consumer parses the same shape whether or not anything is scheduled." + (let ((org-agenda-files nil)) + (should (equal "[]" (cj/agenda-window-json 0 100))))) + +(ert-deftest test-agenda-query-boundary-json-sorted-by-start () + "Boundary: rows come back in start order regardless of file order." + (test-aq-json--with-agenda-file + "* Late\nSCHEDULED: <2026-07-31 Fri 17:00>\n* Early\nSCHEDULED: <2026-07-31 Fri 08:00>\n" + (let ((parsed (json-parse-string + (cj/agenda-window-json (car window) (cdr window)) + :object-type 'alist))) + (should (equal '("Early" "Late") + (mapcar (lambda (e) (alist-get 'title e)) + (append parsed nil))))))) + +(ert-deftest test-agenda-query-error-json-rejects-non-numeric-bounds () + "Error: a non-numeric bound signals rather than returning a wrong answer." + (should-error (cj/agenda-window-json "now" 100) :type 'wrong-type-argument) + (should-error (cj/agenda-window-json 0 nil) :type 'wrong-type-argument)) + +(ert-deftest test-agenda-query-error-rejects-absurdly-wide-window () + "Error: a window wider than the cap signals instead of trying to answer. + +This is the milliseconds-for-seconds mistake, which a JavaScript consumer +makes by passing `Date.now()' straight through. Answering it means building +tens of millions of rows inside the daemon Craig is working in; a renderer +losing one frame is much the cheaper failure." + (let ((org-agenda-files nil) + (now 1785474000)) + (should-error (cj/agenda-window-json now (* now 1000)) :type 'user-error) + ;; A window at the cap is still answered. + (should (equal "[]" (cj/agenda-window-json + now (+ now cj/agenda-query-max-window-seconds)))))) + +(ert-deftest test-agenda-query-error-rejects-millisecond-bounds () + "Error: BOTH bounds in milliseconds is rejected on magnitude. + +This is the likelier shape of the units mistake and the width cap cannot see +it: `Date.now()' and `Date.now() + 3600000' look like a 41-day window, so it +passes the width check and answers with timestamps in the year 58549. A +wrong answer that parses is worse than an error." + (let ((org-agenda-files nil) + (ms 1785474000000)) + (should-error (cj/agenda-window-json ms (+ ms 3600000)) :type 'user-error) + ;; The same instants in seconds are a perfectly ordinary request. + (should (equal "[]" (cj/agenda-window-json 1785474000 1785477600))))) + +;;; ---------- atomic write ---------- + +(ert-deftest test-agenda-query-normal-writes-file-atomically () + "Normal: OUT-PATH receives the JSON and no temp file is left behind." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (out (expand-file-name "agenda.json" dir)) + (org-agenda-files nil)) + (unwind-protect + (progn + (should (equal "[]" (cj/agenda-window-json 0 100 out))) + (should (file-exists-p out)) + (with-temp-buffer + (insert-file-contents out) + (should (equal "[]" (buffer-string)))) + ;; The rename consumed the temp file; only the target remains. + (should (equal '("agenda.json") + (directory-files + dir nil directory-files-no-dot-files-regexp)))) + (delete-directory dir t)))) + +(ert-deftest test-agenda-query-boundary-write-is-readable-by-others () + "Boundary: the written file is not left at the temp file's private 0600. + +`make-temp-file' creates 0600, and the rename carries that mode onto the +target. The whole point of OUT-PATH is that another process reads it, so a +private mode would work only while the reader runs as Craig." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (out (expand-file-name "agenda.json" dir))) + (unwind-protect + (progn + (cj/--agenda-query-write-atomically out "[]") + ;; Readable beyond the owner, following the session umask... + (should (= (logand (file-modes out) #o044) + (logand #o044 (default-file-modes)))) + ;; ...but never executable. `default-file-modes' is 777 minus the + ;; umask, so using it unmasked publishes the JSON as 0755. + ;; No assertion that the mode differs from 0600: under umask 077 + ;; that IS the correct answer, and asserting otherwise would fail + ;; for a reason that has nothing to do with this code. + (should (zerop (logand (file-modes out) #o111)))) + (delete-directory dir t)))) + +(ert-deftest test-agenda-query-boundary-write-replaces-existing () + "Boundary: an existing file is replaced wholesale, not appended to." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (out (expand-file-name "agenda.json" dir))) + (unwind-protect + (progn + (with-temp-file out (insert "stale content that is much longer")) + (cj/--agenda-query-write-atomically out "[]") + (with-temp-buffer + (insert-file-contents out) + (should (equal "[]" (buffer-string))))) + (delete-directory dir t)))) + +(ert-deftest test-agenda-query-error-write-to-missing-dir-preserves-target () + "Error: a write into a nonexistent directory signals and litters nothing." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (missing (expand-file-name "nope/agenda.json" dir))) + (unwind-protect + (progn + (should-error (cj/--agenda-query-write-atomically missing "[]")) + (should-not (file-exists-p missing)) + (should-not (directory-files + dir nil directory-files-no-dot-files-regexp))) + (delete-directory dir t)))) + +(provide 'test-agenda-query) +;;; test-agenda-query.el ends here diff --git a/tests/test-agenda-render-cache.bats b/tests/test-agenda-render-cache.bats new file mode 100644 index 00000000..3e949c16 --- /dev/null +++ b/tests/test-agenda-render-cache.bats @@ -0,0 +1,131 @@ +#!/usr/bin/env bats +# Tests for scripts/agenda-render-cache — the batch writer behind the timer. +# +# The elisp tests cover the query and the row shape. What only a shell test +# can cover is the thing that actually broke: the script runs a batch Emacs +# with -Q, so none of the editor's configuration is loaded, and anything it +# forgets to set up degrades silently rather than erroring. The first version +# wrote a file that parsed fine and was wrong, because org did not know DOING +# was a keyword and left it glued to the front of every title. +# +# Two isolation rules, both learned the hard way: +# +# EMACS_D points at THIS checkout, not $HOME/.emacs.d. Without it the script +# under test runs the installed config's elisp, so a broken tree passes. +# +# AGENDA_RENDER_FILES points at a fixture written here. Asserting over the +# machine's real agenda makes the result depend on what Craig happens to have +# scheduled today: the keyword assertion only bites if some entry carries a +# keyword, and on an empty agenda every all() assertion passes over an empty +# list. The fixture makes the failure mode reachable every run. + +setup() { + SCRIPT="${BATS_TEST_DIRNAME}/../scripts/agenda-render-cache" + export EMACS_D="${BATS_TEST_DIRNAME}/.." + export XDG_CACHE_HOME="${BATS_TEST_TMPDIR}/cache" + OUT="${XDG_CACHE_HOME}/settings/agenda.json" + + FIXTURE="${BATS_TEST_TMPDIR}/fixture.org" + TODAY="$(date +%Y-%m-%d)" + DOW="$(date +%a)" + { + printf '* DOING [#A] Advisor projects\nSCHEDULED: <%s %s 09:00>\n' "$TODAY" "$DOW" + printf '* TODO Standup\nSCHEDULED: <%s %s 10:00-10:15>\n' "$TODAY" "$DOW" + printf '* Lunch\n<%s %s 12:00-13:00>\n' "$TODAY" "$DOW" + printf '* VERIFY [#B] Check the render\nDEADLINE: <%s %s 17:00>\n' "$TODAY" "$DOW" + } > "$FIXTURE" + export AGENDA_RENDER_FILES="$FIXTURE" +} + +# Every assertion below runs through this, so an empty result can never pass +# vacuously — all() over an empty list is true, which is how a writer that +# produced nothing would look like a writer that produced correct rows. +assert_json() { + python3 -c " +import json, sys +rows = json.load(open(sys.argv[1])) +assert isinstance(rows, list), 'not a JSON array' +assert len(rows) == 4, 'expected 4 fixture rows, got %d' % len(rows) +$1 +" "$OUT" +} + +@test "the script is executable" { + [ -x "$SCRIPT" ] +} + +@test "writes a parseable JSON array and creates its directory" { + run "$SCRIPT" + [ "$status" -eq 0 ] + [ -f "$OUT" ] + run assert_json "pass" + [ "$status" -eq 0 ] +} + +@test "every row carries the three keys the renderer reads" { + run "$SCRIPT" + [ "$status" -eq 0 ] + run assert_json " +assert all({'s','e','t'} <= set(r) for r in rows), 'missing s/e/t' +assert all(isinstance(r['s'], int) and isinstance(r['e'], int) for r in rows), 'non-integer instant' +assert all(r['e'] >= r['s'] for r in rows), 'negative duration' +" + [ "$status" -eq 0 ] +} + +@test "instants are milliseconds, not seconds" { + run "$SCRIPT" + [ "$status" -eq 0 ] + # Seconds since 1970 are 10 digits; milliseconds are 13. + run assert_json "assert all(len(str(r['s'])) == 13 for r in rows), 'looks like seconds'" + [ "$status" -eq 0 ] +} + +@test "titles do not carry the TODO keyword vocabulary" { + run "$SCRIPT" + [ "$status" -eq 0 ] + # The regression this file exists for. The fixture carries DOING, TODO and + # VERIFY entries plus two priority cookies, so a script that has not set + # org-todo-keywords fails here every run rather than only on days when + # Craig happens to have such an entry. + run assert_json " +KEYWORDS = {'TODO','PROJECT','DOING','WAITING','VERIFY','STALLED', + 'DELEGATED','FAILED','DONE','CANCELLED'} +bad = [r['t'] for r in rows if r['t'].split(' ')[0] in KEYWORDS] +assert not bad, 'keyword left in title: %r' % bad +cookie = [r['t'] for r in rows if r['t'].startswith('[#')] +assert not cookie, 'priority cookie left in title: %r' % cookie +assert sorted(r['t'] for r in rows) == [ + 'Advisor projects', 'Check the render', 'Lunch', 'Standup'] +" + [ "$status" -eq 0 ] +} + +@test "keyword and completion state survive the batch environment" { + run "$SCRIPT" + [ "$status" -eq 0 ] + run assert_json " +by_title = {r['t']: r for r in rows} +assert by_title['Advisor projects']['keyword'] == 'DOING', by_title['Advisor projects'] +assert by_title['Check the render']['keyword'] == 'VERIFY' +assert by_title['Lunch']['keyword'] is None +assert all(r['done'] is False for r in rows) +assert by_title['Check the render']['type'] == 'deadline' +" + [ "$status" -eq 0 ] +} + +@test "replaces an existing file rather than appending" { + mkdir -p "$(dirname "$OUT")" + printf 'stale garbage that is not json at all\n' > "$OUT" + run "$SCRIPT" + [ "$status" -eq 0 ] + run assert_json "pass" + [ "$status" -eq 0 ] +} + +@test "fails loudly when the config directory is missing" { + run env EMACS_D="${BATS_TEST_TMPDIR}/nonexistent" "$SCRIPT" + [ "$status" -ne 0 ] + [[ "$output" == *"no modules directory"* ]] +} diff --git a/tests/test-ai-term--attached-agent-dirs.el b/tests/test-ai-term--attached-agent-dirs.el new file mode 100644 index 00000000..bdd69544 --- /dev/null +++ b/tests/test-ai-term--attached-agent-dirs.el @@ -0,0 +1,58 @@ +;;; test-ai-term--attached-agent-dirs.el --- Tests for cj/--ai-term-attached-agent-dirs -*- lexical-binding: t; -*- + +;;; Commentary: +;; The queue `cj/ai-term-next-attached' (M-SPC) steps through: project dirs +;; with a live agent BUFFER only -- attached sessions. Unlike +;; `cj/--ai-term-active-agent-dirs', detached tmux sessions with no Emacs +;; buffer are excluded; those are reachable only via `cj/ai-term-next' +;; (M-S-SPC). Candidates / buffers / sessions are mocked so the enumeration +;; logic is exercised without a real tmux server. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-term) + +(ert-deftest test-ai-term--attached-agent-dirs-excludes-detached () + "Normal: only dirs with a live buffer are attached; a detached session is +excluded even though it is active." + (let ((buf (get-buffer-create (cj/--ai-term-buffer-name "/p/alpha")))) + (unwind-protect + (cl-letf (((symbol-function 'cj/--ai-term-candidates) + (lambda (&rest _) '("/p/alpha" "/p/beta" "/p/gamma" "/p/delta"))) + ((symbol-function 'cj/--ai-term-agent-buffers) + (lambda (&rest _) (list buf))) + ((symbol-function 'cj/--ai-term-live-tmux-sessions) + (lambda (&rest _) (list (cj/--ai-term-tmux-session-name "/p/gamma"))))) + ;; alpha attached (buffer), gamma detached (session): only alpha. + (should (equal '("/p/alpha") (cj/--ai-term-attached-agent-dirs)))) + (kill-buffer buf)))) + +(ert-deftest test-ai-term--attached-agent-dirs-multiple-sorted () + "Normal: multiple attached dirs come back sorted by agent buffer name." + (let ((a (get-buffer-create (cj/--ai-term-buffer-name "/p/delta"))) + (b (get-buffer-create (cj/--ai-term-buffer-name "/p/alpha")))) + (unwind-protect + (cl-letf (((symbol-function 'cj/--ai-term-candidates) + (lambda (&rest _) '("/p/alpha" "/p/beta" "/p/delta"))) + ((symbol-function 'cj/--ai-term-agent-buffers) + (lambda (&rest _) (list a b))) + ((symbol-function 'cj/--ai-term-live-tmux-sessions) + (lambda (&rest _) nil))) + (should (equal '("/p/alpha" "/p/delta") (cj/--ai-term-attached-agent-dirs)))) + (kill-buffer a) + (kill-buffer b)))) + +(ert-deftest test-ai-term--attached-agent-dirs-empty-when-only-detached () + "Boundary: sessions exist but no live buffers -> no attached dirs." + (cl-letf (((symbol-function 'cj/--ai-term-candidates) (lambda (&rest _) '("/p/solo"))) + ((symbol-function 'cj/--ai-term-agent-buffers) (lambda (&rest _) nil)) + ((symbol-function 'cj/--ai-term-live-tmux-sessions) + (lambda (&rest _) (list (cj/--ai-term-tmux-session-name "/p/solo"))))) + (should (null (cj/--ai-term-attached-agent-dirs))))) + +(provide 'test-ai-term--attached-agent-dirs) +;;; test-ai-term--attached-agent-dirs.el ends here diff --git a/tests/test-ai-term--buffer-name.el b/tests/test-ai-term--buffer-name.el index b241977d..e728bc82 100644 --- a/tests/test-ai-term--buffer-name.el +++ b/tests/test-ai-term--buffer-name.el @@ -38,5 +38,26 @@ (should (equal (cj/--ai-term-buffer-name "/a/b/c/d/e/leaf") "agent [leaf]"))) +;;; Basename extraction (inverse transform) + +(ert-deftest test-ai-term--buffer-basename-normal-round-trip () + "Normal: extracts the basename embedded in an agent buffer's name." + (let ((buf (get-buffer-create "agent [proj]"))) + (unwind-protect + (should (equal (cj/--ai-term-buffer-basename buf) "proj")) + (kill-buffer buf)))) + +(ert-deftest test-ai-term--buffer-basename-boundary-dotted () + "Boundary: dotted basenames (.emacs.d) survive extraction intact." + (let ((buf (get-buffer-create "agent [.emacs.d]"))) + (unwind-protect + (should (equal (cj/--ai-term-buffer-basename buf) ".emacs.d")) + (kill-buffer buf)))) + +(ert-deftest test-ai-term--buffer-basename-error-non-agent-nil () + "Error: a non-agent buffer yields nil." + (with-temp-buffer + (should (null (cj/--ai-term-buffer-basename (current-buffer)))))) + (provide 'test-ai-term--buffer-name) ;;; test-ai-term--buffer-name.el ends here diff --git a/tests/test-ai-term--close.el b/tests/test-ai-term--close.el index 242bfd74..8b028351 100644 --- a/tests/test-ai-term--close.el +++ b/tests/test-ai-term--close.el @@ -36,8 +36,22 @@ (lambda (&rest _) (error "no tmux")))) (should (null (cj/--ai-term-kill-tmux-session "aiv-foo"))))) +(ert-deftest test-ai-term--close-buffer-session-from-name-after-cd () + "Regression: the session name comes from the immutable buffer name. +ghostel retargets `default-directory' via OSC 7 as the shell cds, so +deriving from it after a cd kills the wrong aiv- session (or misses, +orphaning the agent). The buffer name's basename never changes." + (let ((buf (get-buffer-create "agent [proj]")) + captured-session) + (with-current-buffer buf (setq-local default-directory "/tmp/elsewhere/")) + (cl-letf (((symbol-function 'cj/--ai-term-kill-tmux-session) + (lambda (s) (setq captured-session s) 0))) + (cj/--ai-term-close-buffer buf)) + (should (equal captured-session "aiv-proj")) + (should-not (buffer-live-p buf)))) + (ert-deftest test-ai-term--close-buffer-kills-session-and-buffer () - "Normal: derives the session from default-directory, kills it and the buffer." + "Normal: derives the session from the buffer name, kills it and the buffer." (let ((buf (get-buffer-create "agent [foo]")) captured-session) (with-current-buffer buf (setq-local default-directory "/tmp/foo/")) diff --git a/tests/test-ai-term--keybindings.el b/tests/test-ai-term--keybindings.el index 6f7f53a5..8b1f8fa5 100644 --- a/tests/test-ai-term--keybindings.el +++ b/tests/test-ai-term--keybindings.el @@ -33,14 +33,18 @@ (should (eq (keymap-lookup cj/custom-keymap "a") cj/ai-term-keymap))) (ert-deftest test-ai-term-next-bound-to-meta-space-globally () - "Normal: M-SPC runs `cj/ai-term-next' (the fast swap chord)." - (should (eq (lookup-key (current-global-map) (kbd "M-SPC")) #'cj/ai-term-next))) + "Normal: M-SPC runs `cj/ai-term-next-attached' (cycle attached only) and +M-S-SPC runs `cj/ai-term-next' (cycle all, including detached)." + (should (eq (lookup-key (current-global-map) (kbd "M-SPC")) #'cj/ai-term-next-attached)) + (should (eq (lookup-key (current-global-map) (kbd "M-S-SPC")) #'cj/ai-term-next))) (ert-deftest test-ai-term-meta-space-bound-in-eat-semi-char-mode-map () - "Normal: M-SPC is bound in `eat-semi-char-mode-map' so swap works inside an -agent. EAT forwards unbound keys to the pty, so the bind is what lets it reach -Emacs -- no ghostel-style exception list or rebuild is needed." - (should (eq (keymap-lookup eat-semi-char-mode-map "M-SPC") #'cj/ai-term-next))) + "Normal: both swap chords are bound in `eat-semi-char-mode-map' so they work +inside an agent. EAT forwards unbound keys to the pty, so the bind is what lets +them reach Emacs -- no ghostel-style exception list or rebuild is needed. M-SPC +cycles attached only; M-S-SPC cycles all." + (should (eq (keymap-lookup eat-semi-char-mode-map "M-SPC") #'cj/ai-term-next-attached)) + (should (eq (keymap-lookup eat-semi-char-mode-map "M-S-SPC") #'cj/ai-term-next))) (ert-deftest test-ai-term-f9-family-removed-globally () "Regression: the old F9 family no longer binds the ai-term commands globally." diff --git a/tests/test-ai-term--quit.el b/tests/test-ai-term--quit.el index 55ace81d..64b8a5d4 100644 --- a/tests/test-ai-term--quit.el +++ b/tests/test-ai-term--quit.el @@ -43,6 +43,22 @@ (should-not (buffer-live-p buf))) (when (buffer-live-p buf) (kill-buffer buf))))) +(ert-deftest test-ai-term-quit-nil-project-from-drifted-agent-buffer () + "Regression: nil PROJECT inside an agent buffer keys off the buffer name. +After a cd in the agent shell, ghostel's OSC 7 tracking moves the buffer's +`default-directory' away from the project, so keying off it would kill the +wrong session and miss the buffer." + (let ((buf (get-buffer-create "agent [realproj]")) + (calls nil)) + (unwind-protect + (test-ai-term-quit--with-tmux calls + (with-current-buffer buf + (setq-local default-directory "/tmp/elsewhere/") + (cj/ai-term-quit)) + (should (member '("kill-session" "-t" "aiv-realproj") calls)) + (should-not (buffer-live-p buf))) + (when (buffer-live-p buf) (kill-buffer buf))))) + (ert-deftest test-ai-term-quit-idempotent-when-gone () "Error/Boundary: a second quit (session + buffer already gone) does not error." (let ((calls nil)) diff --git a/tests/test-ai-term--session-threading.el b/tests/test-ai-term--session-threading.el new file mode 100644 index 00000000..984f76d7 --- /dev/null +++ b/tests/test-ai-term--session-threading.el @@ -0,0 +1,40 @@ +;;; test-ai-term--session-threading.el --- Session-list threading tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; The launch path used to call cj/--ai-term-live-tmux-sessions (a tmux +;; subprocess) once in the project picker, again for the launcher's fresh +;; check, and a third time inside show-or-create. One fetch per launch, +;; threaded through, is the contract pinned here. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-term) + +(ert-deftest test-ai-term-launch-fetches-tmux-sessions-once () + "Normal: one tmux session fetch per launch, threaded to the picker and +show-or-create rather than re-spawned by each." + (let ((fetches 0) received-sessions) + (cl-letf (((symbol-function 'cj/--ai-term-live-tmux-sessions) + (lambda () (setq fetches (1+ fetches)) '("other"))) + ((symbol-function 'cj/--ai-term-candidates) + (lambda () '("/tmp/proj/"))) + ((symbol-function 'completing-read) + (lambda (_prompt table &rest _) + (car (all-completions "" table)))) + ((symbol-function 'get-buffer) (lambda (_n) nil)) + ((symbol-function 'cj/--ai-term-pick-runtime) (lambda () 'claude)) + ((symbol-function 'cj/--ai-term-runtime-command) (lambda (_r) "cmd")) + ((symbol-function 'cj/--ai-term-show-or-create) + (lambda (_dir _name _cmd &optional sessions) + (setq received-sessions sessions) + (current-buffer))) + ((symbol-function 'get-buffer-window) (lambda (&rest _) nil))) + (cj/ai-term-pick-project t) + (should (= fetches 1)) + (should (equal received-sessions '("other")))))) + +(provide 'test-ai-term--session-threading) +;;; test-ai-term--session-threading.el ends here diff --git a/tests/test-ai-term--show-or-create.el b/tests/test-ai-term--show-or-create.el index 9574b8a6..64e37653 100644 --- a/tests/test-ai-term--show-or-create.el +++ b/tests/test-ai-term--show-or-create.el @@ -122,7 +122,8 @@ dashboard put and letting the alist place agent into a fresh split. This test stubs `eat' to mimic the same-window side-effect and asserts the originally-selected window still shows its original buffer afterward." (let ((agent-name "agent [preserve-window-test]") - (orig-name "*test-original-buffer*")) + (orig-name "*test-original-buffer*") + (subprocess-calls nil)) (test-ai-term--cleanup agent-name) (when (get-buffer orig-name) (kill-buffer orig-name)) (unwind-protect @@ -138,9 +139,21 @@ originally-selected window still shows its original buffer afterward." (set-window-buffer (selected-window) buf) buf))) ((symbol-function 'cj/--ai-term-send-string) - (lambda (_buf _s) nil))) + (lambda (_buf _s) nil)) + ;; Same hermetic seams the shared macro mocks: no tmux + ;; subprocess for the fresh-session check, no /color timer. + ((symbol-function 'cj/--ai-term-live-tmux-sessions) + (lambda () nil)) + ((symbol-function 'cj/--ai-term-schedule-color) + (lambda (_buffer _color) nil)) + ;; Leak guard: any subprocess attempt is recorded, not run. + ;; `cj/--ai-term-live-tmux-sessions' swallows errors, so a + ;; signaling barrier would pass silently -- record and assert. + ((symbol-function 'process-file) + (lambda (&rest _) (push 'process-file subprocess-calls) -1))) (cj/--ai-term-show-or-create "/tmp/preserve" agent-name) - (should (eq (window-buffer orig-win) orig-buf))))) + (should (eq (window-buffer orig-win) orig-buf)) + (should-not subprocess-calls)))) (test-ai-term--cleanup agent-name) (when (get-buffer orig-name) (kill-buffer orig-name))))) diff --git a/tests/test-auto-dim-config.el b/tests/test-auto-dim-config.el index 12435fa0..8b13fbb0 100644 --- a/tests/test-auto-dim-config.el +++ b/tests/test-auto-dim-config.el @@ -30,11 +30,105 @@ (progn (should (bound-and-true-p auto-dim-other-buffers-mode)) (should (null auto-dim-other-buffers-dim-on-focus-out)) - (should (eq t auto-dim-other-buffers-dim-on-switch-to-minibuffer)) + ;; Config intent only: this asserts the value the module just set, so it + ;; cannot fail even if the fork inverts what the flag MEANS. The two + ;; behavioral tests below are what actually pin the behavior. + (should (null auto-dim-other-buffers-dim-on-switch-to-minibuffer)) (should-not (assq 'fringe auto-dim-other-buffers-affected-faces))) (when (fboundp 'auto-dim-other-buffers-mode) (auto-dim-other-buffers-mode -1)))) +(defmacro test-auto-dim--with-two-windows (win-a win-b &rest body) + "Bind WIN-A and WIN-B to two live windows with the mode on, then run BODY. +Restores the window configuration, the buffers, and the mode's PRIOR state. +Restoring rather than force-disabling matters: `auto-dim-other-buffers-mode' is +global, and switching it off unconditionally left a later test in this file +asserting the mode is on with it off. That only stayed hidden because ERT runs +tests alphabetically and the asserting test sorts first." + (declare (indent 2)) + `(let ((config (current-window-configuration)) + (was-on (bound-and-true-p auto-dim-other-buffers-mode))) + (unwind-protect + (let* ((,win-a (selected-window)) + (,win-b (split-window))) + (set-window-buffer ,win-a (get-buffer-create " *adob-a*")) + (set-window-buffer ,win-b (get-buffer-create " *adob-b*")) + (select-window ,win-a) + (auto-dim-other-buffers-mode 1) + ,@body) + (when (fboundp 'auto-dim-other-buffers-mode) + (auto-dim-other-buffers-mode (if was-on 1 -1))) + (set-window-configuration config) + (dolist (name '(" *adob-a*" " *adob-b*")) + (when (get-buffer name) (kill-buffer name)))))) + +(ert-deftest test-auto-dim-config-minibuffer-entry-leaves-previous-window-lit () + "Normal: with the flag nil, entering the minibuffer leaves the previous window lit. +This is the half that works, and the reason the flag is set to nil. + +Deliberately asserts the composite behavior rather than naming one function. +Selecting the minibuffer fires the mode's own hooks, so the observable outcome is +not attributable to the explicit `adob--update' call alone -- and the observable +outcome is what the setting promises the user. + +The `win-b' assertions are positive controls. Without them this test passes +against an implementation where dimming is broken everywhere, which looks +identical to the implementation being correct." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (test-auto-dim--with-two-windows win-a win-b + (adob--rescan-windows) + (should (null (window-parameter win-a 'adob--dim))) + (should (window-parameter win-b 'adob--dim)) + (select-window (minibuffer-window)) + (adob--update) + (should (null (window-parameter win-a 'adob--dim))) + (should (window-parameter win-b 'adob--dim)))) + +(ert-deftest test-auto-dim-config-minibuffer-entry-dims-when-flag-is-t () + "Boundary: with the flag t, entering the minibuffer DOES dim the previous window. +This is what gives the nil setting meaning. Without it the suite never shows the +flag changing anything, so the config assertion in +`test-auto-dim-config-applies-settings' has nothing standing behind it." + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (test-auto-dim--with-two-windows win-a win-b + (let ((auto-dim-other-buffers-dim-on-switch-to-minibuffer t)) + (adob--rescan-windows) + (should (null (window-parameter win-a 'adob--dim))) + (select-window (minibuffer-window)) + (adob--update) + (should (window-parameter win-a 'adob--dim))))) + +(ert-deftest test-auto-dim-config-rescan-ignores-the-minibuffer-flag () + "Error: `adob--rescan-windows' dims everything on a minibuffer selection. +Known defect in the fork, pinned here rather than left undocumented. The +rescan is on `window-configuration-change-hook' and dims by window identity +alone -- and `(window-list nil \\='n)' excludes the minibuffer, so when the +minibuffer is selected nothing matches and every window dims. A completion +popup is the everyday case: `adob--update' honours the flag, this does not. + +Expected to fail until the fork honours the flag in the rescan too. When it +starts passing, ERT reports an unexpected pass -- that is the signal to drop +this test and stop treating the gap as open. + +The `win-b' positive control is load-bearing here. Three different broken +implementations -- dimming disabled everywhere, the rescan never setting the +parameter, `adob--update' made a no-op -- all produce an unexpected pass that +would otherwise read as \"the fork fixed it\". Asserting that `win-b' is still +dimmed separates a real fix from dimming having broken." + :expected-result :failed + (skip-unless (file-directory-p test-auto-dim--fork)) + (require 'auto-dim-config) + (test-auto-dim--with-two-windows win-a win-b + (adob--rescan-windows) + (should (null (window-parameter win-a 'adob--dim))) + (should (window-parameter win-b 'adob--dim)) + (select-window (minibuffer-window)) + (adob--rescan-windows) + (should (window-parameter win-b 'adob--dim)) + (should (null (window-parameter win-a 'adob--dim))))) + (defconst test-auto-dim--flat-dimmed-org-faces (append (mapcar (lambda (n) (intern (format "org-level-%d" n))) (number-sequence 1 8)) diff --git a/tests/test-browser-config--preferred-default.el b/tests/test-browser-config--preferred-default.el new file mode 100644 index 00000000..113ad540 --- /dev/null +++ b/tests/test-browser-config--preferred-default.el @@ -0,0 +1,89 @@ +;;; test-browser-config--preferred-default.el --- Tests for the first-run browser pick -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/--preferred-default-browser, the pure helper that picks +;; the first-run default when no saved choice exists. +;; +;; The behavior it fixes: EWW is listed first in `cj/browser-definitions' and +;; carries a nil executable, so `cj/discover-browsers' always reports it as +;; available and it sorted first. A fresh machine therefore opened every org +;; link in the Emacs text browser until the user found cj/choose-browser, even +;; with Chrome or Firefox installed. The helper prefers a real external +;; browser and keeps EWW as the genuine last resort. +;; +;; The helper takes the discovered list as an argument rather than calling +;; `cj/discover-browsers' itself, so these tests drive real data structures +;; and never stub executable-find. +;; +;; Test organization: +;; - Normal Cases: external browser preferred over a leading built-in +;; - Boundary Cases: only built-ins, only externals, single entry, empty list +;; - Error Cases: entries missing the :executable key +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'browser-config) + +(defconst test-browser--eww + '(:executable nil :function eww-browse-url :name "EWW (Emacs Browser)" + :path nil :program-var nil)) + +(defconst test-browser--chrome + '(:executable "google-chrome" :function browse-url-chrome :name "Google Chrome" + :path "/usr/bin/google-chrome" :program-var browse-url-chrome-program)) + +(defconst test-browser--firefox + '(:executable "firefox" :function browse-url-firefox :name "Firefox" + :path "/usr/bin/firefox" :program-var browse-url-firefox-program)) + +;;; Normal Cases + +(ert-deftest test-browser-config-preferred-default-skips-leading-builtin () + "Normal: an installed external browser wins over a built-in listed first." + (should (equal (cj/--preferred-default-browser + (list test-browser--eww test-browser--chrome)) + test-browser--chrome))) + +(ert-deftest test-browser-config-preferred-default-keeps-external-order () + "Normal: the FIRST external in list order wins, not merely any external." + (should (equal (cj/--preferred-default-browser + (list test-browser--eww test-browser--chrome test-browser--firefox)) + test-browser--chrome))) + +;;; Boundary Cases + +(ert-deftest test-browser-config-preferred-default-builtin-only-falls-back () + "Boundary: with no external installed, the built-in is still chosen." + (should (equal (cj/--preferred-default-browser (list test-browser--eww)) + test-browser--eww))) + +(ert-deftest test-browser-config-preferred-default-external-only () + "Boundary: a list of externals returns the first one." + (should (equal (cj/--preferred-default-browser + (list test-browser--firefox test-browser--chrome)) + test-browser--firefox))) + +(ert-deftest test-browser-config-preferred-default-empty-list-is-nil () + "Boundary: an empty discovery result yields nil, never an error." + (should (null (cj/--preferred-default-browser '())))) + +(ert-deftest test-browser-config-preferred-default-single-builtin () + "Boundary: a one-element built-in list returns that element." + (should (equal (cj/--preferred-default-browser (list test-browser--eww)) + test-browser--eww))) + +;;; Error Cases + +(ert-deftest test-browser-config-preferred-default-missing-executable-key () + "Error: a plist with no :executable key counts as built-in, not a crash." + (let ((malformed '(:name "Odd" :function ignore))) + (should (equal (cj/--preferred-default-browser + (list malformed test-browser--chrome)) + test-browser--chrome)) + (should (equal (cj/--preferred-default-browser (list malformed)) + malformed)))) + +(provide 'test-browser-config--preferred-default) +;;; test-browser-config--preferred-default.el ends here diff --git a/tests/test-calendar-sync--apply-recurrence-exceptions.el b/tests/test-calendar-sync--apply-recurrence-exceptions.el index 7711c5cb..999296fb 100644 --- a/tests/test-calendar-sync--apply-recurrence-exceptions.el +++ b/tests/test-calendar-sync--apply-recurrence-exceptions.el @@ -153,5 +153,36 @@ NEW-* values are the rescheduled time." (and (= 1 (length result)) (= 9 (nth 3 (plist-get (car result) :start))))))))) +;;; STATUS:CANCELLED Cases + +(ert-deftest test-calendar-sync--apply-recurrence-exceptions-normal-cancelled-removes () + "Normal: a cancelled exception removes its occurrence instead of overriding it." + (let* ((occurrences (list (test-make-occurrence 2026 2 3 9 0 "Weekly Meeting") + (test-make-occurrence 2026 2 10 9 0 "Weekly Meeting") + (test-make-occurrence 2026 2 17 9 0 "Weekly Meeting"))) + (exceptions (make-hash-table :test 'equal))) + ;; Feb 10 is cancelled. + (puthash "test-event@google.com" + (list (append (test-make-exception-data 2026 2 10 9 0 2026 2 10 9 0) + '(:cancelled t))) + exceptions) + (let ((result (calendar-sync--apply-recurrence-exceptions occurrences exceptions))) + (should (= 2 (length result))) + ;; Feb 3 and Feb 17 remain; Feb 10 is gone. + (should (equal '(3 17) + (mapcar (lambda (occ) (nth 2 (plist-get occ :start))) result)))))) + +(ert-deftest test-calendar-sync--apply-recurrence-exceptions-boundary-cancelled-no-match-keeps-all () + "Boundary: a cancelled exception that matches nothing removes nothing." + (let* ((occurrences (list (test-make-occurrence 2026 2 3 9 0 "Weekly Meeting"))) + (exceptions (make-hash-table :test 'equal))) + ;; Cancelled exception targets a different date. + (puthash "test-event@google.com" + (list (append (test-make-exception-data 2026 3 3 9 0 2026 3 3 9 0) + '(:cancelled t))) + exceptions) + (let ((result (calendar-sync--apply-recurrence-exceptions occurrences exceptions))) + (should (= 1 (length result)))))) + (provide 'test-calendar-sync--apply-recurrence-exceptions) ;;; test-calendar-sync--apply-recurrence-exceptions.el ends here diff --git a/tests/test-calendar-sync--expand-monthly.el b/tests/test-calendar-sync--expand-monthly.el index 3dc1f2dc..e9fae901 100644 --- a/tests/test-calendar-sync--expand-monthly.el +++ b/tests/test-calendar-sync--expand-monthly.el @@ -14,9 +14,12 @@ ;;; Normal Cases (ert-deftest test-calendar-sync--expand-monthly-normal-generates-occurrences () - "Test expanding monthly event generates occurrences within range." - (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) - (end-date (test-calendar-sync-time-days-from-now 1 11 0)) + "Test expanding monthly event generates occurrences within range. +Anchored on a day every month has: a series on the 29th, 30th, or 31st +correctly skips the months lacking that day, which is fewer than one per month +and not what this assertion is about." + (let* ((start-date (test-calendar-sync-time-monthly-anchor 10 0)) + (end-date (test-calendar-sync-time-monthly-anchor 11 0)) (base-event (list :summary "Monthly Review" :start start-date :end end-date)) @@ -28,9 +31,13 @@ (should (< (length occurrences) 20)))) (ert-deftest test-calendar-sync--expand-monthly-normal-preserves-day-of-month () - "Test that each occurrence falls on the same day of month." - (let* ((start-date (test-calendar-sync-time-days-from-now 5 10 0)) - (end-date (test-calendar-sync-time-days-from-now 5 11 0)) + "Test that each occurrence falls on the same day of month. +Anchored on a day every month has, so the assertion below can be an equality. +It used to be `<=' against an anchor whose day varied with the run date, which a +skipped month satisfies without ever landing on the right day -- the assertion +held even when the series was wrong." + (let* ((start-date (test-calendar-sync-time-monthly-anchor 10 0)) + (end-date (test-calendar-sync-time-monthly-anchor 11 0)) (expected-day (nth 2 start-date)) (base-event (list :summary "Monthly" :start start-date @@ -39,15 +46,15 @@ (range (test-calendar-sync-wide-range)) (occurrences (calendar-sync--expand-monthly base-event rrule range))) (should (> (length occurrences) 0)) - ;; Day of month should be consistent (may clamp for short months) + ;; Every occurrence lands on the anchor day, exactly. (dolist (occ occurrences) (let ((day (nth 2 (plist-get occ :start)))) - (should (<= day expected-day)))))) + (should (= day expected-day)))))) (ert-deftest test-calendar-sync--expand-monthly-normal-interval-two () "Test expanding bi-monthly event." - (let* ((start-date (test-calendar-sync-time-days-from-now 1 9 0)) - (end-date (test-calendar-sync-time-days-from-now 1 10 0)) + (let* ((start-date (test-calendar-sync-time-monthly-anchor 9 0)) + (end-date (test-calendar-sync-time-monthly-anchor 10 0)) (base-event (list :summary "Bi-Monthly" :start start-date :end end-date)) @@ -170,5 +177,124 @@ (occurrences (calendar-sync--expand-monthly base-event rrule range))) (should (= (length occurrences) 3)))) +;;; BYDAY (nth weekday) Cases +;; +;; Fixed dates are deterministic here: the expansion range is an explicit +;; parameter, not derived from the current time, so these never age out. + +(defun test-calendar-sync--expand-monthly-range-2026 () + "Fixed expansion range covering calendar year 2026." + (list (encode-time 0 0 0 1 1 2026) (encode-time 0 0 0 31 12 2026))) + +(ert-deftest test-calendar-sync--expand-monthly-byday-second-wednesday () + "Normal: BYDAY=2WE lands on the 2nd Wednesday of each month, not the +day-of-month of DTSTART. This is the live Craig/Ryan series shape." + (let* ((base-event (list :summary "2nd Wednesday" + :start '(2026 1 14 10 0) + :end '(2026 1 14 11 0))) + (rrule (list :freq 'monthly :interval 1 :byday '("2WE"))) + (range (test-calendar-sync--expand-monthly-range-2026)) + (occurrences (calendar-sync--expand-monthly base-event rrule range)) + (days (mapcar (lambda (occ) + (let ((s (plist-get occ :start))) + (list (nth 1 s) (nth 2 s)))) + occurrences))) + (should (equal days '((1 14) (2 11) (3 11) (4 8) (5 13) (6 10) + (7 8) (8 12) (9 9) (10 14) (11 11) (12 9)))) + ;; Every occurrence is a Wednesday (weekday 3), never a fixed day-of-month. + (dolist (occ occurrences) + (let ((s (plist-get occ :start))) + (should (= 3 (calendar-sync--date-weekday + (list (nth 0 s) (nth 1 s) (nth 2 s))))))))) + +(ert-deftest test-calendar-sync--expand-monthly-byday-last-tuesday () + "Normal: BYDAY=-1TU lands on the last Tuesday of each month." + (let* ((base-event (list :summary "Last Tuesday" + :start '(2026 1 27 9 0) + :end '(2026 1 27 10 0))) + (rrule (list :freq 'monthly :interval 1 :byday '("-1TU") :count 3)) + (range (test-calendar-sync--expand-monthly-range-2026)) + (occurrences (calendar-sync--expand-monthly base-event rrule range)) + (days (mapcar (lambda (occ) + (let ((s (plist-get occ :start))) + (list (nth 1 s) (nth 2 s)))) + occurrences))) + (should (equal days '((1 27) (2 24) (3 31)))))) + +(ert-deftest test-calendar-sync--expand-monthly-byday-bysetpos-second-sunday () + "Normal: BYDAY=SU with BYSETPOS=2 lands on the 2nd Sunday (Proton shape)." + (let* ((base-event (list :summary "2nd Sunday" + :start '(2026 1 11 8 0) + :end '(2026 1 11 9 0))) + (rrule (list :freq 'monthly :interval 1 :byday '("SU") :bysetpos 2 :count 3)) + (range (test-calendar-sync--expand-monthly-range-2026)) + (occurrences (calendar-sync--expand-monthly base-event rrule range)) + (days (mapcar (lambda (occ) + (let ((s (plist-get occ :start))) + (list (nth 1 s) (nth 2 s)))) + occurrences))) + (should (equal days '((1 11) (2 8) (3 8)))))) + +(ert-deftest test-calendar-sync--expand-monthly-byday-until-inclusive-and-reached () + "Boundary: with BYDAY, UNTIL is inclusive and the series reaches it. +Upper bound alone can't catch a dropped final occurrence -- assert both." + (let* ((base-event (list :summary "Bounded" + :start '(2026 1 14 10 0) + :end '(2026 1 14 11 0))) + (rrule (list :freq 'monthly :interval 1 :byday '("2WE") + :until '(2026 5 13))) + (range (test-calendar-sync--expand-monthly-range-2026)) + (occurrences (calendar-sync--expand-monthly base-event rrule range)) + (last-start (plist-get (car (last occurrences)) :start))) + (should (= (length occurrences) 5)) + ;; Reach: the occurrence landing exactly on UNTIL is kept. + (should (equal (list (nth 0 last-start) (nth 1 last-start) (nth 2 last-start)) + '(2026 5 13))))) + +(ert-deftest test-calendar-sync--expand-monthly-byday-count-limits () + "Boundary: COUNT caps a BYDAY series." + (let* ((base-event (list :summary "Counted" + :start '(2026 1 14 10 0) + :end '(2026 1 14 11 0))) + (rrule (list :freq 'monthly :interval 1 :byday '("2WE") :count 4)) + (range (test-calendar-sync--expand-monthly-range-2026)) + (occurrences (calendar-sync--expand-monthly base-event rrule range))) + (should (= (length occurrences) 4)))) + +(ert-deftest test-calendar-sync--expand-monthly-byday-fifth-weekday-skips-short-months () + "Boundary: BYDAY=5WE only lands in months that have a 5th Wednesday." + (let* ((base-event (list :summary "5th Wednesday" + :start '(2026 4 29 10 0) + :end '(2026 4 29 11 0))) + (rrule (list :freq 'monthly :interval 1 :byday '("5WE"))) + (range (test-calendar-sync--expand-monthly-range-2026)) + (occurrences (calendar-sync--expand-monthly base-event rrule range)) + (days (mapcar (lambda (occ) + (let ((s (plist-get occ :start))) + (list (nth 1 s) (nth 2 s)))) + occurrences))) + ;; 2026 months (Apr on) with a 5th Wednesday: Apr 29, Jul 29, Sep 30, Dec 30. + (should (equal days '((4 29) (7 29) (9 30) (12 30)))))) + +(ert-deftest test-calendar-sync--expand-monthly-on-31st-skips-short-months () + "Boundary: a plain monthly rule on the 31st skips months without a 31st. +The stepper kept day-of-month verbatim, so Jan 31 stepped to Feb 31, +which encode-time normalizes to Mar 3 -- phantom mis-dated occurrences +instead of the RFC 5545 skip." + (let* ((base-event (list :summary "Monthly on the 31st" + :start '(2030 1 31 10 0) + :end '(2030 1 31 11 0))) + (rrule (list :freq 'monthly :interval 1)) + ;; End the range past Dec 31: the range end is midnight, so ending + ;; ON the 31st would exclude that day's 10:00 occurrence. + (range (list (calendar-sync--date-to-time '(2030 1 1)) + (calendar-sync--date-to-time '(2031 1 1)))) + (occurrences (calendar-sync--expand-monthly base-event rrule range)) + (months (mapcar (lambda (o) (nth 1 (plist-get o :start))) occurrences)) + (days (mapcar (lambda (o) (nth 2 (plist-get o :start))) occurrences))) + ;; Only the seven 31-day months of 2030, each on the 31st. + (should (equal months '(1 3 5 7 8 10 12))) + (should (equal days '(31 31 31 31 31 31 31))))) + (provide 'test-calendar-sync--expand-monthly) ;;; test-calendar-sync--expand-monthly.el ends here diff --git a/tests/test-calendar-sync--expand-yearly.el b/tests/test-calendar-sync--expand-yearly.el index ad9b8f27..c636e54a 100644 --- a/tests/test-calendar-sync--expand-yearly.el +++ b/tests/test-calendar-sync--expand-yearly.el @@ -175,5 +175,31 @@ (occurrences (calendar-sync--expand-yearly base-event rrule range))) (should (= (length occurrences) 2)))) +;;; BYMONTH + BYDAY (nth weekday) Cases +;; +;; Fixed dates are deterministic here: the expansion range is an explicit +;; parameter, not derived from the current time. + +(ert-deftest test-calendar-sync--expand-yearly-bymonth-byday-nth-weekday () + "Normal: FREQ=YEARLY;BYMONTH=3;BYDAY=2SU tracks the 2nd Sunday of March +each year (the DST clock-change shape), not DTSTART's calendar date." + (let* ((base-event (list :summary "Clocks change" + :start '(2026 3 8 2 0) + :end '(2026 3 8 3 0))) + (rrule (list :freq 'yearly :interval 1 :bymonth 3 :byday '("2SU"))) + (range (list (encode-time 0 0 0 1 1 2026) + (encode-time 0 0 0 31 12 2027))) + (occurrences (calendar-sync--expand-yearly base-event rrule range)) + (days (mapcar (lambda (occ) + (let ((s (plist-get occ :start))) + (list (nth 0 s) (nth 1 s) (nth 2 s)))) + occurrences))) + ;; 2nd Sunday of March: 2026-03-08, 2027-03-14 -- different day-of-month. + (should (equal days '((2026 3 8) (2027 3 14)))) + (dolist (occ occurrences) + (let ((s (plist-get occ :start))) + (should (= 7 (calendar-sync--date-weekday + (list (nth 0 s) (nth 1 s) (nth 2 s))))))))) + (provide 'test-calendar-sync--expand-yearly) ;;; test-calendar-sync--expand-yearly.el ends here diff --git a/tests/test-calendar-sync--nth-weekday-of-month.el b/tests/test-calendar-sync--nth-weekday-of-month.el new file mode 100644 index 00000000..afb0bd35 --- /dev/null +++ b/tests/test-calendar-sync--nth-weekday-of-month.el @@ -0,0 +1,67 @@ +;;; test-calendar-sync--nth-weekday-of-month.el --- Tests for calendar-sync--nth-weekday-of-month -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the nth-weekday-of-month helper backing monthly/yearly BYDAY +;; expansion. Fixed dates are safe here: the function is pure calendar +;; arithmetic with no relation to the current time. + +;;; Code: + +(require 'ert) +(require 'calendar-sync) + +;;; Normal Cases + +(ert-deftest test-calendar-sync--nth-weekday-of-month-normal-second-wednesday () + "Normal: 2nd Wednesday of Jan 2026 is the 14th." + ;; Jan 2026: Jan 1 is a Thursday; Wednesdays fall on 7, 14, 21, 28. + (should (= (calendar-sync--nth-weekday-of-month 2026 1 3 2) 14))) + +(ert-deftest test-calendar-sync--nth-weekday-of-month-normal-first-monday () + "Normal: 1st Monday of Feb 2026 is the 2nd." + ;; Feb 2026: Feb 1 is a Sunday; Mondays fall on 2, 9, 16, 23. + (should (= (calendar-sync--nth-weekday-of-month 2026 2 1 1) 2))) + +(ert-deftest test-calendar-sync--nth-weekday-of-month-normal-last-tuesday () + "Normal: last Tuesday of Mar 2026 is the 31st (negative ordinal)." + ;; Mar 2026: Tuesdays fall on 3, 10, 17, 24, 31. + (should (= (calendar-sync--nth-weekday-of-month 2026 3 2 -1) 31))) + +(ert-deftest test-calendar-sync--nth-weekday-of-month-normal-second-to-last-friday () + "Normal: -2 ordinal picks the second-to-last Friday." + ;; May 2026: Fridays fall on 1, 8, 15, 22, 29. + (should (= (calendar-sync--nth-weekday-of-month 2026 5 5 -2) 22))) + +;;; Boundary Cases + +(ert-deftest test-calendar-sync--nth-weekday-of-month-boundary-fifth-occurrence-exists () + "Boundary: 5th Friday exists in May 2026." + (should (= (calendar-sync--nth-weekday-of-month 2026 5 5 5) 29))) + +(ert-deftest test-calendar-sync--nth-weekday-of-month-boundary-fifth-occurrence-missing () + "Boundary: 5th Wednesday of Feb 2026 does not exist -- returns nil." + ;; Feb 2026 has four Wednesdays (4, 11, 18, 25). + (should (null (calendar-sync--nth-weekday-of-month 2026 2 3 5)))) + +(ert-deftest test-calendar-sync--nth-weekday-of-month-boundary-first-day-is-target () + "Boundary: the 1st of the month itself is the 1st occurrence." + ;; Apr 2026: Apr 1 is a Wednesday. + (should (= (calendar-sync--nth-weekday-of-month 2026 4 3 1) 1))) + +(ert-deftest test-calendar-sync--nth-weekday-of-month-boundary-leap-february () + "Boundary: leap-year February (2028) handled -- last Tuesday is the 29th." + ;; Feb 2028: Feb 29 exists and is a Tuesday. + (should (= (calendar-sync--nth-weekday-of-month 2028 2 2 -1) 29))) + +;;; Error Cases + +(ert-deftest test-calendar-sync--nth-weekday-of-month-error-zero-ordinal-nil () + "Error: ordinal 0 is meaningless -- returns nil." + (should (null (calendar-sync--nth-weekday-of-month 2026 1 3 0)))) + +(ert-deftest test-calendar-sync--nth-weekday-of-month-error-out-of-range-negative-nil () + "Error: -6th occurrence never exists in a month -- returns nil." + (should (null (calendar-sync--nth-weekday-of-month 2026 1 3 -6)))) + +(provide 'test-calendar-sync--nth-weekday-of-month) +;;; test-calendar-sync--nth-weekday-of-month.el ends here diff --git a/tests/test-calendar-sync--parse-byday-entry.el b/tests/test-calendar-sync--parse-byday-entry.el new file mode 100644 index 00000000..4a9b4ef5 --- /dev/null +++ b/tests/test-calendar-sync--parse-byday-entry.el @@ -0,0 +1,41 @@ +;;; test-calendar-sync--parse-byday-entry.el --- Tests for calendar-sync--parse-byday-entry -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for parsing a single RRULE BYDAY entry ("2WE", "-1TU", "SU") into +;; an (ordinal . weekday-number) cons. Ordinal is nil for a bare weekday. + +;;; Code: + +(require 'ert) +(require 'calendar-sync) + +;;; Normal Cases + +(ert-deftest test-calendar-sync--parse-byday-entry-normal-positive-ordinal () + "Normal: \"2WE\" parses to ordinal 2, Wednesday (3)." + (should (equal (calendar-sync--parse-byday-entry "2WE") '(2 . 3)))) + +(ert-deftest test-calendar-sync--parse-byday-entry-normal-negative-ordinal () + "Normal: \"-1TU\" parses to ordinal -1, Tuesday (2)." + (should (equal (calendar-sync--parse-byday-entry "-1TU") '(-1 . 2)))) + +(ert-deftest test-calendar-sync--parse-byday-entry-normal-bare-weekday () + "Normal: \"SU\" parses to nil ordinal, Sunday (7)." + (should (equal (calendar-sync--parse-byday-entry "SU") '(nil . 7)))) + +;;; Boundary Cases + +(ert-deftest test-calendar-sync--parse-byday-entry-boundary-double-digit-ordinal () + "Boundary: \"53MO\" (yearly-scale ordinal) parses without truncation." + (should (equal (calendar-sync--parse-byday-entry "53MO") '(53 . 1)))) + +;;; Error Cases + +(ert-deftest test-calendar-sync--parse-byday-entry-error-garbage-nil () + "Error: an unrecognizable entry returns nil." + (should (null (calendar-sync--parse-byday-entry "XX"))) + (should (null (calendar-sync--parse-byday-entry ""))) + (should (null (calendar-sync--parse-byday-entry nil)))) + +(provide 'test-calendar-sync--parse-byday-entry) +;;; test-calendar-sync--parse-byday-entry.el ends here diff --git a/tests/test-calendar-sync--parse-event.el b/tests/test-calendar-sync--parse-event.el index 9c343db2..b3f58ba2 100644 --- a/tests/test-calendar-sync--parse-event.el +++ b/tests/test-calendar-sync--parse-event.el @@ -78,5 +78,37 @@ (let ((vevent "BEGIN:VEVENT\nSUMMARY:Orphan\nEND:VEVENT")) (should (null (calendar-sync--parse-event vevent))))) +;;; STATUS:CANCELLED Cases + +(ert-deftest test-calendar-sync--parse-event-error-cancelled-returns-nil () + "Error: a STATUS:CANCELLED event returns nil -- cancelled events don't render." + (let* ((start (test-calendar-sync-time-days-from-now 5 14 0)) + (vevent (concat "BEGIN:VEVENT\n" + "SUMMARY:Cancelled Meeting\n" + "DTSTART:" (test-calendar-sync-ics-datetime start) "\n" + "STATUS:CANCELLED\n" + "END:VEVENT"))) + (should (null (calendar-sync--parse-event vevent))))) + +(ert-deftest test-calendar-sync--parse-event-boundary-cancelled-case-insensitive () + "Boundary: STATUS value matching is case-insensitive." + (let* ((start (test-calendar-sync-time-days-from-now 5 14 0)) + (vevent (concat "BEGIN:VEVENT\n" + "SUMMARY:Cancelled Meeting\n" + "DTSTART:" (test-calendar-sync-ics-datetime start) "\n" + "STATUS:Cancelled\n" + "END:VEVENT"))) + (should (null (calendar-sync--parse-event vevent))))) + +(ert-deftest test-calendar-sync--parse-event-normal-confirmed-still-parses () + "Normal: STATUS:CONFIRMED events still parse." + (let* ((start (test-calendar-sync-time-days-from-now 5 14 0)) + (vevent (concat "BEGIN:VEVENT\n" + "SUMMARY:Confirmed Meeting\n" + "DTSTART:" (test-calendar-sync-ics-datetime start) "\n" + "STATUS:CONFIRMED\n" + "END:VEVENT"))) + (should (calendar-sync--parse-event vevent)))) + (provide 'test-calendar-sync--parse-event) ;;; test-calendar-sync--parse-event.el ends here diff --git a/tests/test-calendar-sync--parse-exception-event.el b/tests/test-calendar-sync--parse-exception-event.el index a26a7418..1c9411f3 100644 --- a/tests/test-calendar-sync--parse-exception-event.el +++ b/tests/test-calendar-sync--parse-exception-event.el @@ -82,5 +82,33 @@ than a half-built plist." "END:VEVENT"))) (should-not (calendar-sync--parse-exception-event event)))) +;;; STATUS:CANCELLED Cases + +(ert-deftest test-calendar-sync--parse-exception-event-normal-cancelled-flag () + "Normal: a STATUS:CANCELLED override carries :cancelled t, so the +matching occurrence can be removed rather than overridden." + (let* ((start (test-calendar-sync-time-days-from-now 7 10 0)) + (end (test-calendar-sync-time-days-from-now 7 11 0)) + (event (concat "BEGIN:VEVENT\n" + "UID:override@google.com\n" + "RECURRENCE-ID:20260203T090000Z\n" + "SUMMARY:Craig / Ryan\n" + "STATUS:CANCELLED\n" + "DTSTART:" (test-calendar-sync-ics-datetime start) "\n" + "DTEND:" (test-calendar-sync-ics-datetime end) "\n" + "END:VEVENT")) + (plist (calendar-sync--parse-exception-event event))) + (should plist) + (should (plist-get plist :cancelled)))) + +(ert-deftest test-calendar-sync--parse-exception-event-boundary-no-status-not-cancelled () + "Boundary: an override without STATUS is not cancelled." + (let* ((start (test-calendar-sync-time-days-from-now 7 10 0)) + (end (test-calendar-sync-time-days-from-now 7 11 0)) + (plist (calendar-sync--parse-exception-event + (test-cs-parse-exc--override-event start end)))) + (should plist) + (should-not (plist-get plist :cancelled)))) + (provide 'test-calendar-sync--parse-exception-event) ;;; test-calendar-sync--parse-exception-event.el ends here diff --git a/tests/test-calendar-sync--parse-rrule.el b/tests/test-calendar-sync--parse-rrule.el index 099e4e44..2668c1ac 100644 --- a/tests/test-calendar-sync--parse-rrule.el +++ b/tests/test-calendar-sync--parse-rrule.el @@ -206,5 +206,26 @@ (should (= (plist-get result :count) 10))) (test-calendar-sync--parse-rrule-teardown))) +;;; BYSETPOS / BYMONTH Cases + +(ert-deftest test-calendar-sync--parse-rrule-normal-bysetpos-returns-number () + "Normal: BYSETPOS parses to a number (Proton emits BYDAY=SU;BYSETPOS=2)." + (let ((result (calendar-sync--parse-rrule "FREQ=MONTHLY;BYDAY=SU;BYSETPOS=2"))) + (should (eq (plist-get result :freq) 'monthly)) + (should (equal (plist-get result :byday) '("SU"))) + (should (= (plist-get result :bysetpos) 2)))) + +(ert-deftest test-calendar-sync--parse-rrule-normal-bymonth-returns-number () + "Normal: BYMONTH parses to a number (yearly nth-weekday rules carry it)." + (let ((result (calendar-sync--parse-rrule "FREQ=YEARLY;BYMONTH=3;BYDAY=2SU"))) + (should (eq (plist-get result :freq) 'yearly)) + (should (= (plist-get result :bymonth) 3)) + (should (equal (plist-get result :byday) '("2SU"))))) + +(ert-deftest test-calendar-sync--parse-rrule-boundary-negative-bysetpos () + "Boundary: negative BYSETPOS (last matching day) parses." + (let ((result (calendar-sync--parse-rrule "FREQ=MONTHLY;BYDAY=FR;BYSETPOS=-1"))) + (should (= (plist-get result :bysetpos) -1)))) + (provide 'test-calendar-sync--parse-rrule) ;;; test-calendar-sync--parse-rrule.el ends here diff --git a/tests/test-calendar-sync--syncing-p.el b/tests/test-calendar-sync--syncing-p.el index b346bf77..df8bcd52 100644 --- a/tests/test-calendar-sync--syncing-p.el +++ b/tests/test-calendar-sync--syncing-p.el @@ -4,81 +4,111 @@ ;; Unit tests for `calendar-sync--syncing-p' (the per-calendar in-flight check ;; that lets the dispatcher skip an overlapping timer tick) and for the ;; load-state sanitize that clears a stale `syncing' status in a fresh process. +;; +;; Every test runs inside `test-cs-syncing--with-fresh-state', which let-binds +;; a private state hash. These tests previously cleared the module's global +;; hash on entry and left whatever they wrote in it on exit, which leaked: +;; `...-sync-calendar-skips-when-in-flight' marks "proton" as syncing to +;; exercise the guard, and `test-calendar-sync--sync-dispatch-normal-ics-fetcher' +;; in the sibling dispatch file dispatches a calendar also named "proton". +;; ERT runs them in that order, so the leftover in-flight status made the +;; dispatch a no-op and the sibling failed -- but only when the calendar-sync +;; files ran in one process. `make test' runs each file separately and the +;; editor hook skipped this family for being over its file cap, so nothing +;; caught it. Let-binding is what the sibling files already do +;; (test-calendar-sync.el, test-calendar-sync-async-worker.el); this file was +;; the odd one out. ;;; Code: (require 'ert) (require 'calendar-sync) -(defun test-cs-syncing--reset () - "Clear the module's per-calendar state hash." - (clrhash calendar-sync--calendar-states)) +(defmacro test-cs-syncing--with-fresh-state (&rest body) + "Run BODY with a private, empty per-calendar state hash. +Let-bound rather than cleared in place, so nothing this test writes can +reach a later test." + (declare (indent 0)) + `(let ((calendar-sync--calendar-states (make-hash-table :test 'equal))) + ,@body)) ;;; calendar-sync--syncing-p (ert-deftest test-calendar-sync--syncing-p-normal-true-when-syncing () "Normal: a calendar whose status is `syncing' reads as in-flight." - (test-cs-syncing--reset) - (calendar-sync--set-calendar-state "google" '(:status syncing)) - (should (calendar-sync--syncing-p "google"))) + (test-cs-syncing--with-fresh-state + (calendar-sync--set-calendar-state "google" '(:status syncing)) + (should (calendar-sync--syncing-p "google")))) (ert-deftest test-calendar-sync--syncing-p-boundary-nil-when-no-state () "Boundary: a calendar with no recorded state is not in-flight." - (test-cs-syncing--reset) - (should-not (calendar-sync--syncing-p "never-seen"))) + (test-cs-syncing--with-fresh-state + (should-not (calendar-sync--syncing-p "never-seen")))) (ert-deftest test-calendar-sync--syncing-p-error-nil-for-terminal-status () "Error: a terminal status (ok / error) is not in-flight." - (test-cs-syncing--reset) - (calendar-sync--set-calendar-state "google" '(:status ok)) - (should-not (calendar-sync--syncing-p "google")) - (calendar-sync--set-calendar-state "proton" '(:status error)) - (should-not (calendar-sync--syncing-p "proton"))) + (test-cs-syncing--with-fresh-state + (calendar-sync--set-calendar-state "google" '(:status ok)) + (should-not (calendar-sync--syncing-p "google")) + (calendar-sync--set-calendar-state "proton" '(:status error)) + (should-not (calendar-sync--syncing-p "proton")))) ;;; Dispatcher guard: an in-flight calendar skips both leaf syncers (ert-deftest test-calendar-sync--sync-calendar-skips-when-in-flight () "Normal: `calendar-sync--sync-calendar' does not launch a second sync for a calendar already marked syncing, so an overlapping timer tick is a no-op." - (test-cs-syncing--reset) - (let ((api-calls '()) (ics-calls '())) - (cl-letf (((symbol-function 'calendar-sync--sync-calendar-api) - (lambda (cal) (push cal api-calls))) - ((symbol-function 'calendar-sync--sync-calendar-ics) - (lambda (cal) (push cal ics-calls)))) - (calendar-sync--set-calendar-state "proton" '(:status syncing)) - (calendar-sync--sync-calendar '(:name "proton" :url "https://x/y.ics" - :file "/tmp/c.org")) - (should (null api-calls)) - (should (null ics-calls))))) + (test-cs-syncing--with-fresh-state + (let ((api-calls '()) (ics-calls '())) + (cl-letf (((symbol-function 'calendar-sync--sync-calendar-api) + (lambda (cal) (push cal api-calls))) + ((symbol-function 'calendar-sync--sync-calendar-ics) + (lambda (cal) (push cal ics-calls)))) + (calendar-sync--set-calendar-state "proton" '(:status syncing)) + (calendar-sync--sync-calendar '(:name "proton" :url "https://x/y.ics" + :file "/tmp/c.org")) + (should (null api-calls)) + (should (null ics-calls)))))) (ert-deftest test-calendar-sync--sync-calendar-dispatches-when-idle () "Boundary: an idle calendar (no in-flight status) still dispatches normally." - (test-cs-syncing--reset) - (let ((ics-calls '())) - (cl-letf (((symbol-function 'calendar-sync--sync-calendar-ics) - (lambda (cal) (push cal ics-calls)))) - (calendar-sync--sync-calendar '(:name "proton" :url "https://x/y.ics" - :file "/tmp/c.org")) - (should (= 1 (length ics-calls)))))) + (test-cs-syncing--with-fresh-state + (let ((ics-calls '())) + (cl-letf (((symbol-function 'calendar-sync--sync-calendar-ics) + (lambda (cal) (push cal ics-calls)))) + (calendar-sync--sync-calendar '(:name "proton" :url "https://x/y.ics" + :file "/tmp/c.org")) + (should (= 1 (length ics-calls))))))) + +;;; Isolation guard + +(ert-deftest test-calendar-sync--syncing-state-does-not-leak () + "Error: state written inside the macro is gone once it returns. +Pins the isolation itself. Without it a test marking a calendar syncing +leaves that status set for every later test in the same process, which is +exactly what broke the sibling dispatch test." + (test-cs-syncing--with-fresh-state + (calendar-sync--set-calendar-state "leak-probe" '(:status syncing)) + (should (calendar-sync--syncing-p "leak-probe"))) + (should-not (calendar-sync--syncing-p "leak-probe"))) ;;; load-state sanitize: a persisted `syncing' status is cleared on load (ert-deftest test-calendar-sync--load-state-clears-stale-syncing () "Error: a `syncing' status persisted before a crash is reset on load, so the in-flight guard cannot skip that calendar forever in the new session." - (test-cs-syncing--reset) - (let* ((dir (make-temp-file "cs-state-" t)) - (calendar-sync--state-file (expand-file-name "state.el" dir))) - (unwind-protect - (progn - (with-temp-file calendar-sync--state-file - (prin1 '((timezone-offset . nil) - (calendar-states . (("google" . (:status syncing))))) - (current-buffer))) - (calendar-sync--load-state) - (should-not (calendar-sync--syncing-p "google"))) - (delete-directory dir t)))) + (test-cs-syncing--with-fresh-state + (let* ((dir (make-temp-file "cs-state-" t)) + (calendar-sync--state-file (expand-file-name "state.el" dir))) + (unwind-protect + (progn + (with-temp-file calendar-sync--state-file + (prin1 '((timezone-offset . nil) + (calendar-states . (("google" . (:status syncing))))) + (current-buffer))) + (calendar-sync--load-state) + (should-not (calendar-sync--syncing-p "google"))) + (delete-directory dir t))))) (provide 'test-calendar-sync--syncing-p) ;;; test-calendar-sync--syncing-p.el ends here diff --git a/tests/test-calendar-sync.el b/tests/test-calendar-sync.el index f562cfc6..8a7c2549 100644 --- a/tests/test-calendar-sync.el +++ b/tests/test-calendar-sync.el @@ -713,5 +713,50 @@ Valid events should be parsed, invalid ones skipped." (should-not (and org-content (string-match-p "OutOfRangeEvent" org-content))))) +;;; calendar-sync--sync-timer-function — hourly-timer body hygiene + +(ert-deftest test-calendar-sync-timer-function-does-not-propagate-a-signal () + "Error: a signal in the timer body is caught, not propagated. +The function runs from an hourly `run-at-time' timer. An unguarded signal +in the timezone check or the sync fan-out would error on every tick — the +same error, once an hour, forever. It must swallow-and-log instead." + (cl-letf (((symbol-function 'calendar-sync--timezone-changed-p) + (lambda (&rest _) (error "boom from the timezone check"))) + ((symbol-function 'calendar-sync--sync-all-calendars) #'ignore) + ((symbol-function 'calendar-sync--log-silently) #'ignore)) + ;; Must return normally rather than signal. + (should (progn (calendar-sync--sync-timer-function) t)))) + +(ert-deftest test-calendar-sync-timer-function-signal-in-sync-is-caught () + "Error: a signal from the sync fan-out is also caught, not propagated." + (cl-letf (((symbol-function 'calendar-sync--timezone-changed-p) #'ignore) + ((symbol-function 'calendar-sync--sync-all-calendars) + (lambda (&rest _) (error "boom from sync-all"))) + ((symbol-function 'calendar-sync--log-silently) #'ignore)) + (should (progn (calendar-sync--sync-timer-function) t)))) + +(ert-deftest test-calendar-sync-timer-function-timezone-change-is-not-echoed () + "Normal: a detected timezone change is logged silently, not echoed. +An hourly timer that calls `message' spams the echo area; the notice belongs +in the silent log like the module's other timer-path notices." + (let (silent-logged echoed) + (cl-letf (((symbol-function 'calendar-sync--timezone-changed-p) + (lambda (&rest _) t)) + ((symbol-function 'calendar-sync--format-timezone-offset) + (lambda (&rest _) "UTC+0")) + ((symbol-function 'calendar-sync--current-timezone-offset) + (lambda (&rest _) 0)) + ((symbol-function 'calendar-sync--sync-all-calendars) #'ignore) + ((symbol-function 'calendar-sync--log-silently) + (lambda (fmt &rest _) (when (string-match-p "Timezone" fmt) + (setq silent-logged t)))) + ((symbol-function 'message) + (lambda (fmt &rest _) (when (and (stringp fmt) + (string-match-p "Timezone" fmt)) + (setq echoed t))))) + (calendar-sync--sync-timer-function) + (should silent-logged) + (should-not echoed)))) + (provide 'test-calendar-sync) ;;; test-calendar-sync.el ends here diff --git a/tests/test-calibredb-epub-config--epub-mode.el b/tests/test-calibredb-epub-config--epub-mode.el new file mode 100644 index 00000000..a65bdabf --- /dev/null +++ b/tests/test-calibredb-epub-config--epub-mode.el @@ -0,0 +1,70 @@ +;;; test-calibredb-epub-config--epub-mode.el --- Tests for epub mode resolution -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests that .epub files reach nov-mode through `auto-mode-alist' alone, with +;; no advice on `set-auto-mode'. +;; +;; Background: the module used to carry an :around advice on `set-auto-mode' +;; forcing nov-mode for .epub, added to keep `magic-fallback-mode-alist' from +;; opening the zip container in archive-mode. It was never needed. +;; `set-auto-mode' consults `auto-mode-alist' before `magic-fallback-mode-alist', +;; and nov's use-package :mode registers "\\.epub\\'" there, so the alist +;; already won. Verified live on the daemon: a real zip-format .epub opened in +;; nov-mode both with the advice and with it removed. +;; +;; The advice was not free. `set-auto-mode' runs on every file visit, so the +;; advice put a redundant frame and an extra failure surface on the path for +;; every file of every type. +;; +;; The second test is a regression guard: it fails if the advice is ever +;; reinstated, which is the mistake this cleanup exists to prevent. +;; +;; Test organization: +;; - Normal Cases: .epub resolves to nov-mode; no advice on set-auto-mode +;; - Boundary Cases: a path merely containing "epub", and a bare "epub" name +;; - Error Cases: an unrelated extension does not resolve to nov-mode +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calibredb-epub-config) + +(defun test-epub-mode--resolve (filename) + "Return the major mode `auto-mode-alist' assigns to FILENAME." + (assoc-default filename auto-mode-alist 'string-match)) + +;;; Normal Cases + +(ert-deftest test-calibredb-epub-config-epub-resolves-to-nov-mode () + "Normal: auto-mode-alist maps a .epub file to nov-mode on its own." + (should (eq 'nov-mode (test-epub-mode--resolve "book.epub")))) + +(ert-deftest test-calibredb-epub-config-no-set-auto-mode-advice () + "Normal: nothing advises set-auto-mode to force nov-mode. +Regression guard. auto-mode-alist already wins over +magic-fallback-mode-alist, so an advice here would be redundant work on +every file visit." + (should-not (advice-member-p 'cj/force-nov-mode-for-epub 'set-auto-mode)) + (should-not (fboundp 'cj/force-nov-mode-for-epub))) + +;;; Boundary Cases + +(ert-deftest test-calibredb-epub-config-epub-in-directory-name () + "Boundary: the extension anchors at the end, so a directory named epub +does not by itself select nov-mode." + (should-not (eq 'nov-mode (test-epub-mode--resolve "/home/user/epub/notes.txt")))) + +(ert-deftest test-calibredb-epub-config-epub-with-path () + "Boundary: a full path with directories still resolves on the extension." + (should (eq 'nov-mode (test-epub-mode--resolve "/home/user/books/a b.epub")))) + +;;; Error Cases + +(ert-deftest test-calibredb-epub-config-other-extension-not-nov () + "Error: an unrelated extension must not resolve to nov-mode." + (should-not (eq 'nov-mode (test-epub-mode--resolve "archive.zip"))) + (should-not (eq 'nov-mode (test-epub-mode--resolve "notes.org")))) + +(provide 'test-calibredb-epub-config--epub-mode) +;;; test-calibredb-epub-config--epub-mode.el ends here diff --git a/tests/test-calibredb-epub-config.el b/tests/test-calibredb-epub-config.el index 71581d4c..7afc58f3 100644 --- a/tests/test-calibredb-epub-config.el +++ b/tests/test-calibredb-epub-config.el @@ -285,57 +285,6 @@ so the search buffer rebuilds against the now-unfiltered set." (cj/calibredb-clear-filters)) (should (equal "" passed)))) -;;; --------------------------- cj/force-nov-mode-for-epub --------------------- - -(ert-deftest test-calibredb-epub-force-nov-mode-on-epub-calls-nov-mode () - "Normal: a .epub buffer with nov-mode bound dispatches to `nov-mode' and -does not fall through to the original mode dispatcher." - (skip-unless (fboundp 'nov-mode)) - (let (orig-called nov-called) - (cl-letf (((symbol-function 'nov-mode) - (lambda () (setq nov-called t)))) - (with-temp-buffer - (setq buffer-file-name "/tmp/sample.epub") - (cj/force-nov-mode-for-epub - (lambda (&rest _) (setq orig-called t))))) - (should nov-called) - (should-not orig-called))) - -(ert-deftest test-calibredb-epub-force-nov-mode-passes-through-non-epub () - "Boundary: a non-epub buffer falls through to the original mode dispatcher." - (let (orig-called) - (with-temp-buffer - (setq buffer-file-name "/tmp/sample.txt") - (cj/force-nov-mode-for-epub - (lambda (&rest _) (setq orig-called t)))) - (should orig-called))) - -(ert-deftest test-calibredb-epub-force-nov-mode-passes-through-no-filename () - "Boundary: a buffer with no associated filename falls through to the -original mode dispatcher." - (let (orig-called) - (with-temp-buffer - (cj/force-nov-mode-for-epub - (lambda (&rest _) (setq orig-called t)))) - (should orig-called))) - -(ert-deftest test-calibredb-epub-force-nov-mode-passes-through-when-nov-missing () - "Error: a .epub buffer falls through to the original dispatcher when nov-mode -is not defined (the require failed and there is nothing to dispatch to)." - (let ((saved (and (fboundp 'nov-mode) (symbol-function 'nov-mode))) - orig-called) - (when saved (fmakunbound 'nov-mode)) - (unwind-protect - (cl-letf (((symbol-function 'require) - ;; Pretend the (require 'nov nil t) call fails too. - (lambda (&rest _) nil))) - (with-temp-buffer - (setq buffer-file-name "/tmp/sample.epub") - (cj/force-nov-mode-for-epub - (lambda (&rest _) (setq orig-called t))))) - (when saved (fset 'nov-mode saved))) - (should orig-called))) - ;;; ---------------------------- cj/nov--metadata-get -------------------------- (ert-deftest test-calibredb-epub-metadata-get-symbol-key () diff --git a/tests/test-custom-buffer-file-move-buffer-and-file.el b/tests/test-custom-buffer-file-move-buffer-and-file.el index 8331db5c..b3d78ccf 100644 --- a/tests/test-custom-buffer-file-move-buffer-and-file.el +++ b/tests/test-custom-buffer-file-move-buffer-and-file.el @@ -884,11 +884,17 @@ (with-temp-file source-file (insert "new")) (find-file source-file) - ;; Mock yes-or-no-p to capture that it was called - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (prompt) + ;; The overwrite confirm goes through `cj/confirm-destructive', which + ;; reads a single key rather than a typed yes. Mock the key read, not + ;; `yes-or-no-p' -- mocking the latter would pass whether or not the + ;; prompt happened at all. + (cl-letf (((symbol-function 'read-char-choice) + (lambda (&rest _) (setq prompted t) - t)) + ?y)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) + (error "overwrite confirm must not demand a typed yes"))) ((symbol-function 'read-directory-name) (lambda (&rest _) target-dir))) (call-interactively #'cj/move-buffer-and-file) @@ -907,11 +913,14 @@ (with-temp-file source-file (insert "new")) (find-file source-file) - ;; Mock yes-or-no-p to capture if it was called - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (prompt) - (setq prompted t) - t)) + ;; Both prompt paths are mocked, not just the old one. Watching + ;; `yes-or-no-p' alone would make this assertion unfalsifiable now + ;; that the confirm reads a key instead: it would pass whether the + ;; prompt was correctly skipped or merely moved. + (cl-letf (((symbol-function 'read-char-choice) + (lambda (&rest _) (setq prompted t) ?y)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) (setq prompted t) t)) ((symbol-function 'read-directory-name) (lambda (&rest _) target-dir))) (call-interactively #'cj/move-buffer-and-file) diff --git a/tests/test-custom-buffer-file-rename-buffer-and-file.el b/tests/test-custom-buffer-file-rename-buffer-and-file.el index 1eb61f1b..019fad8c 100644 --- a/tests/test-custom-buffer-file-rename-buffer-and-file.el +++ b/tests/test-custom-buffer-file-rename-buffer-and-file.el @@ -923,11 +923,17 @@ (with-temp-file new-file (insert "existing")) (find-file old-file) - ;; Mock yes-or-no-p to capture that it was called - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (prompt) + ;; The overwrite confirm goes through `cj/confirm-destructive', which + ;; reads a single key rather than a typed yes. Mock the key read, not + ;; `yes-or-no-p' -- mocking the latter would pass whether or not the + ;; prompt happened at all. + (cl-letf (((symbol-function 'read-char-choice) + (lambda (&rest _) (setq prompted t) - t)) + ?y)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) + (error "overwrite confirm must not demand a typed yes"))) ((symbol-function 'read-string) (lambda (&rest _) "new.txt"))) (call-interactively #'cj/rename-buffer-and-file) diff --git a/tests/test-custom-comments-comment-padded-divider.el b/tests/test-custom-comments-comment-padded-divider.el index d4c18905..9f2b4fd7 100644 --- a/tests/test-custom-comments-comment-padded-divider.el +++ b/tests/test-custom-comments-comment-padded-divider.el @@ -246,5 +246,23 @@ Returns the buffer string for assertions." ;; Should include comment-end (should (string-match-p "\\*/" result)))) +;;; Rendered width honors LENGTH exactly + +(ert-deftest test-padded-divider-width-matches-length-exactly () + "Normal: each decoration line renders exactly LENGTH wide. +available-width forgot the doubled semicolon (elisp) and the space after +comment-start that the emit path adds, so dividers rendered LENGTH+2 +(elisp) or LENGTH+1 wide, contradicting the docstring." + ;; elisp: lone ";" doubles to ";;" plus a space + (let* ((result (test-padded-divider-at-column 0 ";" "" "-" "x" 40 1)) + (lines (split-string result "\n" t))) + (should (= 40 (length (car lines)))) + (should (= 40 (length (car (last lines)))))) + ;; c-style with an end delimiter and no doubling + (let* ((result (test-padded-divider-at-column 0 "/*" "*/" "-" "x" 40 1)) + (lines (split-string result "\n" t))) + (should (= 40 (length (car lines)))) + (should (= 40 (length (car (last lines))))))) + (provide 'test-custom-comments-comment-padded-divider) ;;; test-custom-comments-comment-padded-divider.el ends here diff --git a/tests/test-custom-comments-public-wrappers.el b/tests/test-custom-comments-public-wrappers.el index 42842649..2eda9d94 100644 --- a/tests/test-custom-comments-public-wrappers.el +++ b/tests/test-custom-comments-public-wrappers.el @@ -188,5 +188,30 @@ text via `read-from-minibuffer'." (cj/comment-block-banner) (should (string-match-p "Banner" (buffer-string))))) +;;; cj/--comment-read-syntax — the shared comment-syntax resolution + +(ert-deftest test-comment-read-syntax-uses-buffer-syntax () + "Normal: a buffer with comment syntax resolves without prompting." + (with-temp-buffer + (setq-local comment-start ";") + (setq-local comment-end "") + (cl-letf (((symbol-function 'read-string) + (lambda (&rest _) (error "should not prompt")))) + (should (equal (cj/--comment-read-syntax) '(";" . "")))))) + +(ert-deftest test-comment-read-syntax-nil-end-falls-back-to-empty () + "Boundary: a nil comment-end resolves to the empty string." + (with-temp-buffer + (setq-local comment-start "#") + (setq-local comment-end nil) + (should (equal (cj/--comment-read-syntax) '("#" . ""))))) + +(ert-deftest test-comment-read-syntax-prompts-when-unset () + "Error: no buffer comment-start falls back to the prompt." + (with-temp-buffer + (setq-local comment-start nil) + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "//"))) + (should (equal (car (cj/--comment-read-syntax)) "//"))))) + (provide 'test-custom-comments-public-wrappers) ;;; test-custom-comments-public-wrappers.el ends here diff --git a/tests/test-dashboard-config.el b/tests/test-dashboard-config.el index 2dbcd4f4..3a48ee56 100644 --- a/tests/test-dashboard-config.el +++ b/tests/test-dashboard-config.el @@ -56,5 +56,15 @@ start at the top. Without `set-window-start', batch redisplay leaves (when (buffer-live-p dash) (kill-buffer dash))))) +(ert-deftest test-dashboard-config-bookmark-override-deferred-to-package-load () + "Normal: the bookmarks override is defined exactly when dashboard-widgets is. +A bare top-level defun would exist even without the package (and be +clobbered when the package loads); the deferred registration means the +function tracks the package's own load state. Holds in both runners: +the hook env loads dashboard, the make-test env can't." + (if (featurep 'dashboard-widgets) + (should (fboundp 'dashboard-insert-bookmarks)) + (should-not (fboundp 'dashboard-insert-bookmarks)))) + (provide 'test-dashboard-config) ;;; test-dashboard-config.el ends here diff --git a/tests/test-dev-fkeys--f4-clean-rebuild-impl.el b/tests/test-dev-fkeys--f4-clean-rebuild-impl.el index 27c7c56a..bed51d79 100644 --- a/tests/test-dev-fkeys--f4-clean-rebuild-impl.el +++ b/tests/test-dev-fkeys--f4-clean-rebuild-impl.el @@ -3,7 +3,11 @@ ;;; Commentary: ;; Tests for the "Clean + Rebuild" action handler. Runs the heuristic clean ;; command via `compile' from the project root, then chains -;; `projectile-compile-project' on success via the one-shot finish hook. +;; `projectile-compile-project' on success via a one-shot finish hook +;; installed buffer-locally in the compilation buffer `compile' returns. +;; The global `compilation-finish-functions' is never touched, so a quit +;; before the compile starts or an unrelated concurrent compile can never +;; fire the chained rebuild. ;;; Code: @@ -24,6 +28,18 @@ Bind the dir path to ROOT in BODY. Cleans up on exit." ,@body) (delete-directory root t)))) +(defmacro test-dev-fkeys-cr--with-compilation-buffer (buf &rest body) + "Run BODY with BUF bound to a temp buffer standing in for a compilation buffer." + (declare (indent 1)) + `(let ((,buf (generate-new-buffer " *test-compilation*"))) + (unwind-protect + (progn ,@body) + (kill-buffer ,buf)))) + +(defun test-dev-fkeys-cr--local-hooks (buf) + "Return the buffer-local finish hooks of BUF, without the t marker." + (remq t (buffer-local-value 'compilation-finish-functions buf))) + ;;; Normal Cases (ert-deftest test-dev-fkeys-clean-rebuild-impl-runs-derived-clean-cmd () @@ -34,48 +50,50 @@ Components integrated: - `cj/--f4-clean-rebuild-impl' (unit under test) - `cj/--f4-derive-clean-cmd' (real) - `compile' (MOCKED — captures the command string) -- `projectile-compile-project' (MOCKED — no-op) -- `compilation-finish-functions' (real, scoped via let)" +- `projectile-compile-project' (MOCKED — no-op)" (test-dev-fkeys-cr--with-project '("Makefile") - (let ((compile-calls nil) - (compilation-finish-functions nil)) + (let ((compile-calls nil)) (cl-letf (((symbol-function 'compile) - (lambda (cmd) (push cmd compile-calls))) + (lambda (cmd) (push cmd compile-calls) nil)) ((symbol-function 'projectile-compile-project) (lambda (_arg) nil))) (cj/--f4-clean-rebuild-impl root) (should (equal compile-calls '("make clean"))))))) -(ert-deftest test-dev-fkeys-clean-rebuild-impl-installs-finish-hook () - "Normal: handler installs exactly one hook in `compilation-finish-functions'." +(ert-deftest test-dev-fkeys-clean-rebuild-impl-installs-hook-in-compilation-buffer () + "Normal: the one-shot hook lands buffer-locally in the buffer `compile' +returns; the global `compilation-finish-functions' stays untouched." (test-dev-fkeys-cr--with-project '("go.mod") - (let ((compilation-finish-functions nil)) - (cl-letf (((symbol-function 'compile) (lambda (_cmd) nil)) - ((symbol-function 'projectile-compile-project) - (lambda (_arg) nil))) - (cj/--f4-clean-rebuild-impl root) - (should (= (length compilation-finish-functions) 1)))))) + (test-dev-fkeys-cr--with-compilation-buffer buf + (let ((compilation-finish-functions nil)) + (cl-letf (((symbol-function 'compile) (lambda (_cmd) buf)) + ((symbol-function 'projectile-compile-project) + (lambda (_arg) nil))) + (cj/--f4-clean-rebuild-impl root) + (should (null compilation-finish-functions)) + (should (= 1 (length (test-dev-fkeys-cr--local-hooks buf))))))))) (ert-deftest test-dev-fkeys-clean-rebuild-impl-hook-runs-projectile-compile-on-success () - "Normal: when the clean step finishes successfully, the installed hook + "Normal: when the clean step finishes successfully, the buffer-local hook calls `projectile-compile-project' to do the rebuild." (test-dev-fkeys-cr--with-project '("Cargo.toml") - (let ((compile-calls 0) - (compilation-finish-functions nil)) - (cl-letf (((symbol-function 'compile) (lambda (_cmd) nil)) - ((symbol-function 'projectile-compile-project) - (lambda (_arg) (cl-incf compile-calls)))) - (cj/--f4-clean-rebuild-impl root) - (run-hook-with-args 'compilation-finish-functions nil "finished\n") - (should (= compile-calls 1)))))) + (test-dev-fkeys-cr--with-compilation-buffer buf + (let ((compile-calls 0) + (compilation-finish-functions nil)) + (cl-letf (((symbol-function 'compile) (lambda (_cmd) buf)) + ((symbol-function 'projectile-compile-project) + (lambda (_arg) (cl-incf compile-calls)))) + (cj/--f4-clean-rebuild-impl root) + (with-current-buffer buf + (run-hook-with-args 'compilation-finish-functions buf "finished\n")) + (should (= compile-calls 1))))))) (ert-deftest test-dev-fkeys-clean-rebuild-impl-runs-clean-from-project-root () "Normal: the clean compile runs with default-directory bound to ROOT." (test-dev-fkeys-cr--with-project '("Eask") - (let ((seen-dir nil) - (compilation-finish-functions nil)) + (let ((seen-dir nil)) (cl-letf (((symbol-function 'compile) - (lambda (_cmd) (setq seen-dir default-directory))) + (lambda (_cmd) (setq seen-dir default-directory) nil)) ((symbol-function 'projectile-compile-project) (lambda (_arg) nil))) (cj/--f4-clean-rebuild-impl root) @@ -87,14 +105,28 @@ calls `projectile-compile-project' to do the rebuild." (ert-deftest test-dev-fkeys-clean-rebuild-impl-hook-skips-rebuild-on-failure () "Boundary: when the clean step fails, projectile-compile-project does not run." (test-dev-fkeys-cr--with-project '("Makefile") - (let ((compile-calls 0) - (compilation-finish-functions nil)) + (test-dev-fkeys-cr--with-compilation-buffer buf + (let ((compile-calls 0) + (compilation-finish-functions nil)) + (cl-letf (((symbol-function 'compile) (lambda (_cmd) buf)) + ((symbol-function 'projectile-compile-project) + (lambda (_arg) (cl-incf compile-calls)))) + (cj/--f4-clean-rebuild-impl root) + (with-current-buffer buf + (run-hook-with-args 'compilation-finish-functions + buf "exited abnormally\n")) + (should (= compile-calls 0))))))) + +(ert-deftest test-dev-fkeys-clean-rebuild-impl-dead-compile-buffer-no-global-hook () + "Boundary: when `compile' returns no live buffer, nothing is installed +anywhere — the global hook list stays empty." + (test-dev-fkeys-cr--with-project '("Makefile") + (let ((compilation-finish-functions nil)) (cl-letf (((symbol-function 'compile) (lambda (_cmd) nil)) ((symbol-function 'projectile-compile-project) - (lambda (_arg) (cl-incf compile-calls)))) + (lambda (_arg) nil))) (cj/--f4-clean-rebuild-impl root) - (run-hook-with-args 'compilation-finish-functions nil "exited abnormally\n") - (should (= compile-calls 0)))))) + (should (null compilation-finish-functions)))))) ;;; Error Cases diff --git a/tests/test-dev-fkeys--f4-compile-and-run-impl.el b/tests/test-dev-fkeys--f4-compile-and-run-impl.el index d59a6cd6..34e5bdf3 100644 --- a/tests/test-dev-fkeys--f4-compile-and-run-impl.el +++ b/tests/test-dev-fkeys--f4-compile-and-run-impl.el @@ -2,8 +2,11 @@ ;;; Commentary: ;; Tests for the "Compile + Run" action handler. After kicking off the -;; compile, attaches a one-shot `compilation-finish-functions' hook that -;; runs the project on success. +;; compile, attaches a one-shot finish hook buffer-locally in the +;; compilation buffer projectile returns, so the global +;; `compilation-finish-functions' is never touched. A quit at +;; projectile's compile prompt therefore can never leave an armed hook +;; that a later unrelated compile would fire. ;;; Code: @@ -12,6 +15,14 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'dev-fkeys) +(defmacro test-dev-fkeys-car--with-buffer (buf &rest body) + "Run BODY with BUF bound to a temp buffer standing in for a compilation buffer." + (declare (indent 1)) + `(let ((,buf (generate-new-buffer " *test-compilation*"))) + (unwind-protect + (progn ,@body) + (kill-buffer ,buf)))) + ;;; Normal Cases (ert-deftest test-dev-fkeys-compile-and-run-impl-invokes-projectile-compile () @@ -19,57 +30,77 @@ Components integrated: - `cj/--f4-compile-and-run-impl' (unit under test) -- `projectile-compile-project' (MOCKED via cl-letf) -- `compilation-finish-functions' (real, scoped via let)" - (let ((compile-calls 0) - (compilation-finish-functions nil)) +- `projectile-compile-project' (MOCKED via cl-letf)" + (let ((compile-calls 0)) (cl-letf (((symbol-function 'projectile-compile-project) - (lambda (_arg) (cl-incf compile-calls)))) + (lambda (_arg) (cl-incf compile-calls) nil))) (cj/--f4-compile-and-run-impl) (should (= compile-calls 1))))) -(ert-deftest test-dev-fkeys-compile-and-run-impl-installs-finish-hook () - "Normal: handler installs exactly one hook in `compilation-finish-functions'." - (let ((compilation-finish-functions nil)) - (cl-letf (((symbol-function 'projectile-compile-project) - (lambda (_arg) nil))) - (cj/--f4-compile-and-run-impl) - (should (= (length compilation-finish-functions) 1))))) +(ert-deftest test-dev-fkeys-compile-and-run-impl-installs-hook-in-compilation-buffer () + "Normal: the one-shot hook lands buffer-locally in the compilation buffer; +the global `compilation-finish-functions' stays untouched." + (test-dev-fkeys-car--with-buffer buf + (let ((compilation-finish-functions nil)) + (cl-letf (((symbol-function 'projectile-compile-project) + (lambda (_arg) buf))) + (cj/--f4-compile-and-run-impl) + (should (null compilation-finish-functions)) + (should (= 1 (length (remq t (buffer-local-value + 'compilation-finish-functions buf))))))))) (ert-deftest test-dev-fkeys-compile-and-run-impl-hook-runs-projectile-run-on-success () - "Normal: when the compile finishes successfully, the installed hook calls -`projectile-run-project'. + "Normal: when the compile finishes successfully, the buffer-local hook +calls `projectile-run-project'. Components integrated: - `cj/--f4-compile-and-run-impl' (unit under test) -- `projectile-compile-project' (MOCKED — no-op) +- `projectile-compile-project' (MOCKED — returns the compilation buffer) - `projectile-run-project' (MOCKED — counts calls) -- `compilation-finish-functions' (real) +- `compilation-finish-functions' (real, buffer-local) - `run-hook-with-args' (real — simulates compile.el firing the hook)" - (let ((run-calls 0) - (compilation-finish-functions nil)) - (cl-letf (((symbol-function 'projectile-compile-project) - (lambda (_arg) nil)) - ((symbol-function 'projectile-run-project) - (lambda (_arg) (cl-incf run-calls)))) - (cj/--f4-compile-and-run-impl) - (run-hook-with-args 'compilation-finish-functions nil "finished\n") - (should (= run-calls 1))))) + (test-dev-fkeys-car--with-buffer buf + (let ((run-calls 0) + (compilation-finish-functions nil)) + (cl-letf (((symbol-function 'projectile-compile-project) + (lambda (_arg) buf)) + ((symbol-function 'projectile-run-project) + (lambda (_arg) (cl-incf run-calls)))) + (cj/--f4-compile-and-run-impl) + (with-current-buffer buf + (run-hook-with-args 'compilation-finish-functions buf "finished\n")) + (should (= run-calls 1)))))) ;;; Boundary Cases (ert-deftest test-dev-fkeys-compile-and-run-impl-hook-skips-projectile-run-on-failure () "Boundary: when the compile fails, projectile-run-project must not run. The hook still self-removes (covered in the make-once-hook tests)." - (let ((run-calls 0) - (compilation-finish-functions nil)) + (test-dev-fkeys-car--with-buffer buf + (let ((run-calls 0) + (compilation-finish-functions nil)) + (cl-letf (((symbol-function 'projectile-compile-project) + (lambda (_arg) buf)) + ((symbol-function 'projectile-run-project) + (lambda (_arg) (cl-incf run-calls)))) + (cj/--f4-compile-and-run-impl) + (with-current-buffer buf + (run-hook-with-args 'compilation-finish-functions + buf "exited abnormally\n")) + (should (= run-calls 0)))))) + +(ert-deftest test-dev-fkeys-compile-and-run-impl-quit-leaves-no-global-hook () + "Boundary: a quit at projectile's prompt leaves no armed hook anywhere. +This is the regression the buffer-local install exists to prevent: the +old shape armed a global hook before the prompt, so C-g left it live and +the next unrelated compile fired the chained run." + (let ((compilation-finish-functions nil)) (cl-letf (((symbol-function 'projectile-compile-project) - (lambda (_arg) nil)) - ((symbol-function 'projectile-run-project) - (lambda (_arg) (cl-incf run-calls)))) - (cj/--f4-compile-and-run-impl) - (run-hook-with-args 'compilation-finish-functions nil "exited abnormally\n") - (should (= run-calls 0))))) + (lambda (_arg) (signal 'quit nil)))) + (condition-case nil + (cj/--f4-compile-and-run-impl) + (quit nil)) + (should (null compilation-finish-functions))))) (provide 'test-dev-fkeys--f4-compile-and-run-impl) ;;; test-dev-fkeys--f4-compile-and-run-impl.el ends here diff --git a/tests/test-dev-fkeys--f4-make-once-hook.el b/tests/test-dev-fkeys--f4-make-once-hook.el index b6c71dd7..4fc84e63 100644 --- a/tests/test-dev-fkeys--f4-make-once-hook.el +++ b/tests/test-dev-fkeys--f4-make-once-hook.el @@ -95,6 +95,21 @@ hook exactly once per compile, so the practical contract is one-shot." (funcall hook nil "interrupt\n")) (should (= called 0)))) +(ert-deftest test-dev-fkeys-make-once-hook-removes-itself-buffer-locally () + "Boundary: a hook installed buffer-locally removes its local entry when +run in that buffer — the shape used by the F4 chained-compile handlers." + (let ((buf (generate-new-buffer " *test-once-hook*")) + (called 0)) + (unwind-protect + (let ((hook (cj/--f4-make-once-hook (lambda () (cl-incf called))))) + (with-current-buffer buf + (add-hook 'compilation-finish-functions hook nil t) + (funcall hook buf "finished\n") + (should-not (memq hook (buffer-local-value + 'compilation-finish-functions buf)))) + (should (= called 1))) + (kill-buffer buf)))) + ;;; Error Cases (ert-deftest test-dev-fkeys-make-once-hook-then-fn-error-still-removes-hook () diff --git a/tests/test-dev-fkeys--f6-test-runner-cmd-for.el b/tests/test-dev-fkeys--f6-test-runner-cmd-for.el index d7b6a059..59d0ba42 100644 --- a/tests/test-dev-fkeys--f6-test-runner-cmd-for.el +++ b/tests/test-dev-fkeys--f6-test-runner-cmd-for.el @@ -138,10 +138,15 @@ rather than a silent nil that F6's outer wrapper interprets as 'typescript t "src/foo.test.ts" "foo" "src") "npx --no-install vitest src/foo.test.ts")))) -(ert-deftest test-dev-fkeys-f6-cmd-for-javascript-returns-nil () - "Error: JavaScript is punted for v1 and returns nil." - (should (null (cj/--f6-test-runner-cmd-for - 'javascript t "src/foo.test.js" "foo" "src")))) +(ert-deftest test-dev-fkeys-f6-cmd-for-javascript-uses-npx-runner () + "Normal: javascript gets the same npx runner command as typescript. +The language detector classifies js/jsx and the test-file detector +recognizes JS test files, but the dispatch had no javascript arm, so +C-F6 on a JS test errored even though the npx path would run it." + (cl-letf (((symbol-function 'executable-find) (lambda (&rest _) nil))) + (should (equal (cj/--f6-test-runner-cmd-for + 'javascript t "src/foo.test.js" "foo" "src") + "npx --no-install jest src/foo.test.js")))) (ert-deftest test-dev-fkeys-f6-cmd-for-unknown-returns-nil () "Error: an unknown language returns nil." diff --git a/tests/test-diff-config--ediff-options.el b/tests/test-diff-config--ediff-options.el new file mode 100644 index 00000000..a43637d9 --- /dev/null +++ b/tests/test-diff-config--ediff-options.el @@ -0,0 +1,27 @@ +;;; test-diff-config--ediff-options.el --- Tests for ediff diff options -*- lexical-binding: t -*- + +;;; Commentary: +;; Pins the removal of the global "-w" default for `ediff-diff-options'. +;; With "-w", every ediff session ignores ALL whitespace, so +;; indentation-only changes (significant in Python, Makefiles, YAML) +;; compare as identical. Whitespace-ignoring is a per-session toggle +;; (ediff's `##'), not a global default. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'diff-config) + +;;; Normal Cases + +(ert-deftest test-diff-config-ediff-options-no-global-whitespace-ignore () + "Normal: after ediff loads, no global -w sits in ediff-diff-options. +The use-package :custom values apply when the deferred package loads, +so the assertion must run with ediff actually loaded." + (require 'ediff) + (should (not (string-match-p "-w" (or ediff-diff-options ""))))) + +(provide 'test-diff-config--ediff-options) +;;; test-diff-config--ediff-options.el ends here diff --git a/tests/test-dirvish-config-runtime-requires.el b/tests/test-dirvish-config-runtime-requires.el index 34fb67ac..ca94e4b5 100644 --- a/tests/test-dirvish-config-runtime-requires.el +++ b/tests/test-dirvish-config-runtime-requires.el @@ -3,15 +3,13 @@ ;;; Commentary: ;; dirvish-config.el builds `dirvish-quick-access-entries' from `code-dir', ;; `music-dir', `pix-dir' (and friends) at load time and binds keys to -;; `cj/xdg-open' / `cj/open-file-with-command', so it depends on user-constants -;; and system-utils at runtime. Those were declared with `eval-when-compile', -;; which leaves the compiled module without the requires at load — fragile -;; under init order. This is a dependency-contract smoke test: requiring -;; dirvish-config in isolation must pull both features in, so it fails if the -;; requires are dropped entirely. (It can't catch a downgrade back to -;; `eval-when-compile', since that form still runs when the file loads as -;; source, which the test harness does — that regression is guarded by keeping -;; the plain requires in review, not by this test.) +;; `cj/xdg-open' (external-open) and `cj/open-file-with-command' +;; (system-utils), so it depends on user-constants, system-utils, and +;; external-open at runtime. This is a dependency-contract smoke test: +;; requiring dirvish-config in isolation must pull those features in, so it +;; fails if the requires are dropped entirely. Run it with `make test-file' +;; for a clean signal: in the full suite another file may already have loaded +;; external-open, masking a regression here. ;;; Code: @@ -26,5 +24,13 @@ "Normal: requiring dirvish-config pulls in system-utils at runtime." (should (featurep 'system-utils))) +(ert-deftest test-dirvish-config-loads-external-open () + "Normal: requiring dirvish-config pulls in external-open at runtime. +The keys `o' and the OS-handler fallback call `cj/xdg-open', which lives +in external-open; without the require the binding works only when init +order happens to load external-open first." + (should (featurep 'external-open)) + (should (fboundp 'cj/xdg-open))) + (provide 'test-dirvish-config-runtime-requires) ;;; test-dirvish-config-runtime-requires.el ends here diff --git a/tests/test-dwim-shell-config-runtime-requires.el b/tests/test-dwim-shell-config-runtime-requires.el new file mode 100644 index 00000000..ab53e7d4 --- /dev/null +++ b/tests/test-dwim-shell-config-runtime-requires.el @@ -0,0 +1,24 @@ +;;; test-dwim-shell-config-runtime-requires.el --- dwim-shell-config declares its deps -*- lexical-binding: t; -*- + +;;; Commentary: +;; dwim-shell-config.el calls `cj/xdg-open' (external-open) to open a +;; conversion's output file, but declared it only with `declare-function' +;; and never required external-open. The binding works at runtime only +;; because init.el happens to load external-open first — fragile under init +;; order, and the "Direct test load: yes" header claims otherwise. This is +;; a dependency-contract smoke test: requiring dwim-shell-config in isolation +;; must pull external-open in. Run with `make test-file' for a clean signal; +;; in the full suite another file may already have loaded external-open. + +;;; Code: + +(require 'ert) +(require 'dwim-shell-config) + +(ert-deftest test-dwim-shell-config-loads-external-open () + "Normal: requiring dwim-shell-config pulls in external-open at runtime." + (should (featurep 'external-open)) + (should (fboundp 'cj/xdg-open))) + +(provide 'test-dwim-shell-config-runtime-requires) +;;; test-dwim-shell-config-runtime-requires.el ends here diff --git a/tests/test-elfeed-config-helpers.el b/tests/test-elfeed-config-helpers.el index 16cbb744..95a98e83 100644 --- a/tests/test-elfeed-config-helpers.el +++ b/tests/test-elfeed-config-helpers.el @@ -1,10 +1,7 @@ ;;; test-elfeed-config-helpers.el --- Tests for elfeed stream/process helpers -*- lexical-binding: t; -*- ;;; Commentary: -;; Coverage for two elfeed-config helpers that were untested: -;; - cj/extract-stream-url: runs yt-dlp -g to resolve a direct stream URL, -;; returning the URL, nil on non-URL / nonzero exit, or signalling when -;; yt-dlp is absent. +;; Coverage for the elfeed-config entry-processing helper: ;; - cj/elfeed-process-entries: applies an action to each selected entry, ;; marking them read; errors when nothing is selected, skips entries with ;; no link, and (by default) catches per-entry action errors. @@ -34,40 +31,6 @@ (require 'elfeed-config) (require 'elfeed nil t) -;;; cj/extract-stream-url - -(ert-deftest test-elfeed-extract-stream-url-normal-returns-url () - "Normal: a successful yt-dlp run returns the trimmed https stream URL." - (cl-letf (((symbol-function 'executable-find) - (lambda (p &rest _) (and (equal p "yt-dlp") "/usr/bin/yt-dlp"))) - ((symbol-function 'cj/log-silently) #'ignore) - ((symbol-function 'call-process) - (lambda (_prog _infile _dest _disp &rest _args) - (insert "https://stream.example/abc\n") 0))) - (should (equal "https://stream.example/abc" - (cj/extract-stream-url "https://youtube.com/watch?v=x" "best"))))) - -(ert-deftest test-elfeed-extract-stream-url-boundary-non-url-output-is-nil () - "Boundary: output that is not an http(s) URL yields nil, not the raw text." - (cl-letf (((symbol-function 'executable-find) (lambda (_ &rest _) "/usr/bin/yt-dlp")) - ((symbol-function 'cj/log-silently) #'ignore) - ((symbol-function 'call-process) - (lambda (_p _i _d _disp &rest _) (insert "ERROR: unavailable\n") 0))) - (should (null (cj/extract-stream-url "u" nil))))) - -(ert-deftest test-elfeed-extract-stream-url-boundary-nonzero-exit-is-nil () - "Boundary: a nonzero yt-dlp exit code yields nil." - (cl-letf (((symbol-function 'executable-find) (lambda (_ &rest _) "/usr/bin/yt-dlp")) - ((symbol-function 'cj/log-silently) #'ignore) - ((symbol-function 'call-process) - (lambda (_p _i _d _disp &rest _) (insert "boom") 1))) - (should (null (cj/extract-stream-url "u" nil))))) - -(ert-deftest test-elfeed-extract-stream-url-error-without-yt-dlp () - "Error: a missing yt-dlp signals before attempting the call." - (cl-letf (((symbol-function 'executable-find) (lambda (_ &rest _) nil))) - (should-error (cj/extract-stream-url "u" "best") :type 'error))) - ;;; cj/elfeed-process-entries (defun cj/test--elfeed-entry (link) diff --git a/tests/test-external-open--open-with-argv.el b/tests/test-external-open--open-with-argv.el new file mode 100644 index 00000000..27a7e811 --- /dev/null +++ b/tests/test-external-open--open-with-argv.el @@ -0,0 +1,59 @@ +;;; test-external-open--open-with-argv.el --- Tests for cj/--open-with-argv -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/--open-with-argv, the pure builder that turns the +;; user-typed "open with" command plus a file path into an argv list. +;; The argv shape is the hardening: the file is one list element, so paths +;; with spaces or shell metacharacters never meet a shell. +;; +;; Test organization: +;; - Normal Cases: bare program, program with args, quoted argument +;; - Boundary Cases: file with spaces and metacharacters stays one element +;; - Error Cases: empty and whitespace-only commands +;; +;;; Code: + +(require 'ert) +(require 'external-open) + +;;; Normal Cases + +(ert-deftest test-external-open--open-with-argv-normal-bare-program () + "Normal: a bare program name yields (PROGRAM FILE)." + (should (equal (cj/--open-with-argv "vlc" "/tmp/foo.mp4") + '("vlc" "/tmp/foo.mp4")))) + +(ert-deftest test-external-open--open-with-argv-normal-program-with-args () + "Normal: a command typed with arguments splits into argv words." + (should (equal (cj/--open-with-argv "mpv --fs --loop" "/tmp/foo.mp4") + '("mpv" "--fs" "--loop" "/tmp/foo.mp4")))) + +(ert-deftest test-external-open--open-with-argv-normal-quoted-arg-survives () + "Normal: a double-quoted argument stays one word." + (should (equal (cj/--open-with-argv "player \"two words\"" "/tmp/foo.mp4") + '("player" "two words" "/tmp/foo.mp4")))) + +;;; Boundary Cases + +(ert-deftest test-external-open--open-with-argv-boundary-file-with-spaces () + "Boundary: a path with spaces is one argv element, untouched." + (let ((file "/tmp/my file (draft).mp4")) + (should (equal (car (last (cj/--open-with-argv "vlc" file))) file)))) + +(ert-deftest test-external-open--open-with-argv-boundary-file-with-metacharacters () + "Boundary: shell metacharacters in the path arrive verbatim." + (let ((file "/tmp/a;b&c$(d)'e.mp4")) + (should (equal (car (last (cj/--open-with-argv "vlc" file))) file)))) + +;;; Error Cases + +(ert-deftest test-external-open--open-with-argv-error-empty-command () + "Error: an empty command signals user-error." + (should-error (cj/--open-with-argv "" "/tmp/foo.mp4") :type 'user-error)) + +(ert-deftest test-external-open--open-with-argv-error-whitespace-command () + "Error: a whitespace-only command signals user-error." + (should-error (cj/--open-with-argv " " "/tmp/foo.mp4") :type 'user-error)) + +(provide 'test-external-open--open-with-argv) +;;; test-external-open--open-with-argv.el ends here diff --git a/tests/test-external-open-commands.el b/tests/test-external-open-commands.el index 3d8adc15..5cab1196 100644 --- a/tests/test-external-open-commands.el +++ b/tests/test-external-open-commands.el @@ -64,22 +64,41 @@ (should-error (cj/open-this-file-with "vlc") :type 'user-error))) (ert-deftest test-external-open-open-this-file-with-spawns-detached-process () - "Normal: posix path invokes `call-process-shell-command' with nohup + bg." - (let ((cmd nil)) + "Normal: posix path launches an argv `call-process' with DESTINATION 0." + (let ((captured nil)) (with-temp-buffer - (setq buffer-file-name "/tmp/foo.mp4") + (setq buffer-file-name "/tmp/my file.mp4") (cl-letf (((symbol-function 'env-windows-p) (lambda () nil)) - ((symbol-function 'call-process-shell-command) - (lambda (c _infile _buf &rest _) - (setq cmd c)))) - (cj/open-this-file-with "vlc")) + ((symbol-function 'executable-find) + (lambda (&rest _) "/usr/bin/vlc")) + ((symbol-function 'call-process) + (lambda (&rest args) (setq captured args) 0))) + (cj/open-this-file-with "vlc --fs")) (setq buffer-file-name nil)) - (should (string-match-p "^nohup vlc " cmd)) - (should (string-match-p "&$" cmd)) - (should (string-match-p ">/dev/null" cmd)))) + (should (equal captured '("vlc" nil 0 nil "--fs" "/tmp/my file.mp4"))))) + +(ert-deftest test-external-open-open-this-file-with-errors-missing-program () + "Error: a program not on PATH signals user-error before launching." + (with-temp-buffer + (setq buffer-file-name "/tmp/foo.mp4") + (cl-letf (((symbol-function 'env-windows-p) (lambda () nil)) + ((symbol-function 'executable-find) (lambda (&rest _) nil))) + (should-error (cj/open-this-file-with "no-such-program") + :type 'user-error)) + (setq buffer-file-name nil))) ;;; cj/find-file-auto +(ert-deftest test-external-open-video-looping-errors-missing-program () + "Error: a missing video player gives a clear user-error, not an opaque crash. +The command fires via the find-file advice, so visiting a video on a +machine without mpv must fail with a message naming the program." + (cl-letf (((symbol-function 'executable-find) (lambda (&rest _) nil)) + ((symbol-function 'call-process) + (lambda (&rest _) (error "call-process should not run")))) + (should-error (cj/open-video-looping "/tmp/some-video.mp4") + :type 'user-error))) + (ert-deftest test-external-open-find-file-auto-routes-media-externally () "Normal: a non-video external extension (`.docx', in `default-open-extensions') triggers `cj/xdg-open' instead of the original diff --git a/tests/test-flyspell-and-abbrev.el b/tests/test-flyspell-and-abbrev.el index 3b494d5e..b4be6ab3 100644 --- a/tests/test-flyspell-and-abbrev.el +++ b/tests/test-flyspell-and-abbrev.el @@ -17,6 +17,7 @@ (require 'ert) (require 'cl-lib) +(require 'user-constants) ;; org-dir, read by the ispell :config below (require 'flyspell) (require 'flyspell-and-abbrev) @@ -27,6 +28,23 @@ (overlay-put o 'face 'flyspell-incorrect) o)) +;; ------------------------- org src-block skip entry --------------------------- + +(ert-deftest test-flyspell-ispell-skip-entry-matches-src-block-lines () + "Normal: the ispell skip entry matches real org src-block delimiters. +The old entry used \"#+\" (one-or-more #), which matches no real +begin_src line, so ispell spell-checked inside every org code block." + (require 'ispell) + (let ((entry (seq-find (lambda (e) + (and (consp e) (stringp (car e)) + (string-match-p "BEGIN_SRC" (car e)))) + ispell-skip-region-alist))) + (should entry) + (let ((case-fold-search t)) + (should (string-match-p (car entry) "#+BEGIN_SRC emacs-lisp")) + (should (string-match-p (car entry) "#+begin_src python")) + (should (string-match-p (cdr entry) "#+end_src"))))) + ;; ------------------------ cj/--require-spell-checker ------------------------- (ert-deftest test-flyspell-require-spell-checker-present () diff --git a/tests/test-font-config--frame-lifecycle.el b/tests/test-font-config--frame-lifecycle.el deleted file mode 100644 index 8f338b99..00000000 --- a/tests/test-font-config--frame-lifecycle.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; test-font-config--frame-lifecycle.el --- Tests for the lifted font frame helpers -*- lexical-binding: t; -*- - -;;; Commentary: -;; cj/apply-font-settings-to-frame, cj/cleanup-frame-list, and -;; cj/maybe-install-nerd-icons-fonts were defined inside use-package -;; :config / with-eval-after-load (unreachable under `make test'). Lifting -;; them to top level makes their branching unit-testable; env-gui-p and the -;; package side-effect calls are mocked at the boundary. - -;;; Code: - -(require 'ert) -(require 'cl-lib) - -(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) -(require 'font-config) - -(defvar cj/fontaine-configured-frames) - -(ert-deftest test-font-cleanup-frame-list-removes-frame () - "Normal: cleanup drops the given frame from the configured list." - (let ((cj/fontaine-configured-frames '(fr1 fr2 fr3))) - (cj/cleanup-frame-list 'fr2) - (should (equal cj/fontaine-configured-frames '(fr1 fr3))))) - -(ert-deftest test-font-apply-gui-unconfigured-sets-preset () - "Normal: a GUI frame not yet configured gets the preset and is tracked." - (let ((cj/fontaine-configured-frames nil) - (called nil)) - (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) - ((symbol-function 'fontaine-set-preset) (lambda (_p) (setq called t)))) - (cj/apply-font-settings-to-frame (selected-frame))) - (should called) - (should (member (selected-frame) cj/fontaine-configured-frames)))) - -(ert-deftest test-font-apply-already-configured-is-noop () - "Boundary: an already-configured frame is not re-preset." - (let ((cj/fontaine-configured-frames (list (selected-frame))) - (called nil)) - (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) - ((symbol-function 'fontaine-set-preset) (lambda (_p) (setq called t)))) - (cj/apply-font-settings-to-frame (selected-frame))) - (should-not called))) - -(ert-deftest test-font-apply-non-gui-is-noop () - "Boundary: without a GUI nothing is applied or tracked." - (let ((cj/fontaine-configured-frames nil) - (called nil)) - (cl-letf (((symbol-function 'env-gui-p) (lambda () nil)) - ((symbol-function 'fontaine-set-preset) (lambda (_p) (setq called t)))) - (cj/apply-font-settings-to-frame (selected-frame))) - (should-not called) - (should-not (member (selected-frame) cj/fontaine-configured-frames)))) - -(ert-deftest test-font-maybe-install-icons-gui-missing-installs () - "Normal: GUI present and font missing triggers the install." - (let ((installed nil)) - (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) - ((symbol-function 'cj/font-installed-p) (lambda (_n) nil)) - ((symbol-function 'nerd-icons-install-fonts) (lambda (&rest _) (setq installed t))) - ((symbol-function 'remove-hook) #'ignore)) - (cj/maybe-install-nerd-icons-fonts)) - (should installed))) - -(ert-deftest test-font-maybe-install-icons-already-present-skips () - "Boundary: an installed font means no install attempt." - (let ((installed nil)) - (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) - ((symbol-function 'cj/font-installed-p) (lambda (_n) t)) - ((symbol-function 'nerd-icons-install-fonts) (lambda (&rest _) (setq installed t)))) - (cj/maybe-install-nerd-icons-fonts)) - (should-not installed))) - -(provide 'test-font-config--frame-lifecycle) -;;; test-font-config--frame-lifecycle.el ends here diff --git a/tests/test-font-config.el b/tests/test-font-config.el index 4df2b41a..06ea226b 100644 --- a/tests/test-font-config.el +++ b/tests/test-font-config.el @@ -4,11 +4,10 @@ ;; font-config.el is mostly top-level font/package setup. These smoke tests ;; cover the logic that should stay correct regardless of which fonts are -;; installed: the install check, and the daemon-frame font applier (env-gui-p -;; guard plus idempotency). The module :demand's fontaine and references -;; nerd-icons, so the tests skip when those packages are absent rather than -;; failing on a bare checkout. GUI and font lookups are stubbed so the run -;; stays headless. +;; installed: the install check, task-oriented Fontaine picker, persistence, +;; and emoji setup. The module :demand's fontaine and references nerd-icons, so +;; the tests skip when those packages are absent rather than failing on a bare +;; checkout. GUI and font lookups are stubbed so the run stays headless. ;;; Code: @@ -41,34 +40,32 @@ (cl-letf (((symbol-function 'find-font) (lambda (&rest _) nil))) (should (null (cj/font-installed-p "No Such Font 12345"))))) -;;; cj/apply-font-settings-to-frame +;;; cj/maybe-install-nerd-icons-fonts -(ert-deftest test-font-config-apply-font-settings-noop-without-gui () - "Boundary: on a non-GUI frame the applier does nothing and does not error." +(ert-deftest test-font-config-nerd-icons-missing-font-installs-on-gui () + "Normal: a missing Nerd Icons font is installed on a GUI frame." (skip-unless test-font-config--available) (require 'font-config) - (let ((cj/fontaine-configured-frames nil) - (applied nil)) - (cl-letf (((symbol-function 'env-gui-p) (lambda (&rest _) nil)) - ((symbol-function 'fontaine-set-preset) - (lambda (&rest _) (setq applied t)))) - (cj/apply-font-settings-to-frame (selected-frame)) - (should-not applied) - (should-not cj/fontaine-configured-frames)))) - -(ert-deftest test-font-config-apply-font-settings-applies-once-per-frame () - "Normal: on a GUI frame the applier sets the preset once and is idempotent." - (skip-unless test-font-config--available) - (require 'font-config) - (let ((cj/fontaine-configured-frames nil) - (calls 0)) - (cl-letf (((symbol-function 'env-gui-p) (lambda (&rest _) t)) - ((symbol-function 'fontaine-set-preset) - (lambda (&rest _) (setq calls (1+ calls))))) - (cj/apply-font-settings-to-frame (selected-frame)) - (cj/apply-font-settings-to-frame (selected-frame)) - (should (= calls 1)) - (should (memq (selected-frame) cj/fontaine-configured-frames))))) + (let ((installed nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) + ((symbol-function 'cj/font-installed-p) (lambda (_name) nil)) + ((symbol-function 'nerd-icons-install-fonts) + (lambda (&rest _) (setq installed t))) + ((symbol-function 'remove-hook) #'ignore)) + (cj/maybe-install-nerd-icons-fonts)) + (should installed))) + +(ert-deftest test-font-config-nerd-icons-installed-font-skips-install () + "Boundary: an installed Nerd Icons font needs no install attempt." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((installed nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) + ((symbol-function 'cj/font-installed-p) (lambda (_name) t)) + ((symbol-function 'nerd-icons-install-fonts) + (lambda (&rest _) (setq installed t)))) + (cj/maybe-install-nerd-icons-fonts)) + (should-not installed))) ;;; cj/setup-emoji-fontset @@ -135,5 +132,206 @@ (when (get-buffer "*Available Fonts*") (kill-buffer "*Available Fonts*"))))) +;;; Fontaine workflow profiles + +(ert-deftest test-font-config-fontaine-presets-are-task-oriented () + "Normal: the picker exposes eight complete workflow destinations." + (skip-unless test-font-config--available) + (require 'font-config) + (should (equal (delq t (mapcar #'car fontaine-presets)) + '(everyday writing reading coding-xs coding-m coding-l coding-xl + presentation)))) + +(ert-deftest test-font-config-fontaine-candidates-describe-end-state () + "Normal: every profile label names its purpose, fonts, and point size." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((candidates (cj/fontaine-profile-candidates))) + (should (= (length candidates) 8)) + (should (member (nth 0 candidates) + '("Everyday — Berkeley Mono + Lexend · 13 pt" + "Everyday — Berkeley Mono + Lexend · 14 pt"))) + (should (equal (nth 1 candidates) + "Writing — Berkeley Mono + Merriweather · 14 pt")) + (should (equal (nth 2 candidates) + "Reading — Merriweather · 14 pt")) + (should (equal (nth 3 candidates) + "Coding XS — Berkeley Mono · 11 pt")) + (should (equal (nth 4 candidates) + "Coding M — Berkeley Mono · 13 pt")) + (should (equal (nth 5 candidates) + "Coding L — Berkeley Mono · 14 pt")) + (should (equal (nth 6 candidates) + "Coding XL — Berkeley Mono · 16 pt")) + (should (equal (nth 7 candidates) + "Presentation — Berkeley Mono + Lexend · 20 pt")))) + +(ert-deftest test-font-config-fontaine-candidate-round-trips-to-profile () + "Boundary: a displayed destination maps back to its Fontaine symbol." + (skip-unless test-font-config--available) + (require 'font-config) + (dolist (profile '(everyday writing reading coding-xs coding-m coding-l coding-xl + presentation)) + (let ((label (cj/fontaine-profile-label profile))) + (should (eq (cj/fontaine-profile-from-label label) profile))))) + +(ert-deftest test-font-config-fontaine-uses-one-monospace-family () + "Normal: every workflow profile uses Berkeley Mono for fixed pitch." + (skip-unless test-font-config--available) + (require 'font-config) + (dolist (profile '(everyday writing coding-xs coding-m coding-l coding-xl presentation)) + (let ((properties (fontaine--get-preset-properties profile))) + (should (equal (plist-get properties :default-family) + "BerkeleyMono Nerd Font"))))) + +(ert-deftest test-font-config-fontaine-reading-is-merriweather-only () + "Normal: Reading uses Merriweather for every primary face family." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((properties (fontaine--get-preset-properties 'reading))) + (dolist (property '(:default-family + :fixed-pitch-family + :fixed-pitch-serif-family + :variable-pitch-family)) + (should (equal (plist-get properties property) "Merriweather"))))) + +(ert-deftest test-font-config-fontaine-reading-properties-are-public () + "Normal: consumers can resolve Reading without Fontaine private functions." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((properties (cj/fontaine-profile-properties 'reading))) + (should (equal (plist-get properties :default-family) "Merriweather")) + (should (= (plist-get properties :default-height) 140)))) + +(ert-deftest test-font-config-fontaine-remaps-reading-buffer-locally () + "Normal: the local adapter applies all Reading families at an override height." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((calls nil)) + (cl-letf (((symbol-function 'face-remap-add-relative) + (lambda (face &rest properties) + (push (cons face properties) calls) + face))) + (should (equal (cj/fontaine-remap-buffer-to-profile 'reading 180) + '(default fixed-pitch fixed-pitch-serif variable-pitch)))) + (dolist (face '(default fixed-pitch fixed-pitch-serif variable-pitch)) + (should (member (list face :family "Merriweather" :height 180) + calls))))) + +(ert-deftest test-font-config-fontaine-ui-buffer-remaps-default-to-berkeley () + "Normal: minibuffer and echo buffers remap their default face to Berkeley." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((base nil)) + (cl-letf (((symbol-function 'face-remap-set-base) + (lambda (face &rest specs) (setq base (cons face specs))))) + (cj/fontaine-remap-ui-buffer)) + (should (equal base + '(default (:family "BerkeleyMono Nerd Font")))))) + +(ert-deftest test-font-config-fontaine-ui-chrome-stays-berkeley () + "Normal: Fontaine reasserts Berkeley on chrome faces and echo buffers." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((faces nil) + (remap-count 0)) + (cl-letf (((symbol-function 'facep) (lambda (_face) t)) + ((symbol-function 'set-face-attribute) + (lambda (face _frame &rest properties) + (push (cons face properties) faces))) + ((symbol-function 'get-buffer) (lambda (_name) (current-buffer))) + ((symbol-function 'cj/fontaine-remap-ui-buffer) + (lambda () (setq remap-count (1+ remap-count))))) + (cj/fontaine-keep-ui-chrome-monospace)) + (dolist (face '(mode-line mode-line-active mode-line-inactive + minibuffer-prompt)) + (should (member (list face :family "BerkeleyMono Nerd Font") faces))) + (should (= remap-count 2)))) + +(ert-deftest test-font-config-fontaine-ui-chrome-hooks-are-installed () + "Boundary: profile, theme, and minibuffer changes restore UI typography." + (skip-unless test-font-config--available) + (require 'font-config) + (should (memq 'cj/fontaine-keep-ui-chrome-monospace + fontaine-set-preset-hook)) + (should (memq 'cj/fontaine-keep-ui-chrome-monospace + enable-theme-functions)) + (should (memq 'cj/fontaine-remap-ui-buffer minibuffer-setup-hook))) + +(ert-deftest test-font-config-fontaine-unknown-label-has-no-profile () + "Error: an unknown destination label does not select a preset." + (skip-unless test-font-config--available) + (require 'font-config) + (should-not (cj/fontaine-profile-from-label "Missing profile"))) + +(ert-deftest test-font-config-fontaine-annotation-marks-current-profile () + "Normal: completion marks only the active workflow destination." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((fontaine-current-preset 'writing)) + (should (equal (cj/fontaine-profile-annotation + (cj/fontaine-profile-label 'writing)) + " current")) + (should (equal (cj/fontaine-profile-annotation + (cj/fontaine-profile-label 'coding-m)) + "")))) + +(ert-deftest test-font-config-fontaine-selector-applies-picked-profile () + "Normal: the one-prompt picker maps its complete label before applying." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((picked (cj/fontaine-profile-label 'presentation)) + (applied nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _choices &rest _) picked)) + ((symbol-function 'cj/fontaine-apply-profile) + (lambda (profile) (setq applied profile)))) + (cj/fontaine-select-profile) + (should (eq applied 'presentation))))) + +(ert-deftest test-font-config-fontaine-restores-valid-profile () + "Normal: startup restores a persisted workflow profile." + (skip-unless test-font-config--available) + (require 'font-config) + (cl-letf (((symbol-function 'fontaine-restore-latest-preset) + (lambda () 'writing))) + (should (eq (cj/fontaine-restored-or-default-profile) 'writing)))) + +(ert-deftest test-font-config-fontaine-rejects-obsolete-restored-profile () + "Boundary: an old brand or point-size preset falls back to everyday." + (skip-unless test-font-config--available) + (require 'font-config) + (cl-letf (((symbol-function 'fontaine-restore-latest-preset) + (lambda () '13-point-font))) + (should (eq (cj/fontaine-restored-or-default-profile) 'everyday)))) + +(ert-deftest test-font-config-fontaine-has-no-per-frame-reset-hook () + "Boundary: creating a daemon frame cannot overwrite the active profile." + (skip-unless test-font-config--available) + (require 'font-config) + (should-not (memq 'cj/apply-font-settings-to-frame + server-after-make-frame-hook)) + (should-not (memq 'cj/cleanup-frame-list delete-frame-functions))) + +(ert-deftest test-font-config-fontaine-apply-records-profile-for-persistence () + "Normal: applying a profile updates Fontaine history before setting it." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((fontaine-preset-history nil) + (applied nil)) + (cl-letf (((symbol-function 'fontaine-set-preset) + (lambda (profile) (setq applied profile)))) + (cj/fontaine-apply-profile 'coding-m) + (should (eq applied 'coding-m)) + (should (equal (car fontaine-preset-history) "coding-m"))))) + +(ert-deftest test-font-config-fontaine-apply-rejects-unknown-profile () + "Error: applying an unknown workflow profile signals a user error." + (skip-unless test-font-config--available) + (require 'font-config) + (cl-letf (((symbol-function 'fontaine-set-preset) + (lambda (_profile) (ert-fail "must not apply")))) + (should-error (cj/fontaine-apply-profile 'missing) :type 'user-error))) + (provide 'test-font-config) ;;; test-font-config.el ends here diff --git a/tests/test-help-utils--arch-wiki-search.el b/tests/test-help-utils--arch-wiki-search.el new file mode 100644 index 00000000..d02dd041 --- /dev/null +++ b/tests/test-help-utils--arch-wiki-search.el @@ -0,0 +1,124 @@ +;;; test-help-utils--arch-wiki-search.el --- Tests for the ArchWiki search guard -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/--arch-wiki-topics and the cj/local-arch-wiki-search command. +;; +;; The bug: the command read "/usr/share/doc/arch-wiki/html/en" with +;; `directory-files' before checking the directory existed. On a machine +;; without arch-wiki-docs -- the exact state the command's own error text is +;; written for -- that signaled file-missing on the first line, so the friendly +;; "Is arch-wiki-docs installed?" message below it was unreachable. The user +;; got a raw Lisp error naming a path instead of the install hint. +;; +;; Two things had to change to make this testable. The directory was +;; hardcoded inside the command, so a test could only ever exercise whatever +;; the developer's own machine happened to have installed; it is now +;; `cj/arch-wiki-html-dir'. And the directory read is now the pure helper +;; cj/--arch-wiki-topics, which takes a directory and returns an alist, so the +;; interesting cases are driven with real temporary directories instead of +;; mocking `directory-files'. +;; +;; Test organization: +;; - Normal Cases: topics found and returned; the command opens the choice +;; - Boundary Cases: empty dir, single topic, a name matching no topic +;; - Error Cases: missing dir returns nil and reports the install hint +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'help-utils) + +(defmacro test-arch-wiki--with-topics (dir-var topics &rest body) + "Bind DIR-VAR to a temp dir holding TOPICS (a list of html basenames). +The directory is removed after BODY." + (declare (indent 2)) + `(let ((,dir-var (make-temp-file "arch-wiki-test" t))) + (unwind-protect + (progn + (dolist (name ,topics) + (write-region "" nil (expand-file-name (concat name ".html") ,dir-var))) + ,@body) + (delete-directory ,dir-var t)))) + +;;; Normal Cases — the pure helper + +(ert-deftest test-help-utils-arch-wiki-topics-lists-html-basenames () + "Normal: each .html file becomes a (basename . fullpath) pair." + (test-arch-wiki--with-topics dir '("Systemd" "Pacman") + (let ((topics (cj/--arch-wiki-topics dir))) + (should (equal '("Pacman" "Systemd") (sort (mapcar #'car topics) #'string<))) + (should (string-suffix-p "Systemd.html" (cdr (assoc "Systemd" topics))))))) + +(ert-deftest test-help-utils-arch-wiki-topics-ignores-non-html () + "Normal: files without the .html extension are not topics." + (test-arch-wiki--with-topics dir '("Systemd") + (write-region "" nil (expand-file-name "README.txt" dir)) + (should (equal '("Systemd") (mapcar #'car (cj/--arch-wiki-topics dir)))))) + +;;; Boundary Cases + +(ert-deftest test-help-utils-arch-wiki-topics-empty-dir-is-nil () + "Boundary: an existing but empty directory yields no topics." + (test-arch-wiki--with-topics dir '() + (should (null (cj/--arch-wiki-topics dir))))) + +(ert-deftest test-help-utils-arch-wiki-topics-single-topic () + "Boundary: one topic returns a one-element alist." + (test-arch-wiki--with-topics dir '("Systemd") + (should (= 1 (length (cj/--arch-wiki-topics dir)))))) + +;;; Error Cases — the missing-install path + +(ert-deftest test-help-utils-arch-wiki-topics-missing-dir-returns-nil () + "Error: an absent directory returns nil rather than signaling file-missing." + (let ((missing (expand-file-name "definitely-absent-arch-wiki" + temporary-file-directory))) + (should-not (file-directory-p missing)) + (should (null (cj/--arch-wiki-topics missing))))) + +(ert-deftest test-help-utils-arch-wiki-search-missing-dir-reports-hint () + "Error: the command reports the install hint and opens nothing." + (let ((cj/arch-wiki-html-dir (expand-file-name "definitely-absent-arch-wiki" + temporary-file-directory)) + (said nil) + (opened nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq said (apply #'format fmt args)) nil)) + ((symbol-function 'eww-browse-url) + (lambda (url &rest _) (setq opened url)))) + ;; Must not signal: this is the case that used to raise file-missing. + (cj/local-arch-wiki-search)) + (should-not opened) + (should (string-match-p "arch-wiki-docs" said)))) + +;;; Normal Cases — the command + +(ert-deftest test-help-utils-arch-wiki-search-opens-chosen-topic () + "Normal: the chosen topic is opened as a file URL in EWW." + (test-arch-wiki--with-topics dir '("Systemd") + (let ((cj/arch-wiki-html-dir dir) + (opened nil)) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "Systemd")) + ((symbol-function 'eww-browse-url) + (lambda (url &rest _) (setq opened url)))) + (cj/local-arch-wiki-search)) + (should (string-prefix-p "file://" opened)) + (should (string-suffix-p "Systemd.html" opened)) + ;; The opened path is the one in the temp dir, not a system copy. + (should (string-match-p (regexp-quote dir) opened))))) + +(ert-deftest test-help-utils-arch-wiki-search-unknown-topic-opens-nothing () + "Boundary: a name matching no topic reports rather than opening." + (test-arch-wiki--with-topics dir '("Systemd") + (let ((cj/arch-wiki-html-dir dir) + (opened nil)) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "NotATopic")) + ((symbol-function 'message) (lambda (&rest _) nil)) + ((symbol-function 'eww-browse-url) + (lambda (url &rest _) (setq opened url)))) + (cj/local-arch-wiki-search)) + (should-not opened)))) + +(provide 'test-help-utils--arch-wiki-search) +;;; test-help-utils--arch-wiki-search.el ends here diff --git a/tests/test-host-environment--detect-system-timezone.el b/tests/test-host-environment--detect-system-timezone.el index 209283d1..0d76c206 100644 --- a/tests/test-host-environment--detect-system-timezone.el +++ b/tests/test-host-environment--detect-system-timezone.el @@ -17,12 +17,23 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'host-environment) -(ert-deftest test-host-environment-detect-tz-match-localtime-wins () - "Normal: when match-localtime-to-zoneinfo returns a value, that wins." +(ert-deftest test-host-environment-detect-tz-env-wins-without-content-scan () + "Normal: an explicit TZ wins and the exhaustive zoneinfo scan never runs. +The scan reads hundreds of files; it used to run first on every call even +when a cheap O(1) method would answer." (cl-letf (((symbol-function 'cj/match-localtime-to-zoneinfo) - (lambda () "America/Los_Angeles")) + (lambda () (error "content scan should not have run"))) ((symbol-function 'getenv) - (lambda (_ &rest _) (error "TZ should not have been consulted")))) + (lambda (name &rest _) (when (string= name "TZ") "America/Chicago")))) + (should (equal (cj/detect-system-timezone) "America/Chicago")))) + +(ert-deftest test-host-environment-detect-tz-content-scan-is-last-resort () + "Boundary: with every cheap method empty, the content scan still answers." + (cl-letf (((symbol-function 'cj/match-localtime-to-zoneinfo) + (lambda () "America/Los_Angeles")) + ((symbol-function 'getenv) (lambda (&rest _) nil)) + ((symbol-function 'file-exists-p) (lambda (&rest _) nil)) + ((symbol-function 'file-symlink-p) (lambda (&rest _) nil))) (should (equal (cj/detect-system-timezone) "America/Los_Angeles")))) (ert-deftest test-host-environment-detect-tz-env-var-wins-when-match-nil () diff --git a/tests/test-httpd-config--defer.el b/tests/test-httpd-config--defer.el new file mode 100644 index 00000000..1a1fbbed --- /dev/null +++ b/tests/test-httpd-config--defer.el @@ -0,0 +1,34 @@ +;;; test-httpd-config--defer.el --- Tests for httpd-config lazy loading -*- lexical-binding: t -*- + +;;; Commentary: +;; Pins httpd-config's load-time behavior: merely loading the module must +;; not create the www directory (that belongs to the moment simple-httpd +;; actually loads) and must not pull in simple-httpd itself — +;; impatient-mode requires it on demand. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;;; Boundary Cases + +(ert-deftest test-httpd-config-load-creates-no-www-dir () + "Boundary: loading httpd-config does not create www/ in user-emacs-directory." + (let* ((sandbox (make-temp-file "httpd-config-test-" t)) + (user-emacs-directory (file-name-as-directory sandbox))) + (unwind-protect + (progn + (require 'httpd-config) + (should-not (file-directory-p + (expand-file-name "www" user-emacs-directory)))) + (delete-directory sandbox t)))) + +(ert-deftest test-httpd-config-load-does-not-load-simple-httpd () + "Boundary: loading httpd-config leaves simple-httpd unloaded." + (require 'httpd-config) + (should-not (featurep 'simple-httpd))) + +(provide 'test-httpd-config--defer) +;;; test-httpd-config--defer.el ends here diff --git a/tests/test-hugo-config--keymap.el b/tests/test-hugo-config--keymap.el new file mode 100644 index 00000000..0f8df257 --- /dev/null +++ b/tests/test-hugo-config--keymap.el @@ -0,0 +1,71 @@ +;;; test-hugo-config--keymap.el --- Tests for the Hugo prefix keymap -*- lexical-binding: t; -*- + +;;; Commentary: +;; Pins the eight Hugo commands reachable under the "C-; h" prefix. +;; +;; The module used to install these with eight raw `global-set-key' calls plus +;; a hand-written which-key block, writing into the global map directly instead +;; of going through `cj/register-prefix-map' the way its siblings +;; (erc-config, custom-ordering, org-reveal-config) do. These tests were added +;; alongside that conversion so the refactor is checkable: every key must still +;; reach the same command afterward. +;; +;; Test organization: +;; - Normal Cases: each of the eight keys resolves to its command +;; - Boundary Cases: case-distinct pairs stay distinct; the map is a prefix map +;; - Error Cases: an unbound key in the map resolves to nothing +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(provide 'ox-hugo) +(require 'hugo-config) +(require 'keybindings) + +(defconst test-hugo--expected-bindings + '(("n" . cj/hugo-new-post) + ("e" . cj/hugo-export-post) + ("o" . cj/hugo-open-blog-dir) + ("O" . cj/hugo-open-blog-dir-external) + ("d" . cj/hugo-open-draft) + ("D" . cj/hugo-toggle-draft) + ("p" . cj/hugo-preview) + ("P" . cj/hugo-publish)) + "Every key the Hugo prefix map must carry, and the command it runs.") + +;;; Normal Cases + +(ert-deftest test-hugo-config-keymap-binds-every-command () + "Normal: each Hugo key resolves to its command inside the prefix map." + (dolist (pair test-hugo--expected-bindings) + (should (eq (cdr pair) (keymap-lookup cj/hugo-keymap (car pair)))))) + +(ert-deftest test-hugo-config-keymap-registered-under-custom-prefix () + "Normal: the map is reachable at \"h\" within `cj/custom-keymap'." + (should (eq cj/hugo-keymap (keymap-lookup cj/custom-keymap "h")))) + +;;; Boundary Cases + +(ert-deftest test-hugo-config-keymap-case-pairs-stay-distinct () + "Boundary: the shifted variants run different commands than their lowercase +counterparts, which a case-folding binding would silently collapse." + (should-not (eq (keymap-lookup cj/hugo-keymap "o") + (keymap-lookup cj/hugo-keymap "O"))) + (should-not (eq (keymap-lookup cj/hugo-keymap "d") + (keymap-lookup cj/hugo-keymap "D"))) + (should-not (eq (keymap-lookup cj/hugo-keymap "p") + (keymap-lookup cj/hugo-keymap "P")))) + +(ert-deftest test-hugo-config-keymap-is-a-keymap () + "Boundary: the value registered as a prefix is an actual keymap." + (should (keymapp cj/hugo-keymap))) + +;;; Error Cases + +(ert-deftest test-hugo-config-keymap-unbound-key-is-nil () + "Error: a key the map does not define resolves to nothing." + (should-not (keymap-lookup cj/hugo-keymap "z"))) + +(provide 'test-hugo-config--keymap) +;;; test-hugo-config--keymap.el ends here diff --git a/tests/test-integration-recording-device-workflow.el b/tests/test-integration-recording-device-workflow.el index 3ef631f3..27ffac56 100644 --- a/tests/test-integration-recording-device-workflow.el +++ b/tests/test-integration-recording-device-workflow.el @@ -1,26 +1,24 @@ ;;; test-integration-recording-device-workflow.el --- Integration tests for recording device workflow -*- lexical-binding: t; -*- ;;; Commentary: -;; Integration tests covering the complete device detection and grouping workflow. -;; -;; This tests the full pipeline from raw pactl output through parsing, grouping, -;; and friendly name assignment. The workflow enables users to select audio devices -;; for recording calls/meetings. +;; Integration test covering the device detection path that recording actually +;; uses: raw pactl output through parsing and into friendly state names. ;; ;; Components integrated: ;; - cj/recording--parse-pactl-output (parse raw pactl output into structured data) -;; - cj/recording-parse-sources (shell command wrapper) -;; - cj/recording-group-devices-by-hardware (group inputs/monitors by device) +;; - cj/recording-parse-sources (shell command wrapper, MOCKED at +;; shell-command-to-string so no pactl runs) ;; - cj/recording-friendly-state (convert technical state names) -;; - Bluetooth MAC address normalization (colons → underscores) -;; - Device name pattern matching (USB, PCI, Bluetooth) -;; - Friendly name assignment (user-facing device names) ;; ;; Critical integration points: -;; - Parse output must produce data that group-devices can process -;; - Bluetooth MAC normalization must work across parse→group boundary -;; - Incomplete devices (only mic OR only monitor) must be filtered -;; - Friendly names must correctly identify device types +;; - Parse output must carry device state through to the friendly-name conversion +;; +;; This file once covered a parse-to-group pipeline as well. That half tested +;; cj/recording-group-devices-by-hardware, a second device-grouping +;; implementation nothing ever called -- cj/recording-select-device is the live +;; selection path and reaches parse-sources directly. The function and its +;; tests were removed rather than left as coverage that proved an unused code +;; path worked. ;;; Code: @@ -46,58 +44,6 @@ ;;; Normal Cases - Complete Workflow -(ert-deftest test-integration-recording-device-workflow-parse-to-group-all-devices () - "Test complete workflow from pactl output to grouped devices. - -When pactl output contains all three device types (built-in, USB, Bluetooth), -the workflow should parse, group, and assign friendly names to all devices. - -Components integrated: -- cj/recording--parse-pactl-output (parsing) -- cj/recording-group-devices-by-hardware (grouping + MAC normalization) -- Device pattern matching (USB/PCI/Bluetooth detection) -- Friendly name assignment - -Validates: -- All three device types are detected -- Bluetooth MAC addresses normalized (colons → underscores) -- Each device has both mic and monitor -- Friendly names correctly assigned -- Complete data flow: raw output → parsed list → grouped pairs" - (let ((output (test-load-fixture "pactl-output-normal.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - ;; Test parse step - (let ((parsed (cj/recording-parse-sources))) - (should (= 6 (length parsed))) - - ;; Test group step (receives parsed data) - (let ((grouped (cj/recording-group-devices-by-hardware))) - (should (= 3 (length grouped))) - - ;; Validate built-in device - (let ((built-in (assoc "Built-in Audio" grouped))) - (should built-in) - (should (string-prefix-p "alsa_input.pci" (cadr built-in))) - (should (string-prefix-p "alsa_output.pci" (cddr built-in)))) - - ;; Validate USB device - (let ((usb (assoc "Jabra SPEAK 510 USB" grouped))) - (should usb) - (should (string-match-p "Jabra" (cadr usb))) - (should (string-match-p "Jabra" (cddr usb)))) - - ;; Validate Bluetooth device (CRITICAL: MAC normalization) - (let ((bluetooth (assoc "Bluetooth Headset" grouped))) - (should bluetooth) - ;; Input has colons - (should (string-match-p "00:1B:66:C0:91:6D" (cadr bluetooth))) - ;; Output has underscores - (should (string-match-p "00_1B_66_C0_91_6D" (cddr bluetooth))) - ;; But they're grouped together! - (should (equal "bluez_input.00:1B:66:C0:91:6D" (cadr bluetooth))) - (should (equal "bluez_output.00_1B_66_C0_91_6D.1.monitor" (cddr bluetooth))))))))) - (ert-deftest test-integration-recording-device-workflow-friendly-states-in-list () "Test that friendly state names appear in device list output. @@ -128,105 +74,5 @@ Validates: ;;; Boundary Cases - Incomplete Devices -(ert-deftest test-integration-recording-device-workflow-incomplete-devices-filtered () - "Test that devices with only mic OR only monitor are filtered out. - -For call recording, we need BOTH mic and monitor from the same device. -Incomplete devices should not appear in the grouped output. - -Components integrated: -- cj/recording-parse-sources (parsing all devices) -- cj/recording-group-devices-by-hardware (filtering incomplete pairs) - -Validates: -- Device with only mic is filtered -- Device with only monitor is filtered -- Only complete devices (both mic and monitor) are returned -- Filtering happens at group stage, not parse stage" - (let ((output (concat - ;; Complete device - "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" - "49\talsa_output.pci-0000_00_1f.3.analog-stereo.monitor\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" - ;; Incomplete: USB mic with no monitor - "100\talsa_input.usb-device.mono-fallback\tPipeWire\ts16le 1ch 16000Hz\tSUSPENDED\n" - ;; Incomplete: Bluetooth monitor with no mic - "81\tbluez_output.AA_BB_CC_DD_EE_FF.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - ;; Parse sees all 4 devices - (let ((parsed (cj/recording-parse-sources))) - (should (= 4 (length parsed))) - - ;; Group returns only 1 complete device - (let ((grouped (cj/recording-group-devices-by-hardware))) - (should (= 1 (length grouped))) - (should (equal "Built-in Audio" (caar grouped)))))))) - -;;; Edge Cases - Bluetooth MAC Normalization - -(ert-deftest test-integration-recording-device-workflow-bluetooth-mac-variations () - "Test Bluetooth MAC normalization with different formats. - -Bluetooth devices use colons in input names but underscores in output names. -The grouping must normalize these to match devices correctly. - -Components integrated: -- cj/recording-parse-sources (preserves original MAC format) -- cj/recording-group-devices-by-hardware (normalizes MAC for matching) -- Base name extraction (regex patterns) -- MAC address transformation (underscores → colons) - -Validates: -- Input with colons (bluez_input.AA:BB:CC:DD:EE:FF) parsed correctly -- Output with underscores (bluez_output.AA_BB_CC_DD_EE_FF) parsed correctly -- Normalization happens during grouping -- Devices paired despite format difference -- Original device names preserved (not mutated)" - (let ((output (concat - "79\tbluez_input.11:22:33:44:55:66\tPipeWire\tfloat32le 1ch 48000Hz\tSUSPENDED\n" - "81\tbluez_output.11_22_33_44_55_66.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((parsed (cj/recording-parse-sources))) - ;; Original formats preserved in parse - (should (string-match-p "11:22:33" (caar parsed))) - (should (string-match-p "11_22_33" (caadr parsed))) - - ;; But grouping matches them - (let ((grouped (cj/recording-group-devices-by-hardware))) - (should (= 1 (length grouped))) - (should (equal "Bluetooth Headset" (caar grouped))) - ;; Original names preserved - (should (equal "bluez_input.11:22:33:44:55:66" (cadar grouped))) - (should (equal "bluez_output.11_22_33_44_55_66.1.monitor" (cddar grouped)))))))) - -;;; Error Cases - Malformed Data - -(ert-deftest test-integration-recording-device-workflow-malformed-output-handled () - "Test that malformed pactl output is handled gracefully. - -When pactl output is malformed or unparseable, the workflow should not crash. -It should return empty results at appropriate stages. - -Components integrated: -- cj/recording--parse-pactl-output (malformed line handling) -- cj/recording-group-devices-by-hardware (empty input handling) - -Validates: -- Malformed lines are silently skipped during parse -- Empty parse results don't crash grouping -- Workflow degrades gracefully -- No exceptions thrown" - (let ((output (test-load-fixture "pactl-output-malformed.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((parsed (cj/recording-parse-sources))) - ;; Malformed output produces empty parse - (should (null parsed)) - - ;; Empty parse produces empty grouping (no crash) - (let ((grouped (cj/recording-group-devices-by-hardware))) - (should (null grouped))))))) - (provide 'test-integration-recording-device-workflow) ;;; test-integration-recording-device-workflow.el ends here diff --git a/tests/test-jumper.el b/tests/test-jumper.el index fa65d3f4..638f2aa2 100644 --- a/tests/test-jumper.el +++ b/tests/test-jumper.el @@ -348,5 +348,30 @@ (should (string-match-p "test line" formatted)))) (test-jumper-teardown)) +;;; Empty completing-read input (vertico-less UI can return "") + +(ert-deftest test-jumper-jump-empty-choice-signals-user-error () + "Error: empty input at the jump prompt gives a user-error, not a crash. +An unmatched choice makes (cdr (assoc ...)) nil, which used to flow into +the index arithmetic and signal wrong-type-argument." + (let ((jumper--next-index 2)) + (cl-letf (((symbol-function 'jumper--location-candidates) + (lambda () '(("[0] here" . 0) ("[1] there" . 1)))) + ((symbol-function 'get-register) (lambda (_r) nil)) + ((symbol-function 'completing-read) (lambda (&rest _) ""))) + (should-error (jumper-jump-to-location) :type 'user-error)))) + +(ert-deftest test-jumper-remove-empty-choice-cancels () + "Boundary: empty input at the remove prompt cancels instead of crashing." + (let ((jumper--next-index 2) + removed) + (cl-letf (((symbol-function 'jumper--location-candidates) + (lambda () '(("[0] here" . 0) ("[1] there" . 1)))) + ((symbol-function 'completing-read) (lambda (&rest _) "")) + ((symbol-function 'jumper--reorder-registers) + (lambda (_i) (setq removed t)))) + (jumper-remove-location) + (should-not removed)))) + (provide 'test-jumper) ;;; test-jumper.el ends here diff --git a/tests/test-media-utils--argv.el b/tests/test-media-utils--argv.el new file mode 100644 index 00000000..81317b60 --- /dev/null +++ b/tests/test-media-utils--argv.el @@ -0,0 +1,72 @@ +;;; test-media-utils--argv.el --- Tests for media-utils argv builders -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for the pure helpers behind cj/media-play-it's shell-free +;; launch: cj/media--yt-dlp-argv (stream-URL resolution command), +;; cj/media--stream-urls (yt-dlp -g output parsing), and +;; cj/media--play-argv (player launch argv). Argv lists are the +;; hardening: URLs and args never meet a shell. +;; +;; Test organization: +;; - Normal Cases: formats present/absent, args split, multi-line output +;; - Boundary Cases: metacharacter URLs verbatim, empty output, nil args +;; - Error Cases: none (builders are total; error paths live in the caller) +;; +;;; Code: + +(require 'ert) +(require 'media-utils) + +;;; cj/media--yt-dlp-argv + +(ert-deftest test-media-utils--yt-dlp-argv-normal-with-formats () + "Normal: formats join with / behind -f, URL last." + (should (equal (cj/media--yt-dlp-argv "https://example.com/v" '("22" "18" "best")) + '("yt-dlp" "-f" "22/18/best" "-g" "https://example.com/v")))) + +(ert-deftest test-media-utils--yt-dlp-argv-normal-without-formats () + "Normal: nil formats drops the -f pair." + (should (equal (cj/media--yt-dlp-argv "https://example.com/v" nil) + '("yt-dlp" "-g" "https://example.com/v")))) + +(ert-deftest test-media-utils--yt-dlp-argv-boundary-metacharacter-url () + "Boundary: a URL with shell metacharacters stays one verbatim element." + (let ((url "https://example.com/v?a=1&b=$(x);c='d'")) + (should (equal (car (last (cj/media--yt-dlp-argv url nil))) url)))) + +;;; cj/media--stream-urls + +(ert-deftest test-media-utils--stream-urls-normal-two-lines () + "Normal: each non-empty output line is one stream URL." + (should (equal (cj/media--stream-urls "https://a/video\nhttps://a/audio\n") + '("https://a/video" "https://a/audio")))) + +(ert-deftest test-media-utils--stream-urls-boundary-blank-and-crlf () + "Boundary: blank lines and CR line endings are stripped." + (should (equal (cj/media--stream-urls "https://a/v\r\n\n \nhttps://a/u\r\n") + '("https://a/v" "https://a/u")))) + +(ert-deftest test-media-utils--stream-urls-boundary-empty-output () + "Boundary: empty output yields nil." + (should-not (cj/media--stream-urls ""))) + +;;; cj/media--play-argv + +(ert-deftest test-media-utils--play-argv-normal-args-split () + "Normal: the player's raw args string splits into argv words." + (should (equal (cj/media--play-argv "vlc" "--no-video --intf dummy" + '("https://a/v")) + '("vlc" "--no-video" "--intf" "dummy" "https://a/v")))) + +(ert-deftest test-media-utils--play-argv-boundary-nil-args () + "Boundary: nil args yields program + URLs only." + (should (equal (cj/media--play-argv "mpv" nil '("https://a/v")) + '("mpv" "https://a/v")))) + +(ert-deftest test-media-utils--play-argv-boundary-multiple-urls () + "Boundary: every resolved stream URL is appended in order." + (should (equal (cj/media--play-argv "mpv" nil '("https://a/v" "https://a/u")) + '("mpv" "https://a/v" "https://a/u")))) + +(provide 'test-media-utils--argv) +;;; test-media-utils--argv.el ends here diff --git a/tests/test-media-utils--yt-dl-message.el b/tests/test-media-utils--yt-dl-message.el new file mode 100644 index 00000000..491b64cf --- /dev/null +++ b/tests/test-media-utils--yt-dl-message.el @@ -0,0 +1,64 @@ +;;; test-media-utils--yt-dl-message.el --- Tests for the yt-dl sentinel message -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/media--yt-dl-message, the pure helper behind +;; cj/yt-dl-it's process sentinel. +;; +;; The behavior under test is a correctness fix, not cosmetics. cj/yt-dl-it +;; launches "tsp yt-dlp ...", and tsp enqueues the job and exits immediately. +;; The sentinel therefore fires on tsp's exit, not on yt-dlp's, so the old +;; "Finished downloading" text claimed a completed download at the moment the +;; download was merely queued -- and a yt-dlp failure minutes later was silent. +;; The helper reports queueing, which is the only thing tsp's exit actually +;; proves. +;; +;; Test organization: +;; - Normal Cases: clean tsp exit reports queued; abnormal exit reports failure +;; - Boundary Cases: unrelated events return nil; URL text passes through verbatim +;; - Error Cases: empty event string returns nil +;; +;;; Code: + +(require 'ert) +(require 'media-utils) + +;;; Normal Cases + +(ert-deftest test-media-utils--yt-dl-message-normal-finished-says-queued () + "Normal: a clean tsp exit reports the job queued, never downloaded." + (let ((msg (cj/media--yt-dl-message "finished\n" "https://example.com/v"))) + (should (string-match-p "[Qq]ueued" msg)) + (should-not (string-match-p "[Ff]inished downloading" msg)))) + +(ert-deftest test-media-utils--yt-dl-message-normal-abnormal-reports-failure () + "Normal: an abnormal tsp exit reports that queueing failed." + (let ((msg (cj/media--yt-dl-message "exited abnormally with code 1\n" + "https://example.com/v"))) + (should msg) + (should-not (string-match-p "[Qq]ueued for" msg)))) + +;;; Boundary Cases + +(ert-deftest test-media-utils--yt-dl-message-boundary-unrelated-event-is-nil () + "Boundary: an event that reports neither outcome produces no message." + (should (null (cj/media--yt-dl-message "run\n" "https://example.com/v"))) + (should (null (cj/media--yt-dl-message "stopped\n" "https://example.com/v")))) + +(ert-deftest test-media-utils--yt-dl-message-boundary-url-passes-through () + "Boundary: the URL text is carried into the message verbatim." + (let ((url "https://example.com/watch?v=a&b=c%20d")) + (should (string-match-p (regexp-quote url) + (cj/media--yt-dl-message "finished\n" url))))) + +(ert-deftest test-media-utils--yt-dl-message-boundary-empty-url () + "Boundary: an empty URL still yields a message rather than signaling." + (should (stringp (cj/media--yt-dl-message "finished\n" "")))) + +;;; Error Cases + +(ert-deftest test-media-utils--yt-dl-message-error-empty-event-is-nil () + "Error: an empty event string matches no outcome and returns nil." + (should (null (cj/media--yt-dl-message "" "https://example.com/v")))) + +(provide 'test-media-utils--yt-dl-message) +;;; test-media-utils--yt-dl-message.el ends here diff --git a/tests/test-media-utils.el b/tests/test-media-utils.el index 841b6faf..23b36eeb 100644 --- a/tests/test-media-utils.el +++ b/tests/test-media-utils.el @@ -38,34 +38,41 @@ ;; ----------------------------- cj/media-play-it ------------------------------ (ert-deftest test-media-play-it-direct-playback-command () - "Normal: a player that needs no stream URL gets a plain command, no yt-dlp." + "Normal: a player that needs no stream URL launches an argv process, no yt-dlp." (let (captured cj/default-media-player) (setq cj/default-media-player 'mpv) (cl-letf (((symbol-function 'executable-find) (lambda (_ &rest _) "/usr/bin/mpv")) - ((symbol-function 'start-process-shell-command) - (lambda (_n _b cmd) (setq captured cmd) 'proc)) + ((symbol-function 'start-process) + (lambda (&rest args) (setq captured args) 'proc)) ((symbol-function 'set-process-sentinel) #'ignore) ((symbol-function 'message) #'ignore) ((symbol-function 'cj/log-silently) #'ignore)) (cj/media-play-it "https://example.com/v")) - (should (string-match-p "mpv" captured)) - (should (string-match-p "example\\.com" captured)) - (should-not (string-match-p "yt-dlp" captured)))) - -(ert-deftest test-media-play-it-stream-url-wraps-yt-dlp () - "Normal: a player needing a stream URL wraps the URL in a yt-dlp -g call." - (let (captured cj/default-media-player) + ;; (NAME BUFFER PROGRAM . ARGS) -- program + args are the argv. + (should (equal (nthcdr 2 captured) '("mpv" "https://example.com/v"))) + (should-not (member "yt-dlp" captured)))) + +(ert-deftest test-media-play-it-stream-url-resolves-via-yt-dlp () + "Normal: a stream-URL player resolves through a yt-dlp -g capture, then +launches the player with the resolved URL as argv -- no shell either step." + (let (yt-argv captured cj/default-media-player) (setq cj/default-media-player 'vlc) - (cl-letf (((symbol-function 'executable-find) (lambda (_ &rest _) "/usr/bin/vlc")) - ((symbol-function 'start-process-shell-command) - (lambda (_n _b cmd) (setq captured cmd) 'proc)) + (cl-letf (((symbol-function 'executable-find) (lambda (_ &rest _) "/usr/bin/x")) + ((symbol-function 'call-process) + (lambda (program _infile _dest _display &rest args) + (setq yt-argv (cons program args)) + (insert "https://stream.example.com/resolved\n") + 0)) + ((symbol-function 'start-process) + (lambda (&rest args) (setq captured args) 'proc)) ((symbol-function 'set-process-sentinel) #'ignore) ((symbol-function 'message) #'ignore) ((symbol-function 'cj/log-silently) #'ignore)) (cj/media-play-it "https://example.com/v")) - (should (string-match-p "yt-dlp" captured)) - (should (string-match-p "-g" captured)) - (should (string-match-p "-f 22/18/best" captured)))) + (should (equal yt-argv + '("yt-dlp" "-f" "22/18/best" "-g" "https://example.com/v"))) + (should (equal (nthcdr 2 captured) + '("vlc" "https://stream.example.com/resolved"))))) (ert-deftest test-media-play-it-missing-player-errors () "Error: an unavailable player command signals an error before launching." @@ -74,6 +81,73 @@ (cl-letf (((symbol-function 'executable-find) (lambda (_ &rest _) nil))) (should-error (cj/media-play-it "https://example.com/v"))))) +(ert-deftest test-media-play-it-missing-yt-dlp-errors () + "Error: a stream-URL player with no yt-dlp on PATH aborts before resolving." + (let (cj/default-media-player) + (setq cj/default-media-player 'vlc) + (cl-letf (((symbol-function 'executable-find) + (lambda (cmd &rest _) (and (equal cmd "vlc") "/usr/bin/vlc")))) + (should-error (cj/media-play-it "https://example.com/v"))))) + +(ert-deftest test-media-play-it-yt-dlp-failure-errors () + "Error: a non-zero yt-dlp exit surfaces as an error, player never launches." + (let (launched cj/default-media-player) + (setq cj/default-media-player 'vlc) + (cl-letf (((symbol-function 'executable-find) (lambda (_ &rest _) "/usr/bin/x")) + ((symbol-function 'call-process) + (lambda (&rest _) (insert "ERROR: no video\n") 1)) + ((symbol-function 'start-process) + (lambda (&rest _) (setq launched t) 'proc)) + ((symbol-function 'message) #'ignore)) + (should-error (cj/media-play-it "https://example.com/v"))) + (should-not launched))) + +(ert-deftest test-media-play-it-yt-dlp-empty-output-errors () + "Error: a zero-exit yt-dlp with no output still errors, player never launches." + (let (launched cj/default-media-player) + (setq cj/default-media-player 'vlc) + (cl-letf (((symbol-function 'executable-find) (lambda (_ &rest _) "/usr/bin/x")) + ((symbol-function 'call-process) (lambda (&rest _) 0)) + ((symbol-function 'start-process) + (lambda (&rest _) (setq launched t) 'proc)) + ((symbol-function 'message) #'ignore)) + (should-error (cj/media-play-it "https://example.com/v"))) + (should-not launched))) + +;; -------------------------- cj/media--play-sentinel -------------------------- + +(ert-deftest test-media-utils--play-sentinel-normal-finished-kills-buffer () + "Normal: a finished event reports success and reaps the process buffer." + (let ((buf (generate-new-buffer " *sentinel-test*")) + (said nil)) + (cl-letf (((symbol-function 'process-buffer) (lambda (_p) buf)) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq said (apply #'format fmt args))))) + (funcall (cj/media--play-sentinel "https://a/v") 'proc "finished\n")) + (should (string-match-p "Finished" said)) + (should-not (buffer-live-p buf)))) + +(ert-deftest test-media-utils--play-sentinel-normal-abnormal-exit-kills-buffer () + "Normal: an abnormal exit reports failure and reaps the process buffer." + (let ((buf (generate-new-buffer " *sentinel-test*")) + (said nil)) + (cl-letf (((symbol-function 'process-buffer) (lambda (_p) buf)) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq said (apply #'format fmt args))))) + (funcall (cj/media--play-sentinel "https://a/v") 'proc "exited abnormally with code 2\n")) + (should (string-match-p "failed" said)) + (should-not (buffer-live-p buf)))) + +(ert-deftest test-media-utils--play-sentinel-boundary-other-event-keeps-buffer () + "Boundary: a non-terminal event (e.g. stop) leaves the buffer alone." + (let ((buf (generate-new-buffer " *sentinel-test*"))) + (unwind-protect + (cl-letf (((symbol-function 'process-buffer) (lambda (_p) buf)) + ((symbol-function 'message) #'ignore)) + (funcall (cj/media--play-sentinel "https://a/v") 'proc "stopped\n") + (should (buffer-live-p buf))) + (when (buffer-live-p buf) (kill-buffer buf))))) + ;; ------------------------------- cj/yt-dl-it --------------------------------- (ert-deftest test-media-yt-dl-it-errors-without-yt-dlp () diff --git a/tests/test-music-config--add-dired-selection.el b/tests/test-music-config--add-dired-selection.el new file mode 100644 index 00000000..9380409c --- /dev/null +++ b/tests/test-music-config--add-dired-selection.el @@ -0,0 +1,64 @@ +;;; test-music-config--add-dired-selection.el --- Tests for dired add command -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music-add-dired-selection. +;; +;; Test organization: +;; - Normal Cases: marked files (no region) are all queued +;; - Boundary Cases: no marks falls back to the file at point +;; - Error Cases: outside dired signals a user-error +;; +;;; Code: + +(require 'ert) +(require 'cl-lib) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Add EMMS elpa directory to load path for batch 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) + +(defun test-add-dired--run (marked) + "Run the command with MARKED as dired's marked-file answer; return added files." + (let (added) + (cl-letf (((symbol-function 'derived-mode-p) (lambda (&rest _) t)) + ((symbol-function 'cj/music--ensure-playlist-buffer) (lambda () nil)) + ((symbol-function 'dired-get-marked-files) + (lambda (&rest _) marked)) + ((symbol-function 'file-directory-p) (lambda (_f) nil)) + ((symbol-function 'cj/music--valid-file-p) (lambda (_f) t)) + ((symbol-function 'emms-add-file) (lambda (f) (push f added))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (cj/music-add-dired-selection) + (nreverse added)))) + +(ert-deftest test-music-add-dired-selection-queues-all-marked-files () + "Normal: files marked with m (no region) are all queued, not just point. +The old gate ran dired-get-marked-files only under use-region-p, so marks +without a region fell to the single-file branch and silently dropped all +but the point file." + (should (equal (test-add-dired--run '("/tmp/a.mp3" "/tmp/b.mp3" "/tmp/c.mp3")) + '("/tmp/a.mp3" "/tmp/b.mp3" "/tmp/c.mp3")))) + +(ert-deftest test-music-add-dired-selection-point-file-when-no-marks () + "Boundary: with no marks, dired-get-marked-files returns the point file." + (should (equal (test-add-dired--run '("/tmp/only.mp3")) + '("/tmp/only.mp3")))) + +(ert-deftest test-music-add-dired-selection-errors-outside-dired () + "Error: outside a dired buffer the command signals a user-error." + (cl-letf (((symbol-function 'derived-mode-p) (lambda (&rest _) nil))) + (should-error (cj/music-add-dired-selection) :type 'user-error))) + +(provide 'test-music-config--add-dired-selection) +;;; test-music-config--add-dired-selection.el ends here diff --git a/tests/test-music-config--after-playlist-clear.el b/tests/test-music-config--after-playlist-clear.el index c23e2b5b..42dcf0e3 100644 --- a/tests/test-music-config--after-playlist-clear.el +++ b/tests/test-music-config--after-playlist-clear.el @@ -112,5 +112,30 @@ (progn (cj/music--after-playlist-clear) nil) (error err))))) +(ert-deftest test-music-header-toggle-advice-is-named-and-installed () + "Normal: the header-refresh toggle advice is a named, removable function. +An anonymous lambda can't be advice-removed and stacks a copy on every +:config reload, firing the header refresh N times per toggle." + (should (fboundp 'cj/music--refresh-header-after-toggle)) + (dolist (fn '(emms-toggle-repeat-playlist + emms-toggle-repeat-track + emms-toggle-random-playlist + cj/music-toggle-consume)) + (should (advice-member-p #'cj/music--refresh-header-after-toggle fn)))) + +(ert-deftest test-music-header-toggle-advice-does-not-stack () + "Boundary: re-running the install (a :config reload) keeps one advice copy." + (dolist (fn '(emms-toggle-repeat-playlist emms-toggle-repeat-track)) + (advice-remove fn #'cj/music--refresh-header-after-toggle) + (advice-add fn :after #'cj/music--refresh-header-after-toggle) + (advice-remove fn #'cj/music--refresh-header-after-toggle) + (advice-add fn :after #'cj/music--refresh-header-after-toggle) + (let ((count 0)) + (advice-mapc (lambda (f _props) + (when (eq f 'cj/music--refresh-header-after-toggle) + (setq count (1+ count)))) + fn) + (should (= count 1))))) + (provide 'test-music-config--after-playlist-clear) ;;; test-music-config--after-playlist-clear.el ends here diff --git a/tests/test-music-config--completion-table.el b/tests/test-music-config--completion-table.el index 5e33e655..6b3da442 100644 --- a/tests/test-music-config--completion-table.el +++ b/tests/test-music-config--completion-table.el @@ -19,6 +19,10 @@ (defvar-keymap cj/custom-keymap :doc "Stub keymap for testing") +;; Declare special here too (the module's bare defvar is file-local) so the +;; registration test's `let' binds dynamically. +(defvar marginalia-annotator-registry) + ;; Load production code (require 'music-config) @@ -131,5 +135,15 @@ ;; Should not crash, returns empty (should (null result)))) +;;; Marginalia registration + +(ert-deftest test-music-config--completion-table-registers-with-marginalia () + "Normal: building the table registers cj-music-file so marginalia +right-aligns the size/date annotations." + (let ((marginalia-annotator-registry '())) + (cj/music--completion-table '("a.mp3")) + (should (equal (assq 'cj-music-file marginalia-annotator-registry) + '(cj-music-file builtin none))))) + (provide 'test-music-config--completion-table) ;;; test-music-config--completion-table.el ends here diff --git a/tests/test-music-config--delete-playlist-file.el b/tests/test-music-config--delete-playlist-file.el new file mode 100644 index 00000000..ace51a4d --- /dev/null +++ b/tests/test-music-config--delete-playlist-file.el @@ -0,0 +1,135 @@ +;;; test-music-config--delete-playlist-file.el --- Tests for playlist file deletion -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music--delete-playlist-file function. +;; Tests the internal helper that removes a playlist's .m3u file, +;; clears the playlist buffer's file association when it pointed at +;; the deleted file, and refreshes the radio metadata cache. +;; +;; Test organization: +;; - Normal Cases: Existing file is deleted +;; - Boundary Cases: Association cleared only when it matches; cache refresh +;; - Error Cases: Nil path, nonexistent path +;; +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Add EMMS elpa directory to load path for batch 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 'emms-playlist-mode) +(require 'music-config) + +;;; Test helpers + +(defun test-delete-playlist--setup () + "Create test base dir and ensure playlist buffer exists." + (cj/create-test-base-dir) + (let ((buf (get-buffer-create cj/music-playlist-buffer-name))) + (with-current-buffer buf + (emms-playlist-mode) + (setq emms-playlist-buffer-p t)) + (setq emms-playlist-buffer buf) + buf)) + +(defun test-delete-playlist--teardown () + "Clean up test playlist buffer and temp files." + (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) + (with-current-buffer buf + (setq cj/music-playlist-file nil)) + (kill-buffer buf)) + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-music-config--delete-playlist-file-normal-removes-file () + "Normal: an existing playlist file is deleted from disk." + (test-delete-playlist--setup) + (unwind-protect + (let ((file (cj/create-temp-test-file-with-content + "#EXTM3U\n/tmp/song.mp3\n" "playlist.m3u"))) + (cj/music--delete-playlist-file file) + (should-not (file-exists-p file))) + (test-delete-playlist--teardown))) + +;;; Boundary Cases + +(ert-deftest test-music-config--delete-playlist-file-boundary-clears-matching-association () + "Boundary: deleting the associated playlist file clears the association." + (test-delete-playlist--setup) + (unwind-protect + (let ((file (cj/create-temp-test-file-with-content + "#EXTM3U\n" "playlist.m3u"))) + (with-current-buffer (get-buffer cj/music-playlist-buffer-name) + (setq cj/music-playlist-file file)) + (cj/music--delete-playlist-file file) + (with-current-buffer (get-buffer cj/music-playlist-buffer-name) + (should-not cj/music-playlist-file))) + (test-delete-playlist--teardown))) + +(ert-deftest test-music-config--delete-playlist-file-boundary-keeps-other-association () + "Boundary: deleting a different file leaves the association untouched." + (test-delete-playlist--setup) + (unwind-protect + (let ((doomed (cj/create-temp-test-file-with-content + "#EXTM3U\n" "doomed.m3u")) + (kept (cj/create-temp-test-file-with-content + "#EXTM3U\n" "kept.m3u"))) + (with-current-buffer (get-buffer cj/music-playlist-buffer-name) + (setq cj/music-playlist-file kept)) + (cj/music--delete-playlist-file doomed) + (should (file-exists-p kept)) + (with-current-buffer (get-buffer cj/music-playlist-buffer-name) + (should (equal cj/music-playlist-file kept)))) + (test-delete-playlist--teardown))) + +(ert-deftest test-music-config--delete-playlist-file-boundary-refreshes-radio-cache () + "Boundary: deletion clears the cached radio metadata." + (test-delete-playlist--setup) + (unwind-protect + (let ((file (cj/create-temp-test-file-with-content + "#EXTM3U\n" "playlist.m3u"))) + (setq cj/music--radio-metadata-cache '(("stale" . "entry"))) + (cj/music--delete-playlist-file file) + (should-not cj/music--radio-metadata-cache)) + (test-delete-playlist--teardown))) + +;;; Error Cases + +(ert-deftest test-music-config--delete-playlist-file-error-nil-path () + "Error: nil path signals user-error." + (test-delete-playlist--setup) + (unwind-protect + (should-error (cj/music--delete-playlist-file nil) :type 'user-error) + (test-delete-playlist--teardown))) + +(ert-deftest test-music-config--delete-playlist-file-error-nonexistent-path () + "Error: a path that does not exist signals user-error and touches nothing." + (test-delete-playlist--setup) + (unwind-protect + (let ((kept (cj/create-temp-test-file-with-content + "#EXTM3U\n" "kept.m3u"))) + (with-current-buffer (get-buffer cj/music-playlist-buffer-name) + (setq cj/music-playlist-file kept)) + (should-error + (cj/music--delete-playlist-file + (expand-file-name "no-such.m3u" cj/test-base-dir)) + :type 'user-error) + (with-current-buffer (get-buffer cj/music-playlist-buffer-name) + (should (equal cj/music-playlist-file kept)))) + (test-delete-playlist--teardown))) + +(provide 'test-music-config--delete-playlist-file) +;;; test-music-config--delete-playlist-file.el ends here diff --git a/tests/test-music-config--header-text.el b/tests/test-music-config--header-text.el index 8de97350..c860c6d4 100644 --- a/tests/test-music-config--header-text.el +++ b/tests/test-music-config--header-text.el @@ -139,6 +139,23 @@ (should (string-match-p "consume" plain)))) (test-header--teardown))) +(ert-deftest test-music-config--header-text-boundary-key-hints-single-save-stop () + "Header key hints: single is on 1, save is on s, and stop (S) is gone. +SPC/pause covers stop, so the S:stop hint and the [s] single / v:save hints +are retired." + (unwind-protect + (progn + (test-header--setup-playlist-buffer '("/music/a.mp3")) + (let* ((header (with-current-buffer cj/music-playlist-buffer-name + (cj/music--header-text))) + (plain (test-header--strip-properties header))) + (should (string-match-p "\\[1\\] single" plain)) + (should (string-match-p "s:save" plain)) + (should-not (string-match-p "\\[s\\] single" plain)) + (should-not (string-match-p "v:save" plain)) + (should-not (string-match-p "S:stop" plain)))) + (test-header--teardown))) + ;;; Error Cases (ert-deftest test-music-config--header-text-error-empty-playlist-shows-zero-count () diff --git a/tests/test-music-config--m3u-file-tracks.el b/tests/test-music-config--m3u-file-tracks.el index badc9817..e3cbd72e 100644 --- a/tests/test-music-config--m3u-file-tracks.el +++ b/tests/test-music-config--m3u-file-tracks.el @@ -189,5 +189,23 @@ "Parse nil input returns nil gracefully." (should (null (cj/music--m3u-file-tracks nil)))) +;;; Non-music filtering + +(ert-deftest test-music-config--m3u-file-tracks-filters-non-music-local-files () + "Normal: a local non-music path (a saved cover.jpg line) is dropped; +music files and stream URLs pass through." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content (concat "/home/user/music/track1.mp3\n" + "/home/user/music/album/cover.jpg\n" + "https://somafm.com/stream\n" + "/home/user/music/track2.flac\n")) + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks '("/home/user/music/track1.mp3" + "https://somafm.com/stream" + "/home/user/music/track2.flac")))) + (test-music-config--m3u-file-tracks-teardown))) + (provide 'test-music-config--m3u-file-tracks) ;;; test-music-config--m3u-file-tracks.el ends here diff --git a/tests/test-music-config--music-files-recursive.el b/tests/test-music-config--music-files-recursive.el new file mode 100644 index 00000000..f5f5fc5b --- /dev/null +++ b/tests/test-music-config--music-files-recursive.el @@ -0,0 +1,88 @@ +;;; test-music-config--music-files-recursive.el --- Tests for filtered directory collection -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Directory adds used to hand the whole tree to emms-add-directory-tree, +;; which adds every file it finds -- cover.jpg and friends ended up as +;; playlist rows. The filtered walk returns only files passing +;; cj/music--valid-file-p, skipping hidden dirs/files, sorted. Real temp-dir +;; fixtures; the EMMS boundary is mocked only in the command-level test. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'music-config) + +(defmacro test-music-files--with-fixture (var &rest body) + "Run BODY with VAR bound to a temp music-directory fixture." + (declare (indent 1)) + `(let ((,var (make-temp-file "music-test-" t))) + (unwind-protect + (progn + (make-directory (expand-file-name "album" ,var)) + (make-directory (expand-file-name ".hidden" ,var)) + (dolist (f '("song.mp3" "cover.jpg" "album/track.flac" + "album/folder.png" "album/notes.txt" + ".hidden/secret.mp3" ".stray.ogg")) + (write-region "" nil (expand-file-name f ,var))) + ,@body) + (delete-directory ,var t)))) + +;;; Normal Cases + +(ert-deftest test-music-files-recursive-music-only () + "Normal: only files with accepted music extensions come back, sorted; +cover art, text files, and hidden entries stay out." + (test-music-files--with-fixture root + (should (equal (mapcar (lambda (f) (file-relative-name f root)) + (cj/music--music-files-recursive root)) + '("album/track.flac" "song.mp3"))))) + +(ert-deftest test-music-add-directory-recursive-adds-only-music () + "Normal: the directory-add command feeds only music files to EMMS." + (test-music-files--with-fixture root + (let (added) + (cl-letf (((symbol-function 'cj/music--ensure-playlist-buffer) + (lambda () (current-buffer))) + ((symbol-function 'emms-add-file) + (lambda (f) (push f added)))) + (cj/music-add-directory-recursive root)) + (should (equal (mapcar (lambda (f) (file-relative-name f root)) + (nreverse added)) + '("album/track.flac" "song.mp3")))))) + +;;; Boundary Cases + +(ert-deftest test-music-files-recursive-case-insensitive-extensions () + "Boundary: extensions match case-insensitively (Song.MP3 counts)." + (let ((root (make-temp-file "music-test-case-" t))) + (unwind-protect + (progn + (write-region "" nil (expand-file-name "Song.MP3" root)) + (should (= 1 (length (cj/music--music-files-recursive root))))) + (delete-directory root t)))) + +(ert-deftest test-music-files-recursive-empty-directory () + "Boundary: a directory with no music files returns nil." + (let ((root (make-temp-file "music-test-empty-" t))) + (unwind-protect + (progn + (write-region "" nil (expand-file-name "readme.txt" root)) + (should-not (cj/music--music-files-recursive root))) + (delete-directory root t)))) + +;;; Error Cases + +(ert-deftest test-music-add-directory-recursive-not-a-directory-errors () + "Error: a non-directory argument signals user-error." + (should-error (cj/music-add-directory-recursive "/nonexistent/nowhere") + :type 'user-error)) + +(provide 'test-music-config--music-files-recursive) +;;; test-music-config--music-files-recursive.el ends here diff --git a/tests/test-music-config--pin-point.el b/tests/test-music-config--pin-point.el new file mode 100644 index 00000000..2d6fa916 --- /dev/null +++ b/tests/test-music-config--pin-point.el @@ -0,0 +1,78 @@ +;;; test-music-config--pin-point.el --- Tests for the playlist gutter cursor -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; The playlist cursor lives pinned at the start of the row (the number +;; gutter). The rows are rendered track lines, not editable text, and +;; vertical motion over thumbnails and stretch-space drifts point to +;; arbitrary visual columns (usually line end). A buffer-local +;; post-command snap enforces the model for every motion command. The one +;; exception is an active isearch, which owns point placement until it ends. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'music-config) + +;;; Normal Cases + +(ert-deftest test-music-pin-point-snaps-mid-line-to-bol () + "Normal: point mid-row snaps back to the beginning of the line." + (with-temp-buffer + (insert "track one\ntrack two\n") + (goto-char (point-min)) + (forward-char 5) + (cj/music--pin-point-to-bol) + (should (bolp)) + (should (= (point) (point-min))))) + +(ert-deftest test-music-pin-point-noop-at-bol () + "Normal: point already at the row start stays put." + (with-temp-buffer + (insert "track one\ntrack two\n") + (goto-char (point-min)) + (forward-line 1) + (let ((before (point))) + (cj/music--pin-point-to-bol) + (should (= (point) before))))) + +;;; Boundary Cases + +(ert-deftest test-music-pin-point-skips-during-isearch () + "Boundary: an active isearch owns point; the pin defers until it ends." + (with-temp-buffer + (insert "track one\ntrack two\n") + (goto-char (point-min)) + (forward-char 5) + (let ((isearch-mode t)) + (cj/music--pin-point-to-bol)) + (should-not (bolp)))) + +(ert-deftest test-music-pin-point-empty-buffer-no-error () + "Boundary: an empty buffer is a no-op, no error." + (with-temp-buffer + (should-not (cj/music--pin-point-to-bol)) + (should (bolp)))) + +;;; Hook wiring + +(ert-deftest test-music-pin-point-ensure-wires-post-command-hook () + "Normal: the playlist buffer gets the pin on its buffer-local +post-command-hook." + (let (created) + (cl-letf (((symbol-function 'emms-playlist-mode) #'ignore)) + (unwind-protect + (progn + (setq created (cj/music--ensure-playlist-buffer)) + (with-current-buffer created + (should (member #'cj/music--pin-point-to-bol post-command-hook)))) + (when (buffer-live-p created) (kill-buffer created)))))) + +(provide 'test-music-config--pin-point) +;;; test-music-config--pin-point.el ends here diff --git a/tests/test-music-config--playlist-dock.el b/tests/test-music-config--playlist-dock.el index 69d24cc3..1dbe9fbb 100644 --- a/tests/test-music-config--playlist-dock.el +++ b/tests/test-music-config--playlist-dock.el @@ -70,5 +70,45 @@ silently does nothing." (should-not (boundp 'cj/--music-playlist-width)) (should-not (fboundp 'cj/--music-playlist-side))) +(ert-deftest test-music-config-playlist-default-height-is-half () + "Normal: the dock opens at half the frame height by default (Craig, +2026-07-18 -- a third still read too short for a real playlist)." + (should (= cj/music-playlist-window-height 0.5))) + +(ert-deftest test-music-config-playlist-toggle-off-discards-shrunk-height () + "Error: a captured height below the default is discarded. Window churn +squeezes the dock, and remembering the squeeze reopens it too short on +every later toggle." + (let ((buffer (generate-new-buffer " *test-playlist-shrink*")) + (cj/--music-playlist-height nil)) + (unwind-protect + (save-window-excursion + (set-window-buffer (selected-window) buffer) + (let ((cj/music-playlist-buffer-name (buffer-name buffer))) + (cl-letf (((symbol-function 'cj/side-window-capture-size) + (lambda (_w _side var) (set var 0.2))) + ((symbol-function 'delete-window) #'ignore) + ((symbol-function 'message) #'ignore)) + (cj/music-playlist-toggle))) + (should (null cj/--music-playlist-height))) + (kill-buffer buffer)))) + +(ert-deftest test-music-config-playlist-toggle-off-keeps-enlarged-height () + "Normal: a captured height at or above the default is remembered, so a +deliberate enlargement sticks for the session." + (let ((buffer (generate-new-buffer " *test-playlist-grow*")) + (cj/--music-playlist-height nil)) + (unwind-protect + (save-window-excursion + (set-window-buffer (selected-window) buffer) + (let ((cj/music-playlist-buffer-name (buffer-name buffer))) + (cl-letf (((symbol-function 'cj/side-window-capture-size) + (lambda (_w _side var) (set var 0.5))) + ((symbol-function 'delete-window) #'ignore) + ((symbol-function 'message) #'ignore)) + (cj/music-playlist-toggle))) + (should (= 0.5 cj/--music-playlist-height))) + (kill-buffer buffer)))) + (provide 'test-music-config--playlist-dock) ;;; test-music-config--playlist-dock.el ends here diff --git a/tests/test-music-config--playlist-open-position.el b/tests/test-music-config--playlist-open-position.el new file mode 100644 index 00000000..cd83e65b --- /dev/null +++ b/tests/test-music-config--playlist-open-position.el @@ -0,0 +1,147 @@ +;;; test-music-config--playlist-open-position.el --- Tests for playlist landing position -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Opening the playlist lands point by one rule: the beginning of the playing +;; track's line when a song is playing, else the top of the list. The old +;; behavior keyed off EMMS's selected track, which stays set while stopped, so +;; the playlist opened deep in the list at a stale position. The decision is +;; a pure helper; the window landing (point + upper-third recenter) is tested +;; with recenter stubbed at the display boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Declare the emms vars special HERE too: the module's bare (defvar +;; emms-player-playing-p) marks them special only for code compiled in +;; that file, so a plain `let' in this lexical-binding test file would +;; bind them lexically and the module would never see the value (the +;; scope-shadowing trap from the testing rules). +(defvar emms-player-playing-p) +(defvar emms-playlist-selected-marker) + +(require 'music-config) + +(defmacro test-music-open-pos--with-buffer (var &rest body) + "Run BODY with VAR bound to a temp 3-track playlist-shaped buffer." + (declare (indent 1)) + `(let ((,var (generate-new-buffer " *test-open-pos*"))) + (unwind-protect + (progn + (with-current-buffer ,var + (insert "track one\ntrack two\ntrack three\n")) + ,@body) + (when (buffer-live-p ,var) (kill-buffer ,var))))) + +(defun test-music-open-pos--marker (buffer line offset) + "Marker in BUFFER at LINE (1-based) plus OFFSET chars." + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (forward-char offset) + (point-marker)))) + +;;; Normal Cases + +(ert-deftest test-music-playlist-open-position-playing-lands-on-playing-line-start () + "Normal: playing -> the playing track's line, at its beginning (even when +the marker sits mid-line)." + (test-music-open-pos--with-buffer buf + (let ((emms-player-playing-p t) + (emms-playlist-selected-marker (test-music-open-pos--marker buf 2 4))) + (should (= (cj/music--playlist-open-position buf) + (with-current-buffer buf + (save-excursion (goto-char (point-min)) (forward-line 1) (point)))))))) + +(ert-deftest test-music-playlist-open-position-stopped-lands-at-top () + "Normal: not playing -> top of the list, even though EMMS still has a +stale selected track." + (test-music-open-pos--with-buffer buf + (let ((emms-player-playing-p nil) + (emms-playlist-selected-marker (test-music-open-pos--marker buf 3 0))) + (should (= (cj/music--playlist-open-position buf) 1))))) + +;;; Boundary Cases + +(ert-deftest test-music-playlist-open-position-playing-no-marker-lands-at-top () + "Boundary: playing but no usable marker -> top of the list." + (test-music-open-pos--with-buffer buf + (let ((emms-player-playing-p t) + (emms-playlist-selected-marker nil)) + (should (= (cj/music--playlist-open-position buf) 1))))) + +(ert-deftest test-music-playlist-open-position-marker-in-other-buffer-lands-at-top () + "Boundary: a marker pointing into a different buffer is ignored." + (test-music-open-pos--with-buffer buf + (with-temp-buffer + (insert "elsewhere\n") + (let ((emms-player-playing-p t) + (emms-playlist-selected-marker (point-marker))) + (should (= (cj/music--playlist-open-position buf) 1)))))) + +(ert-deftest test-music-playlist-open-position-empty-buffer () + "Boundary: an empty playlist lands at point-min without error." + (let ((buf (generate-new-buffer " *test-open-pos-empty*"))) + (unwind-protect + (let ((emms-player-playing-p nil) + (emms-playlist-selected-marker nil)) + (should (= (cj/music--playlist-open-position buf) 1))) + (kill-buffer buf)))) + +;;; Landing (window boundary stubbed) + +(ert-deftest test-music-playlist-land-point-playing-recenter-upper-third () + "Normal: landing on a playing row sets window point to its line start and +recenters into the upper third." + (test-music-open-pos--with-buffer buf + (let ((emms-player-playing-p t) + (emms-playlist-selected-marker (test-music-open-pos--marker buf 2 4)) + (recenter-arg 'not-called)) + (save-window-excursion + (set-window-buffer (selected-window) buf) + (cl-letf (((symbol-function 'recenter) + (lambda (&optional arg &rest _) (setq recenter-arg arg)))) + (cj/music--playlist-land-point (selected-window) buf)) + (should (= (window-point (selected-window)) + (with-current-buffer buf + (save-excursion (goto-char (point-min)) (forward-line 1) (point))))) + (should (integerp recenter-arg)) + (should (>= recenter-arg 1)))))) + +(ert-deftest test-music-playlist-land-point-stopped-top-no-recenter () + "Normal: landing while stopped puts window point at the top; no recenter." + (test-music-open-pos--with-buffer buf + (let ((emms-player-playing-p nil) + (emms-playlist-selected-marker nil) + (recenter-called nil)) + (save-window-excursion + (set-window-buffer (selected-window) buf) + (cl-letf (((symbol-function 'recenter) + (lambda (&rest _) (setq recenter-called t)))) + (cj/music--playlist-land-point (selected-window) buf)) + (should (= (window-point (selected-window)) 1)) + (should-not recenter-called))))) + +;;; hl-line in the playlist buffer + +(ert-deftest test-music-playlist-ensure-enables-hl-line () + "Normal: the playlist buffer gets hl-line-mode so the current row is +findable even when the cursor sits on album art." + (let (created) + (cl-letf (((symbol-function 'emms-playlist-mode) #'ignore)) + (unwind-protect + (progn + (setq created (cj/music--ensure-playlist-buffer)) + (with-current-buffer created + (should hl-line-mode))) + (when (buffer-live-p created) (kill-buffer created)))))) + +(provide 'test-music-config--playlist-open-position) +;;; test-music-config--playlist-open-position.el ends here diff --git a/tests/test-music-config--radio-tags.el b/tests/test-music-config--radio-tags.el new file mode 100644 index 00000000..60e1c9d8 --- /dev/null +++ b/tests/test-music-config--radio-tags.el @@ -0,0 +1,79 @@ +;;; test-music-config--radio-tags.el --- Tests for radio-browser tag pre-population -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; The tag-search prompt completes over the popular tags fetched from +;; radio-browser's /json/tags endpoint (cached per session). These tests cover +;; the pure pieces: the endpoint URL, the parse (trim + drop-empty + dedupe, +;; since the source data is user-generated and dirty), and the session cache. +;; The network GET is mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'music-config) + +(defconst test-music-radio-tags--fixture + (concat "[{\"name\":\"jazz \",\"stationcount\":300}," + "{\"name\":\" jazz\",\"stationcount\":5}," + "{\"name\":\"\",\"stationcount\":2}," + "{\"name\":\"rock\",\"stationcount\":100}]") + "A recorded /json/tags response with whitespace, empty, and duplicate names.") + +;;; Normal Cases + +(ert-deftest test-music-radio-tags-url-shape () + "Normal: the tags URL targets /json/tags ordered by station count with the limit." + (let* ((cj/music-radio-tag-limit 500) + (u (cj/music-radio--tags-url "de1.api.radio-browser.info"))) + (should (string-match-p "/json/tags" u)) + (should (string-match-p "order=stationcount" u)) + (should (string-match-p "limit=500" u)))) + +(ert-deftest test-music-radio-parse-tags-trims-dedupes-drops-empty () + "Normal: tag names come back trimmed, deduped, and without empties." + (should (equal (cj/music-radio--parse-tags test-music-radio-tags--fixture) + '("jazz" "rock")))) + +(ert-deftest test-music-radio-available-tags-caches-per-session () + "Normal: the fetch runs once; later calls serve the cache." + (let ((cj/music-radio--tags-cache nil) + (calls 0)) + (cl-letf (((symbol-function 'cj/music-radio--http-get) + (lambda (_url) (cl-incf calls) test-music-radio-tags--fixture))) + (should (equal (cj/music-radio--available-tags) '("jazz" "rock"))) + (should (equal (cj/music-radio--available-tags) '("jazz" "rock"))) + (should (= calls 1))))) + +;;; Boundary Cases + +(ert-deftest test-music-radio-parse-tags-empty-array () + "Boundary: an empty tag array parses to nil." + (should-not (cj/music-radio--parse-tags "[]"))) + +;;; Error Cases + +(ert-deftest test-music-radio-available-tags-fetch-failure-returns-nil-and-retries () + "Error: a failed fetch yields nil, leaves the cache empty, and retries next call." + (let ((cj/music-radio--tags-cache nil) + (calls 0)) + (cl-letf (((symbol-function 'cj/music-radio--http-get) + (lambda (_url) (cl-incf calls) nil))) + (should-not (cj/music-radio--available-tags)) + (should-not cj/music-radio--tags-cache) + (should-not (cj/music-radio--available-tags)) + (should (= calls 2))))) + +(ert-deftest test-music-radio-parse-tags-malformed-user-errors () + "Error: a non-JSON body signals user-error, not a raw parse error." + (should-error (cj/music-radio--parse-tags "<html>502</html>") + :type 'user-error)) + +(provide 'test-music-config--radio-tags) +;;; test-music-config--radio-tags.el ends here diff --git a/tests/test-music-config--radio.el b/tests/test-music-config--radio.el index 3923a599..a91612bf 100644 --- a/tests/test-music-config--radio.el +++ b/tests/test-music-config--radio.el @@ -19,6 +19,10 @@ (defvar cj/custom-keymap (make-sparse-keymap) "Stub keymap for testing.") +;; Declare special here too (the module's bare defvar is file-local) so the +;; registration test's `let' binds dynamically. +(defvar marginalia-annotator-registry) + (require 'music-config) (declare-function cj/music-radio--parse-search "music-config" (json-text)) @@ -134,5 +138,70 @@ (should (= (length cands) 2)) (should (= (length (delete-dups (copy-sequence keys))) 2)))) +;;; --------------------------- query whitespace -------------------------------- + +(ert-deftest test-music-radio-search-and-play-trims-query () + "Normal: surrounding whitespace on the query is stripped before the search. +A trailing space in the minibuffer otherwise reaches the API as %20 and +matches nothing." + (let (captured) + (cl-letf (((symbol-function 'cj/emms--setup) #'ignore) + ((symbol-function 'cj/music-radio--search) + (lambda (query _field) (setq captured query) nil))) + (should-error (cj/music-radio--search-and-play " jazz " "tag") + :type 'user-error)) + (should (equal captured "jazz")))) + +(ert-deftest test-music-radio-search-and-play-whitespace-only-no-search () + "Error: a whitespace-only query errors out before any network search." + (let (searched) + (cl-letf (((symbol-function 'cj/emms--setup) #'ignore) + ((symbol-function 'cj/music-radio--search) + (lambda (&rest _) (setq searched t) nil))) + (should-error (cj/music-radio--search-and-play " " "tag") + :type 'user-error)) + (should-not searched))) + +;;; --------------------------- column alignment -------------------------------- + +(ert-deftest test-music-radio-format-candidate-votes-column-fixed-width () + "Normal: the votes field pads to a fixed width so the tags column aligns +across stations with different vote counts." + (let* ((low (cj/music-radio--format-candidate + '(:codec "MP3" :bitrate 128 :countrycode "US" :votes 7 :tags "jazz"))) + (high (cj/music-radio--format-candidate + '(:codec "MP3" :bitrate 128 :countrycode "US" :votes 174208 :tags "jazz")))) + (should (= (string-match "jazz" low) (string-match "jazz" high))))) + +(ert-deftest test-music-radio-completion-table-annotates-station () + "Normal: the table's annotation function returns the Variant-B string for +a station candidate (marginalia handles the right-alignment)." + (let* ((candidates '(("Jazz FM" . (:codec "MP3" :bitrate 128 :countrycode "US" + :votes 5 :tags "jazz")))) + (table (cj/music-radio--completion-table candidates)) + (meta (funcall table "" nil 'metadata)) + (annotate (alist-get 'annotation-function (cdr meta)))) + (should (functionp annotate)) + (should-not (alist-get 'affixation-function (cdr meta))) + (should (string-match-p "MP3" (funcall annotate "Jazz FM"))) + (should (string-match-p "jazz" (funcall annotate "Jazz FM"))))) + +(ert-deftest test-music-radio-completion-table-done-sentinel-no-annotation () + "Boundary: the [done] sentinel has no station and annotates as nil." + (let* ((candidates '(("[done]") ("Station" . (:codec "MP3" :bitrate 128 + :countrycode "US" :votes 1 :tags "x")))) + (table (cj/music-radio--completion-table candidates)) + (annotate (alist-get 'annotation-function + (cdr (funcall table "" nil 'metadata))))) + (should-not (funcall annotate "[done]")))) + +(ert-deftest test-music-radio-completion-table-registers-with-marginalia () + "Normal: building the table registers cj-radio-station so marginalia +right-aligns the table's own annotations." + (let ((marginalia-annotator-registry '())) + (cj/music-radio--completion-table '(("X" . (:codec "MP3")))) + (should (equal (assq 'cj-radio-station marginalia-annotator-registry) + '(cj-radio-station builtin none))))) + (provide 'test-music-config--radio) ;;; test-music-config--radio.el ends here diff --git a/tests/test-music-config--renumber-rows.el b/tests/test-music-config--renumber-rows.el new file mode 100644 index 00000000..d5bc5141 --- /dev/null +++ b/tests/test-music-config--renumber-rows.el @@ -0,0 +1,232 @@ +;;; test-music-config--renumber-rows.el --- Tests for playlist row numbering -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Playlist rows carry a numeric overlay prefix so the cursor stays visible +;; when it sits on a cover-art thumbnail and each row's position in the list +;; is readable. The renumber walks the buffer and rebuilds the overlays; a +;; buffer-local after-change hook debounces it behind an idle timer. Overlays +;; leave the buffer text untouched (EMMS owns it), so these tests drive plain +;; temp buffers. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'music-config) + +(defun test-music-renumber--numbers (buffer) + "Return the overlay number strings in BUFFER, in position order." + (with-current-buffer buffer + (mapcar (lambda (ov) (overlay-get ov 'before-string)) + (sort (seq-filter (lambda (ov) (overlay-get ov 'cj-music-row-number)) + (overlays-in (point-min) (point-max))) + (lambda (a b) (< (overlay-start a) (overlay-start b))))))) + +;;; Normal Cases + +(ert-deftest test-music-renumber-rows-numbers-each-line () + "Normal: every non-blank line gets a sequential number overlay." + (with-temp-buffer + (insert "track one\ntrack two\ntrack three\n") + (cj/music--renumber-rows (current-buffer)) + (should (equal (mapcar #'substring-no-properties + (test-music-renumber--numbers (current-buffer))) + '(" 1 " " 2 " " 3 "))))) + +(ert-deftest test-music-renumber-rows-idempotent () + "Normal: renumbering twice leaves one overlay per line, not two." + (with-temp-buffer + (insert "track one\ntrack two\n") + (cj/music--renumber-rows (current-buffer)) + (cj/music--renumber-rows (current-buffer)) + (should (= 2 (length (test-music-renumber--numbers (current-buffer))))))) + +(ert-deftest test-music-renumber-rows-number-carries-cursor-property () + "Normal: the number string carries a cursor property. Point is pinned at +the row start, and without the property redisplay draws the cursor after +the before-string -- on the album-art thumbnail, where it's invisible." + (with-temp-buffer + (insert "track one\n") + (cj/music--renumber-rows (current-buffer)) + (let ((s (car (test-music-renumber--numbers (current-buffer))))) + (should (get-text-property 0 'cursor s))))) + +;;; Boundary Cases + +(ert-deftest test-music-renumber-rows-skips-blank-lines () + "Boundary: blank lines are not numbered and don't advance the count." + (with-temp-buffer + (insert "track one\n\ntrack two\n") + (cj/music--renumber-rows (current-buffer)) + (should (equal (mapcar #'substring-no-properties + (test-music-renumber--numbers (current-buffer))) + '(" 1 " " 2 "))))) + +(ert-deftest test-music-renumber-rows-empty-buffer-no-overlays () + "Boundary: an empty buffer gets no overlays and no error." + (with-temp-buffer + (cj/music--renumber-rows (current-buffer)) + (should-not (test-music-renumber--numbers (current-buffer))))) + +;;; Error Cases + +(ert-deftest test-music-renumber-rows-dead-buffer-noop () + "Error: renumbering a killed buffer is a silent no-op (the debounce timer +can fire after the playlist buffer is gone)." + (let ((buf (generate-new-buffer " *test-renumber-dead*"))) + (kill-buffer buf) + (should-not (cj/music--renumber-rows buf)))) + +(ert-deftest test-music-renumber-rows-number-outranks-header-overlay () + "Normal: number overlays carry a priority above the header overlay's 100. +The header block is a same-position overlay string at the buffer start; +without the higher priority, row 1's number renders above the header +instead of next to its own track." + (with-temp-buffer + (insert "track one\n") + (cj/music--renumber-rows (current-buffer)) + (let ((ov (car (seq-filter (lambda (o) (overlay-get o 'cj-music-row-number)) + (overlays-in (point-min) (point-max)))))) + (should (> (or (overlay-get ov 'priority) 0) 100))))) + +(ert-deftest test-music-ensure-playlist-buffer-logical-line-motion () + "Normal: the playlist moves by logical lines, not screen lines. The +multi-line header overlay string at position 1 otherwise absorbs every +next-line from the top row -- vertical motion steps through the header's +display and maps back to the same buffer position, so arrows look dead." + (let (created) + (cl-letf (((symbol-function 'emms-playlist-mode) #'ignore)) + (unwind-protect + (progn + (setq created (cj/music--ensure-playlist-buffer)) + (with-current-buffer created + (should (local-variable-p 'line-move-visual)) + (should-not line-move-visual))) + (when (buffer-live-p created) (kill-buffer created)))))) + +;;; Current-row indicator + +(ert-deftest test-music-highlight-current-number-marks-current-row () + "Normal: the current row's number renders inverse-video; moving to another +row restores the old one and marks the new one. The block cursor only +draws in the selected window, so the number itself carries the mark." + (with-temp-buffer + (insert "track one\ntrack two\ntrack three\n") + (cj/music--renumber-rows (current-buffer)) + (goto-char (point-min)) + (forward-line 1) + (cj/music--highlight-current-number) + (let ((numbers (test-music-renumber--numbers (current-buffer)))) + (should-not (plist-get (get-text-property 0 'face (nth 0 numbers)) :inverse-video)) + (should (plist-get (get-text-property 0 'face (nth 1 numbers)) :inverse-video))) + (forward-line 1) + (cj/music--highlight-current-number) + (let ((numbers (test-music-renumber--numbers (current-buffer)))) + (should-not (plist-get (get-text-property 0 'face (nth 1 numbers)) :inverse-video)) + (should (plist-get (get-text-property 0 'face (nth 2 numbers)) :inverse-video))))) + +(ert-deftest test-music-highlight-current-number-survives-renumber () + "Boundary: a renumber rebuilds the overlays; the highlight re-applies to +the current row rather than pointing at a dead overlay." + (with-temp-buffer + (insert "track one\ntrack two\n") + (cj/music--renumber-rows (current-buffer)) + (goto-char (point-min)) + (forward-line 1) + (cj/music--highlight-current-number) + (cj/music--renumber-rows (current-buffer)) + (let ((numbers (test-music-renumber--numbers (current-buffer)))) + (should (plist-get (get-text-property 0 'face (nth 1 numbers)) :inverse-video))))) + +(ert-deftest test-music-highlight-current-number-keeps-cursor-property () + "Boundary: re-facing a number keeps the cursor property intact." + (with-temp-buffer + (insert "track one\n") + (cj/music--renumber-rows (current-buffer)) + (goto-char (point-min)) + (cj/music--highlight-current-number) + (let ((s (car (test-music-renumber--numbers (current-buffer))))) + (should (get-text-property 0 'cursor s))))) + +(ert-deftest test-music-ensure-playlist-buffer-sticky-hl-line () + "Normal: hl-line in the playlist stays visible when the window isn't +selected -- the dock is glanced at from other windows constantly." + (let (created) + (cl-letf (((symbol-function 'emms-playlist-mode) #'ignore)) + (unwind-protect + (progn + (setq created (cj/music--ensure-playlist-buffer)) + (should (buffer-local-value 'hl-line-sticky-flag created))) + (when (buffer-live-p created) (kill-buffer created)))))) + +;;; Sticky header + +(ert-deftest test-music-stick-header-moves-overlay-to-window-start () + "Normal: a scroll re-anchors the header overlay at the new window start, +so the header block stays at the top of the window while the list scrolls." + (with-temp-buffer + (insert "track one\ntrack two\ntrack three\ntrack four\n") + (setq cj/music--header-overlay (make-overlay (point-min) (point-min))) + (save-window-excursion + (set-window-buffer (selected-window) (current-buffer)) + (let ((start (save-excursion (goto-char (point-min)) (forward-line 2) (point)))) + (cj/music--stick-header (selected-window) start) + (should (= (overlay-start cj/music--header-overlay) start)) + ;; Converges: the same start again is a no-op, not a loop. + (cj/music--stick-header (selected-window) start) + (should (= (overlay-start cj/music--header-overlay) start)))))) + +(ert-deftest test-music-stick-header-no-overlay-noop () + "Boundary: no header overlay yet -- the scroll handler is a silent no-op." + (with-temp-buffer + (insert "track one\n") + (setq cj/music--header-overlay nil) + (save-window-excursion + (set-window-buffer (selected-window) (current-buffer)) + (should-not (cj/music--stick-header (selected-window) (point-min)))))) + +(ert-deftest test-music-header-anchor-position-displayed-vs-not () + "Normal: the header anchors at the displaying window's start; an +undisplayed buffer anchors at the top." + (with-temp-buffer + (insert "track one\ntrack two\ntrack three\ntrack four\n") + (save-window-excursion + (set-window-buffer (selected-window) (current-buffer)) + (let ((start (save-excursion (goto-char (point-min)) (forward-line 2) (point)))) + (set-window-start (selected-window) start) + (should (= (cj/music--header-anchor-position) start)))) + ;; Not displayed after the excursion restores the old config. + (should (= (cj/music--header-anchor-position) (point-min))))) + +(ert-deftest test-music-ensure-playlist-buffer-wires-scroll-hook () + "Normal: the playlist buffer re-sticks its header on every window scroll." + (let (created) + (cl-letf (((symbol-function 'emms-playlist-mode) #'ignore)) + (unwind-protect + (progn + (setq created (cj/music--ensure-playlist-buffer)) + (with-current-buffer created + (should (member #'cj/music--stick-header window-scroll-functions)))) + (when (buffer-live-p created) (kill-buffer created)))))) + +;;; Hook wiring + +(ert-deftest test-music-renumber-ensure-playlist-buffer-wires-hook () + "Normal: the playlist buffer gets the debounced renumber on after-change." + (let (created) + (cl-letf (((symbol-function 'emms-playlist-mode) #'ignore)) + (unwind-protect + (progn + (setq created (cj/music--ensure-playlist-buffer)) + (with-current-buffer created + (should (member #'cj/music--schedule-renumber after-change-functions)))) + (when (buffer-live-p created) (kill-buffer created)))))) + +(provide 'test-music-config--renumber-rows) +;;; test-music-config--renumber-rows.el ends here diff --git a/tests/test-music-config-commands.el b/tests/test-music-config-commands.el index 3c585d0b..40fb2d81 100644 --- a/tests/test-music-config-commands.el +++ b/tests/test-music-config-commands.el @@ -30,17 +30,21 @@ ;;; cj/music-add-directory-recursive (ert-deftest test-music-add-directory-recursive-passes-dir-to-emms () - "Normal: add-directory-recursive routes through emms-add-directory-tree." + "Normal: add-directory-recursive feeds the directory's music files (and +only those) to emms-add-file -- the raw-tree path added cover art too." (let* ((tmp (file-name-as-directory (make-temp-file "cj-music-add-" t))) - called) + added) (unwind-protect - (cl-letf (((symbol-function 'cj/music--ensure-playlist-buffer) #'ignore) - ((symbol-function 'emms-add-directory-tree) - (lambda (dir) (setq called dir))) - ((symbol-function 'message) #'ignore)) - (cj/music-add-directory-recursive tmp)) + (progn + (write-region "" nil (expand-file-name "song.mp3" tmp)) + (write-region "" nil (expand-file-name "cover.jpg" tmp)) + (cl-letf (((symbol-function 'cj/music--ensure-playlist-buffer) #'ignore) + ((symbol-function 'emms-add-file) + (lambda (f) (push f added))) + ((symbol-function 'message) #'ignore)) + (cj/music-add-directory-recursive tmp))) (delete-directory tmp t)) - (should (equal called tmp)))) + (should (equal (mapcar #'file-name-nondirectory added) '("song.mp3"))))) (ert-deftest test-music-add-directory-recursive-errors-on-non-directory () "Error: passing a regular file (not a directory) signals user-error." diff --git a/tests/test-music-config-create-radio-station.el b/tests/test-music-config-create-radio-station.el index 7d9adbed..4f49f49b 100644 --- a/tests/test-music-config-create-radio-station.el +++ b/tests/test-music-config-create-radio-station.el @@ -106,15 +106,16 @@ (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." +playlist buffer saves on s (single on 1, old save key v unbound)." (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))) + (should (eq (lookup-key emms-playlist-mode-map "s") 'cj/music-playlist-save)) + (should (eq (lookup-key emms-playlist-mode-map "1") 'emms-toggle-repeat-track)) + (should-not (lookup-key emms-playlist-mode-map "v"))) ;;; Error Cases diff --git a/tests/test-music-config-helpers-untested.el b/tests/test-music-config-helpers-untested.el index bfdb2634..87aa210c 100644 --- a/tests/test-music-config-helpers-untested.el +++ b/tests/test-music-config-helpers-untested.el @@ -154,17 +154,18 @@ test prelude inserts filler with `inhibit-read-only' bound." ;;; ---------- cj/music-add-directory-recursive ---------- (ert-deftest test-mc-add-directory-recursive-normal-calls-emms () - "Normal: with an existing directory, the recursive add reaches emms." + "Normal: with an existing directory, the recursive add reaches emms with +each music file individually (the filtered walk, not the raw tree)." (test-mc-untested--setup) (unwind-protect (let* ((dir cj/test-base-dir) - (called-with nil)) - (cl-letf (((symbol-function 'emms-add-directory-tree) - (lambda (d) (setq called-with d))) + (added nil)) + (write-region "" nil (expand-file-name "one.mp3" dir)) + (cl-letf (((symbol-function 'emms-add-file) + (lambda (f) (push f added))) ((symbol-function 'message) #'ignore)) (cj/music-add-directory-recursive dir)) - (should (equal (file-name-as-directory called-with) - (file-name-as-directory dir)))) + (should (member "one.mp3" (mapcar #'file-name-nondirectory added)))) (test-mc-untested--teardown))) (ert-deftest test-mc-add-directory-recursive-error-not-a-directory () diff --git a/tests/test-nov-reading--config-defaults.el b/tests/test-nov-reading--config-defaults.el index 5e454ce1..ff52d8f5 100644 --- a/tests/test-nov-reading--config-defaults.el +++ b/tests/test-nov-reading--config-defaults.el @@ -16,6 +16,8 @@ (declare-function cj/nov--next-reading-palette "nov-reading" (current names)) (defvar cj/nov-reading-palettes) (defvar cj/nov-reading-default-palette) +(defvar cj/nov-reading-profile) +(defvar cj/nov--typography-remap-cookies) (ert-deftest test-nov-reading-config-default-is-dark () "Normal: a fresh nov buffer opens on the dark palette." @@ -34,5 +36,32 @@ (should-not (cj/nov--next-reading-palette "light" names)) (should (equal (cj/nov--next-reading-palette nil names) "dark")))) +(ert-deftest test-nov-reading-config-uses-reading-font-profile () + "Normal: nov typography names the shared Reading profile." + (should (eq cj/nov-reading-profile 'reading))) + +(ert-deftest test-nov-reading-depends-on-pure-profile-layer () + "Boundary: loading nov shares profile data without loading Fontaine config." + (should (featurep 'font-profiles)) + (should-not (featurep 'font-config))) + +(ert-deftest test-nov-reading-typography-remaps-shared-profile-locally () + "Normal: nov applies Reading locally at its own base height without stacking." + (let ((cj/nov--typography-remap-cookies '(old-default old-fixed)) + (removed nil) + (applied nil)) + (cl-letf (((symbol-function 'face-remap-remove-relative) + (lambda (cookie) (push cookie removed))) + ((symbol-function 'cj/font-profile-remap-buffer) + (lambda (profile height) + (setq applied (list profile height)) + '(new-default new-fixed)))) + (cj/nov-reading-apply-typography)) + (should (equal applied '(reading 180))) + (should (equal (sort removed #'string-lessp) + '(old-default old-fixed))) + (should (equal cj/nov--typography-remap-cookies + '(new-default new-fixed))))) + (provide 'test-nov-reading--config-defaults) ;;; test-nov-reading--config-defaults.el ends here diff --git a/tests/test-org-agenda-config--auto-refresh.el b/tests/test-org-agenda-config--auto-refresh.el new file mode 100644 index 00000000..58ef729b --- /dev/null +++ b/tests/test-org-agenda-config--auto-refresh.el @@ -0,0 +1,170 @@ +;;; test-org-agenda-config--auto-refresh.el --- Tests for agenda auto-refresh -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the wall-clock-aligned auto-refresh behind the F8 agenda: +;; the next-mark arithmetic, the on-screen-agenda lookup, the timer body's +;; error containment, and start/stop timer ownership. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-agenda-config) + +;; -- Fixtures ---------------------------------------------------------------- + +(defun test-org-agenda-auto-refresh--time (hh mm ss) + "Return an Emacs time value for today at HH:MM:SS local time." + (let ((now (decode-time))) + (encode-time (list ss mm hh + (nth 3 now) (nth 4 now) (nth 5 now) + nil -1 (nth 8 now))))) + +(defmacro test-org-agenda-auto-refresh--with-agenda-window (&rest body) + "Run BODY with a window displaying a buffer in `org-agenda-mode'. +Sets `major-mode' directly rather than calling the mode function: the +lookup under test only asks what mode the window's buffer is in, and +`org-agenda-mode' setup wants a real agenda build behind it." + (declare (indent 0)) + `(let ((buffer (get-buffer-create "*Org Agenda*"))) + (unwind-protect + (save-window-excursion + (with-current-buffer buffer + (setq major-mode 'org-agenda-mode)) + (set-window-buffer (selected-window) buffer) + ,@body) + (kill-buffer buffer)))) + +;; -- cj/--org-agenda-seconds-to-next-mark ------------------------------------ + +(ert-deftest test-org-agenda-config-next-mark-mid-interval () + "Normal: a time between marks returns the remainder to the next one." + (should (= 120 (cj/--org-agenda-seconds-to-next-mark + (test-org-agenda-auto-refresh--time 9 3 0) 300)))) + +(ert-deftest test-org-agenda-config-next-mark-exactly-on-mark () + "Boundary: a time exactly on a mark returns a full period, never zero. +A zero delay would fire the timer immediately and again a period later." + (should (= 300 (cj/--org-agenda-seconds-to-next-mark + (test-org-agenda-auto-refresh--time 9 5 0) 300)))) + +(ert-deftest test-org-agenda-config-next-mark-one-second-before () + "Boundary: one second short of a mark returns one second." + (should (= 1 (cj/--org-agenda-seconds-to-next-mark + (test-org-agenda-auto-refresh--time 9 4 59) 300)))) + +(ert-deftest test-org-agenda-config-next-mark-lands-on-a-multiple () + "Normal: TIME plus the result is always a whole multiple of PERIOD. +This is the property that makes the refresh land on :00/:05 rather than +five minutes after whenever the agenda happened to open." + (dolist (seconds '(0 1 59 60 61 149 150 299)) + (let* ((time (test-org-agenda-auto-refresh--time 9 0 0)) + (start (+ (floor (float-time time)) seconds)) + (delay (cj/--org-agenda-seconds-to-next-mark start 300))) + (should (zerop (mod (+ start delay) 300)))))) + +(ert-deftest test-org-agenda-config-next-mark-rejects-nonpositive-period () + "Error: a zero or negative period is a caller bug, not a silent no-op." + (should-error (cj/--org-agenda-seconds-to-next-mark (current-time) 0)) + (should-error (cj/--org-agenda-seconds-to-next-mark (current-time) -300))) + +;; -- cj/--org-agenda-refresh-window ------------------------------------------ + +(ert-deftest test-org-agenda-config-refresh-window-finds-displayed-agenda () + "Normal: the lookup returns the window showing an agenda buffer." + (test-org-agenda-auto-refresh--with-agenda-window + (should (eq (cj/--org-agenda-refresh-window) (selected-window))))) + +(ert-deftest test-org-agenda-config-refresh-window-nil-when-not-displayed () + "Boundary: an agenda buffer that exists but is off-screen is not a target. +Rebuilding an invisible agenda costs time and shows nobody anything." + (let ((buffer (get-buffer-create "*Org Agenda*"))) + (unwind-protect + (progn + (with-current-buffer buffer (setq major-mode 'org-agenda-mode)) + (should-not (cj/--org-agenda-refresh-window))) + (kill-buffer buffer)))) + +(ert-deftest test-org-agenda-config-refresh-window-nil-with-no-agenda () + "Boundary: no agenda buffer anywhere returns nil rather than erroring." + (should-not (cj/--org-agenda-refresh-window))) + +;; -- cj/--org-agenda-auto-refresh (the timer body) --------------------------- + +(ert-deftest test-org-agenda-config-auto-refresh-noop-without-agenda () + "Boundary: the tick does nothing, and signals nothing, with no agenda up." + (let ((called nil)) + (cl-letf (((symbol-function 'org-agenda-redo) + (lambda (&rest _) (setq called t)))) + (cj/--org-agenda-auto-refresh) + (should-not called)))) + +(ert-deftest test-org-agenda-config-auto-refresh-redoes-visible-agenda () + "Normal: the tick redoes the agenda shown on screen." + (let ((called nil)) + (cl-letf (((symbol-function 'org-agenda-redo) + (lambda (&rest _) (setq called t)))) + (test-org-agenda-auto-refresh--with-agenda-window + (cj/--org-agenda-auto-refresh)) + (should called)))) + +(ert-deftest test-org-agenda-config-auto-refresh-contains-errors () + "Error: a failing redo must not escape the timer body. +An unguarded signal in a repeating timer resignals on every tick, which is +how a five-minute timer turns into an endless backtrace." + (cl-letf (((symbol-function 'org-agenda-redo) + (lambda (&rest _) (error "simulated redo failure"))) + ((symbol-function 'cj/log-silently) (lambda (&rest _) nil))) + (test-org-agenda-auto-refresh--with-agenda-window + (should (progn (cj/--org-agenda-auto-refresh) t))))) + +(ert-deftest test-org-agenda-config-auto-refresh-restores-point-line () + "Normal: the tick leaves point on the line it started on. +A refresh that scrolls the reader back to the top every five minutes is +worse than no refresh." + (cl-letf (((symbol-function 'org-agenda-redo) (lambda (&rest _) nil))) + (test-org-agenda-auto-refresh--with-agenda-window + (with-current-buffer "*Org Agenda*" + (erase-buffer) + (dotimes (i 10) (insert (format "agenda line %d\n" i))) + (goto-char (point-min)) + (forward-line 4)) + (cj/--org-agenda-auto-refresh) + (with-current-buffer "*Org Agenda*" + (should (= 5 (line-number-at-pos))))))) + +;; -- start / stop ------------------------------------------------------------ + +(ert-deftest test-org-agenda-config-auto-refresh-start-owns-one-timer () + "Normal: starting twice leaves exactly one timer, not two. +Re-loading the module in a live daemon re-runs the arming form, so a +non-idempotent start would stack a second ticker on every reload." + (let ((cj/--org-agenda-refresh-timer nil)) + (unwind-protect + (progn + (cj/org-agenda-auto-refresh-start) + (let ((first cj/--org-agenda-refresh-timer)) + (cj/org-agenda-auto-refresh-start) + (should (timerp cj/--org-agenda-refresh-timer)) + (should-not (memq first timer-list)) + (should (memq cj/--org-agenda-refresh-timer timer-list)))) + (cj/org-agenda-auto-refresh-stop)))) + +(ert-deftest test-org-agenda-config-auto-refresh-stop-clears-timer () + "Normal: stopping cancels the timer and clears the handle." + (let ((cj/--org-agenda-refresh-timer nil)) + (cj/org-agenda-auto-refresh-start) + (let ((timer cj/--org-agenda-refresh-timer)) + (cj/org-agenda-auto-refresh-stop) + (should-not cj/--org-agenda-refresh-timer) + (should-not (memq timer timer-list))))) + +(ert-deftest test-org-agenda-config-auto-refresh-stop-is-safe-when-stopped () + "Boundary: stopping an already-stopped refresh is a no-op, not an error." + (let ((cj/--org-agenda-refresh-timer nil)) + (should (progn (cj/org-agenda-auto-refresh-stop) t)) + (should-not cj/--org-agenda-refresh-timer))) + +(provide 'test-org-agenda-config--auto-refresh) +;;; test-org-agenda-config--auto-refresh.el ends here diff --git a/tests/test-org-agenda-config-category.el b/tests/test-org-agenda-config-category.el index 6a54d9e6..918d342a 100644 --- a/tests/test-org-agenda-config-category.el +++ b/tests/test-org-agenda-config-category.el @@ -88,12 +88,11 @@ Suppresses other org-mode hooks to keep the test isolated." (text-mode-hook nil)) (org-mode)) (setq buffer-file-name ,path) - ;; mimic org's default category (filename-sans-extension) so the - ;; hook's "only override the default" guard is exercised. - (setq-local org-category - (and ,path - (file-name-sans-extension - (file-name-nondirectory ,path)))) + ;; `org-category' is deliberately left nil, which is what org actually + ;; does with no `#+CATEGORY:'. An earlier version of this fixture set it + ;; to the filename base to "mimic org's default"; org never does that, so + ;; these tests passed against a state that cannot occur while the feature + ;; did nothing in practice. ,body-form)) ;;; Normal Cases @@ -106,11 +105,14 @@ Suppresses other org-mode hooks to keep the test isolated." (should (equal "emacs.d" org-category))))) (ert-deftest test-org-agenda-config-category-hook-normal-leaves-inbox-alone () - "Normal: hook leaves inbox.org's category at its filename default." + "Normal: hook declines on a non-todo file, leaving `org-category' unset. +Leaving it nil is the correct outcome, not a gap: `org-get-category' then +derives \"inbox\" from the filename, which is already a useful label. The +end-to-end test below checks that derivation on a real file." (test-org-agenda-config-category--with-file "/home/cjennings/sync/org/roam/inbox.org" (progn (cj/--org-set-todo-category) - (should (equal "inbox" org-category))))) + (should (null org-category))))) ;;; Boundary Cases @@ -133,5 +135,98 @@ Suppresses other org-mode hooks to keep the test isolated." ;; no error and no spurious mutation (should t))) +;;; ---------- End-to-end: a real file through the real hook ---------- +;; The fixture above sets `org-category' by hand to the filename base, to +;; "mimic org's default". Org does not do that: with no `#+CATEGORY:' it +;; leaves `org-category' nil and derives the fallback inside +;; `org-get-category' at read time. So those tests exercise a precondition +;; that never occurs, and passed while the feature did nothing in practice. +;; +;; These drive a real file on disk through `find-file-noselect' (which runs +;; `org-mode-hook' for real) and assert on `org-get-category', which is what +;; the agenda's %c column actually reads. + +(defmacro test-org-agenda-config-category--with-real-file (spec &rest body) + "Create FILE under a temp project dir and visit it, then run BODY. +SPEC is (VAR DIRNAME FILENAME CONTENT). VAR is bound to the live buffer." + (declare (indent 1)) + (let ((var (nth 0 spec)) (dirname (nth 1 spec)) + (filename (nth 2 spec)) (content (nth 3 spec))) + ;; The outer `unwind-protect' covers `find-file-noselect' itself, so a + ;; signal there still removes the temp tree rather than leaking it. + `(let* ((root (make-temp-file "cj-cat-" t)) + (project (expand-file-name ,dirname root)) + (path (expand-file-name ,filename project)) + (,var nil)) + (unwind-protect + (progn + (make-directory project t) + (with-temp-file path (insert ,content)) + (setq ,var (find-file-noselect path)) + ,@body) + (when (buffer-live-p ,var) + (with-current-buffer ,var (set-buffer-modified-p nil)) + (kill-buffer ,var)) + (delete-directory root t))))) + +(ert-deftest test-org-agenda-config-category-endtoend-todo-shows-project () + "Normal: visiting a project's todo.org makes the agenda show the project. +This is the whole point of the feature, and it is what the hand-built +fixture above could not check." + (test-org-agenda-config-category--with-real-file + (buffer "myproject" "todo.org" "* TODO a task\n") + (with-current-buffer buffer + (should (equal "myproject" (org-get-category (point-min))))))) + +(ert-deftest test-org-agenda-config-category-endtoend-explicit-category-wins () + "Boundary: an explicit `#+CATEGORY:' still beats the derived name. + +Note what this does and does not prove. It confirms the user-visible contract, +but not that the hook's guard is what enforces it: `org-element--get-category' +searches the buffer for `#+CATEGORY:' itself and returns that before consulting +`org-category', so the directive survives even with the guard deleted. The +guard's own job is covered by +`test-org-agenda-config-category-hook-boundary-respects-explicit'." + (test-org-agenda-config-category--with-real-file + (buffer "myproject" "todo.org" "#+CATEGORY: Personal\n* TODO a task\n") + (with-current-buffer buffer + (should (equal "Personal" (org-get-category (point-min))))))) + +(ert-deftest test-org-agenda-config-category-endtoend-survives-an-earlier-hook () + "Error: the override still lands when another hook reads the category first. + +`org-get-category' resolves a deferred `:CATEGORY' that the org-element cache +then holds. A hook running BEFORE ours that reads it freezes \"todo\" in that +cache, and our later `setq-local' becomes inert -- `org-category' reads correct +while the agenda still shows \"todo\". + +This is not hypothetical. `add-hook' prepends by default, so every hook added +after ours runs before it, and the live config already has three ahead of it. +The fix is the explicit depth on our `add-hook'; this test is what holds it +there." + (test-org-agenda-config-category--with-real-file + (buffer "projX" "todo.org" "* TODO a task\n") + (ignore buffer)) + ;; Re-visit with a nosy reader installed ahead of ours. + (let ((reader (lambda () (ignore (org-get-category (point-min)))))) + (unwind-protect + (progn + (add-hook 'org-mode-hook reader) + (test-org-agenda-config-category--with-real-file + (buffer "projX" "todo.org" "* TODO a task\n") + (with-current-buffer buffer + (should (equal "projX" (org-get-category (point-min))))))) + (remove-hook 'org-mode-hook reader)))) + +(ert-deftest test-org-agenda-config-category-endtoend-other-filename-untouched () + "Boundary: a distinctively-named file keeps its filename category. +Only todo.org is generic enough to be worth replacing. Files like +schedule.org or gcal.org already say something useful, and deriving from +the directory would collapse several of them onto one name." + (test-org-agenda-config-category--with-real-file + (buffer "data" "gcal.org" "* TODO an event\n") + (with-current-buffer buffer + (should (equal "gcal" (org-get-category (point-min))))))) + (provide 'test-org-agenda-config-category) ;;; test-org-agenda-config-category.el ends here diff --git a/tests/test-org-agenda-config-display.el b/tests/test-org-agenda-config-display.el index af4c7ea0..f039985d 100644 --- a/tests/test-org-agenda-config-display.el +++ b/tests/test-org-agenda-config-display.el @@ -2,6 +2,8 @@ ;;; Commentary: ;; Tests for the display-buffer rule used by the F8 org agenda view. +;; The agenda takes the whole frame; these pin that, and pin the two ways +;; it previously failed to (a fraction of the frame, or shrunk to fit). ;;; Code: @@ -10,39 +12,58 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'org-agenda-config) -(ert-deftest test-org-agenda-config-display-rule-uses-configured-height () - "Normal: the agenda display rule uses the configured frame fraction." - (let ((cj/org-agenda-window-height 0.75)) - (should (equal (cdr (assoc 'window-height - (cddr (cj/--org-agenda-display-rule)))) - 0.75)))) +(defun test-org-agenda-config-display--actions () + "Return the display-action function list from the agenda rule." + (car (cdr (cj/--org-agenda-display-rule)))) + +(defun test-org-agenda-config-display--alist () + "Return the action alist from the agenda rule." + (cddr (cj/--org-agenda-display-rule))) + +(ert-deftest test-org-agenda-config-display-rule-takes-full-frame () + "Normal: the agenda display rule claims the whole frame." + (should (memq 'display-buffer-full-frame + (test-org-agenda-config-display--actions)))) + +(ert-deftest test-org-agenda-config-display-rule-reuses-agenda-window () + "Normal: an agenda already on screen is reused rather than re-displayed." + (should (memq 'display-buffer-reuse-mode-window + (test-org-agenda-config-display--actions)))) + +(ert-deftest test-org-agenda-config-display-rule-sets-no-window-height () + "Regression: no height fraction survives. +The rule used to hand the agenda 0.75 of the frame; a leftover +`window-height' entry would cap the full-frame window right back down." + (should-not (assoc 'window-height (test-org-agenda-config-display--alist)))) (ert-deftest test-org-agenda-config-display-rule-does-not-fit-to-buffer () "Regression: F8 agenda should not shrink to fit compact agenda contents." - (let ((cj/org-agenda-window-height 0.75)) - (should-not (eq (cdr (assoc 'window-height - (cddr (cj/--org-agenda-display-rule)))) - 'fit-window-to-buffer)))) - -(ert-deftest test-org-agenda-config-display-rule-creates-large-window () - "Integration: the agenda rule creates a window near the configured height." - (let ((cj/org-agenda-window-height 0.75) - (display-buffer-alist (list (cj/--org-agenda-display-rule))) + (should-not (eq (cdr (assoc 'window-height + (test-org-agenda-config-display--alist))) + 'fit-window-to-buffer))) + +(ert-deftest test-org-agenda-config-display-rule-window-not-dedicated () + "Regression: the agenda window must not be dedicated. +With the agenda owning the only window, a dedicated one leaves RET on an +item (`org-agenda-switch-to') nowhere to put the file, so it splits or +opens a frame instead of replacing the agenda." + (should-not (cdr (assoc 'dedicated (test-org-agenda-config-display--alist))))) + +(ert-deftest test-org-agenda-config-display-rule-creates-sole-window () + "Integration: displaying the agenda leaves it as the frame's only window." + (let ((display-buffer-alist (list (cj/--org-agenda-display-rule))) (buffer (get-buffer-create "*Org Agenda*"))) (unwind-protect (save-window-excursion (delete-other-windows) + (split-window-below) (with-current-buffer buffer (erase-buffer) - (dotimes (_ 3) - (insert "agenda line\n"))) - (let* ((before-height (window-total-height)) - (window (display-buffer buffer)) - (actual-ratio (/ (float (window-total-height window)) - before-height))) - (should (= 2 (length (window-list)))) - (should (> actual-ratio 0.65)) - (should (< actual-ratio 0.85)))) + (dotimes (_ 3) (insert "agenda line\n"))) + (let ((window (display-buffer buffer))) + (should (= 1 (length (window-list)))) + (should (eq window (car (window-list)))) + (should (eq (window-buffer window) buffer)))) (kill-buffer buffer)))) (provide 'test-org-agenda-config-display) diff --git a/tests/test-org-refile-config--advice-helpers.el b/tests/test-org-refile-config--advice-helpers.el new file mode 100644 index 00000000..0d9979d8 --- /dev/null +++ b/tests/test-org-refile-config--advice-helpers.el @@ -0,0 +1,87 @@ +;;; test-org-refile-config--advice-helpers.el --- Tests for the refile advice helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for the two named advice helpers extracted from anonymous lambdas +;; in the org-refile use-package :config block: +;; +;; cj/org-refile--save-all-buffers (:after org-refile) +;; cj/org-refile--ensure-targets-in-org-mode (:before org-refile-get-targets) +;; +;; They were anonymous `(lambda (&rest _) ...)' advices, which cannot be +;; `advice-remove'd by reference and cannot be tested. Naming them makes both +;; possible. The install-by-reference and removability are verified live in the +;; daemon (the :config block doesn't run under batch make test); these tests +;; pin the extracted logic. +;; +;; Test organization: +;; - Normal Cases: ensure-targets visits each string-named target +;; - Boundary Cases: empty targets, non-string cars, mixed list +;; - Error Cases: a nil target list is a no-op +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-refile-config) + +;; The module's bare `(defvar org-refile-targets)' marks the symbol special only +;; within its own file, so it isn't special here. Declare it (with a value) so +;; the `let' bindings below bind it dynamically, the way the sibling +;; test-org-refile-config-commands.el does. +(defvar org-refile-targets nil) + +;;; cj/org-refile--ensure-targets-in-org-mode + +(ert-deftest test-org-refile-ensure-targets-visits-each-string-target () + "Normal: every string-named target file is passed to the ensure helper." + (let ((org-refile-targets '(("/a.org" :maxlevel . 3) + ("/b.org" :maxlevel . 3))) + (seen '())) + (cl-letf (((symbol-function 'cj/org-refile-ensure-org-mode) + (lambda (f) (push f seen)))) + (cj/org-refile--ensure-targets-in-org-mode)) + (should (equal '("/a.org" "/b.org") (nreverse seen))))) + +;;; Boundary + +(ert-deftest test-org-refile-ensure-targets-skips-non-string-cars () + "Boundary: a target whose car is not a string (a function/symbol spec) is +skipped rather than passed to the ensure helper." + (let ((org-refile-targets `((,(lambda () '("/x.org")) :maxlevel . 2) + ("/real.org" :maxlevel . 2) + (org-agenda-files :maxlevel . 2))) + (seen '())) + (cl-letf (((symbol-function 'cj/org-refile-ensure-org-mode) + (lambda (f) (push f seen)))) + (cj/org-refile--ensure-targets-in-org-mode)) + (should (equal '("/real.org") seen)))) + +(ert-deftest test-org-refile-ensure-targets-empty-list-is-noop () + "Boundary: no targets means the ensure helper is never called." + (let ((org-refile-targets '()) + (called nil)) + (cl-letf (((symbol-function 'cj/org-refile-ensure-org-mode) + (lambda (_f) (setq called t)))) + (cj/org-refile--ensure-targets-in-org-mode)) + (should-not called))) + +;;; Error + +(ert-deftest test-org-refile-ensure-targets-nil-targets-does-not-signal () + "Error: a nil `org-refile-targets' completes without signaling." + (let ((org-refile-targets nil)) + (cl-letf (((symbol-function 'cj/org-refile-ensure-org-mode) #'ignore)) + (should (progn (cj/org-refile--ensure-targets-in-org-mode) t))))) + +;;; cj/org-refile--save-all-buffers + +(ert-deftest test-org-refile-save-all-buffers-delegates () + "Normal: the save helper calls `org-save-all-org-buffers'." + (let ((called nil)) + (cl-letf (((symbol-function 'org-save-all-org-buffers) + (lambda (&rest _) (setq called t)))) + (cj/org-refile--save-all-buffers)) + (should called))) + +(provide 'test-org-refile-config--advice-helpers) +;;; test-org-refile-config--advice-helpers.el ends here diff --git a/tests/test-org-roam-config-format.el b/tests/test-org-roam-config-format.el index e9378b7a..16370ca1 100644 --- a/tests/test-org-roam-config-format.el +++ b/tests/test-org-roam-config-format.el @@ -147,5 +147,21 @@ Returns the formatted file content." (let ((result (test-format "Title" "id" "* Content"))) (should (string-match-p "#\\+FILETAGS: Topic\n\n\\* Content" result)))) +(defvar org-roam-capture-templates) + +(ert-deftest test-org-roam-config-immediate-insert-binding-is-dynamic () + "Normal: the immediate-insert template binding reaches the insert call. +Without the module's defvar, the byte-compiled let is a dead lexical +binding: org-roam-node-insert would see the untouched global templates +and :immediate-finish never applies -- the \"immediate\" insert opens a +capture buffer. Asserted behaviorally (not via special-variable-p, +whose answer differs between the package-loaded and bare batch envs)." + (let ((org-roam-capture-templates '(("d" "default"))) + seen) + (cl-letf (((symbol-function 'org-roam-node-insert) + (lambda (&rest _) (setq seen org-roam-capture-templates)))) + (cj/org-roam-node-insert-immediate nil)) + (should (equal seen '(("d" "default" :immediate-finish t)))))) + (provide 'test-org-roam-config-format) ;;; test-org-roam-config-format.el ends here diff --git a/tests/test-pre-commit-hook.bats b/tests/test-pre-commit-hook.bats new file mode 100644 index 00000000..413c71d0 --- /dev/null +++ b/tests/test-pre-commit-hook.bats @@ -0,0 +1,126 @@ +#!/usr/bin/env bats +# Tests for githooks/pre-commit — the secret scan and paren check. +# +# The scan reads its input through a pipeline: +# +# added_lines="$(git diff --cached ... | grep '^+' | grep -v '^+++' || true)" +# +# `grep` exits 1 when it matches nothing, which is the ordinary case, so the +# `|| true` has to stay. But with no `pipefail` it also swallows a failure of +# `git diff` itself, and an empty `added_lines` makes the scan search nothing, +# find nothing, and report clean. A gate that passes without looking is the +# failure this file exists to pin: the fail-open test drives a broken `git diff` +# and asserts the hook refuses rather than exiting 0. +# +# Each test builds a throwaway git repo in BATS_TEST_TMPDIR, so nothing touches +# the real repository or its hooks. + +setup() { + HOOK="${BATS_TEST_DIRNAME}/../githooks/pre-commit" + REPO="${BATS_TEST_TMPDIR}/repo" + mkdir -p "$REPO" + cd "$REPO" || return 1 + git init -q . + git config user.email t@example.com + git config user.name Test + # Split so the fixtures never appear as credential-shaped literals here. + AWS_TAIL="IOSFODNN7EXAMPLE" + WORD_TAIL="word" +} + +# Put a stub `git` ahead of the real one that fails for the staged-diff call +# and delegates everything else, so only the pipeline under test breaks. +break_staged_diff() { + mkdir -p "${BATS_TEST_TMPDIR}/bin" + cat > "${BATS_TEST_TMPDIR}/bin/git" <<'STUB' +#!/usr/bin/env bash +if [ "${1:-}" = "diff" ] && [ "${2:-}" = "--cached" ] && [ "${3:-}" = "-U0" ]; then + echo "simulated git failure" >&2 + exit 128 +fi +exec /usr/bin/git "$@" +STUB + chmod +x "${BATS_TEST_TMPDIR}/bin/git" + PATH="${BATS_TEST_TMPDIR}/bin:$PATH" +} + +# ------------------------------- Normal cases ------------------------------- + +@test "secret scan: blocks a staged AWS key" { + # Assembled at runtime: a literal key-shaped string in this file would trip + # the very hook under test on every commit that touches it, and this repo + # mirrors to a public remote. + printf 'aws = "%s"\n' "AKIA${AWS_TAIL}" > creds.txt + git add creds.txt + run "$HOOK" + [ "$status" -eq 1 ] + [[ "$output" == *"potential secret"* ]] +} + +@test "secret scan: blocks a staged keyword=value password" { + printf '%s = "%s"\n' "pass${WORD_TAIL}" "correcthorsebatterystaple" > conf.txt + git add conf.txt + run "$HOOK" + [ "$status" -eq 1 ] + [[ "$output" == *"potential secret"* ]] +} + +@test "secret scan: allows an ordinary staged file" { + printf 'just some prose\n' > notes.txt + git add notes.txt + run "$HOOK" + [ "$status" -eq 0 ] +} + +# ------------------------------ Boundary cases ------------------------------ + +@test "secret scan: allows a commit with nothing staged" { + run "$HOOK" + [ "$status" -eq 0 ] +} + +@test "paren check: blocks an unbalanced staged .el file" { + printf '(defun broken ()\n (message "no close"\n' > bad.el + git add bad.el + run "$HOOK" + [ "$status" -eq 1 ] + [[ "$output" == *"paren check failed"* ]] +} + +@test "paren check: allows a balanced staged .el file" { + printf '(defun fine ()\n (message "ok"))\n' > good.el + git add good.el + run "$HOOK" + [ "$status" -eq 0 ] +} + +# -------------------------------- Error cases ------------------------------- + +@test "secret scan: refuses to pass when the staged diff cannot be read" { + # The scan must not report clean after searching nothing. Without a + # pipefail-aware guard the broken diff yields an empty added_lines and the + # hook exits 0, letting a real secret through unscanned. + printf 'aws = "%s"\n' "AKIA${AWS_TAIL}" > creds.txt + git add creds.txt + break_staged_diff + run "$HOOK" + [ "$status" -ne 0 ] +} + +@test "paren check: refuses to pass when the staged file list cannot be read" { + printf '(defun broken ()\n (message "no close"\n' > bad.el + git add bad.el + mkdir -p "${BATS_TEST_TMPDIR}/bin2" + cat > "${BATS_TEST_TMPDIR}/bin2/git" <<'STUB' +#!/usr/bin/env bash +if [ "${1:-}" = "diff" ] && [ "${2:-}" = "--cached" ] && [ "${3:-}" = "--name-only" ]; then + echo "simulated git failure" >&2 + exit 128 +fi +exec /usr/bin/git "$@" +STUB + chmod +x "${BATS_TEST_TMPDIR}/bin2/git" + PATH="${BATS_TEST_TMPDIR}/bin2:$PATH" + run "$HOOK" + [ "$status" -ne 0 ] +} diff --git a/tests/test-prog-c--tool-warnings.el b/tests/test-prog-c--tool-warnings.el new file mode 100644 index 00000000..9d4da57e --- /dev/null +++ b/tests/test-prog-c--tool-warnings.el @@ -0,0 +1,34 @@ +;;; test-prog-c--tool-warnings.el --- Load-time missing-tool warnings -*- lexical-binding: t; -*- + +;;; Commentary: +;; The config audit flagged clangd for the load-time missing-tool +;; warning pyright/prettier already have. clang-format is the same +;; class: its use-package block gates on `:if (executable-find ...)', +;; which evaluates once at startup, so an absent binary silently +;; disables the format key until the next restart — the warn is the +;; only visible trace. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(require 'testutil-format-wiring) +(format-test--ensure-packages-init) +(require 'prog-c) + +(ert-deftest test-prog-c-warns-when-tools-missing () + "Error: loading without the C tools on PATH warns for each one." + (let ((warned '())) + (cl-letf (((symbol-function 'executable-find) (lambda (&rest _) nil)) + ((symbol-function 'display-warning) + (lambda (_type msg &rest _) (push msg warned)))) + (load (expand-file-name "modules/prog-c.el" user-emacs-directory) nil t)) + (dolist (tool '("clangd" "clang-format")) + (should (cl-some (lambda (m) (string-match-p (regexp-quote tool) m)) + warned))))) + +(provide 'test-prog-c--tool-warnings) +;;; test-prog-c--tool-warnings.el ends here diff --git a/tests/test-prog-general--pin-go-treesit-revision.el b/tests/test-prog-general--pin-go-treesit-revision.el new file mode 100644 index 00000000..42845b4f --- /dev/null +++ b/tests/test-prog-general--pin-go-treesit-revision.el @@ -0,0 +1,51 @@ +;;; test-prog-general--pin-go-treesit-revision.el --- Go grammar pinning -*- lexical-binding: t; -*- + +;;; Commentary: +;; The treesit-auto Go recipe is pinned for compatibility with Emacs 30.2. +;; Keep the mutation independent of cl-defstruct's compile-time setter +;; expansion: prog-general is loaded before treesit-auto defines that setter +;; during a normal startup. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +;; Deliberately put `revision' at a different offset from treesit-auto's real +;; struct. The production helper must discover the slot rather than hard-code +;; the package's current vector layout. +(cl-defstruct treesit-auto-recipe lang revision url) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'prog-general) + +(ert-deftest test-prog-general-pin-go-treesit-revision-updates-go () + "Normal: the Go recipe receives the supported grammar revision." + (let* ((go (make-treesit-auto-recipe + :lang 'go :revision "main" :url "https://example.test/go")) + (python (make-treesit-auto-recipe + :lang 'python :revision "main" + :url "https://example.test/python"))) + (cj/treesit-auto-pin-go-revision (list python go)) + (should (equal (treesit-auto-recipe-revision go) "v0.19.1")) + (should (equal (treesit-auto-recipe-revision python) "main")))) + +(ert-deftest test-prog-general-pin-go-treesit-revision-no-go-is-no-op () + "Boundary: a recipe list without Go remains unchanged." + (let ((python (make-treesit-auto-recipe + :lang 'python :revision "main" + :url "https://example.test/python"))) + (should-not (cj/treesit-auto-pin-go-revision (list python))) + (should (equal (treesit-auto-recipe-revision python) "main")))) + +(ert-deftest test-prog-general-pin-go-treesit-revision-empty-is-no-op () + "Boundary: an empty recipe list does not signal an error." + (should-not (cj/treesit-auto-pin-go-revision nil))) + +(ert-deftest test-prog-general-pin-go-treesit-revision-malformed-recipe-errors () + "Error: a malformed recipe signals instead of silently skipping the pin." + (should-error (cj/treesit-auto-pin-go-revision '(not-a-recipe)) + :type 'wrong-type-argument)) + +(provide 'test-prog-general--pin-go-treesit-revision) +;;; test-prog-general--pin-go-treesit-revision.el ends here diff --git a/tests/test-prog-go--classic-mode-hooks.el b/tests/test-prog-go--classic-mode-hooks.el new file mode 100644 index 00000000..a9defe2e --- /dev/null +++ b/tests/test-prog-go--classic-mode-hooks.el @@ -0,0 +1,46 @@ +;;; test-prog-go--classic-mode-hooks.el --- Classic go-mode hooks + gopls warn -*- lexical-binding: t; -*- + +;;; Commentary: +;; The config audit found the Go setup hooks attached to go-ts-mode +;; only, so a fallback to classic go-mode silently lost indent, keys, +;; and LSP. It also flagged gopls for the load-time missing-tool +;; warning pyright/prettier already have; that warn is only honest if +;; ~/go/bin is on `exec-path' at load time (it used to join only in +;; go-mode's deferred :config, so gopls installed there read as +;; missing). + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(require 'testutil-format-wiring) +(format-test--ensure-packages-init) +(require 'prog-go) + +(ert-deftest test-prog-go-hooks-cover-classic-go-mode () + "Normal: classic go-mode runs the same setup + keybindings as go-ts-mode." + (dolist (hook '(go-mode-hook go-ts-mode-hook)) + (should (memq #'cj/go-setup (symbol-value hook))) + (should (memq #'cj/go-mode-keybindings (symbol-value hook))))) + +(ert-deftest test-prog-go-bin-path-on-exec-path-at-load () + "Normal: ~/go/bin joins `exec-path' at module load, not first go buffer. +The load-time gopls warn resolves through `exec-path'; registering the +Go bin directory only in go-mode's deferred :config would make gopls +installed there warn as missing on every start." + (should (member go-bin-path exec-path))) + +(ert-deftest test-prog-go-warns-when-gopls-missing () + "Error: loading the module without gopls on PATH warns about gopls." + (let ((warned '())) + (cl-letf (((symbol-function 'executable-find) (lambda (&rest _) nil)) + ((symbol-function 'display-warning) + (lambda (_type msg &rest _) (push msg warned)))) + (load (expand-file-name "modules/prog-go.el" user-emacs-directory) nil t)) + (should (cl-some (lambda (m) (string-match-p "gopls" m)) warned)))) + +(provide 'test-prog-go--classic-mode-hooks) +;;; test-prog-go--classic-mode-hooks.el ends here diff --git a/tests/test-prog-shell--tool-warnings.el b/tests/test-prog-shell--tool-warnings.el new file mode 100644 index 00000000..37c1e559 --- /dev/null +++ b/tests/test-prog-shell--tool-warnings.el @@ -0,0 +1,34 @@ +;;; test-prog-shell--tool-warnings.el --- Load-time missing-tool warnings -*- lexical-binding: t; -*- + +;;; Commentary: +;; The config audit flagged bash-language-server, shfmt, and shellcheck +;; for the load-time missing-tool warnings pyright/prettier already +;; have. The shfmt and flycheck use-package blocks gate on `:if +;; (executable-find ...)', which evaluates once at startup — an absent +;; tool silently disables that setup until the next restart, so the +;; warn is the only visible trace. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(require 'testutil-format-wiring) +(format-test--ensure-packages-init) +(require 'prog-shell) + +(ert-deftest test-prog-shell-warns-when-tools-missing () + "Error: loading without the shell tools on PATH warns for each one." + (let ((warned '())) + (cl-letf (((symbol-function 'executable-find) (lambda (&rest _) nil)) + ((symbol-function 'display-warning) + (lambda (_type msg &rest _) (push msg warned)))) + (load (expand-file-name "modules/prog-shell.el" user-emacs-directory) nil t)) + (dolist (tool '("bash-language-server" "shfmt" "shellcheck")) + (should (cl-some (lambda (m) (string-match-p (regexp-quote tool) m)) + warned))))) + +(provide 'test-prog-shell--tool-warnings) +;;; test-prog-shell--tool-warnings.el ends here diff --git a/tests/test-prog-webdev--classic-and-web-mode-hooks.el b/tests/test-prog-webdev--classic-and-web-mode-hooks.el new file mode 100644 index 00000000..20fc2fb8 --- /dev/null +++ b/tests/test-prog-webdev--classic-and-web-mode-hooks.el @@ -0,0 +1,78 @@ +;;; test-prog-webdev--classic-and-web-mode-hooks.el --- Classic js + web-mode setup hooks -*- lexical-binding: t; -*- + +;;; Commentary: +;; The config audit found the webdev setup hooks attached to the +;; tree-sitter modes only, so a grammar-unavailable fallback to classic +;; js-mode silently lost indent/keys/LSP, and web-mode got the format +;; key but none of the promised setup (no company/flyspell/LSP in HTML +;; buffers). These tests pin the classic js-mode hooks and the +;; web-mode setup hook, plus the html-language-server guard that keeps +;; LSP silent on machines without the server. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(require 'testutil-format-wiring) +(format-test--ensure-packages-init) +(require 'prog-webdev) + +(ert-deftest test-prog-webdev-hooks-cover-classic-js-mode () + "Normal: classic js-mode runs the same setup + keybindings as js-ts-mode." + (should (memq #'cj/webdev-setup js-mode-hook)) + (should (memq #'cj/webdev-keybindings js-mode-hook))) + +(ert-deftest test-prog-webdev-web-mode-hook-runs-setup () + "Normal: web-mode runs `cj/web-mode-setup' alongside the keybindings." + (should (memq #'cj/web-mode-setup web-mode-hook)) + (should (memq #'cj/webdev-keybindings web-mode-hook))) + +(ert-deftest test-prog-webdev-web-mode-setup-sets-buffer-local-preferences () + "Normal: web-mode setup lands the shared webdev buffer preferences." + (with-temp-buffer + (cl-letf (((symbol-function 'company-mode) #'ignore) + ((symbol-function 'flyspell-prog-mode) #'ignore) + ((symbol-function 'superword-mode) #'ignore) + ((symbol-function 'electric-pair-local-mode) #'ignore) + ((symbol-function 'executable-find) (lambda (_ &rest _) nil))) + (cj/web-mode-setup)) + (should (= fill-column 100)) + (should (= tab-width 2)) + (should-not indent-tabs-mode))) + +(ert-deftest test-prog-webdev-web-mode-setup-starts-lsp-when-html-server-on-path () + "Normal: with the html language server on PATH, `lsp-deferred' fires." + (with-temp-buffer + (let ((started nil)) + (cl-letf (((symbol-function 'company-mode) #'ignore) + ((symbol-function 'flyspell-prog-mode) #'ignore) + ((symbol-function 'superword-mode) #'ignore) + ((symbol-function 'electric-pair-local-mode) #'ignore) + ((symbol-function 'lsp-deferred) + (lambda (&rest _) (setq started t))) + ((symbol-function 'executable-find) + (lambda (path &rest _) + (when (equal path html-language-server-path) + "/usr/bin/vscode-html-language-server")))) + (cj/web-mode-setup)) + (should started)))) + +(ert-deftest test-prog-webdev-web-mode-setup-skips-lsp-without-html-server () + "Boundary: without the html language server, `lsp-deferred' is NOT called." + (with-temp-buffer + (let ((started nil)) + (cl-letf (((symbol-function 'company-mode) #'ignore) + ((symbol-function 'flyspell-prog-mode) #'ignore) + ((symbol-function 'superword-mode) #'ignore) + ((symbol-function 'electric-pair-local-mode) #'ignore) + ((symbol-function 'lsp-deferred) + (lambda (&rest _) (setq started t))) + ((symbol-function 'executable-find) (lambda (_ &rest _) nil))) + (cj/web-mode-setup)) + (should-not started)))) + +(provide 'test-prog-webdev--classic-and-web-mode-hooks) +;;; test-prog-webdev--classic-and-web-mode-hooks.el ends here diff --git a/tests/test-restclient-config--keymap.el b/tests/test-restclient-config--keymap.el new file mode 100644 index 00000000..7265c4f3 --- /dev/null +++ b/tests/test-restclient-config--keymap.el @@ -0,0 +1,29 @@ +;;; test-restclient-config--keymap.el --- Tests for the restclient prefix keymap -*- lexical-binding: t -*- + +;;; Commentary: +;; Pins the C-; R prefix wiring. The bindings must go through +;; `cj/restclient-map' + `cj/register-prefix-map' (like the other C-; +;; prefixes), not raw `global-set-key' calls that silently depend on +;; keybindings.el having installed C-; first. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'restclient-config) + +;;; Normal Cases + +(ert-deftest test-restclient-keymap-registered-under-custom-prefix () + "Normal: cj/restclient-map is bound at R inside cj/custom-keymap." + (should (boundp 'cj/restclient-map)) + (should (eq cj/restclient-map (keymap-lookup cj/custom-keymap "R")))) + +(ert-deftest test-restclient-keymap-binds-new-buffer-and-open-file () + "Normal: the prefix map carries the two restclient commands." + (should (eq #'cj/restclient-new-buffer (keymap-lookup cj/restclient-map "n"))) + (should (eq #'cj/restclient-open-file (keymap-lookup cj/restclient-map "o")))) + +(provide 'test-restclient-config--keymap) +;;; test-restclient-config--keymap.el ends here diff --git a/tests/test-slack-config-reactions.el b/tests/test-slack-config-reactions.el index 491b8147..bfcf3e29 100644 --- a/tests/test-slack-config-reactions.el +++ b/tests/test-slack-config-reactions.el @@ -92,5 +92,13 @@ (let ((slack-current-buffer nil)) (should-error (cj/slack-message-add-reaction) :type 'user-error))) +(ert-deftest test-slack-config-message-add-reaction-errors-before-slack-loads () + "Error: a cold call before slack.el ever loads gives the friendly user-error. +The module defvars slack-current-buffer with no value, so until slack.el +binds it the variable is void -- a bare read signals void-variable instead +of the intended \"Not in a Slack buffer\"." + (makunbound 'slack-current-buffer) + (should-error (cj/slack-message-add-reaction) :type 'user-error)) + (provide 'test-slack-config-reactions) ;;; test-slack-config-reactions.el ends here diff --git a/tests/test-system-commands-resolve-and-run.el b/tests/test-system-commands-resolve-and-run.el index 9d92c5d6..3dae8cda 100644 --- a/tests/test-system-commands-resolve-and-run.el +++ b/tests/test-system-commands-resolve-and-run.el @@ -85,26 +85,34 @@ (put 'test-sc-confirm-cmd 'cj/system-confirm nil))) (ert-deftest test-system-cmd-strong-confirm-decline-aborts () - "Boundary: a strong-confirm var uses yes-or-no-p; declining aborts and -does not run the command." + "Boundary: a strong-confirm var asks a single y/n; declining aborts and +does not run the command. + +The strong path used to demand a typed \"yes\", and this test used to assert +that by erroring if `read-char-choice' was called at all. It now asserts the +opposite, because a long-form prompt is only as safe as it is answerable: on +2026-07-31 one became unanswerable when a second agent session held the +selected window, and the Emacs session had to be killed with buffers unsaved. +What survives the change is the part that mattered -- the prompt still has no +default, so RET and space re-prompt rather than confirming a shutdown." (defvar test-sc-strong-cmd "test-strong-cmd") (put 'test-sc-strong-cmd 'cj/system-confirm 'strong) (unwind-protect - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil)) - ((symbol-function 'read-char-choice) - (lambda (&rest _) (error "strong confirm must not use read-char-choice"))) + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?n)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) (error "strong confirm must not demand a typed yes"))) ((symbol-function 'start-process-shell-command) (lambda (&rest _) (error "shouldn't run")))) (should-error (cj/system-cmd 'test-sc-strong-cmd) :type 'user-error)) (put 'test-sc-strong-cmd 'cj/system-confirm nil))) (ert-deftest test-system-cmd-strong-confirm-accept-runs () - "Normal: a strong-confirm var runs the command when yes-or-no-p returns t." + "Normal: a strong-confirm var runs the command on a single y." (defvar test-sc-strong-cmd-2 "echo strong") (put 'test-sc-strong-cmd-2 'cj/system-confirm 'strong) (let (cmd-line) (unwind-protect - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y)) ((symbol-function 'start-process-shell-command) (lambda (_name _buf c) (setq cmd-line c) 'fake-proc)) ((symbol-function 'set-process-query-on-exit-flag) #'ignore) @@ -114,6 +122,29 @@ does not run the command." (put 'test-sc-strong-cmd-2 'cj/system-confirm nil)) (should (string-match-p "echo strong" cmd-line)))) +(ert-deftest test-system-cmd-strong-confirm-rejects-stray-keys () + "Boundary: the strong prompt offers only y and n, so a stray RET or space +cannot confirm an irreversible command. + +This is the protection the typed-\"yes\" form existed for, kept while the +answer became a single keystroke. Asserted on the accepted-character set +handed to `read-char-choice' rather than on the prompt text, because the set +is what actually decides." + (defvar test-sc-strong-cmd-3 "echo strong") + (put 'test-sc-strong-cmd-3 'cj/system-confirm 'strong) + (let (chars) + (unwind-protect + (cl-letf (((symbol-function 'read-char-choice) + (lambda (_prompt cs &rest _) (setq chars cs) ?n)) + ((symbol-function 'start-process-shell-command) + (lambda (&rest _) (error "shouldn't run")))) + (should-error (cj/system-cmd 'test-sc-strong-cmd-3) :type 'user-error)) + (put 'test-sc-strong-cmd-3 'cj/system-confirm nil)) + (should (equal (sort (copy-sequence chars) #'<) '(?N ?Y ?n ?y))) + (should-not (memq ?\r chars)) + (should-not (memq ?\n chars)) + (should-not (memq ?\s chars)))) + ;;; cj/system-cmd--emacs-service-available-p (ert-deftest test-system-cmd-service-available-true-on-zero-exit () @@ -230,5 +261,37 @@ kill-emacs directly (the service owns the daemon lifecycle)." (cj/system-command-menu)) (should (eq called 'cj/system-cmd-lock)))) +;;; Lock command resolves the locker at call time + +(defun test-system-cmd--run-lock-capturing () + "Run the lock command; return the shell command line it launched." + (let (cmd-line) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buf c) (setq cmd-line c) 'fake-proc)) + ((symbol-function 'set-process-query-on-exit-flag) #'ignore) + ((symbol-function 'set-process-sentinel) #'ignore) + ((symbol-function 'message) #'ignore)) + (cj/system-cmd-lock)) + cmd-line)) + +(ert-deftest test-system-cmd-lock-follows-session-type-at-call-time () + "Normal: the locker tracks the live session type, not the load-time bake. +A daemon started before WAYLAND_DISPLAY was imported used to freeze the +locker to slock forever; Lock then failed silently on Wayland." + (let ((lockscreen-cmd nil)) + (cl-letf (((symbol-function 'env-wayland-p) (lambda () t))) + (should (string-match-p "loginctl lock-session" + (test-system-cmd--run-lock-capturing)))) + (cl-letf (((symbol-function 'env-wayland-p) (lambda () nil))) + (should (string-match-p "slock" + (test-system-cmd--run-lock-capturing)))))) + +(ert-deftest test-system-cmd-lock-explicit-override-wins () + "Boundary: a user-set lockscreen-cmd overrides the session-type resolution." + (let ((lockscreen-cmd "my-locker --now")) + (cl-letf (((symbol-function 'env-wayland-p) (lambda () t))) + (should (string-match-p "my-locker --now" + (test-system-cmd--run-lock-capturing)))))) + (provide 'test-system-commands-resolve-and-run) ;;; test-system-commands-resolve-and-run.el ends here diff --git a/tests/test-system-defaults-functions.el b/tests/test-system-defaults-functions.el index c603fc7e..4b647166 100644 --- a/tests/test-system-defaults-functions.el +++ b/tests/test-system-defaults-functions.el @@ -162,5 +162,36 @@ and the rendered S-expression lands in the log." (should (string-match-p ":slot" contents))))) (delete-file comp-warnings-log)))) +(ert-deftest test-system-defaults-log-comp-warning-unwritable-log-does-not-signal () + "Error: an unwritable log path must not signal. +The function is `:before-until' advice on `display-warning'; a signal here +propagates out of `display-warning' and breaks warning display for every +async native-comp notice. It swallows the write failure and still returns +t (the warning stays suppressed), rather than crashing." + (let ((comp-warnings-log "/proc/nonexistent-dir/cannot-write.log")) + (should (eq t (cj/log-comp-warning 'comp "boom"))))) + +(ert-deftest test-system-defaults-log-comp-warning-caps-log-growth () + "Boundary: the log is bounded — once it exceeds the cap, a further write +resets it (deletes the old file, keeping only the new entry) rather than +growing without limit. A hard reset, not a tail-trim: on overflow the old +history is discarded, which is fine for a transient diagnostic log." + (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log"))) + (unwind-protect + (progn + ;; Seed the file well over the cap. + (with-temp-file comp-warnings-log + (insert (make-string (1+ cj/comp-warnings-log-max-bytes) ?x))) + (should (> (file-attribute-size (file-attributes comp-warnings-log)) + cj/comp-warnings-log-max-bytes)) + (cj/log-comp-warning 'comp "after the cap") + (should (<= (file-attribute-size (file-attributes comp-warnings-log)) + cj/comp-warnings-log-max-bytes)) + ;; The newest entry survives the trim. + (with-temp-buffer + (insert-file-contents comp-warnings-log) + (should (string-match-p "after the cap" (buffer-string))))) + (delete-file comp-warnings-log)))) + (provide 'test-system-defaults-functions) ;;; test-system-defaults-functions.el ends here diff --git a/tests/test-system-lib--ensure-marginalia-align.el b/tests/test-system-lib--ensure-marginalia-align.el new file mode 100644 index 00000000..33ff2ba2 --- /dev/null +++ b/tests/test-system-lib--ensure-marginalia-align.el @@ -0,0 +1,57 @@ +;;; test-system-lib--ensure-marginalia-align.el --- Tests for marginalia category registration -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Custom completion categories (cj-music-file, cj-radio-station, and every +;; category passed to the system-lib table helpers) bypass marginalia, so +;; their annotations never get its right-alignment even with marginalia-align +;; set. The registration helper adds a builtin entry per category so the +;; table's own annotation function renders through marginalia's aligned field. + +;;; Code: + +(require 'ert) + +;; The module's bare defvar marks this special only file-locally; declare it +;; here too so `let' binds dynamically (the scope-shadowing trap). +(defvar marginalia-annotator-registry) + +(require 'system-lib) + +;;; Normal Cases + +(ert-deftest test-system-lib-ensure-marginalia-align-registers-category () + "Normal: an unregistered category gains a builtin registry entry." + (let ((marginalia-annotator-registry '((file some-annotator builtin none)))) + (cj/completion-ensure-marginalia-align 'cj-test-category) + (should (equal (assq 'cj-test-category marginalia-annotator-registry) + '(cj-test-category builtin none))))) + +(ert-deftest test-system-lib-ensure-marginalia-align-idempotent () + "Normal: registering the same category twice leaves one entry." + (let ((marginalia-annotator-registry '())) + (cj/completion-ensure-marginalia-align 'cj-test-category) + (cj/completion-ensure-marginalia-align 'cj-test-category) + (should (= 1 (length marginalia-annotator-registry))))) + +;;; Boundary Cases + +(ert-deftest test-system-lib-ensure-marginalia-align-preserves-existing-entry () + "Boundary: a category with an existing (possibly custom) entry is untouched." + (let ((marginalia-annotator-registry '((cj-test-category my-custom-annotator)))) + (cj/completion-ensure-marginalia-align 'cj-test-category) + (should (equal (assq 'cj-test-category marginalia-annotator-registry) + '(cj-test-category my-custom-annotator))))) + +;;; Error Cases + +(ert-deftest test-system-lib-ensure-marginalia-align-marginalia-absent-noop () + "Error: without marginalia loaded (registry void) the helper is a silent +no-op -- annotations just stay unaligned, nothing breaks." + ;; marginalia is not loadable in the batch environment, so the global + ;; registry is genuinely void outside the `let's above. + (should-not (cj/completion-ensure-marginalia-align 'cj-test-category))) + +(provide 'test-system-lib--ensure-marginalia-align) +;;; test-system-lib--ensure-marginalia-align.el ends here diff --git a/tests/test-system-lib-confirm-destructive.el b/tests/test-system-lib-confirm-destructive.el new file mode 100644 index 00000000..4fc96e21 --- /dev/null +++ b/tests/test-system-lib-confirm-destructive.el @@ -0,0 +1,141 @@ +;;; test-system-lib-confirm-destructive.el --- Tests for cj/confirm-destructive -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for `cj/confirm-destructive', the confirmation used for +;; irreversible actions: file destruction, overwrites, power-off. +;; +;; The contract has two halves, and they pull against each other: +;; +;; 1. One keystroke. This replaced a typed-"yes" prompt on 2026-07-31, after +;; one became unanswerable -- a second agent session held the selected +;; window while the prompt waited in another frame, so keystrokes went to a +;; terminal and the Emacs session had to be killed with buffers unsaved. A +;; long-form prompt is only as safe as it is answerable. +;; +;; 2. No default. Only y and n answer. A stray RET or space re-prompts +;; instead of confirming, which is the accidental-confirm protection the +;; long form existed for, and it survives the change. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'system-lib) + +;;; Normal Cases + +(ert-deftest test-system-lib-confirm-destructive-returns-t-on-y () + "Normal: a y answer confirms." + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y))) + (should (eq (cj/confirm-destructive "Really? ") t)))) + +(ert-deftest test-system-lib-confirm-destructive-returns-nil-on-n () + "Normal: an n answer declines." + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?n))) + (should (eq (cj/confirm-destructive "Really? ") nil)))) + +;;; Boundary Cases + +(ert-deftest test-system-lib-confirm-destructive-accepts-uppercase () + "Boundary: a capital Y confirms and a capital N declines, so the answer +does not depend on the shift key or caps lock." + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?Y))) + (should (eq (cj/confirm-destructive "Really? ") t))) + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?N))) + (should (eq (cj/confirm-destructive "Really? ") nil)))) + +(ert-deftest test-system-lib-confirm-destructive-offers-only-y-and-n () + "Boundary: RET, space and every other key are refused. + +This is the protection that justified the old typed-\"yes\" form, kept now +that the answer is a single keystroke. Asserted on the character set handed +to `read-char-choice', which is what actually decides, rather than on the +prompt text, which only describes." + (let (chars) + (cl-letf (((symbol-function 'read-char-choice) + (lambda (_prompt cs &rest _) (setq chars cs) ?n))) + (cj/confirm-destructive "Really? ")) + (should (equal (sort (copy-sequence chars) #'<) '(?N ?Y ?n ?y))) + (should-not (memq ?\r chars)) + (should-not (memq ?\n chars)) + (should-not (memq ?\s chars)))) + +(ert-deftest test-system-lib-confirm-destructive-is-single-keystroke () + "Boundary: it never routes through `yes-or-no-p'. + +The regression this file guards. Binding `use-short-answers' to nil for the +call, which is what the old implementation did, is exactly the shape that +produced an unanswerable prompt." + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) (error "must not demand a typed yes")))) + (should (eq (cj/confirm-destructive "Really? ") t)))) + +(ert-deftest test-system-lib-confirm-destructive-ignores-short-answer-setting () + "Boundary: the answer is one key whether or not `use-short-answers' is set. +The global default is t, but nothing about this prompt should depend on it." + (dolist (setting '(t nil)) + (let ((use-short-answers setting)) + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y)) + ((symbol-function 'yes-or-no-p) + (lambda (&rest _) (error "must not demand a typed yes")))) + (should (eq (cj/confirm-destructive "Really? ") t)))))) + +(ert-deftest test-system-lib-confirm-destructive-discards-type-ahead () + "Boundary: pending input is discarded before the key is read. + +The regression that made this necessary. `read-char-choice' reads the input +queue, so a key typed before the prompt appeared would answer it: a queued y +would confirm a shutdown or a file deletion instantly. The typed-\"yes\" +form absorbed such a key harmlessly, so dropping it without this guard would +have traded a rare annoyance for a rare catastrophe. + +Asserted on ordering, since that is the whole property: the discard has to +happen before the read, not merely somewhere in the function." + (let ((events '())) + (cl-letf (((symbol-function 'discard-input) + (lambda (&rest _) (push 'discard events) nil)) + ((symbol-function 'read-char-choice) + (lambda (&rest _) (push 'read events) ?y))) + (should (eq (cj/confirm-destructive "Really? ") t))) + (should (equal (nreverse events) '(discard read))))) + +;;; Error Cases + +(ert-deftest test-system-lib-confirm-destructive-declines-on-other-char () + "Error: anything that is not y or n declines rather than confirming. + +`read-char-choice' normally loops until it gets a listed character, but it +can return outside the set -- `read-char-from-minibuffer' yields RET when the +minibuffer result is empty. On an irreversible action the safe reading of an +unexpected answer is no." + (dolist (ch (list ?\r ?\n ?\s ?q ?\C-m)) + (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ch))) + (should-not (cj/confirm-destructive "Really? "))))) + +(ert-deftest test-system-lib-confirm-destructive-propagates-quit () + "Error: C-g aborts the caller rather than reading as a confirmation. +Swallowing the quit here would turn an abort into a yes on an irreversible +action." + (cl-letf (((symbol-function 'read-char-choice) + (lambda (&rest _) (signal 'quit nil)))) + ;; `should-error' cannot express this: quit is not an error, so ERT lets + ;; it through and reports the test as QUIT rather than passed. Catching + ;; it here is what makes the assertion a real pass or fail. + (should (eq 'quit (condition-case nil + (progn (cj/confirm-destructive "Really? ") + 'returned-normally) + (quit 'quit)))))) + +(ert-deftest test-system-lib-confirm-destructive-prompt-shows-choices () + "Error: the prompt names the keys that answer, so an unfamiliar prompt is +not a guessing game." + (let (prompt) + (cl-letf (((symbol-function 'read-char-choice) + (lambda (p &rest _) (setq prompt p) ?n))) + (cj/confirm-destructive "Delete everything? ")) + (should (string-match-p "Delete everything\\?" prompt)) + (should (string-match-p "y or n" prompt)))) + +(provide 'test-system-lib-confirm-destructive) +;;; test-system-lib-confirm-destructive.el ends here diff --git a/tests/test-system-lib-confirm-strong.el b/tests/test-system-lib-confirm-strong.el deleted file mode 100644 index 26c00822..00000000 --- a/tests/test-system-lib-confirm-strong.el +++ /dev/null @@ -1,37 +0,0 @@ -;;; test-system-lib-confirm-strong.el --- Tests for cj/confirm-strong -*- lexical-binding: t; -*- - -;;; Commentary: -;; ERT tests for `cj/confirm-strong', the typed-"yes" confirmation used for -;; irreversible actions. The behavior under test is the long-form guarantee: -;; the prompt demands a typed yes/no even when the global single-key default -;; (`use-short-answers') is in effect. - -;;; Code: - -(require 'ert) -(require 'cl-lib) -(require 'system-lib) - -(ert-deftest test-system-lib-confirm-strong-returns-t-on-yes () - "Normal: passes a t answer through from `yes-or-no-p'." - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))) - (should (eq (cj/confirm-strong "Really? ") t)))) - -(ert-deftest test-system-lib-confirm-strong-returns-nil-on-no () - "Normal: passes a nil answer through from `yes-or-no-p'." - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil))) - (should (eq (cj/confirm-strong "Really? ") nil)))) - -(ert-deftest test-system-lib-confirm-strong-forces-long-form () - "Boundary: binds `use-short-answers' to nil for the call even when it is -globally t, so the irreversible prompt requires a typed yes/no regardless of -the single-key default." - (let ((use-short-answers t) - (seen 'unset)) - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (&rest _) (setq seen use-short-answers) t))) - (cj/confirm-strong "Really? ") - (should (eq seen nil))))) - -(provide 'test-system-lib-confirm-strong) -;;; test-system-lib-confirm-strong.el ends here diff --git a/tests/test-telega-config--docker-pin.el b/tests/test-telega-config--docker-pin.el new file mode 100644 index 00000000..894dbfdd --- /dev/null +++ b/tests/test-telega-config--docker-pin.el @@ -0,0 +1,93 @@ +;;; test-telega-config--docker-pin.el --- Tests for the telega docker image pin -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for pinning the telega-server container image. +;; +;; telega infers its image from `telega-tdlib-min-version' and only pins to a +;; version tag when min and max versions are equal and the version ends in +;; ".0". This config has min "1.8.64" and max nil, so the inference always +;; falls through to "zevlg/telega-server:latest" -- a moving tag that can +;; swap the server out from under a fixed elisp version without notice. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'telega-config) + +;; -- cj/--telega-docker-pinned-image ----------------------------------------- + +(ert-deftest test-telega-config-pin-returns-configured-reference () + "Normal: a configured pin is returned verbatim." + (let ((cj/telega-docker-image "zevlg/telega-server@sha256:abc123")) + (should (equal (cj/--telega-docker-pinned-image) + "zevlg/telega-server@sha256:abc123")))) + +(ert-deftest test-telega-config-pin-nil-when-unset () + "Boundary: no pin returns nil so telega's own inference stays in charge." + (let ((cj/telega-docker-image nil)) + (should-not (cj/--telega-docker-pinned-image)))) + +(ert-deftest test-telega-config-pin-nil-for-empty-string () + "Boundary: an empty or whitespace pin is not a reference. +An empty string would otherwise reach the docker command line as a blank +image argument, which fails in a way that looks unrelated to this setting." + (let ((cj/telega-docker-image "")) + (should-not (cj/--telega-docker-pinned-image))) + (let ((cj/telega-docker-image " ")) + (should-not (cj/--telega-docker-pinned-image)))) + +(ert-deftest test-telega-config-pin-nil-for-non-string () + "Error: a non-string pin is ignored rather than passed to the shell." + (let ((cj/telega-docker-image 'latest)) + (should-not (cj/--telega-docker-pinned-image))) + (let ((cj/telega-docker-image 42)) + (should-not (cj/--telega-docker-pinned-image)))) + +(ert-deftest test-telega-config-pin-trims-surrounding-whitespace () + "Boundary: a pin with stray whitespace is trimmed, not rejected. +A trailing newline is easy to introduce when pasting a digest from docker." + (let ((cj/telega-docker-image " zevlg/telega-server@sha256:abc123\n")) + (should (equal (cj/--telega-docker-pinned-image) + "zevlg/telega-server@sha256:abc123")))) + +;; -- cj/--telega-docker-image-name (the advice) ------------------------------ + +(ert-deftest test-telega-config-image-advice-prefers-the-pin () + "Normal: with a pin set, the advice returns it instead of calling telega." + (let ((cj/telega-docker-image "zevlg/telega-server@sha256:abc123") + (called nil)) + (should (equal (cj/--telega-docker-image-name + (lambda () (setq called t) "zevlg/telega-server:latest")) + "zevlg/telega-server@sha256:abc123")) + (should-not called))) + +(ert-deftest test-telega-config-image-advice-delegates-without-a-pin () + "Boundary: with no pin, telega's own inference is used unchanged. +Removing the pin must restore stock behavior rather than break the image +name, so this stays a reversible setting." + (let ((cj/telega-docker-image nil)) + (should (equal (cj/--telega-docker-image-name + (lambda () "zevlg/telega-server:latest")) + "zevlg/telega-server:latest")))) + +(ert-deftest test-telega-config-image-advice-is-named-and-removable () + "Normal: the advice is a named function so it can be removed by reference." + (should (fboundp 'cj/--telega-docker-image-name))) + +(ert-deftest test-telega-config-pin-default-is-a-digest-reference () + "Normal: the shipped default pins by digest, not by a floating tag. +A tag pin (:latest, or even a version tag upstream can re-push) still +moves; a digest names one immutable image. + +Reads the defcustom's standard value rather than the live variable, so +customizing the pin (including to nil, handing the choice back to telega) +is not a test failure -- only changing the shipped default is." + (let ((default (eval (car (get 'cj/telega-docker-image 'standard-value)) t))) + (should (stringp default)) + (should (string-match-p "@sha256:[0-9a-f]\\{64\\}\\'" default)))) + +(provide 'test-telega-config--docker-pin) +;;; test-telega-config--docker-pin.el ends here diff --git a/tests/test-telega-config--server-death.el b/tests/test-telega-config--server-death.el new file mode 100644 index 00000000..1151fa7e --- /dev/null +++ b/tests/test-telega-config--server-death.el @@ -0,0 +1,131 @@ +;;; test-telega-config--server-death.el --- Tests for the telega-server death alert -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the telega-server death sentinel. telega's own sentinel only +;; calls `message' on an abnormal exit, which scrolls away unseen -- so a +;; dead server reads as a quiet Telegram. These pin the alert that replaces +;; that silence. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'telega-config) + +;; -- cj/--telega-server-death-p ---------------------------------------------- + +(ert-deftest test-telega-config-death-p-nonzero-status-is-death () + "Normal: a non-zero exit status is an abnormal death." + (should (cj/--telega-server-death-p 1)) + (should (cj/--telega-server-death-p 139))) + +(ert-deftest test-telega-config-death-p-segv-signal-is-death () + "Normal: a signal number (SIGSEGV is 11) counts as death. +This is the observed failure -- the server segfaults rather than exiting." + (should (cj/--telega-server-death-p 11))) + +(ert-deftest test-telega-config-death-p-zero-is-clean-exit () + "Boundary: exit status 0 is a clean shutdown and must not alert. +Quitting telega deliberately would otherwise page on every exit." + (should-not (cj/--telega-server-death-p 0))) + +(ert-deftest test-telega-config-death-p-nil-is-not-death () + "Boundary: nil status (no status available) is not a death." + (should-not (cj/--telega-server-death-p nil))) + +(ert-deftest test-telega-config-death-p-non-integer-is-not-death () + "Error: a non-integer status returns nil rather than signalling. +`process-exit-status' is documented to return an integer, but this runs +inside telega's sentinel where an error would disrupt telega's own cleanup." + (should-not (cj/--telega-server-death-p "segfault")) + (should-not (cj/--telega-server-death-p 'exited))) + +;; -- cj/--telega-server-exit-status ------------------------------------------ + +(ert-deftest test-telega-config-exit-status-nil-for-non-process () + "Error: a nil or non-process argument yields nil, not a signal. +The sentinel hands us whatever it has; a bad object must not break telega." + (should-not (cj/--telega-server-exit-status nil)) + (should-not (cj/--telega-server-exit-status "not-a-process"))) + +;; -- cj/--telega-server-death-body ------------------------------------------- + +(ert-deftest test-telega-config-death-body-names-status-and-effect () + "Normal: the body carries the status and says coverage is affected. +The status distinguishes a segfault from a clean kill; the effect is why +the reader should care." + (let ((body (cj/--telega-server-death-body 11 "segmentation fault\n"))) + (should (string-match-p "11" body)) + (should (string-match-p "Telegram" body)))) + +(ert-deftest test-telega-config-death-body-strips-trailing-newline () + "Boundary: a sentinel event string ends in a newline; it must not survive. +A trailing newline in a desktop notification body renders as dead space." + (let ((body (cj/--telega-server-death-body 11 "segmentation fault\n"))) + (should-not (string-suffix-p "\n" body)))) + +(ert-deftest test-telega-config-death-body-handles-empty-event () + "Boundary: an empty or nil event still produces a usable body." + (should (stringp (cj/--telega-server-death-body 11 nil))) + (should (stringp (cj/--telega-server-death-body 11 ""))) + (should (string-match-p "11" (cj/--telega-server-death-body 11 nil)))) + +(ert-deftest test-telega-config-death-body-handles-unicode-event () + "Boundary: a non-ASCII event string passes through intact." + (let ((body (cj/--telega-server-death-body 1 "ошибка сервера\n"))) + (should (string-match-p "ошибка" body)))) + +;; -- cj/--telega-server-notify-death (the advice) ---------------------------- + +(defmacro test-telega-config--with-status (status captured &rest body) + "Run BODY with the exit status forced to STATUS. +Notification calls are captured into CAPTURED as (TITLE . BODY) pairs." + (declare (indent 2)) + `(let ((,captured nil)) + (cl-letf (((symbol-function 'cj/--telega-server-exit-status) + (lambda (&rest _) ,status)) + ((symbol-function 'cj/--telega-server-send-notification) + (lambda (title body) (push (cons title body) ,captured)))) + ,@body))) + +(ert-deftest test-telega-config-notify-fires-on-abnormal-exit () + "Normal: an abnormal exit sends exactly one notification." + (test-telega-config--with-status 11 sent + (cj/--telega-server-notify-death nil "segmentation fault\n") + (should (= 1 (length sent))) + (should (string-match-p "telega" (downcase (car (car sent))))))) + +(ert-deftest test-telega-config-notify-silent-on-clean-exit () + "Boundary: a clean exit sends nothing. +Deliberately quitting telega must not page." + (test-telega-config--with-status 0 sent + (cj/--telega-server-notify-death nil "finished\n") + (should-not sent))) + +(ert-deftest test-telega-config-notify-silent-without-status () + "Boundary: no recoverable status sends nothing rather than a bare alert." + (test-telega-config--with-status nil sent + (cj/--telega-server-notify-death nil "gone\n") + (should-not sent))) + +(ert-deftest test-telega-config-notify-contains-notifier-errors () + "Error: a failing notifier must not escape into telega's sentinel. +This runs as :after advice on `telega-server--sentinel'; an error here +would abort telega's own status handling and its relogin path." + (cl-letf (((symbol-function 'cj/--telega-server-exit-status) + (lambda (&rest _) 11)) + ((symbol-function 'cj/--telega-server-send-notification) + (lambda (&rest _) (error "notifier unavailable")))) + (should (progn (cj/--telega-server-notify-death nil "segfault\n") t)))) + +(ert-deftest test-telega-config-notify-advice-is-named-and-removable () + "Normal: the sentinel advice is installed by name, so it can be removed. +An anonymous lambda can't be `advice-remove'd by reference, which strands +the old advice in a live daemon after the source stops installing it." + (should (fboundp 'cj/--telega-server-notify-death)) + (should (symbolp 'cj/--telega-server-notify-death))) + +(provide 'test-telega-config--server-death) +;;; test-telega-config--server-death.el ends here diff --git a/tests/test-test-runner--nil-global-directory.el b/tests/test-test-runner--nil-global-directory.el new file mode 100644 index 00000000..c70de5bd --- /dev/null +++ b/tests/test-test-runner--nil-global-directory.el @@ -0,0 +1,51 @@ +;;; test-test-runner--nil-global-directory.el --- Tests for the no-test-directory path -*- lexical-binding: t -*- + +;;; Commentary: +;; Outside a Projectile project, `cj/test--get-test-directory' falls back +;; to `cj/test-global-directory', which defaults to nil. These tests pin +;; the contract for that nil case: discovery helpers return nil instead +;; of crashing on (file-directory-p nil), and the interactive commands +;; signal `user-error' instead of wrong-type-argument. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'test-runner) + +(defmacro test-runner-nil-dir--outside-project (&rest body) + "Run BODY with no project root and a nil `cj/test-global-directory'." + (declare (indent 0)) + `(let ((cj/test-global-directory nil)) + (cl-letf (((symbol-function 'cj/test--project-root) + (lambda () nil))) + ,@body))) + +;;; Boundary Cases + +(ert-deftest test-test-runner-nil-dir-get-test-directory-returns-nil () + "Boundary: no project and no global dir yields nil, not an error." + (test-runner-nil-dir--outside-project + (should (null (cj/test--get-test-directory))))) + +(ert-deftest test-test-runner-nil-dir-get-test-files-returns-nil () + "Boundary: file discovery returns nil instead of crashing on a nil dir." + (test-runner-nil-dir--outside-project + (should (null (cj/test--get-test-files))))) + +;;; Error Cases + +(ert-deftest test-test-runner-nil-dir-load-all-signals-user-error () + "Error: `cj/test-load-all' signals `user-error', not wrong-type-argument." + (test-runner-nil-dir--outside-project + (should-error (cj/test-load-all) :type 'user-error))) + +(ert-deftest test-test-runner-nil-dir-focus-add-signals-user-error () + "Error: `cj/test-focus-add' signals `user-error', not wrong-type-argument." + (test-runner-nil-dir--outside-project + (should-error (cj/test-focus-add) :type 'user-error))) + +(provide 'test-test-runner--nil-global-directory) +;;; test-test-runner--nil-global-directory.el ends here diff --git a/tests/test-undead-buffers-kill-all-other-buffers-and-windows.el b/tests/test-undead-buffers-kill-all-other-buffers-and-windows.el index 36d82add..bcb9f833 100644 --- a/tests/test-undead-buffers-kill-all-other-buffers-and-windows.el +++ b/tests/test-undead-buffers-kill-all-other-buffers-and-windows.el @@ -158,5 +158,22 @@ (kill-buffer buf)))))) (test-kill-all-other-buffers-and-windows-teardown))) +(ert-deftest test-kill-all-other-buffers-and-windows-with-prefix-still-kills () + "Boundary: C-u on the wrapper must still kill, not spam the undead list. +The delegated cj/kill-buffer-or-bury-alive reads current-prefix-arg, so a +prefixed wrapper call used to take the add-to-undead-list branch for every +buffer -- nothing killed, list spammed." + (test-kill-all-other-buffers-and-windows-setup) + (unwind-protect + (let ((cj/undead-buffer-list cj/undead-buffer-list) + (buf (generate-new-buffer "*test-prefix-kill*"))) + (unwind-protect + (let ((current-prefix-arg '(4))) + (cj/kill-all-other-buffers-and-windows) + (should-not (buffer-live-p buf)) + (should-not (member "*test-prefix-kill*" cj/undead-buffer-list))) + (when (buffer-live-p buf) (kill-buffer buf)))) + (test-kill-all-other-buffers-and-windows-teardown))) + (provide 'test-undead-buffers-kill-all-other-buffers-and-windows) ;;; test-undead-buffers-kill-all-other-buffers-and-windows.el ends here diff --git a/tests/test-validate-el-hook.bats b/tests/test-validate-el-hook.bats new file mode 100644 index 00000000..43c3569c --- /dev/null +++ b/tests/test-validate-el-hook.bats @@ -0,0 +1,97 @@ +#!/usr/bin/env bats +# Tests for .claude/hooks/validate-el.sh — the auto-test runner. +# +# The runner used to skip entirely above MAX_AUTO_TEST_FILES=20, with no else +# branch: nothing printed, exit 0, indistinguishable from a passing run. That +# was live for the three largest families here (calendar-sync 63 test files, +# music 45, ai-term 35), so every edit to those ran parens and byte-compile and +# zero tests, silently. +# +# The cap was removed rather than made loud, because its premise did not hold. +# Measured on this machine, running a whole family takes about a second: +# ai-term 208 tests in 1.0s, music 403 in 1.7s, calendar-sync 633 in 0.9s. It +# was also concealing a real cross-test pollution bug in calendar-sync that +# only appears when that family runs in one process. +# +# These tests pin that no file count is skipped. Each builds a synthetic +# project in BATS_TEST_TMPDIR and points CLAUDE_PROJECT_DIR at it, so nothing +# runs against the real tree. + +setup() { + HOOK="${BATS_TEST_DIRNAME}/../.claude/hooks/validate-el.sh" + PROJ="${BATS_TEST_TMPDIR}/proj" + mkdir -p "$PROJ/modules" "$PROJ/tests" + export CLAUDE_PROJECT_DIR="$PROJ" + printf '(provide (quote widget))\n' > "$PROJ/modules/widget.el" +} + +# N green test files matching the widget stem. +make_tests() { + local n="$1" i + for ((i = 1; i <= n; i++)); do + printf '(require (quote ert))\n(ert-deftest test-widget-%d () (should t))\n' \ + "$i" > "$PROJ/tests/test-widget-${i}.el" + done +} + +# One failing test file, to prove the run is real rather than merely quiet. +make_failing_test() { + printf '(require (quote ert))\n(ert-deftest test-widget-bad () (should nil))\n' \ + > "$PROJ/tests/test-widget-bad.el" +} + +hook_input() { + printf '{"tool_input":{"file_path":"%s"}}' "$PROJ/modules/widget.el" +} + +run_hook() { + run bash -c "$(printf '%q' "$HOOK") <<< '$(hook_input)'" +} + +# ------------------------------- Normal cases ------------------------------- + +@test "a small family runs and passes quietly" { + make_tests 3 + run_hook + [ "$status" -eq 0 ] +} + +@test "a failing test blocks, so a quiet pass means the tests really ran" { + make_tests 3 + make_failing_test + run_hook + [ "$status" -eq 2 ] + [[ "$output" == *"TESTS FAILED"* ]] +} + +# ------------------------------ Boundary cases ------------------------------ + +@test "at the old cap of 20 files: runs" { + make_tests 20 + run_hook + [ "$status" -eq 0 ] +} + +@test "past the old cap: still runs, no longer skipped" { + make_tests 21 + run_hook + [ "$status" -eq 0 ] + [[ "${output,,}" != *"skipped"* ]] +} + +@test "well past the old cap: a failure in file 63 is still caught" { + # The regression this guards: at 63 files the runner used to skip, so a red + # test in a big family reported clean. calendar-sync is exactly this size. + make_tests 63 + make_failing_test + run_hook + [ "$status" -eq 2 ] + [[ "$output" == *"TESTS FAILED"* ]] +} + +# -------------------------------- Error cases ------------------------------- + +@test "no matching tests: exits clean without running anything" { + run_hook + [ "$status" -eq 0 ] +} diff --git a/tests/test-vc-config--git-clone.el b/tests/test-vc-config--git-clone.el index 3b39ece2..46ce3d40 100644 --- a/tests/test-vc-config--git-clone.el +++ b/tests/test-vc-config--git-clone.el @@ -2,9 +2,11 @@ ;;; Commentary: ;; Unit tests for cj/--git-clone-dir-name (robust repo-dir derivation across -;; HTTPS, scp-style SSH, ssh:// and local URLs) and for cj/git-clone-clipboard-url -;; reporting a failed clone from the process exit status instead of silently -;; assuming the directory appeared. +;; HTTPS, scp-style SSH, ssh:// and local URLs), for the async clone process +;; wiring in cj/git-clone-clipboard-url (make-process argv, no shell), and +;; for the sentinel built by cj/--git-clone-make-sentinel (open on success, +;; surface the process buffer on failure). Sentinel tests drive real +;; short-lived processes rather than mocking process primitives. ;;; Code: @@ -14,6 +16,18 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'vc-config) +(defun test-vc-clone--run-sentinel (command sentinel buffer) + "Run COMMAND with SENTINEL and BUFFER; wait for process exit." + (let ((proc (make-process :name "test-vc-clone" + :buffer buffer + :command command + :sentinel sentinel))) + (while (process-live-p proc) + (accept-process-output proc 0.05)) + ;; Give the sentinel a chance to run after exit. + (accept-process-output nil 0.05) + proc)) + ;;; cj/--git-clone-dir-name — Normal Cases (ert-deftest test-vc-git-clone-dir-name-https-with-git-suffix () @@ -36,7 +50,7 @@ (should (equal "repo" (cj/--git-clone-dir-name "ssh://git@example.com/user/repo.git")))) -;;; Boundary Cases +;;; cj/--git-clone-dir-name — Boundary Cases (ert-deftest test-vc-git-clone-dir-name-ssh-scp-without-user () "Boundary: scp-style SSH with no user path (host:repo.git) still works. @@ -60,29 +74,110 @@ since there is no `/' separator." (should (equal "repo" (cj/--git-clone-dir-name " https://example.com/user/repo.git\n")))) -;;; cj/git-clone-clipboard-url — Error Cases +;;; cj/--git-clone-open — Normal / Boundary Cases -(ert-deftest test-vc-git-clone-clipboard-url-reports-clone-failure () - "Error: a nonzero git exit status surfaces a user-error, not silence. -Uses a real writable temp dir as the target (so the file predicates run -for real) and mocks only the clone process to fail." - (let ((target (make-temp-file "cj-clone-fail-" t))) +(ert-deftest test-vc-git-clone-open-finds-readme () + "Normal: a README in the clone is opened." + (let ((dir (make-temp-file "cj-clone-open-" t)) + (opened nil)) + (unwind-protect + (progn + (with-temp-file (expand-file-name "README.md" dir) (insert "hi")) + (cl-letf (((symbol-function 'find-file) + (lambda (f &rest _) (setq opened f))) + ((symbol-function 'dired) #'ignore)) + (cj/--git-clone-open dir) + (should (equal (expand-file-name "README.md" dir) opened)))) + (delete-directory dir t)))) + +(ert-deftest test-vc-git-clone-open-no-readme-dires () + "Boundary: with no README, the clone directory is dired." + (let ((dir (make-temp-file "cj-clone-open-" t)) + (dired-dir nil)) + (unwind-protect + (cl-letf (((symbol-function 'find-file) + (lambda (&rest _) (error "find-file should not run"))) + ((symbol-function 'dired) + (lambda (d &rest _) (setq dired-dir d)))) + (cj/--git-clone-open dir) + (should (equal dir dired-dir))) + (delete-directory dir t)))) + +;;; cj/--git-clone-make-sentinel — Normal / Error Cases + +(ert-deftest test-vc-git-clone-sentinel-success-opens-clone () + "Normal: a zero-exit clone process opens the clone directory." + (let ((buffer (generate-new-buffer " *test-clone-ok*")) + (opened nil)) + (unwind-protect + (cl-letf (((symbol-function 'cj/--git-clone-open) + (lambda (d) (setq opened d))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (test-vc-clone--run-sentinel + '("true") (cj/--git-clone-make-sentinel "url" "/tmp/clone-dst") buffer) + (should (equal "/tmp/clone-dst" opened))) + (kill-buffer buffer)))) + +(ert-deftest test-vc-git-clone-sentinel-failure-pops-process-buffer () + "Error: a nonzero exit surfaces the process buffer, never opens the clone." + (let ((buffer (generate-new-buffer " *test-clone-fail*")) + (opened nil) + (popped nil)) (unwind-protect - (cl-letf (((symbol-function 'call-process) (lambda (&rest _) 128)) - ((symbol-function 'pop-to-buffer) #'ignore) - ((symbol-function 'message) #'ignore)) - (should-error - (cj/git-clone-clipboard-url "https://example.com/user/repo.git" target) - :type 'user-error)) + (cl-letf (((symbol-function 'cj/--git-clone-open) + (lambda (d) (setq opened d))) + ((symbol-function 'pop-to-buffer) + (lambda (b &rest _) (setq popped b))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (test-vc-clone--run-sentinel + '("false") (cj/--git-clone-make-sentinel "url" "/tmp/clone-dst") buffer) + (should-not opened) + (should (eq buffer popped))) + (kill-buffer buffer)))) + +;;; cj/git-clone-clipboard-url — Normal / Error Cases + +(ert-deftest test-vc-git-clone-clipboard-url-spawns-async-argv () + "Normal: the clone runs as an async process with a plain argv, no shell. +The `--' separator must precede the URL so a leading-dash URL cannot be +read as a git flag." + (let ((target (make-temp-file "cj-clone-async-" t)) + (spawned nil)) + (unwind-protect + (cl-letf (((symbol-function 'make-process) + (lambda (&rest args) + (setq spawned (plist-get args :command)) + nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (cj/git-clone-clipboard-url "https://example.com/user/repo.git" target) + (should (equal (list "git" "clone" "--" + "https://example.com/user/repo.git" + (expand-file-name "repo" target)) + spawned))) (delete-directory target t)))) (ert-deftest test-vc-git-clone-clipboard-url-empty-clipboard-errors () "Error: an empty clipboard URL aborts before any clone attempt." - (let ((cloned nil)) - (cl-letf (((symbol-function 'call-process) - (lambda (&rest _) (setq cloned t) 0))) + (let ((spawned nil)) + (cl-letf (((symbol-function 'make-process) + (lambda (&rest _) (setq spawned t) nil))) (should-error (cj/git-clone-clipboard-url " " "/tmp") :type 'user-error)) - (should-not cloned))) + (should-not spawned))) + +(ert-deftest test-vc-git-clone-clipboard-url-existing-destination-errors () + "Error: an existing clone destination aborts before any clone attempt." + (let ((target (make-temp-file "cj-clone-exists-" t)) + (spawned nil)) + (unwind-protect + (progn + (make-directory (expand-file-name "repo" target)) + (cl-letf (((symbol-function 'make-process) + (lambda (&rest _) (setq spawned t) nil))) + (should-error + (cj/git-clone-clipboard-url "https://example.com/user/repo.git" target) + :type 'user-error)) + (should-not spawned)) + (delete-directory target t)))) (provide 'test-vc-config--git-clone) ;;; test-vc-config--git-clone.el ends here diff --git a/tests/test-vc-config--gutter-hunk-candidates.el b/tests/test-vc-config--gutter-hunk-candidates.el new file mode 100644 index 00000000..65db0c3c --- /dev/null +++ b/tests/test-vc-config--gutter-hunk-candidates.el @@ -0,0 +1,69 @@ +;;; test-vc-config--gutter-hunk-candidates.el --- Tests for cj/--git-gutter-hunk-candidates -*- lexical-binding: t -*- + +;;; Commentary: +;; Unit tests for cj/--git-gutter-hunk-candidates, the pure helper that +;; builds completion candidates (label . line) from git-gutter hunk start +;; lines against the current buffer's text. The interactive wrapper +;; cj/goto-git-gutter-diff-hunks maps git-gutter:diffinfos onto start +;; lines and delegates here. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'vc-config) + +;;; Normal Cases + +(ert-deftest test-vc-gutter-hunk-candidates-labels-carry-line-text () + "Normal: each candidate label contains the hunk line's text." + (with-temp-buffer + (insert "alpha\nbravo\ncharlie\n") + (let ((candidates (cj/--git-gutter-hunk-candidates '(2 3)))) + (should (= 2 (length candidates))) + (should (string-match-p "bravo" (car (nth 0 candidates)))) + (should (string-match-p "charlie" (car (nth 1 candidates))))))) + +(ert-deftest test-vc-gutter-hunk-candidates-cdr-is-start-line () + "Normal: each candidate's cdr is the hunk's start line number." + (with-temp-buffer + (insert "alpha\nbravo\ncharlie\n") + (let ((candidates (cj/--git-gutter-hunk-candidates '(1 3)))) + (should (equal '(1 3) (mapcar #'cdr candidates)))))) + +;;; Boundary Cases + +(ert-deftest test-vc-gutter-hunk-candidates-empty-input-returns-nil () + "Boundary: no hunks produce no candidates." + (with-temp-buffer + (insert "alpha\n") + (should (null (cj/--git-gutter-hunk-candidates '()))))) + +(ert-deftest test-vc-gutter-hunk-candidates-first-line () + "Boundary: a hunk on line 1 resolves to the first line's text." + (with-temp-buffer + (insert "alpha\nbravo\n") + (let ((candidates (cj/--git-gutter-hunk-candidates '(1)))) + (should (string-match-p "alpha" (caar candidates))) + (should (= 1 (cdar candidates)))))) + +(ert-deftest test-vc-gutter-hunk-candidates-unicode-line-text () + "Boundary: line text with unicode survives into the label." + (with-temp-buffer + (insert "naïve — 日本語\n") + (let ((candidates (cj/--git-gutter-hunk-candidates '(1)))) + (should (string-match-p "日本語" (caar candidates)))))) + +;;; Error Cases + +(ert-deftest test-vc-goto-git-gutter-diff-hunks-no-hunks-user-error () + "Error: the command signals `user-error' when the buffer has no hunks." + (with-temp-buffer + (setq-local git-gutter:diffinfos nil) + (cl-letf (((symbol-function 'require) (lambda (&rest _) nil))) + (should-error (cj/goto-git-gutter-diff-hunks) :type 'user-error)))) + +(provide 'test-vc-config--gutter-hunk-candidates) +;;; test-vc-config--gutter-hunk-candidates.el ends here diff --git a/tests/test-vc-config--timemachine-commands.el b/tests/test-vc-config--timemachine-commands.el new file mode 100644 index 00000000..36a71695 --- /dev/null +++ b/tests/test-vc-config--timemachine-commands.el @@ -0,0 +1,36 @@ +;;; test-vc-config--timemachine-commands.el --- Tests for git-timemachine command wiring -*- lexical-binding: t -*- + +;;; Commentary: +;; Guards the git-timemachine autoload surface in vc-config.el. The +;; upstream package defines no `git-timemachine-show-selected-revision'; +;; an autoload for it in :commands creates a phantom M-x command that +;; errors after loading the package. The real selector lives in the +;; cj/ namespace. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'vc-config) + +;;; Normal Cases + +(ert-deftest test-vc-timemachine-selected-revision-cj-command-defined () + "Normal: the cj/ selected-revision selector is defined by vc-config." + (should (fboundp 'cj/git-timemachine-show-selected-revision))) + +(ert-deftest test-vc-timemachine-entry-command-defined () + "Normal: the cj/git-timemachine entry command is defined." + (should (commandp 'cj/git-timemachine))) + +;;; Error Cases + +(ert-deftest test-vc-timemachine-no-phantom-package-autoload () + "Error: no autoload exists for a function the package never defines. +An autoload stub for `git-timemachine-show-selected-revision' would +surface in M-x and signal void-function after the package loads." + (should-not (fboundp 'git-timemachine-show-selected-revision))) + +(provide 'test-vc-config--timemachine-commands) +;;; test-vc-config--timemachine-commands.el ends here diff --git a/tests/test-video-audio-recording-group-devices-by-hardware.el b/tests/test-video-audio-recording-group-devices-by-hardware.el deleted file mode 100644 index 2be4982f..00000000 --- a/tests/test-video-audio-recording-group-devices-by-hardware.el +++ /dev/null @@ -1,194 +0,0 @@ -;;; test-video-audio-recording-group-devices-by-hardware.el --- Tests for cj/recording-group-devices-by-hardware -*- lexical-binding: t; -*- - -;;; Commentary: -;; Unit tests for cj/recording-group-devices-by-hardware function. -;; Tests grouping of audio sources by physical hardware device. -;; Critical test: Bluetooth MAC address normalization (colons vs underscores). -;; -;; This function is used by the quick setup command to automatically pair -;; microphone and monitor devices from the same hardware. - -;;; Code: - -(require 'ert) - -;; Stub dependencies before loading the module -(defvar cj/custom-keymap (make-sparse-keymap) - "Stub keymap for testing.") - -;; Now load the actual production module -(require 'video-audio-recording) - -;;; Test Fixtures Helper - -(defun test-load-fixture (filename) - "Load fixture file FILENAME from tests/fixtures directory." - (let ((fixture-path (expand-file-name - (concat "tests/fixtures/" filename) - user-emacs-directory))) - (with-temp-buffer - (insert-file-contents fixture-path) - (buffer-string)))) - -;;; Normal Cases - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-all-types-grouped () - "Test grouping of all three device types (built-in, USB, Bluetooth). -This is the key test validating the complete grouping logic." - (let ((output (test-load-fixture "pactl-output-normal.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (listp result)) - (should (= 3 (length result))) - ;; Check that we have all three device types - (let ((names (mapcar #'car result))) - (should (member "Built-in Audio" names)) - (should (member "Bluetooth Headset" names)) - (should (member "Jabra SPEAK 510 USB" names))) - ;; Verify each device has both mic and monitor - (dolist (device result) - (should (stringp (car device))) ; friendly name - (should (stringp (cadr device))) ; mic device - (should (stringp (cddr device))) ; monitor device - (should-not (string-suffix-p ".monitor" (cadr device))) ; mic not monitor - (should (string-suffix-p ".monitor" (cddr device)))))))) ; monitor has suffix - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-built-in-paired () - "Test that built-in laptop audio devices are correctly paired." - (let ((output (test-load-fixture "pactl-output-normal.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let* ((result (cj/recording-group-devices-by-hardware)) - (built-in (assoc "Built-in Audio" result))) - (should built-in) - (should (string-match-p "pci-0000_00_1f" (cadr built-in))) - (should (string-match-p "pci-0000_00_1f" (cddr built-in))) - (should (equal "alsa_input.pci-0000_00_1f.3.analog-stereo" (cadr built-in))) - (should (equal "alsa_output.pci-0000_00_1f.3.analog-stereo.monitor" (cddr built-in))))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-usb-paired () - "Test that USB devices (Jabra) are correctly paired." - (let ((output (test-load-fixture "pactl-output-normal.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let* ((result (cj/recording-group-devices-by-hardware)) - (jabra (assoc "Jabra SPEAK 510 USB" result))) - (should jabra) - (should (string-match-p "Jabra" (cadr jabra))) - (should (string-match-p "Jabra" (cddr jabra))))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-bluetooth-paired () - "Test that Bluetooth devices are correctly paired. -CRITICAL: Tests MAC address normalization (colons in input, underscores in output)." - (let ((output (test-load-fixture "pactl-output-normal.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let* ((result (cj/recording-group-devices-by-hardware)) - (bluetooth (assoc "Bluetooth Headset" result))) - (should bluetooth) - ;; Input has colons: bluez_input.00:1B:66:C0:91:6D - (should (equal "bluez_input.00:1B:66:C0:91:6D" (cadr bluetooth))) - ;; Output has underscores: bluez_output.00_1B_66_C0_91_6D.1.monitor - ;; But they should still be grouped together (MAC address normalized) - (should (equal "bluez_output.00_1B_66_C0_91_6D.1.monitor" (cddr bluetooth))))))) - -;;; Boundary Cases - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-empty-returns-empty () - "Test that empty pactl output returns empty list." - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) ""))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (listp result)) - (should (null result))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-only-inputs-returns-empty () - "Test that only input devices (no monitors) returns empty list. -Devices must have BOTH mic and monitor to be included." - (let ((output (test-load-fixture "pactl-output-inputs-only.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (listp result)) - (should (null result)))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-only-monitors-returns-empty () - "Test that only monitor devices (no inputs) returns empty list." - (let ((output (test-load-fixture "pactl-output-monitors-only.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (listp result)) - (should (null result)))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-single-complete-device () - "Test that single device with both mic and monitor is returned." - (let ((output "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n49\talsa_output.pci-0000_00_1f.3.analog-stereo.monitor\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n")) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (= 1 (length result))) - (should (equal "Built-in Audio" (caar result))))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-mixed-complete-incomplete () - "Test that only devices with BOTH mic and monitor are included. -Incomplete devices (only mic or only monitor) are filtered out." - (let ((output (concat - ;; Complete device (built-in) - "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" - "49\talsa_output.pci-0000_00_1f.3.analog-stereo.monitor\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" - ;; Incomplete: USB mic with no monitor - "100\talsa_input.usb-device.mono-fallback\tPipeWire\ts16le 1ch 16000Hz\tSUSPENDED\n" - ;; Incomplete: Bluetooth monitor with no mic - "81\tbluez_output.AA_BB_CC_DD_EE_FF.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - ;; Only the complete built-in device should be returned - (should (= 1 (length result))) - (should (equal "Built-in Audio" (caar result))))))) - -;;; Error Cases - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-error-malformed-output-returns-empty () - "Test that malformed pactl output returns empty list." - (let ((output (test-load-fixture "pactl-output-malformed.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (listp result)) - (should (null result)))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-error-unknown-device-type () - "Test that unknown device types get generic 'USB Audio Device' name." - (let ((output (concat - "100\talsa_input.usb-unknown_device-00.analog-stereo\tPipeWire\ts16le 2ch 16000Hz\tSUSPENDED\n" - "99\talsa_output.usb-unknown_device-00.analog-stereo.monitor\tPipeWire\ts16le 2ch 48000Hz\tSUSPENDED\n"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (= 1 (length result))) - ;; Should get generic USB name (not matching Jabra pattern) - (should (equal "USB Audio Device" (caar result))))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-error-bluetooth-mac-case-variations () - "Test that Bluetooth MAC addresses work with different formatting. -Tests the normalization logic handles various MAC address formats." - (let ((output (concat - ;; Input with colons (typical) - "79\tbluez_input.AA:BB:CC:DD:EE:FF\tPipeWire\tfloat32le 1ch 48000Hz\tSUSPENDED\n" - ;; Output with underscores (typical) - "81\tbluez_output.AA_BB_CC_DD_EE_FF.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (= 1 (length result))) - (should (equal "Bluetooth Headset" (caar result))) - ;; Verify both devices paired despite different MAC formats - (let ((device (car result))) - (should (string-match-p "AA:BB:CC" (cadr device))) - (should (string-match-p "AA_BB_CC" (cddr device)))))))) - -(provide 'test-video-audio-recording-group-devices-by-hardware) -;;; test-video-audio-recording-group-devices-by-hardware.el ends here diff --git a/tests/test-wrap-up--bury-buffers.el b/tests/test-wrap-up--bury-buffers.el new file mode 100644 index 00000000..00df69c7 --- /dev/null +++ b/tests/test-wrap-up--bury-buffers.el @@ -0,0 +1,96 @@ +;;; test-wrap-up--bury-buffers.el --- Tests for cj/bury-buffers -*- lexical-binding: t; -*- + +;;; Commentary: +;; Characterization tests for cj/bury-buffers, which buries the noisy +;; compile-and-shell buffers at the end of startup. +;; +;; Written to pin the buried set while a dead clause was removed. The function +;; tested `(derived-mode-p 'elisp-compile-mode)', and no such mode exists in +;; Emacs -- the real one is `emacs-lisp-compilation-mode', which derives from +;; `compilation-mode' and so was already matched by the clause above it. The +;; clause could never be true, and removing it must not change which buffers +;; get buried. These tests are what makes that claim checkable. +;; +;; Test organization: +;; - Normal Cases: each buried mode is buried; byte-compilation output included +;; - Boundary Cases: an ordinary buffer is left alone; an empty buffer list +;; - Error Cases: a killed buffer in the list does not break the sweep +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'wrap-up) + +;; Required explicitly so each test stands alone. Without these the +;; comint-mode test passed only because ERT runs tests in alphabetical order +;; and an earlier test loaded `compile', which pulls in comint -- so renaming +;; or running that test by itself made it fail with void-function comint-mode. +(require 'comint) +(require 'bytecomp) + +(defmacro test-wrap-up--with-mode-buffer (mode &rest body) + "Create a buffer in MODE, bind it to `buf', run BODY, then kill it." + (declare (indent 1)) + `(let ((buf (generate-new-buffer "*test-bury*"))) + (unwind-protect + (progn + (with-current-buffer buf (funcall ,mode)) + ,@body) + (kill-buffer buf)))) + +;;; Normal Cases + +(ert-deftest test-wrap-up-bury-buffers-buries-compilation () + "Normal: a compilation-mode buffer is buried." + (test-wrap-up--with-mode-buffer #'compilation-mode + (switch-to-buffer buf) + (cj/bury-buffers) + (should-not (eq buf (car (buffer-list)))))) + +(ert-deftest test-wrap-up-bury-buffers-buries-byte-compilation-output () + "Normal: the real byte-compilation mode is buried. +`emacs-lisp-compilation-mode' derives from `compilation-mode', which is +why the never-matching elisp-compile-mode clause was redundant." + (should (eq 'compilation-mode + (get 'emacs-lisp-compilation-mode 'derived-mode-parent))) + (test-wrap-up--with-mode-buffer #'emacs-lisp-compilation-mode + (switch-to-buffer buf) + (cj/bury-buffers) + (should-not (eq buf (car (buffer-list)))))) + +(ert-deftest test-wrap-up-bury-buffers-buries-comint () + "Normal: a comint-mode buffer is buried." + (test-wrap-up--with-mode-buffer #'comint-mode + (switch-to-buffer buf) + (cj/bury-buffers) + (should-not (eq buf (car (buffer-list)))))) + +;;; Boundary Cases + +(ert-deftest test-wrap-up-bury-buffers-leaves-ordinary-buffer () + "Boundary: a fundamental-mode buffer is not buried." + (test-wrap-up--with-mode-buffer #'fundamental-mode + (switch-to-buffer buf) + (cj/bury-buffers) + (should (eq buf (car (buffer-list)))))) + +(ert-deftest test-wrap-up-bury-buffers-leaves-text-buffer () + "Boundary: an ordinary text-mode buffer is not buried." + (test-wrap-up--with-mode-buffer #'text-mode + (switch-to-buffer buf) + (cj/bury-buffers) + (should (eq buf (car (buffer-list)))))) + +;;; Error Cases + +(ert-deftest test-wrap-up-bury-buffers-survives-dead-mode-name () + "Error: the sweep completes even though elisp-compile-mode does not exist. +The removed clause named a mode Emacs has never defined; this pins that +the function still runs cleanly with no such mode anywhere." + (should-not (fboundp 'elisp-compile-mode)) + (should-not (get 'elisp-compile-mode 'derived-mode-parent)) + (cj/bury-buffers)) + +(provide 'test-wrap-up--bury-buffers) +;;; test-wrap-up--bury-buffers.el ends here diff --git a/tests/testutil-calendar-sync.el b/tests/testutil-calendar-sync.el index 2187c56c..60f878d0 100644 --- a/tests/testutil-calendar-sync.el +++ b/tests/testutil-calendar-sync.el @@ -172,6 +172,22 @@ Returns float number of days (positive if date2 > date1)." (t2 (calendar-sync--date-to-time (list (nth 0 date2) (nth 1 date2) (nth 2 date2))))) (/ (float-time (time-subtract t2 t1)) 86400.0))) +(defun test-calendar-sync-time-monthly-anchor (hour minute) + "Return a soon-future date on a day-of-month that every month has. +Walks forward from tomorrow to the first date whose day is 28 or less, then +returns it at HOUR:MINUTE. + +Use this instead of `test-calendar-sync-time-days-from-now' for any test that +asserts a monthly cadence. A relative offset is not a date-independent anchor: +its day-of-month varies with the run date, and a monthly series anchored on the +29th, 30th, or 31st correctly appears only in the months that have that day. A +test asserting roughly one occurrence per month then fails for several days each +month, which is what happened on 2026-07-30." + (let ((days 1)) + (while (> (nth 2 (test-calendar-sync-time-days-from-now days hour minute)) 28) + (setq days (1+ days))) + (test-calendar-sync-time-days-from-now days hour minute))) + (defun test-calendar-sync-wide-range () "Generate wide date range: 90 days past to 365 days future. Returns (start-time end-time) suitable for expansion functions." diff --git a/working/eat-sixel-patch/eat-xtwinops.patch b/working/eat-sixel-patch/eat-xtwinops.patch new file mode 100644 index 00000000..4347d729 --- /dev/null +++ b/working/eat-sixel-patch/eat-xtwinops.patch @@ -0,0 +1,46 @@ +--- a/eat.el ++++ b/eat.el +@@ -2809,6 +2809,33 @@ + (funcall (eat--t-term-input-fn eat--t-term) eat--t-term + "\e[>0;0;0c"))))) + ++(defun eat--t-send-window-size-report (n) ++ "Respond to XTWINOPS window size report request N. ++ ++N is 14 (text area size in pixels), 16 (cell size in pixels) or 18 ++\(text area size in characters). Other operations are ignored. ++Multiplexers like tmux send \\='CSI 14 t\\=' to discover the cell ++pixel size they need before they will emit Sixel to a terminal." ++ (let ((disp (eat--t-term-display eat--t-term))) ++ (pcase n ++ (14 ++ (funcall (eat--t-term-input-fn eat--t-term) eat--t-term ++ (format "\e[4;%i;%it" ++ (* (eat--t-disp-height disp) ++ (eat--t-term-char-height eat--t-term)) ++ (* (eat--t-disp-width disp) ++ (eat--t-term-char-width eat--t-term))))) ++ (16 ++ (funcall (eat--t-term-input-fn eat--t-term) eat--t-term ++ (format "\e[6;%i;%it" ++ (eat--t-term-char-height eat--t-term) ++ (eat--t-term-char-width eat--t-term)))) ++ (18 ++ (funcall (eat--t-term-input-fn eat--t-term) eat--t-term ++ (format "\e[8;%i;%it" ++ (eat--t-disp-height disp) ++ (eat--t-disp-width disp))))))) ++ + (defun eat--t-send-graphics-attrs (attr operation) + "Send graphics attributes. + +@@ -3632,6 +3659,9 @@ + ;; CSI s. + (`((?s) nil nil) + (eat--t-save-cur)) ++ ;; CSI <n> t. ++ (`((?t) nil ((,n))) ++ (eat--t-send-window-size-report n)) + ;; CSI u. + (`((?u) nil nil) + (eat--t-restore-cur))))))) diff --git a/working/eat-sixel-patch/rulesets-companion-note.org b/working/eat-sixel-patch/rulesets-companion-note.org new file mode 100644 index 00000000..2df33273 --- /dev/null +++ b/working/eat-sixel-patch/rulesets-companion-note.org @@ -0,0 +1,5 @@ +#+TITLE: EAT XTWINOPS patch companion note +#+SOURCE: from rulesets +#+DATE: 2026-07-13 10:58:54 -0500 + +EAT XTWINOPS patch (companion file eat-xtwinops.patch, sent separately just now): verified live on ratio 2026-07-13, this makes sixel images render AND persist in tmux inside EAT. Root cause chain: tmux 3.7b has native sixel but refuses to transmit unless it knows the client's cell pixel size; it asks via CSI 14 t (XTWINOPS), which EAT 0.9.4 silently ignores (its CSI dispatch has no 't' case). The patch adds eat--t-send-window-size-report answering CSI 14/16/18 t from eat--t-term-char-width/height and the display dims — same fields EAT's own XTSMGRAPHICS reply already uses. With it, tmux learns the geometry at client attach, ingests raw sixel into its grid, and re-emits on every redraw — images survive window switches, scrolling, and resizing (Craig verified visually). Needs on the emacsd side: (1) a durable home for the patch — the elpa file is version-pinned, so likely a load-path shadow or an advice-free vendored fix, your call, plus wiring so both daily drivers load it (velox verified ready: same tmux build, imagemagick present); (2) written test-first per testing.md when productionizing — this was a timeboxed spike, treat the diff as evidence not deliverable; (3) strongly consider sending it upstream to EAT (codeberg akib/emacs-eat) so 0.9.5+ ships it stock. tmux side is separate (two conf lines, handoff sent to dotfiles). Ask rulesets for the full investigation log if useful. diff --git a/working/eat-sixel-patch/takuzu-original-bug-report.org b/working/eat-sixel-patch/takuzu-original-bug-report.org new file mode 100644 index 00000000..02107a88 --- /dev/null +++ b/working/eat-sixel-patch/takuzu-original-bug-report.org @@ -0,0 +1,17 @@ +#+TITLE: Bug/investigate: images from Claude Code don't display in th +#+SOURCE: from takuzu +#+DATE: 2026-07-11 14:41:39 -0500 + +Bug/investigate: images from Claude Code don't display in the EAT terminal. + +Context: running Claude Code inside EAT (eat 0.9.4 from elpa). When the agent posts an image to the terminal, nothing renders — Craig can't see it. + +Finding: EAT *does* have Sixel image support. eat.el defines eat-sixel-scale, eat-sixel-aspect-ratio, eat-sixel-render-formats, and a full Sixel decode/render path (sixel-buffer, sixel-palette, sixel-render-format, etc.). So the capability exists; this isn't a plain 'EAT can't do images' limitation. + +Likely causes to check: +1. Protocol mismatch: Claude Code CLI probably emits the kitty graphics protocol or the iTerm2 inline-image protocol (OSC 1337), NOT Sixel. EAT renders Sixel only, so a kitty/iTerm image sequence is dropped. Confirm which protocol Claude Code uses (env like TERM, or its terminal-capability detection) and whether it can be told to emit Sixel. +2. Sixel render-format availability: eat-sixel-render-formats lists preferred render backends; if none is available in this Emacs build, Sixel silently won't display. Test EAT with a known-good sixel image (e.g. img2sixel output) to confirm EAT-side rendering works at all. + +Repro: in an EAT session, have Claude Code (or any tool) post an image; observe nothing renders. Next step: identify the emitted escape sequence (capture raw bytes) to confirm protocol. + +From the takuzu session, 2026-07-11 — surfaced because the agent kept posting game screenshots the terminal couldn't show. diff --git a/working/music-svg-app-design/2026-07-19-music-config-ui-remodel-render-fixture.svg b/working/music-svg-app-design/2026-07-19-music-config-ui-remodel-render-fixture.svg new file mode 100644 index 00000000..aad6f746 --- /dev/null +++ b/working/music-svg-app-design/2026-07-19-music-config-ui-remodel-render-fixture.svg @@ -0,0 +1,87 @@ +<svg xmlns="http://www.w3.org/2000/svg" + xmlns:xlink="http://www.w3.org/1999/xlink" + viewBox="0 0 1916 821" width="1916" height="821"> + <defs> + <radialGradient id="glassGlow" cx="40%" cy="0" r="90%"> + <stop offset="0" stop-color="#22231f" stop-opacity=".28"/> + <stop offset="1" stop-color="#050605" stop-opacity="0"/> + </radialGradient> + <linearGradient id="headerBrass" x1="0" x2="1"> + <stop offset="0" stop-color="#c4aa89"/> + <stop offset=".5" stop-color="#ae9374"/> + <stop offset="1" stop-color="#c2a27d"/> + </linearGradient> + <clipPath id="metadataClip"><rect x="780" y="104" width="350" height="180"/></clipPath> + <clipPath id="playlistClip"><rect x="1188" y="126" width="610" height="520"/></clipPath> + </defs> + + <image x="0" y="0" width="1916" height="821" + xlink:href="concepts/30a-dupre-studios-user-refined-playlist.png"/> + + <rect x="605" y="96" width="540" height="250" fill="#070807"/> + <rect x="605" y="96" width="540" height="250" fill="url(#glassGlow)"/> + <image x="612" y="108" width="146" height="173" xlink:href="assets/vinyl-placeholder.svg"/> + <g clip-path="url(#metadataClip)" fill="#ebe5d9" font-family="Berkeley Mono, monospace" font-size="20" letter-spacing="1.4"> + <text x="780" y="130">A CHICKEN WITH ITS HEAD CUT OFF — REMASTERED ANNIVERSARY EDITION</text> + <text x="780" y="166">THE MAGNETIC FIELDS AND THE LONG-LOST ORCHESTRA</text> + <text x="780" y="202">69 LOVE SONGS: THE COMPLETE THREE-VOLUME COLLECTION</text> + <text x="780" y="238">MERGE RECORDS</text> + <text x="780" y="274">1999</text> + </g> + <text x="610" y="322" fill="#ddd4c5" font-family="Berkeley Mono, monospace" font-size="19">01:30</text> + <line x1="679" y1="316" x2="1023" y2="316" stroke="#3b3a37" stroke-width="2"/> + <line x1="679" y1="316" x2="850" y2="316" stroke="#f2a900" stroke-width="2"/> + <circle cx="850" cy="316" r="9" fill="#c79a60" stroke="#f0d4a7" stroke-width="1"/> + <text x="1040" y="322" fill="#ddd4c5" font-family="Berkeley Mono, monospace" font-size="19">02:59</text> + + <rect x="1172" y="52" width="688" height="65" fill="url(#headerBrass)"/> + <g fill="#251c14" font-family="Berkeley Mono, monospace" font-size="20" letter-spacing="1.5"> + <text x="1202" y="94">PLAYLIST</text> + <text x="1316" y="94">|</text> + <text x="1355" y="94">69 LOVE SONGS — COMPLETE</text> + <text x="1731" y="94">69 TRACKS</text> + </g> + <rect x="1172" y="118" width="688" height="545" fill="#070807"/> + <rect x="1172" y="118" width="688" height="545" fill="url(#glassGlow)"/> + <g clip-path="url(#playlistClip)" font-family="Berkeley Mono, monospace" font-size="17" letter-spacing=".8"> + <g fill="#ddd8cf"> + <text x="1192" y="153">01</text><text x="1237" y="153">ABSOLUTELY CUCKOO — THE MAGNETIC FIELDS</text><text x="1760" y="153">02:02</text> + <text x="1192" y="190">02</text><text x="1237" y="190">I DON’T BELIEVE IN THE SUN — THE MAGNETIC FIELDS</text><text x="1760" y="190">02:50</text> + <text x="1192" y="227">03</text><text x="1237" y="227">ALL MY LITTLE WORDS — THE MAGNETIC FIELDS</text><text x="1760" y="227">02:03</text> + </g> + <rect x="1175" y="238" width="650" height="37" fill="#f2a900" fill-opacity=".07"/> + <g fill="#f2a900"> + <text x="1174" y="264">▶</text><text x="1192" y="264">04</text><text x="1237" y="264">A CHICKEN WITH ITS HEAD CUT OFF — THE MAGNETIC FIELDS</text><text x="1760" y="264">02:59</text> + </g> + <g fill="#ddd8cf"> + <text x="1192" y="301">05</text><text x="1237" y="301">(I’M) DAZOTA — THE MAGNETIC FIELDS</text><text x="1760" y="301">02:38</text> + <text x="1192" y="338">06</text><text x="1237" y="338">I DON’T WANT TO GET OVER YOU — THE MAGNETIC FIELDS</text><text x="1760" y="338">02:50</text> + <text x="1192" y="375">07</text><text x="1237" y="375">COME BACK FROM SAN FRANCISCO — THE MAGNETIC FIELDS</text><text x="1760" y="375">02:37</text> + <text x="1192" y="412">08</text><text x="1237" y="412">THE LUCKIEST GUY ON THE LOWER EAST SIDE — THE MAGNETIC FIELDS</text><text x="1760" y="412">01:32</text> + <text x="1192" y="449">09</text><text x="1237" y="449">LET’S PRETEND WE’RE BUNNY RABBITS — THE MAGNETIC FIELDS</text><text x="1760" y="449">02:10</text> + <text x="1192" y="486">10</text><text x="1237" y="486">THE CACTUS WHERE YOUR HEART SHOULD BE — THE MAGNETIC FIELDS</text><text x="1760" y="486">02:38</text> + <text x="1192" y="523">11</text><text x="1237" y="523">I THINK I NEED A NEW HEART — THE MAGNETIC FIELDS</text><text x="1760" y="523">02:58</text> + <text x="1192" y="560">12</text><text x="1237" y="560">THE BOOK OF LOVE — THE MAGNETIC FIELDS</text><text x="1760" y="560">02:56</text> + <text x="1192" y="597">13</text><text x="1237" y="597">FIDO, YOUR LEASH IS TOO LONG — THE MAGNETIC FIELDS</text><text x="1760" y="597">02:13</text> + <text x="1192" y="634">14</text><text x="1237" y="634">HOW FUCKING ROMANTIC — THE MAGNETIC FIELDS</text><text x="1760" y="634">00:58</text> + </g> + </g> + + <g fill="#171714" stroke="#6b5a3c" stroke-width="1.5"> + <circle cx="862" cy="614" r="6"/><circle cx="850" cy="588" r="6"/><circle cx="846" cy="559" r="6"/> + <circle cx="850" cy="530" r="6"/><circle cx="861" cy="502" r="6"/><circle cx="878" cy="479" r="6"/> + <circle cx="901" cy="461" r="6"/><circle cx="928" cy="451" r="6"/><circle cx="957" cy="447" r="6"/> + <circle cx="986" cy="451" r="6"/><circle cx="1013" cy="461" r="6"/><circle cx="1036" cy="479" r="6"/> + <circle cx="1053" cy="502" r="6"/><circle cx="1064" cy="530" r="6"/><circle cx="1068" cy="559" r="6"/> + <circle cx="1064" cy="588" r="6"/><circle cx="1052" cy="614" r="6"/> + </g> + <g fill="#ffb23c" stroke="#fff0bd" stroke-width="1.5"> + <circle cx="862" cy="614" r="6"/><circle cx="850" cy="588" r="6"/><circle cx="846" cy="559" r="6"/> + <circle cx="850" cy="530" r="6"/><circle cx="861" cy="502" r="6"/><circle cx="878" cy="479" r="6"/> + <circle cx="901" cy="461" r="6"/><circle cx="928" cy="451" r="6"/><circle cx="957" cy="447" r="6"/> + <circle cx="986" cy="451" r="6"/><circle cx="1013" cy="461" r="6"/> + </g> + + <line x1="227" y1="537" x2="245" y2="467" stroke="#f3d59c" stroke-width="2"/> + <line x1="480" y1="537" x2="496" y2="466" stroke="#f3d59c" stroke-width="2"/> +</svg> diff --git a/working/music-svg-app-design/2026-07-19-music-config-ui-remodel-spec.org b/working/music-svg-app-design/2026-07-19-music-config-ui-remodel-spec.org new file mode 100644 index 00000000..6e68e104 --- /dev/null +++ b/working/music-svg-app-design/2026-07-19-music-config-ui-remodel-spec.org @@ -0,0 +1,923 @@ +#+TITLE: Music Config UI Remodel — Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-07-19 +#+TODO: TODO | DONE +#+TODO: DRAFT READY DOING | IMPLEMENTED SUPERSEDED CANCELLED + +* DRAFT Music Config UI Remodel +:PROPERTIES: +:ID: bcbb9342-1884-4281-8821-89b06f6f8793 +:END: +- 2026-07-19 Sun @ 16:03:13 -0500 — drafted from the approved Dupre Studios design session. + +** Prototype iterations + +The design session started with working HTML directions, moved through six +distinct visual concepts, and then refined one receiver layout through paired +playlist/radio boards. The last board is Craig's GIMP refinement and is the +visual authority for this spec. + +- [[file:music-svg-directions.html][Initial working SVG directions]] +- [[file:concept-board.html][Six-direction comparison board]] +- [[file:concepts/01-champagne-receiver.png][01 Champagne Receiver]] +- [[file:concepts/02-le-mans-night-cluster.png][02 Le Mans Night Cluster]] +- [[file:concepts/03-geneva-playback-chronograph.png][03 Geneva Playback Chronograph]] +- [[file:concepts/04-mastering-room-reel-console.png][04 Mastering Room Reel Console]] +- [[file:concepts/05-perpetual-calendar-salon.png][05 Perpetual Calendar Salon]] +- [[file:concepts/06-transatlantic-broadcast-navigator.png][06 Transatlantic Broadcast Navigator]] +- [[file:concepts/07-functional-black-glass-receiver.png][07 Functional black-glass receiver]] +- [[file:concepts/08-functional-black-glass-flipped.png][08 Playlist-flipped receiver]] +- [[file:concepts/09-functional-black-glass-retro.png][09 Warmer retro receiver]] +- [[file:concepts/10-warm-black-glass-player-volume.png][10 Player-volume receiver]] +- [[file:concepts/11-illuminated-black-glass-controls.png][11 Illuminated controls]] +- [[file:concepts/12-consolidated-functional-receiver.png][12 Consolidated functional receiver]] +- [[file:concepts/13-black-silver-chronograph-receiver.png][13 Black-silver chronograph]] +- [[file:concepts/14-corrected-luxury-chronograph-receiver.png][14 Corrected luxury chronograph]] +- [[file:concepts/15-champagne-brass-digital-hifi.png][15 Champagne digital hi-fi]] +- [[file:concepts/16-champagne-aluminum-radio-groups.png][16 Explicit radio grouping]] +- [[file:concepts/17-dupre-coltrane-scrollbar.png][17 Long-playlist and scrollbar stress test]] +- [[file:concepts/18-dupre-branding-control-study.png][18 Branding and control study]] +- [[file:concepts/19a-dupre-playlist-state.png][19a Playlist state]] and [[file:concepts/19b-dupre-radio-state.png][19b radio state]] +- [[file:concepts/20-dupre-playlist-radio-comparison.png][20 Long playlist / compact radio comparison]] +- [[file:concepts/21-dupre-semantic-controls-comparison.png][21 Semantic control comparison]] +- [[file:concepts/22-dupre-identity-bay-comparison.png][22 Identity-bay comparison]] +- [[file:concepts/23-dupre-swapped-info-comparison.png][23 Swapped information comparison]] +- [[file:concepts/24-dupre-full-brass-vu-comparison.png][24 Full-brass VU comparison]] +- [[file:concepts/25-dupre-seamless-flush-comparison.png][25 Seamless flush comparison]] +- [[file:concepts/26-dupre-studios-rounded-chrome-comparison.png][26 Dupre Studios comparison]] +- [[file:concepts/27-dupre-studios-leather-analog-header-comparison.png][27 Leather and analog-header comparison]] +- [[file:concepts/28-dupre-studios-balanced-controls-comparison.png][28 Balanced-control comparison]] +- [[file:concepts/29a-dupre-studios-brass-seek-playlist.png][29 Brass seek-thumb pass]] +- [[file:concepts/30a-dupre-studios-user-refined-playlist.png][30 Craig's near-final playlist board (visual authority)]] +- [[file:prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html][31 Functional local-playlist / radio prototype (acceptance candidate)]] + +* Metadata +| Status | Not ready — first review found one functional-prototype blocker | +|----------+------------------------------------------------------------------------| +| Owner | Craig Jennings | +|----------+------------------------------------------------------------------------| +| Reviewer | Craig Jennings | +|----------+------------------------------------------------------------------------| +| Related | [[file:../../todo.org][music: SVG player application design and delivery]]; [[file:../../docs/specs/2026-07-06-fancy-music-player-ui-spec.org][implemented fancy player spec]]; [[file:../../docs/specs/music-config-without-emms-spec.org][EMMS-free architecture spec]] | +|----------+------------------------------------------------------------------------| + +* Summary + +Replace the current text-and-image EMMS playlist surface with a realistic +Dupre Studios receiver rendered inside Emacs. The interface uses a raster skin +for leather, glass, brass, and machined controls, then draws all changing +information and illumination in SVG. Emacs Lisp remains the application +runtime and maps the SVG surface to the existing music-config commands. + +The remodel preserves the plain and fancy text views as fallbacks. It does not +change M3U ownership, radio-browser behavior, or the current EMMS playback model. + +* Problem / Context + +The implemented fancy player improved names, artwork, and progress, but it is +still a text playlist with a multi-line overlay. It cannot present the player +as one coherent instrument. Controls are key hints rather than controls, +playlist management is visually detached from playback, and active state is +limited to text faces and a character-cell progress bar. + +Craig wants a bottom-docked application that looks like a manufactured object: +black leather, black glass, champagne brass, lit analog meters, and discreet +controls. The beauty has to explain state. A lamp, depressed key, moving +needle, seek position, or selected row must correspond to real music-config or +mpv behavior. Decorative AM/FM, tone, power, reload, manual URL, and other +unsupported faceplate controls are prohibited. + +The final 1916×821 board settles the visual direction. The remaining design +problem is how to preserve its realism without baking live state into a picture. +An all-vector redraw would lose much of the leather and metal detail. A single +clickable PNG would preserve the appearance but freeze track data, meter state, +playlist rows, and button feedback. The chosen design separates the physical +object from its information and behavior. + +* Goals and Non-Goals + +** Goals + +- Match Craig's near-final board closely enough that the running player reads as + the same manufactured receiver, not a simplified diagram of it. +- Preserve the full music-config workflow: playback, seek, player volume, + playlist browsing and persistence, radio search, repeat/single/random/consume, + reordering, add, new, load, save, and delete. +- Make every visible state honest. Meter needles use real program levels, + volume lamps use mpv volume, progress uses mpv position, and mode lamps use + current mode state. +- Keep the hot path compact: album information and controls on the left, + fourteen playlist rows and playlist actions on the right. +- Keep keyboard operation complete while adding direct mouse interaction. +- Preserve the existing text render for TTY frames, unsupported SVG builds, and + opt-out/rollback. +- Keep the renderer independent of EMMS objects so the planned EMMS-free/VAMP + work can replace the controller without replacing the visual layer. + +** Non-Goals + +- No music library browser, tag editor, lyrics view, waveform editor, or album + collection database. +- No streaming-service integration. +- No fake receiver functions such as AM/FM tuning, bass, treble, speakers, or + power. +- No permanent faceplate controls for reload, editing the M3U file, or manual URL + entry. Existing keyboard and M-x access may remain. +- No all-vector imitation of leather, brushed metal, or photographic reflections. +- No EMMS removal or VAMP extraction in this project. Those remain separate + architecture efforts. +- No alternate narrow/mobile layout in v1. The player scales as one panoramic + instrument. + +** Scope tiers + +- v1: neutral raster skin, SVG renderer, dedicated graphical view buffer, + complete keyboard/mouse command surface, playlist viewport, seek, persistent + mpv volume, real stereo VU telemetry, local-file and radio states, diagnostics, + fallbacks, tests, and live verification. +- Out of scope: library browsing, ratings, per-track menus, editable metadata, + alternate skins, responsive reflow, and remote control. +- vNext: multiple visual skins, a narrower alternate layout, richer motion + transitions, and reuse in a future standalone VAMP package. + +* Design + +** User view + +F10 opens the player in the existing bottom side-window position. In a +graphical frame with the remodel enabled, the buffer is the Dupre Studios +receiver. The same keys still work. The visible buttons also work with the +mouse, the playlist scrolls inside its fourteen-row aperture, and selecting a +row starts that track. + +A local file shows album art, title, artist, album, label, and year on separate +lines when those fields exist. It shows elapsed and total time with a draggable +seek control. A live station shows station art and two ON AIR indications: one +under the art and one in the active station row. It never shows a seek control +or invented time for a stream. Missing metadata produces no placeholder word. + +The interface behaves like hardware. Play/Pause sits depressed and glows green +while playing. Momentary transport controls brighten while pressed. Active +play modes illuminate the circumference of their brass buttons. Volume lamps +fill continuously to the current mpv volume. VU needles move from the actual +left and right audio levels. + +The interaction model is available in the [[file:prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html][functional browser prototype]]. It +switches between a 69-track local fixture and an 18-station radio fixture and +wires transport, playback modes, radio search, playlist actions, row selection, +seek, volume, wheel/keyboard browsing, scrollbar drag, empty state, and delete +confirmation. Its built-in twelve-check behavior pass is green. Craig's +hands-on acceptance remains the last prototype gate. + +** Research and visual sources + +The design session compared NAD restraint, Marshall's black-and-brass control +language, McIntosh black glass and meter hierarchy, vintage stereo transport +controls, automobile instrument clusters, and black/silver chronographs. The +useful lessons were consistent: controls need one visual family, status lights +need stable color meaning, labels belong on the faceplate, and ornament should +make state easier to read. + +The local Dupre references are the implementation sources: + +- [[file:references/dupre-gallery.png][Dupre component gallery capture]] +- [[file:references/waybar-redesign.png][Waybar redesign capture]] +- [[file:README.org][Design-session decisions and critique log]] +- [[file:concepts/30a-dupre-studios-user-refined-playlist.png][Near-final visual authority]] +- [[file:../../../code/archsetup/docs/prototypes/gallery-widget.el][svg.el Dupre renderer proof of concept]] + +** Canonical geometry + +The source canvas is 1916×821 with a viewBox of =0 0 1916 821=. The renderer +preserves that aspect ratio and scales it to the available window width. It +does not reflow the playlist under the controls or move controls at runtime. +Extra vertical room stays black below the instrument. A window too short for +legible rendering falls back to the existing fancy text view rather than +shrinking controls into unusable targets. + +Craig's final board defines the visual positions. Phase 1 records them in one +geometry table, including every visual rectangle, label anchor, hit target, and +playlist row. Rendering and hit testing use the same constants. No second +hand-maintained map is allowed. + +The principal regions are: + +| Region | Approximate source bounds | +|------------------------+---------------------------| +| Complete instrument | 0,0 to 1916,821 | +| Player upper glass | 50,50 to 1170,368 | +| Lower brass deck | 69,372 to 1147,744 | +| Playlist glass | 1170,52 to 1862,744 | +| Branding field | 150,115 to 500,275 | +| Artwork | 609,108 to 755,281 | +| Metadata | 780,100 to 1125,275 | +| Seek / ON AIR line | 608,302 to 1125,330 | +| Playlist viewport | 1175,126 to 1835,658 | +| Playlist actions | 1173,671 to 1850,733 | + +Exact measured values replace these orientation bounds in the geometry table. + +** Rendering layers + +The SVG is a scene graph with four layers. + +1. The physical shell is raster. It contains the leather chassis, compressed + seams, black glass texture, fine low-contrast champagne micro-brush, recessed + grooves, fixed branding, + engraved labels, neutral control bodies, neutral volume knob, and empty VU + scales. The application embeds the assets with =svg-embed= and caches their + encoded data for the Emacs session. + +2. Static vector geometry supplies clip paths, hit-region outlines used only in + debug mode, row separators, and any simple lines that need to stay sharp at + different scales. + +3. Dynamic SVG supplies album/station art, metadata, playlist header and rows, + progress, brass seek thumb, scrollbar, transport glyphs, pressed states, + lamps, VU needles, and meter light. No live text, needle, lamp, selected row, + scrollbar, or progress state is baked into the raster shell. + +4. Emacs Lisp supplies behavior. SVG rendered through librsvg does not run + browser JavaScript. A buffer-local keymap receives mouse events, + =posn-object-x-y= returns pixel coordinates inside the displayed image, and + one scale transform maps them back to the source coordinate system. + +The near-final PNG cannot be embedded unchanged. Phase 1 creates a neutral +layered source by removing metadata, playlist text, active lamps, VU needles, +progress, and selection from the final board. The source stays editable. The +editable source stays one full-resolution instrument. Runtime rendering uses +three aligned image regions: upper player glass, lower control deck, and +playlist. A compact control sprite sheet and neutral VU face supplement those +regions. The current 1916×821 art is treated as a two-times source for a typical +roughly 958×410 rendered dock. Opaque runtime crops may be exported at their +display size after a PNG/JPEG visual comparison. V1 does not upscale beyond the +native source pixels. + +** Module and state boundary + +The SVG view lives in a new =modules/music-svg-ui.el= module. It requires +=svg=, =dom=, and ordinary Emacs image support, but it does not require EMMS. +Its pure entry points accept plain data: + +- =cj/music-svg-render= takes a state snapshot and viewport. +- =cj/music-svg-hit-target= maps source coordinates to an action description. +- =cj/music-svg-truncate= fits display text to a fixed pixel/character budget. +- =cj/music-svg-scrollbar= computes thumb length and position. +- =cj/music-svg-vu-angle= maps a smoothed dB value to the meter scale. + +=modules/music-config.el= remains the controller. It builds an ephemeral +=cj/music-ui-state= snapshot from the current EMMS playlist and player state, +then dispatches renderer actions back to existing commands. The snapshot owns +no durable music data. EMMS and M3U files remain authoritative in v1. + +The snapshot contains: + +- playback status and track kind +- current track identity and metadata +- art path, elapsed time, duration, and seekability +- playlist name/file, total count, rows, selected index, and viewport offset +- repeat, single, random, and consume state +- player volume +- left/right meter values +- transient pressed/focused target + +The graphical view is a dedicated =*Music Player*= special-mode buffer. The +hidden EMMS playlist buffer continues to own playlist markers and track order. +Controller helpers translate a visible row index to an EMMS buffer position +before selection, playback, reorder, or deletion. This avoids making a single +image character pretend to be fourteen editable EMMS rows, and it leaves a +clean seam for the EMMS-free state API later. + +** Metadata and typography + +Berkeley Mono is the default instrument typeface because it is the Dupre token +font and is installed on the target system. Missing font support falls back to +=monospace=. The cursive Dupre Studios mark remains raster in the physical +shell. + +Title, artist, album, label, and year each get one line. Empty values disappear +without closing the line spacing above them. The title receives the largest +width budget and truncates with a literal ellipsis. The renderer uses the +fixed-width font metrics and the measured metadata box, not a guessed character +count from the current window. + +The playlist shows fourteen one-line rows. Each row is number, title, artist, +and duration on one line. The row text truncates before the duration column. +Inactive text is soft white. The active row is amber and carries the triangular +play marker. There are no decorative status dots. + +The header is the only coffee/cream instrument card. It shows the current +collection or search name and item count, but never labels the source as a +playlist or radio. Four concealed warm-light pools are part of the static skin, +but the text is SVG because the name and count change. Its champagne surface is +smooth metal with a fine linear micro-brush, never coarse or wavy wood grain. + +** Playlist viewport + +The UI keeps a buffer-local first-visible index. The current track is kept in +view after track changes unless the user is actively browsing elsewhere. Mouse +wheel moves three rows. Up/Down moves the UI cursor one row. Page Up/Page Down +moves fourteen. Home/End goes to the first/last track. A row click selects and +starts that track. The existing keyboard play command remains available. + +For =N= tracks and fourteen visible rows, the scrollbar thumb fraction is +=min(1, 14/N)=. Its position is =offset/(N-14)= when =N > 14=. Dragging the +thumb changes the viewport but never changes the playing track. No scrollbar +appears for fourteen or fewer tracks. + +** Control behavior + +The visible controls map to existing behavior: + +| Surface | Action | +|---------------+--------| +| PREV | =cj/music-previous= | +| PLAY/PAUSE | start selected/current track, or =emms-pause= while playing | +| STOP | =emms-stop= | +| NEXT | =cj/music-next= | +| REPEAT | =emms-toggle-repeat-playlist= | +| SINGLE | =emms-toggle-repeat-track= | +| RANDOM | =emms-toggle-random-playlist= | +| CONSUME | =cj/music-toggle-consume= | +| NAME | =cj/music-radio-search-by-name= | +| TAGS | =cj/music-radio-search-by-tag= | +| ADD | =cj/music-fuzzy-select-and-add= | +| NEW | =cj/music-playlist-clear=, including its file-association reset | +| LOAD | =cj/music-playlist-load= | +| SAVE | =cj/music-playlist-save= | +| DELETE | =cj/music-delete-playlist= with its existing strong confirmation | + +Mouse press immediately renders the physical pressed state. Release inside the +same target dispatches the command. Release elsewhere cancels it. The +Play/Pause key remains depressed while playback is active. PREV and NEXT only +brighten during a press. STOP has no latched light. + +The four play-mode controls are alternate-action pushbuttons, not lamps or +rotary controls. Each has an unmarked spun-brass cap matching the volume cap, a +fixed collar, and a narrow dark travel seam; the faceplate label identifies its +function. Off stands slightly proud and casts a small lower shadow. On sits +nearly flush, collapses that shadow, and illuminates a thin desaturated-green +ring inside the cap/collar gap. Play/Pause uses the same warm instrument green +through its cut-out symbol with a tight internal bloom; the depressed key +remains the primary playing cue. + +The SVG mode retains the full existing keyboard surface, including commands not +placed on the faceplate: manual station creation, reload, edit, append to another +playlist, shuffle, track removal, and track reordering. Which-key/help text +documents those commands. The faceplate stays limited to the approved controls. + +** Seek and volume + +Local files show elapsed time, total duration, an amber progress line, and a +narrow vertical machined-brass grip. Clicking or dragging the slider sends an +mpv =seek= command in +=absolute-percent= mode. The displayed thumb is computed from mpv =time-pos= +and =duration=. While dragging, the local preview follows the pointer; the next +mpv response confirms or corrects it. + +URL tracks always use the radio presentation. The slider and times disappear. +One red =ON AIR= line appears under the station art, and the active playlist row +contains the second =ON AIR=. No other ON AIR label is rendered. + +Player volume is separate from the system mixer. Add +=cj/music-player-volume=, default 100, and apply it to every new mpv process. +The knob has no number or pointer. Its equally spaced lamps show the stored +0–100 value. Click/drag around the arc sets volume, the mouse wheel changes it +by five, and the existing +/− bindings call the same player-volume commands. +Setting volume writes mpv's =volume= property and updates the stored value so a +track change does not reset it. + +Every volume position is one fixed lamp well. Dark and illuminated states use +the same center and mounting bezel; the lit state replaces the dark lens rather +than adding another dot or adjacent glow. The neutral raster skin contains no +baked lamp cores or light spill. + +** Real VU telemetry + +mpv starts with a labeled FFmpeg audio filter: + +#+begin_src text +--af-add=@meter:lavfi=[astats=metadata=1:reset=1:measure_perchannel=RMS_level+Peak_level:measure_overall=none] +#+end_src + +The UI reads =af-metadata/meter= over mpv JSON IPC. FFmpeg supplies +=lavfi.astats.1.RMS_level= and =lavfi.astats.2.RMS_level= (plus peak values). +Mono duplicates channel one to both meters. Missing or nonnumeric data rests +the needles and records one diagnostic; it never invents motion. + +This path was verified locally on 2026-07-19 with mpv 0.41.0 and FFmpeg 8.1.2. +A synthetic stereo source returned distinct left/right RMS and peak values +through the labeled property. The official references are: + +- [[https://mpv.io/manual/master/#command-interface-af-metadata][mpv af-metadata property]] +- [[https://ffmpeg.org/ffmpeg-filters.html#astats-1][FFmpeg astats filter]] + +The renderer maps dB to the printed meter scale (−40 through +3). A 300 ms +attack and slower 600 ms release approximate a physical VU movement. Values +below the scale rest at the left stop. Values above +3 clamp at the right stop. + +Telemetry uses one persistent, nonblocking IPC connection with request IDs and +line-buffered JSON replies. It polls only while the player view is visible and +audio is running. It closes when playback stops or the view is hidden. The +existing one-shot IPC helpers remain valid for infrequent commands. + +** Refresh and render budget + +Hooks trigger immediate redraws for track, playlist, playback, mode, and art +changes. Progress updates four times per second while a seekable file plays. +Meters target ten updates per second while visible and playing. Paused, stopped, +hidden, and TTY states run no animation timer. + +The [[file:prototypes/2026-07-19-music-config-ui-remodel-benchmark.org][prototype benchmark]] measured full-image and tiled refresh for one minute +each at the real dock size. Full refresh failed at 133.616 ms median and +139.822 ms p95. A display-sized lower-deck tile passed at 35.513 ms median and +38.221 ms p95. The application therefore uses three aligned images: upper +player glass, lower control deck, and playlist. Each image includes the +matching raster crop. Meter ticks refresh only the lower deck; hooks refresh +the other regions. The source geometry and user-visible layout do not change. + +** Errors and empty states + +An empty queue shows the receiver, =UNTITLED=, =0 TRACKS=, and fourteen blank +rows. Playlist actions and radio search remain enabled. Transport, seek, and +mode actions that require a track are visibly inactive and report a short +message if invoked by key. + +Missing artwork uses the existing vinyl placeholder. Missing metadata is +omitted. The UI never displays =Unknown=, =N/A=, a raw nil, or a raw stream URL +as program information. + +If SVG, librsvg, the raster shell, or a minimum legible viewport is unavailable, +F10 opens the implemented fancy/text playlist instead and reports why once. If +mpv IPC is unavailable, seek, volume telemetry, and meters disable without +stopping playback. A command reports the failed operation and the next step, +for example: =Music seek unavailable: mpv IPC socket is not connected; start a +track and try again.= + +=M-x cj/music-ui-doctor= reports graphical/SVG support, resolved assets and font, +view size, last render time, mpv socket state, meter filter state, telemetry +timer state, and the last telemetry error. It does not log private file paths +or stream URLs unless called with a debug prefix. + +* Alternatives Considered + +** Hybrid raster skin plus dynamic SVG (chosen) + +- Good, because it preserves the leather, glass, brass grain, and machined + highlights from the approved board while keeping every changing value honest. +- Bad, because the neutral raster source and SVG geometry must stay aligned. +- Neutral, because the result is still one SVG application document even though + the document embeds raster assets. + +** Rebuild the complete receiver as vector geometry + +- Good, because every surface would scale without raster limits and theme tokens + could recolor everything. +- Bad, because reproducing leather, brushed brass, glass, and irregular reflected + light would take much longer and would look less like the approved board. +- Neutral, because simple Dupre controls still supply useful vector geometry + inside the hybrid renderer. + +** Use the final PNG as one clickable background + +- Good, because it would match the approved image immediately. +- Bad, because the PNG contains one track, one playlist, lit volume segments, + meter needles, progress, and button state. Painting over those areas would + flatten the material texture and produce visible patches. +- Neutral, because a cleaned neutral derivative of the PNG is the chosen shell. + +** Browser/xwidget application + +- Good, because browser SVG supports native DOM events and partial element + updates. +- Bad, because it introduces a browser runtime inside Emacs, complicates window + integration, and weakens TTY and configuration portability. +- Neutral, because browser prototypes remain useful before the svg.el port. + +** Replace the EMMS playlist buffer in place + +- Good, because no second buffer name or adapter is needed. +- Bad, because EMMS commands depend on point and text markers while the SVG is + one displayed image glyph. Mixing invisible rows and image coordinates would + be brittle. +- Neutral, because the dedicated view still delegates every operation to the + existing EMMS buffer in v1. + +* Decisions [10/10] + +** DONE Hybrid raster/SVG rendering +- Context: the final board's realism comes from material texture and reflected + light, while live state must remain replaceable. +- Decision: We will embed a neutral raster skin in an SVG scene and render all + changing information, needles, lights, and selection as SVG. +- Consequences: easier, the running UI can closely match the board. Harder, the + asset export and SVG geometry need one measured coordinate system. + +** DONE Craig's final board is the visual authority +- Context: the design session produced many useful directions, but implementation + needs one source for proportion and material treatment. +- Decision: We will use concept 30, Craig's 1916×821 GIMP refinement, as the + layout and appearance authority. +- Consequences: easier, visual disputes can be checked against one board. Harder, + the radio state must be derived without drifting from that hardware. + +** DONE Neutral physical shell +- Context: the final flattened PNG contains transient information and active + state. +- Decision: We will create an editable neutral source and export a clean shell, + control sprites, and neutral VU face. No live state remains in those assets. +- Consequences: easier, texture stays realistic. Harder, Phase 1 includes careful + image cleanup before application code can look finished. + +** DONE Dedicated graphical view buffer +- Context: EMMS playlist operations are point/marker based and cannot treat one + SVG image as fourteen text rows. +- Decision: We will render into =*Music Player*= and use controller adapters to + operate on the hidden EMMS playlist buffer. +- Consequences: easier, the SVG renderer stays clean and future-backend ready. + Harder, selection and reorder commands need explicit index-to-marker adapters. + +** DONE One geometry table for drawing and input +- Context: separate hand-maintained visual and hit maps will drift. +- Decision: We will measure the final board once and derive rendering, hit tests, + clipping, and scaling from the same constants. +- Consequences: easier, controls stay clickable after scaling. Harder, geometry + extraction is a named deliverable rather than ad hoc coordinates in draw code. + +** DONE Direct control semantics +- Context: every faceplate control must perform real music-config behavior. +- Decision: We will map the approved transport, modes, radio search, playlist + actions, seek, and volume controls directly to their existing commands or the + named mpv additions in this spec. +- Consequences: easier, the interface is self-explanatory. Harder, commands not + approved for the faceplate remain keyboard/M-x only and need discoverable help. + +** DONE Persistent per-player volume +- Context: the existing +/- path can change the system mixer, while the design's + knob is the player's volume and mpv restarts for each track. +- Decision: We will store volume in music-config, write mpv's volume property, + and apply the stored value when every new mpv process starts. +- Consequences: easier, the knob is truthful and track changes preserve level. + Harder, one more piece of runtime state must stay synchronized with mpv. + +** DONE Real meter data through mpv astats +- Context: random needle animation would violate the design's functional-lighting + rule. +- Decision: We will read left/right RMS metadata from a labeled FFmpeg astats + filter over mpv IPC and apply physical needle smoothing. +- Consequences: easier, the VUs convey real program level. Harder, a visible + view needs a small persistent IPC telemetry client and bounded refresh timer. + +** DONE Current text views remain fallbacks +- Context: TTY frames and SVG/asset failures need a usable player, and the + implemented fancy text UI already works. +- Decision: We will add an SVG enable flag and fall back to the current fancy or + plain text path without changing M3U or playback state. +- Consequences: easier, rollout and rollback are safe. Harder, the text path + remains maintained alongside the SVG application. + +** DONE Three-region render path after measurement +- Context: =svg-possibly-update-image= rerasterizes an SVG image, so ten full + receiver renders per second may exceed the dock's CPU budget. +- Decision: The prototype benchmark measured the full receiver at 133.616 ms + median / 139.822 ms p95 and the display-sized lower-deck tile at 35.513 ms + median / 38.221 ms p95. We will use three aligned regions and refresh only + the lower deck at meter cadence. +- Consequences: easier, meter animation passes the render budget with margin. + Harder, the renderer places three images and the asset export must hide their + boundaries exactly. + +* Review findings [0/1] + +** TODO The final interaction model has no working two-state prototype :blocking: + +The design session produced extensive static boards and established concept 30 +as the visual authority, but the final geometry has not been exercised as a +working local-playlist and radio prototype. That leaves click targets, drag +behavior, playlist scrolling, long-text clipping, local/radio state changes, +and the full-image render budget unproven. Starting implementation now would +make the first build phase answer product and performance questions that belong +in the design gate. + +Smallest resolution: create one functional prototype using concept 30's +geometry and neutral skin. It may be a browser prototype or an Emacs SVG proof, +but it must switch between a long local playlist and a live-radio fixture; wire +transport, modes, radio search, playlist actions, row and scrollbar navigation, +seek, and volume interaction; show all pressed and latched states; stress long +metadata; and record one minute of render timing at the intended dock size. +Link the accepted prototype under Prototype iterations and Design, record any +geometry or performance changes here, then repeat spec review. + +Progress on 2026-07-19: [[file:prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html][prototype 1]] now supplies both fixtures and the named +interactions; its twelve-check behavior pass is green. The [[file:prototypes/2026-07-19-music-config-ui-remodel-benchmark.org][librsvg benchmark]] +records a full-render failure and a passing lower-deck tile, so the spec now +requires the three-region renderer. Craig's hands-on acceptance is the only +remaining part of this finding. + +* Implementation phases + +** Phase 1 — Neutral skin and geometry manifest + +Create the editable neutral source from concept 30. Export aligned upper-glass, +lower-deck, and playlist crops plus control sprites and the VU face under final +dated asset names. Record measured +source rectangles, anchors, clip boxes, and hit targets in one Lisp geometry +table. Add an asset/geometry debug command that renders target outlines over the +skin. The phase ends with a static SVG in Emacs that matches the final board and +contains no baked live state. + +** Phase 2 — Pure SVG renderer and view mode + +Add =modules/music-svg-ui.el=, the state structs, pure layout helpers, raster +embedding cache, text clipping, dynamic node construction, and +=cj/music-svg-mode=. F10 can show/hide the static graphical view while the +existing fancy/text path remains available. Add unit tests for scale transforms, +hit testing, truncation, scrollbar math, mode colors, and VU angle mapping. + +** Phase 3 — Controller snapshot and playlist viewport + +Build state snapshots from EMMS without exposing EMMS objects to the renderer. +Render metadata, album art, header, fourteen rows, selection, and the exact +scrollbar. Implement keyboard and mouse scrolling, row selection/play, and +index-to-EMMS-marker adapters. Characterize existing reorder/removal behavior +before routing those keys through the graphical view. + +** Phase 4 — Transport, modes, radio search, and playlist actions + +Wire the approved faceplate controls and pressed/latched rendering. Preserve +the remaining keyboard-only commands and add a concise help surface. Cover +empty-queue behavior, destructive Delete confirmation, command errors, and +state refresh hooks. The phase ends with a complete functional control surface +using the existing backend. + +** Phase 5 — Seek and persistent mpv volume + +Add player-owned volume state and apply it on process start. Route +/−, wheel, +click, and drag through the same volume setters. Add absolute seek and drag +confirmation using mpv time/duration. Render local progress and the exact brass +thumb. Unit-test value/coordinate mapping and use a fake IPC ledger for command +order. + +** Phase 6 — Stereo telemetry and timed refresh + +Add the labeled astats filter, persistent nonblocking telemetry connection, +JSON request/reply routing, meter parsing, dB mapping, and needle ballistics. +Run progress and meter timers only while visible and active. Measure the render +budget for one minute and use the documented three-region fallback if needed. +Test with the synthetic no-audio-output source used during spec research. + +** Phase 7 — Radio state, failures, and diagnostics + +Render the matched live-radio state with exactly two ON AIR labels and no seek +surface. Handle missing art/metadata, unavailable SVG/assets/font, lost mpv IPC, +missing meter metadata, hidden-window timer shutdown, and an empty queue. Add +=cj/music-ui-doctor= and verify that fallback never mutates playback or playlist +state. + +** Phase 8 — Integration, documentation, and live verification + +Run the focused music tests, batch load, byte compilation, TTY fallback, and GUI +daemon verification. Exercise a long local playlist, a short radio playlist, +seek, volume across track changes, every control, scrolling, reorder, deletion, +and one-hour timer stability. Update music documentation and key hints. Make +the SVG view the graphical default only after Craig accepts the live result. + +* Acceptance criteria + +- [ ] F10 opens the Dupre Studios receiver in the bottom side window on a + graphical frame and toggles it closed without changing playback. +- [ ] The running receiver matches concept 30 in proportion, material character, + spacing, typography, and control placement at the normal dock size. +- [ ] Leather, glass, brass, fixed engraving, and neutral hardware come from the + raster skin; live information and illumination are not baked into it. +- [ ] The UI remains fully usable from the keyboard. +- [ ] Every visible button maps to the command named in this spec. +- [ ] Pressed, playing, and latched mode states are physically and chromatically + distinct. +- [ ] Local metadata uses separate lines and omits missing values. No visible + program field says Unknown or N/A. +- [ ] Long metadata and playlist rows truncate with an ellipsis before colliding + with adjacent fields. +- [ ] The analog header card shows only the collection/search name and item + count; it never adds a PLAYLIST or RADIO type label. +- [ ] Champagne surfaces use a fine low-contrast metallic micro-brush and never + read as wood grain. +- [ ] The playlist shows fourteen one-line rows with artist inline, selected row + amber, and a functional scrollbar whose size and position follow the formulas. +- [ ] Mouse wheel, keyboard navigation, scrollbar drag, row click/play, reorder, + and removal operate on the intended EMMS tracks. +- [ ] ADD, NEW, LOAD, SAVE, and DELETE preserve current playlist/M3U semantics. +- [ ] DELETE uses the existing strong confirmation and reports which playlist was + deleted. +- [ ] A local track displays actual elapsed/duration and supports click/drag seek. +- [ ] The seek thumb is brass and its position comes from mpv state. +- [ ] A live station has no slider or times and shows exactly two ON AIR labels. +- [ ] The volume knob controls mpv, not the system mixer, and persists across + track changes. +- [ ] Volume segments fill cumulatively to the stored mpv volume and have no + numeric display. +- [ ] VU needles use distinct real left/right RMS values, rest on missing data, + and never use random animation. +- [ ] Paused, stopped, hidden, and TTY states run no meter/progress timer. +- [ ] Full or tiled rendering meets the median/95th-percentile budget during a + one-minute meter run. +- [ ] Empty playlist, missing art, missing metadata, missing SVG/assets, and lost + mpv IPC each have the fallback or actionable error defined in this spec. +- [ ] =cj/music-ui-doctor= reports the renderer and telemetry state without + exposing file paths or stream URLs by default. +- [ ] Setting the SVG enable flag off restores the implemented fancy/text UI. +- [ ] Existing music-config tests pass, and new pure tests cover geometry, + snapshots, hit targets, clipping, scrolling, volume, seek, meter mapping, and + timer lifecycle. +- [ ] Craig accepts both a long local-playlist state and a live-radio state in the + real Emacs side window before the SVG view becomes the default. + +* Readiness dimensions + +- Data model & ownership: EMMS and M3U remain authoritative. The SVG snapshot, + pressed target, viewport offset, meter smoothing, and render timing are + generated runtime state. Player volume is music-config runtime state applied + to each mpv process. Raster source assets are project-authored and versioned. +- Errors, empty states & failure: defined in the Errors and empty states section. + Playback continues if rendering or meter telemetry fails. Destructive + playlist deletion retains the existing strong confirmation. +- Security & privacy: no credentials are added. Diagnostics omit local paths and + stream URLs by default. Album art and radio favicons stay in the existing + local cache. +- Observability: =cj/music-ui-doctor= exposes assets, font, viewport, render + timing, socket/filter/timer state, and last telemetry error. The UI itself + exposes player state through lamps, needles, progress, and selection. +- Performance & scale: fourteen visible rows from playlists tested through at + least 1,000 tracks. SVG refresh has explicit median/95th-percentile budgets, + a one-minute test, and a pre-approved tiled fallback. Hidden views do no timed + work. +- Reuse & lost opportunities: reuses the current music commands, EMMS state, + M3U/radio/art code, bottom side window, Dupre tokens, =svg.el=, and the gallery + widget proof. It deliberately does not wait for the EMMS-free/VAMP rewrite. +- Architecture fit & weak points: new renderer module is pure at its boundary; + music-config owns EMMS adaptation and mpv effects. Weak points are raster/SVG + alignment, point-based EMMS adapters, full-image rerasterization, and telemetry + lifecycle. Geometry sharing, adapter tests, tiled fallback, and visibility- + scoped IPC mitigate them. +- Config surface: add =cj/music-svg-ui= (boolean, default off until live acceptance, + then on) and =cj/music-player-volume= (integer 0–100, default 100). Keep + =cj/music-fancy-ui= as the fallback selector. Refresh rates and geometry are + internal until real use proves a customization need. +- Documentation plan: update music-config commentary/docstrings, F10/keybinding + notes, the music VERIFY task, and the design README. The final spec and dated + runtime assets remain linked from the parent task. +- Dev tooling: use the existing ERT/byte-compile commands, focused music test + files, Emacs daemon live verification, and a deterministic synthetic mpv meter + script/fixture with =ao=null=. No network or audible output in the normal + suite. +- Rollout, compatibility & rollback: SVG is additive and initially disabled. + Fallback is automatic. Rollback is setting =cj/music-svg-ui= nil or reverting + the new renderer/controller changes; M3U files and cached art do not migrate. +- External APIs & deps: built-in Emacs 30.2 =svg.el= and librsvg are the render + path. mpv 0.41 and FFmpeg 8.1 were checked locally. Official mpv and FFmpeg + documentation confirms labeled audio-filter metadata and astats keys. + +* Risks, Rabbit Holes, and Drawbacks + +- Cleaning a neutral skin from a flattened final board can produce visible + texture patches. Keep the layered source, use broad material samples rather + than small clone spots, and approve the neutral shell before wiring state. +- Full-image librsvg refresh may be too expensive at meter cadence. Measure in + the prototype. Use the specified three-region split rather than lowering the + meter to a decorative crawl. +- EMMS commands expect point in the playlist buffer. Keep every index-to-marker + translation in one controller adapter and test reorder/remove against the same + logical track. +- SVG text metrics can differ from Emacs face metrics. Use the installed Dupre + fixed-width font, fixed boxes, clipping paths, and visual stress fixtures with + long titles. +- An mpv filter may fail for an unusual audio format. Playback wins: leave the + meter at rest, show the failure in the doctor, and never stop the track. +- The raster skin limits infinite scaling and alternate themes. V1 targets the + current dock and approved aesthetic. Multiple skins and responsive reflow are + separate work. + +* Testing / Verification / Rollout + +Pure ERT tests cover layout transforms, geometry/hit agreement, text fitting, +playlist window/scrollbar math, state-to-color mapping, volume/seek conversion, +VU dB/angle mapping, ballistics, and timer state. Controller tests use an EMMS +fixture or stubs and an mpv IPC ledger so they do not play sound. + +Integration tests build representative local and radio snapshots, render SVG +strings, and assert required IDs, text, clip paths, and state classes. They do +not use pixel-perfect screenshots as the main contract because librsvg/font +versions can change antialiasing. A small set of manual reference screenshots +supports the visual acceptance step. + +The live pass runs in the real bottom side window with the normal long playlist +and a radio playlist. It covers every faceplate control, keyboard parity, +scrolling, long strings, seek, persistent volume, two-channel meters, exactly two +ON AIR states, hidden-window timer shutdown, and fallback. The SVG flag changes +to default-on only after that pass. + +* References / Appendix + +- [[file:../../docs/specs/2026-07-06-fancy-music-player-ui-spec.org][Implemented fancy music-player UI spec]] +- [[file:../../docs/specs/music-config-without-emms-spec.org][Music-config without EMMS architecture spec]] +- [[file:README.org][Music SVG design record]] +- [[file:concepts/30a-dupre-studios-user-refined-playlist.png][Near-final playlist board]] +- [[file:prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html][Functional two-state prototype]] +- [[file:prototypes/2026-07-19-music-config-ui-remodel-benchmark.org][Prototype librsvg benchmark]] +- [[https://www.gnu.org/software/emacs/manual/html_node/elisp/SVG-Images.html][Emacs Lisp SVG images]] +- [[https://mpv.io/manual/master/#json-ipc][mpv JSON IPC]] +- [[https://mpv.io/manual/master/#command-interface-af-metadata][mpv audio-filter metadata]] +- [[https://ffmpeg.org/ffmpeg-filters.html#astats-1][FFmpeg astats]] + +* Review and iteration history + +** 2026-07-19 Sun @ 19:11:57 -0500 — Codex (emacs-d) — hardware-depth correction +- What: changed the upper boundary of the lower deck from a raised champagne + rim to a dark glass reveal descending into the brass faceplate. Unified all + four play-mode and both radio-search controls as blank, circularly machined + brass pushbutton caps. Removed the returned search glyphs and expanded then + tightened the source crop to preserve the volume knob's complete black + knurled skirt without importing the old faceplate halo. +- Why: the prior neutral-faceplate overlay flattened the glass/metal depth, + allowed the small-control treatments to diverge, and clipped the knob at a + perfect circle that hid its physical knurling. These changes restore a + believable assembly hierarchy while retaining state-owned lamps. +- Artifacts: updated [[file:prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html][functional prototype 1]]; twelve-check interaction regression green. + +** 2026-07-19 Sun @ 18:43:00 -0500 — Codex (emacs-d) — prototype refinement +- What: replaced the baked lower-deck faceplate with a neutral SVG-owned + champagne micro-brush surface, then restored only the approved volume knob + through a circular crop. Re-engraved the fixed control labels on the new + surface and reduced the volume arc to small dark wells with state-owned amber + cores and local glow. Verified both local and radio layouts and reran the + twelve-check headless interaction pass successfully. +- Why: masking individual source-image lamps left visible baked illumination and + made the faceplate look patched. Owning the complete neutral deck surface in + SVG removes the conflicting lamp state and the woodlike raster grain while + retaining the realistic machined knob from the approved visual authority. +- Artifacts: updated [[file:prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html][functional prototype 1]]; local and radio state screenshots. + +** 2026-07-19 Sun @ 18:39:41 -0500 — Codex (emacs-d) — prototype refinement +- What: applied Craig's second hands-on pass. Removed source-type words and the + separator from the analog card; changed radio fixture naming to =NAME SEARCH=; + replaced the circular seek ornament with a vertical machined-brass grip; + removed all mode-cap glyphs and matched their smooth spun-brass finish to the + volume cap; and rebuilt the volume arc as dark recessed wells whose amber core + and glow exist only for lit positions. +- Why: the card should identify the current collection/search rather than report + an internal playlist/radio type. The prior seek coin had no hardware model, + the mode symbols duplicated their faceplate labels, and baked light spill made + some nominally dark volume positions glow. The spec now also rejects coarse, + wavy champagne texture that reads as wood grain. +- Artifacts: updated [[file:prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html][functional prototype 1]]; Craig's 18:29–18:32 screenshots. + +** 2026-07-19 Sun @ 18:19:28 -0500 — Codex (emacs-d) — prototype refinement +- What: incorporated Craig's first hands-on notes. Rebuilt play modes as + alternate-action brass pushbuttons with engraved glyphs, visible travel, and + a restrained inset green ring; tightened Play/Pause illumination; aligned + each volume lamp's dark and lit state to one physical well; restored four + concealed warm-light pools on a darker coffee/cream playlist card; and made + the prototype's synthetic-VU / production-signal distinction explicit. +- Why: the prior controls read as glowing domes, the green looked like a neon + outline, the flattened source and live volume arcs produced double lamps, and + the playlist card had lost its analog illumination model. Production VUs + remain tied to real mpv astats RMS data as already specified. +- Artifacts: updated [[file:prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html][functional prototype 1]]; Craig's 17:59–18:03 screenshots. + +** 2026-07-19 Sun @ 17:56:27 -0500 — Codex (emacs-d) — prototype author +- What: built functional prototype 1 from concept 30 with local and radio + fixtures, all approved faceplate controls, long-string stress data, exactly + fourteen visible rows, scrollbar and seek/volume drag, pressed/latched states, + empty/delete flows, keyboard navigation, and synthetic stereo needle motion. + Its built-in twelve-check behavior pass is green. Measured librsvg for one + minute per path: full receiver 133.616 ms median / 139.822 ms p95 (fail), + display-sized lower deck 35.513 ms median / 38.221 ms p95 (pass). +- Why: this supplies the interaction and performance evidence requested by the + first review finding. The measured result makes the three-region renderer a + requirement rather than a contingency. Craig's hands-on prototype acceptance + remains pending, so the finding stays open and the spec stays DRAFT. +- Artifacts: [[file:prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html][functional prototype 1]]; [[file:prototypes/2026-07-19-music-config-ui-remodel-benchmark.org][benchmark record]]; + [[file:2026-07-19-music-config-ui-remodel-render-fixture.svg][full-render fixture template]]. + +** 2026-07-19 Sun @ 16:16:57 -0500 — Codex (emacs-d) — reviewer +- What: completed the first implementation-readiness review after reading the + current music-config render, EMMS playlist, radio, mpv IPC, and volume paths. + Assigned =Not ready= and recorded one blocking finding: the approved final + board is static, so its two application states, hit/drag/scroll behavior, and + rendering budget have not passed the project's functional-prototype gate. +- Why: the architecture, ownership, failure handling, telemetry source, rollout, + acceptance criteria, and eight phase boundaries are otherwise specific enough + to implement. A working prototype is the smallest remaining test of the + design rather than an invitation to redesign it during Phase 1. +- Artifacts: =* Review findings [0/1]= in this spec; source checks in + =modules/music-config.el=; Dupre =gallery-widget.el= SVG proof; verified mpv + =af-metadata/meter= / FFmpeg =astats= telemetry path. + +** 2026-07-19 Sun @ 16:03:13 -0500 — Codex (emacs-d) — author +- What: drafted the Music Config UI Remodel spec from Craig's selected concept, + manual GIMP refinement, and hybrid raster/SVG decision. Verified the real VU + telemetry path against the installed mpv/FFmpeg stack and primary docs. +- Why: the visual design is settled closely enough to define the renderer, + controller boundary, interaction surface, phases, and test contract before + implementation. +- Artifacts: [[file:concepts/30a-dupre-studios-user-refined-playlist.png][concept 30]]; local mpv astats IPC check; parent music SVG task. diff --git a/working/music-svg-app-design/README.org b/working/music-svg-app-design/README.org new file mode 100644 index 00000000..5ef6d67d --- /dev/null +++ b/working/music-svg-app-design/README.org @@ -0,0 +1,426 @@ +#+TITLE: Music SVG Application Design Working Set +#+AUTHOR: Craig Jennings + +* Purpose + +Six functional HTML/SVG prototypes for the music-config application design session. +They explore the Dupre chronometer, hi-fi stereo, and automobile-dashboard visual +language while preserving the current player, queue, radio, and playlist workflows. + +This directory owns the complete in-progress remodel package while the design +continues. The implementation spec is +[[file:2026-07-19-music-config-ui-remodel-spec.org][2026-07-19-music-config-ui-remodel-spec.org]]. +The current interactive and rendering evidence lives under [[file:prototypes/][prototypes/]]. +Concept boards, source artwork, and visual references stay beside them so local +iteration does not depend on files scattered through =docs/=. When the design +is accepted, the spec, prototypes, benchmark, render fixture, and selected final +assets graduate together to their permanent =docs/= and =assets/= homes. + +The selected receiver now has a final interaction candidate at +[[file:prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html][prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html]]. It uses +concept 30 as the physical shell and overlays the changing local-playlist and +radio state. The paired [[file:prototypes/2026-07-19-music-config-ui-remodel-benchmark.org][librsvg benchmark]] makes the three-region production +renderer mandatory: full-instrument meter refresh missed the budget, while the +lower control tile passed. + +* Inputs + +- [[file:../../docs/specs/2026-07-06-fancy-music-player-ui-spec.org][Existing music player UI spec]] +- [[file:../../docs/specs/music-config-without-emms-spec.org][EMMS-free architecture spec]] +- [[file:../../../code/archsetup/docs/prototypes/panel-widget-gallery.html][Dupre panel-widget gallery]] +- [[file:../../../code/archsetup/docs/prototypes/waybar-redesign-prototype.html][Waybar redesign prototype]] + +* Prototype Directions + +1. Gold-pinstripe tuner console +2. Touring-car instrument cluster +3. Chronometer record deck +4. Studio rack and tape machine +5. Perpetual-calendar salon receiver +6. Mission-control radio navigator + +* High-Fidelity Concept Boards — Iteration Two + +The second pass deliberately separates visual design from implementation. These +boards establish materials, lighting, silhouette, hierarchy, and instrument +semantics before the selected direction is translated into Dupre components. + +1. [[file:concepts/01-champagne-receiver.png][Champagne Receiver]] +2. [[file:concepts/02-le-mans-night-cluster.png][Le Mans Night Cluster]] +3. [[file:concepts/03-geneva-playback-chronograph.png][Geneva Playback Chronograph]] +4. [[file:concepts/04-mastering-room-reel-console.png][Mastering Room Reel Console]] +5. [[file:concepts/05-perpetual-calendar-salon.png][Perpetual Calendar Salon]] +6. [[file:concepts/06-transatlantic-broadcast-navigator.png][Transatlantic Broadcast Navigator]] +7. [[file:concepts/07-functional-black-glass-receiver.png][Functional Black Glass Receiver]] +8. [[file:concepts/08-functional-black-glass-flipped.png][Functional Black Glass Receiver — flipped]] +9. [[file:concepts/09-functional-black-glass-retro.png][Functional Black Glass Receiver — retro]] +10. [[file:concepts/10-warm-black-glass-player-volume.png][Warm Black Glass Receiver — player volume]] +11. [[file:concepts/11-illuminated-black-glass-controls.png][Illuminated Black Glass Receiver — varied controls]] +12. [[file:concepts/12-consolidated-functional-receiver.png][Consolidated Functional Receiver]] +13. [[file:concepts/13-black-silver-chronograph-receiver.png][Black and Silver Chronograph Receiver]] +14. [[file:concepts/14-corrected-luxury-chronograph-receiver.png][Corrected Luxury Chronograph Receiver]] +15. [[file:concepts/15-champagne-brass-digital-hifi.png][Champagne-Brass Digital Hi-Fi]] +16. [[file:concepts/16-champagne-aluminum-radio-groups.png][Champagne-Aluminum Radio Groups]] +17. [[file:concepts/17-dupre-coltrane-scrollbar.png][Dupre Coltrane Scrollbar State]] +18. [[file:concepts/18-dupre-branding-control-study.png][Dupre Branding and Compact-Control Study]] +19. [[file:concepts/19a-dupre-playlist-state.png][Dupre Playlist State]] / [[file:concepts/19b-dupre-radio-state.png][Dupre Radio State]] +20. [[file:concepts/20-dupre-playlist-radio-comparison.png][Dupre Long-Playlist / Compact-Radio Comparison]] ([[file:concepts/20a-dupre-long-playlist.png][playlist source]] / [[file:concepts/20b-dupre-compact-radio.png][radio source]]) +21. [[file:concepts/21-dupre-semantic-controls-comparison.png][Dupre Semantic-Controls Comparison]] ([[file:concepts/21a-dupre-mode-lamps-playlist.png][playlist source]] / [[file:concepts/21b-dupre-two-on-air-radio.png][radio source]]) + +- [[file:concept-board.html][Open the six-board review sheet]] + +The original functional HTML pass remains at +[[file:music-svg-directions.html][music-svg-directions.html]] for interaction and +workflow reference; it is not the material-design target. + +* Current Design Decisions + +- Beauty must communicate real application function; no decorative controls. +- Preserve the Champagne Receiver's now-playing, progress, transport, queue, + and playlist-management regions as the functional nucleus. +- Remove AM/FM, tone, speaker, loudness, power, and other receiver controls + without a =music-config.el= command or state. +- Target a compact panoramic panel in the bottom portion of a predominantly + portrait Emacs frame; playlist and player controls must sit side by side. +- Prefer a neutral black-glass, warm-meter, polished-chrome language with + restrained warm metal and tactile black leather; keep whitespace low without + returning to clutter. Do not use cold blue illumination. +- Permanent radio controls map only to the implemented name and tag searches. + Manual URL entry remains an Emacs command rather than faceplate hardware. +- Place the player on the left and playlist on the right. +- The dots around the volume knob are a cumulative illuminated scale driven by + actual volume; the last lit dot is the precise pointer. They never chase or + flash. +- The knob controls dedicated mpv player volume rather than the system mixer. + Persist the level in Emacs, pass it to each newly started per-track mpv + process, and read/write mpv's =volume= property over the existing IPC socket. +- Drive the stereo VU meter from real mpv audio analysis. A labeled lavfi + =astats= filter exposes per-channel RMS and peak readings through + =af-metadata/<label>=; apply analog needle ballistics in the UI. Treat the + meter as pre-volume program level so it describes the recording independently + of listening volume. +- Prefer neutral black glass, chrome, and pebbled leather with warm ivory, + amber, and restrained jewel illumination; avoid cold blue light. +- All playlist and now-playing typography is self-luminous behind smoked glass, + never merely engraved. Compose album metadata conditionally from album, + label, year/date, genre, composer, performer, track, and disc; omit missing + values and separators, and never display =Unknown= or =N/A=. +- Do not display a numeric player-volume value. The physical knob pointer, + ticks, and cumulative lamps communicate level. +- Omit manual URL entry and playlist reload from the permanent faceplate; the + commands remain available through Emacs. +- For seekable tracks, the progress indicator is an interactive slider. For a + non-seekable live stream, replace the entire slider/time treatment with an + =ON AIR= state; never show both states together. +- With the slider handling seeking, transport contains only previous, + play/pause, stop, and next. Labels live on the faceplate beneath compact + physical controls. +- Put repeat, single, random, and consume lamps/toggles on the lower player + control rail. Put radio name/tag search there as well. The right side is + reserved for the large playlist and visible playlist actions. +- Present now-playing metadata as separate illuminated lines and omit the + =NOW PLAYING= caption. +- Use one consistent family of small round chrome transport pushbuttons. Mode + controls use four identical low-profile luxury latching pushbuttons with + polished-steel collars, smoked-black enamel centers, and integrated faceted + jewels: pressed and lit means on; raised and dark means off. Bat toggles are + prohibited because they read as utilitarian rather than luxury hardware. +- Build depth with a realistic two-step polished-chrome bezel and dark gasket + around both the VU meter and complete player where they meet black leather. + Avoid excessive parallel chrome rails. +- Use a coherent brushed-silver lower control faceplate. Chrome and silver + dominate; brass remains a hairline accent. +- The playlist shows roughly fourteen compact one-line rows with artist inline, + an explicit illuminated playlist name, and square matte-anodized action keys. + Visible actions are add, new, load, save, and delete. Delete is a normal + matte-red key; edit is not permanent faceplate functionality. +- Put the =ON AIR= lamp inside the radio control bank. It remains dark for a + local file and lights only for a live radio source. +- Do not use the drum/tape roller as a saved-playlist selector. Its unlabeled + adjacent digits were mistaken for a counter and its purpose was not legible; + the labeled =LOAD= action is sufficient. If a drum mechanism is revisited, + it must expose a unique function that is understood without explanation. +- Volume segments are identical and evenly spaced; light continuously from the + rightmost minimum through and including the pointer-aligned segment. +- Allocate approximately 42 percent of usable width to the player and 58 + percent to the playlist. When all fourteen rows fit, show neither a scrollbar + nor another redundant track-count mechanism. +- Remove the current-track =01 / 14= complication entirely: the highlighted + playlist row communicates the same information more directly. +- Put the mode/status/radio rail above the transport rail. Align =ON AIR= with + the other mode jewels and give it the same visible diameter, while retaining + its non-pressable status-only behavior. +- Transport hardware is a coherent bank of four shallow, closely spaced, + machined-metal hi-fi piano keys rather than separate round buttons. +- Use distinctly digital, self-luminous typography for player metadata and the + playlist; keep faceplate labels engraved rather than digital. +- A pale brushed champagne-brass control faceplate is viable so long as black + glass and polished chrome remain dominant and the brass never becomes bronze, + copper, brown, or sepia. +- Prefer authentic pale champagne-anodized aluminum over brass: fine horizontal + brushing, cool metallic highlights, and crisp machined edges retain warmth + while matching real high-end audio construction. +- Fasteners are small, discreet, countersunk details rather than prominent + corner bolts. +- Make radio membership explicit on the faceplate. A restrained engraved + =RADIO= heading and hairline bracket span exactly =ON AIR=, =BY NAME=, and + =BY TAG=; a separate =PLAY MODES= heading owns repeat, single, random, and + consume. Do not use another heavy enclosure. +- Mode controls combine an unmistakably pressable shallow aluminum cap with a + smaller inset jewel. =ON AIR= uses the same jewel diameter and baseline but + no cap or travel, preserving its status-only meaning. +- For a seekable track, slider position must be computed from elapsed/duration + rather than independently illustrated. Concept 16 still places the handle + too far right for =02:37 / 05:35=; implementation must place it at 47 percent. +- Color carries stable semantics: warm ivory is ordinary information; amber is + active playback, progress, and volume; green is an enabled playback mode; + neutral silver is keyboard focus; red is reserved for delete, live =ON AIR=, + and faults. Do not color ordinary playlist actions arbitrarily. +- Use conventional volume geometry: minimum is lower left, maximum lower right, + and illumination advances clockwise from minimum through the knob pointer. + Segments after the pointer toward maximum remain dark. +- Playing state must be physical as well as chromatic: the =PLAY/PAUSE= key sits + visibly lower with its shadow withdrawn; a restrained amber edge is secondary + confirmation. +- The faceplate may carry one modest maker's plaque: coarse black crosshatch + that survives small SVG rendering, with a raised cursive =Dupre= wordmark. + It is a badge, not a fake speaker grille, and must not justify extra height. +- For lists longer than the fourteen-row viewport, show a narrow functional + scrollbar. Thumb length represents =visible rows / total rows= and position + represents the top visible row. Concept 17 demonstrates the long-list state + but its generated thumb remains shorter than the required 14/32 (44 percent). +- The next review set is a matched two-state pair: one seekable normal-playlist + player and one live-radio player using identical hardware. The radio state + replaces slider and times with =ON AIR=, lights the red broadcast lamp, and + conditionally shows only available station/stream metadata. +- Do not assume short metadata. Recover display width by reducing album art and + VU width roughly 20 percent; allow modest automatic font condensation before + ellipsis. Do not marquee by default. Full truncated values remain available + through normal Emacs help/minibuffer affordances. +- Compact playback modes into a 2×2 internally illuminated-legend block. The + engraved symbol itself glows; do not add a separate lamp or oversized lip. + Keep explicit micro-labels because =CONSUME= has no universal symbol. +- Place a similarly compact radio block immediately beside play modes: =NAME= + and =TAG= momentary buttons above a flush =ON AIR= window. This leaves the + right side visually quiet around volume. +- Branding is part of the faceplate surface, never a plate atop another plate. + Concept 18 compares: black-enamel inscription (A), bright-cut inscription + (B), same-plane crosshatched negative-space field (C), and direct-mounted + chrome script without backing (D). +- Select concept 18 option D: a moderately enlarged direct-mounted chrome + cursive =Dupre= script at the faceplate's upper left, with no backing. Put + compact proportional =NAME=, =TAG=, and =ON AIR= radio controls below it. +- Transport adopts the same internally illuminated-legend construction as the + mode keys. The symbol itself is translucent: amber while active, dim ivory + while inactive. Do not add a separate under-key light strip. Concepts 19a/b + still contain a generated amber strip beneath Play and are non-authoritative + on that detail. +- Treat local and live playback as matched states of identical hardware. A + seekable file shows slider and times and keeps =ON AIR= dark; a live stream + removes all seek/time hardware, displays =ON AIR / LIVE STREAM= in that region, + and lights the faceplate broadcast window red. +- Scrollbar thumbs remain mathematical UI, not illustrative ornament: 14/32 is + 44 percent and 14/18 is 78 percent. Both generated concept-19 thumbs are too + short despite their otherwise useful long-list demonstrations. +- Reserve a clear brand field at the far left of the faceplate and optically + center =Dupre= within that invisible rectangle. All functional controls stay + outside it. +- Immediately right of the brand field, stack =NAME=, =TAG=, and =ON AIR= in a + narrow vertical Radio column, right-justified tightly against an even smaller + 2×2 Play Modes block. Volume retains the quiet right-hand field. +- Transport state is symbol-only illumination. The area beneath every key is + plain faceplate plus its engraved label; no amber strip, lamp, or glow. +- Stress-test metadata with realistic long values. Concept 20 uses =A CHICKEN + WITH ITS HEAD CUT OFF= / =THE MAGNETIC FIELDS= and the 69-track =69 LOVE SONGS= + list without marquee or truncation. +- Review normal and live states together by composing their independently + generated panoramic sources. This preserves the true bottom-dock form factor + while making both states simultaneously visible. +- Concept 20's scrollbar rendering remains non-authoritative: the 14/69 playlist + thumb should be 20 percent, and the 14/18 radio thumb should be 78 percent and + clearly visible. The image model made the former too short and omitted the + latter's filled thumb. +- Live playback contains exactly two =ON AIR= presentations: a red bottom-most + metadata line and the current station row. Remove the faceplate status window + and any centered banner or =LIVE STREAM= caption. +- The compact controls form a measured 3×2 grid above transport. Every small + control is half a transport key's width and equal to its height; stacked Radio + occupies column one and the 2×2 Play Modes block columns two and three. The + grid's right edge aligns with =NEXT=. +- Radio =NAME= and =TAG= are momentary search buttons with magnifying-glass + glyphs and no lamps. Persistent playback modes use a separate tiny status + lamp above a compact champagne/brass actuator, borrowing the Heston preset + language without numeric legends. +- Branding is a true faceplate aperture: champagne aluminum is cut away to + reveal a recessed dark woven/diamond-textured subplate with centered warm-white + cursive =Dupre=. It is not a badge attached atop the faceplate. +- =PLAY/PAUSE= glows green through its symbol while playing. Previous, Stop, and + Next stay neutral and merely brighten ivory during activation. +- Volume uses a deeply knurled black body and machined champagne/brass cap with no + pointer. The cumulative lamp arc is the sole indicator and its final lit + segment communicates the level. +- =ADD= and =NEW= may share a restrained OD-green anodized tint. =LOAD= and + =SAVE= remain neutral; =DELETE= remains matte red. +- Concept 21 again renders scrollbar fill incorrectly; the exact 20/78 percent + requirements remain implementation constraints rather than image guidance. +- Tone =DELETE= down from saturated red to muted, low-saturation oxblood or + burgundy. It remains unmistakably destructive without becoming the loudest + object in the application. +- Playback modes use four small circular brass pushbuttons mounted directly on + the metal. Remove the black switch tiles and separate lamps; illuminate only + a thin circumference around an active brass actuator. A single hairline + engraved boundary contains the 2×2 group and its geometry aligns with the + transport grid ending at =NEXT=. +- Split the lower player into two genuine material zones rather than stacking + branding plates. The left 28--32 percent is uninterrupted black woven grille + continuous with the chassis; center a restrained warm-ivory/champagne cursive + =Dupre= directly in that negative space with no border, plaque, or fasteners. + The right 68--72 percent is one compact self-contained champagne-anodized + control island containing Radio, Play Modes, transport, and Volume. +- Concept 22 validates this identity-bay/control-island architecture in matched + playlist and radio states. Its compact balance is authoritative; the image + model's engraved Play Modes boundary does not yet reach the =NEXT= alignment + datum, so the exact grid alignment remains an implementation constraint. +- Lock the concept-22 champagne faceplate and every component mounted on it: + Radio keys, direct-mounted brass Play Modes matrix and engraved boundary, + pointerless cumulative Volume dial, transport keys, fasteners, typography, + materials, spacing, and illumination semantics. Subsequent exploration may + change surrounding glass and layout, but not this control component. +- Swap the information and identity zones. Put reduced album/station art and + separate-line metadata in the lower black-glass bay beside the locked + faceplate. Put =Dupre= directly on the upper black glass with no backing + texture, beside substantially larger VU meters. +- Light each VU face with a subtle warm pool rising from a hidden lamp directly + below its =VU= legend. The fixture is not visible; it only explains the + meter's restrained internal illumination. +- Give the player approximately 49 percent of total width and the list 51 + percent. Keep fourteen rows; ellipsize only the title/artist field when it + exceeds its allocation, while preserving the row number, current-state marker, + duration, and live status. +- In radio state, place the first approved =ON AIR= directly underneath the + reduced station art. The second remains in the active station row; all + inactive status cells are empty. Concept 23 is authoritative for this + swapped-information arrangement. +- Divide the player itself into two equal-height tiers. The upper tier is one + continuous black-glass identity/information display; =Dupre= stays at far left + while reduced art, separate-line metadata, and conditional seek information + occupy the remaining width. +- The lower tier is one uninterrupted full-width champagne-brass faceplate, not + a small plate stacked over another material. Recess modest dual VU meters + into its left side and integrate the locked Radio, Play Modes, Volume, and + transport hardware on its right with proportional spacing. +- Return the VU meters to approximately concept-22 scale or slightly smaller. + They are black instrument windows with narrow chrome bezels physically set + into the brass; their concealed lower lamps remain a soft wash rather than a + visible point source. +- Concept 24 demonstrates this full-brass lower tier in matched playlist and + radio states. State-dependent information changes only in the upper glass + and control illumination; the underlying manufactured unit is identical. +- Remove fasteners and corner radii from every interior surface. The upper + information glass, lower brass faceplate, and right playlist are three flush + rectangular fields separated only by one horizontal and one vertical rule. + Rounded depth remains exclusively in the outer leather/chrome chassis. +- Align the left edge of album or station art exactly with the left edge of the + stacked Radio buttons below. This is a shared vertical datum and reserves a + larger uninterrupted field for =Dupre=. Confine local seek time, line, and + handle to the information block beginning at that datum; nothing extends + beneath the wordmark. Live =ON AIR= occupies the corresponding position below + station art without a seek affordance. +- Render ordinary album metadata and inactive list rows in soft neutral white. + Amber is reserved for the list header/rule and the currently selected row; + inactive rows have no lamps, glow, dots, or amber tint. +- VU windows are flush or slightly recessed apertures in the brass, with only a + hairline inlaid edge and inner shadow. They must never read as raised boxes or + chrome housings attached to the faceplate. +- Concept 25 demonstrates the seamless square-panel and white-type direction. + The image generator still places art left of the Radio datum despite a + targeted correction; exact shared-edge alignment remains authoritative for + the implemented SVG. +- Reintroduce rounded depth selectively rather than through internal cards. The + two-step chrome trim encircling the complete unit has clearly rounded corners, + and the flush VU apertures may use modest rounded corners. +- Rename the maker signature to a two-line =Dupre Studios=: large cursive + =Dupre= above smaller widely tracked uppercase =STUDIOS=, centered as one + optical lockup directly on the black glass. +- Move album/station art, metadata, and the conditional seek/live treatment + farther right to enlarge the calm manufacturer field. +- Remove the upper vertical player/list separator entirely. Branding, program + information, and playlist share one continuous black-glass plane; header rules + and column alignment alone establish list hierarchy. +- Define the lower brass faceplate as a distinct receiver module without adding + fasteners: a narrow recessed dark groove followed by slim deep chrome encircles + all four sides of the brass. Its surround uses graceful rounded corners while + the single brass field remains uninterrupted. +- Concept 26 demonstrates the =Dupre Studios= lockup, continuous upper glass, + rounded outer chrome, rounded flush VU apertures, and fully encircled brass + control module in matched playlist and radio states. +- Remove the complete unit's outer metal trim. The exterior silhouette is a + softly rolled black-leather edge; the leather terminates directly against the + continuous black glass through a narrow compressed dark seam, with no metal + between those materials. +- Convert every remaining metal edge from chrome to warm brass. This includes + the bead encircling the lower faceplate and the hairline rounded VU aperture + edges. No silver/chrome edging remains anywhere. +- The artwork, stacked Radio keys, and =PREV= transport key share one exact left + edge. Treat this as a single vertical construction datum; the seek assembly + begins there as well and remains below only the art/metadata block. +- Make only the playlist/radio header row an analog instrument card: darker + coffee-and-cream stock behind glass with dark espresso lettering. Four hidden + warm lamps above it—one at each corner and two evenly spaced between—cast + broad subtle pools downward. Neither bulbs nor hotspots are visible, and all + list rows below remain black with white/selected-amber type. +- Concept 27 demonstrates the leather-to-glass junction, brass-only edging, and + analog illuminated header in matched playlist/radio states. Its artwork is + visually close to the control datum; implementation must make the shared edge + mathematically exact. +- Adopt Craig's GIMP faceplate composition as the control-layout authority. + Divide usable brass width into approximately 44/25/31 percent zones: dual VUs + over transport at left, Play Modes over a horizontal Name/Tag Radio pair at + center, and Volume vertically centered at right. Use shared baselines, + consistent label offsets, and even component gaps so the plate is full without + crowding. +- The four transport keys span roughly the combined width of the two VUs and sit + directly beneath them. The center controls form two aligned modules: 2×2 + direct-mounted brass modes above and two black radio search keys below. +- Increase the Volume control to the diameter in Craig's GIMP arrangement, but + make it a low-profile frontal instrument: shallow knurled skirt, broad flush + machined brass cap, minimal shadow, and no domed, magnified, or fisheye look. + Center the complete knob/arc vertically and put =VOLUME= beneath it. +- Volume lamps return to unmistakable warm amber/gold. Cumulative lit segments + must never wash out to white, cream, coral, or pink; unlit segments remain + dark. +- Concept 28 demonstrates the proportional three-zone control layout and flatter + enlarged Volume dial in matched playlist and radio states. +- Finalize the program-information construction line by moving the artwork and + all metadata right as one rigid group until the artwork's left edge is exactly + collinear with the left engraved boundary of the Radio group below. The local + seek treatment begins on that same datum: move its left time and left endpoint + with the information group, keep its right time and endpoint fixed, and shorten + the run accordingly. +- The circular seek thumb is warm polished brass, not chrome or silver. Its + restrained highlight may distinguish it from the amber progress line without + introducing a cold-metal exception to the brass-only material language. +- Treat Craig's manually refined 1916×821 playlist board, saved as + =concepts/30a-dupre-studios-user-refined-playlist.png=, as the near-final + visual authority. It resolves the upper-panel composition: the larger calm + =Dupre Studios= field, right-shifted artwork and separate metadata lines, a + contained shorter seek run with brass thumb, and a playlist-dominant right + side all coexist without crowding. +- Preserve the board's proportional lower deck: paired illuminated VUs and one + coherent transport family at left, compact direct-mounted Play Modes and Radio + Search controls in the center, and the large vertically centered low-profile + Volume instrument at right. + +* Concept 14 Review Notes + +The four matching jeweled latching mode buttons, simplified two-step chrome +bezel, fourteen-row playlist, explicit playlist name, one-line track rows, and +clearly labeled action keys move the design toward the selected language. The +board still contains three image-generation errors that are not design changes: + +- The player remains wider than the playlist instead of the required 42/58 + allocation. +- The volume arc stays illuminated beyond the knob pointer instead of ending at + and including the pointer-aligned segment. +- =COLUMBIA= and =1959= share a line instead of occupying separate conditional + metadata lines. diff --git a/working/music-svg-app-design/assets/vinyl-placeholder.svg b/working/music-svg-app-design/assets/vinyl-placeholder.svg new file mode 100644 index 00000000..cf01519f --- /dev/null +++ b/working/music-svg-app-design/assets/vinyl-placeholder.svg @@ -0,0 +1,20 @@ +<svg xmlns="http://www.w3.org/2000/svg" width="300" height="300" viewBox="0 0 300 300" role="img" aria-label="Vinyl record placeholder"> + <defs> + <radialGradient id="disc" cx="50%" cy="50%" r="50%"> + <stop offset="0%" stop-color="#1a1a1a"/> + <stop offset="100%" stop-color="#000000"/> + </radialGradient> + </defs> + <circle cx="150" cy="150" r="148" fill="url(#disc)"/> + <g fill="none" stroke="#2b2b2b" stroke-width="1"> + <circle cx="150" cy="150" r="138"/> + <circle cx="150" cy="150" r="126"/> + <circle cx="150" cy="150" r="114"/> + <circle cx="150" cy="150" r="102"/> + <circle cx="150" cy="150" r="90"/> + <circle cx="150" cy="150" r="78"/> + </g> + <circle cx="150" cy="150" r="52" fill="#d99a2b"/> + <circle cx="150" cy="150" r="52" fill="none" stroke="#a8741a" stroke-width="2"/> + <circle cx="150" cy="150" r="7" fill="#111111"/> +</svg> diff --git a/working/music-svg-app-design/concept-board.html b/working/music-svg-app-design/concept-board.html new file mode 100644 index 00000000..378d13ea --- /dev/null +++ b/working/music-svg-app-design/concept-board.html @@ -0,0 +1,25 @@ +<!doctype html> +<html lang="en"> +<head> +<meta charset="utf-8"> +<meta name="viewport" content="width=device-width,initial-scale=1"> +<title>Music SVG application — high-fidelity concept boards</title> +<style> +:root{color-scheme:dark;--bg:#0c0b0a;--panel:#151310;--ink:#eee3c8;--dim:#97938a;--gold:#e7aa3f;--line:#40351f} +*{box-sizing:border-box}body{margin:0;background:radial-gradient(ellipse at top,#282014 0,transparent 38%),var(--bg);color:var(--ink);font:14px/1.5 "BerkeleyMono Nerd Font","Berkeley Mono",monospace} +header{max-width:1500px;margin:auto;padding:28px 24px 18px}h1{margin:4px 0 8px;color:var(--gold);font:500 clamp(24px,4vw,44px) Georgia,serif}.eyebrow{color:var(--dim);font-size:11px;letter-spacing:.22em;text-transform:uppercase}p{max-width:880px;color:var(--dim)} +main{max-width:1500px;margin:auto;padding:0 24px 70px;display:grid;gap:28px}.board{border:1px solid var(--line);border-radius:14px;overflow:hidden;background:var(--panel);box-shadow:0 18px 50px #0009}.board img{display:block;width:100%;height:auto}.caption{display:flex;gap:18px;align-items:baseline;padding:13px 17px;border-top:1px solid var(--line)}.num{color:var(--gold)}h2{font-size:15px;letter-spacing:.08em;margin:0;font-weight:500}.hint{margin-left:auto;color:var(--dim);font-size:11px}@media(max-width:700px){header,main{padding-left:12px;padding-right:12px}.caption{align-items:flex-start;flex-wrap:wrap}.hint{width:100%;margin:0}} +</style> +</head> +<body> +<header><div class="eyebrow">Music SVG application · material-design pass</div><h1>Six instruments worth living with</h1><p>Judge the silhouette, material palette, visual hierarchy, and behavior metaphors. Typography is illustrative; implementation will use the actual Dupre kit and SVG-safe primitives.</p></header> +<main> +<article class="board"><img src="concepts/01-champagne-receiver.png" alt="Champagne Receiver music application"><div class="caption"><span class="num">01</span><h2>Champagne Receiver</h2><span class="hint">hi-fi receiver · blue glass · walnut · moving-coil VU</span></div></article> +<article class="board"><img src="concepts/02-le-mans-night-cluster.png" alt="Le Mans Night Cluster music application"><div class="caption"><span class="num">02</span><h2>Le Mans Night Cluster</h2><span class="hint">grand tourer · leather · chrome gauges · tell-tales</span></div></article> +<article class="board"><img src="concepts/03-geneva-playback-chronograph.png" alt="Geneva Playback Chronograph music application"><div class="caption"><span class="num">03</span><h2>Geneva Playback Chronograph</h2><span class="hint">guilloché · sapphire chapter ring · jeweled complications</span></div></article> +<article class="board"><img src="concepts/04-mastering-room-reel-console.png" alt="Mastering Room Reel Console music application"><div class="caption"><span class="num">04</span><h2>Mastering Room Reel Console</h2><span class="hint">reel-to-reel · brushed aluminum · VU glass · walnut rack</span></div></article> +<article class="board"><img src="concepts/05-perpetual-calendar-salon.png" alt="Perpetual Calendar Salon music application"><div class="caption"><span class="num">05</span><h2>Perpetual Calendar Salon</h2><span class="hint">rosewood · ivory enamel · apertures · moonphase record</span></div></article> +<article class="board"><img src="concepts/06-transatlantic-broadcast-navigator.png" alt="Transatlantic Broadcast Navigator music application"><div class="caption"><span class="num">06</span><h2>Transatlantic Broadcast Navigator</h2><span class="hint">black glass · chrome · frequency scale · radio radar</span></div></article> +</main> +</body> +</html> diff --git a/working/music-svg-app-design/concepts/01-champagne-receiver.png b/working/music-svg-app-design/concepts/01-champagne-receiver.png Binary files differnew file mode 100644 index 00000000..453ca9e3 --- /dev/null +++ b/working/music-svg-app-design/concepts/01-champagne-receiver.png diff --git a/working/music-svg-app-design/concepts/02-le-mans-night-cluster.png b/working/music-svg-app-design/concepts/02-le-mans-night-cluster.png Binary files differnew file mode 100644 index 00000000..f967f7f6 --- /dev/null +++ b/working/music-svg-app-design/concepts/02-le-mans-night-cluster.png diff --git a/working/music-svg-app-design/concepts/03-geneva-playback-chronograph.png b/working/music-svg-app-design/concepts/03-geneva-playback-chronograph.png Binary files differnew file mode 100644 index 00000000..3990e075 --- /dev/null +++ b/working/music-svg-app-design/concepts/03-geneva-playback-chronograph.png diff --git a/working/music-svg-app-design/concepts/04-mastering-room-reel-console.png b/working/music-svg-app-design/concepts/04-mastering-room-reel-console.png Binary files differnew file mode 100644 index 00000000..3d9ced49 --- /dev/null +++ b/working/music-svg-app-design/concepts/04-mastering-room-reel-console.png diff --git a/working/music-svg-app-design/concepts/05-perpetual-calendar-salon.png b/working/music-svg-app-design/concepts/05-perpetual-calendar-salon.png Binary files differnew file mode 100644 index 00000000..301bec21 --- /dev/null +++ b/working/music-svg-app-design/concepts/05-perpetual-calendar-salon.png diff --git a/working/music-svg-app-design/concepts/06-transatlantic-broadcast-navigator.png b/working/music-svg-app-design/concepts/06-transatlantic-broadcast-navigator.png Binary files differnew file mode 100644 index 00000000..148f573f --- /dev/null +++ b/working/music-svg-app-design/concepts/06-transatlantic-broadcast-navigator.png diff --git a/working/music-svg-app-design/concepts/07-functional-black-glass-receiver.png b/working/music-svg-app-design/concepts/07-functional-black-glass-receiver.png Binary files differnew file mode 100644 index 00000000..8be7cc89 --- /dev/null +++ b/working/music-svg-app-design/concepts/07-functional-black-glass-receiver.png diff --git a/working/music-svg-app-design/concepts/08-functional-black-glass-flipped.png b/working/music-svg-app-design/concepts/08-functional-black-glass-flipped.png Binary files differnew file mode 100644 index 00000000..404c7493 --- /dev/null +++ b/working/music-svg-app-design/concepts/08-functional-black-glass-flipped.png diff --git a/working/music-svg-app-design/concepts/09-functional-black-glass-retro.png b/working/music-svg-app-design/concepts/09-functional-black-glass-retro.png Binary files differnew file mode 100644 index 00000000..12893867 --- /dev/null +++ b/working/music-svg-app-design/concepts/09-functional-black-glass-retro.png diff --git a/working/music-svg-app-design/concepts/10-warm-black-glass-player-volume.png b/working/music-svg-app-design/concepts/10-warm-black-glass-player-volume.png Binary files differnew file mode 100644 index 00000000..ae1ed9f7 --- /dev/null +++ b/working/music-svg-app-design/concepts/10-warm-black-glass-player-volume.png diff --git a/working/music-svg-app-design/concepts/11-illuminated-black-glass-controls.png b/working/music-svg-app-design/concepts/11-illuminated-black-glass-controls.png Binary files differnew file mode 100644 index 00000000..df8ce658 --- /dev/null +++ b/working/music-svg-app-design/concepts/11-illuminated-black-glass-controls.png diff --git a/working/music-svg-app-design/concepts/12-consolidated-functional-receiver.png b/working/music-svg-app-design/concepts/12-consolidated-functional-receiver.png Binary files differnew file mode 100644 index 00000000..dc2ccab4 --- /dev/null +++ b/working/music-svg-app-design/concepts/12-consolidated-functional-receiver.png diff --git a/working/music-svg-app-design/concepts/13-black-silver-chronograph-receiver.png b/working/music-svg-app-design/concepts/13-black-silver-chronograph-receiver.png Binary files differnew file mode 100644 index 00000000..2fe1af0e --- /dev/null +++ b/working/music-svg-app-design/concepts/13-black-silver-chronograph-receiver.png diff --git a/working/music-svg-app-design/concepts/14-corrected-luxury-chronograph-receiver.png b/working/music-svg-app-design/concepts/14-corrected-luxury-chronograph-receiver.png Binary files differnew file mode 100644 index 00000000..c238a8f6 --- /dev/null +++ b/working/music-svg-app-design/concepts/14-corrected-luxury-chronograph-receiver.png diff --git a/working/music-svg-app-design/concepts/15-champagne-brass-digital-hifi.png b/working/music-svg-app-design/concepts/15-champagne-brass-digital-hifi.png Binary files differnew file mode 100644 index 00000000..7469c348 --- /dev/null +++ b/working/music-svg-app-design/concepts/15-champagne-brass-digital-hifi.png diff --git a/working/music-svg-app-design/concepts/16-champagne-aluminum-radio-groups.png b/working/music-svg-app-design/concepts/16-champagne-aluminum-radio-groups.png Binary files differnew file mode 100644 index 00000000..e15bb4c5 --- /dev/null +++ b/working/music-svg-app-design/concepts/16-champagne-aluminum-radio-groups.png diff --git a/working/music-svg-app-design/concepts/17-dupre-coltrane-scrollbar.png b/working/music-svg-app-design/concepts/17-dupre-coltrane-scrollbar.png Binary files differnew file mode 100644 index 00000000..9e9e948e --- /dev/null +++ b/working/music-svg-app-design/concepts/17-dupre-coltrane-scrollbar.png diff --git a/working/music-svg-app-design/concepts/18-dupre-branding-control-study.png b/working/music-svg-app-design/concepts/18-dupre-branding-control-study.png Binary files differnew file mode 100644 index 00000000..6826f613 --- /dev/null +++ b/working/music-svg-app-design/concepts/18-dupre-branding-control-study.png diff --git a/working/music-svg-app-design/concepts/19a-dupre-playlist-state.png b/working/music-svg-app-design/concepts/19a-dupre-playlist-state.png Binary files differnew file mode 100644 index 00000000..cb08988d --- /dev/null +++ b/working/music-svg-app-design/concepts/19a-dupre-playlist-state.png diff --git a/working/music-svg-app-design/concepts/19b-dupre-radio-state.png b/working/music-svg-app-design/concepts/19b-dupre-radio-state.png Binary files differnew file mode 100644 index 00000000..26f0ff9a --- /dev/null +++ b/working/music-svg-app-design/concepts/19b-dupre-radio-state.png diff --git a/working/music-svg-app-design/concepts/20-dupre-playlist-radio-comparison.png b/working/music-svg-app-design/concepts/20-dupre-playlist-radio-comparison.png Binary files differnew file mode 100644 index 00000000..60648503 --- /dev/null +++ b/working/music-svg-app-design/concepts/20-dupre-playlist-radio-comparison.png diff --git a/working/music-svg-app-design/concepts/20a-dupre-long-playlist.png b/working/music-svg-app-design/concepts/20a-dupre-long-playlist.png Binary files differnew file mode 100644 index 00000000..b4fb84a2 --- /dev/null +++ b/working/music-svg-app-design/concepts/20a-dupre-long-playlist.png diff --git a/working/music-svg-app-design/concepts/20b-dupre-compact-radio.png b/working/music-svg-app-design/concepts/20b-dupre-compact-radio.png Binary files differnew file mode 100644 index 00000000..42992161 --- /dev/null +++ b/working/music-svg-app-design/concepts/20b-dupre-compact-radio.png diff --git a/working/music-svg-app-design/concepts/21-dupre-semantic-controls-comparison.png b/working/music-svg-app-design/concepts/21-dupre-semantic-controls-comparison.png Binary files differnew file mode 100644 index 00000000..c86f1f59 --- /dev/null +++ b/working/music-svg-app-design/concepts/21-dupre-semantic-controls-comparison.png diff --git a/working/music-svg-app-design/concepts/21a-dupre-mode-lamps-playlist.png b/working/music-svg-app-design/concepts/21a-dupre-mode-lamps-playlist.png Binary files differnew file mode 100644 index 00000000..a18fdc8b --- /dev/null +++ b/working/music-svg-app-design/concepts/21a-dupre-mode-lamps-playlist.png diff --git a/working/music-svg-app-design/concepts/21b-dupre-two-on-air-radio.png b/working/music-svg-app-design/concepts/21b-dupre-two-on-air-radio.png Binary files differnew file mode 100644 index 00000000..70303bc2 --- /dev/null +++ b/working/music-svg-app-design/concepts/21b-dupre-two-on-air-radio.png diff --git a/working/music-svg-app-design/concepts/22-dupre-identity-bay-comparison.png b/working/music-svg-app-design/concepts/22-dupre-identity-bay-comparison.png Binary files differnew file mode 100644 index 00000000..c0e7d59a --- /dev/null +++ b/working/music-svg-app-design/concepts/22-dupre-identity-bay-comparison.png diff --git a/working/music-svg-app-design/concepts/22a-dupre-identity-bay-playlist.png b/working/music-svg-app-design/concepts/22a-dupre-identity-bay-playlist.png Binary files differnew file mode 100644 index 00000000..1ab38a42 --- /dev/null +++ b/working/music-svg-app-design/concepts/22a-dupre-identity-bay-playlist.png diff --git a/working/music-svg-app-design/concepts/22b-dupre-identity-bay-radio.png b/working/music-svg-app-design/concepts/22b-dupre-identity-bay-radio.png Binary files differnew file mode 100644 index 00000000..f752ed17 --- /dev/null +++ b/working/music-svg-app-design/concepts/22b-dupre-identity-bay-radio.png diff --git a/working/music-svg-app-design/concepts/23-dupre-swapped-info-comparison.png b/working/music-svg-app-design/concepts/23-dupre-swapped-info-comparison.png Binary files differnew file mode 100644 index 00000000..252ad160 --- /dev/null +++ b/working/music-svg-app-design/concepts/23-dupre-swapped-info-comparison.png diff --git a/working/music-svg-app-design/concepts/23a-dupre-swapped-info-playlist.png b/working/music-svg-app-design/concepts/23a-dupre-swapped-info-playlist.png Binary files differnew file mode 100644 index 00000000..f9df6b85 --- /dev/null +++ b/working/music-svg-app-design/concepts/23a-dupre-swapped-info-playlist.png diff --git a/working/music-svg-app-design/concepts/23b-dupre-swapped-info-radio.png b/working/music-svg-app-design/concepts/23b-dupre-swapped-info-radio.png Binary files differnew file mode 100644 index 00000000..e532e98e --- /dev/null +++ b/working/music-svg-app-design/concepts/23b-dupre-swapped-info-radio.png diff --git a/working/music-svg-app-design/concepts/24-dupre-full-brass-vu-comparison.png b/working/music-svg-app-design/concepts/24-dupre-full-brass-vu-comparison.png Binary files differnew file mode 100644 index 00000000..285ec95f --- /dev/null +++ b/working/music-svg-app-design/concepts/24-dupre-full-brass-vu-comparison.png diff --git a/working/music-svg-app-design/concepts/24a-dupre-full-brass-vu-playlist.png b/working/music-svg-app-design/concepts/24a-dupre-full-brass-vu-playlist.png Binary files differnew file mode 100644 index 00000000..59dd8109 --- /dev/null +++ b/working/music-svg-app-design/concepts/24a-dupre-full-brass-vu-playlist.png diff --git a/working/music-svg-app-design/concepts/24b-dupre-full-brass-vu-radio.png b/working/music-svg-app-design/concepts/24b-dupre-full-brass-vu-radio.png Binary files differnew file mode 100644 index 00000000..9a0bde44 --- /dev/null +++ b/working/music-svg-app-design/concepts/24b-dupre-full-brass-vu-radio.png diff --git a/working/music-svg-app-design/concepts/25-dupre-seamless-flush-comparison.png b/working/music-svg-app-design/concepts/25-dupre-seamless-flush-comparison.png Binary files differnew file mode 100644 index 00000000..049d1dd3 --- /dev/null +++ b/working/music-svg-app-design/concepts/25-dupre-seamless-flush-comparison.png diff --git a/working/music-svg-app-design/concepts/25a-dupre-seamless-flush-playlist.png b/working/music-svg-app-design/concepts/25a-dupre-seamless-flush-playlist.png Binary files differnew file mode 100644 index 00000000..16063222 --- /dev/null +++ b/working/music-svg-app-design/concepts/25a-dupre-seamless-flush-playlist.png diff --git a/working/music-svg-app-design/concepts/25b-dupre-seamless-flush-radio.png b/working/music-svg-app-design/concepts/25b-dupre-seamless-flush-radio.png Binary files differnew file mode 100644 index 00000000..4fdbbbb8 --- /dev/null +++ b/working/music-svg-app-design/concepts/25b-dupre-seamless-flush-radio.png diff --git a/working/music-svg-app-design/concepts/26-dupre-studios-rounded-chrome-comparison.png b/working/music-svg-app-design/concepts/26-dupre-studios-rounded-chrome-comparison.png Binary files differnew file mode 100644 index 00000000..ed067d99 --- /dev/null +++ b/working/music-svg-app-design/concepts/26-dupre-studios-rounded-chrome-comparison.png diff --git a/working/music-svg-app-design/concepts/26a-dupre-studios-rounded-chrome-playlist.png b/working/music-svg-app-design/concepts/26a-dupre-studios-rounded-chrome-playlist.png Binary files differnew file mode 100644 index 00000000..b086886d --- /dev/null +++ b/working/music-svg-app-design/concepts/26a-dupre-studios-rounded-chrome-playlist.png diff --git a/working/music-svg-app-design/concepts/26b-dupre-studios-rounded-chrome-radio.png b/working/music-svg-app-design/concepts/26b-dupre-studios-rounded-chrome-radio.png Binary files differnew file mode 100644 index 00000000..dce2f048 --- /dev/null +++ b/working/music-svg-app-design/concepts/26b-dupre-studios-rounded-chrome-radio.png diff --git a/working/music-svg-app-design/concepts/27-dupre-studios-leather-analog-header-comparison.png b/working/music-svg-app-design/concepts/27-dupre-studios-leather-analog-header-comparison.png Binary files differnew file mode 100644 index 00000000..603aa5a0 --- /dev/null +++ b/working/music-svg-app-design/concepts/27-dupre-studios-leather-analog-header-comparison.png diff --git a/working/music-svg-app-design/concepts/27a-dupre-studios-leather-analog-header-playlist.png b/working/music-svg-app-design/concepts/27a-dupre-studios-leather-analog-header-playlist.png Binary files differnew file mode 100644 index 00000000..288ad19b --- /dev/null +++ b/working/music-svg-app-design/concepts/27a-dupre-studios-leather-analog-header-playlist.png diff --git a/working/music-svg-app-design/concepts/27b-dupre-studios-leather-analog-header-radio.png b/working/music-svg-app-design/concepts/27b-dupre-studios-leather-analog-header-radio.png Binary files differnew file mode 100644 index 00000000..c02286a2 --- /dev/null +++ b/working/music-svg-app-design/concepts/27b-dupre-studios-leather-analog-header-radio.png diff --git a/working/music-svg-app-design/concepts/28-dupre-studios-balanced-controls-comparison.png b/working/music-svg-app-design/concepts/28-dupre-studios-balanced-controls-comparison.png Binary files differnew file mode 100644 index 00000000..1e8199f9 --- /dev/null +++ b/working/music-svg-app-design/concepts/28-dupre-studios-balanced-controls-comparison.png diff --git a/working/music-svg-app-design/concepts/28a-dupre-studios-balanced-controls-playlist.png b/working/music-svg-app-design/concepts/28a-dupre-studios-balanced-controls-playlist.png Binary files differnew file mode 100644 index 00000000..ee329bea --- /dev/null +++ b/working/music-svg-app-design/concepts/28a-dupre-studios-balanced-controls-playlist.png diff --git a/working/music-svg-app-design/concepts/28b-dupre-studios-balanced-controls-radio.png b/working/music-svg-app-design/concepts/28b-dupre-studios-balanced-controls-radio.png Binary files differnew file mode 100644 index 00000000..516f555f --- /dev/null +++ b/working/music-svg-app-design/concepts/28b-dupre-studios-balanced-controls-radio.png diff --git a/working/music-svg-app-design/concepts/29a-dupre-studios-brass-seek-playlist.png b/working/music-svg-app-design/concepts/29a-dupre-studios-brass-seek-playlist.png Binary files differnew file mode 100644 index 00000000..20871536 --- /dev/null +++ b/working/music-svg-app-design/concepts/29a-dupre-studios-brass-seek-playlist.png diff --git a/working/music-svg-app-design/concepts/29a-dupre-studios-brass-seek-playlist.xcf b/working/music-svg-app-design/concepts/29a-dupre-studios-brass-seek-playlist.xcf Binary files differnew file mode 100644 index 00000000..9691728b --- /dev/null +++ b/working/music-svg-app-design/concepts/29a-dupre-studios-brass-seek-playlist.xcf diff --git a/working/music-svg-app-design/concepts/30a-dupre-studios-user-refined-playlist.png b/working/music-svg-app-design/concepts/30a-dupre-studios-user-refined-playlist.png Binary files differnew file mode 100644 index 00000000..50dae41b --- /dev/null +++ b/working/music-svg-app-design/concepts/30a-dupre-studios-user-refined-playlist.png diff --git a/working/music-svg-app-design/music-svg-directions.html b/working/music-svg-app-design/music-svg-directions.html new file mode 100644 index 00000000..07b0456e --- /dev/null +++ b/working/music-svg-app-design/music-svg-directions.html @@ -0,0 +1,35 @@ +<!doctype html> +<html lang="en"> +<head> +<meta charset="utf-8"> +<meta name="viewport" content="width=device-width, initial-scale=1"> +<title>Music SVG application — six directions</title> +<style> +:root{--ground:#151311;--panel:#100f0f;--raise:#1a1917;--well:#090a0b;--cream:#f3e7c5;--steel:#969385;--dim:#6f7478;--gold:#e2a038;--goldhi:#ffbe54;--amber:#f0b552;--green:#7fe0a0;--red:#e2543f;--line:#393226;--mono:"BerkeleyMono Nerd Font","Berkeley Mono",monospace}*{box-sizing:border-box}body{margin:0;background:radial-gradient(ellipse at 50% -20%,#302818 0,transparent 55%),var(--ground);color:var(--cream);font:14px/1.35 var(--mono)}header{padding:20px max(20px,calc((100vw - 1320px)/2));border-bottom:1px solid var(--line);background:#100f0fdd;position:sticky;top:0;z-index:4;backdrop-filter:blur(12px)}.eyebrow{color:var(--steel);font-size:10px;letter-spacing:.22em;text-transform:uppercase}.head{display:flex;gap:20px;align-items:end;justify-content:space-between;flex-wrap:wrap}.head h1{font-size:22px;color:var(--goldhi);margin:3px 0}.head p{max-width:640px;margin:0;color:var(--steel)}.tabs{display:flex;gap:6px;flex-wrap:wrap}.tabs button,.button{font:inherit;color:var(--steel);background:var(--raise);border:1px solid var(--line);border-radius:5px;padding:7px 9px;cursor:pointer}.tabs button:hover,.tabs button.on,.button:hover{color:var(--panel);background:var(--gold);border-color:var(--goldhi)}main{max-width:1320px;margin:auto;padding:28px 20px 60px}.note{color:var(--steel);margin:0 0 14px}.concept{display:none;min-height:650px}.concept.on{display:block}.face{min-height:640px;padding:20px;border:1px solid #5d471d;border-radius:16px;background:linear-gradient(135deg,#211b12,#0b0b0b 45%,#19150f);box-shadow:inset 0 1px #ffffff13,0 18px 55px #0008;position:relative;overflow:hidden}.face:before,.face:after{content:"";position:absolute;left:16px;right:16px;height:2px;background:linear-gradient(90deg,transparent,var(--gold),var(--goldhi),var(--gold),transparent);opacity:.9}.face:before{top:11px}.face:after{bottom:11px}.label{color:var(--gold);font-size:10px;letter-spacing:.18em;text-transform:uppercase}.well{background:linear-gradient(#060707,#121313);border:1px solid #342b1b;border-radius:8px;box-shadow:inset 0 2px 12px #000;padding:13px}.screen{color:var(--green);text-shadow:0 0 8px #7fe0a077}.title{font:600 clamp(20px,3vw,38px) Georgia,serif;color:var(--cream)}.sub{color:var(--steel)}.gold{color:var(--goldhi)}.lamp{display:inline-block;width:9px;height:9px;border-radius:100%;background:#312818;border:1px solid #6b5223}.lamp.on{background:var(--goldhi);box-shadow:0 0 12px #ffbe54}.lamp.live{background:var(--green);box-shadow:0 0 12px #7fe0a0}.lamp.warn{background:var(--red);box-shadow:0 0 12px #e2543f}.transport{display:flex;gap:8px;align-items:center;justify-content:center}.transport button{width:46px;height:39px;border-radius:6px;border:1px solid #685025;background:linear-gradient(#3a2e1c,#17130d);color:var(--goldhi);font:18px var(--mono);cursor:pointer}.transport button.play{background:linear-gradient(#f0c46c,#8f671f);color:#181109}.transport button:active{transform:translateY(1px);filter:brightness(1.2)}.queue{display:grid;gap:4px}.track{display:grid;grid-template-columns:30px 1fr auto;gap:10px;align-items:center;padding:7px 8px;border-bottom:1px solid #ffffff0b;cursor:pointer}.track:hover,.track.current{background:#e2a03818}.track.current{border-left:3px solid var(--goldhi)}.track .num{color:var(--gold)}.track .meta{color:var(--steel);font-size:11px}.progress{height:7px;background:#28221a;border:1px solid #554321;border-radius:8px;overflow:hidden}.progress i{display:block;height:100%;width:42%;background:linear-gradient(90deg,#8f671f,var(--goldhi),#fff0af);box-shadow:0 0 8px var(--goldhi)}.presets{display:flex;gap:6px;flex-wrap:wrap}.preset{padding:5px 8px;border:1px solid #49391e;border-radius:20px;background:#17130e;color:var(--steel);cursor:pointer}.preset.on{color:var(--panel);background:var(--goldhi)}.knob{width:84px;height:84px;border:8px solid #5c4319;border-radius:50%;background:radial-gradient(circle at 38% 30%,#ffe0a0,#b77b27 45%,#3d2b13 68%);position:relative;box-shadow:0 3px 8px #000}.knob:after{content:"";position:absolute;width:3px;height:27px;background:#1b1308;top:8px;left:38px;border-radius:2px;transform:rotate(32deg);transform-origin:50% 34px}.gauge{width:230px;height:126px;overflow:hidden;position:relative}.gauge svg{width:230px;height:230px;position:absolute;bottom:-104px}.gauge b{position:absolute;bottom:7px;left:0;right:0;text-align:center;color:var(--goldhi);font-size:24px}.svg{width:100%;height:100%}.caption{margin-top:13px;color:var(--steel);font-size:12px}.pinstripe{display:grid;grid-template-columns:minmax(240px,1.1fr) minmax(360px,1.8fr) minmax(240px,1fr);gap:16px;align-items:stretch}.odometer{font-size:clamp(27px,5vw,58px);letter-spacing:.12em;color:#17120a;background:var(--cream);border:3px solid var(--gold);padding:10px 14px;border-radius:6px;box-shadow:inset 0 -5px #b9a988}.dashboard{display:grid;grid-template-columns:1fr minmax(340px,1.45fr) 1fr;gap:18px;align-items:center}.dash-center{text-align:center}.dial{width:min(100%,310px);aspect-ratio:1;margin:auto;border:10px solid #30343a;border-radius:50%;background:radial-gradient(circle,#171611 0 52%,transparent 53%),repeating-conic-gradient(from 225deg,#d59a36 0 1deg,transparent 1deg 7deg);position:relative}.dial:after{content:"";position:absolute;left:50%;bottom:50%;width:3px;height:36%;background:var(--red);transform-origin:bottom;transform:rotate(42deg);box-shadow:0 0 8px #e2543f}.dial .dialtext{position:absolute;inset:0;display:grid;place-content:center;text-align:center;color:var(--goldhi)}.chronometer{display:grid;grid-template-columns:minmax(260px,1fr) minmax(280px,1fr);gap:22px}.chrono{border-radius:50%;aspect-ratio:1;max-width:440px;margin:auto;border:12px double var(--gold);background:repeating-radial-gradient(circle,#15110c 0 5px,#1f1910 6px 7px);position:relative;display:grid;place-content:center;text-align:center}.chrono:before{content:"";position:absolute;inset:13px;border:1px solid #c28b2c;border-radius:50%;background:repeating-conic-gradient(#d69b38 0 1deg,transparent 1deg 6deg)}.chrono>*{position:relative}.time{font-size:clamp(34px,6vw,66px);letter-spacing:.05em;color:var(--cream)}.rack{display:grid;grid-template-columns:190px 1fr 210px;gap:14px}.vu{display:flex;gap:7px;align-items:end;height:110px}.vu i{width:12px;background:linear-gradient(var(--red) 0 18%,var(--goldhi) 18% 50%,var(--green) 50%);border-radius:2px;box-shadow:0 0 6px #7fe0a066}.vu i:nth-child(1){height:28%}.vu i:nth-child(2){height:55%}.vu i:nth-child(3){height:38%}.vu i:nth-child(4){height:76%}.vu i:nth-child(5){height:92%}.vu i:nth-child(6){height:64%}.vu i:nth-child(7){height:48%}.calendar{display:grid;grid-template-columns:1fr 1.35fr 1fr;gap:16px}.apertures{display:grid;grid-template-columns:repeat(3,1fr);gap:8px}.aperture{padding:11px 5px;text-align:center;background:#080706;border:2px solid var(--gold);border-radius:5px;color:var(--cream);font-size:20px;box-shadow:inset 0 3px 10px #000}.radio{display:grid;grid-template-columns:1.1fr 1.5fr;gap:18px}.radar{aspect-ratio:1;max-width:370px;margin:auto;border:2px solid #4b742d;border-radius:50%;background:repeating-radial-gradient(circle,#102012 0 1px,transparent 2px 58px),linear-gradient(135deg,#07100a,#122d16);position:relative;overflow:hidden}.radar:before{content:"";position:absolute;inset:50% 0 0 50%;background:conic-gradient(from 15deg,#7fe0a088,transparent 55deg);transform-origin:0 0;animation:sweep 3s linear infinite}.radar:after{content:"• 104.9\A\A ◉ \A\A •";white-space:pre;position:absolute;inset:30px;color:var(--green);font-size:20px;text-shadow:0 0 8px var(--green)}@keyframes sweep{to{transform:rotate(360deg)}}@media(max-width:900px){.pinstripe,.dashboard,.rack,.calendar,.chronometer,.radio{grid-template-columns:1fr}.face{min-height:auto}.gauge{margin:auto}} +</style> +</head> +<body> +<header><div class="head"><div><div class="eyebrow">Music SVG application · six functional directions</div><h1>Which instrument do you want to live with?</h1><p>Every direction drives the same player state: transport, queue selection, radio preset, playback mode, and volume all respond.</p></div><nav class="tabs" id="tabs"></nav></div></header> +<main><p class="note" id="note"></p><div id="stage"></div></main> +<script> +const state={playing:true,track:0,volume:68,preset:'Groove Salad',modes:{repeat:false,random:false,consume:false}}; +const tracks=[['Groove Salad','SomaFM · 256k','◉'],['Blue in Green','Miles Davis · 5:37','♪'],['Dawn Chorus','Tycho · 4:21','♪'],['Drone Zone','SomaFM · 128k','◉'],['Night Drive','Chromatics · 4:06','♪']]; +const names=['Gold-pinstripe tuner','Touring-car dashboard','Chronometer record deck','Studio rack','Perpetual-calendar salon','Radio navigator']; +const notes=['One machined faceplate: the clearest bridge to Waybar direction 1. A tape-counter queue and a brass volume knob make library work feel deliberate.','A driving instrument cluster: progress becomes speed, queue position becomes odometer, and state becomes a small set of unmistakable tell-tales.','A timepiece that treats playback as elapsed time. Best for focused listening: transport is controlled from the bezel and the queue becomes a program card.','A tactile late-70s receiver: VU meters make audio activity visible, while a rack layout gives playlist and library controls equal status.','A restrained horological receiver: album/stream art sits beside calendar-like status apertures. Best if the music panel should feel like a dressed object, not a machine.','A green-phosphor tuner/navigation station: radio discovery takes center stage, with stations as signals and playlists as routes.']; +function controls(){return `<div class="transport"><button data-action="prev">‹‹</button><button class="play" data-action="play">${state.playing?'Ⅱ':'▶'}</button><button data-action="next">››</button><button data-action="seek">↶</button><button data-action="library">☰</button></div>`} +function queue(){return `<div class="queue">${tracks.map((t,i)=>`<div class="track ${i===state.track?'current':''}" data-track="${i}"><span class="num">${String(i+1).padStart(2,'0')}</span><span>${t[2]} ${t[0]}<br><span class="meta">${t[1]}</span></span><span class="lamp ${i===state.track?'live':''}"></span></div>`).join('')}</div>`} +function modes(){return `<div class="presets"><span class="preset ${state.modes.repeat?'on':''}" data-mode="repeat">repeat</span><span class="preset ${state.modes.random?'on':''}" data-mode="random">random</span><span class="preset ${state.modes.consume?'on':''}" data-mode="consume">consume</span></div>`} +function radioPresets(){return `<div class="presets">${['Groove Salad','Drone Zone','FIP','NTS 1'].map(x=>`<span class="preset ${x===state.preset?'on':''}" data-preset="${x}">${x}</span>`).join('')}</div>`} +function now(){let t=tracks[state.track];return `<div class="label">Now playing <span class="lamp ${state.playing?'live':''}"></span></div><div class="title">${t[0]}</div><div class="sub">${t[1]} · ${state.playing?'playing':'paused'}</div><div class="progress"><i style="width:${state.playing?42:13}%"></i></div>`} +function pinstripe(){return `<section class="concept pinstripe on"><div class="face"><div class="pinstripe"><div class="well"><div class="label">Program counter</div><div class="odometer">0${state.track+1}·24</div><p class="caption">Playlist position is a physical counter. The control bank below opens load, save, edit, and delete flows.</p>${modes()}</div><div class="well">${now()}<div style="height:12px"></div>${controls()}<div style="height:16px"></div><div class="label">Live queue</div>${queue()}</div><div class="well" style="display:grid;place-items:center;align-content:center;gap:12px"><div class="label">Volume</div><div class="knob" data-action="volume"></div><b class="gold">${state.volume}%</b><div class="label">Radio presets</div>${radioPresets()}</div></div><p class="caption">Direction 1 — gold pinstripe tuner console. Use as the base language if the player should visibly belong beside the Waybar odometer console.</p></div></section>`} +function dashboard(){return `<section class="concept dashboard"><div class="face"><div class="dashboard"><div class="well"><div class="label">Source / modes</div>${radioPresets()}<div style="height:18px"></div>${modes()}<div style="height:18px"></div><div class="label">Queue</div>${queue()}</div><div class="dash-center"><div class="dial"><div class="dialtext"><div class="label">elapsed</div><div style="font-size:42px">02:18</div><div class="gold">${state.track+1} / ${tracks.length}</div></div></div><div style="height:12px"></div>${controls()}<p class="caption">Needle position means playback progress. Lamps mean real state: green live, amber engaged, red fault or missing media.</p></div><div class="well"><div class="label">Signal and volume</div><div class="gauge"><svg viewBox="0 0 230 230"><path d="M28 172 A95 95 0 0 1 202 172" fill="none" stroke="#5d451e" stroke-width="16"/><path d="M28 172 A95 95 0 0 1 164 83" fill="none" stroke="#e2a038" stroke-width="10"/><line x1="115" y1="172" x2="153" y2="95" stroke="#ffbe54" stroke-width="4"/></svg><b>${state.volume}<small>%</small></b></div><div class="label">Tell-tales</div><p><span class="lamp live"></span> playing <span class="lamp on"></span> repeat <span class="lamp"></span> queue saved</p></div></div><p class="caption">Direction 2 — touring-car dashboard. Strongest one-glance state model; it turns progress, volume, queue position, and errors into instruments rather than labels.</p></div></section>`} +function chronometer(){return `<section class="concept chronometer"><div class="face"><div class="chronometer"><div class="chrono"><div class="label">${state.playing?'running':'held'} chronometer</div><div class="time">02:18</div><div class="sub">of 05:37</div><div style="margin-top:18px">${controls()}</div></div><div class="well">${now()}<div style="height:16px"></div><div class="label">Program card</div>${queue()}<div style="height:15px"></div><div class="label">Playback modes</div>${modes()}<div style="height:15px"></div><div class="label">Station bank</div>${radioPresets()}</div></div><p class="caption">Direction 3 — chronometer record deck. Playback time is the hero; a physical bezel is a compelling seek surface in the SVG port.</p></div></section>`} +function rack(){return `<section class="concept rack"><div class="face"><div class="rack"><div class="well"><div class="label">Input / source</div>${radioPresets()}<div style="height:15px"></div><div class="label">Program modes</div>${modes()}<div style="height:20px"></div><div class="label">Master</div><div class="knob" data-action="volume"></div><p class="gold">${state.volume}%</p></div><div class="well">${now()}<div style="height:18px"></div><div class="label">Stereo program</div><div class="vu">${Array.from({length:7},()=>'<i></i>').join('')}<span style="width:18px"></span>${Array.from({length:7},()=>'<i></i>').join('')}</div><div class="screen" style="margin:12px 0;padding:8px">L −8.1 dB R −7.8 dB ${state.playing?'SIGNAL':'HOLD'}</div>${controls()}</div><div class="well"><div class="label">Tape library / queue</div>${queue()}</div></div><p class="caption">Direction 4 — studio rack and tape machine. The VU meters are alive only while a track is playing; flashing or red meter states become a useful failure vocabulary.</p></div></section>`} +function calendar(){return `<section class="concept calendar"><div class="face"><div class="calendar"><div class="well"><div class="label">Library cabinet</div>${queue()}<div style="height:12px"></div><div class="label">File operations</div><div class="presets"><span class="preset">load</span><span class="preset">save</span><span class="preset">edit</span><span class="preset">delete</span></div></div><div class="well"><div class="label">Music perpetual calendar</div><div class="apertures"><div class="aperture">JAZZ</div><div class="aperture">SIDE A</div><div class="aperture">LIVE</div></div><div style="height:22px"></div>${now()}<div style="height:18px"></div>${controls()}<div style="height:18px"></div>${modes()}</div><div class="well"><div class="label">Station complications</div>${radioPresets()}<div style="height:18px"></div><div class="label">Volume winding</div><div class="knob" data-action="volume"></div><p class="gold">${state.volume}%</p></div></div><p class="caption">Direction 5 — perpetual-calendar dress. Gold-framed apertures make source, mode, and queue identity feel calm and ceremonial; reserve flashing for actual attention, never decoration.</p></div></section>`} +function navigator(){return `<section class="concept radio"><div class="face"><div class="radio"><div><div class="radar"></div><div class="caption" style="text-align:center">The sweep means an active radio discovery request. A fixed blip means a saved station; a pulsing blip means buffering or reconnecting.</div></div><div class="well"><div class="label">Tuner navigator</div>${now()}<div style="height:16px"></div>${controls()}<div style="height:16px"></div><div class="label">Stations</div>${radioPresets()}<div style="height:16px"></div><div class="label">Route / playlist</div>${queue()}<div style="height:16px"></div>${modes()}</div></div><p class="caption">Direction 6 — mission-control radio navigator. Best for elevating radio search, tag browsing, and saved stations to first-class interaction rather than hiding them behind a command row.</p></div></section>`} +const renders=[pinstripe,dashboard,chronometer,rack,calendar,navigator];let active=Math.max(0,Math.min(renders.length-1,Number(new URLSearchParams(location.search).get('direction'))||0)); +function render(){document.querySelector('#tabs').innerHTML=names.map((n,i)=>`<button class="${i===active?'on':''}" data-tab="${i}">${i+1}. ${n}</button>`).join('');document.querySelector('#stage').innerHTML=renders[active]();document.querySelector('#stage .concept').classList.add('on');document.querySelector('#note').textContent=notes[active];bind()} +function bind(){document.querySelectorAll('[data-tab]').forEach(e=>e.onclick=()=>{active=+e.dataset.tab;render()});document.querySelectorAll('[data-track]').forEach(e=>e.onclick=()=>{state.track=+e.dataset.track;render()});document.querySelectorAll('[data-preset]').forEach(e=>e.onclick=()=>{state.preset=e.dataset.preset;state.track=0;render()});document.querySelectorAll('[data-mode]').forEach(e=>e.onclick=()=>{state.modes[e.dataset.mode]=!state.modes[e.dataset.mode];render()});document.querySelectorAll('[data-action]').forEach(e=>e.onclick=()=>{let a=e.dataset.action;if(a==='play')state.playing=!state.playing;if(a==='next')state.track=(state.track+1)%tracks.length;if(a==='prev')state.track=(state.track+tracks.length-1)%tracks.length;if(a==='volume')state.volume=state.volume>82?35:state.volume+8;render()})}render(); +</script> +</body> +</html> diff --git a/working/music-svg-app-design/prototypes/2026-07-19-music-config-ui-remodel-benchmark.org b/working/music-svg-app-design/prototypes/2026-07-19-music-config-ui-remodel-benchmark.org new file mode 100644 index 00000000..7243ad5f --- /dev/null +++ b/working/music-svg-app-design/prototypes/2026-07-19-music-config-ui-remodel-benchmark.org @@ -0,0 +1,61 @@ +#+TITLE: Music Config UI Remodel Prototype Benchmark +#+DATE: 2026-07-19 + +* Purpose + +Measure the rasterization cost that matters for the proposed Emacs SVG port. +The interactive browser prototype proves behavior, but its DOM timings do not +predict librsvg cost. These trials use =rsvg-convert= 2.62.3 against embedded +raster/SVG fixtures at the intended roughly 958×411 dock size. + +The shell loop launched a fresh =rsvg-convert= process for each sample. Process +startup is therefore included, making these results a conservative bound for an +in-process Emacs/librsvg update. + +* Full instrument trial + +- Fixture: concept 30 embedded as a 3.0 MiB data URI, plus live metadata, + playlist rows, progress, VU needles, and volume segments. +- Output: 958×411. +- Duration: 60 seconds. +- Samples: 448. +- Mean: 134.074 ms. +- Median: 133.616 ms. +- 95th percentile: 139.822 ms. +- Range: 125.105–163.231 ms. +- Verdict: fail. A full receiver rasterization cannot drive ten-Hz VU motion. + +* Lower-deck tile trial + +- Fixture: the opaque lower control deck exported at its 585×226 display size + as JPEG quality 88, embedded as a 52 KiB data URI, plus two dynamic needles + and twenty-one dynamic volume segments. +- Output: 585×226. +- Duration: 60 seconds. +- Samples: 1,677. +- Mean: 35.694 ms. +- Median: 35.513 ms. +- 95th percentile: 38.221 ms. +- Range: 31.719–62.626 ms. +- Verdict: pass. Both the under-50-ms median and under-100-ms p95 budgets pass. + +* Resulting implementation constraint + +The production view uses three aligned image regions from one coordinate +manifest: + +1. Upper player glass, redrawn for track, art, seek, and radio-state changes. +2. Lower control deck, redrawn at meter cadence while visible and playing. +3. Playlist, redrawn for queue, selection, and scroll changes. + +The editable neutral source remains lossless and full resolution. The opaque +runtime deck export is sized for the normal dock and may use a high-quality JPEG +after visual comparison with PNG; it is not the editable source. A wider dock +may select a larger cached export, but V1 never returns to full-instrument +meter-rate rasterization. + +* Related artifacts + +- [[file:2026-07-19-music-config-ui-remodel-prototype-1.html][Functional browser prototype]] +- [[file:../2026-07-19-music-config-ui-remodel-render-fixture.svg][Full-render SVG fixture]] +- [[file:../2026-07-19-music-config-ui-remodel-spec.org][Music Config UI Remodel spec]] diff --git a/working/music-svg-app-design/prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html b/working/music-svg-app-design/prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html new file mode 100644 index 00000000..c05a6947 --- /dev/null +++ b/working/music-svg-app-design/prototypes/2026-07-19-music-config-ui-remodel-prototype-1.html @@ -0,0 +1,1450 @@ +<!doctype html> +<html lang="en"> +<head> +<meta charset="utf-8"> +<meta name="viewport" content="width=device-width, initial-scale=1"> +<title>Dupre Studios Music Config UI Remodel</title> +<style> + :root { + --black: #050605; + --glass: #090a09; + --soft-white: #e9e2d3; + --dim-white: #a9a59c; + --amber: #f2a900; + --amber-hot: #ffc34f; + --green: #9dda59; + --red: #a73a29; + --brass: #c9a574; + --coffee: #b69c7d; + --ink: #201810; + --mono: "Berkeley Mono", "BerkeleyMono Nerd Font", ui-monospace, monospace; + } + + * { box-sizing: border-box; } + + [hidden] { display: none !important; } + + html, body { min-height: 100%; } + + body { + margin: 0; + color: var(--soft-white); + background: + radial-gradient(circle at 50% -20%, #2c261e 0, transparent 42%), + linear-gradient(#0e0e0d, #050505 70%); + font-family: var(--mono); + } + + button, input { font: inherit; } + + .workbench { + width: min(100%, 1960px); + margin: 0 auto; + padding: 16px 20px 28px; + } + + .prototype-bar { + min-height: 48px; + display: flex; + align-items: center; + justify-content: space-between; + gap: 18px; + margin-bottom: 12px; + color: #bbb3a3; + font-size: 12px; + letter-spacing: .04em; + } + + .prototype-bar h1 { + margin: 0 0 3px; + color: #e8d6b7; + font-size: 14px; + font-weight: 500; + letter-spacing: .13em; + text-transform: uppercase; + } + + .prototype-bar p { margin: 0; } + + .fixture-switch, .bench-controls { + display: flex; + align-items: center; + gap: 7px; + flex-wrap: wrap; + justify-content: flex-end; + } + + .lab-button { + min-height: 31px; + padding: 5px 10px; + color: #bbb3a3; + border: 1px solid #554b3e; + border-radius: 3px; + background: linear-gradient(#26231f, #141311); + cursor: pointer; + } + + .lab-button:hover, .lab-button[aria-pressed="true"] { + color: #17130e; + border-color: #b89765; + background: linear-gradient(#e0c292, #a98857); + } + + .bench-readout { + min-width: 242px; + color: #9b9487; + font-variant-numeric: tabular-nums; + text-align: right; + } + + .receiver-wrap { + width: 100%; + overflow: hidden; + border-radius: 0 0 12px 12px; + box-shadow: 0 28px 60px #000c; + } + + .receiver { + position: relative; + width: 100%; + aspect-ratio: 1916 / 821; + overflow: hidden; + background: #060606 url("../concepts/30a-dupre-studios-user-refined-playlist.png") center / 100% 100% no-repeat; + user-select: none; + touch-action: none; + } + + .dynamic-svg, .hit-layer { + position: absolute; + inset: 0; + width: 100%; + height: 100%; + } + + .dynamic-svg { pointer-events: none; } + + .upper-live { + position: absolute; + left: 31.55%; + top: 11.6%; + width: 27.9%; + height: 31.4%; + overflow: hidden; + background: + radial-gradient(ellipse at 36% 10%, #25242140, transparent 46%), + linear-gradient(100deg, #090a09 0, #060706 72%, #080908 100%); + box-shadow: inset 0 0 34px #000; + } + + .art { + position: absolute; + left: 1.4%; + top: 1.5%; + width: 28%; + height: 69%; + overflow: hidden; + border: 1px solid #292724; + border-radius: 2px; + background: #171716; + box-shadow: 0 5px 15px #000b; + } + + .art img { + width: 100%; + height: 100%; + object-fit: cover; + display: block; + } + + .album-crop { + width: 100%; + height: 100%; + background-image: url("../concepts/30a-dupre-studios-user-refined-playlist.png"); + background-size: 1312.33% 475.2%; + background-position: 34.42% 20.9%; + } + + .metadata { + position: absolute; + left: 33.1%; + right: 1.5%; + top: 0; + height: 72%; + display: grid; + align-content: start; + gap: 4.6%; + padding-top: 1.2%; + color: var(--soft-white); + font-size: clamp(7px, 1.04vw, 20px); + line-height: 1.07; + letter-spacing: .08em; + text-shadow: 0 0 6px #fff2; + text-transform: uppercase; + } + + .metadata-line { + min-width: 0; + overflow: hidden; + white-space: nowrap; + text-overflow: ellipsis; + } + + .metadata-line.dim { color: #d5cfc2; } + + .on-air-under-art { + position: absolute; + left: 1.6%; + top: 73.5%; + width: 27.5%; + color: #e9543f; + font-size: clamp(8px, 1vw, 18px); + letter-spacing: .18em; + text-align: center; + text-shadow: 0 0 9px #e9543f99; + } + + .seek-line { + position: absolute; + left: 1.4%; + right: 1.5%; + bottom: 2.5%; + height: 20%; + display: grid; + grid-template-columns: 12% 1fr 12%; + align-items: center; + gap: 3%; + color: #d2cabd; + font-size: clamp(8px, .94vw, 18px); + font-variant-numeric: tabular-nums; + } + + .seek-time:last-child { text-align: right; } + + .seek-track { + position: relative; + height: 12px; + cursor: ew-resize; + } + + .seek-track::before { + content: ""; + position: absolute; + left: 0; + right: 0; + top: 5px; + height: 2px; + background: #373735; + box-shadow: inset 0 1px #000; + } + + .seek-fill { + position: absolute; + left: 0; + top: 5px; + width: calc(var(--progress) * 1%); + height: 2px; + background: var(--amber); + box-shadow: 0 0 4px #f2a90088; + } + + .seek-thumb { + position: absolute; + top: 50%; + left: calc(var(--progress) * 1%); + width: 12px; + height: 21px; + border: 1px solid #ead0a4; + border-radius: 3px; + background: linear-gradient(90deg, #6f4c2d, #caa16a 22%, #f0d3a0 48%, #ad7f4a 74%, #654429); + box-shadow: 0 2px 4px #000d, inset 0 1px #fff4, inset 0 -1px #50351f; + transform: translate(-50%, -50%); + } + + .seek-thumb::after { + content: ""; + position: absolute; + left: 50%; + top: 3px; + bottom: 3px; + width: 1px; + background: #5f4026aa; + box-shadow: 1px 0 #f2d7aa66; + } + + .playlist-header { + position: absolute; + left: 61.16%; + top: 6.35%; + width: 36%; + height: 7.8%; + display: grid; + grid-template-columns: minmax(0, 1fr) auto; + align-items: center; + gap: 2.4%; + padding: 0 2.1%; + overflow: hidden; + color: #1f1811; + background: + radial-gradient(ellipse 10% 100% at 5% -3%, #fff1d7 0, #eac184aa 35%, transparent 76%), + radial-gradient(ellipse 10% 100% at 35% -3%, #fff1d7 0, #eac184aa 35%, transparent 76%), + radial-gradient(ellipse 10% 100% at 65% -3%, #fff1d7 0, #eac184aa 35%, transparent 76%), + radial-gradient(ellipse 10% 100% at 95% -3%, #fff1d7 0, #eac184aa 35%, transparent 76%), + linear-gradient(90deg, #d5b78c22, transparent 25% 75%, #5c3c2233), + linear-gradient(180deg, #92795e, #877057); + box-shadow: + inset 0 1px #f7dfb6, + inset 0 5px 14px #fff2, + inset 0 -8px 15px #5a3d2433, + inset 0 0 0 1px #73583b66; + font-size: clamp(8px, 1.04vw, 20px); + letter-spacing: .075em; + text-transform: uppercase; + } + + .header-name { + min-width: 0; + overflow: hidden; + white-space: nowrap; + text-overflow: ellipsis; + } + + .playlist-live { + position: absolute; + left: 61.05%; + top: 14.25%; + width: 36.12%; + height: 66.15%; + overflow: hidden; + background: + radial-gradient(ellipse at 48% 0, #20211e22, transparent 55%), + linear-gradient(90deg, #070807, #090a09 65%, #050605); + box-shadow: inset 0 0 26px #000; + } + + .playlist-scroll { + position: absolute; + inset: 0 22px 0 0; + overflow-y: scroll; + scrollbar-width: none; + overscroll-behavior: contain; + } + + .playlist-scroll::-webkit-scrollbar { display: none; } + + .playlist-rows { min-height: 100%; } + + .playlist-row { + height: var(--row-height, 37px); + min-height: var(--row-height, 37px); + display: grid; + grid-template-columns: 7.5% minmax(0, 1fr) 12%; + align-items: center; + gap: 1.5%; + padding: 0 1.2% 0 2.6%; + color: #dad6cd; + border-bottom: 1px solid #ffffff06; + font-size: clamp(7px, .91vw, 17px); + letter-spacing: .045em; + text-transform: uppercase; + cursor: pointer; + } + + .playlist-row:hover { background: #f2a9000b; color: #fffaf0; } + + .playlist-row.selected { + color: var(--amber); + background: linear-gradient(90deg, #f2a90012, transparent 72%); + text-shadow: 0 0 7px #f2a90044; + } + + .row-number { position: relative; font-variant-numeric: tabular-nums; } + + .playlist-row.selected .row-number::before { + content: "▶"; + position: absolute; + right: calc(100% + 4px); + font-size: .78em; + } + + .row-name { + min-width: 0; + overflow: hidden; + white-space: nowrap; + text-overflow: ellipsis; + } + + .row-meta { text-align: right; font-variant-numeric: tabular-nums; } + + .scroll-rail { + position: absolute; + top: 1.2%; + right: 5px; + bottom: 1.2%; + width: 9px; + border: 1px solid #554b3d; + border-radius: 5px; + background: #191815; + box-shadow: inset 0 1px 3px #000; + } + + .scroll-thumb { + position: absolute; + left: -1px; + top: 0; + width: 9px; + min-height: 38px; + border: 1px solid #aa9574; + border-radius: 5px; + background: linear-gradient(90deg, #7b6a53, #bca887 45%, #76634b); + box-shadow: 0 0 4px #000; + cursor: ns-resize; + } + + .empty-row { + height: var(--row-height, 37px); + border-bottom: 1px solid #ffffff05; + } + + .transport-bank { + position: absolute; + left: 5.95%; + top: 71.7%; + width: 24.5%; + height: 7.45%; + display: grid; + grid-template-columns: repeat(4, 1fr); + gap: 5.4%; + } + + .transport-button { + position: relative; + border: 1px solid #1d1b18; + border-radius: 4px; + color: #b6a687; + background: + linear-gradient(180deg, #292927 0 7%, #171716 15% 72%, #090a09 100%); + box-shadow: + inset 0 1px #5b5953, + inset 0 -3px #050505, + 0 5px 5px #0009; + font-size: clamp(10px, 1.4vw, 25px); + cursor: pointer; + transform: translateY(0); + } + + .transport-button:hover { color: #e9ddc6; filter: brightness(1.12); } + + .transport-button:active, .transport-button.pressed { + transform: translateY(3px); + box-shadow: inset 0 2px 4px #000, 0 1px 2px #000b; + } + + .transport-button.playing { + color: #bdd27c; + text-shadow: 0 0 2px #a7c26c, 0 0 4px #70883e99; + transform: translateY(3px); + box-shadow: inset 0 2px 5px #000, 0 1px 2px #000b; + } + + .mode-button, + .radio-button { + position: absolute; + width: 2.05%; + aspect-ratio: 1; + padding: 0; + border: 1px solid #6e5436; + border-radius: 50%; + color: #2a2118; + background: + radial-gradient(circle at 34% 25%, #fff0c5 0 2.5%, transparent 5%), + repeating-radial-gradient(circle at 50% 50%, #fff3d00b 0 1px, #4b2e160b 1px 2px), + radial-gradient(circle at 46% 42%, #e8cb94 0, #c79a60 52%, #8b6038 82%, #d3aa70 100%); + box-shadow: + 0 3px 3px #0009, + inset 0 1px #f2d39e, + 0 0 0 3px #342719, + 0 0 0 4px #d0ad78; + cursor: pointer; + transform: translateY(0); + } + + .mode-button::after { + content: ""; + position: absolute; + inset: -4px; + border: 1px solid transparent; + border-radius: 50%; + } + + .mode-button[aria-pressed="true"]::after { + border-color: #829b55; + box-shadow: 0 0 2px #819a55aa, inset 0 0 2px #71864988; + } + + .mode-button[aria-pressed="true"], .mode-button:active { + transform: translateY(2px); + box-shadow: + 0 1px 1px #0009, + inset 0 2px 3px #3c291777, + 0 0 0 3px #2c2117, + 0 0 0 4px #bb9766; + } + + .radio-button { + box-shadow: + 0 3px 3px #0009, + inset 0 1px #f2d39e, + 0 0 0 3px #342719, + 0 0 0 4px #d0ad78; + } + + .radio-button:active { + transform: translateY(2px); + box-shadow: + 0 1px 1px #0009, + inset 0 2px 3px #3c291777, + 0 0 0 3px #2c2117, + 0 0 0 4px #bb9766; + } + + .mode-repeat { left: 34.68%; top: 52.75%; } + .mode-single { left: 39.18%; top: 52.75%; } + .mode-random { left: 34.68%; top: 61.25%; } + .mode-consume { left: 39.18%; top: 61.25%; } + .radio-name { left: 34.68%; top: 75.65%; } + .radio-tags { left: 39.18%; top: 75.65%; } + + .volume-hit { + position: absolute; + left: 43.2%; + top: 49.6%; + width: 14.6%; + height: 34%; + border-radius: 50%; + cursor: grab; + } + + .volume-hit:active { cursor: grabbing; } + + .playlist-actions { + position: absolute; + left: 61.13%; + top: 81.65%; + width: 35.45%; + height: 7.45%; + display: grid; + grid-template-columns: repeat(5, 1fr); + gap: .65%; + } + + .playlist-action { + border: 1px solid #302b23; + border-radius: 2px; + color: #ccc5b8; + background: linear-gradient(#1d1c19, #090a09); + box-shadow: inset 0 1px #555147, 0 3px 5px #0007; + font-size: clamp(8px, 1vw, 19px); + letter-spacing: .05em; + cursor: pointer; + } + + .playlist-action[data-action="add"], + .playlist-action[data-action="new"] { + background: linear-gradient(#29271d, #11120d); + } + + .playlist-action[data-action="delete"] { + color: #ead3cc; + border-color: #572c24; + background: linear-gradient(#552019, #2e0f0b); + } + + .playlist-action:hover { filter: brightness(1.2); } + + .playlist-action:active { transform: translateY(2px); box-shadow: inset 0 2px 5px #000; } + + .status-toast { + position: absolute; + left: 50%; + bottom: 2.7%; + z-index: 8; + max-width: 52%; + padding: .55% 1%; + color: #d7ccb8; + border: 1px solid #6d5b42; + border-radius: 3px; + background: #090907ed; + box-shadow: 0 5px 14px #000c; + font-size: clamp(7px, .78vw, 15px); + letter-spacing: .04em; + opacity: 0; + pointer-events: none; + transform: translate(-50%, 8px); + transition: opacity .15s, transform .15s; + } + + .status-toast.show { opacity: 1; transform: translate(-50%, 0); } + + dialog { + width: min(430px, calc(100vw - 40px)); + color: #e6dccb; + border: 1px solid #9b7651; + border-radius: 6px; + background: linear-gradient(#1d1b18, #0b0b0a); + box-shadow: 0 24px 70px #000; + font-family: var(--mono); + } + + dialog::backdrop { background: #000b; } + dialog h2 { color: #e0be87; font-size: 16px; font-weight: 500; } + dialog p { color: #bdb5a8; font-size: 13px; line-height: 1.45; } + dialog menu { display: flex; justify-content: flex-end; gap: 8px; padding: 0; } + + .delete-confirm { + color: #f0dad3; + border-color: #7c3327; + background: #592018; + } + + .inspection-note { + margin: 13px 2px 0; + display: flex; + justify-content: space-between; + gap: 18px; + color: #7f796f; + font-size: 11px; + line-height: 1.5; + } + + .inspection-note span:last-child { text-align: right; } + + @media (max-width: 980px) { + .workbench { padding: 10px 8px 20px; } + .prototype-bar { align-items: flex-start; flex-direction: column; } + .fixture-switch, .bench-controls { justify-content: flex-start; } + .bench-readout { text-align: left; } + } +</style> +</head> +<body> +<main class="workbench"> + <header class="prototype-bar"> + <div> + <h1>Music Config UI Remodel · Functional Prototype 1</h1> + <p>Drive the receiver. The controls outside it only switch fixtures and run the review benchmark.</p> + </div> + <div class="fixture-switch" aria-label="Prototype fixtures"> + <button class="lab-button" id="localFixture" aria-pressed="true">Local playlist</button> + <button class="lab-button" id="radioFixture" aria-pressed="false">Radio station</button> + <button class="lab-button" id="restoreFixture">Restore fixture</button> + </div> + <div class="bench-controls"> + <button class="lab-button" id="benchmarkButton">Run 60s benchmark</button> + <span class="bench-readout" id="benchmarkReadout">Dynamic updates: awaiting benchmark</span> + </div> + </header> + + <section class="receiver-wrap" aria-label="Dupre Studios receiver prototype"> + <div class="receiver" id="receiver"> + <div class="upper-live" id="upperLive"> + <div class="art" id="art"><div class="album-crop" aria-label="69 Love Songs album art"></div></div> + <div class="metadata" id="metadata"></div> + <div class="on-air-under-art" id="onAirUnderArt" hidden>ON AIR</div> + <div class="seek-line" id="seekLine"> + <span class="seek-time" id="elapsed">01:30</span> + <div class="seek-track" id="seekTrack" role="slider" tabindex="0" aria-label="Track position" aria-valuemin="0" aria-valuemax="100" aria-valuenow="50"> + <div class="seek-fill"></div> + <div class="seek-thumb"></div> + </div> + <span class="seek-time" id="duration">02:59</span> + </div> + </div> + + <div class="playlist-header" id="playlistHeader"> + <span class="header-name" id="headerName">69 LOVE SONGS — COMPLETE</span> + <span id="headerCount">69 TRACKS</span> + </div> + + <div class="playlist-live"> + <div class="playlist-scroll" id="playlistScroll" tabindex="0" aria-label="Playlist rows"> + <div class="playlist-rows" id="playlistRows"></div> + </div> + <div class="scroll-rail" id="scrollRail" hidden><div class="scroll-thumb" id="scrollThumb"></div></div> + </div> + + <svg class="dynamic-svg" viewBox="0 0 1916 821" aria-hidden="true"> + <defs> + <radialGradient id="meterGlow" cx="50%" cy="100%" r="65%"> + <stop offset="0" stop-color="#ffc55b" stop-opacity=".75"/> + <stop offset=".32" stop-color="#8c5b16" stop-opacity=".18"/> + <stop offset="1" stop-color="#000" stop-opacity="0"/> + </radialGradient> + <linearGradient id="meterFrame" x1="0" x2="1"> + <stop offset="0" stop-color="#5b4325"/> + <stop offset=".18" stop-color="#e2c08a"/> + <stop offset=".5" stop-color="#7c5a32"/> + <stop offset=".82" stop-color="#ddba82"/> + <stop offset="1" stop-color="#4a321c"/> + </linearGradient> + <linearGradient id="faceplateMask" x1="0" y1="0" x2="1" y2="1"> + <stop offset="0" stop-color="#c3a477"/> + <stop offset=".52" stop-color="#b9996d"/> + <stop offset="1" stop-color="#c5a77b"/> + </linearGradient> + <linearGradient id="champagneFace" x1="0" y1="0" x2="0" y2="1"> + <stop offset="0" stop-color="#c8b89f"/> + <stop offset=".18" stop-color="#b9a489"/> + <stop offset=".56" stop-color="#b19a7c"/> + <stop offset="1" stop-color="#a68e71"/> + </linearGradient> + <linearGradient id="glassLip" x1="0" y1="0" x2="0" y2="1"> + <stop offset="0" stop-color="#050606" stop-opacity=".96"/> + <stop offset=".45" stop-color="#111311"/> + <stop offset=".76" stop-color="#030404"/> + <stop offset="1" stop-color="#2a2118"/> + </linearGradient> + <pattern id="microBrush" width="5" height="4" patternUnits="userSpaceOnUse"> + <path d="M0 .5 H5" stroke="#fff5df" stroke-opacity=".1" stroke-width=".55"/> + <path d="M0 3.5 H5" stroke="#57452f" stroke-opacity=".08" stroke-width=".45"/> + </pattern> + <clipPath id="volumeKnobClip"> + <circle cx="972" cy="551" r="98"/> + </clipPath> + <radialGradient id="volumeLamp" cx="36%" cy="28%" r="70%"> + <stop offset="0" stop-color="#fff8d7"/> + <stop offset=".24" stop-color="#ffd27d"/> + <stop offset=".72" stop-color="#f1a02e"/> + <stop offset="1" stop-color="#b96513"/> + </radialGradient> + </defs> + <g id="faceplateSurface"> + <rect x="69" y="366" width="1078" height="31" rx="19" fill="url(#glassLip)"/> + <path d="M88 369 H1128 Q1143 369 1147 385" fill="none" stroke="#353735" stroke-opacity=".8" stroke-width="2"/> + <rect x="69" y="379" width="1078" height="367" rx="19" fill="url(#champagneFace)"/> + <rect x="69" y="379" width="1078" height="367" rx="19" fill="url(#microBrush)"/> + <path d="M88 379 H1128 Q1142 379 1147 395" fill="none" stroke="#f0d09c" stroke-width="2.2"/> + <rect x="73" y="383" width="1070" height="359" rx="16" fill="none" stroke="#d2b584" stroke-width="1.5"/> + <rect x="77" y="387" width="1062" height="351" rx="14" fill="none" stroke="#715438" stroke-opacity=".72" stroke-width="1.4"/> + <line x1="641" y1="578" x2="817" y2="578" stroke="#705438" stroke-width="1.2"/> + <g fill="#261d16" font-family="Berkeley Mono, monospace" text-anchor="middle" letter-spacing=".5"> + <text x="729" y="422" font-size="17">PLAY MODES</text> + <text x="684" y="492" font-size="15">REPEAT</text> + <text x="770" y="492" font-size="15">SINGLE</text> + <text x="684" y="563" font-size="15">RANDOM</text> + <text x="770" y="563" font-size="15">CONSUME</text> + <text x="729" y="608" font-size="16">RADIO SEARCH</text> + <text x="684" y="686" font-size="15">NAME</text> + <text x="770" y="686" font-size="15">TAGS</text> + <text x="162" y="690" font-size="16">PREV</text> + <text x="285" y="690" font-size="16">PLAY/PAUSE</text> + <text x="408" y="690" font-size="16">STOP</text> + <text x="531" y="690" font-size="16">NEXT</text> + <text x="972" y="691" font-size="17">VOLUME</text> + </g> + <image href="../concepts/30a-dupre-studios-user-refined-playlist.png" + x="0" y="0" width="1916" height="821" clip-path="url(#volumeKnobClip)"/> + </g> + <g id="meters"></g> + <g id="volumeMask"></g> + <g id="volumeSegments"></g> + </svg> + + <div class="transport-bank" aria-label="Transport controls"> + <button class="transport-button" data-transport="prev" aria-label="Previous">|◀</button> + <button class="transport-button" data-transport="play" aria-label="Play or pause">▶Ⅱ</button> + <button class="transport-button" data-transport="stop" aria-label="Stop">■</button> + <button class="transport-button" data-transport="next" aria-label="Next">▶|</button> + </div> + + <button class="mode-button mode-repeat" data-mode="repeat" aria-label="Repeat playlist" aria-pressed="false"></button> + <button class="mode-button mode-single" data-mode="single" aria-label="Repeat one track" aria-pressed="false"></button> + <button class="mode-button mode-random" data-mode="random" aria-label="Random playback" aria-pressed="false"></button> + <button class="mode-button mode-consume" data-mode="consume" aria-label="Consume tracks" aria-pressed="false"></button> + <button class="radio-button radio-name" data-radio="name" aria-label="Search radio stations by name"></button> + <button class="radio-button radio-tags" data-radio="tags" aria-label="Search radio stations by tag"></button> + <div class="volume-hit" id="volumeHit" role="slider" tabindex="0" aria-label="Player volume" aria-valuemin="0" aria-valuemax="100" aria-valuenow="68"></div> + + <div class="playlist-actions" aria-label="Playlist actions"> + <button class="playlist-action" data-action="add">ADD</button> + <button class="playlist-action" data-action="new">NEW</button> + <button class="playlist-action" data-action="load">LOAD</button> + <button class="playlist-action" data-action="save">SAVE</button> + <button class="playlist-action" data-action="delete">DELETE</button> + </div> + + <div class="status-toast" id="statusToast" role="status" aria-live="polite"></div> + </div> + </section> + + <div class="inspection-note"> + <span>Keyboard: Space play/pause · arrows select · Page Up/Down browse · Home/End · R/S/X/C modes. Prototype VU motion is synthetic; production reads mpv RMS.</span> + <span id="interactionStatus">Local fixture · playing · volume 68</span> + </div> +</main> + +<dialog id="deleteDialog"> + <form method="dialog"> + <h2>Delete this playlist?</h2> + <p id="deletePrompt">This removes the saved playlist. Playback stops and the receiver returns to an untitled empty queue.</p> + <menu> + <button class="lab-button" value="cancel">Cancel</button> + <button class="lab-button delete-confirm" value="confirm">Delete playlist</button> + </menu> + </form> +</dialog> + +<script> +(() => { + "use strict"; + + const BASE_ROW_HEIGHT = 37; + const VISIBLE_ROWS = 14; + const localSeed = [ + ["Absolutely Cuckoo", "The Magnetic Fields", "02:02"], + ["I Don’t Believe in the Sun", "The Magnetic Fields", "02:50"], + ["All My Little Words", "The Magnetic Fields", "02:03"], + ["A Chicken With Its Head Cut Off — Remastered Anniversary Edition", "The Magnetic Fields and the Long-Lost Orchestra", "02:59"], + ["(I’m) Dazota", "The Magnetic Fields", "02:38"], + ["I Don’t Want to Get Over You", "The Magnetic Fields", "02:50"], + ["Come Back From San Francisco", "The Magnetic Fields", "02:37"], + ["The Luckiest Guy on the Lower East Side", "The Magnetic Fields", "01:32"], + ["Let’s Pretend We’re Bunny Rabbits", "The Magnetic Fields", "02:10"], + ["The Cactus Where Your Heart Should Be", "The Magnetic Fields", "02:38"], + ["I Think I Need a New Heart", "The Magnetic Fields", "02:58"], + ["The Book of Love", "The Magnetic Fields", "02:56"], + ["Fido, Your Leash Is Too Long", "The Magnetic Fields", "02:13"], + ["How Fucking Romantic", "The Magnetic Fields", "00:58"], + ["The One You Really Love", "The Magnetic Fields", "02:53"], + ["Punk Love", "The Magnetic Fields", "00:58"], + ["Parades Go By", "The Magnetic Fields", "02:56"], + ["Boa Constrictor", "The Magnetic Fields", "00:58"], + ["A Pretty Girl Is Like…", "The Magnetic Fields", "01:50"], + ["My Sentimental Melody", "The Magnetic Fields", "03:07"] + ]; + + const fillerTitles = [ + "Nothing Matters When We’re Dancing", "Sweet-Lovin’ Man", "The Things We Did and Didn’t Do", + "Roses", "Love Is Like Jazz", "When My Boy Walks Down the Street", "Time Enough for Rocking", + "Very Funny", "Grand Canyon", "No One Will Ever Love You", "If You Don’t Cry", + "You’re My Only Home", "Washington, D.C.", "Long-Forgotten Fairytale" + ]; + + const radioSeed = [ + ["Groove Salad", "SomaFM · Ambient / Downtempo", "ON AIR"], + ["Drone Zone", "SomaFM · Atmospheric Textures", "256k"], + ["Secret Agent", "SomaFM · Cinematic", "256k"], + ["Illinois Street Lounge", "SomaFM · Lounge", "256k"], + ["Space Station Soma", "SomaFM · Space Music", "256k"], + ["Left Coast 70s", "SomaFM · Mellow Rock", "256k"], + ["The Trip", "SomaFM · Progressive House", "256k"], + ["Underground 80s", "SomaFM · Synthpop", "256k"], + ["Deep Space One", "SomaFM · Ambient", "256k"], + ["Black Rock FM", "SomaFM · Eclectic", "256k"], + ["Bossa Beyond", "SomaFM · Brazilian", "256k"], + ["Seven Inch Soul", "SomaFM · Vintage Soul", "256k"], + ["Suburbs of Goa", "SomaFM · South Asian", "256k"], + ["Boot Liquor", "SomaFM · Americana", "256k"], + ["Heavyweight Reggae", "SomaFM · Roots Reggae", "256k"], + ["Lush", "SomaFM · Female Vocals", "256k"], + ["Beat Blender", "SomaFM · Electronic", "256k"], + ["Digitalis", "SomaFM · Indie Electronic", "256k"] + ]; + + const makeLocalTracks = () => Array.from({length: 69}, (_, index) => { + const base = localSeed[index] || [ + fillerTitles[index % fillerTitles.length], + index % 7 === 0 ? "The Magnetic Fields with an Improbably Long Guest Credit" : "The Magnetic Fields", + `${String(1 + (index % 3)).padStart(2, "0")}:${String((17 * index) % 60).padStart(2, "0")}` + ]; + return {id: `local-${index}`, title: base[0], artist: base[1], meta: base[2]}; + }); + + const makeRadioTracks = () => radioSeed.map((row, index) => ({ + id: `radio-${index}`, title: row[0], artist: row[1], meta: row[2] + })); + + const fixtures = { + local: { + name: "69 Love Songs — The Complete Three-Volume Collection", + kind: "PLAYLIST", + tracks: makeLocalTracks, + selected: 3, + position: 90, + duration: 179, + metadata: [ + "A Chicken With Its Head Cut Off — Remastered Anniversary Edition", + "The Magnetic Fields and the Long-Lost Orchestra", + "69 Love Songs: The Complete Three-Volume Collection", + "Merge Records", + "1999" + ] + }, + radio: { + name: "Name Search · Ambient", + kind: "RADIO", + tracks: makeRadioTracks, + selected: 0, + position: 0, + duration: 0, + metadata: ["Groove Salad", "SomaFM", "Ambient / Downtempo", "256 kbps"] + } + }; + + const state = { + fixture: "local", + playlistName: fixtures.local.name, + tracks: fixtures.local.tracks(), + selected: fixtures.local.selected, + position: fixtures.local.position, + duration: fixtures.local.duration, + playing: true, + volume: 68, + modes: {repeat: false, single: false, random: false, consume: false}, + search: null, + vu: {left: -20, right: -20}, + benchmark: null + }; + + const $ = selector => document.querySelector(selector); + const $$ = selector => [...document.querySelectorAll(selector)]; + const receiver = $("#receiver"); + const rows = $("#playlistRows"); + const scroll = $("#playlistScroll"); + const rail = $("#scrollRail"); + const thumb = $("#scrollThumb"); + const seekTrack = $("#seekTrack"); + const volumeHit = $("#volumeHit"); + const toast = $("#statusToast"); + const deleteDialog = $("#deleteDialog"); + let toastTimer = null; + let seekDragging = false; + let volumeDragging = false; + let thumbDragging = false; + let thumbGrabOffset = 0; + let lastMeterTime = performance.now(); + + const clamp = (value, min, max) => Math.max(min, Math.min(max, value)); + const formatTime = seconds => { + const value = Math.max(0, Math.round(seconds)); + return `${String(Math.floor(value / 60)).padStart(2, "0")}:${String(value % 60).padStart(2, "0")}`; + }; + + function announce(message) { + clearTimeout(toastTimer); + toast.textContent = message; + toast.classList.add("show"); + toastTimer = setTimeout(() => toast.classList.remove("show"), 1800); + updateInspection(message); + } + + function currentTrack() { return state.tracks[state.selected] || null; } + + function switchFixture(name, message = null) { + const source = fixtures[name]; + state.fixture = name; + state.playlistName = source.name; + state.tracks = source.tracks(); + state.selected = source.selected; + state.position = source.position; + state.duration = source.duration; + state.playing = true; + state.search = null; + scroll.scrollTop = 0; + renderAll(); + announce(message || `${name === "local" ? "Local playlist" : "Radio station"} fixture loaded`); + } + + function renderInfo() { + const source = fixtures[state.fixture]; + const track = currentTrack(); + const metadata = track ? (state.fixture === "local" ? [ + track.title, + track.artist, + source.metadata[2], + source.metadata[3], + source.metadata[4] + ] : [track.title, "SomaFM", track.artist.replace(/^SomaFM · /, ""), "256 kbps"]) : []; + + $("#metadata").innerHTML = metadata.filter(Boolean).map((line, index) => + `<div class="metadata-line ${index ? "dim" : ""}" title="${escapeHtml(line)}">${escapeHtml(line)}</div>` + ).join(""); + + $("#art").innerHTML = state.fixture === "radio" + ? '<img src="../../../assets/vinyl-placeholder.svg" alt="Radio station artwork unavailable; vinyl placeholder">' + : '<div class="album-crop" role="img" aria-label="69 Love Songs album art"></div>'; + + const onAir = state.fixture === "radio" && Boolean(track); + $("#onAirUnderArt").hidden = !onAir; + $("#seekLine").hidden = onAir || !track; + if (track && !onAir) updateSeekVisual(); + } + + function escapeHtml(value) { + return String(value).replace(/[&<>"']/g, character => ({ + "&": "&", "<": "<", ">": ">", '"': """, "'": "'" + })[character]); + } + + function renderHeader() { + $("#headerName").textContent = state.playlistName || "UNTITLED"; + $("#headerName").title = state.playlistName || "UNTITLED"; + const noun = state.fixture === "radio" ? (state.tracks.length === 1 ? "STATION" : "STATIONS") : (state.tracks.length === 1 ? "TRACK" : "TRACKS"); + $("#headerCount").textContent = `${state.tracks.length} ${noun}`; + } + + function renderRows() { + const rowHeight = scroll.clientHeight / VISIBLE_ROWS; + rows.style.setProperty("--row-height", `${rowHeight}px`); + if (!state.tracks.length) { + rows.innerHTML = Array.from({length: VISIBLE_ROWS}, () => '<div class="empty-row"></div>').join(""); + rows.style.height = `${scroll.clientHeight}px`; + rail.hidden = true; + return; + } + rows.style.height = `${rowHeight * Math.max(VISIBLE_ROWS, state.tracks.length)}px`; + rows.innerHTML = state.tracks.map((track, index) => ` + <div class="playlist-row ${index === state.selected ? "selected" : ""}" data-row="${index}" title="${escapeHtml(`${track.title} — ${track.artist}`)}"> + <span class="row-number">${String(index + 1).padStart(2, "0")}</span> + <span class="row-name">${escapeHtml(track.title)} — ${escapeHtml(track.artist)}</span> + <span class="row-meta">${state.fixture === "radio" && index === state.selected && state.playing ? "ON AIR" : escapeHtml(track.meta)}</span> + </div>`).join(""); + $$("[data-row]").forEach(row => row.addEventListener("click", () => selectTrack(Number(row.dataset.row), true))); + requestAnimationFrame(updateScrollbar); + } + + function renderControls() { + const hasTrack = Boolean(currentTrack()); + const play = $('[data-transport="play"]'); + play.classList.toggle("playing", state.playing && hasTrack); + play.disabled = !hasTrack; + $('[data-transport="prev"]').disabled = !hasTrack; + $('[data-transport="next"]').disabled = !hasTrack; + $('[data-transport="stop"]').disabled = !hasTrack; + $$("[data-mode]").forEach(button => button.setAttribute("aria-pressed", String(state.modes[button.dataset.mode]))); + $("#localFixture").setAttribute("aria-pressed", String(state.fixture === "local")); + $("#radioFixture").setAttribute("aria-pressed", String(state.fixture === "radio")); + volumeHit.setAttribute("aria-valuenow", String(state.volume)); + updateVolumeSegments(); + updateInspection(); + } + + function renderAll() { + const started = performance.now(); + renderInfo(); + renderHeader(); + renderRows(); + renderControls(); + recordRender(performance.now() - started); + } + + function updateSeekVisual() { + const percentage = state.duration ? clamp((state.position / state.duration) * 100, 0, 100) : 0; + seekTrack.style.setProperty("--progress", percentage.toFixed(3)); + seekTrack.setAttribute("aria-valuenow", String(Math.round(percentage))); + $("#elapsed").textContent = formatTime(state.position); + $("#duration").textContent = formatTime(state.duration); + } + + function seekFromPointer(event) { + if (state.fixture !== "local" || !currentTrack()) return; + const bounds = seekTrack.getBoundingClientRect(); + const fraction = clamp((event.clientX - bounds.left) / bounds.width, 0, 1); + state.position = state.duration * fraction; + updateSeekVisual(); + updateInspection(`Seek ${formatTime(state.position)} / ${formatTime(state.duration)}`); + } + + function selectTrack(index, play = false) { + if (!state.tracks.length) return; + state.selected = clamp(index, 0, state.tracks.length - 1); + state.position = 0; + if (play) state.playing = true; + renderInfo(); + renderRows(); + renderControls(); + ensureSelectedVisible(); + } + + function ensureSelectedVisible() { + const row = rows.children[state.selected]; + if (row) row.scrollIntoView({block: "nearest"}); + } + + function moveTrack(delta) { + if (!state.tracks.length) return; + const next = (state.selected + delta + state.tracks.length) % state.tracks.length; + selectTrack(next, true); + announce(`${delta < 0 ? "Previous" : "Next"}: ${currentTrack().title}`); + } + + function togglePlay() { + if (!currentTrack()) return; + state.playing = !state.playing; + renderRows(); + renderControls(); + announce(state.playing ? "Playback resumed" : "Playback paused"); + } + + function setVolume(value, message = true) { + state.volume = Math.round(clamp(value, 0, 100)); + renderControls(); + if (message) updateInspection(`Player volume ${state.volume}`); + } + + function volumeFromPointer(event) { + const bounds = volumeHit.getBoundingClientRect(); + const x = event.clientX - (bounds.left + bounds.width / 2); + const y = event.clientY - (bounds.top + bounds.height / 2); + let angle = Math.atan2(y, x) * 180 / Math.PI; + if (angle < 150) angle += 360; + setVolume(((clamp(angle, 150, 390) - 150) / 240) * 100, false); + } + + function updateVolumeSegments() { + const points = [ + [885, 630], [871, 608], [861, 583], [857, 557], [857, 531], [864, 507], + [875, 484], [890, 464], [906, 448], [924, 440], [947, 432], [972, 431], + [996, 433], [1018, 440], [1038, 452], [1055, 467], [1068, 486], [1079, 507], + [1086, 532], [1087, 557], [1085, 582], [1078, 608], [1059, 628] + ]; + const count = points.length; + const lit = Math.round((state.volume / 100) * (count - 1)); + $("#volumeMask").innerHTML = points.map(([x, y]) => + `<circle cx="${x}" cy="${y}" r="5.3" fill="#0d0e0c" stroke="#655039" stroke-width=".8"/>` + ).join(""); + const circles = points.map(([x, y], index) => { + const active = index <= lit; + if (active) { + return `<g><circle cx="${x}" cy="${y}" r="10" fill="#ff9d24" fill-opacity=".28"/><circle cx="${x}" cy="${y}" r="7" fill="#ffad32" fill-opacity=".22"/><circle cx="${x}" cy="${y}" r="4.8" fill="url(#volumeLamp)" stroke="#fff1c2" stroke-width=".85"/></g>`; + } + return ""; + }).join(""); + $("#volumeSegments").innerHTML = circles; + } + + function meterMarkup(x, id) { + const labels = ["-40", "-20", "-10", "-6", "-3", "0", "+3"]; + const ticks = Array.from({length: 19}, (_, index) => { + const angle = -56 + index * (112 / 18); + const major = index % 3 === 0; + const radians = angle * Math.PI / 180; + const x1 = 115 + Math.sin(radians) * (major ? 91 : 95); + const y1 = 131 - Math.cos(radians) * (major ? 91 : 95); + const x2 = 115 + Math.sin(radians) * 102; + const y2 = 131 - Math.cos(radians) * 102; + return `<line x1="${x1}" y1="${y1}" x2="${x2}" y2="${y2}" stroke="${index > 14 ? "#d43b25" : "#d7c48d"}" stroke-width="${major ? 1.7 : 1}"/>`; + }).join(""); + const labelText = labels.map((label, index) => { + const angle = -52 + index * (104 / (labels.length - 1)); + const radians = angle * Math.PI / 180; + const lx = 115 + Math.sin(radians) * 72; + const ly = 131 - Math.cos(radians) * 72; + return `<text x="${lx}" y="${ly}" text-anchor="middle" fill="${index > 4 ? "#de442f" : "#ddd0aa"}" font-family="Berkeley Mono,monospace" font-size="10">${label}</text>`; + }).join(""); + return `<g transform="translate(${x} 432)"> + <rect x="0" y="0" width="230" height="113" rx="7" fill="url(#meterFrame)"/> + <rect x="4" y="4" width="222" height="105" rx="5" fill="#050605" stroke="#1b1812" stroke-width="2"/> + <rect x="5" y="5" width="220" height="103" rx="5" fill="url(#meterGlow)"/> + ${ticks}${labelText} + <text x="115" y="91" text-anchor="middle" fill="#e7d7ae" font-family="Berkeley Mono,monospace" font-size="18">VU</text> + <circle cx="115" cy="111" r="17" fill="url(#meterGlow)" opacity=".9"/> + <line id="needle-${id}" x1="115" y1="105" x2="115" y2="27" stroke="#f3d59c" stroke-width="2.2" transform="rotate(0 115 105)"/> + <circle cx="115" cy="105" r="3.2" fill="#c7a56f"/> + </g>`; + } + + function initMeters() { + $("#meters").innerHTML = meterMarkup(112, "left") + meterMarkup(365, "right"); + } + + function vuAngle(db) { + const normalized = clamp((db + 40) / 43, 0, 1); + return -54 + normalized * 108; + } + + function updateMeters(timestamp) { + const started = performance.now(); + const elapsed = Math.min(.05, (timestamp - lastMeterTime) / 1000); + lastMeterTime = timestamp; + const signal = state.playing && currentTrack(); + const base = timestamp / 350; + const targets = signal ? { + left: -13 + Math.sin(base * 1.13) * 5 + Math.sin(base * 2.31) * 2, + right: -14 + Math.sin(base * .97 + 1.1) * 5.5 + Math.sin(base * 2.08) * 2 + } : {left: -40, right: -40}; + for (const side of ["left", "right"]) { + const target = targets[side]; + const speed = target > state.vu[side] ? 7.2 : 2.4; + state.vu[side] += (target - state.vu[side]) * Math.min(1, elapsed * speed); + $(`#needle-${side}`).setAttribute("transform", `rotate(${vuAngle(state.vu[side]).toFixed(2)} 115 105)`); + } + recordRender(performance.now() - started); + requestAnimationFrame(updateMeters); + } + + function updateScrollbar() { + const overflow = scroll.scrollHeight - scroll.clientHeight; + rail.hidden = overflow <= 1; + if (overflow <= 1) return; + const railHeight = rail.clientHeight; + const ratio = scroll.clientHeight / scroll.scrollHeight; + const thumbHeight = Math.max(38, railHeight * ratio); + const travel = railHeight - thumbHeight; + thumb.style.height = `${thumbHeight}px`; + thumb.style.top = `${travel * (scroll.scrollTop / overflow)}px`; + } + + function updateInspection(message = null) { + const label = state.fixture === "radio" ? "Radio fixture" : "Local fixture"; + const play = state.playing ? "playing" : "paused"; + $("#interactionStatus").textContent = message || `${label} · ${play} · volume ${state.volume}`; + } + + function handlePlaylistAction(action) { + if (action === "add") { + const number = state.tracks.length + 1; + state.tracks.push({id: `added-${Date.now()}`, title: "Newly Added Track With a Deliberately Long Display Name", artist: "Prototype Library", meta: "04:12"}); + state.selected = number - 1; + renderAll(); + ensureSelectedVisible(); + announce(`Added track ${number}`); + } else if (action === "new") { + state.playlistName = "UNTITLED"; + state.tracks = []; + state.selected = 0; + state.playing = false; + renderAll(); + announce("New empty playlist"); + } else if (action === "load") { + switchFixture(state.fixture, `Loaded ${fixtures[state.fixture].name}`); + } else if (action === "save") { + announce(`Saved ${state.playlistName || "UNTITLED"} · ${state.tracks.length} tracks`); + } else if (action === "delete") { + $("#deletePrompt").textContent = `Delete “${state.playlistName || "UNTITLED"}”? This removes the saved playlist and leaves an untitled empty queue.`; + deleteDialog.showModal(); + } + } + + function handleTransport(action) { + if (action === "prev") moveTrack(-1); + if (action === "next") moveTrack(1); + if (action === "play") togglePlay(); + if (action === "stop") { + state.playing = false; + state.position = 0; + renderRows(); + renderControls(); + if (state.fixture === "local") updateSeekVisual(); + announce("Playback stopped"); + } + } + + function radioSearch(kind) { + const label = kind === "name" ? "Name search · Groove" : "Tag search · Ambient"; + if (state.fixture !== "radio") switchFixture("radio", label); + state.search = kind; + state.playlistName = label; + renderHeader(); + announce(label); + } + + function recordRender(value) { + if (!state.benchmark) return; + state.benchmark.samples.push(value); + } + + function percentile(sorted, fraction) { + return sorted[Math.min(sorted.length - 1, Math.floor(sorted.length * fraction))] || 0; + } + + function updateBenchmarkReadout() { + if (!state.benchmark) return; + const elapsed = performance.now() - state.benchmark.started; + const remaining = Math.max(0, state.benchmark.duration - elapsed); + const sorted = [...state.benchmark.samples].sort((a, b) => a - b); + const median = percentile(sorted, .5); + const p95 = percentile(sorted, .95); + $("#benchmarkReadout").textContent = remaining > 0 + ? `Benchmark ${Math.ceil(remaining / 1000)}s · median ${median.toFixed(2)} ms · p95 ${p95.toFixed(2)} ms` + : `Complete · ${sorted.length} updates · median ${median.toFixed(2)} ms · p95 ${p95.toFixed(2)} ms`; + if (remaining > 0) setTimeout(updateBenchmarkReadout, 250); + else { + state.benchmark.complete = true; + $("#benchmarkButton").disabled = false; + document.documentElement.dataset.benchmark = JSON.stringify({ + samples: sorted.length, + medianMs: Number(median.toFixed(3)), + p95Ms: Number(p95.toFixed(3)), + durationMs: state.benchmark.duration, + viewport: `${Math.round(receiver.getBoundingClientRect().width)}x${Math.round(receiver.getBoundingClientRect().height)}` + }); + announce("60-second dynamic-update benchmark complete"); + } + } + + function runBenchmark(duration = 60000) { + if (state.benchmark && !state.benchmark.complete) return; + state.benchmark = {started: performance.now(), duration, samples: [], complete: false}; + $("#benchmarkButton").disabled = true; + updateBenchmarkReadout(); + } + + function bindEvents() { + $("#localFixture").addEventListener("click", () => switchFixture("local")); + $("#radioFixture").addEventListener("click", () => switchFixture("radio")); + $("#restoreFixture").addEventListener("click", () => switchFixture(state.fixture)); + $("#benchmarkButton").addEventListener("click", () => runBenchmark()); + + $$("[data-transport]").forEach(button => button.addEventListener("click", () => handleTransport(button.dataset.transport))); + $$("[data-mode]").forEach(button => button.addEventListener("click", () => { + const mode = button.dataset.mode; + state.modes[mode] = !state.modes[mode]; + renderControls(); + announce(`${mode.toUpperCase()} ${state.modes[mode] ? "enabled" : "disabled"}`); + })); + $$("[data-radio]").forEach(button => button.addEventListener("click", () => radioSearch(button.dataset.radio))); + $$("[data-action]").forEach(button => button.addEventListener("click", () => handlePlaylistAction(button.dataset.action))); + + seekTrack.addEventListener("pointerdown", event => { + seekDragging = true; + seekTrack.setPointerCapture(event.pointerId); + seekFromPointer(event); + }); + seekTrack.addEventListener("pointermove", event => { if (seekDragging) seekFromPointer(event); }); + seekTrack.addEventListener("pointerup", event => { + seekDragging = false; + seekTrack.releasePointerCapture(event.pointerId); + announce(`Seeked to ${formatTime(state.position)}`); + }); + seekTrack.addEventListener("keydown", event => { + if (!["ArrowLeft", "ArrowRight"].includes(event.key)) return; + event.preventDefault(); + state.position = clamp(state.position + (event.key === "ArrowRight" ? 5 : -5), 0, state.duration); + updateSeekVisual(); + }); + + volumeHit.addEventListener("pointerdown", event => { + volumeDragging = true; + volumeHit.setPointerCapture(event.pointerId); + volumeFromPointer(event); + }); + volumeHit.addEventListener("pointermove", event => { if (volumeDragging) volumeFromPointer(event); }); + volumeHit.addEventListener("pointerup", event => { + volumeDragging = false; + volumeHit.releasePointerCapture(event.pointerId); + announce(`Player volume ${state.volume}`); + }); + volumeHit.addEventListener("wheel", event => { + event.preventDefault(); + setVolume(state.volume + (event.deltaY < 0 ? 5 : -5)); + }, {passive: false}); + volumeHit.addEventListener("keydown", event => { + if (!["ArrowLeft", "ArrowDown", "ArrowRight", "ArrowUp"].includes(event.key)) return; + event.preventDefault(); + setVolume(state.volume + (["ArrowRight", "ArrowUp"].includes(event.key) ? 5 : -5)); + }); + + scroll.addEventListener("scroll", updateScrollbar); + thumb.addEventListener("pointerdown", event => { + thumbDragging = true; + thumbGrabOffset = event.clientY - thumb.getBoundingClientRect().top; + thumb.setPointerCapture(event.pointerId); + }); + thumb.addEventListener("pointermove", event => { + if (!thumbDragging) return; + const railBox = rail.getBoundingClientRect(); + const thumbHeight = thumb.getBoundingClientRect().height; + const travel = railBox.height - thumbHeight; + const top = clamp(event.clientY - railBox.top - thumbGrabOffset, 0, travel); + scroll.scrollTop = (top / travel) * (scroll.scrollHeight - scroll.clientHeight); + }); + thumb.addEventListener("pointerup", event => { + thumbDragging = false; + thumb.releasePointerCapture(event.pointerId); + }); + + deleteDialog.addEventListener("close", () => { + if (deleteDialog.returnValue !== "confirm") return; + const deleted = state.playlistName || "UNTITLED"; + state.playlistName = "UNTITLED"; + state.tracks = []; + state.selected = 0; + state.playing = false; + renderAll(); + announce(`Deleted ${deleted}`); + }); + + document.addEventListener("keydown", event => { + if (deleteDialog.open || event.target.matches("button, input, [role=slider], .playlist-scroll")) return; + if (event.code === "Space") { event.preventDefault(); togglePlay(); } + else if (event.key === "ArrowDown") { event.preventDefault(); selectTrack(state.selected + 1); ensureSelectedVisible(); } + else if (event.key === "ArrowUp") { event.preventDefault(); selectTrack(state.selected - 1); ensureSelectedVisible(); } + else if (event.key === "PageDown") { event.preventDefault(); selectTrack(state.selected + VISIBLE_ROWS); ensureSelectedVisible(); } + else if (event.key === "PageUp") { event.preventDefault(); selectTrack(state.selected - VISIBLE_ROWS); ensureSelectedVisible(); } + else if (event.key === "Home") { event.preventDefault(); selectTrack(0); ensureSelectedVisible(); } + else if (event.key === "End") { event.preventDefault(); selectTrack(state.tracks.length - 1); ensureSelectedVisible(); } + else if (["r", "s", "x", "c"].includes(event.key.toLowerCase())) { + const mode = ({r: "repeat", s: "single", x: "random", c: "consume"})[event.key.toLowerCase()]; + state.modes[mode] = !state.modes[mode]; + renderControls(); + } + }); + + window.addEventListener("resize", () => { + renderRows(); + updateScrollbar(); + }); + } + + function runSelfTest() { + const checks = []; + const check = (name, condition) => { + checks.push({name, passed: Boolean(condition)}); + if (!condition) throw new Error(`Self-test failed: ${name}`); + }; + try { + switchFixture("radio", "Self-test radio fixture"); + check("radio hides seek", $("#seekLine").hidden); + check("radio has two ON AIR indications", !$("#onAirUnderArt").hidden && $(".playlist-row.selected .row-meta")?.textContent === "ON AIR"); + $('[data-mode="repeat"]').click(); + check("mode latches", state.modes.repeat); + $('[data-transport="next"]').click(); + check("next selects a station", state.selected === 1); + $('[data-action="add"]').click(); + check("add changes queue", state.tracks.length === 19); + $('[data-action="new"]').click(); + check("new clears queue", state.tracks.length === 0 && state.playlistName === "UNTITLED"); + $('[data-action="load"]').click(); + check("load restores queue", state.tracks.length === 18); + switchFixture("local", "Self-test local fixture"); + check("local shows seek", !$("#seekLine").hidden); + setVolume(35, false); + check("volume state changes", state.volume === 35); + state.position = state.duration * .72; + updateSeekVisual(); + check("seek state changes", Math.round(Number(seekTrack.getAttribute("aria-valuenow"))) === 72); + scroll.scrollTop = scroll.scrollHeight; + updateScrollbar(); + check("long playlist has scrollbar", !rail.hidden && scroll.scrollTop > 0); + check("fourteen rows fit viewport", Math.abs(rows.children[0].getBoundingClientRect().height * VISIBLE_ROWS - scroll.clientHeight) < 2); + switchFixture("local", "Self-test restored"); + document.documentElement.dataset.selftest = JSON.stringify({passed: true, checks}); + } catch (error) { + document.documentElement.dataset.selftest = JSON.stringify({passed: false, error: error.message, checks}); + console.error(error); + } + } + + initMeters(); + bindEvents(); + renderAll(); + requestAnimationFrame(updateMeters); + + const params = new URLSearchParams(location.search); + if (params.get("state") === "radio") switchFixture("radio"); + if (params.has("benchmark")) runBenchmark(Number(params.get("benchmark")) || 60000); + if (params.has("selftest")) setTimeout(runSelfTest, 50); +})(); +</script> +</body> +</html> diff --git a/working/music-svg-app-design/references/29-alignment-guide.png b/working/music-svg-app-design/references/29-alignment-guide.png Binary files differnew file mode 100644 index 00000000..d8da4ebf --- /dev/null +++ b/working/music-svg-app-design/references/29-alignment-guide.png diff --git a/working/music-svg-app-design/references/dupre-gallery-tall.png b/working/music-svg-app-design/references/dupre-gallery-tall.png Binary files differnew file mode 100644 index 00000000..0f42c2ae --- /dev/null +++ b/working/music-svg-app-design/references/dupre-gallery-tall.png diff --git a/working/music-svg-app-design/references/dupre-gallery.png b/working/music-svg-app-design/references/dupre-gallery.png Binary files differnew file mode 100644 index 00000000..1842fb5a --- /dev/null +++ b/working/music-svg-app-design/references/dupre-gallery.png diff --git a/working/music-svg-app-design/references/waybar-redesign-tall.png b/working/music-svg-app-design/references/waybar-redesign-tall.png Binary files differnew file mode 100644 index 00000000..554dc041 --- /dev/null +++ b/working/music-svg-app-design/references/waybar-redesign-tall.png diff --git a/working/music-svg-app-design/references/waybar-redesign.png b/working/music-svg-app-design/references/waybar-redesign.png Binary files differnew file mode 100644 index 00000000..17e4c307 --- /dev/null +++ b/working/music-svg-app-design/references/waybar-redesign.png diff --git a/working/org-element-cache-persist-bug/README.org b/working/org-element-cache-persist-bug/README.org new file mode 100644 index 00000000..2ad8b1bf --- /dev/null +++ b/working/org-element-cache-persist-bug/README.org @@ -0,0 +1,94 @@ +#+TITLE: org-element persistent-cache corruption — reproduction evidence +#+AUTHOR: Craig Jennings +#+DATE: 2026-07-28 + +* What this is + +Evidence for the org-element cache corruption I chased on 2026-07-28, kept +because the diagnosis outlived the fix. I shipped a fix as =d2103877=, put it +through four hostile reviews, and reverted it on their findings. These scripts +are what the reviews were arguing about. + +Run any of them with: + +: emacs --batch -q -l <script> + +Several of the failing ones never terminate once corruption sets in, because +=org-element--cache-self-verify= floods warnings (one run reached 26 million +lines). Use =timeout=. + +* The actual bug + +=org-element--cache-persist-before-write= (org-element.el:7694) resolves +=(get-file-buffer ...)= and destructively nils =:buffer= on the *live* cache. +The next edit to that buffer then signals =wrong-type-argument stringp nil= +from =org-element--cache-after-change=. + +It needs no second buffer and no dirvish. That is the finding that killed the +fix: I had diagnosed a *trigger* and written the fix against it. + +Which buffer gets corrupted is decided by =buffer-list= order, since +=get-file-buffer= returns the first buffer visiting the file. That is why the +symptom is intermittent, and why any future fix needs a test that controls the +order rather than accepting whatever the harness happens to produce. + +* The scripts + +| File | What it shows | +|----------------------------+-----------------------------------------------------------| +| =hostile-d-nopreview.el= | The root cause. One org buffer, no preview, no dirvish. | +| | =org-persist-write-all-buffer= alone strips =:buffer= | +| | from 6134 elements and the next insert signals. | +|----------------------------+-----------------------------------------------------------| +| =hostile-d-order.el= | Corruption depends on =buffer-list= order. Bury the real | +| | buffer and =get-file-buffer= returns the other one, and | +| | the run comes back clean. | +|----------------------------+-----------------------------------------------------------| +| =hostile-d-faithful.el= | A faithful replay of dirvish's preview, with the real | +| | =dirvish-preview-environment= bindings and buffer naming. | +| | Reproduces. My own replay below was looser. | +|----------------------------+-----------------------------------------------------------| +| =hostile-c-repro.el= | The regression the reverted fix introduced: with | +| | =org-element-cache-persistent= nil in a preview buffer, | +| | =org-element-cache-reset= unregisters the *real* file's | +| | persisted cache and removes it from disk. | +|----------------------------+-----------------------------------------------------------| +| =hostile-a-errorbranch.el= | dirvish.el:671-680 kills the preview buffer on a signal | +| | without ever running =dirvish-preview-setup-hook=, so a | +| | hook-based fix is skipped there. Needs =so-long= enabled | +| | to reach, which it is not here today. | +|----------------------------+-----------------------------------------------------------| +| =hostile-e-ffnoselect.el= | =dirvish--find-file-temporarily= returns the user's | +| | existing buffer, which dirvish later kills. Separate | +| | pre-existing bug, tracked as its own task. | +|----------------------------+-----------------------------------------------------------| +| =repro-preview-cache.el= | My original replay. Kept as the record of what I ran, | +| | not as good evidence: its control differs from it by | +| | three variables, so on its own it cannot attribute cause. | +|----------------------------+-----------------------------------------------------------| +| =control-no-preview.el= | That flawed control. | +|----------------------------+-----------------------------------------------------------| +| =variant-no-kill.el= | Preview created but not killed: clean. Supported the | +| | "the kill is required" framing, which turned out to be | +| | backwards. The persist *write* is causal; the kill only | +| | triggers it. | +|----------------------------+-----------------------------------------------------------| +| =variant-no-persist.el= | Same sequence with persistence off: clean. | +|----------------------------+-----------------------------------------------------------| +| =verify-shipped-fix.el= | The reverted fix suppressing the corruption on the | +| | dirvish path. It did work there. It was aimed one layer | +| | too low and carried a regression. | +|----------------------------+-----------------------------------------------------------| +| =d2103877-reverted.patch= | The reverted commit, kept so the approach is recoverable. | +|----------------------------+-----------------------------------------------------------| + +* What does not reproduce it + +Turning =org-element--cache-self-verify= on does *not* manufacture the error. +It reproduces at org's defaults; self-verify only makes it loud. I had worried +the instrumentation was creating the signal, and it is not. + +* Filed as + +See =todo.org=: the org-element persist task, and the separate dirvish +=find-file-noselect= buffer-kill task. diff --git a/working/org-element-cache-persist-bug/attempt2-tests-blind.el b/working/org-element-cache-persist-bug/attempt2-tests-blind.el new file mode 100644 index 00000000..4e9c4f37 --- /dev/null +++ b/working/org-element-cache-persist-bug/attempt2-tests-blind.el @@ -0,0 +1,190 @@ +;;; test-dirvish-config--preview-org-cache-env.el --- preview org-cache opt-out -*- lexical-binding: t; -*- + +;;; Commentary: +;; Dirvish's fallback preview builds a throwaway buffer, points `buffer-file-name' +;; at the real file (dirvish.el:667) and runs `set-auto-mode' (dirvish.el:671). +;; Previewing an .org file therefore makes a real org-mode buffer that registers +;; with org-persist and picks up a buffer-local `org-persist-write-all-buffer' on +;; `kill-buffer-hook'. When dirvish kills that buffer, the write fires, +;; `org-element--cache-persist-before-write' resolves `get-file-buffer' to the +;; user's REAL buffer, and nils `:buffer' across its live element cache. The next +;; access to a cached headline then runs +;; `org-element--headline-parse-title', whose first form is +;; `(with-current-buffer (org-element-property :buffer headline))' -- and +;; `set-buffer' on nil signals `wrong-type-argument stringp nil'. +;; +;; Dirvish let-binds `dirvish-preview-environment' around `set-auto-mode', so +;; adding `(org-element-use-cache . nil)' there stops the preview buffer ever +;; registering. Nothing is written mid-session and the real buffer is untouched. +;; +;; Coverage note, stated plainly: the wiring tests below assert the alist entry, +;; and the behavioral test drives the corruption sequence directly rather than +;; through dirvish. Neither runs dirvish's own preview machinery, so a change in +;; how dirvish applies the environment would not be caught here. That gap is +;; covered by a live check in the running daemon. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'package) +(require 'org) +(require 'org-element) +(require 'org-persist) + +(setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) +(package-initialize) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "elpa/dirvish-2.3.0/extensions" + user-emacs-directory)) +(require 'user-constants) +(require 'keybindings) +(require 'dirvish-config) + +;;; ----------------------------- the wiring ----------------------------------- + +(ert-deftest test-dirvish-preview-env-disables-org-cache () + "Normal: `dirvish-preview-environment' turns the element cache off. +This is the entry dirvish let-binds around `set-auto-mode', so it is what keeps +an org preview buffer from registering with org-persist." + (should (member '(org-element-use-cache . nil) dirvish-preview-environment))) + +(ert-deftest test-dirvish-preview-env-keeps-upstream-entries () + "Boundary: the upstream entries survive alongside ours. +Replacing the alist rather than extending it would silently drop dirvish's own +bindings, and preview would start honouring dir-locals and printing messages." + (dolist (pair '((inhibit-message . t) + (non-essential . t) + (enable-dir-local-variables . nil) + (enable-local-variables . :safe))) + (should (member pair dirvish-preview-environment)))) + +(ert-deftest test-dirvish-preview-env-entry-is-not-duplicated () + "Boundary: the entry appears exactly once. +The module can be re-loaded into a running daemon, so the wiring has to be +idempotent rather than appending on every load." + (should (= 1 (cl-count 'org-element-use-cache dirvish-preview-environment + :key #'car)))) + +;;; --------------------------- the behavior ----------------------------------- + +(defun cj--test-preview-buffer (file env) + "Build a dirvish-style preview buffer for FILE with ENV bound, and return it. +Mirrors `dirvish--preview-file-maybe-truncate': real `buffer-file-name', then +`set-auto-mode' under the preview environment." + (with-current-buffer (get-buffer-create "*cj-test-preview*") + (with-silent-modifications + (insert-file-contents file nil 0 1048576) + (setq buffer-file-name file) + (goto-char (point-min)) + (rename-buffer (format "PREVIEW :: 1 :: %s" (file-name-nondirectory file)))) + ;; Dynamic `eval', matching dirvish.el:672 -- NOT lexical. Under lexical + ;; binding a non-special symbol would bind lexically and never reach + ;; `set-auto-mode', so the replay would silently no-op and the test would + ;; pass for the wrong reason. Same trap as the json-object-type gotcha. + (eval `(let ,(mapcar (lambda (e) `(,(car e) ',(cdr e))) env) + (setq-local delay-mode-hooks t) + (set-auto-mode) + (font-lock-mode 1))) + (current-buffer))) + +(defun cj--test-persisted-p (file) + "Return non-nil when FILE still has a registered org-element cache collection." + (and (org-persist--find-index + (org-persist--normalize-associated (list :file file))) + t)) + +(defun cj--test-cached-buffers (buf) + "Return the distinct `:buffer' values cached in BUF's element cache." + (with-current-buffer buf + (let (seen) + (avl-tree-mapc (lambda (el) (push (org-element-property :buffer el) seen)) + org-element--cache) + (delete-dups seen)))) + +(defmacro cj--with-org-fixture (var &rest body) + "Bind VAR to a live buffer visiting a populated org fixture, then run BODY." + (declare (indent 1)) + `(let* ((dir (make-temp-file "cj-preview-" t)) + (org-persist-directory (expand-file-name "persist" dir)) + (file (expand-file-name "notes.org" dir)) + (org-element-use-cache t) + (org-element-cache-persistent t) + (org-log-done nil)) + (with-temp-file file + (dotimes (i 30) (insert (format "* TODO task %d :t%d:\nbody %d\n" i i i)))) + (let ((,var (find-file-noselect file))) + (unwind-protect + (progn + (with-current-buffer ,var + (org-element-cache-reset) + (org-element-cache-map #'ignore :granularity 'headline) + ;; Closing a task is what actually lands parsed headline elements + ;; in the cache carrying a `:buffer'. Without it the cache stays + ;; empty and every assertion below passes vacuously against nil. + (goto-char (point-min)) + (re-search-forward "^\\* TODO task 0 ") + (beginning-of-line) + (org-todo "DONE")) + (should (cj--test-cached-buffers ,var)) + ,@body) + (when (buffer-live-p ,var) + (with-current-buffer ,var (set-buffer-modified-p nil)) + (kill-buffer ,var)) + (delete-directory dir t))))) + +(ert-deftest test-dirvish-preview-env-protects-the-real-buffer () + "Normal: previewing an already-open org file leaves its cache intact. +The whole point of the entry -- with it, killing the preview must not strip +`:buffer' from the real buffer's cached elements." + (cj--with-org-fixture real + (should (member real (cj--test-cached-buffers real))) + (let ((preview (cj--test-preview-buffer (buffer-file-name real) + dirvish-preview-environment))) + (let (kill-buffer-query-functions) (kill-buffer preview))) + (should (member real (cj--test-cached-buffers real))) + (should-not (member nil (cj--test-cached-buffers real))))) + +(ert-deftest test-dirvish-preview-env-real-buffer-still-parses () + "Normal: the real buffer still parses after the preview is killed. +Asserting on `:buffer' alone would pass against a cache that is broken in some +other way, so this drives the access path that actually signalled." + (cj--with-org-fixture real + (let ((preview (cj--test-preview-buffer (buffer-file-name real) + dirvish-preview-environment))) + (let (kill-buffer-query-functions) (kill-buffer preview))) + (with-current-buffer real + (should (equal "OK" + (condition-case err + (progn (org-element-cache-map + (lambda (el) (org-element-property :raw-value el)) + :granularity 'headline) + "OK") + (error (format "%S" err)))))))) + +(ert-deftest test-dirvish-preview-env-without-the-entry-corrupts () + "Error: the same sequence WITHOUT the entry does corrupt the real buffer. +This is the control. Without it the two tests above could pass because the +corruption never happens in this harness at all, rather than because the entry +prevents it." + (cj--with-org-fixture real + (let* ((bare (assq-delete-all 'org-element-use-cache + (copy-alist dirvish-preview-environment))) + (preview (cj--test-preview-buffer (buffer-file-name real) bare))) + (let (kill-buffer-query-functions) (kill-buffer preview))) + (should (member nil (cj--test-cached-buffers real))))) + +(ert-deftest test-dirvish-preview-env-spares-an-unopened-file () + "Boundary: previewing an org file that is NOT open harms nothing. +`org-element--cache-persist-before-write' only acts when `get-file-buffer' +finds a live buffer, so this path was never at risk and must stay cheap." + (cj--with-org-fixture real + (let* ((other (expand-file-name "other.org" (file-name-directory + (buffer-file-name real))))) + (with-temp-file other (insert "* TODO unrelated\n")) + (let ((preview (cj--test-preview-buffer other dirvish-preview-environment))) + (let (kill-buffer-query-functions) (kill-buffer preview)))) + (should-not (member nil (cj--test-cached-buffers real))))) + +(provide 'test-dirvish-config--preview-org-cache-env) +;;; test-dirvish-config--preview-org-cache-env.el ends here diff --git a/working/org-element-cache-persist-bug/control-no-preview.el b/working/org-element-cache-persist-bug/control-no-preview.el new file mode 100644 index 00000000..5f5ad3f2 --- /dev/null +++ b/working/org-element-cache-persist-bug/control-no-preview.el @@ -0,0 +1,62 @@ +;;; repro-preview-cache.el --- Does dirvish's text preview disturb an org buffer's element cache? -*- lexical-binding: t -*- + +;; Replays `dirvish--preview-file-maybe-truncate' (dirvish.el:653-684) against an +;; org file that is ALSO open for real, then kills the preview buffer the way +;; dirvish does (`dirvish--kill-buffer', dirvish.el:416). The kill is the step +;; that matters: killing an org-mode buffer with a `buffer-file-name' is when +;; org-persist writes that file's cache. + +(require 'org) +(require 'org-element) +(require 'org-persist) + +(setq org-element-use-cache t + org-element-cache-persistent t + org-element--cache-self-verify t + org-element--cache-self-verify-frequency 1.0) + +(defun repro--build-cache (buf) + "Actually populate the element cache of BUF by walking it." + (with-current-buffer buf + (org-element-cache-map (lambda (_el) nil) :granularity 'element) + (and org-element--cache (avl-tree-size org-element--cache)))) + +(defun repro--warnings () + (when (get-buffer "*Warnings*") + (with-current-buffer "*Warnings*" (string-trim (buffer-string))))) + +(let* ((src (expand-file-name "todo.org" default-directory)) + (file (make-temp-file "repro-" nil ".org")) + (threshold 1048576)) + (copy-file src file t) + (let ((size (nth 7 (file-attributes file)))) + (message "== fixture %s (%d bytes, %s threshold) ==" + (file-name-nondirectory file) size + (if (>= size threshold) "over" "under"))) + + (let ((real (find-file-noselect file))) + (message "real buffer cache after full walk: %S" (repro--build-cache real)) + + (message "CONTROL: preview step skipped entirely") + + ;; --- dirvish kills the preview buffer when the session ends --- + (let ((kill-buffer-query-functions nil) + (preview (format "PREVIEW :: %s" (file-name-nondirectory file)))) + (when (get-buffer preview) (kill-buffer preview)) + (message "preview buffer %S killed" preview)) + + ;; --- is the real buffer still coherent? --- + (with-current-buffer real + ;; Edit it the way Craig would after stepping back from dirvish. + (goto-char (point-max)) + (let ((inhibit-read-only t)) (insert "\n* Repro edit\n")) + (condition-case err + (progn (org-element-cache-map (lambda (_el) nil) :granularity 'element) + (message "post-kill cache-map: clean (size=%S)" + (avl-tree-size org-element--cache))) + (error (message "post-kill cache-map: ERROR %S" err))) + (set-buffer-modified-p nil)) + + (message "warnings=%s" (or (repro--warnings) "none"))) + + (delete-file file)) diff --git a/working/org-element-cache-persist-bug/d2103877-reverted.patch b/working/org-element-cache-persist-bug/d2103877-reverted.patch new file mode 100644 index 00000000..512c6abd --- /dev/null +++ b/working/org-element-cache-persist-bug/d2103877-reverted.patch @@ -0,0 +1,199 @@ +commit d2103877f677463cbf113df951f388aaaa4a06ea +Author: Craig Jennings <c@cjennings.net> +Date: Tue Jul 28 18:25:03 2026 -0500 + + fix(dirvish): keep org previews out of the persistent element cache + + - Previewing an open .org file corrupted that file's element cache. + - The next edit to it signalled wrong-type-argument stringp nil. + - Dirvish's fallback preview claims the real file's buffer-file-name. + - set-auto-mode then makes it a second org-mode buffer. + - Killing that preview is what breaks the original buffer. + + I made the opt-out buffer-local, so real org buffers keep persistence. + + That error string is the one cj/org-clear-element-cache was written for, + so the workaround had been hiding this. + +diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el +index edbb0b35..ef5966c9 100644 +--- a/modules/dirvish-config.el ++++ b/modules/dirvish-config.el +@@ -833,7 +833,41 @@ Returns nil if not in a project." + ;; No project found + (t nil))) + +- ++;;; ------------------- Dirvish Preview Org-Element Cache Opt-Out --------------- ++;; dirvish's `fallback' dispatcher previews any file it has no media handler for, ++;; and `dirvish--preview-file-maybe-truncate' builds that preview by pointing ++;; `buffer-file-name' at the real file and running `set-auto-mode'. Previewing an ++;; .org file therefore yields a SECOND org-mode buffer claiming an already-open ++;; file's name. When dirvish later kills that preview buffer, the real buffer's ++;; org-element cache is left corrupt, and the next edit to it signals ++;; `wrong-type-argument stringp nil' from `org-element--cache-after-change'. ++;; ++;; Reproduced 2026-07-28 with controls: no preview is clean, a preview left alive ++;; is clean, and the same sequence with `org-element-cache-persistent' nil is ++;; clean -- so the kill is required and the persistent cache is the mechanism. ++;; (That error string is the one `cj/org-clear-element-cache' was written for, ++;; which is how this hid for so long: the workaround was already in the config.) ++;; ++;; Opting the throwaway preview buffer out of the persistent cache is enough. It ++;; is deliberately buffer-local: the real org buffers must keep persistence. ++ ++;; A variable, not a function -- declared so the byte-compiler knows it is ++;; special without pulling org-element onto dirvish's load path. ++(defvar org-element-cache-persistent) ++ ++(defun cj/--dirvish-preview-disable-org-cache-persist () ++ "Opt a dirvish org-mode preview buffer out of the persistent element cache. ++Runs from `dirvish-preview-setup-hook' in the preview buffer. Does nothing ++outside org-mode, and nothing when `org-element-cache-persistent' is unbound -- ++a signal here would abort dirvish's preview rendering, so every branch is a ++no-op rather than an error. Returns nil." ++ (when (and (derived-mode-p 'org-mode) ++ (boundp 'org-element-cache-persistent)) ++ (setq-local org-element-cache-persistent nil)) ++ nil) ++ ++(add-hook 'dirvish-preview-setup-hook ++ #'cj/--dirvish-preview-disable-org-cache-persist) + + (provide 'dirvish-config) + ;;; dirvish-config.el ends here. +diff --git a/tests/test-dirvish-config--preview-org-cache.el b/tests/test-dirvish-config--preview-org-cache.el +new file mode 100644 +index 00000000..233b04a8 +--- /dev/null ++++ b/tests/test-dirvish-config--preview-org-cache.el +@@ -0,0 +1,129 @@ ++;;; test-dirvish-config--preview-org-cache.el --- preview org-cache opt-out tests -*- lexical-binding: t; -*- ++ ++;;; Commentary: ++;; Dirvish's fallback preview builds a buffer, points `buffer-file-name' at the ++;; real file, and runs `set-auto-mode' -- so previewing an .org file yields a ++;; second org-mode buffer claiming an open file's name. Killing that preview ++;; buffer corrupted the real buffer's element cache, surfacing as ++;; `wrong-type-argument stringp nil' on the next edit. Reproduced 2026-07-28 ++;; with controls: the kill is required, and `org-element-cache-persistent' is ++;; the mechanism (nil made the same sequence clean). ++;; ++;; `cj/--dirvish-preview-disable-org-cache-persist' opts the preview buffer out ++;; of the persistent cache, buffer-locally, leaving the real buffer alone. ++ ++;;; Code: ++ ++(require 'ert) ++(require 'org-element) ++(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) ++(require 'dirvish-config) ++ ++(declare-function cj/--dirvish-preview-disable-org-cache-persist "dirvish-config" ()) ++ ++;;; ----------------------------- Normal cases --------------------------------- ++ ++(ert-deftest test-dirvish-preview-org-cache-disables-in-org-buffer () ++ "Normal: an org-mode preview buffer opts out of the persistent cache." ++ (with-temp-buffer ++ (delay-mode-hooks (org-mode)) ++ (cj/--dirvish-preview-disable-org-cache-persist) ++ (should (local-variable-p 'org-element-cache-persistent)) ++ (should-not org-element-cache-persistent))) ++ ++(ert-deftest test-dirvish-preview-org-cache-leaves-global-alone () ++ "Normal: the opt-out is buffer-local and never touches the global value. ++The real org buffers must keep their persistent cache; only the throwaway ++preview buffer opts out. Asserting the global default explicitly is the point ++of this test -- a buffer-local set that leaked to the default would disable ++persistence everywhere and still pass every other test here." ++ (let ((original (default-value 'org-element-cache-persistent))) ++ (unwind-protect ++ (progn ++ (setq-default org-element-cache-persistent t) ++ (with-temp-buffer ++ (delay-mode-hooks (org-mode)) ++ (cj/--dirvish-preview-disable-org-cache-persist) ++ (should-not org-element-cache-persistent)) ++ ;; The default survived the buffer-local set. ++ (should (eq (default-value 'org-element-cache-persistent) t)) ++ ;; And a fresh org buffer still inherits persistence. ++ (with-temp-buffer ++ (delay-mode-hooks (org-mode)) ++ (should org-element-cache-persistent))) ++ (setq-default org-element-cache-persistent original)))) ++ ++;;; ---------------------------- Boundary cases -------------------------------- ++ ++(ert-deftest test-dirvish-preview-org-cache-ignores-non-org-buffer () ++ "Boundary: a non-org preview buffer is left completely alone." ++ (with-temp-buffer ++ (fundamental-mode) ++ (cj/--dirvish-preview-disable-org-cache-persist) ++ (should-not (local-variable-p 'org-element-cache-persistent)))) ++ ++(ert-deftest test-dirvish-preview-org-cache-covers-derived-mode () ++ "Boundary: a mode derived from org-mode still opts out. ++The check is `derived-mode-p', not an `eq' on `major-mode', so org derivatives ++previewed by dirvish are covered too." ++ (with-temp-buffer ++ (delay-mode-hooks (org-mode)) ++ (define-derived-mode cj-test-org-derived-mode org-mode "TestOrg" ++ "Throwaway org derivative for this test.") ++ (delay-mode-hooks (cj-test-org-derived-mode)) ++ (cj/--dirvish-preview-disable-org-cache-persist) ++ (should (local-variable-p 'org-element-cache-persistent)) ++ (should-not org-element-cache-persistent))) ++ ++(ert-deftest test-dirvish-preview-org-cache-is-idempotent () ++ "Boundary: running twice in one buffer is a no-op the second time." ++ (with-temp-buffer ++ (delay-mode-hooks (org-mode)) ++ (cj/--dirvish-preview-disable-org-cache-persist) ++ (cj/--dirvish-preview-disable-org-cache-persist) ++ (should (local-variable-p 'org-element-cache-persistent)) ++ (should-not org-element-cache-persistent))) ++ ++;;; ------------------------------ Error cases --------------------------------- ++ ++(ert-deftest test-dirvish-preview-org-cache-survives-missing-variable () ++ "Error: no signal when `org-element-cache-persistent' is not bound. ++The function runs from a dirvish hook; an error there would break preview ++rendering, so a missing org internal must degrade to a no-op. ++ ++Drives real state rather than mocking `boundp'. `boundp' is a C primitive, and ++redefining one is unreliable under native-comp -- a natively-compiled caller can ++run the real primitive through a trampoline and quietly ignore the mock, which ++would turn this into a test that passes without exercising the guard. Org-mode ++is entered before the unbind so mode setup never reads the missing variable." ++ (let* ((bound (boundp 'org-element-cache-persistent)) ++ (original (and bound (default-value 'org-element-cache-persistent)))) ++ (unwind-protect ++ (with-temp-buffer ++ (delay-mode-hooks (org-mode)) ++ (makunbound 'org-element-cache-persistent) ++ (should-not (boundp 'org-element-cache-persistent)) ++ (should-not (cj/--dirvish-preview-disable-org-cache-persist)) ++ ;; The guard declined to create a binding rather than erroring. ++ (should-not (local-variable-p 'org-element-cache-persistent))) ++ (when bound (setq-default org-element-cache-persistent original))))) ++ ++(ert-deftest test-dirvish-preview-org-cache-runs-in-a-fileless-buffer () ++ "Error: a buffer with no `buffer-file-name' is handled without signalling." ++ (with-temp-buffer ++ (delay-mode-hooks (org-mode)) ++ (should-not (buffer-file-name)) ++ (cj/--dirvish-preview-disable-org-cache-persist) ++ (should-not org-element-cache-persistent))) ++ ++;;; ----------------------------- Registration --------------------------------- ++ ++(ert-deftest test-dirvish-preview-org-cache-hook-registered () ++ "Normal: the opt-out is on `dirvish-preview-setup-hook'. ++Registration is the half that makes the fix reach dirvish at all -- the ++function being correct is useless if nothing calls it." ++ (should (memq 'cj/--dirvish-preview-disable-org-cache-persist ++ (default-value 'dirvish-preview-setup-hook)))) ++ ++(provide 'test-dirvish-config--preview-org-cache) ++;;; test-dirvish-config--preview-org-cache.el ends here diff --git a/working/org-element-cache-persist-bug/hostile-a-errorbranch.el b/working/org-element-cache-persist-bug/hostile-a-errorbranch.el new file mode 100644 index 00000000..88711787 --- /dev/null +++ b/working/org-element-cache-persist-bug/hostile-a-errorbranch.el @@ -0,0 +1,76 @@ +;;; hostile-a-errorbranch.el --- attack the dirvish.el:680 error branch -*- lexical-binding: t -*- + +;; dirvish--preview-file-maybe-truncate (dirvish.el:671-680) wraps +;; (set-auto-mode) (font-lock-mode 1) (and so-long-detected-p (error ...)) +;; in a condition-case. On ANY error the buffer is KILLED at line 680 and +;; `dirvish-preview-setup-hook' at line 682 is NEVER reached. By then +;; set-auto-mode has already put the buffer in org-mode with buffer-file-name +;; pointing at the real file. So the shipped fix cannot run on that path. + +(require 'org) (require 'org-element) (require 'org-persist) +(add-to-list 'load-path (expand-file-name "modules" default-directory)) +(require 'dirvish-config) + +(setq org-element-use-cache t + org-element-cache-persistent t + org-element--cache-self-verify t + org-element--cache-self-verify-frequency 1.0) + +(defun h--walk (buf) + (with-current-buffer buf + (org-element-cache-map (lambda (_e) nil) :granularity 'element) + (and org-element--cache (avl-tree-size org-element--cache)))) + +;; Faithful replay of dirvish.el:657-684, including the condition-case and the +;; error-branch kill. ERROR-INJECT non-nil simulates so-long-detected-p / any +;; other signal raised AFTER set-auto-mode has entered org-mode. +(defun h--preview (file error-inject) + (with-current-buffer (get-buffer-create "*preview-temp*") + (let ((threshold 1048576) info jka-compr-verbose) + (with-silent-modifications + (setq buffer-read-only t) + (insert-file-contents file nil 0 threshold) + (setq buffer-file-name file) + (goto-char (point-min)) + (rename-buffer (format "PREVIEW :: 999 :: %s" (file-name-nondirectory file)))) + (condition-case err + (let ((enable-dir-local-variables nil) (enable-local-variables :safe) + (non-essential t) (inhibit-message t)) + (setq-local delay-mode-hooks t) + (set-auto-mode) (font-lock-mode 1) + (and error-inject (error "No preview of file with long lines"))) + (error (setq info (error-message-string err)))) + (message " preview: mode=%s file=%s persist-local=%s registered-kill-hook=%s" + major-mode (and buffer-file-name t) + (local-variable-p 'org-element-cache-persistent) + (and (memq 'org-persist-write-all-buffer kill-buffer-hook) t)) + (if info + (progn (message " ERROR BRANCH taken (%s) -> kill WITHOUT hook" info) + (let (kill-buffer-query-functions) (kill-buffer (current-buffer)))) + (run-hooks 'dirvish-preview-setup-hook) + (message " ok branch: hook ran, persist-local=%s value=%s" + (local-variable-p 'org-element-cache-persistent) + org-element-cache-persistent) + (let (kill-buffer-query-functions) (kill-buffer (current-buffer))))))) + +(defun h--trial (label error-inject) + (let* ((src (expand-file-name "todo.org" default-directory)) + (file (make-temp-file "hostile-" nil ".org"))) + (copy-file src file t) + (message "== %s ==" label) + (let ((real (find-file-noselect file))) + (message " real cache: %S" (h--walk real)) + (h--preview file error-inject) + (with-current-buffer real + (goto-char (point-max)) + (condition-case err + (progn (let ((inhibit-read-only t)) (insert "\n* Hostile edit\n")) + (org-element-cache-map (lambda (_e) nil) :granularity 'element) + (message " RESULT: CLEAN (size=%S)" (avl-tree-size org-element--cache))) + (error (message " RESULT: CORRUPT -> %S" err))) + (set-buffer-modified-p nil)) + (let (kill-buffer-query-functions) (kill-buffer real))) + (delete-file file))) + +(h--trial "control: no error, hook runs (shipped fix active)" nil) +(h--trial "attack: error after set-auto-mode -> hook skipped" t) diff --git a/working/org-element-cache-persist-bug/hostile-c-repro.el b/working/org-element-cache-persist-bug/hostile-c-repro.el new file mode 100644 index 00000000..17627e63 --- /dev/null +++ b/working/org-element-cache-persist-bug/hostile-c-repro.el @@ -0,0 +1,32 @@ +;;; -*- lexical-binding: t -*- +(setq org-persist-directory (expand-file-name "hostile-c-persist" default-directory)) +(require 'org) +(require 'org-element) +(require 'org-persist) +(let* ((f (expand-file-name "hostile-c-real.org" default-directory))) + (with-temp-file f (insert "* Head one\nbody\n* Head two\n")) + ;; 1. the REAL buffer, as Craig has open + (let ((real (find-file-noselect f))) + (with-current-buffer real (org-element-at-point (point-max))) + (princ (format "real registered: %S\n" + (and (org-persist--find-index + `(:container ,(org-persist--normalize-container + `((elisp org-element--cache) (version ,org-element-cache-version))) + :associated ,(org-persist--normalize-associated real))) + t))) + ;; 2. dirvish preview: second org buffer claiming the same file name + (let ((prev (get-buffer-create "PREVIEW :: hostile-c-real.org"))) + (with-current-buffer prev + (insert-file-contents f) + (setq buffer-file-name f) + (delay-mode-hooks (org-mode)) + ;; the commit's hook + (setq-local org-element-cache-persistent nil) + ;; 3. anything that resets the cache in this live preview buffer + (org-element-cache-reset)) + (princ (format "real registered AFTER preview reset: %S\n" + (and (org-persist--find-index + `(:container ,(org-persist--normalize-container + `((elisp org-element--cache) (version ,org-element-cache-version))) + :associated ,(org-persist--normalize-associated real))) + t)))))) diff --git a/working/org-element-cache-persist-bug/hostile-d-faithful.el b/working/org-element-cache-persist-bug/hostile-d-faithful.el new file mode 100644 index 00000000..bbd0aecb --- /dev/null +++ b/working/org-element-cache-persist-bug/hostile-d-faithful.el @@ -0,0 +1,48 @@ +;; Faithful replay: real dirvish env incl. delay-mode-hooks, inhibit-message, +;; timestamped buffer name, preview-hash text reuse, dirvish--kill-buffer shape. +(require 'cl-lib) (require 'org) (require 'org-element) (require 'org-persist) +(when (getenv "FIX") + (add-to-list 'load-path (expand-file-name "modules" default-directory)) + (require 'dirvish-config)) +(setq org-element-use-cache t org-element-cache-persistent t) +(defvar hash (make-hash-table :test 'equal)) +(defun nilbuf (b) (with-current-buffer b + (let ((k 0)) (avl-tree-mapc (lambda (e) (unless (org-element-property :buffer e) (cl-incf k))) org-element--cache) k))) +(defun preview (file name) + (with-current-buffer (get-buffer-create "*preview-temp*") + (let ((text (gethash file hash)) info jka-compr-verbose) + (with-silent-modifications + (setq buffer-read-only t) + (if text (insert text) (insert-file-contents file nil 0 1048576)) + (setq buffer-file-name file) (goto-char (point-min)) + (rename-buffer name)) + (condition-case err + (eval `(let ((inhibit-message t) (non-essential t) + (enable-dir-local-variables nil) (enable-local-variables :safe)) + (setq-local delay-mode-hooks t) + (set-auto-mode) (font-lock-mode 1))) + (error (setq info (error-message-string err)))) + (if info (message ">> preview aborted: %s" info) + (run-hooks 'dirvish-preview-setup-hook) + (unless text (puthash file (buffer-string) hash))) + (message ">> preview mode=%s delay-mode-hooks=%S persist=%S" + major-mode delay-mode-hooks org-element-cache-persistent) + (current-buffer)))) +(defun dv-kill (b) (and (buffer-live-p b) (let (kill-buffer-query-functions) (kill-buffer b)))) +(let* ((file (make-temp-file "fa-" nil ".org"))) + (copy-file (expand-file-name "todo.org" default-directory) file t) + (let ((real (find-file-noselect file))) + (with-current-buffer real (org-element-cache-map (lambda (_) nil) :granularity 'element)) + (message ">> real nil-buffer before=%d" (nilbuf real)) + ;; pass 1 + (dv-kill (preview file (format "PREVIEW :: %s :: %s" "1753000000" (file-name-nondirectory file)))) + (message ">> after pass1 kill nil-buffer=%d gfb=%S" (nilbuf real) (buffer-name (get-file-buffer file))) + ;; pass 2 (hash hit: text branch) + (dv-kill (preview file (format "PREVIEW :: %s :: %s" "1753000001" (file-name-nondirectory file)))) + (message ">> after pass2 kill nil-buffer=%d" (nilbuf real)) + (with-current-buffer real + (goto-char (point-max)) + (condition-case err (let ((inhibit-read-only t)) (insert "\n* E\n")) + (error (message ">> RESULT: SIGNALLED %S" err))) + (message ">> edit completed") (set-buffer-modified-p nil))) + (delete-file file)) diff --git a/working/org-element-cache-persist-bug/hostile-d-nopreview.el b/working/org-element-cache-persist-bug/hostile-d-nopreview.el new file mode 100644 index 00000000..91ae1ce7 --- /dev/null +++ b/working/org-element-cache-persist-bug/hostile-d-nopreview.el @@ -0,0 +1,23 @@ +(require 'cl-lib) (require 'org) (require 'org-element) (require 'org-persist) +(setq org-element-use-cache t org-element-cache-persistent t) +(when (getenv "SV") (setq org-element--cache-self-verify t org-element--cache-self-verify-frequency 1.0)) +(defun nilbuf (buf) (with-current-buffer buf + (let ((k 0)) (avl-tree-mapc (lambda (el) (unless (org-element-property :buffer el) (cl-incf k))) org-element--cache) k))) +(let* ((file (make-temp-file "np-" nil ".org"))) + (copy-file (expand-file-name "todo.org" default-directory) file t) + (let ((real (find-file-noselect file))) + (with-current-buffer real (org-element-cache-map (lambda (_) nil) :granularity 'element)) + (message ">> before: nil-buffer=%d" (nilbuf real)) + (message ">> MODE=%s" (getenv "MODE")) + (pcase (getenv "MODE") + ("writeall" (org-persist-write-all)) + ("writebuf" (with-current-buffer real (org-persist-write-all-buffer))) + (_ nil)) + (message ">> after trigger: nil-buffer=%d" (nilbuf real)) + (with-current-buffer real + (goto-char (point-max)) + (condition-case err (let ((inhibit-read-only t)) (insert "\n* Edit\n")) + (error (message ">> RESULT: insert SIGNALLED %S" err))) + (message ">> insert survived (nil-buffer=%d)" (nilbuf real)) + (set-buffer-modified-p nil))) + (delete-file file)) diff --git a/working/org-element-cache-persist-bug/hostile-d-order.el b/working/org-element-cache-persist-bug/hostile-d-order.el new file mode 100644 index 00000000..898e90fe --- /dev/null +++ b/working/org-element-cache-persist-bug/hostile-d-order.el @@ -0,0 +1,30 @@ +(require 'cl-lib) (require 'org) (require 'org-element) (require 'org-persist) +(setq org-element-use-cache t org-element-cache-persistent t) +(defun nilbuf (buf) (with-current-buffer buf + (let ((k 0)) (avl-tree-mapc (lambda (el) (unless (org-element-property :buffer el) (cl-incf k))) org-element--cache) k))) +(let* ((file (make-temp-file "ord-" nil ".org"))) + (copy-file (expand-file-name "todo.org" default-directory) file t) + (let ((real (find-file-noselect file))) + (with-current-buffer real (org-element-cache-map (lambda (_) nil) :granularity 'element)) + (with-current-buffer (get-buffer-create "*preview-temp*") + (let (jka-compr-verbose) + (with-silent-modifications + (setq buffer-read-only t) (insert-file-contents file nil 0 1048576) + (setq buffer-file-name file) (goto-char (point-min)) (rename-buffer "PREVIEW")) + (let ((enable-dir-local-variables nil) (enable-local-variables :safe) (non-essential t)) + (set-auto-mode) (font-lock-mode 1))) + (org-element-cache-map (lambda (_) nil) :granularity 'element)) + (when (equal (getenv "BURY") "1") + (bury-buffer real) + (message ">> buried real")) + (message ">> get-file-buffer -> %S (buffer-list head: %S)" + (buffer-name (get-file-buffer file)) + (mapcar #'buffer-name (seq-take (buffer-list) 4))) + (let ((kill-buffer-query-functions nil)) (kill-buffer "PREVIEW")) + (message ">> after kill nil-buffer=%d" (nilbuf real)) + (with-current-buffer real + (goto-char (point-max)) + (condition-case err (let ((inhibit-read-only t)) (insert "\n* E\n")) + (error (message ">> RESULT: SIGNALLED %S" err))) + (message ">> done") (set-buffer-modified-p nil))) + (delete-file file)) diff --git a/working/org-element-cache-persist-bug/hostile-e-ffnoselect.el b/working/org-element-cache-persist-bug/hostile-e-ffnoselect.el new file mode 100644 index 00000000..b4c474ba --- /dev/null +++ b/working/org-element-cache-persist-bug/hostile-e-ffnoselect.el @@ -0,0 +1,8 @@ +(let ((f (make-temp-file "h-e-" nil ".org"))) + (with-temp-file f (insert "* real\n")) + (let* ((real (find-file-noselect f)) + (temp (cdr `(buffer . ,(eval `(let ((vc-follow-symlinks t) (find-file-hook nil)) + (find-file-noselect ,f 'nowarn))))))) + (message "find-file-temporarily returned the USER'S buffer: %s (same=%s) name=%s" + (buffer-name temp) (eq real temp) (buffer-name real))) + (delete-file f)) diff --git a/working/org-element-cache-persist-bug/refute-fontify-rearms.el b/working/org-element-cache-persist-bug/refute-fontify-rearms.el new file mode 100644 index 00000000..fd55194b --- /dev/null +++ b/working/org-element-cache-persist-bug/refute-fontify-rearms.el @@ -0,0 +1,49 @@ +;; Does the preview buffer re-register after the let unwinds, on fontification? +(require 'org) (require 'org-element) (require 'org-persist) +(defvar rk-dir (make-temp-file "refute-" t)) +(setq org-persist-directory (expand-file-name "persist" rk-dir)) +(setq org-element-use-cache t org-element-cache-persistent t org-log-done nil) +(defvar rk-file (expand-file-name "notes.org" rk-dir)) +(with-temp-file rk-file + (dotimes (i 20) (insert (format "* TODO task %d\nbody with src_python{1+1} inline\n" i)))) + +(defun rk-bufs (buf) + (with-current-buffer buf + (let (s) (avl-tree-mapc (lambda (el) (push (org-element-property :buffer el) s)) + org-element--cache) + (delete-dups s)))) + +(let ((real (find-file-noselect rk-file))) + (with-current-buffer real + (org-element-cache-reset) + (org-element-cache-map #'ignore :granularity 'headline) + (goto-char (point-min)) (re-search-forward "^\\* TODO task 0") (beginning-of-line) + (org-todo "DONE")) + (message "before: %S" (rk-bufs real)) + ;; preview WITH the fix's environment, then let it LIVE and fontify (the step my tests skip) + (let ((prev (get-buffer-create "*prev*"))) + (with-current-buffer prev + (with-silent-modifications + (insert-file-contents rk-file nil 0 1048576) + (setq buffer-file-name rk-file)) + (eval `(let ((inhibit-message t) (non-essential t) + (enable-dir-local-variables nil) (enable-local-variables :safe) + (org-element-use-cache nil)) + (setq-local delay-mode-hooks t) (set-auto-mode) (font-lock-mode 1))) + (message "after set-auto-mode: local-cache=%S global=%S persist-hook=%S" + org-element-use-cache (default-value 'org-element-use-cache) + (and (memq 'org-persist-write-all-buffer kill-buffer-hook) t)) + ;; THE MISSING STEP: the preview lives in a window and gets fontified + (font-lock-ensure) + (message "after fontify: persist-hook=%S cache-active=%S" + (and (memq 'org-persist-write-all-buffer kill-buffer-hook) t) + (org-element--cache-active-p))) + (let (kill-buffer-query-functions) (kill-buffer prev))) + (message "after kill: %S" (rk-bufs real)) + (with-current-buffer real + (message "parse => %s" + (condition-case e (progn (org-element-cache-map + (lambda (el) (org-element-property :raw-value el)) + :granularity 'headline) "OK") + (error (format "ERROR %S" e)))))) +(delete-directory rk-dir t) diff --git a/working/org-element-cache-persist-bug/repro-preview-cache.el b/working/org-element-cache-persist-bug/repro-preview-cache.el new file mode 100644 index 00000000..2a527af1 --- /dev/null +++ b/working/org-element-cache-persist-bug/repro-preview-cache.el @@ -0,0 +1,88 @@ +;;; repro-preview-cache.el --- Does dirvish's text preview disturb an org buffer's element cache? -*- lexical-binding: t -*- + +;; Replays `dirvish--preview-file-maybe-truncate' (dirvish.el:653-684) against an +;; org file that is ALSO open for real, then kills the preview buffer the way +;; dirvish does (`dirvish--kill-buffer', dirvish.el:416). The kill is the step +;; that matters: killing an org-mode buffer with a `buffer-file-name' is when +;; org-persist writes that file's cache. + +(require 'org) +(require 'org-element) +(require 'org-persist) + +(setq org-element-use-cache t + org-element-cache-persistent t + org-element--cache-self-verify t + org-element--cache-self-verify-frequency 1.0) + +(defun repro--build-cache (buf) + "Actually populate the element cache of BUF by walking it." + (with-current-buffer buf + (org-element-cache-map (lambda (_el) nil) :granularity 'element) + (and org-element--cache (avl-tree-size org-element--cache)))) + +(defun repro--warnings () + (when (get-buffer "*Warnings*") + (with-current-buffer "*Warnings*" (string-trim (buffer-string))))) + +(let* ((src (expand-file-name "todo.org" default-directory)) + (file (make-temp-file "repro-" nil ".org")) + (threshold 1048576)) + (copy-file src file t) + (let ((size (nth 7 (file-attributes file)))) + (message "== fixture %s (%d bytes, %s threshold) ==" + (file-name-nondirectory file) size + (if (>= size threshold) "over" "under"))) + + (let ((real (find-file-noselect file))) + (message "real buffer cache after full walk: %S" (repro--build-cache real)) + + ;; --- dirvish text preview of the same file --- + (with-current-buffer (get-buffer-create "*preview-temp*") + (let (jka-compr-verbose) + (with-silent-modifications + (setq buffer-read-only t) + (insert-file-contents file nil 0 threshold) + (when (>= (nth 7 (file-attributes file)) threshold) + (goto-char (point-max)) + (insert "\n\nFile truncated. End of partial preview.\n")) + (setq buffer-file-name file) + (goto-char (point-min)) + (rename-buffer (format "PREVIEW :: %s" (file-name-nondirectory file)))) + (let ((enable-dir-local-variables nil) + (enable-local-variables :safe) + (non-essential t)) + (set-auto-mode) + (font-lock-mode 1))) + (message "preview buffer: mode=%s claims=%s cache=%S" + major-mode (file-name-nondirectory (or buffer-file-name "none")) + (repro--build-cache (current-buffer)))) + + (message "-- both buffers live: real=%S claiming-file=%d --" + (with-current-buffer real (avl-tree-size org-element--cache)) + (length (seq-filter (lambda (b) (equal (buffer-local-value 'buffer-file-name b) file)) + (buffer-list)))) + + ;; --- dirvish kills the preview buffer when the session ends --- + (let ((kill-buffer-query-functions nil) + (preview (format "PREVIEW :: %s" (file-name-nondirectory file)))) + (kill-buffer preview) + (message "preview buffer %S killed" preview)) + + ;; --- is the real buffer still coherent? --- + (with-current-buffer real + ;; Edit it the way Craig would after stepping back from dirvish. + (goto-char (point-max)) + (condition-case err + (let ((inhibit-read-only t)) (insert "\n* Repro edit\n")) + (error (message "RESULT: insert into real buffer SIGNALLED %S" (car err)))) + (condition-case err + (progn (org-element-cache-map (lambda (_el) nil) :granularity 'element) + (message "post-kill cache-map: clean (size=%S)" + (avl-tree-size org-element--cache))) + (error (message "post-kill cache-map: ERROR %S" err))) + (set-buffer-modified-p nil)) + + (message "warnings=%s" (or (repro--warnings) "none"))) + + (delete-file file)) diff --git a/working/org-element-cache-persist-bug/upstream-report.txt b/working/org-element-cache-persist-bug/upstream-report.txt new file mode 100644 index 00000000..81fcaaa7 --- /dev/null +++ b/working/org-element-cache-persist-bug/upstream-report.txt @@ -0,0 +1,87 @@ +Subject: [BUG] Persisting the element cache while its buffer is live corrupts it [9.7.11 (release_9.7.11 @ /usr/share/emacs/30.2/lisp/org/)] + +Writing the element cache to disk strips the :buffer property from every cached +element in the live buffer and never puts it back. The next access to a cached +headline signals (wrong-type-argument stringp nil), and it keeps signalling until +the cache is reset by hand. + +Minimal reproduction, self-contained, no dirvish or other packages involved. Save +as repro.el and run "emacs -Q --batch -l repro.el": + + (require 'org) + (require 'org-element) + (require 'org-persist) + + (let* ((dir (make-temp-file "org-persist-repro-" t)) + (org-persist-directory (expand-file-name "persist" dir)) + (file (expand-file-name "notes.org" dir)) + (org-element-use-cache t) + (org-element-cache-persistent t) + (org-log-done nil)) + (with-temp-file file + (dotimes (i 20) (insert (format "* TODO task %d\nbody %d\n" i i)))) + (let ((buffer (find-file-noselect file))) + (with-current-buffer buffer + (org-element-cache-reset) + (org-element-cache-map #'ignore :granularity 'headline) + (goto-char (point-min)) + (re-search-forward "^\\* TODO task 0") + (beginning-of-line) + (org-todo "DONE")) + (org-persist-write `((elisp org-element--cache) + (version ,org-element-cache-version)) + buffer t) + (with-current-buffer buffer + (message "%S" + (condition-case err + (progn (org-element-cache-map + (lambda (e) (org-element-property :raw-value e)) + :granularity 'headline) + "ok") + (error err)))) + (set-buffer-modified-p nil) + (kill-buffer buffer)) + (delete-directory dir t)) + +Expected: "ok". +Actual: (wrong-type-argument stringp nil). + +Adding a print of the cached :buffer values on either side of the write shows +(#<buffer notes.org>) before and (nil) after. + +The mechanism, as far as I can follow it. org-element--cache-persist-before-write +walks org-element--cache and clears :buffer on every element. That looks +deliberate, since buffer objects can't be printed, and a8286a5a9 describes it as +"Clear and restore non-printable buffer objects in :buffer property". The restore +half is org-element--cache-persist-after-read, which sets :buffer back to +(current-buffer). But that only runs on the read path. Nothing restores :buffer +after a write, so a write against a buffer that is still alive leaves the live +cache holding nils. + +The error itself comes from org-element--headline-parse-title. Cached elements +keep their deferred :title and :tags thunks, and resolving one runs +(with-current-buffer (org-element-property :buffer headline)). set-buffer on nil +is the signal. + +How I reached it without calling org-persist-write directly. Any second buffer +visiting the same file will do it, because org-persist registers a buffer-local +org-persist-write-all-buffer on kill-buffer-hook, and the write's hook resolves +(get-file-buffer FILE), which can return the other buffer. In my case dirvish +built a preview buffer, pointed buffer-file-name at a file I already had open, +and ran set-auto-mode. Killing that preview corrupted the cache of the buffer I +was working in. Any package that makes a throwaway buffer visiting a live file +can trigger it, so I don't think this is dirvish's bug to fix. + +Two details that might help narrow it. Which buffer gets damaged depends on +buffer-list order, since get-file-buffer returns the first buffer visiting the +file. And a nearly empty cache survives, because the next access reparses instead +of reading a stripped element. That combination is probably why this shows up as +an intermittent "org-element cache is broken again" rather than a clean repro. + +Setting org-element-cache-persistent to nil avoids it, which I see recommended on +this list fairly often. It looks like it may be working around this rather than a +separate problem. + +I haven't written a patch. From the outside the symmetric fix would be to restore +:buffer after an in-session write the way the read path does, rather than to stop +clearing it. Happy to test a patch against the reproduction above. diff --git a/working/org-element-cache-persist-bug/upstream-repro.el b/working/org-element-cache-persist-bug/upstream-repro.el new file mode 100644 index 00000000..d0a96774 --- /dev/null +++ b/working/org-element-cache-persist-bug/upstream-repro.el @@ -0,0 +1,70 @@ +;;; upstream-repro.el --- minimal reproduction for the org list -*- lexical-binding: t -*- + +;; Run with: emacs -Q --batch -l upstream-repro.el +;; +;; Writing the element cache to disk while the buffer is still live strips the +;; :buffer property from every cached element and never restores it. The next +;; access to a cached headline signals (wrong-type-argument stringp nil). + +(require 'org) +(require 'org-element) +(require 'org-persist) + +(let* ((dir (make-temp-file "org-persist-repro-" t)) + (org-persist-directory (expand-file-name "persist" dir)) + (file (expand-file-name "notes.org" dir)) + (org-element-use-cache t) + (org-element-cache-persistent t) + (org-log-done nil)) + + (with-temp-file file + (dotimes (i 20) + (insert (format "* TODO task %d\nbody %d\n" i i)))) + + (let ((buffer (find-file-noselect file))) + (with-current-buffer buffer + ;; Populate the cache with parsed headlines. + (org-element-cache-reset) + (org-element-cache-map #'ignore :granularity 'headline) + (goto-char (point-min)) + (re-search-forward "^\\* TODO task 0") + (beginning-of-line) + (org-todo "DONE")) + + (message "cached :buffer values before write: %S" + (with-current-buffer buffer + (let (values) + (avl-tree-mapc (lambda (element) + (push (org-element-property :buffer element) values)) + org-element--cache) + (delete-dups values)))) + + ;; Persist while the buffer is still alive. In a real session this is + ;; reached by any in-session write, e.g. `org-persist-write-all-buffer' from + ;; `kill-buffer-hook' in a *second* buffer visiting the same file. + (org-persist-write `((elisp org-element--cache) + (version ,org-element-cache-version)) + buffer t) + + (message "cached :buffer values after write: %S" + (with-current-buffer buffer + (let (values) + (avl-tree-mapc (lambda (element) + (push (org-element-property :buffer element) values)) + org-element--cache) + (delete-dups values)))) + + (with-current-buffer buffer + (message "reading a cached headline: %s" + (condition-case err + (progn (org-element-cache-map + (lambda (element) (org-element-property :raw-value element)) + :granularity 'headline) + "ok") + (error (format "%S" err))))) + + (set-buffer-modified-p nil) + (kill-buffer buffer)) + (delete-directory dir t)) + +;;; upstream-repro.el ends here diff --git a/working/org-element-cache-persist-bug/variant-no-kill.el b/working/org-element-cache-persist-bug/variant-no-kill.el new file mode 100644 index 00000000..180f6cd2 --- /dev/null +++ b/working/org-element-cache-persist-bug/variant-no-kill.el @@ -0,0 +1,88 @@ +;;; repro-preview-cache.el --- Does dirvish's text preview disturb an org buffer's element cache? -*- lexical-binding: t -*- + +;; Replays `dirvish--preview-file-maybe-truncate' (dirvish.el:653-684) against an +;; org file that is ALSO open for real, then kills the preview buffer the way +;; dirvish does (`dirvish--kill-buffer', dirvish.el:416). The kill is the step +;; that matters: killing an org-mode buffer with a `buffer-file-name' is when +;; org-persist writes that file's cache. + +(require 'org) +(require 'org-element) +(require 'org-persist) + +(setq org-element-use-cache t + org-element-cache-persistent t + org-element--cache-self-verify t + org-element--cache-self-verify-frequency 1.0) + +(defun repro--build-cache (buf) + "Actually populate the element cache of BUF by walking it." + (with-current-buffer buf + (org-element-cache-map (lambda (_el) nil) :granularity 'element) + (and org-element--cache (avl-tree-size org-element--cache)))) + +(defun repro--warnings () + (when (get-buffer "*Warnings*") + (with-current-buffer "*Warnings*" (string-trim (buffer-string))))) + +(let* ((src (expand-file-name "todo.org" default-directory)) + (file (make-temp-file "repro-" nil ".org")) + (threshold 1048576)) + (copy-file src file t) + (let ((size (nth 7 (file-attributes file)))) + (message "== fixture %s (%d bytes, %s threshold) ==" + (file-name-nondirectory file) size + (if (>= size threshold) "over" "under"))) + + (let ((real (find-file-noselect file))) + (message "real buffer cache after full walk: %S" (repro--build-cache real)) + + ;; --- dirvish text preview of the same file --- + (with-current-buffer (get-buffer-create "*preview-temp*") + (let (jka-compr-verbose) + (with-silent-modifications + (setq buffer-read-only t) + (insert-file-contents file nil 0 threshold) + (when (>= (nth 7 (file-attributes file)) threshold) + (goto-char (point-max)) + (insert "\n\nFile truncated. End of partial preview.\n")) + (setq buffer-file-name file) + (goto-char (point-min)) + (rename-buffer (format "PREVIEW :: %s" (file-name-nondirectory file)))) + (let ((enable-dir-local-variables nil) + (enable-local-variables :safe) + (non-essential t)) + (set-auto-mode) + (font-lock-mode 1))) + (message "preview buffer: mode=%s claims=%s cache=%S" + major-mode (file-name-nondirectory (or buffer-file-name "none")) + (repro--build-cache (current-buffer)))) + + (message "-- both buffers live: real=%S claiming-file=%d --" + (with-current-buffer real (avl-tree-size org-element--cache)) + (length (seq-filter (lambda (b) (equal (buffer-local-value 'buffer-file-name b) file)) + (buffer-list)))) + + ;; --- dirvish kills the preview buffer when the session ends --- + (let ((kill-buffer-query-functions nil) + (preview (format "PREVIEW :: %s" (file-name-nondirectory file)))) + (ignore preview) + (message "VARIANT: preview buffer left ALIVE")) + + ;; --- is the real buffer still coherent? --- + (with-current-buffer real + ;; Edit it the way Craig would after stepping back from dirvish. + (goto-char (point-max)) + (condition-case err + (let ((inhibit-read-only t)) (insert "\n* Repro edit\n")) + (error (message "RESULT: insert into real buffer SIGNALLED %S" (car err)))) + (condition-case err + (progn (org-element-cache-map (lambda (_el) nil) :granularity 'element) + (message "post-kill cache-map: clean (size=%S)" + (avl-tree-size org-element--cache))) + (error (message "post-kill cache-map: ERROR %S" err))) + (set-buffer-modified-p nil)) + + (message "warnings=%s" (or (repro--warnings) "none"))) + + (delete-file file)) diff --git a/working/org-element-cache-persist-bug/variant-no-persist.el b/working/org-element-cache-persist-bug/variant-no-persist.el new file mode 100644 index 00000000..75c85bc6 --- /dev/null +++ b/working/org-element-cache-persist-bug/variant-no-persist.el @@ -0,0 +1,88 @@ +;;; repro-preview-cache.el --- Does dirvish's text preview disturb an org buffer's element cache? -*- lexical-binding: t -*- + +;; Replays `dirvish--preview-file-maybe-truncate' (dirvish.el:653-684) against an +;; org file that is ALSO open for real, then kills the preview buffer the way +;; dirvish does (`dirvish--kill-buffer', dirvish.el:416). The kill is the step +;; that matters: killing an org-mode buffer with a `buffer-file-name' is when +;; org-persist writes that file's cache. + +(require 'org) +(require 'org-element) +(require 'org-persist) + +(setq org-element-use-cache t + org-element-cache-persistent nil + org-element--cache-self-verify t + org-element--cache-self-verify-frequency 1.0) + +(defun repro--build-cache (buf) + "Actually populate the element cache of BUF by walking it." + (with-current-buffer buf + (org-element-cache-map (lambda (_el) nil) :granularity 'element) + (and org-element--cache (avl-tree-size org-element--cache)))) + +(defun repro--warnings () + (when (get-buffer "*Warnings*") + (with-current-buffer "*Warnings*" (string-trim (buffer-string))))) + +(let* ((src (expand-file-name "todo.org" default-directory)) + (file (make-temp-file "repro-" nil ".org")) + (threshold 1048576)) + (copy-file src file t) + (let ((size (nth 7 (file-attributes file)))) + (message "== fixture %s (%d bytes, %s threshold) ==" + (file-name-nondirectory file) size + (if (>= size threshold) "over" "under"))) + + (let ((real (find-file-noselect file))) + (message "real buffer cache after full walk: %S" (repro--build-cache real)) + + ;; --- dirvish text preview of the same file --- + (with-current-buffer (get-buffer-create "*preview-temp*") + (let (jka-compr-verbose) + (with-silent-modifications + (setq buffer-read-only t) + (insert-file-contents file nil 0 threshold) + (when (>= (nth 7 (file-attributes file)) threshold) + (goto-char (point-max)) + (insert "\n\nFile truncated. End of partial preview.\n")) + (setq buffer-file-name file) + (goto-char (point-min)) + (rename-buffer (format "PREVIEW :: %s" (file-name-nondirectory file)))) + (let ((enable-dir-local-variables nil) + (enable-local-variables :safe) + (non-essential t)) + (set-auto-mode) + (font-lock-mode 1))) + (message "preview buffer: mode=%s claims=%s cache=%S" + major-mode (file-name-nondirectory (or buffer-file-name "none")) + (repro--build-cache (current-buffer)))) + + (message "-- both buffers live: real=%S claiming-file=%d --" + (with-current-buffer real (avl-tree-size org-element--cache)) + (length (seq-filter (lambda (b) (equal (buffer-local-value 'buffer-file-name b) file)) + (buffer-list)))) + + ;; --- dirvish kills the preview buffer when the session ends --- + (let ((kill-buffer-query-functions nil) + (preview (format "PREVIEW :: %s" (file-name-nondirectory file)))) + (kill-buffer preview) + (message "preview buffer %S killed" preview)) + + ;; --- is the real buffer still coherent? --- + (with-current-buffer real + ;; Edit it the way Craig would after stepping back from dirvish. + (goto-char (point-max)) + (condition-case err + (let ((inhibit-read-only t)) (insert "\n* Repro edit\n")) + (error (message "RESULT: insert into real buffer SIGNALLED %S" (car err)))) + (condition-case err + (progn (org-element-cache-map (lambda (_el) nil) :granularity 'element) + (message "post-kill cache-map: clean (size=%S)" + (avl-tree-size org-element--cache))) + (error (message "post-kill cache-map: ERROR %S" err))) + (set-buffer-modified-p nil)) + + (message "warnings=%s" (or (repro--warnings) "none"))) + + (delete-file file)) diff --git a/working/org-element-cache-persist-bug/verify-shipped-fix.el b/working/org-element-cache-persist-bug/verify-shipped-fix.el new file mode 100644 index 00000000..a8883085 --- /dev/null +++ b/working/org-element-cache-persist-bug/verify-shipped-fix.el @@ -0,0 +1,91 @@ +;;; repro-preview-cache.el --- Does dirvish's text preview disturb an org buffer's element cache? -*- lexical-binding: t -*- + +;; Replays `dirvish--preview-file-maybe-truncate' (dirvish.el:653-684) against an +;; org file that is ALSO open for real, then kills the preview buffer the way +;; dirvish does (`dirvish--kill-buffer', dirvish.el:416). The kill is the step +;; that matters: killing an org-mode buffer with a `buffer-file-name' is when +;; org-persist writes that file's cache. + +(require 'org) +(require 'org-element) +(require 'org-persist) +(add-to-list 'load-path (expand-file-name "modules" default-directory)) +(require 'dirvish-config) + +(setq org-element-use-cache t + org-element-cache-persistent t + org-element--cache-self-verify t + org-element--cache-self-verify-frequency 1.0) + +(defun repro--build-cache (buf) + "Actually populate the element cache of BUF by walking it." + (with-current-buffer buf + (org-element-cache-map (lambda (_el) nil) :granularity 'element) + (and org-element--cache (avl-tree-size org-element--cache)))) + +(defun repro--warnings () + (when (get-buffer "*Warnings*") + (with-current-buffer "*Warnings*" (string-trim (buffer-string))))) + +(let* ((src (expand-file-name "todo.org" default-directory)) + (file (make-temp-file "repro-" nil ".org")) + (threshold 1048576)) + (copy-file src file t) + (let ((size (nth 7 (file-attributes file)))) + (message "== fixture %s (%d bytes, %s threshold) ==" + (file-name-nondirectory file) size + (if (>= size threshold) "over" "under"))) + + (let ((real (find-file-noselect file))) + (message "real buffer cache after full walk: %S" (repro--build-cache real)) + + ;; --- dirvish text preview of the same file --- + (with-current-buffer (get-buffer-create "*preview-temp*") + (let (jka-compr-verbose) + (with-silent-modifications + (setq buffer-read-only t) + (insert-file-contents file nil 0 threshold) + (when (>= (nth 7 (file-attributes file)) threshold) + (goto-char (point-max)) + (insert "\n\nFile truncated. End of partial preview.\n")) + (setq buffer-file-name file) + (goto-char (point-min)) + (rename-buffer (format "PREVIEW :: %s" (file-name-nondirectory file)))) + (let ((enable-dir-local-variables nil) + (enable-local-variables :safe) + (non-essential t)) + (set-auto-mode) + (font-lock-mode 1)) + (run-hooks 'dirvish-preview-setup-hook)) + (message "preview buffer: mode=%s claims=%s cache=%S" + major-mode (file-name-nondirectory (or buffer-file-name "none")) + (repro--build-cache (current-buffer)))) + + (message "-- both buffers live: real=%S claiming-file=%d --" + (with-current-buffer real (avl-tree-size org-element--cache)) + (length (seq-filter (lambda (b) (equal (buffer-local-value 'buffer-file-name b) file)) + (buffer-list)))) + + ;; --- dirvish kills the preview buffer when the session ends --- + (let ((kill-buffer-query-functions nil) + (preview (format "PREVIEW :: %s" (file-name-nondirectory file)))) + (kill-buffer preview) + (message "preview buffer %S killed" preview)) + + ;; --- is the real buffer still coherent? --- + (with-current-buffer real + ;; Edit it the way Craig would after stepping back from dirvish. + (goto-char (point-max)) + (condition-case err + (let ((inhibit-read-only t)) (insert "\n* Repro edit\n")) + (error (message "RESULT: insert into real buffer SIGNALLED %S" (car err)))) + (condition-case err + (progn (org-element-cache-map (lambda (_el) nil) :granularity 'element) + (message "post-kill cache-map: clean (size=%S)" + (avl-tree-size org-element--cache))) + (error (message "post-kill cache-map: ERROR %S" err))) + (set-buffer-modified-p nil)) + + (message "warnings=%s" (or (repro--warnings) "none"))) + + (delete-file file)) |
