diff options
Diffstat (limited to 'modules')
96 files changed, 4888 insertions, 1992 deletions
diff --git a/modules/ai-term-backend-eat.el b/modules/ai-term-backend-eat.el index 9a166ff8..906abd00 100644 --- a/modules/ai-term-backend-eat.el +++ b/modules/ai-term-backend-eat.el @@ -100,14 +100,21 @@ typed into a bare shell. Returns the poll timer." (cancel-timer timer)))))) timer)) -(defun cj/--ai-term-show-or-create (dir name) +(defun cj/--ai-term-show-or-create (dir name &optional agent-command 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 no such buffer exists, create a new EAT terminal in DIR and send the project's tmux launch command (see `cj/--ai-term-launch-command') so the same project basename reattaches across Emacs restarts. +AGENT-COMMAND, when non-nil, is the full agent launch command for a +fresh session (the multi-backend picker's choice); nil falls back to +`cj/ai-term-agent-command'. A reattach ignores it (`tmux new-session +-A' attaches without running the command). EAT runs a plain shell with no auto-tmux hook, so the named `tmux new-session -A' launch command is the only thing that starts the @@ -131,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 @@ -148,19 +156,21 @@ buffer." (with-current-buffer buf (cj/--ai-term-apply-accent buf) (cj/--ai-term-send-string - buf (concat (cj/--ai-term-launch-command dir) "\n"))) + buf (concat (cj/--ai-term-launch-command dir agent-command) "\n"))) (when fresh (cj/--ai-term-schedule-color buf (cj/--ai-term-project-color dir))) (display-buffer buf) 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 99585a70..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. @@ -157,7 +188,7 @@ looked up in SESSIONS, so the lossy whitespace->hyphen transform in `cj/--ai-term-tmux-session-name' never needs reversing." (and (member (cj/--ai-term-tmux-session-name dir) sessions) t)) -(defun cj/--ai-term-launch-command (dir) +(defun cj/--ai-term-launch-command (dir &optional agent-command) "Return the shell command line that runs the AI tool in a project tmux session. Uses `tmux new-session -A' so a second toggle on the same project reattaches @@ -167,9 +198,12 @@ comes from `cj/--ai-term-tmux-session-name'; the first window is named window auto-names after its command and the two read distinctly. The shell command run on first creation is - <cj/ai-term-agent-command>; exec bash + <agent command>; exec bash so the tmux window survives the AI command exiting -- the session stays -alive with a bare bash prompt for recovery, and reattach works the same way." +alive with a bare bash prompt for recovery, and reattach works the same way. +AGENT-COMMAND overrides `cj/ai-term-agent-command' for the fresh-session +case (the multi-backend picker passes the chosen runtime's command); on a +reattach `tmux new-session -A' ignores the command either way." (let ((session (cj/--ai-term-tmux-session-name dir)) (start-dir (expand-file-name dir))) ;; Pass the inner shell-command-string through `shell-quote-argument' @@ -184,7 +218,8 @@ alive with a bare bash prompt for recovery, and reattach works the same way." (shell-quote-argument cj/ai-term-tmux-window-name) (shell-quote-argument start-dir) (shell-quote-argument - (concat cj/ai-term-agent-command "; exec bash"))))) + (concat (or agent-command cj/ai-term-agent-command) + "; exec bash"))))) (defun cj/--ai-term-kill-tmux-session (session) "Kill the tmux SESSION via `tmux kill-session -t SESSION'. @@ -316,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 @@ -333,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 e0706abb..52494c18 100644 --- a/modules/ai-term.el +++ b/modules/ai-term.el @@ -46,10 +46,24 @@ (defcustom cj/ai-term-agent-command "claude \"Read .ai/protocols.org and follow all instructions.\"" - "Shell command sent to a fresh AI-term to start the agent. + "Shell command for the default (\"claude\") agent runtime. -The default invokes the Claude Code CLI; set it to whatever terminal -agent you run (aider, an open-source LLM TUI, etc.)." +Sent to a fresh AI-term when no other runtime is picked; also the +fallback when launch paths bypass the runtime picker (e.g. attaching a +detached session, where the command is ignored anyway). Non-Claude +runtimes compose their commands from `cj/ai-term-agent-prompt' instead +-- see `cj/--ai-term-runtime-command'." + :type 'string + :group 'ai-term) + +(defcustom cj/ai-term-agent-prompt + "Read .ai/protocols.org and follow all instructions." + "Opening instructions passed to non-Claude agent runtimes. + +Claude, Codex, and codex --oss all take the opening instructions as a +positional prompt, so this one string serves every runtime; only the +command in front of it varies (the \"claude\" runtime carries its full +line in `cj/ai-term-agent-command' for backward compatibility)." :type 'string :group 'ai-term) @@ -240,6 +254,80 @@ without firing real `display-buffer' or `quit-window' calls." (car buffers)))) (t '(pick-project)))))))) +;; ------------------------- Agent runtime selection --------------------------- +;; A fresh session can run Claude, Codex (ChatGPT), or a local model through +;; codex --oss (ollama). Runtime names and launch strings mirror the rulesets +;; bin/ai launcher so the two launchers stay one mental model: "claude", +;; "codex", "local:<model>". The choice list itself comes from +;; `ai --print-runtimes' when that launcher is installed (single source of +;; truth, including the live ollama model scan with its own timeout); without +;; it a static claude/codex list stands in. + +(defun cj/--ai-term-runtime-command (runtime) + "Return the full agent shell command for RUNTIME. +RUNTIME is \"claude\" (or nil, both meaning `cj/ai-term-agent-command' +verbatim), \"codex\", or \"local:<model>\" for an ollama model via +codex --oss. The non-Claude commands append `cj/ai-term-agent-prompt' +as the positional opening prompt. An unknown RUNTIME signals a +`user-error' rather than launching something half-formed. The explicit +--local-provider flag is deliberate: setting the provider through +config.toml silently does nothing (rulesets, 2026-07-13)." + (cond + ((or (null runtime) (equal runtime "claude")) + cj/ai-term-agent-command) + ((equal runtime "codex") + (concat "codex " (shell-quote-argument cj/ai-term-agent-prompt))) + ((string-prefix-p "local:" runtime) + (let ((model (substring runtime (length "local:")))) + (when (string-empty-p model) + (user-error "Agent runtime %s names no ollama model" runtime)) + (concat "codex --oss --local-provider=ollama -m " + (shell-quote-argument model) " " + (shell-quote-argument cj/ai-term-agent-prompt)))) + (t (user-error "Unknown agent runtime: %s" runtime)))) + +(defun cj/--ai-term-parse-runtime-lines (output) + "Parse `ai --print-runtimes' OUTPUT into an alist of (NAME . LABEL). +Each line is \"NAME — LABEL\"; blank lines and lines without the +separator are dropped, so a stray warning in the output degrades to a +shorter list instead of a parse error." + (delq nil + (mapcar (lambda (line) + (when (string-match "\\`\\(.+?\\) — \\(.+\\)\\'" line) + (cons (match-string 1 line) (match-string 2 line)))) + (split-string output "\n" t)))) + +(defun cj/--ai-term-runtime-choices () + "Return the agent runtime choices as an alist of (NAME . LABEL). +Shells out to `ai --print-runtimes' when the launcher is installed -- +that keeps the two launchers' lists identical and reuses its live +ollama scan (which carries its own dead-server timeout). When the +launcher is absent, errors, or prints nothing parseable, a static +claude-first list stands in." + (or (when-let* ((ai (executable-find "ai"))) + (with-temp-buffer + (when (eq 0 (ignore-errors + (process-file ai nil t nil "--print-runtimes"))) + (cj/--ai-term-parse-runtime-lines (buffer-string))))) + '(("claude" . "Claude Code") + ("codex" . "ChatGPT (Codex CLI)")))) + +(defun cj/--ai-term-pick-runtime () + "Prompt for the agent runtime of a fresh session; RET picks the first. +The first choice is claude, so launching a project stays Enter-Enter +for the common case. Labels annotate the candidates." + (let* ((choices (cj/--ai-term-runtime-choices)) + (default (caar choices))) + (completing-read + (format "Agent runtime (default %s): " default) + (cj/completion-table-annotated + 'ai-term-runtime + (lambda (cand) + (when-let* ((label (cdr (assoc cand choices)))) + (format " %s" label))) + choices) + nil t nil nil default))) + (defun cj/ai-term-pick-project (&optional arg) "Pick an AI-agent project and open or reuse its EAT terminal. @@ -254,12 +342,27 @@ With prefix ARG, display the buffer without selecting its window. Bound to C-; a s -- always shows the project picker, even when an agent buffer is currently displayed. +A genuinely fresh launch (no live agent buffer AND no surviving tmux +session) also asks which agent runtime to run -- claude, codex, or a +local model; RET keeps claude, so the common case stays Enter-Enter. +Reattaches and redisplays never ask: the session already runs whatever +it runs. + EAT renders in terminal frames as well as GUI frames, so this launches from either." (interactive "P") - (let* ((dir (cj/--ai-term-pick-project)) + ;; 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)) - (buf (cj/--ai-term-show-or-create dir name))) + (existing (get-buffer name)) + (fresh (and (not (and existing + (cj/--ai-term-process-live-p existing))) + (not (cj/--ai-term-session-active-p dir sessions)))) + (command (when fresh + (cj/--ai-term-runtime-command (cj/--ai-term-pick-runtime)))) + (buf (cj/--ai-term-show-or-create dir name command sessions))) (unless arg (let ((win (get-buffer-window buf))) (when win (select-window win)))) @@ -299,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))) @@ -353,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) @@ -381,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 @@ -407,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 @@ -425,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 ------------------------- ;; @@ -446,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 efae5341..980d301f 100644 --- a/modules/auto-dim-config.el +++ b/modules/auto-dim-config.el @@ -23,6 +23,14 @@ ;; terminal background, so -- unlike the old ghostel/vterm engines, which baked ;; color per-terminal with no per-window hook -- they follow the per-window ;; dimmed background like any other buffer. +;; +;; One caveat, so nobody chases it through this alist: ANSI-coloured spans in a +;; terminal keep their colour when dimmed. EAT attaches those as anonymous face +;; plists carrying a literal foreground, e.g. (:foreground "#AFD7FF" :inherit +;; (eat-term-font-0)), and `face-remap-add-relative' only reaches named faces. +;; There is no face name to add below. Reaching them would need an overlay +;; (whose face outranks a text property), not a remap. Background and uncoloured +;; text still dim, which is close enough; this is deliberate, not an oversight. ;;; Code: @@ -50,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. @@ -75,6 +87,76 @@ focus cue on a split-displayed dashboard, accepted as a fair trade." (font-lock-builtin-face . (auto-dim-other-buffers . nil)) (font-lock-preprocessor-face . (auto-dim-other-buffers . nil)) (font-lock-warning-face . (auto-dim-other-buffers . nil)) + ;; Faces that sit AHEAD of a mapped face in a face list and outrank it, so + ;; the text under them stayed lit until each was named here: a table header + ;; renders as (org-table-header org-table), a TODO line as + ;; (org-faces-todo org-level-3). tests/test-auto-dim-config.el walks a + ;; fontified org buffer and fails when a built-in org face is left out. + (org-table-header . (auto-dim-other-buffers . nil)) + (org-formula . (auto-dim-other-buffers . nil)) + (org-checkbox . (auto-dim-other-buffers . nil)) + (org-checkbox-statistics-done . (auto-dim-other-buffers . nil)) + (org-headline-done . (auto-dim-other-buffers . nil)) + (org-drill-visible-cloze-face . (auto-dim-other-buffers . nil)) + ;; org-indent inherits org-hide, so its foreground IS the background: that + ;; is what makes indent prefixes invisible. -hide face, never the flat dim. + (org-indent . (auto-dim-other-buffers-hide . nil)) + ;; org-superstar draws heading stars and list bullets, and puts its own face + ;; ahead of the org face beneath, so a star renders as + ;; (org-superstar-header-bullet org-level-1) and outranks the dimmed level. + ;; Without these three, bullets are the last thing left lit in a dimmed window. + (org-superstar-header-bullet . (auto-dim-other-buffers . nil)) + (org-superstar-item . (auto-dim-other-buffers . nil)) + (org-superstar-first . (auto-dim-other-buffers . nil)) + ;; org-superstar-leading takes the -hide face, not the flat dim: its + ;; foreground IS the background colour, which is what keeps hidden leading + ;; stars invisible. Flat-dimming it would reveal them. Same as org-hide. + (org-superstar-leading . (auto-dim-other-buffers-hide . nil)) + ;; The built-in link faces, distinct from org-link below. They fontify + ;; links in help, info, and customize buffers. Both carry :underline t, + ;; which survives the relative remap, so a dimmed link still reads as one. + (link . (auto-dim-other-buffers . nil)) + (link-visited . (auto-dim-other-buffers . nil)) + ;; Org structure faces flat-dim like font-lock rather than getting + ;; -dim variants: the active theme gives org-level-1..8 one shared + ;; foreground and no height or weight, so there is no level-by-colour + ;; signal to preserve. The remap is relative, so org-link keeps its + ;; underline and the heading stars / org-indent keep conveying depth. + ;; That premise is theme-dependent -- a theme that colours heading + ;; levels distinctly would make the flat dim discard real signal, and + ;; those levels would then want -dim variants like the keywords below. + (org-level-1 . (auto-dim-other-buffers . nil)) + (org-level-2 . (auto-dim-other-buffers . nil)) + (org-level-3 . (auto-dim-other-buffers . nil)) + (org-level-4 . (auto-dim-other-buffers . nil)) + (org-level-5 . (auto-dim-other-buffers . nil)) + (org-level-6 . (auto-dim-other-buffers . nil)) + (org-level-7 . (auto-dim-other-buffers . nil)) + (org-level-8 . (auto-dim-other-buffers . nil)) + (org-link . (auto-dim-other-buffers . nil)) + (org-tag . (auto-dim-other-buffers . nil)) + ;; org-todo and org-priority are deliberately absent: they are keyword + ;; class, like the org-faces-* set below, and flat-dimming them would + ;; erase the status colour those -dim variants exist to preserve. + ;; Document header: #+TITLE:, #+AUTHOR:, #+ARCHIVE: and their values. + (org-document-title . (auto-dim-other-buffers . nil)) + (org-document-info . (auto-dim-other-buffers . nil)) + (org-document-info-keyword . (auto-dim-other-buffers . nil)) + (org-meta-line . (auto-dim-other-buffers . nil)) + ;; Inline markup and source blocks. + (org-code . (auto-dim-other-buffers . nil)) + (org-verbatim . (auto-dim-other-buffers . nil)) + (org-block-begin-line . (auto-dim-other-buffers . nil)) + (org-block-end-line . (auto-dim-other-buffers . nil)) + ;; Drawers, properties, and planning lines. + (org-drawer . (auto-dim-other-buffers . nil)) + (org-special-keyword . (auto-dim-other-buffers . nil)) + (org-property-value . (auto-dim-other-buffers . nil)) + (org-date . (auto-dim-other-buffers . nil)) + ;; Tables and the fold indicator. + (org-table . (auto-dim-other-buffers . nil)) + (org-table-row . (auto-dim-other-buffers . nil)) + (org-ellipsis . (auto-dim-other-buffers . nil)) ;; Org TODO-keyword + priority faces dim to their own -dim variant ;; (a darker shade of the same colour) rather than the flat gray, so ;; a dimmed window's keywords stay recognizable. Faces are defined diff --git a/modules/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 72576a6f..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 @@ -193,21 +202,30 @@ Handles both simple values and values with parameters like TZID." (when (and event-str (stringp event-str) (not (string-empty-p event-str))) (let ((exdates '()) (pos 0)) - ;; Find all EXDATE lines + ;; Find all EXDATE lines. One line may carry several comma-separated + ;; datetimes (RFC 5545); split them so each is excluded individually. + ;; Capture the match end BEFORE split-string: its internal matching + ;; clobbers the match data, and reading (match-end 0) afterwards made + ;; pos jump backwards to a comma offset inside the value -- re-matching + ;; the same line forever and growing the list until the OOM killer + ;; intervened (took two agent sessions down on 2026-07-13). (while (string-match "^EXDATE[^:\n]*:\\([^\n]+\\)" event-str pos) - (push (match-string 1 event-str) exdates) - (setq pos (match-end 0))) + (let ((line-end (match-end 0))) + (dolist (val (split-string (match-string 1 event-str) "," t)) + (push val exdates)) + (setq pos line-end))) (nreverse exdates)))) (defun calendar-sync--get-exdate-line (event-str exdate-value) "Find the full EXDATE line containing EXDATE-VALUE from EVENT-STR. Returns the complete line like -`EXDATE;TZID=America/New_York:20260210T130000'. -Returns nil if not found." +`EXDATE;TZID=America/New_York:20260210T130000'. Matches the value anywhere +in the value list, so a comma-separated line's shared TZID reaches every +value on it. Returns nil if not found." (when (and event-str (stringp event-str) exdate-value) - (let ((pattern (format "^\\(EXDATE[^:]*:%s\\)" (regexp-quote exdate-value)))) + (let ((pattern (format "^EXDATE[^:\n]*:[^\n]*%s" (regexp-quote exdate-value)))) (when (string-match pattern event-str) - (match-string 1 event-str))))) + (match-string 0 event-str))))) (defalias 'calendar-sync--parse-exdate #'calendar-sync--parse-ics-datetime "Parse EXDATE value. See `calendar-sync--parse-ics-datetime'.") @@ -282,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) @@ -293,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 @@ -313,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)) @@ -355,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) @@ -363,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)) @@ -378,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-source.el b/modules/calendar-sync-source.el index 15c91c59..10dea66e 100644 --- a/modules/calendar-sync-source.el +++ b/modules/calendar-sync-source.el @@ -138,39 +138,25 @@ Checks `cj/debug-modules' for symbol `calendar-sync' or t (all)." ;;; .ics Fetch -(defun calendar-sync--fetch-ics (url callback) - "Fetch .ics file from URL asynchronously using curl. -Calls CALLBACK with the .ics content as string (normalized to Unix line endings) -or nil on error. CALLBACK signature: (lambda (content) ...). - -The fetch happens asynchronously and doesn't block Emacs. The callback is -invoked when the fetch completes, either successfully or with an error." - (condition-case err - (let ((buffer (generate-new-buffer " *calendar-sync-curl*"))) - (make-process - :name "calendar-sync-curl" - :buffer buffer - :command (list "curl" "-s" "-L" "--fail" - "--connect-timeout" "10" - "--max-time" (number-to-string calendar-sync-fetch-timeout) - url) - :sentinel - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (let ((buf (process-buffer process))) - (when (buffer-live-p buf) - (let ((content - (with-current-buffer buf - (if (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)) - (calendar-sync--normalize-line-endings (buffer-string)) - (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" (string-trim event)) - nil)))) - (kill-buffer buf) - (funcall callback content)))))))) - (error - (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) - (funcall callback nil)))) +(defun calendar-sync--fetch-sentinel-finish (success event temp-file buffer callback) + "Finish an async .ics fetch. +SUCCESS is non-nil when curl exited cleanly, EVENT the process event +string, TEMP-FILE the curl output path, BUFFER the process buffer, and +CALLBACK the continuation. On success CALLBACK receives TEMP-FILE (the +caller owns deleting it); on failure the error is logged, TEMP-FILE is +removed, and CALLBACK receives nil. Extracted from the sentinel so the +success, failure, and cleanup branches are unit-testable without a live +curl process." + (when (buffer-live-p buffer) + (unless success + (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" + (string-trim event))) + (kill-buffer buffer)) + (if success + (funcall callback temp-file) + (when (file-exists-p temp-file) + (delete-file temp-file)) + (funcall callback nil))) (defun calendar-sync--fetch-ics-file (url callback) "Fetch .ics from URL to a temp file asynchronously. @@ -190,19 +176,10 @@ owns deleting the temp file after a successful callback." :sentinel (lambda (process event) (when (memq (process-status process) '(exit signal)) - (let ((buf (process-buffer process)) - (success (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)))) - (when (buffer-live-p buf) - (unless success - (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" - (string-trim event))) - (kill-buffer buf)) - (if success - (funcall callback temp-file) - (when (file-exists-p temp-file) - (delete-file temp-file)) - (funcall callback nil))))))) + (calendar-sync--fetch-sentinel-finish + (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0)) + event temp-file (process-buffer process) callback))))) (error (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) (funcall callback nil)))) diff --git a/modules/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/config-utilities.el b/modules/config-utilities.el index 72427ef9..4332f407 100644 --- a/modules/config-utilities.el +++ b/modules/config-utilities.el @@ -131,12 +131,18 @@ Signals `user-error' if METHOD-SYMBOL is nil or not fboundp." ;;; ----------------------------- Config Compilation ---------------------------- +(defun cj/--native-comp-p () + "Return non-nil when native compilation is available on this build. +Detected with `native-comp-available-p', not `boundp' of the async function: +`native-compile-async' is a function, so `boundp' is always nil." + (and (fboundp 'native-comp-available-p) (native-comp-available-p))) + (defun cj/--recompile-emacs-home (dir &optional native-p) "Delete all .elc/.eln files under DIR, then recompile. NATIVE-P chooses native compilation when non-nil, byte otherwise. -Also removes the eln (native) or elc (byte) cache directory. +Also removes the eln-cache (native) or elc (byte) cache directory. Returns the compilation method used: \\='native or \\='byte." - (let ((elt-dir (expand-file-name (if native-p "eln" "elc") dir))) + (let ((elt-dir (expand-file-name (if native-p "eln-cache" "elc") dir))) (message "Deleting all compiled files in %s" dir) (dolist (file (directory-files-recursively dir "\\(\\.elc\\|\\.eln\\)$")) (delete-file file)) @@ -157,7 +163,7 @@ Returns the compilation method used: \\='native or \\='byte." "Delete all compiled files in the Emacs home before recompiling. Recompile natively when supported, otherwise fall back to byte compilation." (interactive) - (let* ((native (boundp 'native-compile-async)) + (let* ((native (cj/--native-comp-p)) (mode-word (if native "native" "byte"))) (if (yes-or-no-p (format "Please confirm recursive %s recompilation of %s: " diff --git a/modules/coverage-core.el b/modules/coverage-core.el index e8f7a474..c320651d 100644 --- a/modules/coverage-core.el +++ b/modules/coverage-core.el @@ -220,7 +220,7 @@ empty hash table. Malformed hunk headers are skipped silently." "Return the merge-base between HEAD and BASE." (let ((merge-base (string-trim (cj/git-output-or-error "merge-base" "HEAD" base)))) - (unless (not (string-empty-p merge-base)) + (when (string-empty-p merge-base) (user-error "git merge-base HEAD %s returned no commit" base)) merge-base)) diff --git a/modules/custom-buffer-file.el b/modules/custom-buffer-file.el index 25555b53..0ca06cf9 100644 --- a/modules/custom-buffer-file.el +++ b/modules/custom-buffer-file.el @@ -51,8 +51,13 @@ (declare-function ps-print-buffer-with-faces "ps-print") (declare-function ps-print-region-with-faces "ps-print") -;; mm-decode for email viewing (mm-handle-type is a macro, needs early require) -(require 'mm-decode) +;; mm-handle-type is a macro used in `cj/--email-handle-is-type-p', so mm-decode +;; is only needed at compile time here; `cj/view-email-in-buffer' requires it at +;; runtime before any mm-* call, so the eager startup require is unnecessary. +(eval-when-compile (require 'mm-decode)) +(declare-function mm-dissect-buffer "mm-decode") +(declare-function mm-insert-part "mm-decode") +(declare-function mm-destroy-parts "mm-decode") (require 'external-open) ;; for cj/xdg-open, cj/open-this-file-with (require 'system-lib) ;; cj/confirm-strong (overwrite confirms), used below @@ -236,13 +241,16 @@ blast-radius operation on this map. The VC path is not double-prompted: (cj/--delete-buffer-and-file)))))) (defun cj/copy-link-to-buffer-file () - "Copy the full file:// path of the current buffer's source file to the kill ring." + "Copy the full file:// path of the current buffer's source file to the kill ring. +Signal a `user-error' when the buffer is not visiting a file, matching the +other copy commands in this module." (interactive) (let ((file-path (buffer-file-name))) - (when file-path - (setq file-path (concat "file://" file-path)) - (kill-new file-path) - (message "Copied file link to kill ring: %s" file-path)))) + (unless file-path + (user-error "Buffer is not visiting a file")) + (setq file-path (concat "file://" file-path)) + (kill-new file-path) + (message "Copied file link to kill ring: %s" file-path))) (defvar cj/buffer-source-functions '((eww-mode . (lambda () (eww-current-url))) @@ -941,19 +949,24 @@ Signals an error if: (let* ((handle (mm-dissect-buffer t)) (displayable-part (cj/--email-find-displayable-part handle)) (buffer-name (format "*Email: %s*" (file-name-nondirectory buffer-file-name)))) - (unless displayable-part - (user-error "No displayable content found in email")) - (with-current-buffer (get-buffer-create buffer-name) - (let ((inhibit-read-only t)) - (erase-buffer) - (mm-insert-part displayable-part) - (goto-char (point-min)) - (when (cj/--email-handle-is-type-p displayable-part "text/html") - (shr-render-region (point-min) (point-max))) - (goto-char (point-min)) - (special-mode))) - (mm-destroy-parts handle) - (switch-to-buffer buffer-name))) + ;; `mm-dissect-buffer' allocates handles that must be freed even when we + ;; bail out early (no displayable part), so destroy them from the cleanup + ;; form rather than after the body. + (unwind-protect + (progn + (unless displayable-part + (user-error "No displayable content found in email")) + (with-current-buffer (get-buffer-create buffer-name) + (let ((inhibit-read-only t)) + (erase-buffer) + (mm-insert-part displayable-part) + (goto-char (point-min)) + (when (cj/--email-handle-is-type-p displayable-part "text/html") + (shr-render-region (point-min) (point-max))) + (goto-char (point-min)) + (special-mode))) + (switch-to-buffer buffer-name)) + (mm-destroy-parts handle)))) ;; --------------------------- Buffer And File Keymap -------------------------- diff --git a/modules/custom-case.el b/modules/custom-case.el index 87622695..c203cd9e 100644 --- a/modules/custom-case.el +++ b/modules/custom-case.el @@ -49,49 +49,92 @@ (downcase-region (car bounds) (cdr bounds)) (user-error "No symbol at point"))))) -(defun cj/--title-case-capitalize-word-p (word is-first prev-word-end word-skip chars-skip-reset) +(defun cj/--title-case-capitalize-word-p (word is-first is-last prev-word-end word-skip chars-skip-reset) "Return non-nil when WORD at point should be capitalized in title case. Point is at WORD's first character. WORD is capitalized when it is the first -word (IS-FIRST), is not a minor skip word (in WORD-SKIP), or immediately follows -a skip-reset character (one of CHARS-SKIP-RESET: : ! ?), reached by skipping -blanks back to PREV-WORD-END." +word (IS-FIRST) or the last word (IS-LAST), is not a minor skip word (in +WORD-SKIP), or immediately follows a skip-reset character (one of +CHARS-SKIP-RESET: : ! ? .), reached by skipping blanks back to PREV-WORD-END." (or is-first + is-last (not (member word word-skip)) (save-excursion (and (not (zerop (skip-chars-backward "[:blank:]" prev-word-end))) (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, and most minor words are lowercase. Nouns, verbs (including linking verbs), adjectives, adverbs,pronouns, and all words of four letters or more are considered major words. Short (i.e., three letters or fewer) conjunctions, -short prepositions, and all articles are considered minor words." +short prepositions, and all articles are considered minor words. The first +and last words are always capitalized, and a word following a sentence-ending +period (or a colon, exclamation mark, or question mark) restarts +capitalization even when it is a minor word." (interactive) - (let ((beg nil) - (end nil) - (prev-word-end nil) - ;; Allow capitals for skip characters after this, so: - ;; Warning: An Example - ;; Capitalizes the `An'. - (chars-skip-reset '(?: ?! ??)) - ;; Don't capitalize characters directly after these. e.g. - ;; "Foo-bar" or "Foo\bar" or "Foo's". - (chars-separator '(?\\ ?- ?' ?.)) - (word-chars "[:alnum:]") - (word-skip - (list "a" "an" "and" "as" "at" "but" "by" - "for" "if" "in" "is" "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)))) + (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) @@ -105,16 +148,8 @@ short prepositions, and all articles are considered minor words." (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 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 a2604a55..2e77af5a 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -35,19 +35,19 @@ ;; ------------------------------ Comment Reformat ----------------------------- (defun cj/comment-reformat () - "Reformat commented text into a single paragraph." + "Reformat the commented text in the active region into a single paragraph. +Signal a `user-error' when no region is active." (interactive) - (if mark-active - (let ((beg (region-beginning)) - (end (copy-marker (region-end))) - (orig-fill-column fill-column)) - (uncomment-region beg end) - (setq fill-column (- fill-column 3)) - (cj/join-line-or-region) - (comment-region beg end) - (setq fill-column orig-fill-column ))) - ;; if no region - (message "No region was selected. Select the comment lines to reformat.")) + (unless (use-region-p) + (user-error "No region selected: select the comment lines to reformat")) + (let ((beg (region-beginning)) + (end (copy-marker (region-end))) + ;; Dynamically narrow the fill target for the join, then let it + ;; restore itself -- an error mid-join no longer strands fill-column. + (fill-column (- fill-column 3))) + (uncomment-region beg end) + (cj/join-line-or-region) + (comment-region beg end))) ;; ======================== Comment Generation Functions ======================= @@ -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) @@ -95,6 +107,14 @@ LENGTH is the total width of the line." text-length (if (> text-length 0) 2 0)) ; spaces around text 2)) + ;; The right side fills the exact remaining width so the line always + ;; reaches LENGTH. Keying this off text-length parity (as before) left + ;; even-length and empty text two columns short, misaligning stacked + ;; dividers of differing text lengths. + (right-space (- available-width + text-length + (if (> text-length 0) 2 0) + space-on-each-side)) (min-space 2)) ;; Validate we have enough space (when (< space-on-each-side min-space) @@ -108,10 +128,8 @@ LENGTH is the total width of the line." ;; Text with spaces (when (> text-length 0) (insert " " text " ")) - ;; Right decoration (handle odd-length text) - (dotimes (_ (if (= (% text-length 2) 0) - (- space-on-each-side 1) - space-on-each-side)) + ;; Right decoration -- fills the exact remaining width so the line reaches LENGTH. + (dotimes (_ right-space) (insert decoration-char)) ;; Comment end (when (not (string-empty-p cmt-end)) @@ -123,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))) @@ -151,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: " @@ -194,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 @@ -226,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"))) @@ -327,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))) @@ -355,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: " @@ -438,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-datetime.el b/modules/custom-datetime.el index 0528688c..52e8c2b3 100644 --- a/modules/custom-datetime.el +++ b/modules/custom-datetime.el @@ -51,7 +51,7 @@ See `format-time-string' for possible replacements.") ;; ------------------------------- Sortable Time ------------------------------- -(defvar sortable-time-format "%I:%M:%S %p %Z " +(defvar sortable-time-format "%H:%M:%S %Z " "Format string used by `cj/insert-sortable-time'. See `format-time-string' for possible replacements.") diff --git a/modules/custom-line-paragraph.el b/modules/custom-line-paragraph.el index d29d4125..5d96fe41 100644 --- a/modules/custom-line-paragraph.el +++ b/modules/custom-line-paragraph.el @@ -46,7 +46,10 @@ (when (> (line-number-at-pos) 1) (join-line)) (end-of-line) - (newline))) + ;; Only add a newline at end of buffer. Doing it unconditionally left a + ;; stray blank line when joining a line in the middle of the buffer. + (when (eobp) + (newline)))) (defun cj/join-paragraph () "Join all lines in the current paragraph using `cj/join-line-or-region'." @@ -67,18 +70,27 @@ produce malformed output silently." (> (length comment-start) 0)))) (user-error "Cannot comment in %s: no comment syntax defined" major-mode)) - (let* ((b (if (region-active-p) (region-beginning) (line-beginning-position))) - (e (if (region-active-p) (region-end) (line-end-position))) - (lines (split-string (buffer-substring-no-properties b e) "\n"))) + ;; Normalize the bounds to whole lines: extend to the start of the first + ;; line and the end of the last line the region touches. The old open-line + ;; loop mishandled a region ending mid-line or at beginning-of-line, either + ;; splitting a line or duplicating a stray empty line. + (let* ((rb (if (region-active-p) (region-beginning) (point))) + (re (if (region-active-p) (region-end) (point))) + (beg (save-excursion (goto-char rb) (line-beginning-position))) + (end (save-excursion + (goto-char re) + ;; A region ending exactly at beginning-of-line does not + ;; include that line, so step back to the previous line's end. + (when (and (> re rb) (bolp)) + (backward-char)) + (line-end-position))) + (text (buffer-substring-no-properties beg end))) (save-excursion - (goto-char e) - (dolist (line lines) - (open-line 1) - (forward-line 1) - (insert line) - ;; If the COMMENT prefix argument is non-nil, comment the inserted text - (when comment - (comment-region (line-beginning-position) (line-end-position))))))) + (goto-char end) + (insert "\n" text) + ;; Comment the freshly-inserted copy when the COMMENT prefix arg is set. + (when comment + (comment-region (1+ end) (point)))))) (defun cj/remove-duplicate-lines-region-or-buffer () "Remove duplicate lines in the region or buffer, keeping the first occurrence. @@ -175,9 +187,9 @@ If not on a delimiter, show a message. Respects the current syntax table." (cb (char-before)) ;; Check if on opening paren (open-p (and ca (eq (char-syntax ca) ?\())) - ;; Check if on or just after closing paren - (close-p (or (and ca (eq (char-syntax ca) ?\))) - (and cb (eq (char-syntax cb) ?\)))))) + ;; On a closing paren (point sits on it) vs just after one. + (on-close-p (and ca (eq (char-syntax ca) ?\)))) + (after-close-p (and cb (eq (char-syntax cb) ?\))))) (cond ;; Jump forward from opening (open-p @@ -185,12 +197,19 @@ If not on a delimiter, show a message. Respects the current syntax table." (forward-sexp) (scan-error (message "No matching delimiter: %s" (error-message-string err))))) - ;; Jump backward from closing - (close-p - (condition-case err - (backward-sexp) - (scan-error - (message "No matching delimiter: %s" (error-message-string err))))) + ;; Jump backward from closing to its matching opener. When point is ON + ;; the closer, step past it first so `backward-sexp' spans the whole + ;; expression to the opener rather than the last inner sexp. Restore + ;; point if the delimiter is unmatched. + ((or on-close-p after-close-p) + (let ((start (point))) + (condition-case err + (progn + (when on-close-p (forward-char)) + (backward-sexp)) + (scan-error + (goto-char start) + (message "No matching delimiter: %s" (error-message-string err)))))) ;; Not on delimiter (t (message "Point is not on a delimiter."))))) diff --git a/modules/custom-ordering.el b/modules/custom-ordering.el index 4dc5bff8..71477948 100644 --- a/modules/custom-ordering.el +++ b/modules/custom-ordering.el @@ -145,8 +145,15 @@ START and END identify the active region." START and END define the region to operate on. Returns the transformed string without modifying the buffer." (cj/--ordering-validate-region start end) - (let ((lines (split-string (buffer-substring start end) "\n"))) - (mapconcat #'identity (nreverse lines) "\n"))) + ;; Strip a trailing newline before splitting so it doesn't become a spurious + ;; empty line (which reversing would float to the top); reattach it after. + ;; Internal blank lines are preserved. + (let* ((raw (buffer-substring start end)) + (trailing-newline (string-suffix-p "\n" raw)) + (body (if trailing-newline (substring raw 0 -1) raw)) + (lines (split-string body "\n"))) + (concat (mapconcat #'identity (nreverse lines) "\n") + (if trailing-newline "\n" "")))) (defun cj/reverse-lines (start end) "Reverse the order of lines in region between START and END. @@ -164,20 +171,28 @@ ZERO-PAD when non-nil pads numbers with zeros for alignment. Example with 100 lines: \"001\", \"002\", ..., \"100\". Returns the transformed string without modifying the buffer." (cj/--ordering-validate-region start end) - (let* ((lines (split-string (buffer-substring start end) "\n")) + ;; Strip a trailing newline before splitting so it doesn't become a spurious + ;; extra numbered empty line; reattach it after. Internal blank lines are + ;; preserved and numbered. + (let* ((raw (buffer-substring start end)) + (trailing-newline (string-suffix-p "\n" raw)) + (body (if trailing-newline (substring raw 0 -1) raw)) + (lines (split-string body "\n")) (line-count (length lines)) (width (if zero-pad (length (number-to-string line-count)) 1)) (format-spec (if zero-pad (format "%%0%dd" width) "%d"))) - (mapconcat - (lambda (pair) - (let* ((num (car pair)) - (line (cdr pair)) - (num-str (format format-spec num))) - (concat (replace-regexp-in-string "N" num-str format-string) line))) - (cl-loop for line in lines - for i from 1 - collect (cons i line)) - "\n"))) + (concat + (mapconcat + (lambda (pair) + (let* ((num (car pair)) + (line (cdr pair)) + (num-str (format format-spec num))) + (concat (replace-regexp-in-string "N" num-str format-string) line))) + (cl-loop for line in lines + for i from 1 + collect (cons i line)) + "\n") + (if trailing-newline "\n" "")))) (defun cj/number-lines (start end format-string zero-pad) "Number lines in region between START and END with custom format. diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 4d72347d..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. @@ -180,17 +183,16 @@ Returns the indented text without modifying the buffer." (defun cj/indent-lines-in-region-or-buffer (count use-tabs) "Indent each line in region or buffer by COUNT characters. -COUNT is the number of characters to indent (default 4). -USE-TABS when non-nil (prefix argument) uses tabs instead of spaces." - (interactive "p\nP") - (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))) +COUNT is the numeric prefix argument, defaulting to 4 with no prefix. +USE-TABS non-nil indents with tabs instead of spaces; interactively it +follows the buffer's `indent-tabs-mode', so the prefix argument is free to +mean the count. Call it from Lisp with an explicit USE-TABS to override." + (interactive (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 4) + indent-tabs-mode)) + (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. @@ -224,17 +226,13 @@ Returns the dedented text without modifying the buffer." (defun cj/dedent-lines-in-region-or-buffer (count) "Remove up to COUNT leading whitespace characters from each line. -COUNT is the number of characters to remove (default 4). +COUNT is the numeric prefix argument, defaulting to 4 with no prefix. Works on region if active, otherwise entire buffer." - (interactive "p") - (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))) + (interactive (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 4))) + (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 53f19b72..c7ff39dc 100644 --- a/modules/dashboard-config.el +++ b/modules/dashboard-config.el @@ -68,12 +68,12 @@ (declare-function cj/erc-switch-to-buffer-with-completion "erc-config") (declare-function cj/telega "telega-config") (declare-function cj/slack-start "slack-config") -(declare-function cj/signel-message "signal-config") (declare-function cj/kill-all-other-buffers-and-windows "undead-buffers") ;; External package commands invoked by launchers. (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 @@ -85,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. @@ -149,15 +158,15 @@ Adjust this if the title doesn't appear centered under the banner image.") (list "i" #'nerd-icons-faicon "nf-fa-comments" "IRC" "Emacs Relay Chat" (lambda () (cj/erc-switch-to-buffer-with-completion))) (list "G" #'nerd-icons-faicon "nf-fa-telegram" "Telegram" "Telega Telegram Client" (lambda () (cj/telega))) (list "s" #'nerd-icons-faicon "nf-fa-slack" "Slack" "Slack Client" (lambda () (cj/slack-start))) - (list "l" #'nerd-icons-octicon "nf-oct-issue_tracks" "Linear" "Linear Issue Tracker" (lambda () (pearl-list-issues))) - (list "S" #'nerd-icons-mdicon "nf-md-message" "Signal" "Signal Messenger" (lambda () (cj/signel-message)))) + (list "l" #'nerd-icons-octicon "nf-oct-issue_tracks" "Linear" "Linear Issue Tracker" (lambda () (pearl-list-issues)))) "Dashboard launcher table: (KEY ICON-FN ICON-NAME LABEL TOOLTIP ACTION). Drives both `dashboard-navigator-buttons' and the dashboard-mode-map keys.") -(defconst cj/dashboard--row-sizes '(5 4 3 3) +(defconst cj/dashboard--row-sizes '(5 4 3 2) "Navigator row lengths. Must sum to the number of `cj/dashboard--launchers'. -The top row carries Weather alongside the core tools; the last row groups -Slack, Linear, and Signal together.") +The top row carries Weather alongside the core tools; the last row pairs +Slack and Linear. (Signal left the table when the signel client was +retired to archive/ -- agents drive Signal via signal-cli.)") (defun cj/dashboard--navigator-button (l) "Build a `dashboard-navigator-buttons' entry from launcher L." diff --git a/modules/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 713a5e69..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)") @@ -685,6 +687,51 @@ no popup frame is live." ("v" . dirvish-vc-menu) ("y" . dirvish-yank-menu))) +;;; --------------------- Dirvish Thumbnail Cache Width Bucket ------------------ +;; dirvish keys its media thumbnail cache path on the exact preview-window pixel +;; width (thumbnails/<width>/<md5>.jpg). Fast image thumbnails finish before the +;; window settles, so their width is stable across a landing. Slow video (webm +;; VP9 decode + seek) loses that race: the jpg is written at the generation-time +;; width, then `dirvish-media--cache-sentinel' recomputes the width for redisplay, +;; and if the preview window jittered even one pixel across a `floor' boundary the +;; lookup hits a different bucket, misses, regenerates, and flashes blank. +;; Quantizing the computed size to a coarse bucket maps that jitter to one stable +;; key. A local workaround for the upstream cache design. + +(defgroup cj/dirvish nil + "Local dirvish tweaks on top of the upstream package." + :group 'dirvish) + +(defcustom cj/dirvish-thumb-width-bucket 100 + "Pixel bucket dirvish's thumbnail cache width is quantized to. +Rounding `dirvish-media--img-size' to this bucket keeps small preview-window +jitter on one cache key, so a slow video thumbnail isn't looked up under a +different width than it was written at. A larger bucket tolerates more jitter at +a slight thumbnail-resolution cost. Set to 0 or nil to disable quantization." + :type '(choice (const :tag "Off" nil) integer) + :group 'cj/dirvish) + +(defun cj/--dirvish-quantize-thumb-size (size bucket) + "Round SIZE to the nearest multiple of BUCKET, clamped to at least BUCKET. +BUCKET nil or non-positive returns SIZE unchanged (quantization off). Pure +helper behind the `dirvish-media--img-size' advice." + (if (and (integerp bucket) (> bucket 0)) + (max bucket (* bucket (round size bucket))) + size)) + +(defun cj/--dirvish-thumb-size-advice (size) + "Quantize dirvish's computed thumbnail SIZE to a stable cache bucket. +`:filter-return' advice on `dirvish-media--img-size'; the bucket is +`cj/dirvish-thumb-width-bucket'." + (cj/--dirvish-quantize-thumb-size size cj/dirvish-thumb-width-bucket)) + +;; dirvish-media--img-size lives in dirvish-widgets.el (loaded lazily on the +;; first media preview), so advise it only once that file is present. advice-add +;; with a named function is idempotent, so a module reload never stacks copies. +(with-eval-after-load 'dirvish-widgets + (advice-add 'dirvish-media--img-size :filter-return + #'cj/--dirvish-thumb-size-advice)) + ;;; ----------------------------- Dired Text Greying ---------------------------- ;; `default' is remapped buffer-locally to `shadow' inside dired/dirvish (see diff --git a/modules/duet-config.el b/modules/duet-config.el deleted file mode 100644 index 2dc7ad2e..00000000 --- a/modules/duet-config.el +++ /dev/null @@ -1,19 +0,0 @@ -;;; duet-config.el --- DUET dual-pane commander configuration -*- lexical-binding: t -*- - -;;; Commentary: -;; Personal configuration glue for the DUET package, developed locally at -;; ~/code/duet. Keybindings, defcustom values, and connection storage live -;; here; the package itself stays free of personal opinions. -;; -;; Not yet required from init.el — DUET is a pre-alpha skeleton. Wire it in -;; once Stage 1 provides usable commands. - -;;; Code: - -(use-package duet - :load-path "~/code/duet" - :ensure nil - :commands (duet)) - -(provide 'duet-config) -;;; duet-config.el ends here 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/eat-config.el b/modules/eat-config.el index e5b8f0c5..01d0fbe6 100644 --- a/modules/eat-config.el +++ b/modules/eat-config.el @@ -110,6 +110,102 @@ not recognize (which would later trip (cl-assert charset) on write)." (with-eval-after-load 'eat (advice-add 'eat--t-set-charset :filter-args #'cj/--eat-charset-never-nil)) +;; EAT 0.9.4 XTWINOPS gap. tmux 3.7b has native Sixel but refuses to emit it +;; until it learns the client's cell pixel size, which it asks for with the +;; XTWINOPS window-size requests CSI 14 t (text area in pixels), CSI 16 t (cell +;; size in pixels) and CSI 18 t (text area in characters). EAT's parser +;; (eat--t-handle-output) has no `t' case, so it silently drops these -- tmux +;; never learns the geometry and images never render. We can't add the parser +;; clause without forking the vendored 541-line pcase (see the charset note +;; above), so answer the query from a `:before' advice instead: eat--t-handle-output +;; is called inside (eat--t-with-env terminal ...), which dynamically binds +;; eat--t-term, so the advice can read the live display + cell dimensions and +;; write the report back through the terminal's own input function. The reply +;; format matches EAT's existing XTSMGRAPHICS reply (same char-width/height and +;; display fields). Verified live on ratio 2026-07-13: images render and +;; persist across window switches, scrolling, and resizing. An upstream-shaped +;; patch (a real parser clause) is kept locally for a PR to akib/emacs-eat. +;; The advice does NOT become a no-op when upstream +;; ships that clause: it runs :before the parser and scans raw output, so +;; queries always survive to it, and two answerers means tmux gets a double +;; reply -- it treats the second as unrequested input and forwards the raw +;; escape bytes into the pane as keystrokes (this killed an agent session on +;; 2026-07-13 when a second patched parser was live in the daemon). The +;; advice-add is therefore guarded: it installs only while EAT itself cannot +;; answer, and stays out the day the upstream clause (which defines +;; eat--t-send-window-size-report) lands. + +(declare-function eat--t-handle-output "eat") +(declare-function eat--t-term-display "eat") +(declare-function eat--t-term-input-fn "eat") +(declare-function eat--t-term-char-width "eat") +(declare-function eat--t-term-char-height "eat") +(declare-function eat--t-disp-width "eat") +(declare-function eat--t-disp-height "eat") +(defvar eat--t-term) + +(defun cj/--eat-xtwinops-report (n cols rows char-width char-height) + "Return the XTWINOPS reply string for window-size request N, or nil. +COLS and ROWS are the display size in characters; CHAR-WIDTH and +CHAR-HEIGHT are the pixel size of one cell. N is 14 (text area in +pixels), 16 (cell size in pixels), or 18 (text area in characters); any +other N returns nil so the request goes unanswered." + (pcase n + (14 (format "\e[4;%d;%dt" (* rows char-height) (* cols char-width))) + (16 (format "\e[6;%d;%dt" char-height char-width)) + (18 (format "\e[8;%d;%dt" rows cols)))) + +(defun cj/--eat-xtwinops-queries (output) + "Return the XTWINOPS request numbers found in terminal OUTPUT, in order. +Matches only the bare CSI 14/16/18 t window-size requests EAT drops -- a +parametrized form (e.g. CSI 3 ; 14 t) or a different CSI t op (e.g. the +CSI 24 t resize) is not one we answer and is left alone. Returns nil +when OUTPUT carries no such request. OUTPUT is one pty chunk, so a +query split across two reads would be missed; in practice tmux writes +the few-byte query atomically, so it arrives whole." + (let ((start 0) (found '())) + (while (string-match "\e\\[\\(14\\|16\\|18\\)t" output start) + (push (string-to-number (match-string 1 output)) found) + (setq start (match-end 0))) + (nreverse found))) + +(defun cj/--eat-send-window-size-report (n) + "Answer XTWINOPS window-size request N on the current EAT terminal. +Runs with `eat--t-term' dynamically bound (inside `eat--t-with-env'), +reads the live display and cell dimensions, and writes the report back +through the terminal's own input function. A request number EAT does +not report on (`cj/--eat-xtwinops-report' returns nil) is ignored." + (let* ((disp (eat--t-term-display eat--t-term)) + (reply (cj/--eat-xtwinops-report + n + (eat--t-disp-width disp) + (eat--t-disp-height disp) + (eat--t-term-char-width eat--t-term) + (eat--t-term-char-height eat--t-term)))) + (when reply + (funcall (eat--t-term-input-fn eat--t-term) eat--t-term reply)))) + +(defun cj/--eat-answer-xtwinops (output) + "`:before' advice for `eat--t-handle-output'. +Answer every XTWINOPS window-size request in OUTPUT that EAT 0.9.4 would +otherwise drop, so tmux learns the cell pixel size it needs before it +will emit Sixel. Runs inside `eat--t-with-env', so `eat--t-term' is +bound for the responder." + (mapc #'cj/--eat-send-window-size-report (cj/--eat-xtwinops-queries output))) + +(defun cj/--eat-xtwinops-advice-needed-p () + "Return non-nil when EAT itself cannot answer XTWINOPS window-size queries. +EAT 0.9.4 has no CSI t parser clause, so the advice must answer them. +An EAT that ships the clause defines `eat--t-send-window-size-report' +(the function the upstream-shaped parser patch adds); with that present +the advice must stay out, or every query gets two replies and tmux +types the second one's raw bytes into the pane." + (not (fboundp 'eat--t-send-window-size-report))) + +(with-eval-after-load 'eat + (when (cj/--eat-xtwinops-advice-needed-p) + (advice-add 'eat--t-handle-output :before #'cj/--eat-answer-xtwinops))) + ;; ------------------------------- eat package --------------------------------- (defun cj/--eat-clear-mode-line-process () diff --git a/modules/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/flycheck-config.el b/modules/flycheck-config.el index 2a5a5e74..ad762b3b 100644 --- a/modules/flycheck-config.el +++ b/modules/flycheck-config.el @@ -44,15 +44,21 @@ :defer t :commands (flycheck-list-errors cj/flycheck-list-errors) - :hook ((sh-mode emacs-lisp-mode) . flycheck-mode) + ;; ledger-mode is here, not in ledger-config.el, so this list stays the one + ;; answer to "where is flycheck turned on?". flycheck-ledger registers a + ;; `ledger' checker but never enables the mode, so before this hook existed an + ;; unbalanced transaction in a ledger file produced no warning at all. + :hook ((sh-mode emacs-lisp-mode ledger-mode) . flycheck-mode) :bind (:map cj/custom-keymap ("?" . cj/flycheck-list-errors)) :custom - ;; Only disable these two Checkdoc warnings; leave all others intact. - (checkdoc-arguments - '(("sentence-end-double-space" nil) - ("warn-escape" nil))) + ;; No checkdoc suppression here: the old `checkdoc-arguments' entry named a + ;; variable that doesn't exist (checkdoc has no such option and this + ;; flycheck runs checkdoc via a fixed subprocess form), so it never + ;; suppressed anything. Removing it changes no behavior; if specific + ;; checkdoc warnings need silencing, that's a new feature against + ;; `flycheck-emacs-lisp-checkdoc-form'. ;; Modeline customization (rendered via mode-line-format in modeline-config.el). ;; The count portion picks up `error' / `warning' faces because ;; `flycheck-mode-line-color' stays t (the default). diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index b73bfdf3..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 @@ -197,9 +199,10 @@ Without prefix argument, it's created in the global abbrev table. Press C-' repeatedly to step through misspellings one at a time." (interactive "P") (cj/--require-spell-checker) - ;; Run flyspell-buffer only if buffer hasn't been checked yet - (unless (bound-and-true-p flyspell-mode) - (flyspell-buffer)) + ;; Enable Flyspell for the buffer type so the mode sticks and the buffer is + ;; scanned once. A bare flyspell-buffer here never turned the mode on, so + ;; the guard never tripped and every C-' press re-scanned the whole buffer. + (cj/flyspell-on-for-buffer-type) (let ((misspelled-word (cj/flyspell-goto-previous-misspelling (point)))) (if (not misspelled-word) diff --git a/modules/font-config.el b/modules/font-config.el index 3aa3d80f..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. @@ -210,6 +261,15 @@ the fontset repeatedly is harmless, so it can be called from ;; ---------------------------------- Emojify ---------------------------------- ;; converts emoji identifiers into emojis; allows for easy emoji entry. +(defvar emojify-display-style) ;; emojify's, forward-declared for the helper + +(defun cj/set-emojify-display-style () + "Set `emojify-display-style' to `image' on a graphical frame, else `unicode'. +Image emoji only render on a GUI frame. In daemon mode no GUI frame exists when +emojify loads, so this runs per-frame from `server-after-make-frame-hook'; +otherwise the value would latch to `unicode' and GUI frames never get images." + (setq emojify-display-style (if (env-gui-p) 'image 'unicode))) + (use-package emojify :defer 1 :hook ((erc-mode . emojify-mode)) @@ -221,7 +281,11 @@ the fontset repeatedly is harmless, so it can be called from :config (setq emojify-show-help nil) (setq emojify-point-entered-behaviour 'uncover) - (setq emojify-display-style (if (env-gui-p) 'image 'unicode)) + ;; In daemon mode `env-gui-p' is nil at :config time (no GUI frame yet), so + ;; recompute the display style per-frame; otherwise set it now. + (if (daemonp) + (add-hook 'server-after-make-frame-hook #'cj/set-emojify-display-style) + (cj/set-emojify-display-style)) (setq emojify-emoji-styles '(ascii unicode github)) ;; Disable emojify in programming modes @@ -242,21 +306,24 @@ the fontset repeatedly is harmless, so it can be called from (let ((font-list (font-family-list))) (setq font-list (cl-remove-duplicates (cl-sort font-list 'string-lessp :key 'downcase))) (with-current-buffer "*Available Fonts*" - (erase-buffer) - (dolist (font-family font-list) - (insert (propertize (concat font-family) 'face '(font-lock-keyword-face (:weight bold)))) - (insert (concat "\n"(propertize "Regular: "))) - (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") - 'face `((:family, font-family)))) - (insert (concat "\n" (propertize "Bold: "))) - (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") - 'face `((:family, font-family :weight bold)))) - (insert (concat "\n" (propertize "Italic: "))) - (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") - 'face `((:family, font-family :slant italic)))) - (insert (concat "\n\n")))) - (move-to-window-line 0) - (special-mode))) + ;; The buffer is left in `special-mode' (read-only) after the first call, + ;; so re-running must relax read-only to erase and rewrite it. + (let ((inhibit-read-only t)) + (erase-buffer) + (dolist (font-family font-list) + (insert (propertize (concat font-family) 'face '(font-lock-keyword-face (:weight bold)))) + (insert (concat "\n"(propertize "Regular: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family)))) + (insert (concat "\n" (propertize "Bold: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family :weight bold)))) + (insert (concat "\n" (propertize "Italic: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family :slant italic)))) + (insert (concat "\n\n")))) + (move-to-window-line 0) + (special-mode)))) (keymap-global-set "C-z F" #'cj/display-available-fonts) diff --git a/modules/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/keybindings.el b/modules/keybindings.el index 3e51b2dd..5d0262ed 100644 --- a/modules/keybindings.el +++ b/modules/keybindings.el @@ -153,8 +153,6 @@ Errors if VAR is unbound, not a non-empty string, or the file does not exist." ;; is armed everywhere. cj/modeline-reset repairs a hijacked buffer. (keymap-global-unset "<f2>") ;; 2C-command prefix (keymap-global-unset "C-x 6") ;; 2C-command prefix (same map) -(keymap-global-unset "C-x C-f") ;; find-file-read-only -(keymap-global-set "C-x C-f" #'find-file) (keymap-global-set "C-z" (make-sparse-keymap)) ;; replace suspend-frame with prefix map (keymap-global-unset "M-o") ;; facemenu-mode diff --git a/modules/keyboard-compat.el b/modules/keyboard-compat.el index 9395b9c8..73138ca5 100644 --- a/modules/keyboard-compat.el +++ b/modules/keyboard-compat.el @@ -45,8 +45,11 @@ This runs after init to override any package settings." (define-key input-decode-map "\eOC" [right]) (define-key input-decode-map "\eOD" [left]))) -;; Run after init completes to override any package settings -(add-hook 'emacs-startup-hook #'cj/keyboard-compat-terminal-setup) +;; `input-decode-map' is terminal-local, and a daemon's `emacs-startup-hook' +;; runs once with no tty, so a startup-hook registration never reaches the +;; `emacsclient -t' frames that need it. `tty-setup-hook' runs for each new +;; tty frame (daemon and non-daemon alike), which is where the decodings belong. +(add-hook 'tty-setup-hook #'cj/keyboard-compat-terminal-setup) ;; Icon-rendering functions return blank on terminal frames so unicode ;; artifacts don't show up. The check runs per call against the selected @@ -95,8 +98,7 @@ Meta+Shift+letter triggers M-S-letter keybindings." (define-key key-translation-map (kbd "M-D") (kbd "M-S-d")) (define-key key-translation-map (kbd "M-I") (kbd "M-S-i")) (define-key key-translation-map (kbd "M-C") (kbd "M-S-c")) - (define-key key-translation-map (kbd "M-B") (kbd "M-S-b")) - (define-key key-translation-map (kbd "M-K") (kbd "M-S-k")))) + (define-key key-translation-map (kbd "M-B") (kbd "M-S-b")))) ;; In daemon mode, no frame exists at startup so env-gui-p returns nil. ;; Use server-after-make-frame-hook to set up translations when the first diff --git a/modules/keyboard-macros.el b/modules/keyboard-macros.el index 4e801096..bca36eed 100644 --- a/modules/keyboard-macros.el +++ b/modules/keyboard-macros.el @@ -43,7 +43,7 @@ ;;; Code: (require 'subr-x) ;; for string-trim -(eval-when-compile (require 'user-constants)) +(require 'user-constants) ;; for macros-file, read at runtime (defvar cj/macros-loaded nil "Whether saved keyboard macros have been loaded from file.") @@ -130,15 +130,7 @@ With prefix arg, open the macros file for editing after saving." (keymap-global-set "C-<f3>" #'cj/kbd-macro-start-or-end) (keymap-global-set "<f3>" #'call-last-kbd-macro) (keymap-global-set "M-<f3>" #'cj/save-maybe-edit-macro) - (keymap-global-set "s-<f3>" #'cj/open-macros-file) - (add-hook 'kill-emacs-hook #'cj/save-last-kbd-macro-on-exit)) - -;; Add hook to save any unnamed macros on exit if desired -(defun cj/save-last-kbd-macro-on-exit () - "Save the last keyboard macro before exiting Emacs if it's not saved." - (when last-kbd-macro - (when (y-or-n-p "Save last keyboard macro before exiting? ") - (call-interactively #'cj/save-maybe-edit-macro)))) + (keymap-global-set "s-<f3>" #'cj/open-macros-file)) ;; Auto-call setup after init (if after-init-time diff --git a/modules/local-repository.el b/modules/local-repository.el index e3c7a227..0f2c981c 100644 --- a/modules/local-repository.el +++ b/modules/local-repository.el @@ -6,72 +6,28 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P. ;; Load shape: eager. -;; Eager reason: none; local package mirror commands can autoload. +;; Eager reason: none; the mirror-refresh command can autoload. ;; Top-level side effects: none. ;; Runtime requires: elpa-mirror when updating the mirror. ;; Direct test load: yes. ;; -;; Adds the checked-in local package archive to package-archives with high -;; priority, and provides a command to refresh that archive from installed -;; packages via elpa-mirror. +;; Provides a command to refresh the checked-in local package archive from the +;; installed packages via elpa-mirror. Adding that archive to package-archives +;; is owned by early-init.el (see `localrepo-location'); this module only +;; refreshes it. ;;; Code: (require 'elpa-mirror nil t) ;; optional; cj/update-localrepo-repository fails at call-time if absent (declare-function elpamr-create-mirror-for-installed "elpa-mirror") - -;; ------------------------------ Utility Function ----------------------------- - - -(defun localrepo--car-member (value list) - "Check if VALUE exists as the car of any cons cell in LIST." - (member value (mapcar #'car list))) - -;; ------------------------------- Customizations ------------------------------ - -(defgroup localrepo nil - "Local last-known-good package repository." - :group 'package) - -(defcustom localrepo-repository-id "localrepo" - "The name used to identify the local repository internally. - -Used for the package-archive and package-archive-priorities lists." - :type 'string - :group 'localrepo) - -(defcustom localrepo-repository-priority 100 - "The value for the local repository in the package-archive-priority list. - -A higher value means higher priority. If you want your local packages to be -preferred, this must be a higher number than any other repositories." - :type 'integer - :group 'localrepo) - -(defcustom localrepo-repository-location - (concat user-emacs-directory "/.localrepo") - "The location of the local repository. - -It's a good idea to keep this with the rest of your configuration files and -keep them in source control." - :type 'directory - :group 'localrepo) +(defvar localrepo-location) ;; defconst in early-init.el: the archive path (defun cj/update-localrepo-repository () - "Update the local repository with currently installed packages." + "Update the local repository with currently installed packages. +Targets `localrepo-location', the archive path early-init.el sets up." (interactive) - (elpamr-create-mirror-for-installed localrepo-repository-location t)) - -(defun localrepo-initialize () -"Add the repository to the package archives, then gives it a high priority." - (unless (localrepo--car-member localrepo-repository-id package-archives) - (add-to-list 'package-archives - (cons localrepo-repository-id localrepo-repository-location))) - - (unless (localrepo--car-member localrepo-repository-id package-archive-priorities) - (add-to-list 'package-archive-priorities - (cons localrepo-repository-id localrepo-repository-priority)))) + (elpamr-create-mirror-for-installed localrepo-location t)) (provide 'local-repository) ;;; local-repository.el ends here. diff --git a/modules/lorem-optimum.el b/modules/lorem-optimum.el index 8aa96345..14f1d666 100644 --- a/modules/lorem-optimum.el +++ b/modules/lorem-optimum.el @@ -219,8 +219,22 @@ Builds and caches the keys list lazily if not already cached." (message "Lorem-optimum learned from file: %s" file)) (defun cj/lipsum (n) - "Return N words of lorem ipsum." - (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum"))) + "Return N words of lorem ipsum. +Interactively, prompt for N and echo the generated words. + +Signal a `user-error' when the Markov chain is empty (for example when the +training file `cj/lipsum-default-file' is missing). Without this, callers +such as `cj/lipsum-insert' would insert nil and raise a cryptic wrong-type +error far from the cause. Train the chain with `cj/lipsum-learn-file', +`cj/lipsum-learn-buffer', or `cj/lipsum-learn-region', or restore the file." + (interactive "nNumber of words: ") + (let ((text (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum")))) + (unless (and (stringp text) (not (string-empty-p text))) + (user-error "Lorem-optimum chain is empty; train it with cj/lipsum-learn-file or restore %s" + cj/lipsum-default-file)) + (when (called-interactively-p 'any) + (message "%s" text)) + text)) (defun cj/lipsum-insert (n) "Insert N words of lorem ipsum at point." diff --git a/modules/mail-config.el b/modules/mail-config.el index 297e70d4..b410bf1b 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -127,8 +127,17 @@ transport details in debug buffers." "mbsync" "mu4e mail synchronization" 'mail-config))) (concat (shell-quote-argument mbsync) " -a"))) +(defun cj/mail--send-mail-unavailable (&rest _) + "Signal a descriptive error: no mail transport is configured. +Installed as the send function when msmtp is absent, so a send attempt +explains itself instead of dying with \"invalid function: nil\" (the +top-level defvar pre-empts message.el's default)." + (user-error "Cannot send mail: msmtp not found -- install msmtp to enable sending")) + (defun cj/mail-configure-smtpmail () - "Configure SMTP mail transport when msmtp is available." + "Configure SMTP mail transport when msmtp is available. +With msmtp absent, install `cj/mail--send-mail-unavailable' on both send +variables so the failure at send time names the missing transport." (setq smtpmail-debug-info cj/smtpmail-debug-enabled) (if-let ((msmtp (cj/executable-find-or-warn "msmtp" "SMTP mail sending" 'mail-config))) @@ -136,7 +145,9 @@ transport details in debug buffers." send-mail-function 'message-send-mail-with-sendmail message-send-mail-function 'message-send-mail-with-sendmail message-sendmail-envelope-from 'header) - (setq sendmail-program nil))) + (setq sendmail-program nil + send-mail-function #'cj/mail--send-mail-unavailable + message-send-mail-function #'cj/mail--send-mail-unavailable))) ;; -------------------- HarfBuzz Crash Fix: Disable Composition --------------- ;; Disable auto-composition in mu4e headers to prevent SIGSEGV from HarfBuzz @@ -229,9 +240,6 @@ Prompts user for the action when executing." (setq mu4e-context-policy 'pick-first) ;; start with the first (default) context (setq mu4e-headers-auto-update nil) ;; updating headers buffer on email is too jarring (setq mu4e-root-maildir mail-dir) ;; root directory for all email accounts - (with-suppressed-warnings ((obsolete mu4e-maildir) - (free-vars mu4e-maildir)) - (setq mu4e-maildir mail-dir)) ;; same as above (for newer mu4e) (setq mu4e-sent-messages-behavior 'delete) ;; don't save to "Sent", IMAP does this already (setq mu4e-show-images t) ;; show embedded images ;; (setq mu4e-update-interval 600) ;; check for new mail every 10 minutes (600 seconds) @@ -243,9 +251,6 @@ Prompts user for the action when executing." ;; This will be automatically disabled when org-msg is active (setq mu4e-compose-format-flowed t) - (with-suppressed-warnings ((obsolete mu4e-html2text-command) - (free-vars mu4e-html2text-command)) - (setq mu4e-html2text-command 'mu4e-shr2text)) ;; email conversion to html via shr2text (setq mu4e-mu-binary (executable-find "mu")) (setq mu4e-get-mail-command (cj/mail--mbsync-command)) ;; command to sync mail (with-suppressed-warnings ((obsolete mu4e-user-mail-address-list) @@ -257,22 +262,15 @@ Prompts user for the action when executing." ;; ------------------------------ Mu4e Contexts ------------------------------ + ;; cmail (cjennings.net) is listed first deliberately: `pick-first' makes it + ;; the startup context, matching cmail's primary role everywhere else in the + ;; config (shortcuts, bookmarks, refile). Gmail-first here made gmail the + ;; silent default for the first compose. (mu4e-starred-folder was dropped: + ;; it isn't a mu4e variable, so it never had an effect -- flagged searches + ;; use flag:flagged.) (setq mu4e-contexts (list (make-mu4e-context - :name "gmail.com" - :match-func - (lambda (msg) - (when msg - (string-prefix-p "/gmail" (mu4e-message-field msg :maildir)))) - :vars '((user-mail-address . "craigmartinjennings@gmail.com") - (user-full-name . "Craig Jennings") - (mu4e-drafts-folder . "/gmail/Drafts") - (mu4e-sent-folder . "/gmail/Sent") - (mu4e-starred-folder . "/gmail/Starred") - (mu4e-trash-folder . "/gmail/Trash"))) - - (make-mu4e-context :name "cjennings.net" :match-func (lambda (msg) @@ -285,6 +283,18 @@ Prompts user for the action when executing." (mu4e-trash-folder . "/cmail/Trash"))) (make-mu4e-context + :name "gmail.com" + :match-func + (lambda (msg) + (when msg + (string-prefix-p "/gmail" (mu4e-message-field msg :maildir)))) + :vars '((user-mail-address . "craigmartinjennings@gmail.com") + (user-full-name . "Craig Jennings") + (mu4e-drafts-folder . "/gmail/Drafts") + (mu4e-sent-folder . "/gmail/Sent") + (mu4e-trash-folder . "/gmail/Trash"))) + + (make-mu4e-context :name "deepsat.com" :match-func (lambda (msg) @@ -294,7 +304,6 @@ Prompts user for the action when executing." (user-full-name . "Craig Jennings") (mu4e-drafts-folder . "/dmail/Drafts") (mu4e-sent-folder . "/dmail/Sent") - (mu4e-starred-folder . "/dmail/Starred") (mu4e-trash-folder . "/dmail/Trash"))))) ;; Refile target is computed per message (see `cj/mu4e--refile-folder'), not @@ -348,25 +357,11 @@ Prompts user for the action when executing." ;; ------------------------------ HTML Settings ------------------------------ ;; also see org-msg below - - ;; Prefer HTML over plain text when both are available - (with-suppressed-warnings ((obsolete mu4e-view-prefer-html) - (free-vars mu4e-view-prefer-html)) - (setq mu4e-view-prefer-html t)) - - ;; Use a better HTML renderer with more control - (with-suppressed-warnings ((obsolete mu4e-html2text-command) - (free-vars mu4e-html2text-command)) - (setq mu4e-html2text-command - (cond - ;; Best option: pandoc (if available) - ((executable-find "pandoc") - "pandoc -f html -t plain --reference-links") - ;; Good option: w3m (better tables/formatting) - ((executable-find "w3m") - "w3m -dump -T text/html -cols 72 -o display_link_number=true") - ;; Fallback: built-in shr - (t 'mu4e-shr2text)))) + ;; + ;; The view is shr-based since mu4e 1.7; the old knobs + ;; (mu4e-view-prefer-html, mu4e-html2text-command and its pandoc/w3m + ;; renderer selection) are obsolete and ignored on 1.14, so they were + ;; dropped. HTML display is governed by the shr settings below. ;; Configure shr (built-in HTML renderer) for better display (setq shr-use-colors nil) ; Don't use colors in terminal @@ -407,10 +402,12 @@ Echoes the effective state so there's no guessing what a refresh did." (message "Remote images: %s (this message only)" (if (equal gnus-blocked-images "http") "blocked" "shown"))) - ;; first letter is the keybinding + ;; first letter is the keybinding. No save-attachment action here: + ;; mu4e-view-save-attachments reads MIME parts from the view buffer (and + ;; takes no message argument), so it cannot work from headers -- open the + ;; message and save from the view instead. (setq mu4e-headers-actions - '(("asave attachment" . mu4e-view-save-attachments) - ("csave contact" . mu4e-action-add-org-contact) + '(("csave contact" . mu4e-action-add-org-contact) ("ssearch for sender" . cj/search-for-sender) ("tshow this thread" . mu4e-action-show-thread) ("vview in browser" . mu4e-action-view-in-browser))) @@ -483,12 +480,18 @@ INBOX maildir." (defun cj/--mail-make-account-map (account) "Build a mu4e navigation keymap for ACCOUNT (a maildir account name). Keys i/u/s/l run the inbox/unread/flagged/large searches from -`cj/--mail-account-search-queries', each scoped to ACCOUNT." +`cj/--mail-account-search-queries', each scoped to ACCOUNT. Each command +requires mu4e first: these maps register eagerly at startup, but +`mu4e-search' has no autoload cookie, so a nav key pressed before mu4e's +first launch would otherwise signal void-function. With the feature +loaded, mu4e itself starts the server on demand." (let ((map (make-sparse-keymap))) (dolist (entry (cj/--mail-account-search-queries account) map) (let ((query (cdr entry))) (keymap-set map (car entry) - (lambda () (interactive) (mu4e-search query)))))))) + (lambda () (interactive) + (require 'mu4e) + (mu4e-search query)))))))) ;; ---------------------------------- Org-Msg ---------------------------------- ;; user composes org mode; recipient receives html @@ -577,10 +580,12 @@ Keys i/u/s/l run the inbox/unread/flagged/large searches from ;; turn on org-msg in all compose buffers (org-msg-mode +1)) -(advice-add #'mu4e-compose-reply - :after (lambda (&rest _) (org-msg-edit-mode))) -(advice-add #'mu4e-compose-wide-reply - :after (lambda (&rest _) (org-msg-edit-mode))) +;; No reply advice here: org-msg-post-setup runs on mu4e-compose-mode-hook for +;; every compose (replies included) and applies `org-msg-default-alternatives' +;; itself. The old unconditional org-msg-edit-mode :after advice on the two +;; reply commands forced org-msg onto text-only replies, defeating the +;; (reply-to-text . (text)) alternative above and re-running a major mode +;; org-msg had already set up. ;; which-key labels (with-eval-after-load 'which-key diff --git a/modules/markdown-config.el b/modules/markdown-config.el index 815bb3fb..1d4a8b74 100644 --- a/modules/markdown-config.el +++ b/modules/markdown-config.el @@ -108,8 +108,21 @@ Starts the simple-httpd listener automatically when it isn't already running." ;; stub doesn't collide with this file's own definition of the command ;; (that collision is the "defined multiple times" byte-compile warning). ;; Same key as compile, for consistency. +(defun cj/markdown-toggle-view () + "Toggle the current Markdown buffer between edit and read-only view. +Handles the gfm variants too. The cond checks the most-derived mode +first, since the view modes derive from their edit modes." + (interactive) + (cond + ((derived-mode-p 'markdown-view-mode) (markdown-mode)) + ((derived-mode-p 'gfm-view-mode) (gfm-mode)) + ((derived-mode-p 'gfm-mode) (gfm-view-mode)) + ((derived-mode-p 'markdown-mode) (markdown-view-mode)))) + (with-eval-after-load 'markdown-mode - (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview)) + (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview) + (keymap-set markdown-mode-map "C-c C-x v" #'cj/markdown-toggle-view) + (keymap-set markdown-view-mode-map "C-c C-x v" #'cj/markdown-toggle-view)) (provide 'markdown-config) ;;; markdown-config.el ends here diff --git a/modules/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-attachments.el b/modules/mu4e-attachments.el index 6c2be6fb..56b96b87 100644 --- a/modules/mu4e-attachments.el +++ b/modules/mu4e-attachments.el @@ -100,11 +100,21 @@ size; an unknown candidate annotates as nil so marginalia shows nothing." (require 'mu4e-mime-parts))) (defun cj/mu4e--save-attachment-part (part directory) - "Save attachment PART to DIRECTORY and return the final path." + "Save attachment PART to DIRECTORY and return the final path. +Signals a `user-error' when PART's MIME handle is stale: a handle's car +is the buffer holding the part's bytes, and viewing another message kills +it, so saving through it would error deep in mm-decode or write another +message's content. The staleness check runs before +`cj/mu4e--ensure-attachment-save-functions', like the no-handle check." (let ((handle (plist-get part :handle))) (unless handle (user-error "Attachment has no MIME handle: %s" (or (plist-get part :filename) "<unnamed>"))) + (when (and (consp handle) + (bufferp (car handle)) + (not (buffer-live-p (car handle)))) + (user-error "Attachment %s is stale (the message view changed) -- reopen the message and save again" + (or (plist-get part :filename) "<unnamed>"))) (cj/mu4e--ensure-attachment-save-functions) (let* ((path (funcall mu4e-uniquify-save-file-name-function (mu4e-join-paths directory diff --git a/modules/mu4e-org-contacts-integration.el b/modules/mu4e-org-contacts-integration.el index 6062b8cf..a143bdc4 100644 --- a/modules/mu4e-org-contacts-integration.el +++ b/modules/mu4e-org-contacts-integration.el @@ -22,6 +22,7 @@ ;; isolation doesn't warn about free variables / undefined functions; the ;; actual definitions live where named. (eval-when-compile (defvar contacts-file)) ; user-constants.el +(defvar mu4e-compose-complete-addresses) ; mu4e-compose.el (lazy) (declare-function cj/get-all-contact-emails ; org-contacts-config.el "org-contacts-config" ()) @@ -59,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))) @@ -157,10 +155,10 @@ This bypasses the completion-at-point system for direct selection." ;; Setup hooks for org-msg-edit-mode (HTML email composition) (with-eval-after-load 'org-msg (add-hook 'org-msg-edit-mode-hook #'cj/mu4e-org-contacts-compose-setup)) - - ;; Remove any existing mu4e completion setup - (remove-hook 'mu4e-compose-mode-hook #'mu4e--compose-setup-completion) - + + ;; No hook surgery on mu4e--compose-setup-completion: mu4e 1.14 calls it + ;; directly during compose setup (never via this hook), and it is already + ;; gated by the `mu4e-compose-complete-addresses' nil above. (message "mu4e org-contacts integration activated")) (defun cj/deactivate-mu4e-org-contacts-integration () @@ -170,11 +168,11 @@ This bypasses the completion-at-point system for direct selection." ;; Remove our hooks (remove-hook 'mu4e-compose-mode-hook #'cj/mu4e-org-contacts-compose-setup) (remove-hook 'org-msg-edit-mode-hook #'cj/mu4e-org-contacts-compose-setup) - - ;; Re-enable mu4e's built-in completion if desired + + ;; Re-enable mu4e's built-in completion: the var is enough, since mu4e's + ;; compose setup calls its completion function directly, gated on this. (setq mu4e-compose-complete-addresses t) - (add-hook 'mu4e-compose-mode-hook #'mu4e--compose-setup-completion) - + (message "mu4e org-contacts integration deactivated")) (provide 'mu4e-org-contacts-integration) diff --git a/modules/mu4e-org-contacts-setup.el b/modules/mu4e-org-contacts-setup.el deleted file mode 100644 index bfb9b1f2..00000000 --- a/modules/mu4e-org-contacts-setup.el +++ /dev/null @@ -1,31 +0,0 @@ -;;; mu4e-org-contacts-setup.el --- Setup mu4e with org-contacts -*- lexical-binding: t; -*- -;; author: Craig Jennings <c@cjennings.net> - -;;; Commentary: -;; -;; Thin activation wrapper for mu4e-org-contacts-integration. If mu4e is loaded, -;; enable org-contacts completion and disable mu4e's internal contact collector -;; so completion has one source of truth. - -;;; Code: - -(defvar mu4e-compose-complete-only-personal) -(defvar mu4e-compose-complete-only-after) -(declare-function cj/activate-mu4e-org-contacts-integration "mu4e-org-contacts-integration") - -;; Load the integration module. Activation only runs when the module loaded -;; cleanly AND mu4e is present; otherwise this file is a no-op so the rest -;; of the config can load without mu4e installed. -(when (require 'mu4e-org-contacts-integration nil t) - (when (featurep 'mu4e) - (cj/activate-mu4e-org-contacts-integration))) - -;; Optional: If you want to use org-contacts as the primary source, -;; you might want to disable mu4e's contact caching to save memory -(with-eval-after-load 'mu4e - ;; Disable mu4e's internal contact collection - (setq mu4e-compose-complete-only-personal nil) - (setq mu4e-compose-complete-only-after nil)) - -(provide 'mu4e-org-contacts-setup) -;;; mu4e-org-contacts-setup.el ends here
\ No newline at end of file diff --git a/modules/music-config.el b/modules/music-config.el index d16e2bb2..233bae72 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -16,13 +16,20 @@ ;; ;; The playlist keymap intentionally follows ncmpcpp where it maps cleanly, with ;; EMMS-specific additions for M3U editing and consume mode. +;; +;; The player has two render paths. In a graphical frame with `cj/music-fancy-ui' +;; on (the default), it draws the fancy hi-fi surface: a now-playing hero with +;; cover art (station favicon / sibling album art / a shipped vinyl placeholder, +;; cached under data/music-art/), a serif title, and a block progress bar that +;; advances from mpv's percent-pos while a file plays. A TTY frame, or the +;; toggle off, falls back to the plain text player (names, a dim glyph, a thin +;; status line). `cj/music-clear-art-cache' empties the art cache. ;;; Code: (require 'subr-x) (require 'user-constants) (require 'keybindings) ;; provides cj/custom-keymap -(require 'cj-window-geometry-lib) ;; cj/preferred-dock-direction (F10 dock side) (require 'cj-window-toggle-lib) ;; side-window size memory (F10 toggle) (require 'system-lib) ;; cj/confirm-strong (overwrite confirms) @@ -30,7 +37,6 @@ ;; compiles as a dynamic bind, not a dead lexical local -- otherwise emms / ;; orderless never see the binding (the lexical-binding foreign-special-var trap). (defvar orderless-smart-case) -(defvar emms-source-playlist-ask-before-overwrite) (defvar emms-playlist-buffer-p) (defvar emms-playlist-buffer) (defvar emms-random-playlist) @@ -56,6 +62,46 @@ (defface cj/music-keyhint-face '((t :inherit shadow)) "Key hints in the playlist header.") +;; Fancy-render faces (Phase 3). Amber comes from the themed `warning' face so +;; the active theme (dupre) owns the color; the serif family is applied at +;; render time from `cj/music-title-family'. +(defface cj/music-title-face '((t :inherit cj/music-header-value-face :weight bold)) + "Now-playing title in the fancy player.") +(defface cj/music-subtitle-face '((t :inherit shadow)) + "Now-playing subtitle (station or album) in the fancy player.") +(defface cj/music-bar-fill-face '((t :inherit warning)) + "Filled portion of the fancy progress bar (amber).") +(defface cj/music-bar-empty-face '((t :inherit shadow)) + "Empty portion of the fancy progress bar.") + +(defgroup cj/music nil + "Personal EMMS music-player tweaks." + :group 'emms) + +(defcustom cj/music-fancy-ui t + "When non-nil and the frame is graphical, render the fancy hi-fi player: +cover art, a serif now-playing hero, and a progress bar. Nil, or a TTY frame, +falls back to the plain text player (names, a dim glyph, a thin status line)." + :type 'boolean + :group 'cj/music) + +(defcustom cj/music-title-family + (if (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) + +(defvar cj/music-hero-size 96 + "Pixel height of the now-playing hero cover image.") +(defvar cj/music-thumb-size 22 + "Pixel height of a playlist row's cover thumbnail.") +(defvar cj/music-bar-width 24 + "Cell width of the now-playing progress bar.") +(defvar cj/music-bar-interval 1 + "Seconds between progress-bar redraws while a track is playing and visible.") + ;; Foreign functions used lazily after their packages load. (declare-function emms-playlist-mode "emms-playlist-mode") (declare-function emms-playlist-track-at "emms-playlist-mode") @@ -63,11 +109,15 @@ (declare-function emms-track-name "emms") (declare-function emms-track-type "emms") (declare-function emms-track-get "emms") +(declare-function emms-track "emms") +(declare-function emms-track-set "emms") (declare-function emms-track-simple-description "emms") (declare-function emms-playlist-current-selected-track "emms") (declare-function emms-playlist-select "emms") +(declare-function emms-playlist-selected-track "emms") (declare-function emms-playlist-clear "emms") -(declare-function emms-playlist-save "emms-source-playlist") +(declare-function emms-playlist-insert-track "emms") +(declare-function emms-stop "emms") (declare-function emms-start "emms") (declare-function emms-random "emms") (declare-function emms-next "emms") @@ -82,7 +132,19 @@ "Root directory of your music collection.") (defvar cj/music-m3u-root cj/music-root - "Directory where M3U playlists are saved and loaded.") + "Directory M3U playlists are saved to (the single writable target). +Reading and selection union `cj/music-m3u-roots'; only saving and radio-station +creation write here.") + +(defvar cj/music-m3u-roots + (list cj/music-root + (expand-file-name "~/.local/share/mpd/playlists/")) + "Directories to source M3U playlists from, in precedence order. +Both the local-library playlists (`cj/music-root') and the dotfiles-tracked +internet-radio playlists (MPD's playlist_directory) surface together for +selection and loading. Earlier directories win on a basename collision. +Missing directories are skipped. Saving still targets the single +`cj/music-m3u-root'.") (defvar cj/music-file-extensions '("aac" "flac" "m4a" "mp3" "ogg" "opus" "wav") "List of valid music file extensions.") @@ -167,6 +229,30 @@ A no-op when nothing is playing or the socket is gone, so it never errors." (accept-process-output proc 0.1)) (delete-process proc)))))) +(defun cj/music--mpv-get-property (prop) + "Query the mpv IPC socket for PROP and return its value, or nil. +Reads the reply (unlike `cj/music--mpv-command', which only sends), so the +progress bar can read percent-pos. Blocks briefly, so call it off redisplay." + (when (file-exists-p cj/music--mpv-socket) + (ignore-errors + (let ((out "") proc) + (setq proc (make-network-process + :name "cj-music-mpv-get" :family 'local + :service cj/music--mpv-socket :noquery t + :filter (lambda (_p s) (setq out (concat out s))))) + (unwind-protect + (progn + (process-send-string + proc (format "{\"command\":[\"get_property\",\"%s\"]}\n" prop)) + (accept-process-output proc 0.2) + (cl-loop for line in (split-string out "\n" t) + for obj = (ignore-errors + (json-parse-string line :object-type 'plist + :null-object nil)) + when (and obj (plist-member obj :data)) + return (plist-get obj :data))) + (delete-process proc)))))) + (defun cj/music-seek-forward () "Seek `cj/music-seek-seconds' seconds forward in the current track." (interactive) @@ -222,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 @@ -238,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) @@ -260,39 +506,56 @@ 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-tracks () - "Return list of track names from current EMMS playlist buffer." +(defun cj/music--playlist-track-objects () + "Return the track objects from the current EMMS playlist buffer, in order." (let ((tracks '())) (with-current-buffer (cj/music--ensure-playlist-buffer) (save-excursion (goto-char (point-min)) (while (not (eobp)) (when-let ((track (emms-playlist-track-at (point)))) - (push (emms-track-name track) tracks)) + (push track tracks)) (forward-line 1)))) (nreverse tracks))) +(defun cj/music--playlist-tracks () + "Return list of track names from current EMMS playlist buffer." + (mapcar #'emms-track-name (cj/music--playlist-track-objects))) + +(defun cj/music--dedup-m3u-files (paths) + "Return (BASENAME . PATH) conses for PATHS, first occurrence of a basename winning. +Pure helper: since `cj/music--get-m3u-files' scans `cj/music-m3u-roots' in order, +an earlier directory shadows a same-named playlist in a later one." + (let ((seen (make-hash-table :test 'equal)) + (result '())) + (dolist (p paths (nreverse result)) + (let ((base (file-name-nondirectory p))) + (unless (gethash base seen) + (puthash base t seen) + (push (cons base p) result)))))) + (defun cj/music--get-m3u-files () - "Return list of (BASENAME . FULLPATH) conses for M3Us in cj/music-m3u-root." - (let ((files (directory-files cj/music-m3u-root t "\\.m3u\\'" t))) - (mapcar (lambda (f) (cons (file-name-nondirectory f) f)) files))) + "Return (BASENAME . FULLPATH) conses for M3Us across `cj/music-m3u-roots'. +Directories are scanned in order and missing ones skipped; on a basename +collision the earlier directory wins." + (cj/music--dedup-m3u-files + (cl-loop for dir in cj/music-m3u-roots + when (file-directory-p dir) + append (directory-files dir t "\\.m3u\\'" t)))) (defun cj/music--get-m3u-basenames () - "Return list of M3U basenames (no extension) in cj/music-m3u-root." + "Return list of M3U basenames (no extension) across `cj/music-m3u-roots'." (mapcar (lambda (pair) (file-name-sans-extension (car pair))) (cj/music--get-m3u-files))) -(defun cj/music--safe-filename (name) - "Return NAME made filesystem-safe by replacing bad chars with underscores." - (replace-regexp-in-string "[^a-zA-Z0-9_-]" "_" name)) - (defun cj/music--playlist-modified-p () "Return non-nil if current playlist differs from its associated M3U file." (and cj/music-playlist-file @@ -312,11 +575,12 @@ Signals user-error if missing or deleted." (file-name-nondirectory cj/music-playlist-file)))))) (defun cj/music--assert-m3u-files-exist () - "Assert that M3U files exist in cj/music-m3u-root. + "Assert that M3U files exist across `cj/music-m3u-roots'. Returns the list of (BASENAME . FULLPATH) conses. Signals user-error if none." (let ((files (cj/music--get-m3u-files))) (when (null files) - (user-error "No M3U files found in %s" cj/music-m3u-root)) + (user-error "No M3U files found in %s" + (string-join cj/music-m3u-roots ", "))) files)) (defun cj/music--sync-playlist-file (file-path) @@ -334,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 () @@ -438,23 +736,107 @@ Replaces current playlist." (message "Loaded playlist: %s" choice-name))) +(defun cj/music--m3u-track-lines (track entries) + "The .m3u lines for TRACK. +A file track is its bare absolute path. A url track carries its station +metadata — an #EXTINF label plus #RADIOBROWSERUUID / #RADIOBROWSERFAVICON when +known — read from the track's properties first, then its ENTRIES metadata (a +loaded legacy playlist has entries but no properties), so a saved station +keeps its display name and cover art on reload." + (let ((name (emms-track-name track))) + (if (not (eq (emms-track-type track) 'url)) + (concat name "\n") + (let* ((meta (cdr (assoc name entries))) + (label (or (emms-track-get track 'info-title) + (plist-get meta :name) + (cj/music--tidy-host name))) + (uuid (or (emms-track-get track 'radio-uuid) + (plist-get meta :uuid))) + (favicon (or (emms-track-get track 'radio-favicon) + (plist-get meta :favicon)))) + (concat + (if (and (stringp uuid) (not (string-empty-p uuid))) + (format "#RADIOBROWSERUUID:%s\n" uuid) + "") + (if (and (stringp favicon) (not (string-empty-p favicon))) + (format "#RADIOBROWSERFAVICON:%s\n" + (replace-regexp-in-string "[\r\n]+" " " favicon)) + "") + (format "#EXTINF:-1,%s\n" + (replace-regexp-in-string "[\r\n]+" " " label)) + name "\n"))))) + +(defun cj/music--m3u-text (tracks entries) + "The full .m3u file text for TRACKS, station metadata from ENTRIES. +The stock EMMS m3u writer emits bare URLs; this emitter writes the comment +lines `cj/music--m3u-entries' parses, so save -> load round-trips." + (concat "#EXTM3U\n" + (mapconcat (lambda (tr) (cj/music--m3u-track-lines tr entries)) + tracks ""))) + +(defun cj/music--write-playlist-file (path tracks entries) + "Write TRACKS to PATH as .m3u text, station metadata from ENTRIES. +Refreshes the radio metadata cache since a new .m3u just landed." + (with-temp-file path + (insert (cj/music--m3u-text tracks entries))) + (cj/music--refresh-radio-name-map)) + +(defun cj/music--save-default-name (tracks file entries) + "The name the save prompt should offer. +FILE (the playlist's associated .m3u) wins when present. Otherwise the first +url track's station name — its title property, else its #EXTINF label from +ENTRIES. Nil when neither applies (the caller falls back to a timestamp)." + (if file + (file-name-sans-extension (file-name-nondirectory file)) + (cl-loop for tr in tracks + when (eq (emms-track-type tr) 'url) + thereis (or (emms-track-get tr 'info-title) + (plist-get (cdr (assoc (emms-track-name tr) entries)) + :name))))) + +;; 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 +`cj/music-radio-save-dir'; anything else saves into `cj/music-m3u-root'." + (if (and tracks + (cl-every (lambda (tr) (eq (emms-track-type tr) 'url)) tracks)) + cj/music-radio-save-dir + cj/music-m3u-root)) + (defun cj/music-playlist-save () - "Save current EMMS playlist to a file in cj/music-m3u-root. -Offers completion over existing names but allows new names." + "Save the current EMMS playlist to an .m3u file. +An all-stream queue saves into `cj/music-radio-save-dir' (the radio playlist +home); anything else saves into `cj/music-m3u-root'. A queue of freshly +looked-up stations pre-fills the first station's name in the prompt; a +playlist with an associated file keeps that file's name as the default. +Station metadata (name, uuid, favicon) is written with each stream so a +reloaded playlist keeps its display name and cover art." (interactive) - (let* ((existing (cj/music--get-m3u-basenames)) - (default-name (if cj/music-playlist-file - (file-name-sans-extension (file-name-nondirectory cj/music-playlist-file)) - (format-time-string "playlist-%Y%m%d-%H%M%S"))) - (chosen (completing-read "Save playlist as: " existing nil nil nil nil default-name)) + (let* ((tracks (cj/music--playlist-track-objects)) + (entries (cj/music--radio-metadata)) + (existing (cj/music--get-m3u-basenames)) + (assoc-file (with-current-buffer (cj/music--ensure-playlist-buffer) + cj/music-playlist-file)) + (prefill (and (null assoc-file) + (cj/music--save-default-name tracks nil entries))) + (default-name (or (cj/music--save-default-name tracks assoc-file entries) + (format-time-string "playlist-%Y%m%d-%H%M%S"))) + (chosen (completing-read "Save playlist as: " existing nil nil + prefill nil default-name)) (filename (if (string-suffix-p ".m3u" chosen) chosen (concat chosen ".m3u"))) - (full (expand-file-name filename cj/music-m3u-root))) + (dir (cj/music--save-directory tracks)) + (full (expand-file-name filename dir))) + (when (string-empty-p (string-trim chosen)) + (user-error "Playlist name cannot be empty")) (when (and (file-exists-p full) (not (cj/confirm-strong (format "Overwrite %s? " filename)))) (user-error "Aborted saving playlist")) - (with-current-buffer (cj/music--ensure-playlist-buffer) - (let ((emms-source-playlist-ask-before-overwrite nil)) - (emms-playlist-save 'm3u full))) + (make-directory dir t) + (cj/music--write-playlist-file full tracks entries) (cj/music--sync-playlist-file full) (message "Saved playlist: %s" filename))) @@ -483,6 +865,23 @@ Offers completion over existing names but allows new names." (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) @@ -491,8 +890,9 @@ Offers completion over existing names but allows new names." (let ((path cj/music-playlist-file)) (when (cj/music--playlist-modified-p) (when (yes-or-no-p "Playlist modified. Save before editing? ") - (let ((emms-source-playlist-ask-before-overwrite nil)) - (emms-playlist-save 'm3u path)))) + (cj/music--write-playlist-file path + (cj/music--playlist-track-objects) + (cj/music--radio-metadata)))) ;; Re-validate existence before opening (if (file-exists-p path) (find-file-other-window path) @@ -593,42 +993,26 @@ 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 docks at the bottom and hasn't been resized and -toggled off this session; after that, the toggled-off height is remembered -in `cj/--music-playlist-height'.") - -(defvar cj/music-playlist-window-width 0.4 - "Default fraction of frame width for the F10 music playlist side window. -Used when the playlist docks as a right-side column (see -`cj/--music-playlist-side') and hasn't been resized this session; after -that the toggled-off width is remembered in `cj/--music-playlist-width'.") +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 while docked bottom. + "Last height fraction the playlist was toggled off at. nil means fall back to `cj/music-playlist-window-height'. In-memory only -- resets each Emacs session.") -(defvar cj/--music-playlist-width nil - "Last width fraction the playlist was toggled off at while docked right. -nil means fall back to `cj/music-playlist-window-width'. In-memory only -- -resets each Emacs session.") - -(defun cj/--music-playlist-side () - "Return the side the F10 playlist should dock on: `right' or `bottom'. -Docks as a right-side column only when a side-by-side split would leave -both panes at least `cj/window-dock-min-columns' wide (the playlist's -share is `cj/music-playlist-window-width'); otherwise docks at the bottom. -See `cj/preferred-dock-direction'." - (if (eq (cj/preferred-dock-direction (frame-width) - cj/music-playlist-window-width) - 'right) - 'right - 'bottom)) - (defun cj/music-playlist-toggle () "Toggle the EMMS playlist buffer in a bottom side window. +The playlist always docks at the bottom, whatever the frame's shape. It +used to dock as a right-side column on a wide frame (via +`cj/preferred-dock-direction'), which split a wide frame three ways -- +unexpected often enough that Craig retired the rule (2026-07-09). + The window opens at `cj/music-playlist-window-height'; if it has been resized and toggled off this session, it reopens at that remembered height." (interactive) @@ -637,34 +1021,24 @@ resized and toggled off this session, it reopens at that remembered height." (win (and buffer (get-buffer-window buffer)))) (if win (progn - ;; Capture the resized size into the var matching the window's - ;; actual side, so width and height memories stay independent. - ;; Guard the parameter lookup: a dead or non-window WIN (the - ;; capture helpers tolerate one) must not error here. - (let ((side (if (window-live-p win) - (or (window-parameter win 'window-side) 'bottom) - 'bottom))) - (if (memq side '(left right)) - (cj/side-window-capture-size win side 'cj/--music-playlist-width) - (cj/side-window-capture-size win 'bottom 'cj/--music-playlist-height))) + (cj/side-window-capture-size win 'bottom 'cj/--music-playlist-height) + ;; 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 (cj/emms--setup) (setq buffer (cj/music--ensure-playlist-buffer)) - (let* ((side (cj/--music-playlist-side)) - (right (eq side 'right))) - (setq win (cj/side-window-display - buffer side - (if right 'cj/--music-playlist-width 'cj/--music-playlist-height) - (if right cj/music-playlist-window-width - cj/music-playlist-window-height)))) + (setq win (cj/side-window-display + buffer 'bottom 'cj/--music-playlist-height + cj/music-playlist-window-height)) (select-window win) - (with-current-buffer buffer - (if (and (fboundp 'emms-playlist-current-selected-track) - (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) @@ -682,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")) @@ -697,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) @@ -715,19 +1092,25 @@ Dirs added recursively." ;;; EMMS setup and keybindings ;; Music/EMMS keymap +(defvar-keymap cj/music-radio-map + :doc "Radio prefix: mirrors the playlist buffer's n/t/m radio row." + "n" #'cj/music-radio-search-by-name + "t" #'cj/music-radio-search-by-tag + "m" #'cj/music-create-radio-station) + (defvar-keymap cj/music-map - :doc "Keymap for music commands" + :doc "Keymap for music commands (all lowercase, chord-friendly)" "m" #'cj/music-playlist-toggle - "M" #'cj/music-playlist-show + "v" #'cj/music-playlist-show "a" #'cj/music-fuzzy-select-and-add - "R" #'cj/music-create-radio-station + "r" cj/music-radio-map "SPC" #'emms-pause "s" #'emms-stop "n" #'cj/music-next "p" #'cj/music-previous "g" #'emms-playlist-mode-go - "Z" #'emms-shuffle - "r" #'emms-toggle-repeat-playlist + "u" #'emms-shuffle + "l" #'emms-toggle-repeat-playlist "t" #'emms-toggle-repeat-track "z" #'emms-toggle-random-playlist "x" #'cj/music-toggle-consume) @@ -737,16 +1120,19 @@ Dirs added recursively." (which-key-add-key-based-replacements "C-; m" "music menu" "C-; m m" "toggle playlist" - "C-; m M" "show playlist" + "C-; m v" "show playlist" "C-; m a" "add music" - "C-; m R" "create radio" + "C-; m r" "+radio" + "C-; m r n" "radio by name" + "C-; m r t" "radio by tag" + "C-; m r m" "radio manual entry" "C-; m SPC" "pause" "C-; m s" "stop" "C-; m n" "next track" "C-; m p" "previous track" "C-; m g" "goto playlist" - "C-; m Z" "shuffle" - "C-; m r" "repeat playlist" + "C-; m u" "shuffle" + "C-; m l" "repeat playlist" "C-; m t" "repeat track" "C-; m z" "random" "C-; m x" "consume")) @@ -767,92 +1153,381 @@ Dirs added recursively." (when (and seconds (numberp seconds) (> seconds 0)) (format "%d:%02d" (/ seconds 60) (mod seconds 60)))) -(defun cj/music--track-description (track) - "Return a human-readable description of TRACK. -For tagged tracks: \"Artist - Title [M:SS]\". -For file tracks without tags: filename without path or extension. -For URL tracks: decoded URL." +;; ---------------------------- Display-name layer ----------------------------- +;; A track maps to a display NAME (shared by the header's Current line and the +;; playlist row renderer) plus, on a row, a dim type glyph and right-aligned +;; meta. The pure pieces (name resolution, #EXTINF-label extraction, host +;; tidying, progress-bar fill) carry the tests; the glyph, the :align-to meta, +;; and the disk-backed name-map are exercised live. + +(defun cj/music--tidy-host (url) + "Return a readable host label for URL: scheme and path dropped, a leading +\"www.\" removed, and a multi-label host reduced to its last two labels +\(ice6.somafm.com -> somafm.com). A string with no scheme://host is returned +unchanged, so a non-URL name shows as-is instead of erroring." + (if (string-match "\\`[a-zA-Z]+://\\(?:[^@/]*@\\)?\\([^:/?#]+\\)" url) + (let* ((host (replace-regexp-in-string "\\`www\\." "" (match-string 1 url))) + (labels (split-string host "\\." t))) + (if (> (length labels) 2) + (string-join (last labels 2) ".") + host)) + url)) + +(defun cj/music--m3u-entries (text) + "Parse M3U TEXT into an alist of (STREAM-URL . PLIST). +Each PLIST carries :name (the #EXTINF label), :uuid (#RADIOBROWSERUUID), and +:favicon (#RADIOBROWSERFAVICON), read from the comment lines preceding the url. +A url with no #EXTINF is skipped; fields reset after each url so nothing leaks +between stations." + (let ((name nil) (uuid nil) (favicon nil) (entries '())) + (dolist (line (split-string text "[\r\n]+" t) (nreverse entries)) + (cond + ((string-match "\\`#EXTINF:[^,]*,\\(.*\\)\\'" line) + (setq name (match-string 1 line))) + ((string-match "\\`#RADIOBROWSERUUID:\\(.*\\)\\'" line) + (setq uuid (match-string 1 line))) + ((string-match "\\`#RADIOBROWSERFAVICON:\\(.*\\)\\'" line) + (setq favicon (match-string 1 line))) + ((string-prefix-p "#" line)) ; other comment + (t (when name + (push (cons line (list :name name :uuid uuid :favicon favicon)) + entries)) + (setq name nil uuid nil favicon nil)))))) + +(defun cj/music--m3u-labels (text) + "Alist of (STREAM-URL . #EXTINF-LABEL) parsed from M3U TEXT. +A thin projection of `cj/music--m3u-entries' onto the label field." + (mapcar (lambda (e) (cons (car e) (plist-get (cdr e) :name))) + (cj/music--m3u-entries text))) + +(defvar cj/music--radio-metadata-cache nil + "Cached url->plist metadata (:name :uuid :favicon) across `cj/music-m3u-roots'. +Built lazily so a row render never re-scans disk; cleared by +`cj/music--refresh-radio-name-map' when a station is created or a playlist +loads.") + +(defun cj/music--radio-metadata () + "Alist of stream-url -> plist metadata, unioned across all playlist roots. +Reads each .m3u once and caches the result; both name resolution and the +cover-art layer read from it." + (or cj/music--radio-metadata-cache + (setq cj/music--radio-metadata-cache + (cl-loop for (_base . path) in (cj/music--get-m3u-files) + append (cj/music--m3u-entries + (with-temp-buffer + (insert-file-contents path) + (buffer-string))))))) + +(defun cj/music--radio-name-map () + "Alist of stream-url -> station label, derived from the cached metadata." + (mapcar (lambda (e) (cons (car e) (plist-get (cdr e) :name))) + (cj/music--radio-metadata))) + +(defun cj/music--refresh-radio-name-map () + "Clear the cached radio metadata so the next render rebuilds it." + (setq cj/music--radio-metadata-cache nil)) + +(defun cj/music--display-name (track &optional name-map) + "Human display name for TRACK, name only (no duration). +A tagged track (file or url) shows \"Artist - Title\" or the bare title; an +untagged file shows its filename; a url track resolves to its #EXTINF label +from NAME-MAP (an alist of url->label), else a tidied host. Unknown types +fall back to `emms-track-simple-description'." (let ((type (emms-track-type track)) (title (emms-track-get track 'info-title)) (artist (emms-track-get track 'info-artist)) - (duration (emms-track-get track 'info-playing-time)) (name (emms-track-name track))) (cond - ;; Tagged track with title - (title - (let ((dur-str (cj/music--format-duration duration)) - (parts '())) - (when artist (push artist parts)) - (push title parts) - (let ((desc (string-join (nreverse parts) " - "))) - (if dur-str (format "%s [%s]" desc dur-str) desc)))) - ;; File without tags — show clean filename - ((eq type 'file) - (file-name-sans-extension (file-name-nondirectory name))) - ;; URL — decode percent-encoded characters - ((eq type 'url) - (decode-coding-string (url-unhex-string name) 'utf-8)) - ;; Fallback + (title (if artist (format "%s - %s" artist title) title)) + ((eq type 'file) (file-name-sans-extension (file-name-nondirectory name))) + ((eq type 'url) (or (cdr (assoc name name-map)) (cj/music--tidy-host name))) (t (emms-track-simple-description track))))) +(defun cj/music--format-meta (track) + "Right-aligned meta string for TRACK's row: a file's duration as \"[M:SS]\", +empty when there's no duration (a live stream, or an untimed file)." + (let ((dur (cj/music--format-duration (emms-track-get track 'info-playing-time)))) + (if dur (format "[%s]" dur) ""))) + +(defun cj/music--bar-fill (elapsed total width) + "Filled-cell count for a WIDTH-cell progress bar at ELAPSED/TOTAL seconds. +Returns 0..WIDTH, or the symbol `indeterminate' when TOTAL is nil or +non-positive (a live stream). A nil ELAPSED counts as zero." + (if (or (null total) (<= total 0)) + 'indeterminate + (let ((ratio (min 1.0 (max 0.0 (/ (float (or elapsed 0)) total))))) + (round (* ratio width))))) + +(defun cj/music--type-glyph (track) + "A leading glyph for TRACK: a broadcast icon for a stream, a note for a file. +Uses nerd-icons when available; otherwise a plain marker, so a TTY or a +fontless frame never shows a tofu box." + (let ((stream (eq (emms-track-type track) 'url))) + (or (and (fboundp 'nerd-icons-mdicon) + (ignore-errors + (nerd-icons-mdicon (if stream "nf-md-broadcast" "nf-md-music_note") + :face 'cj/music-header-face))) + (if stream "»" "•")))) + +(defun cj/music--row-string (track) + "Playlist row for TRACK: a lead glyph or cover thumbnail, the display name, +and the meta right-aligned to the window edge with a resize-safe :align-to +space. In the fancy render the lead is a thumbnail and the name is serif. +This is `emms-track-description-function'." + (let* ((name (cj/music--display-name track (cj/music--radio-name-map))) + (meta (cj/music--format-meta track)) + (fancy (cj/music--fancy-p)) + (lead (if-let* ((fancy) + (img (cj/music--image (cj/music-art--for-track track) + cj/music-thumb-size))) + (propertize " " 'display img) + (cj/music--type-glyph track))) + (label (if fancy + (propertize name 'face (list :family cj/music-title-family + :inherit 'cj/music-title-face)) + name))) + (if (string-empty-p meta) + (concat lead " " label) + (concat lead " " label + (propertize " " 'display + `(space :align-to (- right ,(1+ (length meta))))) + (propertize meta 'face 'cj/music-keyhint-face))))) + +(defun cj/music--now-playing-suffix (track) + "Trailing status for the header Current line: on-air for a stream, the +duration for a timed file, empty otherwise." + (if (eq (emms-track-type track) 'url) + " ◉ on air" + (let ((d (cj/music--format-duration (emms-track-get track 'info-playing-time)))) + (if d (format " %s" d) "")))) + +;; ------------------------------ Fancy render --------------------------------- +;; The GUI hero (cover image + serif title + bar) and thumbnailed serif rows, +;; gated on a graphical frame + `cj/music-fancy-ui'. Cover art comes from the +;; non-blocking `cj/music-art--for-track' (defined with the art layer below). + +(defun cj/music--fancy-p () + "Non-nil when the fancy render applies: a graphical frame with the +`cj/music-fancy-ui' toggle on. Decided per redisplay, so a TTY frame and a GUI +frame in the same session can differ." + (and cj/music-fancy-ui (display-graphic-p))) + +(defun cj/music--image (path height) + "Image spec for PATH scaled to HEIGHT px, or nil when it can't be displayed +\(no image support, an unreadable file, an unavailable format)." + (when (and path (file-readable-p path)) + (ignore-errors + (create-image path nil nil :height height :ascent 'center)))) + +(defun cj/music--bar-string (fill width) + "Render a WIDTH-cell block progress bar with FILL filled cells. +FILL `indeterminate' (a live stream) renders an on-air marker instead." + (if (eq fill 'indeterminate) + (propertize "◉ on air" 'face 'cj/music-subtitle-face) + (let ((n (max 0 (min fill width)))) + (concat (propertize (make-string n ?█) 'face 'cj/music-bar-fill-face) + (propertize (make-string (- width n) ?░) + 'face 'cj/music-bar-empty-face))))) + +(defun cj/music--current-bar (track) + "The progress bar for TRACK: a stream is indeterminate; a file fills from +mpv's percent-pos." + (if (eq (emms-track-type track) 'url) + (cj/music--bar-string 'indeterminate cj/music-bar-width) + (let ((pct (cj/music--mpv-get-property "percent-pos"))) + (cj/music--bar-string + (cj/music--bar-fill (and (numberp pct) pct) 100 cj/music-bar-width) + cj/music-bar-width)))) + +(defun cj/music--hero-header (track) + "Fancy now-playing hero for TRACK: cover image, serif amber title, subtitle, +and the progress bar, stacked vertically." + (let* ((img (cj/music--image (cj/music-art--for-track track) cj/music-hero-size)) + (title (cj/music--display-name track (cj/music--radio-name-map))) + (sub (if (eq (emms-track-type track) 'url) + "radio" + (or (emms-track-get track 'info-album) "")))) + (concat + (if img (concat (propertize " " 'display img) "\n") "") + (propertize title 'face (list :family cj/music-title-family + :inherit 'cj/music-title-face)) + "\n" + (if (string-empty-p sub) + "" + (concat (propertize sub 'face 'cj/music-subtitle-face) "\n")) + (cj/music--current-bar track) + "\n"))) + ;; Multi-line header overlay (defvar-local cj/music--header-overlay nil "Overlay displaying the playlist header.") -(defun cj/music--header-text () - "Build a multi-line header string for the playlist buffer overlay." - (let* ((pl-name (if cj/music-playlist-file - (file-name-sans-extension - (file-name-nondirectory cj/music-playlist-file)) - "Untitled")) - (track-count (count-lines (point-min) (point-max))) - (now-playing (cond - ((not emms-player-playing-p) "Stopped") - (emms-player-paused-p "Paused") - (t (let ((track (emms-playlist-current-selected-track))) - (if track - (cj/music--track-description track) - "Playing"))))) - (mode-indicator - (lambda (key label active) - (let ((face (if active 'cj/music-mode-on-face 'cj/music-mode-off-face))) - (propertize (format "[%s] %s" key label) 'face face))))) +(defun cj/music--playlist-string () + "The \"Playlist : NAME (N)\" header line." + (let ((pl-name (if cj/music-playlist-file + (file-name-sans-extension + (file-name-nondirectory cj/music-playlist-file)) + "Untitled")) + (track-count (count-lines (point-min) (point-max)))) + (concat (propertize "Playlist" 'face 'cj/music-header-face) + (propertize " : " 'face 'cj/music-header-face) + (propertize (format "%s (%d)" pl-name track-count) + 'face 'cj/music-header-value-face) + "\n"))) + +(defun cj/music--controls-string () + "The Mode / Keys / Radio control lines and the closing full-width rule. +The rule uses a resize-safe :align-to span, not a hardcoded character count." + (let ((mode-indicator + (lambda (key label active) + (let ((face (if active 'cj/music-mode-on-face 'cj/music-mode-off-face))) + (propertize (format "[%s] %s" key label) 'face face))))) (concat - (propertize "Playlist" 'face 'cj/music-header-face) - (propertize " : " 'face 'cj/music-header-face) - (propertize (format "%s (%d)" pl-name track-count) 'face 'cj/music-header-value-face) - "\n" - (propertize "Current " 'face 'cj/music-header-face) - (propertize " : " 'face 'cj/music-header-face) - (propertize now-playing 'face 'cj/music-header-value-face) - "\n" (propertize "Mode " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) - (funcall mode-indicator "r" "repeat" (bound-and-true-p emms-repeat-playlist)) - " " - (funcall mode-indicator "t" "single" (bound-and-true-p emms-repeat-track)) - " " - (funcall mode-indicator "z" "random" (bound-and-true-p emms-random-playlist)) - " " - (funcall mode-indicator "x" "consume" cj/music-consume-mode) - "\n" + (funcall mode-indicator "r" "repeat" (bound-and-true-p emms-repeat-playlist)) " " + (funcall mode-indicator "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 S:save SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" - 'face 'cj/music-keyhint-face) + (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) + (propertize "n:by name t:by tag m:enter manually" + 'face 'cj/music-keyhint-face) "\n" + (propertize " " 'face '(:strike-through t :inherit shadow) + 'display '(space :align-to right)) "\n\n"))) +(defun cj/music--current-track () + "The selected track when one is playing or paused, else nil." + (and emms-player-playing-p + (ignore-errors (emms-playlist-current-selected-track)))) + +(defun cj/music--text-header () + "The plain text header: Playlist, Current, then the controls." + (let ((now (cond ((not emms-player-playing-p) "Stopped") + (emms-player-paused-p "Paused") + (t (let ((track (cj/music--current-track))) + (if track + (concat (cj/music--display-name + track (cj/music--radio-name-map)) + (cj/music--now-playing-suffix track)) + "Playing")))))) + (concat (cj/music--playlist-string) + (propertize "Current " 'face 'cj/music-header-face) + (propertize " : " 'face 'cj/music-header-face) + (propertize now 'face 'cj/music-header-value-face) "\n" + (cj/music--controls-string)))) + +(defun cj/music--fancy-header () + "The fancy header: Playlist, the now-playing hero when a track plays, then +the controls." + (let ((track (cj/music--current-track))) + (concat (cj/music--playlist-string) + (if track + (cj/music--hero-header track) + (concat (propertize "Current " 'face 'cj/music-header-face) + (propertize " : " 'face 'cj/music-header-face) + (propertize (if emms-player-paused-p "Paused" "Stopped") + 'face 'cj/music-header-value-face) + "\n")) + (cj/music--controls-string)))) + +(defun cj/music--header-text () + "Build the playlist header overlay string: fancy in a graphical frame with +`cj/music-fancy-ui' on, plain text otherwise." + (if (cj/music--fancy-p) + (cj/music--fancy-header) + (cj/music--text-header))) + +(defun cj/music--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))))) +;; Progress-bar redraw timer and cover-art pre-warm (Phase 3). +(defvar cj/music--bar-timer nil + "Repeating timer redrawing the progress bar while a track plays.") + +(defun cj/music--bar-tick () + "Redraw the header when the player buffer is visible and a track is playing. +The timer keeps running while idle/paused; it just skips the redraw." + (when (and emms-player-playing-p (not emms-player-paused-p) + (get-buffer-window cj/music-playlist-buffer-name t)) + (cj/music--update-header))) + +(defun cj/music--start-bar-timer (&rest _) + "Start the progress-bar redraw timer if it is not already running." + (unless cj/music--bar-timer + (setq cj/music--bar-timer + (run-at-time t cj/music-bar-interval #'cj/music--bar-tick)))) + +(defun cj/music--stop-bar-timer (&rest _) + "Stop the progress-bar redraw timer." + (when cj/music--bar-timer + (cancel-timer cj/music--bar-timer) + (setq cj/music--bar-timer nil))) + +(defun cj/music--do-prewarm-art () + "Fetch the current track's cover art, then refresh the header so the fetched +art replaces the placeholder. Blocks on the network; runs off an idle timer." + (when-let ((track (cj/music--current-track))) + (when (cj/music-art--ensure track) + (cj/music--update-header)))) + +(defun cj/music--prewarm-art (&rest _) + "Schedule a cover-art fetch for the current track during idle, so a slow +fetch never blocks playback start (the emms-player-started-hook). A no-op +unless fancy." + (when (cj/music--fancy-p) + (run-with-idle-timer 0.2 nil #'cj/music--do-prewarm-art))) + (defvar-local cj/music--bg-remap-cookie nil "Cookie for the active-window background face remapping.") @@ -915,7 +1590,7 @@ For URL tracks: decoded URL." ;;; Playlist display ;; Track description: show "Artist - Title [M:SS]" instead of file paths - (setq emms-track-description-function #'cj/music--track-description) + (setq emms-track-description-function #'cj/music--row-string) (add-hook 'emms-playlist-mode-hook #'cj/music--setup-playlist-display) (add-hook 'emms-player-started-hook #'cj/music--record-random-history) @@ -925,19 +1600,29 @@ For URL tracks: decoded URL." (add-hook 'emms-player-finished-hook #'cj/music--update-header) (add-hook 'emms-playlist-cleared-hook #'cj/music--update-header) - ;; Refresh header immediately when toggling modes + ;; Fancy render: run the bar timer only across a playing span, and pre-warm + ;; the current track's cover art off the redisplay path. + (add-hook 'emms-player-started-hook #'cj/music--start-bar-timer) + (add-hook 'emms-player-started-hook #'cj/music--prewarm-art) + (add-hook 'emms-player-stopped-hook #'cj/music--stop-bar-timer) + (add-hook 'emms-player-finished-hook #'cj/music--stop-bar-timer) + + ;; Refresh header immediately when toggling modes. 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) @@ -960,9 +1645,9 @@ For URL tracks: decoded URL." ("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) - ("S" . cj/music-playlist-save) ;; Track reordering ("S-<up>" . emms-playlist-mode-shift-track-up) ("S-<down>" . emms-playlist-mode-shift-track-down) @@ -978,7 +1663,10 @@ For URL tracks: decoded URL." ;;; Radio station creation (defun cj/music-create-radio-station (name url) - "Create a radio station M3U playlist with NAME and URL in cj/music-m3u-root." + "Queue and play a radio station from a hand-entered NAME and URL. +The station becomes a url track in the playlist (NAME as its title) and +playback starts. Nothing is written to disk — save the queue with the normal +playlist save, where NAME pre-fills the prompt." (interactive (list (read-string "Radio station name: ") (read-string "Stream URL: "))) @@ -986,20 +1674,442 @@ For URL tracks: decoded URL." (user-error "Radio station name cannot be empty")) (when (string-empty-p url) (user-error "Stream URL cannot be empty")) - (let* ((safe (cj/music--safe-filename name)) - (file (expand-file-name (concat safe "_Radio.m3u") cj/music-m3u-root)) - (content (format "#EXTM3U\n#EXTINF:-1,%s\n%s\n" name url))) - (when (and (file-exists-p file) - (not (cj/confirm-strong (format "Overwrite %s? " (file-name-nondirectory file))))) - (user-error "Aborted creating radio station")) - (with-temp-file file - (insert content)) - (message "Created radio station: %s" (file-name-nondirectory file)))) - -;; Bound here rather than in the emms `:bind' so use-package does not emit a -;; redundant autoload that collides with this same-file definition. + (cj/emms--setup) + (cj/music-radio--enqueue-and-play + (list (cj/music-radio--station-track (list :name name :url url)))) + (message "Queued radio station: %s" name)) + +;; The manual name+URL creator is bound to m in the radio row below (see the +;; with-eval-after-load block near the radio-browser lookup), not R. + +;; --------------------------- Radio-browser Lookup ---------------------------- +;; Search radio-browser.info and queue a selection as playing url tracks, each +;; carrying its station metadata as track properties. Nothing is written at +;; pick time; the playlist save writes the metadata back out as .m3u comment +;; lines. Spec: docs/specs/2026-07-06-radio-browser-lookup-spec.org. The +;; pure pieces (parse / track-build / format) carry the tests; the network GET +;; and the interactive command are exercised live. + +(require 'url) + +(defvar cj/music-radio-server "de1.api.radio-browser.info" + "Default radio-browser API host. +On a connection failure the client falls back to a host from /json/servers.") + +(defvar cj/music-radio-user-agent "cj-emacs-music/1.0 (radio-browser lookup)" + "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.") + +(defvar cj/music-radio-save-dir (expand-file-name "~/.local/share/mpd/playlists/") + "Directory radio playlists are saved to (the radio home). +The playlist save targets it when every track in the queue is a stream.") + +(defun cj/music-radio--parse-search (json-text) + "Parse a radio-browser JSON-TEXT array into a list of station plists. +Signals a `user-error' rather than a raw parse error when JSON-TEXT is not +JSON (a gateway HTML page or a rate-limit notice), so a bad response reads as a +clear message instead of a stack trace." + (condition-case nil + (json-parse-string json-text :object-type 'plist :array-type 'list :null-object nil) + (error (user-error "radio-browser returned an unreadable response")))) + +(defun cj/music-radio--station-url (st) + "Best stream URL for station ST: url_resolved, then url, then nil." + (let ((r (plist-get st :url_resolved)) + (u (plist-get st :url))) + (cond ((and (stringp r) (not (string-empty-p r))) r) + ((and (stringp u) (not (string-empty-p u))) u)))) + +(defun cj/music-radio--station-track (st) + "Return an EMMS url track for station ST, or nil when it has no stream URL. +The track carries the station name as `info-title' plus `radio-uuid' and +`radio-favicon' properties, so display names and cover art need no .m3u on +disk; the playlist save writes the same metadata back out as comment lines. +Newlines in the external name/favicon are flattened so they can't inject +extra .m3u lines at save time." + (when-let ((url (cj/music-radio--station-url st))) + (let ((track (emms-track 'url url)) + (name (replace-regexp-in-string "[\r\n]+" " " + (or (plist-get st :name) "Radio"))) + (uuid (plist-get st :stationuuid)) + (favicon (plist-get st :favicon))) + (emms-track-set track 'info-title name) + (when (and (stringp uuid) (not (string-empty-p uuid))) + (emms-track-set track 'radio-uuid uuid)) + (when (and (stringp favicon) (not (string-empty-p favicon))) + (emms-track-set track 'radio-favicon + (replace-regexp-in-string "[\r\n]+" " " favicon))) + track))) + +(defun cj/music-radio--enqueue-and-play (tracks) + "Append TRACKS to the playlist buffer and play the first of them. +Interrupts whatever is playing; the rest of the queue is left in place. A nil +TRACKS is a no-op." + (when tracks + (cj/emms--setup) + (with-current-buffer (cj/music--ensure-playlist-buffer) + (let ((first-pos nil)) + (save-excursion + (dolist (tr tracks) + (goto-char (point-max)) + (unless first-pos (setq first-pos (point))) + (emms-playlist-insert-track tr))) + (emms-playlist-select first-pos))) + (when emms-player-playing-p (emms-stop)) + (emms-start))) + +(defun cj/music-radio--tags-snippet (tags n) + "Return the first N comma-separated TAGS as a trimmed display string. +TAGS is a comma-separated string or nil; nil or empty yields the empty string." + (if (and (stringp tags) (not (string-empty-p tags))) + (string-join (seq-take (split-string tags "," t "[ \t]*") n) ", ") + "")) + +(defun cj/music-radio--format-candidate (st) + "Marginalia annotation for station ST. +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 %-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. +FIELD is the search field: \"name\" (default) or \"tag\"." + (format "https://%s/json/stations/search?%s=%s&limit=%d&hidebroken=true&order=votes&reverse=true" + server (or field "name") (url-hexify-string query) cj/music-radio-search-limit)) + +(defun cj/music-radio--http-get (url) + "GET URL with the radio-browser User-Agent; return the response body or nil." + (let ((url-request-extra-headers `(("User-Agent" . ,cj/music-radio-user-agent)))) + (when-let* ((buf (url-retrieve-synchronously url t t 15))) + (with-current-buffer buf + (goto-char (point-min)) + (prog1 (when (re-search-forward "\n\n" nil t) + (buffer-substring-no-properties (point) (point-max))) + (kill-buffer buf)))))) + +(defun cj/music-radio--search-fallback (query &optional field) + "Fetch an alternate radio-browser host and retry the QUERY/FIELD search once." + (when-let* ((body (cj/music-radio--http-get + "https://all.api.radio-browser.info/json/servers")) + (servers (cj/music-radio--parse-search body)) + (host (plist-get (car servers) :name))) + (cj/music-radio--http-get (cj/music-radio--search-url host query field)))) + +(defun cj/music-radio--search (query &optional field) + "Search radio-browser for QUERY on FIELD; return a list of station plists. +FIELD is \"name\" (default) or \"tag\". Tries `cj/music-radio-server' first, +then falls back to a host from /json/servers once. Signals a `user-error' when +nothing responds." + (let ((body (or (ignore-errors + (cj/music-radio--http-get + (cj/music-radio--search-url cj/music-radio-server query field))) + (ignore-errors (cj/music-radio--search-fallback query field))))) + (unless body (user-error "radio-browser: no response (network down?)")) + (cj/music-radio--parse-search body))) + +(defun cj/music-radio--candidates (stations) + "Return an alist of (DISPLAY . STATION) for STATIONS with unique display keys. +DISPLAY is the station name; a repeated name gets its codec/bitrate appended, +then a numeric suffix, so completing-read keys never collide and each maps back +to one station. Pure helper." + (let ((seen (make-hash-table :test 'equal)) + (out '())) + (dolist (st stations (nreverse out)) + (let* ((name (string-trim (or (plist-get st :name) "(unnamed)"))) + (disp name) + (n 2)) + (when (gethash disp seen) + (setq disp (format "%s (%s%s)" name (or (plist-get st :codec) "") + (let ((b (plist-get st :bitrate))) + (if (and (integerp b) (> b 0)) (format " %dk" b) ""))))) + (while (gethash disp seen) + (setq disp (format "%s #%d" name n)) + (setq n (1+ n))) + (puthash disp t seen) + (push (cons disp st) out))))) + +(defun cj/music-radio--completion-table (candidates) + "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) + (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) + "Repeatedly prompt to pick from CANDIDATES until \"[done]\" is chosen. +CANDIDATES is a (DISPLAY . STATION) alist. Returns the chosen station plists in +selection order; each pick is removed from the pool so it can't be chosen twice." + (let ((pool (copy-sequence candidates)) + (chosen '()) + (done nil)) + (while (and (not done) pool) + (let ((pick (completing-read + (format "Add station (%d picked, RET [done] to finish): " + (length chosen)) + (cj/music-radio--completion-table (cons '("[done]") pool)) + nil t))) + (if (equal pick "[done]") + (setq done t) + (when-let ((cell (assoc pick pool))) + (push (cdr cell) chosen) + (setq pool (delq cell pool)))))) + (nreverse chosen))) + +(defun cj/music-radio--search-and-play (query field) + "Search radio-browser for QUERY on FIELD, pick stations, then queue and play. +FIELD is \"name\" or \"tag\". Lists matching stations (annotated with codec, +bitrate, country, votes, and tags), lets you pick several one at a time, 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. 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)) + (candidates (cj/music-radio--candidates stations))) + (unless candidates + (user-error "No stations found for %s %S" field query)) + (let ((chosen (cj/music-radio--pick-loop candidates))) + (unless chosen + (user-error "No stations selected")) + (let ((tracks (delq nil (mapcar #'cj/music-radio--station-track chosen))) + (skipped (cl-loop for st in chosen + unless (cj/music-radio--station-url st) + collect (or (plist-get st :name) "(unnamed)")))) + (cj/music-radio--enqueue-and-play tracks) + (message "Queued %d station%s%s%s" + (length tracks) + (if (= (length tracks) 1) "" "s") + (if skipped + (format ", skipped %d with no URL (%s)" + (length skipped) (string-join skipped ", ")) + "") + (if tracks + (format " — playing %s" + (emms-track-get (car tracks) 'info-title)) + "")))))) + +(defun cj/music-radio-search-by-name (query) + "Search radio-browser.info by station name, then queue and play a selection." + (interactive "sRadio search (name): ") + (cj/music-radio--search-and-play query "name")) + +(defun cj/music-radio--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. +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 ----------------------------------- +;; A track maps to a local cover-image path: a cached favicon/album art, or a +;; shipped vinyl placeholder. `cj/music-art--for-track' is non-blocking (it +;; reads only the cache) so the row renderer can call it during redisplay; +;; `cj/music-art--ensure' does the network fetch off the render path. The pure +;; pieces (cache key, favicon URL, image validation) carry the tests; the fetch +;; is a live smoke test. Consumed by the Phase 3 fancy render. + +(require 'image) + +(defvar cj/music-art-cache-dir + (expand-file-name "music-art/" (expand-file-name "data/" user-emacs-directory)) + "Directory holding fetched or extracted cover art, keyed by station UUID or a +file hash. Gitignored runtime state; `cj/music-clear-art-cache' empties it.") + +(defvar cj/music-art-placeholder + (expand-file-name "vinyl-placeholder.svg" + (expand-file-name "assets/" user-emacs-directory)) + "Shipped vinyl-record placeholder shown when a track has no cover art.") + +(defun cj/music-art--cache-key (track &optional entries) + "Stable cache-file basename (no extension) for TRACK. +A url with a station uuid — the track's `radio-uuid' property, else a +#RADIOBROWSERUUID in ENTRIES — keys on the uuid so a station shares one cached +logo; any other url keys on a hash of its address; a file keys on a hash of +its path." + (let ((name (emms-track-name track))) + (if (eq (emms-track-type track) 'url) + (let ((uuid (or (emms-track-get track 'radio-uuid) + (plist-get (cdr (assoc name entries)) :uuid)))) + (if (and (stringp uuid) (not (string-empty-p uuid))) + uuid + (concat "url-" (sha1 name)))) + (concat "file-" (sha1 name))))) + +(defun cj/music-art--favicon-url (track &optional entries) + "Direct favicon image URL for a url TRACK, or nil. +The track's `radio-favicon' property wins, then its captured +#RADIOBROWSERFAVICON from ENTRIES. A station with only a uuid resolves via a +byuuid lookup elsewhere; a file track has no favicon URL." + (when (eq (emms-track-type track) 'url) + (let ((fav (or (emms-track-get track 'radio-favicon) + (plist-get (cdr (assoc (emms-track-name track) entries)) + :favicon)))) + (and (stringp fav) (not (string-empty-p fav)) fav)))) + +(defun cj/music-art--valid-image-p (data) + "Non-nil when DATA looks like a displayable image (a recognizable image +header), so an empty body, an HTML error page, or a text response is rejected +before it is cached." + (and (stringp data) (not (string-empty-p data)) + (image-type-from-data data) t)) + +(defun cj/music-art--cached-file (key) + "Return an existing cached art file for KEY (any extension), or nil." + (car (file-expand-wildcards + (expand-file-name (concat key ".*") cj/music-art-cache-dir)))) + +(defun cj/music-art--file-cover (track) + "Return a sibling cover image (cover/folder/front .jpg/.jpeg/.png) next to a +file TRACK, or nil. Embedded-tag art extraction is deferred (vNext)." + (when (eq (emms-track-type track) 'file) + (when-let ((dir (file-name-directory (emms-track-name track)))) + (cl-loop for base in '("cover" "folder" "front") + thereis (cl-loop for ext in '("jpg" "jpeg" "png") + for f = (expand-file-name (concat base "." ext) dir) + when (file-exists-p f) return f))))) + +(defun cj/music-art--fetch-to-cache (url key) + "Fetch URL and, if it is a valid image, write it into the art cache under KEY. +Returns the cached path, or nil on a failed or non-image response. Blocks on +the network, so call it off the redisplay path. Only http/https URLs are +fetched, so an external favicon field can't point the reader at a file:// or +other-scheme resource." + (when-let* (((string-match-p "\\`https?://" url)) + (data (cj/music-radio--http-get url)) + ((cj/music-art--valid-image-p data))) + (make-directory cj/music-art-cache-dir t) + (let ((path (expand-file-name + (concat key "." (symbol-name (image-type-from-data data))) + cj/music-art-cache-dir)) + (coding-system-for-write 'binary)) + (with-temp-file path + (set-buffer-multibyte nil) + (insert data)) + path))) + +(defun cj/music-art--byuuid-favicon (uuid) + "Look up station UUID via radio-browser byuuid and return its favicon URL, or +nil. The fallback for a legacy station that carries a uuid but no captured +favicon. Blocks on the network." + (when-let* ((body (cj/music-radio--http-get + (format "https://%s/json/stations/byuuid/%s" + cj/music-radio-server uuid))) + (stations (ignore-errors (cj/music-radio--parse-search body))) + (fav (plist-get (car stations) :favicon))) + (and (stringp fav) (not (string-empty-p fav)) fav))) + +(defun cj/music-art--for-track (track) + "Local cover-art path for TRACK, WITHOUT any network: an already-cached file, +a sibling cover for a local file, else the vinyl placeholder. Never blocks, so +the row renderer can call it during redisplay; `cj/music-art--ensure' does the +fetch off the render path." + (let ((key (cj/music-art--cache-key track (cj/music--radio-metadata)))) + (or (cj/music-art--cached-file key) + (cj/music-art--file-cover track) + cj/music-art-placeholder))) + +(defun cj/music-art--ensure (track) + "Fetch and cache TRACK's cover art if it is not cached yet. Blocks on the +network, so call it off the redisplay path. Returns the cached path, or nil +when there is nothing to fetch." + (let* ((entries (cj/music--radio-metadata)) + (key (cj/music-art--cache-key track entries))) + (unless (cj/music-art--cached-file key) + (when (eq (emms-track-type track) 'url) + (let ((fav (or (cj/music-art--favicon-url track entries) + (let ((uuid (or (emms-track-get track 'radio-uuid) + (plist-get (cdr (assoc (emms-track-name track) + entries)) + :uuid)))) + (and (stringp uuid) (not (string-empty-p uuid)) + (cj/music-art--byuuid-favicon uuid)))))) + (and fav (cj/music-art--fetch-to-cache fav key))))))) + +(defun cj/music-clear-art-cache () + "Delete every cached cover-art file so art is re-fetched on next need." + (interactive) + (when (file-directory-p cj/music-art-cache-dir) + (dolist (f (directory-files cj/music-art-cache-dir t "\\`[^.]")) + (delete-file f))) + (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. 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 "R" #'cj/music-create-radio-station)) + (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 "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 4134f497..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) @@ -93,12 +96,12 @@ :group 'cj/nov-reading) (defcustom cj/nov-reading-palettes - '(("sepia" :face cj/nov-reading-sepia - :heading cj/nov-reading-sepia-heading - :link cj/nov-reading-sepia-link) - ("dark" :face cj/nov-reading-dark + '(("dark" :face cj/nov-reading-dark :heading cj/nov-reading-dark-heading :link cj/nov-reading-dark-link) + ("sepia" :face cj/nov-reading-sepia + :heading cj/nov-reading-sepia-heading + :link cj/nov-reading-sepia-link) ("light" :face cj/nov-reading-light :heading cj/nov-reading-light-heading :link cj/nov-reading-light-link)) @@ -114,7 +117,7 @@ palette; omit :heading or :link to leave that element at the theme's default." (plist :options ((:face face) (:heading face) (:link face)))) :group 'cj/nov-reading) -(defcustom cj/nov-reading-default-palette "sepia" +(defcustom cj/nov-reading-default-palette "dark" "Reading palette applied to a fresh nov-mode buffer. A key in `cj/nov-reading-palettes', or nil for the theme's normal rendering." :type '(choice (const :tag "None (theme default)" nil) string) @@ -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 207c286e..1e91fa48 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -50,10 +50,10 @@ :demand t :config (setq org-agenda-prefix-format '((agenda . " %i %-25:c%?-12t% s") - (timeline . " % s") (todo . " %i %-25:c") (tags . " %i %-12:c") (search . " %i %-12:c"))) + (setq org-agenda-timegrid-use-ampm t) ;; show the agenda time grid in 12-hour am/pm (setq org-agenda-dim-blocked-tasks 'invisible) (setq org-agenda-skip-scheduled-if-done nil) (setq org-agenda-remove-tags t) @@ -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-babel-config.el b/modules/org-babel-config.el index 79661013..51919da1 100644 --- a/modules/org-babel-config.el +++ b/modules/org-babel-config.el @@ -173,8 +173,5 @@ session when working in trusted files, and back on when done." ;; requires ob-racket, not yet in repositories ;; (add-to-list 'org-structure-template-alist '("sicp" . "src racket :lang sicp")) -;; drop Org’s default footnote list at the end -(setq org-html-footnote-separator "") - (provide 'org-babel-config) ;;; org-babel-config.el ends here. diff --git a/modules/org-capture-config.el b/modules/org-capture-config.el index 292e26a7..b7250f1e 100644 --- a/modules/org-capture-config.el +++ b/modules/org-capture-config.el @@ -157,6 +157,8 @@ re-scanning large target files after the first successful lookup." (interactive) (user-error "Key disabled during capture -- finalize with C-c C-c or abort with C-c C-k")) +(defvar org-capture-mode-map) + (with-eval-after-load 'org-capture (dolist (key '("<f1>" "<f10>" "<f11>" "<f12>" "M-SPC")) (keymap-set org-capture-mode-map key #'cj/--org-capture-blocked-key))) @@ -381,10 +383,10 @@ A popup still mid-capture has capture UI and is not reapable, so it is spared." (defun cj/org-capture-reap-popup-frames () "Delete every quick-capture popup frame that no longer shows capture UI. Reaps across ALL frames, not just the selected one: a capture that finalizes, -aborts, or errors while the daemon's selected frame is something else (the common -multi-frame case) still cleans up its \"org-capture\" popup, while a popup -mid-capture is spared. Never deletes the last remaining frame. Safe to call -anytime — bound to nothing, run via M-x when a stray popup needs clearing." +aborts, or errors while the daemon's selected frame is something else (the +common multi-frame case) still cleans up its \"org-capture\" popup, while a +popup mid-capture is spared. Never deletes the last remaining frame. Safe to +call anytime — bound to nothing, run via M-x when a stray popup needs clearing." (interactive) (dolist (f (frame-list)) (when (and (frame-live-p f) @@ -395,9 +397,7 @@ anytime — bound to nothing, run via M-x when a stray popup needs clearing." (window-list f 'no-minibuf)))) (delete-frame f)))) -;; Reap on every capture exit. `remove-hook' first so a live module reload swaps -;; the retired narrow (selected-frame) handler for this one without leaving both. -(remove-hook 'org-capture-after-finalize-hook #'cj/org-capture--delete-popup-frame) +;; Reap on every capture exit. (add-hook 'org-capture-after-finalize-hook #'cj/org-capture-reap-popup-frames) ;; The popup opens a fresh emacsclient frame still showing the daemon's last @@ -437,6 +437,55 @@ never split the small floating frame." '(cj/org-capture--popup-display-condition cj/org-capture--display-sole-window)) +;; A fresh "org-capture" popup opens showing the daemon's last buffer (see the +;; comment above), and only the capture UI + the reap-on-finalize hook clear it. +;; If a capture aborts before its UI paints (a C-g, an erroring template, a path +;; that skips `cj/quick-capture'), the popup lingers showing whatever was current +;; -- and if that was a live terminal (an eat/vterm Claude Code buffer), eat +;; sizes the terminal to that small popup window and clamps the real frame down +;; to the popup's rows. These two guards keep the popup from ever holding a +;; size-sensitive live buffer: it only ever shows capture UI or *scratch*. + +(defun cj/org-capture--neutralize-frame (frame) + "Point every non-capture-UI window of the \"org-capture\" popup FRAME at +*scratch*. Capture UI (the *Org Select* menu, a CAPTURE-* buffer) is spared, so +this never disturbs a live capture; it only evicts a stray live buffer (the +daemon's last buffer on open, or a buffer restored on abort) that would +otherwise mirror the popup's size onto its source buffer. Idempotent: a window +already on *scratch* is left alone, so it can't loop through the +`window-buffer-change-functions' it fires." + (when (and (frame-live-p frame) + (equal (frame-parameter frame 'name) "org-capture")) + (dolist (w (window-list frame 'no-minibuf)) + (let ((name (buffer-name (window-buffer w)))) + (unless (or (cj/org-capture--popup-sole-window-p "org-capture" name) + (equal name "*scratch*")) + (set-window-buffer w (get-buffer-create "*scratch*"))))))) + +;; Guard 1 (root cause): neutralize the popup the instant it is created, before +;; any capture UI paints, so it never opens mirroring the daemon's last buffer. +(defun cj/org-capture--neutralize-new-frame (frame) + "Neutralize a freshly-made \"org-capture\" popup FRAME on creation. +See `cj/org-capture--neutralize-frame'." + (cj/org-capture--neutralize-frame frame)) + +(add-hook 'after-make-frame-functions #'cj/org-capture--neutralize-new-frame) + +;; Guard 2 (safety net): catch any path the finalize reap misses. If a live +;; buffer is displayed in the popup after creation (an aborted capture restoring +;; the previous buffer, a stray `switch-to-buffer'), evict it at once. +(defun cj/org-capture--neutralize-on-buffer-change (frame-or-window) + "Neutralize the \"org-capture\" popup after any buffer change in FRAME-OR-WINDOW. +`window-buffer-change-functions' passes a frame (global hook) or a window +(buffer-local); handle both." + (let ((frame (if (windowp frame-or-window) + (window-frame frame-or-window) + frame-or-window))) + (cj/org-capture--neutralize-frame frame))) + +(add-hook 'window-buffer-change-functions + #'cj/org-capture--neutralize-on-buffer-change) + ;; The desktop quick-capture popup is launched globally (no browser selection, ;; no mu4e message, no pdf/epub buffer), so the context-dependent templates make ;; no sense there. `cj/quick-capture' captures a single Task straight into the diff --git a/modules/org-contacts-config.el b/modules/org-contacts-config.el index 944d75c1..39ff9910 100644 --- a/modules/org-contacts-config.el +++ b/modules/org-contacts-config.el @@ -170,29 +170,40 @@ Added: %U" (require 'system-lib) +(defun cj/--org-contacts-collect (buffer) + "Return an alist of (NAME POSITION INFO) for the contact headings in BUFFER. +NAME is the heading text, POSITION its buffer position, and INFO the +EMAIL or PHONE property value (or nil)." + (with-current-buffer buffer + (org-map-entries + (lambda () + (list (nth 4 (org-heading-components)) + (point) + (or (org-entry-get nil "EMAIL") + (org-entry-get nil "PHONE")))) + nil nil))) + (defun cj/org-contacts-find () - "Find and open a contact." + "Find a contact and jump to its heading. +Collect the contact headings before prompting, so cancelling the prompt +leaves point where it was, and jump to the selected heading's stored +position instead of a text search that could land inside another entry." (interactive) - (find-file contacts-file) - (goto-char (point-min)) - (let* ((alist (org-map-entries - (lambda () - (cons (nth 4 (org-heading-components)) - (or (org-entry-get nil "EMAIL") - (org-entry-get nil "PHONE")))) - nil (list contacts-file))) + (let* ((buf (find-file-noselect contacts-file)) + (alist (cj/--org-contacts-collect buf)) (contact (completing-read "Find contact: " (cj/completion-table-annotated 'contact (lambda (cand) - (let ((info (cdr (assoc cand alist)))) + (let ((info (nth 2 (assoc cand alist)))) (when (and info (> (length info) 0)) (concat " " (propertize info 'face 'completions-annotations))))) - alist)))) - (goto-char (point-min)) - (search-forward contact) + alist) + nil t))) + (switch-to-buffer buf) + (goto-char (nth 1 (assoc contact alist))) (org-fold-show-entry) (org-reveal))) diff --git a/modules/org-drill-config.el b/modules/org-drill-config.el index 29f6130a..f53f36b9 100644 --- a/modules/org-drill-config.el +++ b/modules/org-drill-config.el @@ -134,25 +134,42 @@ With a prefix arg OTHER-DIR, prompt for the directory instead of `drill-dir'." ;; --------------------------------- Org Drill --------------------------------- -(use-package org-drill - ;; :vc (:url "git@cjennings.net:org-drill.git" - ;; :branch "main" - ;; :rev :newest) - :load-path "~/code/org-drill" ;; local dev checkout — switch back to :vc above when done - :after (org org-capture) - :demand t - :commands (org-drill org-drill-resume) - :custom - (org-drill-leech-failure-threshold 50 "leech cards = 50 wrong answers") - (org-drill-leech-method 'warn "leech cards show warnings") - (org-drill-use-visible-cloze-face-p t "cloze text shows up in a different font") - (org-drill-hide-item-headings-p t "don't show heading text") - (org-drill-maximum-items-per-session 100 "drill sessions end after 100 cards") - (org-drill-maximum-duration 30 "each drill session can last up to 30 mins") - (org-drill-add-random-noise-to-intervals-p t "vary the days to repetition slightly") - (org-drill-text-size-during-session 24 "24-point font for comfortable reading") - (org-drill-use-variable-pitch t "variable-pitch font for readability") - (org-drill-hide-modeline-during-session t "hide the modeline for a cleaner display")) +(defconst cj/org-drill-dev-checkout (expand-file-name "org-drill" "~/code/") + "Local org-drill development checkout, preferred when it exists.") + +(defun cj/--org-drill-source-keywords (&optional checkout) + "Return the use-package source keywords for org-drill. +With CHECKOUT (default `cj/org-drill-dev-checkout') an existing directory, +load from it via :load-path. Otherwise install from upstream via :vc, so +drill still loads on a machine without the dev checkout (bare :load-path + +:demand t would fail to load there)." + (let ((dir (or checkout cj/org-drill-dev-checkout))) + (if (file-directory-p dir) + (list :load-path dir) + (list :vc '(:url "git@cjennings.net:org-drill.git" + :branch "main" + :rev :newest))))) + +;; `use-package' keywords must be literals at macro-expansion, so the +;; source keyword is spliced in through `eval' at load time (same idiom as +;; the computed flycheck checker path elsewhere in the config). +(eval + `(use-package org-drill + ,@(cj/--org-drill-source-keywords) + :after (org org-capture) + :demand t + :commands (org-drill org-drill-resume) + :custom + (org-drill-leech-failure-threshold 50 "leech cards = 50 wrong answers") + (org-drill-leech-method 'warn "leech cards show warnings") + (org-drill-use-visible-cloze-face-p t "cloze text shows up in a different font") + (org-drill-hide-item-headings-p t "don't show heading text") + (org-drill-maximum-items-per-session 100 "drill sessions end after 100 cards") + (org-drill-maximum-duration 30 "each drill session can last up to 30 mins") + (org-drill-add-random-noise-to-intervals-p t "vary the days to repetition slightly") + (org-drill-text-size-during-session 24 "24-point font for comfortable reading") + (org-drill-use-variable-pitch t "variable-pitch font for readability") + (org-drill-hide-modeline-during-session t "hide the modeline for a cleaner display"))) (provide 'org-drill-config) ;;; org-drill-config.el ends here. diff --git a/modules/org-export-config.el b/modules/org-export-config.el index 5a6f09fc..c3d3294c 100644 --- a/modules/org-export-config.el +++ b/modules/org-export-config.el @@ -20,7 +20,6 @@ ;; - HTML: Web publishing with HTML5 support ;; - Markdown: README files and web content ;; - ODT: Office documents for LibreOffice/MS Word -;; - Texinfo: GNU documentation and Info files ;; ;; Extended via Pandoc: ;; - Additional formats: DOCX, self-contained HTML5 @@ -28,7 +27,7 @@ ;; ;; Key features: ;; - UTF-8 encoding enforced across all backends -;; - Subtree export as default scope +;; - Buffer export as default scope ;; ;; Note: reveal.js presentations are handled by org-reveal-config.el (C-; p) ;; @@ -68,17 +67,8 @@ :config (setq org-html-postamble nil) (setq org-html-html5-fancy t) - (setq org-html-head-include-default-style nil)) - - -(use-package ox-texinfo - :ensure nil ; Built into Org - :defer t - :after ox - :config - (setq org-texinfo-coding-system 'utf-8) - (setq org-texinfo-default-class "info") - (add-to-list 'org-export-backends 'texinfo)) + (setq org-html-head-include-default-style nil) + (setq org-html-footnote-separator "")) ;; no separator between adjacent footnote refs (use-package ox-pandoc :defer t diff --git a/modules/org-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-reveal-config.el b/modules/org-reveal-config.el index be702bf7..f842680b 100644 --- a/modules/org-reveal-config.el +++ b/modules/org-reveal-config.el @@ -8,9 +8,10 @@ ;; Load shape: eager. ;; Eager reason: none; presentation export is a command-loaded deferral ;; candidate for Phase 4. -;; Top-level side effects: package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). -;; Direct test load: yes. +;; Top-level side effects: registers a presentation prefix keymap under +;; cj/custom-keymap; package configuration via use-package. +;; Runtime requires: keybindings. +;; Direct test load: yes (requires keybindings explicitly). ;; ;; Integrates ox-reveal for creating reveal.js presentations from Org files. ;; @@ -28,6 +29,8 @@ ;;; Code: +(require 'keybindings) ;; cj/register-prefix-map, cj/custom-keymap + ;; Forward declarations for byte-compiler (ox-reveal loaded via use-package) (defvar org-reveal-root) (defvar org-reveal-single-file) @@ -238,17 +241,25 @@ reveal.js headers pre-filled." ;; -------------------------------- Keybindings -------------------------------- -(global-set-key (kbd "C-; p SPC") #'cj/reveal-present) -(global-set-key (kbd "C-; p e") #'cj/reveal-export) -(global-set-key (kbd "C-; p p") #'cj/reveal-preview-start) -(global-set-key (kbd "C-; p s") #'cj/reveal-preview-stop) -(global-set-key (kbd "C-; p h") #'cj/reveal-insert-header) -(global-set-key (kbd "C-; p H") #'cj/reveal-remove-headers) -(global-set-key (kbd "C-; p n") #'cj/reveal-new) +;; A registered prefix keymap, not raw `global-set-key' chains: binding +;; "C-; p ..." directly depends on keybindings.el having already made "C-;" +;; a live prefix (otherwise "non-prefix key" errors), while +;; `cj/register-prefix-map' binds into `cj/custom-keymap' with no load-order +;; dependency beyond requiring keybindings. +(defvar-keymap cj/reveal-map + :doc "Keymap for reveal.js presentation commands." + "SPC" #'cj/reveal-present + "e" #'cj/reveal-export + "p" #'cj/reveal-preview-start + "s" #'cj/reveal-preview-stop + "h" #'cj/reveal-insert-header + "H" #'cj/reveal-remove-headers + "n" #'cj/reveal-new) + +(cj/register-prefix-map "p" cj/reveal-map "presentations") (with-eval-after-load 'which-key (which-key-add-key-based-replacements - "C-; p" "presentations" "C-; p SPC" "present current buffer" "C-; p e" "export & open" "C-; p p" "start live preview" diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index eca867df..e8d003e0 100644 --- a/modules/org-roam-config.el +++ b/modules/org-roam-config.el @@ -30,11 +30,14 @@ ;; 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 ;; as free references/assignments. Owned by org and org-roam-dailies. -(defvar org-agenda-timegrid-use-ampm) (defvar org-roam-dailies-map) (defvar org-last-state) @@ -77,30 +80,27 @@ FILETAGS and TITLE must sit on separate lines so Org parses the :unnarrowed t) ("v" "v2mom" plain - (file ,(concat user-emacs-directory "org-roam-templates/v2mom.org")) + (file ,(concat roam-dir "templates/v2mom.org")) :if-new (file+head "%<%Y%m%d%H%M%S>-${slug}.org" "") :unnarrowed t) ("r" "recipe" plain - (file ,(concat user-emacs-directory "org-roam-templates/recipe.org")) + (file ,(concat roam-dir "templates/recipe.org")) :if-new (file+head "recipes/%<%Y%m%d%H%M%S>-${slug}.org" "") :unnarrowed t) ("t" "topic" plain - (file ,(concat user-emacs-directory "org-roam-templates/topic.org")) + (file ,(concat roam-dir "templates/topic.org")) :if-new (file+head "%<%Y%m%d%H%M%S>-${slug}.org" "") :unnarrowed t))) :bind (("C-c n l" . org-roam-buffer-toggle) ("C-c n f" . org-roam-node-find) - ("C-c n p" . cj/org-roam-find-node-project) ("C-c n i" . org-roam-node-insert) - ("C-c n w" . cj/org-roam-find-node-webclip) :map org-mode-map ("C-M-i" . completion-at-point)) :config ;; org-log-done is set once in org-config.el (cj/org-todo-settings). - (setq org-agenda-timegrid-use-ampm t) ;; Don't build the org-refile targets cache here. org-refile-config.el ;; already schedules it on a 5s idle timer; doing it in org-roam's :config @@ -209,10 +209,17 @@ created in that subdirectory of `org-roam-directory'." (interactive) (cj/org-roam-find-node "Recipe" "r" (concat roam-dir "templates/recipe.org") "recipes/")) + +(defun cj/org-roam-find-node-project () + "List nodes of type \"Project\" in completing read for selection or creation." + (interactive) + (cj/org-roam-find-node "Project" "p" (concat roam-dir "templates/project.org"))) + ;; Bound after their defuns (not in the use-package :bind) so the byte-compiler ;; doesn't see both a :bind autoload and the real defun as two definitions. (keymap-global-set "C-c n r" #'cj/org-roam-find-node-recipe) (keymap-global-set "C-c n t" #'cj/org-roam-find-node-topic) +(keymap-global-set "C-c n p" #'cj/org-roam-find-node-project) ;; ---------------------- Org Capture After Finalize Hook ---------------------- @@ -394,36 +401,6 @@ cut stays undoable. A confirmation prompt guards large subtrees (see (org-roam-db-sync) (message "'%s' moved to a new org-roam node (%s)." title filename)))) -;; TASK: Need to decide keybindings before implementation and testing -;; (use-package consult-org-roam -;; :ensure t -;; :after org-roam -;; :init -;; (require 'consult-org-roam) -;; ;; Activate the minor mode -;; (consult-org-roam-mode 1) -;; :custom -;; ;; Use `ripgrep' for searching with `consult-org-roam-search' -;; (consult-org-roam-grep-func #'consult-ripgrep) -;; ;; Configure a custom narrow key for `consult-buffer' -;; (consult-org-roam-buffer-narrow-key ?r) -;; ;; Display org-roam buffers right after non-org-roam buffers -;; ;; in consult-buffer (and not down at the bottom) -;; (consult-org-roam-buffer-after-buffers t) -;; :config -;; ;; Eventually suppress previewing for certain functions -;; (consult-customize -;; consult-org-roam-forward-links -;; :preview-key "M-.") -;; :bind -;; ;; Define some convenient keybindings as an addition -;; ("C-c n e" . consult-org-roam-file-find) -;; ("C-c n b" . consult-org-roam-backlinks) -;; ("C-c n B" . consult-org-roam-backlinks-recursive) -;; ("C-c n l" . consult-org-roam-forward-links) -;; ("C-c n r" . consult-org-roam-search)) - - ;; which-key labels (with-eval-after-load 'which-key (which-key-add-key-based-replacements @@ -434,7 +411,6 @@ cut stays undoable. A confirmation prompt guards large subtrees (see "C-c n r" "roam find recipe" "C-c n t" "roam find topic" "C-c n i" "roam insert node" - "C-c n w" "roam find webclip" "C-c n I" "roam insert immediate" "C-c n d" "roam dailies menu")) diff --git a/modules/org-webclipper.el b/modules/org-webclipper.el index 40ceada7..217aecfa 100644 --- a/modules/org-webclipper.el +++ b/modules/org-webclipper.el @@ -186,22 +186,6 @@ Return the yanked content as a string so templates can insert it." ;; extract the webpage content from the kill ring (car kill-ring))) -;; ----------------------------- Webclipper Keymap ----------------------------- - -;; keymaps shouldn't be required for webclipper -;; Setup keymaps -;; -;; (defun cj/webclipper-setup-keymaps () -;; "Setup webclipper keymaps." -;; (define-prefix-command 'cj/webclipper-map nil -;; "Keymap for weblipper operations.") -;; (define-key cj/custom-keymap "c" 'cj/webclipper-map) -;; (define-key cj/webclipper-map "n" 'cj/move-org-branch-to-roam)) - -;; ;; Call keymap setup if cj/custom-keymap is already defined -;; (when (boundp 'cj/custom-keymap) -;; (cj/webclipper-setup-keymaps)) - ;; Register protocol handler early for external calls (with-eval-after-load 'org-protocol (unless (assoc "webclip" org-protocol-protocol-alist) @@ -211,9 +195,5 @@ Return the yanked content as a string so templates can insert it." :function cj/org-protocol-webclip :kill-client t)))) -;; (with-eval-after-load 'cj/custom-keymap -;; (require 'org-webclipper) -;; (cj/webclipper-setup-keymaps)) - (provide 'org-webclipper) ;;; org-webclipper.el ends here diff --git a/modules/pdf-config.el b/modules/pdf-config.el index a5dc3c49..b5a3e217 100644 --- a/modules/pdf-config.el +++ b/modules/pdf-config.el @@ -8,10 +8,18 @@ ;; Load shape: eager. ;; Eager reason: none; heavy PDF packages should load on PDF open, a file/mode ;; deferral candidate. -;; Top-level side effects: package configuration via use-package. +;; Top-level side effects: a defgroup, defcustoms, a defvar-local, and package +;; configuration via use-package. ;; Runtime requires: none (configures packages via use-package). ;; Direct test load: yes. ;; +;; A reading-view palette layer sits on top of pdf-tools: a fresh PDF opens in +;; the "dark" tint, and `c' cycles dark -> sepia -> light -> none, mirroring the +;; nov-mode reading view (see nov-reading.el). Each palette is a (FG . BG) cons +;; driven through `pdf-view-midnight-minor-mode', which recolors the rendered +;; page as a duotone -- so "sepia" and "light" are the same mechanism as the +;; built-in midnight mode, just with warmer / lighter color pairs. +;; ;;; Code: ;; ------------------------------- Declarations -------------------------------- @@ -30,13 +38,107 @@ (declare-function cj/open-file-with-command "system-utils") (declare-function cj/org-noter-insert-note-dwim "org-noter-config") +;; `pdf-view-midnight-colors' lives in pdf-view.el, which loads lazily on the +;; first PDF open. Declare it special so the `setq-local' below compiles as a +;; dynamic binding rather than a lexical no-op. +(defvar pdf-view-midnight-colors) + +;; ------------------------------ Reading palettes ----------------------------- +;; pdf-view has no sepia/light of its own -- only a binary midnight toggle. This +;; layer generalizes that toggle into a named palette cycle: `pdf-view-midnight- +;; minor-mode' recolors the page from a (FG . BG) pair, so any tint is just a +;; different pair. Colors mirror the nov-reading palettes for a consistent read +;; across EPUBs and PDFs; tune them there and here together. + +(defgroup cj/pdf-reading nil + "Reading-view theming for pdf-view PDFs." + :group 'cj) + +(defcustom cj/pdf-reading-palettes + '(("dark" . ("#cfc8b8" . "#15140f")) + ("sepia" . ("#c9b187" . "#1f1b16")) + ("light" . ("#2a2622" . "#ece3cf"))) + "Alist of reading-palette NAME -> (FOREGROUND . BACKGROUND) for pdf-view. +Each value is the color pair `pdf-view-midnight-minor-mode' renders the page +with (white maps to BACKGROUND, black to FOREGROUND). The selector and cycle +commands choose among these names; add an entry to add a palette." + :type '(alist :key-type string + :value-type (cons (string :tag "Foreground") + (string :tag "Background"))) + :group 'cj/pdf-reading) + +(defcustom cj/pdf-reading-default-palette "dark" + "Reading palette applied to a freshly opened PDF. +A key in `cj/pdf-reading-palettes', or nil for the PDF's native colors." + :type '(choice (const :tag "None (native colors)" nil) string) + :group 'cj/pdf-reading) + +(defvar-local cj/pdf--reading-palette nil + "Name of the reading palette active in this pdf buffer, or nil for none.") + +(defun cj/pdf--reading-palette-colors (name) + "Return the (FOREGROUND . BACKGROUND) cons for palette NAME, or nil when unknown. +NAME nil (the no-palette state) and unknown names both yield nil." + (cdr (assoc name cj/pdf-reading-palettes))) + +(defun cj/pdf--next-reading-palette (current names) + "Return the palette after CURRENT in the cycle NAMES then nil, wrapping. +CURRENT nil is the no-palette state, and a returned nil means no palette. An +unknown CURRENT falls back to the first palette." + (let* ((cycle (append names (list nil))) + (tail (cdr (member current cycle)))) + (car (or tail cycle)))) + +(defun cj/pdf--apply-reading-palette (name) + "Apply reading palette NAME to this pdf buffer; NAME nil removes any palette. +Drives `pdf-view-midnight-minor-mode' with the palette's (FG . BG) colors so the +page renders as a duotone in the reading tint. An unknown or nil NAME turns +midnight mode off, restoring the PDF's native colors." + (let ((colors (cj/pdf--reading-palette-colors name))) + (if colors + (progn + (setq-local pdf-view-midnight-colors colors) + (pdf-view-midnight-minor-mode 1) + (setq cj/pdf--reading-palette name)) + (pdf-view-midnight-minor-mode -1) + (setq cj/pdf--reading-palette nil)))) + +(defun cj/pdf-set-reading-palette (name) + "Choose reading palette NAME for this pdf buffer; \"none\" clears it. +Interactively prompts among `cj/pdf-reading-palettes' plus \"none\"." + (interactive + (list (completing-read "Reading palette: " + (cons "none" (mapcar #'car cj/pdf-reading-palettes)) + nil t))) + (unless (derived-mode-p 'pdf-view-mode) + (user-error "Not in a pdf-view-mode buffer")) + (cj/pdf--apply-reading-palette (unless (equal name "none") name)) + (message "Reading palette: %s" (or cj/pdf--reading-palette "none"))) + +(defun cj/pdf-cycle-reading-palette () + "Cycle to the next reading palette, then the no-palette state, wrapping." + (interactive) + (unless (derived-mode-p 'pdf-view-mode) + (user-error "Not in a pdf-view-mode buffer")) + (let ((next (cj/pdf--next-reading-palette + cj/pdf--reading-palette + (mapcar #'car cj/pdf-reading-palettes)))) + (cj/pdf--apply-reading-palette next) + (message "Reading palette: %s" (or next "none")))) + +(defun cj/pdf-reading-setup () + "Apply the default reading palette to a freshly opened PDF. +Called from the `pdf-view-mode' launch hook." + (when cj/pdf-reading-default-palette + (cj/pdf--apply-reading-palette cj/pdf-reading-default-palette))) + ;; --------------------------------- PDF Tools --------------------------------- (use-package pdf-tools :defer t :mode (("\\.pdf\\'" . pdf-view-mode)) :hook - (pdf-view-mode . pdf-view-midnight-minor-mode) + (pdf-view-mode . cj/pdf-reading-setup) :custom (pdf-view-display-size 'fit-page) (pdf-view-resize-factor 1.1) @@ -61,7 +163,11 @@ (with-current-buffer buf (when (eq major-mode 'pdf-view-mode) (revert-buffer nil t)))) - (define-key pdf-view-mode-map "M" #'pdf-view-midnight-minor-mode) + ;; Reading palette: c cycles dark -> sepia -> light -> none, C selects by name. + ;; M keeps the old midnight key working, now as the cycle. + (define-key pdf-view-mode-map "c" #'cj/pdf-cycle-reading-palette) + (define-key pdf-view-mode-map "C" #'cj/pdf-set-reading-palette) + (define-key pdf-view-mode-map "M" #'cj/pdf-cycle-reading-palette) (define-key pdf-view-mode-map "m" #'bookmark-set) (define-key pdf-view-mode-map (kbd "C-=") #'pdf-view-enlarge) (define-key pdf-view-mode-map (kbd "C--") #'pdf-view-shrink) 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 831f43cb..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)) @@ -409,46 +419,129 @@ defer to `electric-pair-default-inhibit' for any other CHAR." (setq ws-butler-convert-leading-tabs-or-spaces t)) ;; ------------------------------------ LSP ------------------------------------ -;; Language Server Protocol for intelligent code completion and navigation -;; Works with multiple languages: C, Python, Go, Rust, JavaScript, etc. - -;; Forward declarations for LSP variables +;; Language Server Protocol for intelligent code completion and navigation. +;; Single owner of generic LSP policy (prog-lsp.el folded in and removed +;; 2026-07-10). Language-specific server variables and the lsp-deferred mode +;; hooks stay in the per-language modules. Reference for what to turn off: +;; https://emacs-lsp.github.io/lsp-mode/tutorials/how-to-turn-off/ + +;; Forward declarations for byte-compile. lsp-mode's defcustoms aren't loaded +;; under `make test' (no package-initialize) and use-package defers the package +;; via :commands, so these vars are unknown at compile time without declaring. +(defvar lsp-mode-map) +(defvar eldoc-documentation-functions) +(defvar lsp-file-watch-ignored-directories) +(defvar lsp-enable-remote) +(defvar lsp-auto-guess-root) +(defvar lsp-restart) (defvar lsp-idle-delay) (defvar lsp-log-io) (defvar lsp-enable-folding) +(defvar lsp-enable-imenu) (defvar lsp-enable-snippet) +(defvar lsp-enable-symbol-highlighting) +(defvar lsp-enable-on-type-formatting) +(defvar lsp-signature-auto-activate) +(defvar lsp-signature-render-documentation) +(defvar lsp-modeline-code-actions-enable) +(defvar lsp-modeline-diagnostics-enable) (defvar lsp-headerline-breadcrumb-enable) +(defvar lsp-semantic-tokens-enable) (defvar lsp-completion-provider) (defvar lsp-completion-show-detail) (defvar lsp-completion-show-kind) +(declare-function lsp-eldoc-function "lsp-mode") + +;; File-watch ignore patterns. lsp-mode prompts when a workspace exceeds +;; `lsp-file-watch-threshold' (1000) directories. Real source repos cross that +;; once node_modules, build outputs, and language caches are counted. These +;; extend the lsp-mode defaults (.git, .svn, .idea, ...) instead of replacing +;; them. A buffer-local override via `.dir-locals.el' doesn't work: lsp-mode +;; reads the global value at workspace init, not the buffer-local one, so the +;; defaults live here globally. +(defvar cj/lsp-file-watch-ignored-extras + '("[/\\\\]node_modules\\'" + "[/\\\\]\\.ruff_cache\\'" + "[/\\\\]dist\\'" + "[/\\\\]coverage\\'" + "[/\\\\]test-results\\'" + "[/\\\\]playwright-report\\'" + "[/\\\\]tf[/\\\\]\\.terraform\\'" + "[/\\\\]__pycache__\\'" + "[/\\\\]\\.venv\\'" + "[/\\\\]venv\\'" + "[/\\\\]\\.pytest_cache\\'" + "[/\\\\]\\.mypy_cache\\'" + "[/\\\\]target\\'") + "Build/cache directory patterns to add to `lsp-file-watch-ignored-directories'. +Each entry is an Emacs regex matching a path ending in the named directory.") + +(defun cj/lsp--add-file-watch-ignored-extras () + "Append `cj/lsp-file-watch-ignored-extras' to lsp-mode's ignore list. +Idempotent — `add-to-list' skips patterns already present." + (dolist (pattern cj/lsp-file-watch-ignored-extras) + (add-to-list 'lsp-file-watch-ignored-directories pattern))) + +(defun cj/lsp--remove-eldoc-provider-global () + "Remove lsp-mode's provider from the global `eldoc-documentation-functions'. +Run once after lsp-mode loads. The previous per-buffer removal raced +lsp's own buffer-local add: the buffer-local remove fired before lsp +populated the buffer-local hook (lsp inherits the global default and +mutates from there), so the buffer-local hook ended up holding the +provider anyway. Removing globally before lsp ever attaches a buffer +makes the absence stick for every subsequent lsp-managed buffer." + (remove-hook 'eldoc-documentation-functions #'lsp-eldoc-function)) (use-package lsp-mode :commands (lsp lsp-deferred) + :bind (:map lsp-mode-map + ("C-c d" . lsp-describe-thing-at-point) + ("C-c a" . lsp-execute-code-action)) :custom (lsp-keymap-prefix "C-c l") ;; LSP commands under C-c l prefix + :init + (setq lsp-enable-remote nil) ;; Don't start LSP on TRAMP files (slow, prompts for root) :config - ;; Performance optimizations - (setq lsp-idle-delay 0.1) + ;; Quiet, performance-first policy + (setq lsp-idle-delay 0.5) (setq lsp-log-io nil) + (setq lsp-auto-guess-root t) + (setq lsp-restart 'auto-restart) (setq lsp-enable-folding nil) - (setq lsp-enable-snippet t) + (setq lsp-enable-imenu nil) + (setq lsp-enable-snippet nil) + (setq lsp-enable-symbol-highlighting nil) + (setq lsp-enable-on-type-formatting nil) + (setq lsp-signature-auto-activate nil) + (setq lsp-signature-render-documentation nil) + (setq lsp-modeline-code-actions-enable nil) + (setq lsp-modeline-diagnostics-enable nil) (setq lsp-headerline-breadcrumb-enable nil) - - ;; Improve completion + (setq lsp-semantic-tokens-enable nil) + (setq read-process-output-max (* 1024 1024)) ;; 1MB + ;; Completion (setq lsp-completion-provider :capf) (setq lsp-completion-show-detail t) - (setq lsp-completion-show-kind t)) + (setq lsp-completion-show-kind t) + ;; Strip lsp's global eldoc provider once (see the helper for the race note). + (cj/lsp--remove-eldoc-provider-global) + (cj/lsp--add-file-watch-ignored-extras)) (use-package lsp-ui :after lsp-mode :commands lsp-ui-mode :custom - (lsp-ui-doc-enable t) + (lsp-ui-doc-enable nil) (lsp-ui-doc-position 'at-point) (lsp-ui-doc-delay 0.5) + (lsp-ui-doc-header t) + (lsp-ui-doc-include-signature t) + (lsp-ui-doc-border (face-foreground 'default)) (lsp-ui-sideline-enable t) (lsp-ui-sideline-show-diagnostics t) (lsp-ui-sideline-show-hover nil) + (lsp-ui-sideline-show-code-actions nil) + (lsp-ui-sideline-delay 0.05) (lsp-ui-peek-enable t) (lsp-ui-peek-show-directory t)) diff --git a/modules/prog-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-json.el b/modules/prog-json.el index e7abd182..66f4c5f2 100644 --- a/modules/prog-json.el +++ b/modules/prog-json.el @@ -62,9 +62,14 @@ back to the built-in `json-pretty-print-buffer-ordered'." ;; interactive jq queries against JSON buffers (use-package jq-mode - :defer t - :bind (:map json-ts-mode-map - ("C-c C-q" . jq-interactively))) + :defer t) + +;; Bind on json-ts-mode's own map, keyed to its load. The old +;; :bind (:map json-ts-mode-map ...) inside the jq-mode use-package deferred +;; the binding to jq-mode's load -- which nothing triggered, so the key was +;; dead. jq-interactively is autoloaded, so pressing the key loads jq-mode. +(with-eval-after-load 'json-ts-mode + (keymap-set json-ts-mode-map "C-c C-q" #'jq-interactively)) (provide 'prog-json) ;;; prog-json.el ends here. diff --git a/modules/prog-lisp.el b/modules/prog-lisp.el index ba568c9c..16740507 100644 --- a/modules/prog-lisp.el +++ b/modules/prog-lisp.el @@ -119,8 +119,12 @@ (use-package package-lint :commands (package-lint-current-buffer package-lint-batch-and-exit)) +;; Load when flycheck does. The old `:after (flycheck package-lint)' never +;; fired: nothing loads package-lint on its own (it is flycheck-package's +;; dependency, pulled in by its require), so the setup silently never ran +;; and elisp buffers never got the package-lint checker. (use-package flycheck-package - :after (flycheck package-lint) + :after flycheck :config (flycheck-package-setup)) diff --git a/modules/prog-lsp.el b/modules/prog-lsp.el deleted file mode 100644 index 1c74bcc1..00000000 --- a/modules/prog-lsp.el +++ /dev/null @@ -1,110 +0,0 @@ -;;; prog-lsp.el --- Setup for LSP Mode -*- lexical-binding: t; coding: utf-8; -*- -;; author: Craig Jennings <c@cjennings.net> - -;;; Commentary: - -;; good reference as to what to enable/disable in lsp-mode -;; https://emacs-lsp.github.io/lsp-mode/tutorials/how-to-turn-off/ - -;;; Code: - -;; Forward declarations for byte-compile and let-binding under lexical scope. -;; Real definitions are lsp-mode's defcustoms. -(defvar eldoc-documentation-functions) -(defvar lsp-file-watch-ignored-directories) -(defvar lsp-enable-remote) - -(declare-function lsp-eldoc-function "lsp-mode") - -;;;;; --------------------- File-Watch Ignore Patterns --------------------- -;; lsp-mode prompts when a workspace exceeds `lsp-file-watch-threshold' (1000) -;; directories. Real source repos cross that line easily once node_modules, -;; build outputs, and language caches are counted. These patterns extend the -;; lsp-mode defaults (.git, .svn, .idea, ...) instead of replacing them, so the -;; built-in VC/IDE excludes still apply. Buffer-local overrides via -;; `.dir-locals.el' don't work — lsp-mode reads the global value at workspace -;; init, not the buffer-local one. Hence: global defaults here. - -(defvar cj/lsp-file-watch-ignored-extras - '("[/\\\\]node_modules\\'" - "[/\\\\]\\.ruff_cache\\'" - "[/\\\\]dist\\'" - "[/\\\\]coverage\\'" - "[/\\\\]test-results\\'" - "[/\\\\]playwright-report\\'" - "[/\\\\]tf[/\\\\]\\.terraform\\'" - "[/\\\\]__pycache__\\'" - "[/\\\\]\\.venv\\'" - "[/\\\\]venv\\'" - "[/\\\\]\\.pytest_cache\\'" - "[/\\\\]\\.mypy_cache\\'" - "[/\\\\]target\\'") - "Build/cache directory patterns to add to `lsp-file-watch-ignored-directories'. -Each entry is an Emacs regex matching a path ending in the named directory.") - -(defun cj/lsp--add-file-watch-ignored-extras () - "Append `cj/lsp-file-watch-ignored-extras' to lsp-mode's ignore list. -Idempotent — `add-to-list' skips patterns already present." - (dolist (pattern cj/lsp-file-watch-ignored-extras) - (add-to-list 'lsp-file-watch-ignored-directories pattern))) - -(defun cj/lsp--remove-eldoc-provider-global () - "Remove lsp-mode's provider from the global `eldoc-documentation-functions'. -Run once after lsp-mode loads. The previous per-buffer removal raced -lsp's own buffer-local add: the buffer-local remove fired before lsp -populated the buffer-local hook (lsp inherits the global default and -mutates from there), so the buffer-local hook ended up holding the -provider anyway. Removing globally before lsp ever attaches a buffer -makes the absence stick for every subsequent lsp-managed buffer." - (remove-hook 'eldoc-documentation-functions #'lsp-eldoc-function)) - -;;;;; ---------------------------- LSP Mode --------------------------- - -(use-package lsp-mode - :hook - ((c-mode c++-mode go-mode js-mode js-jsx-mode typescript-mode python-mode web-mode) . lsp-deferred) - :commands (lsp) - :bind (:map lsp-mode-map - ("C-c d" . lsp-describe-thing-at-point) - ("C-c a" . lsp-execute-code-action)) - :bind-keymap ("C-c L" . lsp-command-map) - :init - (setq lsp-enable-remote nil) ;; Don't start LSP on TRAMP files (slow, prompts for project root) - :config - (setq lsp-auto-guess-root t) - (setq lsp-log-io nil) - (setq lsp-restart 'auto-restart) - (setq lsp-enable-symbol-highlighting nil) - (setq lsp-enable-on-type-formatting nil) - (setq lsp-signature-auto-activate nil) - (setq lsp-signature-render-documentation nil) - ;; Strip lsp-mode's eldoc provider from the GLOBAL hook value once, - ;; not per buffer. See `cj/lsp--remove-eldoc-provider-global' for - ;; why per-buffer racing didn't stick. - (cj/lsp--remove-eldoc-provider-global) - (setq lsp-modeline-code-actions-enable nil) - (setq lsp-modeline-diagnostics-enable nil) - (setq lsp-headerline-breadcrumb-enable nil) - (setq lsp-semantic-tokens-enable nil) - (setq lsp-enable-folding nil) - (setq lsp-enable-imenu nil) - (setq lsp-enable-snippet nil) - (setq read-process-output-max (* 1024 1024)) ;; 1MB - (setq lsp-idle-delay 0.5) - (cj/lsp--add-file-watch-ignored-extras)) - -;;;;; ----------------------------- LSP UI ---------------------------- - -(use-package lsp-ui - :after lsp-mode - :commands lsp-ui-mode - :config - (setq lsp-ui-doc-enable nil) - (setq lsp-ui-doc-header t) - (setq lsp-ui-doc-include-signature t) - (setq lsp-ui-doc-border (face-foreground 'default)) - (setq lsp-ui-sideline-show-code-actions nil) ;; turn off code actions in sidebar - (setq lsp-ui-sideline-delay 0.05)) - -(provide 'prog-lsp) -;;; prog-lsp.el ends here diff --git a/modules/prog-python.el b/modules/prog-python.el index 6354bd90..91670ec0 100644 --- a/modules/prog-python.el +++ b/modules/prog-python.el @@ -69,9 +69,12 @@ Install with: pip install mypy") (setq-local indent-tabs-mode nil) ;; disable tab characters (electric-pair-local-mode t) ;; match delimiters automatically (buffer-local) - ;; Enable LSP if available + ;; Enable LSP if available. lsp-pyright is required here, inside the + ;; guard, so a pyright-less machine never loads it and never sees the + ;; LSP attach prompt the guard exists to prevent. (when (and (fboundp 'lsp-deferred) (executable-find pyright-path)) + (require 'lsp-pyright nil t) (lsp-deferred))) (defun cj/--python-mypy-command (target) @@ -111,8 +114,12 @@ Overrides default prog-mode keybindings with Python-specific commands." (use-package python :ensure nil ;; built-in :hook + ;; Both variants: treesit-auto falls back to classic python-mode when the + ;; grammar is unavailable, and that fallback should keep the same setup. ((python-ts-mode . cj/python-setup) - (python-ts-mode . cj/python-mode-keybindings)) + (python-ts-mode . cj/python-mode-keybindings) + (python-mode . cj/python-setup) + (python-mode . cj/python-mode-keybindings)) :custom (python-shell-interpreter "python3") :config @@ -126,10 +133,12 @@ Overrides default prog-mode keybindings with Python-specific commands." ;; Python-specific LSP configuration via pyright ;; Core LSP setup is in prog-general.el +;; No :hook here: the old unguarded (require 'lsp-pyright) + (lsp-deferred) +;; lambda ran on every python-ts buffer, so pyright-less machines got the +;; LSP attach prompt cj/python-setup's guard exists to prevent. The guarded +;; branch in cj/python-setup owns the require and the attach. (use-package lsp-pyright - :hook (python-ts-mode . (lambda () - (require 'lsp-pyright) - (lsp-deferred)))) + :defer t) ;; ----------------------------------- Poetry ---------------------------------- ;; virtual environments and dependencies diff --git a/modules/prog-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-training.el b/modules/prog-training.el index 41f3053b..d38208ee 100644 --- a/modules/prog-training.el +++ b/modules/prog-training.el @@ -17,6 +17,7 @@ ;;; Code: +(defvar code-dir) ;; user-constants.el; read lazily in leetcode's :config ;; ----------------------------- Exercism ---------------------------- @@ -33,9 +34,9 @@ :defer t :commands (leetcode) :bind ("C-h L" . leetcode) - :custom - (url-debug t) :config + ;; No (url-debug t) here: that was a debugging leftover, and it turned on + ;; GLOBAL url.el request logging for the whole session once leetcode loaded. (setq leetcode-prefer-language "golang") (setq leetcode-directory (concat code-dir "/leetcode")) (setq leetcode-save-solutions t)) diff --git a/modules/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 7f7f9a47..47fbf7c7 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -41,7 +41,9 @@ (vertico-cycle t) ; Cycle through candidates (vertico-count 10) ; Number of candidates to display (vertico-resize nil) ; Don't resize the minibuffer - (vertico-sort-function #'vertico-sort-history-alpha) ; History first, then alphabetical + ;; Sorting is owned by `vertico-prescient-mode' (frecency). A + ;; `vertico-sort-function' set here is overridden inside every vertico + ;; session, so it is omitted rather than left as dead config. :bind (:map vertico-map ("C-j" . vertico-next) ("C-k" . vertico-previous) @@ -223,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/show-kill-ring.el b/modules/show-kill-ring.el deleted file mode 100644 index e65d48b5..00000000 --- a/modules/show-kill-ring.el +++ /dev/null @@ -1,122 +0,0 @@ -;;; show-kill-ring.el --- Displays Previous Kill Ring Entries -*- lexical-binding: t; coding: utf-8; -*- -;; Show Kill Ring -;; Stolen from Steve Yegge when he wasn't looking -;; enhancements and bugs added by Craig Jennings <c@cjennings.net> -;; -;;; Commentary: -;; Browse items you've previously killed. -;; Yank text using C-u, the index, then C-y. -;; -;; I've lovingly kept the nice 1970s aesthetic, complete with wood paneling. -;; Maybe I'll give it a makeover at some point. -;; -;;; Code: - -(require 'cl-lib) - -(defvar show-kill-max-item-size 1000 - "This represents the size of a \='kill ring\=' entry. -A positive number means to limit the display of \='kill-ring\=' items to -that number of characters.") - -(defun show-kill-ring-exit () - "Exit the show-kill-ring buffer." - (interactive) - (quit-window t)) - -(defun show-kill-ring () - "Show the current contents of the kill ring in a separate buffer. -This makes it easy to figure out which prefix to pass to yank." - (interactive) - ;; kill existing one, since erasing it doesn't work - (let ((buf (get-buffer "*Kill Ring*"))) - (and buf (kill-buffer buf))) - - (let* ((buf (get-buffer-create "*Kill Ring*")) - (temp kill-ring) - (count 1) - (bar (make-string 32 ?=)) - (bar2 (concat " " bar)) - (item " Item ") - (yptr nil) (ynum 1)) - (set-buffer buf) - (erase-buffer) - - (show-kill-insert-header) - - ;; show each of the items in the kill ring, in order - (while temp - ;; insert our little divider - (insert (concat "\n" bar item (prin1-to-string count) " " - (if (< count 10) bar2 bar) "\n")) - - ;; if this is the yank pointer target, grab it - (when (equal temp kill-ring-yank-pointer) - (setq yptr (car temp) ynum count)) - - ;; insert the item and loop - (show-kill-insert-item (car temp)) - (cl-incf count) - (setq temp (cdr temp))) - - ;; show info about yank item - (show-kill-insert-footer yptr ynum) - - ;; use define-key instead of local-set-key - (use-local-map (make-sparse-keymap)) - (define-key (current-local-map) "q" #'show-kill-ring-exit) - - ;; show it - (goto-char (point-min)) - (setq buffer-read-only t) - (set-buffer-modified-p nil) - ;; display-buffer rather than pop-to-buffer - ;; easier for user to C-u (item#) C-y - ;; while the point is where they want to yank - (display-buffer buf))) - -(defun show-kill-insert-item (item) - "Insert an ITEM from the kill ring into the current buffer. -If it's too long, truncate it first." - (let ((max show-kill-max-item-size)) - (cond - ((or (not (numberp max)) - (< max 0) - (< (length item) max)) - (insert item)) - (t - ;; put ellipsis on its own line if item is longer than 1 line - (let ((preview (substring item 0 max))) - (if (< (length item) (- (frame-width) 5)) - (insert (concat preview "...")) - (insert (concat preview "\n...")))))))) - -(defun show-kill-insert-header () - "Insert the show-kill-ring header or a notice if the kill ring is empty." - (if kill-ring - (insert "Contents of the kill ring:\n") - (insert "The kill ring is empty"))) - -(defun show-kill-insert-footer (yptr ynum) - "Insert final divider and the yank-pointer (YPTR YNUM) info." - (when kill-ring - (save-excursion - (re-search-backward "^\\(=+ Item [0-9]+ =+\\)$")) - (insert "\n") - (insert (make-string (length (match-string 1)) ?=)) - ;; Use number-to-string instead of int-to-string - (insert (concat "\n\nItem " (number-to-string ynum) - " is the next to be yanked:\n\n")) - (show-kill-insert-item yptr) - (insert "\n\nThe prefix arg will yank relative to this item."))) - -(defun empty-kill-ring () - "Force garbage collection of huge kill ring entries that I don't care about." - (interactive) - (setq kill-ring nil) - (garbage-collect)) - -(keymap-global-set "M-S-k" #'show-kill-ring) ;; was M-K, overrides kill-sentence - -(provide 'show-kill-ring) -;;; show-kill-ring.el ends here diff --git a/modules/signal-config.el b/modules/signal-config.el deleted file mode 100644 index edb7d0dc..00000000 --- a/modules/signal-config.el +++ /dev/null @@ -1,357 +0,0 @@ -;;; signal-config.el --- Signal client (forked signel) configuration -*- lexical-binding: t -*- - -;;; Commentary: -;; cj/-namespaced configuration and helpers layered on the forked `signel' -;; package, a Signal client that drives signal-cli over JSON-RPC. -;; -;; This file currently holds the pure, signal-cli-independent helper layer -;; that the fork edits and `use-package' wiring build on: -;; - contact-list parsing for a completing-read contact picker, and -;; - the predicate that suppresses a notification for the chat the user -;; is actively viewing. -;; Both are unit-tested without a linked account. The use-package wiring, -;; keybindings, and the signel fork edits that call these helpers land once -;; signal-cli is installed and the device is linked. - -;;; Code: - -(require 'seq) -(require 'keybindings) ;; provides cj/custom-keymap + cj/register-prefix-map -(require 'system-lib) ;; for cj/executable-find-or-warn - -(declare-function notifications-notify "notifications") - -(defun cj/signal--jstr (value) - "Return VALUE if it is a non-blank string, else nil. -Normalizes a JSON field that may arrive as nil, the empty string, or a -null sentinel symbol into a plain string-or-nil." - (and (stringp value) - (not (string-empty-p (string-trim value))) - value)) - -(defun cj/signal--combine-name (given family) - "Join GIVEN and FAMILY name parts into a trimmed full name, or nil. -Either part may be nil, the empty string, or a JSON null sentinel." - (let ((parts (delq nil (list (cj/signal--jstr given) (cj/signal--jstr family))))) - (cj/signal--jstr (mapconcat #'identity parts " ")))) - -(defun cj/signal--contact-display-name (contact) - "Return a display name for CONTACT, or nil when none is set. -CONTACT is one entry alist from signal-cli `listContacts'. Picks the -first set source in priority order: the nickname (combined nickName, or -nickGivenName+nickFamilyName), the stored contact name, the top-level -givenName+familyName, the profile givenName+familyName, then username. -signal-cli 0.14 puts givenName/familyName at the top level; the profile -sub-object's name fields are usually null, so it is the deeper fallback." - (let ((profile (alist-get 'profile contact))) - (seq-find - #'cj/signal--jstr - (list (cj/signal--jstr (alist-get 'nickName contact)) - (cj/signal--combine-name (alist-get 'nickGivenName contact) - (alist-get 'nickFamilyName contact)) - (cj/signal--jstr (alist-get 'name contact)) - (cj/signal--combine-name (alist-get 'givenName contact) - (alist-get 'familyName contact)) - (cj/signal--combine-name (alist-get 'givenName profile) - (alist-get 'familyName profile)) - (cj/signal--jstr (alist-get 'username contact)))))) - -(defun cj/signal--parse-contacts (result) - "Parse RESULT from signal-cli `listContacts' into a completing-read alist. -RESULT is the JSON-RPC result value: a sequence (list or vector) of -contact alists. Returns an alist of (LABEL . RECIPIENT) sorted by LABEL, -where RECIPIENT is the contact's phone number (falling back to its UUID) -and LABEL is \"Name (recipient)\" when a name is known, or the bare -recipient otherwise. Contacts with no usable recipient are dropped." - (let (pairs) - (dolist (contact (append result nil)) - (let ((recipient (or (cj/signal--jstr (alist-get 'number contact)) - (cj/signal--jstr (alist-get 'uuid contact)))) - (name (cj/signal--contact-display-name contact))) - (when recipient - (push (cons (if name (format "%s (%s)" name recipient) recipient) - recipient) - pairs)))) - (sort pairs (lambda (a b) (string-lessp (car a) (car b)))))) - -(defun cj/signal--chat-buffer-name (id) - "Return the chat buffer name `signel' uses for chat ID." - (format "*Signel: %s*" id)) - -(defun cj/signal--suppress-notify-p (chat-id viewing-buffer-name frame-focused) - "Return non-nil when a notification for CHAT-ID should be suppressed. -Suppress only while the user is actively viewing that chat: the chat -buffer named by `cj/signal--chat-buffer-name' is VIEWING-BUFFER-NAME and -FRAME-FOCUSED is non-nil. A nil VIEWING-BUFFER-NAME or an unfocused -frame never suppresses." - (and frame-focused - (stringp viewing-buffer-name) - (string= viewing-buffer-name (cj/signal--chat-buffer-name chat-id)))) - -(defun cj/signal--frame-focused-p () - "Return non-nil when the selected frame currently has input focus. -Treats an unknown focus state as focused." - (if (fboundp 'frame-focus-state) - (let ((state (frame-focus-state))) - (if (eq state 'unknown) t state)) - t)) - -(defun cj/signal--should-notify-p (chat-id) - "Return non-nil when an incoming message for CHAT-ID should notify. -Notify unless the user is actively viewing that chat in the selected -window of a focused frame." - (not (cj/signal--suppress-notify-p - chat-id - (buffer-name (window-buffer (selected-window))) - (cj/signal--frame-focused-p)))) - -;;; Notifications - -(defcustom cj/signel-notify-sound nil - "When non-nil, incoming-message notifications play the notify script's sound. -Nil (the default) passes --silent so the toast is visual only." - :type 'boolean - :group 'signel) - -(defconst cj/signal--notify-body-max 120 - "Maximum character length of a desktop-notification body. -Longer message text truncates to this length ending in an ellipsis; -the full text is always in the chat buffer.") - -(defun cj/signal--format-notify-body (text) - "Collapse whitespace in TEXT and truncate it for a notification body. -Whitespace runs (including newlines) become single spaces, the result -is trimmed, and anything over `cj/signal--notify-body-max' characters -truncates to that length with a trailing ellipsis." - (let ((flat (string-trim (replace-regexp-in-string "[ \t\n\r]+" " " text)))) - (if (<= (length flat) cj/signal--notify-body-max) - flat - (concat (substring flat 0 (1- cj/signal--notify-body-max)) "…")))) - -(defun cj/signel--notify (chat-id sender body) - "Raise a desktop notification for an incoming Signal message. -Suppressed via `cj/signal--should-notify-p' when the user is actively -viewing CHAT-ID. Routes through the external notify script when it is -on PATH (type info, sound gated by `cj/signel-notify-sound'), falling -back to `notifications-notify' otherwise. SENDER names the title; -BODY is formatted by `cj/signal--format-notify-body'. Installed as -`signel-notify-function' in the use-package :config below." - (when (cj/signal--should-notify-p chat-id) - (let ((title (format "Signal: %s" sender)) - (text (cj/signal--format-notify-body body)) - (script (executable-find "notify"))) - (if script - (apply #'start-process "signel-notify" nil script "info" title text - (unless cj/signel-notify-sound (list "--silent"))) - (notifications-notify :title title :body text))))) - -;;; signel — fork integration - -(defcustom cj/signal-private-config-file - (expand-file-name "signal-config.local.el" user-emacs-directory) - "Private signal-config file, loaded when readable. -This is the place to set `signel-account' to the linked phone number so -the number stays out of the version-controlled (and publicly mirrored) -config. A phone number is an identifier rather than a credential, so it -lives here rather than in authinfo, which avoids a GPG prompt at connect -time." - :type 'file - :group 'signel) - -(use-package signel - :load-path "~/code/signel" - :ensure nil - :commands (signel-start signel-stop signel-chat signel-dashboard) - :custom - ;; Don't let an incoming message steal a window by auto-popping its chat - ;; buffer; surface arrivals through notifications instead (see child task - ;; "Notify only for the unviewed conversation"). - (signel-auto-open-buffer nil) - :config - (when (file-readable-p cj/signal-private-config-file) - (load cj/signal-private-config-file nil t)) - ;; Route incoming-message notifications through cj/signel--notify - ;; (suppression + notify script + truncation); warn once at load when - ;; the script is missing — the runtime path still falls back to - ;; notifications-notify, so messages are never silently dropped. - (setq signel-notify-function #'cj/signel--notify) - (cj/executable-find-or-warn "notify" "Signal desktop notifications via the notify script (falling back to notifications-notify)" 'signal-config)) - -;; Chat buffers (named `*Signel: <id>*') open in the bottom 30% of the -;; frame rather than wherever display-buffer's fallback rule picks. -;; The fork's `signel-chat' uses `pop-to-buffer', so this entry applies. -(add-to-list - 'display-buffer-alist - '("\\`\\*Signel: " - (display-buffer-reuse-window display-buffer-at-bottom) - (window-height . 0.3) - (reusable-frames . nil))) - -;;; Connection guard, contact fetch, and cache - -;; Forward declarations: signel.el is loaded by the use-package above (with -;; :load-path on the fork), but the byte-compiler doesn't see those symbols -;; statically. Declaring them keeps the compile clean without changing -;; runtime behavior. -(defvar signel-account) -(defvar signel--process-name) -(declare-function signel-start "signel" ()) -(declare-function signel--send-rpc "signel" (method params &optional target-buffer success-callback)) - -(defvar cj/signel--contact-cache nil - "Cached `(LABEL . RECIPIENT)' alist for the contact picker. -Populated by `cj/signel--fetch-contacts' on first invocation (or after a -`cj/signel-refresh-contacts'), and cleared on `signel-stop' / restart so -a stale list can't survive a reconnect. In-memory only.") - -(defcustom cj/signel-fetch-timeout 3.0 - "Seconds the picker blocks on `accept-process-output' for a cold-cache fetch. -On warm cache the picker opens instantly; on cold cache it kicks off a -fetch and waits up to this many seconds for the RPC result before -reporting a `user-error' so a dead or wedged daemon can't hang Emacs." - :type 'number - :group 'signel) - -(defun cj/signel--ensure-started () - "Ensure the signel daemon is live, starting it if needed. -Three branches: -- The process is already live -- no-op, return nil. -- `signel-account' is set but no live process exists -- call `signel-start' - and pre-warm the contact cache with a background `listContacts' fetch so - the picker is instant on first use. -- `signel-account' is nil -- `user-error' naming the remedy (set the - account in `cj/signal-private-config-file'). - -If startup launches but the RPC handshake exits before the first response, -the subsequent `signel--send-rpc' call (in the pre-warm or any later -fetch) signals through its own error path; check =*signel-log*= and -=*signel-stderr*= for detail and link the account manually. - -Loads the `signel' feature explicitly before reading any of its -private variables: the use-package above autoloads only on -`signel-start' / `signel-stop' / `signel-chat' / `signel-dashboard', -so without this require the first branch's read of `signel--process-name' -fires a void-variable error before the autoload would trigger." - (require 'signel) - (cond - ((process-live-p (get-process signel--process-name)) - nil) - ((null signel-account) - (user-error - "signel-account is unset. Set it in %s (or your private config) and link the device manually with `signal-cli link', then retry" - cj/signal-private-config-file)) - (t - (signel-start) - (cj/signel--fetch-contacts)))) - -(defun cj/signel--fetch-contacts (&optional after-callback) - "Fetch the contact list from signal-cli and populate `cj/signel--contact-cache'. -Issues a `listContacts' RPC and registers a success callback that runs -the result through `cj/signal--parse-contacts' (the verified parser) and -stores the resulting `(LABEL . RECIPIENT)' alist in the cache. An empty -result populates the cache as nil; a failure goes through the dispatch -error path and never invokes the callback, so the prior cache survives. - -AFTER-CALLBACK, when non-nil, is invoked with no arguments after the -cache has been populated -- the picker uses this to unblock its -bounded-wait on cold caches." - (signel--send-rpc - "listContacts" nil nil - (lambda (result) - (setq cj/signel--contact-cache (cj/signal--parse-contacts result)) - (when after-callback (funcall after-callback))))) - -(defun cj/signel-refresh-contacts () - "Clear the picker's contact cache and refetch it from signal-cli. -Use when a contact added or renamed on the phone hasn't shown up in the -picker yet; this forces a fresh `listContacts' rather than reading the -cached snapshot." - (interactive) - (setq cj/signel--contact-cache nil) - (cj/signel--fetch-contacts)) - -;;; Picker, self-message, and connect - -(declare-function signel-chat "signel" (recipient)) -(declare-function signel-dashboard "signel" ()) -(declare-function signel-stop "signel" ()) - -(defun cj/signel-connect () - "Connect to signal-cli, starting the daemon if needed. -Thin interactive wrapper around `cj/signel--ensure-started' so the -keymap has a friendly verb to bind." - (interactive) - (cj/signel--ensure-started) - (message "Signel connected.")) - -(defun cj/signel-message () - "Pick a Signal contact by name and open the chat buffer. -Ensures the daemon is connected first (auto-starts and pre-warms on -cold start, or errors with the remedy if the account isn't set). Uses -the cached contact list when warm; on a cold cache, kicks off a fetch -and waits up to `cj/signel-fetch-timeout' seconds for the result before -raising a `user-error' so a dead daemon can't hang Emacs. The picker -offers a pinned \"Note to Self\" entry plus every Signal contact, and -opens the chosen recipient in `signel-chat'." - (interactive) - (cj/signel--ensure-started) - (unless cj/signel--contact-cache - (let ((done nil) - (deadline (+ (float-time) cj/signel-fetch-timeout))) - (cj/signel--fetch-contacts (lambda () (setq done t))) - (while (and (not done) (< (float-time) deadline)) - (accept-process-output nil 0.1)) - (unless done - (user-error - "Signal contact fetch timed out after %.1fs; try again or run M-x cj/signel-refresh-contacts (see *signel-log* for detail)" - cj/signel-fetch-timeout)))) - (let* ((note-self (cons "Note to Self" signel-account)) - (candidates (cons note-self cj/signel--contact-cache)) - (table (lambda (string pred action) - (if (eq action 'metadata) - `(metadata - (category . signal-contact) - (annotation-function - . ,(lambda (cand) - (let ((r (cdr (assoc cand candidates)))) - (when r - (concat " " (propertize r 'face 'completions-annotations)))))) - (display-sort-function . identity) - (cycle-sort-function . identity)) - (complete-with-action action candidates string pred)))) - (label (completing-read "Signal recipient: " table nil t)) - (recipient (cdr (assoc label candidates)))) - (when recipient - (signel-chat recipient)))) - -(defun cj/signel-message-self () - "Open a Signal chat buffer addressed to Note to Self. -Resolves to `signel-account' (the linked phone number). Sending to it -lands in the Signal Note-to-Self thread on the phone; manual-verify -that on first use." - (interactive) - (cj/signel--ensure-started) - (unless signel-account - (user-error "signel-account is unset; cannot send to self")) - (signel-chat signel-account)) - -(defvar cj/signel-prefix-map - (let ((map (make-sparse-keymap))) - (keymap-set map "m" #'cj/signel-message) - (keymap-set map "s" #'cj/signel-message-self) - (keymap-set map "d" #'signel-dashboard) - (keymap-set map "q" #'signel-stop) - (keymap-set map "SPC" #'cj/signel-connect) - map) - "Signel \"Messages\" prefix keymap, bound under `C-; M'. -Leaves =l= unbound for now -- the future =cj/signel-link= command lands -in a later pass. See =docs/specs/signal-client-spec-doing.org= scope summary.") - -;; Register the messages prefix under C-; M via the documented helper. -;; keybindings.el owns cj/custom-keymap; the (require 'keybindings) above -;; guarantees it is loaded before this runs, so no load-order guard is -;; needed. This is the same pattern every other feature module uses. -(cj/register-prefix-map "M" cj/signel-prefix-map "signal messages") - -(provide 'signal-config) -;;; signal-config.el ends here diff --git a/modules/slack-config.el b/modules/slack-config.el index adf38804..e0ad5b75 100644 --- a/modules/slack-config.el +++ b/modules/slack-config.el @@ -52,6 +52,7 @@ (defvar slack-message-custom-notifier) (defvar slack-teams) +(declare-function notifications-notify "notifications") (declare-function slack-buffer-add-reaction-to-message "slack-buffer") (declare-function slack-buffer-latest-ts "slack-buffer") (declare-function slack-buffer-team "slack-buffer") @@ -196,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))) @@ -207,6 +211,46 @@ Errors if called outside a Slack message buffer." :around #'cj/slack--safe-reaction-echo-description)) ;; ----------------------------- Notifications --------------------------------- +;; Mirrors signel's notification hardening (body truncation, sound gating, +;; script-with-fallback delivery). The shared cj/messenger-notify extraction +;; that collapses the two copies belongs to the messenger-unification task. + +(defcustom cj/slack-notify-sound nil + "When non-nil, Slack notifications play the notify script's sound. +Nil (the default) passes --silent so the toast is visual only." + :type 'boolean + :group 'slack) + +(defconst cj/slack--notify-body-max 120 + "Maximum character length of a desktop-notification body. +Longer message text truncates to this length ending in an ellipsis; +the full text is always in the Slack buffer.") + +(defun cj/slack--format-notify-body (text) + "Collapse whitespace in TEXT and truncate it for a notification body. +Whitespace runs (including newlines) become single spaces, the result +is trimmed, and anything over `cj/slack--notify-body-max' characters +truncates to that length with a trailing ellipsis." + (let ((flat (string-trim (replace-regexp-in-string "[ \t\n\r]+" " " text)))) + (if (<= (length flat) cj/slack--notify-body-max) + flat + (concat (substring flat 0 (1- cj/slack--notify-body-max)) "…")))) + +(defun cj/slack--send-notification (title body) + "Deliver a desktop notification with TITLE and BODY. +Routes through the external notify script when it is on PATH (type +info, sound gated by `cj/slack-notify-sound'), falling back to +`notifications-notify' otherwise. Previously a missing script made +`start-process' error inside the caller's condition-case, so the +notification silently vanished." + (let ((script (executable-find "notify"))) + (if script + (apply #'start-process "slack-notify" nil script "info" title body + (unless cj/slack-notify-sound (list "--silent"))) + ;; notifications.el is not autoloaded; load it on the first fallback. + (unless (fboundp 'notifications-notify) + (require 'notifications)) + (notifications-notify :title title :body body)))) (defun cj/slack-notify (message room team) "Send desktop notification for DMs and @mentions only. @@ -218,18 +262,17 @@ swallows exceptions via `websocket-try-callback'." (when (and (not (slack-message-minep message team)) (or (slack-im-p room) (slack-message-mentioned-p message team))) - (let ((title (format "Slack: %s" (slack-room-display-name room team))) - (body (or (slack-message-body message team) ""))) - (start-process "slack-notify" nil - "notify" "info" title body))) + (cj/slack--send-notification + (format "Slack: %s" (slack-room-display-name room team)) + (cj/slack--format-notify-body + (or (slack-message-body message team) "")))) (error (message "cj/slack-notify error: %S" err)))) (defun cj/slack-test-notify () "Send a test desktop notification to verify the notify pipeline works." (interactive) (condition-case err - (start-process "slack-notify-test" nil - "notify" "info" "Slack: Test" "Notification pipeline works") + (cj/slack--send-notification "Slack: Test" "Notification pipeline works") (error (message "cj/slack-test-notify error: %S" err)))) (defun cj/slack-mark-read-and-bury () diff --git a/modules/system-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/system-utils.el b/modules/system-utils.el index e779026a..58325d06 100644 --- a/modules/system-utils.el +++ b/modules/system-utils.el @@ -92,7 +92,7 @@ detached from Emacs." output-buffer (format "%s %s" command (shell-quote-argument file))) (message "Running %s on %s..." - (file-name-nondirectory file) command))))) + command (file-name-nondirectory file)))))) ;;; ------------------------------ Server Shutdown ------------------------------ diff --git a/modules/takuzu-config.el b/modules/takuzu-config.el new file mode 100644 index 00000000..470aaec8 --- /dev/null +++ b/modules/takuzu-config.el @@ -0,0 +1,17 @@ +;;; takuzu-config.el --- Takuzu (Binairo) game configuration -*- lexical-binding: t -*- + +;;; Commentary: +;; Wire the standalone takuzu game package (developed at ~/code/takuzu). +;; Play with M-x takuzu. Switch to :vc once it is published on GitHub. + +;;; Code: + +(use-package takuzu + :load-path "~/code/takuzu" + :commands (takuzu) + :custom + (takuzu-default-size 6) + (takuzu-default-difficulty 'easy)) + +(provide 'takuzu-config) +;;; takuzu-config.el ends here diff --git a/modules/telega-config.el b/modules/telega-config.el index 0ae5116b..acc9e482 100644 --- a/modules/telega-config.el +++ b/modules/telega-config.el @@ -54,7 +54,14 @@ :ensure nil :commands (telega) :custom - (telega-use-docker t)) + (telega-use-docker t) + :config + ;; Without this, incoming Telegram messages are invisible unless their + ;; buffer is on screen -- telega ships desktop notifications but leaves + ;; the mode off by default. Runs at telega load (M-x telega), respects + ;; telega's own per-chat mute settings. From the 2026-06 config audit; + ;; routing through a shared messenger notifier is the unification task. + (telega-notifications-mode 1)) (defun cj/telega () "Launch telega.el with a helpful message when it isn't installed yet. diff --git a/modules/test-runner.el b/modules/test-runner.el index e05145e4..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=)) @@ -239,7 +244,10 @@ Returns: \\='success if added successfully, Second value is the relative filename if successful." (cond ((null filepath) (cons 'no-file nil)) - ((not (string-prefix-p (file-truename testdir) (file-truename filepath))) + ;; Route through the helper: it appends the trailing slash, so a sibling + ;; sharing the directory's name prefix (tests-old/ against tests/) is + ;; rejected. A bare `string-prefix-p' on the truenames accepts it. + ((not (cj/test--file-in-directory-p filepath testdir)) (cons 'not-in-testdir nil)) (t (let ((relative (file-relative-name filepath testdir))) diff --git a/modules/text-config.el b/modules/text-config.el index dd7bd3ca..a65002a8 100644 --- a/modules/text-config.el +++ b/modules/text-config.el @@ -69,7 +69,7 @@ ;; edit selection in new buffer, C-c to finish; replaces with modifications (use-package edit-indirect - :bind ("M-S-i" . edit-indirect-region)) ;; was M-I + :bind ("M-I" . edit-indirect-region)) ;; ------------------------------ Prettify Symbols ----------------------------- ;; replacing the word l-a-m-b-d-a with a symbol, just because @@ -118,8 +118,8 @@ everything else, such as `lambda', use the standard boundary check." ;; an easy way to enter diacritical marks (use-package accent - :commands accent-company - :bind ("C-`" . accent-company)) + :commands accent-menu + :bind ("C-`" . accent-menu)) (provide 'text-config) ;;; text-config.el ends here diff --git a/modules/tramp-config.el b/modules/tramp-config.el index f2bc8457..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/ui-config.el b/modules/ui-config.el index fbc3d91c..9ac6faec 100644 --- a/modules/ui-config.el +++ b/modules/ui-config.el @@ -29,9 +29,6 @@ ;; (i.e., read-only, overwrite, normal) ;; – Option to customize cursor shape with 'cj/set-cursor-type' -;; • Icons -;; – Load and enable 'nerd-icons' for UI glyphs - ;; Customize the transparency and cursor color options at the top of this file. ;;; Code: @@ -116,11 +113,5 @@ When `cj/enable-transparency' is nil, reset alpha to fully opaque." ;; burst when entering read-only buffers like EPUBs or vterm). (blink-cursor-mode -1) -;; --------------------------------- Nerd Icons -------------------------------- -;; use icons from nerd fonts in the Emacs UI - -(use-package nerd-icons - :defer t) - (provide 'ui-config) ;;; ui-config.el ends here diff --git a/modules/ui-theme.el b/modules/ui-theme.el index 499e71a4..b3cdc634 100644 --- a/modules/ui-theme.el +++ b/modules/ui-theme.el @@ -88,8 +88,14 @@ If FILENAME isn't readable, return nil." (string-trim (buffer-string))))) (defun cj/theme-write-file-contents (content filename) - "Write CONTENT to FILENAME. -If FILENAME isn't writeable, return nil. If successful, return t." + "Write CONTENT to FILENAME, creating its parent directory if absent. +On a fresh machine the `persist/' directory doesn't exist yet, and +`file-writable-p' returns nil for a file inside a missing directory, so the +write would silently fail. If FILENAME still isn't writeable, return nil. +If successful, return t." + (let ((dir (file-name-directory filename))) + (when (and dir (not (file-directory-p dir))) + (ignore-errors (make-directory dir t)))) (when (file-writable-p filename) (condition-case err (progn diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el index cbd2c0d7..e5b8dc00 100644 --- a/modules/undead-buffers.el +++ b/modules/undead-buffers.el @@ -65,7 +65,10 @@ regexp in `cj/undead-buffer-regexps'." cj/undead-buffer-regexps)))) (defun cj/kill-buffer-or-bury-alive (buffer) - "Kill BUFFER or bury it if it's in `cj/undead-buffer-list'." + "Kill BUFFER, or bury it when it is in `cj/undead-buffer-list'. +With a prefix argument (e.g. \\`C-u'), instead add BUFFER's name to +`cj/undead-buffer-list' and report it, so the buffer is buried rather than +killed on later kill attempts." (interactive "bBuffer to kill or bury: ") (with-current-buffer buffer (if current-prefix-arg @@ -93,17 +96,24 @@ 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 () - "Delete the next window and kill or bury its buffer." + "Delete the next window and kill or bury its buffer. +Signal a `user-error' in a single-window frame, where there is no other +window and acting would kill the buffer being viewed." (interactive) + (when (one-window-p) + (user-error "No other window")) (other-window 1) (let ((buf (current-buffer))) - (unless (one-window-p) - (delete-window)) - (cj/kill-buffer-or-bury-alive buf))) + (delete-window) + (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 () @@ -117,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 () @@ -125,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 ea0d687c..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. @@ -70,7 +74,20 @@ is killed externally." (message "Audio recording stopped: %s" (string-trim event))) ((eq process cj/video-recording-ffmpeg-process) (setq cj/video-recording-ffmpeg-process nil) - (message "Video recording stopped: %s" (string-trim event)))) + (let ((start (process-get process 'cj-start-time))) + (if (and start + (not (process-get process 'cj-stopping)) + (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. 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))) (defun cj/recording--wait-for-exit (process timeout-secs) @@ -87,13 +104,54 @@ so a fixed 0.5s wait was causing zero-byte output files." (accept-process-output process 0.1)) (not (process-live-p process)))) +(defvar cj/recording-wf-recorder-wait-timeout 2.0 + "Seconds to wait for a dying wf-recorder to release the compositor capture. +Bounds the start-path poll in `cj/ffmpeg-record-video' so it never hangs.") + +(defvar cj/recording-start-fail-threshold 1.5 + "Seconds below which a video recording that exits is treated as a failed start. +A wf-recorder that can't grab the screen dies almost immediately (~0.5s); a real +recording runs far longer, so an exit sooner than this is a start failure, not a +normal stop.") + +(defun cj/recording--wf-recorder-running-p () + "Return non-nil if any wf-recorder process is currently running." + (eq 0 (call-process "pgrep" nil nil nil "-x" "wf-recorder"))) + +(defun cj/recording--wait-for-no-wf-recorder (timeout-secs &optional running-p) + "Poll until no wf-recorder remains, or TIMEOUT-SECS elapse. +Returns t if wf-recorder cleared within the timeout, nil on timeout. RUNNING-P +is the predicate checked each poll (default `cj/recording--wf-recorder-running-p'); +tests inject a fake. This replaces a fixed `sit-for' after the start-path +`pkill -INT wf-recorder': the kill signals the old recorder to finalize and +exit, but releasing the compositor capture takes longer than a fixed wait, so +launching too soon loses the grab and produces a ~0.5s fragment file." + (let ((check (or running-p #'cj/recording--wf-recorder-running-p)) + (deadline (+ (float-time) timeout-secs))) + (while (and (funcall check) (< (float-time) deadline)) + (sleep-for 0.05)) + (not (funcall check)))) + +(defun cj/recording--start-failed-p (elapsed threshold) + "Return non-nil when ELAPSED seconds since start is below THRESHOLD. +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 () @@ -104,8 +162,7 @@ so a fixed 0.5s wait was causing zero-byte output files." "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 @@ -199,7 +256,10 @@ On X11: ffmpeg captures screen directly via x11grab with PulseAudio audio." (if on-wayland (progn (cj/recording--check-wf-recorder) - (format (concat "wf-recorder -y -c libx264 -m matroska -f /dev/stdout 2>/dev/null | " + ;; wf-recorder stderr is NOT discarded: it flows to the process buffer + ;; (*ffmpeg-video-recording*) so a failed capture grab is diagnosable + ;; instead of silent. + (format (concat "wf-recorder -y -c libx264 -m matroska -f /dev/stdout | " "ffmpeg -i pipe:0 " "-f pulse -i %s " "-f pulse -i %s " @@ -264,9 +324,13 @@ Uses wf-recorder on Wayland, x11grab on X11." ;; kill on purpose: the orphans' launching shells are already dead, so ;; there is no live PID to scope to. The stop path, by contrast, scopes ;; to our own shell's child (see cj/recording--interrupt-child-wf-recorder). + ;; Wait for the signalled wf-recorder to actually exit and release the + ;; compositor capture before launching a new one. A fixed `sit-for' here + ;; raced the dying recorder and left ~0.5s fragment files (same class the + ;; stop path already fixed with `cj/recording--wait-for-exit'). (when (cj/recording--wayland-p) (call-process "pkill" nil nil nil "-INT" "wf-recorder") - (sit-for 0.1)) + (cj/recording--wait-for-no-wf-recorder cj/recording-wf-recorder-wait-timeout)) (let* ((devices (cj/recording-get-devices)) (mic-device (car devices)) (system-device (cdr devices)) @@ -282,6 +346,11 @@ Uses wf-recorder on Wayland, x11grab on X11." record-command)) (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, 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 @@ -339,6 +408,9 @@ for ffmpeg to write container metadata before giving up." (if (not cj/video-recording-ffmpeg-process) (message "No video recording in progress.") (let ((proc cj/video-recording-ffmpeg-process)) + ;; Mark this as a user stop so the sentinel's fail-fast check doesn't + ;; misread a quick intentional stop as a failed start. + (process-put proc 'cj-stopping t) ;; On Wayland, kill the producer (wf-recorder) FIRST so ffmpeg sees ;; a clean EOF on pipe:0. This triggers ffmpeg's orderly shutdown: ;; drain remaining frames, write container metadata, close file. 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 () |