diff options
Diffstat (limited to 'modules')
58 files changed, 2734 insertions, 757 deletions
diff --git a/modules/ai-term-backend-eat.el b/modules/ai-term-backend-eat.el index be84ef25..906abd00 100644 --- a/modules/ai-term-backend-eat.el +++ b/modules/ai-term-backend-eat.el @@ -100,8 +100,11 @@ typed into a bare shell. Returns the poll timer." (cancel-timer timer)))))) timer)) -(defun cj/--ai-term-show-or-create (dir name &optional agent-command) +(defun cj/--ai-term-show-or-create (dir name &optional agent-command sessions) "Show or create the AI-term buffer for project DIR with buffer NAME. +SESSIONS, when non-nil, is a pre-fetched +`cj/--ai-term-live-tmux-sessions' list threaded from the caller so the +launch path pays for the tmux subprocess once. If a buffer named NAME exists with a live process, display it. If the buffer exists but its process is dead, kill it and recreate. If @@ -135,7 +138,8 @@ buffer." ;; session gets the project /color injected below; a reattach carries ;; whatever color the running Claude already has. (let ((fresh (not (cj/--ai-term-session-active-p - dir (cj/--ai-term-live-tmux-sessions))))) + dir (or sessions + (cj/--ai-term-live-tmux-sessions)))))) ;; `eat' switches to its buffer in the selected window before our ;; display-buffer-alist rule can route it; `save-window-excursion' ;; reverts that, and the explicit display-buffer below routes the buffer @@ -159,12 +163,14 @@ buffer." buf)))))) ;; In EAT's semi-char mode, keys not bound in `eat-semi-char-mode-map' are -;; forwarded to the pty. M-SPC (swap to the next agent) must reach Emacs from -;; inside an agent buffer, so bind it in that map -- no exception-list or rebuild +;; forwarded to the pty. The swap-to-next chords must reach Emacs from inside +;; an agent buffer, so bind them in that map -- no exception-list or rebuild ;; dance like ghostel needed. C-; is already bound there (eat-config), so the ;; C-; a family resolves through the global prefix without extra wiring. +;; M-SPC cycles attached agents only; M-S-SPC cycles all (attaching a detached). (with-eval-after-load 'eat - (keymap-set eat-semi-char-mode-map "M-SPC" #'cj/ai-term-next)) + (keymap-set eat-semi-char-mode-map "M-SPC" #'cj/ai-term-next-attached) + (keymap-set eat-semi-char-mode-map "M-S-SPC" #'cj/ai-term-next)) (provide 'ai-term-backend-eat) ;;; ai-term-backend-eat.el ends here diff --git a/modules/ai-term-display.el b/modules/ai-term-display.el index b78a2638..fdb2b7ed 100644 --- a/modules/ai-term-display.el +++ b/modules/ai-term-display.el @@ -248,10 +248,13 @@ or a layout split on the other axis), so the chain falls through to nil when the edge window is dedicated -- those are not ours to replace. Records the displaced buffer through `display-buffer-record-window' -\(type `reuse') before swapping, so the native `quit-restore-window' -called at toggle-off puts that buffer back into the slot instead of -deleting the window -- toggling swaps the slot's buffer between the -displaced buffer and the agent, never changing the window count. +\(type `reuse') before swapping. Toggle-off does NOT put that buffer +back: `cj/--ai-term-toggle-off' deletes the agent's window outright in +multi-window layouts, because the slot's `quit-restore' parameter goes +stale when several agents share it (see its docstring). The displaced +buffer stays alive and reachable through normal buffer switching; the +record call just keeps the window's `quit-restore' parameter accurate +for native `quit-window' paths outside the toggle. Runs after `cj/--ai-term-reuse-existing-agent', so an agent already on screen has been handled already; the window reused here always holds a diff --git a/modules/ai-term-sessions.el b/modules/ai-term-sessions.el index fab6b0a6..57d735d1 100644 --- a/modules/ai-term-sessions.el +++ b/modules/ai-term-sessions.el @@ -65,6 +65,20 @@ the start so names like \"foo agent [bar]\" do not match." (buffer-live-p buffer) (string-prefix-p cj/--ai-term-name-prefix (buffer-name buffer)))) +(defun cj/--ai-term-buffer-basename (buffer) + "Return the project basename embedded in BUFFER's AI-term name, or nil. + +The buffer name is \"agent [<basename>]\" (see +`cj/--ai-term-buffer-name') and never changes for the buffer's life, +unlike `default-directory', which ghostel retargets via OSC 7 every time +the shell cds. Teardown paths must key tmux-session lookups off this, +not the directory, or a close after a cd kills the wrong aiv- session. +Returns nil when BUFFER is not a live AI-term buffer." + (when (cj/--ai-term-buffer-p buffer) + (let ((name (buffer-name buffer))) + (when (string-suffix-p "]" name) + (substring name (length cj/--ai-term-name-prefix) -1))))) + (defun cj/--ai-term-agent-buffers () "Return the live AI-term buffers in `buffer-list' order. @@ -107,6 +121,23 @@ which the step materializes by attaching." (lambda (a b) (string< (cj/--ai-term-buffer-name a) (cj/--ai-term-buffer-name b)))))) +(defun cj/--ai-term-attached-agent-dirs () + "Return project dirs that have a live agent BUFFER (attached only). + +Like `cj/--ai-term-active-agent-dirs' but excludes detached tmux +sessions with no Emacs buffer -- this is the queue `cj/ai-term-next-attached' +\(M-SPC) steps through, so the fast chord stays among agents already on +screen. Detached sessions are reachable only via `cj/ai-term-next' +\(M-S-SPC). Sorted by agent buffer name for a stable rotation." + (let ((live-names (mapcar #'buffer-name (cj/--ai-term-agent-buffers)))) + (sort + (seq-filter + (lambda (dir) + (member (cj/--ai-term-buffer-name dir) live-names)) + (cj/--ai-term-candidates)) + (lambda (a b) + (string< (cj/--ai-term-buffer-name a) (cj/--ai-term-buffer-name b)))))) + (defun cj/--ai-term-tmux-session-name (dir) "Return the tmux session name for project directory DIR. @@ -320,8 +351,11 @@ the metadata keeps the order ALIST was built in." (cycle-sort-function . identity)) (complete-with-action action alist string predicate)))) -(defun cj/--ai-term-pick-project () +(defun cj/--ai-term-pick-project (&optional sessions) "Prompt for an AI-agent project; return its absolute path. +SESSIONS, when non-nil, is a pre-fetched result of +`cj/--ai-term-live-tmux-sessions', so a caller that already paid for the +tmux subprocess can thread it through instead of spawning another. Candidates come from `cj/--ai-term-candidates', ordered by `cj/--ai-term-sort-candidates' so projects with a live tmux session @@ -337,7 +371,7 @@ Signals `user-error' when no candidates exist." (append cj/ai-term-project-roots cj/ai-term-container-roots) ", "))) - (let* ((sessions (cj/--ai-term-live-tmux-sessions)) + (let* ((sessions (or sessions (cj/--ai-term-live-tmux-sessions))) (sorted (cj/--ai-term-sort-candidates candidates sessions)) (display-alist (mapcar (lambda (p) diff --git a/modules/ai-term.el b/modules/ai-term.el index 9d7be47e..52494c18 100644 --- a/modules/ai-term.el +++ b/modules/ai-term.el @@ -351,16 +351,18 @@ it runs. EAT renders in terminal frames as well as GUI frames, so this launches from either." (interactive "P") - (let* ((dir (cj/--ai-term-pick-project)) + ;; One tmux fetch per launch: the same list feeds the picker's sorting, + ;; the fresh check here, and show-or-create's own fresh check. + (let* ((sessions (cj/--ai-term-live-tmux-sessions)) + (dir (cj/--ai-term-pick-project sessions)) (name (cj/--ai-term-buffer-name dir)) (existing (get-buffer name)) (fresh (and (not (and existing (cj/--ai-term-process-live-p existing))) - (not (cj/--ai-term-session-active-p - dir (cj/--ai-term-live-tmux-sessions))))) + (not (cj/--ai-term-session-active-p dir sessions)))) (command (when fresh (cj/--ai-term-runtime-command (cj/--ai-term-pick-runtime)))) - (buf (cj/--ai-term-show-or-create dir name command))) + (buf (cj/--ai-term-show-or-create dir name command sessions))) (unless arg (let ((win (get-buffer-window buf))) (when win (select-window win)))) @@ -400,18 +402,22 @@ C-; a k closes an agent via `cj/ai-term-close'." (defun cj/--ai-term-close-buffer (buffer) "Gracefully tear down AI-term BUFFER: tmux session, then buffer. -Derives the tmux session name from BUFFER's `default-directory' (the -project dir the terminal was created in) and kills it so the agent -process stops. When BUFFER is shown, swaps its window to a non-agent -buffer (the working file) rather than deleting the window -- closing an -agent must not collapse the user's window layout; the hide toggle is -what collapses the split. Then kills BUFFER (suppressing the +Derives the tmux session name from BUFFER's immutable name (\"agent +[<basename>]\") and kills it so the agent process stops. The name, not +`default-directory', is the reliable key: ghostel retargets the +directory via OSC 7 as the shell cds, so a directory-derived name after +a cd misses the real session (orphaning the agent) or collides with a +different aiv- session. When BUFFER is shown, swaps its window to a +non-agent buffer (the working file) rather than deleting the window -- +closing an agent must not collapse the user's window layout; the hide +toggle is what collapses the split. Then kills BUFFER (suppressing the process-still-running prompt -- the session is already down). No-op when BUFFER isn't an AI-term buffer." (when (cj/--ai-term-buffer-p buffer) (cj/--ai-term-kill-tmux-session (cj/--ai-term-tmux-session-name - (buffer-local-value 'default-directory buffer))) + (or (cj/--ai-term-buffer-basename buffer) + (buffer-local-value 'default-directory buffer)))) (let ((win (get-buffer-window buffer))) (when (window-live-p win) (cj/--ai-term-swap-to-working-buffer win))) @@ -454,26 +460,18 @@ interrupt work in progress. Bound to C-; a k." ;; ------------------------- Step to the next agent ---------------------------- -(defun cj/ai-term-next () - "Step to the next open AI-term agent in the queue. - -The queue is every active agent ordered by buffer name -- a stable -rotation, unaffected by which agent was most recently selected. Active -means a live agent buffer (attached) OR a live tmux session with no Emacs -buffer (detached); stepping onto a detached agent attaches it (recreates -its terminal, which reattaches the session). When an agent window is on -screen, swap it to the next agent (wrapping after the last) and select it. -When no agent is displayed but agents exist, show the first. When none -are open, open the project picker to launch the first agent rather than -erroring. When the sole agent is already focused, echo that there are -no other ai-terms to switch to instead of swapping to itself. - -Bound to M-SPC. Unlike C-; a a (toggle the most-recent agent on/off), this -is the \"switch among existing agents\" surface; C-; a s opens the project -picker and C-; a k closes an agent." - (interactive) - (let* ((dirs (cj/--ai-term-active-agent-dirs)) - (win (cj/--ai-term-displayed-agent-window)) +(defun cj/--ai-term-step-among (dirs) + "Step to the next AI-term agent among DIRS, an ordered active-dir list. + +Shared body for `cj/ai-term-next' (all active agents) and +`cj/ai-term-next-attached' (attached agents only). When an agent window +is on screen, swap it to the next agent in DIRS (wrapping after the last) +and select it: a live attached agent swaps buffer-only, a detached one is +materialized by `cj/--ai-term-show-or-create'. When DIRS is empty, open +the project picker rather than erroring, so the swap key doubles as a +start-an-agent key. When the sole eligible agent is already focused, echo +that there is nowhere else to go instead of swapping to itself." + (let* ((win (cj/--ai-term-displayed-agent-window)) (current-name (and win (buffer-name (window-buffer win)))) (current-dir (and current-name (seq-find (lambda (d) @@ -482,8 +480,8 @@ picker and C-; a k closes an agent." (next-dir (cj/--ai-term-next-agent-dir current-dir dirs))) (cond ((not next-dir) - ;; No agents open: launch the first via the project picker instead of - ;; erroring, so the swap key doubles as a "start an agent" key. + ;; No eligible agents: launch the first via the project picker instead + ;; of erroring, so the swap key doubles as a "start an agent" key. (cj/ai-term-pick-project)) ;; Sole agent, already focused: the rotation wraps back to the same ;; agent, so a swap would be a silent no-op. Say there's nowhere to @@ -508,16 +506,49 @@ picker and C-; a k closes an agent." (let ((w (get-buffer-window name))) (when w (select-window w))))))))) +(defun cj/ai-term-next () + "Step to the next open AI-term agent -- attached or detached. + +The queue is every active agent ordered by buffer name -- a stable +rotation, unaffected by which agent was most recently selected. Active +means a live agent buffer (attached) OR a live tmux session with no Emacs +buffer (detached); stepping onto a detached agent attaches it (recreates +its terminal, which reattaches the session). + +Bound to M-S-SPC (and C-; a n). For a chord that stays among the agents +already on screen, use `cj/ai-term-next-attached' (M-SPC). Unlike C-; a a +\(toggle the most-recent agent on/off), this is the \"switch among existing +agents\" surface; C-; a s opens the project picker and C-; a k closes an +agent." + (interactive) + (cj/--ai-term-step-among (cj/--ai-term-active-agent-dirs))) + +(defun cj/ai-term-next-attached () + "Step to the next ATTACHED AI-term agent -- live Emacs buffers only. + +Cycles only agents currently on screen (a live agent buffer), skipping +detached tmux sessions. Use `cj/ai-term-next' (M-S-SPC) to include +detached sessions and attach them. When no agent is attached, opens the +project picker. + +Bound to M-SPC -- the fast \"swap to the next visible agent\" chord." + (interactive) + (cj/--ai-term-step-among (cj/--ai-term-attached-agent-dirs))) + ;; ai-term lives under the C-; a prefix (vacated when gptel was archived). -;; The frequent "swap to the next agent" also gets M-SPC for a fast chord. +;; The frequent "swap to the next agent" gets M-SPC (attached only) for a fast +;; chord, with M-S-SPC to include detached sessions. (defvar-keymap cj/ai-term-keymap :doc "Keymap for ai-term agent commands (C-; a)." "a" #'cj/ai-term ;; toggle the most-recent agent on/off "s" #'cj/ai-term-pick-project ;; select / launch via the project picker - "n" #'cj/ai-term-next ;; swap to the next open agent + "n" #'cj/ai-term-next ;; swap to the next open agent (all) "k" #'cj/ai-term-close) ;; kill the current agent (cj/register-prefix-map "a" cj/ai-term-keymap "ai-term") -(keymap-global-set "M-SPC" #'cj/ai-term-next) +;; M-SPC cycles only attached agents (on-screen); M-S-SPC cycles all, attaching +;; a detached tmux session when it lands on one. +(keymap-global-set "M-SPC" #'cj/ai-term-next-attached) +(keymap-global-set "M-S-SPC" #'cj/ai-term-next) (with-eval-after-load 'which-key (which-key-add-key-based-replacements @@ -526,7 +557,8 @@ picker and C-; a k closes an agent." "C-; a s" "select / launch" "C-; a n" "next agent" "C-; a k" "kill agent" - "M-SPC" "ai-term: next agent")) + "M-SPC" "ai-term: next attached" + "M-S-SPC" "ai-term: next (all)")) ;; ------------------- Wrap-it-up teardown + shutdown ------------------------- ;; @@ -547,11 +579,16 @@ A defcustom so development and tests can stub it instead of powering off (defun cj/ai-term-quit (&optional project) "Tear down PROJECT's AI-term: kill its tmux session, buffer, and restore layout. PROJECT is a project basename (as the rulesets Stop hook passes) or a directory; -nil means the current project (`default-directory'). Kills the `aiv-<name>' -tmux session (taking the agent process with it), then, when the agent buffer is -live, swaps its window back to the working buffer and kills it. Idempotent and -safe headless: a session or buffer already gone is a no-op, not an error." - (let* ((key (or project default-directory)) +nil means the current project -- the current agent buffer's embedded basename +when called from inside one (immune to the OSC 7 `default-directory' drift a +cd in the agent shell causes), else `default-directory'. Kills the +`aiv-<name>' tmux session (taking the agent process with it), then, when the +agent buffer is live, swaps its window back to the working buffer and kills +it. Idempotent and safe headless: a session or buffer already gone is a +no-op, not an error." + (let* ((key (or project + (cj/--ai-term-buffer-basename (current-buffer)) + default-directory)) (session (cj/--ai-term-tmux-session-name key)) (buffer (get-buffer (cj/--ai-term-buffer-name key)))) (cj/--ai-term-kill-tmux-session session) diff --git a/modules/auth-config.el b/modules/auth-config.el index c2df244b..c862e916 100644 --- a/modules/auth-config.el +++ b/modules/auth-config.el @@ -26,6 +26,7 @@ ;; below. oauth2-auto is required at runtime inside the advised function; these ;; declarations satisfy the byte-compiler without forcing an eager load. (declare-function oauth2-auto--compute-id "oauth2-auto") +(declare-function plstore-open "plstore") (declare-function plstore-get "plstore") (declare-function plstore-close "plstore") (defvar oauth2-auto--plstore-cache) diff --git a/modules/auto-dim-config.el b/modules/auto-dim-config.el index faa4101c..980d301f 100644 --- a/modules/auto-dim-config.el +++ b/modules/auto-dim-config.el @@ -58,7 +58,11 @@ focus cue on a split-displayed dashboard, accepted as a fair trade." ;; Emacs loses focus -- on Hyprland focus moves to other apps constantly, ;; and the ai-term agents live in their own windows. (auto-dim-other-buffers-dim-on-focus-out nil) - (auto-dim-other-buffers-dim-on-switch-to-minibuffer t) + ;; Entering the minibuffer leaves dimming exactly as it was -- a dim window + ;; stays dim, a lit one stays lit. With this at t, the window being worked + ;; in went dark on every minibuffer prompt, since selecting the minibuffer + ;; deselects it and the dim follows selection. + (auto-dim-other-buffers-dim-on-switch-to-minibuffer nil) :config ;; Remap these faces to auto-dim-other-buffers (pure-black background + ;; faded gray foreground, defined in the theme) in non-selected windows. diff --git a/modules/browser-config.el b/modules/browser-config.el index 564e7a27..4571c1d9 100644 --- a/modules/browser-config.el +++ b/modules/browser-config.el @@ -143,7 +143,23 @@ Persists the choice for future sessions." ('save-failed (message "Failed to save browser choice")) ('invalid-plist (message "Invalid browser configuration")))))))) -;; Initialize: Load saved choice or use first available browser +(defun cj/--preferred-default-browser (browsers) + "Return the browser plist to adopt as the first-run default from BROWSERS. + +Prefers the first entry with a non-nil :executable -- a real external +browser -- and falls back to the first entry overall when none is +installed. Built-in browsers carry a nil :executable and so are always +\"available\", which put EWW at the head of `cj/discover-browsers' on +every machine. Taking the head therefore opened every link in the text +browser on a fresh checkout even with Chrome installed, until the user +happened to run `cj/choose-browser'. EWW stays reachable as the +deliberate fallback when nothing external is on PATH. + +Returns nil for an empty BROWSERS list." + (or (seq-find (lambda (b) (plist-get b :executable)) browsers) + (car browsers))) + +;; Initialize: Load saved choice or use the preferred available browser (defun cj/--do-initialize-browser () "Initialize browser configuration. Returns: (cons \\='loaded browser-plist) if saved choice was loaded, @@ -153,10 +169,10 @@ Returns: (cons \\='loaded browser-plist) if saved choice was loaded, (let ((saved-choice (cj/load-browser-choice))) (if saved-choice (cons 'loaded saved-choice) - ;; No saved choice - try to set first available browser + ;; No saved choice - adopt the preferred available browser (let ((browsers (cj/discover-browsers))) (if browsers - (cons 'first-available (car browsers)) + (cons 'first-available (cj/--preferred-default-browser browsers)) (cons 'no-browsers nil)))))) (defun cj/initialize-browser () diff --git a/modules/calendar-sync-ics.el b/modules/calendar-sync-ics.el index 9cb57e96..7fecce10 100644 --- a/modules/calendar-sync-ics.el +++ b/modules/calendar-sync-ics.el @@ -188,6 +188,22 @@ Monday = 1, Sunday = 7." (dow (nth 6 decoded))) ; 0 = Sunday, 1 = Monday, etc. (if (= dow 0) 7 dow))) +(defun calendar-sync--nth-weekday-of-month (year month weekday n) + "Return the day-of-month of the Nth WEEKDAY in YEAR/MONTH, or nil. +WEEKDAY is 1-7 (Monday = 1), matching `calendar-sync--date-weekday'. +Positive N counts from the start of the month (1 = first); negative N +counts from the end (-1 = last). Returns nil when the month has no such +occurrence (a 5th Friday most months), or when N is zero." + (when (and (integerp n) (not (zerop n))) + (let* ((first-dow (calendar-sync--date-weekday (list year month 1))) + (first-day (1+ (mod (- weekday first-dow) 7))) + (next-month (calendar-sync--add-months (list year month 1) 1)) + (last-day (nth 2 (calendar-sync--add-days next-month -1))) + (total (1+ (/ (- last-day first-day) 7))) + (index (if (> n 0) n (+ total n 1)))) + (when (and (>= index 1) (<= index total)) + (+ first-day (* 7 (1- index))))))) + (defun calendar-sync--add-days (date days) "Add DAYS to DATE (year month day). Returns new (year month day). @@ -218,6 +234,18 @@ Both dates should be lists like (year month day)." (time-less-p (calendar-sync--date-to-time date1) (calendar-sync--date-to-time date2))) +(defun calendar-sync--date-on-or-before-p (date1 date2) + "Return t if DATE1 falls on or before DATE2. +Both dates should be lists like (year month day); like +`calendar-sync--date-to-time', only the first three elements are compared, +so any hour/minute tail is ignored. + +This is the comparison RRULE UNTIL needs. RFC 5545 3.3.10 bounds a +recurrence \"in an inclusive manner\": when UNTIL lines up with the +recurrence, that date is the last instance. A strict +`calendar-sync--before-date-p' drops it." + (not (calendar-sync--before-date-p date2 date1))) + ;;; Datetime Parsing (defun calendar-sync--parse-ics-datetime (value) @@ -492,39 +520,90 @@ Returns nil if parsing fails." (string-to-number (match-string 3 timestamp-str)))) (t nil))) +(defun calendar-sync--format-stamp (date &optional time-str) + "Return one org timestamp for DATE, with TIME-STR appended when non-nil. +DATE is a (year month day) list; TIME-STR is a preformatted leading-space +string such as \" 14:00\" or \" 14:00-15:30\". Produces +`<2025-11-16 Sun 14:00>' or `<2025-11-16 Sun>'. Both the compact same-day +form and each half of a multi-day range are built from this." + (concat (format-time-string + "<%Y-%m-%d %a" + (encode-time 0 0 0 (nth 2 date) (nth 1 date) (nth 0 date))) + time-str + ">")) + +(defun calendar-sync--format-hhmm (hour minute) + "Return \" HH:MM\" for HOUR and MINUTE, or nil unless both are non-nil." + (when (and hour minute) (format " %02d:%02d" hour minute))) + (defun calendar-sync--format-timestamp (start end) - "Format START and END timestamps as org timestamp. + "Format START and END timestamps as an org timestamp. START and END are lists from `calendar-sync--parse-timestamp'. -Returns string like '<2025-11-16 Sun 14:00-15:00>' or '<2025-11-16 Sun>'." - (let* ((year (nth 0 start)) - (month (nth 1 start)) - (day (nth 2 start)) + +Same-day events keep the compact form: `<2025-11-16 Sun 14:00-15:00>' when +timed, `<2025-11-16 Sun>' when all-day. An event whose last day is later +than its start renders as an org range, `<start>--<end>', so the agenda shows +it on every day it covers rather than only the first. + +DTEND is the non-inclusive end of the event (RFC 5545 3.6.1). For an all-day +event that makes DTEND the day AFTER the last day, so the last day is +DTEND-1 and a one-day all-day event (DTEND = start+1) stays a single stamp. +For a timed event DTEND is the end instant, so its date is already the last +day. The decrement is therefore gated on both ends being date-only; a +date-only start with a timed end is malformed, and treating it as all-day +would push the last day BEFORE the start and emit a backwards range." + (let* ((start-date (list (nth 0 start) (nth 1 start) (nth 2 start))) (start-hour (nth 3 start)) (start-min (nth 4 start)) (end-hour (and end (nth 3 end))) (end-min (and end (nth 4 end))) - (date-str (format-time-string - "<%Y-%m-%d %a" - (encode-time 0 0 0 day month year))) - (time-str (when (and start-hour end-hour) - (format " %02d:%02d-%02d:%02d" - start-hour start-min end-hour end-min)))) - (concat date-str time-str ">"))) + (all-day-span (and end (null start-hour) (null end-hour))) + (last-date (when end + (let ((end-date (list (nth 0 end) (nth 1 end) (nth 2 end)))) + (if all-day-span + (calendar-sync--add-days end-date -1) + end-date)))) + (spans-days (and last-date + (calendar-sync--before-date-p start-date last-date)))) + (if spans-days + (concat (calendar-sync--format-stamp + start-date (calendar-sync--format-hhmm start-hour start-min)) + "--" + (calendar-sync--format-stamp + last-date (calendar-sync--format-hhmm end-hour end-min))) + ;; Same-day: the compact HH:MM-HH:MM range lives inside one stamp. + (calendar-sync--format-stamp + start-date + (when (and start-hour end-hour) + (format " %02d:%02d-%02d:%02d" + start-hour start-min end-hour end-min)))))) ;;; Single Event Parsing +(defun calendar-sync--event-cancelled-p (event-str) + "Return non-nil when EVENT-STR carries STATUS:CANCELLED. +This is the VEVENT's own STATUS property (RFC 5545 3.8.1.11), not the +user's attendee PARTSTAT. Matching is case-insensitive." + (let ((status (calendar-sync--get-property event-str "STATUS"))) + (and status (string= (upcase status) "CANCELLED")))) + (defun calendar-sync--parse-event (event-str) "Parse single VEVENT string EVENT-STR into plist. Returns plist with :uid :summary :description :location :start :end :attendees :organizer :url :status. Returns nil if event lacks required fields (DTSTART, SUMMARY). Skips events with RECURRENCE-ID (individual instances of recurring events -are handled separately via exception collection). +are handled separately via exception collection) and events whose own +STATUS is CANCELLED -- a cancelled meeting must not render, and a +cancelled series master kills its whole series because RRULE expansion +builds its base event through this function. Handles TZID-qualified timestamps by converting to local time. Cleans text fields (description, location, summary) via `calendar-sync--clean-text'." - ;; Skip individual instances of recurring events (they're collected as exceptions) - (unless (calendar-sync--get-property event-str "RECURRENCE-ID") + ;; Skip individual instances of recurring events (they're collected as + ;; exceptions) and cancelled events (they must not render). + (unless (or (calendar-sync--get-property event-str "RECURRENCE-ID") + (calendar-sync--event-cancelled-p event-str)) (let* ((uid (calendar-sync--get-property event-str "UID")) (summary (calendar-sync--clean-text (calendar-sync--get-property event-str "SUMMARY"))) diff --git a/modules/calendar-sync-recurrence.el b/modules/calendar-sync-recurrence.el index 2689cdd6..9ef12ce5 100644 --- a/modules/calendar-sync-recurrence.el +++ b/modules/calendar-sync-recurrence.el @@ -90,6 +90,9 @@ dropped by `calendar-sync--filter-declined'." (list :recurrence-id (calendar-sync--localize-parsed-datetime recurrence-id-parsed recurrence-id-is-utc recurrence-id-tzid) :recurrence-id-raw recurrence-id + ;; A cancelled override removes its occurrence downstream + ;; rather than rescheduling it. + :cancelled (calendar-sync--event-cancelled-p event-str) :start start-parsed :end end-parsed :summary summary @@ -164,24 +167,30 @@ Compares year, month, day, hour, minute." "Apply EXCEPTIONS to OCCURRENCES list. OCCURRENCES is list of event plists from RRULE expansion. EXCEPTIONS is hash table from `calendar-sync--collect-recurrence-exceptions'. -Returns new list with matching occurrences replaced by exception times." +Returns new list with matching occurrences replaced by exception times. +A cancelled exception (STATUS:CANCELLED override) removes its occurrence +from the list instead of overriding it." (if (or (null occurrences) (null exceptions)) occurrences - (mapcar - (lambda (occurrence) - (let* ((uid (plist-get occurrence :uid)) - (uid-exceptions (and uid (gethash uid exceptions)))) - (if (null uid-exceptions) - occurrence - ;; Check if any exception matches this occurrence - (let ((matching-exception - (cl-find-if (lambda (exc) - (calendar-sync--occurrence-matches-exception-p occurrence exc)) - uid-exceptions))) - (if matching-exception - (calendar-sync--apply-single-exception occurrence matching-exception) - occurrence))))) - occurrences))) + (delq nil + (mapcar + (lambda (occurrence) + (let* ((uid (plist-get occurrence :uid)) + (uid-exceptions (and uid (gethash uid exceptions)))) + (if (null uid-exceptions) + occurrence + ;; Check if any exception matches this occurrence + (let ((matching-exception + (cl-find-if (lambda (exc) + (calendar-sync--occurrence-matches-exception-p occurrence exc)) + uid-exceptions))) + (cond + ((null matching-exception) occurrence) + ;; Cancelled instance: drop it entirely. + ((plist-get matching-exception :cancelled) nil) + (t (calendar-sync--apply-single-exception + occurrence matching-exception))))))) + occurrences)))) ;;; EXDATE (Excluded Date) Handling @@ -291,7 +300,9 @@ OCCURRENCE-DATE should be a list (year month day hour minute second)." (defun calendar-sync--parse-rrule (rrule-str) "Parse RRULE string into plist. -Returns plist with :freq :interval :byday :until :count." +Returns plist with :freq :interval :byday :bysetpos :bymonth :until :count. +BYMONTH keeps only the first value of a comma-separated list -- feeds in +practice emit a single month there." (let ((parts (split-string rrule-str ";")) (result '())) (dolist (part parts) @@ -302,6 +313,8 @@ Returns plist with :freq :interval :byday :until :count." ("FREQ" (setq result (plist-put result :freq (intern (downcase value))))) ("INTERVAL" (setq result (plist-put result :interval (string-to-number value)))) ("BYDAY" (setq result (plist-put result :byday (split-string value ",")))) + ("BYSETPOS" (setq result (plist-put result :bysetpos (string-to-number value)))) + ("BYMONTH" (setq result (plist-put result :bymonth (string-to-number value)))) ("UNTIL" (setq result (plist-put result :until (calendar-sync--parse-timestamp value)))) ("COUNT" (setq result (plist-put result :count (string-to-number value)))))))) ;; Set defaults @@ -322,7 +335,8 @@ ADVANCE-FN takes (current-date interval) and returns the next date." (num-generated 0) (range-end-time (cadr range))) (while (and (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) - (or (not until) (calendar-sync--before-date-p current-date until)) + ;; UNTIL is inclusive (RFC 5545 3.3.10) -- on-or-before, not before. + (or (not until) (calendar-sync--date-on-or-before-p current-date until)) (or (not count) (< num-generated count))) (let ((occurrence-datetime (append current-date (nthcdr 3 start)))) (setq num-generated (1+ num-generated)) @@ -364,7 +378,8 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (while (and (< iterations max-iterations) (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) (or (not count) (< num-generated count)) - (or (not until) (calendar-sync--before-date-p current-date until))) + ;; UNTIL is inclusive (RFC 5545 3.3.10) -- on-or-before, not before. + (or (not until) (calendar-sync--date-on-or-before-p current-date until))) (setq iterations (1+ iterations)) ;; Generate occurrences for each weekday in this week (dolist (weekday weekdays) @@ -372,8 +387,8 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (days-ahead (mod (- weekday current-weekday) 7)) (occurrence-date (calendar-sync--add-days current-date days-ahead)) (occurrence-datetime (append occurrence-date (nthcdr 3 start)))) - ;; Check UNTIL date first - (when (or (not until) (calendar-sync--before-date-p occurrence-date until)) + ;; Check UNTIL date first -- inclusive per RFC 5545 3.3.10. + (when (or (not until) (calendar-sync--date-on-or-before-p occurrence-date until)) ;; Check COUNT - increment BEFORE range check so COUNT is absolute from start (when (or (not count) (< num-generated count)) (setq num-generated (1+ num-generated)) @@ -387,18 +402,149 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (calendar-sync--log-silently "calendar-sync: WARNING: Hit max iterations (%d) expanding weekly event" max-iterations)) (nreverse occurrences))) +(defun calendar-sync--parse-byday-entry (entry) + "Parse a single RRULE BYDAY ENTRY into a cons (ORDINAL . WEEKDAY). +ENTRY is a string like \"2WE\" (2nd Wednesday), \"-1TU\" (last Tuesday), +or \"SU\" (bare weekday). ORDINAL is nil for a bare weekday. WEEKDAY is +1-7 (Monday = 1). Returns nil for unparseable input." + (when (and (stringp entry) + (string-match "\\`\\(-?[0-9]+\\)?\\([A-Z][A-Z]\\)\\'" entry)) + (let ((ordinal (match-string 1 entry)) + (weekday (calendar-sync--weekday-to-number (match-string 2 entry)))) + (when weekday + (cons (and ordinal (string-to-number ordinal)) weekday))))) + +(defun calendar-sync--byday-days-in-month (year month byday-entries bysetpos) + "Return the sorted day-of-month list BYDAY-ENTRIES select in YEAR/MONTH. +An entry with an ordinal (\"2WE\") resolves directly via +`calendar-sync--nth-weekday-of-month'. A bare entry (\"SU\") expands to +every matching weekday in the month. When BYSETPOS is non-nil it then +selects one day from the combined set (1-based; negative counts from the +end), per RFC 5545 3.8.5.3. Months with no match return nil." + (let ((days '())) + (dolist (entry byday-entries) + (let ((parsed (calendar-sync--parse-byday-entry entry))) + (when parsed + (let ((ordinal (car parsed)) + (weekday (cdr parsed))) + (if ordinal + (let ((day (calendar-sync--nth-weekday-of-month year month weekday ordinal))) + (when day (push day days))) + (let ((n 1) day) + (while (setq day (calendar-sync--nth-weekday-of-month year month weekday n)) + (push day days) + (setq n (1+ n))))))))) + (setq days (sort (delete-dups days) #'<)) + (if (and bysetpos days) + (let* ((total (length days)) + (index (if (> bysetpos 0) bysetpos (+ total bysetpos 1)))) + (if (and (>= index 1) (<= index total)) + (list (nth (1- index) days)) + '())) + days))) + +(defun calendar-sync--expand-monthly-byday (base-event rrule range) + "Expand a monthly nth-weekday (BYDAY) recurring event. +BASE-EVENT is the event plist, RRULE is parsed rrule (carrying :byday and +optionally :bysetpos), RANGE is date range. Steps month by month from +DTSTART's month, landing each occurrence on the day its BYDAY rule selects +-- never on DTSTART's day-of-month." + (let* ((start (plist-get base-event :start)) + (interval (plist-get rrule :interval)) + (byday (plist-get rrule :byday)) + (bysetpos (plist-get rrule :bysetpos)) + (until (plist-get rrule :until)) + (count (plist-get rrule :count)) + (occurrences '()) + (month-anchor (list (nth 0 start) (nth 1 start) 1)) + (start-day (nth 2 start)) + (first-month t) + (num-generated 0) + (range-end-time (cadr range)) + (max-iterations 1000) + (iterations 0)) + (when (<= interval 0) + (error "Invalid RRULE interval: %s (must be > 0)" interval)) + (while (and (< iterations max-iterations) + (or count until + (time-less-p (calendar-sync--date-to-time month-anchor) range-end-time)) + (or (not count) (< num-generated count)) + ;; A month starting after UNTIL can't contain an occurrence + ;; on-or-before it (UNTIL is inclusive, RFC 5545 3.3.10). + (or (not until) (calendar-sync--date-on-or-before-p month-anchor until))) + (setq iterations (1+ iterations)) + (dolist (day (calendar-sync--byday-days-in-month + (nth 0 month-anchor) (nth 1 month-anchor) byday bysetpos)) + (let* ((occurrence-date (list (nth 0 month-anchor) (nth 1 month-anchor) day)) + (occurrence-datetime (append occurrence-date (nthcdr 3 start)))) + ;; The series starts at DTSTART: skip earlier days in the first month. + (unless (and first-month (< day start-day)) + (when (or (not until) (calendar-sync--date-on-or-before-p occurrence-date until)) + (when (or (not count) (< num-generated count)) + (setq num-generated (1+ num-generated)) + (when (calendar-sync--date-in-range-p occurrence-datetime range) + (push (calendar-sync--create-occurrence base-event occurrence-datetime) + occurrences))))))) + (setq first-month nil) + (setq month-anchor (calendar-sync--add-months month-anchor interval))) + (when (>= iterations max-iterations) + (calendar-sync--log-silently + "calendar-sync: WARNING: Hit max iterations (%d) expanding monthly BYDAY event" + max-iterations)) + (nreverse occurrences))) + (defun calendar-sync--expand-monthly (base-event rrule range) "Expand monthly recurring event. -BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." - (calendar-sync--expand-simple-recurrence - base-event rrule range #'calendar-sync--add-months)) +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. +A rule with BYDAY (nth weekday, e.g. 2WE, -1TU, or SU with BYSETPOS) +expands via `calendar-sync--expand-monthly-byday'; a plain rule steps +DTSTART's day-of-month, skipping months without that day." + (if (plist-get rrule :byday) + (calendar-sync--expand-monthly-byday base-event rrule range) + (calendar-sync--expand-simple-recurrence + base-event rrule range #'calendar-sync--next-monthly-date))) + +(defun calendar-sync--next-monthly-date (date interval) + "Step DATE forward INTERVAL months, skipping months without DATE's day. +A plain FREQ=MONTHLY on the 31st must skip short months (RFC 5545): +`calendar-sync--add-months' keeps day-of-month verbatim, so Jan 31 would +step to Feb 31, which encode-time normalizes into a phantom Mar 3 +occurrence. Bounded so a pathological input can't loop forever." + (require 'time-date) + (let ((next (calendar-sync--add-months date interval)) + (day (nth 2 date)) + (guard 0)) + (while (and (< guard 100) + (> day (date-days-in-month (nth 0 next) (nth 1 next)))) + (setq guard (1+ guard)) + (setq next (calendar-sync--add-months next interval))) + next)) + +(defun calendar-sync--expand-yearly-byday (base-event rrule range) + "Expand a yearly nth-weekday event (e.g. BYMONTH=3;BYDAY=2SU). +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. +Reuses the monthly BYDAY expander with a 12-month step, anchored on +:bymonth (falling back to DTSTART's month)." + (let* ((start (plist-get base-event :start)) + (month (or (plist-get rrule :bymonth) (nth 1 start))) + (sched-event (plist-put (copy-sequence base-event) :start + (append (list (nth 0 start) month (nth 2 start)) + (nthcdr 3 start)))) + (sched-rrule (plist-put (copy-sequence rrule) :interval + (* 12 (or (plist-get rrule :interval) 1))))) + (calendar-sync--expand-monthly-byday sched-event sched-rrule range))) (defun calendar-sync--expand-yearly (base-event rrule range) "Expand yearly recurring event. -BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." - (calendar-sync--expand-simple-recurrence - base-event rrule range - (lambda (date interval) (calendar-sync--add-months date (* 12 interval))))) +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. +A rule with BYDAY (the DST clock-change shape, BYMONTH=n;BYDAY=nWD) +expands via `calendar-sync--expand-yearly-byday'; a plain rule repeats +DTSTART's calendar date." + (if (plist-get rrule :byday) + (calendar-sync--expand-yearly-byday base-event rrule range) + (calendar-sync--expand-simple-recurrence + base-event rrule range + (lambda (date interval) (calendar-sync--add-months date (* 12 interval)))))) (defun calendar-sync--expand-recurring-event (event-str range) "Expand recurring event EVENT-STR into individual occurrences within RANGE. diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index 804d71fa..d504f246 100644 --- a/modules/calendar-sync.el +++ b/modules/calendar-sync.el @@ -300,16 +300,28 @@ When called non-interactively with nil, syncs all calendars." ;;; Timer management (defun calendar-sync--sync-timer-function () - "Function called by sync timer. -Checks for timezone changes and triggers re-sync if detected." - (when (calendar-sync--timezone-changed-p) - (let ((old-tz (calendar-sync--format-timezone-offset - calendar-sync--last-timezone-offset)) - (new-tz (calendar-sync--format-timezone-offset - (calendar-sync--current-timezone-offset)))) - (message "calendar-sync: Timezone change detected (%s → %s), re-syncing..." - old-tz new-tz))) - (calendar-sync--sync-all-calendars)) + "Function called by the hourly sync timer. +Checks for timezone changes and triggers re-sync if detected. + +The body is wrapped so a signal — from the timezone check or the sync +fan-out — is caught and logged rather than propagated: this runs from a +`run-at-time' timer, and an unguarded error would repeat on every tick, +once an hour, indefinitely. The timezone-change notice goes to the silent +log, not the echo area, since an hourly timer must not spam `message'." + (condition-case err + (progn + (when (calendar-sync--timezone-changed-p) + (let ((old-tz (calendar-sync--format-timezone-offset + calendar-sync--last-timezone-offset)) + (new-tz (calendar-sync--format-timezone-offset + (calendar-sync--current-timezone-offset)))) + (calendar-sync--log-silently + "calendar-sync: Timezone change detected (%s → %s), re-syncing..." + old-tz new-tz))) + (calendar-sync--sync-all-calendars)) + (error + (calendar-sync--log-silently + "calendar-sync: sync timer error: %s" (error-message-string err))))) ;;;###autoload (defun calendar-sync-start () diff --git a/modules/calibredb-epub-config.el b/modules/calibredb-epub-config.el index b03d83ed..27fa6369 100644 --- a/modules/calibredb-epub-config.el +++ b/modules/calibredb-epub-config.el @@ -205,22 +205,14 @@ Adjust it live with `cj/nov-widen-text' and `cj/nov-narrow-text'.") (defvar cj/nov-margin-step 2 "Percentage points each `cj/nov-widen-text'/`cj/nov-narrow-text' press changes.") -;; Prevent magic-fallback-mode-alist from opening epub as archive-mode -;; Advise set-auto-mode to force nov-mode for .epub files before magic-fallback runs -(defun cj/force-nov-mode-for-epub (orig-fun &rest args) - "Force nov-mode for .epub files, bypassing archive-mode detection." - (if (and buffer-file-name - (string-match-p "\\.epub\\'" buffer-file-name)) - (progn - (unless (featurep 'nov) - (require 'nov nil t)) - ;; Call nov-mode if available, otherwise fallback to default behavior - (if (fboundp 'nov-mode) - (nov-mode) - (apply orig-fun args))) - (apply orig-fun args))) - -(advice-add 'set-auto-mode :around #'cj/force-nov-mode-for-epub) +;; .epub reaches nov-mode through auto-mode-alist -- nov's use-package :mode +;; below registers "\\.epub\\'" there, and `set-auto-mode' consults +;; auto-mode-alist before magic-fallback-mode-alist, so the zip container never +;; reaches the archive-mode fallback. An :around advice on `set-auto-mode' used +;; to force this and was pure overhead: set-auto-mode runs on every file visit, +;; so it added a frame and a failure surface to every file of every type. +;; Verified live before removal -- a real zip-format .epub opened in nov-mode +;; both with the advice and without it. ;; Define helper functions before use-package so they're available for hooks (defun cj/forward-paragraph-and-center () @@ -519,8 +511,7 @@ computed column based on the window text area width." (goto-char (point-min)) ;; Work in the selected window showing this buffer (if any). (when-let* ((win (get-buffer-window (current-buffer) t)) - (col-width (window-body-width win)) ;; columns - (col-px (* col-width (window-font-width win)))) + (col-width (window-body-width win))) ;; columns (while (let ((m (text-property-search-forward 'display nil (lambda (_ p) (and (consp p) (eq (car-safe p) 'image)))))) diff --git a/modules/coverage-core.el b/modules/coverage-core.el index e8f7a474..c320651d 100644 --- a/modules/coverage-core.el +++ b/modules/coverage-core.el @@ -220,7 +220,7 @@ empty hash table. Malformed hunk headers are skipped silently." "Return the merge-base between HEAD and BASE." (let ((merge-base (string-trim (cj/git-output-or-error "merge-base" "HEAD" base)))) - (unless (not (string-empty-p merge-base)) + (when (string-empty-p merge-base) (user-error "git merge-base HEAD %s returned no commit" base)) merge-base)) diff --git a/modules/custom-case.el b/modules/custom-case.el index dde2d6c1..c203cd9e 100644 --- a/modules/custom-case.el +++ b/modules/custom-case.el @@ -62,6 +62,61 @@ CHARS-SKIP-RESET: : ! ? .), reached by skipping blanks back to PREV-WORD-END." (and (not (zerop (skip-chars-backward "[:blank:]" prev-word-end))) (memq (char-before (point)) chars-skip-reset))))) +(defconst cj/--title-case-reset-chars '(?: ?! ?? ?.) + "Characters that restart capitalization for the following word. +So \"Warning: An Example\" capitalizes the \"An\" and a sentence-ending +period capitalizes the next word (\"End. The Next\").") + +(defconst cj/--title-case-separator-chars '(?\\ ?- ?' ?.) + "Characters whose following character is never capitalized. +Covers \"Foo-bar\", \"Foo\\bar\", and \"Foo's\". The period keeps +\"3.14\" and \"foo.bar\" untouched; a period followed by a blank still +restarts capitalization via `cj/--title-case-reset-chars'.") + +(defconst cj/--title-case-minor-words + '("a" "an" "and" "as" "at" "but" "by" + "for" "if" "in" "nor" "of" + "on" "or" "so" "the" "to" "yet") + "Minor words kept lowercase mid-title. +\"is\" and other linking verbs are major words, so they are not here.") + +(defconst cj/--title-case-word-chars "[:alnum:]" + "skip-chars set that constitutes a word for title-casing.") + +(defun cj/--title-case-region-bounds () + "Return (BEG . END) for the active region, else the current line." + (if (region-active-p) + (cons (region-beginning) (region-end)) + (cons (line-beginning-position) (line-end-position)))) + +(defun cj/--title-case-last-word-start (beg end) + "Return the start position of the last word in BEG..END. +The last word is always capitalized in title case, so it is located once: +from END, skip back over trailing non-word characters, then the word." + (save-excursion + (goto-char end) + (skip-chars-backward (concat "^" cj/--title-case-word-chars) beg) + (skip-chars-backward cj/--title-case-word-chars beg) + (point))) + +(defun cj/--title-case-maybe-capitalize (word-end end is-first last-word-start prev-word-end) + "Capitalize the character at point when title-case rules call for it. +Point sits on a word's first character, WORD-END past its last. END bounds +the operation; IS-FIRST, LAST-WORD-START, and PREV-WORD-END feed +`cj/--title-case-capitalize-word-p'. Modifies the buffer in place." + (unless (or (>= (point) end) + (memq (char-before (point)) cj/--title-case-separator-chars)) + (let* ((c-orig (char-to-string (char-after (point)))) + (c-up (capitalize c-orig))) + (unless (string-equal c-orig c-up) + (let ((word (buffer-substring-no-properties (point) word-end))) + (when (cj/--title-case-capitalize-word-p + word is-first (= (point) last-word-start) + prev-word-end cj/--title-case-minor-words + cj/--title-case-reset-chars) + (delete-region (point) (1+ (point))) + (insert c-up))))))) + (defun cj/title-case-region () "Capitalize the region in title case format. Title case is a capitalization convention where major words are capitalized, @@ -73,43 +128,13 @@ and last words are always capitalized, and a word following a sentence-ending period (or a colon, exclamation mark, or question mark) restarts capitalization even when it is a minor word." (interactive) - (let ((beg nil) - (end nil) - (prev-word-end nil) - (last-word-start nil) - ;; Restart capitalization for a minor word after one of these, so - ;; "Warning: An Example" capitalizes the "An" and a sentence-ending - ;; period capitalizes the next word ("End. The Next"). - (chars-skip-reset '(?: ?! ?? ?.)) - ;; Don't capitalize characters directly after these. e.g. - ;; "Foo-bar" or "Foo\bar" or "Foo's". A period is here too, so - ;; "3.14" and "foo.bar" are left alone; a period followed by a - ;; blank still restarts via `chars-skip-reset' above. - (chars-separator '(?\\ ?- ?' ?.)) - (word-chars "[:alnum:]") - ;; "is" and other linking verbs are major words, so they are not in - ;; this minor-word skip list. - (word-skip - (list "a" "an" "and" "as" "at" "but" "by" - "for" "if" "in" "nor" "of" - "on" "or" "so" "the" "to" "yet")) - (is-first t)) - (cond - ((region-active-p) - (setq beg (region-beginning)) - (setq end (region-end))) - (t - (setq beg (line-beginning-position)) - (setq end (line-end-position)))) - ;; The last word is always capitalized in title case, so find its start - ;; once: from END, skip back over any trailing non-word chars, then over - ;; the word itself. - (setq last-word-start - (save-excursion - (goto-char end) - (skip-chars-backward (concat "^" word-chars) beg) - (skip-chars-backward word-chars beg) - (point))) + (let* ((bounds (cj/--title-case-region-bounds)) + (beg (car bounds)) + (end (cdr bounds)) + (last-word-start (cj/--title-case-last-word-start beg end)) + (word-chars cj/--title-case-word-chars) + (prev-word-end nil) + (is-first t)) (save-excursion ;; work on uppercased text (e.g., headlines) by downcasing first (downcase-region beg end) @@ -123,17 +148,8 @@ capitalization even when it is a minor word." (save-excursion (skip-chars-forward word-chars end) (point)))) - (unless (or (>= (point) end) - (memq (char-before (point)) chars-separator)) - (let* ((c-orig (char-to-string (char-after (point)))) - (c-up (capitalize c-orig))) - (unless (string-equal c-orig c-up) - (let ((word (buffer-substring-no-properties (point) word-end))) - (when (cj/--title-case-capitalize-word-p - word is-first (= (point) last-word-start) - prev-word-end word-skip chars-skip-reset) - (delete-region (point) (1+ (point))) - (insert c-up)))))) + (cj/--title-case-maybe-capitalize + word-end end is-first last-word-start prev-word-end) (goto-char word-end) (setq is-first nil)))))) diff --git a/modules/custom-comments.el b/modules/custom-comments.el index 73d29b0c..2e77af5a 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -72,6 +72,18 @@ is the line-opening prologue shared by the divider and inline-border emitters." (when (equal cmt-start ";") (insert cmt-start)) (insert " ")) +(defun cj/--comment-read-syntax () + "Return the buffer's comment syntax as a cons (COMMENT-START . COMMENT-END). +Falls back to prompting for the start when the buffer has none, and to an +empty end string. The single source of the resolution that was previously +copied into each command wrapper." + (cons (if (and (boundp 'comment-start) comment-start) + comment-start + (read-string "Comment start character(s): ")) + (if (and (boundp 'comment-end) comment-end) + comment-end + ""))) + ;; ----------------------------- Inline Border --------------------------------- (defun cj/--comment-inline-border (cmt-start cmt-end decoration-char text length) @@ -129,12 +141,9 @@ LENGTH is the total width of the line." DECORATION-CHAR defaults to \"#\" if not provided. Uses the lesser of `fill-column\\=' or 80 for line length." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (or decoration-char "#")) (text (capitalize (string-trim (read-from-minibuffer "Comment: ")))) (length (min fill-column 80))) @@ -157,12 +166,9 @@ delegates to `cj/--comment-padded-divider' with PADDING 0." "Insert a simple divider comment banner. Prompts for decoration character, text, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default =): " nil nil "=")) (text (read-string "Comment text: ")) (length-option (completing-read "Comment length: " @@ -200,8 +206,13 @@ PADDING is the number of spaces before the text." (if (string-empty-p cmt-end) 0 (1+ (length cmt-end)))))) (when (< length min-length) (error "Length %d is too small to generate comment (minimum %d)" length min-length)) + ;; Mirror every term the emit path adds: the prologue also inserts a + ;; doubled semicolon (elisp) and a trailing space that this budget used + ;; to omit, rendering dividers LENGTH+2 (elisp) or LENGTH+1 wide. (let* ((available-width (- length current-column-pos (length cmt-start) + (if (equal cmt-start ";") 1 0) ; doubled semicolon + 1 ; space after comment-start (if (string-empty-p cmt-end) 0 (1+ (length cmt-end))))) (line (make-string available-width (string-to-char decoration-char)))) ;; Top line @@ -232,12 +243,9 @@ PADDING is the number of spaces before the text." "Insert a padded divider comment banner. Prompts for decoration character, text, padding, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default =): " nil nil "=")) (text (read-string "Comment text: ")) (padding (string-to-number (read-string "Padding spaces (default 2): " nil nil "2"))) @@ -333,12 +341,9 @@ LENGTH is the total width of each line." "Insert a 3-line comment box with centered text. Prompts for decoration character, text, and uses `fill-column' for length." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default -): " nil nil "-")) (text (capitalize (string-trim (read-from-minibuffer "Comment: ")))) (length (min fill-column 80))) @@ -361,12 +366,9 @@ text, so it delegates to `cj/--comment-box-emit' with HEAVY non-nil." "Insert a heavy box comment with blank lines around centered text. Prompts for decoration character, text, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default *): " nil nil "*")) (text (read-string "Comment text: ")) (length-option (completing-read "Comment length: " @@ -444,12 +446,9 @@ BOX-STYLE is either \\='single or \\='double for line style." "Insert a unicode box comment. Prompts for text, box style, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (text (read-string "Comment text: ")) (box-style (intern (completing-read "Comment box style: " '("single" "double") diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 12d2deaf..3c33dcad 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -126,18 +126,27 @@ active, otherwise the entire buffer." (cons (region-beginning) (region-end)) (cons (point-min) (point-max)))) -(defun cj/append-to-lines-in-region-or-buffer (str) - "Append STR to the end of each line in the region or entire buffer." - (interactive "sEnter string to append: ") +(defun cj/--replace-region-or-buffer (transform) + "Replace the region (or whole buffer) with TRANSFORM applied to its text. +TRANSFORM takes the current text and returns the replacement. The +replacement is computed before anything is deleted, so a TRANSFORM error +leaves the buffer untouched. Point lands at the start of the replaced +span. The shared delete/goto/insert tail of the line-transform commands." (let* ((bounds (cj/--region-or-buffer-bounds)) (start-pos (car bounds)) (end-pos (cdr bounds)) (text (buffer-substring start-pos end-pos)) - (insertion (cj/--append-to-lines text str))) + (insertion (funcall transform text))) (delete-region start-pos end-pos) (goto-char start-pos) (insert insertion))) +(defun cj/append-to-lines-in-region-or-buffer (str) + "Append STR to the end of each line in the region or entire buffer." + (interactive "sEnter string to append: ") + (cj/--replace-region-or-buffer + (lambda (text) (cj/--append-to-lines text str)))) + (defun cj/--prepend-to-lines (text prefix) "Internal implementation: Prepend PREFIX to each line in TEXT. TEXT is the string containing one or more lines. @@ -158,14 +167,8 @@ Returns the transformed string without modifying the buffer." (defun cj/prepend-to-lines-in-region-or-buffer (str) "Prepend STR to the beginning of each line in the region or entire buffer." (interactive "sEnter string to prepend: ") - (let* ((bounds (cj/--region-or-buffer-bounds)) - (start-pos (car bounds)) - (end-pos (cdr bounds)) - (text (buffer-substring start-pos end-pos)) - (insertion (cj/--prepend-to-lines text str))) - (delete-region start-pos end-pos) - (goto-char start-pos) - (insert insertion))) + (cj/--replace-region-or-buffer + (lambda (text) (cj/--prepend-to-lines text str)))) (defun cj/--indent-lines (text count use-tabs) "Internal implementation: Indent each line in TEXT by COUNT characters. @@ -188,14 +191,8 @@ mean the count. Call it from Lisp with an explicit USE-TABS to override." (prefix-numeric-value current-prefix-arg) 4) indent-tabs-mode)) - (let* ((bounds (cj/--region-or-buffer-bounds)) - (start-pos (car bounds)) - (end-pos (cdr bounds)) - (text (buffer-substring start-pos end-pos)) - (insertion (cj/--indent-lines text count use-tabs))) - (delete-region start-pos end-pos) - (goto-char start-pos) - (insert insertion))) + (cj/--replace-region-or-buffer + (lambda (text) (cj/--indent-lines text count use-tabs)))) (defun cj/--dedent-lines (text count) "Internal implementation: Remove up to COUNT leading characters from each line. @@ -234,14 +231,8 @@ Works on region if active, otherwise entire buffer." (interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) 4))) - (let* ((bounds (cj/--region-or-buffer-bounds)) - (start-pos (car bounds)) - (end-pos (cdr bounds)) - (text (buffer-substring start-pos end-pos)) - (insertion (cj/--dedent-lines text count))) - (delete-region start-pos end-pos) - (goto-char start-pos) - (insert insertion))) + (cj/--replace-region-or-buffer + (lambda (text) (cj/--dedent-lines text count)))) ;; Text enclosure keymap (defvar-keymap cj/enclose-map diff --git a/modules/dashboard-config.el b/modules/dashboard-config.el index d5aa501d..c7ff39dc 100644 --- a/modules/dashboard-config.el +++ b/modules/dashboard-config.el @@ -73,6 +73,7 @@ ;; External package commands invoked by launchers. (declare-function mu4e "mu4e") (declare-function pearl-list-issues "pearl") +(declare-function wttrin "wttrin") ;; ------------------------ Dashboard Bookmarks Override ----------------------- ;; overrides the bookmark insertion from the dashboard package to provide an @@ -84,38 +85,47 @@ (defvar dashboard-bookmarks-item-format "%s" "Format to use when showing the base of the file name.") -;; `el' is bound dynamically by dashboard's section-insertion machinery, which the -;; override below plugs into. Declare it so the byte-compiler reads the -;; references as that special variable rather than a free variable. The name is -;; dashboard's, not ours, so the missing-prefix lint is suppressed rather than -;; renamed (renaming would break the dynamic binding dashboard supplies). -(with-suppressed-warnings ((lexical el)) - (defvar el)) - -(defun dashboard-insert-bookmarks (list-size) - "Add the list of LIST-SIZE items of bookmarks." - (require 'bookmark) - (dashboard-insert-section - "Bookmarks:" - (dashboard-subseq (bookmark-all-names) list-size) - list-size - 'bookmarks - (dashboard-get-shortcut 'bookmarks) - `(lambda (&rest _) (bookmark-jump ,el)) - (if-let* ((filename el) - (path (bookmark-get-filename el)) - (path-shorten (dashboard-shorten-path path 'bookmarks))) - (cl-case dashboard-bookmarks-show-path - (`align - (unless dashboard--bookmarks-cache-item-format - (let* ((len-align (dashboard--align-length-by-type 'bookmarks)) - (new-fmt (dashboard--generate-align-format - dashboard-bookmarks-item-format len-align))) - (setq dashboard--bookmarks-cache-item-format new-fmt))) - (format dashboard--bookmarks-cache-item-format filename path-shorten)) - (`nil filename) - (t (format dashboard-bookmarks-item-format filename path-shorten))) - el))) +;; No `(defvar el)' here on purpose. `el' is the per-item variable that +;; dashboard's `dashboard-insert-section' macro binds inside its own expansion; +;; the override's forms below reference it within that binding. Declaring `el' +;; special (as an earlier attempt did) is what CREATED a byte-compile warning -- +;; it turned the macro's ordinary lexical binding into one that "shadows the +;; dynamic variable el". Left lexical, the references resolve inside the +;; expansion and the compile is clean. + +;; The override body uses the `dashboard-insert-section' MACRO, so it must be +;; known when this module byte-compiles or the call compiles as a plain +;; function call that evaluates `el' eagerly -- void-variable at render time. +(eval-when-compile (require 'dashboard-widgets nil t)) + +;; Registered after dashboard-widgets, not as a bare top-level defun: the +;; use-package below reloads dashboard-widgets, which would clobber an eager +;; override. Same shape as the banner-title override further down. +(with-eval-after-load 'dashboard-widgets + (defun dashboard-insert-bookmarks (list-size) + "Add the list of LIST-SIZE items of bookmarks." + (require 'bookmark) + (dashboard-insert-section + "Bookmarks:" + (dashboard-subseq (bookmark-all-names) list-size) + list-size + 'bookmarks + (dashboard-get-shortcut 'bookmarks) + `(lambda (&rest _) (bookmark-jump ,el)) + (if-let* ((filename el) + (path (bookmark-get-filename el)) + (path-shorten (dashboard-shorten-path path 'bookmarks))) + (cl-case dashboard-bookmarks-show-path + (`align + (unless dashboard--bookmarks-cache-item-format + (let* ((len-align (dashboard--align-length-by-type 'bookmarks)) + (new-fmt (dashboard--generate-align-format + dashboard-bookmarks-item-format len-align))) + (setq dashboard--bookmarks-cache-item-format new-fmt))) + (format dashboard--bookmarks-cache-item-format filename path-shorten)) + (`nil filename) + (t (format dashboard-bookmarks-item-format filename path-shorten))) + el)))) ;; ------------------------- Banner Title Centering Fix ------------------------ ;; The default centering can be off due to font width calculations. diff --git a/modules/dev-fkeys.el b/modules/dev-fkeys.el index 80b43600..c760e392 100644 --- a/modules/dev-fkeys.el +++ b/modules/dev-fkeys.el @@ -82,13 +82,25 @@ recognized markers both return nil." ;; ---------- Action handlers ---------- +(defun cj/--f4-install-once-hook (buffer then-fn) + "Install a one-shot buffer-local compilation finish hook in BUFFER. +Installing in the compilation buffer itself (rather than globally) +means a quit before the compile starts, or an unrelated concurrent +compile, can never fire the chained THEN-FN. No-op when BUFFER is not +a live buffer." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (add-hook 'compilation-finish-functions + (cj/--f4-make-once-hook then-fn) nil t)))) + (defun cj/--f4-compile-and-run-impl () "Run `projectile-compile-project', then `projectile-run-project' on success. -Installs a one-shot `compilation-finish-functions' hook to chain the run." - (add-hook 'compilation-finish-functions - (cj/--f4-make-once-hook - (lambda () (projectile-run-project nil)))) - (projectile-compile-project nil)) +Chains the run via a one-shot finish hook installed buffer-locally in +the compilation buffer projectile returns." + (let ((result (projectile-compile-project nil))) + (cj/--f4-install-once-hook + (cj/--projectile-compilation-buffer result) + (lambda () (projectile-run-project nil))))) (defun cj/--f4-dispatch (action) "Route ACTION (a symbol from `cj/--f4-candidates') to its handler. @@ -109,24 +121,26 @@ command (prompted-and-cached by projectile) drives the build." (let ((clean-cmd (cj/--f4-derive-clean-cmd root))) (unless clean-cmd (user-error "Clean + Rebuild: no clean command for this project type")) - (add-hook 'compilation-finish-functions - (cj/--f4-make-once-hook - (lambda () (projectile-compile-project nil)))) - (let ((default-directory root)) - (compile clean-cmd)))) + (let* ((default-directory root) + (buffer (compile clean-cmd))) + (cj/--f4-install-once-hook + buffer (lambda () (projectile-compile-project nil)))))) ;; ---------- One-shot compilation-finish hook ---------- (defun cj/--f4-make-once-hook (then-fn) "Build a one-shot `compilation-finish-functions' hook that chains THEN-FN. The returned lambda removes itself from `compilation-finish-functions' on -first invocation regardless of status, then calls THEN-FN only if the -status string starts with \"finished\" (the convention used by compile.el -for a successful compile)." +first invocation regardless of status — from both the global value and +the running buffer's local value, so it is one-shot wherever it was +installed — then calls THEN-FN only if the status string starts with +\"finished\" (the convention used by compile.el for a successful +compile)." (let (hook) (setq hook (lambda (_buf status) (remove-hook 'compilation-finish-functions hook) + (remove-hook 'compilation-finish-functions hook t) (when (and (stringp status) (string-prefix-p "finished" status)) (funcall then-fn)))) @@ -350,9 +364,10 @@ TypeScript / JavaScript and unknown languages return nil." (if (string-empty-p rel-dir) "./" (format "./%s" rel-dir))))) - ('typescript + ((or 'typescript 'javascript) ;; Prefer vitest when present on PATH, fall back to jest otherwise. - ;; Both runners take a path argument and accept relative paths. + ;; Both runners take a path argument and accept relative paths, and + ;; both run JS test files the same way they run TS ones. (let ((runner (or (and (executable-find "vitest") "vitest") (and (executable-find "jest") "jest") "jest"))) ; reasonable default for stack traces diff --git a/modules/diff-config.el b/modules/diff-config.el index 0c09b951..75911587 100644 --- a/modules/diff-config.el +++ b/modules/diff-config.el @@ -40,7 +40,6 @@ :custom (ediff-window-setup-function 'ediff-setup-windows-plain) (ediff-split-window-function 'split-window-horizontally) - (ediff-diff-options "-w") (ediff-highlight-all-diffs nil) :bind-keymap ("C-c D" . cj/ediff-map) :init diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el index 0e22dcee..edbb0b35 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -8,8 +8,8 @@ ;; Load shape: eager. ;; Eager reason: none; file manager, a command/hook-loaded deferral candidate. ;; Top-level side effects: three add-hook, package configuration via use-package. -;; Runtime requires: user-constants, system-utils, host-environment, system-lib, -;; external-open-lib. +;; Runtime requires: user-constants, system-utils, external-open, +;; host-environment, system-lib, external-open-lib. ;; Direct test load: yes. ;; ;; Enhanced file management via Dirvish (modern dired replacement) with icons, @@ -34,7 +34,8 @@ ;;; Code: (require 'user-constants) ;; code-dir, music-dir, pix-dir et al. used at load time -(require 'system-utils) ;; cj/xdg-open, cj/open-file-with-command bound to keys +(require 'system-utils) ;; cj/open-file-with-command bound to keys +(require 'external-open) ;; cj/xdg-open bound to keys ("o" and OS-handler fallback) (require 'host-environment) (require 'system-lib) (require 'external-open-lib) @@ -589,6 +590,7 @@ no popup frame is live." ("ps" ,(concat pix-dir "/screenshots/") "pictures screenshots") ("px" ,pix-dir "pictures directory") ("wp" ,(concat pix-dir "/wallpaper/") "pictures wallpaper") + ("fp" "/ftp:android@192.168.86.13#2221:/" "phone ftp (android)") ("rcj" "/sshx:cjennings@cjennings.net:~" "remote c@cjennings.net") ("rtl" "/sshx:cjennings@truenas.local:~" "remote cjennings@truenas.local") ("rtt" "/sshx:cjennings@truenas:~" "remote cjennings@truenas (tailscale)") diff --git a/modules/dwim-shell-config.el b/modules/dwim-shell-config.el index e8790a48..54272fd5 100644 --- a/modules/dwim-shell-config.el +++ b/modules/dwim-shell-config.el @@ -7,7 +7,7 @@ ;; Load shape: eager. ;; Eager reason: none; Dired/Dirvish shell commands can load by command. ;; Top-level side effects: package configuration via use-package. -;; Runtime requires: cl-lib, system-lib. +;; Runtime requires: cl-lib, system-lib, external-open. ;; Direct test load: yes. ;; ;; Configures dwim-shell-command actions for marked Dired/Dirvish files: @@ -23,6 +23,7 @@ (require 'cl-lib) (require 'system-lib) ;; cj/confirm-strong (permanent file destruction confirm) +(require 'external-open) ;; cj/xdg-open, called to open conversion output files ;; Function declarations (lazily-loaded packages and sibling modules). (declare-function dwim-shell-command-on-marked-files "dwim-shell-command") @@ -222,7 +223,7 @@ not apply to). Signals a `user-error' when a used second count is negative." :utils "convert")) (defun cj/dwim-shell-commands-flip-image-vertically () - "Horizontally flip image(s)." + "Vertically flip image(s)." (interactive) (dwim-shell-command-on-marked-files "Image vertical flip" diff --git a/modules/elfeed-config.el b/modules/elfeed-config.el index dbc7e4a4..f4feef3a 100644 --- a/modules/elfeed-config.el +++ b/modules/elfeed-config.el @@ -142,30 +142,6 @@ (elfeed-search-update--force) (goto-char (point-min))) -;; ----------------------------- Extract Stream URL ---------------------------- -;; TASK: Is this method reused anywhere here or in another file? - -(defun cj/extract-stream-url (url format) - "Extract the direct stream URL from URL using yt-dlp with FORMAT. -Returns the stream URL or nil on failure." - (unless (executable-find "yt-dlp") - (error "The program yt-dlp is not installed or not in PATH")) - (let* ((format-args (if format - (list "-f" format) - nil)) - (cmd-args (append '("yt-dlp" "-q" "-g") - format-args - (list url))) - (output (with-temp-buffer - (let ((exit-code (apply #'call-process - (car cmd-args) nil t nil - (cdr cmd-args)))) - (if (zerop exit-code) - (string-trim (buffer-string)) - nil))))) - (when (and output (string-match-p "^https?://" output)) - output))) - ;; -------------------------- Elfeed Core Processing --------------------------- (defun cj/elfeed-process-entries (action-fn action-name &optional skip-error-handling) diff --git a/modules/erc-config.el b/modules/erc-config.el index 57d4eb56..afcb3901 100644 --- a/modules/erc-config.el +++ b/modules/erc-config.el @@ -38,6 +38,7 @@ ;; without forcing an eager require. ;; Functions provided by the erc package. +(defvar erc-server-process) (declare-function erc-buffer-list "erc") (declare-function erc-server-process-alive "erc") (declare-function erc-server-or-unjoined-channel-buffer-p "erc") diff --git a/modules/external-open.el b/modules/external-open.el index 811c32c2..f7f09816 100644 --- a/modules/external-open.el +++ b/modules/external-open.el @@ -142,6 +142,18 @@ Logs output and exit code to buffer *external-open.log*." ;; ------------------------------- Open File With ------------------------------ +(defun cj/--open-with-argv (command file) + "The argv list to open FILE with the user-typed COMMAND. +COMMAND may carry arguments (\"mpv --fs\"); `split-string-and-unquote' +splits it so a double-quoted argument survives as one word. FILE is +appended as the final element, so paths with spaces or shell +metacharacters never meet a shell. Signals a `user-error' when COMMAND +is empty or whitespace." + (let ((argv (split-string-and-unquote command))) + (unless argv + (user-error "No program given")) + (append argv (list file)))) + (defun cj/open-this-file-with (command) "Open this buffer's file with COMMAND, detached from Emacs." (interactive "MOpen with program: ") @@ -152,12 +164,12 @@ Logs output and exit code to buffer *external-open.log*." ;; Windows: launch via ShellExecute so the child isn't tied to Emacs. ((env-windows-p) (w32-shell-execute "open" command (format "\"%s\"" file))) - ;; POSIX: disown with nohup + background. No child remains. + ;; POSIX: argv launch, DESTINATION 0 detaches with no shell in between. (t - (call-process-shell-command - (format "nohup %s %s >/dev/null 2>&1 &" - command (shell-quote-argument file)) - nil 0))))) + (let ((argv (cj/--open-with-argv command file))) + (unless (executable-find (car argv)) + (user-error "Program not found: %s" (car argv))) + (apply #'call-process (car argv) nil 0 nil (cdr argv))))))) ;; -------------------------- Open Videos On Repeat ---------------------------- @@ -185,6 +197,11 @@ blocks Emacs." (if (env-windows-p) (w32-shell-execute "open" cj/video-open-command (mapconcat (lambda (a) (format "\"%s\"" a)) args " ")) + ;; Guard like `cj/open-this-file-with': this fires via the find-file + ;; advice, so a missing player must fail with a clear message, not an + ;; opaque call-process error mid-visit. + (unless (executable-find cj/video-open-command) + (user-error "Program not found: %s" cj/video-open-command)) (apply #'call-process cj/video-open-command nil 0 nil args)))) ;; -------------------- Open Files With Default File Handler ------------------- diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index ebe4898e..d0cdd09c 100644 --- a/modules/flyspell-and-abbrev.el +++ b/modules/flyspell-and-abbrev.el @@ -73,8 +73,10 @@ ;; personal directory goes with sync'd files (setq ispell-personal-dictionary (concat org-dir "aspell-personal-dictionary")) - ;; skip code blocks in org mode - (add-to-list 'ispell-skip-region-alist '("^#+BEGIN_SRC" . "^#+END_SRC"))) + ;; Skip code blocks in org mode. The # must be literal and the + escaped: + ;; "#+" in regex means one-or-more #, which matches no real begin_src line, + ;; so ispell used to spell-check inside every org code block. + (add-to-list 'ispell-skip-region-alist '("^#\\+BEGIN_SRC" . "^#\\+END_SRC"))) (use-package flyspell :ensure nil ;; built-in diff --git a/modules/font-config.el b/modules/font-config.el index e5afb361..e4549c95 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -8,12 +8,12 @@ ;; Load shape: eager. ;; Eager reason: first-frame font setup and font keybindings. ;; Top-level side effects: font keys, font checks, package config. -;; Runtime requires: host-environment, keybindings. +;; Runtime requires: host-environment, font-profiles, keybindings. ;; Direct test load: yes. ;; -;; Configures fontaine presets, text scaling keys, icon/emoji fonts, and -;; programming ligatures. Presets are applied per frame so daemon clients get -;; the intended fixed/variable pitch sizes. +;; Configures task-oriented Fontaine profiles, text scaling keys, icon/emoji +;; fonts, and programming ligatures. The selected profile is global, persists +;; across restarts, and applies to every daemon frame without per-frame resets. ;; ;; Also carries font-rendering safeguards for known HarfBuzz/font-cache crashes ;; triggered by emoji and Arabic shaping in this setup. @@ -21,6 +21,7 @@ ;;; Code: (require 'host-environment) +(require 'font-profiles) (require 'keybindings) ;; establishes the C-z prefix used for "C-z F" below (defvar text-scale-mode-step) @@ -50,106 +51,156 @@ (#xFE70 . #xFEFF))) ;; Arabic Presentation Forms-B (set-char-table-range composition-function-table range nil))) -;; ----------------------- Font Family And Size Selection ---------------------- -;; preset your fixed and variable fonts, then apply them to text as a set +;; ------------------------- Workflow Font Profiles ---------------------------- +;; Each choice is a complete destination. Font size adjustments within one +;; buffer remain on C-+/C--; Fontaine owns the global workflow typography. + +(defconst cj/fontaine-profile-order + cj/font-profile-order + "Fontaine profiles in picker order.") + +(defconst cj/fontaine-profile-names + '((everyday . "Everyday") + (writing . "Writing") + (reading . "Reading") + (coding-xs . "Coding XS") + (coding-m . "Coding M") + (coding-l . "Coding L") + (coding-xl . "Coding XL") + (presentation . "Presentation")) + "Human names for Fontaine workflow profiles.") + +(defconst cj/fontaine-profile-fonts + '((everyday . "Berkeley Mono + Lexend") + (writing . "Berkeley Mono + Merriweather") + (reading . "Merriweather") + (coding-xs . "Berkeley Mono") + (coding-m . "Berkeley Mono") + (coding-l . "Berkeley Mono") + (coding-xl . "Berkeley Mono") + (presentation . "Berkeley Mono + Lexend")) + "Human-readable font combinations for Fontaine workflow profiles.") + +(defconst cj/fontaine-profile-heights + (mapcar (lambda (profile) + (cons profile + (plist-get (cj/font-profile-properties profile) + :default-height))) + cj/fontaine-profile-order) + "Default face heights for Fontaine workflow profiles.") + +(defconst cj/fontaine-ui-family "BerkeleyMono Nerd Font" + "Font family reserved for the mode line, echo area, and minibuffer.") + +(defvar fontaine-current-preset) +(defvar fontaine-preset-history) +(defvar fontaine-presets) +(defvar enable-theme-functions) +(defvar cj/fontaine-profile-history nil + "Minibuffer history for `cj/fontaine-select-profile'.") + +(declare-function fontaine-mode "fontaine") +(declare-function fontaine-restore-latest-preset "fontaine") +(declare-function fontaine-set-preset "fontaine") +(declare-function face-remap-set-base "face-remap") + +(defun cj/fontaine-profile-p (profile) + "Return non-nil when PROFILE is a configured workflow profile." + (cj/font-profile-p profile)) + +(defun cj/fontaine-profile-label (profile) + "Return the complete picker label for PROFILE." + (when (cj/fontaine-profile-p profile) + (format "%s — %s · %d pt" + (alist-get profile cj/fontaine-profile-names) + (alist-get profile cj/fontaine-profile-fonts) + (/ (alist-get profile cj/fontaine-profile-heights) 10)))) + +(defun cj/fontaine-profile-candidates () + "Return complete labels for all Fontaine workflow profiles." + (mapcar #'cj/fontaine-profile-label cj/fontaine-profile-order)) + +(defun cj/fontaine-profile-from-label (label) + "Return the workflow profile represented by LABEL, or nil." + (seq-find (lambda (profile) + (equal label (cj/fontaine-profile-label profile))) + cj/fontaine-profile-order)) + +(defun cj/fontaine-profile-annotation (candidate) + "Mark CANDIDATE when it represents the active Fontaine profile." + (if (eq (cj/fontaine-profile-from-label candidate) + fontaine-current-preset) + " current" + "")) + +(defun cj/fontaine-apply-profile (profile) + "Apply workflow PROFILE and record it for Fontaine persistence." + (unless (cj/fontaine-profile-p profile) + (user-error "Unknown font profile: %s" profile)) + (add-to-history 'fontaine-preset-history (symbol-name profile)) + (fontaine-set-preset profile)) + +(defun cj/fontaine-select-profile () + "Select and apply one complete Fontaine workflow profile." + (interactive) + (let* ((candidates (cj/fontaine-profile-candidates)) + (default (cj/fontaine-profile-label + (if (cj/fontaine-profile-p fontaine-current-preset) + fontaine-current-preset + 'everyday))) + (completion-extra-properties + '(:annotation-function cj/fontaine-profile-annotation)) + (choice (completing-read "Font profile: " candidates nil t + nil 'cj/fontaine-profile-history default))) + (cj/fontaine-apply-profile (cj/fontaine-profile-from-label choice)))) + +(defun cj/fontaine-restored-or-default-profile () + "Return the saved Fontaine profile, or the `everyday' fallback." + (let ((restored (fontaine-restore-latest-preset))) + (if (cj/fontaine-profile-p restored) restored 'everyday))) + +(defalias 'cj/fontaine-profile-properties #'cj/font-profile-properties) +(defalias 'cj/fontaine-remap-buffer-to-profile #'cj/font-profile-remap-buffer) + +(defun cj/fontaine-remap-ui-buffer () + "Keep the current minibuffer or echo-area buffer in Berkeley Mono." + (face-remap-set-base + 'default `(:family ,cj/fontaine-ui-family))) + +(defun cj/fontaine-keep-ui-chrome-monospace (&rest _ignored) + "Keep mode-line, minibuffer, and echo-area chrome in Berkeley Mono." + (dolist (face '(mode-line mode-line-active mode-line-inactive + minibuffer-prompt)) + (when (facep face) + (set-face-attribute face nil :family cj/fontaine-ui-family))) + (dolist (name '(" *Echo Area 0*" " *Echo Area 1*")) + (when-let* ((buffer (get-buffer name))) + (with-current-buffer buffer + (cj/fontaine-remap-ui-buffer))))) + +;; Fontaine 3 is global rather than frame-specific. Remove the retired hooks +;; as well as omitting them below, so a live module reload migrates cleanly. +(remove-hook 'server-after-make-frame-hook #'cj/apply-font-settings-to-frame) +(remove-hook 'delete-frame-functions #'cj/cleanup-frame-list) (use-package fontaine :demand t :bind - ("M-S-f" . fontaine-set-preset) ;; was M-F, overrides forward-word + ("M-S-f" . cj/fontaine-select-profile) ;; was M-F, overrides forward-word :config (setq fontaine-presets - `( - (default - :default-family "BerkeleyMono Nerd Font" - :default-weight regular - :default-height ,(if (env-laptop-p) 130 140) - :fixed-pitch-family nil ;; falls back to :default-family - :fixed-pitch-weight nil ;; falls back to :default-weight - :fixed-pitch-height 1.0 - :variable-pitch-family "Lexend" - :variable-pitch-weight regular - :variable-pitch-height 1.0) - (FiraCode - :default-family "FiraCode Nerd Font Mono" - :variable-pitch-family "Merriweather" - :variable-pitch-weight light) - (Hack - :default-family "Hack Nerd Font Mono" - :variable-pitch-family "Hack Nerd Font Mono") - (BerkeleyMono - :default-family "Berkeley Mono" - :variable-pitch-family "Charis SIL") - (FiraCode-Literata - :default-family "Fira Code Nerd Font" - :variable-pitch-family "Literata") - (24-point-font - :default-height 240) - (20-point-font - :default-height 200) - (16-point-font - :default-height 160) - (14-point-font - :default-height 140) - (13-point-font - :default-height 130) - (12-point-font - :default-height 120) - (11-point-font - :default-height 110) - (10-point-font - :default-height 100) - (t ;; shared fallback properties go here - :default-family "FiraCode Nerd Font Mono" - :default-weight regular - :default-height 120 - :fixed-pitch-family nil ;; falls back to :default-family - :fixed-pitch-weight nil ;; falls back to :default-weight - :fixed-pitch-height 1.0 - :fixed-pitch-serif-family nil ;; falls back to :default-family - :fixed-pitch-serif-weight nil ;; falls back to :default-weight - :fixed-pitch-serif-height 1.0 - :variable-pitch-family "Merriweather" - :variable-pitch-weight light - :variable-pitch-height 1.0 - :bold-family nil ;; use whatever the underlying face has - :bold-weight bold - :italic-family nil - :italic-slant italic - :line-spacing nil)))) - -;; Track which frames have had fonts applied -(defvar cj/fontaine-configured-frames nil - "List of frames that have had fontaine configuration applied.") - -(declare-function fontaine-set-preset "fontaine") - -(defun cj/apply-font-settings-to-frame (&optional frame) - "Apply font settings to FRAME if not already configured. -If FRAME is nil, uses the selected frame." - (let ((target-frame (or frame (selected-frame)))) - (unless (member target-frame cj/fontaine-configured-frames) - (with-selected-frame target-frame - (when (env-gui-p) - (fontaine-set-preset 'default) - (push target-frame cj/fontaine-configured-frames)))))) - -(defun cj/cleanup-frame-list (frame) - "Remove FRAME from the configured frames list when deleted." - (setq cj/fontaine-configured-frames - (delq frame cj/fontaine-configured-frames))) - -(with-eval-after-load 'fontaine - ;; Handle daemon mode and regular mode - (if (daemonp) - (progn - ;; Apply to each new frame in daemon mode - (add-hook 'server-after-make-frame-hook #'cj/apply-font-settings-to-frame) - ;; Clean up deleted frames from tracking list - (add-hook 'delete-frame-functions #'cj/cleanup-frame-list)) - ;; Apply immediately in non-daemon mode - (when (env-gui-p) - (cj/apply-font-settings-to-frame)))) + (append (copy-tree cj/font-profile-definitions) + (list (cons t (copy-sequence + cj/font-profile-shared-properties))))) + (fontaine-mode 1) + (add-hook 'fontaine-set-preset-hook + #'cj/fontaine-keep-ui-chrome-monospace) + (add-hook 'enable-theme-functions + #'cj/fontaine-keep-ui-chrome-monospace) + (add-hook 'minibuffer-setup-hook #'cj/fontaine-remap-ui-buffer) + (cj/fontaine-keep-ui-chrome-monospace) + (when (or (daemonp) (env-gui-p)) + (cj/fontaine-apply-profile (cj/fontaine-restored-or-default-profile)))) ;; ----------------------------- Font Install Check ---------------------------- ;; convenience function to indicate whether a font is available by name. diff --git a/modules/font-profiles.el b/modules/font-profiles.el new file mode 100644 index 00000000..a2c40562 --- /dev/null +++ b/modules/font-profiles.el @@ -0,0 +1,116 @@ +;;; font-profiles.el --- Shared Workflow Font Profile Data -*- lexical-binding: t; coding: utf-8; -*- +;; author: Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 1 (Foundation). +;; Category: F/L. +;; Load shape: library. +;; Top-level side effects: none. +;; Runtime requires: host-environment. +;; Direct test load: yes. +;; +;; Owns the effective font properties shared by the global Fontaine adapter and +;; buffer-local mode adapters such as nov-reading. Consumers can therefore use +;; the same named profile without making a global Fontaine selection. + +;;; Code: + +(require 'host-environment) + +(declare-function face-remap-add-relative "face-remap") + +(defconst cj/font-profile-shared-properties + `(:default-family "BerkeleyMono Nerd Font" + :default-weight regular + :default-height ,(if (env-laptop-p) 130 140) + :fixed-pitch-family nil + :fixed-pitch-weight nil + :fixed-pitch-height 1.0 + :fixed-pitch-serif-family nil + :fixed-pitch-serif-weight nil + :fixed-pitch-serif-height 1.0 + :variable-pitch-family "Lexend" + :variable-pitch-weight regular + :variable-pitch-height 1.0 + :bold-family nil + :bold-weight bold + :italic-family nil + :italic-slant italic + :line-spacing nil) + "Properties shared by every workflow font profile unless overridden.") + +(defconst cj/font-profile-definitions + '((everyday) + (writing + :default-height 140 + :variable-pitch-family "Merriweather" + :variable-pitch-weight light) + (reading + :default-family "Merriweather" + :default-height 140 + :fixed-pitch-family "Merriweather" + :fixed-pitch-serif-family "Merriweather" + :variable-pitch-family "Merriweather") + (coding-xs + :default-height 110 + :variable-pitch-family "BerkeleyMono Nerd Font") + (coding-m + :default-height 130 + :variable-pitch-family "BerkeleyMono Nerd Font") + (coding-l + :default-height 140 + :variable-pitch-family "BerkeleyMono Nerd Font") + (coding-xl + :default-height 160 + :variable-pitch-family "BerkeleyMono Nerd Font") + (presentation + :default-height 200)) + "Profile-specific font properties in user-facing order.") + +(defconst cj/font-profile-order + (mapcar #'car cj/font-profile-definitions) + "Workflow font profiles in user-facing order.") + +(defun cj/font-profile-p (profile) + "Return non-nil when PROFILE is a configured workflow font profile." + (memq profile cj/font-profile-order)) + +(defun cj/font-profile-properties (profile) + "Return effective font properties for workflow PROFILE." + (let ((entry (assq profile cj/font-profile-definitions))) + (unless entry + (user-error "Unknown font profile: %s" profile)) + (append (cdr entry) cj/font-profile-shared-properties))) + +(defun cj/font-profile-remap-buffer (profile &optional height) + "Apply PROFILE's face families buffer-locally and return remap cookies. +When HEIGHT is non-nil, use it for every remapped face instead of the profile's +configured heights. No global face or Fontaine state is changed." + (let ((properties (cj/font-profile-properties profile)) + (cookies nil)) + (dolist (face-property '((default + :default-family :default-height) + (fixed-pitch + :fixed-pitch-family :fixed-pitch-height) + (fixed-pitch-serif + :fixed-pitch-serif-family + :fixed-pitch-serif-height) + (variable-pitch + :variable-pitch-family + :variable-pitch-height))) + (pcase-let ((`(,face ,family-property ,height-property) + face-property)) + (let ((family (or (plist-get properties family-property) + (and (memq face '(fixed-pitch fixed-pitch-serif)) + (plist-get properties :default-family)))) + (face-height (or height + (plist-get properties height-property)))) + (when family + (push (face-remap-add-relative + face :family family :height face-height) + cookies))))) + (nreverse cookies))) + +(provide 'font-profiles) +;;; font-profiles.el ends here diff --git a/modules/help-utils.el b/modules/help-utils.el index 9792841a..2709ac45 100644 --- a/modules/help-utils.el +++ b/modules/help-utils.el @@ -65,24 +65,40 @@ ;; on Arch: yay (or whatever your AUR package manager is) -S arch-wiki-docs ;; browse the arch wiki topics offline +(defvar cj/arch-wiki-html-dir "/usr/share/doc/arch-wiki/html/en" + "Directory holding the offline ArchWiki HTML copies. +Populated by the arch-wiki-docs package on Arch systems.") + +(defun cj/--arch-wiki-topics (dir) + "Return an alist of (BASENAME . FULLPATH) for ArchWiki topics under DIR. + +Returns nil when DIR does not exist rather than signaling. This is the +whole point of the helper: `directory-files' raises file-missing on an +absent directory, and the caller's \"is arch-wiki-docs installed?\" hint +sat below that call, so on the one machine state the hint was written for +it could never be reached." + (when (file-directory-p dir) + (mapcar (lambda (f) (cons (file-name-base f) f)) + (directory-files dir t "\\.html\\'")))) + (defun cj/local-arch-wiki-search () "Prompt for an ArchWiki topic and open its local HTML copy in EWW. -Looks for “*.html” files under \"/usr/share/doc/arch-wiki/html/en\", -lets you complete on their basenames, and displays the chosen file -with `eww-browse-url'. If no file is found, reminds you to install +Looks for “*.html” files under `cj/arch-wiki-html-dir', lets you complete +on their basenames, and displays the chosen file with `eww-browse-url'. +If the directory is missing or empty, reminds you to install arch-wiki-docs." (interactive) - (let* ((dir "/usr/share/doc/arch-wiki/html/en") - (full-filenames (directory-files dir t "\\.html\\'")) - (basenames (mapcar 'file-name-base full-filenames)) - (chosen (completing-read "Choose an ArchWiki Topic: " basenames))) - (if (member chosen basenames) - (let* ((idx (cl-position chosen basenames :test 'equal)) - (fullname (nth idx full-filenames)) - (url (concat "file://" fullname))) - (eww-browse-url url)) - (message "File not found! Is arch-wiki-docs installed?")))) + (let ((topics (cj/--arch-wiki-topics cj/arch-wiki-html-dir))) + (if (null topics) + (message "No ArchWiki topics in %s. Is arch-wiki-docs installed?" + cj/arch-wiki-html-dir) + (let* ((chosen (completing-read "Choose an ArchWiki Topic: " + (mapcar #'car topics))) + (fullname (cdr (assoc chosen topics)))) + (if fullname + (eww-browse-url (concat "file://" fullname)) + (message "No ArchWiki topic named %s" chosen)))))) (keymap-global-set "C-h A" #'cj/local-arch-wiki-search) (provide 'help-utils) diff --git a/modules/host-environment.el b/modules/host-environment.el index 0afb39cb..1c33e342 100644 --- a/modules/host-environment.el +++ b/modules/host-environment.el @@ -138,15 +138,13 @@ find /usr/share/zoneinfo -type f ! -name `posixrules' \\ (defun cj/detect-system-timezone () "Detect the system timezone in IANA format (e.g., `America/Los_Angeles'). -Tries multiple methods in order of reliability: -1. File comparison of /etc/localtime with zoneinfo database -2. Environment variable TZ -3. /etc/timezone file contents -4. /etc/localtime symlink target" +Tries the cheap methods first and the exhaustive scan last: +1. Environment variable TZ (most explicit if set) +2. /etc/timezone file contents (Debian/Ubuntu) +3. /etc/localtime symlink target (O(1) on symlinked systems) +4. File comparison of /etc/localtime against the zoneinfo database + (reads hundreds of files; only needed when localtime is a copy)" (or - ;; Compare file contents (reliable on Arch/modern systems) - (cj/match-localtime-to-zoneinfo) - ;; Environment variable (most explicit if set) (getenv "TZ") @@ -156,12 +154,15 @@ Tries multiple methods in order of reliability: (insert-file-contents "/etc/timezone") (string-trim (buffer-string)))) - ;; Method 4: Parse symlink (fallback for older systems) + ;; Parse the symlink -- O(1), answers on any symlinked /etc/localtime (when (file-symlink-p "/etc/localtime") (let ((target (file-truename "/etc/localtime"))) (when (string-match ".*/zoneinfo/\\(.+\\)" target) (match-string 1 target)))) + ;; Compare file contents -- the last resort for a copied /etc/localtime + (cj/match-localtime-to-zoneinfo) + ;; Default to nil if detection fails nil)) diff --git a/modules/httpd-config.el b/modules/httpd-config.el index 1a2a5c61..a3ae0fac 100644 --- a/modules/httpd-config.el +++ b/modules/httpd-config.el @@ -5,8 +5,9 @@ ;; ;; Layer: 4 (Optional). ;; Category: O/D/P. -;; Load shape: eager. -;; Eager reason: none; local web server, a command-loaded deferral candidate. +;; Load shape: deferred. +;; Defer reason: impatient-mode requires simple-httpd on demand; nothing +;; needs the server (or its www/ root) at startup. ;; Top-level side effects: package configuration via use-package. ;; Runtime requires: none. ;; Direct test load: yes. @@ -17,14 +18,15 @@ ;;;; -------------------------- Simple-Httpd ------------------------- (use-package simple-httpd - :defer 1 + :defer t :preface (defconst cj/httpd-wwwdir (concat user-emacs-directory "www")) (defun cj/httpd-check-or-create-wwwdir () (unless (file-exists-p cj/httpd-wwwdir) (make-directory cj/httpd-wwwdir))) - :init (cj/httpd-check-or-create-wwwdir) :config + ;; Create the doc root only when the server package actually loads. + (cj/httpd-check-or-create-wwwdir) (setq httpd-root cj/httpd-wwwdir) (setq httpd-show-backtrace-when-error t) (setq httpd-serve-files t)) diff --git a/modules/hugo-config.el b/modules/hugo-config.el index b26398c6..36f9e07a 100644 --- a/modules/hugo-config.el +++ b/modules/hugo-config.el @@ -28,6 +28,7 @@ (require 'user-constants) (require 'host-environment) (require 'system-lib) ;; completion table + file annotator +(require 'keybindings) ;; cj/register-prefix-map, cj/custom-keymap ;; --------------------------------- Constants --------------------------------- @@ -247,14 +248,18 @@ to /var/www/cjennings/, so a successful push is the deploy." ;; -------------------------------- Keybindings -------------------------------- -(global-set-key (kbd "C-; h n") #'cj/hugo-new-post) -(global-set-key (kbd "C-; h e") #'cj/hugo-export-post) -(global-set-key (kbd "C-; h o") #'cj/hugo-open-blog-dir) -(global-set-key (kbd "C-; h O") #'cj/hugo-open-blog-dir-external) -(global-set-key (kbd "C-; h d") #'cj/hugo-open-draft) -(global-set-key (kbd "C-; h D") #'cj/hugo-toggle-draft) -(global-set-key (kbd "C-; h p") #'cj/hugo-preview) -(global-set-key (kbd "C-; h P") #'cj/hugo-publish) +(defvar-keymap cj/hugo-keymap + :doc "Keymap for Hugo blog commands" + "n" #'cj/hugo-new-post + "e" #'cj/hugo-export-post + "o" #'cj/hugo-open-blog-dir + "O" #'cj/hugo-open-blog-dir-external + "d" #'cj/hugo-open-draft + "D" #'cj/hugo-toggle-draft + "p" #'cj/hugo-preview + "P" #'cj/hugo-publish) + +(cj/register-prefix-map "h" cj/hugo-keymap) (with-eval-after-load 'which-key (which-key-add-key-based-replacements diff --git a/modules/jumper.el b/modules/jumper.el index 1fbd1293..bfafe08b 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -194,6 +194,10 @@ Returns: \\='no-locations if no locations stored, locations)) (choice (completing-read "Jump to: " locations nil t)) (idx (cdr (assoc choice locations)))) + ;; A UI that permits empty input (no vertico) yields a choice with no + ;; entry; nil would crash the index arithmetic downstream. + (unless idx + (user-error "No matching location")) (jumper--do-jump-to-location idx) (message "Jumped to location"))))) @@ -230,7 +234,8 @@ Returns: \\='no-locations if no locations stored, (jumper--location-candidates)) (locations (cons (cons "Cancel" -1) locations)) (choice (completing-read "Remove location: " locations nil t)) - (idx (cdr (assoc choice locations)))) + ;; Empty input (no matching entry) cancels, same as picking Cancel. + (idx (or (cdr (assoc choice locations)) -1))) (pcase (jumper--do-remove-location idx) ('cancelled (message "Operation cancelled")) ('t (message "Location removed")))))) diff --git a/modules/markdown-config.el b/modules/markdown-config.el index 815bb3fb..1d4a8b74 100644 --- a/modules/markdown-config.el +++ b/modules/markdown-config.el @@ -108,8 +108,21 @@ Starts the simple-httpd listener automatically when it isn't already running." ;; stub doesn't collide with this file's own definition of the command ;; (that collision is the "defined multiple times" byte-compile warning). ;; Same key as compile, for consistency. +(defun cj/markdown-toggle-view () + "Toggle the current Markdown buffer between edit and read-only view. +Handles the gfm variants too. The cond checks the most-derived mode +first, since the view modes derive from their edit modes." + (interactive) + (cond + ((derived-mode-p 'markdown-view-mode) (markdown-mode)) + ((derived-mode-p 'gfm-view-mode) (gfm-mode)) + ((derived-mode-p 'gfm-mode) (gfm-view-mode)) + ((derived-mode-p 'markdown-mode) (markdown-view-mode)))) + (with-eval-after-load 'markdown-mode - (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview)) + (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview) + (keymap-set markdown-mode-map "C-c C-x v" #'cj/markdown-toggle-view) + (keymap-set markdown-view-mode-map "C-c C-x v" #'cj/markdown-toggle-view)) (provide 'markdown-config) ;;; markdown-config.el ends here diff --git a/modules/media-utils.el b/modules/media-utils.el index 1abbc1b2..7047411f 100644 --- a/modules/media-utils.el +++ b/modules/media-utils.el @@ -119,8 +119,67 @@ stream URL (see the :needs-stream-url flag in `cj/media-players')." ;; ---------------------- Playing Via Default Media Player --------------------- +(defun cj/media--yt-dlp-argv (url formats) + "The argv to resolve URL's stream address: yt-dlp [-f FORMATS] -g URL. +FORMATS is a prioritized list of yt-dlp format codes, or nil for the +default. URL stays one verbatim argv element, so it never meets a shell." + (append (list "yt-dlp") + (when formats (list "-f" (string-join formats "/"))) + (list "-g" url))) + +(defun cj/media--stream-urls (output) + "The non-empty lines of yt-dlp -g OUTPUT, surrounding whitespace trimmed." + (split-string output "\n" t "[ \t\r]+")) + +(defun cj/media--play-argv (command args urls) + "The argv to play URLS with COMMAND. +ARGS is the player's raw option string from `cj/media-players' (nil for +none); it splits with `split-string-and-unquote' so a quoted option +survives as one word." + (append (list command) + (and args (split-string-and-unquote args)) + urls)) + +(defun cj/media--resolve-stream-urls (url formats) + "Resolve URL to direct stream URLs with a synchronous yt-dlp -g capture. +FORMATS is the player's format-preference list. Only stdout is parsed +for URLs -- yt-dlp's warnings go to stderr, captured separately for the +error message. Signals an error when yt-dlp exits non-zero or resolves +nothing." + (let ((err-file (make-temp-file "yt-dlp-stderr"))) + (unwind-protect + (with-temp-buffer + (let* ((argv (cj/media--yt-dlp-argv url formats)) + (exit (apply #'call-process (car argv) nil + (list t err-file) nil (cdr argv)))) + (unless (and (integerp exit) (zerop exit)) + (error "yt-dlp failed (exit %s): %s" exit + (string-trim + (with-temp-buffer + (insert-file-contents err-file) + (buffer-string))))) + (or (cj/media--stream-urls (buffer-string)) + (error "yt-dlp resolved no stream URL for %s" url)))) + (delete-file err-file)))) + +(defun cj/media--play-sentinel (url-display) + "A process sentinel reporting playback of URL-DISPLAY. +Messages success or failure and reaps the process buffer once the +player finishes or exits." + (lambda (proc event) + (cond + ((string-match-p "finished" event) + (message "✓ Finished playing: %s" url-display)) + ((string-match-p "exited abnormally" event) + (message "✗ Playback failed: %s" url-display))) + (when (string-match-p "finished\\|exited" event) + (kill-buffer (process-buffer proc))))) + (defun cj/media-play-it (url) - "Play the URL with the configured media player in an async process." + "Play the URL with the configured media player in an async process. +A player flagged :needs-stream-url gets the URL resolved first via a +synchronous yt-dlp -g capture (blocks briefly); the player then launches +with a plain argv list -- no shell anywhere in the pipeline." (let* ((player-config (alist-get cj/default-media-player cj/media-players)) (command (plist-get player-config :command)) (args (plist-get player-config :args)) @@ -131,56 +190,52 @@ stream URL (see the :needs-stream-url flag in `cj/media-players')." (unless (executable-find command) (error "%s is not installed or not in PATH" player-name)) + (when needs-stream-url + (unless (executable-find "yt-dlp") + (error "The program yt-dlp is not installed or not in PATH"))) - (let* ((buffer-name (format "*%s: %s*" player-name url-display)) - (shell-command - (if needs-stream-url - ;; Use shell substitution with yt-dlp - (let ((format-string (if yt-dlp-formats - (format "-f %s" - (mapconcat #'shell-quote-argument - yt-dlp-formats - "/")) - ""))) - (format "%s %s $(%s %s -g %s)" - command - (or args "") - "yt-dlp" - format-string - (shell-quote-argument url))) - ;; Direct playback without yt-dlp - (format "%s %s %s" - command - (or args "") - (shell-quote-argument url))))) + (let* ((urls (if needs-stream-url + (progn + (message "Resolving stream URL: %s" url-display) + (cj/media--resolve-stream-urls url yt-dlp-formats)) + (list url))) + (argv (cj/media--play-argv command args urls)) + (buffer-name (format "*%s: %s*" player-name url-display))) (message "Playing with %s: %s" player-name url-display) - (cj/log-silently "DEBUG: Executing: %s" shell-command) - - (let ((process (start-process-shell-command - player-name - buffer-name - shell-command))) - (set-process-sentinel - process - (lambda (proc event) - (cond - ((string-match-p "finished" event) - (message "✓ Finished playing: %s" url-display)) - ((string-match-p "exited abnormally" event) - (message "✗ Playback failed: %s" url-display) - (with-current-buffer (process-buffer proc) - (goto-char (point-min)) - (when (re-search-forward "ERROR:" nil t) - (cj/log-silently "DEBUG: yt-dlp error: %s" - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position))))))) - (when (string-match-p "finished\\|exited" event) - (kill-buffer (process-buffer proc))))))))) + (cj/log-silently "DEBUG: Executing: %s" (string-join argv " ")) + + (let ((process (apply #'start-process player-name buffer-name argv))) + (set-process-sentinel process (cj/media--play-sentinel url-display)))))) ;; ------------------------- Media-Download Via yt-dlp ------------------------- +(defun cj/media--yt-dl-message (event url-display) + "Return the message for tsp EVENT on URL-DISPLAY, or nil when it reports nothing. + +Reports queueing, not completion, and the distinction is the point. +`cj/yt-dl-it' launches \"tsp yt-dlp ...\", and tsp enqueues the job and +exits immediately, so this sentinel fires on tsp's exit rather than +yt-dlp's. A clean exit proves the job was accepted by the spooler and +nothing more, so claiming the download finished would be a guess that is +wrong whenever yt-dlp fails minutes later. Check the spooler with +\"tsp\" for real download status." + (cond + ((string-match-p "finished" event) + (format "✓ Queued for download: %s" url-display)) + ((string-match-p "exited abnormally" event) + (format "✗ Could not queue download: %s" url-display)))) + +(defun cj/media--yt-dl-sentinel (url-display) + "A process sentinel reporting the queueing of URL-DISPLAY. +Messages per `cj/media--yt-dl-message' and reaps the process buffer once +tsp finishes or exits." + (lambda (proc event) + (when-let ((msg (cj/media--yt-dl-message event url-display))) + (message "%s" msg)) + (when (string-match-p "finished\\|exited" event) + (kill-buffer (process-buffer proc))))) + (defun cj/yt-dl-it (url) "Downloads the URL in an async shell." (unless (executable-find "yt-dlp") @@ -194,16 +249,8 @@ stream URL (see the :needs-stream-url flag in `cj/media-players')." (process (start-process "yt-dlp" buffer-name "tsp" "yt-dlp" "--add-metadata" "-ic" "-o" output-template url))) - (message "Started download: %s" url-display) - (set-process-sentinel process - (lambda (proc event) - (cond - ((string-match-p "finished" event) - (message "✓ Finished downloading: %s" url-display)) - ((string-match-p "exited abnormally" event) - (message "✗ Download failed: %s" url-display))) - (when (string-match-p "finished\\|exited" event) - (kill-buffer (process-buffer proc))))))) + (message "Queueing download: %s" url-display) + (set-process-sentinel process (cj/media--yt-dl-sentinel url-display)))) (provide 'media-utils) ;;; media-utils.el ends here. diff --git a/modules/mu4e-org-contacts-integration.el b/modules/mu4e-org-contacts-integration.el index fc0a7325..a143bdc4 100644 --- a/modules/mu4e-org-contacts-integration.el +++ b/modules/mu4e-org-contacts-integration.el @@ -60,13 +60,10 @@ In email header fields (To, Cc, Bcc), complete using org-contacts. Elsewhere, perform the default TAB action." (interactive) (cond - ;; In email header fields, use completion-at-point + ;; In email header fields, use completion-at-point (it both starts a new + ;; completion and cycles an in-progress one, so no mode check is needed). ((mail-abbrev-in-expansion-header-p) - (if (and (boundp 'completion-in-region-mode) completion-in-region-mode) - ;; If we're already in completion mode, cycle through candidates - (completion-at-point) - ;; Start new completion - (completion-at-point))) + (completion-at-point)) ;; In org-msg-edit-mode body, use org-cycle ((and (eq major-mode 'org-msg-edit-mode) (not (mail-abbrev-in-expansion-header-p))) diff --git a/modules/music-config.el b/modules/music-config.el index 3559930b..233bae72 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -86,7 +86,9 @@ falls back to the plain text player (names, a dim glyph, a thin status line)." :group 'cj/music) (defcustom cj/music-title-family - (if (boundp 'cj/nov-reading-font-family) cj/nov-reading-font-family "Merriweather") + (if (fboundp 'cj/font-profile-properties) + (plist-get (cj/font-profile-properties 'reading) :default-family) + "Merriweather") "Serif family for the fancy now-playing title, mirroring the nov reading view." :type 'string :group 'cj/music) @@ -306,7 +308,9 @@ Directories are suffixed with /; files are plain. Hidden dirs/files skipped." "Completion table for CANDIDATES preserving order and case-insensitive match. Tags the `cj-music-file' category and annotates each candidate (a path relative to `cj/music-root', with a trailing slash for directories) with its size and -modification date so marginalia can show them." +modification date so marginalia can show them. The category is registered +with marginalia (builtin) so the annotations render right-aligned." + (cj/completion-ensure-marginalia-align 'cj-music-file) (let ((annotate (cj/completion-file-annotator (lambda (c) (expand-file-name @@ -322,19 +326,177 @@ modification date so marginalia can show them." (completion-ignore-case . t)) (complete-with-action action candidates string pred))))) +(defun cj/music--playlist-open-position (buffer) + "Return where point should land when the playlist BUFFER is displayed. +The beginning of the playing track's line when a song is playing (during +playback the selected track is the playing one), else the top of the +list. Keying off the selected track alone is wrong: EMMS keeps a stale +selection while stopped, which used to open the playlist deep in the list +at whatever played last." + (with-current-buffer buffer + (if (and (boundp 'emms-player-playing-p) emms-player-playing-p + (boundp 'emms-playlist-selected-marker) + (markerp emms-playlist-selected-marker) + (marker-position emms-playlist-selected-marker) + (eq (marker-buffer emms-playlist-selected-marker) (current-buffer))) + (save-excursion + (goto-char emms-playlist-selected-marker) + (line-beginning-position)) + (point-min)))) + +(defun cj/music--playlist-land-point (win buffer) + "Move WIN's point in BUFFER per the open-position rule and settle the view. +When a song is playing its row lands in the window's upper third, so the +upcoming tracks fill the space below it. When stopped, the view starts at +the top of the list. Point sits at the beginning of its line either way, +so the row reads left-to-right from its number." + (let ((pos (cj/music--playlist-open-position buffer))) + (set-window-point win pos) + (if (> pos (with-current-buffer buffer (point-min))) + (with-selected-window win + (with-current-buffer buffer + (recenter (max 1 (/ (window-body-height) 3))))) + (set-window-start win pos)))) + +(defun cj/music--pin-point-to-bol () + "Keep the playlist cursor in the number gutter (column 0). +The rows are rendered track lines, not editable text: the cursor's home is +the number, and operations on a track (kill, shift, play) act on its row +wherever point sits. Vertical motion over thumbnails and the stretch-space +that right-aligns the metadata drifts point to arbitrary visual columns +(usually line end), so this runs on the buffer-local `post-command-hook' +and snaps every landing back to the row start. An active isearch owns +point until it ends; the snap lands when the search exits." + (unless (or (bolp) (bound-and-true-p isearch-mode)) + (beginning-of-line)) + (cj/music--highlight-current-number)) + +(defvar-local cj/music--renumber-timer nil + "Pending idle timer for the playlist row renumber, or nil.") + +;; Forward declaration: the real `defvar-local' is a few defuns below, next to +;; the highlight helper that owns it. Declared special here so the setq in this +;; function compiles as a dynamic binding, not a free-variable warning. +(defvar cj/music--current-number-overlay) + +(defun cj/music--renumber-rows (&optional buffer) + "Number every playlist row in BUFFER (default: current buffer) via overlays. +Each non-blank line gets an \"NNN \" before-string so the cursor stays +visible when it sits on a cover-art thumbnail and the row's position in +the list is readable at a glance. Overlays rebuild from scratch, so the +numbering survives kills, inserts, and reorders; the buffer text itself is +untouched (EMMS owns it). A dead BUFFER is a silent no-op, since the +debounce timer can outlive the playlist buffer." + (let ((buf (or buffer (current-buffer)))) + (when (buffer-live-p buf) + (with-current-buffer buf + (remove-overlays (point-min) (point-max) 'cj-music-row-number t) + (save-excursion + (goto-char (point-min)) + (let ((n 0)) + (while (not (eobp)) + (unless (looking-at-p "[ \t]*$") + (setq n (1+ n)) + ;; Span one char rather than zero: `overlays-in' (and so + ;; `remove-overlays') can miss an empty overlay sitting + ;; exactly at the region start. + (let ((ov (make-overlay (line-beginning-position) + (1+ (line-beginning-position))))) + (overlay-put ov 'cj-music-row-number t) + ;; Outrank the header overlay (priority 100): both anchor + ;; strings at position 1 on row 1, and without this the + ;; row's number renders above the header block instead of + ;; beside its own track. + (overlay-put ov 'priority 200) + (overlay-put ov 'before-string + (cj/music--number-string (format "%3d " n) nil)))) + (forward-line 1)))) + ;; The rebuild deleted the marked overlay; re-mark the current row. + (setq cj/music--current-number-overlay nil) + (cj/music--highlight-current-number))))) + +(defvar-local cj/music--current-number-overlay nil + "The number overlay currently rendered as the you-are-here mark, or nil.") + +(defun cj/music--number-string (text current) + "Build the number-gutter display string from TEXT. +CURRENT non-nil renders it inverse video (the you-are-here mark). The +single place the gutter string's properties live: the face, and the +cursor property that makes redisplay draw the cursor on the number +instead of invisibly on the album art after it." + (propertize text + 'face (if current + '(:inherit cj/music-keyhint-face :inverse-video t) + 'cj/music-keyhint-face) + 'cursor t)) + +(defun cj/music--set-number-face (ov current) + "Re-render number overlay OV's string; CURRENT non-nil marks it inverse. +Keeps the text, swaps only the rendering (see `cj/music--number-string')." + (let ((s (overlay-get ov 'before-string))) + (overlay-put ov 'before-string + (cj/music--number-string (substring-no-properties s) current)))) + +(defun cj/music--highlight-current-number () + "Render the current row's number in inverse video, restoring the last one. +The block cursor draws only in the selected window, and the playlist dock +is glanced at from other windows constantly, so the number itself carries +the you-are-here mark -- visible whether or not the window has focus." + (let ((ov (seq-find (lambda (o) (overlay-get o 'cj-music-row-number)) + (overlays-in (line-beginning-position) + (min (1+ (line-beginning-position)) (point-max)))))) + (unless (eq ov cj/music--current-number-overlay) + (when (and (overlayp cj/music--current-number-overlay) + (overlay-buffer cj/music--current-number-overlay)) + (cj/music--set-number-face cj/music--current-number-overlay nil)) + (setq cj/music--current-number-overlay ov) + (when ov + (cj/music--set-number-face ov t))))) + +(defun cj/music--schedule-renumber (&rest _) + "Debounced renumber of the current playlist buffer after a text change. +Wired buffer-locally into `after-change-functions' by +`cj/music--ensure-playlist-buffer'; the idle delay coalesces a burst of +inserts or kills into one renumber pass." + (when (timerp cj/music--renumber-timer) + (cancel-timer cj/music--renumber-timer)) + (setq cj/music--renumber-timer + (run-with-idle-timer 0.2 nil #'cj/music--renumber-rows (current-buffer)))) + (defun cj/music--ensure-playlist-buffer () "Ensure EMMS playlist buffer exists and is in playlist mode. Return buffer." (let ((buffer (get-buffer-create cj/music-playlist-buffer-name))) (with-current-buffer buffer (unless (eq major-mode 'emms-playlist-mode) (emms-playlist-mode)) - (setq emms-playlist-buffer-p t)) + (setq emms-playlist-buffer-p t) + ;; Row numbering: renumber after every playlist change, debounced. + (add-hook 'after-change-functions #'cj/music--schedule-renumber nil t) + ;; The highlighted row stays findable even when the cursor sits on + ;; album art (pairs with the row-number prefixes). + (hl-line-mode 1) + ;; Gutter cursor: point lives at the row start (the number column). + (add-hook 'post-command-hook #'cj/music--pin-point-to-bol nil t) + ;; Logical-line motion: the multi-line header overlay string at + ;; position 1 otherwise absorbs next-line from the top row (vertical + ;; motion walks the header's screen lines, which all map back to the + ;; same buffer position, so arrows look dead). Rows are one logical + ;; line each; visual movement buys nothing here. + (setq-local line-move-visual nil) + ;; Sticky header: re-anchor the header block at the window start on + ;; every scroll, so it stays frozen while the list scrolls under it. + (add-hook 'window-scroll-functions #'cj/music--stick-header nil t)) + (cj/music--renumber-rows buffer) ;; Set this as the current EMMS playlist buffer (setq emms-playlist-buffer buffer) buffer)) (defun cj/music--m3u-file-tracks (m3u-file) - "Return list of absolute track paths from M3U-FILE. Ignore # comment lines." + "Return list of absolute track paths from M3U-FILE. Ignore # comment lines. +Stream URLs pass through untouched; a local path must carry an accepted +music extension (`cj/music--valid-file-p') -- old playlists saved before +directory adds were filtered can carry cover.jpg lines, and loading one +would put the cover right back in the playlist." (when (and m3u-file (file-exists-p m3u-file)) (with-temp-buffer (insert-file-contents m3u-file) @@ -344,11 +506,12 @@ modification date so marginalia can show them." (while (re-search-forward "^[^#].*$" nil t) (let ((line (string-trim (match-string 0)))) (unless (string-empty-p line) - (push (if (or (file-name-absolute-p line) - (string-match-p "\\`\\(https?\\|mms\\)://" line)) - line - (expand-file-name line dir)) - tracks)))) + (let* ((url-p (string-match-p "\\`\\(https?\\|mms\\)://" line)) + (path (cond (url-p line) + ((file-name-absolute-p line) line) + (t (expand-file-name line dir))))) + (when (or url-p (cj/music--valid-file-p path)) + (push path tracks)))))) (nreverse tracks))))) (defun cj/music--playlist-track-objects () @@ -435,17 +598,51 @@ Returns the full path to the selected file, or nil if cancelled." (unless (string= choice "(Cancel)") (cdr (assoc choice m3u-files))))) +(defun cj/music--delete-playlist-file (path) + "Delete the playlist file at PATH. +Signals a `user-error' when PATH is nil or missing. When the playlist +buffer's associated file is PATH, the association is cleared (the in-memory +queue is untouched). Refreshes the radio metadata cache since an .m3u just +left the roots." + (unless (and path (file-exists-p path)) + (user-error "Playlist file does not exist: %s" + (if path (file-name-nondirectory path) "nil"))) + (delete-file path) + (with-current-buffer (cj/music--ensure-playlist-buffer) + (when (equal cj/music-playlist-file path) + (setq cj/music-playlist-file nil))) + (cj/music--refresh-radio-name-map)) + ;;; Commands: add/select +(defun cj/music--music-files-recursive (directory) + "Return sorted absolute paths of the music files under DIRECTORY. +Only files passing `cj/music--valid-file-p' (the accepted extensions in +`cj/music-file-extensions') come back; hidden files and hidden +directories are skipped. This is the filter the directory-add commands +route through -- handing the raw tree to EMMS added every file it found, +so cover art and liner notes ended up as playlist rows." + (sort (seq-filter #'cj/music--valid-file-p + (directory-files-recursively + directory "\\`[^.]" nil + (lambda (dir) + (not (string-prefix-p "." (file-name-nondirectory dir)))))) + #'string-lessp)) + (defun cj/music-add-directory-recursive (directory) - "Add all music files under DIRECTORY recursively to the EMMS playlist." + "Add all music files under DIRECTORY recursively to the EMMS playlist. +Only files with accepted music extensions are added; cover art and other +non-music files in album directories stay out." (interactive (list (read-directory-name "Add directory recursively: " cj/music-root nil t))) (unless (file-directory-p directory) (user-error "Not a directory: %s" directory)) (cj/music--ensure-playlist-buffer) - (emms-add-directory-tree directory) - (message "Added recursively: %s" directory)) + (let ((files (cj/music--music-files-recursive directory))) + (dolist (f files) + (emms-add-file f)) + (message "Added %d music file%s from %s" + (length files) (if (= (length files) 1) "" "s") directory))) (defun cj/music-fuzzy-select-and-add () @@ -597,6 +794,10 @@ ENTRIES. Nil when neither applies (the caller falls back to a timestamp)." (plist-get (cdr (assoc (emms-track-name tr) entries)) :name))))) +;; Forward declaration: the real `defvar' lives with the radio config block far +;; below. Declared special here so this reference compiles clean. +(defvar cj/music-radio-save-dir) + (defun cj/music--save-directory (tracks) "Directory a saved playlist targets. An all-stream queue is a radio playlist and saves into @@ -664,6 +865,23 @@ reloaded playlist keeps its display name and cover art." (message "Reloaded playlist: %s" name))) +(defun cj/music-delete-playlist () + "Delete an .m3u playlist file after strong confirmation. +Candidates are the playlists `cj/music-playlist-load' offers -- every +directory in `cj/music-m3u-roots' (the local library and MPD's playlist +dir). Deleting the loaded playlist's file keeps the in-memory queue but +clears its file association." + (interactive) + (let ((file (cj/music--select-m3u-file "Delete playlist: "))) + (if (not file) + (message "Playlist deletion cancelled") + (unless (cj/confirm-strong (format "Delete playlist %s? " + (file-name-nondirectory file))) + (user-error "Aborted deleting playlist")) + (cj/music--delete-playlist-file file) + (message "Deleted playlist: %s" (file-name-nondirectory file))))) + + (defun cj/music-playlist-edit () "Open the playlist's M3U file in other window, prompting to save if modified." (interactive) @@ -775,11 +993,13 @@ Intended for use on `emms-player-finished-hook'." ) -(defvar cj/music-playlist-window-height 0.3 +(defvar cj/music-playlist-window-height 0.5 "Default fraction of frame height for the F10 music playlist side window. -Used when the playlist hasn't been resized and toggled off this session; -after that, the toggled-off height is remembered in -`cj/--music-playlist-height'.") +Half the frame, so a playlist of real length shows enough rows (a third +still read too short in practice). Used when the playlist hasn't been +resized and toggled off this session; after that, the toggled-off height +is remembered in `cj/--music-playlist-height' -- but only when it's at +least this default (see the discard in `cj/music-playlist-toggle').") (defvar cj/--music-playlist-height nil "Last height fraction the playlist was toggled off at. @@ -802,6 +1022,13 @@ resized and toggled off this session, it reopens at that remembered height." (if win (progn (cj/side-window-capture-size win 'bottom 'cj/--music-playlist-height) + ;; Remember enlargements only. Window churn (another side window + ;; opening) squeezes the dock, and remembering the squeeze reopens + ;; it too short on every later toggle. A deliberate shrink is the + ;; rare case; losing it costs one resize. + (when (and (numberp cj/--music-playlist-height) + (< cj/--music-playlist-height cj/music-playlist-window-height)) + (setq cj/--music-playlist-height nil)) (delete-window win) (message "Playlist window closed")) (progn @@ -811,11 +1038,7 @@ resized and toggled off this session, it reopens at that remembered height." buffer 'bottom 'cj/--music-playlist-height cj/music-playlist-window-height)) (select-window win) - (with-current-buffer buffer - (if (and (fboundp 'emms-playlist-current-selected-track) - (emms-playlist-current-selected-track)) - (emms-playlist-mode-center-current) - (goto-char (point-min)))) + (cj/music--playlist-land-point win buffer) (let ((count (with-current-buffer buffer (count-lines (point-min) (point-max))))) (message (if (> count 0) @@ -833,7 +1056,9 @@ Initializes EMMS if needed." (when buffer-exists (with-current-buffer cj/music-playlist-buffer-name (setq has-content (> (point-max) (point-min))))) - (switch-to-buffer (cj/music--ensure-playlist-buffer)) + (let ((buffer (cj/music--ensure-playlist-buffer))) + (switch-to-buffer buffer) + (cj/music--playlist-land-point (selected-window) buffer)) (cond ((not emms-was-loaded) (message "EMMS started. Current playlist empty")) ((and buffer-exists has-content) (message "EMMS running. Displaying current playlist")) @@ -848,9 +1073,10 @@ Dirs added recursively." (unless (derived-mode-p 'dired-mode) (user-error "This command must be run in a Dired buffer")) (cj/music--ensure-playlist-buffer) - (let ((files (if (use-region-p) - (dired-get-marked-files) - (list (dired-get-file-for-visit))))) + ;; dired-get-marked-files already honors m-marks, an active region, or the + ;; file at point; gating it behind use-region-p silently dropped all but + ;; the point file whenever files were marked without a region. + (let ((files (dired-get-marked-files))) (when (null files) (user-error "No files selected")) (dolist (file files) @@ -1160,12 +1386,12 @@ The rule uses a resize-safe :align-to span, not a hardcoded character count." (propertize "Mode " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) (funcall mode-indicator "r" "repeat" (bound-and-true-p emms-repeat-playlist)) " " - (funcall mode-indicator "s" "single" (bound-and-true-p emms-repeat-track)) " " + (funcall mode-indicator "1" "single" (bound-and-true-p emms-repeat-track)) " " (funcall mode-indicator "z" "random" (bound-and-true-p emms-random-playlist)) " " (funcall mode-indicator "x" "consume" cj/music-consume-mode) "\n" (propertize "Keys " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) - (propertize "a:add c:clear L:load v:save S:stop SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" + (propertize "a:add c:clear L:load s:save D:delete SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" 'face 'cj/music-keyhint-face) "\n" (propertize "Radio " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) @@ -1217,14 +1443,51 @@ the controls." (cj/music--fancy-header) (cj/music--text-header))) +(defun cj/music--header-anchor-position () + "Return the position the header overlay should anchor at right now. +The start of the displaying window when the playlist is shown (so the +header stays at the top of the window while the list scrolls under it), +else the top of the buffer. Searches all frames -- the refresh timer can +run with any frame selected, and missing a window on another frame would +anchor at the buffer top and yank a scrolled header back." + (if-let ((win (get-buffer-window (current-buffer) t))) + (max (point-min) (min (window-start win) (point-max))) + (point-min))) + +(defun cj/music--stick-header (win start) + "Re-anchor the header overlay at START, WIN's new display start. +Runs on the buffer-local `window-scroll-functions', so every scroll pins +the header block to the top of the window and the track list scrolls +beneath it. Converges: an already-anchored header is a no-op, so the +redisplay this move triggers doesn't loop. Always returns nil." + (with-current-buffer (window-buffer win) + (when (and (overlayp cj/music--header-overlay) + (overlay-buffer cj/music--header-overlay) + (integer-or-marker-p start)) + (let ((pos (max (point-min) (min start (point-max))))) + (unless (= (overlay-start cj/music--header-overlay) pos) + (move-overlay cj/music--header-overlay pos pos)))) + nil)) + +(defun cj/music--refresh-header-after-toggle (&rest _) + "Refresh the playlist header after a repeat/random/consume toggle. +Named (not an anonymous lambda) so the :config reload can advice-remove +it before re-adding -- anonymous advice stacks a copy per reload." + (cj/music--update-header)) + (defun cj/music--update-header () - "Insert or update the multi-line header overlay in the playlist buffer." + "Insert or update the multi-line header overlay in the playlist buffer. +Anchors at the displaying window's start (see +`cj/music--header-anchor-position') -- the refresh timer calls this every +second, and re-anchoring at the buffer top would yank the sticky header +away whenever the list is scrolled." (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) (with-current-buffer buf (unless cj/music--header-overlay (setq cj/music--header-overlay (make-overlay (point-min) (point-min))) (overlay-put cj/music--header-overlay 'priority 100)) - (move-overlay cj/music--header-overlay (point-min) (point-min)) + (let ((pos (cj/music--header-anchor-position))) + (move-overlay cj/music--header-overlay pos pos)) (overlay-put cj/music--header-overlay 'before-string (cj/music--header-text))))) @@ -1344,19 +1607,22 @@ unless fancy." (add-hook 'emms-player-stopped-hook #'cj/music--stop-bar-timer) (add-hook 'emms-player-finished-hook #'cj/music--stop-bar-timer) - ;; Refresh header immediately when toggling modes + ;; Refresh header immediately when toggling modes. Named advice with a + ;; remove-then-add guard (like the emms-playlist-clear advice above): + ;; an anonymous lambda can't be advice-removed and stacks a copy on every + ;; :config reload, firing the refresh N times per toggle. (dolist (fn '(emms-toggle-repeat-playlist emms-toggle-repeat-track emms-toggle-random-playlist cj/music-toggle-consume)) - (advice-add fn :after (lambda (&rest _) (cj/music--update-header)))) + (advice-remove fn #'cj/music--refresh-header-after-toggle) + (advice-add fn :after #'cj/music--refresh-header-after-toggle)) :bind (:map emms-playlist-mode-map ;; Playback ("p" . emms-playlist-mode-go) ("SPC" . emms-pause) - ("s" . emms-stop) ("n" . cj/music-next) (">" . cj/music-next) ("P" . cj/music-previous) @@ -1379,9 +1645,9 @@ unless fancy." ("c" . cj/music-playlist-clear) ("C" . cj/music-playlist-clear) ("L" . cj/music-playlist-load) + ("D" . cj/music-delete-playlist) ("E" . cj/music-playlist-edit) ("g" . cj/music-playlist-reload) - ("v" . cj/music-playlist-save) ;; Track reordering ("S-<up>" . emms-playlist-mode-shift-track-up) ("S-<down>" . emms-playlist-mode-shift-track-down) @@ -1434,6 +1700,15 @@ On a connection failure the client falls back to a host from /json/servers.") "User-Agent sent with radio-browser requests. The project asks clients to identify themselves.") +(defvar cj/music-radio-tag-limit 500 + "Maximum number of tags fetched from radio-browser for tag completion. +The /json/tags endpoint is fetched ordered by station count, so the limit +keeps the popular tags and drops the long tail of one-station noise tags.") + +(defvar cj/music-radio--tags-cache nil + "Session cache of radio-browser tag names, or nil before the first fetch. +A failed fetch leaves it nil so the next tag search retries.") + (defvar cj/music-radio-search-limit 30 "Maximum number of stations a radio-browser search returns.") @@ -1504,14 +1779,16 @@ TAGS is a comma-separated string or nil; nil or empty yields the empty string." (defun cj/music-radio--format-candidate (st) "Marginalia annotation for station ST. -Variant B: codec, bitrate, country, votes, and the first few tags." +Variant B: codec, bitrate, country, votes, and the first few tags. Every +field pads to a fixed width (votes included) so the listing reads as +aligned columns across stations." (let ((codec (or (plist-get st :codec) "")) (bitrate (let ((b (plist-get st :bitrate))) (if (and (integerp b) (> b 0)) (format "%dk" b) ""))) (cc (or (plist-get st :countrycode) "")) (votes (or (plist-get st :votes) 0)) (tags (cj/music-radio--tags-snippet (plist-get st :tags) 3))) - (format "%-4s %-5s %-2s ♥%d %s" codec bitrate cc votes tags))) + (format "%-4s %-5s %-2s %-7s %s" codec bitrate cc (format "♥%d" votes) tags))) (defun cj/music-radio--search-url (server query &optional field) "Build the radio-browser station-search URL for QUERY against SERVER. @@ -1571,23 +1848,21 @@ to one station. Pure helper." (push (cons disp st) out))))) (defun cj/music-radio--completion-table (candidates) - "Completion table over CANDIDATES carrying the Variant-B marginalia affix." + "Completion table over CANDIDATES carrying the Variant-B annotation. +Tagged `cj-radio-station' and registered with marginalia (builtin), so the +codec/bitrate/country/votes/tags annotation renders right-aligned like the +stock categories. The \"[done]\" sentinel has no station and annotates as +nil rather than a bogus zero row." + (cj/completion-ensure-marginalia-align 'cj-radio-station) (lambda (string pred action) (if (eq action 'metadata) `(metadata (category . cj-radio-station) - (affixation-function - . ,(lambda (cands) - (mapcar (lambda (c) - (let ((st (cdr (assoc c candidates)))) - ;; The "[done]" sentinel has no station, so it gets - ;; no annotation rather than a bogus "0" row. - (list c "" (if st - (concat " " - (propertize (cj/music-radio--format-candidate st) - 'face 'completions-annotations)) - "")))) - cands)))) + (annotation-function + . ,(lambda (c) + (when-let ((st (cdr (assoc c candidates)))) + (concat " " (propertize (cj/music-radio--format-candidate st) + 'face 'completions-annotations)))))) (complete-with-action action (mapcar #'car candidates) string pred)))) (defun cj/music-radio--pick-loop (candidates) @@ -1617,8 +1892,10 @@ bitrate, country, votes, and tags), lets you pick several one at a time, adds each to the playlist as a url track carrying its station metadata, and plays the first pick (interrupting whatever was playing). Nothing is written to disk; save the queue with the normal playlist save, where the station name -pre-fills the prompt." - (when (string-empty-p (string-trim query)) +pre-fills the prompt. QUERY is trimmed of surrounding whitespace first -- +a stray trailing space otherwise reaches the API as %20 and matches nothing." + (setq query (string-trim query)) + (when (string-empty-p query) (user-error "Empty search")) (cj/emms--setup) (let* ((stations (cj/music-radio--search query field)) @@ -1650,9 +1927,44 @@ pre-fills the prompt." (interactive "sRadio search (name): ") (cj/music-radio--search-and-play query "name")) +(defun cj/music-radio--tags-url (server) + "Build the radio-browser tag-list URL against SERVER. +Ordered by station count descending so the limit keeps the popular tags." + (format "https://%s/json/tags?order=stationcount&reverse=true&limit=%d" + server cj/music-radio-tag-limit)) + +(defun cj/music-radio--parse-tags (json-text) + "Parse a radio-browser JSON-TEXT tag array into a clean list of tag names. +Names come back whitespace-trimmed with empties and duplicates dropped -- +the source data is user-generated and carries all three. Signals +`user-error' on unreadable JSON (via `cj/music-radio--parse-search')." + (let ((names '())) + (dolist (tag (cj/music-radio--parse-search json-text)) + (let ((name (string-trim (or (plist-get tag :name) "")))) + (unless (or (string-empty-p name) (member name names)) + (push name names)))) + (nreverse names))) + +(defun cj/music-radio--available-tags () + "Return cached radio-browser tag names, fetching once per session. +Returns nil when the fetch or parse fails, leaving the cache empty so a +later call retries; the tag prompt then falls back to free-form input." + (or cj/music-radio--tags-cache + (setq cj/music-radio--tags-cache + (ignore-errors + (when-let ((body (cj/music-radio--http-get + (cj/music-radio--tags-url cj/music-radio-server)))) + (cj/music-radio--parse-tags body)))))) + (defun cj/music-radio-search-by-tag (tag) - "Search radio-browser.info by tag/genre, then queue and play a selection." - (interactive "sRadio search (tag): ") + "Search radio-browser.info by tag/genre, then queue and play a selection. +The prompt completes over the popular tags fetched from radio-browser +\(cached per session), so you pick from tags that exist instead of +guessing. Free-form input still works for an unlisted tag, and the prompt +degrades to plain input when the tag fetch fails." + (interactive + (list (completing-read "Radio search (tag): " + (cj/music-radio--available-tags)))) (cj/music-radio--search-and-play tag "tag")) ;; ------------------------------- Cover art ----------------------------------- @@ -1789,14 +2101,15 @@ when there is nothing to fetch." (message "Cleared music art cache: %s" cj/music-art-cache-dir)) ;; Radio row in the playlist buffer: n = search by name, t = search by tag, -;; m = enter a station by hand. This moves the "single" mode toggle off t to s -;; and emms-stop off s to S (see the header's Mode/Keys/Radio rows). +;; m = enter a station by hand. Single-track mode is on 1 and s saves the +;; playlist; stop was dropped (SPC/pause covers it). These run after +;; use-package's :map, so they win (see the header's Mode/Keys/Radio rows). (with-eval-after-load 'emms (keymap-set emms-playlist-mode-map "n" #'cj/music-radio-search-by-name) (keymap-set emms-playlist-mode-map "t" #'cj/music-radio-search-by-tag) (keymap-set emms-playlist-mode-map "m" #'cj/music-create-radio-station) - (keymap-set emms-playlist-mode-map "s" #'emms-toggle-repeat-track) - (keymap-set emms-playlist-mode-map "S" #'emms-stop)) + (keymap-set emms-playlist-mode-map "1" #'emms-toggle-repeat-track) + (keymap-set emms-playlist-mode-map "s" #'cj/music-playlist-save)) (provide 'music-config) ;;; music-config.el ends here diff --git a/modules/nov-reading.el b/modules/nov-reading.el index 636a2f53..3af8721c 100644 --- a/modules/nov-reading.el +++ b/modules/nov-reading.el @@ -10,7 +10,7 @@ ;; keymap reference; the faces must exist for theme-studio's inventory too. ;; Top-level side effects: defface x9 (3 palettes + per-palette heading/link), ;; defcustoms, a defgroup, a defvar. -;; Runtime requires: none (face-remap and text-scale are built in). +;; Runtime requires: font-profiles (shared workflow profile data). ;; Direct test load: yes. ;; ;; A small theme layer on top of the stock `nov' package (no fork): how an EPUB @@ -20,8 +20,9 @@ ;; - Reading palette -- the background + foreground, as sepia / dark / light, ;; each a face the dupre theme / theme-studio own (registered as the ;; "nov-reading" bespoke app in theme-studio's face_data.py). -;; - Typography -- a serif family and a base height, with +/-/= adjusting the -;; page font size live via a buffer-local text-scale on top of the base. +;; - Typography -- the shared Reading font profile and a nov-specific base +;; height, with +/-/= adjusting the page font size live via a buffer-local +;; text-scale on top of the base. ;; The live size is remembered globally, so every book opens where you left ;; it; "=" returns to the base height. ;; @@ -31,6 +32,8 @@ ;;; Code: +(require 'font-profiles) + (defgroup cj/nov-reading nil "Reading-view theming for nov-mode EPUBs." :group 'cj) @@ -194,9 +197,9 @@ Interactively prompts among `cj/nov-reading-palettes' plus \"none\"." ;; ------------------------------- Typography ---------------------------------- -(defcustom cj/nov-reading-font-family "Merriweather" - "Variable-pitch serif family for the EPUB reading view." - :type 'string +(defcustom cj/nov-reading-profile 'reading + "Shared font profile applied buffer-locally to the EPUB reading view." + :type 'symbol :group 'cj/nov-reading) (defcustom cj/nov-reading-text-height 180 @@ -214,6 +217,9 @@ returns to this base." A single integer: the buffer-local `text-scale-mode-amount' the +/-/= keys last set, applied on top of `cj/nov-reading-text-height' when a book opens.") +(defvar-local cj/nov--typography-remap-cookies nil + "Face-remap cookies for the shared font profile in this nov buffer.") + (defun cj/nov-reading--parse-text-scale (s) "Parse S (a string or nil) as an integer text-scale offset; 0 when invalid. Surrounding whitespace is tolerated; non-integer content yields 0." @@ -239,15 +245,11 @@ Creates the data directory when absent." (insert (number-to-string amount)))) (defun cj/nov-reading-apply-typography () - "Apply the reading family and base height buffer-local. -Remaps `variable-pitch', `default', and `fixed-pitch' so nov's shr output reads -as a comfortably-sized serif page." - (face-remap-add-relative 'variable-pitch - :family cj/nov-reading-font-family :height 1.0) - (face-remap-add-relative 'default - :family cj/nov-reading-font-family - :height cj/nov-reading-text-height) - (face-remap-add-relative 'fixed-pitch :height cj/nov-reading-text-height)) + "Apply the shared reading profile at nov's base height buffer-locally." + (mapc #'face-remap-remove-relative cj/nov--typography-remap-cookies) + (setq cj/nov--typography-remap-cookies + (cj/font-profile-remap-buffer + cj/nov-reading-profile cj/nov-reading-text-height))) (defun cj/nov-reading-text-bigger () "Increase the page font size and remember it across books and sessions." diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index d4407b28..1e91fa48 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -123,8 +123,15 @@ the file keeps precedence." ;; Cache agenda file list to avoid expensive directory scanning on every view. ;; The TTL+building cache lifecycle is provided by `cj-cache.el'. -(defvar cj/--org-agenda-files-cache (cj/cache-make :ttl 3600) - "Cache state for the agenda files list. See `cj-cache.el'.") +(defvar cj/--org-agenda-files-cache (cj/cache-make :ttl 86400) + "Cache state for the agenda files list. See `cj-cache.el'. + +TTL is 24h. The cache holds only the file *list* (which files are agenda +files), never their contents -- task edits and completions are re-read on +every agenda build/redo regardless of cache age. The list only changes when +a project directory with a todo.org is created or removed, which is rare, so a +long TTL costs little; use `cj/org-agenda-refresh-files' (S-<f8>) to force a +re-scan the moment a new project is added.") ;; ------------------------ Add Files To Org Agenda List ----------------------- ;; Checks immediate subdirectories of DIRECTORY for todo.org files and adds @@ -216,9 +223,16 @@ improves performance from several seconds to instant." "Force rebuild of agenda files cache. Use this after adding new projects or todo.org files. -Bypasses cache and scans directories from scratch." +Bypasses cache and scans directories from scratch. + +Bound to C-M-<f8>, the force-rebuild sibling of the F8 agenda family +\(<f8> display, s-<f8> all files, C-<f8> single project, M-<f8> this buffer). +The binding lives in `org-agenda-frame.el', which took S-<f8> for the +agenda-frame toggle and moved the force-rescan here." (interactive) (cj/build-org-agenda-list 'force-rebuild)) +;; S-<f8> and C-M-<f8> are bound by `org-agenda-frame.el' (cj/--agenda-frame-install-keys): +;; S-<f8> toggles the dedicated agenda frame; C-M-<f8> runs the force-rescan above. (defun cj/todo-list-all-agenda-files () "Displays an \\='org-agenda\\=' todo list. @@ -383,11 +397,14 @@ The agenda is rebuilt from all sources before display, including: ;; ------------------------- Add Timestamp To Org Entry ------------------------ ;; simply adds a timestamp to put the org entry on an agenda +(defvar cj/timeformat "%Y-%m-%d %a" + "Date format for the stamp `cj/add-timestamp-to-org-entry' inserts. +Must stay an org-readable date so the stamped line reaches the agenda.") + (defun cj/add-timestamp-to-org-entry (s) "Add an event with time S to appear underneath the line-at-point. This allows a line to show in an agenda without being scheduled or a deadline." (interactive "sTime: ") - (defvar cj/timeformat "%Y-%m-%d %a") (org-end-of-line) (save-excursion (open-line 1) diff --git a/modules/org-agenda-frame.el b/modules/org-agenda-frame.el new file mode 100644 index 00000000..471b246b --- /dev/null +++ b/modules/org-agenda-frame.el @@ -0,0 +1,874 @@ +;;; org-agenda-frame.el --- Dedicated agenda frame -*- lexical-binding: t; -*- +;; author: Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 4 (Optional). +;; Category: O/D. +;; Load shape: eager (binds keys in Phase 2; Phase 1 defines helpers only). +;; Top-level side effects: none yet (Phase 1 is private helpers). +;; Runtime requires: none. +;; Direct test load: yes. +;; +;; A dedicated Emacs frame of the running daemon that shows a today-anchored +;; seven-day org-agenda, refreshing itself, kept read-only and focus-locked. +;; A normal (non-fullscreen) frame, so a tiling WM places it side by side with +;; the working frame. Spawned/raised/closed by one key. See the spec: +;; docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org. +;; +;; Phase 1 (this pass) builds non-interactive helpers only: frame lookup, +;; spawn/raise/delete, the dedicated view, the default-deny read-only policy, +;; and working-frame routing. No interactive command or key is bound until +;; Phase 2, so nothing user-visible changes yet. + +;;; Code: + +(require 'seq) + +;; Declared, not required: `org-agenda-config' pulls in vc packages that don't +;; load under `make test' (no package-initialize). The frame module references +;; org-agenda symbols through these declarations and does its real wiring inside +;; `with-eval-after-load' so a batch test-load runs no org-agenda side effects. +(defvar org-agenda-custom-commands) +(defvar org-agenda-finalize-hook) +(defvar org-agenda-mode-map) +(defvar org-agenda-sticky) +(defvar org-agenda-window-setup) +(declare-function cj/build-org-agenda-list "org-agenda-config" (&optional force-rebuild)) +(declare-function cj/org-agenda-refresh-files "org-agenda-config" ()) +(declare-function org-agenda-redo "org-agenda" (&optional all)) +(declare-function org-agenda-next-line "org-agenda" ()) +(declare-function org-agenda-previous-line "org-agenda" ()) +(declare-function org-agenda-next-item "org-agenda" (n)) +(declare-function org-agenda-previous-item "org-agenda" (n)) +(declare-function org-agenda-open-link "org-agenda" (&optional arg)) +(declare-function org-agenda-priority-down "org-agenda" ()) +(declare-function org-agenda-priority-up "org-agenda" ()) +(declare-function org-agenda-todo "org-agenda" (&optional arg)) +(declare-function org-agenda-todo-nextset "org-agenda" ()) +(declare-function org-agenda-todo-previousset "org-agenda" ()) +(declare-function org-get-at-bol "org" (property)) +(declare-function org-fold-show-context "org-fold" (&optional key)) +(declare-function org-agenda "org-agenda" (&optional arg org-keys restriction)) +;; No declare-function for -safe-redo / -delete: they are defined later in THIS +;; file, and the byte-compiler resolves same-file forward references at end of +;; compilation. A declare-function for a same-file function instead counts as a +;; second definition ("defined multiple times") and, worse, its declared arglist +;; overrides the real one for arg-count checking -- the empty () shadowed +;; -safe-redo's actual (&optional frame), disabling that check. + +(defconst cj/--agenda-frame-parameter 'cj/agenda-frame + "Frame parameter marking the dedicated agenda frame. +Its presence (non-nil) is how `cj/--agenda-frame' locates the frame among +all of the daemon's frames.") + +(defvar cj/--agenda-frame-launch-frame nil + "The frame selected when the agenda frame was last spawned. +Preferred routing target for source files opened from the agenda (see +`cj/--agenda-frame-working-frame'); ignored once it is dead or is itself +the agenda frame.") + +(defun cj/--agenda-frame-p (frame) + "Return non-nil when FRAME is a live agenda frame. +FRAME is an agenda frame when it is live and carries the +`cj/--agenda-frame-parameter' marker; a dead frame is never one." + (and (frame-live-p frame) + (frame-parameter frame cj/--agenda-frame-parameter))) + +(defun cj/--agenda-frame () + "Return the live agenda frame, or nil. +The frame is identified by the `cj/--agenda-frame-parameter' marker; a +dead frame is never returned even if it still carries the marker." + (seq-find #'cj/--agenda-frame-p (frame-list))) + +(defun cj/--agenda-frame-working-frame () + "Return a live non-agenda frame to route source files into, or nil. +Prefer `cj/--agenda-frame-launch-frame' when it is still live and not the +agenda frame; otherwise the first live non-agenda frame among all frames. +Return nil when the agenda frame is the only live frame -- the caller then +creates a normal frame." + (or (and (frame-live-p cj/--agenda-frame-launch-frame) + (not (cj/--agenda-frame-p cj/--agenda-frame-launch-frame)) + cj/--agenda-frame-launch-frame) + (seq-find (lambda (frame) + (and (frame-live-p frame) + (not (cj/--agenda-frame-p frame)))) + (frame-list)))) + +;;; The dedicated seven-day view (org-agenda-custom-commands key F) + +(defconst cj/--agenda-frame-command-key "F" + "The `org-agenda-custom-commands' key for the agenda-frame view. +The existing top-level key is `d' (org-agenda-config.el:344), so `F' is +collision-free. The sticky buffer derives its name from this key +\(*Org Agenda(F)*).") + +(defvar cj/--agenda-frame-span 7 + "Span, in days, of the agenda-frame view. +The `F' custom command reads this via its `org-agenda-span' setting, which +Org evaluates on every build and every redo, so `cj/--agenda-frame-day-view' +\(span 1) and `cj/--agenda-frame-week-view' (span 7) change it and the next +redo picks up the new span. Reset to 7 on each spawn so a fresh frame opens +at the documented default.") + +(defun cj/--agenda-frame-command () + "Return the `org-agenda-custom-commands' entry for the agenda frame. +A one-block agenda: a `cj/--agenda-frame-span'-day span anchored to today +rather than +Monday (`org-agenda-list' otherwise anchors any seven-day span to the +week start in Org 9.7.11), rendered in the frame's sole window +\(`current-window', so Org's default `reorganize-frame' can't split it), +as its own sticky *Org Agenda(F)* buffer, with follow-mode forced off so +a non-nil global default can't open a second window at build time." + `(,cj/--agenda-frame-command-key "Agenda frame: 7-day today-anchored" + ((agenda "" + ((org-agenda-span cj/--agenda-frame-span) + (org-agenda-start-day "0d") + (org-agenda-start-on-weekday nil) + (org-agenda-start-with-follow-mode nil) + ;; The global daily agenda intentionally keeps scheduled done + ;; items visible. The Full Agenda is a live work surface, so + ;; completed items are noise regardless of schedule or priority. + (org-agenda-skip-function + '(org-agenda-skip-entry-if 'todo 'done)) + ;; Narrow category column: the global agenda format pads the + ;; category to 25 chars, leaving a wide blank gutter between + ;; the source name (todo:, dcal:) and the item. + (org-agenda-prefix-format " %i %-10:c%?-12t% s")))) + ;; No `org-agenda-sticky' here, deliberately: these settings are baked + ;; into the buffer's series-redo-cmd and re-applied by every redo, and a + ;; sticky t mid-redo makes `org-agenda-use-sticky-p' true while the + ;; buffer exists -- `org-agenda-prepare' then throws \\='exit ("use `r' + ;; to refresh") with no catch, failing every refresh tick. Stickiness + ;; is bound in the spawn wrapper instead, where it names the buffer. + ((org-agenda-window-setup 'current-window)))) + +(defun cj/--agenda-frame-register-command () + "Register the agenda-frame view in `org-agenda-custom-commands'. +Idempotent: any existing entry for `cj/--agenda-frame-command-key' is +replaced, so a module reload never accumulates duplicate keys." + (setq org-agenda-custom-commands + (cons (cj/--agenda-frame-command) + (assoc-delete-all cj/--agenda-frame-command-key + org-agenda-custom-commands)))) + +;;; Engage routing — open the item's source outside the agenda frame + +(defun cj/--agenda-frame-item-marker () + "Return the source marker for the agenda item at point, or nil. +Prefers the item's own marker, falling back to the heading marker. Reads +the text property directly (like `org-get-at-bol') so point restoration +is exercisable without loading org." + (or (get-text-property (line-beginning-position) 'org-marker) + (get-text-property (line-beginning-position) 'org-hd-marker))) + +(defun cj/--agenda-frame-target-frame () + "Return the frame to open agenda source in, creating one when needed. +The engage action never opens into the agenda frame: it targets the +working frame (`cj/--agenda-frame-working-frame'), and when the agenda +frame is the only live frame it creates a normal, non-fullscreen frame." + (or (cj/--agenda-frame-working-frame) + (make-frame))) + +(defun cj/--agenda-frame-engage-open () + "Open the source of the agenda item at point in the working frame. +Routes to the MRU non-agenda frame (or a new normal frame when the agenda +frame is the only one), so the agenda frame keeps showing the agenda. +Signals a `user-error' when point is not on an agenda item." + (interactive) + (let ((marker (cj/--agenda-frame-item-marker))) + (unless (and marker (marker-buffer marker)) + (user-error "No agenda item on this line")) + (let ((buffer (marker-buffer marker)) + (pos (marker-position marker)) + (frame (cj/--agenda-frame-target-frame))) + (select-frame-set-input-focus frame) + (pop-to-buffer-same-window buffer) + (widen) + (goto-char pos) + (when (derived-mode-p 'org-mode) + (org-fold-show-context 'agenda)) + (beginning-of-line)))) + +(defun cj/--agenda-frame-engage-mouse (event) + "Open the agenda item clicked by EVENT in the working frame." + (interactive "e") + (mouse-set-point event) + (cj/--agenda-frame-engage-open)) + +(defun cj/--agenda-frame-open-link () + "Follow the link in the agenda item at point, in the working frame." + (interactive) + (select-frame-set-input-focus (cj/--agenda-frame-target-frame)) + (org-agenda-open-link)) + +(defun cj/--agenda-frame-close () + "Close the agenda frame from within it. +Bound to q, Q, and x so Org's own quit keys delete the whole frame +\(and cancel its timer) rather than leaving a sole-window agenda +frame stranded on a non-agenda buffer." + (interactive) + (cj/--agenda-frame-delete)) + +;;; Default-deny read-only policy + +(defconst cj/--agenda-frame-readonly-message + "Agenda frame is read-only — press RET to edit in your working frame" + "Shown when a mutating or buffer-opening command is denied in the frame.") + +(defconst cj/--agenda-frame-fixed-view-message + "Agenda frame shows only the day (d) and week (w) views" + "Shown when a view-changing command is denied in the frame.") + +(defun cj/--agenda-frame-denied-readonly () + "Deny a mutating or buffer-opening command in the agenda frame. +The default binding for every key not on the allowlist." + (interactive) + (message "%s" cj/--agenda-frame-readonly-message)) + +(defun cj/--agenda-frame-denied-fixed-view () + "Deny a view-changing command that would break the today-anchored span." + (interactive) + (message "%s" cj/--agenda-frame-fixed-view-message)) + +(defvar cj/agenda-frame-mode-map + (let ((map (make-sparse-keymap))) + ;; Default-deny: every key/mouse event not rebound below funnels through + ;; this one catch-all, so mutations (present and future) are read-only. + (define-key map [t] #'cj/--agenda-frame-denied-readonly) + ;; Hide the Org Agenda menu-bar entry so there is no menu path to a mutation. + (define-key map [menu-bar org-agenda] #'undefined) + ;; (a) Navigation — allowlisted to their org-agenda commands. + (define-key map (kbd "n") #'org-agenda-next-line) + (define-key map (kbd "p") #'org-agenda-previous-line) + (define-key map (kbd "<down>") #'org-agenda-next-line) + (define-key map (kbd "<up>") #'org-agenda-previous-line) + (define-key map (kbd "C-n") #'org-agenda-next-line) + (define-key map (kbd "C-p") #'org-agenda-previous-line) + (define-key map (kbd "N") #'org-agenda-next-item) + (define-key map (kbd "P") #'org-agenda-previous-item) + (define-key map (kbd "C-v") #'scroll-up-command) + (define-key map (kbd "M-v") #'scroll-down-command) + (define-key map (kbd "M-<") #'beginning-of-buffer) + (define-key map (kbd "M->") #'end-of-buffer) + ;; Read-only point motion and search within the agenda. + (define-key map (kbd "C-a") #'move-beginning-of-line) + (define-key map (kbd "C-e") #'move-end-of-line) + (define-key map (kbd "C-f") #'forward-char) + (define-key map (kbd "C-b") #'backward-char) + (define-key map (kbd "C-s") #'isearch-forward) + (define-key map (kbd "C-r") #'isearch-backward) + (define-key map (kbd "C-g") #'keyboard-quit) + ;; (b) Engage / open — routed to the working frame, never the agenda frame. + ;; Bind the GUI function-key events ([return]/[tab]) as well as the ASCII + ;; forms: the [t] catch-all otherwise gives `return'/`tab' a binding, which + ;; suppresses their function-key translation to RET/TAB, so a bare RET would + ;; hit the deny handler instead of engaging in a graphical frame. + (define-key map (kbd "RET") #'cj/--agenda-frame-engage-open) + (define-key map (kbd "TAB") #'cj/--agenda-frame-engage-open) + (define-key map [return] #'cj/--agenda-frame-engage-open) + (define-key map [tab] #'cj/--agenda-frame-engage-open) + (define-key map (kbd "<mouse-2>") #'cj/--agenda-frame-engage-mouse) + (define-key map (kbd "C-c C-o") #'cj/--agenda-frame-open-link) + ;; (c) The frame's own controls. + (define-key map (kbd "q") #'cj/--agenda-frame-close) + (define-key map (kbd "Q") #'cj/--agenda-frame-close) + (define-key map (kbd "x") #'cj/--agenda-frame-close) + (define-key map (kbd "r") #'cj/--agenda-frame-safe-redo) + ;; g is the muscle-memory agenda refresh; keep it working here (the + ;; frame-scoped safe redo, same as r) rather than denying it as a + ;; view-change. C-M-<f8> stays the force-rescan. + (define-key map (kbd "g") #'cj/--agenda-frame-safe-redo) + ;; d / w toggle the span (today's day vs the seven-day view) in place; the + ;; other view-changers stay denied to keep the today-anchored frame stable. + (define-key map (kbd "d") #'cj/--agenda-frame-day-view) + (define-key map (kbd "w") #'cj/--agenda-frame-week-view) + ;; (d) Controlled task mutations. The frame remains default-deny for + ;; scheduling, clocking, capture, notes, and file writes, but status and + ;; priority are deliberate in-place agenda operations. C-c t is Craig's + ;; requested status chord; C-c C-t keeps Org's standard agenda chord. + ;; This config uses Super arrows in ordinary Org agendas, while Meta arrows + ;; are the requested Full Agenda muscle memory, so support both. + (define-key map (kbd "C-c t") #'org-agenda-todo) + (define-key map (kbd "C-c C-t") #'org-agenda-todo) + (dolist (key '("M-<up>" "s-<up>")) + (define-key map (kbd key) #'org-agenda-priority-up)) + (dolist (key '("M-<down>" "s-<down>")) + (define-key map (kbd key) #'org-agenda-priority-down)) + (dolist (key '("M-<left>" "s-<left>")) + (define-key map (kbd key) #'org-agenda-todo-previousset)) + (dolist (key '("M-<right>" "s-<right>")) + (define-key map (kbd key) #'org-agenda-todo-nextset)) + (define-key map (kbd "S-<f8>") #'cj/agenda-frame-toggle) + (define-key map (kbd "C-M-<f8>") #'cj/org-agenda-refresh-files) + ;; C-x C-c means "close this frame" here. The global + ;; `save-buffers-kill-terminal' must never run in this frame: it was made + ;; by `make-frame', not emacsclient, so with no client to close it falls + ;; back to killing the daemon itself. + (define-key map (kbd "C-x C-c") #'cj/--agenda-frame-close) + ;; (e) Input machinery punched through the catch-all. An explicit nil + ;; shadows the [t] default in this map, so these fall through to their + ;; global bindings. Without the punches, every frame-focus change + ;; (switch-frame), every wheel scroll, and every mouse click hits the + ;; deny handler -- message spam and broken frame switching. + (dolist (key (list [switch-frame] + [wheel-up] [wheel-down] [wheel-left] [wheel-right] + [double-wheel-up] [double-wheel-down] + [triple-wheel-up] [triple-wheel-down] + [mouse-1] [down-mouse-1] [drag-mouse-1] + (kbd "C-h"))) + (define-key map key nil)) + ;; (f) Global chords that would pull focus out of the frame must be + ;; denied *explicitly*. The [t] catch-all can't reach them: a keymap's + ;; default binding does not shadow an *explicit* binding in a + ;; lower-priority map, and these are bound in the global map (M-SPC / + ;; M-S-SPC swap ai-term agents). Left to the catch-all, M-SPC follows + ;; its global binding and escapes the read-only frame into ai-term. + (dolist (key '("M-SPC" "M-S-SPC")) + (define-key map (kbd key) #'cj/--agenda-frame-denied-readonly)) + ;; The remaining view-changers get the distinct fixed-view message, not the + ;; read-only one. d/w are handled above (they toggle the span in place). + (dolist (key '("y" "f" "b" "j")) + (define-key map (kbd key) #'cj/--agenda-frame-denied-fixed-view)) + map) + "Keymap for `cj/agenda-frame-mode'. +Shadows `org-agenda-mode-map' by default-deny: the `[t]' catch-all denies +every key that is not explicitly allowlisted here. Status and priority are +the only source-task mutations allowed; a future Org binding is denied by +default and there is nothing to keep in sync.") + +(define-minor-mode cj/agenda-frame-mode + "Focus-locked, default-deny policy for the dedicated agenda frame. +Only the allowlist in `cj/agenda-frame-mode-map' is permitted: navigation, +the engage/open keys (routed to the working frame), and the frame's own +controls, plus controlled task status and priority changes. Every other +key/mouse command is denied. The enforcement boundary is keys and mouse; +a direct \\[execute-extended-command] is out of contract." + :init-value nil + :lighter " AgendaFrame" + :keymap cj/agenda-frame-mode-map) + +(defun cj/--agenda-frame-shadow-mutations (&optional source-map prefix) + "Deny every SOURCE-MAP key sequence not on the frame map's allowlist. +Walk SOURCE-MAP (default `org-agenda-mode-map') recursively. For each +sequence it binds to a command, if `cj/agenda-frame-mode-map' doesn't already +bind that sequence to a command or manage it as a prefix, add an explicit +read-only deny. + +This closes the default-deny hole: a keymap's `[t]' default never shadows an +explicit binding in a lower-priority map, so a single `[t]' catch-all denies +only keys that are unbound everywhere. Every key `org-agenda-mode-map' binds +\(t, I, k, z, s, ., the C-c mutators, C-x C-s, ...) would otherwise sail +through the catch-all and mutate source files from the read-only frame. +Explicitly denying each non-allowlisted sequence makes the catch-all's intent +actually hold. + +PREFIX is the accumulated key vector during recursion (internal). Idempotent: +re-running rebinds the same denials. Runs from `with-eval-after-load' once +`org-agenda-mode-map' exists." + (let ((source (or source-map org-agenda-mode-map)) + (prefix (or prefix []))) + (map-keymap + (lambda (event binding) + (unless (or (eq event t) (eq event 'menu-bar) (eq event 'remap) + (consp event)) + (let ((seq (vconcat prefix (vector event)))) + (cond + ((keymapp binding) + (cj/--agenda-frame-shadow-mutations binding seq)) + ((commandp binding) + (let ((ours (lookup-key cj/agenda-frame-mode-map seq))) + ;; A command we allowlisted or a prefix we manage: leave it. + ;; Anything else (only the `[t]' default, or unbound under a + ;; shared prefix) escapes to org's command -- deny it here. + (unless (or (commandp ours) (keymapp ours)) + (define-key cj/agenda-frame-mode-map seq + #'cj/--agenda-frame-denied-readonly)))))))) + source))) + +;; The shadow walk is installed at the END of this file, not here: it reads +;; `commandp' on each allowlisted binding to decide whether to keep it, and the +;; view/redo handlers (day-view, week-view, safe-redo) are defined further down. +;; If org-agenda is already loaded when this file loads (the normal startup order, +;; and every reload), `with-eval-after-load' fires immediately -- so the walk must +;; not run until those defuns exist, or it reads them as undefined, fails the +;; commandp guard, and denies the very keys the allowlist grants. See the bottom +;; of the file. + +(defun cj/--agenda-frame-maybe-enable-mode () + "Re-enable `cj/agenda-frame-mode' after an agenda build in the agenda frame. +Added to `org-agenda-finalize-hook'. `org-agenda-redo' rebuilds through +`org-agenda-mode', whose `kill-all-local-variables' strips the buffer-local +minor mode; this reinstates it whenever the just-built buffer is displayed +in the frame carrying the `cj/agenda-frame' marker (a frame parameter, which +survives the buffer reset). Ordinary agenda builds in working frames are +left untouched. + +The same reset also strips the buffer-local `kill-buffer-hook' installed at +spawn, so it is re-added here too -- otherwise, after the first refresh +tick, killing the buffer would no longer delete the frame." + (let ((frame (cj/--agenda-frame))) + (when (and frame (get-buffer-window (current-buffer) frame)) + (cj/agenda-frame-mode 1) + (add-hook 'kill-buffer-hook #'cj/--agenda-frame-on-kill-buffer nil t)))) + +;;; Frame lifecycle — spawn, raise, delete, toggle, cleanup + +(defconst cj/--agenda-frame-timer-parameter 'cj/agenda-frame-timer + "Frame parameter holding the agenda frame's refresh timer (set in Phase 2).") + +(declare-function auto-dim-other-buffers-mode "auto-dim-other-buffers" (&optional arg)) + +(defvar cj/--agenda-frame-dim-was-on nil + "Non-nil when the agenda frame's spawn turned `auto-dim-other-buffers-mode' off. +The refresh tick's selection swing marks the working window non-selected, +and auto-dim's debounced dim lands after the tick -- the working frame +visibly dims every five minutes. Spawn suspends the mode and remembers it +here; closing the frame restores it.") + +(defun cj/--agenda-frame-suspend-dim () + "Turn auto-dim off for the agenda frame's lifetime, remembering it was on." + (when (and (bound-and-true-p auto-dim-other-buffers-mode) + (fboundp 'auto-dim-other-buffers-mode)) + (setq cj/--agenda-frame-dim-was-on t) + (auto-dim-other-buffers-mode -1))) + +(defun cj/--agenda-frame-restore-dim () + "Restore auto-dim if the agenda frame's spawn suspended it." + (when (and cj/--agenda-frame-dim-was-on + (fboundp 'auto-dim-other-buffers-mode)) + (setq cj/--agenda-frame-dim-was-on nil) + (auto-dim-other-buffers-mode 1))) + +(defvar cj/--agenda-frame-tearing-down nil + "Non-nil while the agenda frame is being torn down. +Breaks the `delete-frame' / `kill-buffer-hook' re-entrancy loop: deleting +the frame kills its buffer and killing the buffer deletes the frame, so +whichever fires first sets this to skip the other.") + +(defun cj/--agenda-frame-sticky-buffer () + "Return the dedicated *Org Agenda(F)* sticky buffer, or nil if none." + (get-buffer (format "*Org Agenda(%s)*" cj/--agenda-frame-command-key))) + +(defun cj/--agenda-frame-cancel-timer (&optional frame) + "Cancel and clear the refresh timer on FRAME (default: the agenda frame). +Safe when no timer is set or FRAME is dead. Returns nil." + (let* ((frame (or frame (cj/--agenda-frame))) + (timer (and (frame-live-p frame) + (frame-parameter frame cj/--agenda-frame-timer-parameter)))) + (when (timerp timer) + (cancel-timer timer)) + (when (frame-live-p frame) + (set-frame-parameter frame cj/--agenda-frame-timer-parameter nil)) + nil)) + +(defun cj/--agenda-frame-on-delete-frame (frame) + "Clean up when the agenda FRAME dies by any path. +Registered on `delete-frame-functions': cancels the refresh timer and +kills the dedicated sticky buffer, so the next spawn regenerates fresh +rather than reusing stale sticky content. A non-agenda frame is ignored." + (when (cj/--agenda-frame-p frame) + (cj/--agenda-frame-cancel-timer frame) + (cj/--agenda-frame-restore-dim) + (let ((buffer (cj/--agenda-frame-sticky-buffer)) + (cj/--agenda-frame-tearing-down t)) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(defun cj/--agenda-frame-on-kill-buffer () + "Delete the agenda frame when its dedicated buffer is killed. +A buffer-local `kill-buffer-hook' on the sticky buffer, so killing it from +anywhere takes the frame with it. Guarded against re-entry during a +frame-initiated teardown." + (unless cj/--agenda-frame-tearing-down + (let ((frame (cj/--agenda-frame))) + (when (frame-live-p frame) + (delete-frame frame))))) + +(defun cj/--agenda-frame-delete () + "Delete the agenda frame; a no-op when none exists. +`delete-frame' fires `cj/--agenda-frame-on-delete-frame', which cancels +the timer and kills the sticky buffer." + (let ((frame (cj/--agenda-frame))) + (when (frame-live-p frame) + (delete-frame frame)))) + +(defun cj/--agenda-frame-raise (frame) + "Raise FRAME and give it input focus. Returns FRAME." + (select-frame-set-input-focus frame) + frame) + +(defun cj/--agenda-frame-make-parameters () + "Return the frame parameters for the dedicated agenda frame. +A normal frame -- not fullscreen -- so a tiling window manager places it +side by side with the working frame rather than covering the whole output. +It carries the `cj/agenda-frame' marker and a distinct, noticeable name +\(\"Full Agenda\") so the frame is recognizable at a glance and +window-manager rules can target it." + `((,cj/--agenda-frame-parameter . t) + (name . "Full Agenda"))) + +(defun cj/--agenda-frame-spawn () + "Create, display, and focus the dedicated agenda frame. +Transactional: on any failure after `make-frame', delete the partial +frame (which cleans up its buffer and timer via the delete hook), restore +focus to the launching frame, and signal a `user-error' naming the cause. +Returns the new agenda frame on success." + (let ((launch (selected-frame)) + (frame nil)) + (condition-case err + (progn + (setq cj/--agenda-frame-launch-frame launch) + ;; A fresh frame opens at the documented seven-day default, even if a + ;; prior session left the span on the day view (d). + (setq cj/--agenda-frame-span 7) + (setq frame (make-frame (cj/--agenda-frame-make-parameters))) + (select-frame-set-input-focus frame) + ;; Cached, non-forced: a frame spawned early after daemon startup + ;; still shows the full project agenda, not the base-files-only view. + (cj/build-org-agenda-list) + ;; Bind sticky + current-window dynamically around the render. The + ;; custom command's own settings apply too late to name the buffer; + ;; without these the buffer is plain *Org Agenda*, which matches the + ;; 0.75 below-selected display rule in org-agenda-config.el -- the + ;; new frame gets split with the launch buffer left in the top 25%. + ;; Sticky names it *Org Agenda(F)*, which no display rule matches. + (let ((org-agenda-sticky t) + (org-agenda-window-setup 'current-window)) + (org-agenda "a" cj/--agenda-frame-command-key)) + ;; Belt: whatever a display rule did, the frame is one agenda window. + (delete-other-windows) + (let ((buffer (cj/--agenda-frame-sticky-buffer))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (add-hook 'kill-buffer-hook + #'cj/--agenda-frame-on-kill-buffer nil t)))) + (cj/--agenda-frame-start-timer frame) + (cj/--agenda-frame-suspend-dim) + frame) + (error + (when (frame-live-p frame) + (delete-frame frame)) + (when (frame-live-p launch) + (select-frame-set-input-focus launch)) + (user-error "Agenda frame: spawn failed: %s" + (error-message-string err)))))) + +(defun cj/--agenda-frame-toggle () + "Spawn, raise, or delete the dedicated agenda frame. +Spawn when none exists, delete when the agenda frame is the selected +frame, raise and focus it otherwise. + +Non-interactive by design in Phase 1: reachable only from ERT, never from +\\[execute-extended-command] or a key. Phase 2 wraps this in the public +`cj/agenda-frame-toggle' and binds it to S-<f8>." + (let ((frame (cj/--agenda-frame))) + (cond + ((null frame) (cj/--agenda-frame-spawn)) + ((eq frame (selected-frame)) (cj/--agenda-frame-delete) nil) + (t (cj/--agenda-frame-raise frame))))) + +;;; Phase 2 — refresh timer, snapshot restore, and the public command + +(defconst cj/--agenda-frame-refresh-seconds 300 + "Refresh cadence for the agenda frame, in seconds (five minutes).") + +(defconst cj/--agenda-frame-fail-count-parameter 'cj/agenda-frame-fail-count + "Frame parameter holding the consecutive-failure count for the refresh timer.") + +(defconst cj/--agenda-frame-overlay-property 'cj/agenda-frame-failure + "Overlay property tagging the refresh-failed banner. +The banner is found by scanning for this property, never held in a +buffer-local variable: `org-agenda-redo' runs `kill-all-local-variables', +which would wipe the variable while the overlay object survives +`erase-buffer' -- leaving a banner nothing could ever remove.") + +(defun cj/--agenda-frame-seconds-to-next-mark (time period) + "Return seconds from TIME to the next wall-clock multiple of PERIOD. +TIME is any Emacs time value, PERIOD is seconds (300 gives the :00/:05 +marks). A TIME exactly on a mark returns a full PERIOD, so the timer +never fires twice back-to-back." + (let ((rem (mod (floor (float-time time)) period))) + (if (zerop rem) period (- period rem)))) + +;; -- Point restoration ------------------------------------------------------- + +(defun cj/--agenda-frame-goto-first-item () + "Move point to the first agenda item, or `point-min' when the view is empty." + (goto-char (point-min)) + (let ((found nil)) + (while (and (not found) (not (eobp))) + (if (get-text-property (line-beginning-position) 'org-marker) + (setq found t) + (forward-line 1))) + (unless found (goto-char (point-min))))) + +(defun cj/--agenda-frame-restore-point (old-marker old-line) + "Restore point in the rebuilt agenda buffer after a redo. +Prefer the line whose org-marker points at the same source location as +OLD-MARKER, choosing the occurrence nearest OLD-LINE when a source line +appears twice. When the marker is gone, clamp OLD-LINE into range; if +that lands on a header (no item), move to the first item; an item-less +view leaves point at buffer start." + (let ((max-line (line-number-at-pos (point-max))) + (targets '())) + (when (and (markerp old-marker) (marker-buffer old-marker)) + (let ((src-buf (marker-buffer old-marker)) + (src-pos (marker-position old-marker))) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((m (get-text-property (line-beginning-position) 'org-marker))) + (when (and (markerp m) + (eq (marker-buffer m) src-buf) + (eql (marker-position m) src-pos)) + (push (line-number-at-pos) targets))) + (forward-line 1))))) + (cond + (targets + (let ((best (car (sort targets + (lambda (a b) + (< (abs (- a old-line)) (abs (- b old-line)))))))) + (goto-char (point-min)) + (forward-line (1- best)))) + (t + (let ((line (max 1 (min old-line max-line)))) + (goto-char (point-min)) + (forward-line (1- line)) + (unless (get-text-property (line-beginning-position) 'org-marker) + (cj/--agenda-frame-goto-first-item))))))) + +;; -- Snapshot with cloned markers -------------------------------------------- + +(defun cj/--agenda-frame-snapshot-markers (buffer) + "Return a list of (POSITION . CLONE) for every org-marker in BUFFER. +CLONE is an independent `copy-marker' into the same source location, so +it survives `org-agenda-reset-markers' nulling BUFFER's own markers on a +rebuild." + (with-current-buffer buffer + (let ((clones '()) + (pos (point-min))) + (while (< pos (point-max)) + (let ((m (get-text-property pos 'org-marker))) + (when (and (markerp m) (marker-buffer m)) + (push (cons pos (copy-marker m)) clones))) + (setq pos (or (next-single-property-change pos 'org-marker buffer) + (point-max)))) + (nreverse clones)))) + +(defun cj/--agenda-frame-reinstall-markers (buffer clones) + "Reapply CLONES (from `cj/--agenda-frame-snapshot-markers') to BUFFER. +Restores each cloned marker as the org-marker text property at its +recorded position, so RET/TAB resolve to the right source line after a +snapshot restore." + (with-current-buffer buffer + (dolist (entry clones) + (let ((pos (car entry))) + (when (and (>= pos (point-min)) (< pos (point-max))) + (put-text-property pos (1+ pos) 'org-marker (cdr entry))))))) + +(defun cj/--agenda-frame-snapshot (buffer window) + "Capture BUFFER's last-good state for restore after a failed redo. +Returns a plist of the propertized :text (carrying org-redo-cmd/org-lprops), +:point, :window-start, and :markers (cloned, source-owned)." + (with-current-buffer buffer + (list :text (buffer-substring (point-min) (point-max)) + :point (point) + :window-start (and (window-live-p window) (window-start window)) + :markers (cj/--agenda-frame-snapshot-markers buffer)))) + +(defun cj/--agenda-frame-restore-snapshot (buffer snapshot window) + "Restore SNAPSHOT verbatim into BUFFER, reinstating cloned markers. +Sets point and, when WINDOW is live, window-start from the snapshot." + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (plist-get snapshot :text)) + (cj/--agenda-frame-reinstall-markers buffer (plist-get snapshot :markers)) + (goto-char (min (plist-get snapshot :point) (point-max)))) + (when (and (window-live-p window) (plist-get snapshot :window-start)) + (set-window-start window (min (plist-get snapshot :window-start) + (point-max)))))) + +(defun cj/--agenda-frame-release-snapshot (snapshot) + "Release SNAPSHOT's cloned markers so repeated redoes don't leak markers. +Called on a successful redo (the snapshot is discarded); never on the +error path, where the clones become the buffer's live org-markers." + (dolist (entry (plist-get snapshot :markers)) + (when (markerp (cdr entry)) + (set-marker (cdr entry) nil)))) + +;; -- Failure latch and overlay ----------------------------------------------- + +(defun cj/--agenda-frame-record-failure (frame) + "Increment FRAME's consecutive-failure count; return non-nil to report. +Reports only on the first failure of a run (the 0 -> 1 transition)." + (let ((n (1+ (or (frame-parameter frame cj/--agenda-frame-fail-count-parameter) + 0)))) + (set-frame-parameter frame cj/--agenda-frame-fail-count-parameter n) + (= n 1))) + +(defun cj/--agenda-frame-clear-failure (frame) + "Reset FRAME's consecutive-failure count (the next tick reports again)." + (set-frame-parameter frame cj/--agenda-frame-fail-count-parameter 0)) + +(defun cj/--agenda-frame-failure-overlays (buffer) + "Return the refresh-failed banner overlays in BUFFER (normally 0 or 1)." + (with-current-buffer buffer + (seq-filter (lambda (o) (overlay-get o cj/--agenda-frame-overlay-property)) + (overlays-in (point-min) (point-max))))) + +(defun cj/--agenda-frame-show-failure-overlay (buffer) + "Show the refresh-failed notice as an overlay at the top of BUFFER. +Idempotent: an existing banner is reused, so consecutive failures never +stack a second one." + (with-current-buffer buffer + (let ((overlay (or (car (cj/--agenda-frame-failure-overlays buffer)) + (make-overlay (point-min) (point-min))))) + (overlay-put overlay cj/--agenda-frame-overlay-property t) + (overlay-put overlay 'before-string + (propertize "Agenda frame: refresh failed (C-M-<f8> to force-rescan)\n" + 'face 'warning))))) + +(defun cj/--agenda-frame-remove-overlay (buffer) + "Remove the refresh-failed banner from BUFFER, if present." + (when (buffer-live-p buffer) + (mapc #'delete-overlay (cj/--agenda-frame-failure-overlays buffer)))) + +;; -- The refresh itself ------------------------------------------------------ + +(defun cj/--agenda-frame-do-redo (frame buffer window) + "Redo the agenda in BUFFER, degrading to the last-good snapshot on failure. +On success: drop the failure overlay, restore point, clear the failure +latch, and release the pre-redo snapshot. On error: restore the snapshot +verbatim, re-enable the policy (the finalize hook runs only on success), +show the failure overlay, and report once per consecutive-failure run. +Either way the frame is never blank, unrestricted, or non-retryable." + (with-current-buffer buffer + ;; Clone the point marker: `org-agenda-redo' calls `org-agenda-reset-markers' + ;; which nulls the buffer's own org-markers, so the raw marker would be dead + ;; by the time `cj/--agenda-frame-restore-point' runs -- collapsing the + ;; "follow the same source item" restoration to the line-number clamp on + ;; every normal tick. An independent clone survives the reset. + (let ((old-marker (let ((m (cj/--agenda-frame-item-marker))) + (and (markerp m) (marker-buffer m) (copy-marker m)))) + (old-line (line-number-at-pos)) + (snapshot (cj/--agenda-frame-snapshot buffer window))) + (unwind-protect + (condition-case nil + ;; Never bind sticky here: `org-agenda-redo' handles the + ;; in-place rebuild itself (binds sticky nil, redirects the + ;; buffer name). A sticky t reaching `org-agenda-prepare' + ;; mid-redo makes it throw \\='exit with no catch, failing + ;; every tick. current-window is bound as a belt so a rule + ;; can't split the frame during the rebuild. + (let ((inhibit-message t) + (org-agenda-window-setup 'current-window)) + (org-agenda-redo) + (cj/--agenda-frame-remove-overlay buffer) + (cj/--agenda-frame-restore-point old-marker old-line) + (cj/--agenda-frame-clear-failure frame) + (cj/--agenda-frame-release-snapshot snapshot)) + (error + (cj/--agenda-frame-restore-snapshot buffer snapshot window) + (cj/agenda-frame-mode 1) + (cj/--agenda-frame-show-failure-overlay buffer) + (when (cj/--agenda-frame-record-failure frame) + (message "Agenda frame: refresh failed (C-M-<f8> to force-rescan)")))) + (when (markerp old-marker) + (set-marker old-marker nil)))))) + +(defun cj/--agenda-frame-safe-redo (&optional frame) + "Refresh the agenda buffer in FRAME safely (the timer tick and manual `r'). +Runs with the dedicated window selected for the redo's dynamic extent and +restores the prior window afterward, never calling an input-focus +function, so a tick while another frame is active neither errors on an +out-of-range window-start nor steals focus." + (interactive) + (let* ((frame (or frame (cj/--agenda-frame))) + (buffer (cj/--agenda-frame-sticky-buffer)) + (window (and (frame-live-p frame) (buffer-live-p buffer) + (get-buffer-window buffer frame)))) + (when (and (window-live-p window) + ;; Skip the tick while a minibuffer is active anywhere -- + ;; reselecting windows under an active minibuffer session can + ;; break it, and the next tick catches up. + (not (active-minibuffer-window))) + (let ((prev-window (selected-window)) + ;; The rebuild takes visible time, and for its duration the + ;; agenda window is the selected window. Without inhibiting + ;; redisplay the user's cursor visibly goes hollow for the whole + ;; rebuild every tick -- indistinguishable from focus theft. + ;; The rebuild blocks Emacs either way (it is synchronous), so + ;; this hides the selection flicker at no extra cost; redisplay + ;; resumes after the selection is restored. + (inhibit-redisplay t)) + (unwind-protect + (progn + (select-window window t) + (cj/--agenda-frame-do-redo frame buffer window)) + (when (window-live-p prev-window) + (select-window prev-window t))))))) + +(defun cj/--agenda-frame-day-view () + "Shrink the Full Agenda frame to today's single-day view. +Sets the span to 1 and refreshes. The redo re-evaluates the span, so the +day view survives the wall-clock refresh tick until `w' widens it again." + (interactive) + (setq cj/--agenda-frame-span 1) + (cj/--agenda-frame-safe-redo)) + +(defun cj/--agenda-frame-week-view () + "Restore the Full Agenda frame to the seven-day today-anchored view. +Sets the span back to 7 and refreshes." + (interactive) + (setq cj/--agenda-frame-span 7) + (cj/--agenda-frame-safe-redo)) + +(defun cj/--agenda-frame-start-timer (frame) + "Start FRAME's five-minute wall-clock refresh timer, unless one exists. +Idempotent: a frame already carrying a live timer keeps it (no duplicate). +Returns the timer." + (unless (timerp (frame-parameter frame cj/--agenda-frame-timer-parameter)) + (let* ((period cj/--agenda-frame-refresh-seconds) + (delay (cj/--agenda-frame-seconds-to-next-mark (current-time) period)) + (timer (run-at-time delay period #'cj/--agenda-frame-safe-redo frame))) + (set-frame-parameter frame cj/--agenda-frame-timer-parameter timer) + timer))) + +;; -- Public command and key install ------------------------------------------ + +(defun cj/agenda-frame-toggle () + "Toggle the dedicated agenda frame. +Spawn it when none exists, raise and focus it when it exists but is +unfocused, and close it when it is the selected frame." + (interactive) + (cj/--agenda-frame-toggle)) + +(defun cj/--agenda-frame-install-keys (&optional map) + "Bind the F8-family keys for the agenda frame in MAP (default: the global map). +S-<f8> toggles the agenda frame; the force-rescan +\(`cj/org-agenda-refresh-files') moves to C-M-<f8>, keeping the whole +force-refresh idea in the F8 family." + (let ((map (or map (current-global-map)))) + (define-key map (kbd "S-<f8>") #'cj/agenda-frame-toggle) + (define-key map (kbd "C-M-<f8>") #'cj/org-agenda-refresh-files))) + +;;; Wiring — registered once org-agenda is loaded (no batch side effects) + +(with-eval-after-load 'org-agenda + (cj/--agenda-frame-register-command) + (add-hook 'org-agenda-finalize-hook #'cj/--agenda-frame-maybe-enable-mode) + (add-hook 'delete-frame-functions #'cj/--agenda-frame-on-delete-frame)) + +;; The public gesture appears only now that the feature is complete and live. +(cj/--agenda-frame-install-keys) + +;; Install the read-only shadow now that every allowlist handler above is +;; defined, so the walk's `commandp' guard recognizes them and preserves the +;; allowlist regardless of whether org-agenda loaded before or after this file. +(with-eval-after-load 'org-agenda + (cj/--agenda-frame-shadow-mutations)) + +(provide 'org-agenda-frame) +;;; org-agenda-frame.el ends here diff --git a/modules/org-refile-config.el b/modules/org-refile-config.el index 5f826cac..d94e4965 100644 --- a/modules/org-refile-config.el +++ b/modules/org-refile-config.el @@ -185,6 +185,25 @@ ARG DEFAULT-BUFFER RFLOC and MSG parameters passed to org-refile." ;; --------------------------------- Org Refile -------------------------------- +(declare-function org-save-all-org-buffers "org") + +(defun cj/org-refile--save-all-buffers (&rest _) + "Save every open Org buffer. Installed as `:after' advice on `org-refile'. +Named (not an anonymous lambda) so the :config reload can `advice-remove' +it by reference and a test can assert its installation." + (org-save-all-org-buffers)) + +(defun cj/org-refile--ensure-targets-in-org-mode (&rest _) + "Put every string-named refile target buffer into `org-mode' first. +Installed as `:before' advice on `org-refile-get-targets'. Fixes targets +opened before Org loaded getting stuck in `fundamental-mode'. A non-string +target car (a function or symbol spec) is skipped. Named for the same +remove-by-reference and testability reasons as the save helper above." + (dolist (target org-refile-targets) + (let ((file (car target))) + (when (stringp file) + (cj/org-refile-ensure-org-mode file))))) + (use-package org-refile :ensure nil ;; built-in :defer .5 @@ -193,20 +212,14 @@ ARG DEFAULT-BUFFER RFLOC and MSG parameters passed to org-refile." ("C-c C-w" . cj/org-refile) ("C-c w" . cj/org-refile-in-file)) :config - ;; save all open org buffers after a refile is complete - (advice-add 'org-refile :after - (lambda (&rest _) - (org-save-all-org-buffers))) - - ;; Ensure refile target buffers are in org-mode before processing - ;; Fixes issue where buffers opened before org loaded get stuck in fundamental-mode - (advice-add 'org-refile-get-targets :before - (lambda (&rest _) - "Ensure all refile target buffers are in org-mode." - (dolist (target org-refile-targets) - (let ((file (car target))) - (when (stringp file) - (cj/org-refile-ensure-org-mode file))))))) + ;; Install both advices by named-function reference with a remove-then-add + ;; guard. Anonymous lambdas here couldn't be `advice-remove'd (deleting the + ;; advice from source left a live daemon still running it) and couldn't be + ;; tested; the named helpers above are both. + (advice-remove 'org-refile #'cj/org-refile--save-all-buffers) + (advice-add 'org-refile :after #'cj/org-refile--save-all-buffers) + (advice-remove 'org-refile-get-targets #'cj/org-refile--ensure-targets-in-org-mode) + (advice-add 'org-refile-get-targets :before #'cj/org-refile--ensure-targets-in-org-mode)) (provide 'org-refile-config) ;;; org-refile-config.el ends here. diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index 867f2d99..e8d003e0 100644 --- a/modules/org-roam-config.el +++ b/modules/org-roam-config.el @@ -30,6 +30,10 @@ ;; Declared special so the `let'-binding in `cj/org-roam-copy-todo-to-today' ;; compiles as a dynamic bind, not a dead lexical local -- otherwise the custom ;; capture template never reaches org-roam-dailies (the foreign-special-var trap). +;; Declared special so cj/org-roam-node-insert-immediate's let-binding is +;; dynamic under lexical-binding; without it the byte-compiled let is a dead +;; lexical binding and :immediate-finish never reaches org-roam-node-insert. +(defvar org-roam-capture-templates) (defvar org-roam-dailies-capture-templates) ;; External variables, declared special so byte-compilation doesn't treat them diff --git a/modules/prog-c.el b/modules/prog-c.el index 728df018..29a341d5 100644 --- a/modules/prog-c.el +++ b/modules/prog-c.el @@ -8,8 +8,9 @@ ;; Load shape: eager. ;; Eager reason: none necessary; currently eager but should load by C major mode ;; (Phase 6 deferral candidate). -;; Top-level side effects: six add-hook, package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). +;; Top-level side effects: six add-hook, package configuration via use-package; +;; warns at load if clangd or clang-format is missing. +;; Runtime requires: system-lib. ;; Direct test load: yes. ;; ;; Modern C programming environment with LSP, tree-sitter, debugging, and formatting. @@ -59,6 +60,14 @@ (defvar clang-format-path "clang-format" "Path to clang-format executable.") +;; Warn at load time when a C tool is missing. The clang-format block +;; below gates on `:if (executable-find ...)', which evaluates once at +;; startup — an absent binary silently disables the format key until the +;; next restart, so this warn is the only visible trace. +(require 'system-lib) ; for cj/executable-find-or-warn +(cj/executable-find-or-warn clangd-path "clangd LSP" 'prog-c) +(cj/executable-find-or-warn clang-format-path "C formatting" 'prog-c) + ;; -------------------------------- C Mode Setup ------------------------------- ;; preferences for C programming following common conventions diff --git a/modules/prog-general.el b/modules/prog-general.el index 89771cbf..77ff88a5 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -39,6 +39,7 @@ ;;; Code: (require 'user-constants) ;; code-dir, projects-dir, snippets-dir +(require 'cl-lib) (defvar display-line-numbers-type) (defvar outline-minor-mode-map) @@ -57,6 +58,7 @@ (declare-function dired-get-filename "dired") (declare-function global-treesit-auto-mode "treesit-auto") (declare-function treesit-auto-add-to-auto-mode-alist "treesit-auto") +(declare-function treesit-auto-install-all "treesit-auto") (declare-function treesit-auto-recipe-lang "treesit-auto") (declare-function highlight-indent-guides-mode "highlight-indent-guides") (declare-function electric-pair-default-inhibit "elec-pair") @@ -120,19 +122,27 @@ REGEXP must be a string or an rx form." ;; build mid-edit. Batch/test runs never load treesit-auto (no package ;; init), so they can never install. Fresh-machine bootstrap is the ;; explicit `cj/install-treesit-grammars' command below. +(defun cj/treesit-auto-pin-go-revision (recipes) + "Pin the Go grammar revision in treesit-auto RECIPES. +Return the updated Go recipe, or nil when RECIPES has no Go entry. +Discover the `revision' slot at runtime because treesit-auto is not loaded +when this file's `use-package' form is macro-expanded." + (when-let ((go-recipe + (cl-find-if + (lambda (recipe) + (eq (treesit-auto-recipe-lang recipe) 'go)) + recipes))) + (aset go-recipe + (cl-struct-slot-offset 'treesit-auto-recipe 'revision) + "v0.19.1") + go-recipe)) + (use-package treesit-auto :custom (treesit-auto-install 'prompt) :config - (require 'cl-lib) ;; Pin Go grammar to v0.19.1 for compatibility with Emacs 30.2 font-lock queries - (let* ((go-idx (cl-position-if (lambda (recipe) - (eq (treesit-auto-recipe-lang recipe) 'go)) - treesit-auto-recipe-list)) - (go-recipe (and go-idx (nth go-idx treesit-auto-recipe-list)))) - (when go-recipe - ;; Directly modify the slot value using aset (struct fields are vectors internally) - (aset go-recipe 6 "v0.19.1"))) ; slot 6 is :revision + (cj/treesit-auto-pin-go-revision treesit-auto-recipe-list) (treesit-auto-add-to-auto-mode-alist 'all) (global-treesit-auto-mode)) diff --git a/modules/prog-go.el b/modules/prog-go.el index 7faf92a0..630b725c 100644 --- a/modules/prog-go.el +++ b/modules/prog-go.el @@ -8,8 +8,9 @@ ;; Load shape: eager. ;; Eager reason: none necessary; currently eager but should load by Go major ;; mode (Phase 6 deferral candidate). -;; Top-level side effects: package configuration via use-package (hooks via :hook). -;; Runtime requires: none (configures packages via use-package). +;; Top-level side effects: package configuration via use-package (hooks via +;; :hook); adds ~/go/bin to exec-path; warns at load if gopls is missing. +;; Runtime requires: system-lib. ;; Direct test load: yes. ;; ;; Configuration for Go programming using go-ts-mode (tree-sitter based). @@ -29,14 +30,25 @@ ;;; Code: +(require 'system-lib) ; for cj/executable-find-or-warn + (defvar go-bin-path (expand-file-name "~/go/bin") "Path to Go binaries directory. This is where tools like goimports and staticcheck are installed.") +;; Register the Go bin directory before the gopls check below: go tools +;; install there, so probing PATH without it would warn about a gopls +;; that is in fact present. +(add-to-list 'exec-path go-bin-path) + (defvar gopls-path "gopls" "Path to gopls (Go language server). Install with: go install golang.org/x/tools/gopls@latest") +;; Warn at load time if gopls is missing rather than waiting for the +;; first Go buffer to silently skip the LSP attach. +(cj/executable-find-or-warn gopls-path "gopls LSP" 'prog-go) + (defvar dlv-path "dlv" "Path to Delve debugger. Install with: go install github.com/go-delve/delve/cmd/dlv@latest") @@ -113,11 +125,14 @@ Overrides default prog-mode keybindings with Go-specific commands." ;; never ran. Autoload gofmt so the first format pulls go-mode and its :config. :commands (gofmt) :hook ((go-ts-mode . cj/go-setup) - (go-ts-mode . cj/go-mode-keybindings)) + (go-ts-mode . cj/go-mode-keybindings) + ;; Classic-mode fallback: same setup when the Go grammar is + ;; unavailable and the buffer lands in go-mode. + (go-mode . cj/go-setup) + (go-mode . cj/go-mode-keybindings)) :mode (("\\.go\\'" . go-ts-mode) ;; .go files use go-ts-mode ("go\\.mod\\'" . go-mod-ts-mode)) ;; go.mod uses go-mod-ts-mode :config - (add-to-list 'exec-path go-bin-path) ;; Use goimports for formatting (adds/removes imports automatically) (setq gofmt-command "goimports")) diff --git a/modules/prog-shell.el b/modules/prog-shell.el index 3ed51da1..7c0972f0 100644 --- a/modules/prog-shell.el +++ b/modules/prog-shell.el @@ -9,8 +9,9 @@ ;; Eager reason: none necessary; currently eager but should load by shell major ;; mode (Phase 6 deferral candidate). ;; Top-level side effects: five add-hook, including an after-save executable hook -;; the spec flags as needing opt-in/scoping; package config via use-package. -;; Runtime requires: none (configures packages via use-package). +;; the spec flags as needing opt-in/scoping; package config via use-package; +;; warns at load for missing shell tools. +;; Runtime requires: system-lib. ;; Direct test load: yes. ;; ;; Modern shell scripting environment with LSP, tree-sitter, linting, and formatting. @@ -65,6 +66,15 @@ Install with: sudo pacman -S shfmt") "Path to shellcheck executable. Install with: sudo pacman -S shellcheck") +;; Warn at load time when a shell tool is missing. The shfmt and +;; flycheck blocks below gate on `:if (executable-find ...)', which +;; evaluates once at startup — an absent tool silently disables that +;; setup until the next restart, so this warn is the only visible trace. +(require 'system-lib) ; for cj/executable-find-or-warn +(cj/executable-find-or-warn bash-language-server-path "bash LSP" 'prog-shell) +(cj/executable-find-or-warn shfmt-path "shell formatting" 'prog-shell) +(cj/executable-find-or-warn shellcheck-path "shell linting" 'prog-shell) + ;; ------------------------------- Shell Script Setup ------------------------------ ;; preferences for shell scripting diff --git a/modules/prog-webdev.el b/modules/prog-webdev.el index b228d0cc..f305c65d 100644 --- a/modules/prog-webdev.el +++ b/modules/prog-webdev.el @@ -18,6 +18,7 @@ ;; ;; Installation: ;; sudo pacman -S typescript-language-server typescript prettier +;; sudo pacman -S vscode-html-languageserver # LSP in web-mode buffers ;; ;; Features: ;; - Tree-sitter: Syntax highlighting for TS, TSX, JS (via treesit-auto) @@ -52,6 +53,10 @@ Install with: sudo pacman -S typescript-language-server") "Path to prettier executable. Install with: sudo pacman -S prettier") +(defvar html-language-server-path "vscode-html-language-server" + "Path to the HTML language server executable used in web-mode buffers. +Install with: sudo pacman -S vscode-html-languageserver") + ;; Warn at load time if prettier is missing rather than waiting for the ;; first format-on-save to fail mid-edit. (cj/executable-find-or-warn prettier-path "prettier formatter" 'prog-webdev) @@ -59,8 +64,8 @@ Install with: sudo pacman -S prettier") ;; ------------------------------ Web Dev Setup -------------------------------- ;; shared setup for TypeScript, JavaScript, and TSX modes -(defun cj/webdev-setup () - "Set up common preferences for web development buffers." +(defun cj/--webdev-prefs () + "Apply the shared buffer-local preferences for web development buffers." (company-mode) (flyspell-prog-mode) (superword-mode) @@ -68,13 +73,27 @@ Install with: sudo pacman -S prettier") (setq-local tab-width 2) (setq-local standard-indent 2) (setq-local indent-tabs-mode nil) - (electric-pair-local-mode t) + (electric-pair-local-mode t)) + +(defun cj/webdev-setup () + "Set up common preferences for TypeScript/JavaScript buffers." + (cj/--webdev-prefs) ;; Enable LSP if available (when (and (fboundp 'lsp-deferred) (executable-find ts-language-server-path)) (lsp-deferred))) +(defun cj/web-mode-setup () + "Set up preferences for web-mode (HTML template) buffers. +Same shared preferences as the TS/JS modes, but the LSP attach is +guarded on the HTML language server rather than the TypeScript one, so +machines without it stay silent instead of prompting." + (cj/--webdev-prefs) + (when (and (fboundp 'lsp-deferred) + (executable-find html-language-server-path)) + (lsp-deferred))) + (defun cj/--webdev-format-args (file) "Return the prettier argv list that formats FILE's contents on stdin. No shell quoting is needed: the args are passed to prettier directly @@ -121,6 +140,11 @@ Detects the file type automatically from the filename." ((js-ts-mode . cj/webdev-setup) (js-ts-mode . cj/webdev-keybindings))) +;; Classic-mode fallback: when the JS grammar is unavailable the buffer +;; lands in js-mode; give it the same setup as the tree-sitter modes. +(add-hook 'js-mode-hook #'cj/webdev-setup) +(add-hook 'js-mode-hook #'cj/webdev-keybindings) + ;; ----------------------------------- LSP ------------------------------------- ;; TypeScript/JavaScript LSP configuration ;; Core LSP setup is in prog-general.el @@ -145,7 +169,8 @@ Detects the file type automatically from the filename." (web-mode-code-indent-offset 2) (web-mode-engines-alist '(("django" . "\\.html\\'"))) :mode ("\\.html?$" . web-mode) - :hook (web-mode . cj/webdev-keybindings)) + :hook ((web-mode . cj/web-mode-setup) + (web-mode . cj/webdev-keybindings))) (provide 'prog-webdev) ;;; prog-webdev.el ends here. diff --git a/modules/restclient-config.el b/modules/restclient-config.el index 0511eddb..497f54d0 100644 --- a/modules/restclient-config.el +++ b/modules/restclient-config.el @@ -8,7 +8,7 @@ ;; Load shape: eager. ;; Eager reason: none; API exploration, a command-loaded deferral candidate. ;; Top-level side effects: package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). +;; Runtime requires: keybindings (C-; R prefix registration). ;; Direct test load: yes. ;; ;; Integrates restclient.el for interactive API exploration from within Emacs. @@ -23,6 +23,8 @@ ;;; Code: +(require 'keybindings) ;; cj/register-prefix-map + ;; --------------------------------- Constants --------------------------------- (defvar cj/restclient-data-dir (expand-file-name "data/" user-emacs-directory) @@ -61,12 +63,15 @@ ;; -------------------------------- Keybindings -------------------------------- -(global-set-key (kbd "C-; R n") #'cj/restclient-new-buffer) -(global-set-key (kbd "C-; R o") #'cj/restclient-open-file) +(defvar-keymap cj/restclient-map + :doc "Keymap for restclient operations" + "n" #'cj/restclient-new-buffer + "o" #'cj/restclient-open-file) + +(cj/register-prefix-map "R" cj/restclient-map "REST client") (with-eval-after-load 'which-key (which-key-add-key-based-replacements - "C-; R" "REST client" "C-; R n" "new scratch buffer" "C-; R o" "open .rest file")) diff --git a/modules/selection-framework.el b/modules/selection-framework.el index 8e3ee252..47fbf7c7 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -225,7 +225,7 @@ ("C-p" . company-select-previous)) :custom (company-backends '(company-capf company-files company-keywords)) - (company-idle-delay 2) + (company-idle-delay 4) (company-minimum-prefix-length 2) (company-show-numbers t) (company-tooltip-align-annotations t) diff --git a/modules/slack-config.el b/modules/slack-config.el index 9eb9f838..e0ad5b75 100644 --- a/modules/slack-config.el +++ b/modules/slack-config.el @@ -197,7 +197,10 @@ so the Slack buffer stays usable." "Add a reaction to the current Slack message using a curated shortlist. Errors if called outside a Slack message buffer." (interactive) - (let ((buf (or slack-current-buffer + ;; boundp guard: the defvar above declares the var with no value, so it is + ;; void until slack.el loads -- a bare read on a cold call would signal + ;; void-variable instead of this friendly error. + (let ((buf (or (and (boundp 'slack-current-buffer) slack-current-buffer) (user-error "Not in a Slack buffer")))) (when-let* ((team (slack-buffer-team buf)) (reaction (cj/slack-select-reaction team))) diff --git a/modules/system-commands.el b/modules/system-commands.el index de5e8853..edc6339d 100644 --- a/modules/system-commands.el +++ b/modules/system-commands.el @@ -115,8 +115,21 @@ actions like shutdown and reboot), nil for no confirmation." ;; directly: logind emits the Lock signal, hypridle catches it and runs its ;; lock_cmd (hyprlock), the same path idle/before-sleep locking already uses. ;; X11 machines keep slock. -(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd - (if (env-wayland-p) "loginctl lock-session" "slock")) +;; +;; Unlike its siblings, the locker is resolved at COMMAND time, not baked into +;; the defvar at load: a daemon started before WAYLAND_DISPLAY reaches its +;; environment would freeze the locker to slock forever, and Lock would then +;; fail silently on Wayland. `lockscreen-cmd' stays as an override knob. +(defvar lockscreen-cmd nil + "Explicit lock command, overriding session-type resolution when non-nil.") + +(defun cj/system-cmd-lock () + "Lock the session, resolving the locker from the live session type. +Runs `lockscreen-cmd' when set; otherwise `loginctl lock-session' on +Wayland and slock on X11, decided per call via `env-wayland-p'." + (interactive) + (cj/system-cmd (or lockscreen-cmd + (if (env-wayland-p) "loginctl lock-session" "slock")))) (cj/defsystem-command cj/system-cmd-suspend suspend-cmd "systemctl suspend" t) (cj/defsystem-command cj/system-cmd-shutdown shutdown-cmd "systemctl poweroff" strong) (cj/defsystem-command cj/system-cmd-reboot reboot-cmd "systemctl reboot" strong) diff --git a/modules/system-defaults.el b/modules/system-defaults.el index 7f369a5e..9b4652e8 100644 --- a/modules/system-defaults.el +++ b/modules/system-defaults.el @@ -55,6 +55,10 @@ (expand-file-name "comp-warnings.log" user-emacs-directory) "File where native-comp warnings will be appended.") +(defvar cj/comp-warnings-log-max-bytes (* 512 1024) + "Cap on `comp-warnings-log' size. Once it exceeds this, the log is reset +before the next write, so native-comp warnings can't grow it without bound.") + (defun cj/log-comp-warning (type message &rest args) "Log native-comp warnings of TYPE with MESSAGE & ARGS. Log to buffer `comp-warnings-log'. Suppress warnings from appearing in the @@ -62,13 +66,24 @@ Log to buffer `comp-warnings-log'. Suppress warnings from appearing in the timestamp to the file specified by `comp-warnings-log'. Return non-nil to indicate the warning was handled." (when (memq 'comp (if (listp type) type (list type))) - (with-temp-buffer - (insert (format-time-string "[%Y-%m-%d %H:%M:%S] ")) - (insert (if (stringp message) - (apply #'format message args) - (format "%S %S" message args))) - (insert "\n") - (append-to-file (point-min) (point-max) comp-warnings-log)) + ;; Reset the log if it has grown past the cap, so async comp warnings can't + ;; grow it without bound. + (when (ignore-errors + (> (or (file-attribute-size (file-attributes comp-warnings-log)) 0) + cj/comp-warnings-log-max-bytes)) + (ignore-errors (delete-file comp-warnings-log))) + ;; Guard the write: this runs as `:before-until' advice on `display-warning', + ;; so a signal here (an unwritable log path) would propagate out and break + ;; warning display for every async comp notice. Swallow the failure; the + ;; warning stays suppressed either way. + (ignore-errors + (with-temp-buffer + (insert (format-time-string "[%Y-%m-%d %H:%M:%S] ")) + (insert (if (stringp message) + (apply #'format message args) + (format "%S %S" message args))) + (insert "\n") + (append-to-file (point-min) (point-max) comp-warnings-log))) ;; Return non-nil to tell `display-warning' “we handled it.” t)) diff --git a/modules/system-lib.el b/modules/system-lib.el index f1049c02..54e20b74 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -164,6 +164,22 @@ contributes its own modes regardless of load order." (setq font-lock-global-modes (cj/--font-lock-global-modes-excluding font-lock-global-modes mode)))) +;; Declared special here for the compiler; marginalia owns the defvar. +(defvar marginalia-annotator-registry) + +(defun cj/completion-ensure-marginalia-align (category) + "Register CATEGORY with marginalia as builtin-annotated, once. +A custom completion category bypasses marginalia entirely, so the table's +own annotation function renders unaligned even with `marginalia-align' +set. A builtin registry entry tells marginalia to use the table's +annotation function inside its aligned field, so custom annotations line +up like every stock category. A category that already has an entry is +left alone (someone chose its annotators deliberately). Silent no-op +when marginalia isn't loaded." + (when (and (boundp 'marginalia-annotator-registry) + (not (assq category marginalia-annotator-registry))) + (push (list category 'builtin 'none) marginalia-annotator-registry))) + (defun cj/completion-table (category collection) "Return a completion table over COLLECTION tagged with completion CATEGORY. COLLECTION is anything `completing-read' accepts (list, alist, obarray, hash @@ -180,7 +196,9 @@ the candidates match one; marginalia then annotates them with no further work." "Like `cj/completion-table' but also attach ANNOTATE as the annotation function. ANNOTATE is called with a candidate string and returns its annotation suffix, or nil. Use this for a custom CATEGORY that marginalia has no built-in annotator -for: marginalia falls back to the table's own annotation function." +for; the category is registered with marginalia (builtin) so ANNOTATE's output +renders right-aligned like stock annotations." + (cj/completion-ensure-marginalia-align category) (lambda (string predicate action) (if (eq action 'metadata) `(metadata (category . ,category) diff --git a/modules/test-runner.el b/modules/test-runner.el index 7f157f1c..6cb35275 100644 --- a/modules/test-runner.el +++ b/modules/test-runner.el @@ -139,9 +139,11 @@ if not found or not in a project." (t cj/test-global-directory)))))) (defun cj/test--get-test-files () - "Return list of test file names (without path) in test directory." + "Return list of test file names (without path) in test directory. +Returns nil when no test directory is available (outside a project +with `cj/test-global-directory' unset)." (let ((dir (cj/test--get-test-directory))) - (when (file-directory-p dir) + (when (and dir (file-directory-p dir)) (mapcar #'file-name-nondirectory (directory-files dir t "^test-.*\\.el$"))))) @@ -169,6 +171,8 @@ Returns: (cons \\='success loaded-count) on success, (interactive) (cj/test--ensure-test-dir-in-load-path) (let ((dir (cj/test--get-test-directory))) + (unless dir + (user-error "No test directory: not in a project and cj/test-global-directory is unset")) (unless (file-directory-p dir) (user-error "Test directory %s does not exist" dir)) (let ((test-files (directory-files dir t "^test-.*\\.el$"))) @@ -200,11 +204,12 @@ Returns: \\='success if added successfully, (cj/test--ensure-test-dir-in-load-path) (let* ((focused-files (cj/test--current-focused-files)) (dir (cj/test--get-test-directory)) - (available-files (when (file-directory-p dir) + (available-files (when (and dir (file-directory-p dir)) (mapcar #'file-name-nondirectory (directory-files dir t "^test-.*\\.el$"))))) (if (null available-files) - (user-error "No test files found in %s" dir) + (user-error "No test files found in %s" + (or dir "any test directory (not in a project)")) (let* ((unfocused-files (cl-set-difference available-files focused-files :test #'string=)) diff --git a/modules/tramp-config.el b/modules/tramp-config.el index f2bc8457..1c8a8ab9 100644 --- a/modules/tramp-config.el +++ b/modules/tramp-config.el @@ -26,6 +26,7 @@ ;; Silence byte-compiler "assignment to free variable" warnings for vars ;; defined by lazily-loaded packages (tramp, dirtrack, magit). These are ;; only set inside the use-package :config block, after the package loads. +(defvar ange-ftp-try-passive-mode) (defvar tramp-copy-size-limit) (defvar tramp-use-ssh-controlmaster-options) (defvar tramp-cleanup-idle-time) @@ -76,9 +77,10 @@ ;; Cache remote file attributes for better performance (setq remote-file-name-inhibit-cache nil) - ;; Don't check for modified buffers before revert - ;; to avoid unnecessary remote operations - (setq revert-without-query '(".*")) + ;; Skip the revert confirmation for remote files only, to avoid + ;; unnecessary remote round-trips. Scoped to the TRAMP path regexp so + ;; local files keep their normal revert prompt. + (setq revert-without-query (list tramp-file-name-regexp)) ;; Refresh buffers when needed rather than automatically (setq auto-revert-remote-files nil) @@ -119,21 +121,8 @@ ;; Default transfer method (use scp for most efficient transfer) (setq tramp-default-method "scp") - ;; Use different methods based on host/domain patterns - (add-to-list 'tramp-methods - '("sshfast" - (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") - ("-e" "none") ("-t" "-t") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-connection-timeout 10))) - ;; Remote shell and project settings - ;; Support for Docker containers - (add-to-list 'tramp-remote-path 'tramp-own-remote-path) + ;; Extend the remote PATH (tramp-own-remote-path already added above) (add-to-list 'tramp-remote-path "/usr/local/bin") (add-to-list 'tramp-remote-path "/usr/local/sbin") @@ -147,5 +136,11 @@ ;; Cleanup TRAMP buffers when idle (every 15 min) (setq tramp-cleanup-idle-time 900)) +;; FTP (ange-ftp) settings — TRAMP's /ftp: method delegates to ange-ftp. +;; Passive mode is required for servers that can't open a data connection +;; back to this machine (NAT, phone FTP servers); active mode hangs on LIST. +(with-eval-after-load 'ange-ftp + (setq ange-ftp-try-passive-mode t)) + (provide 'tramp-config) ;;; tramp-config.el ends here diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el index 21a04de9..e5b8dc00 100644 --- a/modules/undead-buffers.el +++ b/modules/undead-buffers.el @@ -96,7 +96,10 @@ Undead-buffers are buffers in `cj/undead-buffer-list'." (let ((buf (current-buffer))) (unless (one-window-p) (delete-window)) - (cj/kill-buffer-or-bury-alive buf))) + ;; The delegate reads current-prefix-arg; a C-u meant for this wrapper + ;; must not flip it into add-to-undead-list mode. + (let ((current-prefix-arg nil)) + (cj/kill-buffer-or-bury-alive buf)))) ;; Keybinding moved to custom-buffer-file.el (C-; b k) (defun cj/kill-other-window () @@ -109,7 +112,8 @@ window and acting would kill the buffer being viewed." (other-window 1) (let ((buf (current-buffer))) (delete-window) - (cj/kill-buffer-or-bury-alive buf))) + (let ((current-prefix-arg nil)) + (cj/kill-buffer-or-bury-alive buf)))) (keymap-global-set "M-S-o" #'cj/kill-other-window) (defun cj/kill-other-window-buffer () @@ -123,7 +127,8 @@ split is preserved. Buffers in `cj/undead-buffer-list' are buried." (if (one-window-p) (user-error "No other window") (with-selected-window (next-window) - (cj/kill-buffer-or-bury-alive (current-buffer))))) + (let ((current-prefix-arg nil)) + (cj/kill-buffer-or-bury-alive (current-buffer)))))) ;; Keybinding in custom-buffer-file.el (C-; b K) (defun cj/kill-all-other-buffers-and-windows () @@ -131,8 +136,9 @@ split is preserved. Buffers in `cj/undead-buffer-list' are buried." (interactive) (save-some-buffers nil #'cj/undead-buffer-p) (delete-other-windows) - (mapc #'cj/kill-buffer-or-bury-alive - (delq (current-buffer) (buffer-list)))) + (let ((current-prefix-arg nil)) + (mapc #'cj/kill-buffer-or-bury-alive + (delq (current-buffer) (buffer-list))))) (keymap-global-set "M-S-m" #'cj/kill-all-other-buffers-and-windows) ;; was M-M (provide 'undead-buffers) diff --git a/modules/vc-config.el b/modules/vc-config.el index 60fcaeb8..3da9266f 100644 --- a/modules/vc-config.el +++ b/modules/vc-config.el @@ -37,9 +37,13 @@ (defvar forge-pull-notifications) (defvar forge-topic-list-limit) +;; External package variables (buffer-local hunk list from git-gutter). +(defvar git-gutter:diffinfos) + ;; External package functions (from lazily-loaded packages). (declare-function git-gutter:next-hunk "git-gutter") (declare-function git-gutter:previous-hunk "git-gutter") +(declare-function git-gutter-hunk-start-line "git-gutter") (declare-function git-timemachine--start "git-timemachine") (declare-function git-timemachine--revisions "git-timemachine") (declare-function git-timemachine-show-revision "git-timemachine") @@ -100,8 +104,7 @@ (use-package git-timemachine :commands (git-timemachine - git-timemachine-show-revision - git-timemachine-show-selected-revision) + git-timemachine-show-revision) :init (defun cj/git-timemachine-show-selected-revision () "Displays git revisions of file in chronological order adding metadata." @@ -157,13 +160,33 @@ (forge-create-issue) (user-error "Not in a forge repository"))) +(defun cj/--git-gutter-hunk-candidates (start-lines) + "Build completion candidates for hunk START-LINES in the current buffer. +Each candidate is a cons of a \"LINE: text\" label and the line number." + (mapcar (lambda (line) + (cons (format "%4d: %s" line + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + line)) + start-lines)) + (defun cj/goto-git-gutter-diff-hunks () - "Jump to git-gutter diff hunks using consult. -Searches for lines starting with + or - (diff markers) and allows -interactive selection to jump to any changed line in the buffer." + "Jump to a git-gutter hunk in the current buffer chosen with completion." (interactive) (require 'git-gutter) - (consult-line "^[+\\-]")) + (let ((candidates (cj/--git-gutter-hunk-candidates + (mapcar #'git-gutter-hunk-start-line + (and (boundp 'git-gutter:diffinfos) + git-gutter:diffinfos))))) + (unless candidates + (user-error "No git-gutter hunks in this buffer")) + (let ((line (cdr (assoc (completing-read "Hunk: " candidates nil t) + candidates)))) + (goto-char (point-min)) + (forward-line (1- line))))) ;; ------------------------------ Git Clone Clipboard ----------------------------- ;; Quick git clone from clipboard URL @@ -180,6 +203,33 @@ scp form." (last (car (last (split-string trimmed "[/:]" t))))) (and last (file-name-sans-extension last)))) +(defun cj/--git-clone-open (clone-dir) + "Open CLONE-DIR's README when one exists, else `dired' the directory." + (let ((readme (seq-find + (lambda (file) + (string-match-p "\\`README" (upcase file))) + (directory-files clone-dir)))) + (if readme + (find-file (expand-file-name readme clone-dir)) + (dired clone-dir)))) + +(defun cj/--git-clone-make-sentinel (url clone-dir) + "Return a sentinel reporting the git clone of URL into CLONE-DIR. +On a zero exit the sentinel announces success and opens the clone; on +any other exit or a signal it surfaces the process buffer." + (lambda (process _event) + (when (memq (process-status process) '(exit signal)) + (if (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + (progn + (message "Cloned %s into %s" url clone-dir) + (cj/--git-clone-open clone-dir)) + (let ((buf (process-buffer process))) + (when (buffer-live-p buf) + (pop-to-buffer buf)) + (message "git clone of %s failed (status %s)" + url (process-exit-status process))))))) + (defun cj/git-clone-clipboard-url (url target-dir) "Clone git repository from clipboard URL to TARGET-DIR. @@ -187,11 +237,13 @@ With no prefix argument: uses first directory in `cj/git-clone-dirs'. With \\[universal-argument]: choose from `cj/git-clone-dirs'. With \\[universal-argument] \\[universal-argument]: choose any directory. -Clones with a direct `git' process (no shell), into a path derived -robustly from URL. Aborts with a clear message when the clipboard is -empty, the target is not a writable directory, the destination already -exists, or `git' exits non-zero. After a successful clone, opens the -repository's README if found, else `dired's the clone." +Clones with a direct asynchronous `git' process (no shell, no frozen +frames), into a path derived robustly from URL. Aborts with a clear +message when the clipboard is empty, the target is not a writable +directory, or the destination already exists. The process sentinel +reports the result: on success it opens the repository's README if +found (else `dired's the clone); on failure it surfaces the process +buffer." (interactive (list (current-kill 0) ;; Get URL from clipboard (cond @@ -219,21 +271,14 @@ repository's README if found, else `dired's the clone." (when (file-exists-p clone-dir) (user-error "Clone destination already exists: %s" clone-dir)) (message "Cloning %s into %s..." url clone-dir) - ;; Direct process, no shell. `--' stops option parsing so a URL - ;; beginning with `-' can't be read as a git flag. - (let ((status (call-process "git" nil "*git-clone*" nil - "clone" "--" url clone-dir))) - (unless (zerop status) - (pop-to-buffer "*git-clone*") - (user-error "git clone failed (exit %d); see *git-clone*" status))) - ;; Find and open README - (let ((readme (seq-find - (lambda (file) - (string-match-p "\\`README" (upcase file))) - (directory-files clone-dir)))) - (if readme - (find-file (expand-file-name readme clone-dir)) - (dired clone-dir)))))) + ;; Direct async process, no shell, so no emacsclient frame blocks + ;; for the duration of the clone. `--' stops option parsing so a + ;; URL beginning with `-' can't be read as a git flag. + (make-process + :name "git-clone" + :buffer "*git-clone*" + :command (list "git" "clone" "--" url clone-dir) + :sentinel (cj/--git-clone-make-sentinel url clone-dir))))) ;; -------------------------------- Difftastic --------------------------------- ;; Structural diffs for better git change visualization @@ -243,7 +288,7 @@ repository's README if found, else `dired's the clone." :defer t :commands (difftastic-magit-diff difftastic-magit-show) :bind (:map magit-blame-read-only-mode-map - ("D" . difftastic-magit-show) + ("D" . difftastic-magit-diff) ("S" . difftastic-magit-show)) :config (eval-after-load 'magit-diff diff --git a/modules/video-audio-recording-capture.el b/modules/video-audio-recording-capture.el index 41b72ebd..a56a5906 100644 --- a/modules/video-audio-recording-capture.el +++ b/modules/video-audio-recording-capture.el @@ -56,6 +56,10 @@ Checks if process is actually alive, not just if variable is set." ;;; Process Lifecycle (Sentinel and Graceful Shutdown) +;; Forward declaration: the real `defvar' is defined below with the other +;; recording thresholds. Declared special here so this reference compiles clean. +(defvar cj/recording-start-fail-threshold) + (defun cj/recording-process-sentinel (process event) "Sentinel for recording processes — handles unexpected exits. PROCESS is the ffmpeg shell process, EVENT describes what happened. @@ -76,9 +80,13 @@ is killed externally." (cj/recording--start-failed-p (- (float-time) start) cj/recording-start-fail-threshold)) ;; Died almost immediately and the user didn't stop it: wf-recorder - ;; couldn't grab the screen. Say so instead of silently clearing, - ;; so Craig isn't left blind-retrying (which bursts fragment files). - (message "Video recording failed to start (wf-recorder couldn't grab the screen). Try again.") + ;; couldn't grab the screen. Delete the ~0.5s stub file the failed + ;; start wrote (it would otherwise litter the recordings directory + ;; and get swept up by *.mkv globs downstream), then say so instead + ;; of silently clearing, so Craig isn't left blind-retrying. + (progn + (cj/recording--delete-failed-start-stub process) + (message "Video recording failed to start (wf-recorder couldn't grab the screen). Try again.")) (message "Video recording stopped: %s" (string-trim event)))))) (force-mode-line-update t))) @@ -129,13 +137,21 @@ launching too soon loses the grab and produces a ~0.5s fragment file." A failed wf-recorder start exits almost immediately; a real recording does not." (< elapsed threshold)) +(defun cj/recording--delete-failed-start-stub (process) + "Delete the stub output file a failed video start left behind. +Reads the output path from PROCESS's `cj-output-file' property (stamped +by `cj/ffmpeg-record-video'). A no-op when the property is absent (a +process started before the property existed) or the file never hit disk." + (let ((file (process-get process 'cj-output-file))) + (when (and file (file-exists-p file)) + (delete-file file)))) + ;;; Dependency Checks (defun cj/recording-check-ffmpeg () "Check if ffmpeg is available. Error if not found." (unless (executable-find "ffmpeg") - (user-error "Ffmpeg not found. Install with: sudo pacman -S ffmpeg") - nil) + (user-error "Ffmpeg not found. Install with: sudo pacman -S ffmpeg")) t) (defun cj/recording--wayland-p () @@ -146,8 +162,7 @@ A failed wf-recorder start exits almost immediately; a real recording does not." "Check if wf-recorder is available (needed for Wayland video capture)." (if (executable-find "wf-recorder") t - (user-error "wf-recorder not found. Install with: sudo pacman -S wf-recorder") - nil)) + (user-error "wf-recorder not found. Install with: sudo pacman -S wf-recorder"))) ;;; Device Acquisition and Validation @@ -332,8 +347,10 @@ Uses wf-recorder on Wayland, x11grab on X11." (set-process-query-on-exit-flag cj/video-recording-ffmpeg-process nil) (set-process-sentinel cj/video-recording-ffmpeg-process #'cj/recording-process-sentinel) ;; Stamp the start time so the sentinel can tell a ~0.5s failed start - ;; (wf-recorder couldn't grab the screen) from a normal recording. + ;; (wf-recorder couldn't grab the screen) from a normal recording, and + ;; the output path so the failed-start branch can delete the stub file. (process-put cj/video-recording-ffmpeg-process 'cj-start-time (float-time)) + (process-put cj/video-recording-ffmpeg-process 'cj-output-file filename) (force-mode-line-update t) (message "Started video recording to %s (%s, mic: %.1fx, system: %.1fx)." filename diff --git a/modules/video-audio-recording-devices.el b/modules/video-audio-recording-devices.el index 375a81cf..8adcd347 100644 --- a/modules/video-audio-recording-devices.el +++ b/modules/video-audio-recording-devices.el @@ -272,54 +272,6 @@ Returns the selected device name, or signals user-error if cancelled." (user-error "Device setup cancelled")) device)) -(defun cj/recording-group-devices-by-hardware () - "Group audio sources by physical hardware device. -Returns alist of (friendly-name . (mic-source . monitor-source)). -Only includes devices that have BOTH a mic and a monitor source, -since recording needs both to capture your voice and system audio." - (let ((sources (cj/recording-parse-sources)) - (devices (make-hash-table :test 'equal)) - (result nil)) - ;; Group sources by base device name (hardware identifier) - (dolist (source sources) - (let* ((device (nth 0 source)) - ;; Extract hardware ID — the unique part identifying the physical device. - ;; Different device types use different naming conventions in PulseAudio. - (base-name (cond - ;; USB devices: extract usb-XXXXX-XX part - ((string-match "\\.\\(usb-[^.]+\\-[0-9]+\\)\\." device) - (match-string 1 device)) - ;; Built-in (PCI) devices: extract pci-XXXXX part - ((string-match "\\.\\(pci-[^.]+\\)\\." device) - (match-string 1 device)) - ;; Bluetooth devices: extract and normalize MAC address - ;; (input uses colons, output uses underscores) - ((string-match "bluez_\\(?:input\\|output\\)\\.\\([^.]+\\)" device) - (replace-regexp-in-string "_" ":" (match-string 1 device))) - (t device))) - (is-monitor (string-match-p "\\.monitor$" device)) - (device-entry (gethash base-name devices))) - (unless device-entry - (setf device-entry (cons nil nil)) - (puthash base-name device-entry devices)) - (if is-monitor - (setcdr device-entry device) - (setcar device-entry device)))) - - ;; Convert hash table to alist with user-friendly names - (maphash (lambda (base-name pair) - (when (and (car pair) (cdr pair)) - (let ((friendly-name - (cond - ((string-match-p "usb.*[Jj]abra" base-name) "Jabra SPEAK 510 USB") - ((string-match-p "^usb-" base-name) "USB Audio Device") - ((string-match-p "^pci-" base-name) "Built-in Audio") - ((string-match-p "^[0-9A-Fa-f:]+$" base-name) "Bluetooth Headset") - (t base-name)))) - (push (cons friendly-name pair) result)))) - devices) - (nreverse result))) - (defun cj/recording-select-device (prompt device-type) "Interactively select an audio device. PROMPT is shown to user. DEVICE-TYPE is \\='mic or \\='monitor for filtering. diff --git a/modules/wrap-up.el b/modules/wrap-up.el index e28ba845..6901901f 100644 --- a/modules/wrap-up.el +++ b/modules/wrap-up.el @@ -23,12 +23,12 @@ "Bury comint and compilation buffers." (dolist (buf (buffer-list)) (with-current-buffer buf + ;; Byte-compilation output arrives in `emacs-lisp-compilation-mode', + ;; which derives from `compilation-mode' and so is covered by that clause. (when (or (derived-mode-p 'comint-mode) (derived-mode-p 'compilation-mode) (derived-mode-p 'debugger-mode) - (derived-mode-p 'elisp-compile-mode) - (derived-mode-p 'messages-buffer-mode) - ) ;; byte-compilations + (derived-mode-p 'messages-buffer-mode)) (bury-buffer))))) (defun cj/bury-buffers-after-delay () |