diff options
233 files changed, 12162 insertions, 1597 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/ @@ -32,8 +32,13 @@ EMACS_HOME = $(HOME)/.emacs.d OUT ?= themes # Test files +# NOTE: filter-out takes make patterns, where % is the wildcard; $(wildcard ...) +# takes a shell glob, where % is a literal character and * is the wildcard. The +# two are not interchangeable. INTEGRATION_TESTS used a % here and so expanded +# to nothing, which silently skipped every integration test in `make test' while +# it still printed ALL TESTS COMPLETE. UNIT_TESTS = $(filter-out $(TEST_DIR)/test-integration-%.el, $(wildcard $(TEST_DIR)/test-*.el)) -INTEGRATION_TESTS = $(wildcard $(TEST_DIR)/test-integration-%.el) +INTEGRATION_TESTS = $(wildcard $(TEST_DIR)/test-integration-*.el) ALL_TESTS = $(UNIT_TESTS) $(INTEGRATION_TESTS) BASH_TESTS = $(wildcard $(TEST_DIR)/*.bats) 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-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..567da53b --- /dev/null +++ b/docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org @@ -0,0 +1,404 @@ +#+TITLE: org-agenda fullscreen frame — Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-07-17 +#+TODO: TODO | DONE +#+TODO: DRAFT READY DOING | IMPLEMENTED SUPERSEDED CANCELLED + +* IMPLEMENTED org-agenda fullscreen frame +:PROPERTIES: +:ID: 7705c94b-9bb7-47d8-9828-e9584172c54f +:END: +- 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 | implemented | +|----------+------------------------------------------------| +| 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 'org-agenda-frame) ;; S-<f8> dedicated agenda frame (tiled beside the working frame) (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/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 9cb57e96..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). @@ -218,6 +234,18 @@ Both dates should be lists like (year month day)." (time-less-p (calendar-sync--date-to-time date1) (calendar-sync--date-to-time date2))) +(defun calendar-sync--date-on-or-before-p (date1 date2) + "Return t if DATE1 falls on or before DATE2. +Both dates should be lists like (year month day); like +`calendar-sync--date-to-time', only the first three elements are compared, +so any hour/minute tail is ignored. + +This is the comparison RRULE UNTIL needs. RFC 5545 3.3.10 bounds a +recurrence \"in an inclusive manner\": when UNTIL lines up with the +recurrence, that date is the last instance. A strict +`calendar-sync--before-date-p' drops it." + (not (calendar-sync--before-date-p date2 date1))) + ;;; Datetime Parsing (defun calendar-sync--parse-ics-datetime (value) @@ -492,39 +520,90 @@ Returns nil if parsing fails." (string-to-number (match-string 3 timestamp-str)))) (t nil))) +(defun calendar-sync--format-stamp (date &optional time-str) + "Return one org timestamp for DATE, with TIME-STR appended when non-nil. +DATE is a (year month day) list; TIME-STR is a preformatted leading-space +string such as \" 14:00\" or \" 14:00-15:30\". Produces +`<2025-11-16 Sun 14:00>' or `<2025-11-16 Sun>'. Both the compact same-day +form and each half of a multi-day range are built from this." + (concat (format-time-string + "<%Y-%m-%d %a" + (encode-time 0 0 0 (nth 2 date) (nth 1 date) (nth 0 date))) + time-str + ">")) + +(defun calendar-sync--format-hhmm (hour minute) + "Return \" HH:MM\" for HOUR and MINUTE, or nil unless both are non-nil." + (when (and hour minute) (format " %02d:%02d" hour minute))) + (defun calendar-sync--format-timestamp (start end) - "Format START and END timestamps as org timestamp. + "Format START and END timestamps as an org timestamp. START and END are lists from `calendar-sync--parse-timestamp'. -Returns string like '<2025-11-16 Sun 14:00-15:00>' or '<2025-11-16 Sun>'." - (let* ((year (nth 0 start)) - (month (nth 1 start)) - (day (nth 2 start)) + +Same-day events keep the compact form: `<2025-11-16 Sun 14:00-15:00>' when +timed, `<2025-11-16 Sun>' when all-day. An event whose last day is later +than its start renders as an org range, `<start>--<end>', so the agenda shows +it on every day it covers rather than only the first. + +DTEND is the non-inclusive end of the event (RFC 5545 3.6.1). For an all-day +event that makes DTEND the day AFTER the last day, so the last day is +DTEND-1 and a one-day all-day event (DTEND = start+1) stays a single stamp. +For a timed event DTEND is the end instant, so its date is already the last +day. The decrement is therefore gated on both ends being date-only; a +date-only start with a timed end is malformed, and treating it as all-day +would push the last day BEFORE the start and emit a backwards range." + (let* ((start-date (list (nth 0 start) (nth 1 start) (nth 2 start))) (start-hour (nth 3 start)) (start-min (nth 4 start)) (end-hour (and end (nth 3 end))) (end-min (and end (nth 4 end))) - (date-str (format-time-string - "<%Y-%m-%d %a" - (encode-time 0 0 0 day month year))) - (time-str (when (and start-hour end-hour) - (format " %02d:%02d-%02d:%02d" - start-hour start-min end-hour end-min)))) - (concat date-str time-str ">"))) + (all-day-span (and end (null start-hour) (null end-hour))) + (last-date (when end + (let ((end-date (list (nth 0 end) (nth 1 end) (nth 2 end)))) + (if all-day-span + (calendar-sync--add-days end-date -1) + end-date)))) + (spans-days (and last-date + (calendar-sync--before-date-p start-date last-date)))) + (if spans-days + (concat (calendar-sync--format-stamp + start-date (calendar-sync--format-hhmm start-hour start-min)) + "--" + (calendar-sync--format-stamp + last-date (calendar-sync--format-hhmm end-hour end-min))) + ;; Same-day: the compact HH:MM-HH:MM range lives inside one stamp. + (calendar-sync--format-stamp + start-date + (when (and start-hour end-hour) + (format " %02d:%02d-%02d:%02d" + start-hour start-min end-hour end-min)))))) ;;; 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 2689cdd6..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 @@ -322,7 +335,8 @@ ADVANCE-FN takes (current-date interval) and returns the next date." (num-generated 0) (range-end-time (cadr range))) (while (and (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) - (or (not until) (calendar-sync--before-date-p current-date until)) + ;; UNTIL is inclusive (RFC 5545 3.3.10) -- on-or-before, not before. + (or (not until) (calendar-sync--date-on-or-before-p current-date until)) (or (not count) (< num-generated count))) (let ((occurrence-datetime (append current-date (nthcdr 3 start)))) (setq num-generated (1+ num-generated)) @@ -364,7 +378,8 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (while (and (< iterations max-iterations) (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) (or (not count) (< num-generated count)) - (or (not until) (calendar-sync--before-date-p current-date until))) + ;; UNTIL is inclusive (RFC 5545 3.3.10) -- on-or-before, not before. + (or (not until) (calendar-sync--date-on-or-before-p current-date until))) (setq iterations (1+ iterations)) ;; Generate occurrences for each weekday in this week (dolist (weekday weekdays) @@ -372,8 +387,8 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (days-ahead (mod (- weekday current-weekday) 7)) (occurrence-date (calendar-sync--add-days current-date days-ahead)) (occurrence-datetime (append occurrence-date (nthcdr 3 start)))) - ;; Check UNTIL date first - (when (or (not until) (calendar-sync--before-date-p occurrence-date until)) + ;; Check UNTIL date first -- inclusive per RFC 5545 3.3.10. + (when (or (not until) (calendar-sync--date-on-or-before-p occurrence-date until)) ;; Check COUNT - increment BEFORE range check so COUNT is absolute from start (when (or (not count) (< num-generated count)) (setq num-generated (1+ num-generated)) @@ -387,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-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 0e22dcee..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) @@ -589,6 +590,7 @@ no popup frame is live." ("ps" ,(concat pix-dir "/screenshots/") "pictures screenshots") ("px" ,pix-dir "pictures directory") ("wp" ,(concat pix-dir "/wallpaper/") "pictures wallpaper") + ("fp" "/ftp:android@192.168.86.13#2221:/" "phone ftp (android)") ("rcj" "/sshx:cjennings@cjennings.net:~" "remote c@cjennings.net") ("rtl" "/sshx:cjennings@truenas.local:~" "remote cjennings@truenas.local") ("rtt" "/sshx:cjennings@truenas:~" "remote cjennings@truenas (tailscale)") diff --git a/modules/dwim-shell-config.el b/modules/dwim-shell-config.el index e8790a48..54272fd5 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: @@ -23,6 +23,7 @@ (require 'cl-lib) (require 'system-lib) ;; cj/confirm-strong (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" 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/markdown-config.el b/modules/markdown-config.el index 815bb3fb..1d4a8b74 100644 --- a/modules/markdown-config.el +++ b/modules/markdown-config.el @@ -108,8 +108,21 @@ Starts the simple-httpd listener automatically when it isn't already running." ;; stub doesn't collide with this file's own definition of the command ;; (that collision is the "defined multiple times" byte-compile warning). ;; Same key as compile, for consistency. +(defun cj/markdown-toggle-view () + "Toggle the current Markdown buffer between edit and read-only view. +Handles the gfm variants too. The cond checks the most-derived mode +first, since the view modes derive from their edit modes." + (interactive) + (cond + ((derived-mode-p 'markdown-view-mode) (markdown-mode)) + ((derived-mode-p 'gfm-view-mode) (gfm-mode)) + ((derived-mode-p 'gfm-mode) (gfm-view-mode)) + ((derived-mode-p 'markdown-mode) (markdown-view-mode)))) + (with-eval-after-load 'markdown-mode - (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview)) + (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview) + (keymap-set markdown-mode-map "C-c C-x v" #'cj/markdown-toggle-view) + (keymap-set markdown-view-mode-map "C-c C-x v" #'cj/markdown-toggle-view)) (provide 'markdown-config) ;;; markdown-config.el ends here diff --git a/modules/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..233bae72 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -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 @@ -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-strong (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 d4407b28..1e91fa48 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -123,8 +123,15 @@ the file keeps precedence." ;; 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 +223,16 @@ 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 C-M-<f8>, the force-rebuild sibling of the F8 agenda family +\(<f8> display, s-<f8> all files, C-<f8> single project, M-<f8> this buffer). +The binding lives in `org-agenda-frame.el', which took S-<f8> for the +agenda-frame toggle and moved the force-rescan here." (interactive) (cj/build-org-agenda-list 'force-rebuild)) +;; S-<f8> and C-M-<f8> are bound by `org-agenda-frame.el' (cj/--agenda-frame-install-keys): +;; S-<f8> toggles the dedicated agenda frame; C-M-<f8> runs the force-rescan above. (defun cj/todo-list-all-agenda-files () "Displays an \\='org-agenda\\=' todo list. @@ -383,11 +397,14 @@ The agenda is rebuilt from all sources before display, including: ;; ------------------------- Add Timestamp To Org Entry ------------------------ ;; simply adds a timestamp to put the org entry on an agenda +(defvar cj/timeformat "%Y-%m-%d %a" + "Date format for the stamp `cj/add-timestamp-to-org-entry' inserts. +Must stay an org-readable date so the stamped line reaches the agenda.") + (defun cj/add-timestamp-to-org-entry (s) "Add an event with time S to appear underneath the line-at-point. This allows a line to show in an agenda without being scheduled or a deadline." (interactive "sTime: ") - (defvar cj/timeformat "%Y-%m-%d %a") (org-end-of-line) (save-excursion (open-line 1) diff --git a/modules/org-agenda-frame.el b/modules/org-agenda-frame.el new file mode 100644 index 00000000..471b246b --- /dev/null +++ b/modules/org-agenda-frame.el @@ -0,0 +1,874 @@ +;;; org-agenda-frame.el --- Dedicated agenda frame -*- lexical-binding: t; -*- +;; author: Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 4 (Optional). +;; Category: O/D. +;; Load shape: eager (binds keys in Phase 2; Phase 1 defines helpers only). +;; Top-level side effects: none yet (Phase 1 is private helpers). +;; Runtime requires: none. +;; Direct test load: yes. +;; +;; A dedicated Emacs frame of the running daemon that shows a today-anchored +;; seven-day org-agenda, refreshing itself, kept read-only and focus-locked. +;; A normal (non-fullscreen) frame, so a tiling WM places it side by side with +;; the working frame. Spawned/raised/closed by one key. See the spec: +;; docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org. +;; +;; Phase 1 (this pass) builds non-interactive helpers only: frame lookup, +;; spawn/raise/delete, the dedicated view, the default-deny read-only policy, +;; and working-frame routing. No interactive command or key is bound until +;; Phase 2, so nothing user-visible changes yet. + +;;; Code: + +(require 'seq) + +;; Declared, not required: `org-agenda-config' pulls in vc packages that don't +;; load under `make test' (no package-initialize). The frame module references +;; org-agenda symbols through these declarations and does its real wiring inside +;; `with-eval-after-load' so a batch test-load runs no org-agenda side effects. +(defvar org-agenda-custom-commands) +(defvar org-agenda-finalize-hook) +(defvar org-agenda-mode-map) +(defvar org-agenda-sticky) +(defvar org-agenda-window-setup) +(declare-function cj/build-org-agenda-list "org-agenda-config" (&optional force-rebuild)) +(declare-function cj/org-agenda-refresh-files "org-agenda-config" ()) +(declare-function org-agenda-redo "org-agenda" (&optional all)) +(declare-function org-agenda-next-line "org-agenda" ()) +(declare-function org-agenda-previous-line "org-agenda" ()) +(declare-function org-agenda-next-item "org-agenda" (n)) +(declare-function org-agenda-previous-item "org-agenda" (n)) +(declare-function org-agenda-open-link "org-agenda" (&optional arg)) +(declare-function org-agenda-priority-down "org-agenda" ()) +(declare-function org-agenda-priority-up "org-agenda" ()) +(declare-function org-agenda-todo "org-agenda" (&optional arg)) +(declare-function org-agenda-todo-nextset "org-agenda" ()) +(declare-function org-agenda-todo-previousset "org-agenda" ()) +(declare-function org-get-at-bol "org" (property)) +(declare-function org-fold-show-context "org-fold" (&optional key)) +(declare-function org-agenda "org-agenda" (&optional arg org-keys restriction)) +;; No declare-function for -safe-redo / -delete: they are defined later in THIS +;; file, and the byte-compiler resolves same-file forward references at end of +;; compilation. A declare-function for a same-file function instead counts as a +;; second definition ("defined multiple times") and, worse, its declared arglist +;; overrides the real one for arg-count checking -- the empty () shadowed +;; -safe-redo's actual (&optional frame), disabling that check. + +(defconst cj/--agenda-frame-parameter 'cj/agenda-frame + "Frame parameter marking the dedicated agenda frame. +Its presence (non-nil) is how `cj/--agenda-frame' locates the frame among +all of the daemon's frames.") + +(defvar cj/--agenda-frame-launch-frame nil + "The frame selected when the agenda frame was last spawned. +Preferred routing target for source files opened from the agenda (see +`cj/--agenda-frame-working-frame'); ignored once it is dead or is itself +the agenda frame.") + +(defun cj/--agenda-frame-p (frame) + "Return non-nil when FRAME is a live agenda frame. +FRAME is an agenda frame when it is live and carries the +`cj/--agenda-frame-parameter' marker; a dead frame is never one." + (and (frame-live-p frame) + (frame-parameter frame cj/--agenda-frame-parameter))) + +(defun cj/--agenda-frame () + "Return the live agenda frame, or nil. +The frame is identified by the `cj/--agenda-frame-parameter' marker; a +dead frame is never returned even if it still carries the marker." + (seq-find #'cj/--agenda-frame-p (frame-list))) + +(defun cj/--agenda-frame-working-frame () + "Return a live non-agenda frame to route source files into, or nil. +Prefer `cj/--agenda-frame-launch-frame' when it is still live and not the +agenda frame; otherwise the first live non-agenda frame among all frames. +Return nil when the agenda frame is the only live frame -- the caller then +creates a normal frame." + (or (and (frame-live-p cj/--agenda-frame-launch-frame) + (not (cj/--agenda-frame-p cj/--agenda-frame-launch-frame)) + cj/--agenda-frame-launch-frame) + (seq-find (lambda (frame) + (and (frame-live-p frame) + (not (cj/--agenda-frame-p frame)))) + (frame-list)))) + +;;; The dedicated seven-day view (org-agenda-custom-commands key F) + +(defconst cj/--agenda-frame-command-key "F" + "The `org-agenda-custom-commands' key for the agenda-frame view. +The existing top-level key is `d' (org-agenda-config.el:344), so `F' is +collision-free. The sticky buffer derives its name from this key +\(*Org Agenda(F)*).") + +(defvar cj/--agenda-frame-span 7 + "Span, in days, of the agenda-frame view. +The `F' custom command reads this via its `org-agenda-span' setting, which +Org evaluates on every build and every redo, so `cj/--agenda-frame-day-view' +\(span 1) and `cj/--agenda-frame-week-view' (span 7) change it and the next +redo picks up the new span. Reset to 7 on each spawn so a fresh frame opens +at the documented default.") + +(defun cj/--agenda-frame-command () + "Return the `org-agenda-custom-commands' entry for the agenda frame. +A one-block agenda: a `cj/--agenda-frame-span'-day span anchored to today +rather than +Monday (`org-agenda-list' otherwise anchors any seven-day span to the +week start in Org 9.7.11), rendered in the frame's sole window +\(`current-window', so Org's default `reorganize-frame' can't split it), +as its own sticky *Org Agenda(F)* buffer, with follow-mode forced off so +a non-nil global default can't open a second window at build time." + `(,cj/--agenda-frame-command-key "Agenda frame: 7-day today-anchored" + ((agenda "" + ((org-agenda-span cj/--agenda-frame-span) + (org-agenda-start-day "0d") + (org-agenda-start-on-weekday nil) + (org-agenda-start-with-follow-mode nil) + ;; The global daily agenda intentionally keeps scheduled done + ;; items visible. The Full Agenda is a live work surface, so + ;; completed items are noise regardless of schedule or priority. + (org-agenda-skip-function + '(org-agenda-skip-entry-if 'todo 'done)) + ;; Narrow category column: the global agenda format pads the + ;; category to 25 chars, leaving a wide blank gutter between + ;; the source name (todo:, dcal:) and the item. + (org-agenda-prefix-format " %i %-10:c%?-12t% s")))) + ;; No `org-agenda-sticky' here, deliberately: these settings are baked + ;; into the buffer's series-redo-cmd and re-applied by every redo, and a + ;; sticky t mid-redo makes `org-agenda-use-sticky-p' true while the + ;; buffer exists -- `org-agenda-prepare' then throws \\='exit ("use `r' + ;; to refresh") with no catch, failing every refresh tick. Stickiness + ;; is bound in the spawn wrapper instead, where it names the buffer. + ((org-agenda-window-setup 'current-window)))) + +(defun cj/--agenda-frame-register-command () + "Register the agenda-frame view in `org-agenda-custom-commands'. +Idempotent: any existing entry for `cj/--agenda-frame-command-key' is +replaced, so a module reload never accumulates duplicate keys." + (setq org-agenda-custom-commands + (cons (cj/--agenda-frame-command) + (assoc-delete-all cj/--agenda-frame-command-key + org-agenda-custom-commands)))) + +;;; Engage routing — open the item's source outside the agenda frame + +(defun cj/--agenda-frame-item-marker () + "Return the source marker for the agenda item at point, or nil. +Prefers the item's own marker, falling back to the heading marker. Reads +the text property directly (like `org-get-at-bol') so point restoration +is exercisable without loading org." + (or (get-text-property (line-beginning-position) 'org-marker) + (get-text-property (line-beginning-position) 'org-hd-marker))) + +(defun cj/--agenda-frame-target-frame () + "Return the frame to open agenda source in, creating one when needed. +The engage action never opens into the agenda frame: it targets the +working frame (`cj/--agenda-frame-working-frame'), and when the agenda +frame is the only live frame it creates a normal, non-fullscreen frame." + (or (cj/--agenda-frame-working-frame) + (make-frame))) + +(defun cj/--agenda-frame-engage-open () + "Open the source of the agenda item at point in the working frame. +Routes to the MRU non-agenda frame (or a new normal frame when the agenda +frame is the only one), so the agenda frame keeps showing the agenda. +Signals a `user-error' when point is not on an agenda item." + (interactive) + (let ((marker (cj/--agenda-frame-item-marker))) + (unless (and marker (marker-buffer marker)) + (user-error "No agenda item on this line")) + (let ((buffer (marker-buffer marker)) + (pos (marker-position marker)) + (frame (cj/--agenda-frame-target-frame))) + (select-frame-set-input-focus frame) + (pop-to-buffer-same-window buffer) + (widen) + (goto-char pos) + (when (derived-mode-p 'org-mode) + (org-fold-show-context 'agenda)) + (beginning-of-line)))) + +(defun cj/--agenda-frame-engage-mouse (event) + "Open the agenda item clicked by EVENT in the working frame." + (interactive "e") + (mouse-set-point event) + (cj/--agenda-frame-engage-open)) + +(defun cj/--agenda-frame-open-link () + "Follow the link in the agenda item at point, in the working frame." + (interactive) + (select-frame-set-input-focus (cj/--agenda-frame-target-frame)) + (org-agenda-open-link)) + +(defun cj/--agenda-frame-close () + "Close the agenda frame from within it. +Bound to q, Q, and x so Org's own quit keys delete the whole frame +\(and cancel its timer) rather than leaving a sole-window agenda +frame stranded on a non-agenda buffer." + (interactive) + (cj/--agenda-frame-delete)) + +;;; Default-deny read-only policy + +(defconst cj/--agenda-frame-readonly-message + "Agenda frame is read-only — press RET to edit in your working frame" + "Shown when a mutating or buffer-opening command is denied in the frame.") + +(defconst cj/--agenda-frame-fixed-view-message + "Agenda frame shows only the day (d) and week (w) views" + "Shown when a view-changing command is denied in the frame.") + +(defun cj/--agenda-frame-denied-readonly () + "Deny a mutating or buffer-opening command in the agenda frame. +The default binding for every key not on the allowlist." + (interactive) + (message "%s" cj/--agenda-frame-readonly-message)) + +(defun cj/--agenda-frame-denied-fixed-view () + "Deny a view-changing command that would break the today-anchored span." + (interactive) + (message "%s" cj/--agenda-frame-fixed-view-message)) + +(defvar cj/agenda-frame-mode-map + (let ((map (make-sparse-keymap))) + ;; Default-deny: every key/mouse event not rebound below funnels through + ;; this one catch-all, so mutations (present and future) are read-only. + (define-key map [t] #'cj/--agenda-frame-denied-readonly) + ;; Hide the Org Agenda menu-bar entry so there is no menu path to a mutation. + (define-key map [menu-bar org-agenda] #'undefined) + ;; (a) Navigation — allowlisted to their org-agenda commands. + (define-key map (kbd "n") #'org-agenda-next-line) + (define-key map (kbd "p") #'org-agenda-previous-line) + (define-key map (kbd "<down>") #'org-agenda-next-line) + (define-key map (kbd "<up>") #'org-agenda-previous-line) + (define-key map (kbd "C-n") #'org-agenda-next-line) + (define-key map (kbd "C-p") #'org-agenda-previous-line) + (define-key map (kbd "N") #'org-agenda-next-item) + (define-key map (kbd "P") #'org-agenda-previous-item) + (define-key map (kbd "C-v") #'scroll-up-command) + (define-key map (kbd "M-v") #'scroll-down-command) + (define-key map (kbd "M-<") #'beginning-of-buffer) + (define-key map (kbd "M->") #'end-of-buffer) + ;; Read-only point motion and search within the agenda. + (define-key map (kbd "C-a") #'move-beginning-of-line) + (define-key map (kbd "C-e") #'move-end-of-line) + (define-key map (kbd "C-f") #'forward-char) + (define-key map (kbd "C-b") #'backward-char) + (define-key map (kbd "C-s") #'isearch-forward) + (define-key map (kbd "C-r") #'isearch-backward) + (define-key map (kbd "C-g") #'keyboard-quit) + ;; (b) Engage / open — routed to the working frame, never the agenda frame. + ;; Bind the GUI function-key events ([return]/[tab]) as well as the ASCII + ;; forms: the [t] catch-all otherwise gives `return'/`tab' a binding, which + ;; suppresses their function-key translation to RET/TAB, so a bare RET would + ;; hit the deny handler instead of engaging in a graphical frame. + (define-key map (kbd "RET") #'cj/--agenda-frame-engage-open) + (define-key map (kbd "TAB") #'cj/--agenda-frame-engage-open) + (define-key map [return] #'cj/--agenda-frame-engage-open) + (define-key map [tab] #'cj/--agenda-frame-engage-open) + (define-key map (kbd "<mouse-2>") #'cj/--agenda-frame-engage-mouse) + (define-key map (kbd "C-c C-o") #'cj/--agenda-frame-open-link) + ;; (c) The frame's own controls. + (define-key map (kbd "q") #'cj/--agenda-frame-close) + (define-key map (kbd "Q") #'cj/--agenda-frame-close) + (define-key map (kbd "x") #'cj/--agenda-frame-close) + (define-key map (kbd "r") #'cj/--agenda-frame-safe-redo) + ;; g is the muscle-memory agenda refresh; keep it working here (the + ;; frame-scoped safe redo, same as r) rather than denying it as a + ;; view-change. C-M-<f8> stays the force-rescan. + (define-key map (kbd "g") #'cj/--agenda-frame-safe-redo) + ;; d / w toggle the span (today's day vs the seven-day view) in place; the + ;; other view-changers stay denied to keep the today-anchored frame stable. + (define-key map (kbd "d") #'cj/--agenda-frame-day-view) + (define-key map (kbd "w") #'cj/--agenda-frame-week-view) + ;; (d) Controlled task mutations. The frame remains default-deny for + ;; scheduling, clocking, capture, notes, and file writes, but status and + ;; priority are deliberate in-place agenda operations. C-c t is Craig's + ;; requested status chord; C-c C-t keeps Org's standard agenda chord. + ;; This config uses Super arrows in ordinary Org agendas, while Meta arrows + ;; are the requested Full Agenda muscle memory, so support both. + (define-key map (kbd "C-c t") #'org-agenda-todo) + (define-key map (kbd "C-c C-t") #'org-agenda-todo) + (dolist (key '("M-<up>" "s-<up>")) + (define-key map (kbd key) #'org-agenda-priority-up)) + (dolist (key '("M-<down>" "s-<down>")) + (define-key map (kbd key) #'org-agenda-priority-down)) + (dolist (key '("M-<left>" "s-<left>")) + (define-key map (kbd key) #'org-agenda-todo-previousset)) + (dolist (key '("M-<right>" "s-<right>")) + (define-key map (kbd key) #'org-agenda-todo-nextset)) + (define-key map (kbd "S-<f8>") #'cj/agenda-frame-toggle) + (define-key map (kbd "C-M-<f8>") #'cj/org-agenda-refresh-files) + ;; C-x C-c means "close this frame" here. The global + ;; `save-buffers-kill-terminal' must never run in this frame: it was made + ;; by `make-frame', not emacsclient, so with no client to close it falls + ;; back to killing the daemon itself. + (define-key map (kbd "C-x C-c") #'cj/--agenda-frame-close) + ;; (e) Input machinery punched through the catch-all. An explicit nil + ;; shadows the [t] default in this map, so these fall through to their + ;; global bindings. Without the punches, every frame-focus change + ;; (switch-frame), every wheel scroll, and every mouse click hits the + ;; deny handler -- message spam and broken frame switching. + (dolist (key (list [switch-frame] + [wheel-up] [wheel-down] [wheel-left] [wheel-right] + [double-wheel-up] [double-wheel-down] + [triple-wheel-up] [triple-wheel-down] + [mouse-1] [down-mouse-1] [drag-mouse-1] + (kbd "C-h"))) + (define-key map key nil)) + ;; (f) Global chords that would pull focus out of the frame must be + ;; denied *explicitly*. The [t] catch-all can't reach them: a keymap's + ;; default binding does not shadow an *explicit* binding in a + ;; lower-priority map, and these are bound in the global map (M-SPC / + ;; M-S-SPC swap ai-term agents). Left to the catch-all, M-SPC follows + ;; its global binding and escapes the read-only frame into ai-term. + (dolist (key '("M-SPC" "M-S-SPC")) + (define-key map (kbd key) #'cj/--agenda-frame-denied-readonly)) + ;; The remaining view-changers get the distinct fixed-view message, not the + ;; read-only one. d/w are handled above (they toggle the span in place). + (dolist (key '("y" "f" "b" "j")) + (define-key map (kbd key) #'cj/--agenda-frame-denied-fixed-view)) + map) + "Keymap for `cj/agenda-frame-mode'. +Shadows `org-agenda-mode-map' by default-deny: the `[t]' catch-all denies +every key that is not explicitly allowlisted here. Status and priority are +the only source-task mutations allowed; a future Org binding is denied by +default and there is nothing to keep in sync.") + +(define-minor-mode cj/agenda-frame-mode + "Focus-locked, default-deny policy for the dedicated agenda frame. +Only the allowlist in `cj/agenda-frame-mode-map' is permitted: navigation, +the engage/open keys (routed to the working frame), and the frame's own +controls, plus controlled task status and priority changes. Every other +key/mouse command is denied. The enforcement boundary is keys and mouse; +a direct \\[execute-extended-command] is out of contract." + :init-value nil + :lighter " AgendaFrame" + :keymap cj/agenda-frame-mode-map) + +(defun cj/--agenda-frame-shadow-mutations (&optional source-map prefix) + "Deny every SOURCE-MAP key sequence not on the frame map's allowlist. +Walk SOURCE-MAP (default `org-agenda-mode-map') recursively. For each +sequence it binds to a command, if `cj/agenda-frame-mode-map' doesn't already +bind that sequence to a command or manage it as a prefix, add an explicit +read-only deny. + +This closes the default-deny hole: a keymap's `[t]' default never shadows an +explicit binding in a lower-priority map, so a single `[t]' catch-all denies +only keys that are unbound everywhere. Every key `org-agenda-mode-map' binds +\(t, I, k, z, s, ., the C-c mutators, C-x C-s, ...) would otherwise sail +through the catch-all and mutate source files from the read-only frame. +Explicitly denying each non-allowlisted sequence makes the catch-all's intent +actually hold. + +PREFIX is the accumulated key vector during recursion (internal). Idempotent: +re-running rebinds the same denials. Runs from `with-eval-after-load' once +`org-agenda-mode-map' exists." + (let ((source (or source-map org-agenda-mode-map)) + (prefix (or prefix []))) + (map-keymap + (lambda (event binding) + (unless (or (eq event t) (eq event 'menu-bar) (eq event 'remap) + (consp event)) + (let ((seq (vconcat prefix (vector event)))) + (cond + ((keymapp binding) + (cj/--agenda-frame-shadow-mutations binding seq)) + ((commandp binding) + (let ((ours (lookup-key cj/agenda-frame-mode-map seq))) + ;; A command we allowlisted or a prefix we manage: leave it. + ;; Anything else (only the `[t]' default, or unbound under a + ;; shared prefix) escapes to org's command -- deny it here. + (unless (or (commandp ours) (keymapp ours)) + (define-key cj/agenda-frame-mode-map seq + #'cj/--agenda-frame-denied-readonly)))))))) + source))) + +;; The shadow walk is installed at the END of this file, not here: it reads +;; `commandp' on each allowlisted binding to decide whether to keep it, and the +;; view/redo handlers (day-view, week-view, safe-redo) are defined further down. +;; If org-agenda is already loaded when this file loads (the normal startup order, +;; and every reload), `with-eval-after-load' fires immediately -- so the walk must +;; not run until those defuns exist, or it reads them as undefined, fails the +;; commandp guard, and denies the very keys the allowlist grants. See the bottom +;; of the file. + +(defun cj/--agenda-frame-maybe-enable-mode () + "Re-enable `cj/agenda-frame-mode' after an agenda build in the agenda frame. +Added to `org-agenda-finalize-hook'. `org-agenda-redo' rebuilds through +`org-agenda-mode', whose `kill-all-local-variables' strips the buffer-local +minor mode; this reinstates it whenever the just-built buffer is displayed +in the frame carrying the `cj/agenda-frame' marker (a frame parameter, which +survives the buffer reset). Ordinary agenda builds in working frames are +left untouched. + +The same reset also strips the buffer-local `kill-buffer-hook' installed at +spawn, so it is re-added here too -- otherwise, after the first refresh +tick, killing the buffer would no longer delete the frame." + (let ((frame (cj/--agenda-frame))) + (when (and frame (get-buffer-window (current-buffer) frame)) + (cj/agenda-frame-mode 1) + (add-hook 'kill-buffer-hook #'cj/--agenda-frame-on-kill-buffer nil t)))) + +;;; Frame lifecycle — spawn, raise, delete, toggle, cleanup + +(defconst cj/--agenda-frame-timer-parameter 'cj/agenda-frame-timer + "Frame parameter holding the agenda frame's refresh timer (set in Phase 2).") + +(declare-function auto-dim-other-buffers-mode "auto-dim-other-buffers" (&optional arg)) + +(defvar cj/--agenda-frame-dim-was-on nil + "Non-nil when the agenda frame's spawn turned `auto-dim-other-buffers-mode' off. +The refresh tick's selection swing marks the working window non-selected, +and auto-dim's debounced dim lands after the tick -- the working frame +visibly dims every five minutes. Spawn suspends the mode and remembers it +here; closing the frame restores it.") + +(defun cj/--agenda-frame-suspend-dim () + "Turn auto-dim off for the agenda frame's lifetime, remembering it was on." + (when (and (bound-and-true-p auto-dim-other-buffers-mode) + (fboundp 'auto-dim-other-buffers-mode)) + (setq cj/--agenda-frame-dim-was-on t) + (auto-dim-other-buffers-mode -1))) + +(defun cj/--agenda-frame-restore-dim () + "Restore auto-dim if the agenda frame's spawn suspended it." + (when (and cj/--agenda-frame-dim-was-on + (fboundp 'auto-dim-other-buffers-mode)) + (setq cj/--agenda-frame-dim-was-on nil) + (auto-dim-other-buffers-mode 1))) + +(defvar cj/--agenda-frame-tearing-down nil + "Non-nil while the agenda frame is being torn down. +Breaks the `delete-frame' / `kill-buffer-hook' re-entrancy loop: deleting +the frame kills its buffer and killing the buffer deletes the frame, so +whichever fires first sets this to skip the other.") + +(defun cj/--agenda-frame-sticky-buffer () + "Return the dedicated *Org Agenda(F)* sticky buffer, or nil if none." + (get-buffer (format "*Org Agenda(%s)*" cj/--agenda-frame-command-key))) + +(defun cj/--agenda-frame-cancel-timer (&optional frame) + "Cancel and clear the refresh timer on FRAME (default: the agenda frame). +Safe when no timer is set or FRAME is dead. Returns nil." + (let* ((frame (or frame (cj/--agenda-frame))) + (timer (and (frame-live-p frame) + (frame-parameter frame cj/--agenda-frame-timer-parameter)))) + (when (timerp timer) + (cancel-timer timer)) + (when (frame-live-p frame) + (set-frame-parameter frame cj/--agenda-frame-timer-parameter nil)) + nil)) + +(defun cj/--agenda-frame-on-delete-frame (frame) + "Clean up when the agenda FRAME dies by any path. +Registered on `delete-frame-functions': cancels the refresh timer and +kills the dedicated sticky buffer, so the next spawn regenerates fresh +rather than reusing stale sticky content. A non-agenda frame is ignored." + (when (cj/--agenda-frame-p frame) + (cj/--agenda-frame-cancel-timer frame) + (cj/--agenda-frame-restore-dim) + (let ((buffer (cj/--agenda-frame-sticky-buffer)) + (cj/--agenda-frame-tearing-down t)) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(defun cj/--agenda-frame-on-kill-buffer () + "Delete the agenda frame when its dedicated buffer is killed. +A buffer-local `kill-buffer-hook' on the sticky buffer, so killing it from +anywhere takes the frame with it. Guarded against re-entry during a +frame-initiated teardown." + (unless cj/--agenda-frame-tearing-down + (let ((frame (cj/--agenda-frame))) + (when (frame-live-p frame) + (delete-frame frame))))) + +(defun cj/--agenda-frame-delete () + "Delete the agenda frame; a no-op when none exists. +`delete-frame' fires `cj/--agenda-frame-on-delete-frame', which cancels +the timer and kills the sticky buffer." + (let ((frame (cj/--agenda-frame))) + (when (frame-live-p frame) + (delete-frame frame)))) + +(defun cj/--agenda-frame-raise (frame) + "Raise FRAME and give it input focus. Returns FRAME." + (select-frame-set-input-focus frame) + frame) + +(defun cj/--agenda-frame-make-parameters () + "Return the frame parameters for the dedicated agenda frame. +A normal frame -- not fullscreen -- so a tiling window manager places it +side by side with the working frame rather than covering the whole output. +It carries the `cj/agenda-frame' marker and a distinct, noticeable name +\(\"Full Agenda\") so the frame is recognizable at a glance and +window-manager rules can target it." + `((,cj/--agenda-frame-parameter . t) + (name . "Full Agenda"))) + +(defun cj/--agenda-frame-spawn () + "Create, display, and focus the dedicated agenda frame. +Transactional: on any failure after `make-frame', delete the partial +frame (which cleans up its buffer and timer via the delete hook), restore +focus to the launching frame, and signal a `user-error' naming the cause. +Returns the new agenda frame on success." + (let ((launch (selected-frame)) + (frame nil)) + (condition-case err + (progn + (setq cj/--agenda-frame-launch-frame launch) + ;; A fresh frame opens at the documented seven-day default, even if a + ;; prior session left the span on the day view (d). + (setq cj/--agenda-frame-span 7) + (setq frame (make-frame (cj/--agenda-frame-make-parameters))) + (select-frame-set-input-focus frame) + ;; Cached, non-forced: a frame spawned early after daemon startup + ;; still shows the full project agenda, not the base-files-only view. + (cj/build-org-agenda-list) + ;; Bind sticky + current-window dynamically around the render. The + ;; custom command's own settings apply too late to name the buffer; + ;; without these the buffer is plain *Org Agenda*, which matches the + ;; 0.75 below-selected display rule in org-agenda-config.el -- the + ;; new frame gets split with the launch buffer left in the top 25%. + ;; Sticky names it *Org Agenda(F)*, which no display rule matches. + (let ((org-agenda-sticky t) + (org-agenda-window-setup 'current-window)) + (org-agenda "a" cj/--agenda-frame-command-key)) + ;; Belt: whatever a display rule did, the frame is one agenda window. + (delete-other-windows) + (let ((buffer (cj/--agenda-frame-sticky-buffer))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (add-hook 'kill-buffer-hook + #'cj/--agenda-frame-on-kill-buffer nil t)))) + (cj/--agenda-frame-start-timer frame) + (cj/--agenda-frame-suspend-dim) + frame) + (error + (when (frame-live-p frame) + (delete-frame frame)) + (when (frame-live-p launch) + (select-frame-set-input-focus launch)) + (user-error "Agenda frame: spawn failed: %s" + (error-message-string err)))))) + +(defun cj/--agenda-frame-toggle () + "Spawn, raise, or delete the dedicated agenda frame. +Spawn when none exists, delete when the agenda frame is the selected +frame, raise and focus it otherwise. + +Non-interactive by design in Phase 1: reachable only from ERT, never from +\\[execute-extended-command] or a key. Phase 2 wraps this in the public +`cj/agenda-frame-toggle' and binds it to S-<f8>." + (let ((frame (cj/--agenda-frame))) + (cond + ((null frame) (cj/--agenda-frame-spawn)) + ((eq frame (selected-frame)) (cj/--agenda-frame-delete) nil) + (t (cj/--agenda-frame-raise frame))))) + +;;; Phase 2 — refresh timer, snapshot restore, and the public command + +(defconst cj/--agenda-frame-refresh-seconds 300 + "Refresh cadence for the agenda frame, in seconds (five minutes).") + +(defconst cj/--agenda-frame-fail-count-parameter 'cj/agenda-frame-fail-count + "Frame parameter holding the consecutive-failure count for the refresh timer.") + +(defconst cj/--agenda-frame-overlay-property 'cj/agenda-frame-failure + "Overlay property tagging the refresh-failed banner. +The banner is found by scanning for this property, never held in a +buffer-local variable: `org-agenda-redo' runs `kill-all-local-variables', +which would wipe the variable while the overlay object survives +`erase-buffer' -- leaving a banner nothing could ever remove.") + +(defun cj/--agenda-frame-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 seconds (300 gives the :00/:05 +marks). A TIME exactly on a mark returns a full PERIOD, so the timer +never fires twice back-to-back." + (let ((rem (mod (floor (float-time time)) period))) + (if (zerop rem) period (- period rem)))) + +;; -- Point restoration ------------------------------------------------------- + +(defun cj/--agenda-frame-goto-first-item () + "Move point to the first agenda item, or `point-min' when the view is empty." + (goto-char (point-min)) + (let ((found nil)) + (while (and (not found) (not (eobp))) + (if (get-text-property (line-beginning-position) 'org-marker) + (setq found t) + (forward-line 1))) + (unless found (goto-char (point-min))))) + +(defun cj/--agenda-frame-restore-point (old-marker old-line) + "Restore point in the rebuilt agenda buffer after a redo. +Prefer the line whose org-marker points at the same source location as +OLD-MARKER, choosing the occurrence nearest OLD-LINE when a source line +appears twice. When the marker is gone, clamp OLD-LINE into range; if +that lands on a header (no item), move to the first item; an item-less +view leaves point at buffer start." + (let ((max-line (line-number-at-pos (point-max))) + (targets '())) + (when (and (markerp old-marker) (marker-buffer old-marker)) + (let ((src-buf (marker-buffer old-marker)) + (src-pos (marker-position old-marker))) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((m (get-text-property (line-beginning-position) 'org-marker))) + (when (and (markerp m) + (eq (marker-buffer m) src-buf) + (eql (marker-position m) src-pos)) + (push (line-number-at-pos) targets))) + (forward-line 1))))) + (cond + (targets + (let ((best (car (sort targets + (lambda (a b) + (< (abs (- a old-line)) (abs (- b old-line)))))))) + (goto-char (point-min)) + (forward-line (1- best)))) + (t + (let ((line (max 1 (min old-line max-line)))) + (goto-char (point-min)) + (forward-line (1- line)) + (unless (get-text-property (line-beginning-position) 'org-marker) + (cj/--agenda-frame-goto-first-item))))))) + +;; -- Snapshot with cloned markers -------------------------------------------- + +(defun cj/--agenda-frame-snapshot-markers (buffer) + "Return a list of (POSITION . CLONE) for every org-marker in BUFFER. +CLONE is an independent `copy-marker' into the same source location, so +it survives `org-agenda-reset-markers' nulling BUFFER's own markers on a +rebuild." + (with-current-buffer buffer + (let ((clones '()) + (pos (point-min))) + (while (< pos (point-max)) + (let ((m (get-text-property pos 'org-marker))) + (when (and (markerp m) (marker-buffer m)) + (push (cons pos (copy-marker m)) clones))) + (setq pos (or (next-single-property-change pos 'org-marker buffer) + (point-max)))) + (nreverse clones)))) + +(defun cj/--agenda-frame-reinstall-markers (buffer clones) + "Reapply CLONES (from `cj/--agenda-frame-snapshot-markers') to BUFFER. +Restores each cloned marker as the org-marker text property at its +recorded position, so RET/TAB resolve to the right source line after a +snapshot restore." + (with-current-buffer buffer + (dolist (entry clones) + (let ((pos (car entry))) + (when (and (>= pos (point-min)) (< pos (point-max))) + (put-text-property pos (1+ pos) 'org-marker (cdr entry))))))) + +(defun cj/--agenda-frame-snapshot (buffer window) + "Capture BUFFER's last-good state for restore after a failed redo. +Returns a plist of the propertized :text (carrying org-redo-cmd/org-lprops), +:point, :window-start, and :markers (cloned, source-owned)." + (with-current-buffer buffer + (list :text (buffer-substring (point-min) (point-max)) + :point (point) + :window-start (and (window-live-p window) (window-start window)) + :markers (cj/--agenda-frame-snapshot-markers buffer)))) + +(defun cj/--agenda-frame-restore-snapshot (buffer snapshot window) + "Restore SNAPSHOT verbatim into BUFFER, reinstating cloned markers. +Sets point and, when WINDOW is live, window-start from the snapshot." + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (plist-get snapshot :text)) + (cj/--agenda-frame-reinstall-markers buffer (plist-get snapshot :markers)) + (goto-char (min (plist-get snapshot :point) (point-max)))) + (when (and (window-live-p window) (plist-get snapshot :window-start)) + (set-window-start window (min (plist-get snapshot :window-start) + (point-max)))))) + +(defun cj/--agenda-frame-release-snapshot (snapshot) + "Release SNAPSHOT's cloned markers so repeated redoes don't leak markers. +Called on a successful redo (the snapshot is discarded); never on the +error path, where the clones become the buffer's live org-markers." + (dolist (entry (plist-get snapshot :markers)) + (when (markerp (cdr entry)) + (set-marker (cdr entry) nil)))) + +;; -- Failure latch and overlay ----------------------------------------------- + +(defun cj/--agenda-frame-record-failure (frame) + "Increment FRAME's consecutive-failure count; return non-nil to report. +Reports only on the first failure of a run (the 0 -> 1 transition)." + (let ((n (1+ (or (frame-parameter frame cj/--agenda-frame-fail-count-parameter) + 0)))) + (set-frame-parameter frame cj/--agenda-frame-fail-count-parameter n) + (= n 1))) + +(defun cj/--agenda-frame-clear-failure (frame) + "Reset FRAME's consecutive-failure count (the next tick reports again)." + (set-frame-parameter frame cj/--agenda-frame-fail-count-parameter 0)) + +(defun cj/--agenda-frame-failure-overlays (buffer) + "Return the refresh-failed banner overlays in BUFFER (normally 0 or 1)." + (with-current-buffer buffer + (seq-filter (lambda (o) (overlay-get o cj/--agenda-frame-overlay-property)) + (overlays-in (point-min) (point-max))))) + +(defun cj/--agenda-frame-show-failure-overlay (buffer) + "Show the refresh-failed notice as an overlay at the top of BUFFER. +Idempotent: an existing banner is reused, so consecutive failures never +stack a second one." + (with-current-buffer buffer + (let ((overlay (or (car (cj/--agenda-frame-failure-overlays buffer)) + (make-overlay (point-min) (point-min))))) + (overlay-put overlay cj/--agenda-frame-overlay-property t) + (overlay-put overlay 'before-string + (propertize "Agenda frame: refresh failed (C-M-<f8> to force-rescan)\n" + 'face 'warning))))) + +(defun cj/--agenda-frame-remove-overlay (buffer) + "Remove the refresh-failed banner from BUFFER, if present." + (when (buffer-live-p buffer) + (mapc #'delete-overlay (cj/--agenda-frame-failure-overlays buffer)))) + +;; -- The refresh itself ------------------------------------------------------ + +(defun cj/--agenda-frame-do-redo (frame buffer window) + "Redo the agenda in BUFFER, degrading to the last-good snapshot on failure. +On success: drop the failure overlay, restore point, clear the failure +latch, and release the pre-redo snapshot. On error: restore the snapshot +verbatim, re-enable the policy (the finalize hook runs only on success), +show the failure overlay, and report once per consecutive-failure run. +Either way the frame is never blank, unrestricted, or non-retryable." + (with-current-buffer buffer + ;; Clone the point marker: `org-agenda-redo' calls `org-agenda-reset-markers' + ;; which nulls the buffer's own org-markers, so the raw marker would be dead + ;; by the time `cj/--agenda-frame-restore-point' runs -- collapsing the + ;; "follow the same source item" restoration to the line-number clamp on + ;; every normal tick. An independent clone survives the reset. + (let ((old-marker (let ((m (cj/--agenda-frame-item-marker))) + (and (markerp m) (marker-buffer m) (copy-marker m)))) + (old-line (line-number-at-pos)) + (snapshot (cj/--agenda-frame-snapshot buffer window))) + (unwind-protect + (condition-case nil + ;; Never bind sticky here: `org-agenda-redo' handles the + ;; in-place rebuild itself (binds sticky nil, redirects the + ;; buffer name). A sticky t reaching `org-agenda-prepare' + ;; mid-redo makes it throw \\='exit with no catch, failing + ;; every tick. current-window is bound as a belt so a rule + ;; can't split the frame during the rebuild. + (let ((inhibit-message t) + (org-agenda-window-setup 'current-window)) + (org-agenda-redo) + (cj/--agenda-frame-remove-overlay buffer) + (cj/--agenda-frame-restore-point old-marker old-line) + (cj/--agenda-frame-clear-failure frame) + (cj/--agenda-frame-release-snapshot snapshot)) + (error + (cj/--agenda-frame-restore-snapshot buffer snapshot window) + (cj/agenda-frame-mode 1) + (cj/--agenda-frame-show-failure-overlay buffer) + (when (cj/--agenda-frame-record-failure frame) + (message "Agenda frame: refresh failed (C-M-<f8> to force-rescan)")))) + (when (markerp old-marker) + (set-marker old-marker nil)))))) + +(defun cj/--agenda-frame-safe-redo (&optional frame) + "Refresh the agenda buffer in FRAME safely (the timer tick and manual `r'). +Runs with the dedicated window selected for the redo's dynamic extent and +restores the prior window afterward, never calling an input-focus +function, so a tick while another frame is active neither errors on an +out-of-range window-start nor steals focus." + (interactive) + (let* ((frame (or frame (cj/--agenda-frame))) + (buffer (cj/--agenda-frame-sticky-buffer)) + (window (and (frame-live-p frame) (buffer-live-p buffer) + (get-buffer-window buffer frame)))) + (when (and (window-live-p window) + ;; Skip the tick while a minibuffer is active anywhere -- + ;; reselecting windows under an active minibuffer session can + ;; break it, and the next tick catches up. + (not (active-minibuffer-window))) + (let ((prev-window (selected-window)) + ;; The rebuild takes visible time, and for its duration the + ;; agenda window is the selected window. Without inhibiting + ;; redisplay the user's cursor visibly goes hollow for the whole + ;; rebuild every tick -- indistinguishable from focus theft. + ;; The rebuild blocks Emacs either way (it is synchronous), so + ;; this hides the selection flicker at no extra cost; redisplay + ;; resumes after the selection is restored. + (inhibit-redisplay t)) + (unwind-protect + (progn + (select-window window t) + (cj/--agenda-frame-do-redo frame buffer window)) + (when (window-live-p prev-window) + (select-window prev-window t))))))) + +(defun cj/--agenda-frame-day-view () + "Shrink the Full Agenda frame to today's single-day view. +Sets the span to 1 and refreshes. The redo re-evaluates the span, so the +day view survives the wall-clock refresh tick until `w' widens it again." + (interactive) + (setq cj/--agenda-frame-span 1) + (cj/--agenda-frame-safe-redo)) + +(defun cj/--agenda-frame-week-view () + "Restore the Full Agenda frame to the seven-day today-anchored view. +Sets the span back to 7 and refreshes." + (interactive) + (setq cj/--agenda-frame-span 7) + (cj/--agenda-frame-safe-redo)) + +(defun cj/--agenda-frame-start-timer (frame) + "Start FRAME's five-minute wall-clock refresh timer, unless one exists. +Idempotent: a frame already carrying a live timer keeps it (no duplicate). +Returns the timer." + (unless (timerp (frame-parameter frame cj/--agenda-frame-timer-parameter)) + (let* ((period cj/--agenda-frame-refresh-seconds) + (delay (cj/--agenda-frame-seconds-to-next-mark (current-time) period)) + (timer (run-at-time delay period #'cj/--agenda-frame-safe-redo frame))) + (set-frame-parameter frame cj/--agenda-frame-timer-parameter timer) + timer))) + +;; -- Public command and key install ------------------------------------------ + +(defun cj/agenda-frame-toggle () + "Toggle the dedicated agenda frame. +Spawn it when none exists, raise and focus it when it exists but is +unfocused, and close it when it is the selected frame." + (interactive) + (cj/--agenda-frame-toggle)) + +(defun cj/--agenda-frame-install-keys (&optional map) + "Bind the F8-family keys for the agenda frame in MAP (default: the global map). +S-<f8> toggles the agenda frame; the force-rescan +\(`cj/org-agenda-refresh-files') moves to C-M-<f8>, keeping the whole +force-refresh idea in the F8 family." + (let ((map (or map (current-global-map)))) + (define-key map (kbd "S-<f8>") #'cj/agenda-frame-toggle) + (define-key map (kbd "C-M-<f8>") #'cj/org-agenda-refresh-files))) + +;;; Wiring — registered once org-agenda is loaded (no batch side effects) + +(with-eval-after-load 'org-agenda + (cj/--agenda-frame-register-command) + (add-hook 'org-agenda-finalize-hook #'cj/--agenda-frame-maybe-enable-mode) + (add-hook 'delete-frame-functions #'cj/--agenda-frame-on-delete-frame)) + +;; The public gesture appears only now that the feature is complete and live. +(cj/--agenda-frame-install-keys) + +;; Install the read-only shadow now that every allowlist handler above is +;; defined, so the walk's `commandp' guard recognizes them and preserves the +;; allowlist regardless of whether org-agenda loaded before or after this file. +(with-eval-after-load 'org-agenda + (cj/--agenda-frame-shadow-mutations)) + +(provide 'org-agenda-frame) +;;; org-agenda-frame.el ends here 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..edc6339d 100644 --- a/modules/system-commands.el +++ b/modules/system-commands.el @@ -115,8 +115,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..9b4652e8 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)) diff --git a/modules/system-lib.el b/modules/system-lib.el index f1049c02..54e20b74 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -164,6 +164,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 +196,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/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 f2bc8457..1c8a8ab9 100644 --- a/modules/tramp-config.el +++ b/modules/tramp-config.el @@ -26,6 +26,7 @@ ;; Silence byte-compiler "assignment to free variable" warnings for vars ;; defined by lazily-loaded packages (tramp, dirtrack, magit). These are ;; only set inside the use-package :config block, after the package loads. +(defvar ange-ftp-try-passive-mode) (defvar tramp-copy-size-limit) (defvar tramp-use-ssh-controlmaster-options) (defvar tramp-cleanup-idle-time) @@ -76,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) @@ -119,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") @@ -147,5 +136,11 @@ ;; Cleanup TRAMP buffers when idle (every 15 min) (setq tramp-cleanup-idle-time 900)) +;; FTP (ange-ftp) settings — TRAMP's /ftp: method delegates to ange-ftp. +;; Passive mode is required for servers that can't open a data connection +;; back to this machine (NAT, phone FTP servers); active mode hangs on LIST. +(with-eval-after-load 'ange-ftp + (setq ange-ftp-try-passive-mode t)) + (provide 'tramp-config) ;;; tramp-config.el ends here diff --git a/modules/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/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 41b72ebd..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. @@ -76,9 +80,13 @@ is killed externally." (cj/recording--start-failed-p (- (float-time) start) cj/recording-start-fail-threshold)) ;; Died almost immediately and the user didn't stop it: wf-recorder - ;; couldn't grab the screen. Say so instead of silently clearing, - ;; so Craig isn't left blind-retrying (which bursts fragment files). - (message "Video recording failed to start (wf-recorder couldn't grab the screen). Try again.") + ;; couldn't grab the screen. Delete the ~0.5s stub file the failed + ;; start wrote (it would otherwise litter the recordings directory + ;; and get swept up by *.mkv globs downstream), then say so instead + ;; of silently clearing, so Craig isn't left blind-retrying. + (progn + (cj/recording--delete-failed-start-stub process) + (message "Video recording failed to start (wf-recorder couldn't grab the screen). Try again.")) (message "Video recording stopped: %s" (string-trim event)))))) (force-mode-line-update t))) @@ -129,13 +137,21 @@ launching too soon loses the grab and produces a ~0.5s fragment file." A failed wf-recorder start exits almost immediately; a real recording does not." (< elapsed threshold)) +(defun cj/recording--delete-failed-start-stub (process) + "Delete the stub output file a failed video start left behind. +Reads the output path from PROCESS's `cj-output-file' property (stamped +by `cj/ffmpeg-record-video'). A no-op when the property is absent (a +process started before the property existed) or the file never hit disk." + (let ((file (process-get process 'cj-output-file))) + (when (and file (file-exists-p file)) + (delete-file file)))) + ;;; Dependency Checks (defun cj/recording-check-ffmpeg () "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 () @@ -146,8 +162,7 @@ A failed wf-recorder start exits almost immediately; a real recording does not." "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 @@ -332,8 +347,10 @@ Uses wf-recorder on Wayland, x11grab on X11." (set-process-query-on-exit-flag cj/video-recording-ffmpeg-process nil) (set-process-sentinel cj/video-recording-ffmpeg-process #'cj/recording-process-sentinel) ;; Stamp the start time so the sentinel can tell a ~0.5s failed start - ;; (wf-recorder couldn't grab the screen) from a normal recording. + ;; (wf-recorder couldn't grab the screen) from a normal recording, and + ;; the output path so the failed-start branch can delete the stub file. (process-put cj/video-recording-ffmpeg-process 'cj-start-time (float-time)) + (process-put cj/video-recording-ffmpeg-process 'cj-output-file filename) (force-mode-line-update t) (message "Started video recording to %s (%s, mic: %.1fx, system: %.1fx)." filename diff --git a/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/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/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..dcab7eff 100644 --- a/tests/test-auto-dim-config.el +++ b/tests/test-auto-dim-config.el @@ -30,7 +30,12 @@ (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)) + ;; Entering the minibuffer must not change what is dimmed: a dim window + ;; stays dim, a lit one stays lit. The fork's `adob--update' returns + ;; early when this is nil and the selected window is the minibuffer, so + ;; nil is what keeps a minibuffer prompt from re-dimming the window the + ;; user was just in. + (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)))) 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-daily.el b/tests/test-calendar-sync--expand-daily.el index 43b93664..0db9f345 100644 --- a/tests/test-calendar-sync--expand-daily.el +++ b/tests/test-calendar-sync--expand-daily.el @@ -176,5 +176,52 @@ (occurrences (calendar-sync--expand-daily base-event rrule range))) (should (= (length occurrences) 5)))) +;;; UNTIL is inclusive (RFC 5545 3.3.10) + +(ert-deftest test-calendar-sync--expand-daily-until-includes-the-until-date () + "Boundary: an occurrence falling ON the UNTIL date is kept. +RFC 5545 3.3.10: UNTIL bounds the recurrence \"in an inclusive manner\", and +when it lines up with the recurrence that date \"becomes the last instance\". +A strict before-comparison drops it, so the last meeting of every bounded +series silently vanishes from the agenda." + (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) + (until-date (test-calendar-sync-time-date-only 5)) + (base-event (list :summary "Bounded Standup" :start start-date)) + (rrule (list :freq 'daily :interval 1 :until until-date)) + (range (test-calendar-sync-wide-range)) + (occurrences (calendar-sync--expand-daily base-event rrule range)) + (last-start (plist-get (car (last occurrences)) :start))) + ;; day+1 through day+5 inclusive = 5 occurrences. + (should (= (length occurrences) 5)) + ;; The final occurrence is the UNTIL date itself. + (should (equal (seq-take last-start 3) until-date)))) + +(ert-deftest test-calendar-sync--expand-daily-until-excludes-dates-after-it () + "Boundary: inclusivity stops at UNTIL; the next day is not generated. +Guards the fix against over-correcting into an off-by-one the other way." + (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) + (until-date (test-calendar-sync-time-date-only 5)) + (day-after (test-calendar-sync-time-date-only 6)) + (base-event (list :summary "Bounded Standup" :start start-date)) + (rrule (list :freq 'daily :interval 1 :until until-date)) + (range (test-calendar-sync-wide-range)) + (occurrences (calendar-sync--expand-daily base-event rrule range)) + (dates (mapcar (lambda (o) (seq-take (plist-get o :start) 3)) occurrences))) + (should (member until-date dates)) + (should-not (member day-after dates)))) + +(ert-deftest test-calendar-sync--expand-daily-until-on-start-date-yields-one () + "Boundary: UNTIL equal to the start date yields exactly that one occurrence. +The degenerate single-instance series -- a strict comparison returns nothing +at all here, which is the same defect at its smallest." + (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) + (until-date (test-calendar-sync-time-date-only 1)) + (base-event (list :summary "One Shot" :start start-date)) + (rrule (list :freq 'daily :interval 1 :until until-date)) + (range (test-calendar-sync-wide-range)) + (occurrences (calendar-sync--expand-daily base-event rrule range))) + (should (= (length occurrences) 1)) + (should (equal (seq-take (plist-get (car occurrences) :start) 3) until-date)))) + (provide 'test-calendar-sync--expand-daily) ;;; test-calendar-sync--expand-daily.el ends here diff --git a/tests/test-calendar-sync--expand-monthly.el b/tests/test-calendar-sync--expand-monthly.el index 3dc1f2dc..41b196a7 100644 --- a/tests/test-calendar-sync--expand-monthly.el +++ b/tests/test-calendar-sync--expand-monthly.el @@ -170,5 +170,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-weekly.el b/tests/test-calendar-sync--expand-weekly.el index a6143bce..0639ca07 100644 --- a/tests/test-calendar-sync--expand-weekly.el +++ b/tests/test-calendar-sync--expand-weekly.el @@ -270,5 +270,33 @@ (should (= (length occurrences) 0))) (test-calendar-sync--expand-weekly-teardown))) +;;; UNTIL is inclusive (RFC 5545 3.3.10) + +(ert-deftest test-calendar-sync--expand-weekly-until-includes-the-until-date () + "Boundary: a weekly occurrence landing ON the UNTIL date is kept. +The weekly loop checks UNTIL in two places -- the outer week-stepping guard +and the per-weekday check inside it -- so it needs its own guard rather than +inheriting the daily one. Fixing the loop without this test left weekly +silently unprotected: reverting the fix failed three daily tests and zero +weekly ones." + (test-calendar-sync--expand-weekly-setup) + (unwind-protect + ;; Omitting :byday makes the series recur on the start date's own weekday, + ;; which anchors UNTIL exactly on an occurrence without hardcoding a date. + (let* ((start-date (test-calendar-sync-time-days-from-now 1 9 0)) + (week-2 (test-calendar-sync-time-date-only 8)) + (until-date (test-calendar-sync-time-date-only 15)) + (week-4 (test-calendar-sync-time-date-only 22)) + (base-event (list :summary "Bounded Weekly" :start start-date)) + (rrule (list :freq 'weekly :interval 1 :until until-date)) + (range (test-calendar-sync-wide-range)) + (occurrences (calendar-sync--expand-weekly base-event rrule range)) + (dates (mapcar (lambda (o) (seq-take (plist-get o :start) 3)) occurrences))) + ;; day+1, +8, +15 are consecutive same-weekday dates; UNTIL is the third. + (should (equal dates (list (seq-take start-date 3) week-2 until-date))) + ;; Inclusivity stops at UNTIL -- the following week is not generated. + (should-not (member week-4 dates))) + (test-calendar-sync--expand-weekly-teardown))) + (provide 'test-calendar-sync--expand-weekly) ;;; test-calendar-sync--expand-weekly.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--format-timestamp.el b/tests/test-calendar-sync--format-timestamp.el index 5b8a6d02..b84e625d 100644 --- a/tests/test-calendar-sync--format-timestamp.el +++ b/tests/test-calendar-sync--format-timestamp.el @@ -56,5 +56,59 @@ ;; start-hour is nil so time-str should be nil (should-not (string-match-p "[0-9][0-9]:[0-9][0-9]-" result)))) +;;; Multi-day spans (org range syntax) + +(ert-deftest test-calendar-sync--format-timestamp-multi-day-timed-spans-dates () + "A timed event ending on a later date renders as an org range. +The end DATE used to be discarded and only its time kept, so a four-day +conference produced the same timestamp as a same-day meeting and the agenda +showed it on day one only." + (let ((result (calendar-sync--format-timestamp + '(2026 3 15 14 0) '(2026 3 18 15 30)))) + (should (equal result "<2026-03-15 Sun 14:00>--<2026-03-18 Wed 15:30>")))) + +(ert-deftest test-calendar-sync--format-timestamp-multi-day-all-day-excludes-dtend () + "An all-day span ends the day before DTEND, which is non-inclusive. +RFC 5545 3.6.1: DTEND is \"the non-inclusive end of the event\", so an +all-day event running Mar 15-17 carries DTEND 2026-03-18. Rendering DTEND +verbatim would add a phantom fourth day." + (let ((result (calendar-sync--format-timestamp + '(2026 3 15 nil nil) '(2026 3 18 nil nil)))) + (should (equal result "<2026-03-15 Sun>--<2026-03-17 Tue>")))) + +(ert-deftest test-calendar-sync--format-timestamp-single-all-day-stays-single () + "A one-day all-day event stays a single stamp, never a degenerate range. +Its DTEND is the next day (non-inclusive), so a naive range would turn every +single all-day event into a two-day one -- a worse regression than the +collapse this range support fixes." + (let ((result (calendar-sync--format-timestamp + '(2026 3 15 nil nil) '(2026 3 16 nil nil)))) + (should (equal result "<2026-03-15 Sun>")) + (should-not (string-match-p "--" result)))) + +(ert-deftest test-calendar-sync--format-timestamp-same-day-timed-stays-compact () + "A same-day timed event keeps the compact HH:MM-HH:MM form, not a range. +Guards the common case against the range branch." + (let ((result (calendar-sync--format-timestamp + '(2026 3 15 14 0) '(2026 3 15 15 30)))) + (should (equal result "<2026-03-15 Sun 14:00-15:30>")) + (should-not (string-match-p "--" result)))) + +(ert-deftest test-calendar-sync--format-timestamp-multi-day-all-day-two-days () + "Boundary: the shortest real all-day span (two days) renders as a range. +DTEND 2026-03-17 means the event covers Mar 15-16; one day fewer and it +collapses to the single-stamp case above." + (let ((result (calendar-sync--format-timestamp + '(2026 3 15 nil nil) '(2026 3 17 nil nil)))) + (should (equal result "<2026-03-15 Sun>--<2026-03-16 Mon>")))) + +(ert-deftest test-calendar-sync--format-timestamp-multi-day-span-crosses-month () + "Boundary: an all-day span crossing a month boundary decrements correctly. +DTEND 2026-04-01 means the event's last day is 2026-03-31, which exercises +the borrow in `calendar-sync--add-days'." + (let ((result (calendar-sync--format-timestamp + '(2026 3 30 nil nil) '(2026 4 1 nil nil)))) + (should (equal result "<2026-03-30 Mon>--<2026-03-31 Tue>")))) + (provide 'test-calendar-sync--format-timestamp) ;;; test-calendar-sync--format-timestamp.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-properties.el b/tests/test-calendar-sync-properties.el index c25bb99f..0b01cbd9 100644 --- a/tests/test-calendar-sync-properties.el +++ b/tests/test-calendar-sync-properties.el @@ -77,12 +77,21 @@ For any COUNT value N, expansion never produces more than N occurrences." ;;; Property 2: UNTIL Boundary +;; These two asserted the wrong invariant until 2026-07-16: they required every +;; occurrence to fall strictly BEFORE UNTIL, which is the exclusive reading RFC +;; 5545 3.3.10 contradicts ("bounds the recurrence rule in an inclusive manner"; +;; a UNTIL synchronized with the recurrence "becomes the last instance"). They +;; were written against the expansion loop's strict `before-date-p' guard and so +;; pinned the very defect that dropped the last instance of every bounded series. +;; The property is on-or-before; the upper bound is what UNTIL is for. + (ert-deftest test-calendar-sync-property-until-bounds-daily () - "Property: No daily occurrence starts on or after UNTIL date." + "Property: no daily occurrence starts after the UNTIL date. +UNTIL is an inclusive bound (RFC 5545 3.3.10), so landing exactly on it is +correct and only a later date violates the property." (dotimes (_ test-calendar-sync-property-trials) (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) (until-days (+ 10 (random 60))) - ;; UNTIL must be date-only (3 elements) for calendar-sync--before-date-p (until-date (test-calendar-sync-time-date-only until-days)) (base-event (list :summary "Until Test" :start start-date)) (rrule (list :freq 'daily :interval 1 :until until-date)) @@ -90,16 +99,35 @@ For any COUNT value N, expansion never produces more than N occurrences." (occurrences (calendar-sync--expand-daily base-event rrule range))) (dolist (occ occurrences) (let ((occ-start (plist-get occ :start))) - (should (calendar-sync--before-date-p + (should (calendar-sync--date-on-or-before-p (list (nth 0 occ-start) (nth 1 occ-start) (nth 2 occ-start)) until-date))))))) +(ert-deftest test-calendar-sync-property-until-bounds-daily-reaches-until () + "Property: a daily series stepping by one day always reaches its UNTIL date. +With interval 1 the recurrence is synchronized with any UNTIL, so the last +instance must be UNTIL itself. This is the half the old exclusive property +could never have caught -- it only bounded from above, so silently dropping +the final occurrence satisfied it." + (dotimes (_ test-calendar-sync-property-trials) + (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) + (until-days (+ 10 (random 60))) + (until-date (test-calendar-sync-time-date-only until-days)) + (base-event (list :summary "Until Test" :start start-date)) + (rrule (list :freq 'daily :interval 1 :until until-date)) + (range (test-calendar-sync-wide-range)) + (occurrences (calendar-sync--expand-daily base-event rrule range)) + (last-start (plist-get (car (last occurrences)) :start))) + (should occurrences) + (should (equal (seq-take last-start 3) until-date))))) + (ert-deftest test-calendar-sync-property-until-bounds-weekly () - "Property: No weekly occurrence starts on or after UNTIL date." + "Property: no weekly occurrence starts after the UNTIL date. +UNTIL is an inclusive bound (RFC 5545 3.3.10), so landing exactly on it is +correct and only a later date violates the property." (dotimes (_ test-calendar-sync-property-trials) (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) (until-days (+ 14 (random 60))) - ;; UNTIL must be date-only (3 elements) for calendar-sync--before-date-p (until-date (test-calendar-sync-time-date-only until-days)) (weekdays (test-calendar-sync-random-weekday-subset)) (base-event (list :summary "Until Test" :start start-date)) @@ -108,7 +136,7 @@ For any COUNT value N, expansion never produces more than N occurrences." (occurrences (calendar-sync--expand-weekly base-event rrule range))) (dolist (occ occurrences) (let ((occ-start (plist-get occ :start))) - (should (calendar-sync--before-date-p + (should (calendar-sync--date-on-or-before-p (list (nth 0 occ-start) (nth 1 occ-start) (nth 2 occ-start)) until-date))))))) 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-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-calendar-sync-timezone.el b/tests/test-integration-calendar-sync-timezone.el index 304d3233..a3f65146 100644 --- a/tests/test-integration-calendar-sync-timezone.el +++ b/tests/test-integration-calendar-sync-timezone.el @@ -187,12 +187,21 @@ Components integrated: Validates: - Org timestamp format is correct (<YYYY-MM-DD Day HH:MM-HH:MM>) -- Hour in timestamp is the converted local hour" - (let* ((source-time (list 2026 2 2 19 0)) +- Hour in timestamp is the converted local hour + +The date is generated relative to now because `calendar-sync--parse-ics' +drops events outside `calendar-sync--get-date-range' (today minus +`calendar-sync-past-months', plus `calendar-sync-future-months'). This test +used a hardcoded 2026-02-02, which sat inside that window when it was written +and fell out of it once three months had passed -- the event was filtered +before rendering and the assertion failed against an empty org buffer. The +sibling tests survived hardcoded dates only because they call +`calendar-sync--parse-event' directly, which applies no range filter." + (let* ((source-time (test-calendar-sync-time-days-from-now 7 19 0)) (ics (test-integration-tz--make-ics-with-tzid-event "Test Event" source-time "Europe/Lisbon")) - (expected-local (test-calendar-sync-convert-tz-via-date - 2026 2 2 19 0 "Europe/Lisbon")) + (expected-local (apply #'test-calendar-sync-convert-tz-via-date + (append source-time (list "Europe/Lisbon")))) (expected-hour (nth 3 expected-local)) (org-output (calendar-sync--parse-ics ics))) (should org-output) diff --git a/tests/test-integration-org-agenda-frame-load-order.el b/tests/test-integration-org-agenda-frame-load-order.el new file mode 100644 index 00000000..a8eeaa47 --- /dev/null +++ b/tests/test-integration-org-agenda-frame-load-order.el @@ -0,0 +1,89 @@ +;;; test-integration-org-agenda-frame-load-order.el --- Frame allowlist survives load order -*- lexical-binding: t; -*- + +;;; Commentary: +;; Regression test for a load-order bug in the Full Agenda frame's read-only +;; shadow. +;; +;; Components integrated: +;; - org-agenda-frame (real, loaded in a subprocess) +;; - org-agenda (real, loaded BEFORE the frame module to reproduce the bug) +;; +;; The bug: cj/--agenda-frame-shadow-mutations walks org-agenda-mode-map and +;; keeps a key only when the frame map already binds it to a `commandp' value. +;; The view/redo handlers (day-view, week-view, safe-redo) were defined LOWER in +;; the file than the `with-eval-after-load' that ran the walk. When org-agenda +;; was already loaded at frame-load time -- the normal startup order and every +;; reload -- the walk fired before those defuns existed, read them as not-yet +;; commands, and denied d/w/g/r, the very keys the allowlist grants. Moving the +;; walk to the end of the file (after the defuns) fixed it. +;; +;; This test can't reproduce the ordering in-process (the module is already +;; loaded), so it drives a fresh Emacs that requires org-agenda first, then the +;; frame module, and inspects the resulting keymap. +;; +;; Validates: +;; - d/w/g/r keep their allowlist commands in the org-first load order +;; - the controlled status/priority mutations survive the shadow walk +;; - a non-allowlisted mutation key (t) is still denied +;; +;;; Code: + +(require 'ert) + +(defconst test-oaf--repo-root + (file-name-directory (directory-file-name + (file-name-directory (or load-file-name buffer-file-name)))) + "Repo root, one level up from tests/.") + +(defun test-oaf--lookup-in-subprocess (keys) + "Load org-agenda then org-agenda-frame in a fresh Emacs, return KEYS' bindings. +Returns an alist of (KEY . BINDING-SYMBOL-NAME-OR-nil)." + (let* ((root test-oaf--repo-root) + (form + (prin1-to-string + `(progn + (setq load-prefer-newer t) + (package-initialize) + (require 'org-agenda) ; the bad order: org first + (require 'org-agenda-frame) + (princ (prin1-to-string + (mapcar + (lambda (k) + (cons k (let ((b (lookup-key cj/agenda-frame-mode-map (kbd k)))) + (and (symbolp b) (symbol-name b))))) + ',keys)))))) + (out (with-output-to-string + (with-current-buffer standard-output + (call-process + (expand-file-name invocation-name invocation-directory) + nil t nil + "--batch" "--no-site-file" "--no-site-lisp" + "-L" root + "-L" (expand-file-name "modules" root) + "-L" (expand-file-name "themes" root) + "--eval" form))))) + (car (read-from-string out)))) + +(ert-deftest test-integration-org-agenda-frame-allowlist-survives-org-first-load () + "Integration: with org-agenda loaded before the frame module, the allowlisted +view/redo and controlled task-mutation keys survive while t stays denied." + (skip-unless (file-exists-p (expand-file-name "modules/org-agenda-frame.el" + test-oaf--repo-root))) + (let ((got (test-oaf--lookup-in-subprocess + '("d" "w" "g" "r" "C-c t" "C-c C-t" + "M-<up>" "M-<right>" "s-<down>" "s-<left>" "t")))) + (should (equal "cj/--agenda-frame-day-view" (cdr (assoc "d" got)))) + (should (equal "cj/--agenda-frame-week-view" (cdr (assoc "w" got)))) + (should (equal "cj/--agenda-frame-safe-redo" (cdr (assoc "g" got)))) + (should (equal "cj/--agenda-frame-safe-redo" (cdr (assoc "r" got)))) + (should (equal "org-agenda-todo" (cdr (assoc "C-c t" got)))) + (should (equal "org-agenda-todo" (cdr (assoc "C-c C-t" got)))) + (should (equal "org-agenda-priority-up" (cdr (assoc "M-<up>" got)))) + (should (equal "org-agenda-todo-nextset" (cdr (assoc "M-<right>" got)))) + (should (equal "org-agenda-priority-down" (cdr (assoc "s-<down>" got)))) + (should (equal "org-agenda-todo-previousset" (cdr (assoc "s-<left>" got)))) + ;; t is a real org mutation key; it must be denied, not allowlisted. + (should (equal "cj/--agenda-frame-denied-readonly" (cdr (assoc "t" got)))))) + +(provide 'test-integration-org-agenda-frame-load-order) +;;; test-integration-org-agenda-frame-load-order.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-integration-recording-toggle-workflow.el b/tests/test-integration-recording-toggle-workflow.el index e73ef87e..6258fc58 100644 --- a/tests/test-integration-recording-toggle-workflow.el +++ b/tests/test-integration-recording-toggle-workflow.el @@ -43,6 +43,24 @@ ;;; Setup and Teardown +(defun test-integration-toggle--fake-pactl (cmd &rest _) + "Answer pactl queries for CMD from fixture devices, never the real machine. + +`cj/recording-get-devices' runs `cj/recording--validate-system-audio', which +shells out to pactl, decides a fixture device name is not a real source, and +\"auto-fixes\" the configured device to the default sink's monitor. Left +unmocked that clobbers the test's device with whatever hardware the developer +has plugged in, so the assertions compare against a JDS Labs DAC rather than +the fixture. Answering at the shell boundary keeps the real validation logic +under test while the machine stays out of it." + (cond + ((string-match-p "get-default-sink" cmd) "fixture-sink\n") + ((string-match-p "list sources short" cmd) + "0\ttest-monitor\tmodule-x\ts16le 2ch 44100Hz\tIDLE\n1\tcached-monitor\tmodule-x\ts16le 2ch 44100Hz\tIDLE\n") + ((string-match-p "list sinks short" cmd) + "0\tfixture-sink\tmodule-x\ts16le 2ch 44100Hz\tRUNNING\n") + (t ""))) + (defun test-integration-toggle-setup () "Reset all variables before each test." (setq cj/video-recording-ffmpeg-process nil) @@ -102,6 +120,8 @@ Validates: (setq setup-called t) (setq cj/recording-mic-device "test-mic") (setq cj/recording-system-device "test-monitor"))) + ((symbol-function 'shell-command-to-string) + #'test-integration-toggle--fake-pactl) ((symbol-function 'file-directory-p) (lambda (_dir) t)) ((symbol-function 'start-process-shell-command) @@ -168,6 +188,8 @@ Validates: (ffmpeg-cmd nil)) (cl-letf (((symbol-function 'cj/recording-quick-setup) (lambda () (setq setup-called t))) + ((symbol-function 'shell-command-to-string) + #'test-integration-toggle--fake-pactl) ((symbol-function 'file-directory-p) (lambda (_dir) t)) ((symbol-function 'start-process-shell-command) diff --git a/tests/test-integration-recurring-events.el b/tests/test-integration-recurring-events.el index 3cae1a20..8339d167 100644 --- a/tests/test-integration-recurring-events.el +++ b/tests/test-integration-recurring-events.el @@ -34,53 +34,78 @@ ;;; Test Data -(defconst test-integration-recurring-events--weekly-ics - "BEGIN:VCALENDAR -VERSION:2.0 -PRODID:-//Test//Test//EN -BEGIN:VEVENT -DTSTART;TZID=America/Chicago:20251118T103000 -DTEND;TZID=America/Chicago:20251118T110000 -RRULE:FREQ=WEEKLY;BYDAY=SA -SUMMARY:GTFO -UID:test-weekly@example.com -END:VEVENT -END:VCALENDAR" - "Test ICS with weekly recurring event (GTFO use case).") +;; Fixtures that reach `calendar-sync--parse-ics' must carry dates relative to +;; now. That entry point drops any event outside +;; `calendar-sync--get-date-range' (today minus `calendar-sync-past-months', +;; plus `calendar-sync-future-months'), so a hardcoded DTSTART works only until +;; the rolling window moves past it. Three tests here rotted exactly that way: +;; their November-2025 fixtures aged out of the window, the events were filtered +;; before rendering, and the assertions failed against an empty org buffer. The +;; weekly fixtures survived only because an unbounded RRULE keeps generating +;; occurrences into the window no matter how old its DTSTART is. +;; +;; Fixtures given straight to `calendar-sync--parse-event' can stay static -- +;; that path applies no range filter. -(defconst test-integration-recurring-events--daily-with-count-ics - "BEGIN:VCALENDAR +(defun test-integration-recurring-events--ics-stamp (offset-days hour minute) + "Return an ICS UTC datetime OFFSET-DAYS from today at HOUR:MINUTE." + (let ((d (test-calendar-sync-time-days-from-now offset-days hour minute))) + (format "%04d%02d%02dT%02d%02d00Z" (nth 0 d) (nth 1 d) (nth 2 d) hour minute))) + +(defun test-integration-recurring-events--daily-with-count-ics () + "ICS with a COUNT=5 daily series starting inside the sync window." + (format "BEGIN:VCALENDAR VERSION:2.0 PRODID:-//Test//Test//EN BEGIN:VEVENT -DTSTART:20251120T090000Z -DTEND:20251120T100000Z +DTSTART:%s +DTEND:%s RRULE:FREQ=DAILY;COUNT=5 SUMMARY:Daily Standup UID:test-daily@example.com END:VEVENT END:VCALENDAR" - "Test ICS with daily recurring event limited by COUNT.") + (test-integration-recurring-events--ics-stamp 2 9 0) + (test-integration-recurring-events--ics-stamp 2 10 0))) -(defconst test-integration-recurring-events--mixed-ics - "BEGIN:VCALENDAR +(defun test-integration-recurring-events--mixed-ics () + "ICS mixing a one-time event and a recurring one, both inside the window." + (format "BEGIN:VCALENDAR VERSION:2.0 PRODID:-//Test//Test//EN BEGIN:VEVENT -DTSTART:20251125T140000Z -DTEND:20251125T150000Z +DTSTART:%s +DTEND:%s SUMMARY:One-time Meeting UID:test-onetime@example.com END:VEVENT BEGIN:VEVENT -DTSTART;TZID=America/Chicago:20251201T093000 -DTEND;TZID=America/Chicago:20251201T103000 +DTSTART;TZID=America/Chicago:%s +DTEND;TZID=America/Chicago:%s RRULE:FREQ=WEEKLY;BYDAY=MO,WE,FR SUMMARY:Recurring Standup UID:test-recurring@example.com END:VEVENT END:VCALENDAR" - "Test ICS with mix of recurring and non-recurring events.") + (test-integration-recurring-events--ics-stamp 3 14 0) + (test-integration-recurring-events--ics-stamp 3 15 0) + ;; TZID form carries no Z suffix. + (string-remove-suffix "Z" (test-integration-recurring-events--ics-stamp 5 9 30)) + (string-remove-suffix "Z" (test-integration-recurring-events--ics-stamp 5 10 30)))) + +(defconst test-integration-recurring-events--weekly-ics + "BEGIN:VCALENDAR +VERSION:2.0 +PRODID:-//Test//Test//EN +BEGIN:VEVENT +DTSTART;TZID=America/Chicago:20251118T103000 +DTEND;TZID=America/Chicago:20251118T110000 +RRULE:FREQ=WEEKLY;BYDAY=SA +SUMMARY:GTFO +UID:test-weekly@example.com +END:VEVENT +END:VCALENDAR" + "Test ICS with weekly recurring event (GTFO use case).") ;;; Normal Cases - Complete Workflow @@ -133,7 +158,7 @@ Validates: - Exactly 5 occurrences created" (test-integration-recurring-events-setup) (unwind-protect - (let ((org-output (calendar-sync--parse-ics test-integration-recurring-events--daily-with-count-ics))) + (let ((org-output (calendar-sync--parse-ics (test-integration-recurring-events--daily-with-count-ics)))) (should (stringp org-output)) ;; Should generate exactly 5 Daily Standup entries @@ -160,7 +185,7 @@ Validates: - Events are sorted chronologically" (test-integration-recurring-events-setup) (unwind-protect - (let ((org-output (calendar-sync--parse-ics test-integration-recurring-events--mixed-ics))) + (let ((org-output (calendar-sync--parse-ics (test-integration-recurring-events--mixed-ics)))) (should (stringp org-output)) ;; Should have one-time meeting @@ -197,12 +222,19 @@ Validates: (test-integration-recurring-events-setup) (unwind-protect (let* ((org-output (calendar-sync--parse-ics test-integration-recurring-events--weekly-ics)) - (now (current-time)) - (three-months-ago (time-subtract now (* 90 24 3600))) - (twelve-months-future (time-add now (* 365 24 3600)))) + (range (calendar-sync--get-date-range)) + (window-start (nth 0 range)) + (window-end (nth 1 range))) (should (stringp org-output)) - ;; Parse all dates from output + ;; Every emitted occurrence must fall within the pipeline's own window + ;; (-3/+12 calendar months at day granularity, from + ;; `calendar-sync--get-date-range'). Asserting against that boundary, + ;; rather than a hand-rolled now +/- fixed-day approximation, keeps the + ;; test robust on every date: a valid boundary occurrence stamped at + ;; midnight used to read as out-of-range against a now-90d bound taken + ;; at the current clock time, so the test failed or passed depending on + ;; the day it ran. (with-temp-buffer (insert org-output) (goto-char (point-min)) @@ -212,9 +244,9 @@ Validates: (month (string-to-number (match-string 2))) (day (string-to-number (match-string 3))) (event-time (encode-time 0 0 0 day month year))) - ;; All dates should be within window - (when (or (time-less-p event-time three-months-ago) - (time-less-p twelve-months-future event-time)) + ;; Within [window-start, window-end] inclusive. + (when (or (time-less-p event-time window-start) + (time-less-p window-end event-time)) (setq all-dates-in-range nil)))) (should all-dates-in-range)))) (test-integration-recurring-events-teardown))) @@ -291,18 +323,21 @@ Validates: - Valid events still processed" (test-integration-recurring-events-setup) (unwind-protect - (let* ((incomplete-ics "BEGIN:VCALENDAR + (let* ((incomplete-ics (format "BEGIN:VCALENDAR VERSION:2.0 BEGIN:VEVENT -DTSTART:20251201T100000Z +DTSTART:%s RRULE:FREQ=DAILY;COUNT=2 END:VEVENT BEGIN:VEVENT SUMMARY:Valid Event -DTSTART:20251201T110000Z -DTEND:20251201T120000Z +DTSTART:%s +DTEND:%s END:VEVENT -END:VCALENDAR") +END:VCALENDAR" + (test-integration-recurring-events--ics-stamp 4 10 0) + (test-integration-recurring-events--ics-stamp 4 11 0) + (test-integration-recurring-events--ics-stamp 4 12 0))) (org-output (calendar-sync--parse-ics incomplete-ics))) ;; Should still generate output (for valid event) (should (stringp org-output)) 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-commands.el b/tests/test-org-agenda-config-commands.el index 76407439..139bf90f 100644 --- a/tests/test-org-agenda-config-commands.el +++ b/tests/test-org-agenda-config-commands.el @@ -176,5 +176,89 @@ large), so the standalone OVERDUE section was redundant." (should (string-match-p "<[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [A-Za-z]\\{3\\} 09:00>" text))))) +(ert-deftest test-org-agenda-add-timestamp-preserves-point-and-following-line () + "Normal: the stamp lands between the entry and the next line, point unmoved. +The docstring promises the event appears \"underneath the line-at-point\", +so neither the entry nor whatever follows it may be disturbed." + (with-temp-buffer + (insert "* First\n* Second") + (goto-char (point-min)) + (let ((start (progn (org-end-of-line) (point)))) + (goto-char (point-min)) + (cj/add-timestamp-to-org-entry "09:00") + ;; Point is left at the end of the entry it stamped. + (should (= (point) start))) + (let ((lines (split-string (buffer-string) "\n"))) + (should (equal (nth 0 lines) "* First")) + (should (string-match-p "\\`<[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [A-Za-z]\\{3\\} 09:00>\\'" + (nth 1 lines))) + (should (equal (nth 2 lines) "* Second"))))) + +(ert-deftest test-org-agenda-add-timestamp-empty-time-string () + "Boundary: an empty time yields a bare date stamp with a trailing space. +Characterizes current behavior -- the separator space is unconditional, so +an empty S produces `<DATE >' rather than `<DATE>'. Harmless in an agenda +\(org reads the date\), and pinned here so a future format change is a +deliberate one." + (with-temp-buffer + (insert "* Heading here") + (goto-char (point-min)) + (cj/add-timestamp-to-org-entry "") + (should (string-match-p "<[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [A-Za-z]\\{3\\} >" + (buffer-string))))) + +(ert-deftest test-org-agenda-add-timestamp-unicode-time-string () + "Boundary: non-ASCII in S survives into the stamp uncorrupted." + (with-temp-buffer + (insert "* Heading here") + (goto-char (point-min)) + (cj/add-timestamp-to-org-entry "09:00 café ☕") + (should (string-match-p "09:00 café ☕>" (buffer-string))))) + +(ert-deftest test-org-agenda-add-timestamp-empty-buffer () + "Boundary: an empty buffer still gets a stamp rather than signalling. +`org-end-of-line' and `open-line' both no-op safely at point-min." + (with-temp-buffer + (cj/add-timestamp-to-org-entry "09:00") + (should (string-match-p "<[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [A-Za-z]\\{3\\} 09:00>" + (buffer-string))))) + +(ert-deftest test-org-agenda-add-timestamp-read-only-buffer-signals () + "Error: a read-only buffer signals rather than silently dropping the stamp." + (with-temp-buffer + (insert "* Heading") + (goto-char (point-min)) + (setq buffer-read-only t) + (should-error (cj/add-timestamp-to-org-entry "09:00") :type 'buffer-read-only))) + +(defconst test-org-agenda--timeformat-special-at-load + (special-variable-p 'cj/timeformat) + "Whether `cj/timeformat' was special immediately after loading the module. +Captured here at load, before any test body runs, because the fact under +test is destroyed by observing it late: calling +`cj/add-timestamp-to-org-entry' once would execute a `defvar' nested in the +defun and make the symbol special retroactively. ERT runs tests +alphabetically, so an in-test `special-variable-p' check passes on the +strength of whichever test ran first -- green in a full-file run, red in +isolation. Snapshotting at load makes the guard order-independent.") + +(ert-deftest test-org-agenda-timeformat-is-a-top-level-special-variable () + "Normal: `cj/timeformat' is special and bound at load, not first call. +It used to be `defvar'd inside `cj/add-timestamp-to-org-entry', so it was +unbound until the command ran once and a `let' around the call bound it +lexically instead of dynamically. Pinning both halves of the fix: the +symbol is special at load time, and rebinding it actually reaches the +command." + (should test-org-agenda--timeformat-special-at-load) + (should (equal (default-value 'cj/timeformat) "%Y-%m-%d %a")) + ;; The dynamic binding must reach the insertion. + (with-temp-buffer + (insert "* Heading") + (goto-char (point-min)) + (let ((cj/timeformat "%Y")) + (cj/add-timestamp-to-org-entry "09:00")) + (should (string-match-p "\\`<[0-9]\\{4\\} 09:00>\\'" + (nth 1 (split-string (buffer-string) "\n")))))) + (provide 'test-org-agenda-config-commands) ;;; test-org-agenda-config-commands.el ends here diff --git a/tests/test-org-agenda-frame.el b/tests/test-org-agenda-frame.el new file mode 100644 index 00000000..167cf2ff --- /dev/null +++ b/tests/test-org-agenda-frame.el @@ -0,0 +1,1167 @@ +;;; test-org-agenda-frame.el --- Tests for the fullscreen agenda frame -*- lexical-binding: t; -*- + +;;; Commentary: +;; Phase 1 of the org-agenda fullscreen frame (spec: +;; docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org). Frame lookup +;; is mocked (frame-list / frame-live-p / frame-parameter), the house pattern +;; from test-dirvish-config-popup.el, since --batch can't create real frames. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-agenda-frame) + +;; org-agenda isn't loaded in batch (no package-initialize), so declare the +;; command list special and bound for the registration tests to let-bind. +(defvar org-agenda-custom-commands nil) + +;;; cj/--agenda-frame — locate the marked frame + +(ert-deftest test-org-agenda-frame-find-returns-marked-live-frame () + "Normal: returns the live frame carrying the `cj/agenda-frame' marker." + (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fb fc))) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'frame-parameter) + (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'fb))))) + (should (eq (cj/--agenda-frame) 'fb)))) + +(ert-deftest test-org-agenda-frame-find-nil-when-none-marked () + "Boundary: no frame carries the marker -> nil." + (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fc))) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'frame-parameter) (lambda (_f _p) nil))) + (should (null (cj/--agenda-frame))))) + +(ert-deftest test-org-agenda-frame-find-ignores-dead-marked-frame () + "Error: a marked but dead frame is not returned." + (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fb))) + ((symbol-function 'frame-live-p) (lambda (f) (not (eq f 'fb)))) + ((symbol-function 'frame-parameter) + (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'fb))))) + (should (null (cj/--agenda-frame))))) + +;;; cj/--agenda-frame-p — is FRAME a live agenda frame + +(ert-deftest test-org-agenda-frame-p-true-for-live-marked () + "Normal: a live marked frame is an agenda frame." + (cl-letf (((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'frame-parameter) + (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'fa))))) + (should (cj/--agenda-frame-p 'fa)))) + +(ert-deftest test-org-agenda-frame-p-nil-for-unmarked () + "Boundary: a live unmarked frame is not an agenda frame." + (cl-letf (((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'frame-parameter) (lambda (_f _p) nil))) + (should (null (cj/--agenda-frame-p 'fa))))) + +(ert-deftest test-org-agenda-frame-p-nil-for-dead-marked () + "Error: a dead marked frame is not an agenda frame." + (cl-letf (((symbol-function 'frame-live-p) (lambda (_f) nil)) + ((symbol-function 'frame-parameter) + (lambda (_f p) (eq p 'cj/agenda-frame)))) + (should (null (cj/--agenda-frame-p 'fa))))) + +;;; cj/--agenda-frame-working-frame — route source files to a non-agenda frame + +(ert-deftest test-org-agenda-working-frame-returns-non-agenda-frame () + "Normal: with no recorded launch frame, returns the first live non-agenda frame." + (let ((cj/--agenda-frame-launch-frame nil)) + (cl-letf (((symbol-function 'frame-list) (lambda () '(agenda work))) + ((symbol-function 'frame-live-p) (lambda (f) (memq f '(agenda work)))) + ((symbol-function 'frame-parameter) + (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'agenda))))) + (should (eq (cj/--agenda-frame-working-frame) 'work))))) + +(ert-deftest test-org-agenda-working-frame-prefers-live-launch-frame () + "Normal: the recorded launch frame wins when live and non-agenda." + (let ((cj/--agenda-frame-launch-frame 'w2)) + (cl-letf (((symbol-function 'frame-list) (lambda () '(agenda w1 w2))) + ((symbol-function 'frame-live-p) (lambda (f) (memq f '(agenda w1 w2)))) + ((symbol-function 'frame-parameter) + (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'agenda))))) + (should (eq (cj/--agenda-frame-working-frame) 'w2))))) + +(ert-deftest test-org-agenda-working-frame-falls-back-when-launch-dead () + "Boundary: a dead recorded launch frame falls back to another non-agenda frame." + (let ((cj/--agenda-frame-launch-frame 'gone)) + (cl-letf (((symbol-function 'frame-list) (lambda () '(agenda work))) + ((symbol-function 'frame-live-p) (lambda (f) (memq f '(agenda work)))) + ((symbol-function 'frame-parameter) + (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'agenda))))) + (should (eq (cj/--agenda-frame-working-frame) 'work))))) + +(ert-deftest test-org-agenda-working-frame-nil-when-only-agenda () + "Error: the agenda frame is the only live frame -> nil (caller creates one)." + (let ((cj/--agenda-frame-launch-frame nil)) + (cl-letf (((symbol-function 'frame-list) (lambda () '(agenda))) + ((symbol-function 'frame-live-p) (lambda (f) (eq f 'agenda))) + ((symbol-function 'frame-parameter) + (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'agenda))))) + (should (null (cj/--agenda-frame-working-frame)))))) + +;;; cj/--agenda-frame-command — the dedicated F seven-day view + +(defun test-org-agenda-frame--block-settings () + "Return the per-block settings alist of the agenda-frame command." + (let* ((cmd (cj/--agenda-frame-command)) + (blocks (nth 2 cmd)) + (agenda-block (car blocks))) + (nth 2 agenda-block))) + +(defun test-org-agenda-frame--general-settings () + "Return the general (view-wide) settings alist of the agenda-frame command." + (nth 3 (cj/--agenda-frame-command))) + +(ert-deftest test-org-agenda-frame-command-key-is-F () + "Normal: the command's key is F (collision-free with the existing d)." + (should (equal (nth 0 (cj/--agenda-frame-command)) "F"))) + +(ert-deftest test-org-agenda-frame-command-today-anchored-7-day () + "Normal: the default span is seven days anchored to today, not Monday. +The span is the frame-span variable (default 7), evaluated the way org +evaluates custom-command settings." + (let ((s (test-org-agenda-frame--block-settings))) + (should (equal (default-value 'cj/--agenda-frame-span) 7)) + (should (equal (eval (cadr (assq 'org-agenda-span s)) t) + (default-value 'cj/--agenda-frame-span))) + (should (equal (cadr (assq 'org-agenda-start-day s)) "0d")) + ;; start-on-weekday nil is what un-anchors the span from Monday. + (should (assq 'org-agenda-start-on-weekday s)) + (should (null (cadr (assq 'org-agenda-start-on-weekday s)))))) + +(ert-deftest test-org-agenda-frame-command-span-follows-variable () + "Normal: the block span reads `cj/--agenda-frame-span', so d/w can change it +and a redo -- which re-evaluates the lprops -- picks up the new span." + (let ((cj/--agenda-frame-span 1)) + (should (equal (eval (cadr (assq 'org-agenda-span + (test-org-agenda-frame--block-settings))) + t) + 1))) + (let ((cj/--agenda-frame-span 7)) + (should (equal (eval (cadr (assq 'org-agenda-span + (test-org-agenda-frame--block-settings))) + t) + 7)))) + +(ert-deftest test-org-agenda-frame-day-view-sets-span-1-and-redoes () + "Normal: d sets the span to one day and refreshes via the safe redo." + (let ((cj/--agenda-frame-span 7) redone) + (cl-letf (((symbol-function 'cj/--agenda-frame-safe-redo) + (lambda (&rest _) (setq redone t)))) + (cj/--agenda-frame-day-view) + (should (equal cj/--agenda-frame-span 1)) + (should redone)))) + +(ert-deftest test-org-agenda-frame-week-view-sets-span-7-and-redoes () + "Normal: w restores the seven-day span and refreshes." + (let ((cj/--agenda-frame-span 1) redone) + (cl-letf (((symbol-function 'cj/--agenda-frame-safe-redo) + (lambda (&rest _) (setq redone t)))) + (cj/--agenda-frame-week-view) + (should (equal cj/--agenda-frame-span 7)) + (should redone)))) + +(ert-deftest test-org-agenda-frame-command-tight-prefix-format () + "Normal: the view sets its own prefix format with a narrow category column. +Without it the global agenda format applies, whose 25-char category pad +leaves a wide blank gutter between the source name and the item." + (let ((s (test-org-agenda-frame--block-settings))) + (should (assq 'org-agenda-prefix-format s)) + (should (string-match-p "%-10:c" + (cadr (assq 'org-agenda-prefix-format s)))))) + +(ert-deftest test-org-agenda-frame-command-skips-done-items () + "Normal: completed tasks never appear in the Full Agenda. +The global agenda deliberately shows scheduled done items, so the dedicated +view needs its own skip function to exclude every done-state keyword." + (let* ((settings (test-org-agenda-frame--block-settings)) + (skip (assq 'org-agenda-skip-function settings))) + (should skip) + (should (equal (eval (cadr skip) t) + '(org-agenda-skip-entry-if 'todo 'done))))) + +(ert-deftest test-org-agenda-frame-command-render-excludes-scheduled-done () + "Boundary: a scheduled high-priority DONE item is absent from rendered output. +An equally scheduled active task remains, proving the whole date was not +skipped." + (require 'org-agenda) + (let* ((file (make-temp-file "agenda-frame-done-" nil ".org")) + (today (format-time-string "%Y-%m-%d %a")) + (org-agenda-files (list file)) + (org-agenda-custom-commands (list (cj/--agenda-frame-command))) + (org-agenda-sticky nil) + (agenda-buffer "*Org Agenda*")) + (unwind-protect + (progn + (with-temp-file file + (insert "#+TODO: TODO | DONE\n" + "* DONE [#A] completed-scheduled-marker\n" + "SCHEDULED: <" today ">\n" + "* TODO [#A] active-scheduled-marker\n" + "SCHEDULED: <" today ">\n")) + (org-agenda nil cj/--agenda-frame-command-key) + (with-current-buffer agenda-buffer + (should-not (string-match-p "completed-scheduled-marker" + (buffer-string))) + (should (string-match-p "active-scheduled-marker" + (buffer-string))))) + (when (get-buffer agenda-buffer) + (kill-buffer agenda-buffer)) + (delete-file file)))) + +(ert-deftest test-org-agenda-frame-do-redo-leaves-sticky-alone () + "Normal: the redo binds current-window but never touches sticky. +org-agenda-redo handles the in-place rebuild itself (it binds sticky nil +and redirects the buffer name); a sticky t reaching org-agenda-prepare +mid-redo makes it throw \\='exit with no catch and the tick fails." + (let ((org-agenda-sticky nil) + seen-sticky seen-setup (params '())) + (with-temp-buffer + (insert "agenda line\n") + (cl-letf (((symbol-function 'org-agenda-redo) + (lambda (&rest _) + (setq seen-sticky org-agenda-sticky + seen-setup org-agenda-window-setup))) + ((symbol-function 'frame-parameter) (lambda (_f p) (alist-get p params))) + ((symbol-function 'set-frame-parameter) + (lambda (_f p v) (setf (alist-get p params) v)))) + (cj/--agenda-frame-do-redo 'af (current-buffer) nil) + (should (null seen-sticky)) + (should (eq seen-setup 'current-window)))))) + +(ert-deftest test-org-agenda-frame-command-follow-mode-off () + "Boundary: follow-mode is forced off locally so a global default can't split." + (let ((s (test-org-agenda-frame--block-settings))) + (should (assq 'org-agenda-start-with-follow-mode s)) + (should (null (cadr (assq 'org-agenda-start-with-follow-mode s)))))) + +(ert-deftest test-org-agenda-frame-command-sticky-and-current-window () + "Normal: current-window in the settings; sticky deliberately NOT there. +The general settings are baked into the buffer's series-redo-cmd and +re-applied on every redo; a sticky t there makes org-agenda-use-sticky-p +true mid-redo (the buffer exists), and org-agenda-prepare throws \\='exit +with no catch -- every refresh tick fails. Stickiness belongs only in +the spawn wrapper, where it names the buffer." + (let ((g (test-org-agenda-frame--general-settings))) + (should-not (assq 'org-agenda-sticky g)) + ;; org evaluates custom-command setting values via org-let, so the stored + ;; form is (quote current-window); eval it the way org would. + (should (eq (eval (cadr (assq 'org-agenda-window-setup g)) t) + 'current-window)))) + +;;; cj/--agenda-frame-register-command — idempotent registration + +(ert-deftest test-org-agenda-frame-register-adds-entry () + "Normal: registration inserts the F entry into org-agenda-custom-commands." + (let ((org-agenda-custom-commands '(("d" "Daily" nil)))) + (cj/--agenda-frame-register-command) + (should (assoc "F" org-agenda-custom-commands)) + (should (assoc "d" org-agenda-custom-commands)))) + +(ert-deftest test-org-agenda-frame-register-is-idempotent () + "Boundary: registering twice leaves exactly one F entry." + (let ((org-agenda-custom-commands nil)) + (cj/--agenda-frame-register-command) + (cj/--agenda-frame-register-command) + (should (= 1 (seq-count (lambda (e) (equal (car e) "F")) + org-agenda-custom-commands))))) + +;;; Default-deny policy — denial handlers + +(ert-deftest test-org-agenda-frame-denied-readonly-messages () + "Normal: the read-only denial shows the read-only message and acts on nothing." + (let (captured) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq captured (apply #'format fmt args))))) + (cj/--agenda-frame-denied-readonly)) + (should (string-match-p "read-only" captured)) + (should (string-match-p "working frame" captured)))) + +(ert-deftest test-org-agenda-frame-denied-fixed-view-messages () + "Normal: the view-change denial shows the fixed-view message." + (let (captured) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq captured (apply #'format fmt args))))) + (cj/--agenda-frame-denied-fixed-view)) + (should (string-match-p "day (d) and week (w)" captured)))) + +;;; Default-deny policy — the keymap + +(ert-deftest test-org-agenda-frame-map-catch-all-is-readonly-deny () + "Normal: the [t] default binding denies with the read-only handler." + (should (eq (lookup-key cj/agenda-frame-mode-map [t]) + 'cj/--agenda-frame-denied-readonly))) + +(ert-deftest test-org-agenda-frame-map-navigation-allowed () + "Normal: navigation keys resolve to their org-agenda commands." + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "n")) 'org-agenda-next-line)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "p")) 'org-agenda-previous-line)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-g")) 'keyboard-quit))) + +(ert-deftest test-org-agenda-frame-map-point-motion-and-isearch-allowed () + "Normal: read-only point motion and isearch work in the frame. +C-a/C-e/C-f/C-b move point and C-s/C-r search; all are read-only and +must not hit the deny catch-all." + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-a")) 'move-beginning-of-line)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-e")) 'move-end-of-line)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-f")) 'forward-char)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-b")) 'backward-char)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-s")) 'isearch-forward)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-r")) 'isearch-backward))) + +(ert-deftest test-org-agenda-frame-map-engage-routed () + "Normal: RET and TAB route to the working-frame engage command." + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "RET")) + 'cj/--agenda-frame-engage-open)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "TAB")) + 'cj/--agenda-frame-engage-open))) + +(ert-deftest test-org-agenda-frame-map-engage-gui-function-keys () + "Boundary: the GUI [return]/[tab] events engage too, not the [t] deny handler. +Without these, the catch-all suppresses their translation to RET/TAB in a +graphical frame and RET would be denied instead of opening the item." + (should (eq (lookup-key cj/agenda-frame-mode-map [return]) + 'cj/--agenda-frame-engage-open)) + (should (eq (lookup-key cj/agenda-frame-mode-map [tab]) + 'cj/--agenda-frame-engage-open))) + +(ert-deftest test-org-agenda-frame-map-lifecycle-keys () + "Normal: q/Q/x close the frame; r and g take the safe-redo path. +g is the muscle-memory agenda refresh; it must refresh, not hit the +fixed-view deny handler." + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "q")) 'cj/--agenda-frame-close)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "Q")) 'cj/--agenda-frame-close)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "x")) 'cj/--agenda-frame-close)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "r")) 'cj/--agenda-frame-safe-redo)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "g")) 'cj/--agenda-frame-safe-redo))) + +(ert-deftest test-org-agenda-frame-map-view-changers-fixed-view-deny () + "Boundary: view-changing keys are explicitly denied with the fixed-view message, +not caught by the read-only catch-all." + (dolist (key '("y" "f" "b" "j")) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd key)) + 'cj/--agenda-frame-denied-fixed-view)))) + +(ert-deftest test-org-agenda-frame-map-day-week-view-keys () + "Normal: d and w toggle the span (day / week) rather than being denied. +d shrinks the frame to the current day, w restores the seven-day span." + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "d")) + 'cj/--agenda-frame-day-view)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "w")) + 'cj/--agenda-frame-week-view))) + +(ert-deftest test-org-agenda-frame-map-controlled-task-mutations () + "Normal: status and priority changes are the frame's controlled mutations. +C-c t is Craig's requested status chord, C-c C-t keeps Org's standard agenda +chord, and both Meta and the configured Super arrows support the same +priority/status operations." + (dolist (binding '(("C-c t" . org-agenda-todo) + ("C-c C-t" . org-agenda-todo) + ("M-<up>" . org-agenda-priority-up) + ("M-<down>" . org-agenda-priority-down) + ("M-<left>" . org-agenda-todo-previousset) + ("M-<right>" . org-agenda-todo-nextset) + ("s-<up>" . org-agenda-priority-up) + ("s-<down>" . org-agenda-priority-down) + ("s-<left>" . org-agenda-todo-previousset) + ("s-<right>" . org-agenda-todo-nextset))) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd (car binding))) + (cdr binding))))) + +(ert-deftest test-org-agenda-frame-shadow-denies-org-mutations-preserves-allowlist () + "Boundary: with the frame mode active over `org-agenda-mode-map', mutating +org-agenda keys are denied and the allowlist still works. +The `[t]' default cannot shadow org-agenda-mode-map's explicit bindings, so +the shadow walk must add explicit denies for every non-allowlisted key -- +single keys (t/I/k/z/s/.), the C-c mutators (schedule/deadline/clock), and +C-x (save-all) -- while leaving the allowlist (navigation, engage, refresh, +d/w, C-c C-o) intact." + (require 'org-agenda) + (cj/--agenda-frame-shadow-mutations) + (with-temp-buffer + (use-local-map org-agenda-mode-map) + (cj/agenda-frame-mode 1) + ;; escaping mutators are now explicitly denied (not org's commands) + (dolist (chord '("t" "I" "k" "z" "s" "." "C-c C-s" "C-c C-d" + "C-c C-x C-i" "C-x C-s")) + (should (eq (key-binding (kbd chord)) + 'cj/--agenda-frame-denied-readonly))) + ;; the allowlist survives the walk + (should (eq (key-binding (kbd "n")) 'org-agenda-next-line)) + (should (eq (key-binding (kbd "p")) 'org-agenda-previous-line)) + (should (eq (key-binding (kbd "RET")) 'cj/--agenda-frame-engage-open)) + (should (eq (key-binding (kbd "g")) 'cj/--agenda-frame-safe-redo)) + (should (eq (key-binding (kbd "d")) 'cj/--agenda-frame-day-view)) + (should (eq (key-binding (kbd "w")) 'cj/--agenda-frame-week-view)) + (should (eq (key-binding (kbd "C-c t")) 'org-agenda-todo)) + (should (eq (key-binding (kbd "C-c C-t")) 'org-agenda-todo)) + (should (eq (key-binding (kbd "M-<up>")) 'org-agenda-priority-up)) + (should (eq (key-binding (kbd "M-<right>")) 'org-agenda-todo-nextset)) + (should (eq (key-binding (kbd "s-<down>")) 'org-agenda-priority-down)) + (should (eq (key-binding (kbd "s-<left>")) 'org-agenda-todo-previousset)) + (should (eq (key-binding (kbd "C-c C-o")) 'cj/--agenda-frame-open-link)) + (should (eq (key-binding (kbd "q")) 'cj/--agenda-frame-close)))) + +(ert-deftest test-org-agenda-frame-map-frame-controls-bound () + "Normal: the frame's own controls work from inside the frame. +S-<f8> must close/toggle and C-M-<f8> must force-rescan; unbound, the +catch-all denies them and the frame can't be closed by its own key." + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "S-<f8>")) + 'cj/agenda-frame-toggle)) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-M-<f8>")) + 'cj/org-agenda-refresh-files))) + +(ert-deftest test-org-agenda-frame-map-C-x-C-c-closes-frame () + "Normal: C-x C-c in the agenda frame closes the frame, not the daemon. +The global save-buffers-kill-terminal would kill Emacs itself here (a +make-frame frame has no client), so the intuitive close gesture must be +remapped to the frame close." + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-x C-c")) + 'cj/--agenda-frame-close))) + +(ert-deftest test-org-agenda-frame-map-machinery-punched-through () + "Boundary: input machinery is punched through the [t] catch-all. +switch-frame events, mouse-wheel scrolling, mouse-1 clicks, and the help +prefix must fall through to their global bindings (an explicit nil shadows +the default in this map); otherwise every frame-focus change and every +scroll spams the deny message." + (dolist (key (list [switch-frame] + [wheel-up] [wheel-down] [wheel-left] [wheel-right] + [double-wheel-up] [double-wheel-down] + [triple-wheel-up] [triple-wheel-down] + [mouse-1] [down-mouse-1] [drag-mouse-1] + (kbd "C-h"))) + ;; accept-default t: a punched key returns nil (falls through to the + ;; global map); an unpunched key returns the catch-all deny handler. + (should (null (lookup-key cj/agenda-frame-mode-map key t))))) + +(ert-deftest test-org-agenda-frame-map-global-escape-chords-denied () + "Boundary: global chords bound elsewhere (M-SPC / M-S-SPC swap ai-term +agents) are denied by an explicit binding, not left to the [t] catch-all. +A keymap's default binding does not shadow an explicit binding in a +lower-priority map, so without an explicit deny here M-SPC follows its +global binding and escapes the read-only frame into ai-term." + (dolist (key '("M-SPC" "M-S-SPC")) + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd key)) + 'cj/--agenda-frame-denied-readonly)))) + +(ert-deftest test-org-agenda-frame-map-unpunched-still-denied () + "Normal: an ordinary unbound key still hits the catch-all after the punches." + (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "t") t) + 'cj/--agenda-frame-denied-readonly))) + +(ert-deftest test-org-agenda-frame-maybe-enable-readds-kill-buffer-hook () + "Normal: the finalize re-enable also re-adds the buffer-local kill hook. +org-agenda-redo's kill-all-local-variables strips the hook installed at +spawn; without the re-add, killing the buffer after the first refresh tick +orphans the frame." + (with-temp-buffer + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'agenda)) + ((symbol-function 'get-buffer-window) (lambda (_b _f) 'win))) + (cj/--agenda-frame-maybe-enable-mode) + (should (memq 'cj/--agenda-frame-on-kill-buffer + (buffer-local-value 'kill-buffer-hook (current-buffer))))))) + +(ert-deftest test-org-agenda-frame-overlay-removable-after-local-var-wipe () + "Error: the failure overlay is found by property, not a buffer-local var. +kill-all-local-variables (every redo) wipes buffer-local vars while the +overlay object survives erase-buffer, so a var-held overlay could never be +removed after a later success -- the failure banner would stick forever." + (with-temp-buffer + (insert "x\n") + (cj/--agenda-frame-show-failure-overlay (current-buffer)) + ;; Simulate the org-agenda-mode reset between failure and success. + (kill-all-local-variables) + (cj/--agenda-frame-remove-overlay (current-buffer)) + ;; The visible banner (a before-string overlay) must be gone. + (should (= 0 (seq-count (lambda (o) (overlay-get o 'before-string)) + (overlays-in (point-min) (point-max))))))) + +(ert-deftest test-org-agenda-frame-map-mutation-keys-denied () + "Boundary: a mutation key (t = org-agenda-todo) is denied, never allowlisted. +It is denied two ways depending on whether the shadow walk has run: the `[t]' +catch-all handles it (lookup returns nil) before the walk, and the walk binds +it explicitly to the deny handler once `org-agenda-mode-map' is present. Both +are a read-only denial; the test asserts the outcome, not which path produced +it, so it holds whether or not org-agenda is loaded in the test process." + (let ((b (lookup-key cj/agenda-frame-mode-map (kbd "t")))) + (should (or (null b) (eq b 'cj/--agenda-frame-denied-readonly))))) + +;;; Default-deny policy — the minor mode + finalize re-enable + +(ert-deftest test-org-agenda-frame-mode-toggles () + "Normal: the minor mode turns on and off in a buffer." + (with-temp-buffer + (cj/agenda-frame-mode 1) + (should cj/agenda-frame-mode) + (cj/agenda-frame-mode -1) + (should-not cj/agenda-frame-mode))) + +(ert-deftest test-org-agenda-frame-maybe-enable-in-agenda-frame () + "Normal: after a build in the agenda frame, the policy is re-enabled." + (with-temp-buffer + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'agenda)) + ((symbol-function 'get-buffer-window) (lambda (_b _f) 'win))) + (cj/--agenda-frame-maybe-enable-mode) + (should cj/agenda-frame-mode)))) + +(ert-deftest test-org-agenda-frame-maybe-enable-skips-other-buffers () + "Boundary: a build not shown in the agenda frame leaves the policy off." + (with-temp-buffer + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'agenda)) + ((symbol-function 'get-buffer-window) (lambda (_b _f) nil))) + (cj/--agenda-frame-maybe-enable-mode) + (should-not cj/agenda-frame-mode)))) + +(ert-deftest test-org-agenda-frame-maybe-enable-no-frame () + "Boundary: no agenda frame at all -> policy stays off, no error." + (with-temp-buffer + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () nil))) + (cj/--agenda-frame-maybe-enable-mode) + (should-not cj/agenda-frame-mode)))) + +;;; Engage routing — frame target + open + +(ert-deftest test-org-agenda-frame-target-frame-uses-working-frame () + "Normal: the engage target is the working frame when one exists." + (cl-letf (((symbol-function 'cj/--agenda-frame-working-frame) (lambda () 'work)) + ((symbol-function 'make-frame) (lambda (&rest _) (error "should not create")))) + (should (eq (cj/--agenda-frame-target-frame) 'work)))) + +(ert-deftest test-org-agenda-frame-target-frame-creates-when-none () + "Boundary: no working frame -> a normal frame is created." + (cl-letf (((symbol-function 'cj/--agenda-frame-working-frame) (lambda () nil)) + ((symbol-function 'make-frame) (lambda (&rest _) 'new))) + (should (eq (cj/--agenda-frame-target-frame) 'new)))) + +(ert-deftest test-org-agenda-frame-engage-open-no-item-errors () + "Error: engaging on a line with no source item signals a user-error." + (cl-letf (((symbol-function 'cj/--agenda-frame-item-marker) (lambda () nil))) + (should-error (cj/--agenda-frame-engage-open) :type 'user-error))) + +(ert-deftest test-org-agenda-frame-engage-open-routes-to-source () + "Normal: engage opens the item's source buffer at the item's position." + (let ((source (generate-new-buffer " *frame-engage-source*"))) + (unwind-protect + (progn + (with-current-buffer source (insert "line one\nline two\nline three\n")) + (let ((marker (set-marker (make-marker) 10 source)) + focused opened) + (cl-letf (((symbol-function 'cj/--agenda-frame-item-marker) (lambda () marker)) + ((symbol-function 'cj/--agenda-frame-target-frame) (lambda () 'work)) + ((symbol-function 'select-frame-set-input-focus) + (lambda (f &rest _) (setq focused f))) + ((symbol-function 'pop-to-buffer-same-window) + (lambda (b &rest _) (setq opened b) (set-buffer b))) + ((symbol-function 'org-fold-show-context) (lambda (&rest _) nil))) + (cj/--agenda-frame-engage-open) + (should (eq focused 'work)) + (should (eq opened source)) + (should (eq (current-buffer) source)) + (should (= (point) (line-beginning-position)))))) + (kill-buffer source)))) + +;;; Frame lifecycle — sticky buffer, timer-cancel, teardown cleanup + +(ert-deftest test-org-agenda-frame-sticky-buffer-name () + "Normal: the sticky buffer is *Org Agenda(F)*; nil when absent." + (should (null (cj/--agenda-frame-sticky-buffer))) + (let ((buf (get-buffer-create "*Org Agenda(F)*"))) + (unwind-protect + (should (eq (cj/--agenda-frame-sticky-buffer) buf)) + (kill-buffer buf)))) + +(ert-deftest test-org-agenda-frame-cancel-timer-safe-when-none () + "Boundary: cancelling with no timer set does nothing and does not error." + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () nil))) + (should-not (cj/--agenda-frame-cancel-timer)))) + +;;; Frame lifecycle — toggle dispatch + +(ert-deftest test-org-agenda-frame-toggle-spawns-when-none () + "Normal: with no agenda frame, toggle spawns one." + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () nil)) + ((symbol-function 'cj/--agenda-frame-spawn) (lambda () 'spawned))) + (should (eq (cj/--agenda-frame-toggle) 'spawned)))) + +(ert-deftest test-org-agenda-frame-toggle-deletes-when-selected () + "Normal: toggle from within the agenda frame deletes it." + (let (deleted) + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) + ((symbol-function 'selected-frame) (lambda () 'af)) + ((symbol-function 'cj/--agenda-frame-delete) + (lambda () (setq deleted t)))) + (cj/--agenda-frame-toggle) + (should deleted)))) + +(ert-deftest test-org-agenda-frame-toggle-raises-when-unfocused () + "Normal: toggle from a working frame raises the existing agenda frame." + (let (raised) + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) + ((symbol-function 'selected-frame) (lambda () 'work)) + ((symbol-function 'cj/--agenda-frame-raise) + (lambda (f) (setq raised f)))) + (cj/--agenda-frame-toggle) + (should (eq raised 'af))))) + +;;; Frame lifecycle — delete + +(ert-deftest test-org-agenda-frame-delete-deletes-live-frame () + "Normal: delete removes the live agenda frame." + (let (deleted) + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) + ((symbol-function 'frame-live-p) (lambda (f) (eq f 'af))) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/--agenda-frame-delete) + (should (eq deleted 'af))))) + +(ert-deftest test-org-agenda-frame-delete-noop-when-none () + "Boundary: delete with no agenda frame does nothing." + (let (called) + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () nil)) + ((symbol-function 'delete-frame) (lambda (_f &rest _) (setq called t)))) + (cj/--agenda-frame-delete) + (should-not called)))) + +;;; Frame lifecycle — cleanup on frame death and buffer kill + +(ert-deftest test-org-agenda-frame-on-delete-cancels-and-kills-buffer () + "Normal: deleting the agenda frame cancels its timer and kills the sticky buffer." + (let ((buf (get-buffer-create "*Org Agenda(F)*")) + cancelled) + (unwind-protect + (cl-letf (((symbol-function 'cj/--agenda-frame-p) (lambda (_f) t)) + ((symbol-function 'cj/--agenda-frame-cancel-timer) + (lambda (&optional _f) (setq cancelled t)))) + (cj/--agenda-frame-on-delete-frame 'af) + (should cancelled) + (should-not (buffer-live-p buf))) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest test-org-agenda-frame-on-delete-ignores-non-agenda-frame () + "Boundary: a non-agenda frame deletion triggers no cleanup." + (let (cancelled) + (cl-letf (((symbol-function 'cj/--agenda-frame-p) (lambda (_f) nil)) + ((symbol-function 'cj/--agenda-frame-cancel-timer) + (lambda (&optional _f) (setq cancelled t)))) + (cj/--agenda-frame-on-delete-frame 'work) + (should-not cancelled)))) + +(ert-deftest test-org-agenda-frame-on-kill-buffer-deletes-frame () + "Normal: killing the dedicated buffer deletes the frame." + (let (deleted) + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) + ((symbol-function 'frame-live-p) (lambda (f) (eq f 'af))) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/--agenda-frame-on-kill-buffer) + (should (eq deleted 'af))))) + +(ert-deftest test-org-agenda-frame-on-kill-buffer-guarded-during-teardown () + "Boundary: during a teardown the buffer-kill hook does not re-delete the frame." + (let (deleted (cj/--agenda-frame-tearing-down t)) + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/--agenda-frame-on-kill-buffer) + (should-not deleted)))) + +;;; Auto-dim suspension while the agenda frame lives + +(ert-deftest test-org-agenda-frame-spawn-suspends-auto-dim () + "Normal: spawning the frame turns auto-dim off and remembers it was on. +The refresh tick's selection swing marks the working window non-selected; +auto-dim's debounced dim then lands after the tick and the working frame +visibly dims every five minutes." + (defvar auto-dim-other-buffers-mode) + (let ((auto-dim-other-buffers-mode t) + (cj/--agenda-frame-dim-was-on nil) + calls) + (cl-letf (((symbol-function 'auto-dim-other-buffers-mode) + (lambda (arg) (push arg calls))) + ((symbol-function 'selected-frame) (lambda () 'launch)) + ((symbol-function 'make-frame) (lambda (&rest _) 'af)) + ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) + ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) + ((symbol-function 'org-agenda) (lambda (&rest _) nil)) + ((symbol-function 'delete-other-windows) (lambda (&rest _) nil)) + ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) + ((symbol-function 'cj/--agenda-frame-start-timer) (lambda (_f) nil))) + (cj/--agenda-frame-spawn) + (should (equal calls '(-1))) + (should cj/--agenda-frame-dim-was-on)))) + +(ert-deftest test-org-agenda-frame-spawn-leaves-auto-dim-when-off () + "Boundary: auto-dim already off -> spawn doesn't touch it, no restore later." + (defvar auto-dim-other-buffers-mode) + (let ((auto-dim-other-buffers-mode nil) + (cj/--agenda-frame-dim-was-on nil) + calls) + (cl-letf (((symbol-function 'auto-dim-other-buffers-mode) + (lambda (arg) (push arg calls))) + ((symbol-function 'selected-frame) (lambda () 'launch)) + ((symbol-function 'make-frame) (lambda (&rest _) 'af)) + ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) + ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) + ((symbol-function 'org-agenda) (lambda (&rest _) nil)) + ((symbol-function 'delete-other-windows) (lambda (&rest _) nil)) + ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) + ((symbol-function 'cj/--agenda-frame-start-timer) (lambda (_f) nil))) + (cj/--agenda-frame-spawn) + (should (null calls)) + (should-not cj/--agenda-frame-dim-was-on)))) + +(ert-deftest test-org-agenda-frame-on-delete-restores-auto-dim () + "Normal: closing the frame restores auto-dim when spawn had turned it off." + (let ((cj/--agenda-frame-dim-was-on t) + calls) + (cl-letf (((symbol-function 'auto-dim-other-buffers-mode) + (lambda (arg) (push arg calls))) + ((symbol-function 'cj/--agenda-frame-p) (lambda (_f) t)) + ((symbol-function 'cj/--agenda-frame-cancel-timer) + (lambda (&optional _f) nil))) + (cj/--agenda-frame-on-delete-frame 'af) + (should (equal calls '(1))) + (should-not cj/--agenda-frame-dim-was-on)))) + +(ert-deftest test-org-agenda-frame-on-delete-no-dim-restore-when-untouched () + "Boundary: closing without a suspended auto-dim doesn't enable it." + (let ((cj/--agenda-frame-dim-was-on nil) + calls) + (cl-letf (((symbol-function 'auto-dim-other-buffers-mode) + (lambda (arg) (push arg calls))) + ((symbol-function 'cj/--agenda-frame-p) (lambda (_f) t)) + ((symbol-function 'cj/--agenda-frame-cancel-timer) + (lambda (&optional _f) nil))) + (cj/--agenda-frame-on-delete-frame 'af) + (should (null calls))))) + +;;; Frame lifecycle — transactional spawn rollback + +(ert-deftest test-org-agenda-frame-spawn-rolls-back-on-failure () + "Error: a failure after make-frame deletes the partial frame, restores the +working frame, and signals a user-error." + (let (deleted focus) + (cl-letf (((symbol-function 'selected-frame) (lambda () 'launch)) + ((symbol-function 'make-frame) (lambda (&rest _) 'pf)) + ((symbol-function 'select-frame-set-input-focus) + (lambda (f &rest _) (setq focus f))) + ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) + ((symbol-function 'org-agenda) (lambda (&rest _) (error "boom"))) + ((symbol-function 'frame-live-p) (lambda (f) (memq f '(pf launch)))) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (should-error (cj/--agenda-frame-spawn) :type 'user-error) + (should (eq deleted 'pf)) + (should (eq focus 'launch))))) + +;;; Phase 2 — wall-clock alignment + +(ert-deftest test-org-agenda-frame-seconds-to-next-mark-aligned () + "Normal: a time exactly on a 5-minute boundary yields a full period." + ;; 1000000200 is divisible by 300 (a :00/:05 wall-clock mark). + (should (= (cj/--agenda-frame-seconds-to-next-mark 1000000200 300) 300))) + +(ert-deftest test-org-agenda-frame-seconds-to-next-mark-midway () + "Boundary: partway through a period returns the remainder to the next mark." + ;; 1000000200 + 120 -> 180 seconds remain to the next 300 mark. + (should (= (cj/--agenda-frame-seconds-to-next-mark 1000000320 300) 180))) + +;;; Phase 2 — deterministic point restoration + +(defun test-org-agenda-frame--make-agenda-buffer (lines source) + "Insert LINES into the current buffer; each is (TEXT . SRC-POS). +A non-nil SRC-POS puts an org-marker into SOURCE at that position on the line." + (dolist (spec lines) + (let ((start (point))) + (insert (car spec) "\n") + (when (cdr spec) + (put-text-property start (1+ start) 'org-marker + (set-marker (make-marker) (cdr spec) source)))))) + +(ert-deftest test-org-agenda-frame-restore-point-duplicate-nearest () + "Normal: a source marker occurring twice restores the occurrence nearest the old line." + (let ((src (generate-new-buffer " *rp-src*"))) + (unwind-protect + (with-temp-buffer + (with-current-buffer src (insert "aaaaaaaaaa\n")) + (test-org-agenda-frame--make-agenda-buffer + '(("header" . nil) ("item @2" . 3) ("filler" . nil) + ("filler" . nil) ("item @5" . 3)) + src) + (let ((old (set-marker (make-marker) 3 src))) + (cj/--agenda-frame-restore-point old 4)) + ;; lines 2 and 5 both point at src pos 3; nearest to old-line 4 is line 5. + (should (= (line-number-at-pos) 5))) + (kill-buffer src)))) + +(ert-deftest test-org-agenda-frame-restore-point-missing-clamps () + "Boundary: a gone marker clamps the old line into range and lands on an item." + (let ((src (generate-new-buffer " *rp-src*"))) + (unwind-protect + (with-temp-buffer + (with-current-buffer src (insert "aaaaaaaaaa\n")) + (test-org-agenda-frame--make-agenda-buffer + '(("header" . nil) ("item" . 3) ("item" . 5)) + src) + ;; old-line 99 is past the end; clamp to last line (an item). + (let ((gone (set-marker (make-marker) 99 src))) + (cj/--agenda-frame-restore-point gone 99)) + (should (get-text-property (line-beginning-position) 'org-marker))) + (kill-buffer src)))) + +(ert-deftest test-org-agenda-frame-restore-point-header-goes-to-first-item () + "Boundary: with no marker match, a header line moves to the first item." + (let ((src (generate-new-buffer " *rp-src*"))) + (unwind-protect + (with-temp-buffer + (with-current-buffer src (insert "aaaaaaaaaa\n")) + (test-org-agenda-frame--make-agenda-buffer + '(("header" . nil) ("item one" . 3) ("item two" . 5)) + src) + (cj/--agenda-frame-restore-point nil 1) ; line 1 is the header + (should (= (line-number-at-pos) 2)) + (should (get-text-property (line-beginning-position) 'org-marker))) + (kill-buffer src)))) + +(ert-deftest test-org-agenda-frame-restore-point-empty-buffer-start () + "Error: an empty (item-less) view leaves point at buffer start." + (with-temp-buffer + (test-org-agenda-frame--make-agenda-buffer + '(("only a header" . nil) ("no items here" . nil)) nil) + (cj/--agenda-frame-restore-point nil 2) + (should (= (point) (point-min))))) + +;;; Phase 2 — snapshot marker cloning + +(ert-deftest test-org-agenda-frame-clone-and-reinstall-markers () + "Normal: cloned markers survive nulling the originals and reinstall live." + (let ((src (generate-new-buffer " *clone-src*"))) + (unwind-protect + (let (clones) + (with-temp-buffer + (with-current-buffer src (insert "0123456789\n")) + (test-org-agenda-frame--make-agenda-buffer '(("item" . 4)) src) + (setq clones (cj/--agenda-frame-snapshot-markers (current-buffer))) + ;; Simulate org-agenda-reset-markers nulling the buffer's originals. + (let ((orig (get-text-property (point-min) 'org-marker))) + (set-marker orig nil))) + ;; Reinstall into a fresh buffer copy; the clone must still be live. + (with-temp-buffer + (test-org-agenda-frame--make-agenda-buffer '(("item" . nil)) nil) + (cj/--agenda-frame-reinstall-markers (current-buffer) clones) + (let ((m (get-text-property (point-min) 'org-marker))) + (should (markerp m)) + (should (eq (marker-buffer m) src)) + (should (= (marker-position m) 4))))) + (kill-buffer src)))) + +;;; Phase 2 — failure latch (report once per consecutive-failure run) + +(ert-deftest test-org-agenda-frame-failure-latch-reports-once () + "Normal: the first failure of a run reports; subsequent ones stay silent." + (let ((params '())) + (cl-letf (((symbol-function 'frame-parameter) + (lambda (_f p) (alist-get p params))) + ((symbol-function 'set-frame-parameter) + (lambda (_f p v) (setf (alist-get p params) v)))) + (should (cj/--agenda-frame-record-failure 'af)) ; 0 -> 1, report + (should-not (cj/--agenda-frame-record-failure 'af)) ; 1 -> 2, silent + (cj/--agenda-frame-clear-failure 'af) + (should (cj/--agenda-frame-record-failure 'af))))) ; reset -> report again + +;;; Phase 2 — timer start + duplicate prevention + +(ert-deftest test-org-agenda-frame-start-timer-sets-timer () + "Normal: start-timer schedules and stores a timer when none exists." + (let (stored) + (cl-letf (((symbol-function 'frame-parameter) (lambda (_f _p) nil)) + ((symbol-function 'run-at-time) (lambda (&rest _) 'the-timer)) + ((symbol-function 'set-frame-parameter) + (lambda (_f _p v) (setq stored v)))) + (should (eq (cj/--agenda-frame-start-timer 'af) 'the-timer)) + (should (eq stored 'the-timer))))) + +(ert-deftest test-org-agenda-frame-start-timer-no-duplicate () + "Boundary: a frame already carrying a live timer is not given a second one." + (let (called) + (cl-letf (((symbol-function 'frame-parameter) (lambda (_f _p) 'existing)) + ((symbol-function 'timerp) (lambda (x) (eq x 'existing))) + ((symbol-function 'run-at-time) (lambda (&rest _) (setq called t) 'new))) + (cj/--agenda-frame-start-timer 'af) + (should-not called)))) + +;;; Phase 2 — do-redo orchestration (success and failure branches) + +(ert-deftest test-org-agenda-frame-do-redo-success-clears-and-releases () + "Normal: a successful redo clears the failure latch and releases the snapshot." + (let ((params (list (cons 'cj/agenda-frame-fail-count 3))) + released) + (with-temp-buffer + (insert "agenda line\n") + (cl-letf (((symbol-function 'org-agenda-redo) (lambda (&rest _) nil)) + ((symbol-function 'frame-parameter) (lambda (_f p) (alist-get p params))) + ((symbol-function 'set-frame-parameter) + (lambda (_f p v) (setf (alist-get p params) v))) + ((symbol-function 'cj/--agenda-frame-release-snapshot) + (lambda (_s) (setq released t)))) + (cj/--agenda-frame-do-redo 'af (current-buffer) nil) + (should (equal (alist-get 'cj/agenda-frame-fail-count params) 0)) + (should released))))) + +(ert-deftest test-org-agenda-frame-do-redo-error-restores-reenables-reports () + "Error: a redo that fails mid-rebuild restores the last-good buffer verbatim, +re-enables the policy, shows one overlay, and reports once." + (let ((params '()) msgs) + (with-temp-buffer + (insert "good agenda content\n") + (unwind-protect + (cl-letf (((symbol-function 'org-agenda-redo) + (lambda (&rest _) (erase-buffer) (insert "PARTIAL") (error "boom"))) + ((symbol-function 'frame-parameter) (lambda (_f p) (alist-get p params))) + ((symbol-function 'set-frame-parameter) + (lambda (_f p v) (setf (alist-get p params) v))) + ((symbol-function 'message) + (lambda (fmt &rest a) (push (apply #'format fmt a) msgs)))) + (cj/--agenda-frame-do-redo 'af (current-buffer) nil) + (should cj/agenda-frame-mode) ; policy re-enabled + (should (= 1 (length (cj/--agenda-frame-failure-overlays + (current-buffer))))) ; overlay shown + (should (string-match-p "good agenda content" (buffer-string))) ; restored + (should-not (string-match-p "PARTIAL" (buffer-string))) + (should (= 1 (seq-count (lambda (m) (string-match-p "refresh failed" m)) + msgs)))) + (cj/agenda-frame-mode -1) + (cj/--agenda-frame-remove-overlay (current-buffer)))))) + +(ert-deftest test-org-agenda-frame-do-redo-follows-item-across-shift () + "Normal: on a successful redo, point follows the same source item even when +lines shift and the buffer's own markers are nulled (the reset-markers case). +Guards against restoring by raw line number after the item moved." + (let ((src (generate-new-buffer " *shift-src*")) + (params '())) + (unwind-protect + (with-temp-buffer + (with-current-buffer src (insert "0123456789\n")) + ;; Before: item B (src pos 5) sits on line 3, and point is on it. + (test-org-agenda-frame--make-agenda-buffer + '(("header" . nil) ("item A" . 3) ("item B" . 5)) src) + (goto-char (point-min)) (forward-line 2) ; line 3, item B + (cl-letf (((symbol-function 'frame-parameter) (lambda (_f p) (alist-get p params))) + ((symbol-function 'set-frame-parameter) + (lambda (_f p v) (setf (alist-get p params) v))) + ((symbol-function 'org-agenda-redo) + (lambda (&rest _) + ;; Null the buffer's originals (as org-agenda-reset-markers + ;; does), then rebuild with item B shifted to line 4. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((m (get-text-property (line-beginning-position) 'org-marker))) + (when (markerp m) (set-marker m nil))) + (forward-line 1))) + (erase-buffer) + (test-org-agenda-frame--make-agenda-buffer + '(("header" . nil) ("new item" . 1) ("item A" . 3) ("item B" . 5)) + src)))) + (cj/--agenda-frame-do-redo 'af (current-buffer) nil)) + ;; Point should be on the rebuilt item B (src pos 5), now line 4 -- + ;; not clamped to old line 3 (which is now item A, src pos 3). + (let ((m (get-text-property (line-beginning-position) 'org-marker))) + (should (markerp m)) + (should (= (marker-position m) 5)))) + (kill-buffer src)))) + +;;; Phase 2 — snapshot round-trip, release, safe-redo window contract, overlay + +(ert-deftest test-org-agenda-frame-restore-snapshot-round-trip () + "Normal: snapshot then restore reinstates text and a live cloned marker." + (let ((src (generate-new-buffer " *ss-src*"))) + (unwind-protect + (with-temp-buffer + (with-current-buffer src (insert "0123456789\n")) + (test-org-agenda-frame--make-agenda-buffer '(("item alpha" . 4)) src) + (let ((snap (cj/--agenda-frame-snapshot (current-buffer) nil))) + (erase-buffer) + (insert "CORRUPT") + (cj/--agenda-frame-restore-snapshot (current-buffer) snap nil) + (should (string-match-p "item alpha" (buffer-string))) + (let ((m (get-text-property (point-min) 'org-marker))) + (should (markerp m)) + (should (eq (marker-buffer m) src)) + (should (= (marker-position m) 4))) + (cj/--agenda-frame-release-snapshot snap) + (should-not (marker-buffer (cdr (car (plist-get snap :markers))))))) + (kill-buffer src)))) + +(ert-deftest test-org-agenda-frame-safe-redo-selects-and-restores-window () + "Normal: the active tick runs the redo and restores the prior window (no focus theft)." + (let (redone (prev (selected-window))) + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) + ((symbol-function 'cj/--agenda-frame-sticky-buffer) + (lambda () (current-buffer))) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'get-buffer-window) (lambda (&rest _) prev)) + ((symbol-function 'cj/--agenda-frame-do-redo) + (lambda (&rest _) (setq redone t)))) + (cj/--agenda-frame-safe-redo) + (should redone) + (should (eq (selected-window) prev))))) + +(ert-deftest test-org-agenda-frame-overlay-idempotent () + "Boundary: showing the failure overlay twice keeps a single overlay." + (with-temp-buffer + (insert "x\n") + (unwind-protect + (progn + (cj/--agenda-frame-show-failure-overlay (current-buffer)) + (let ((first (car (cj/--agenda-frame-failure-overlays (current-buffer))))) + (cj/--agenda-frame-show-failure-overlay (current-buffer)) + (should (equal (cj/--agenda-frame-failure-overlays (current-buffer)) + (list first))) + (should (= 1 (seq-count (lambda (o) (overlay-get o 'before-string)) + (overlays-in (point-min) (point-max))))))) + (cj/--agenda-frame-remove-overlay (current-buffer))))) + +;;; Phase 2 — public command + F8-family rebind + +(ert-deftest test-org-agenda-frame-public-toggle-wraps-private () + "Normal: the interactive command delegates to the private toggle." + (let (called) + (cl-letf (((symbol-function 'cj/--agenda-frame-toggle) + (lambda () (setq called t)))) + (call-interactively 'cj/agenda-frame-toggle) + (should called)))) + +(ert-deftest test-org-agenda-frame-parameters-normal-tiled-frame () + "Boundary: the agenda frame is a normal frame (the tiling WM places it +side by side with the working frame), carrying the marker and a distinct name." + (let ((params (cj/--agenda-frame-make-parameters))) + (should (assq cj/--agenda-frame-parameter params)) + (should (equal (cdr (assq 'name params)) "Full Agenda")) + ;; No fullscreen request -- a fullboth frame would cover the whole output + ;; instead of tiling beside the working frame. + (should-not (assq 'fullscreen params)))) + +(ert-deftest test-org-agenda-frame-spawn-binds-sticky-and-current-window () + "Normal: spawn dynamically binds sticky + current-window around the render. +The custom command's own settings apply too late to name the buffer, so +without these bindings the buffer is plain *Org Agenda* -- which matches +the 0.75 below-selected display rule and splits the new frame with the +working buffer left on top." + (let (seen-sticky seen-setup) + (cl-letf (((symbol-function 'selected-frame) (lambda () 'launch)) + ((symbol-function 'make-frame) (lambda (&rest _) 'af)) + ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) + ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) + ((symbol-function 'org-agenda) + (lambda (&rest _) + (setq seen-sticky org-agenda-sticky + seen-setup org-agenda-window-setup))) + ((symbol-function 'delete-other-windows) (lambda (&rest _) nil)) + ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) + ((symbol-function 'cj/--agenda-frame-start-timer) (lambda (_f) nil))) + (cj/--agenda-frame-spawn) + (should (eq seen-sticky t)) + (should (eq seen-setup 'current-window))))) + +(ert-deftest test-org-agenda-frame-spawn-forces-single-window () + "Boundary: spawn collapses the frame to one window after rendering. +A display rule that still splits the frame must not leave a second window +showing the launch buffer." + (let (collapsed) + (cl-letf (((symbol-function 'selected-frame) (lambda () 'launch)) + ((symbol-function 'make-frame) (lambda (&rest _) 'af)) + ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) + ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) + ((symbol-function 'org-agenda) (lambda (&rest _) nil)) + ((symbol-function 'delete-other-windows) + (lambda (&rest _) (setq collapsed t))) + ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) + ((symbol-function 'cj/--agenda-frame-start-timer) (lambda (_f) nil))) + (cj/--agenda-frame-spawn) + (should collapsed)))) + +(ert-deftest test-org-agenda-frame-spawn-resets-span-to-7 () + "Normal: a fresh spawn opens at the documented seven-day default, even when a +prior frame's session left `cj/--agenda-frame-span' at the day view." + (let ((cj/--agenda-frame-span 1)) + (cl-letf (((symbol-function 'selected-frame) (lambda () 'launch)) + ((symbol-function 'make-frame) (lambda (&rest _) 'af)) + ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) + ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) + ((symbol-function 'org-agenda) (lambda (&rest _) nil)) + ((symbol-function 'delete-other-windows) (lambda (&rest _) nil)) + ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) + ((symbol-function 'cj/--agenda-frame-start-timer) (lambda (_f) nil))) + (cj/--agenda-frame-spawn) + (should (equal cj/--agenda-frame-span 7))))) + +(ert-deftest test-org-agenda-frame-spawn-starts-timer () + "Normal: a successful spawn starts the refresh timer for the new frame." + (let (timed) + (cl-letf (((symbol-function 'selected-frame) (lambda () 'launch)) + ((symbol-function 'make-frame) (lambda (&rest _) 'af)) + ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) + ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) + ((symbol-function 'org-agenda) (lambda (&rest _) nil)) + ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) + ((symbol-function 'cj/--agenda-frame-start-timer) + (lambda (f) (setq timed f)))) + (should (eq (cj/--agenda-frame-spawn) 'af)) + (should (eq timed 'af))))) + +(ert-deftest test-org-agenda-frame-safe-redo-inhibits-redisplay () + "Normal: the tick runs with redisplay inhibited. +The rebuild takes visible time; without this, the agenda window is the +selected window for the whole rebuild and the user watches their cursor +go hollow every five minutes -- indistinguishable from focus theft." + (let (seen (prev (selected-window))) + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) + ((symbol-function 'cj/--agenda-frame-sticky-buffer) + (lambda () (current-buffer))) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'get-buffer-window) (lambda (&rest _) prev)) + ((symbol-function 'cj/--agenda-frame-do-redo) + (lambda (&rest _) (setq seen inhibit-redisplay)))) + (cj/--agenda-frame-safe-redo) + (should (eq seen t))))) + +(ert-deftest test-org-agenda-frame-safe-redo-skips-during-minibuffer () + "Boundary: a tick while a minibuffer is active is skipped entirely. +Reselecting windows under an active minibuffer session can break it; the +next tick catches up." + (let (redone (prev (selected-window))) + (cl-letf (((symbol-function 'active-minibuffer-window) (lambda () 'mini)) + ((symbol-function 'cj/--agenda-frame) (lambda () 'af)) + ((symbol-function 'cj/--agenda-frame-sticky-buffer) + (lambda () (current-buffer))) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'get-buffer-window) (lambda (&rest _) prev)) + ((symbol-function 'cj/--agenda-frame-do-redo) + (lambda (&rest _) (setq redone t)))) + (cj/--agenda-frame-safe-redo) + (should-not redone)))) + +(ert-deftest test-org-agenda-frame-safe-redo-noop-when-not-shown () + "Boundary: a tick with the buffer not shown in the frame does not redo or error." + (let (redone) + (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) + ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) + ((symbol-function 'get-buffer-window) (lambda (&rest _) nil)) + ((symbol-function 'cj/--agenda-frame-do-redo) + (lambda (&rest _) (setq redone t)))) + (cj/--agenda-frame-safe-redo) + (should-not redone)))) + +(ert-deftest test-org-agenda-frame-install-keys-rebinds-f8-family () + "Normal: S-<f8> toggles the frame; the force-rescan moves to C-M-<f8>." + (let ((map (make-sparse-keymap))) + (cj/--agenda-frame-install-keys map) + (should (eq (lookup-key map (kbd "S-<f8>")) 'cj/agenda-frame-toggle)) + (should (eq (lookup-key map (kbd "C-M-<f8>")) 'cj/org-agenda-refresh-files)))) + +(provide 'test-org-agenda-frame) +;;; test-org-agenda-frame.el ends here 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..7e5146b1 100644 --- a/tests/test-system-commands-resolve-and-run.el +++ b/tests/test-system-commands-resolve-and-run.el @@ -230,5 +230,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-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-video-audio-recording-process-sentinel.el b/tests/test-video-audio-recording-process-sentinel.el index 92fb3f0d..d733e46f 100644 --- a/tests/test-video-audio-recording-process-sentinel.el +++ b/tests/test-video-audio-recording-process-sentinel.el @@ -190,5 +190,157 @@ (should (null cj/audio-recording-ffmpeg-process)))) (test-sentinel-teardown))) +;;; Failed-Start Stub Deletion +;; +;; On Wayland a wf-recorder that fails to grab the compositor capture +;; still writes a ~500KB, ~0.5s stub .mkv before dying. The sentinel +;; detects the failed start (exit sooner than +;; `cj/recording-start-fail-threshold' without a user stop); these tests +;; pin that it also deletes the stub file stamped on the process as the +;; `cj-output-file' property — and that normal stops and user stops +;; never delete anything. + +(defun test-sentinel--make-exited-process () + "Return a real process that has already exited. +Drives the sentinel with a genuinely dead process so `process-status' +and the process plist behave for real instead of through mocks." + (let ((proc (make-process :name "test-sentinel-exited" + :command '("true") + :sentinel #'ignore))) + (while (process-live-p proc) + (accept-process-output proc 0.05)) + proc)) + +(defun test-sentinel--make-stub-file () + "Create and return a temp file standing in for the stub .mkv." + (make-temp-file "test-sentinel-stub-" nil ".mkv" "stub-content")) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-failed-start-deletes-stub () + "Normal: a failed video start deletes the stub output file." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process)) + (stub (test-sentinel--make-stub-file))) + (unwind-protect + (progn + (setq cj/video-recording-ffmpeg-process proc) + ;; Exited immediately after its start time — a failed start. + (process-put proc 'cj-start-time (float-time)) + (process-put proc 'cj-output-file stub) + (cj/recording-process-sentinel proc "exited abnormally\n") + (should-not (file-exists-p stub))) + (when (file-exists-p stub) (delete-file stub)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-failed-start-still-messages () + "Normal: the failed-start branch still reports the failure to the user." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process)) + (stub (test-sentinel--make-stub-file)) + (failure-messaged nil)) + (unwind-protect + (progn + (setq cj/video-recording-ffmpeg-process proc) + (process-put proc 'cj-start-time (float-time)) + (process-put proc 'cj-output-file stub) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (let ((msg (apply #'format fmt args))) + (when (string-match-p "failed to start" msg) + (setq failure-messaged t)))))) + (cj/recording-process-sentinel proc "exited abnormally\n")) + (should failure-messaged)) + (when (file-exists-p stub) (delete-file stub)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-long-run-keeps-file () + "Normal: a recording that ran past the threshold keeps its output file." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process)) + (stub (test-sentinel--make-stub-file))) + (unwind-protect + (progn + (setq cj/video-recording-ffmpeg-process proc) + ;; Ran well past the fail threshold — a real recording. + (process-put proc 'cj-start-time + (- (float-time) + (* 10 cj/recording-start-fail-threshold))) + (process-put proc 'cj-output-file stub) + (cj/recording-process-sentinel proc "finished\n") + (should (file-exists-p stub))) + (when (file-exists-p stub) (delete-file stub)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-boundary-user-stop-keeps-file () + "Boundary: a quick user stop (cj-stopping) never deletes the file." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process)) + (stub (test-sentinel--make-stub-file))) + (unwind-protect + (progn + (setq cj/video-recording-ffmpeg-process proc) + ;; Quick exit, but the user asked for it. + (process-put proc 'cj-start-time (float-time)) + (process-put proc 'cj-stopping t) + (process-put proc 'cj-output-file stub) + (cj/recording-process-sentinel proc "finished\n") + (should (file-exists-p stub))) + (when (file-exists-p stub) (delete-file stub)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-boundary-missing-stub-no-error () + "Boundary: failed start whose stub never hit disk signals no error." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process))) + (setq cj/video-recording-ffmpeg-process proc) + (process-put proc 'cj-start-time (float-time)) + (process-put proc 'cj-output-file "/nonexistent/dir/never-written.mkv") + ;; Must not signal even though the file is absent. + (cj/recording-process-sentinel proc "exited abnormally\n") + (should (null cj/video-recording-ffmpeg-process))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-error-nil-output-property-no-error () + "Error: failed start with no cj-output-file property signals no error. +Covers processes started before the property existed (a live daemon +mid-upgrade) — the sentinel degrades to the old message-only path." + (test-sentinel-setup) + (unwind-protect + (let ((proc (test-sentinel--make-exited-process))) + (setq cj/video-recording-ffmpeg-process proc) + (process-put proc 'cj-start-time (float-time)) + ;; No cj-output-file property at all. + (cj/recording-process-sentinel proc "exited abnormally\n") + (should (null cj/video-recording-ffmpeg-process))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-start-stamps-output-file () + "Normal: `cj/ffmpeg-record-video' stamps cj-output-file on the process." + (test-sentinel-setup) + (unwind-protect + (let ((cj/recording-mic-device "test-mic-device") + (cj/recording-system-device "test-monitor-device") + (cj/recording-mic-boost 2.0) + (cj/recording-system-volume 1.0)) + (cl-letf (((symbol-function 'cj/recording--wayland-p) (lambda () nil)) + ((symbol-function 'cj/recording--validate-system-audio) + (lambda () nil)) + ((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _command) + (make-process :name "fake-video" :command '("sleep" "1000"))))) + (cj/ffmpeg-record-video "/tmp/video-recordings/") + (let ((output-file (process-get cj/video-recording-ffmpeg-process + 'cj-output-file))) + (should (stringp output-file)) + (should (string-suffix-p ".mkv" output-file)) + (should (string-prefix-p "/tmp/video-recordings/" output-file)))) + (when cj/video-recording-ffmpeg-process + (ignore-errors (delete-process cj/video-recording-ffmpeg-process)))) + (test-sentinel-teardown))) + (provide 'test-video-audio-recording-process-sentinel) ;;; test-video-audio-recording-process-sentinel.el ends here 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/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 |
