diff options
Diffstat (limited to 'modules')
93 files changed, 4701 insertions, 4243 deletions
diff --git a/modules/ai-term.el b/modules/ai-term.el index b463da90b..6dfb669a9 100644 --- a/modules/ai-term.el +++ b/modules/ai-term.el @@ -1,4 +1,4 @@ -;;; ai-term.el --- In-Emacs AI-agent launcher with vertical-split terminal -*- lexical-binding: t; -*- +;;; ai-term.el --- AI-agent terminals backed by EAT and tmux -*- lexical-binding: t; -*- ;; Author: Craig Jennings <c@cjennings.net> @@ -7,70 +7,18 @@ ;; Layer: 3 (Domain Workflow). ;; Category: D. ;; Load shape: eager. -;; Eager reason: registers four global keys for the AI-agent terminal launcher; a -;; command-loaded deferral candidate. -;; Top-level side effects: four global key bindings. -;; Runtime requires: cl-lib, seq, cj-window-geometry-lib, cj-window-toggle-lib, -;; host-environment. +;; Eager reason: binds M-SPC and the C-; a AI-agent prefix. +;; Top-level side effects: global M-SPC binding and C-; a prefix map. +;; Runtime requires: cl-lib, seq, window-toggle/geometry helpers, host-environment. ;; Direct test load: yes. ;; -;; Picks an AI-agent project (a dir under ~/.emacs.d, ~/code/*, or -;; ~/projects/* containing .ai/protocols.org), opens or reuses a terminal -;; buffer named "agent [<basename>]", sends the agent's startup -;; instruction to it, and routes the buffer to a side window via -;; display-buffer-alist. When the frame already has a window forming the -;; half the agent would occupy (a right column on a desktop, a bottom row -;; on a laptop), the agent reuses that slot rather than splitting a third -;; window in; toggling off restores the displaced buffer to the slot. -;; Otherwise placement is a host-aware split: a right-side split at 50% -;; width on a desktop, a bottom split at 75% height on a laptop (see -;; `cj/--ai-term-default-direction'). Multiple -;; projects produce multiple coexisting buffers that share the same -;; slot; switching among them is a buffer-switch, not a -;; kill-and-recreate. +;; Opens project-scoped AI agents in EAT buffers backed by tmux sessions. Project +;; candidates come from configured roots that contain .ai/protocols.org. ;; -;; Each project's agent runs inside a tmux session named -;; "<cj/ai-term-tmux-session-prefix><basename>" (default prefix "aiv-"). -;; The prefix lets `tmux ls' be filtered to AI-term's own sessions, so -;; after an Emacs crash the project picker can match surviving sessions -;; back to their directories: matched projects sort to the top of the -;; picker (flagged "[detached]" -- session alive, no Emacs buffer -- or -;; "[running]" when a live terminal buffer exists), the rest follow in -;; alphabetical order. -;; -;; Four F-key entry points: -;; -;; - F9 `cj/ai-term' -- DWIM dispatch. If an agent buffer is -;; currently displayed in this frame, F9 toggles it off: when it -;; took over an existing window (a reused slot) the buffer it -;; displaced returns to that slot, when it was split into its own -;; window that window is removed, and when it fills the frame it -;; is buried. Otherwise, if exactly one agent buffer is alive, -;; F9 re-displays it; if zero or two-plus are alive, F9 falls -;; through to the project picker. -;; - C-F9 `cj/ai-term-pick-project' -- always show the project -;; picker, even when an agent buffer is currently displayed. -;; Used when the user wants to start a new project session -;; instead of toggling the current one. -;; - s-F9 `cj/ai-term-next' -- step to the next active agent in the -;; queue. The queue is every active agent in buffer-name order -;; (a stable rotation): attached agents (a live buffer) and -;; detached ones (a live tmux session with no Emacs buffer). -;; Stepping onto a detached agent attaches it. When an agent -;; window is on screen, swap it to the next agent and focus it, -;; wrapping after the last; when none is shown but agents exist, -;; show the first. This is the "switch among existing agents" -;; surface F9 deliberately doesn't provide. -;; - M-F9 `cj/ai-term-close' -- gracefully close an agent: kill its -;; tmux session (stopping the agent process), then its terminal -;; buffer. Its window stays in the layout (swapped to the -;; working buffer), so closing never collapses a split. Confirms -;; first. Targets the current agent, the sole live agent, or -;; prompts among several. -;; -;; Existing windmove (Shift-arrows) handles code <-> agent focus -;; toggling. Buffer-move (C-M-arrows) handles side-swap. Neither -;; needs anything new from this module. +;; Agent display reuses the host-appropriate side slot when possible, otherwise +;; splits right on desktop frames and below on laptop frames. Attached buffers +;; and detached tmux sessions share the same rotation; selecting a detached +;; agent recreates its EAT buffer and attaches to the live session. ;;; Code: @@ -81,16 +29,13 @@ (require 'host-environment) (require 'keybindings) ;; provides cj/register-prefix-map (C-; a) -(declare-function ghostel "ghostel" (&optional arg)) -(declare-function ghostel-send-string "ghostel" (string)) -(declare-function ghostel--rebuild-semi-char-keymap "ghostel" ()) -(defvar ghostel-keymap-exceptions) -(defvar ghostel-mode-map) -(defvar ghostel-buffer-name) -(defvar ghostel-buffer-name-function) +(declare-function eat "eat" (&optional program arg)) +(declare-function cj/make-buffer-pattern-undead "undead-buffers") +(defvar eat-buffer-name) +(defvar eat-semi-char-mode-map) (defgroup ai-term nil - "In-Emacs AI-agent launcher with a vertical-split ghostel terminal." + "In-Emacs AI-agent launcher with a vertical-split EAT terminal." :group 'tools) (defcustom cj/ai-term-agent-command @@ -102,15 +47,6 @@ agent you run (aider, an open-source LLM TUI, etc.)." :type 'string :group 'ai-term) -(defvar cj/--ai-term-suppress-tmux nil - "When non-nil, the generic ghostel tmux-launch hook skips its auto-tmux step. - -ai-term dynamically binds this around `(ghostel)' so the hook in -term-config.el doesn't send a bare \"tmux\\n\" before the named -session launch command runs. The hook reads the variable via -`bound-and-true-p' so loading order between the two modules doesn't -matter.") - (defcustom cj/ai-term-project-roots (list (expand-file-name "~/.emacs.d")) "Directories that are themselves AI-agent projects. @@ -228,7 +164,7 @@ which the step materializes by attaching." Walks `buffer-list' (most-recently-selected first) and returns the first buffer that is not an AI-term agent buffer (per `cj/--ai-term-buffer-p') and is not an internal buffer (name starting -with a space). Used by the single-window F9 toggle-off so dismissing a +with a space). Used by the single-window toggle-off so dismissing a full-frame agent returns to the file the user was working in (e.g. todo.org) rather than swapping in another agent." (seq-find (lambda (b) @@ -300,7 +236,7 @@ looked up in SESSIONS, so the lossy whitespace->hyphen transform in (defun cj/--ai-term-launch-command (dir) "Return the shell command line that runs the AI tool in a project tmux session. -Uses `tmux new-session -A' so a second F9 on the same project reattaches +Uses `tmux new-session -A' so a second toggle on the same project reattaches to the running session instead of spawning a new one. The session name comes from `cj/--ai-term-tmux-session-name'; the first window is named `cj/ai-term-tmux-window-name' (default \"ai\") so a later hand-opened @@ -465,7 +401,7 @@ direction applies. Captured at toggle-off by `cj/--ai-term-display-saved'.") (defvar cj/--ai-term-last-was-bury nil - "Non-nil when the last F9 toggle-off used `bury-buffer'. + "Non-nil when the last toggle-off used `bury-buffer'. Set by `cj/ai-term' in its `toggle-off' branch: t when the agent window was the only window in the frame (so toggle-off buried @@ -475,7 +411,7 @@ buried agent in the current window (the only one) or splitting per the saved direction.") (defvar cj/--ai-term-last-toggle-deleted-split nil - "Non-nil when the last F9 toggle-off deleted the agent's own split window. + "Non-nil when the last toggle-off deleted the agent's own split window. Set t by `cj/--ai-term-toggle-off' only when it actually `delete-window's the agent (a multi-window layout where the agent had its own window); @@ -487,7 +423,7 @@ working window at the edge, displacing its buffer and collapsing the layout -- the toggle must be reversible (off then on returns the same windows).") (defvar cj/--ai-term-last-hidden-buffer nil - "The agent buffer hidden by the most recent F9 toggle-off. + "The agent buffer hidden by the most recent toggle-off. Captured in `cj/ai-term' just before an agent window is torn down, and consumed by `cj/--ai-term-dispatch' so the next toggle-on reopens the @@ -529,11 +465,24 @@ and a fraction-of-frame produces the wrong size on replay (squeezes the other windows). An integer is unambiguous, at the cost of not auto-scaling if the frame itself resizes.") +(defvar cj/--ai-term-last-fullscreen nil + "Non-nil when the agent window was last seen filling its frame. + +Maintained by `cj/--ai-term-track-geometry' on +`window-configuration-change-hook': set t whenever a live agent window is +the sole window in its frame, cleared when the agent is shown as a split +\(its dock direction and size are captured then instead). Consulted by +`cj/--ai-term-display-saved' so a summon into a single-window frame +restores the agent fullscreen rather than docking it -- the sole-window +state isn't a representable dock size, so this flag is how it round-trips. +Unlike `cj/--ai-term-last-was-bury' it does not depend on a toggle-off, so +it also covers leaving the agent by switching buffers or `C-x 1'.") + (defun cj/--ai-term-capture-state (window) "Capture WINDOW's direction and size into module-level state. Sets `cj/--ai-term-last-direction' and `cj/--ai-term-last-size' -so a subsequent F9 display can restore the user's chosen orientation +so a subsequent display can restore the user's chosen orientation and size. Called at toggle-off (just before the window is torn down). The default direction is host-aware via `cj/--ai-term-default-direction' (used only when WINDOW fills its @@ -545,6 +494,35 @@ is not live." 'cj/--ai-term-last-size '(right below left))) +(defun cj/--ai-term-window-sole-p (window) + "Return non-nil when WINDOW is the only live window in its frame. +A frame's sole window is its root window; once split, the root is an +internal window and no live window equals it." + (and (window-live-p window) + (eq window (frame-root-window (window-frame window))))) + +(defun cj/--ai-term-track-geometry (&rest _) + "Track whether the displayed agent window is fullscreen. + +Run from `window-configuration-change-hook'. Sets +`cj/--ai-term-last-fullscreen' to whether a live agent window is the sole +window in its frame, and leaves it untouched when no agent window is +displayed -- that retained value is the just-left state a later summon +replays. Dock direction and size stay owned by the toggle-off capture +\(`cj/--ai-term-capture-state'); this hook must not re-capture them, or the +repeated capture/replay drifts the dock height a couple rows per cycle." + (let ((win (cj/--ai-term-displayed-agent-window))) + (when (window-live-p win) + (setq cj/--ai-term-last-fullscreen (cj/--ai-term-window-sole-p win))))) + +(add-hook 'window-configuration-change-hook #'cj/--ai-term-track-geometry) + +;; Agent buffers ("agent [<project>]") are buried, not killed, by the +;; kill-all sweep (F1 / `cj/dashboard-only'). Register the family pattern so +;; every agent -- however and whenever created -- survives with its session. +(with-eval-after-load 'undead-buffers + (cj/make-buffer-pattern-undead "\\`agent \\[")) + (defun cj/--ai-term-reuse-existing-agent (buffer _alist) "Display-buffer action: reuse any window in this frame already showing an agent buffer. @@ -557,7 +535,7 @@ action in the chain runs. This is more specific than `display-buffer-use-some-window', which would happily steal any non-selected window (e.g. a code window above the agent split) when the user is focused in agent and -swaps projects via C-F9. The selective lookup here keeps non-agent +swaps projects via C-; a s. The selective lookup here keeps non-agent windows undisturbed and preserves the user's split geometry across project changes." (let ((win (cj/--ai-term-displayed-agent-window))) @@ -605,19 +583,27 @@ keeping the toggle reversible." win)))) (defun cj/--ai-term-display-saved (buffer alist) - "Display-buffer action: split per saved direction and size. + "Display-buffer action: restore fullscreen in a single-window frame, +otherwise split per saved direction and size. -When the prior toggle-off was a bury (single-window state, flagged -via `cj/--ai-term-last-was-bury') and the frame is still single- -window, restore the agent into the selected window in place rather -than splitting -- preserves the user's lone-window layout across -F9 toggles. +When the frame is a single window and the agent was last fullscreen +\(`cj/--ai-term-last-fullscreen', tracked by `cj/--ai-term-track-geometry') +or the prior toggle-off was a single-window bury +\(`cj/--ai-term-last-was-bury'), restore the agent into the selected window +in place rather than splitting. This round-trips a fullscreen agent -- +left by toggle-off, `C-x 1', or switching buffers -- since the sole-window +state isn't a representable dock size. Otherwise delegates to `cj/window-toggle-display-saved' against the -F9 state vars, falling back to the host-aware defaults from +toggle state vars, falling back to the host-aware defaults from `cj/--ai-term-default-direction' and `cj/--ai-term-default-size'." (cond - ((and cj/--ai-term-last-was-bury (one-window-p)) + ;; NOMINI t: don't count an active minibuffer as a second window. A summon + ;; can run with a picker prompt up, and a bare `one-window-p' then returns + ;; nil on a structurally single-window frame, misfiring the fullscreen + ;; restore into a dock -- which clears the fullscreen flag and cascades. + ((and (or cj/--ai-term-last-fullscreen cj/--ai-term-last-was-bury) + (one-window-p t)) (setq cj/--ai-term-last-was-bury nil) (let ((win (selected-window))) (set-window-buffer win buffer) @@ -640,7 +626,7 @@ through four actions in order: 2. `cj/--ai-term-reuse-existing-agent' -- otherwise, if any window in this frame already shows an agent-prefixed buffer, swap its buffer for the new one (preserves geometry across - project changes via C-F9). + project changes via C-; a s). 3. `cj/--ai-term-reuse-edge-window' -- otherwise, if the frame already has a window forming the half the agent would occupy (the right column on a desktop, the bottom row on a laptop), @@ -669,19 +655,26 @@ split) when the user is focused in agent and switches projects." (dolist (entry (cj/--ai-term-display-rule-list)) (add-to-list 'display-buffer-alist entry)) +(defun cj/--ai-term-send-string (buffer string) + "Send STRING to BUFFER's terminal process (the agent's shell). +Sends to the pty directly so the launch command reaches the shell EAT runs." + (let ((proc (get-buffer-process buffer))) + (when (process-live-p proc) + (process-send-string proc string)))) + (defun cj/--ai-term-show-or-create (dir name) "Show or create the AI-term buffer for project DIR with buffer NAME. If a buffer named NAME exists with a live process, display it. If the buffer exists but its process is dead, kill it and recreate. If -no such buffer exists, create a new ghostel terminal in DIR and send +no such buffer exists, create a new EAT terminal in DIR and send the project's tmux launch command (see `cj/--ai-term-launch-command') so the same project basename reattaches across Emacs restarts. -The dynamic binding of `cj/--ai-term-suppress-tmux' around `(ghostel)' -suppresses the generic tmux-launch hook in term-config.el so -it doesn't fire a bare \"tmux\\n\" before the project-named launch -command runs. +EAT runs a plain shell with no auto-tmux hook, so the named +`tmux new-session -A' launch command is the only thing that starts the +session -- the spike confirmed EAT + tmux detach and reattach exactly +like ghostel + tmux did. Records DIR in `cj/--ai-term-mru' (whichever branch runs) so the project picker can list recently-opened projects first. Returns the @@ -695,28 +688,22 @@ buffer." (t (when existing (kill-buffer existing)) - ;; `ghostel' switches to its buffer in the selected window before our + ;; `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 - ;; through the alist into the agent slot. `ghostel-buffer-name' is bound - ;; to NAME so the terminal is created under the agent name, and - ;; `ghostel-buffer-name-function' is pinned nil (dynamically during - ;; creation, then buffer-locally) so OSC title escapes from the agent - ;; don't rename it out from under the "agent [" prefix that buffer - ;; detection and the display rule key on. + ;; through the alist into the agent slot. `eat-buffer-name' is bound to + ;; NAME so the terminal is created under the agent name; EAT (unlike + ;; ghostel) does not rename the buffer from the terminal's OSC title, so + ;; the "agent [" prefix that buffer detection and the display rule key on + ;; stays put. (save-window-excursion (let ((default-directory dir) - (ghostel-buffer-name name) - (ghostel-buffer-name-function nil) - (cj/--ai-term-suppress-tmux t)) - (let ((buf (ghostel))) - (when (buffer-live-p buf) - (with-current-buffer buf - (setq-local ghostel-buffer-name-function nil)))))) + (eat-buffer-name name)) + (eat))) (let ((buf (get-buffer name))) (with-current-buffer buf - (ghostel-send-string (cj/--ai-term-launch-command dir)) - (ghostel-send-string "\n")) + (cj/--ai-term-send-string + buf (concat (cj/--ai-term-launch-command dir) "\n"))) (display-buffer buf) buf))))) @@ -785,17 +772,17 @@ Signals `user-error' when no candidates exist." (expand-file-name chosen))))) (defun cj/--ai-term-dispatch () - "Compute the F9 (`cj/ai-term') action without performing it. + "Compute the `cj/ai-term' (C-; a a) action without performing it. Returns one of: - (toggle-off . WINDOW) -- agent is displayed in WINDOW; quit it. - (redisplay-recent . BUFFER) -- 1+ alive agent buffers; show MRU. - (pick-project) -- zero alive agent buffers; prompt. -When 2+ agent buffers are alive, F9 redisplays the most-recently- -selected one rather than opening the project picker. C-F9 is the -explicit \"start a different project\" surface; M-F9 is the explicit -\"switch among existing agents\" surface. F9 keeps a single, simple +When 2+ agent buffers are alive, C-; a a redisplays the most-recently- +selected one rather than opening the project picker. C-; a s is the +explicit \"start a different project\" surface; C-; a n is the explicit +\"switch among existing agents\" surface. C-; a a keeps a single, simple job: toggle whichever agent was last in use. A pure-decision helper so the dispatch logic is exercisable in tests @@ -818,7 +805,7 @@ without firing real `display-buffer' or `quit-window' calls." (t '(pick-project)))))))) (defun cj/ai-term-pick-project (&optional arg) - "Pick an AI-agent project and open or reuse its ghostel terminal. + "Pick an AI-agent project and open or reuse its EAT terminal. The project is picked from a filtered completing-read list of dirs that contain .ai/protocols.org. The terminal buffer is named @@ -828,11 +815,11 @@ buffers; reinvoking on the same project reuses its existing terminal. With prefix ARG, display the buffer without selecting its window. -Bound to C-F9 -- always shows the project picker, even when an agent +Bound to C-; a s -- always shows the project picker, even when an agent buffer is currently displayed. -ghostel renders in terminal frames as well as GUI frames, so this -launches from either (only kitty inline-graphics degrade in a TTY)." +EAT renders in terminal frames as well as GUI frames, so this +launches from either." (interactive "P") (let* ((dir (cj/--ai-term-pick-project)) (name (cj/--ai-term-buffer-name dir)) @@ -854,7 +841,7 @@ the agent itself." (other-buffer (window-buffer win) t))))) (defun cj/--ai-term-toggle-off (win) - "Hide the agent shown in WIN for an F9 toggle-off. Always returns nil. + "Hide the agent shown in WIN for a toggle-off. Always returns nil. Two cases, by window count: @@ -867,7 +854,7 @@ Two cases, by window count: force a swap to a non-agent buffer to keep the toggle observable. - Multi-window: collapse the agent split outright by deleting its window, so - the working buffer (e.g. todo.org) reclaims the space. F9 is a pure + the working buffer (e.g. todo.org) reclaims the space. The toggle is a pure show/hide toggle of THE agent split -- it must never surface a different agent. `quit-restore-window' can't guarantee that here: switching among several agents reuses the one slot via `set-window-buffer' (see @@ -909,21 +896,21 @@ Two cases, by window count: nil) (defun cj/ai-term (&optional arg) - "Smart F9 dispatch for the AI-term launcher. + "DWIM dispatch for the AI-term launcher. Bound to C-; a a. Behavior depends on the current state: -- If an AI-term buffer is currently displayed in this frame, F9 +- If an AI-term buffer is currently displayed in this frame, it quits its window (toggle off, buffer stays alive). -- Else, if exactly one alive AI-term buffer exists, F9 re-displays +- Else, if exactly one alive AI-term buffer exists, it re-displays it (DWIM -- the obvious next step is to look at it). -- Else (zero or 2+), F9 falls through to `cj/ai-term-pick-project'. +- Else (zero or 2+), it falls through to `cj/ai-term-pick-project'. With prefix ARG, display the buffer without selecting its window when a buffer is being shown (no effect on the toggle-off branch). -See `cj/ai-term-pick-project' (C-F9) to force the project picker. -M-F9 closes an agent via `cj/ai-term-close'." +See `cj/ai-term-pick-project' (C-; a s) to force the project picker. +C-; a k closes an agent via `cj/ai-term-close'." (interactive "P") (pcase (cj/--ai-term-dispatch) (`(toggle-off . ,win) @@ -957,7 +944,7 @@ 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 F9 hide toggle is +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." @@ -971,6 +958,8 @@ when BUFFER isn't an AI-term buffer." (let ((kill-buffer-query-functions nil)) (kill-buffer buffer)))) +(require 'system-lib) + (defun cj/--ai-term-close-target () "Return the AI-term buffer `cj/ai-term-close' should act on, or nil. @@ -985,7 +974,8 @@ buffers; nil when none are alive." ((null (cdr buffers)) (car buffers)) (t (get-buffer (completing-read "Close AI terminal: " - (mapcar #'buffer-name buffers) nil t)))))))) + (cj/completion-table 'buffer (mapcar #'buffer-name buffers)) + nil t)))))))) (defun cj/ai-term-close () "Gracefully close an AI-term agent: kill its tmux session and buffer. @@ -993,7 +983,7 @@ buffers; nil when none are alive." Targets the current agent buffer, the sole live agent, or prompts when several are alive (see `cj/--ai-term-close-target'). Asks for confirmation first -- this kills the running agent process, which can -interrupt work in progress. Bound to M-<f9>." +interrupt work in progress. Bound to C-; a k." (interactive) (let ((buffer (cj/--ai-term-close-target))) (unless buffer @@ -1067,16 +1057,13 @@ picker and C-; a k closes an agent." "C-; a k" "kill agent" "M-SPC" "ai-term: next agent")) -;; In ghostel's semi-char mode, keys not in `ghostel-keymap-exceptions' are -;; forwarded to the pty, and `ghostel-semi-char-mode-map' outranks the major -;; mode map. M-SPC (swap to the next agent) must reach Emacs from inside an -;; agent buffer, so add it to the exceptions, rebuild the semi-char map, and -;; bind it in `ghostel-mode-map'. C-; is already an exception (term-config), -;; so the C-; a family resolves through the global prefix without extra wiring. -(with-eval-after-load 'ghostel - (keymap-set ghostel-mode-map "M-SPC" #'cj/ai-term-next) - (add-to-list 'ghostel-keymap-exceptions "M-SPC") - (ghostel--rebuild-semi-char-keymap)) +;; 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 +;; dance like ghostel needed. C-; is already bound there (eat-config), so the +;; C-; a family resolves through the global prefix without extra wiring. +(with-eval-after-load 'eat + (keymap-set eat-semi-char-mode-map "M-SPC" #'cj/ai-term-next)) ;; ------------------- Wrap-it-up teardown + shutdown ------------------------- ;; diff --git a/modules/auth-config.el b/modules/auth-config.el index 62d773057..c2df244b5 100644 --- a/modules/auth-config.el +++ b/modules/auth-config.el @@ -1,4 +1,4 @@ -;; auth-config.el --- Configuration for Authentication Utilities -*- lexical-binding: t; coding: utf-8; -*- +;;; auth-config.el --- Authentication and GPG integration -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -6,29 +6,16 @@ ;; Layer: 1 (Foundation). ;; Category: F/D. ;; Load shape: eager. -;; Eager reason: auth-source and GPG/epa setup that other modules rely on for -;; credentials early in the session. -;; Top-level side effects: auth-source/epa configuration via use-package and setq. +;; Eager reason: credentials and GPG setup are needed by other modules early. +;; Top-level side effects: auth-source/epa setup and oauth2-auto cache advice. ;; Runtime requires: system-lib, user-constants. -;; Direct test load: yes (configuration only). +;; Direct test load: yes. ;; -;; Configuration for Emacs authentication and GPG integration: - -;; • auth-source -;; – Forces use of your default authinfo file -;; – Disable external GPG agent in favor of Emacs's own prompt -;; – Keeps auth-source debug logging disabled by default - -;; • Easy PG Assistant (epa) -;; – Force using the 'gpg2' executable for encryption/decryption operations - -;; • oauth2-auto cache fix (via advice) -;; – oauth2-auto version 20250624.1919 has caching bug on line 206 -;; – Function oauth2-auto--plstore-read has `or nil` disabling cache -;; – This caused GPG passphrase prompts every ~15 minutes during gcal-sync -;; – Fix: Advice to enable hash-table cache without modifying package -;; – Works across package updates -;; – Fixed 2025-11-11 +;; Central auth-source, GPG, and credential-debug setup. Auth lookups use the +;; configured authinfo file; passphrase caching is left to gpg-agent. +;; +;; Advises oauth2-auto's plstore reader to restore in-memory caching and avoid +;; repeated GPG prompts during calendar/mail refreshes. ;;; Code: diff --git a/modules/auto-dim-config.el b/modules/auto-dim-config.el index a143f8fe0..efae5341b 100644 --- a/modules/auto-dim-config.el +++ b/modules/auto-dim-config.el @@ -19,11 +19,10 @@ ;; auto-dim-other-buffers-hide) live in the active theme (the generated ;; theme-studio theme) so they track theme switches. ;; -;; Terminal buffers (ghostel) do not participate in window dimming: ghostel -;; bakes its color palette into the native module per-terminal, not per-window, -;; so there is no per-window color hook to dim through (the vterm engine had -;; one via `vterm--get-color', which this module used to advise). See the -;; terminal-migration follow-up task in todo.org for revisiting this. +;; EAT terminals render in real Emacs faces and use the `default' face for the +;; terminal background, so -- unlike the old ghostel/vterm engines, which baked +;; color per-terminal with no per-window hook -- they follow the per-window +;; dimmed background like any other buffer. ;;; Code: diff --git a/modules/browser-config.el b/modules/browser-config.el index d596b9e9d..564e7a275 100644 --- a/modules/browser-config.el +++ b/modules/browser-config.el @@ -76,7 +76,10 @@ Includes built-in Emacs browsers (those with nil executable)." (defun cj/save-browser-choice (browser-plist) "Save BROWSER-PLIST to the persistence file." (with-temp-file cj/browser-choice-file - (insert ";;; Browser choice - Auto-generated\n") + (insert ";;; browser-choice.el --- Generated browser selection -*- lexical-binding: t; -*-\n") + (insert ";;\n") + (insert ";; Generated by browser-config.el. Do not edit by hand; use\n") + (insert ";; `cj/choose-browser' to rewrite this file.\n") (insert (format "(setq cj/saved-browser-choice '%S)\n" browser-plist)))) (defun cj/load-browser-choice () @@ -102,7 +105,6 @@ Returns: \\='success if applied successfully, (program-var (plist-get browser-plist :program-var))) (if (null browse-fn) 'invalid-plist - ;; Set the main browse-url function (setq browse-url-browser-function browse-fn) ;; Set the specific browser program variable if it exists (when program-var diff --git a/modules/calendar-sync-ics.el b/modules/calendar-sync-ics.el new file mode 100644 index 000000000..9cb57e96b --- /dev/null +++ b/modules/calendar-sync-ics.el @@ -0,0 +1,582 @@ +;;; calendar-sync-ics.el --- iCalendar parsing primitives for calendar-sync -*- coding: utf-8; lexical-binding: t; -*- + +;; Author: Craig Jennings <c@cjennings.net> +;; Created: 2025-11-16 + +;;; Commentary: +;; +;; Layer: 3 (Domain Workflow). +;; Category: D. +;; Load shape: library. +;; Top-level side effects: none (defuns plus one internal state defvar). +;; Runtime requires: cl-lib, subr-x. +;; Direct test load: yes. +;; +;; Base layer of the calendar-sync parser: RFC 5545 text cleaning, VEVENT +;; property extraction, attendee/organizer/URL parsing, timezone and +;; timestamp conversion, date arithmetic, and single-event parsing. It has +;; no dependency on the other calendar-sync modules, so the recurrence, org, +;; and source layers build on it. The sync-window and user-identity +;; configuration it reads is owned by calendar-sync.el and forward-declared +;; here so this base layer never requires the top module back. + +;;; Code: + +(require 'cl-lib) +(require 'subr-x) + +;; Configuration owned by calendar-sync.el; declared special here so this +;; base module reads it without a back-require onto the top module. +(defvar calendar-sync-past-months) +(defvar calendar-sync-future-months) +(defvar calendar-sync-user-emails) +(defvar calendar-sync-skip-declined) + +;;; Logging + +(defun calendar-sync--log-silently (format-string &rest args) + "Log FORMAT-STRING with ARGS without requiring the full config." + (if (fboundp 'cj/log-silently) + (apply #'cj/log-silently format-string args) + (apply #'message format-string args))) + +;;; Internal state + +(defvar calendar-sync--last-timezone-offset nil + "Timezone offset in seconds from UTC at last sync. +Used to detect timezone changes (e.g., when traveling).") + +;;; Timezone Detection + +(defun calendar-sync--current-timezone-offset () + "Get current timezone offset in seconds from UTC. +Returns negative for west of UTC, positive for east. +Example: -21600 for CST (UTC-6), -28800 for PST (UTC-8)." + (car (current-time-zone))) + +(defun calendar-sync--format-timezone-offset (offset) + "Format timezone OFFSET (in seconds) as human-readable string. +Example: -21600 → `UTC-6' or `UTC-6:00'." + (if (null offset) + "unknown" + (let* ((hours (/ offset 3600)) + (minutes (abs (mod (/ offset 60) 60))) + (sign (if (>= hours 0) "+" "-")) + (abs-hours (abs hours))) + (if (= minutes 0) + (format "UTC%s%d" sign abs-hours) + (format "UTC%s%d:%02d" sign abs-hours minutes))))) + +(defun calendar-sync--timezone-changed-p () + "Return t if timezone has changed since last sync." + (and calendar-sync--last-timezone-offset + (not (= (calendar-sync--current-timezone-offset) + calendar-sync--last-timezone-offset)))) + +;;; Line Ending Normalization + +(defun calendar-sync--normalize-line-endings (content) + "Normalize line endings in CONTENT to Unix format (LF only). +Removes all carriage return characters (\\r) from CONTENT. +The iCalendar format (RFC 5545) uses CRLF line endings, but Emacs +and `org-mode' expect LF only. This function ensures consistent line +endings throughout the parsing pipeline. + +Returns CONTENT with all \\r characters removed." + (if (not (stringp content)) + content + (replace-regexp-in-string "\r" "" content))) + +;;; Text Cleaning (ICS unescape + HTML strip) + +(defun calendar-sync--unescape-ics-text (text) + "Unescape RFC 5545 escape sequences in TEXT. +Converts: \\n→newline, \\,→comma, \\\\→backslash, \\;→semicolon. +Returns nil for nil input." + (when text + ;; Use placeholder for literal backslash to avoid double-unescaping. + ;; replace-regexp-in-string with LITERAL=t avoids backslash interpretation. + (let ((result (replace-regexp-in-string "\\\\\\\\" "\000" text))) + (setq result (replace-regexp-in-string "\\\\n" "\n" result t t)) + (setq result (replace-regexp-in-string "\\\\," "," result t t)) + (setq result (replace-regexp-in-string "\\\\;" ";" result t t)) + (replace-regexp-in-string "\000" "\\" result t t)))) + +(defun calendar-sync--strip-html (text) + "Strip HTML tags from TEXT and decode common HTML entities. +Converts <br>, <br/>, <br /> to newlines. Strips all other tags. +Decodes & < > ". Collapses excessive blank lines. +Returns nil for nil input." + (when text + (let ((result text)) + ;; Convert <br> variants to newline (must come before tag stripping) + (setq result (replace-regexp-in-string "<br[ \t]*/?>[ \t]*" "\n" result)) + ;; Strip all remaining HTML tags + (setq result (replace-regexp-in-string "<[^>]*>" "" result)) + ;; Decode HTML entities + (setq result (replace-regexp-in-string "&" "&" result)) + (setq result (replace-regexp-in-string "<" "<" result)) + (setq result (replace-regexp-in-string ">" ">" result)) + (setq result (replace-regexp-in-string """ "\"" result)) + ;; Collapse 3+ consecutive newlines to 2 + (setq result (replace-regexp-in-string "\n\\{3,\\}" "\n\n" result)) + result))) + +(defun calendar-sync--clean-text (text) + "Clean TEXT by unescaping ICS sequences, stripping HTML, and trimming. +Returns nil for nil input. Returns empty string for whitespace-only input." + (when text + (string-trim (calendar-sync--strip-html (calendar-sync--unescape-ics-text text))))) + +;;; Date Utilities + +(defun calendar-sync--add-months (date months) + "Add MONTHS to DATE. +DATE is (year month day), returns new (year month day)." + (let* ((year (nth 0 date)) + (month (nth 1 date)) + (day (nth 2 date)) + (total-months (+ (* year 12) month -1 months)) + (new-year (/ total-months 12)) + (new-month (1+ (mod total-months 12)))) + (list new-year new-month day))) + +(defun calendar-sync--get-date-range () + "Get date range for event expansion as (start-time end-time). +Returns time values for -3 months and +12 months from today." + (let* ((now (decode-time)) + (today (list (nth 5 now) (nth 4 now) (nth 3 now))) + (start-date (calendar-sync--add-months today (- calendar-sync-past-months))) + (end-date (calendar-sync--add-months today calendar-sync-future-months)) + (start-time (apply #'encode-time 0 0 0 (reverse start-date))) + (end-time (apply #'encode-time 0 0 0 (reverse end-date)))) + (list start-time end-time))) + +(defun calendar-sync--date-in-range-p (date range) + "Check if DATE is within RANGE. +DATE is (year month day hour minute), RANGE is (start-time end-time)." + (let* ((year (nth 0 date)) + (month (nth 1 date)) + (day (nth 2 date)) + (date-time (encode-time 0 0 0 day month year)) + (start-time (nth 0 range)) + (end-time (nth 1 range))) + (and (time-less-p start-time date-time) + (time-less-p date-time end-time)))) + +(defun calendar-sync--weekday-to-number (weekday) + "Convert WEEKDAY string (MO, TU, etc.) to number (1-7). +Monday = 1, Sunday = 7." + (pcase weekday + ("MO" 1) + ("TU" 2) + ("WE" 3) + ("TH" 4) + ("FR" 5) + ("SA" 6) + ("SU" 7) + (_ nil))) + +(defun calendar-sync--date-weekday (date) + "Get weekday number for DATE (year month day). +Monday = 1, Sunday = 7." + (let* ((year (nth 0 date)) + (month (nth 1 date)) + (day (nth 2 date)) + (time (encode-time 0 0 0 day month year)) + (decoded (decode-time time)) + (dow (nth 6 decoded))) ; 0 = Sunday, 1 = Monday, etc. + (if (= dow 0) 7 dow))) + +(defun calendar-sync--add-days (date days) + "Add DAYS to DATE (year month day). +Returns new (year month day). +Uses noon internally to avoid DST boundary issues where adding +86400 seconds to midnight can land on the same calendar date +during fall-back transitions." + (let* ((year (nth 0 date)) + (month (nth 1 date)) + (day (nth 2 date)) + (time (encode-time 0 0 12 day month year)) + (new-time (time-add time (days-to-time days))) + (decoded (decode-time new-time))) + (list (nth 5 decoded) (nth 4 decoded) (nth 3 decoded)))) + +(defun calendar-sync--date-to-time (date) + "Convert DATE to time value for comparison. +DATE should be a list starting with (year month day ...). +Only the first three elements are used; extra elements (hour, minute) are +ignored." + (let ((day (nth 2 date)) + (month (nth 1 date)) + (year (nth 0 date))) + (encode-time 0 0 0 day month year))) + +(defun calendar-sync--before-date-p (date1 date2) + "Return t if DATE1 is before DATE2. +Both dates should be lists like (year month day)." + (time-less-p (calendar-sync--date-to-time date1) + (calendar-sync--date-to-time date2))) + +;;; Datetime Parsing + +(defun calendar-sync--parse-ics-datetime (value) + "Parse iCal datetime VALUE into (year month day hour minute) list. +Returns nil for invalid input. For date-only values, returns +(year month day nil nil). +Handles formats: 20260203T090000Z, 20260203T090000, 20260203." + (when (and value + (stringp value) + (not (string-empty-p value))) + (cond + ;; DateTime format: 20260203T090000Z or 20260203T090000 + ((string-match "\\`\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)T\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)Z?\\'" value) + (list (string-to-number (match-string 1 value)) + (string-to-number (match-string 2 value)) + (string-to-number (match-string 3 value)) + (string-to-number (match-string 4 value)) + (string-to-number (match-string 5 value)))) + ;; Date-only format: 20260203 + ((string-match "\\`\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)\\'" value) + (list (string-to-number (match-string 1 value)) + (string-to-number (match-string 2 value)) + (string-to-number (match-string 3 value)) + nil nil)) + (t nil)))) + +;;; .ics Property Extraction + +(defun calendar-sync--split-events (ics-content) + "Split ICS-CONTENT into individual VEVENT blocks. +Returns list of strings, each containing one VEVENT block." + (let ((events '())) + (with-temp-buffer + (insert ics-content) + (goto-char (point-min)) + (while (search-forward "BEGIN:VEVENT" nil t) + (let ((start (match-beginning 0))) + (when (search-forward "END:VEVENT" nil t) + (push (buffer-substring-no-properties start (point)) events))))) + (nreverse events))) + +(defun calendar-sync--unfold-continuation (text value start) + "Unfold RFC 5545 continuation lines from TEXT starting at START. +VALUE is the initial content to append to. Continuation lines begin +with a space or tab after a newline. Returns (unfolded-value . new-pos)." + (while (and (< start (length text)) + (string-match "\n[ \t]\\([^\n]*\\)" text start) + (= (match-beginning 0) start)) + (setq value (concat value (match-string 1 text))) + (setq start (match-end 0))) + (cons value start)) + +(defun calendar-sync--get-property (event property) + "Extract PROPERTY value from EVENT string. +Handles property parameters (e.g., DTSTART;TZID=America/Chicago:value). +Handles multi-line values (lines starting with space). +Returns nil if property not found." + (when (string-match (format "^%s[^:\n]*:\\(.*\\)$" (regexp-quote property)) event) + (car (calendar-sync--unfold-continuation + event (match-string 1 event) (match-end 0))))) + +(defun calendar-sync--get-property-line (event property) + "Extract full PROPERTY line from EVENT string, including parameters. +Returns the complete line like +`DTSTART;TZID=Europe/Lisbon:20260202T190000'. +Returns nil if property not found." + (when (string-match (format "^\\(%s[^\n]*\\)$" (regexp-quote property)) event) + (match-string 1 event))) + +(defun calendar-sync--get-all-property-lines (event property) + "Extract ALL lines matching PROPERTY from EVENT string. +Unlike `calendar-sync--get-property-line' which returns the first match, +this returns a list of all matching lines. Handles continuation lines +\(lines starting with space or tab). +Returns nil if EVENT or PROPERTY is nil, or no matches found." + (when (and event property (stringp event) (not (string-empty-p event))) + (let ((lines '()) + (pattern (format "^%s[^\n]*" (regexp-quote property))) + (pos 0)) + (while (string-match pattern event pos) + (let* ((result (calendar-sync--unfold-continuation + event (match-string 0 event) (match-end 0))) + (line (car result)) + (end (cdr result))) + (push line lines) + (setq pos (if (< end (length event)) (1+ end) end)))) + (nreverse lines)))) + +(defun calendar-sync--extract-cn (line) + "Extract and dequote CN parameter from iCal LINE. +Returns the CN value string, or nil if not found." + (when (string-match ";CN=\\([^;:]+\\)" line) + (let ((cn (match-string 1 line))) + (if (and (string-prefix-p "\"" cn) (string-suffix-p "\"" cn)) + (substring cn 1 -1) + cn)))) + +(defun calendar-sync--extract-email (line) + "Extract email address from mailto: value in iCal LINE. +Returns email string, or nil if not found." + (when (string-match "mailto:\\([^>\n ]+\\)" line) + (match-string 1 line))) + +(defun calendar-sync--parse-attendee-line (line) + "Parse single ATTENDEE LINE into plist. +Returns plist (:cn NAME :email EMAIL :partstat STATUS :role ROLE). +Returns nil for nil, empty, or malformed input." + (when (and line (stringp line) (not (string-empty-p line)) + (string-match-p "^ATTENDEE" line)) + (let ((cn (calendar-sync--extract-cn line)) + (email (calendar-sync--extract-email line)) + (partstat nil) + (role nil)) + (when (string-match ";PARTSTAT=\\([^;:]+\\)" line) + (setq partstat (match-string 1 line))) + (when (string-match ";ROLE=\\([^;:]+\\)" line) + (setq role (match-string 1 line))) + (when email + (list :cn cn :email email :partstat partstat :role role))))) + +(defun calendar-sync--find-user-status (attendees user-emails) + "Find user's PARTSTAT from ATTENDEES list using USER-EMAILS. +ATTENDEES is list of plists from `calendar-sync--parse-attendee-line'. +USER-EMAILS is list of email strings to match against. +Returns lowercase status string (\"accepted\", \"declined\", etc.) or nil." + (when (and attendees user-emails) + (let ((user-emails-lower (mapcar #'downcase user-emails)) + (found nil)) + (cl-dolist (attendee attendees) + (let ((attendee-email (downcase (or (plist-get attendee :email) "")))) + (when (member attendee-email user-emails-lower) + (let ((partstat (plist-get attendee :partstat))) + (when partstat + (setq found (downcase partstat)) + (cl-return found)))))) + found))) + +(defun calendar-sync--filter-declined (events) + "Return EVENTS with declined entries removed when the toggle is on. +EVENTS is a list of plists produced by `calendar-sync--parse-event'. +Each plist's :status is the lowercase PARTSTAT for the user (set by +`calendar-sync--find-user-status'), or nil for events without an +attendee block. Drops only events whose :status is exactly the string +\"declined\" so that nil / accepted / tentative / needs-action all +survive. When `calendar-sync-skip-declined' is nil, returns EVENTS +unchanged." + (if (and calendar-sync-skip-declined events) + (cl-remove-if (lambda (event) + (equal (plist-get event :status) "declined")) + events) + events)) + +(defun calendar-sync--parse-organizer (event-str) + "Parse ORGANIZER property from EVENT-STR into plist. +Returns plist (:cn NAME :email EMAIL), or nil if no ORGANIZER found." + (when (and event-str (stringp event-str)) + (let ((line (calendar-sync--get-property-line event-str "ORGANIZER"))) + (when line + (let ((email (calendar-sync--extract-email line))) + (when email + (list :cn (calendar-sync--extract-cn line) :email email))))))) + +(defun calendar-sync--extract-meeting-url (event-str) + "Extract meeting URL from EVENT-STR. +Prefers X-GOOGLE-CONFERENCE over URL property. +Returns URL string or nil." + (when (and event-str (stringp event-str)) + (or (calendar-sync--get-property event-str "X-GOOGLE-CONFERENCE") + (calendar-sync--get-property event-str "URL")))) + +(defun calendar-sync--extract-tzid (property-line) + "Extract TZID parameter value from PROPERTY-LINE. +PROPERTY-LINE is like `DTSTART;TZID=Europe/Lisbon:20260202T190000'. +Returns timezone string like `Europe/Lisbon', or nil if no TZID. +Returns nil for malformed lines (missing colon separator)." + (when (and property-line + (stringp property-line) + ;; Must have colon (property:value format) + (string-match-p ":" property-line) + (string-match ";TZID=\\([^;:]+\\)" property-line)) + (match-string 1 property-line))) + +;;; Timezone / Timestamp Conversion + +(defun calendar-sync--convert-utc-to-local (year month day hour minute second) + "Convert UTC datetime to local time. +Returns list (year month day hour minute) in local timezone." + (let* ((utc-time (encode-time second minute hour day month year 0)) + (local-time (decode-time utc-time))) + (list (nth 5 local-time) ; year + (nth 4 local-time) ; month + (nth 3 local-time) ; day + (nth 2 local-time) ; hour + (nth 1 local-time)))) + +(defun calendar-sync--convert-tz-to-local (year month day hour minute source-tz) + "Convert datetime from SOURCE-TZ timezone to local time. +SOURCE-TZ is a timezone name like `Europe/Lisbon' or `Asia/Yerevan'. +Returns list (year month day hour minute) in local timezone, or nil on error. + +Uses Emacs built-in timezone support (encode-time/decode-time with ZONE +argument) for fast, subprocess-free conversion. Uses the same system +TZ database as the `date' command." + (when (and source-tz (not (string-empty-p source-tz))) + (condition-case err + (let* ((abs-time (encode-time 0 minute hour day month year source-tz)) + (local (decode-time abs-time))) + (list (nth 5 local) ; year + (nth 4 local) ; month + (nth 3 local) ; day + (nth 2 local) ; hour + (nth 1 local))) ; minute + (error + (calendar-sync--log-silently "calendar-sync: Error converting timezone %s: %s" + source-tz (error-message-string err)) + nil)))) + +(defun calendar-sync--localize-parsed-datetime (parsed is-utc tzid) + "Convert PARSED datetime to local time using timezone info. +PARSED is (year month day hour minute) or (year month day nil nil). +IS-UTC non-nil means the value had a Z suffix. + +TZID is a timezone string like \"Europe/Lisbon\", or nil. +Returns PARSED converted to local time, or PARSED unchanged if no +conversion needed." + (cond + (is-utc + (calendar-sync--convert-utc-to-local + (nth 0 parsed) (nth 1 parsed) (nth 2 parsed) + (or (nth 3 parsed) 0) (or (nth 4 parsed) 0) 0)) + (tzid + (or (calendar-sync--convert-tz-to-local + (nth 0 parsed) (nth 1 parsed) (nth 2 parsed) + (or (nth 3 parsed) 0) (or (nth 4 parsed) 0) + tzid) + parsed)) + (t parsed))) + +(defun calendar-sync--parse-timestamp (timestamp-str &optional tzid) + "Parse iCal timestamp string TIMESTAMP-STR. +Returns (year month day hour minute) or (year month day) for all-day events. +Converts UTC times (ending in Z) to local time. +If TZID is provided (e.g., `Europe/Lisbon'), converts from that timezone +to local. +Returns nil if parsing fails." + (cond + ;; DateTime format: 20251116T140000Z or 20251116T140000 + ((string-match "\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)T\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)\\(Z\\)?" timestamp-str) + (let* ((year (string-to-number (match-string 1 timestamp-str))) + (month (string-to-number (match-string 2 timestamp-str))) + (day (string-to-number (match-string 3 timestamp-str))) + (hour (string-to-number (match-string 4 timestamp-str))) + (minute (string-to-number (match-string 5 timestamp-str))) + (second (string-to-number (match-string 6 timestamp-str))) + (is-utc (match-string 7 timestamp-str))) + (cond + ;; UTC timestamp (Z suffix) - convert from UTC + (is-utc + (calendar-sync--convert-utc-to-local year month day hour minute second)) + ;; TZID provided - convert from that timezone + (tzid + (or (calendar-sync--convert-tz-to-local year month day hour minute tzid) + ;; Fallback to raw time if conversion fails + (list year month day hour minute))) + ;; No timezone info - assume local time + (t + (list year month day hour minute))))) + ;; Date format: 20251116 + ((string-match "\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)" timestamp-str) + (list (string-to-number (match-string 1 timestamp-str)) + (string-to-number (match-string 2 timestamp-str)) + (string-to-number (match-string 3 timestamp-str)))) + (t nil))) + +(defun calendar-sync--format-timestamp (start end) + "Format START and END timestamps as 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)) + (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 ">"))) + +;;; Single Event Parsing + +(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). +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") + (let* ((uid (calendar-sync--get-property event-str "UID")) + (summary (calendar-sync--clean-text + (calendar-sync--get-property event-str "SUMMARY"))) + (description (calendar-sync--clean-text + (calendar-sync--get-property event-str "DESCRIPTION"))) + (location (calendar-sync--clean-text + (calendar-sync--get-property event-str "LOCATION"))) + ;; Get raw property values + (dtstart (calendar-sync--get-property event-str "DTSTART")) + (dtend (calendar-sync--get-property event-str "DTEND")) + ;; Extract TZID from property lines (if present) + (dtstart-line (calendar-sync--get-property-line event-str "DTSTART")) + (dtend-line (calendar-sync--get-property-line event-str "DTEND")) + (start-tzid (calendar-sync--extract-tzid dtstart-line)) + (end-tzid (calendar-sync--extract-tzid dtend-line)) + ;; Extract attendees + (attendee-lines (calendar-sync--get-all-property-lines event-str "ATTENDEE")) + (attendees (delq nil (mapcar #'calendar-sync--parse-attendee-line attendee-lines))) + ;; Extract organizer and URL + (organizer (calendar-sync--parse-organizer event-str)) + (url (calendar-sync--extract-meeting-url event-str)) + ;; Determine user status from attendees + (status (calendar-sync--find-user-status attendees calendar-sync-user-emails))) + (when (and summary dtstart) + (let ((start-parsed (calendar-sync--parse-timestamp dtstart start-tzid)) + (end-parsed (and dtend (calendar-sync--parse-timestamp dtend end-tzid)))) + (when start-parsed + (list :uid uid + :summary summary + :description description + :location location + :start start-parsed + :end end-parsed + :attendees attendees + :organizer organizer + :url url + :status status))))))) + +(defun calendar-sync--event-start-time (event) + "Extract comparable start time from EVENT plist. +Returns time value suitable for comparison, or 0 if no start time." + (let ((start (plist-get event :start))) + (if start + (apply #'encode-time + 0 ; second + (or (nth 4 start) 0) ; minute + (or (nth 3 start) 0) ; hour + (nth 2 start) ; day + (nth 1 start) ; month + (nth 0 start) ; year + nil) + 0))) + +(provide 'calendar-sync-ics) +;;; calendar-sync-ics.el ends here diff --git a/modules/calendar-sync-org.el b/modules/calendar-sync-org.el new file mode 100644 index 000000000..9ea5a129d --- /dev/null +++ b/modules/calendar-sync-org.el @@ -0,0 +1,94 @@ +;;; calendar-sync-org.el --- Org rendering and atomic file output -*- coding: utf-8; lexical-binding: t; -*- + +;; Author: Craig Jennings <c@cjennings.net> +;; Created: 2025-11-16 + +;;; Commentary: +;; +;; Layer: 3 (Domain Workflow). +;; Category: D. +;; Load shape: library. +;; Top-level side effects: none (defuns only). +;; Runtime requires: subr-x, cj-org-text-lib, calendar-sync-ics. +;; Direct test load: yes (requires calendar-sync-ics explicitly). +;; +;; Output layer of the calendar-sync parser: render a parsed event plist +;; into an Org entry (heading, property drawer, body) and write generated +;; content to disk atomically via a same-directory temp file plus rename, +;; so a reader never sees a half-written calendar. + +;;; Code: + +(require 'subr-x) +(require 'cj-org-text-lib) +(require 'calendar-sync-ics) + +;;; Org Rendering + +(defun calendar-sync--event-to-org (event) + "Convert parsed EVENT plist to org entry string. +Produces property drawer with LOCATION, ORGANIZER, STATUS, URL when present. +Description appears as body text after the drawer." + (let* ((summary (cj/org-sanitize-heading + (or (plist-get event :summary) "(No Title)"))) + (description (plist-get event :description)) + (location (plist-get event :location)) + (start (plist-get event :start)) + (end (plist-get event :end)) + (organizer (plist-get event :organizer)) + (status (plist-get event :status)) + (url (plist-get event :url)) + (timestamp (calendar-sync--format-timestamp start end)) + ;; Build property drawer entries + (props '())) + ;; Collect non-nil properties + (when (and location (not (string-empty-p location))) + (push (format ":LOCATION: %s" + (cj/org-sanitize-property-value location)) + props)) + (when organizer + (let ((org-name (or (plist-get organizer :cn) + (plist-get organizer :email)))) + (when org-name + (push (format ":ORGANIZER: %s" + (cj/org-sanitize-property-value org-name)) + props)))) + (when (and status (not (string-empty-p status))) + (push (format ":STATUS: %s" + (cj/org-sanitize-property-value status)) + props)) + (when (and url (not (string-empty-p url))) + (push (format ":URL: %s" + (cj/org-sanitize-property-value url)) + props)) + (setq props (nreverse props)) + ;; Build output + (let ((parts (list timestamp (format "* %s" summary)))) + ;; Add property drawer if any properties exist + (when props + (push ":PROPERTIES:" parts) + (dolist (prop props) + (push prop parts)) + (push ":END:" parts)) + ;; Add description as body text (sanitized to prevent org heading conflicts) + (when (and description (not (string-empty-p description))) + (push (cj/org-sanitize-body-text description) parts)) + (string-join (nreverse parts) "\n")))) + +;;; Atomic File Output + +(defun calendar-sync--write-file (content file) + "Write CONTENT to FILE atomically. +Creates parent directories if needed, then writes a temp file in the same +directory and renames it into place, so org-agenda or chime reading mid-write +never sees a half-written calendar." + (let ((dir (file-name-directory file))) + (unless (file-directory-p dir) + (make-directory dir t)) + (let ((tmp (make-temp-file (expand-file-name ".calendar-sync-" dir)))) + (with-temp-file tmp + (insert content)) + (rename-file tmp file t)))) + +(provide 'calendar-sync-org) +;;; calendar-sync-org.el ends here diff --git a/modules/calendar-sync-recurrence.el b/modules/calendar-sync-recurrence.el new file mode 100644 index 000000000..d4f70b7d1 --- /dev/null +++ b/modules/calendar-sync-recurrence.el @@ -0,0 +1,405 @@ +;;; calendar-sync-recurrence.el --- RRULE / EXDATE / RECURRENCE-ID expansion -*- coding: utf-8; lexical-binding: t; -*- + +;; Author: Craig Jennings <c@cjennings.net> +;; Created: 2025-11-16 + +;;; Commentary: +;; +;; Layer: 3 (Domain Workflow). +;; Category: D. +;; Load shape: library. +;; Top-level side effects: none (defuns and defaliases only). +;; Runtime requires: cl-lib, subr-x, calendar-sync-ics. +;; Direct test load: yes (requires calendar-sync-ics explicitly). +;; +;; Recurrence layer of the calendar-sync parser: RECURRENCE-ID exception +;; collection and application, EXDATE exclusion, RRULE parsing, and +;; expansion of daily/weekly/monthly/yearly series into concrete +;; occurrences. Builds on calendar-sync-ics for property extraction, +;; timestamp parsing, date arithmetic, and single-event parsing. + +;;; Code: + +(require 'cl-lib) +(require 'subr-x) +(require 'calendar-sync-ics) + +;; Configuration owned by calendar-sync.el; declared special here. +(defvar calendar-sync-user-emails) + +;;; RECURRENCE-ID Exception Handling + +(defun calendar-sync--get-recurrence-id (event-str) + "Extract RECURRENCE-ID value from EVENT-STR. +Returns the datetime value (without TZID parameter), or nil if not found. +Handles both simple values and values with parameters like TZID." + (when (and event-str (stringp event-str)) + (calendar-sync--get-property event-str "RECURRENCE-ID"))) + +(defun calendar-sync--get-recurrence-id-line (event-str) + "Extract full RECURRENCE-ID line from EVENT-STR, including parameters. +Returns the complete line like +`RECURRENCE-ID;TZID=Europe/Tallinn:20260203T170000'. +Returns nil if not found." + (when (and event-str (stringp event-str)) + (calendar-sync--get-property-line event-str "RECURRENCE-ID"))) + +(defalias 'calendar-sync--parse-recurrence-id #'calendar-sync--parse-ics-datetime + "Parse RECURRENCE-ID value. See `calendar-sync--parse-ics-datetime'.") + +(defun calendar-sync--parse-exception-event (event-str) + "Parse a RECURRENCE-ID override EVENT-STR into an exception plist, or nil. +Returns nil when EVENT-STR carries no RECURRENCE-ID, or its recurrence-id / +start time fail to parse. The plist holds :recurrence-id (localized), +:recurrence-id-raw, :start, :end, :summary, :description, :location." + (let ((recurrence-id (calendar-sync--get-recurrence-id event-str))) + (when recurrence-id + (let* ((recurrence-id-line (calendar-sync--get-recurrence-id-line event-str)) + (recurrence-id-tzid (calendar-sync--extract-tzid recurrence-id-line)) + (recurrence-id-is-utc (string-suffix-p "Z" recurrence-id)) + (recurrence-id-parsed (calendar-sync--parse-recurrence-id recurrence-id)) + ;; Parse the new times from the exception + (dtstart (calendar-sync--get-property event-str "DTSTART")) + (dtend (calendar-sync--get-property event-str "DTEND")) + (dtstart-line (calendar-sync--get-property-line event-str "DTSTART")) + (dtend-line (calendar-sync--get-property-line event-str "DTEND")) + (start-tzid (calendar-sync--extract-tzid dtstart-line)) + (end-tzid (calendar-sync--extract-tzid dtend-line)) + (start-parsed (calendar-sync--parse-timestamp dtstart start-tzid)) + (end-parsed (and dtend (calendar-sync--parse-timestamp dtend end-tzid))) + (summary (calendar-sync--clean-text + (calendar-sync--get-property event-str "SUMMARY"))) + (description (calendar-sync--clean-text + (calendar-sync--get-property event-str "DESCRIPTION"))) + (location (calendar-sync--clean-text + (calendar-sync--get-property event-str "LOCATION")))) + (when (and recurrence-id-parsed start-parsed) + (list :recurrence-id (calendar-sync--localize-parsed-datetime + recurrence-id-parsed recurrence-id-is-utc recurrence-id-tzid) + :recurrence-id-raw recurrence-id + :start start-parsed + :end end-parsed + :summary summary + :description description + :location location)))))) + +(defun calendar-sync--collect-recurrence-exceptions (ics-content) + "Collect all RECURRENCE-ID events from ICS-CONTENT. +Returns hash table mapping UID to list of exception event plists. +Each exception plist contains :recurrence-id (parsed), :start, :end, +:summary, etc." + (let ((exceptions (make-hash-table :test 'equal))) + (when (and ics-content (stringp ics-content)) + (dolist (event-str (calendar-sync--split-events ics-content)) + (let ((uid (calendar-sync--get-property event-str "UID")) + (exception-plist (calendar-sync--parse-exception-event event-str))) + (when (and uid exception-plist) + (puthash uid + (cons exception-plist (gethash uid exceptions)) + exceptions))))) + exceptions)) + +(defun calendar-sync--occurrence-matches-exception-p (occurrence exception) + "Check if OCCURRENCE matches EXCEPTION's recurrence-id. +Compares year, month, day, hour, minute." + (let ((occ-start (plist-get occurrence :start)) + (exc-recid (plist-get exception :recurrence-id))) + (and occ-start exc-recid + (= (nth 0 occ-start) (nth 0 exc-recid)) ; year + (= (nth 1 occ-start) (nth 1 exc-recid)) ; month + (= (nth 2 occ-start) (nth 2 exc-recid)) ; day + ;; Hour/minute check (handle nil for all-day events) + (or (and (null (nth 3 occ-start)) (null (nth 3 exc-recid))) + (and (nth 3 occ-start) (nth 3 exc-recid) + (= (nth 3 occ-start) (nth 3 exc-recid)) + (= (or (nth 4 occ-start) 0) (or (nth 4 exc-recid) 0))))))) + +(defun calendar-sync--apply-single-exception (occurrence exception) + "Apply EXCEPTION to OCCURRENCE, returning modified occurrence." + (let ((result (copy-sequence occurrence))) + ;; Update time from exception + (plist-put result :start (plist-get exception :start)) + (when (plist-get exception :end) + (plist-put result :end (plist-get exception :end))) + ;; Update summary if exception has one + (when (plist-get exception :summary) + (plist-put result :summary (plist-get exception :summary))) + ;; Update other fields + (when (plist-get exception :description) + (plist-put result :description (plist-get exception :description))) + (when (plist-get exception :location) + (plist-put result :location (plist-get exception :location))) + ;; Pass through new fields if exception overrides them + (when (plist-get exception :attendees) + (plist-put result :attendees (plist-get exception :attendees)) + ;; Re-derive the user's status from the overridden attendees so a + ;; singly-declined occurrence drops its inherited series "accepted" + ;; (otherwise `calendar-sync--filter-declined' can't drop it). Leave the + ;; inherited status when the override doesn't name the user. + (let ((status (calendar-sync--find-user-status + (plist-get exception :attendees) calendar-sync-user-emails))) + (when status + (plist-put result :status status)))) + (when (plist-get exception :organizer) + (plist-put result :organizer (plist-get exception :organizer))) + (when (plist-get exception :url) + (plist-put result :url (plist-get exception :url))) + result)) + +(defun calendar-sync--apply-recurrence-exceptions (occurrences exceptions) + "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." + (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))) + +;;; EXDATE (Excluded Date) Handling + +(defun calendar-sync--get-exdates (event-str) + "Extract all EXDATE values from EVENT-STR. +Returns list of datetime strings (without TZID parameters), or nil if +none found. +Handles both simple values and values with parameters like TZID." + (when (and event-str (stringp event-str) (not (string-empty-p event-str))) + (let ((exdates '()) + (pos 0)) + ;; Find all EXDATE lines + (while (string-match "^EXDATE[^:\n]*:\\([^\n]+\\)" event-str pos) + (push (match-string 1 event-str) exdates) + (setq pos (match-end 0))) + (nreverse exdates)))) + +(defun calendar-sync--get-exdate-line (event-str exdate-value) + "Find the full EXDATE line containing EXDATE-VALUE from EVENT-STR. +Returns the complete line like +`EXDATE;TZID=America/New_York:20260210T130000'. +Returns nil if not found." + (when (and event-str (stringp event-str) exdate-value) + (let ((pattern (format "^\\(EXDATE[^:]*:%s\\)" (regexp-quote exdate-value)))) + (when (string-match pattern event-str) + (match-string 1 event-str))))) + +(defalias 'calendar-sync--parse-exdate #'calendar-sync--parse-ics-datetime + "Parse EXDATE value. See `calendar-sync--parse-ics-datetime'.") + +(defun calendar-sync--collect-exdates (event-str) + "Collect all excluded dates from EVENT-STR, handling timezone conversion. +Returns list of parsed datetime lists (year month day hour minute). +Converts TZID-qualified and UTC times to local time." + (if (or (null event-str) + (not (stringp event-str)) + (string-empty-p event-str)) + '() + (let ((exdate-values (calendar-sync--get-exdates event-str)) + (result '())) + (dolist (exdate-value exdate-values) + (let* ((exdate-line (calendar-sync--get-exdate-line event-str exdate-value)) + (exdate-tzid (and exdate-line (calendar-sync--extract-tzid exdate-line))) + (exdate-is-utc (and exdate-value (string-suffix-p "Z" exdate-value))) + (exdate-parsed (calendar-sync--parse-exdate exdate-value))) + (when exdate-parsed + (push (calendar-sync--localize-parsed-datetime + exdate-parsed exdate-is-utc exdate-tzid) + result)))) + (nreverse result)))) + +(defun calendar-sync--exdate-matches-p (occurrence-start exdate) + "Check if OCCURRENCE-START matches EXDATE. +OCCURRENCE-START is (year month day hour minute). +EXDATE is (year month day hour minute) or (year month day nil nil) for +date-only. +Date-only EXDATE matches any time on that day." + (and occurrence-start exdate + (= (nth 0 occurrence-start) (nth 0 exdate)) ; year + (= (nth 1 occurrence-start) (nth 1 exdate)) ; month + (= (nth 2 occurrence-start) (nth 2 exdate)) ; day + ;; If EXDATE has nil hour/minute (date-only), match any time + (or (null (nth 3 exdate)) + (and (nth 3 occurrence-start) + (= (nth 3 occurrence-start) (nth 3 exdate)) + (= (or (nth 4 occurrence-start) 0) (or (nth 4 exdate) 0)))))) + +(defun calendar-sync--filter-exdates (occurrences exdates) + "Filter OCCURRENCES list to remove entries matching EXDATES. +OCCURRENCES is list of event plists with :start key. +EXDATES is list of parsed datetime lists from `calendar-sync--collect-exdates'. +Returns filtered list with excluded dates removed." + (if (or (null occurrences) (null exdates)) + (or occurrences '()) + (cl-remove-if + (lambda (occurrence) + (let ((occ-start (plist-get occurrence :start))) + (cl-some (lambda (exdate) + (calendar-sync--exdate-matches-p occ-start exdate)) + exdates))) + occurrences))) + +;;; RRULE Parsing and Expansion + +(defun calendar-sync--create-occurrence (base-event occurrence-date) + "Create an occurrence from BASE-EVENT with OCCURRENCE-DATE. +OCCURRENCE-DATE should be a list (year month day hour minute second)." + (let* ((occurrence (copy-sequence base-event)) + (end (plist-get base-event :end))) + (plist-put occurrence :start occurrence-date) + (when end + ;; Use the date from occurrence-date but keep the time from the original end + (let ((date-only (list (nth 0 occurrence-date) + (nth 1 occurrence-date) + (nth 2 occurrence-date)))) + (plist-put occurrence :end (append date-only (nthcdr 3 end))))) + occurrence)) + +(defun calendar-sync--parse-rrule (rrule-str) + "Parse RRULE string into plist. +Returns plist with :freq :interval :byday :until :count." + (let ((parts (split-string rrule-str ";")) + (result '())) + (dolist (part parts) + (when (string-match "\\([^=]+\\)=\\(.+\\)" part) + (let ((key (match-string 1 part)) + (value (match-string 2 part))) + (pcase key + ("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 ",")))) + ("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 + (unless (plist-get result :interval) + (setq result (plist-put result :interval 1))) + result)) + +(defun calendar-sync--expand-simple-recurrence (base-event rrule range advance-fn) + "Expand a simple (non-weekly) recurring event using ADVANCE-FN to step dates. +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. +ADVANCE-FN takes (current-date interval) and returns the next date." + (let* ((start (plist-get base-event :start)) + (interval (plist-get rrule :interval)) + (until (plist-get rrule :until)) + (count (plist-get rrule :count)) + (occurrences '()) + (current-date (list (nth 0 start) (nth 1 start) (nth 2 start))) + (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)) + (or (not count) (< num-generated count))) + (let ((occurrence-datetime (append current-date (nthcdr 3 start)))) + (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 current-date (funcall advance-fn current-date interval))) + (nreverse occurrences))) + +(defun calendar-sync--expand-daily (base-event rrule range) + "Expand daily 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-days)) + +(defun calendar-sync--expand-weekly (base-event rrule range) + "Expand weekly recurring event. +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." + (let* ((start (plist-get base-event :start)) + (interval (plist-get rrule :interval)) + (byday (plist-get rrule :byday)) + (until (plist-get rrule :until)) + (count (plist-get rrule :count)) + (occurrences '()) + (current-date (list (nth 0 start) (nth 1 start) (nth 2 start))) + (num-generated 0) + (range-end-time (cadr range)) + (max-iterations 1000) ;; Safety: prevent infinite loops + (iterations 0) + (weekdays (if byday + (mapcar #'calendar-sync--weekday-to-number byday) + (list (calendar-sync--date-weekday current-date))))) + ;; Validate interval + (when (<= interval 0) + (error "Invalid RRULE interval: %s (must be > 0)" interval)) + ;; Start from the first week + ;; For infinite recurrence (no COUNT/UNTIL), stop at range-end for performance + ;; For COUNT, generate all occurrences from start regardless of 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))) + (setq iterations (1+ iterations)) + ;; Generate occurrences for each weekday in this week + (dolist (weekday weekdays) + (let* ((current-weekday (calendar-sync--date-weekday current-date)) + (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 COUNT - increment BEFORE range check so COUNT is absolute from start + (when (or (not count) (< num-generated count)) + (setq num-generated (1+ num-generated)) + ;; Only add to output if within date range + (when (calendar-sync--date-in-range-p occurrence-datetime range) + (push (calendar-sync--create-occurrence base-event occurrence-datetime) + occurrences)))))) + ;; Move to next interval week + (setq current-date (calendar-sync--add-days current-date (* 7 interval)))) + (when (>= iterations max-iterations) + (calendar-sync--log-silently "calendar-sync: WARNING: Hit max iterations (%d) expanding weekly 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)) + +(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))))) + +(defun calendar-sync--expand-recurring-event (event-str range) + "Expand recurring event EVENT-STR into individual occurrences within RANGE. +Returns list of event plists, or nil if not a recurring event. +Filters out dates excluded via EXDATE properties." + (let ((rrule (calendar-sync--get-property event-str "RRULE"))) + (when rrule + (let* ((base-event (calendar-sync--parse-event event-str)) + (parsed-rrule (calendar-sync--parse-rrule rrule)) + (freq (plist-get parsed-rrule :freq)) + (exdates (calendar-sync--collect-exdates event-str))) + (when base-event + (let ((occurrences + (pcase freq + ('daily (calendar-sync--expand-daily base-event parsed-rrule range)) + ('weekly (calendar-sync--expand-weekly base-event parsed-rrule range)) + ('monthly (calendar-sync--expand-monthly base-event parsed-rrule range)) + ('yearly (calendar-sync--expand-yearly base-event parsed-rrule range)) + (_ (calendar-sync--log-silently "calendar-sync: Unsupported RRULE frequency: %s" freq) + nil)))) + ;; Filter out EXDATE occurrences + (if exdates + (calendar-sync--filter-exdates occurrences exdates) + occurrences))))))) + +(provide 'calendar-sync-recurrence) +;;; calendar-sync-recurrence.el ends here diff --git a/modules/calendar-sync-source.el b/modules/calendar-sync-source.el new file mode 100644 index 000000000..d9efc885b --- /dev/null +++ b/modules/calendar-sync-source.el @@ -0,0 +1,426 @@ +;;; calendar-sync-source.el --- Feed fetch, state, and conversion workers -*- coding: utf-8; lexical-binding: t; -*- + +;; Author: Craig Jennings <c@cjennings.net> +;; Created: 2025-11-16 + +;;; Commentary: +;; +;; Layer: 3 (Domain Workflow). +;; Category: D/S. +;; Load shape: library. +;; Top-level side effects: none (defuns plus internal state defvars). +;; Runtime requires: subr-x, system-lib, calendar-sync-ics. +;; Direct test load: yes (requires calendar-sync-ics explicitly). +;; +;; Source layer of calendar-sync: per-calendar sync state and its on-disk +;; persistence, asynchronous .ics fetching via curl, the batch Emacs +;; conversion worker, and the Google Calendar API fetch path. Drives a +;; single calendar from either its .ics feed or the API helper. +;; +;; The batch worker loads the top calendar-sync module (whose path is held +;; in `calendar-sync--module-file') and there calls `calendar-sync--parse-ics' +;; and `calendar-sync--write-file'. Those live in the top and org modules +;; respectively, which require this one, so they are forward-declared here +;; rather than required (the worker has the full graph loaded, and these +;; functions are only ever invoked inside it). + +;;; Code: + +(require 'subr-x) +(require 'system-lib) ;; provides cj/auth-source-secret-value +(require 'calendar-sync-ics) + +;; Owned by calendar-sync.el (config) / calendar-sync-org.el (output); +;; forward-declared so this module compiles and reads them without a cycle. +(defvar calendar-sync-calendars) +(defvar calendar-sync-fetch-timeout) +(defvar calendar-sync-python-command) +(defvar calendar-sync-past-months) +(defvar calendar-sync-future-months) +(defvar calendar-sync-user-emails) +(defvar calendar-sync-skip-declined) +(defvar calendar-sync-private-config-file) +(defvar calendar-sync--module-file) +(declare-function calendar-sync--parse-ics "calendar-sync" (ics-content)) +(declare-function calendar-sync--write-file "calendar-sync-org" (content file)) + +;;; Internal state + +(defvar calendar-sync--calendar-states (make-hash-table :test 'equal) + "Per-calendar sync state. +Hash table mapping calendar name (string) to state plist with: + :last-sync - Time of last successful sync + :status - Symbol: ok, error, or syncing + :last-error - Error message string, or nil") + +(defvar calendar-sync--state-file + (expand-file-name "persist/calendar-sync-state.el" user-emacs-directory) + "File to persist sync state across Emacs sessions.") + +;;; State Persistence + +(defun calendar-sync--save-state () + "Save sync state to disk for persistence across sessions." + (let* ((calendar-states-alist + (let ((result '())) + (maphash (lambda (name state) + (push (cons name state) result)) + calendar-sync--calendar-states) + result)) + (state `((timezone-offset . ,calendar-sync--last-timezone-offset) + (calendar-states . ,calendar-states-alist))) + (dir (file-name-directory calendar-sync--state-file))) + (unless (file-directory-p dir) + (make-directory dir t)) + (let ((tmp (make-temp-file (expand-file-name ".calendar-sync-state-" dir)))) + (with-temp-file tmp + (prin1 state (current-buffer))) + (rename-file tmp calendar-sync--state-file t)))) + +(defun calendar-sync--load-state () + "Load sync state from disk." + (when (file-exists-p calendar-sync--state-file) + (condition-case err + (with-temp-buffer + (insert-file-contents calendar-sync--state-file) + (let ((state (read (current-buffer)))) + (setq calendar-sync--last-timezone-offset + (alist-get 'timezone-offset state)) + ;; Load per-calendar states + (let ((cal-states (alist-get 'calendar-states state))) + (clrhash calendar-sync--calendar-states) + (dolist (entry cal-states) + (puthash (car entry) (cdr entry) calendar-sync--calendar-states))))) + (error + (calendar-sync--log-silently "calendar-sync: Error loading state: %s" (error-message-string err)))))) + +(defun calendar-sync--get-calendar-state (calendar-name) + "Get state plist for CALENDAR-NAME, or nil if not found." + (gethash calendar-name calendar-sync--calendar-states)) + +(defun calendar-sync--set-calendar-state (calendar-name state) + "Set STATE plist for CALENDAR-NAME." + (puthash calendar-name state calendar-sync--calendar-states)) + +;;; Debug Logging + +(defun calendar-sync--debug-p () + "Return non-nil if calendar-sync debug logging is enabled. +Checks `cj/debug-modules' for symbol `calendar-sync' or t (all)." + (and (boundp 'cj/debug-modules) + (or (eq cj/debug-modules t) + (memq 'calendar-sync cj/debug-modules)))) + +;;; Private Config + +(defun calendar-sync--load-private-config () + "Load private calendar-sync configuration when available." + (when (file-readable-p calendar-sync-private-config-file) + (condition-case err + (load calendar-sync-private-config-file nil t) + (error + (message "calendar-sync: Failed to load private config %s: %s" + (abbreviate-file-name calendar-sync-private-config-file) + (error-message-string err)))))) + +;;; .ics Fetch + +(defun calendar-sync--fetch-ics (url callback) + "Fetch .ics file from URL asynchronously using curl. +Calls CALLBACK with the .ics content as string (normalized to Unix line endings) +or nil on error. CALLBACK signature: (lambda (content) ...). + +The fetch happens asynchronously and doesn't block Emacs. The callback is +invoked when the fetch completes, either successfully or with an error." + (condition-case err + (let ((buffer (generate-new-buffer " *calendar-sync-curl*"))) + (make-process + :name "calendar-sync-curl" + :buffer buffer + :command (list "curl" "-s" "-L" "--fail" + "--connect-timeout" "10" + "--max-time" (number-to-string calendar-sync-fetch-timeout) + url) + :sentinel + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (let ((buf (process-buffer process))) + (when (buffer-live-p buf) + (let ((content + (with-current-buffer buf + (if (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0)) + (calendar-sync--normalize-line-endings (buffer-string)) + (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" (string-trim event)) + nil)))) + (kill-buffer buf) + (funcall callback content)))))))) + (error + (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) + (funcall callback nil)))) + +(defun calendar-sync--fetch-ics-file (url callback) + "Fetch .ics from URL to a temp file asynchronously. +Calls CALLBACK with the temp file path on success, or nil on error. The caller +owns deleting the temp file after a successful callback." + (condition-case err + (let ((buffer (generate-new-buffer " *calendar-sync-curl*")) + (temp-file (make-temp-file "calendar-sync-" nil ".ics"))) + (make-process + :name "calendar-sync-curl" + :buffer buffer + :command (list "curl" "-s" "-L" "--fail" + "--connect-timeout" "10" + "--max-time" (number-to-string calendar-sync-fetch-timeout) + "-o" temp-file + url) + :sentinel + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (let ((buf (process-buffer process)) + (success (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0)))) + (when (buffer-live-p buf) + (unless success + (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" + (string-trim event))) + (kill-buffer buf)) + (if success + (funcall callback temp-file) + (when (file-exists-p temp-file) + (delete-file temp-file)) + (funcall callback nil))))))) + (error + (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) + (funcall callback nil)))) + +;;; Batch Conversion Worker + +(defun calendar-sync--emacs-binary () + "Return the Emacs executable to use for calendar conversion workers." + (let ((candidate (expand-file-name invocation-name invocation-directory))) + (if (file-executable-p candidate) + candidate + invocation-name))) + +(defun calendar-sync--batch-convert-file (ics-file output-file past-months future-months user-emails) + "Convert ICS-FILE to Org format and write OUTPUT-FILE. +PAST-MONTHS, FUTURE-MONTHS, and USER-EMAILS mirror the interactive session's +calendar conversion settings. This is intended for noninteractive worker +processes, not direct interactive use." + (setq calendar-sync-past-months past-months + calendar-sync-future-months future-months + calendar-sync-user-emails user-emails) + (let* ((ics-content + (with-temp-buffer + (insert-file-contents ics-file) + (calendar-sync--normalize-line-endings (buffer-string)))) + (org-content (calendar-sync--parse-ics ics-content))) + (unless org-content + (error "calendar-sync: parse failed")) + (calendar-sync--write-file org-content output-file))) + +(defun calendar-sync--worker-command (ics-file output-file) + "Build the batch Emacs command that converts ICS-FILE to OUTPUT-FILE." + (let ((module-dir (file-name-directory calendar-sync--module-file)) + (private-config-file + (make-temp-name (expand-file-name "calendar-sync-worker-config-" + temporary-file-directory))) + (state-file + (make-temp-name (expand-file-name "calendar-sync-worker-state-" + temporary-file-directory)))) + (list (calendar-sync--emacs-binary) + "--batch" + "--no-site-file" + "--no-site-lisp" + "--eval" (format "(setq load-prefer-newer t calendar-sync-auto-start nil calendar-sync-private-config-file %S calendar-sync--state-file %S)" + private-config-file state-file) + "-L" module-dir + "-l" calendar-sync--module-file + "--eval" (format "(calendar-sync--batch-convert-file %S %S %S %S '%S)" + ics-file + output-file + calendar-sync-past-months + calendar-sync-future-months + calendar-sync-user-emails)))) + +(defun calendar-sync--convert-ics-file-async (ics-file output-file callback) + "Convert ICS-FILE to OUTPUT-FILE in a batch Emacs worker. +Calls CALLBACK as (CALLBACK SUCCESS ERROR-MESSAGE). Deletes ICS-FILE after the +worker exits." + (condition-case err + (let ((buffer (generate-new-buffer " *calendar-sync-worker*"))) + (make-process + :name "calendar-sync-worker" + :buffer buffer + :command (calendar-sync--worker-command ics-file output-file) + :sentinel + (lambda (process _event) + (when (memq (process-status process) '(exit signal)) + (let* ((buf (process-buffer process)) + (success (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0))) + (error-message + (when (buffer-live-p buf) + (with-current-buffer buf + (string-trim (buffer-string)))))) + (when (file-exists-p ics-file) + (delete-file ics-file)) + (when (buffer-live-p buf) + (kill-buffer buf)) + (funcall callback success error-message)))))) + (error + (when (file-exists-p ics-file) + (delete-file ics-file)) + (funcall callback nil (error-message-string err))))) + +(defun calendar-sync--mark-sync-failed (name reason) + "Record failed sync state for calendar NAME with REASON." + (calendar-sync--set-calendar-state + name + (list :status 'error + :last-sync (plist-get (calendar-sync--get-calendar-state name) :last-sync) + :last-error reason)) + (calendar-sync--save-state) + (message "calendar-sync: [%s] Sync failed (see *Messages*)" name)) + +;;; Google Calendar API Fetch Path + +(defun calendar-sync--api-script () + "Return the absolute path to the Google Calendar API helper script. +Resolved relative to this module so batch workers and tests don't depend +on `user-emacs-directory'." + (let ((module-dir (file-name-directory calendar-sync--module-file))) + (expand-file-name "calendar_sync_api.py" + (expand-file-name "scripts" + (file-name-parent-directory module-dir))))) + +(defun calendar-sync--api-command (account calendar-id output-file) + "Build the command list that runs the API helper. +ACCOUNT and CALENDAR-ID select the OAuth account and calendar; OUTPUT-FILE +is where the helper writes rendered org content. The past/future window +mirrors the .ics path's `calendar-sync-past-months' / +`calendar-sync-future-months'. When `calendar-sync-skip-declined' is nil, +passes --keep-declined so the API path honors the same toggle." + (append + (list calendar-sync-python-command + (calendar-sync--api-script) + "--account" account + "--calendar-id" calendar-id + "--output" output-file + "--past-months" (number-to-string calendar-sync-past-months) + "--future-months" (number-to-string calendar-sync-future-months)) + (unless calendar-sync-skip-declined + (list "--keep-declined")))) + +(defun calendar-sync--sync-calendar-api (calendar) + "Sync a single Google CALENDAR via the API helper script. +CALENDAR is a plist with :name, :account, :calendar-id, and :file keys. +The helper fetches, filters, and renders org in one pass and writes :file +directly, so it runs in a single external process off the interactive thread." + (let* ((name (plist-get calendar :name)) + (account (plist-get calendar :account)) + (calendar-id (plist-get calendar :calendar-id)) + (file (plist-get calendar :file)) + (fetch-start (float-time))) + (calendar-sync--set-calendar-state name '(:status syncing)) + (calendar-sync--log-silently "calendar-sync: [%s] Syncing (API)..." name) + (condition-case err + (let ((buffer (generate-new-buffer " *calendar-sync-api*"))) + (make-process + :name "calendar-sync-api" + :buffer buffer + :command (calendar-sync--api-command account calendar-id file) + :sentinel + (lambda (process _event) + (when (memq (process-status process) '(exit signal)) + (let* ((buf (process-buffer process)) + (success (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0))) + (output (when (buffer-live-p buf) + (with-current-buffer buf + (string-trim (buffer-string)))))) + (when (buffer-live-p buf) + (kill-buffer buf)) + (if (not success) + (calendar-sync--mark-sync-failed + name (if (or (null output) (string-empty-p output)) + "API helper failed" + output)) + (calendar-sync--set-calendar-state + name + (list :status 'ok + :last-sync (current-time) + :last-error nil)) + (setq calendar-sync--last-timezone-offset + (calendar-sync--current-timezone-offset)) + (calendar-sync--save-state) + (let ((total-elapsed (- (float-time) fetch-start))) + (message "calendar-sync: [%s] Sync complete (%.1fs total) → %s" + name total-elapsed file)))))))) + (error + (calendar-sync--log-silently "calendar-sync: [%s] API helper error: %s" + name (error-message-string err)) + (calendar-sync--mark-sync-failed name (error-message-string err)))))) + +;;; .ics Sync Path + +(defun calendar-sync--calendar-url (calendar) + "Return the .ics feed URL for CALENDAR, or nil if none is configured. +An explicit :url wins. Otherwise :secret-host names an auth-source host +whose stored secret is the URL (kept in auth-source because the .ics URL +is itself a token)." + (or (plist-get calendar :url) + (when-let* ((host (plist-get calendar :secret-host))) + (cj/auth-source-secret-value host)))) + +(defun calendar-sync--sync-calendar-ics (calendar) + "Sync a single CALENDAR from its .ics feed asynchronously. +CALENDAR is a plist with :name, :file, and a feed URL resolved by +`calendar-sync--calendar-url' (an explicit :url, or a :secret-host +looked up in auth-source)." + (let ((name (plist-get calendar :name)) + (url (calendar-sync--calendar-url calendar)) + (file (plist-get calendar :file)) + (fetch-start (float-time))) + (calendar-sync--set-calendar-state name '(:status syncing)) + (calendar-sync--log-silently "calendar-sync: [%s] Syncing..." name) + (calendar-sync--fetch-ics-file + url + (lambda (ics-file) + (let ((fetch-elapsed (- (float-time) fetch-start))) + (if (null ics-file) + (progn + (calendar-sync--log-silently "calendar-sync: [%s] Fetch failed" name) + (calendar-sync--mark-sync-failed name "Fetch failed")) + (when (calendar-sync--debug-p) + (calendar-sync--log-silently "calendar-sync: [%s] Fetched in %.1fs" + name fetch-elapsed)) + (calendar-sync--convert-ics-file-async + ics-file + file + (lambda (success error-message) + (if (not success) + (progn + (calendar-sync--log-silently "calendar-sync: [%s] Conversion failed: %s" + name error-message) + (calendar-sync--mark-sync-failed + name + (if (or (null error-message) + (string-empty-p error-message)) + "Conversion failed" + error-message))) + (calendar-sync--set-calendar-state + name + (list :status 'ok + :last-sync (current-time) + :last-error nil)) + (setq calendar-sync--last-timezone-offset + (calendar-sync--current-timezone-offset)) + (calendar-sync--save-state) + (let ((total-elapsed (- (float-time) fetch-start))) + (message "calendar-sync: [%s] Sync complete (%.1fs total) → %s" + name total-elapsed file))))))))))) + +(provide 'calendar-sync-source) +;;; calendar-sync-source.el ends here diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index c0e0e935a..297d1fe61 100644 --- a/modules/calendar-sync.el +++ b/modules/calendar-sync.el @@ -8,75 +8,22 @@ ;; Layer: 3 (Domain Workflow). ;; Category: D/S. ;; Load shape: eager only when calendar-sync.local.el configures calendars. -;; Eager reason: daily-driver workflow; calendars are expected synced at the -;; first session. Timers and network fetches are guarded for batch/test loads. -;; Top-level side effects: defines a calendar keymap and conditionally registers -;; it under cj/custom-keymap; timer and network fetches guarded by -;; config/noninteractive checks. -;; Runtime requires: cl-lib, subr-x, system-lib, cj-org-text-lib, keybindings. -;; Direct test load: yes (private config optional; degrades cleanly when absent). +;; Eager reason: daily agenda workflow; timers and network fetches are guarded. +;; Top-level side effects: defines C-; g map; starts sync only when configured. +;; Runtime requires: cl-lib, subr-x, system-lib, cj-org-text-lib, keybindings, +;; calendar-sync-ics, calendar-sync-recurrence, calendar-sync-org, +;; calendar-sync-source. +;; Direct test load: yes. ;; -;; Simple, reliable one-way sync from multiple calendars to Org mode. -;; Downloads .ics files from calendar URLs (Google, Proton, etc.) and -;; converts to Org format. No OAuth, no API complexity, just file conversion. +;; One-way calendar synchronization from configured .ics/API sources into Org +;; files. Feed URLs may be inline or resolved from auth-source via :secret-host. ;; -;; Features: -;; - Multi-calendar support (sync multiple calendars to separate files) -;; - Pure Emacs Lisp .ics parser (no external dependencies) -;; - Recurring event support (RRULE expansion) -;; - Timer-based automatic sync (every 60 minutes, configurable) -;; - Self-contained in .emacs.d (no cron, portable across machines) -;; - Read-only (can't corrupt source calendars) -;; - Works with Chime for event notifications -;; -;; Recurring Events (RRULE): -;; -;; Calendar recurring events are defined once with an RRULE -;; (recurrence rule) rather than as individual event instances. This -;; module expands recurring events into individual org entries. -;; -;; Expansion uses a rolling window approach: -;; - Past: 3 months before today -;; - Future: 12 months after today -;; -;; Every sync regenerates the entire file based on the current date, -;; so the window automatically advances as time passes. Old events -;; naturally fall off after 3 months, and new future events appear -;; as you approach them. -;; -;; Supported RRULE patterns: -;; - FREQ=DAILY: Daily events -;; - FREQ=WEEKLY;BYDAY=MO,WE,FR: Weekly on specific days -;; - FREQ=MONTHLY: Monthly events (same day each month) -;; - FREQ=YEARLY: Yearly events (anniversaries, birthdays) -;; - INTERVAL: Repeat every N periods (e.g., every 2 weeks) -;; - UNTIL: End date for recurrence -;; - COUNT: Maximum occurrences (combined with date range limit) -;; -;; Setup: -;; 1. Configure calendars in your init.el: -;; (setq calendar-sync-calendars -;; '((:name "google" -;; :url "https://calendar.google.com/calendar/ical/.../basic.ics" -;; :file gcal-file) -;; (:name "proton" -;; :url "https://calendar.proton.me/api/calendar/v1/url/.../calendar.ics" -;; :file pcal-file))) -;; -;; 2. Load and start: -;; (require 'calendar-sync) -;; (calendar-sync-start) -;; -;; 3. Add to org-agenda (optional): -;; (dolist (cal calendar-sync-calendars) -;; (add-to-list 'org-agenda-files (plist-get cal :file))) -;; -;; Usage: -;; - M-x calendar-sync-now ; Sync all or select specific calendar -;; - M-x calendar-sync-start ; Start auto-sync -;; - M-x calendar-sync-stop ; Stop auto-sync -;; - M-x calendar-sync-toggle ; Toggle auto-sync -;; - M-x calendar-sync-status ; Show sync status for all calendars +;; This is the public face of the module: it owns configuration, the parse +;; pipeline orchestrator, the sync dispatch, the user commands, the timer, and +;; the C-; g keymap. The parsing, recurrence expansion, Org rendering, and +;; fetch/worker code live in the calendar-sync-ics / -recurrence / -org / +;; -source layers, which this module requires. Every public name is unchanged +;; so existing (require 'calendar-sync) callers and tests keep working. ;;; Code: @@ -85,12 +32,10 @@ (require 'system-lib) ;; provides cj/auth-source-secret-value (leaf; no ai-config dep) (require 'cj-org-text-lib) (require 'keybindings) ;; provides cj/custom-keymap - -(defun calendar-sync--log-silently (format-string &rest args) - "Log FORMAT-STRING with ARGS without requiring the full config." - (if (fboundp 'cj/log-silently) - (apply #'cj/log-silently format-string args) - (apply #'message format-string args))) +(require 'calendar-sync-ics) +(require 'calendar-sync-recurrence) +(require 'calendar-sync-org) +(require 'calendar-sync-source) ;;; Configuration @@ -198,1017 +143,7 @@ without loading the user's init file.") (defvar calendar-sync--timer nil "Timer object for automatic syncing.") -(defvar calendar-sync--calendar-states (make-hash-table :test 'equal) - "Per-calendar sync state. -Hash table mapping calendar name (string) to state plist with: - :last-sync - Time of last successful sync - :status - Symbol: ok, error, or syncing - :last-error - Error message string, or nil") - -(defvar calendar-sync--last-timezone-offset nil - "Timezone offset in seconds from UTC at last sync. -Used to detect timezone changes (e.g., when traveling).") - -(defvar calendar-sync--state-file - (expand-file-name "persist/calendar-sync-state.el" user-emacs-directory) - "File to persist sync state across Emacs sessions.") - -;;; Timezone Detection - -(defun calendar-sync--current-timezone-offset () - "Get current timezone offset in seconds from UTC. -Returns negative for west of UTC, positive for east. -Example: -21600 for CST (UTC-6), -28800 for PST (UTC-8)." - (car (current-time-zone))) - -(defun calendar-sync--format-timezone-offset (offset) - "Format timezone OFFSET (in seconds) as human-readable string. -Example: -21600 → `UTC-6' or `UTC-6:00'." - (if (null offset) - "unknown" - (let* ((hours (/ offset 3600)) - (minutes (abs (mod (/ offset 60) 60))) - (sign (if (>= hours 0) "+" "-")) - (abs-hours (abs hours))) - (if (= minutes 0) - (format "UTC%s%d" sign abs-hours) - (format "UTC%s%d:%02d" sign abs-hours minutes))))) - -(defun calendar-sync--timezone-changed-p () - "Return t if timezone has changed since last sync." - (and calendar-sync--last-timezone-offset - (not (= (calendar-sync--current-timezone-offset) - calendar-sync--last-timezone-offset)))) - -;;; State Persistence - -(defun calendar-sync--save-state () - "Save sync state to disk for persistence across sessions." - (let* ((calendar-states-alist - (let ((result '())) - (maphash (lambda (name state) - (push (cons name state) result)) - calendar-sync--calendar-states) - result)) - (state `((timezone-offset . ,calendar-sync--last-timezone-offset) - (calendar-states . ,calendar-states-alist))) - (dir (file-name-directory calendar-sync--state-file))) - (unless (file-directory-p dir) - (make-directory dir t)) - (let ((tmp (make-temp-file (expand-file-name ".calendar-sync-state-" dir)))) - (with-temp-file tmp - (prin1 state (current-buffer))) - (rename-file tmp calendar-sync--state-file t)))) - -(defun calendar-sync--load-state () - "Load sync state from disk." - (when (file-exists-p calendar-sync--state-file) - (condition-case err - (with-temp-buffer - (insert-file-contents calendar-sync--state-file) - (let ((state (read (current-buffer)))) - (setq calendar-sync--last-timezone-offset - (alist-get 'timezone-offset state)) - ;; Load per-calendar states - (let ((cal-states (alist-get 'calendar-states state))) - (clrhash calendar-sync--calendar-states) - (dolist (entry cal-states) - (puthash (car entry) (cdr entry) calendar-sync--calendar-states))))) - (error - (calendar-sync--log-silently "calendar-sync: Error loading state: %s" (error-message-string err)))))) - -(defun calendar-sync--get-calendar-state (calendar-name) - "Get state plist for CALENDAR-NAME, or nil if not found." - (gethash calendar-name calendar-sync--calendar-states)) - -(defun calendar-sync--set-calendar-state (calendar-name state) - "Set STATE plist for CALENDAR-NAME." - (puthash calendar-name state calendar-sync--calendar-states)) - -;;; Line Ending Normalization - -(defun calendar-sync--normalize-line-endings (content) - "Normalize line endings in CONTENT to Unix format (LF only). -Removes all carriage return characters (\\r) from CONTENT. -The iCalendar format (RFC 5545) uses CRLF line endings, but Emacs -and `org-mode' expect LF only. This function ensures consistent line -endings throughout the parsing pipeline. - -Returns CONTENT with all \\r characters removed." - (if (not (stringp content)) - content - (replace-regexp-in-string "\r" "" content))) - -;;; Text Cleaning (ICS unescape + HTML strip) - -(defun calendar-sync--unescape-ics-text (text) - "Unescape RFC 5545 escape sequences in TEXT. -Converts: \\n→newline, \\,→comma, \\\\→backslash, \\;→semicolon. -Returns nil for nil input." - (when text - ;; Use placeholder for literal backslash to avoid double-unescaping. - ;; replace-regexp-in-string with LITERAL=t avoids backslash interpretation. - (let ((result (replace-regexp-in-string "\\\\\\\\" "\000" text))) - (setq result (replace-regexp-in-string "\\\\n" "\n" result t t)) - (setq result (replace-regexp-in-string "\\\\," "," result t t)) - (setq result (replace-regexp-in-string "\\\\;" ";" result t t)) - (replace-regexp-in-string "\000" "\\" result t t)))) - -(defun calendar-sync--strip-html (text) - "Strip HTML tags from TEXT and decode common HTML entities. -Converts <br>, <br/>, <br /> to newlines. Strips all other tags. -Decodes & < > ". Collapses excessive blank lines. -Returns nil for nil input." - (when text - (let ((result text)) - ;; Convert <br> variants to newline (must come before tag stripping) - (setq result (replace-regexp-in-string "<br[ \t]*/?>[ \t]*" "\n" result)) - ;; Strip all remaining HTML tags - (setq result (replace-regexp-in-string "<[^>]*>" "" result)) - ;; Decode HTML entities - (setq result (replace-regexp-in-string "&" "&" result)) - (setq result (replace-regexp-in-string "<" "<" result)) - (setq result (replace-regexp-in-string ">" ">" result)) - (setq result (replace-regexp-in-string """ "\"" result)) - ;; Collapse 3+ consecutive newlines to 2 - (setq result (replace-regexp-in-string "\n\\{3,\\}" "\n\n" result)) - result))) - -(defun calendar-sync--clean-text (text) - "Clean TEXT by unescaping ICS sequences, stripping HTML, and trimming. -Returns nil for nil input. Returns empty string for whitespace-only input." - (when text - (string-trim (calendar-sync--strip-html (calendar-sync--unescape-ics-text text))))) - -;;; Date Utilities - -(defun calendar-sync--add-months (date months) - "Add MONTHS to DATE. -DATE is (year month day), returns new (year month day)." - (let* ((year (nth 0 date)) - (month (nth 1 date)) - (day (nth 2 date)) - (total-months (+ (* year 12) month -1 months)) - (new-year (/ total-months 12)) - (new-month (1+ (mod total-months 12)))) - (list new-year new-month day))) - -(defun calendar-sync--get-date-range () - "Get date range for event expansion as (start-time end-time). -Returns time values for -3 months and +12 months from today." - (let* ((now (decode-time)) - (today (list (nth 5 now) (nth 4 now) (nth 3 now))) - (start-date (calendar-sync--add-months today (- calendar-sync-past-months))) - (end-date (calendar-sync--add-months today calendar-sync-future-months)) - (start-time (apply #'encode-time 0 0 0 (reverse start-date))) - (end-time (apply #'encode-time 0 0 0 (reverse end-date)))) - (list start-time end-time))) - -(defun calendar-sync--date-in-range-p (date range) - "Check if DATE is within RANGE. -DATE is (year month day hour minute), RANGE is (start-time end-time)." - (let* ((year (nth 0 date)) - (month (nth 1 date)) - (day (nth 2 date)) - (date-time (encode-time 0 0 0 day month year)) - (start-time (nth 0 range)) - (end-time (nth 1 range))) - (and (time-less-p start-time date-time) - (time-less-p date-time end-time)))) - -(defun calendar-sync--weekday-to-number (weekday) - "Convert WEEKDAY string (MO, TU, etc.) to number (1-7). -Monday = 1, Sunday = 7." - (pcase weekday - ("MO" 1) - ("TU" 2) - ("WE" 3) - ("TH" 4) - ("FR" 5) - ("SA" 6) - ("SU" 7) - (_ nil))) - -(defun calendar-sync--date-weekday (date) - "Get weekday number for DATE (year month day). -Monday = 1, Sunday = 7." - (let* ((year (nth 0 date)) - (month (nth 1 date)) - (day (nth 2 date)) - (time (encode-time 0 0 0 day month year)) - (decoded (decode-time time)) - (dow (nth 6 decoded))) ; 0 = Sunday, 1 = Monday, etc. - (if (= dow 0) 7 dow))) ; Convert to 1-7 with Monday=1 - -(defun calendar-sync--add-days (date days) - "Add DAYS to DATE (year month day). -Returns new (year month day). -Uses noon internally to avoid DST boundary issues where adding -86400 seconds to midnight can land on the same calendar date -during fall-back transitions." - (let* ((year (nth 0 date)) - (month (nth 1 date)) - (day (nth 2 date)) - (time (encode-time 0 0 12 day month year)) - (new-time (time-add time (days-to-time days))) - (decoded (decode-time new-time))) - (list (nth 5 decoded) (nth 4 decoded) (nth 3 decoded)))) - -;;; RECURRENCE-ID Exception Handling - -(defun calendar-sync--get-recurrence-id (event-str) - "Extract RECURRENCE-ID value from EVENT-STR. -Returns the datetime value (without TZID parameter), or nil if not found. -Handles both simple values and values with parameters like TZID." - (when (and event-str (stringp event-str)) - (calendar-sync--get-property event-str "RECURRENCE-ID"))) - -(defun calendar-sync--get-recurrence-id-line (event-str) - "Extract full RECURRENCE-ID line from EVENT-STR, including parameters. -Returns the complete line like -`RECURRENCE-ID;TZID=Europe/Tallinn:20260203T170000'. -Returns nil if not found." - (when (and event-str (stringp event-str)) - (calendar-sync--get-property-line event-str "RECURRENCE-ID"))) - -(defun calendar-sync--parse-ics-datetime (value) - "Parse iCal datetime VALUE into (year month day hour minute) list. -Returns nil for invalid input. For date-only values, returns -(year month day nil nil). -Handles formats: 20260203T090000Z, 20260203T090000, 20260203." - (when (and value - (stringp value) - (not (string-empty-p value))) - (cond - ;; DateTime format: 20260203T090000Z or 20260203T090000 - ((string-match "\\`\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)T\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)Z?\\'" value) - (list (string-to-number (match-string 1 value)) - (string-to-number (match-string 2 value)) - (string-to-number (match-string 3 value)) - (string-to-number (match-string 4 value)) - (string-to-number (match-string 5 value)))) - ;; Date-only format: 20260203 - ((string-match "\\`\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)\\'" value) - (list (string-to-number (match-string 1 value)) - (string-to-number (match-string 2 value)) - (string-to-number (match-string 3 value)) - nil nil)) - (t nil)))) - -(defalias 'calendar-sync--parse-recurrence-id #'calendar-sync--parse-ics-datetime - "Parse RECURRENCE-ID value. See `calendar-sync--parse-ics-datetime'.") - -(defun calendar-sync--parse-exception-event (event-str) - "Parse a RECURRENCE-ID override EVENT-STR into an exception plist, or nil. -Returns nil when EVENT-STR carries no RECURRENCE-ID, or its recurrence-id / -start time fail to parse. The plist holds :recurrence-id (localized), -:recurrence-id-raw, :start, :end, :summary, :description, :location." - (let ((recurrence-id (calendar-sync--get-recurrence-id event-str))) - (when recurrence-id - (let* ((recurrence-id-line (calendar-sync--get-recurrence-id-line event-str)) - (recurrence-id-tzid (calendar-sync--extract-tzid recurrence-id-line)) - (recurrence-id-is-utc (string-suffix-p "Z" recurrence-id)) - (recurrence-id-parsed (calendar-sync--parse-recurrence-id recurrence-id)) - ;; Parse the new times from the exception - (dtstart (calendar-sync--get-property event-str "DTSTART")) - (dtend (calendar-sync--get-property event-str "DTEND")) - (dtstart-line (calendar-sync--get-property-line event-str "DTSTART")) - (dtend-line (calendar-sync--get-property-line event-str "DTEND")) - (start-tzid (calendar-sync--extract-tzid dtstart-line)) - (end-tzid (calendar-sync--extract-tzid dtend-line)) - (start-parsed (calendar-sync--parse-timestamp dtstart start-tzid)) - (end-parsed (and dtend (calendar-sync--parse-timestamp dtend end-tzid))) - (summary (calendar-sync--clean-text - (calendar-sync--get-property event-str "SUMMARY"))) - (description (calendar-sync--clean-text - (calendar-sync--get-property event-str "DESCRIPTION"))) - (location (calendar-sync--clean-text - (calendar-sync--get-property event-str "LOCATION")))) - (when (and recurrence-id-parsed start-parsed) - (list :recurrence-id (calendar-sync--localize-parsed-datetime - recurrence-id-parsed recurrence-id-is-utc recurrence-id-tzid) - :recurrence-id-raw recurrence-id - :start start-parsed - :end end-parsed - :summary summary - :description description - :location location)))))) - -(defun calendar-sync--collect-recurrence-exceptions (ics-content) - "Collect all RECURRENCE-ID events from ICS-CONTENT. -Returns hash table mapping UID to list of exception event plists. -Each exception plist contains :recurrence-id (parsed), :start, :end, -:summary, etc." - (let ((exceptions (make-hash-table :test 'equal))) - (when (and ics-content (stringp ics-content)) - (dolist (event-str (calendar-sync--split-events ics-content)) - (let ((uid (calendar-sync--get-property event-str "UID")) - (exception-plist (calendar-sync--parse-exception-event event-str))) - (when (and uid exception-plist) - (puthash uid - (cons exception-plist (gethash uid exceptions)) - exceptions))))) - exceptions)) - -(defun calendar-sync--occurrence-matches-exception-p (occurrence exception) - "Check if OCCURRENCE matches EXCEPTION's recurrence-id. -Compares year, month, day, hour, minute." - (let ((occ-start (plist-get occurrence :start)) - (exc-recid (plist-get exception :recurrence-id))) - (and occ-start exc-recid - (= (nth 0 occ-start) (nth 0 exc-recid)) ; year - (= (nth 1 occ-start) (nth 1 exc-recid)) ; month - (= (nth 2 occ-start) (nth 2 exc-recid)) ; day - ;; Hour/minute check (handle nil for all-day events) - (or (and (null (nth 3 occ-start)) (null (nth 3 exc-recid))) - (and (nth 3 occ-start) (nth 3 exc-recid) - (= (nth 3 occ-start) (nth 3 exc-recid)) - (= (or (nth 4 occ-start) 0) (or (nth 4 exc-recid) 0))))))) - -(defun calendar-sync--apply-single-exception (occurrence exception) - "Apply EXCEPTION to OCCURRENCE, returning modified occurrence." - (let ((result (copy-sequence occurrence))) - ;; Update time from exception - (plist-put result :start (plist-get exception :start)) - (when (plist-get exception :end) - (plist-put result :end (plist-get exception :end))) - ;; Update summary if exception has one - (when (plist-get exception :summary) - (plist-put result :summary (plist-get exception :summary))) - ;; Update other fields - (when (plist-get exception :description) - (plist-put result :description (plist-get exception :description))) - (when (plist-get exception :location) - (plist-put result :location (plist-get exception :location))) - ;; Pass through new fields if exception overrides them - (when (plist-get exception :attendees) - (plist-put result :attendees (plist-get exception :attendees)) - ;; Re-derive the user's status from the overridden attendees so a - ;; singly-declined occurrence drops its inherited series "accepted" - ;; (otherwise `calendar-sync--filter-declined' can't drop it). Leave the - ;; inherited status when the override doesn't name the user. - (let ((status (calendar-sync--find-user-status - (plist-get exception :attendees) calendar-sync-user-emails))) - (when status - (plist-put result :status status)))) - (when (plist-get exception :organizer) - (plist-put result :organizer (plist-get exception :organizer))) - (when (plist-get exception :url) - (plist-put result :url (plist-get exception :url))) - result)) - -(defun calendar-sync--apply-recurrence-exceptions (occurrences exceptions) - "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." - (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))) - -;;; EXDATE (Excluded Date) Handling - -(defun calendar-sync--get-exdates (event-str) - "Extract all EXDATE values from EVENT-STR. -Returns list of datetime strings (without TZID parameters), or nil if -none found. -Handles both simple values and values with parameters like TZID." - (when (and event-str (stringp event-str) (not (string-empty-p event-str))) - (let ((exdates '()) - (pos 0)) - ;; Find all EXDATE lines - (while (string-match "^EXDATE[^:\n]*:\\([^\n]+\\)" event-str pos) - (push (match-string 1 event-str) exdates) - (setq pos (match-end 0))) - (nreverse exdates)))) - -(defun calendar-sync--get-exdate-line (event-str exdate-value) - "Find the full EXDATE line containing EXDATE-VALUE from EVENT-STR. -Returns the complete line like -`EXDATE;TZID=America/New_York:20260210T130000'. -Returns nil if not found." - (when (and event-str (stringp event-str) exdate-value) - (let ((pattern (format "^\\(EXDATE[^:]*:%s\\)" (regexp-quote exdate-value)))) - (when (string-match pattern event-str) - (match-string 1 event-str))))) - -(defalias 'calendar-sync--parse-exdate #'calendar-sync--parse-ics-datetime - "Parse EXDATE value. See `calendar-sync--parse-ics-datetime'.") - -(defun calendar-sync--collect-exdates (event-str) - "Collect all excluded dates from EVENT-STR, handling timezone conversion. -Returns list of parsed datetime lists (year month day hour minute). -Converts TZID-qualified and UTC times to local time." - (if (or (null event-str) - (not (stringp event-str)) - (string-empty-p event-str)) - '() - (let ((exdate-values (calendar-sync--get-exdates event-str)) - (result '())) - (dolist (exdate-value exdate-values) - (let* ((exdate-line (calendar-sync--get-exdate-line event-str exdate-value)) - (exdate-tzid (and exdate-line (calendar-sync--extract-tzid exdate-line))) - (exdate-is-utc (and exdate-value (string-suffix-p "Z" exdate-value))) - (exdate-parsed (calendar-sync--parse-exdate exdate-value))) - (when exdate-parsed - (push (calendar-sync--localize-parsed-datetime - exdate-parsed exdate-is-utc exdate-tzid) - result)))) - (nreverse result)))) - -(defun calendar-sync--exdate-matches-p (occurrence-start exdate) - "Check if OCCURRENCE-START matches EXDATE. -OCCURRENCE-START is (year month day hour minute). -EXDATE is (year month day hour minute) or (year month day nil nil) for -date-only. -Date-only EXDATE matches any time on that day." - (and occurrence-start exdate - (= (nth 0 occurrence-start) (nth 0 exdate)) ; year - (= (nth 1 occurrence-start) (nth 1 exdate)) ; month - (= (nth 2 occurrence-start) (nth 2 exdate)) ; day - ;; If EXDATE has nil hour/minute (date-only), match any time - (or (null (nth 3 exdate)) - (and (nth 3 occurrence-start) - (= (nth 3 occurrence-start) (nth 3 exdate)) - (= (or (nth 4 occurrence-start) 0) (or (nth 4 exdate) 0)))))) - -(defun calendar-sync--filter-exdates (occurrences exdates) - "Filter OCCURRENCES list to remove entries matching EXDATES. -OCCURRENCES is list of event plists with :start key. -EXDATES is list of parsed datetime lists from `calendar-sync--collect-exdates'. -Returns filtered list with excluded dates removed." - (if (or (null occurrences) (null exdates)) - (or occurrences '()) - (cl-remove-if - (lambda (occurrence) - (let ((occ-start (plist-get occurrence :start))) - (cl-some (lambda (exdate) - (calendar-sync--exdate-matches-p occ-start exdate)) - exdates))) - occurrences))) - -;;; .ics Parsing - -(defun calendar-sync--split-events (ics-content) - "Split ICS-CONTENT into individual VEVENT blocks. -Returns list of strings, each containing one VEVENT block." - (let ((events '())) - (with-temp-buffer - (insert ics-content) - (goto-char (point-min)) - (while (search-forward "BEGIN:VEVENT" nil t) - (let ((start (match-beginning 0))) - (when (search-forward "END:VEVENT" nil t) - (push (buffer-substring-no-properties start (point)) events))))) - (nreverse events))) - -(defun calendar-sync--unfold-continuation (text value start) - "Unfold RFC 5545 continuation lines from TEXT starting at START. -VALUE is the initial content to append to. Continuation lines begin -with a space or tab after a newline. Returns (unfolded-value . new-pos)." - (while (and (< start (length text)) - (string-match "\n[ \t]\\([^\n]*\\)" text start) - (= (match-beginning 0) start)) - (setq value (concat value (match-string 1 text))) - (setq start (match-end 0))) - (cons value start)) - -(defun calendar-sync--get-property (event property) - "Extract PROPERTY value from EVENT string. -Handles property parameters (e.g., DTSTART;TZID=America/Chicago:value). -Handles multi-line values (lines starting with space). -Returns nil if property not found." - (when (string-match (format "^%s[^:\n]*:\\(.*\\)$" (regexp-quote property)) event) - (car (calendar-sync--unfold-continuation - event (match-string 1 event) (match-end 0))))) - -(defun calendar-sync--get-property-line (event property) - "Extract full PROPERTY line from EVENT string, including parameters. -Returns the complete line like -`DTSTART;TZID=Europe/Lisbon:20260202T190000'. -Returns nil if property not found." - (when (string-match (format "^\\(%s[^\n]*\\)$" (regexp-quote property)) event) - (match-string 1 event))) - -(defun calendar-sync--get-all-property-lines (event property) - "Extract ALL lines matching PROPERTY from EVENT string. -Unlike `calendar-sync--get-property-line' which returns the first match, -this returns a list of all matching lines. Handles continuation lines -\(lines starting with space or tab). -Returns nil if EVENT or PROPERTY is nil, or no matches found." - (when (and event property (stringp event) (not (string-empty-p event))) - (let ((lines '()) - (pattern (format "^%s[^\n]*" (regexp-quote property))) - (pos 0)) - (while (string-match pattern event pos) - (let* ((result (calendar-sync--unfold-continuation - event (match-string 0 event) (match-end 0))) - (line (car result)) - (end (cdr result))) - (push line lines) - (setq pos (if (< end (length event)) (1+ end) end)))) - (nreverse lines)))) - -(defun calendar-sync--extract-cn (line) - "Extract and dequote CN parameter from iCal LINE. -Returns the CN value string, or nil if not found." - (when (string-match ";CN=\\([^;:]+\\)" line) - (let ((cn (match-string 1 line))) - (if (and (string-prefix-p "\"" cn) (string-suffix-p "\"" cn)) - (substring cn 1 -1) - cn)))) - -(defun calendar-sync--extract-email (line) - "Extract email address from mailto: value in iCal LINE. -Returns email string, or nil if not found." - (when (string-match "mailto:\\([^>\n ]+\\)" line) - (match-string 1 line))) - -(defun calendar-sync--parse-attendee-line (line) - "Parse single ATTENDEE LINE into plist. -Returns plist (:cn NAME :email EMAIL :partstat STATUS :role ROLE). -Returns nil for nil, empty, or malformed input." - (when (and line (stringp line) (not (string-empty-p line)) - (string-match-p "^ATTENDEE" line)) - (let ((cn (calendar-sync--extract-cn line)) - (email (calendar-sync--extract-email line)) - (partstat nil) - (role nil)) - (when (string-match ";PARTSTAT=\\([^;:]+\\)" line) - (setq partstat (match-string 1 line))) - (when (string-match ";ROLE=\\([^;:]+\\)" line) - (setq role (match-string 1 line))) - (when email - (list :cn cn :email email :partstat partstat :role role))))) - -(defun calendar-sync--find-user-status (attendees user-emails) - "Find user's PARTSTAT from ATTENDEES list using USER-EMAILS. -ATTENDEES is list of plists from `calendar-sync--parse-attendee-line'. -USER-EMAILS is list of email strings to match against. -Returns lowercase status string (\"accepted\", \"declined\", etc.) or nil." - (when (and attendees user-emails) - (let ((user-emails-lower (mapcar #'downcase user-emails)) - (found nil)) - (cl-dolist (attendee attendees) - (let ((attendee-email (downcase (or (plist-get attendee :email) "")))) - (when (member attendee-email user-emails-lower) - (let ((partstat (plist-get attendee :partstat))) - (when partstat - (setq found (downcase partstat)) - (cl-return found)))))) - found))) - -(defun calendar-sync--filter-declined (events) - "Return EVENTS with declined entries removed when the toggle is on. -EVENTS is a list of plists produced by `calendar-sync--parse-event'. -Each plist's :status is the lowercase PARTSTAT for the user (set by -`calendar-sync--find-user-status'), or nil for events without an -attendee block. Drops only events whose :status is exactly the string -\"declined\" so that nil / accepted / tentative / needs-action all -survive. When `calendar-sync-skip-declined' is nil, returns EVENTS -unchanged." - (if (and calendar-sync-skip-declined events) - (cl-remove-if (lambda (event) - (equal (plist-get event :status) "declined")) - events) - events)) - -(defun calendar-sync--parse-organizer (event-str) - "Parse ORGANIZER property from EVENT-STR into plist. -Returns plist (:cn NAME :email EMAIL), or nil if no ORGANIZER found." - (when (and event-str (stringp event-str)) - (let ((line (calendar-sync--get-property-line event-str "ORGANIZER"))) - (when line - (let ((email (calendar-sync--extract-email line))) - (when email - (list :cn (calendar-sync--extract-cn line) :email email))))))) - -(defun calendar-sync--extract-meeting-url (event-str) - "Extract meeting URL from EVENT-STR. -Prefers X-GOOGLE-CONFERENCE over URL property. -Returns URL string or nil." - (when (and event-str (stringp event-str)) - (or (calendar-sync--get-property event-str "X-GOOGLE-CONFERENCE") - (calendar-sync--get-property event-str "URL")))) - -(defun calendar-sync--extract-tzid (property-line) - "Extract TZID parameter value from PROPERTY-LINE. -PROPERTY-LINE is like `DTSTART;TZID=Europe/Lisbon:20260202T190000'. -Returns timezone string like `Europe/Lisbon', or nil if no TZID. -Returns nil for malformed lines (missing colon separator)." - (when (and property-line - (stringp property-line) - ;; Must have colon (property:value format) - (string-match-p ":" property-line) - (string-match ";TZID=\\([^;:]+\\)" property-line)) - (match-string 1 property-line))) - -(defun calendar-sync--convert-utc-to-local (year month day hour minute second) - "Convert UTC datetime to local time. -Returns list (year month day hour minute) in local timezone." - (let* ((utc-time (encode-time second minute hour day month year 0)) - (local-time (decode-time utc-time))) - (list (nth 5 local-time) ; year - (nth 4 local-time) ; month - (nth 3 local-time) ; day - (nth 2 local-time) ; hour - (nth 1 local-time)))) ; minute - -(defun calendar-sync--convert-tz-to-local (year month day hour minute source-tz) - "Convert datetime from SOURCE-TZ timezone to local time. -SOURCE-TZ is a timezone name like `Europe/Lisbon' or `Asia/Yerevan'. -Returns list (year month day hour minute) in local timezone, or nil on error. - -Uses Emacs built-in timezone support (encode-time/decode-time with ZONE -argument) for fast, subprocess-free conversion. Uses the same system -TZ database as the `date' command." - (when (and source-tz (not (string-empty-p source-tz))) - (condition-case err - (let* ((abs-time (encode-time 0 minute hour day month year source-tz)) - (local (decode-time abs-time))) - (list (nth 5 local) ; year - (nth 4 local) ; month - (nth 3 local) ; day - (nth 2 local) ; hour - (nth 1 local))) ; minute - (error - (calendar-sync--log-silently "calendar-sync: Error converting timezone %s: %s" - source-tz (error-message-string err)) - nil)))) - -(defun calendar-sync--localize-parsed-datetime (parsed is-utc tzid) - "Convert PARSED datetime to local time using timezone info. -PARSED is (year month day hour minute) or (year month day nil nil). -IS-UTC non-nil means the value had a Z suffix. - -TZID is a timezone string like \"Europe/Lisbon\", or nil. -Returns PARSED converted to local time, or PARSED unchanged if no -conversion needed." - (cond - (is-utc - (calendar-sync--convert-utc-to-local - (nth 0 parsed) (nth 1 parsed) (nth 2 parsed) - (or (nth 3 parsed) 0) (or (nth 4 parsed) 0) 0)) - (tzid - (or (calendar-sync--convert-tz-to-local - (nth 0 parsed) (nth 1 parsed) (nth 2 parsed) - (or (nth 3 parsed) 0) (or (nth 4 parsed) 0) - tzid) - parsed)) - (t parsed))) - -(defun calendar-sync--parse-timestamp (timestamp-str &optional tzid) - "Parse iCal timestamp string TIMESTAMP-STR. -Returns (year month day hour minute) or (year month day) for all-day events. -Converts UTC times (ending in Z) to local time. -If TZID is provided (e.g., `Europe/Lisbon'), converts from that timezone -to local. -Returns nil if parsing fails." - (cond - ;; DateTime format: 20251116T140000Z or 20251116T140000 - ((string-match "\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)T\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)\\(Z\\)?" timestamp-str) - (let* ((year (string-to-number (match-string 1 timestamp-str))) - (month (string-to-number (match-string 2 timestamp-str))) - (day (string-to-number (match-string 3 timestamp-str))) - (hour (string-to-number (match-string 4 timestamp-str))) - (minute (string-to-number (match-string 5 timestamp-str))) - (second (string-to-number (match-string 6 timestamp-str))) - (is-utc (match-string 7 timestamp-str))) - (cond - ;; UTC timestamp (Z suffix) - convert from UTC - (is-utc - (calendar-sync--convert-utc-to-local year month day hour minute second)) - ;; TZID provided - convert from that timezone - (tzid - (or (calendar-sync--convert-tz-to-local year month day hour minute tzid) - ;; Fallback to raw time if conversion fails - (list year month day hour minute))) - ;; No timezone info - assume local time - (t - (list year month day hour minute))))) - ;; Date format: 20251116 - ((string-match "\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)" timestamp-str) - (list (string-to-number (match-string 1 timestamp-str)) - (string-to-number (match-string 2 timestamp-str)) - (string-to-number (match-string 3 timestamp-str)))) - (t nil))) - -(defun calendar-sync--format-timestamp (start end) - "Format START and END timestamps as 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)) - (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 ">"))) - -;;; RRULE Parsing and Expansion - -;;; Helper Functions - -(defun calendar-sync--date-to-time (date) - "Convert DATE to time value for comparison. -DATE should be a list starting with (year month day ...). -Only the first three elements are used; extra elements (hour, minute) are -ignored." - (let ((day (nth 2 date)) - (month (nth 1 date)) - (year (nth 0 date))) - (encode-time 0 0 0 day month year))) - -(defun calendar-sync--before-date-p (date1 date2) - "Return t if DATE1 is before DATE2. -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--create-occurrence (base-event occurrence-date) - "Create an occurrence from BASE-EVENT with OCCURRENCE-DATE. -OCCURRENCE-DATE should be a list (year month day hour minute second)." - (let* ((occurrence (copy-sequence base-event)) - (end (plist-get base-event :end))) - (plist-put occurrence :start occurrence-date) - (when end - ;; Use the date from occurrence-date but keep the time from the original end - (let ((date-only (list (nth 0 occurrence-date) - (nth 1 occurrence-date) - (nth 2 occurrence-date)))) - (plist-put occurrence :end (append date-only (nthcdr 3 end))))) - occurrence)) - -(defun calendar-sync--parse-rrule (rrule-str) - "Parse RRULE string into plist. -Returns plist with :freq :interval :byday :until :count." - (let ((parts (split-string rrule-str ";")) - (result '())) - (dolist (part parts) - (when (string-match "\\([^=]+\\)=\\(.+\\)" part) - (let ((key (match-string 1 part)) - (value (match-string 2 part))) - (pcase key - ("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 ",")))) - ("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 - (unless (plist-get result :interval) - (setq result (plist-put result :interval 1))) - result)) - -(defun calendar-sync--expand-simple-recurrence (base-event rrule range advance-fn) - "Expand a simple (non-weekly) recurring event using ADVANCE-FN to step dates. -BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. -ADVANCE-FN takes (current-date interval) and returns the next date." - (let* ((start (plist-get base-event :start)) - (interval (plist-get rrule :interval)) - (until (plist-get rrule :until)) - (count (plist-get rrule :count)) - (occurrences '()) - (current-date (list (nth 0 start) (nth 1 start) (nth 2 start))) - (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)) - (or (not count) (< num-generated count))) - (let ((occurrence-datetime (append current-date (nthcdr 3 start)))) - (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 current-date (funcall advance-fn current-date interval))) - (nreverse occurrences))) - -(defun calendar-sync--expand-daily (base-event rrule range) - "Expand daily 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-days)) - -(defun calendar-sync--expand-weekly (base-event rrule range) - "Expand weekly recurring event. -BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." - (let* ((start (plist-get base-event :start)) - (interval (plist-get rrule :interval)) - (byday (plist-get rrule :byday)) - (until (plist-get rrule :until)) - (count (plist-get rrule :count)) - (occurrences '()) - (current-date (list (nth 0 start) (nth 1 start) (nth 2 start))) - (num-generated 0) - (range-end-time (cadr range)) - (max-iterations 1000) ;; Safety: prevent infinite loops - (iterations 0) - (weekdays (if byday - (mapcar #'calendar-sync--weekday-to-number byday) - (list (calendar-sync--date-weekday current-date))))) - ;; Validate interval - (when (<= interval 0) - (error "Invalid RRULE interval: %s (must be > 0)" interval)) - ;; Start from the first week - ;; For infinite recurrence (no COUNT/UNTIL), stop at range-end for performance - ;; For COUNT, generate all occurrences from start regardless of 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))) - (setq iterations (1+ iterations)) - ;; Generate occurrences for each weekday in this week - (dolist (weekday weekdays) - (let* ((current-weekday (calendar-sync--date-weekday current-date)) - (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 COUNT - increment BEFORE range check so COUNT is absolute from start - (when (or (not count) (< num-generated count)) - (setq num-generated (1+ num-generated)) - ;; Only add to output if within date range - (when (calendar-sync--date-in-range-p occurrence-datetime range) - (push (calendar-sync--create-occurrence base-event occurrence-datetime) - occurrences)))))) - ;; Move to next interval week - (setq current-date (calendar-sync--add-days current-date (* 7 interval)))) - (when (>= iterations max-iterations) - (calendar-sync--log-silently "calendar-sync: WARNING: Hit max iterations (%d) expanding weekly 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)) - -(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))))) - -(defun calendar-sync--expand-recurring-event (event-str range) - "Expand recurring event EVENT-STR into individual occurrences within RANGE. -Returns list of event plists, or nil if not a recurring event. -Filters out dates excluded via EXDATE properties." - (let ((rrule (calendar-sync--get-property event-str "RRULE"))) - (when rrule - (let* ((base-event (calendar-sync--parse-event event-str)) - (parsed-rrule (calendar-sync--parse-rrule rrule)) - (freq (plist-get parsed-rrule :freq)) - (exdates (calendar-sync--collect-exdates event-str))) - (when base-event - (let ((occurrences - (pcase freq - ('daily (calendar-sync--expand-daily base-event parsed-rrule range)) - ('weekly (calendar-sync--expand-weekly base-event parsed-rrule range)) - ('monthly (calendar-sync--expand-monthly base-event parsed-rrule range)) - ('yearly (calendar-sync--expand-yearly base-event parsed-rrule range)) - (_ (calendar-sync--log-silently "calendar-sync: Unsupported RRULE frequency: %s" freq) - nil)))) - ;; Filter out EXDATE occurrences - (if exdates - (calendar-sync--filter-exdates occurrences exdates) - occurrences))))))) - -(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). -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") - (let* ((uid (calendar-sync--get-property event-str "UID")) - (summary (calendar-sync--clean-text - (calendar-sync--get-property event-str "SUMMARY"))) - (description (calendar-sync--clean-text - (calendar-sync--get-property event-str "DESCRIPTION"))) - (location (calendar-sync--clean-text - (calendar-sync--get-property event-str "LOCATION"))) - ;; Get raw property values - (dtstart (calendar-sync--get-property event-str "DTSTART")) - (dtend (calendar-sync--get-property event-str "DTEND")) - ;; Extract TZID from property lines (if present) - (dtstart-line (calendar-sync--get-property-line event-str "DTSTART")) - (dtend-line (calendar-sync--get-property-line event-str "DTEND")) - (start-tzid (calendar-sync--extract-tzid dtstart-line)) - (end-tzid (calendar-sync--extract-tzid dtend-line)) - ;; Extract attendees - (attendee-lines (calendar-sync--get-all-property-lines event-str "ATTENDEE")) - (attendees (delq nil (mapcar #'calendar-sync--parse-attendee-line attendee-lines))) - ;; Extract organizer and URL - (organizer (calendar-sync--parse-organizer event-str)) - (url (calendar-sync--extract-meeting-url event-str)) - ;; Determine user status from attendees - (status (calendar-sync--find-user-status attendees calendar-sync-user-emails))) - (when (and summary dtstart) - (let ((start-parsed (calendar-sync--parse-timestamp dtstart start-tzid)) - (end-parsed (and dtend (calendar-sync--parse-timestamp dtend end-tzid)))) - (when start-parsed - (list :uid uid - :summary summary - :description description - :location location - :start start-parsed - :end end-parsed - :attendees attendees - :organizer organizer - :url url - :status status))))))) - -(defun calendar-sync--event-to-org (event) - "Convert parsed EVENT plist to org entry string. -Produces property drawer with LOCATION, ORGANIZER, STATUS, URL when present. -Description appears as body text after the drawer." - (let* ((summary (cj/org-sanitize-heading - (or (plist-get event :summary) "(No Title)"))) - (description (plist-get event :description)) - (location (plist-get event :location)) - (start (plist-get event :start)) - (end (plist-get event :end)) - (organizer (plist-get event :organizer)) - (status (plist-get event :status)) - (url (plist-get event :url)) - (timestamp (calendar-sync--format-timestamp start end)) - ;; Build property drawer entries - (props '())) - ;; Collect non-nil properties - (when (and location (not (string-empty-p location))) - (push (format ":LOCATION: %s" - (cj/org-sanitize-property-value location)) - props)) - (when organizer - (let ((org-name (or (plist-get organizer :cn) - (plist-get organizer :email)))) - (when org-name - (push (format ":ORGANIZER: %s" - (cj/org-sanitize-property-value org-name)) - props)))) - (when (and status (not (string-empty-p status))) - (push (format ":STATUS: %s" - (cj/org-sanitize-property-value status)) - props)) - (when (and url (not (string-empty-p url))) - (push (format ":URL: %s" - (cj/org-sanitize-property-value url)) - props)) - (setq props (nreverse props)) - ;; Build output - (let ((parts (list timestamp (format "* %s" summary)))) - ;; Add property drawer if any properties exist - (when props - (push ":PROPERTIES:" parts) - (dolist (prop props) - (push prop parts)) - (push ":END:" parts)) - ;; Add description as body text (sanitized to prevent org heading conflicts) - (when (and description (not (string-empty-p description))) - (push (cj/org-sanitize-body-text description) parts)) - (string-join (nreverse parts) "\n")))) - -(defun calendar-sync--event-start-time (event) - "Extract comparable start time from EVENT plist. -Returns time value suitable for comparison, or 0 if no start time." - (let ((start (plist-get event :start))) - (if start - (apply #'encode-time - 0 ; second - (or (nth 4 start) 0) ; minute - (or (nth 3 start) 0) ; hour - (nth 2 start) ; day - (nth 1 start) ; month - (nth 0 start) ; year - nil) - 0))) +;;; Parsing orchestration (defun calendar-sync--parse-ics (ics-content) "Parse ICS-CONTENT and return org-formatted string. @@ -1267,277 +202,7 @@ RECURRENCE-ID exceptions are applied to override specific occurrences." (calendar-sync--log-silently "calendar-sync: Parse error: %s" (error-message-string err)) nil))) -;;; Sync functions - -(defun calendar-sync--fetch-ics (url callback) - "Fetch .ics file from URL asynchronously using curl. -Calls CALLBACK with the .ics content as string (normalized to Unix line endings) -or nil on error. CALLBACK signature: (lambda (content) ...). - -The fetch happens asynchronously and doesn't block Emacs. The callback is -invoked when the fetch completes, either successfully or with an error." - (condition-case err - (let ((buffer (generate-new-buffer " *calendar-sync-curl*"))) - (make-process - :name "calendar-sync-curl" - :buffer buffer - :command (list "curl" "-s" "-L" "--fail" - "--connect-timeout" "10" - "--max-time" (number-to-string calendar-sync-fetch-timeout) - url) - :sentinel - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (let ((buf (process-buffer process))) - (when (buffer-live-p buf) - (let ((content - (with-current-buffer buf - (if (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)) - (calendar-sync--normalize-line-endings (buffer-string)) - (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" (string-trim event)) - nil)))) - (kill-buffer buf) - (funcall callback content)))))))) - (error - (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) - (funcall callback nil)))) - -(defun calendar-sync--fetch-ics-file (url callback) - "Fetch .ics from URL to a temp file asynchronously. -Calls CALLBACK with the temp file path on success, or nil on error. The caller -owns deleting the temp file after a successful callback." - (condition-case err - (let ((buffer (generate-new-buffer " *calendar-sync-curl*")) - (temp-file (make-temp-file "calendar-sync-" nil ".ics"))) - (make-process - :name "calendar-sync-curl" - :buffer buffer - :command (list "curl" "-s" "-L" "--fail" - "--connect-timeout" "10" - "--max-time" (number-to-string calendar-sync-fetch-timeout) - "-o" temp-file - url) - :sentinel - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (let ((buf (process-buffer process)) - (success (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)))) - (when (buffer-live-p buf) - (unless success - (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" - (string-trim event))) - (kill-buffer buf)) - (if success - (funcall callback temp-file) - (when (file-exists-p temp-file) - (delete-file temp-file)) - (funcall callback nil))))))) - (error - (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) - (funcall callback nil)))) - -(defun calendar-sync--write-file (content file) - "Write CONTENT to FILE atomically. -Creates parent directories if needed, then writes a temp file in the same -directory and renames it into place, so org-agenda or chime reading mid-write -never sees a half-written calendar." - (let ((dir (file-name-directory file))) - (unless (file-directory-p dir) - (make-directory dir t)) - (let ((tmp (make-temp-file (expand-file-name ".calendar-sync-" dir)))) - (with-temp-file tmp - (insert content)) - (rename-file tmp file t)))) - -(defun calendar-sync--emacs-binary () - "Return the Emacs executable to use for calendar conversion workers." - (let ((candidate (expand-file-name invocation-name invocation-directory))) - (if (file-executable-p candidate) - candidate - invocation-name))) - -(defun calendar-sync--batch-convert-file (ics-file output-file past-months future-months user-emails) - "Convert ICS-FILE to Org format and write OUTPUT-FILE. -PAST-MONTHS, FUTURE-MONTHS, and USER-EMAILS mirror the interactive session's -calendar conversion settings. This is intended for noninteractive worker -processes, not direct interactive use." - (setq calendar-sync-past-months past-months - calendar-sync-future-months future-months - calendar-sync-user-emails user-emails) - (let* ((ics-content - (with-temp-buffer - (insert-file-contents ics-file) - (calendar-sync--normalize-line-endings (buffer-string)))) - (org-content (calendar-sync--parse-ics ics-content))) - (unless org-content - (error "calendar-sync: parse failed")) - (calendar-sync--write-file org-content output-file))) - -(defun calendar-sync--worker-command (ics-file output-file) - "Build the batch Emacs command that converts ICS-FILE to OUTPUT-FILE." - (let ((module-dir (file-name-directory calendar-sync--module-file)) - (private-config-file - (make-temp-name (expand-file-name "calendar-sync-worker-config-" - temporary-file-directory))) - (state-file - (make-temp-name (expand-file-name "calendar-sync-worker-state-" - temporary-file-directory)))) - (list (calendar-sync--emacs-binary) - "--batch" - "--no-site-file" - "--no-site-lisp" - "--eval" (format "(setq load-prefer-newer t calendar-sync-auto-start nil calendar-sync-private-config-file %S calendar-sync--state-file %S)" - private-config-file state-file) - "-L" module-dir - "-l" calendar-sync--module-file - "--eval" (format "(calendar-sync--batch-convert-file %S %S %S %S '%S)" - ics-file - output-file - calendar-sync-past-months - calendar-sync-future-months - calendar-sync-user-emails)))) - -(defun calendar-sync--convert-ics-file-async (ics-file output-file callback) - "Convert ICS-FILE to OUTPUT-FILE in a batch Emacs worker. -Calls CALLBACK as (CALLBACK SUCCESS ERROR-MESSAGE). Deletes ICS-FILE after the -worker exits." - (condition-case err - (let ((buffer (generate-new-buffer " *calendar-sync-worker*"))) - (make-process - :name "calendar-sync-worker" - :buffer buffer - :command (calendar-sync--worker-command ics-file output-file) - :sentinel - (lambda (process _event) - (when (memq (process-status process) '(exit signal)) - (let* ((buf (process-buffer process)) - (success (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0))) - (error-message - (when (buffer-live-p buf) - (with-current-buffer buf - (string-trim (buffer-string)))))) - (when (file-exists-p ics-file) - (delete-file ics-file)) - (when (buffer-live-p buf) - (kill-buffer buf)) - (funcall callback success error-message)))))) - (error - (when (file-exists-p ics-file) - (delete-file ics-file)) - (funcall callback nil (error-message-string err))))) - -(defun calendar-sync--mark-sync-failed (name reason) - "Record failed sync state for calendar NAME with REASON." - (calendar-sync--set-calendar-state - name - (list :status 'error - :last-sync (plist-get (calendar-sync--get-calendar-state name) :last-sync) - :last-error reason)) - (calendar-sync--save-state) - (message "calendar-sync: [%s] Sync failed (see *Messages*)" name)) - -;;; Debug Logging - -(defun calendar-sync--load-private-config () - "Load private calendar-sync configuration when available." - (when (file-readable-p calendar-sync-private-config-file) - (condition-case err - (load calendar-sync-private-config-file nil t) - (error - (message "calendar-sync: Failed to load private config %s: %s" - (abbreviate-file-name calendar-sync-private-config-file) - (error-message-string err)))))) - -(defun calendar-sync--debug-p () - "Return non-nil if calendar-sync debug logging is enabled. -Checks `cj/debug-modules' for symbol `calendar-sync' or t (all)." - (and (boundp 'cj/debug-modules) - (or (eq cj/debug-modules t) - (memq 'calendar-sync cj/debug-modules)))) - -;;; Google Calendar API Fetch Path - -(defun calendar-sync--api-script () - "Return the absolute path to the Google Calendar API helper script. -Resolved relative to this module so batch workers and tests don't depend -on `user-emacs-directory'." - (let ((module-dir (file-name-directory calendar-sync--module-file))) - (expand-file-name "calendar_sync_api.py" - (expand-file-name "scripts" - (file-name-parent-directory module-dir))))) - -(defun calendar-sync--api-command (account calendar-id output-file) - "Build the command list that runs the API helper. -ACCOUNT and CALENDAR-ID select the OAuth account and calendar; OUTPUT-FILE -is where the helper writes rendered org content. The past/future window -mirrors the .ics path's `calendar-sync-past-months' / -`calendar-sync-future-months'. When `calendar-sync-skip-declined' is nil, -passes --keep-declined so the API path honors the same toggle." - (append - (list calendar-sync-python-command - (calendar-sync--api-script) - "--account" account - "--calendar-id" calendar-id - "--output" output-file - "--past-months" (number-to-string calendar-sync-past-months) - "--future-months" (number-to-string calendar-sync-future-months)) - (unless calendar-sync-skip-declined - (list "--keep-declined")))) - -(defun calendar-sync--sync-calendar-api (calendar) - "Sync a single Google CALENDAR via the API helper script. -CALENDAR is a plist with :name, :account, :calendar-id, and :file keys. -The helper fetches, filters, and renders org in one pass and writes :file -directly, so it runs in a single external process off the interactive thread." - (let* ((name (plist-get calendar :name)) - (account (plist-get calendar :account)) - (calendar-id (plist-get calendar :calendar-id)) - (file (plist-get calendar :file)) - (fetch-start (float-time))) - (calendar-sync--set-calendar-state name '(:status syncing)) - (calendar-sync--log-silently "calendar-sync: [%s] Syncing (API)..." name) - (condition-case err - (let ((buffer (generate-new-buffer " *calendar-sync-api*"))) - (make-process - :name "calendar-sync-api" - :buffer buffer - :command (calendar-sync--api-command account calendar-id file) - :sentinel - (lambda (process _event) - (when (memq (process-status process) '(exit signal)) - (let* ((buf (process-buffer process)) - (success (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0))) - (output (when (buffer-live-p buf) - (with-current-buffer buf - (string-trim (buffer-string)))))) - (when (buffer-live-p buf) - (kill-buffer buf)) - (if (not success) - (calendar-sync--mark-sync-failed - name (if (or (null output) (string-empty-p output)) - "API helper failed" - output)) - (calendar-sync--set-calendar-state - name - (list :status 'ok - :last-sync (current-time) - :last-error nil)) - (setq calendar-sync--last-timezone-offset - (calendar-sync--current-timezone-offset)) - (calendar-sync--save-state) - (let ((total-elapsed (- (float-time) fetch-start))) - (message "calendar-sync: [%s] Sync complete (%.1fs total) → %s" - name total-elapsed file)))))))) - (error - (calendar-sync--log-silently "calendar-sync: [%s] API helper error: %s" - name (error-message-string err)) - (calendar-sync--mark-sync-failed name (error-message-string err)))))) - -;;; Single Calendar Sync +;;; Sync dispatch (defun calendar-sync--sync-calendar (calendar) "Sync a single CALENDAR asynchronously. @@ -1551,63 +216,6 @@ calendar files do not block the interactive Emacs thread." (calendar-sync--sync-calendar-api calendar) (calendar-sync--sync-calendar-ics calendar))) -(defun calendar-sync--calendar-url (calendar) - "Return the .ics feed URL for CALENDAR, or nil if none is configured. -An explicit :url wins. Otherwise :secret-host names an auth-source host -whose stored secret is the URL (kept in auth-source because the .ics URL -is itself a token)." - (or (plist-get calendar :url) - (when-let* ((host (plist-get calendar :secret-host))) - (cj/auth-source-secret-value host)))) - -(defun calendar-sync--sync-calendar-ics (calendar) - "Sync a single CALENDAR from its .ics feed asynchronously. -CALENDAR is a plist with :name, :file, and a feed URL resolved by -`calendar-sync--calendar-url' (an explicit :url, or a :secret-host -looked up in auth-source)." - (let ((name (plist-get calendar :name)) - (url (calendar-sync--calendar-url calendar)) - (file (plist-get calendar :file)) - (fetch-start (float-time))) - (calendar-sync--set-calendar-state name '(:status syncing)) - (calendar-sync--log-silently "calendar-sync: [%s] Syncing..." name) - (calendar-sync--fetch-ics-file - url - (lambda (ics-file) - (let ((fetch-elapsed (- (float-time) fetch-start))) - (if (null ics-file) - (progn - (calendar-sync--log-silently "calendar-sync: [%s] Fetch failed" name) - (calendar-sync--mark-sync-failed name "Fetch failed")) - (when (calendar-sync--debug-p) - (calendar-sync--log-silently "calendar-sync: [%s] Fetched in %.1fs" - name fetch-elapsed)) - (calendar-sync--convert-ics-file-async - ics-file - file - (lambda (success error-message) - (if (not success) - (progn - (calendar-sync--log-silently "calendar-sync: [%s] Conversion failed: %s" - name error-message) - (calendar-sync--mark-sync-failed - name - (if (or (null error-message) - (string-empty-p error-message)) - "Conversion failed" - error-message))) - (calendar-sync--set-calendar-state - name - (list :status 'ok - :last-sync (current-time) - :last-error nil)) - (setq calendar-sync--last-timezone-offset - (calendar-sync--current-timezone-offset)) - (calendar-sync--save-state) - (let ((total-elapsed (- (float-time) fetch-start))) - (message "calendar-sync: [%s] Sync complete (%.1fs total) → %s" - name total-elapsed file))))))))))) - (defun calendar-sync--require-calendars () "Return non-nil if calendars are configured, else warn and return nil." (or calendar-sync-calendars @@ -1631,6 +239,8 @@ Each calendar syncs in parallel." (cl-find-if (lambda (cal) (string= (plist-get cal :name) name)) calendar-sync-calendars)) +;;; Commands + ;;;###autoload (defun calendar-sync-now (&optional calendar-name) "Sync calendar(s) now asynchronously. @@ -1771,12 +381,29 @@ Syncs all calendars immediately, then every `calendar-sync-interval-minutes'." ;; User can manually sync or it will happen on next timer tick if auto-sync is enabled )) -;; Start auto-sync if enabled and calendars are configured -;; Syncs immediately then every calendar-sync-interval-minutes (default: 60 minutes) +;; Defer auto-sync until calendar data is first needed. +;; +;; The :secret-host feed URLs live in authinfo.gpg, and BOTH the immediate sync +;; and every periodic timer tick resolve them. Calling `calendar-sync-start' at +;; load (immediate sync + recurring timer) therefore decrypts authinfo.gpg right +;; after startup, prompting for the GPG passphrase on a cold gpg-agent (e.g. +;; after a reboot). Defer the whole start to the first org-agenda use, so the +;; unlock happens when the user actually asks for calendar data. A manual +;; `calendar-sync-start' / `calendar-sync-now' still works on demand. +(defun calendar-sync--auto-start-on-first-agenda () + "Start auto-sync on the first org-agenda use, then remove this hook. +One-shot: deferring `calendar-sync-start' until the agenda is first built keeps a +cold gpg-agent from being prompted for the authinfo passphrase at startup. +Removes itself before starting so a `calendar-sync-start' error can't re-fire it." + (remove-hook 'org-agenda-mode-hook #'calendar-sync--auto-start-on-first-agenda) + (calendar-sync-start)) + +;; Arm the deferred start when auto-sync is enabled and calendars are configured. (when (and calendar-sync-auto-start calendar-sync-calendars (not noninteractive)) - (calendar-sync-start)) + (add-hook 'org-agenda-mode-hook #'calendar-sync--auto-start-on-first-agenda)) + (provide 'calendar-sync) ;;; calendar-sync.el ends here diff --git a/modules/calibredb-epub-config.el b/modules/calibredb-epub-config.el index 1e6437d26..b03d83ed0 100644 --- a/modules/calibredb-epub-config.el +++ b/modules/calibredb-epub-config.el @@ -1,4 +1,4 @@ -;;; calibredb-epub-config --- Functionality for Ebook Management and Display -*- lexical-binding: t; coding: utf-8; -*- +;;; calibredb-epub-config.el --- Functionality for Ebook Management and Display -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -6,46 +6,17 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P. ;; Load shape: eager. -;; Eager reason: none; optional ebook workflow, a command-loaded deferral -;; candidate for Phase 4. -;; Top-level side effects: one add-hook, one advice-add, package config. -;; Runtime requires: user-constants, subr-x. +;; Eager reason: none; ebook commands can load by command. +;; Top-level side effects: one hook, one advice, package config. +;; Runtime requires: user-constants, subr-x, transient. ;; Direct test load: yes. ;; -;; This module provides a comprehensive ebook management and reading experience -;; within Emacs, integrating CalibreDB for library management and Nov for EPUB -;; reading. +;; CalibreDB and Nov integration for browsing the Calibre library and reading +;; EPUBs inside Emacs. The module adds a curated CalibreDB transient, filter +;; helpers, Nov typography, image centering, and reader-to-library navigation. ;; -;; FEATURES: -;; - CalibreDB integration for managing your Calibre ebook library -;; - Nov mode for reading EPUB files with customized typography and layout -;; - Seamless navigation between Nov reading buffers and CalibreDB entries -;; - Image centering in EPUB documents without modifying buffer text -;; - Quick filtering and searching within your ebook library -;; -;; KEY BINDINGS: -;; - M-B: Open CalibreDB library browser -;; - In CalibreDB search mode: -;; - l: Filter by tag -;; - L: Clear all filters -;; - In Nov mode: -;; - z: Open current EPUB in external viewer (zathura) -;; - C-c C-b: Jump to CalibreDB entry for current book -;; - m: Set bookmark -;; - b: List bookmarks -;; -;; WORKFLOW: -;; 1. Press M-B to browse your Calibre library -;; 2. Use filters (l for tags, L to clear) to narrow results -;; 3. Open an EPUB to read it in Nov with optimized typography -;; 4. While reading, use C-c C-b to jump back to the book's metadata -;; 5. Use z to open in external reader when needed -;; -;; CONFIGURATION NOTES: -;; - Prefers EPUB format when available, falls back to PDF -;; - Centers images in EPUB documents using display properties -;; - Applies custom typography with larger fonts for comfortable reading -;; - Uses visual-fill-column for centered text with appropriate margins +;; EPUB is preferred when available; external opening remains available for +;; formats or workflows better handled outside Emacs. ;;; Code: @@ -60,8 +31,19 @@ (declare-function nov-render-document "nov" ()) (defvar nov-text-width) ; from nov.el; set buffer-local here +(require 'nov-reading) ;; reading-view theme layer: palettes + typography + size + ;; calibredb commands the curated menu drives (all autoloaded by calibredb) (declare-function calibredb-switch-library "calibredb" ()) +(declare-function calibredb-search-keyword-filter "calibredb-search") + +;; calibredb's filter-scope flags (set in `cj/--calibredb-open-to-favorites'); +;; declared special so the assignments compile clean when calibredb is absent. +(defvar calibredb-tag-filter-p) +(defvar calibredb-favorite-filter-p) +(defvar calibredb-author-filter-p) +(defvar calibredb-date-filter-p) +(defvar calibredb-format-filter-p) (declare-function calibredb-filter-by-book-format "calibredb" ()) (declare-function calibredb-filter-by-author-sort "calibredb" ()) (declare-function calibredb-search-clear-filter "calibredb" ()) @@ -116,6 +98,26 @@ which re-applies `calibredb-search-filter' instead." (setq calibredb-sort-by field) (calibredb-search-refresh-or-resume)) +(defun cj/--calibredb-open-to-favorites (&rest _) + "Filter the calibredb search to books tagged `calibredb-favorite-keyword'. +Advice (:after) on `calibredb' so every launch lands on the favorite-keyword +books (Craig's \"in-progress\" reading list); clear with L / x to see the +whole library. Scopes to the tag field (sets `calibredb-tag-filter-p', +clears the other filter-scope flags), because a bare keyword filter matches +the keyword in any field -- title, author, or the description -- and would +surface books that merely mention it. No-op unless a non-empty string +keyword is set." + (when (and (boundp 'calibredb-favorite-keyword) + (stringp calibredb-favorite-keyword) + (not (string-empty-p calibredb-favorite-keyword)) + (fboundp 'calibredb-search-keyword-filter)) + (setq calibredb-tag-filter-p t + calibredb-favorite-filter-p nil + calibredb-author-filter-p nil + calibredb-date-filter-p nil + calibredb-format-filter-p nil) + (calibredb-search-keyword-filter calibredb-favorite-keyword))) + (use-package calibredb :commands calibredb :bind @@ -184,7 +186,10 @@ which re-applies `calibredb-search-filter' instead." (setq calibredb-order "asc") (setq calibredb-id-width 7) (setq calibredb-favorite-icon "🔖") - (setq calibredb-favorite-keyword "in-progress")) + (setq calibredb-favorite-keyword "in-progress") + ;; Open every calibredb launch (dashboard, M-x, elsewhere) filtered to the + ;; in-progress favorites; L / x clears to the whole library. + (advice-add 'calibredb :after #'cj/--calibredb-open-to-favorites)) ;; ------------------------------ Nov Epub Reader ------------------------------ @@ -207,7 +212,6 @@ Adjust it live with `cj/nov-widen-text' and `cj/nov-narrow-text'.") (if (and buffer-file-name (string-match-p "\\.epub\\'" buffer-file-name)) (progn - ;; Load nov if not already loaded (unless (featurep 'nov) (require 'nov nil t)) ;; Call nov-mode if available, otherwise fallback to default behavior @@ -312,12 +316,8 @@ A positive DELTA narrows the text column; a negative DELTA widens it." (defun cj/nov-apply-preferences () "Apply preferences after nov-mode has launched." (interactive) - ;; Use Merriweather for comfortable reading with appropriate scaling. - ;; (Reading fg color stripped; falls back to the theme default until a - ;; themeable reading face exists -- see todo.org.) - (face-remap-add-relative 'variable-pitch :family "Merriweather" :height 1.0) - (face-remap-add-relative 'default :family "Merriweather" :height 180) - (face-remap-add-relative 'fixed-pitch :height 180) + ;; Reading typography + color palette live in the nov-reading theme layer. + (cj/nov-reading-setup) ;; Enable visual-line-mode for proper text wrapping (visual-line-mode 1) ;; Set fill-column as a fallback @@ -404,6 +404,12 @@ Try to use the Calibre book id from the parent folder name (for example, (calibredb-search-keyword-filter "") (message "CalibreDB: no metadata; showing all")))))) +(require 'system-lib) +;; nov renders epub via shr, which paints with manual `face' properties. Left in +;; `global-font-lock-mode' font-lock overwrites them and the book loses its +;; colors, the same issue as elfeed-show and mu4e-view. Exclude nov-mode. +(cj/exclude-from-global-font-lock 'nov-mode) + (use-package nov :mode ("\\.epub\\'" . nov-mode) @@ -420,26 +426,32 @@ Try to use the Calibre book id from the parent folder name (for example, ("<" . nov-history-back) (">" . nov-history-forward) ("," . backward-paragraph) - ;; +/= widen the text column, -/_ narrow it (50%..100% of the window) - ("+" . cj/nov-widen-text) - ("=" . cj/nov-widen-text) - ("-" . cj/nov-narrow-text) - ("_" . cj/nov-narrow-text) + ;; +/- adjust the page font size, = resets it to the default height + ("+" . cj/nov-reading-text-bigger) + ("-" . cj/nov-reading-text-smaller) + ("=" . cj/nov-reading-text-reset) + ;; { } adjust the text-column width (50%..100% of the window) + ("}" . cj/nov-widen-text) + ("{" . cj/nov-narrow-text) ;; open current EPUB with zathura (same key in pdf-view) ("z" . cj/nov-open-external) ("t" . nov-goto-toc) + ;; c cycles reading palettes (sepia/dark/light/none); C picks one by name + ("c" . cj/nov-cycle-reading-palette) + ("C" . cj/nov-set-reading-palette) ("C-c C-b" . cj/nov-jump-to-calibredb))) ;; ------------------------- Nov bookmark naming ------------------------------- ;; In a nov buffer "m" is bound to `bookmark-set' (above). nov's -;; `nov-bookmark-make-record' names the record after `(buffer-name)' -- the EPUB -;; filename, extension and all. Rebuild it as "Author, Title" parsed from the -;; filename: under Calibre's "<Title> - <Author>.epub" naming the filename is -;; more complete than the EPUB's embedded metadata (which carries truncated -;; titles and author-sort "Last, First" forms). - -(defun cj/--nov-clean-title (s) - "Clean a title or author S parsed from an EPUB filename, or nil when blank. +;; Both nov (EPUB) and pdf-view (PDF) name a new bookmark after the buffer -- +;; the file's name, extension and all. Rebuild it as "Author, Title" parsed +;; from the filename: under Calibre's "<Title> - <Author>.<ext>" naming the +;; filename is more complete than the file's embedded metadata (which carries +;; truncated titles and author-sort "Last, First" forms). One :filter-return +;; advice serves both record functions; the parser is extension-agnostic. + +(defun cj/--reading-clean-title (s) + "Clean a title or author S parsed from a book filename, or nil when blank. Restores a colon where Calibre sanitized \":\" to \"_\" (\"Frege_ A Guide\" -> \"Frege: A Guide\"), turns any leftover underscore into a space, and collapses runs of whitespace." @@ -449,34 +461,39 @@ collapses runs of whitespace." (out (string-trim (replace-regexp-in-string "[ \t]+" " " spaced)))) (and (not (string-empty-p out)) out)))) -(defun cj/--nov-bookmark-name-from-file (path) - "Return \"Author, Title\" derived from an EPUB PATH's filename, or nil. +(defun cj/--reading-bookmark-name-from-file (path) + "Return \"Author, Title\" derived from a book PATH's filename, or nil. Splits the filename (sans extension) on its last \" - \" into title and author per Calibre's \"<Title> - <Author>\" convention, restoring colons and reordering to \"Author, Title\". Falls back to the cleaned whole name when -there is no \" - \" separator." +there is no \" - \" separator. Extension-agnostic, so it serves EPUB and PDF." (when (and (stringp path) (not (string-empty-p path))) (let ((base (file-name-sans-extension (file-name-nondirectory path)))) (if (string-match "\\`\\(.+\\) - \\(.+\\)\\'" base) - (let ((title (cj/--nov-clean-title (match-string 1 base))) - (author (cj/--nov-clean-title (match-string 2 base)))) + (let ((title (cj/--reading-clean-title (match-string 1 base))) + (author (cj/--reading-clean-title (match-string 2 base)))) (cond ((and author title) (format "%s, %s" author title)) (title title) (author author) (t nil))) - (cj/--nov-clean-title base))))) - -(defun cj/--nov-bookmark-rename-record (record) - "Replace RECORD's bookmark name with \"Author, Title\" from its EPUB filename. -Advice (:filter-return) on `nov-bookmark-make-record'. RECORD is -\(NAME . ALIST) carrying a `filename'; left unchanged when no name derives." - (let ((name (cj/--nov-bookmark-name-from-file + (cj/--reading-clean-title base))))) + +(defun cj/--reading-bookmark-rename-record (record) + "Replace RECORD's bookmark name with \"Author, Title\" from its filename. +Advice (:filter-return) on `nov-bookmark-make-record' and +`pdf-view-bookmark-make-record'. RECORD is (NAME . ALIST) carrying a +`filename'; left unchanged when no name derives." + (let ((name (cj/--reading-bookmark-name-from-file (alist-get 'filename (cdr record))))) (if name (cons name (cdr record)) record))) (with-eval-after-load 'nov (advice-add 'nov-bookmark-make-record :filter-return - #'cj/--nov-bookmark-rename-record)) + #'cj/--reading-bookmark-rename-record)) + +(with-eval-after-load 'pdf-view + (advice-add 'pdf-view-bookmark-make-record :filter-return + #'cj/--reading-bookmark-rename-record)) (defun cj/--nov-image-padding-cols (col-width img-px font-width-px) "Return left-padding columns to center an IMG-PX-wide image in COL-WIDTH cols. diff --git a/modules/chrono-tools.el b/modules/chrono-tools.el index 744781268..57309178d 100644 --- a/modules/chrono-tools.el +++ b/modules/chrono-tools.el @@ -9,7 +9,7 @@ ;; Eager reason: none; calendar/timer commands, a command-loaded deferral ;; candidate. ;; Top-level side effects: package configuration via use-package. -;; Runtime requires: user-constants. +;; Runtime requires: user-constants, system-lib. ;; Direct test load: yes. ;; ;; This module centralizes configuration for Emacs time-related tools: @@ -21,6 +21,7 @@ ;;; Code: (require 'user-constants) +(require 'system-lib) ;; provides cj/completion-table-annotated, cj/completion-file-annotator ;; Declared by the lazily-loaded `tmr' package; quiet the byte-compiler ;; without forcing the package to load. @@ -107,7 +108,12 @@ Present all audio files in the sounds directory and set the chosen file as (if current-file (format " (current: %s)" current-file) "")) - sound-files nil t nil nil current-file))) + (cj/completion-table-annotated + 'cj-sound-file + (cj/completion-file-annotator + (lambda (c) (expand-file-name c sounds-dir))) + sound-files) + nil t nil nil current-file))) (if (or (null selected-file) (string-empty-p selected-file)) (message "No file selected") (message "%s" (cj/tmr--apply-sound-file selected-file))))))))) diff --git a/modules/config-utilities.el b/modules/config-utilities.el index f448327c1..72427ef9b 100644 --- a/modules/config-utilities.el +++ b/modules/config-utilities.el @@ -1,4 +1,4 @@ -;;; config-utilities --- Config Hacking Utilities -*- lexical-binding: t; coding: utf-8; -*- +;;; config-utilities.el --- Config Hacking Utilities -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -114,11 +114,14 @@ Signals `user-error' if METHOD-SYMBOL is nil or not fboundp." (with-timer title (funcall method-symbol))) +(require 'system-lib) + (defun cj/benchmark-this-method () "Prompt for a title and method name, then time the execution of the method." (interactive) (let* ((title (read-string "Enter the title for the timing: ")) - (method-name (completing-read "Enter the method name to time: " obarray + (method-name (completing-read "Enter the method name to time: " + (cj/completion-table 'function obarray) #'fboundp t)) (method-symbol (intern-soft method-name))) (condition-case err diff --git a/modules/custom-buffer-file.el b/modules/custom-buffer-file.el index 84faf01d8..38ae0bae1 100644 --- a/modules/custom-buffer-file.el +++ b/modules/custom-buffer-file.el @@ -370,6 +370,262 @@ Sets up diff-mode for navigation." (diff-mode) (goto-char (point-min))))) +(defun cj/--diff-buffer-renderer (ws-only difft-available) + "Choose the diff renderer symbol from WS-ONLY and DIFFT-AVAILABLE. +`whitespace' for a whitespace-only diff (a plain unified diff with trailing +whitespace highlighted, because difftastic treats it as no change and renders it +blank); otherwise `difftastic' when available, else `regular'." + (cond (ws-only 'whitespace) + (difft-available 'difftastic) + (t 'regular))) + +(defun cj/--diff-whitespace-only-p (file-a file-b) + "Return non-nil if FILE-A and FILE-B differ ONLY in whitespace. +Route-1 detection via diff(1): true when a plain `diff' reports a difference but +`diff -w' (ignore all whitespace) reports none. Identical files differ in +nothing, so they are not whitespace-only." + (and (not (zerop (call-process "diff" nil nil nil "-q" file-a file-b))) + (zerop (call-process "diff" nil nil nil "-q" "-w" file-a file-b)))) + +(defun cj/--buffer-differs-prompt-string (name ws-only-p) + "Build the buffer-differs prompt question for buffer NAME. +When WS-ONLY-P is non-nil, fold a terse \"(whitespace only)\" parenthetical into +the question so the reader knows the difference is whitespace before choosing." + (format "%s changed on disk%s" + name (if ws-only-p " (whitespace only)" ""))) + +(defun cj/--buffer-differs-choices () + "Return the terse `read-multiple-choice' menu for the disk-changed save prompt. +Inline names are single words so the menu fits at a glance; the full meaning is +in each description (the ? help). s overwrites the file with the buffer; r +discards the buffer's edits and rereads from disk." + '((?s "save" "overwrite the file with this buffer") + (?d "diff" "show what changed, then ask again") + (?w "clean" "clean whitespace and save") + (?r "revert" "discard edits and reread from disk") + (?c "cancel" "leave the buffer as is"))) + +(defun cj/--buffer-changed-on-disk-p (buffer) + "Return non-nil if BUFFER is modified AND its file changed on disk since visited. +This is the disk-changed conflict: there are unsaved edits to lose AND the file +underneath has moved, so a plain save would silently overwrite the disk version." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (and (buffer-modified-p) + buffer-file-name + (file-exists-p buffer-file-name) + (not (verify-visited-file-modtime buffer)))))) + +(defun cj/--buffer-differs-action (key) + "Map a disk-changed-prompt KEY to an action symbol, or nil when unmapped. +`save' overwrites the file, `clean-save' cleans whitespace then saves, `revert' +rereads from disk, `cancel' does nothing, and `diff' peeks (the caller re-prompts)." + (pcase key + (?s 'save) + (?w 'clean-save) + (?r 'revert) + (?d 'diff) + (?c 'cancel))) + +(defun cj/--buffer-differs-dispatch (buffer action) + "Carry out ACTION for BUFFER after a disk-changed prompt. +`save' overwrites the file with the buffer; `clean-save' strips trailing +whitespace first; `revert' discards the buffer's edits and rereads the disk; +`cancel' leaves the buffer untouched. Save updates the recorded modtime first so +the stock `save-buffer' does not re-ask its own \"changed on disk\" question." + (with-current-buffer buffer + (pcase action + ('save (set-visited-file-modtime) (save-buffer)) + ('clean-save (delete-trailing-whitespace) (set-visited-file-modtime) (save-buffer)) + ('revert (revert-buffer t t)) + ('cancel (message "Save cancelled; buffer left as is")) + (_ nil)))) + +(defun cj/--read-choice-with-diff (prompt choices show-diff-fn) + "Read a `read-multiple-choice' key for PROMPT and CHOICES; d toggles a diff. +SHOW-DIFF-FN displays the buffer/file diff and returns its buffer. The d key +shows the diff, or hides it when it is already shown (a toggle). Any other key +-- a terminating choice -- closes a still-open diff window before returning that +key, so the diff never lingers after the decision is made." + (let ((key nil) (diff-buf nil)) + (while (not key) + (let ((k (car (read-multiple-choice prompt choices)))) + (if (eq k ?d) + (let ((win (and (buffer-live-p diff-buf) (get-buffer-window diff-buf)))) + (if win + (progn (quit-window nil win) (setq diff-buf nil)) + (setq diff-buf (funcall show-diff-fn)))) + (setq key k)))) + (let ((win (and (buffer-live-p diff-buf) (get-buffer-window diff-buf)))) + (when win (quit-window nil win))) + key)) + +(defun cj/--buffer-differs-read-key (buffer ws-only) + "Read a disk-changed-prompt key for BUFFER via `read-multiple-choice'. +WS-ONLY non-nil folds a terse \"(whitespace only)\" note into the prompt. d +toggles the buffer/file diff; a terminating choice closes a still-open diff." + (cj/--read-choice-with-diff + (cj/--buffer-differs-prompt-string (buffer-name buffer) ws-only) + (cj/--buffer-differs-choices) + (lambda () (with-current-buffer buffer (cj/diff-buffer-with-file))))) + +(defun cj/save-buffer (&optional arg) + "Save the current buffer; show a legible menu when the file changed on disk. +A normal save falls straight through to `save-buffer' (ARG, the prefix argument, +is passed along so \\[universal-argument] \\[save-buffer] still marks for backup). +When the buffer has unsaved edits AND the file changed on disk since it was +visited, offer a terse labeled menu -- save / diff / clean / revert / cancel -- +instead of the stock yes/no \"Save anyway?\" prompt. Bound to \\`C-x C-s'." + (interactive "P") + (if (not (cj/--buffer-changed-on-disk-p (current-buffer))) + (save-buffer arg) + (let* ((buf (current-buffer)) + (ws-only (cj/--buffer-file-whitespace-only-p buf)) + (key (cj/--buffer-differs-read-key buf ws-only))) + (cj/--buffer-differs-dispatch buf (cj/--buffer-differs-action key))))) + +(defun cj/--save-some-buffers-action (key) + "Map a save-loop KEY to (THIS-ACTION . LOOP-EFFECT), or nil when unmapped. +THIS-ACTION is `save', `clean-save', `skip', or `diff'. LOOP-EFFECT is +`continue' (keep prompting), `save-rest' (save this and all remaining without +asking), `stop' (act on this, skip the rest), or `reprompt' (peek, then ask the +same buffer again)." + (pcase key + (?y '(save . continue)) + (?n '(skip . continue)) + (?w '(clean-save . continue)) + (?! '(save . save-rest)) + (?. '(save . stop)) + (?q '(skip . stop)) + (?d '(diff . reprompt)))) + +(defun cj/--save-some-buffers-choices () + "Return the terse `read-multiple-choice' choices for the save loop. +Single-word inline names keep the menu to the minimum space; the full meaning is +in each description (the ? help)." + '((?y "save" "save this buffer") + (?n "skip" "do not save this buffer") + (?w "clean" "clean whitespace and save this buffer") + (?d "diff" "show what changed, then ask again") + (?! "all" "save this and all remaining buffers") + (?. "only" "save this buffer, then skip the rest") + (?q "none" "stop; save no more buffers"))) + +(defun cj/--buffer-file-whitespace-only-p (buffer) + "Return non-nil if BUFFER's text differs from its visited file ONLY in whitespace. +Writes the buffer to a temp file and reuses `cj/--diff-whitespace-only-p'. Nil +when BUFFER visits no file or the file is gone." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (let ((file (buffer-file-name))) + (when (and file (file-exists-p file)) + (let ((temp (make-temp-file "cbf-ws-buf-" nil + (or (file-name-extension file t) ""))) + (content (buffer-string))) + (unwind-protect + (progn (with-temp-file temp (insert content)) + (cj/--diff-whitespace-only-p file temp)) + (when (file-exists-p temp) (delete-file temp))))))))) + +(defun cj/--save-some-buffers-plan (buffers key-fn) + "Resolve each buffer in BUFFERS to a per-buffer action using KEY-FN. +KEY-FN is called with a buffer and returns a `read-multiple-choice' key; the diff +re-prompt is the caller's concern, so KEY-FN never returns ?d. Returns a list of +\(BUFFER . ACTION) where ACTION is `save', `clean-save', or `skip', honoring +`save-rest' (! saves this and all remaining) and `stop' (./q act on this, then +skip the rest). KEY-FN is not consulted once a buffer triggers save-rest or stop." + (let ((plan nil) (mode 'ask)) + (dolist (buf buffers (nreverse plan)) + (pcase mode + ('save-all (push (cons buf 'save) plan)) + ('done (push (cons buf 'skip) plan)) + ('ask + (pcase (cj/--save-some-buffers-action (funcall key-fn buf)) + (`(,act . save-rest) (push (cons buf act) plan) (setq mode 'save-all)) + (`(,act . stop) (push (cons buf act) plan) (setq mode 'done)) + (`(,act . ,_) (push (cons buf act) plan)) + (_ (push (cons buf 'skip) plan)))))))) + +(declare-function files--buffers-needing-to-be-saved "files" (pred)) + +(defun cj/--save-some-buffers-read-key (buffer ws-only) + "Read a save-loop key for BUFFER via `read-multiple-choice'. +WS-ONLY non-nil folds a terse \"(whitespace only)\" note into the prompt. d +toggles the buffer/file diff; a terminating choice closes a still-open diff." + (cj/--read-choice-with-diff + (format "Save %s%s" + (if (buffer-file-name buffer) + (file-name-nondirectory (buffer-file-name buffer)) + (buffer-name buffer)) + (if ws-only " (whitespace only)" "")) + (cj/--save-some-buffers-choices) + (lambda () (with-current-buffer buffer (cj/diff-buffer-with-file))))) + +(defun cj/--save-some-buffers-execute (plan) + "Carry out PLAN, a list of (BUFFER . ACTION); return the number saved. +ACTION `clean-save' deletes trailing whitespace before saving; `save' saves as-is; +`skip' leaves the buffer alone." + (let ((n 0)) + (dolist (entry plan n) + (let ((buffer (car entry))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (pcase (cdr entry) + ('clean-save (delete-trailing-whitespace) (save-buffer) (setq n (1+ n))) + ('save (save-buffer) (setq n (1+ n))) + (_ nil)))))))) + +(defun cj/save-some-buffers (&optional arg pred) + "Save modified buffers with a legible, labeled prompt per buffer. +A `read-multiple-choice' replacement for `save-some-buffers': the options are +shown on screen rather than recalled as keys, with an added clean-whitespace-and- +save action and a per-buffer \"(whitespace only)\" note. ARG and PRED match +`save-some-buffers' -- ARG non-nil saves all without asking; PRED selects which +buffers are considered. Installed over `save-some-buffers' by advice, so \\[save-some-buffers] +and the save-on-exit prompt both use it." + (interactive "P") + (unless pred + (setq pred + (if (and (symbolp save-some-buffers-default-predicate) + (get save-some-buffers-default-predicate + 'save-some-buffers-function)) + (funcall save-some-buffers-default-predicate) + save-some-buffers-default-predicate))) + (let (queried autosaved-buffers files-done inhibit-message) + (save-window-excursion + ;; Save buffers flagged for unconditional save first (mirrors the original). + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (and buffer-save-without-query (buffer-modified-p)) + (push (buffer-name) autosaved-buffers) + (save-buffer)))) + (let* ((candidates (files--buffers-needing-to-be-saved pred)) + (plan (if arg + (mapcar (lambda (b) (cons b 'save)) candidates) + (when candidates (setq queried t)) + (cj/--save-some-buffers-plan + candidates + (lambda (b) + (cj/--save-some-buffers-read-key + b (cj/--buffer-file-whitespace-only-p b))))))) + (setq files-done (cj/--save-some-buffers-execute plan))) + ;; Let other things (abbrevs, etc.) save at this point. + (dolist (func save-some-buffers-functions) + (setq inhibit-message (or (funcall func nil arg) inhibit-message))) + (or queried (> files-done 0) inhibit-message + (cond + ((null autosaved-buffers) + (when (called-interactively-p 'any) + (message "(No files need saving)"))) + ((= (length autosaved-buffers) 1) + (message "(Saved %s)" (car autosaved-buffers))) + (t (message "(Saved %d files: %s)" (length autosaved-buffers) + (mapconcat #'identity autosaved-buffers ", ")))))) + files-done)) + +(advice-add 'save-some-buffers :override #'cj/save-some-buffers) +(keymap-global-set "C-x C-s" #'cj/save-buffer) + (defun cj/diff-buffer-with-file () "Compare the current modified buffer with the saved version. Uses difftastic if available for syntax-aware diffing, otherwise @@ -389,17 +645,27 @@ Signals an error if the buffer is not visiting a file." (insert buffer-content)) ;; Check if there are any differences first (if (zerop (call-process "diff" nil nil nil "-q" file temp-file)) - (message "No differences between buffer and file") - ;; Run diff/difftastic and display in buffer - (let* ((using-difftastic (cj/executable-exists-p "difft")) - (buffer-name (if using-difftastic + (progn (message "No differences between buffer and file") nil) + ;; Pick a renderer: difftastic for content diffs, but a plain unified + ;; diff with trailing whitespace highlighted for whitespace-only ones + ;; (difftastic treats trailing whitespace as no change and hides it). + (let* ((renderer (cj/--diff-buffer-renderer + (cj/--diff-whitespace-only-p file temp-file) + (cj/executable-exists-p "difft"))) + (buffer-name (if (eq renderer 'difftastic) "*Diff (difftastic)*" "*Diff (unified)*")) (diff-buffer (get-buffer-create buffer-name))) - (if using-difftastic + (if (eq renderer 'difftastic) (cj/--diff-with-difftastic file temp-file diff-buffer) - (cj/--diff-with-regular-diff file temp-file diff-buffer)) - (display-buffer diff-buffer)))) + (cj/--diff-with-regular-diff file temp-file diff-buffer) + (when (eq renderer 'whitespace) + (with-current-buffer diff-buffer + (setq-local show-trailing-whitespace t)))) + (display-buffer diff-buffer) + ;; Return the diff buffer so callers (the save prompts) can toggle + ;; and auto-close its window. + diff-buffer))) ;; Clean up temp file (when (file-exists-p temp-file) (delete-file temp-file))))) @@ -546,8 +812,8 @@ Signals an error if: "C-; b m" "move file" "C-; b r" "rename file" "C-; b p" "copy buffer source" - "C-; b d" "delete file" - "C-; b D" "diff buffer with file" + "C-; b d" "diff buffer with file" + "C-; b D" "delete file" "C-; b c" "buffer copy menu" "C-; b c w" "copy whole buffer" "C-; b c b" "copy to bottom" @@ -574,5 +840,14 @@ Signals an error if: "C-; b <down>" "resize divider down")) +;; --- previous-buffer toggle (formerly in custom-misc.el) --- +(defun cj/switch-to-previous-buffer () + "Switch to previously open buffer. +Repeated invocations toggle between the two most recently open buffers." + (interactive) + (switch-to-buffer (other-buffer (current-buffer) 1))) + +(cj/register-command "SPC" #'cj/switch-to-previous-buffer "prev buffer") + (provide 'custom-buffer-file) ;;; custom-buffer-file.el ends here. diff --git a/modules/custom-comments.el b/modules/custom-comments.el index 231a03860..a2604a558 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -5,62 +5,17 @@ ;; Layer: 2 (Core UX). ;; Category: L/C. ;; Load shape: eager. -;; Eager reason: registers its C-; C comment submap at load. Currently eager by -;; init order; a deferral candidate for Phase 3/4 (command/autoload + -;; registration API). -;; Top-level side effects: defines cj/comment-map, registers it under C-; C. +;; Eager reason: registers C-; C comment helpers. +;; Top-level side effects: defines and registers cj/comment-map. ;; Runtime requires: keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Direct test load: yes. ;; -;; This module provides custom comment formatting and manipulation utilities for code editing. -;; -;; Functions include: -;; - deleting all comments in a buffer, -;; - reformatting commented text into single-line paragraphs, -;; - creating centered comment headers with customizable separator characters, -;; - creating comment boxes around text -;; - inserting hyphen-style centered comments. -;; -;; These utilities help create consistent, well-formatted code comments and section headers. -;; Bound to keymap prefix: C-; C -;; -;; Comment Style Patterns: -;; -;; inline-border: -;; ========== inline-border ========== -;; -;; simple-divider: -;; ==================================== -;; simple-divider -;; ==================================== -;; -;; padded-divider: -;; ==================================== -;; padded-divider -;; ==================================== -;; -;; box: -;; ************************************ -;; * box * -;; ************************************ -;; -;; heavy-box: -;; ************************************ -;; * * -;; * heavy-box * -;; * * -;; ************************************ -;; -;; unicode-box: -;; ┌──────────────────────────────────┐ -;; │ unicode-box │ -;; └──────────────────────────────────┘ -;; -;; block-banner: -;; /************************************ -;; * block-banner -;; ************************************/ +;; Comment editing helpers: delete comments, reflow commented regions, and insert +;; consistent section headers or boxes using the current mode's comment syntax. ;; +;; Public commands live under C-; C. Decoration helpers validate single printable +;; characters before generating comment borders. + ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap diff --git a/modules/custom-counts.el b/modules/custom-counts.el new file mode 100644 index 000000000..792732a40 --- /dev/null +++ b/modules/custom-counts.el @@ -0,0 +1,63 @@ +;;; custom-counts.el --- Word and character counts -*- coding: utf-8; lexical-binding: t; -*- + +;;; Commentary: +;; +;; Layer: 2 (Core UX). +;; Category: L. +;; Load shape: eager. +;; Eager reason: registers its C-; # w and C-; # c command bindings at load. +;; Top-level side effects: binds the count commands under C-; # w and C-; # c. +;; Runtime requires: keybindings. +;; Direct test load: yes (requires keybindings explicitly). +;; +;; Count words or characters in the active region, or the whole buffer when no +;; region is active, and report the total in the minibuffer. Split out of the +;; former custom-misc.el grab-bag. + +;;; Code: + +(require 'keybindings) ;; provides cj/register-command + +(defun cj/--count-words (start end) + "Internal implementation: Count words between START and END. +START and END define the region to count. +Returns the word count as an integer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (count-words start end)) + +(defun cj/count-words-buffer-or-region () + "Count the number of words in the buffer or region. +Display the result in the minibuffer." + (interactive) + (let* ((use-region (use-region-p)) + (begin (if use-region (region-beginning) (point-min))) + (end (if use-region (region-end) (point-max))) + (area-type (if use-region "the region" "the buffer")) + (word-count (cj/--count-words begin end))) + (message "There are %d words in %s." word-count area-type))) + +(defun cj/--count-characters (start end) + "Internal implementation: Count characters between START and END. +START and END define the region to count. +Returns the character count as an integer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (- end start)) + +(defun cj/count-characters-buffer-or-region () + "Count the number of characters in the buffer or region. +Display the result in the minibuffer." + (interactive) + (let* ((use-region (use-region-p)) + (begin (if use-region (region-beginning) (point-min))) + (end (if use-region (region-end) (point-max))) + (area-type (if use-region "the region" "the buffer")) + (char-count (cj/--count-characters begin end))) + (message "There are %d characters in %s." char-count area-type))) + +(cj/register-command "# w" #'cj/count-words-buffer-or-region "count words") +(cj/register-command "# c" #'cj/count-characters-buffer-or-region "count characters") + +(provide 'custom-counts) +;;; custom-counts.el ends here diff --git a/modules/custom-datetime.el b/modules/custom-datetime.el index 6bca494d8..0528688c2 100644 --- a/modules/custom-datetime.el +++ b/modules/custom-datetime.el @@ -1,4 +1,4 @@ -;;; custom-datetime.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-datetime.el --- Insert formatted date and time strings -*- coding: utf-8; lexical-binding: t; -*- ;;; Commentary: ;; @@ -12,32 +12,8 @@ ;; Runtime requires: keybindings. ;; Direct test load: yes (requires keybindings explicitly). ;; -;; Utilities for inserting date/time stamps in multiple formats. -;; -;; Interactive commands: -;; - cj/insert-readable-date-time -;; - cj/insert-sortable-date-time -;; - cj/insert-sortable-time -;; - cj/insert-readable-time -;; - cj/insert-sortable-date -;; - cj/insert-readable-date -;; -;; Each command is generated by `cj/--define-datetime-inserter' from a -;; corresponding format variable: -;; readable-date-time-format, sortable-date-time-format, -;; sortable-time-format, readable-time-format, -;; sortable-date-format, readable-date-format. -;; Customize these (see `format-time-string') to change output. -;; Some defaults include a trailing space for convenient typing. -;; -;; Key bindings: -;; A prefix map `cj/datetime-map' is installed on "d" under `cj/custom-keymap': -;; r → readable date+time -;; s → sortable date+time -;; t → sortable time -;; T → readable time -;; d → sortable date -;; D → readable date +;; Date/time insertion commands under C-; d. Each command is generated from a +;; customizable format variable and inserts format-time-string output at point. ;; ;;; Code: diff --git a/modules/custom-format.el b/modules/custom-format.el new file mode 100644 index 000000000..47cd7d88d --- /dev/null +++ b/modules/custom-format.el @@ -0,0 +1,46 @@ +;;; custom-format.el --- Region and buffer reformatting -*- coding: utf-8; lexical-binding: t; -*- + +;;; Commentary: +;; +;; Layer: 2 (Core UX). +;; Category: L. +;; Load shape: eager. +;; Eager reason: registers its C-; f command binding at load. +;; Top-level side effects: binds cj/format-region-or-buffer under C-; f. +;; Runtime requires: keybindings. +;; Direct test load: yes (requires keybindings explicitly). +;; +;; Reformat the active region, or the whole buffer when no region is active: +;; untabify, reindent, and delete trailing whitespace. Split out of the +;; former custom-misc.el grab-bag. + +;;; Code: + +(require 'keybindings) ;; provides cj/register-command + +(defun cj/--format-region (start end) + "Internal implementation: Reformat text between START and END. +START and END define the region to operate on. +Replaces tabs with spaces, reindents, and deletes trailing whitespace." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (untabify (point-min) (point-max)) + (indent-region (point-min) (point-max)) + (delete-trailing-whitespace (point-min) (point-max))))) + +(defun cj/format-region-or-buffer () + "Reformat the region or the entire buffer. +Replaces tabs with spaces, deletes trailing whitespace, and reindents." + (interactive) + (let ((start-pos (if (use-region-p) (region-beginning) (point-min))) + (end-pos (if (use-region-p) (region-end) (point-max)))) + (cj/--format-region start-pos end-pos) + (message "Formatted %s" (if (use-region-p) "region" "buffer")))) + +(cj/register-command "f" #'cj/format-region-or-buffer "format buffer") + +(provide 'custom-format) +;;; custom-format.el ends here diff --git a/modules/custom-line-paragraph.el b/modules/custom-line-paragraph.el index 2cbcecc16..d29d4125b 100644 --- a/modules/custom-line-paragraph.el +++ b/modules/custom-line-paragraph.el @@ -1,4 +1,4 @@ -;;; custom-line-paragraph.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-line-paragraph.el --- Line and paragraph editing commands -*- coding: utf-8; lexical-binding: t; -*- ;; Author: Craig Jennings <c@cjennings.net> ;; ;;; Commentary: @@ -14,16 +14,9 @@ ;; Runtime requires: keybindings (expand-region on demand via declare-function). ;; Direct test load: yes (requires keybindings explicitly). ;; -;; This module provides the following line and paragraph manipulation utilities: -;; -;; - joining lines in a region or the current line with the previous one -;; - joining separate lines into a single paragraph -;; - duplicating lines or regions (optional commenting) -;; - removing duplicate lines -;; - removing lines containing specific text -;; - underlining text with a custom character -;; -;; Bound to keymap prefix C-; l +;; Line and paragraph transforms under C-; l: join, duplicate, delete matching +;; lines, remove duplicates, and underline text. Commands operate on the active +;; region when present and otherwise on the current line or paragraph. ;; ;;; Code: @@ -173,5 +166,36 @@ If the line is empty or contains only whitespace, abort with a message." "C-; l r" "remove matching" "C-; l u" "underscore line")) +;; --- delimiter jump (formerly in custom-misc.el) --- +(defun cj/jump-to-matching-paren () + "Jump to the matching delimiter if point is on (or just after) one. +If not on a delimiter, show a message. Respects the current syntax table." + (interactive) + (let* ((ca (char-after)) + (cb (char-before)) + ;; Check if on opening paren + (open-p (and ca (eq (char-syntax ca) ?\())) + ;; Check if on or just after closing paren + (close-p (or (and ca (eq (char-syntax ca) ?\))) + (and cb (eq (char-syntax cb) ?\)))))) + (cond + ;; Jump forward from opening + (open-p + (condition-case err + (forward-sexp) + (scan-error + (message "No matching delimiter: %s" (error-message-string err))))) + ;; Jump backward from closing + (close-p + (condition-case err + (backward-sexp) + (scan-error + (message "No matching delimiter: %s" (error-message-string err))))) + ;; Not on delimiter + (t + (message "Point is not on a delimiter."))))) + +(cj/register-command ")" #'cj/jump-to-matching-paren "jump to paren") + (provide 'custom-line-paragraph) ;;; custom-line-paragraph.el ends here. diff --git a/modules/custom-misc.el b/modules/custom-misc.el deleted file mode 100644 index 7e5e4f8d6..000000000 --- a/modules/custom-misc.el +++ /dev/null @@ -1,196 +0,0 @@ -;;; custom-misc.el --- Miscellaneous utility functions -*- coding: utf-8; lexical-binding: t; -*- - -;;; Commentary: -;; -;; Layer: 2 (Core UX). -;; Category: L/C. -;; Load shape: eager. -;; Eager reason: registers its C-; command bindings and an align-regexp advice -;; at load. Currently eager by init order; a deferral candidate for Phase 3/4. -;; Top-level side effects: advises align-regexp; binds several commands directly -;; under C-; (")", "f", "A", "SPC", "|", and others). -;; Runtime requires: keybindings. -;; Direct test load: yes (requires keybindings explicitly). -;; -;; This module provides various utility functions for text manipulation, -;; formatting, and navigation. Features include: -;; - Jump between matching delimiters -;; - Format regions/buffers (untabify, reindent, remove trailing whitespace) -;; - Word counting with region awareness -;; - Fraction glyph conversion (¼ ↔ 1/4) -;; - Force align-regexp to use spaces instead of tabs -;; -;; All functions are bound to the cj/custom-keymap for easy access. -;; -;;; Code: - -(require 'keybindings) ;; provides cj/custom-keymap - -(defun cj/jump-to-matching-paren () - "Jump to the matching delimiter if point is on (or just after) one. -If not on a delimiter, show a message. Respects the current syntax table." - (interactive) - (let* ((ca (char-after)) - (cb (char-before)) - ;; Check if on opening paren - (open-p (and ca (eq (char-syntax ca) ?\())) - ;; Check if on or just after closing paren - (close-p (or (and ca (eq (char-syntax ca) ?\))) - (and cb (eq (char-syntax cb) ?\)))))) - (cond - ;; Jump forward from opening - (open-p - (condition-case err - (forward-sexp) - (scan-error - (message "No matching delimiter: %s" (error-message-string err))))) - ;; Jump backward from closing - (close-p - (condition-case err - (backward-sexp) - (scan-error - (message "No matching delimiter: %s" (error-message-string err))))) - ;; Not on delimiter - (t - (message "Point is not on a delimiter."))))) - - -(defun cj/--format-region (start end) - "Internal implementation: Reformat text between START and END. -START and END define the region to operate on. -Replaces tabs with spaces, reindents, and deletes trailing whitespace." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (untabify (point-min) (point-max)) - (indent-region (point-min) (point-max)) - (delete-trailing-whitespace (point-min) (point-max))))) - -(defun cj/format-region-or-buffer () - "Reformat the region or the entire buffer. -Replaces tabs with spaces, deletes trailing whitespace, and reindents." - (interactive) - (let ((start-pos (if (use-region-p) (region-beginning) (point-min))) - (end-pos (if (use-region-p) (region-end) (point-max)))) - (cj/--format-region start-pos end-pos) - (message "Formatted %s" (if (use-region-p) "region" "buffer")))) - -(defun cj/switch-to-previous-buffer () - "Switch to previously open buffer. -Repeated invocations toggle between the two most recently open buffers." - (interactive) - (switch-to-buffer (other-buffer (current-buffer) 1))) - -(defun cj/--count-words (start end) - "Internal implementation: Count words between START and END. -START and END define the region to count. -Returns the word count as an integer." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) - (count-words start end)) - -(defun cj/count-words-buffer-or-region () - "Count the number of words in the buffer or region. -Display the result in the minibuffer." - (interactive) - (let* ((use-region (use-region-p)) - (begin (if use-region (region-beginning) (point-min))) - (end (if use-region (region-end) (point-max))) - (area-type (if use-region "the region" "the buffer")) - (word-count (cj/--count-words begin end))) - (message "There are %d words in %s." word-count area-type))) - -(defun cj/--count-characters (start end) - "Internal implementation: Count characters between START and END. -START and END define the region to count. -Returns the character count as an integer." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) - (- end start)) - -(defun cj/count-characters-buffer-or-region () - "Count the number of characters in the buffer or region. -Display the result in the minibuffer." - (interactive) - (let* ((use-region (use-region-p)) - (begin (if use-region (region-beginning) (point-min))) - (end (if use-region (region-end) (point-max))) - (area-type (if use-region "the region" "the buffer")) - (char-count (cj/--count-characters begin end))) - (message "There are %d characters in %s." char-count area-type))) - - -(defun cj/--replace-fraction-glyphs (start end to-glyphs) - "Internal implementation: Replace fraction glyphs or text between START and END. -START and END define the region to operate on. -TO-GLYPHS when non-nil converts text (1/4) to glyphs (¼), -otherwise converts glyphs to text." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) - (let ((replacements (if to-glyphs - '(("1/4" . "¼") - ("1/2" . "½") - ("3/4" . "¾") - ("1/3" . "⅓") - ("2/3" . "⅔")) - '(("¼" . "1/4") - ("½" . "1/2") - ("¾" . "3/4") - ("⅓" . "1/3") - ("⅔" . "2/3")))) - (count 0) - (end-marker (copy-marker end))) - (save-excursion - (dolist (r replacements) - (goto-char start) - (while (search-forward (car r) end-marker t) - (replace-match (cdr r)) - (setq count (1+ count))))) - count)) - -(defun cj/replace-fraction-glyphs (start end) - "Replace common fraction glyphs between START and END. -Operate on the buffer or region designated by START and END. -Replace the text representations with glyphs when called with a -\\[universal-argument] prefix." - (interactive (if (use-region-p) - (list (region-beginning) (region-end)) - (list (point-min) (point-max)))) - (let ((count (cj/--replace-fraction-glyphs start end current-prefix-arg))) - (message "Replaced %d fraction%s" count (if (= count 1) "" "s")))) - -(defun cj/align-regexp-with-spaces (orig-fun &rest args) - "Call ORIG-FUN with ARGS while temporarily disabling tabs for alignment. -This advice ensures =align-regexp' uses spaces by binding =indent-tabs-mode' -to nil." - (let ((indent-tabs-mode nil)) - (apply orig-fun args))) - -;; avoid double advice stacking in case the file is reloaded -(advice-remove 'align-regexp #'cj/align-regexp-with-spaces) -(advice-add 'align-regexp :around #'cj/align-regexp-with-spaces) - -(cj/register-command ")" #'cj/jump-to-matching-paren) -(cj/register-command "f" #'cj/format-region-or-buffer) -(cj/register-command "# w" #'cj/count-words-buffer-or-region) -(cj/register-command "# c" #'cj/count-characters-buffer-or-region) -(cj/register-command "/" #'cj/replace-fraction-glyphs) -(cj/register-command "A" #'align-regexp) -(cj/register-command "SPC" #'cj/switch-to-previous-buffer) -(cj/register-command "|" #'display-fill-column-indicator-mode) - -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements - "C-; )" "jump to paren" - "C-; f" "format buffer" - "C-; # w" "count words" - "C-; # c" "count characters" - "C-; /" "fraction glyphs" - "C-; A" "align regexp" - "C-; SPC" "prev buffer" - "C-; |" "fill column")) - -(provide 'custom-misc) -;;; custom-misc.el ends here diff --git a/modules/custom-ordering.el b/modules/custom-ordering.el index 0a499a35a..4dc5bff84 100644 --- a/modules/custom-ordering.el +++ b/modules/custom-ordering.el @@ -1,4 +1,4 @@ -;;; custom-ordering.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-ordering.el --- Region sorting and list-format transforms -*- coding: utf-8; lexical-binding: t; -*- ;;; Commentary: ;; @@ -13,22 +13,10 @@ ;; declare-function). ;; Direct test load: yes (requires keybindings explicitly). ;; -;; Text transformation and sorting utilities for reformatting data structures. +;; Region transforms under C-; o for sorting, reversing, numbering, quote +;; toggling, and converting between line lists and comma-separated arrays. +;; Helpers preserve trailing newlines where line-oriented callers expect them. ;; -;; Array/list formatting: -;; - arrayify/listify - convert lines to comma-separated format (with/without quotes, brackets) -;; - unarrayify - convert arrays back to separate lines -;; -;; Line manipulation: -;; - toggle-quotes - swap double ↔ single quotes -;; - reverse-lines - reverse line order -;; - number-lines - add line numbers with custom format (supports zero-padding) -;; - alphabetize-region - sort words alphabetically -;; - comma-separated-text-to-lines - split CSV text into lines -;; -;; Convenience functions: listify, arrayify-json, arrayify-python -;; Bound to keymap prefix C-; o - ;;; Code: (require 'cl-lib) diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 5b1b00a71..4d72347d1 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -1,4 +1,4 @@ -;;; custom-text-enclose.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-text-enclose.el --- Wrap, unwrap, and prefix text ranges -*- coding: utf-8; lexical-binding: t; -*- ;;; Commentary: ;; @@ -12,23 +12,10 @@ ;; Runtime requires: keybindings (change-inner on demand via declare-function). ;; Direct test load: yes (requires keybindings explicitly). ;; -;; Text enclosure utilities for wrapping and line manipulation. +;; Text enclosure commands under C-; s. Commands wrap or unwrap the active +;; region/word at point, and add prefixes, suffixes, indentation, or dedentation +;; across selected lines. ;; -;; Wrapping functions: -;; - surround-word-or-region - wrap text with same delimiter on both sides -;; - wrap-word-or-region - wrap with different opening/closing delimiters -;; - unwrap-word-or-region - remove surrounding delimiters -;; -;; Line manipulation: -;; - append-to-lines - add suffix to each line -;; - prepend-to-lines - add prefix to each line -;; - indent-lines - add leading whitespace (spaces or tabs) -;; - dedent-lines - remove leading whitespace -;; -;; Most functions work on region or entire buffer when no region is active. -;; -;; Bound to keymap prefix C-; s - ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap diff --git a/modules/custom-text-transform.el b/modules/custom-text-transform.el new file mode 100644 index 000000000..537f8df21 --- /dev/null +++ b/modules/custom-text-transform.el @@ -0,0 +1,63 @@ +;;; custom-text-transform.el --- Text glyph transforms -*- coding: utf-8; lexical-binding: t; -*- + +;;; Commentary: +;; +;; Layer: 2 (Core UX). +;; Category: L. +;; Load shape: eager. +;; Eager reason: registers its C-; / command binding at load. +;; Top-level side effects: binds cj/replace-fraction-glyphs under C-; /. +;; Runtime requires: keybindings. +;; Direct test load: yes (requires keybindings explicitly). +;; +;; Convert between text fractions (1/4) and their Unicode glyphs (1/4 becomes +;; the vulgar-fraction character), over the region or whole buffer. Split out +;; of the former custom-misc.el grab-bag. + +;;; Code: + +(require 'keybindings) ;; provides cj/register-command + +(defun cj/--replace-fraction-glyphs (start end to-glyphs) + "Internal implementation: Replace fraction glyphs or text between START and END. +START and END define the region to operate on. +TO-GLYPHS when non-nil converts text (1/4) to glyphs (¼), +otherwise converts glyphs to text." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((replacements (if to-glyphs + '(("1/4" . "¼") + ("1/2" . "½") + ("3/4" . "¾") + ("1/3" . "⅓") + ("2/3" . "⅔")) + '(("¼" . "1/4") + ("½" . "1/2") + ("¾" . "3/4") + ("⅓" . "1/3") + ("⅔" . "2/3")))) + (count 0) + (end-marker (copy-marker end))) + (save-excursion + (dolist (r replacements) + (goto-char start) + (while (search-forward (car r) end-marker t) + (replace-match (cdr r)) + (setq count (1+ count))))) + count)) + +(defun cj/replace-fraction-glyphs (start end) + "Replace common fraction glyphs between START and END. +Operate on the buffer or region designated by START and END. +Replace the text representations with glyphs when called with a +\\[universal-argument] prefix." + (interactive (if (use-region-p) + (list (region-beginning) (region-end)) + (list (point-min) (point-max)))) + (let ((count (cj/--replace-fraction-glyphs start end current-prefix-arg))) + (message "Replaced %d fraction%s" count (if (= count 1) "" "s")))) + +(cj/register-command "/" #'cj/replace-fraction-glyphs "fraction glyphs") + +(provide 'custom-text-transform) +;;; custom-text-transform.el ends here diff --git a/modules/custom-whitespace.el b/modules/custom-whitespace.el index 0d4d1cc06..52cc4e54d 100644 --- a/modules/custom-whitespace.el +++ b/modules/custom-whitespace.el @@ -1,4 +1,4 @@ -;;; custom-whitespace.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-whitespace.el --- Whitespace cleanup commands -*- coding: utf-8; lexical-binding: t; -*- ;;; Commentary: ;; @@ -12,19 +12,10 @@ ;; Runtime requires: keybindings. ;; Direct test load: yes (requires keybindings explicitly). ;; -;; This module provides whitespace manipulation operations for cleaning and transforming whitespace in text. - -;; Functions include: - -;; - removing leading and trailing whitespace -;; - collapsing multiple spaces to single spaces -;; - deleting blank lines -;; - converting whitespace to hyphens. - -;; All operations work on the current line, active region, or entire buffer depending on context. - -;; Bound to keymap prefix C-; w - +;; Whitespace cleanup under C-; w: trim line edges, collapse runs of spaces, +;; delete blank lines, enforce a single blank line, and hyphenate whitespace. +;; Commands choose region, buffer, or current line based on prefix/mark state. +;; ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap @@ -237,5 +228,21 @@ Operate on the active region designated by START and END." "C-; w t" "untabify" "C-; w T" "tabify")) +;; --- align-regexp space enforcement + alignment/fill bindings --- +;; (formerly in custom-misc.el) +(defun cj/align-regexp-with-spaces (orig-fun &rest args) + "Call ORIG-FUN with ARGS while temporarily disabling tabs for alignment. +This advice ensures =align-regexp' uses spaces by binding =indent-tabs-mode' +to nil." + (let ((indent-tabs-mode nil)) + (apply orig-fun args))) + +;; avoid double advice stacking in case the file is reloaded +(advice-remove 'align-regexp #'cj/align-regexp-with-spaces) +(advice-add 'align-regexp :around #'cj/align-regexp-with-spaces) + +(cj/register-command "A" #'align-regexp "align regexp") +(cj/register-command "|" #'display-fill-column-indicator-mode "fill column") + (provide 'custom-whitespace) ;;; custom-whitespace.el ends here. diff --git a/modules/dashboard-config.el b/modules/dashboard-config.el index 96aaaf6a1..53f19b72b 100644 --- a/modules/dashboard-config.el +++ b/modules/dashboard-config.el @@ -21,7 +21,7 @@ (eval-when-compile (require 'undead-buffers)) (declare-function cj/make-buffer-undead "undead-buffers" (string)) (autoload 'cj/make-buffer-undead "undead-buffers" nil t) -(declare-function ghostel "ghostel" (&optional arg)) +(declare-function cj/term-toggle "eat-config") ;; ------------------------------ Declarations ------------------------------- ;; These functions and variables belong to lazily-loaded packages or to other @@ -54,6 +54,7 @@ (declare-function nerd-icons-mdicon "nerd-icons") (declare-function nerd-icons-codicon "nerd-icons") (declare-function nerd-icons-octicon "nerd-icons") +(declare-function nerd-icons-wicon "nerd-icons") ;; user-constants.el provides the home-directory constant. (defvar user-home-dir) @@ -137,8 +138,9 @@ Adjust this if the title doesn't appear centered under the banner image.") (list (list "c" #'nerd-icons-faicon "nf-fa-code" "Code" "Switch Project" (lambda () (projectile-switch-project))) (list "d" #'nerd-icons-faicon "nf-fa-folder_o" "Files" "Dirvish File Manager" (lambda () (dirvish user-home-dir))) - (list "t" #'nerd-icons-devicon "nf-dev-terminal" "Terminal" "Launch Terminal" (lambda () (ghostel))) + (list "t" #'nerd-icons-devicon "nf-dev-terminal" "Terminal" "Launch Terminal" (lambda () (cj/term-toggle))) (list "a" #'nerd-icons-mdicon "nf-md-calendar" "Agenda" "Main Org Agenda" (lambda () (cj/main-agenda-display))) + (list "w" #'nerd-icons-wicon "nf-weather-day_sunny_overcast" "Weather" "Wttrin Weather Forecast" (lambda () (call-interactively #'wttrin))) (list "r" #'nerd-icons-faicon "nf-fa-rss_square" "Feeds" "Elfeed Feed Reader" (lambda () (cj/elfeed-open))) (list "b" #'nerd-icons-codicon "nf-cod-library" "Books" "Calibre Ebook Reader" (lambda () (calibredb))) (list "f" #'nerd-icons-mdicon "nf-md-school" "Flashcards" "Org-Drill" (lambda () (cj/drill-start))) @@ -152,9 +154,10 @@ Adjust this if the title doesn't appear centered under the banner image.") "Dashboard launcher table: (KEY ICON-FN ICON-NAME LABEL TOOLTIP ACTION). Drives both `dashboard-navigator-buttons' and the dashboard-mode-map keys.") -(defconst cj/dashboard--row-sizes '(4 4 3 3) +(defconst cj/dashboard--row-sizes '(5 4 3 3) "Navigator row lengths. Must sum to the number of `cj/dashboard--launchers'. -The last row groups Slack, Linear, and Signal together.") +The top row carries Weather alongside the core tools; the last row groups +Slack, Linear, and Signal together.") (defun cj/dashboard--navigator-button (l) "Build a `dashboard-navigator-buttons' entry from launcher L." @@ -272,7 +275,7 @@ system-defaults) are preserved rather than overwritten." (setq initial-buffer-choice (lambda () (get-buffer "*dashboard*")))) ;; don't display dashboard if opening a file (setq dashboard-display-icons-p t) ;; display icons on both GUI and terminal (setq dashboard-icon-type 'nerd-icons) ;; use `nerd-icons' package - (setq dashboard-set-file-icons t) ;; per-filetype icons on the list items (nerd-icons colors them by type) + (setq dashboard-set-file-icons nil) ;; no per-item icons on the list entries: URL bookmarks have no filename, so they'd render iconless next to file items -- dropping them all keeps the lists uniform (setq dashboard-set-heading-icons t) ;; nerd-icons on the section titles (Projects/Bookmarks/Recent) (setq dashboard-center-content t) ;; horizontally center dashboard content (setq dashboard-bookmarks-show-path nil) ;; don't show paths in bookmarks diff --git a/modules/dev-fkeys.el b/modules/dev-fkeys.el index 9fdfa5b3f..80b43600b 100644 --- a/modules/dev-fkeys.el +++ b/modules/dev-fkeys.el @@ -5,48 +5,17 @@ ;; Layer: 2 (Core UX). ;; Category: C. ;; Load shape: eager. -;; Eager reason: the F4/F6 developer command entry points. -;; Top-level side effects: six global F-key bindings; conditionally registers a -;; C-; P binding. +;; Eager reason: binds the F4/F6 developer command entry points. +;; Top-level side effects: global F-key bindings and optional C-; P binding. ;; Runtime requires: cl-lib, system-lib, keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Direct test load: yes. ;; -;; Project-aware F-key block for developer workflows: +;; Project-aware F-key dispatchers. F4 chooses compile/run/clean commands by +;; project markers; C-F4 and M-F4 are fast paths. F6 runs all project tests or +;; the current file's tests using language-specific command builders. ;; -;; F4 completing-read of compile/run candidates filtered by project type -;; C-F4 fast path: compile only (no-op on interpreted projects) -;; M-F4 fast path: clean + rebuild (no-op on interpreted projects) -;; S-F4 recompile (built-in) -;; F6 completing-read of test candidates: All tests / Current file's tests -;; C-F6 fast path: current file's tests -;; -;; F4 project-type detection runs against the projectile root and falls back -;; to \\='unknown when no marker matches. Interpreted markers are checked -;; before compiled markers, so a Python or Node project that also has a -;; Makefile for tasks classifies as interpreted. -;; -;; F6 \"All tests\" delegates to `projectile-test-project'. F6 \"Current -;; file's tests\" detects the language by extension, derives the runner -;; command (elisp via the project Makefile, Python via pytest, Go via the -;; package), and pipes through `compile' from the projectile root. -;; TypeScript / JavaScript are detected but punted for v1 — the function -;; signals a user-error rather than guessing a runner. -;; -;; M-F6 is reserved for Phase 2b (\"Run a test...\" menu entry with -;; per-language test-name discovery). Phase 2b also adds buffer-local -;; last-test memory and tree-sitter-based discovery for Python / Go / -;; TypeScript. The tree-sitter discovery uses a capture-then-filter pattern -;; (queries without `:match' / `:equal' / `:pred' predicates, with the -;; pattern filter applied in Elisp) to sidestep Emacs bug #79687 — Emacs -;; 30.2 emits unsuffixed `#match' predicates that libtree-sitter 0.26 -;; rejects. The fix lives on Emacs master (commit b0143530) and is -;; targeted at Emacs 31; it has not been backported to the emacs-30 -;; branch as of 2026-05-03. See Mike Olson's writeup at -;; https://mwolson.org/blog/emacs/2026-04-20-fixing-typescript-ts-mode-in-emacs-30-2/ -;; for the same workaround applied to font-lock. -;; -;; F7 (coverage) is wired in coverage-core.el. F5 is reserved for the debug -;; ticket and intentionally left unbound here. +;; Interpreted markers win over compiled markers so task Makefiles do not turn +;; Python/Node projects into compile-first projects. ;;; Code: diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el index 81d352dbd..713a5e69b 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -17,8 +17,8 @@ ;; ediff, playlist creation, path copying, and external file manager integration. ;; ;; Key Bindings: -;; - d: Delete marked files (dired-do-delete) -;; - D: Duplicate file at point (adds "-copy" before extension) +;; - d: Diff/ediff selected files (cj/dired-ediff-files) +;; - D: Delete (dired-do-delete; mark with m for batches) ;; - g: Quick access menu (jump to predefined directories) ;; - G: Search with deadgrep in current directory ;; - f: Open system file manager in current directory @@ -194,7 +194,9 @@ Filters for audio files, prompts for the playlist name, and saves the resulting (:map dired-mode-map ([remap dired-summary] . which-key-show-major-mode) ("E" . wdired-change-to-wdired-mode) ;; edit names and properties in buffer - ("e" . cj/dired-ediff-files)) ;; ediff files + ("e" . cj/dired-ediff-files) ;; ediff files + ("d" . cj/dired-ediff-files) ;; d = diff, matching C-; b / ibuffer (was dired-flag-file-deletion) + ("D" . dired-do-delete)) ;; D = delete (d no longer flags; mark with m, then D) :custom (dired-use-ls-dired nil) ;; non GNU FreeBSD doesn't support a "--dired" switch :config @@ -205,6 +207,13 @@ Filters for audio files, prompts for the playlist name, and saves the resulting (setq dired-recursive-copies (quote always)) ;; "always" means no asking (setq dired-recursive-deletes (quote top))) ;; "top" means ask once +;; which-key labels for the d=diff / D=delete pair (shown in the major-mode +;; popup via `which-key-show-major-mode'). +(with-eval-after-load 'which-key + (which-key-add-major-mode-key-based-replacements 'dired-mode + "d" "diff (ediff files)" + "D" "delete file")) + ;; note: disabled as it prevents marking and moving files to another directory ;; (setq dired-kill-when-opening-new-dired-buffer t) ;; don't litter by leaving buffers when navigating directories @@ -438,7 +447,7 @@ Uses feh on X11, the `set-wallpaper' script on Wayland." ;; at home. `q' in that frame runs `cj/dirvish-popup-quit', which quits Dirvish ;; and deletes the popup frame so a stray launch never orphans it; `q' in any ;; other frame quits Dirvish normally. The launcher script calls this command -;; instead of plain `dirvish'. This mirrors the Super+Shift+N quick-capture +;; instead of plain `dirvish'. This mirrors the Super+N quick-capture ;; popup (see `cj/quick-capture' in org-capture-config.el). (defun cj/--dirvish-popup-frame () diff --git a/modules/dwim-shell-config.el b/modules/dwim-shell-config.el index 014194c7b..e8790a489 100644 --- a/modules/dwim-shell-config.el +++ b/modules/dwim-shell-config.el @@ -1,99 +1,23 @@ -;; dwim-shell-config.el --- Dired Shell Commands -*- coding: utf-8; lexical-binding: t; -*- +;;; dwim-shell-config.el --- Dired shell command menu -*- coding: utf-8; lexical-binding: t; -*- ;; ;;; Commentary: ;; ;; Layer: 3 (Domain Workflow). ;; Category: D/P. ;; Load shape: eager. -;; Eager reason: none; Dired/Dirvish shell commands, a command-loaded deferral -;; candidate. +;; Eager reason: none; Dired/Dirvish shell commands can load by command. ;; Top-level side effects: package configuration via use-package. -;; Runtime requires: cl-lib. +;; Runtime requires: cl-lib, system-lib. ;; Direct test load: yes. ;; -;; This module provides a collection of DWIM (Do What I Mean) shell commands -;; for common file operations in Dired and other buffers. It leverages the -;; `dwim-shell-command' package to execute shell commands on marked files -;; with smart templating and progress tracking. -;; -;; Features: -;; - Audio/Video conversion (mp3, opus, webp, HEVC) -;; - Image manipulation (resize, flip, format conversion) -;; - PDF operations (merge, split, password protection, OCR) -;; - Archive management (zip/unzip) -;; - Document conversion (epub to org, docx to pdf, pdf to txt) -;; - Git operations (clone from clipboard) -;; - External file opening with context awareness -;; -;; Workflow: -;; 1. *Mark files in Dired/Dirvish* -;; - Use =m= to mark individual files -;; - Use =* .= to mark by extension -;; - Use =% m= to mark by regexp -;; - Or operate on the file under cursor if nothing is marked -;; -;; 2. *Execute a DWIM command* -;; - Call the command via =M-x dwim-shell-commands-[command-name]= -;; - Or bind frequently used commands to keys -;; -;; 3. *Command execution* -;; - The command runs asynchronously in the background -;; - A =*Async Shell Command*= buffer shows progress -;; - Files are processed with smart templating (replacing =<<f>>=, =<<fne>>=, etc.) -;; -;; 4. *Results* -;; - New files appear in the Dired/Dirvish buffer -;; - Buffer auto-refreshes when command completes -;; - Errors appear in the async buffer if something fails -;; -;; Requirements: -;; The commands rely on various external utilities that need to be installed: -;; - ffmpeg: Audio/video conversion -;; - imagemagick (convert): Image manipulation -;; - qpdf: PDF operations (requires version 8.x+ for secure password handling) -;; - tesseract: OCR functionality -;; - pandoc: Document conversion -;; - atool: Archive extraction -;; - rsvg-convert: SVG to PNG conversion -;; - pdftotext: PDF text extraction -;; - git: Version control operations -;; - gpgconf: GPG agent management -;; - 7z (p7zip): Secure password-protected archives -;; -;; On Arch Linux, install the requirements with: -;; #+begin_src bash -;; sudo pacman -S --needed ffmpeg imagemagick qpdf tesseract tesseract-data-eng pandoc atool librsvg poppler git gnupg p7zip zip unzip mkvtoolnix-cli mpv ruby -;; #+end_src -;; -;; On MacOS, install the requirements with: -;; #+begin_src bash -;; brew install ffmpeg imagemagick qpdf tesseract pandoc atool librsvg poppler gnupg p7zip mkvtoolnix mpv -;; #+end_src -;; -;; Usage: -;; Commands operate on marked files in Dired or the current file in other modes. -;; The package automatically replaces standard shell commands with DWIM versions -;; for a more intuitive experience. -;; -;; Security: -;; Password-protected operations (PDF encryption, archive encryption) use secure -;; methods to avoid exposing passwords in process lists or command history: -;; - PDF operations: Use temporary files with restrictive permissions (mode 600) -;; - Archive operations: Use 7z instead of zip for better password handling -;; - Temporary password files are automatically cleaned up after use -;; - Note: Switched from zip to 7z for encryption due to zip's insecure -P flag -;; -;; Template Variables: -;; - <<f>>: Full path to file -;; - <<fne>>: File name without extension -;; - <<e>>: File extension -;; - <<b>>: Base name (file name with extension, no directory) -;; - <<d>>: Directory path -;; - <<n>>: Sequential number (for batch renaming) -;; - <<td>>: Temporary directory -;; - <<cb>>: Clipboard contents -;; - <<*>>: All marked files +;; Configures dwim-shell-command actions for marked Dired/Dirvish files: +;; media conversion, archive/PDF/document operations, external opening, and a +;; curated transient menu. Commands use dwim-shell templates for marked files or +;; the current buffer file. ;; +;; Password-bearing operations avoid command-line secrets by writing temporary +;; password files with restrictive permissions and deleting them from the process +;; sentinel after the spawned command exits. ;;; Code: diff --git a/modules/eat-config.el b/modules/eat-config.el new file mode 100644 index 000000000..1de24dc4f --- /dev/null +++ b/modules/eat-config.el @@ -0,0 +1,531 @@ +;;; eat-config.el --- EAT terminal emulator and the F12 eshell toggle -*- lexical-binding: t; coding: utf-8; -*- + +;;; Commentary: +;; +;; EAT (Emulate A Terminal, pure elisp) is the terminal emulator. Because EAT +;; renders entirely in elisp, its whole palette is real Emacs faces, so it themes +;; from the theme. This module owns the eat package configuration, the keymap +;; wiring that lets F12 and C-; reach Emacs from inside a terminal, and the F12 +;; dock-and-remember toggle. +;; +;; F12 opens eshell, which runs through EAT (eat-eshell-mode, set up in +;; eshell-config.el): the shell is eshell -- elisp functions as commands, TRAMP +;; transparency -- and EAT renders its visual commands. eshell-config.el holds +;; the shell itself; this module holds the emulator and the toggle. +;; +;; The toggle reuses the geometry-preservation pattern from cj-window-toggle-lib: +;; capture direction + body size at toggle-off, replay them via a custom display +;; action using frame-edge directions and body-relative sizes, so the docked +;; terminal returns at the same size and the result is divider-independent. + +;;; Code: + +(require 'keybindings) +(require 'system-lib) +(require 'cj-window-geometry-lib) +(require 'cj-window-toggle-lib) + +(declare-function eat "eat" (&optional program arg)) +(declare-function eshell "eshell" (&optional arg)) +(declare-function cj/dashboard-only "dashboard-config") +(defvar eat-mode-map) +(defvar eat-semi-char-mode-map) +(defvar eshell-buffer-name) +(defvar cj/custom-keymap) + +;; EAT paints its palette with manual `face' text properties (the ANSI colors). +;; Left in `global-font-lock-mode', the terminal buffer also gets syntactic +;; fontification -- a "..." in program output becomes `font-lock-string-face', +;; overriding the foreground EAT painted (e.g. green-on-green inside a diff) -- +;; so exclude eat-mode, the same reason dashboard and mu4e are excluded. A +;; mode-hook can't do this: `global-font-lock-mode' runs after the mode hook. +(cj/exclude-from-global-font-lock 'eat-mode) + +(defun cj/turn-off-chrome-for-term () + "Turn off line numbers and hl-line in a terminal buffer." + (hl-line-mode -1) + (display-line-numbers-mode -1)) + +(defun cj/--eat-tame-scroll () + "Reduce the viewport bounce from full-frame inline redraws (Claude Code). +Such programs move the terminal cursor up to redraw their whole block and back +to the bottom on every tick; EAT follows the cursor with point, so the window +chases it. Line-scroll minimally instead of recentering, drop the scroll +margin, and disable auto vscroll, so the window follows with the smallest +movement. It cannot fully remove the bounce -- the inline redraw is the root -- +but it makes each jump gentler." + (setq-local scroll-conservatively 101) + (setq-local scroll-margin 0) + (setq-local auto-window-vscroll nil)) + +(defcustom cj/eat-reset-sgr-at-newline t + "When non-nil, EAT resets SGR (color) at each newline. +Claude Code and similar inline TUIs sometimes truncate a colored span without +emitting a reset; the unterminated color then bleeds onto every following line +in the buffer. Injecting a reset before each newline contains it to its own +line. Safe for the common case where programs re-open their color per line; a +program that carries a single color across newlines without re-opening it would +lose that color past the first line, so set this to nil if you hit that." + :type 'boolean + :group 'eat) + +(declare-function eat-term-process-output "eat") + +(defun cj/--eat-reset-sgr-at-newline (args) + "`:filter-args' advice for `eat-term-process-output'. +When `cj/eat-reset-sgr-at-newline' is non-nil, inject an SGR reset before each +newline in the pty OUTPUT so an unterminated color cannot bleed past its line. +ARGS is (TERMINAL OUTPUT)." + (if cj/eat-reset-sgr-at-newline + (list (car args) + (replace-regexp-in-string "\n" "\e[0m\n" (cadr args) t t)) + args)) + +(advice-add 'eat-term-process-output :filter-args #'cj/--eat-reset-sgr-at-newline) + +;; ------------------------------- eat package --------------------------------- + +(use-package eat + :ensure t + :commands (eat) + :hook ((eat-mode . cj/turn-off-chrome-for-term) + (eat-mode . cj/--eat-tame-scroll)) + :custom + ;; Close the EAT buffer when its shell exits. + (eat-kill-buffer-on-exit t) + ;; Shell-integration UX. These are EAT defaults, set explicitly to document + ;; intent and survive default changes. They only light up once the shell + ;; sources EAT's integration script -- see the EAT block in the zsh rc. + (eat-enable-directory-tracking t) ; Emacs follows the terminal's cwd + (eat-enable-shell-prompt-annotation t) ; the success/running/failure prompt glyphs + (eat-enable-shell-command-history t) ; terminal history into EAT line-mode isearch + ;; Interaction. + (eat-enable-mouse t) ; mouse clicks + selection in TUIs (default) + (eat-enable-kill-from-terminal t) ; terminal selection -> Emacs kill-ring (default) + (eat-enable-yank-to-terminal t) ; Emacs kill-ring -> the terminal (off by default) + ;; Fidelity. + (eat-enable-alternative-display t) ; alt-screen so TUIs restore scrollback on exit (default) + (eat-term-scrollback-size (* 10 1024 1024)) ; ~10MB of scrollback, matching the old ghostel + ;; Truecolor is already on: eat-term-name auto-selects the compiled eat-truecolor terminfo. + ;; Niceties. + (eat-sixel-render-formats '(xpm svg half-block background none)) ; inline images (on by default) + (eat-query-before-killing-running-terminal 'auto) ; confirm before killing a terminal with a live process + :config + ;; F1, F12, and C-; must reach Emacs from inside EAT. In semi-char mode + ;; (EAT's default) EAT forwards unbound keys to the terminal -- a letter runs + ;; `eat-self-input' -- so bind these explicitly or they never reach Emacs: + ;; F1 runs the kill-all sweep back to the dashboard (`cj/dashboard-only', + ;; which buries agent buffers rather than killing them), F12 toggles the + ;; terminal window, C-; opens the global prefix map. Unlike ghostel, EAT + ;; needs no exception-list or keymap rebuild -- the bind alone suffices. + (keymap-set eat-semi-char-mode-map "<f1>" #'cj/dashboard-only) + (keymap-set eat-semi-char-mode-map "<f12>" #'cj/term-toggle) + (keymap-set eat-semi-char-mode-map "C-;" cj/custom-keymap) + (keymap-set eat-mode-map "<f1>" #'cj/dashboard-only) + (keymap-set eat-mode-map "<f12>" #'cj/term-toggle) + (keymap-set eat-mode-map "C-;" cj/custom-keymap)) + +;; ----------------------- F12 toggle (custom) ----------------------- +;; +;; Mirrors the geometry-preservation pattern shared with ai-term.el: capture +;; direction + body size at toggle-off, replay them via a custom display action +;; using frame-edge directions and body-relative sizes so the result is +;; divider-independent and layout-stable. Manages the EAT terminal only; +;; ai-term.el's agent buffers are separate (M-SPC). + +(defcustom cj/term-toggle-window-height 0.7 + "Default fraction of frame height for the F12 terminal window. +Used as the size fallback when F12 docks the terminal as a bottom split." + :type 'number + :group 'term) + +(defcustom cj/term-toggle-window-width 0.5 + "Default fraction of frame width for the F12 terminal window. +Used as the size fallback when F12 docks the terminal as a right-side +column (see `cj/--term-toggle-default-direction')." + :type 'number + :group 'term) + +(defun cj/--term-toggle-default-direction () + "Return the default dock direction for the F12 terminal: `right' or `below'. +Docks as a right-side column only when a side-by-side split would leave +both panes at least `cj/window-dock-min-columns' wide (the terminal's +share is `cj/term-toggle-window-width'); otherwise stacks below. See +`cj/preferred-dock-direction'." + (cj/preferred-dock-direction (frame-width) cj/term-toggle-window-width)) + +(defun cj/--term-toggle-default-size (direction) + "Return the default size fraction paired with DIRECTION for the F12 terminal. +`cj/term-toggle-window-width' for `right', `cj/term-toggle-window-height' +otherwise." + (if (eq direction 'right) + cj/term-toggle-window-width + cj/term-toggle-window-height)) + +(defvar cj/--term-toggle-last-direction nil + "Last user-chosen direction for the F12 terminal display. +Symbol: right, left, or below. `above' is never stored. nil means use the +default `below' for F12's traditional bottom split.") + +(defvar cj/--term-toggle-last-size nil + "Last user-chosen size for the F12 terminal display. +Positive integer: body-cols (right/left) or total-lines (below/above) -- see +`cj/window-replay-size' for why the vertical axis uses total, not body. +nil means fall back to `cj/term-toggle-window-height' as a fraction.") + +(defun cj/--term-toggle-buffer-p (buffer) + "Return non-nil when BUFFER is an eshell terminal F12 should manage. + +F12 opens eshell, which runs through EAT via eat-eshell-mode. ai-term's +agent buffers are managed separately via M-SPC, not F12." + (and (bufferp buffer) + (buffer-live-p buffer) + (with-current-buffer buffer + (derived-mode-p 'eshell-mode)))) + +(defun cj/--term-toggle-buffers () + "Return live F12-managed terminal buffers in `buffer-list' (MRU) order." + (seq-filter #'cj/--term-toggle-buffer-p (buffer-list))) + +(defun cj/--term-toggle-displayed-window (&optional frame) + "Return a window in FRAME currently displaying an F12 terminal buffer, or nil. +FRAME defaults to the selected frame. Minibuffer is excluded." + (seq-find (lambda (w) + (cj/--term-toggle-buffer-p (window-buffer w))) + (window-list (or frame (selected-frame)) 'never))) + +(defun cj/--term-toggle-capture-state (window) + "Capture WINDOW's direction + body size into module-level state. +The default direction (used when WINDOW fills its frame) is the +column-rule choice from `cj/--term-toggle-default-direction'." + (cj/window-toggle-capture-state + window (cj/--term-toggle-default-direction) + 'cj/--term-toggle-last-direction + 'cj/--term-toggle-last-size + '(right below left))) + +(defun cj/--term-toggle-display-saved (buffer alist) + "Display-buffer action: split per saved direction and body size. +Delegates to `cj/window-toggle-display-saved' against the F12 state vars, +falling back to the column-rule default direction +\(`cj/--term-toggle-default-direction') and its paired size." + (let ((dir (cj/--term-toggle-default-direction))) + (cj/window-toggle-display-saved + buffer alist + 'cj/--term-toggle-last-direction dir + 'cj/--term-toggle-last-size (cj/--term-toggle-default-size dir)))) + +(defun cj/--term-toggle-display-rule-list () + "Return the `display-buffer-alist' entry list installed by F12. +Routes any terminal buffer satisfying `cj/--term-toggle-buffer-p' through +reuse-window then the saved-geometry action. Excludes agent buffers." + '(((lambda (buffer-or-name _) + (cj/--term-toggle-buffer-p (get-buffer buffer-or-name))) + (display-buffer-reuse-window + cj/--term-toggle-display-saved) + (inhibit-same-window . t)))) + +(dolist (entry (cj/--term-toggle-display-rule-list)) + (add-to-list 'display-buffer-alist entry)) + +(defun cj/--term-toggle-dispatch () + "Compute the F12 (`cj/term-toggle') action without performing it. + +Returns one of: +- (toggle-off . WINDOW) -- terminal displayed in WINDOW; hide it. +- (show-recent . BUFFER) -- terminal alive but not shown; redisplay. +- (create-new) -- no terminal buffer alive; create one." + (let ((win (cj/--term-toggle-displayed-window))) + (cond + (win (cons 'toggle-off win)) + (t + (let ((buffers (cj/--term-toggle-buffers))) + (cond + (buffers (cons 'show-recent (car buffers))) + (t '(create-new)))))))) + +(defun cj/term-toggle () + "Toggle the F12 eshell terminal (the primary `*eshell*', run through EAT). + +- If it is displayed in this frame, capture its geometry and delete its window + (toggle off). Falls back to burying when it is the only window in the frame. +- Otherwise, if it is alive, display it via the saved-geometry action. +- Otherwise, open eshell, displaying it through the same saved-geometry action. + +eshell runs through EAT via eat-eshell-mode, so visual commands render in a real +terminal. ai-term's agent buffers are managed separately via M-SPC." + (interactive) + (pcase (cj/--term-toggle-dispatch) + (`(toggle-off . ,win) + (cj/--term-toggle-capture-state win) + (if (one-window-p) + (bury-buffer (window-buffer win)) + (delete-window win)) + nil) + (`(show-recent . ,buf) + (display-buffer buf) + (let ((w (get-buffer-window buf))) + (when w (select-window w))) + buf) + (`(create-new) + ;; Open the primary eshell without stealing the layout, then display it + ;; through the saved-geometry dock rule (same path as show-recent). + (save-window-excursion (eshell)) + (let ((buf (get-buffer (or (bound-and-true-p eshell-buffer-name) "*eshell*")))) + (when buf + (display-buffer buf) + (let ((w (get-buffer-window buf))) + (when w (select-window w)))) + buf)))) + +(keymap-global-set "<f12>" #'cj/term-toggle) + +;; ------------------- terminal copy mode + tmux history ----------------------- +;; Carried over from the ghostel era for the EAT agent terminals (ai-term). +;; Agents run EAT over tmux, so copy-mode is tmux's own copy-mode -- the same UX +;; ghostel-over-tmux had. C-<up> enters it and scrolls up in one stroke; C-; x c +;; enters it via the menu, and C-; x h grabs the whole pane history into a buffer. + +(declare-function cj/register-prefix-map "keybindings") +(declare-function eat-emacs-mode "eat") +(defvar eat--semi-char-mode) +(defvar eat--char-mode) +(defvar eat--line-mode) + +(defun cj/--term-send-string (string) + "Send STRING to the current terminal buffer's process (the pty)." + (let ((proc (get-buffer-process (current-buffer)))) + (when (process-live-p proc) + (process-send-string proc string)))) + +(defun cj/term-send-escape () + "Send ESC to the terminal. +In tmux copy-mode this cancels it (tmux binds Escape to cancel); in a TUI like +vim it forwards ESC normally. EAT's semi-char mode leaves the bare escape key +unbound and treats `ESC' only as the Meta prefix, so without this the key never +reaches the pty -- which is why C-<up>'s tmux copy-mode could not be exited with +Escape." + (interactive) + (cj/--term-send-string "\e")) + +(defun cj/term-backward-kill-word () + "Delete the previous word in the terminal program's input line. +Sends M-DEL (ESC DEL) to the pty, which readline and most line editors map to +backward-kill-word -- the same word-boundary delete C-<backspace> does in normal +Emacs buffers (it stops at punctuation). EAT's default forwards C-<backspace> as +a bare key the program ignores, so the word never gets deleted; sending the +escape sequence the program actually understands is what makes the key work." + (interactive) + (cj/--term-send-string "\e\d")) + +(defun cj/term--tmux-output (&rest args) + "Run tmux with ARGS and return its stdout. +Signal `user-error' when tmux exits with a non-zero status." + (with-temp-buffer + (let ((exit-code (apply #'process-file "tmux" nil t nil args))) + (unless (zerop exit-code) + (user-error "tmux failed: %s" (string-trim (buffer-string)))) + (buffer-string)))) + +(defun cj/term--tmux-pane-id-for-tty (tty) + "Return the tmux pane id for client TTY." + (let* ((output (cj/term--tmux-output + "list-clients" "-F" "#{client_tty}\t#{pane_id}")) + (lines (split-string output "\n" t)) + (match (seq-find + (lambda (line) + (let ((fields (split-string line "\t"))) + (equal (car fields) tty))) + lines))) + (unless match + (user-error "No tmux client found for terminal tty %s" tty)) + (cadr (split-string match "\t")))) + +(defun cj/term--tmux-capture-pane (pane-id) + "Return full joined tmux history for PANE-ID." + (cj/term--tmux-output + "capture-pane" "-p" "-J" "-S" "-" "-E" "-" "-t" pane-id)) + +(defun cj/term--current-tmux-pane-id () + "Return the tmux pane id for the current EAT terminal buffer." + (unless (derived-mode-p 'eat-mode) + (user-error "Current buffer is not an EAT terminal")) + (let* ((proc (get-buffer-process (current-buffer))) + (tty (and proc (process-tty-name proc)))) + (unless (and tty (not (string-empty-p tty))) + (user-error "Could not determine terminal tty")) + (cj/term--tmux-pane-id-for-tty tty))) + +(defvar-local cj/term-tmux-history--origin-buffer nil + "Buffer active before opening the tmux history buffer.") +(defvar-local cj/term-tmux-history--origin-window nil + "Window active before opening the tmux history buffer.") +(defvar-local cj/term-tmux-history--origin-point nil + "Point in the origin buffer before opening the tmux history buffer.") + +(defun cj/term-tmux-history-quit () + "Quit tmux history and return to its origin buffer." + (interactive) + (let ((history-buffer (current-buffer)) + (origin-buffer cj/term-tmux-history--origin-buffer) + (origin-window cj/term-tmux-history--origin-window) + (origin-point cj/term-tmux-history--origin-point)) + (when (buffer-live-p origin-buffer) + (if (window-live-p origin-window) + (progn + (set-window-buffer origin-window origin-buffer) + (select-window origin-window)) + (pop-to-buffer origin-buffer)) + (with-current-buffer origin-buffer + (when (integer-or-marker-p origin-point) + (goto-char origin-point)))) + (when (buffer-live-p history-buffer) + (kill-buffer history-buffer)))) + +(defvar-keymap cj/term-tmux-history-mode-map + :doc "Keymap for `cj/term-tmux-history-mode'. +M-w copies the active region without leaving the buffer; C-g, <escape>, or q +returns to the terminal without copying. RET is left unbound." + "M-w" #'kill-ring-save + "C-g" #'cj/term-tmux-history-quit + "<escape>" #'cj/term-tmux-history-quit + "q" #'cj/term-tmux-history-quit) + +(define-derived-mode cj/term-tmux-history-mode special-mode "Tmux History" + "Mode for copying captured tmux pane history with normal Emacs keys." + (setq-local truncate-lines t) + (goto-address-mode 1)) + +(defun cj/term-tmux-history () + "Open full tmux pane history in a temporary Emacs buffer. + +The history buffer uses normal Emacs navigation and selection. `M-w' copies +the active region and stays open, so several pieces can be copied in a row; +`q', `<escape>', or `C-g' returns point to the terminal buffer that launched +it. The history view replaces the origin terminal buffer in the same window." + (interactive) + (let* ((origin-buffer (current-buffer)) + (origin-window (selected-window)) + (origin-point (point)) + (pane-id (cj/term--current-tmux-pane-id)) + (history (cj/term--tmux-capture-pane pane-id)) + (buffer (get-buffer-create + (format "*terminal tmux history: %s*" (buffer-name origin-buffer))))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert history)) + (cj/term-tmux-history-mode) + (setq-local cj/term-tmux-history--origin-buffer origin-buffer) + (setq-local cj/term-tmux-history--origin-window origin-window) + (setq-local cj/term-tmux-history--origin-point origin-point) + (goto-char (point-max))) + (switch-to-buffer buffer))) + +(defun cj/term--in-tmux-p () + "Return non-nil when the current EAT buffer has a tmux client attached. +Lookup errors (not eat-mode, no tty, no client, tmux absent) are treated as +nil so callers can use this as a cheap boolean predicate." + (and (derived-mode-p 'eat-mode) + (condition-case _ + (and (cj/term--current-tmux-pane-id) t) + (error nil)))) + +(defun cj/--term-in-emacs-mode-p () + "Return non-nil when the current EAT buffer is in emacs (navigation) mode. +EAT has no dedicated emacs-mode flag; emacs mode is the absence of the +semi-char, char, and line input modes." + (and (derived-mode-p 'eat-mode) + (not (or (bound-and-true-p eat--semi-char-mode) + (bound-and-true-p eat--char-mode) + (bound-and-true-p eat--line-mode))))) + +(defun cj/term-copy-mode-dwim () + "Enter copy-mode using the engine appropriate to this terminal. + +When tmux is attached (an agent terminal), write tmux's prefix sequence (C-b [) +into the pty so the user lands in tmux's copy-mode with the full pane history, +then C-a to land the cursor at column 0 so scrolling up runs up the left edge. +Without tmux, falls through to EAT's emacs mode (a navigable view of the +scrollback) and moves point to the start of the line." + (interactive) + (if (cj/term--in-tmux-p) + (cj/--term-send-string "\C-b[\C-a") + (eat-emacs-mode) + (beginning-of-line))) + +(defun cj/term--tmux-pane-in-copy-mode-p (pane-id) + "Return non-nil when tmux PANE-ID is currently displaying a mode. +tmux's `pane_in_mode' is 1 while a pane is in any mode; copy-mode is the only +mode this config enters. tmux failures are treated as nil." + (condition-case nil + (equal "1" (string-trim + (cj/term--tmux-output + "display-message" "-p" "-t" pane-id "#{pane_in_mode}"))) + (error nil))) + +(defun cj/term-copy-mode-up () + "Enter copy-mode if needed, then scroll up one line. +A single C-<up> lands in the terminal's copy-mode already moving up. Pressed +again while already in copy-mode it just moves up another line, so it never +re-enters and resets the cursor. In tmux, writes the up-arrow escape into the +pty; without tmux, moves point up in EAT's emacs-mode buffer." + (interactive) + (let ((pane (ignore-errors (cj/term--current-tmux-pane-id)))) + (cond + (pane + (unless (cj/term--tmux-pane-in-copy-mode-p pane) + (cj/term-copy-mode-dwim)) + (cj/--term-send-string "\e[A")) + (t + (unless (cj/--term-in-emacs-mode-p) + (cj/term-copy-mode-dwim)) + (forward-line -1))))) + +;; The C-; x terminal prefix (copy-mode, tmux history, the F12 toggle). C-<up> +;; enters copy-mode + scrolls in one stroke; bound in EAT's semi-char map so it +;; reaches Emacs from inside an agent terminal. +(defvar-keymap cj/term-map + :doc "Personal terminal command map.") +(cj/register-prefix-map "x" cj/term-map) +(keymap-set cj/term-map "c" #'cj/term-copy-mode-dwim) +(keymap-set cj/term-map "h" #'cj/term-tmux-history) +(keymap-set cj/term-map "t" #'cj/term-toggle) + +(defvar eat-mode-map) +(declare-function eat-semi-char-mode "eat") +(declare-function eat-self-input "eat") + +(defun cj/eat-text-scale-reset () + "Reset the text scale to its default in the current buffer." + (interactive) + (text-scale-set 0)) + +(with-eval-after-load 'eat + (keymap-set eat-semi-char-mode-map "C-<up>" #'cj/term-copy-mode-up) + ;; Zoom-out and reset reach Emacs, not the pty. EAT binds C-- to + ;; eat-self-input (forwarded to the terminal), so without this the font can + ;; only grow: C-= / C-+ pass through and zoom in, but C-- never reaches + ;; text-scale-decrease. Low cost -- the Claude TUI and tmux don't use Ctrl+-, + ;; and C-0 shadows digit-argument inside eat buffers only. + (keymap-set eat-semi-char-mode-map "C--" #'text-scale-decrease) + (keymap-set eat-semi-char-mode-map "C-0" #'cj/eat-text-scale-reset) + ;; Escape forwards ESC to the pty, so it cancels tmux copy-mode (tmux binds + ;; Escape to cancel) and works in TUIs; in EAT's own emacs/char mode it returns + ;; to semi-char. One key gets out of either copy view. + (keymap-set eat-semi-char-mode-map "<escape>" #'cj/term-send-escape) + (keymap-set eat-mode-map "<escape>" #'eat-semi-char-mode) + ;; Ctrl+Backspace deletes the previous word, matching its behavior in normal + ;; buffers. Terminals send no standard code for it, so EAT's default forwards + ;; a bare key the program drops; send M-DEL instead (readline backward-kill-word). + (keymap-set eat-semi-char-mode-map "C-<backspace>" #'cj/term-backward-kill-word) + ;; Word-motion arrows edit the terminal program's input (claude, readline), so + ;; forward them to the pty. EAT's default leaves them in the non-bound-keys + ;; list, which moved Emacs point instead and desynced it from the real cursor + ;; (point jumped back on the next keystroke). Window arrows (S-, C-M-) keep + ;; reaching Emacs for windmove / buffer-move. + (dolist (key '("C-<left>" "C-<right>" "M-<left>" "M-<right>")) + (keymap-set eat-semi-char-mode-map key #'eat-self-input))) + +(provide 'eat-config) +;;; eat-config.el ends here diff --git a/modules/elfeed-config.el b/modules/elfeed-config.el index 7b4d7d745..dbc7e4a4b 100644 --- a/modules/elfeed-config.el +++ b/modules/elfeed-config.el @@ -1,4 +1,4 @@ -;;; elfeed-config --- Settings and Enhancements to the Elfeed RSS Feed Reader -*- lexical-binding: t; coding: utf-8; -*- +;;; elfeed-config.el --- Settings and Enhancements to the Elfeed RSS Feed Reader -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;; ;;; Commentary: @@ -41,6 +41,13 @@ (declare-function eww-browse-url "eww") (declare-function eww-readable "eww") +;; elfeed paints its search and entry buffers with manual `face' text properties +;; (the date, title, feed, and tag faces the theme styles). Left in +;; `global-font-lock-mode', font-lock overwrites those with syntactic string +;; fontification, so the buffer loses the theme colors. Exclude both modes, the +;; same reason dashboard and mu4e are excluded. +(cj/exclude-from-global-font-lock 'elfeed-search-mode 'elfeed-show-mode) + ;; ------------------------------- Elfeed Config ------------------------------- (use-package elfeed @@ -65,11 +72,26 @@ ;; Pivot with Kara Swisher and Scott Galloway ("https://www.youtube.com/feeds/videos.xml?channel_id=UCBHGZpDF2fsqPIPi0pNyuTg" yt pivot) + ;; Platypus Economics with Justin Wolfers + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCB5eaPWEwR6wR2MxRx64s0g" yt platypus) + + ;; Conversations with Tyler (Tyler Cowen) + ("https://www.youtube.com/feeds/videos.xml?channel_id=UC_AnpBvnhXTcipgGEHLWoOg" yt cwt) + + ;; Plain English with Derek Thompson + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCoOUW7SiXzLbc_O3nSDOBYA" yt plain-english) + + ;; Odd Lots (Bloomberg) -- Joe Weisenthal & Tracy Alloway + ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLe4PRejZgr0MuA6M0zkZyy-99-qc87wKV" yt oddlots) + + ;; All-In Podcast + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCESLZhusAkFfsNsApnjF_Cg" yt allin) + ;; The Prof G Pod ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLtQ-jBytlXCasRuBG86m22rOQfrEPcctq" yt profg) ;; On with Kara Swisher - ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLKof9YSAshgxI6odrEJFKsJbxamwoQBju" yt) + ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLKof9YSAshgxI6odrEJFKsJbxamwoQBju" yt on) ;; Raging Moderates ("https://www.youtube.com/feeds/videos.xml?channel_id=UCcvDWzvxz6Kn1iPQHMl2teA" yt raging-moderates) @@ -81,7 +103,7 @@ ("https://www.youtube.com/feeds/videos.xml?playlist_id=PL45Mc1cDgnsB-u1iLPBYNF1fk-y1cVzTJ" yt trae) ;; Tropical Tidbits - ("https://www.youtube.com/feeds/videos.xml?channel_id=UCrFIk7g_riIm2G2Vi90pxDA" yt) + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCrFIk7g_riIm2G2Vi90pxDA" yt tropical) ;; If You're Listening | ABC News In-depth ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLDTPrMoGHssAfgMMS3L5LpLNFMNp1U_Nq" yt listening) diff --git a/modules/erc-config.el b/modules/erc-config.el index 3e98a66a3..57d4eb567 100644 --- a/modules/erc-config.el +++ b/modules/erc-config.el @@ -1,4 +1,4 @@ -;;; erc-config --- Preferences for Emacs Relay Chat (IRC Client) -*- lexical-binding: t; coding: utf-8; -*- +;;; erc-config.el --- Preferences for Emacs Relay Chat (IRC Client) -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;; ;;; Commentary: @@ -140,6 +140,8 @@ Change this value to use a different nickname.") server-buffers)) +(require 'system-lib) + (defun cj/erc-switch-to-buffer-with-completion () "Switch to an ERC buffer using completion. If no ERC buffers exist, prompt to connect to a server. @@ -148,7 +150,7 @@ Buffer names are shown with server context for clarity." (let* ((erc-buffers (erc-buffer-list)) (buffer-names (mapcar #'buffer-name erc-buffers))) (if buffer-names - (let ((selected (completing-read "Switch to ERC buffer: " buffer-names nil t))) + (let ((selected (completing-read "Switch to ERC buffer: " (cj/completion-table 'buffer buffer-names) nil t))) (switch-to-buffer selected)) (message "No ERC buffers found.") (when (y-or-n-p "Connect to an IRC server? ") diff --git a/modules/eshell-config.el b/modules/eshell-config.el index c2ec6d152..7379795d2 100644 --- a/modules/eshell-config.el +++ b/modules/eshell-config.el @@ -51,6 +51,9 @@ (declare-function eshell-send-input "esh-mode") (declare-function eshell/pwd "em-dirs") (declare-function eshell/alias "em-alias") +(declare-function eshell/cd "em-dirs") +(declare-function eshell-stringify "esh-util") +(declare-function eat-eshell-mode "eat") (defgroup cj/eshell nil "Personal Eshell configuration." @@ -83,6 +86,59 @@ pairs where COMMAND is the `cd' string `eshell/alias' should run." (dolist (pair (cj/--eshell-ssh-alias-commands hosts)) (eshell/alias (car pair) (cdr pair)))) +;; ---------------------------- prompt segments -------------------------------- + +(defun cj/--eshell-git-branch () + "Return the current git branch for `default-directory', or nil. +Reads .git/HEAD directly so it adds no subprocess per prompt, and skips remote +directories so a TRAMP prompt stays fast." + (unless (file-remote-p default-directory) + (when-let* ((root (locate-dominating-file default-directory ".git")) + (head (expand-file-name ".git/HEAD" root))) + (when (file-readable-p head) + (with-temp-buffer + (insert-file-contents head) + (when (looking-at "ref: refs/heads/\\(.*\\)") + (string-trim (match-string 1)))))))) + +(defun cj/--eshell-prompt-status-segment () + "Return the eshell prompt's exit-status segment, or an empty string. +Shows the last command's exit code in brackets when it was non-zero, mirroring +the zsh prompt's failure indicator." + (let ((status (bound-and-true-p eshell-last-command-status))) + (if (or (null status) (zerop status)) + "" + (format " [%d]" status)))) + +;; ------------------------------- zoxide -------------------------------------- +;; Share the same frecency database as the zsh shell by calling the zoxide +;; binary: `z' jumps to a remembered directory, and every eshell directory +;; change feeds `zoxide add' so eshell visits accrue in the same database. + +(defun eshell/z (&rest args) + "Jump to a directory via zoxide, sharing the zsh zoxide database. +With no ARGS, cd home. Otherwise query zoxide for the best match and cd there." + (if (null args) + (eshell/cd) + (let ((dir (string-trim + (shell-command-to-string + (concat "zoxide query -- " + (mapconcat #'shell-quote-argument + (mapcar #'eshell-stringify args) " ")))))) + (if (and (not (string-empty-p dir)) (file-directory-p dir)) + (eshell/cd dir) + (error "zoxide: no match for %s" + (string-join (mapcar #'eshell-stringify args) " ")))))) + +(defun cj/--eshell-zoxide-add () + "Record `default-directory' in the zoxide database (skips remote dirs)." + (when (and (not (file-remote-p default-directory)) + (executable-find "zoxide")) + (call-process "zoxide" nil 0 nil "add" "--" + (expand-file-name default-directory)))) + +(add-hook 'eshell-directory-change-hook #'cj/--eshell-zoxide-add) + (use-package eshell :ensure nil ;; built-in :commands (eshell) @@ -108,6 +164,9 @@ pairs where COMMAND is the `cd' string `eshell/alias' should run." (propertize (system-name) 'face 'default) ":" (propertize (abbreviate-file-name (eshell/pwd)) 'face 'default) + (let ((branch (cj/--eshell-git-branch))) + (if branch (propertize (concat " (" branch ")") 'face 'default) "")) + (propertize (cj/--eshell-prompt-status-segment) 'face 'default) "\n" (propertize "%" 'face 'default) " "))) @@ -179,35 +238,20 @@ pairs where COMMAND is the `cd' string `eshell/alias' should run." (delete-window))) (advice-add 'eshell-life-is-too-much :after 'cj/eshell-delete-window-on-exit) -(use-package eshell-toggle - :custom - (eshell-toggle-size-fraction 2) - (eshell-toggle-run-command nil) - (eshell-toggle-init-function #'eshell-toggle-init-eshell) - :bind - ("C-<f12>" . eshell-toggle)) +;; Run eshell's external commands through EAT (a real terminal): visual commands +;; (vim, htop, less) render properly and ANSI output is faithful, while eshell +;; stays the shell -- elisp functions as commands + TRAMP transparency. EAT +;; handles color itself, so it supersedes xterm-color for eshell; the +;; xterm-color block below stays for now and steps aside if colors double up. +(with-eval-after-load 'esh-mode + (require 'eat) + (eat-eshell-mode 1)) -(use-package xterm-color - :after eshell - ;; Two hooks. eshell-before-prompt is the real hook name; use-package appends - ;; "-hook", so writing eshell-before-prompt-hook here registered on a - ;; nonexistent eshell-before-prompt-hook-hook and never ran. The eshell-mode - ;; hook scopes TERM=xterm-256color to eshell-spawned processes only (a global - ;; setenv would leak it to every start-process regardless of terminal). - :hook - ((eshell-before-prompt . (lambda () - (setq xterm-color-preserve-properties t))) - (eshell-mode . (lambda () - (setq-local process-environment - (cons "TERM=xterm-256color" - process-environment))))) - :config - ;; Wire xterm-color into eshell's output pipeline (per its README): install - ;; the filter and drop eshell's own ANSI handler. Without this the escapes are - ;; never interpreted and TERM=xterm-256color only leaks raw codes. - (add-to-list 'eshell-preoutput-filter-functions 'xterm-color-filter) - (setq eshell-output-filter-functions - (remove 'eshell-handle-ansi-color eshell-output-filter-functions))) +;; eshell-toggle and xterm-color are retired. F12 opens eshell now (the +;; dock-and-remember toggle in eat-config.el), and eat-eshell-mode renders +;; eshell's output through EAT, which handles ANSI color natively -- so +;; xterm-color's filter and its TERM=xterm-256color override are redundant and +;; would fight EAT's own TERM=eat-truecolor. (use-package eshell-syntax-highlighting :after esh-mode diff --git a/modules/eww-config.el b/modules/eww-config.el index ff7ddc211..0ddebfe4f 100644 --- a/modules/eww-config.el +++ b/modules/eww-config.el @@ -1,4 +1,4 @@ -;;; eww-config --- EWW Text Browser Settings -*- lexical-binding: t; coding: utf-8; -*- +;;; eww-config.el --- EWW Text Browser Settings -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;; ;;; Commentary: @@ -73,6 +73,12 @@ ;; --------------------------------- EWW Config -------------------------------- +(require 'system-lib) +;; eww renders pages with shr, which paints with manual `face' properties. Left +;; in `global-font-lock-mode' font-lock overwrites them and the page loses its +;; colors, the same issue as elfeed-show and mu4e-view. Exclude eww-mode. +(cj/exclude-from-global-font-lock 'eww-mode) + (use-package eww :ensure nil ;; built-in :bind diff --git a/modules/external-open.el b/modules/external-open.el index 22e56a290..811c32c28 100644 --- a/modules/external-open.el +++ b/modules/external-open.el @@ -42,15 +42,33 @@ "Open certain files with the OS default handler." :group 'files) -(defcustom default-open-extensions - '( - ;; Video - "\\.3g2\\'" "\\.3gp\\'" "\\.asf\\'" "\\.avi\\'" "\\.divx\\'" "\\.dv\\'" +(defcustom cj/video-extensions + '("\\.3g2\\'" "\\.3gp\\'" "\\.asf\\'" "\\.avi\\'" "\\.divx\\'" "\\.dv\\'" "\\.f4v\\'" "\\.flv\\'" "\\.m1v\\'" "\\.m2ts\\'" "\\.m2v\\'" "\\.m4v\\'" "\\.mkv\\'" "\\.mov\\'" "\\.mpe\\'" "\\.mpeg\\'" "\\.mpg\\'" "\\.mp4\\'" "\\.mts\\'" "\\.ogv\\'" "\\.rm\\'" "\\.rmvb\\'" "\\.vob\\'" - "\\.webm\\'" "\\.wmv\\'" + "\\.webm\\'" "\\.wmv\\'") + "Regexps matching video files opened in a looping player. +These route through `cj/open-video-looping' (mpv --loop-file=inf by default) +instead of the OS default handler, so a video opened from dirvish plays on +repeat." + :type '(repeat (regexp :tag "Video extension regexp")) + :group 'external-open) + +(defcustom cj/video-open-command "mpv" + "Player command used to open local video files on repeat. +Launched detached from Emacs with `cj/video-open-args' before the file name." + :type 'string + :group 'external-open) + +(defcustom cj/video-open-args '("--loop-file=inf") + "Arguments passed to `cj/video-open-command' before the file name. +Defaults to mpv's infinite single-file loop so the video plays on repeat." + :type '(repeat string) + :group 'external-open) +(defcustom default-open-extensions + '( ;; Audio "\\.aac\\'" "\\.ac3\\'" "\\.aif\\'" "\\.aifc\\'" "\\.aiff\\'" "\\.alac\\'" "\\.amr\\'" "\\.ape\\'" "\\.caf\\'" @@ -142,18 +160,49 @@ Logs output and exit code to buffer *external-open.log*." nil 0))))) +;; -------------------------- Open Videos On Repeat ---------------------------- + +(defun cj/--video-file-p (file) + "Return non-nil when FILE matches a regexp in `cj/video-extensions'." + (and (stringp file) + (let ((case-fold-search t)) + (cl-some (lambda (re) (string-match-p re file)) cj/video-extensions)))) + +(defun cj/--video-open-arglist (file) + "Return the argument list to play FILE on repeat: `cj/video-open-args' + FILE." + (append cj/video-open-args (list file))) + +(defun cj/open-video-looping (&optional filename) + "Open FILENAME (or the file at point) in a looping video player, detached. +Uses `cj/video-open-command' and `cj/video-open-args' (mpv --loop-file=inf by +default) so the video plays on repeat. Launched asynchronously so it never +blocks Emacs." + (interactive) + (let* ((file (expand-file-name + (or (cj/file-from-context filename) + (user-error "No file associated with this buffer")))) + (args (cj/--video-open-arglist file))) + (if (env-windows-p) + (w32-shell-execute "open" cj/video-open-command + (mapconcat (lambda (a) (format "\"%s\"" a)) args " ")) + (apply #'call-process cj/video-open-command nil 0 nil args)))) + ;; -------------------- Open Files With Default File Handler ------------------- (defun cj/find-file-auto (orig-fun &rest args) - "If file has an extension in `default-open-extensions', open externally. -Else call ORIG-FUN with ARGS." + "Open FILE externally based on its extension, else call ORIG-FUN with ARGS. +A video (`cj/video-extensions') opens in a looping player; any other extension +in `default-open-extensions' opens with the OS default handler." (let* ((file (car args)) (case-fold-search t)) - (if (and (stringp file) - (cl-some (lambda (re) (string-match-p re file)) - default-open-extensions)) - (cj/xdg-open file) - (apply orig-fun args)))) + (cond + ((cj/--video-file-p file) + (cj/open-video-looping file)) + ((and (stringp file) + (cl-some (lambda (re) (string-match-p re file)) + default-open-extensions)) + (cj/xdg-open file)) + (t (apply orig-fun args))))) (defun cj/external-open-install-advice () "Install the `cj/find-file-auto' advice on `find-file'. diff --git a/modules/face-diagnostic.el b/modules/face-diagnostic.el index a2bfe2483..6f0722099 100644 --- a/modules/face-diagnostic.el +++ b/modules/face-diagnostic.el @@ -36,7 +36,7 @@ Return one of `theme-faced', `terminal-ansi', `document-shr', or best-effort dump rather than a full provenance trace." (with-current-buffer (or buffer (current-buffer)) (cond - ((derived-mode-p 'term-mode 'comint-mode 'eshell-mode 'ghostel-mode) + ((derived-mode-p 'term-mode 'comint-mode 'eshell-mode 'eat-mode) 'terminal-ansi) ((derived-mode-p 'eww-mode 'nov-mode 'elfeed-show-mode 'mu4e-view-mode) 'document-shr) diff --git a/modules/flycheck-config.el b/modules/flycheck-config.el index 1afd3ae6c..2a5a5e74f 100644 --- a/modules/flycheck-config.el +++ b/modules/flycheck-config.el @@ -1,4 +1,4 @@ -;;; flycheck-config --- Syntax/Grammar Check -*- lexical-binding: t; coding: utf-8; -*- +;;; flycheck-config.el --- Syntax/Grammar Check -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -6,40 +6,17 @@ ;; Layer: 2 (Core UX). ;; Category: C/P. ;; Load shape: eager. -;; Eager reason: general linting setup; spec target is hook-loaded, a deferral -;; candidate. -;; Top-level side effects: package configuration via use-package, binds into -;; cj/custom-keymap through use-package :map. +;; Eager reason: linting keymap and mode hooks; could become hook-loaded. +;; Top-level side effects: package config and C-; ? binding. ;; Runtime requires: keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Direct test load: yes. ;; -;; This file configures Flycheck for on-demand syntax and grammar checking. -;; - Flycheck starts automatically only in sh-mode and emacs-lisp-mode - -;; - This binds a custom helper (=cj/flycheck-list-errors=) to "C-; ?" -;; for popping up Flycheck's error list in another window. - -;; - It also customizes Checkdoc to suppress only the "sentence-end-double-space" -;; and "warn-escape" warnings. - -;; - It registers LanguageTool for comprehensive grammar checking of prose files -;; (text-mode, markdown-mode, gfm-mode, org-mode). - -;; Note: Grammar checking is on-demand only to avoid performance issues. -;; Hitting "C-; ?" runs cj/flycheck-prose-on-demand if in an org buffer. - -;; The cj/flycheck-prose-on-demand function: -;; - Turns on flycheck for the local buffer -;; - Enables LanguageTool checker -;; - Triggers an immediate check -;; - Displays errors in the *Flycheck errors* buffer - -;; Installation: -;; On Arch Linux: -;; sudo pacman -S languagetool +;; Flycheck configuration for automatic shell/Elisp linting and on-demand prose +;; grammar checks. C-; ? opens the Flycheck error list, enabling prose checking +;; first when appropriate. ;; -;; The wrapper script at scripts/languagetool-flycheck formats LanguageTool's -;; JSON output into flycheck-compatible format. It requires Python 3. +;; LanguageTool uses scripts/languagetool-flycheck to adapt JSON output to +;; Flycheck's checker protocol. ;;; Code: diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index 376a9dc51..b73bfdf32 100644 --- a/modules/flyspell-and-abbrev.el +++ b/modules/flyspell-and-abbrev.el @@ -6,48 +6,18 @@ ;; Layer: 2 (Core UX). ;; Category: C/P. ;; Load shape: eager. -;; Eager reason: text-mode spelling and abbrev hooks; spec target is hook-loaded. -;; Top-level side effects: package configuration via use-package (mode hooks). +;; Eager reason: text-mode spelling and abbrev hooks. +;; Top-level side effects: package configuration via use-package. ;; Runtime requires: cl-lib. ;; Direct test load: yes. ;; -;; WORKFLOW: -;; This module provides intelligent spell checking with automatic abbreviation -;; creation to prevent repeated misspellings. +;; On-demand Flyspell workflow with automatic abbrev creation from accepted +;; corrections. C-' checks/corrects nearby misspellings; C-c f toggles Flyspell +;; with mode-aware behavior. ;; -;; KEYBINDINGS: -;; C-' - Main spell check interface (cj/flyspell-then-abbrev) -;; C-c f - Toggle flyspell on/off (cj/flyspell-toggle) -;; M-o - Access 'other options' during correction (save to dictionary, etc.) -;; -;; SPELL CHECKING WORKFLOW: -;; 1. Press C-' to start spell checking -;; 2. Finds the nearest misspelled word above the cursor -;; 3. Prompts for correction or allows saving to personal dictionary -;; 4. Press C-' again to move to the next misspelling -;; 5. Each correction automatically creates an abbrev for future auto-expansion -;; -;; FLYSPELL ACTIVATION: -;; Flyspell is NOT automatically enabled. You activate it manually: -;; - C-c f - Toggle flyspell on (uses smart mode detection) or off -;; - C-' - Runs flyspell-buffer then starts correction workflow -;; -;; When enabled, flyspell adapts to the buffer type: -;; - Programming modes (prog-mode): Only checks comments and strings -;; - Text modes (text-mode): Checks all text -;; - Other modes: Must enable manually with C-c f -;; -;; ABBREVIATION AUTO-EXPANSION: -;; Each spell correction creates an abbrev that auto-expands the misspelling -;; to the correct spelling when you type it in the future. This significantly -;; increases typing speed over time. -;; -;; Original idea from Artur Malabarba: -;; http://endlessparentheses.com/ispell-and-abbrev-the-perfect-auto-correct.html -;; -;; NOTES: -;; The default flyspell keybinding "C-;" is unbound in this config as it's -;; used for the custom keymap (cj/custom-keymap). +;; Flyspell is not enabled globally. Programming buffers check comments/strings +;; when enabled; prose buffers check all text. The default C-; Flyspell binding +;; is intentionally left free for cj/custom-keymap. ;;; Code: diff --git a/modules/font-config.el b/modules/font-config.el index 3272a946e..3aa3d80f6 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -1,4 +1,4 @@ -;;; font-config --- Font Defaults and Related Functionality -*- lexical-binding: t; coding: utf-8; -*- +;;; font-config.el --- Font Defaults and Related Functionality -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -6,51 +6,18 @@ ;; Layer: 2 (Core UX). ;; Category: C/P/S. ;; Load shape: eager. -;; Eager reason: font setup for the first frame, plus font keybindings. -;; Top-level side effects: binds five global font keys, runs font-installation -;; checks, configures packages via use-package. +;; Eager reason: first-frame font setup and font keybindings. +;; Top-level side effects: font keys, font checks, package config. ;; Runtime requires: host-environment, keybindings. ;; Direct test load: yes. ;; -;; This module provides font configuration, including: -;; -;; 1. Font Management: -;; - Dynamic font preset switching via `fontaine' package -;; - Separate configurations for fixed-pitch and variable-pitch fonts -;; - Multiple size presets for different viewing contexts -;; - Per-frame font configuration tracking for daemon mode compatibility -;; -;; 2. Icon Support: -;; - All-the-icons integration with automatic font installation -;; - Nerd fonts support for enhanced icons in terminals and GUI -;; - Platform-specific emoji font configuration (Noto, Apple, Segoe) -;; - Emojify package for emoji rendering and insertion -;; -;; 3. Typography Enhancements: -;; - Programming ligatures via `ligature' package -;; - Mode-specific ligature rules for markdown and programming -;; - Text scaling keybindings for quick size adjustments -;; -;; 4. Utility Functions: -;; - `cj/font-installed-p': Check font availability -;; - `cj/display-available-fonts': Interactive font browser with samples -;; - Frame-aware font application for client/server setups -;; -;; Configuration Notes: -;; - Default preset: BerkeleyMono Nerd Font; height 120 on laptops, 140 on desktops -;; - Variable pitch: Lexend in the default preset; Merriweather for fallback presets -;; - Handles both standalone and daemon mode Emacs instances -;; - Emoji fonts selected based on OS availability -;; -;; Keybindings: -;; - M-S-f: Select font preset (fontaine-set-preset) -;; - C-z F: Display available fonts -;; - C-+/C-=: Increase text scale -;; - C--/C-_: Decrease text scale -;; - C-c E i: Insert emoji -;; - C-c E l: List emojis -;; +;; 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. ;; +;; Also carries font-rendering safeguards for known HarfBuzz/font-cache crashes +;; triggered by emoji and Arabic shaping in this setup. + ;;; Code: (require 'host-environment) @@ -96,7 +63,7 @@ (default :default-family "BerkeleyMono Nerd Font" :default-weight regular - :default-height ,(if (env-laptop-p) 120 140) + :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 @@ -116,11 +83,6 @@ (FiraCode-Literata :default-family "Fira Code Nerd Font" :variable-pitch-family "Literata") - (EBook - :default-family "Lexend" - :default-weight regular - :default-height 200 - :variable-pitch-family "Lexend") (24-point-font :default-height 240) (20-point-font @@ -198,35 +160,29 @@ If FRAME is nil, uses the selected frame." t nil)) -;; ------------------------------- All The Icons ------------------------------- -;; icons made available through fonts +;; ------------------------------- Nerd Icons fonts ---------------------------- +;; nerd-icons (configured in nerd-icons-config.el) renders glyphs from the +;; "Symbols Nerd Font Mono" font. Auto-install it on the first GUI frame when +;; it is missing -- the same convenience the dropped all-the-icons setup gave. -(declare-function all-the-icons-install-fonts "all-the-icons") +(declare-function nerd-icons-install-fonts "nerd-icons") -(defun cj/maybe-install-all-the-icons-fonts (&optional _frame) - "Install all-the-icons fonts if needed and we have a GUI." +(defun cj/maybe-install-nerd-icons-fonts (&optional _frame) + "Install the nerd-icons font if it is missing and we have a GUI." (when (and (env-gui-p) - (not (cj/font-installed-p "all-the-icons"))) - (all-the-icons-install-fonts t) + (not (cj/font-installed-p "Symbols Nerd Font Mono"))) + (nerd-icons-install-fonts t) ;; Remove this hook after successful installation - (remove-hook 'server-after-make-frame-hook #'cj/maybe-install-all-the-icons-fonts))) + (remove-hook 'server-after-make-frame-hook #'cj/maybe-install-nerd-icons-fonts))) -(use-package all-the-icons - :demand t - :config - ;; Handle both daemon and non-daemon modes +;; nerd-icons loads after this module (see init.el order), so defer the wiring +;; until it is present. Daemon: install on the first GUI frame; otherwise now. +(with-eval-after-load 'nerd-icons (if (daemonp) - (add-hook 'server-after-make-frame-hook #'cj/maybe-install-all-the-icons-fonts) - (cj/maybe-install-all-the-icons-fonts))) - -(use-package all-the-icons-nerd-fonts - :after all-the-icons - :demand t - :config - (all-the-icons-nerd-fonts-prefer)) + (add-hook 'server-after-make-frame-hook #'cj/maybe-install-nerd-icons-fonts) + (cj/maybe-install-nerd-icons-fonts))) ;; ----------------------------- Emoji Fonts Per OS ---------------------------- -;; Set emoji fonts in priority order (first found wins) (defun cj/setup-emoji-fontset (&optional _frame) "Set emoji fonts in priority order (first found wins). diff --git a/modules/help-config.el b/modules/help-config.el index f8431aef2..114b264ed 100644 --- a/modules/help-config.el +++ b/modules/help-config.el @@ -1,4 +1,4 @@ -;;; help-config --- Help Functionality Configuration -*- lexical-binding: t; coding: utf-8; -*- +;;; help-config.el --- Help Functionality Configuration -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -9,7 +9,7 @@ ;; Eager reason: help/info/man configuration and its keybindings; eager only by ;; init order, a deferral candidate. ;; Top-level side effects: two global keys, package configuration via use-package. -;; Runtime requires: none. +;; Runtime requires: system-lib. ;; Direct test load: yes. ;; ;; This module enhances Emacs' built-in help system and documentation features. @@ -25,6 +25,7 @@ ;;; Code: +(require 'system-lib) ;; completion table + file annotator (setq help-window-select t) ;; Always select the help buffer in a separate window @@ -90,7 +91,11 @@ Preserves any unsaved changes and checks if the file exists." info-files)) (chosen-name (completing-read "Select Info file: " - (mapcar #'car files-alist) + (cj/completion-table-annotated + 'cj-info-file + (cj/completion-file-annotator + (lambda (c) (cdr (assoc c files-alist)))) + (mapcar #'car files-alist)) nil t)) (chosen-file (cdr (assoc chosen-name files-alist)))) (when chosen-file diff --git a/modules/help-utils.el b/modules/help-utils.el index 3e31efffe..9792841a3 100644 --- a/modules/help-utils.el +++ b/modules/help-utils.el @@ -1,4 +1,4 @@ -;;; help-utils --- Help Integrations and Searches -*- lexical-binding: t; coding: utf-8; -*- +;;; help-utils.el --- Help Integrations and Searches -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;; ;;; Commentary: diff --git a/modules/httpd-config.el b/modules/httpd-config.el index 60baf7e82..1a2a5c611 100644 --- a/modules/httpd-config.el +++ b/modules/httpd-config.el @@ -1,4 +1,4 @@ -;;; httpd-config --- Setup for a Simple HTTP Server -*- lexical-binding: t; coding: utf-8; -*- +;;; httpd-config.el --- Setup for a Simple HTTP Server -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/hugo-config.el b/modules/hugo-config.el index 7afa45a7b..b26398c69 100644 --- a/modules/hugo-config.el +++ b/modules/hugo-config.el @@ -9,7 +9,7 @@ ;; Eager reason: none; blog publishing is a command-loaded deferral candidate ;; for Phase 4. ;; Top-level side effects: package configuration via use-package. -;; Runtime requires: user-constants, host-environment. +;; Runtime requires: user-constants, host-environment, system-lib. ;; Direct test load: yes. ;; ;; Integrates ox-hugo for publishing Org files to a Hugo website. @@ -27,6 +27,7 @@ (require 'user-constants) (require 'host-environment) +(require 'system-lib) ;; completion table + file annotator ;; --------------------------------- Constants --------------------------------- @@ -166,7 +167,12 @@ Switches #+hugo_draft between true and false." (if (null drafts) (message "No drafts found in %s" cj/hugo-content-org-dir) (let ((choice (completing-read "Open draft: " - (mapcar #'car drafts) nil t))) + (cj/completion-table-annotated + 'cj-hugo-draft + (cj/completion-file-annotator + (lambda (c) (cdr (assoc c drafts)))) + (mapcar #'car drafts)) + nil t))) (find-file (cdr (assoc choice drafts))))))) ;; ---------------------------- Preview and Publish ---------------------------- diff --git a/modules/jumper.el b/modules/jumper.el index 3dc00aa18..1fbd1293b 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -11,72 +11,17 @@ ;; Layer: 4 (Optional). ;; Category: O/L. ;; Load shape: eager. -;; Eager reason: none; navigation helper, a command-loaded deferral candidate. -;; Top-level side effects: defines a jumper keymap. +;; Eager reason: none; jump commands can autoload. +;; Top-level side effects: defines jumper keymap. ;; Runtime requires: cl-lib. ;; Direct test load: yes. ;; -;; Jumper provides a simple way to store and jump between locations -;; in your codebase without needing to remember register assignments. +;; Small register-backed jump list. Locations are stored in numbered registers, +;; shown through completion with file/line context, and removed explicitly when +;; no longer useful. ;; -;; PURPOSE: -;; -;; When working on large codebases, you often need to jump between -;; multiple related locations: a function definition, its tests, its -;; callers, configuration files, etc. Emacs registers are perfect for -;; this, but require you to remember which register you assigned to -;; which location. Jumper automates register management, letting you -;; focus on your work instead of bookkeeping. -;; -;; WORKFLOW: -;; -;; 1. Navigate to an important location in your code -;; 2. Press M-SPC SPC to store it (automatically assigned to register 0) -;; 3. Continue working, storing more locations as needed (registers 1-9) -;; 4. Press M-SPC j to jump back to any stored location -;; 5. Select from the list using completion (shows file, line, context) -;; 6. Press M-SPC d to remove locations you no longer need -;; -;; RECOMMENDED USAGE: -;; -;; Store locations temporarily while working on a feature: -;; - Store the main function you're implementing -;; - Store the test file where you're writing tests -;; - Store the caller that needs updating -;; - Store the documentation that needs changes -;; - Jump between them freely as you work -;; - Clear them when done with the feature -;; -;; SPECIAL BEHAVIORS: -;; -;; - Duplicate prevention: Storing the same location twice shows a message -;; instead of wasting a register slot. -;; -;; - Single location toggle: When only one location is stored, M-SPC j -;; toggles between that location and your current position. Perfect for -;; rapid back-and-forth between two related files. -;; -;; - Last location tracking: The last position before each jump is saved -;; in register 'z', allowing quick "undo" of navigation. -;; -;; - Smart selection: With multiple locations, completing-read shows -;; helpful context: "[0] filename.el:42 - function definition..." -;; -;; KEYBINDINGS: -;; -;; M-SPC SPC Store current location in next available register -;; M-SPC j Jump to a stored location (with completion) -;; M-SPC d Delete a stored location from the list -;; -;; CONFIGURATION: -;; -;; You can customize the prefix key and maximum locations: -;; -;; (setq jumper-prefix-key "C-c j") ; Change prefix key -;; (setq jumper-max-locations 20) ; Store up to 20 locations -;; -;; Note: Changing jumper-max-locations requires restarting Emacs or -;; manually reinitializing jumper--registers. +;; A single stored location toggles with the current point; each jump records the +;; previous point in register z for a quick return path. ;;; Code: @@ -124,12 +69,10 @@ marker." (defun jumper--location-exists-p () "Check if current location is already stored." - (let ((key (jumper--location-key)) - (found nil)) - (dotimes (i jumper--next-index found) - (when (jumper--with-marker-at - i (lambda () (string= key (jumper--location-key)))) - (setq found t))))) + (let ((key (jumper--location-key))) + (cl-loop for i from 0 below jumper--next-index + thereis (jumper--with-marker-at + i (lambda () (string= key (jumper--location-key))))))) (defun jumper--register-available-p () "Check if there are registers available." diff --git a/modules/keybindings.el b/modules/keybindings.el index b61c3f2b3..7072cb9c2 100644 --- a/modules/keybindings.el +++ b/modules/keybindings.el @@ -1,4 +1,4 @@ -;;; keybindings --- General Keyboard Shortcuts -*- lexical-binding: t; coding: utf-8; -*- +;;; keybindings.el --- General Keyboard Shortcuts -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;; ;;; Commentary: diff --git a/modules/keyboard-compat.el b/modules/keyboard-compat.el index 914a343a6..9395b9c86 100644 --- a/modules/keyboard-compat.el +++ b/modules/keyboard-compat.el @@ -6,90 +6,18 @@ ;; Layer: 1 (Foundation). ;; Category: F/S. ;; Load shape: eager. -;; Eager reason: normalizes terminal/GUI key input so the first session's -;; keybindings resolve consistently. -;; Top-level side effects: adds `cj/keyboard-compat-terminal-setup' to -;; `emacs-startup-hook'. +;; Eager reason: normalizes terminal/GUI key input before custom bindings matter. +;; Top-level side effects: adds cj/keyboard-compat-terminal-setup to startup. ;; Runtime requires: host-environment. -;; Direct test load: yes (registers a startup hook; batch-safe). +;; Direct test load: yes. ;; -;; This module fixes keyboard input differences between terminal and GUI Emacs. +;; Normalizes Meta+Shift bindings across GUI and terminal frames. GUI frames +;; translate M-uppercase events to explicit M-S-lowercase keys; terminal frames +;; decode arrow escape sequences before key lookup so ESC O prefixes do not trip +;; M-S bindings. ;; -;; THE PROBLEM: Meta+Shift keybindings behave differently in terminal vs GUI -;; ========================================================================= -;; -;; In Emacs, there are two ways to express "Meta + Shift + o": -;; -;; 1. M-O (Meta + uppercase O) - key code 134217807 -;; 2. M-S-o (Meta + explicit Shift modifier + lowercase o) - key code 167772271 -;; -;; These are NOT the same key in Emacs! -;; -;; GUI Emacs behavior: -;; When you press Meta+Shift+o on your keyboard, GUI Emacs receives M-O -;; (uppercase O). It does NOT receive M-S-o. This is because the keyboard -;; sends Shift+o as uppercase 'O', not as a Shift modifier plus lowercase 'o'. -;; -;; Terminal Emacs behavior: -;; Terminals send escape sequences for special keys. Arrow keys send: -;; - Up: ESC O A -;; - Down: ESC O B -;; - Right: ESC O C -;; - Left: ESC O D -;; -;; The problem: ESC O is interpreted as M-O by Emacs! So if you bind M-O -;; to a function, pressing the up arrow sends "ESC O A", Emacs sees "M-O" -;; and triggers your function instead of moving up. Arrow keys break. -;; -;; THE SOLUTION: Different handling for each display type -;; ====================================================== -;; -;; For terminal mode (handled by cj/keyboard-compat-terminal-setup): -;; - Use input-decode-map to translate arrow escape sequences BEFORE -;; any keybinding lookup. ESC O A becomes [up], not M-O followed by A. -;; - Keybindings use M-S-o syntax (some terminals support explicit Shift) -;; - Disable graphical icons that show as unicode artifacts -;; -;; For GUI mode (handled by cj/keyboard-compat-gui-setup): -;; - Use key-translation-map to translate M-O to M-S-o BEFORE lookup -;; - This way, pressing Meta+Shift+o (which sends M-O) gets translated -;; to M-S-o, matching the keybinding definitions -;; - All 18 Meta+Shift keybindings work correctly -;; -;; WHY NOT JUST USE M-O FOR KEYBINDINGS? -;; ===================================== -;; -;; We could bind to M-O directly, but: -;; 1. Terminal arrow keys would break (ESC O prefix conflict) -;; 2. We'd need to maintain two sets of bindings (M-O for GUI, something -;; else for terminal) -;; -;; By using M-S-o syntax everywhere and translating M-O -> M-S-o in GUI mode, -;; we have one consistent set of keybindings that work everywhere. -;; -;; KEYBINDINGS AFFECTED: -;; ==================== -;; -;; The following M-S- keybindings are translated from M-uppercase in GUI: -;; -;; M-O -> M-S-o cj/kill-other-window (undead-buffers.el) -;; M-M -> M-S-m cj/kill-all-other-buffers-and-windows (undead-buffers.el) -;; M-Y -> M-S-y yank-media (keybindings.el) -;; M-F -> M-S-f fontaine-set-preset (font-config.el) -;; M-W -> M-S-w wttrin (weather-config.el) -;; M-E -> M-S-e eww (eww-config.el) -;; M-L -> M-S-l cj/switch-themes (ui-theme.el) -;; M-R -> M-S-r cj/elfeed-open (elfeed-config.el) -;; M-V -> M-S-v cj/split-and-follow-right (ui-navigation.el) -;; M-H -> M-S-h cj/split-and-follow-below (ui-navigation.el) -;; M-T -> M-S-t toggle-window-split (ui-navigation.el) -;; M-Z -> M-S-z cj/undo-kill-buffer (ui-navigation.el) -;; M-U -> M-S-u winner-undo (ui-navigation.el) -;; M-D -> M-S-d dwim-shell-commands-menu (dwim-shell-config.el) -;; M-I -> M-S-i edit-indirect-region (text-config.el) -;; M-C -> M-S-c time-zones (chrono-tools.el) -;; M-B -> M-S-b calibredb (calibredb-epub-config.el) -;; M-K -> M-S-k show-kill-ring (show-kill-ring.el) +;; Also provides terminal-specific display fallbacks, such as hiding icon glyphs +;; that render poorly outside GUI frames. ;;; Code: @@ -140,12 +68,6 @@ This runs after init to override any package settings." nerd-icons-icon-for-buffer)) (advice-add fn :around #'cj/--icon-blank-in-terminal))) -(with-eval-after-load 'all-the-icons - (dolist (fn '(all-the-icons-icon-for-file - all-the-icons-icon-for-dir - all-the-icons-icon-for-mode)) - (advice-add fn :around #'cj/--icon-blank-in-terminal))) - ;; ============================================================================= ;; GUI-specific fixes ;; ============================================================================= diff --git a/modules/latex-config.el b/modules/latex-config.el index f2a586704..2cc19171e 100644 --- a/modules/latex-config.el +++ b/modules/latex-config.el @@ -1,4 +1,4 @@ -;;; latex-config --- Setup for LaTeX and Related Software -*- lexical-binding: t; coding: utf-8; -*- +;;; latex-config.el --- Setup for LaTeX and Related Software -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/local-repository.el b/modules/local-repository.el index 6376d9f73..e3c7a227a 100644 --- a/modules/local-repository.el +++ b/modules/local-repository.el @@ -1,4 +1,4 @@ -;;; local-repository.el --- local repository functionality -*- lexical-binding: t; coding: utf-8; -*- +;;; local-repository.el --- Local package archive helpers -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -6,20 +6,25 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P. ;; Load shape: eager. -;; Eager reason: none; local package-mirror workflow, a command-loaded deferral -;; candidate. +;; Eager reason: none; local package mirror commands can autoload. ;; Top-level side effects: none. -;; Runtime requires: elpa-mirror. +;; Runtime requires: elpa-mirror when updating the mirror. ;; Direct test load: yes. ;; +;; Adds the checked-in local package archive to package-archives with high +;; priority, and provides a command to refresh that archive from installed +;; packages via elpa-mirror. + ;;; Code: (require 'elpa-mirror nil t) ;; optional; cj/update-localrepo-repository fails at call-time if absent +(declare-function elpamr-create-mirror-for-installed "elpa-mirror") + ;; ------------------------------ Utility Function ----------------------------- -(defun car-member (value list) +(defun localrepo--car-member (value list) "Check if VALUE exists as the car of any cons cell in LIST." (member value (mapcar #'car list))) @@ -60,11 +65,11 @@ keep them in source control." (defun localrepo-initialize () "Add the repository to the package archives, then gives it a high priority." - (unless (car-member localrepo-repository-id package-archives) + (unless (localrepo--car-member localrepo-repository-id package-archives) (add-to-list 'package-archives (cons localrepo-repository-id localrepo-repository-location))) - (unless (car-member localrepo-repository-id package-archive-priorities) + (unless (localrepo--car-member localrepo-repository-id package-archive-priorities) (add-to-list 'package-archive-priorities (cons localrepo-repository-id localrepo-repository-priority)))) diff --git a/modules/mail-config.el b/modules/mail-config.el index 1d8a98c97..84d5f029a 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -1,4 +1,4 @@ -;;; mail-config --- Settings for Mu4e Email -*- lexical-binding: t; coding: utf-8; -*- +;;; mail-config.el --- Settings for Mu4e Email -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;; ;;; Commentary: diff --git a/modules/markdown-config.el b/modules/markdown-config.el index 424c09cc8..4b6c9947d 100644 --- a/modules/markdown-config.el +++ b/modules/markdown-config.el @@ -1,4 +1,4 @@ -;;; markdown-config --- Settings for Editing Markdown -*- lexical-binding: t; coding: utf-8; -*- +;;; markdown-config.el --- Settings for Editing Markdown -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/media-utils.el b/modules/media-utils.el index 685530d89..1abbc1b2b 100644 --- a/modules/media-utils.el +++ b/modules/media-utils.el @@ -86,9 +86,11 @@ strings." :value-type sexp)) :group 'media) -(defcustom cj/default-media-player 'vlc +(defcustom cj/default-media-player 'mpv "The default media player to use for videos. -Should be a key from `cj/media-players'." +Should be a key from `cj/media-players'. mpv is the default because it +resolves streaming-site URLs itself via yt-dlp, so it needs no pre-extracted +stream URL (see the :needs-stream-url flag in `cj/media-players')." :type 'symbol :group 'media) diff --git a/modules/modeline-config.el b/modules/modeline-config.el index 61dcb69c6..2793cfae5 100644 --- a/modules/modeline-config.el +++ b/modules/modeline-config.el @@ -1,4 +1,4 @@ -;;; modeline-config --- Modeline Settings -*- lexical-binding: t; coding: utf-8; -*- +;;; modeline-config.el --- Modeline Settings -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/mousetrap-mode.el b/modules/mousetrap-mode.el index 3817e0081..656d49e2f 100644 --- a/modules/mousetrap-mode.el +++ b/modules/mousetrap-mode.el @@ -1,4 +1,4 @@ -;;; mousetrap-mode.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; mousetrap-mode.el --- Profile-based mouse event blocking -*- coding: utf-8; lexical-binding: t; -*- ;; ;;; Commentary: ;; @@ -11,25 +11,12 @@ ;; Runtime requires: cl-lib. ;; Direct test load: yes. ;; -;; Mouse Trap Mode is a minor mode for Emacs that disables most mouse and -;; trackpad events to prevent accidental text modifications. Hitting the -;; trackpad and finding my text is being inserted in an unintended place is -;; quite annoying, especially when you're overcaffeinated. +;; Global minor mode that blocks accidental mouse edits while preserving allowed +;; interaction categories per major-mode profile: scroll, click, drag, and +;; multi-click. ;; -;; The mode uses a profile-based architecture to selectively enable/disable -;; mouse events based on the current major mode. Profiles define which -;; event categories are allowed (scrolling, clicks, drags, etc.), and modes -;; are mapped to profiles. -;; -;; The keymap is built dynamically when the mode is toggled, so you can -;; change profiles or mode mappings and re-enable the mode without reloading -;; your Emacs configuration. -;; -;; Keymaps are buffer-local via `emulation-mode-map-alists', so each buffer -;; gets the correct profile for its major mode independently. -;; -;; Inspired by this blog post from Malabarba -;; https://endlessparentheses.com/disable-mouse-only-inside-emacs.html +;; The mode builds buffer-local emulation keymaps from profiles, so changing a +;; profile or mode mapping takes effect after toggling the mode. ;; ;;; Code: diff --git a/modules/mu4e-org-contacts-integration.el b/modules/mu4e-org-contacts-integration.el index daa12701a..6062b8cf5 100644 --- a/modules/mu4e-org-contacts-integration.el +++ b/modules/mu4e-org-contacts-integration.el @@ -2,8 +2,13 @@ ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: -;; This module provides seamless integration between org-contacts and mu4e's -;; email composition, enabling automatic contact completion in email fields. +;; +;; Completion-at-point integration between org-contacts and mu4e/org-msg compose +;; buffers. Header fields complete against org contact email strings; message +;; bodies keep their normal TAB behavior. +;; +;; Dependencies are optional at file load. Activation is a no-op when mu4e or +;; org-contacts is unavailable so the wider config can still load. ;;; Code: diff --git a/modules/mu4e-org-contacts-setup.el b/modules/mu4e-org-contacts-setup.el index 64e9a611f..bfb9b1f24 100644 --- a/modules/mu4e-org-contacts-setup.el +++ b/modules/mu4e-org-contacts-setup.el @@ -2,8 +2,10 @@ ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: -;; Simple setup file to enable org-contacts integration with mu4e. -;; Add this to your mail-config.el or load it after both mu4e and org-contacts. +;; +;; Thin activation wrapper for mu4e-org-contacts-integration. If mu4e is loaded, +;; enable org-contacts completion and disable mu4e's internal contact collector +;; so completion has one source of truth. ;;; Code: diff --git a/modules/music-config.el b/modules/music-config.el index 76fff283b..d16e2bb2f 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -5,90 +5,18 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P/S. ;; Load shape: eager. -;; Eager reason: none; optional music workflow that registers a music keymap, a -;; command-loaded deferral candidate. EMMS hooks should run only after EMMS. -;; Top-level side effects: defines a music keymap under cj/custom-keymap, one -;; global key, package config. +;; Eager reason: none; optional music workflow that registers a music keymap. +;; Top-level side effects: defines C-; m map, one global key, package config. ;; Runtime requires: subr-x, user-constants, keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Direct test load: yes. ;; -;; Music management in Emacs via EMMS with MPV backend. -;; Focus: simple, modular helpers; consistent error handling; streamlined UX. -;; -;; Highlights: -;; - Fuzzy add: select files/dirs; dirs have trailing /; case-insensitive; stable order -;; - Recursive directory add -;; - Dired/Dirvish integration (add selection) -;; - M3U playlist save/load/edit/reload -;; - Radio station M3U creation (streaming URLs supported) -;; - Playlist window toggling -;; - Consume mode (remove tracks after playback) -;; - MPV as player (no daemon required) -;; -;; Keybindings (playlist-mode-map): -;; -;; Aligned with ncmpcpp defaults where possible (83% match). -;; Additional EMMS-specific bindings for features ncmpcpp lacks. -;; -;; Key Action ncmpcpp default Match -;; ─── ────── ─────────────── ───── -;; Playback -;; SPC pause add_item * -;; s stop stop ✓ -;; > / n next track next ✓ -;; < / P previous track previous ✓ -;; p play selected (enter) ✓ -;; f seek forward seek_forward ✓ -;; b seek backward seek_backward ✓ -;; -;; Toggles -;; r repeat playlist toggle_repeat ✓ -;; t repeat track (none) + -;; z random toggle_random ✓ -;; x consume toggle_crossfade * -;; Z shuffle shuffle ✓ -;; -;; Volume -;; + / = volume up volume_up ✓ -;; - volume down volume_down ✓ -;; -;; Info -;; i song info show_song_info ✓ -;; o jump to playing jump_to_playing ✓ -;; -;; Playlist management -;; a add music (fuzzy) add_selected ✓ -;; c / C clear playlist clear_playlist ✓ -;; S save playlist (none) + -;; L load playlist (none) + -;; E edit playlist M3U (none) + -;; g reload playlist (none) + -;; A append track to M3U (none) + -;; q quit/bury quit ✓ -;; -;; Track reordering -;; S-up move track up (shift-up) ✓ -;; S-down move track down (shift-down) ✓ -;; C-up move track up (alias) (none) + -;; C-down move track down (alias) (none) + -;; -;; Other -;; R create radio station (none) + -;; -;; Legend: ✓ = matches ncmpcpp default -;; * = intentional divergence (see below) -;; + = EMMS-only feature -;; -;; Intentional divergences from ncmpcpp defaults: -;; -;; SPC/p swap: ncmpcpp defaults p=pause, SPC=add_item_to_playlist. -;; This config uses SPC=pause (more natural in Emacs) and p=play -;; selected track. Pause via SPC is a common media player convention. -;; -;; x=consume vs crossfade: ncmpcpp's crossfade is an mpd daemon -;; feature. EMMS uses mpv directly, so consume mode (remove tracks -;; after playback) is more useful here. +;; EMMS setup using an mpv subprocess player, M3U playlist helpers, fuzzy +;; file/directory adds, Dired/Dirvish integration, radio-station creation, and +;; playlist window toggling. ;; +;; The playlist keymap intentionally follows ncmpcpp where it maps cleanly, with +;; EMMS-specific additions for M3U editing and consume mode. + ;;; Code: (require 'subr-x) @@ -108,13 +36,26 @@ (defvar emms-random-playlist) (defvar emms-playlist-selected-marker) (defvar emms-source-file-default-directory) -(defvar emms-player-mpv-parameters) -(defvar emms-player-mpv-regexp) (defvar emms-player-playing-p) (defvar emms-player-paused-p) (defvar emms-playlist-mode-map) (defvar dirvish-mode-map) +;; Playlist-header faces. Defined here so the `cj/music--header-text' +;; references are valid (an undefined face spams "Invalid face reference" on +;; every render). Appearance inherits themed base faces so the active theme +;; owns the colors -- the literal values were dropped in the route-colors pass. +(defface cj/music-header-face '((t :inherit shadow)) + "Playlist-header field labels (Playlist, Current, Mode, Keys).") +(defface cj/music-header-value-face '((t :inherit default)) + "Playlist-header field values.") +(defface cj/music-mode-on-face '((t :inherit warning)) + "Active mode indicator in the playlist header.") +(defface cj/music-mode-off-face '((t :inherit shadow)) + "Inactive mode indicator in the playlist header.") +(defface cj/music-keyhint-face '((t :inherit shadow)) + "Key hints in the playlist header.") + ;; Foreign functions used lazily after their packages load. (declare-function emms-playlist-mode "emms-playlist-mode") (declare-function emms-playlist-track-at "emms-playlist-mode") @@ -146,9 +87,98 @@ (defvar cj/music-file-extensions '("aac" "flac" "m4a" "mp3" "ogg" "opus" "wav") "List of valid music file extensions.") +(defvar cj/music-seek-seconds 5 + "Seconds to move when seeking forward or backward in the current track.") + (defvar cj/music-playlist-buffer-name "*EMMS-Playlist*" "Name of the EMMS playlist buffer used by this configuration.") +;;; Subprocess mpv player (reliable playback) + +;; The IPC player (emms-player-mpv) drives mpv over a socket -- start mpv idle, +;; connect, send loadfile. That handshake was leaving mpv loaded but never +;; streaming, so playback silently failed. Driving mpv with the track as a +;; direct argument -- the invocation that plays every time -- is the reliable +;; path. --no-config isolates this mpv from the interactive/video mpv setup so +;; the two cannot interfere. Pause is in place via process signals; in-track +;; seek is not available with a subprocess player (the trade for reliability). + +(declare-function emms-player "emms") +(declare-function emms-player-set "emms") +(declare-function emms-player-simple-start "emms-player-simple") +(declare-function emms-player-simple-stop "emms-player-simple") +(defvar emms-player-simple-process-name) +(defvar emms-player-cj/music-mpv) + +(defvar cj/music--mpv-regex + (concat "\\(?:\\." (regexp-opt cj/music-file-extensions) "\\'\\)" + "\\|\\`\\(?:https?\\|mms\\)://") + "Track names the subprocess mpv player handles: music files or stream URLs.") + +(defvar cj/music--mpv-socket + (expand-file-name "emms/mpv-control.sock" user-emacs-directory) + "IPC control socket for the subprocess mpv player. +mpv opens it per playback via --input-ipc-server. It does NOT affect startup: +mpv still plays the track passed as a direct argument, so the reliable start is +unchanged. The socket only carries control commands (seek) to the already +playing process, which is where the old idle + loadfile handshake failed.") + +(defun cj/music--mpv-start (track) + "Play TRACK by running mpv with the track name as a direct argument." + (emms-player-simple-start (emms-track-name track) + 'emms-player-cj/music-mpv + "mpv" + (list "--no-video" "--no-config" "--really-quiet" + (concat "--input-ipc-server=" cj/music--mpv-socket)))) + +(defun cj/music--mpv-stop () + "Stop the mpv subprocess." + (emms-player-simple-stop)) + +(defun cj/music--mpv-playable-p (track) + "Return non-nil if the subprocess mpv player can play TRACK." + (and (executable-find "mpv") + (memq (emms-track-type track) '(file url)) + (string-match cj/music--mpv-regex (emms-track-name track)))) + +(defun cj/music--mpv-pause () + "Pause the mpv subprocess in place by stopping it (SIGSTOP)." + (let ((proc (get-process emms-player-simple-process-name))) + (when (and proc (process-live-p proc)) + (signal-process proc 'SIGSTOP)))) + +(defun cj/music--mpv-resume () + "Resume the paused mpv subprocess (SIGCONT)." + (let ((proc (get-process emms-player-simple-process-name))) + (when (and proc (process-live-p proc)) + (signal-process proc 'SIGCONT)))) + +(defun cj/music--mpv-command (json) + "Send JSON (a one-line mpv IPC command) to the control socket. +A no-op when nothing is playing or the socket is gone, so it never errors." + (when (file-exists-p cj/music--mpv-socket) + (ignore-errors + (let ((proc (make-network-process :name "cj-music-mpv-cmd" + :family 'local + :service cj/music--mpv-socket + :noquery t))) + (unwind-protect + (progn (process-send-string proc (concat json "\n")) + (accept-process-output proc 0.1)) + (delete-process proc)))))) + +(defun cj/music-seek-forward () + "Seek `cj/music-seek-seconds' seconds forward in the current track." + (interactive) + (cj/music--mpv-command + (format "{\"command\": [\"seek\", %d, \"relative\"]}" cj/music-seek-seconds))) + +(defun cj/music-seek-backward () + "Seek `cj/music-seek-seconds' seconds backward in the current track." + (interactive) + (cj/music--mpv-command + (format "{\"command\": [\"seek\", %d, \"relative\"]}" (- cj/music-seek-seconds)))) + ;;; Buffer-local state (defvar-local cj/music-playlist-file nil @@ -189,14 +219,24 @@ Directories are suffixed with /; files are plain. Hidden dirs/files skipped." (sort acc #'string-lessp))) (defun cj/music--completion-table (candidates) - "Completion table for CANDIDATES preserving order and case-insensitive match." - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata - (display-sort-function . identity) - (cycle-sort-function . identity) - (completion-ignore-case . t)) - (complete-with-action action candidates string pred)))) + "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." + (let ((annotate (cj/completion-file-annotator + (lambda (c) + (expand-file-name + (if (string-suffix-p "/" c) (substring c 0 -1) c) + cj/music-root))))) + (lambda (string pred action) + (if (eq action 'metadata) + `(metadata + (category . cj-music-file) + (annotation-function . ,annotate) + (display-sort-function . identity) + (cycle-sort-function . identity) + (completion-ignore-case . t)) + (complete-with-action action candidates string pred))))) (defun cj/music--ensure-playlist-buffer () "Ensure EMMS playlist buffer exists and is in playlist mode. Return buffer." @@ -843,7 +883,7 @@ For URL tracks: decoded URL." :commands (emms-mode-line-mode) :config (require 'emms-setup) - (require 'emms-player-mpv) + (require 'emms-player-simple) (require 'emms-playlist-mode) (require 'emms-source-file) (require 'emms-source-playlist) @@ -852,8 +892,13 @@ For URL tracks: decoded URL." (setq emms-source-file-default-directory cj/music-root) (setq emms-playlist-default-major-mode 'emms-playlist-mode) - ;; Use MPV as player - MUST be set before emms-all - (setq emms-player-list '(emms-player-mpv)) + ;; Use the reliable subprocess mpv player (built above) - MUST be set before emms-all + (setq emms-player-cj/music-mpv + (emms-player #'cj/music--mpv-start #'cj/music--mpv-stop + #'cj/music--mpv-playable-p)) + (emms-player-set emms-player-cj/music-mpv 'pause #'cj/music--mpv-pause) + (emms-player-set emms-player-cj/music-mpv 'resume #'cj/music--mpv-resume) + (setq emms-player-list '(emms-player-cj/music-mpv)) ;; Now initialize EMMS (emms-all) @@ -862,17 +907,6 @@ For URL tracks: decoded URL." (emms-playing-time-display-mode -1) (emms-mode-line-mode -1) - ;; MPV configuration - ;; MPV supports both local files and stream URLs - (setq emms-player-mpv-parameters - '("--quiet" "--no-video" "--audio-display=no")) - - ;; Update supported file types for mpv player - (setq emms-player-mpv-regexp - (concat "\\(?:\\`\\(?:https?\\|mms\\)://\\)\\|\\(?:\\." - (regexp-opt cj/music-file-extensions) - "\\'\\)")) - ;; Keep cj/music-playlist-file in sync if playlist is cleared. ;; Ensure we don't stack duplicate advice on reload. (advice-remove 'emms-playlist-clear #'cj/music--after-playlist-clear) @@ -908,8 +942,8 @@ For URL tracks: decoded URL." (">" . cj/music-next) ("P" . cj/music-previous) ("<" . cj/music-previous) - ("f" . emms-seek-forward) - ("b" . emms-seek-backward) + ("f" . cj/music-seek-forward) + ("b" . cj/music-seek-backward) ("q" . emms-playlist-mode-bury-buffer) ("a" . cj/music-fuzzy-select-and-add) ;; Toggles (aligned with ncmpcpp) diff --git a/modules/nerd-icons-config.el b/modules/nerd-icons-config.el index e2edb0717..e38db7d80 100644 --- a/modules/nerd-icons-config.el +++ b/modules/nerd-icons-config.el @@ -72,7 +72,20 @@ every call. The `memq' check skips when the face is already present." :after (nerd-icons marginalia) :hook (marginalia-mode . nerd-icons-completion-marginalia-setup) :config - (nerd-icons-completion-mode)) + (nerd-icons-completion-mode) + ;; The `cj/--nerd-icons-color-dir' advice forces `nerd-icons-yellow' onto every + ;; dir icon, so the package's inherit-behind `nerd-icons-completion-dir-face' + ;; can never win. Redefine the file-category icon so completing-read folders + ;; carry the dir face: copy the icon first (the memoized original stays + ;; untouched, so dired/dirvish folders are unaffected) and prepend the dir face + ;; so it takes the foreground. Files keep their own type face. + (cl-defmethod nerd-icons-completion-get-icon (cand (_cat (eql file))) + (if (string-suffix-p "/" cand) + (let ((icon (copy-sequence + (nerd-icons-icon-for-dir cand :height nerd-icons-completion-icon-size)))) + (add-face-text-property 0 (length icon) 'nerd-icons-completion-dir-face nil icon) + (concat icon " ")) + (concat (nerd-icons-icon-for-file cand :height nerd-icons-completion-icon-size) " ")))) (use-package nerd-icons-ibuffer :after nerd-icons diff --git a/modules/nov-reading.el b/modules/nov-reading.el new file mode 100644 index 000000000..4134f4975 --- /dev/null +++ b/modules/nov-reading.el @@ -0,0 +1,282 @@ +;;; nov-reading.el --- Reading-view theme layer for nov-mode EPUBs -*- lexical-binding: t; -*- +;; author: Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 4 (Added features). +;; Category: O (optional commands + faces). +;; Load shape: eager. +;; Eager reason: defines the reading faces and commands the nov launch hook and +;; 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). +;; Direct test load: yes. +;; +;; A small theme layer on top of the stock `nov' package (no fork): how an EPUB +;; *reads*, kept buffer-local so it never disturbs the frame or other buffers. +;; Two knobs: +;; +;; - 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. +;; The live size is remembered globally, so every book opens where you left +;; it; "=" returns to the base height. +;; +;; calibredb-epub-config.el owns the library/calibre side and the text-width / +;; centering layout; this module owns reading color and typography. Its launch +;; entry point `cj/nov-reading-setup' is called from that module's nov-mode hook. + +;;; Code: + +(defgroup cj/nov-reading nil + "Reading-view theming for nov-mode EPUBs." + :group 'cj) + +;; ----------------------------- Reading palettes ------------------------------ +;; nov renders through shr and defines no faces, so a palette is a buffer-local +;; face-remap of `default'. Each palette is one face carrying a :background and +;; :foreground, so the theme owns the real colors (the hex defaults here are a +;; starting point to tune in theme-studio). + +(defface cj/nov-reading-sepia + '((t :background "#1f1b16" :foreground "#c9b187")) + "Sepia reading palette for nov-mode: warm dark background, tan text." + :group 'cj/nov-reading) + +(defface cj/nov-reading-dark + '((t :background "#15140f" :foreground "#cfc8b8")) + "Dark reading palette for nov-mode: near-black background, light-gray text." + :group 'cj/nov-reading) + +(defface cj/nov-reading-light + '((t :background "#ece3cf" :foreground "#2a2622")) + "Light reading palette for nov-mode: cream background, near-black text." + :group 'cj/nov-reading) + +;; Structural faces: recolor shr's heading (h1-h6) and link faces per palette, +;; remapped buffer-local so the EPUB's hierarchy reads in the palette's accent +;; while mail/eww (the other shr consumers) keep the theme's shr colors. Heading +;; faces carry :foreground only -- shr's per-level height and weight survive the +;; relative remap; link faces add :underline so the cue reads as a link. + +(defface cj/nov-reading-sepia-heading + '((t :foreground "#e6c98a")) + "Heading accent for the sepia reading palette (recolors shr-h1..h6)." + :group 'cj/nov-reading) + +(defface cj/nov-reading-sepia-link + '((t :foreground "#c98f5a" :underline t)) + "Link accent for the sepia reading palette (recolors shr-link)." + :group 'cj/nov-reading) + +(defface cj/nov-reading-dark-heading + '((t :foreground "#e8e0cc")) + "Heading accent for the dark reading palette (recolors shr-h1..h6)." + :group 'cj/nov-reading) + +(defface cj/nov-reading-dark-link + '((t :foreground "#8fb0c4" :underline t)) + "Link accent for the dark reading palette (recolors shr-link)." + :group 'cj/nov-reading) + +(defface cj/nov-reading-light-heading + '((t :foreground "#5a3d28")) + "Heading accent for the light reading palette (recolors shr-h1..h6)." + :group 'cj/nov-reading) + +(defface cj/nov-reading-light-link + '((t :foreground "#8a5a2a" :underline t)) + "Link accent for the light reading palette (recolors shr-link)." + :group 'cj/nov-reading) + +(defcustom cj/nov-reading-palettes + '(("sepia" :face cj/nov-reading-sepia + :heading cj/nov-reading-sepia-heading + :link cj/nov-reading-sepia-link) + ("dark" :face cj/nov-reading-dark + :heading cj/nov-reading-dark-heading + :link cj/nov-reading-dark-link) + ("light" :face cj/nov-reading-light + :heading cj/nov-reading-light-heading + :link cj/nov-reading-light-link)) + "Alist of reading-palette NAME -> face property list for nov-mode. +Each entry's plist supplies the palette's colors, all theme-owned faces: + :face reading-view :background and :foreground, remapped onto `default' + :heading recolors shr's heading faces (h1-h6) for this palette + :link recolors shr's link face for this palette +The selector and cycle commands choose among these names. Add an entry to add a +palette; omit :heading or :link to leave that element at the theme's default." + :type '(alist :key-type string + :value-type + (plist :options ((:face face) (:heading face) (:link face)))) + :group 'cj/nov-reading) + +(defcustom cj/nov-reading-default-palette "sepia" + "Reading palette applied to a fresh nov-mode buffer. +A key in `cj/nov-reading-palettes', or nil for the theme's normal rendering." + :type '(choice (const :tag "None (theme default)" nil) string) + :group 'cj/nov-reading) + +(defvar-local cj/nov--reading-remap-cookies nil + "List of `face-remap-add-relative' cookies for the active reading palette. +Covers the `default' remap and any shr heading/link remaps, so switching +palettes can remove them all at once.") + +(defvar-local cj/nov--reading-palette nil + "Name of the reading palette active in this buffer, or nil for none.") + +(defun cj/nov--reading-palette-plist (name) + "Return the face property list for palette NAME, or nil when unknown. +NAME nil (the no-palette state) and unknown names both yield nil." + (cdr (assoc name cj/nov-reading-palettes))) + +(defun cj/nov--reading-palette-face (name) + "Return the base (bg/fg) face for palette NAME, or nil when NAME is unknown." + (plist-get (cj/nov--reading-palette-plist name) :face)) + +(defun cj/nov--next-reading-palette (current names) + "Return the palette after CURRENT in the cycle NAMES then nil, wrapping. +CURRENT nil is the no-palette state, and a returned nil means no palette. An +unknown CURRENT falls back to the first palette." + (let* ((cycle (append names (list nil))) + (tail (cdr (member current cycle)))) + (car (or tail cycle)))) + +(defun cj/nov--apply-reading-palette (name) + "Apply reading palette NAME buffer-local; NAME nil removes any palette. +Remaps `default' to the palette's :face, and (when present) shr's heading faces +h1-h6 to its :heading face and shr-link to its :link face. Removes the previous +palette's remaps first so switching never stacks, and leaves the typography +remap (a separate `default' remap) untouched." + (mapc #'face-remap-remove-relative cj/nov--reading-remap-cookies) + (setq cj/nov--reading-remap-cookies nil) + (let* ((plist (cj/nov--reading-palette-plist name)) + (face (plist-get plist :face))) + (when face + (push (face-remap-add-relative 'default face) + cj/nov--reading-remap-cookies) + (let ((heading (plist-get plist :heading))) + (when heading + (dolist (h '(shr-h1 shr-h2 shr-h3 shr-h4 shr-h5 shr-h6)) + (push (face-remap-add-relative h heading) + cj/nov--reading-remap-cookies)))) + (let ((link (plist-get plist :link))) + (when link + (push (face-remap-add-relative 'shr-link link) + cj/nov--reading-remap-cookies)))) + (setq cj/nov--reading-palette (and face name)))) + +(defun cj/nov-set-reading-palette (name) + "Choose reading palette NAME for this nov buffer; \"none\" clears it. +Interactively prompts among `cj/nov-reading-palettes' plus \"none\"." + (interactive + (list (completing-read "Reading palette: " + (cons "none" (mapcar #'car cj/nov-reading-palettes)) + nil t))) + (unless (derived-mode-p 'nov-mode) + (user-error "Not in a nov-mode buffer")) + (cj/nov--apply-reading-palette (unless (equal name "none") name)) + (message "Reading palette: %s" (or cj/nov--reading-palette "none"))) + +(defun cj/nov-cycle-reading-palette () + "Cycle to the next reading palette, then the no-palette state, wrapping." + (interactive) + (unless (derived-mode-p 'nov-mode) + (user-error "Not in a nov-mode buffer")) + (let ((next (cj/nov--next-reading-palette + cj/nov--reading-palette + (mapcar #'car cj/nov-reading-palettes)))) + (cj/nov--apply-reading-palette next) + (message "Reading palette: %s" (or next "none")))) + +;; ------------------------------- Typography ---------------------------------- + +(defcustom cj/nov-reading-font-family "Merriweather" + "Variable-pitch serif family for the EPUB reading view." + :type 'string + :group 'cj/nov-reading) + +(defcustom cj/nov-reading-text-height 180 + "Base `default'-face height (1/10 pt) the reading view renders at. +The +/-/= keys adjust the page size from here with a buffer-local text-scale. +That adjustment is remembered globally (see `cj/nov-reading-text-scale-file'): +every book and every session opens at the size you last left it, and `=' +returns to this base." + :type 'integer + :group 'cj/nov-reading) + +(defvar cj/nov-reading-text-scale-file + (expand-file-name "data/nov-reading-text-scale" user-emacs-directory) + "File persisting the global reading text-scale offset across sessions. +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.") + +(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." + (let ((trimmed (and (stringp s) (string-trim s)))) + (if (and trimmed (string-match-p "\\`[+-]?[0-9]+\\'" trimmed)) + (string-to-number trimmed) + 0))) + +(defun cj/nov-reading--load-text-scale () + "Return the persisted reading text-scale offset, or 0 when none is saved." + (if (file-readable-p cj/nov-reading-text-scale-file) + (cj/nov-reading--parse-text-scale + (with-temp-buffer + (insert-file-contents cj/nov-reading-text-scale-file) + (buffer-string))) + 0)) + +(defun cj/nov-reading--save-text-scale (amount) + "Persist AMOUNT as the global reading text-scale offset. +Creates the data directory when absent." + (make-directory (file-name-directory cj/nov-reading-text-scale-file) t) + (with-temp-file cj/nov-reading-text-scale-file + (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)) + +(defun cj/nov-reading-text-bigger () + "Increase the page font size and remember it across books and sessions." + (interactive) + (text-scale-increase 1) + (cj/nov-reading--save-text-scale text-scale-mode-amount)) + +(defun cj/nov-reading-text-smaller () + "Decrease the page font size and remember it across books and sessions." + (interactive) + (text-scale-decrease 1) + (cj/nov-reading--save-text-scale text-scale-mode-amount)) + +(defun cj/nov-reading-text-reset () + "Reset the page font size to the base reading height; clears the saved offset." + (interactive) + (text-scale-set 0) + (cj/nov-reading--save-text-scale 0)) + +;; ------------------------------- Launch hook --------------------------------- + +(defun cj/nov-reading-setup () + "Apply the reading view (typography + default palette) to this nov buffer. +Restores the remembered page font size on top of the base height. +Called from the nov-mode launch hook in calibredb-epub-config.el." + (cj/nov-reading-apply-typography) + (text-scale-set (cj/nov-reading--load-text-scale)) + (when cj/nov-reading-default-palette + (cj/nov--apply-reading-palette cj/nov-reading-default-palette))) + +(provide 'nov-reading) +;;; nov-reading.el ends here diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index 3234cc929..207c286e6 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -1,4 +1,4 @@ -;;; org-agenda-config --- Org-Agenda/Todo Config -*- lexical-binding: t; coding: utf-8; -*- +;;; org-agenda-config.el --- Org-Agenda/Todo Config -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;; ;;; Commentary: @@ -6,51 +6,18 @@ ;; Layer: 3 (Domain Workflow). ;; Category: D/S. ;; Load shape: eager. -;; Eager reason: daily agenda workflow; the user expects agenda available at the -;; first session. -;; Top-level side effects: one add-hook and an idle timer that builds the agenda -;; file cache 10s after startup (guarded; spec tracks the cache lifecycle). +;; Eager reason: agenda should be available in the first session. +;; Top-level side effects: agenda hooks plus guarded idle cache build. ;; Runtime requires: user-constants, system-lib, cj-cache-lib. ;; Direct test load: yes. ;; -;; Performance: -;; - Caches agenda file list to avoid scanning projects directory on every view -;; - Cache builds asynchronously 10 seconds after Emacs startup (non-blocking) -;; - First agenda view uses cache if ready, otherwise builds synchronously -;; - Subsequent views are instant (cached) -;; - Cache auto-refreshes after 1 hour -;; - Manual refresh: M-x cj/org-agenda-refresh-files (e.g., after adding projects) +;; Org agenda configuration for global, project-scoped, and buffer-scoped task +;; views. F8 opens the main agenda; modified F8 bindings narrow by project, +;; current buffer, or task list. ;; -;; Agenda views are tied to the F8 (fate) key. -;; -;; "We are what we repeatedly do. -;; Excellence, then, is not an act, but a habit" -;; -- Aristotle -;; -;; "...watch your actions, they become habits; -;; watch your habits, they become character; -;; watch your character, for it becomes your destiny." -;; -- Lao Tzu -;; -;; -;; f8 - MAIN AGENDA which organizes all tasks and events into: -;; - all unfinished priority A tasks -;; - the weekly schedule, including the habit consistency graph -;; - all priority B tasks -;; -;; C-f8 - PROJECT AGENDA showing the main agenda filtered to a single project. -;; Prompts for project selection, then shows overdue/hi-pri/schedule/B tasks -;; scoped to that project's todo.org plus all calendars and inbox. -;; -;; s-f8 - TASK LIST containing all tasks from all agenda targets. -;; -;; M-f8 - TASK LIST containing all tasks from just the current org-mode buffer. -;; -;; NOTE: -;; Files that contain information relevant to the agenda are: the inbox, the -;; schedule-file, the synced calendars, and the per-project todo.org files found -;; in immediate subdirectories of projects-dir. (org-roam notes are refile -;; targets, not agenda sources -- see org-refile-config.el.) +;; Agenda files come from inbox, schedule files, synced calendars, and immediate +;; project todo.org files. The file list is cached and rebuilt asynchronously to +;; keep normal agenda opens fast. ;;; Code: (require 'user-constants) @@ -278,7 +245,16 @@ scoped to that project's todo.org plus calendars, schedule, and inbox." (file-exists-p (expand-file-name "todo.org" dir)))) all-dirs)) (project-names (mapcar #'file-name-nondirectory project-dirs)) - (chosen (completing-read "Show agenda for project: " project-names nil t)) + (chosen (completing-read + "Show agenda for project: " + (cj/completion-table-annotated + 'cj-agenda-project + (cj/completion-file-annotator + (lambda (c) + (expand-file-name "todo.org" + (expand-file-name c projects-dir)))) + project-names) + nil t)) (todo-file (expand-file-name "todo.org" (expand-file-name chosen projects-dir))) (org-agenda-files (cons todo-file (cj/--org-agenda-base-files)))) diff --git a/modules/org-capture-config.el b/modules/org-capture-config.el index 9f5bfbe7f..14fb8e582 100644 --- a/modules/org-capture-config.el +++ b/modules/org-capture-config.el @@ -345,22 +345,43 @@ Captured On: %U" :prepend t) ) ;; end use-package org-protocol ;; ---------------------- Popup Capture Frame Auto-Close ---------------------- -;; The quick-capture script (Hyprland Super+Shift+N) opens an emacsclient +;; The quick-capture script (Hyprland Super+N) opens an emacsclient ;; frame named "org-capture"; Hyprland window rules float and center it by ;; that name. These hooks close the frame when the capture finalizes or ;; aborts, so the popup never lingers. Frames not named "org-capture" are ;; untouched — normal in-Emacs captures keep their windows. -(defun cj/org-capture--popup-frame-p () - "Return non-nil when the selected frame is the quick-capture popup." - (equal (frame-parameter nil 'name) "org-capture")) - -(defun cj/org-capture--delete-popup-frame () - "Delete the current frame when it is the quick-capture popup." - (when (cj/org-capture--popup-frame-p) - (delete-frame))) - -(add-hook 'org-capture-after-finalize-hook #'cj/org-capture--delete-popup-frame) +(defun cj/org-capture--frame-reapable-p (frame-name buffer-names) + "Non-nil when a frame named FRAME-NAME showing BUFFER-NAMES is a reapable popup. +Reapable means the quick-capture popup (FRAME-NAME equal to \"org-capture\") with +no capture UI left in any window — no *Org Select* menu and no CAPTURE-* buffer. +A popup still mid-capture has capture UI and is not reapable, so it is spared." + (and (equal frame-name "org-capture") + (not (seq-some (lambda (b) + (cj/org-capture--popup-sole-window-p frame-name b)) + buffer-names)))) + +(defun cj/org-capture-reap-popup-frames () + "Delete every quick-capture popup frame that no longer shows capture UI. +Reaps across ALL frames, not just the selected one: a capture that finalizes, +aborts, or errors while the daemon's selected frame is something else (the common +multi-frame case) still cleans up its \"org-capture\" popup, while a popup +mid-capture is spared. Never deletes the last remaining frame. Safe to call +anytime — bound to nothing, run via M-x when a stray popup needs clearing." + (interactive) + (dolist (f (frame-list)) + (when (and (frame-live-p f) + (cdr (frame-list)) ; never delete the last frame + (cj/org-capture--frame-reapable-p + (frame-parameter f 'name) + (mapcar (lambda (w) (buffer-name (window-buffer w))) + (window-list f 'no-minibuf)))) + (delete-frame f)))) + +;; Reap on every capture exit. `remove-hook' first so a live module reload swaps +;; the retired narrow (selected-frame) handler for this one without leaving both. +(remove-hook 'org-capture-after-finalize-hook #'cj/org-capture--delete-popup-frame) +(add-hook 'org-capture-after-finalize-hook #'cj/org-capture-reap-popup-frames) ;; The popup opens a fresh emacsclient frame still showing the daemon's last ;; buffer. `org-mks' shows the *Org Select* menu via @@ -439,9 +460,9 @@ daemon's main frame and the capture would otherwise land there." (when frame (select-frame-set-input-focus frame)) (let ((org-capture-templates (cj/--quick-capture-template inbox-file))) (org-capture nil "t"))) - (quit (cj/org-capture--delete-popup-frame)) + (quit (cj/org-capture-reap-popup-frames)) (error (message "Quick-capture: %s" (error-message-string err)) - (cj/org-capture--delete-popup-frame))))) + (cj/org-capture-reap-popup-frames))))) (provide 'org-capture-config) ;;; org-capture-config.el ends here. diff --git a/modules/org-config.el b/modules/org-config.el index f316ee0df..6f25752f4 100644 --- a/modules/org-config.el +++ b/modules/org-config.el @@ -1,4 +1,4 @@ -;;; org-config --- Settings and Enhancements to Org Mode -*- lexical-binding: t; coding: utf-8; -*- +;;; org-config.el --- Settings and Enhancements to Org Mode -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: ;; diff --git a/modules/org-contacts-config.el b/modules/org-contacts-config.el index 64abb9fb5..944d75c10 100644 --- a/modules/org-contacts-config.el +++ b/modules/org-contacts-config.el @@ -168,15 +168,29 @@ Added: %U" ;;; ------------------------- Quick Contact Functions --------------------------- +(require 'system-lib) + (defun cj/org-contacts-find () "Find and open a contact." (interactive) (find-file contacts-file) (goto-char (point-min)) - (let ((contact (completing-read "Find contact: " - (org-map-entries - (lambda () (nth 4 (org-heading-components))) - nil (list contacts-file))))) + (let* ((alist (org-map-entries + (lambda () + (cons (nth 4 (org-heading-components)) + (or (org-entry-get nil "EMAIL") + (org-entry-get nil "PHONE")))) + nil (list contacts-file))) + (contact (completing-read + "Find contact: " + (cj/completion-table-annotated + 'contact + (lambda (cand) + (let ((info (cdr (assoc cand alist)))) + (when (and info (> (length info) 0)) + (concat " " (propertize info 'face + 'completions-annotations))))) + alist)))) (goto-char (point-min)) (search-forward contact) (org-fold-show-entry) diff --git a/modules/org-drill-config.el b/modules/org-drill-config.el index 2c6e400e0..29f6130a2 100644 --- a/modules/org-drill-config.el +++ b/modules/org-drill-config.el @@ -8,7 +8,7 @@ ;; Eager reason: none; optional flashcard workflow, a command-loaded deferral ;; candidate for Phase 4. ;; Top-level side effects: defines a drill keymap, registers it under cj/custom-keymap. -;; Runtime requires: user-constants, keybindings. +;; Runtime requires: user-constants, keybindings, system-lib. ;; Direct test load: yes (requires keybindings explicitly). ;; ;; Notes: Org-Drill @@ -29,6 +29,7 @@ (require 'user-constants) ;; `drill-dir' (require 'keybindings) ;; provides `cj/custom-keymap' +(require 'system-lib) ;; completion table + file annotator (declare-function org-drill "org-drill" (&optional scope drill-match resume-p)) (declare-function org-drill-resume "org-drill" ()) (declare-function org-capture "org-capture" (&optional goto keys)) @@ -57,7 +58,13 @@ drill commands and the drill capture templates share." (defun cj/--drill-pick-file (dir) "Prompt for one of the drill Org files in DIR; return its absolute path." (expand-file-name - (completing-read "Choose flashcard file: " (cj/--drill-files-or-error dir) nil t) + (completing-read "Choose flashcard file: " + (cj/completion-table-annotated + 'cj-drill-file + (cj/completion-file-annotator + (lambda (c) (expand-file-name c dir))) + (cj/--drill-files-or-error dir)) + nil t) dir)) (defun cj/--drill-pick-dir (other-dir) diff --git a/modules/org-webclipper.el b/modules/org-webclipper.el index 99e837e63..40ceada76 100644 --- a/modules/org-webclipper.el +++ b/modules/org-webclipper.el @@ -5,53 +5,29 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P. ;; Load shape: eager. -;; Eager reason: none; web clipping runs via org-protocol/command, a Phase 4 -;; protocol/command-loaded deferral candidate. +;; Eager reason: none; protocol and direct clipping can load on command. ;; Top-level side effects: org-protocol handler registration via use-package. -;; Runtime requires: none (configures packages via use-package). +;; Runtime requires: none. ;; Direct test load: yes. ;; -;; This package provides a seamless "fire-and-forget" workflow for clipping -;; web pages from the browser directly into an Org file using org-protocol -;; and org-web-tools. +;; Captures web pages into Org from org-protocol, EWW, or W3M. The protocol path +;; records URL/title dynamically around org-capture; the direct path clips the +;; current browser buffer. ;; -;; Features: -;; - Browser bookmarklet integration via org-protocol -;; - Automatic conversion to Org format using eww-readable and Pandoc -;; - One-click capture from any web page -;; - Preserves page structure and formatting -;; - Smart heading adjustment (removes page title, demotes remaining headings) -;; -;; Setup: -;; 1. Ensure this file is loaded in your Emacs configuration -;; 2. Make sure emacsclient is configured for org-protocol -;; 3. Add the following bookmarklet to your browser's bookmarks bar: -;; -;; javascript:location.href='org-protocol://webclip?url='+encodeURIComponent(location.href)+'&title='+encodeURIComponent(document.title);void(0); -;; -;; To add the bookmarklet: -;; a. Create a new bookmark in your browser -;; b. Set the name to: Clip to Org (or your preference) -;; c. Set the URL to the JavaScript code above -;; d. Save it to your bookmarks bar for easy access -;; -;; 4. Click the bookmarklet on any web page to clip its content -;; -;; The clipped content will be added to the file specified by `webclipped-file` -;; under the "Webclipped Inbox" heading with proper formatting and metadata. -;; -;; Architecture: -;; - cj/--process-webclip-content: Pure function for content processing -;; - cj/org-protocol-webclip-handler: Handles URL fetching and capture -;; - cj/org-webclipper-EWW: Direct capture from EWW/W3M buffers -;; -;; Requirements: -;; - org-web-tools package -;; - Pandoc installed on your system -;; - Emacs server running (M-x server-start) +;; Content is converted to readable Org, normalized, and filed under the +;; configured webclip inbox heading. ;;; Code: +(declare-function org-web-tools--url-as-readable-org "org-web-tools") +(declare-function org-w3m-copy-for-org-mode "org-w3m") +(declare-function org-eww-copy-for-org-mode "org-eww") +(declare-function org-capture-get "org-capture") +;; Special vars from org-capture / org-protocol / user-constants, loaded at +;; runtime; declared here so standalone byte-compilation does not warn. +(defvar org-capture-templates) +(defvar org-protocol-protocol-alist) +(defvar webclipped-file) ;; Variables for storing org-protocol data (defvar cj/--webclip-url nil @@ -76,7 +52,6 @@ See `cj/--webclip-url' for the binding contract.") (defun cj/webclipper-ensure-initialized () "Ensure webclipper is initialized when first used." (unless cj/webclipper-initialized - ;; Load required packages now (require 'org-protocol) (require 'org-capture) (require 'org-web-tools) diff --git a/modules/pdf-config.el b/modules/pdf-config.el index 56b397df3..a5dc3c490 100644 --- a/modules/pdf-config.el +++ b/modules/pdf-config.el @@ -1,4 +1,4 @@ -;;; pdf-config --- PDF Viewer Setup -*- lexical-binding: t; coding: utf-8; -*- +;;; pdf-config.el --- PDF Viewer Setup -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/prog-c.el b/modules/prog-c.el index 294375cb4..728df0181 100644 --- a/modules/prog-c.el +++ b/modules/prog-c.el @@ -1,4 +1,4 @@ -;;; prog-c --- C Programming Settings and Functionality -*- lexical-binding: t; coding: utf-8; -*- +;;; prog-c.el --- C Programming Settings and Functionality -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/prog-general.el b/modules/prog-general.el index f22f89923..15bf40c41 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -1,4 +1,4 @@ -;;; prog-general --- General Programming Settings -*- lexical-binding: t; coding: utf-8; -*- +;;; prog-general.el --- General Programming Settings -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/prog-go.el b/modules/prog-go.el index 4b09f29c3..7faf92a08 100644 --- a/modules/prog-go.el +++ b/modules/prog-go.el @@ -1,4 +1,4 @@ -;;; prog-go --- Golang Specific Settings and Functionality -*- lexical-binding: t; coding: utf-8; -*- +;;; prog-go.el --- Golang Specific Settings and Functionality -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/prog-lisp.el b/modules/prog-lisp.el index 30c04ad7e..ba568c9c6 100644 --- a/modules/prog-lisp.el +++ b/modules/prog-lisp.el @@ -1,4 +1,4 @@ -;;; prog-lisp --- Lisp Specific Settings and Functionality -*- lexical-binding: t; coding: utf-8; -*- +;;; prog-lisp.el --- Lisp Specific Settings and Functionality -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/prog-lsp.el b/modules/prog-lsp.el index 045dda248..1c74bcc10 100644 --- a/modules/prog-lsp.el +++ b/modules/prog-lsp.el @@ -1,4 +1,4 @@ -;;; prog-lsp --- Setup for LSP Mode -*- lexical-binding: t; coding: utf-8; -*- +;;; prog-lsp.el --- Setup for LSP Mode -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/prog-python.el b/modules/prog-python.el index d8556c4d7..6354bd90c 100644 --- a/modules/prog-python.el +++ b/modules/prog-python.el @@ -1,4 +1,4 @@ -;;; prog-python --- Python Specific Setup and Functionality -*- lexical-binding: t; coding: utf-8; -*- +;;; prog-python.el --- Python Specific Setup and Functionality -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/prog-shell.el b/modules/prog-shell.el index 45c0afbca..d7f97932b 100644 --- a/modules/prog-shell.el +++ b/modules/prog-shell.el @@ -1,4 +1,4 @@ -;;; prog-shell --- Shell Programming Settings and Functionality -*- lexical-binding: t; coding: utf-8; -*- +;;; prog-shell.el --- Shell Programming Settings and Functionality -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/prog-yaml.el b/modules/prog-yaml.el index e07cf510e..71f358c7f 100644 --- a/modules/prog-yaml.el +++ b/modules/prog-yaml.el @@ -1,4 +1,4 @@ -;;; prog-yaml --- YAML Settings -*- lexical-binding: t; coding: utf-8; -*- +;;; prog-yaml.el --- YAML Settings -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/selection-framework.el b/modules/selection-framework.el index 464654a20..7f7f9a475 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -128,7 +128,6 @@ ;; Optionally tweak the register preview window. (advice-add #'register-preview :override #'consult-register-window) - ;; Configure other variables and modes (setq xref-show-xrefs-function #'consult-xref xref-show-definitions-function #'consult-xref) diff --git a/modules/show-kill-ring.el b/modules/show-kill-ring.el index a6c59e26c..e65d48b5f 100644 --- a/modules/show-kill-ring.el +++ b/modules/show-kill-ring.el @@ -1,4 +1,4 @@ -;;; show-kill-ring --- Displays Previous Kill Ring Entries -*- lexical-binding: t; coding: utf-8; -*- +;;; show-kill-ring.el --- Displays Previous Kill Ring Entries -*- lexical-binding: t; coding: utf-8; -*- ;; Show Kill Ring ;; Stolen from Steve Yegge when he wasn't looking ;; enhancements and bugs added by Craig Jennings <c@cjennings.net> diff --git a/modules/signal-config.el b/modules/signal-config.el index 86cb523ce..edb7d0dc3 100644 --- a/modules/signal-config.el +++ b/modules/signal-config.el @@ -309,7 +309,13 @@ opens the chosen recipient in `signel-chat'." (candidates (cons note-self cj/signel--contact-cache)) (table (lambda (string pred action) (if (eq action 'metadata) - '(metadata + `(metadata + (category . signal-contact) + (annotation-function + . ,(lambda (cand) + (let ((r (cdr (assoc cand candidates)))) + (when r + (concat " " (propertize r 'face 'completions-annotations)))))) (display-sort-function . identity) (cycle-sort-function . identity)) (complete-with-action action candidates string pred)))) diff --git a/modules/system-commands.el b/modules/system-commands.el index 44ac3ae89..de5e88535 100644 --- a/modules/system-commands.el +++ b/modules/system-commands.el @@ -6,14 +6,14 @@ ;; Layer: 3 (Domain Workflow). ;; Category: D/S. ;; Load shape: eager. -;; Eager reason: registers the C-; ! system-command keymap; high-impact commands +;; Eager reason: binds C-; ! to the system-command menu; high-impact commands ;; that should run only by command (command-loaded target). -;; Top-level side effects: defines a system-command keymap under cj/custom-keymap. +;; Top-level side effects: binds C-; ! to the system-command menu in cj/custom-keymap. ;; Runtime requires: keybindings, host-environment, rx. ;; Direct test load: yes (requires keybindings explicitly). ;; ;; System commands for logout, lock, suspend, shutdown, reboot, and Emacs -;; exit/restart. Provides both a keymap (C-; !) and a completing-read menu. +;; exit/restart. C-; ! opens a completing-read menu of all commands. ;; ;; Commands include: ;; - Logout (terminate user session) @@ -28,8 +28,8 @@ ;; ;;; Code: -;; `keybindings' provides `cj/custom-keymap', which is referenced at load -;; time by the `keymap-set' call at the tail of this file. An +;; `keybindings' provides `cj/custom-keymap' and `cj/register-command', +;; referenced at load time by the binding call at the tail of this file. An ;; `eval-when-compile' require would silence the byte-compiler but leave ;; the load-time reference void if anything required `system-commands' ;; before `keybindings'. Make the dependency explicit. @@ -181,29 +181,10 @@ daemon alive rather than killing the session blindly." (when-let ((cmd (alist-get choice commands nil nil #'equal))) (call-interactively cmd)))) -(defvar-keymap cj/system-command-map - :doc "Keymap for system commands." - "!" #'cj/system-command-menu - "L" #'cj/system-cmd-logout - "r" #'cj/system-cmd-reboot - "s" #'cj/system-cmd-shutdown - "S" #'cj/system-cmd-suspend - "l" #'cj/system-cmd-lock - "E" #'cj/system-cmd-exit-emacs - "e" #'cj/system-cmd-restart-emacs) -(cj/register-prefix-map "!" cj/system-command-map) - -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements - "C-; !" "system commands" - "C-; ! !" "system command menu" - "C-; ! L" "logout" - "C-; ! E" "exit Emacs" - "C-; ! S" "suspend" - "C-; ! e" "restart Emacs" - "C-; ! l" "lock screen" - "C-; ! r" "reboot" - "C-; ! s" "shutdown")) +;; C-; ! opens the completing-read menu directly. The per-command leaf +;; keys (s/r/e/l/L/E/S) were removed 2026-06-28 to reclaim the key +;; real-estate; every command stays reachable through the menu. +(cj/register-command "!" #'cj/system-command-menu "system commands") (provide 'system-commands) ;;; system-commands.el ends here diff --git a/modules/system-defaults.el b/modules/system-defaults.el index 6d9c811a6..c63ca0093 100644 --- a/modules/system-defaults.el +++ b/modules/system-defaults.el @@ -1,4 +1,4 @@ -;;; system-defaults --- Non-UI Preferences -*- lexical-binding: t; coding: utf-8-unix; -*- +;;; system-defaults.el --- Non-UI Preferences -*- lexical-binding: t; coding: utf-8-unix; -*- ;; author: Craig Jennings <c@cjennings.net> ;; ;;; Commentary: @@ -266,10 +266,10 @@ appears only once per session." ;; ------------------ Unpropertize Kill Ring For Performance ----------------- -(defun unpropertize-kill-ring () +(defun cj/--unpropertize-kill-ring () (setq kill-ring (mapcar 'substring-no-properties kill-ring))) -(add-hook 'kill-emacs-hook 'unpropertize-kill-ring) +(add-hook 'kill-emacs-hook 'cj/--unpropertize-kill-ring) ;; ------------------------------- GNU 'ls' On BSD ------------------------------- diff --git a/modules/system-lib.el b/modules/system-lib.el index 49bb6cd1a..f1049c021 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -164,6 +164,50 @@ contributes its own modes regardless of load order." (setq font-lock-global-modes (cj/--font-lock-global-modes-excluding font-lock-global-modes mode)))) +(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 +table, or another table). The table reports CATEGORY in its metadata so +marginalia (and embark, consult, sorting) can recognize and annotate the +candidates. Use a standard category (file, buffer, function, theme, ...) when +the candidates match one; marginalia then annotates them with no further work." + (lambda (string predicate action) + (if (eq action 'metadata) + `(metadata (category . ,category)) + (complete-with-action action collection string predicate)))) + +(defun cj/completion-table-annotated (category annotate collection) + "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." + (lambda (string predicate action) + (if (eq action 'metadata) + `(metadata (category . ,category) + (annotation-function . ,annotate)) + (complete-with-action action collection string predicate)))) + +(defun cj/completion-file-annotator (candidate->path) + "Return an annotation function for completion candidates backed by files. +CANDIDATE->PATH maps a candidate string to its absolute file path, or nil when +the candidate has no backing file. The returned function, suitable as a +completion table's annotation function (see `cj/completion-table-annotated'), +yields a suffix with the file size and modification date for a regular file, +the marker \"dir\" plus the date for a directory, or nil when the path is nil +or the file is missing -- so marginalia then shows no suffix for that +candidate." + (lambda (cand) + (let ((path (funcall candidate->path cand))) + (when (and path (file-exists-p path)) + (let* ((attrs (file-attributes path)) + (dirp (eq t (file-attribute-type attrs))) + (size (if dirp "dir" + (file-size-human-readable (file-attribute-size attrs)))) + (date (format-time-string + "%Y-%m-%d" + (file-attribute-modification-time attrs)))) + (format " %8s %s" size date)))))) + (defun cj/format-region-with-program (program &rest args) "Replace the current buffer with PROGRAM ARGS run over its contents, via argv. Runs PROGRAM (with ARGS) on the whole buffer through `call-process-region' diff --git a/modules/system-utils.el b/modules/system-utils.el index c76193a71..e779026a0 100644 --- a/modules/system-utils.el +++ b/modules/system-utils.el @@ -1,4 +1,4 @@ -;;; system-utils --- System-Wide Utilities -*- lexical-binding: t; coding: utf-8; -*- +;;; system-utils.el --- System-Wide Utilities -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;; ;;; Commentary: @@ -147,6 +147,22 @@ detached from Emacs." ;; in `nerd-icons-config'. (keymap-global-set "<remap> <list-buffers>" #'ibuffer) +;; Swap delete and diff in the ibuffer list: d diffs the buffer at point against +;; its saved file (was on =), and D marks it for deletion (was on d; `x' still +;; executes the marks). +(defvar ibuffer-mode-map) +(declare-function ibuffer-diff-with-file "ibuffer") +(declare-function ibuffer-mark-for-delete "ibuffer") +(with-eval-after-load 'ibuffer + (keymap-set ibuffer-mode-map "d" #'ibuffer-diff-with-file) + (keymap-set ibuffer-mode-map "D" #'ibuffer-mark-for-delete)) + +;; ibuffer paints its rows with manual `face' properties (nerd-icons + ibuffer +;; faces). Left in `global-font-lock-mode', font-lock leaks keyword fontification +;; onto buffer and mode names, mixing wrong colors in. Exclude it, the same fix +;; as the shr-rendered reader modes. +(cj/exclude-from-global-font-lock 'ibuffer-mode) + ;;; -------------------------- Scratch Buffer Happiness ------------------------- (defvar scratch-emacs-version-and-system diff --git a/modules/term-config.el b/modules/term-config.el deleted file mode 100644 index 474a85c42..000000000 --- a/modules/term-config.el +++ /dev/null @@ -1,558 +0,0 @@ -;;; term-config.el --- Settings for ghostel and the F12 toggle -*- lexical-binding: t; coding: utf-8; -*- -;; author Craig Jennings <c@cjennings.net> - -;;; Commentary: -;; -;; Layer: 3 (Domain Workflow). -;; Category: D/P. -;; Load shape: eager. -;; Eager reason: registers terminal keymaps and the F12 toggle. -;; Top-level side effects: defines two keymaps (one under cj/custom-keymap), one -;; global key, two add-hook, package config. -;; Runtime requires: keybindings, seq, subr-x, cj-window-geometry-lib, -;; cj-window-toggle-lib. -;; Direct test load: yes (requires keybindings explicitly). -;; -;; GHOSTEL -;; ghostel is a native Emacs terminal emulator over libghostty-vt (the Ghostty -;; engine). Like a real terminal, in its default semi-char mode most keys are -;; sent to the running program; `ghostel-keymap-exceptions' lists the keys that -;; reach Emacs instead. We add C-; so the personal prefix keymap works inside -;; ghostel buffers. -;; -;; The module degrades gracefully when ghostel is unavailable (D6 of the -;; migration spec): the package installs via use-package, the native module -;; auto-downloads on first use, and ghostel emits its own warning if the module -;; cannot load. A machine without a prebuilt binary needs Zig to build it; the -;; terminal commands stay defined either way. -;; -;; Two ways to lift text out of a terminal, both with the same key story: -;; - C-; x c enters copy-mode via `cj/term-copy-mode-dwim'. When a tmux -;; client is attached (typical -- `cj/term-launch-tmux' auto-starts tmux), -;; sends tmux's prefix C-b [ then C-a, so the user lands in tmux's own -;; copy-mode with the full pane history and the cursor at column 0 (so -;; scrolling up runs up the left, not the right). Without tmux, falls back to -;; `ghostel-copy-mode' (read-only standard-Emacs navigation over the -;; scrollback; M-w copies and stays, q / C-g exit) and moves point to the -;; start of the line for the same column-0 reason. -;; - C-; x h captures the current tmux pane's full history into a temporary -;; Emacs buffer. -;; In both copy surfaces, M-w copies the active region and stays open so several -;; pieces can be grabbed in a row; C-g / q leave without copying. - -;;; Code: - -(require 'keybindings) -(require 'seq) -(require 'subr-x) -(require 'cj-window-geometry-lib) -(require 'cj-window-toggle-lib) - -(declare-function ghostel "ghostel" (&optional directory)) -(declare-function ghostel-send-string "ghostel" (string)) -(declare-function ghostel-copy-mode "ghostel" ()) -(declare-function ghostel-clear-scrollback "ghostel" ()) -(declare-function ghostel-next-prompt "ghostel" (&optional n)) -(declare-function ghostel-previous-prompt "ghostel" (&optional n)) -(declare-function ghostel-send-next-key "ghostel" ()) -(declare-function ghostel--rebuild-semi-char-keymap "ghostel" ()) -(defvar ghostel-mode-map) -(defvar ghostel-keymap-exceptions) -(defvar ghostel-buffer-name) -(defvar ghostel--input-mode) - -;; eat backs the F12 toggle (see the eat package + F12 toggle sections below). -(declare-function eat "eat" (&optional program arg)) -(defvar eat-buffer-name) -(defvar eat-mode-map) -(defvar eat-semi-char-mode-map) -(defvar cj/custom-keymap) - -(defvar-keymap cj/term-map - :doc "Personal terminal command map.") -;; Lowercase x picked over T for fewer Shift presses; t is the toggle leaf. -(cj/register-prefix-map "x" cj/term-map) - -;; ----------------------------- tmux history ---------------------------------- - -(defvar-local cj/term-tmux-history--origin-buffer nil - "Buffer active before opening the tmux history buffer.") - -(defvar-local cj/term-tmux-history--origin-window nil - "Window active before opening the tmux history buffer.") - -(defvar-local cj/term-tmux-history--origin-point nil - "Point in the origin buffer before opening the tmux history buffer.") - -(defun cj/term--tmux-output (&rest args) - "Run tmux with ARGS and return its stdout. -Signal `user-error' when tmux exits with a non-zero status." - (with-temp-buffer - (let ((exit-code (apply #'process-file "tmux" nil t nil args))) - (unless (zerop exit-code) - (user-error "tmux failed: %s" (string-trim (buffer-string)))) - (buffer-string)))) - -(defun cj/term--tmux-pane-id-for-tty (tty) - "Return the tmux pane id for client TTY." - (let* ((output (cj/term--tmux-output - "list-clients" "-F" "#{client_tty}\t#{pane_id}")) - (lines (split-string output "\n" t)) - (match (seq-find - (lambda (line) - (let ((fields (split-string line "\t"))) - (equal (car fields) tty))) - lines))) - (unless match - (user-error "No tmux client found for terminal tty %s" tty)) - (cadr (split-string match "\t")))) - -(defun cj/term--tmux-capture-pane (pane-id) - "Return full joined tmux history for PANE-ID." - (cj/term--tmux-output - "capture-pane" "-p" "-J" "-S" "-" "-E" "-" "-t" pane-id)) - -(defun cj/term--current-tmux-pane-id () - "Return the tmux pane id for the current ghostel buffer." - (unless (eq major-mode 'ghostel-mode) - (user-error "Current buffer is not a ghostel buffer")) - (let* ((proc (get-buffer-process (current-buffer))) - (tty (and proc (process-tty-name proc)))) - (unless (and tty (not (string-empty-p tty))) - (user-error "Could not determine terminal tty")) - (cj/term--tmux-pane-id-for-tty tty))) - -(defvar-keymap cj/term-tmux-history-mode-map - :doc "Keymap for `cj/term-tmux-history-mode'. -M-w copies the active region without leaving the buffer; C-g, <escape>, or q -returns to the terminal without copying. RET is left unbound." - "M-w" #'kill-ring-save - "C-g" #'cj/term-tmux-history-quit - "<escape>" #'cj/term-tmux-history-quit - "q" #'cj/term-tmux-history-quit) - -(define-derived-mode cj/term-tmux-history-mode special-mode "Tmux History" - "Mode for copying captured tmux pane history with normal Emacs keys." - (setq-local truncate-lines t) - (goto-address-mode 1)) - -(defun cj/term-tmux-history-quit () - "Quit tmux history and return to its origin buffer." - (interactive) - (let ((history-buffer (current-buffer)) - (origin-buffer cj/term-tmux-history--origin-buffer) - (origin-window cj/term-tmux-history--origin-window) - (origin-point cj/term-tmux-history--origin-point)) - (when (buffer-live-p origin-buffer) - (if (window-live-p origin-window) - (progn - (set-window-buffer origin-window origin-buffer) - (select-window origin-window)) - (pop-to-buffer origin-buffer)) - (with-current-buffer origin-buffer - (when (integer-or-marker-p origin-point) - (goto-char origin-point)))) - (when (buffer-live-p history-buffer) - (kill-buffer history-buffer)))) - -(defun cj/term-tmux-history () - "Open full tmux pane history in a temporary Emacs buffer. - -The history buffer uses normal Emacs navigation and selection. `M-w' -copies the active region and stays open, so several pieces can be -copied in a row; `q', `<escape>', or `C-g' returns point to the -terminal buffer that launched it. - -The history view replaces the origin terminal buffer in the same window -\(via `switch-to-buffer'), not a split or a popped-up window." - (interactive) - (let* ((origin-buffer (current-buffer)) - (origin-window (selected-window)) - (origin-point (point)) - (pane-id (cj/term--current-tmux-pane-id)) - (history (cj/term--tmux-capture-pane pane-id)) - (buffer (get-buffer-create - (format "*terminal tmux history: %s*" (buffer-name origin-buffer))))) - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (insert history)) - (cj/term-tmux-history-mode) - (setq-local cj/term-tmux-history--origin-buffer origin-buffer) - (setq-local cj/term-tmux-history--origin-window origin-window) - (setq-local cj/term-tmux-history--origin-point origin-point) - (goto-char (point-max))) - (switch-to-buffer buffer))) - -;; ----------------------------- copy mode ------------------------------------- - -(defun cj/term--in-tmux-p () - "Return non-nil when the current ghostel buffer has a tmux client attached. -Errors from the pane-id lookup (not in ghostel-mode, no tty, no matching -client, tmux not installed) are treated as nil so callers can use this as a -cheap boolean predicate." - (and (eq major-mode 'ghostel-mode) - (condition-case _ - (and (cj/term--current-tmux-pane-id) t) - (error nil)))) - -(defun cj/term-copy-mode-dwim () - "Enter copy-mode using the engine appropriate to this terminal. - -When tmux is attached, write tmux's default prefix sequence (C-b [) into the -pty so the user lands in tmux's copy-mode with the full pane history, then -C-a to land the cursor at the start of the line. Without the trailing C-a -the copy cursor inherits the live column (far right after a prompt) and -scrolling up runs up the right edge; tmux's emacs copy-mode binds C-a to -start-of-line, so column 0 makes it run up the left. Without tmux, falls -through to `ghostel-copy-mode' (a read-only standard-Emacs view of the -scrollback; M-w copies and stays, q / C-g exit), then moves point to the -start of the line for the same column-0 reason." - (interactive) - (if (cj/term--in-tmux-p) - (ghostel-send-string "\C-b[\C-a") - (ghostel-copy-mode) - (beginning-of-line))) - -;; ----------------------------- copy-mode scroll ------------------------------ -;; -;; C-<up> both enters copy-mode and scrolls up one line, so a single stroke -;; lands in the scrollback already moving the right way. It joins -;; `ghostel-keymap-exceptions' so it reaches Emacs instead of the pty. Only the -;; up gesture is bound: C-<left>/<right> are readline word-motion at the shell -;; prompt and must pass through, and the other directions have no copy-mode use. -;; Pressed again while already in copy-mode it just moves up -- re-entering would -;; reset the cursor (tmux's prefix-[ + C-a, or ghostel's toggle exiting). - -(defun cj/term--tmux-pane-in-copy-mode-p (pane-id) - "Return non-nil when tmux PANE-ID is currently displaying a mode. -tmux's `pane_in_mode' is 1 while a pane is in any mode; copy-mode is the only -mode this config enters. tmux failures are treated as nil." - (condition-case nil - (equal "1" (string-trim - (cj/term--tmux-output - "display-message" "-p" "-t" pane-id "#{pane_in_mode}"))) - (error nil))) - -(defun cj/term-copy-mode-up () - "Enter copy-mode if needed, then scroll up one line. -A single C-<up> lands in the terminal's copy-mode already moving up. Pressed -again while already in copy-mode it just moves up another line, so it never -re-enters and resets the cursor. In tmux, writes the up-arrow escape sequence -into the pty; without tmux, moves point up in the `ghostel-copy-mode' buffer." - (interactive) - (let ((pane (ignore-errors (cj/term--current-tmux-pane-id)))) - (cond - (pane - (unless (cj/term--tmux-pane-in-copy-mode-p pane) - (cj/term-copy-mode-dwim)) - (ghostel-send-string "\e[A")) - (t - (unless (eq (bound-and-true-p ghostel--input-mode) 'copy) - (cj/term-copy-mode-dwim)) - (forward-line -1))))) - -;; ----------------------------- ghostel package ------------------------------- - -(defun cj/turn-off-chrome-for-term () - "Turn off line numbers and hl-line in a terminal buffer." - (hl-line-mode -1) - (display-line-numbers-mode -1)) - -(defun cj/term-launch-tmux () - "Auto-launch tmux in a ghostel buffer unless already inside tmux. - -Skipped when `cj/--ai-term-suppress-tmux' is non-nil so the AI-agent flow can -run its own project-named tmux session instead of a bare, auto-named one. -`bound-and-true-p' keeps this safe whether or not ai-term.el is loaded." - (let ((proc (get-buffer-process (current-buffer)))) - (when (and proc - (not (getenv "TMUX")) - (not (bound-and-true-p cj/--ai-term-suppress-tmux))) - (ghostel-send-string "tmux\n")))) - -(use-package ghostel - ;; PINNED at module 0.33.0 (ghostel-20260604.2049, the last pre-rework June-4 - ;; build), installed directly into elpa/ rather than from MELPA. The 0.35.0-0.35.2 - ;; native-PTY rework (worker threads + mutex-outside-read-loop) hard-crashes the - ;; whole Emacs process when a ghostel buffer is displayed: on Linux/glibc a - ;; SIGSETXID handler calls malloc while the main thread holds the arena lock - ;; (ghostel upstream #422); on macOS a recursive os_unfair_lock via - ;; run_window_change_functions (#423). `:ensure t' is satisfied by the present - ;; 0.33.0 dir and will NOT upgrade it -- do NOT `package-upgrade' ghostel until - ;; #422/#423 are fixed upstream, or it returns to the crashing 0.35.x. - :ensure t - :commands (ghostel) - :init - ;; These keys must reach Emacs (not the terminal program) inside ghostel - ;; buffers. In semi-char mode ghostel forwards every key NOT in - ;; `ghostel-keymap-exceptions' to the pty, and `ghostel-semi-char-mode-map' - ;; is rebuilt from that list by `ghostel--rebuild-semi-char-keymap' -- - ;; `add-to-list' alone updates the list but not the already-built map, so the - ;; rebuild is what actually lets the key through to `ghostel-mode-map' / the - ;; global map. C-; and F12 are the prefix + toggle; the modified arrows are - ;; windmove (S-arrows, focus), buffer-move (C-M-arrows, swap), and copy-mode - ;; entry (C-<up> only, via `cj/term-copy-mode-up'), which the ai-term workflow - ;; expects to work from inside an agent buffer. C-<left>/<right> deliberately - ;; stay forwarding so readline word-motion works at the shell prompt. F8 and - ;; F10 are global bindings (org agenda, music-playlist toggle) that reach - ;; Emacs by falling through to the global map once the semi-char map stops - ;; forwarding them. (Server shutdown moved off C-F10 to C-x C, which is - ;; deliberately left forwarding to the terminal program inside an agent - ;; buffer.) - (with-eval-after-load 'ghostel - (dolist (key '("C-;" "<f8>" "<f12>" "<f10>" - "S-<up>" "S-<down>" "S-<left>" "S-<right>" - "C-M-<up>" "C-M-<down>" "C-M-<left>" "C-M-<right>" - "C-<up>")) - (add-to-list 'ghostel-keymap-exceptions key)) - (ghostel--rebuild-semi-char-keymap)) - :hook - ((ghostel-mode . cj/turn-off-chrome-for-term) - (ghostel-mode . cj/term-launch-tmux)) - :custom - (ghostel-kill-buffer-on-exit t) - ;; Auto-download the prebuilt native module on first launch instead of the - ;; default `ask' prompt -- it fetches the platform release asset from GitHub - ;; (for the pinned 0.33.0 source this resolves to the matching v0.33.0 module). - ;; The compile-from-source fallback also works here: zig 0.15.2 is installed at - ;; /usr/local/bin/zig (see M-x ghostel-module-compile). - (ghostel-module-auto-install 'download) - ;; Byte analog of the prior 100000-line vterm setting (~100 bytes/line) -- D7. - (ghostel-max-scrollback (* 10 1024 1024))) - -;; ------------------------------- eat package --------------------------------- -;; EAT (pure-elisp terminal) backs the F12 toggle: its whole palette is real -;; Emacs faces, so it themes from the theme. ghostel stays for ai-term (M-SPC). -;; No tmux here -- F12's EAT runs a plain $SHELL (decision 2026-06-25). - -(use-package eat - :ensure t - :commands (eat) - :hook (eat-mode . cj/turn-off-chrome-for-term) - :custom - ;; Close the EAT buffer when its shell exits (mirrors ghostel-kill-buffer-on-exit). - (eat-kill-buffer-on-exit t) - :config - ;; F12 and C-; must reach Emacs from inside EAT. In semi-char mode (EAT's - ;; default) EAT forwards unbound keys to the terminal -- a letter runs - ;; `eat-self-input' -- so bind these explicitly or they never reach Emacs: - ;; F12 toggles the terminal window, C-; opens the global prefix map. - (keymap-set eat-semi-char-mode-map "<f12>" #'cj/term-toggle) - (keymap-set eat-semi-char-mode-map "C-;" cj/custom-keymap) - (keymap-set eat-mode-map "<f12>" #'cj/term-toggle) - (keymap-set eat-mode-map "C-;" cj/custom-keymap)) - -;; ----------------------- F12 toggle (custom) ----------------------- -;; -;; Mirrors the geometry-preservation pattern shared with ai-term.el: capture -;; direction + body size at toggle-off, replay them via a custom display action -;; using frame-edge directions and body-relative sizes so the result is -;; divider-independent and layout-stable. Manages the EAT terminal only; -;; ai-term.el's ghostel agent buffers are separate (M-SPC). - -(defcustom cj/term-toggle-window-height 0.7 - "Default fraction of frame height for the F12 terminal window. -Used as the size fallback when F12 docks the terminal as a bottom split." - :type 'number - :group 'term) - -(defcustom cj/term-toggle-window-width 0.5 - "Default fraction of frame width for the F12 terminal window. -Used as the size fallback when F12 docks the terminal as a right-side -column (see `cj/--term-toggle-default-direction')." - :type 'number - :group 'term) - -(defun cj/--term-toggle-default-direction () - "Return the default dock direction for the F12 terminal: `right' or `below'. -Docks as a right-side column only when a side-by-side split would leave -both panes at least `cj/window-dock-min-columns' wide (the terminal's -share is `cj/term-toggle-window-width'); otherwise stacks below. See -`cj/preferred-dock-direction'." - (cj/preferred-dock-direction (frame-width) cj/term-toggle-window-width)) - -(defun cj/--term-toggle-default-size (direction) - "Return the default size fraction paired with DIRECTION for the F12 terminal. -`cj/term-toggle-window-width' for `right', `cj/term-toggle-window-height' -otherwise." - (if (eq direction 'right) - cj/term-toggle-window-width - cj/term-toggle-window-height)) - -(defvar cj/--term-toggle-last-direction nil - "Last user-chosen direction for the F12 terminal display. -Symbol: right, left, or below. `above' is never stored. nil means use the -default `below' for F12's traditional bottom split.") - -(defvar cj/--term-toggle-last-size nil - "Last user-chosen size for the F12 terminal display. -Positive integer: body-cols (right/left) or total-lines (below/above) -- see -`cj/window-replay-size' for why the vertical axis uses total, not body. -nil means fall back to `cj/term-toggle-window-height' as a fraction.") - -(defun cj/--term-toggle-buffer-p (buffer) - "Return non-nil when BUFFER is the EAT terminal F12 should manage. - -Qualifies when BUFFER is alive and has `eat-mode' (or its name starts with the -EAT buffer-name prefix). ai-term's ghostel agent buffers never match -- they -are managed separately via M-SPC, not F12." - (and (bufferp buffer) - (buffer-live-p buffer) - (with-current-buffer buffer - (or (eq major-mode 'eat-mode) - (string-prefix-p (or (bound-and-true-p eat-buffer-name) - "*eat*") - (buffer-name buffer)))))) - -(defun cj/--term-toggle-buffers () - "Return live F12-managed terminal buffers in `buffer-list' (MRU) order." - (seq-filter #'cj/--term-toggle-buffer-p (buffer-list))) - -(defun cj/--term-toggle-displayed-window (&optional frame) - "Return a window in FRAME currently displaying an F12 terminal buffer, or nil. -FRAME defaults to the selected frame. Minibuffer is excluded." - (seq-find (lambda (w) - (cj/--term-toggle-buffer-p (window-buffer w))) - (window-list (or frame (selected-frame)) 'never))) - -(defun cj/--term-toggle-capture-state (window) - "Capture WINDOW's direction + body size into module-level state. -The default direction (used when WINDOW fills its frame) is the -column-rule choice from `cj/--term-toggle-default-direction'." - (cj/window-toggle-capture-state - window (cj/--term-toggle-default-direction) - 'cj/--term-toggle-last-direction - 'cj/--term-toggle-last-size - '(right below left))) - -(defun cj/--term-toggle-display-saved (buffer alist) - "Display-buffer action: split per saved direction and body size. -Delegates to `cj/window-toggle-display-saved' against the F12 state vars, -falling back to the column-rule default direction -\(`cj/--term-toggle-default-direction') and its paired size." - (let ((dir (cj/--term-toggle-default-direction))) - (cj/window-toggle-display-saved - buffer alist - 'cj/--term-toggle-last-direction dir - 'cj/--term-toggle-last-size (cj/--term-toggle-default-size dir)))) - -(defun cj/--term-toggle-display-rule-list () - "Return the `display-buffer-alist' entry list installed by F12. -Routes any terminal buffer satisfying `cj/--term-toggle-buffer-p' through -reuse-window then the saved-geometry action. Excludes agent buffers." - '(((lambda (buffer-or-name _) - (cj/--term-toggle-buffer-p (get-buffer buffer-or-name))) - (display-buffer-reuse-window - cj/--term-toggle-display-saved) - (inhibit-same-window . t)))) - -(dolist (entry (cj/--term-toggle-display-rule-list)) - (add-to-list 'display-buffer-alist entry)) - -(defun cj/--term-toggle-dispatch () - "Compute the F12 (`cj/term-toggle') action without performing it. - -Returns one of: -- (toggle-off . WINDOW) -- terminal displayed in WINDOW; hide it. -- (show-recent . BUFFER) -- terminal alive but not shown; redisplay. -- (create-new) -- no terminal buffer alive; create one." - (let ((win (cj/--term-toggle-displayed-window))) - (cond - (win (cons 'toggle-off win)) - (t - (let ((buffers (cj/--term-toggle-buffers))) - (cond - (buffers (cons 'show-recent (car buffers))) - (t '(create-new)))))))) - -(defun cj/term-toggle () - "Toggle the EAT terminal buffer. - -- If the EAT terminal is displayed in this frame, capture its geometry and - delete its window (toggle off). Falls back to burying when it is the only - window in the frame. -- Otherwise, if the EAT terminal buffer is alive, display it via the - saved-geometry action. -- Otherwise, create a new EAT terminal, displaying it through the same - saved-geometry action. - -ai-term's ghostel agent buffers are managed separately via M-SPC, not F12." - (interactive) - (pcase (cj/--term-toggle-dispatch) - (`(toggle-off . ,win) - (cj/--term-toggle-capture-state win) - (if (one-window-p) - (bury-buffer (window-buffer win)) - (delete-window win)) - nil) - (`(show-recent . ,buf) - (display-buffer buf) - (let ((w (get-buffer-window buf))) - (when w (select-window w))) - buf) - (`(create-new) - ;; Create the EAT buffer without stealing the layout, then display it - ;; through the saved-geometry dock rule (same path as show-recent). - (save-window-excursion (eat)) - (let ((buf (get-buffer (or (bound-and-true-p eat-buffer-name) "*eat*")))) - (when buf - (display-buffer buf) - (let ((w (get-buffer-window buf))) - (when w (select-window w)))) - buf)))) - -(keymap-global-set "<f12>" #'cj/term-toggle) - -;; ----------------------------- prefix menu ----------------------------------- - -(keymap-set cj/term-map "c" #'cj/term-copy-mode-dwim) -(keymap-set cj/term-map "h" #'cj/term-tmux-history) -(keymap-set cj/term-map "l" #'ghostel-clear-scrollback) -(keymap-set cj/term-map "N" #'ghostel) -(keymap-set cj/term-map "n" #'ghostel-next-prompt) -(keymap-set cj/term-map "p" #'ghostel-previous-prompt) -(keymap-set cj/term-map "q" #'ghostel-send-next-key) -(keymap-set cj/term-map "t" #'cj/term-toggle) - -(defun cj/term-send-C-SPC () - "Forward C-SPC (NUL) to the terminal instead of setting an Emacs mark. - -ghostel forwards the `C-@' event but not the distinct `C-SPC' event GUI -Emacs produces, so a bare C-SPC in a ghostel buffer falls through to the -global `set-mark-command'. That sets an Emacs region in the terminal buffer -that follows point as output streams (a stuck \"selection\" C-g / Escape -can't clear) and, worse, never reaches tmux -- so tmux copy-mode's -begin-selection (C-Space) never starts and M-w then copies nothing. -Forwarding NUL makes C-Space behave like a terminal key." - (interactive) - (ghostel-send-string "\C-@")) - -(defun cj/term-install-keys () - "Make `C-;' resolve as the personal keymap inside ghostel buffers, bind the -F12 toggle, forward C-SPC so it reaches the terminal (see -`cj/term-send-C-SPC'), and bind C-<up> to enter copy-mode and scroll up." - (when (boundp 'ghostel-mode-map) - (keymap-set ghostel-mode-map "C-;" cj/custom-keymap) - (keymap-set ghostel-mode-map "<f12>" #'cj/term-toggle) - (keymap-set ghostel-mode-map "C-SPC" #'cj/term-send-C-SPC) - (keymap-set ghostel-mode-map "C-<up>" #'cj/term-copy-mode-up))) - -(cj/term-install-keys) -(with-eval-after-load 'ghostel - (cj/term-install-keys)) - -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements - "C-; x" "terminal menu" - "C-; x c" "copy mode (tmux/ghostel)" - "C-; x h" "tmux scrollback history" - "C-; x l" "clear scrollback" - "C-; x N" "new terminal" - "C-; x n" "next prompt" - "C-; x p" "previous prompt" - "C-; x q" "send next key to terminal" - "C-; x t" "toggle terminal")) - -(provide 'term-config) -;;; term-config.el ends here. diff --git a/modules/test-runner.el b/modules/test-runner.el index 50d4f7e40..e05145e4e 100644 --- a/modules/test-runner.el +++ b/modules/test-runner.el @@ -6,74 +6,24 @@ ;; Layer: 2 (Core UX). ;; Category: C/L. ;; Load shape: eager. -;; Eager reason: the test keymap entry point and project-scoped runner state. -;; Top-level side effects: defines a test keymap, registers it under cj/custom-keymap. -;; Runtime requires: ert, cl-lib, keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Eager reason: registers the C-; t test runner entry point and state. +;; Top-level side effects: defines and registers cj/test-map. +;; Runtime requires: ert, cl-lib, keybindings, system-lib. +;; Direct test load: yes. ;; -;; This module provides a powerful ERT test runner with focus/unfocus workflow -;; for efficient test-driven development in Emacs Lisp projects. -;; -;; PURPOSE: -;; -;; When working on large Emacs Lisp projects with many test files, you often -;; want to focus on running just the tests relevant to your current work without -;; waiting for the entire suite to run. This module provides a smart test runner -;; that supports both running all tests and focusing on specific test files. -;; -;; WORKFLOW: -;; -;; 1. Run all tests initially to establish baseline (C-; t R) -;; 2. Add test files to focus while working on a feature (C-; t a) -;; 3. Run focused tests repeatedly as you develop (C-; t r) -;; 4. Add more test files as needed (C-; t b from within test buffer) -;; 5. View your focused test list at any time (C-; t v) -;; 6. Clear focus and run all tests before finishing (C-; t c, then C-; t R) -;; -;; PROJECT INTEGRATION: -;; -;; - Automatically discovers test directories in Projectile projects -;; (looks for "test" or "tests" under project root) -;; - Falls back to ~/.emacs.d/tests if not in a Projectile project -;; - Test files must match pattern: test-*.el -;; -;; SPECIAL BEHAVIORS: -;; -;; - Smart test running: Automatically runs all or focused tests based on mode -;; - Test extraction: Discovers test names via regex to run specific tests -;; - At-point execution: Run individual test at cursor position (C-; t .) -;; - Error handling: Continues loading tests even if individual files fail -;; -;; KEYBINDINGS: -;; -;; C-; t L Load all test files -;; C-; t R Run all tests (full suite) -;; C-; t r Run tests smartly (all or focused based on mode) -;; C-; t . Run test at point -;; C-; t a Add test file to focus (with completion) -;; C-; t b Add current buffer's test file to focus -;; C-; t c Clear all focused test files -;; C-; t v View list of focused test files -;; C-; t t Toggle mode between 'all and 'focused -;; -;; RECOMMENDED USAGE: -;; -;; While implementing a feature: -;; - Add the main test file for the feature you're working on -;; - Add any related test files that might be affected -;; - Use C-; t r to repeatedly run just those focused tests -;; - This provides fast feedback during development -;; -;; Before committing: -;; - Clear the focus with C-; t c -;; - Run the full suite with C-; t R to ensure nothing broke -;; - Verify all tests pass before pushing changes +;; Project-aware ERT runner with two modes: all tests or a focused file set. +;; Test roots come from Projectile projects, falling back to the config's tests +;; directory, and test files are discovered by the test-*.el convention. ;; +;; Commands under C-; t load tests, run all/focused tests, run the test at point, +;; and manage the per-project focus list. + ;;; Code: (require 'ert) (require 'cl-lib) (require 'keybindings) ;; provides cj/custom-keymap +(require 'system-lib) ;; completion table + file annotator ;;; External Variables and Functions @@ -260,7 +210,11 @@ Returns: \\='success if added successfully, :test #'string=)) (selected (if unfocused-files (completing-read "Add test file to focus: " - unfocused-files + (cj/completion-table-annotated + 'cj-test-file + (cj/completion-file-annotator + (lambda (c) (expand-file-name c dir))) + unfocused-files) nil t) (user-error "All test files are already focused")))) (pcase (cj/test--do-focus-add selected available-files focused-files) @@ -329,7 +283,13 @@ Returns: \\='success if removed successfully, (if (null focused-files) (user-error "No focused files to remove") (let ((selected (completing-read "Remove from focus: " - focused-files + (cj/completion-table-annotated + 'cj-test-file + (cj/completion-file-annotator + (lambda (c) + (expand-file-name + c (cj/test--get-test-directory)))) + focused-files) nil t))) (pcase (cj/test--do-focus-remove selected focused-files) ('success diff --git a/modules/text-config.el b/modules/text-config.el index 14e06f3e8..dd7bd3cac 100644 --- a/modules/text-config.el +++ b/modules/text-config.el @@ -1,4 +1,4 @@ -;;; text-config --- Text Settings and Functionality -*- lexical-binding: t; coding: utf-8; -*- +;;; text-config.el --- Text Settings and Functionality -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/tramp-config.el b/modules/tramp-config.el index e3b835f1f..f2bc8457c 100644 --- a/modules/tramp-config.el +++ b/modules/tramp-config.el @@ -57,7 +57,6 @@ (setq tramp-auto-save-directory (expand-file-name "tramp-auto-save" user-emacs-directory)) - ;; Create directory if it doesn't exist (unless (file-exists-p tramp-auto-save-directory) (make-directory tramp-auto-save-directory t)) diff --git a/modules/transcription-config.el b/modules/transcription-config.el index e00306d1e..944063b88 100644 --- a/modules/transcription-config.el +++ b/modules/transcription-config.el @@ -195,6 +195,8 @@ transcript lands alongside the source, not next to the temp /tmp audio." (txt-file (car outputs)) (log-file (cdr outputs)) (buffer-name (format " *transcribe-%s*" (file-name-nondirectory audio-file))) + (stderr-buffer-name (format " *transcribe-stderr-%s*" + (file-name-nondirectory audio-file))) (process-name (format "transcribe-%s" (file-name-nondirectory audio-file)))) (unless (file-executable-p script) @@ -203,15 +205,25 @@ transcript lands alongside the source, not next to the temp /tmp audio." (cj/--init-log-file log-file audio-file script) (let* ((process-environment (cj/--build-process-environment cj/transcribe-backend)) + ;; A live, explicitly-managed buffer for stderr. Passing a file PATH + ;; to :stderr makes Emacs create a phantom buffer named after the + ;; path, so the error text never reaches the log file and that buffer + ;; leaks per run; the sentinel drains this buffer into the log and + ;; kills it. Keeping stderr off the stdout :buffer leaves the + ;; transcript (stdout) clean. + (stderr-buffer (with-current-buffer (get-buffer-create stderr-buffer-name) + (erase-buffer) + (current-buffer))) (process (make-process :name process-name :buffer (get-buffer-create buffer-name) :command (list script audio-file) :sentinel (lambda (proc event) - (cj/--transcription-sentinel proc event audio-file txt-file log-file) + (cj/--transcription-sentinel proc event audio-file + txt-file log-file stderr-buffer) (when cleanup-file (ignore-errors (delete-file cleanup-file)))) - :stderr log-file))) + :stderr stderr-buffer))) (cj/--track-transcription process audio-file) (cj/--notify "Transcription" (format "Started on %s" (file-name-nondirectory audio-file))) @@ -294,20 +306,25 @@ References TXT-FILE on success (normal urgency), LOG-FILE on failure (format "Errored. Logs in %s" (file-name-nondirectory log-file)) 'critical))) -(defun cj/--transcription-sentinel (process event _audio-file txt-file log-file) +(defun cj/--transcription-sentinel (process event _audio-file txt-file log-file stderr-buffer) "Sentinel for transcription PROCESS. EVENT is the process event string. TXT-FILE and LOG-FILE are the -associated output files." +associated output files. STDERR-BUFFER holds the process's stderr; its +contents are appended to LOG-FILE so the \"Logs in <file>\" notification +points at real error text, and the buffer is then killed so it does not +leak per run." (let* ((success-p (and (string-match-p "finished" event) (= 0 (process-exit-status process)))) (process-buffer (process-buffer process))) (cj/--write-transcript-on-success process-buffer success-p txt-file) - (cj/--append-to-log process-buffer log-file event) + (cj/--append-to-log stderr-buffer log-file event) (cj/--update-transcription-status process success-p) (when (and success-p (not (cj/--should-keep-log success-p))) (delete-file log-file)) (when (buffer-live-p process-buffer) (kill-buffer process-buffer)) + (when (buffer-live-p stderr-buffer) + (kill-buffer stderr-buffer)) (cj/--notify-completion success-p txt-file log-file) (run-at-time 600 nil #'cj/--cleanup-completed-transcriptions) (force-mode-line-update t))) diff --git a/modules/ui-config.el b/modules/ui-config.el index 32bd393f5..fbc3d91c1 100644 --- a/modules/ui-config.el +++ b/modules/ui-config.el @@ -1,4 +1,4 @@ -;;; ui-config --- User Interface Preferences -*- lexical-binding: t; coding: utf-8; -*- +;;; ui-config.el --- User Interface Preferences -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: diff --git a/modules/ui-navigation.el b/modules/ui-navigation.el index cb0fc5697..7ec56e078 100644 --- a/modules/ui-navigation.el +++ b/modules/ui-navigation.el @@ -1,4 +1,4 @@ -;;; ui-navigation --- Managing Cursor Placement, Buffers, and Windows -*- lexical-binding: t; coding: utf-8; -*- +;;; ui-navigation.el --- Managing Cursor Placement, Buffers, and Windows -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -110,7 +110,9 @@ existing split does. No-op when SIDE is nil." (defun cj/window-resize-sticky () "Resize the active window's divider in the just-pressed arrow's direction \(via `windsize'), then keep `cj/window-resize-map' active so bare arrows keep -nudging until any other key. Bound to `C-; b <left>/<right>/<up>/<down>'. +nudging until any other key. Bound to `C-; b <arrow>' and to the global +`M-<arrow>' keys (each direction); the arrow is read with `event-basic-type', +so the Meta modifier on the M-<arrow> path is stripped and both behave alike. When the selected window is the sole window in the frame there is no divider to move, so the first arrow instead splits a sliver away on the @@ -119,13 +121,21 @@ buffer; the current window keeps almost the whole frame and the following arrows shrink it via `windsize', so it reads the same as resizing an existing split." (interactive) - (let ((key (key-description (vector last-command-event)))) + (let ((key (format "<%s>" (event-basic-type last-command-event)))) (if (one-window-p) (cj/window--pull-away (cj/window-pull-side key)) (let ((cmd (keymap-lookup cj/window-resize-map key))) (when cmd (call-interactively cmd))))) (set-transient-map cj/window-resize-map t)) +;; M-<arrow> mirrors `C-; b <arrow>': one chord to pull a split from a sole +;; window or nudge a divider. M-<up>/<down> are otherwise unbound; M-<left>/ +;; <right> shed their word-motion, which stays on `C-<left>'/`C-<right>'. +(keymap-global-set "M-<left>" #'cj/window-resize-sticky) +(keymap-global-set "M-<right>" #'cj/window-resize-sticky) +(keymap-global-set "M-<up>" #'cj/window-resize-sticky) +(keymap-global-set "M-<down>" #'cj/window-resize-sticky) + ;; ------------------------------ Window Splitting ----------------------------- (defun cj/split-and-follow-right () diff --git a/modules/ui-theme.el b/modules/ui-theme.el index eb4efd9b5..499e71a49 100644 --- a/modules/ui-theme.el +++ b/modules/ui-theme.el @@ -37,13 +37,17 @@ ;; ------------------------------- Switch Themes ------------------------------- ;; loads themes in completing read, then persists via the functions below +(require 'system-lib) + (defun cj/switch-themes () "Function to switch themes and save chosen theme name for persistence. Unloads any other applied themes before applying the chosen theme." (interactive) (let ((chosentheme (completing-read "Load custom theme: " - (mapcar #'symbol-name - (custom-available-themes))))) + (cj/completion-table + 'theme + (mapcar #'symbol-name + (custom-available-themes)))))) (cj/theme-disable-all) (cj/theme-load-name chosentheme)) (cj/save-theme-to-file)) diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el index fe43575e9..4780ef227 100644 --- a/modules/undead-buffers.el +++ b/modules/undead-buffers.el @@ -32,7 +32,13 @@ (defvar cj/undead-buffer-list '("*scratch*" "*EMMS-Playlist*" "*Messages*" "*ert*" "*AI-Assistant*") - "Buffers to bury instead of killing.") + "Buffer names to bury instead of killing (exact match).") + +(defvar cj/undead-buffer-regexps nil + "Regexps for buffer names to bury instead of killing, alongside +`cj/undead-buffer-list'. Use for dynamically-named buffer families where an +exact name can't be pre-listed -- e.g. ai-term agents, named \"agent [<project>]\". +Register one with `cj/make-buffer-pattern-undead'.") (defun cj/make-buffer-undead (name) "Append NAME to `cj/undead-buffer-list' if not present. @@ -41,6 +47,23 @@ Signal an error if NAME is not a non-empty string. Return the updated list." (error "cj/bury-alive-add: NAME must be a non-empty string")) (add-to-list 'cj/undead-buffer-list name t)) +(defun cj/make-buffer-pattern-undead (regexp) + "Append REGEXP to `cj/undead-buffer-regexps' if not present. +A buffer whose name matches REGEXP is buried instead of killed. Signal an +error if REGEXP is not a non-empty string. Return the updated list." + (unless (and (stringp regexp) (> (length regexp) 0)) + (error "cj/make-buffer-pattern-undead: REGEXP must be a non-empty string")) + (add-to-list 'cj/undead-buffer-regexps regexp t)) + +(defun cj/--buffer-undead-p (name) + "Return non-nil when buffer NAME should be buried instead of killed. +NAME is undead when it is in `cj/undead-buffer-list' (exact) or matches any +regexp in `cj/undead-buffer-regexps'." + (and (stringp name) + (or (member name cj/undead-buffer-list) + (seq-some (lambda (re) (string-match-p re name)) + cj/undead-buffer-regexps)))) + (defun cj/kill-buffer-or-bury-alive (buffer) "Kill BUFFER or bury it if it's in `cj/undead-buffer-list'." (interactive "bBuffer to kill or bury: ") @@ -49,7 +72,7 @@ Signal an error if NAME is not a non-empty string. Return the updated list." (progn (add-to-list 'cj/undead-buffer-list (buffer-name)) (message "Added %s to bury-alive-list" (buffer-name))) - (if (member (buffer-name) cj/undead-buffer-list) + (if (cj/--buffer-undead-p (buffer-name)) (bury-buffer) (kill-buffer))))) (keymap-global-set "<remap> <kill-buffer>" #'cj/kill-buffer-or-bury-alive) @@ -60,7 +83,7 @@ Undead-buffers are buffers in `cj/undead-buffer-list'." (let* ((buf (current-buffer)) (name (buffer-name buf))) (and - (not (member name cj/undead-buffer-list)) + (not (cj/--buffer-undead-p name)) (buffer-file-name buf) (buffer-modified-p buf)))) diff --git a/modules/vc-config.el b/modules/vc-config.el index fcca7e07b..60fcaeb89 100644 --- a/modules/vc-config.el +++ b/modules/vc-config.el @@ -8,7 +8,7 @@ ;; Eager reason: the C-x g Magit entry point and the git keymap. ;; Top-level side effects: defines two keymaps, registers under cj/custom-keymap, ;; package configuration via use-package. -;; Runtime requires: user-constants, keybindings. +;; Runtime requires: user-constants, keybindings, system-lib. ;; Direct test load: yes (requires keybindings explicitly). ;; ;; C-x g is my general entry to Magit's version control via the status page. @@ -26,6 +26,7 @@ (require 'user-constants) ;; provides code-dir (require 'keybindings) ;; provides cj/custom-keymap +(require 'system-lib) ;; completion table + file annotator ;; Forward declaration: cj/vc-map is defined later in this file (see ;; `defvar-keymap' below) but referenced earlier in a use-package :bind form. @@ -199,7 +200,13 @@ repository's README if found, else `dired's the clone." (read-directory-name "Clone to: " code-dir)) ;; C-u: Choose from configured list (current-prefix-arg - (completing-read "Clone to: " cj/git-clone-dirs nil t)) + (completing-read "Clone to: " + (cj/completion-table-annotated + 'cj-clone-dir + (cj/completion-file-annotator + (lambda (c) (expand-file-name c))) + cj/git-clone-dirs) + nil t)) ;; No prefix: Use default (first in list) (t (car cj/git-clone-dirs))))) diff --git a/modules/video-audio-recording-capture.el b/modules/video-audio-recording-capture.el new file mode 100644 index 000000000..069975bc3 --- /dev/null +++ b/modules/video-audio-recording-capture.el @@ -0,0 +1,394 @@ +;;; video-audio-recording-capture.el --- ffmpeg capture engine and process lifecycle -*- lexical-binding: t; coding: utf-8; -*- + +;; Author: Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 4 (Optional). +;; Category: O/S. +;; Load shape: library. +;; Top-level side effects: none (defuns only). +;; Runtime requires: subr-x, system-lib, video-audio-recording-devices. +;; Direct test load: yes (requires video-audio-recording-devices explicitly). +;; +;; Capture engine for video-audio-recording: ffmpeg / wf-recorder command +;; construction, the recording process lifecycle (sentinel, graceful +;; producer-first shutdown, exit polling), the modeline indicator, +;; dependency checks, device acquisition and validation, and the start/stop +;; entry points. Builds on the devices layer for discovery and selection. +;; +;; Configuration and the recording process-handle variables are owned by +;; the top video-audio-recording module; they are forward-declared here so +;; the engine reads and updates them without a back-require onto the top +;; module. + +;;; Code: + +(require 'subr-x) +(require 'system-lib) ;; provides cj/log-silently +(require 'video-audio-recording-devices) + +;; Configuration and process-handle state owned by the top module; +;; declared special here so the engine reads and updates them without a +;; back-require onto video-audio-recording.el. +(defvar cj/recording-mic-boost) +(defvar cj/recording-system-volume) +(defvar cj/recording-mic-device) +(defvar cj/recording-system-device) +(defvar cj/video-recording-ffmpeg-process) +(defvar cj/audio-recording-ffmpeg-process) + +;;; Modeline Indicator + +(defun cj/recording-modeline-indicator () + "Return modeline string showing active recordings. +Shows 🎤 (microphone) for audio, 🎬 (clapper board) for video. +Checks if process is actually alive, not just if variable is set." + (let ((audio-active (and cj/audio-recording-ffmpeg-process + (process-live-p cj/audio-recording-ffmpeg-process))) + (video-active (and cj/video-recording-ffmpeg-process + (process-live-p cj/video-recording-ffmpeg-process)))) + (cond + ((and audio-active video-active) " 🎤🎬 ") + (audio-active " 🎤 ") + (video-active " 🎬 ") + (t "")))) + +;;; Process Lifecycle (Sentinel and Graceful Shutdown) + +(defun cj/recording-process-sentinel (process event) + "Sentinel for recording processes — handles unexpected exits. +PROCESS is the ffmpeg shell process, EVENT describes what happened. +This is called by Emacs when the process changes state (exits, is +killed, etc.). It clears the process variable and updates the modeline +so the recording indicator disappears even if the recording crashes or +is killed externally." + (when (memq (process-status process) '(exit signal)) + (cond + ((eq process cj/audio-recording-ffmpeg-process) + (setq cj/audio-recording-ffmpeg-process nil) + (message "Audio recording stopped: %s" (string-trim event))) + ((eq process cj/video-recording-ffmpeg-process) + (setq cj/video-recording-ffmpeg-process nil) + (message "Video recording stopped: %s" (string-trim event)))) + (force-mode-line-update t))) + +(defun cj/recording--wait-for-exit (process timeout-secs) + "Wait for PROCESS to exit, polling until done or TIMEOUT-SECS elapsed. +Returns t if the process exited within the timeout, nil if it timed out. + +This replaces fixed `sit-for' delays with an actual check that ffmpeg has +finished writing its output file. Container finalization (writing index +tables, flushing buffers) can take several seconds for large recordings, +so a fixed 0.5s wait was causing zero-byte output files." + (let ((deadline (+ (float-time) timeout-secs))) + (while (and (process-live-p process) + (< (float-time) deadline)) + (accept-process-output process 0.1)) + (not (process-live-p process)))) + +;;; 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) + t) + +(defun cj/recording--wayland-p () + "Return non-nil if running under Wayland." + (string= (getenv "XDG_SESSION_TYPE") "wayland")) + +(defun cj/recording--check-wf-recorder () + "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)) + +;;; Device Acquisition and Validation + +(defun cj/recording-quick-setup () + "Quick device setup for recording — two-step mic + sink selection. +Step 1: Pick a microphone. Each mic shows its status: + [in use] = an app is actively using this mic + [ready] = recently used, still open + [available] = no app has this mic open + [muted] = device is muted in PulseAudio +Step 2: Pick an audio output to capture. Same status labels, plus +application names for outputs with active streams (e.g. \"Firefox\"). +Devices are sorted: in use → ready → available → muted. +The chosen output's .monitor source is set as the system audio device. + +This approach is portable across systems — plug in a new mic, run this +command, and it appears in the list. No hardware-specific configuration +needed." + (interactive) + (let* ((mic-entries (cj/recording--label-devices (cj/recording--get-available-mics)))) + (unless mic-entries + (user-error "No microphones found. Is a mic connected?")) + (let ((mic-device (cj/recording--select-from-labeled "Select microphone: " mic-entries)) + (sink-entries (cj/recording--label-sinks (cj/recording--get-available-sinks)))) + (let ((sink-device (cj/recording--select-from-labeled "Select audio output to capture: " sink-entries))) + (setq cj/recording-mic-device mic-device) + (setq cj/recording-system-device (concat sink-device ".monitor")) + (message "Recording ready!\n Mic: %s\n System audio: %s.monitor" + (car (rassoc mic-device mic-entries)) + (file-name-nondirectory sink-device)))))) + +(defun cj/recording-get-devices () + "Get audio devices, prompting user if not already configured. +Returns (mic-device . system-device) cons cell. +If devices aren't set, goes straight into quick setup (mic selection)." + (unless (and cj/recording-mic-device cj/recording-system-device) + (cj/recording-quick-setup)) + (unless (and cj/recording-mic-device cj/recording-system-device) + (user-error "Audio devices not configured. Run C-; r s (quick setup) or C-; r S (manual select)")) + (cj/recording--validate-system-audio) + (cons cj/recording-mic-device cj/recording-system-device)) + +(defun cj/recording--validate-system-audio () + "Validate that the configured system audio device will capture audio. +Checks two things: +1. Does the configured device still exist as a PulseAudio source? +2. Is anything currently playing through the monitored sink? + +Auto-fixes stale devices by falling back to the default sink's monitor. +Warns (but doesn't block) if no audio is currently playing. +Respects the user's explicit sink choice from quick-setup." + (when cj/recording-system-device + (let* ((sources-output (shell-command-to-string "pactl list sources short 2>/dev/null")) + (current-default (cj/recording--get-default-sink-monitor)) + (device-exists (cj/recording--source-exists-p + cj/recording-system-device sources-output))) + ;; Check 1: Device no longer exists — auto-update + (unless device-exists + (let ((old cj/recording-system-device)) + (setq cj/recording-system-device current-default) + (message "System audio device updated: %s → %s (old device no longer exists)" + old current-default))) + ;; Check 2: No active audio on the monitored sink — warn + (let* ((sink-name (if (string-suffix-p ".monitor" cj/recording-system-device) + (substring cj/recording-system-device 0 -8) + cj/recording-system-device)) + (sinks-output (shell-command-to-string "pactl list sinks short 2>/dev/null")) + (sink-index (cj/recording--get-sink-index sink-name sinks-output)) + (sink-inputs (shell-command-to-string "pactl list sink-inputs 2>/dev/null")) + (has-audio (and sink-index + (cj/recording--sink-has-active-audio-p sink-index sink-inputs)))) + (unless has-audio + (message "Warning: No audio connected to %s. Run C-; r s to check devices" + sink-name) + (cj/log-silently + (concat "No audio connected to %s. " + "Run C-; r s to see active streams and switch devices") + sink-name)))))) + +;;; ffmpeg Command Construction + +(defun cj/recording--build-video-command (mic-device system-device filename on-wayland) + "Build the shell command string for video recording. +MIC-DEVICE and SYSTEM-DEVICE are PulseAudio device names. +FILENAME is the output .mkv path. ON-WAYLAND selects the capture method. + +On Wayland: wf-recorder captures screen as H.264 in matroska container, +piped to ffmpeg which adds mic + system audio, then writes the final MKV. + +On X11: ffmpeg captures screen directly via x11grab with PulseAudio audio." + (if on-wayland + (progn + (cj/recording--check-wf-recorder) + (format (concat "wf-recorder -y -c libx264 -m matroska -f /dev/stdout 2>/dev/null | " + "ffmpeg -i pipe:0 " + "-f pulse -i %s " + "-f pulse -i %s " + "-filter_complex \"[1:a]volume=%.1f[mic];[2:a]volume=%.1f[sys];[mic][sys]amerge=inputs=2[out]\" " + "-map 0:v -map \"[out]\" " + "-c:v copy " + "%s") + (shell-quote-argument mic-device) + (shell-quote-argument system-device) + cj/recording-mic-boost + cj/recording-system-volume + (shell-quote-argument filename))) + (format (concat "ffmpeg -framerate 30 -f x11grab -i :0.0+ " + "-f pulse -i %s " + "-ac 1 " + "-f pulse -i %s " + "-ac 2 " + "-filter_complex \"[1:a]volume=%.1f[mic];[2:a]volume=%.1f[sys];[mic][sys]amerge=inputs=2[out]\" " + "-map 0:v -map \"[out]\" " + "%s") + (shell-quote-argument mic-device) + (shell-quote-argument system-device) + cj/recording-mic-boost + cj/recording-system-volume + (shell-quote-argument filename)))) + +(defun cj/recording--build-audio-command (mic-device system-device filename) + "Build the ffmpeg shell command string for audio-only recording. +MIC-DEVICE and SYSTEM-DEVICE are PulseAudio device names. FILENAME is +the output .m4a path. Mixes mic + system monitor into a single AAC file." + (format (concat "ffmpeg " + "-f pulse -i %s " ; Input 0: microphone + "-f pulse -i %s " ; Input 1: system audio monitor + "-filter_complex \"" + "[0:a]volume=%.1f[mic];" + "[1:a]volume=%.1f[sys];" + "[mic][sys]amix=inputs=2:duration=longest[out]\" " + "-map \"[out]\" " + "-c:a aac " + "-b:a 64k " + "%s") + (shell-quote-argument mic-device) + (shell-quote-argument system-device) + cj/recording-mic-boost + cj/recording-system-volume + (shell-quote-argument filename))) + +;;; Start Recording + +(defun cj/ffmpeg-record-video (directory) + "Start a video recording, saving output to DIRECTORY. +Uses wf-recorder on Wayland, x11grab on X11." + (cj/recording-check-ffmpeg) + (unless cj/video-recording-ffmpeg-process + ;; On Wayland, kill any orphan wf-recorder processes left over from + ;; previous crashes. Without this, old wf-recorders hold the compositor + ;; capture and new ones fail silently. This one stays a broad by-name + ;; kill on purpose: the orphans' launching shells are already dead, so + ;; there is no live PID to scope to. The stop path, by contrast, scopes + ;; to our own shell's child (see cj/recording--interrupt-child-wf-recorder). + (when (cj/recording--wayland-p) + (call-process "pkill" nil nil nil "-INT" "wf-recorder") + (sit-for 0.1)) + (let* ((devices (cj/recording-get-devices)) + (mic-device (car devices)) + (system-device (cdr devices)) + (location (expand-file-name directory)) + (name (format-time-string "%Y-%m-%d-%H-%M-%S")) + (filename (expand-file-name (concat name ".mkv") location)) + (on-wayland (cj/recording--wayland-p)) + (record-command (cj/recording--build-video-command + mic-device system-device filename on-wayland))) + (setq cj/video-recording-ffmpeg-process + (start-process-shell-command "ffmpeg-video-recording" + "*ffmpeg-video-recording*" + record-command)) + (set-process-query-on-exit-flag cj/video-recording-ffmpeg-process nil) + (set-process-sentinel cj/video-recording-ffmpeg-process #'cj/recording-process-sentinel) + (force-mode-line-update t) + (message "Started video recording to %s (%s, mic: %.1fx, system: %.1fx)." + filename + (if on-wayland "Wayland/wf-recorder" "X11") + cj/recording-mic-boost cj/recording-system-volume)))) + +(defun cj/ffmpeg-record-audio (directory) + "Start an audio recording, saving output to DIRECTORY. +Records from microphone and system audio monitor (configured device), +mixing them together into a single M4A/AAC file. + +The filter graph mixes two PulseAudio inputs: + [mic] → volume boost → amerge → AAC encoder → .m4a + [sys] → volume boost ↗" + (cj/recording-check-ffmpeg) + (unless cj/audio-recording-ffmpeg-process + (let* ((devices (cj/recording-get-devices)) + (mic-device (car devices)) + (system-device (cdr devices)) + (location (expand-file-name directory)) + (name (format-time-string "%Y-%m-%d-%H-%M-%S")) + (filename (expand-file-name (concat name ".m4a") location)) + (ffmpeg-command + (cj/recording--build-audio-command mic-device system-device filename))) + (message "Recording from mic: %s + ALL system outputs" mic-device) + (cj/log-silently "Audio recording ffmpeg command: %s" ffmpeg-command) + (setq cj/audio-recording-ffmpeg-process + (start-process-shell-command "ffmpeg-audio-recording" + "*ffmpeg-audio-recording*" + ffmpeg-command)) + (set-process-query-on-exit-flag cj/audio-recording-ffmpeg-process nil) + (set-process-sentinel cj/audio-recording-ffmpeg-process #'cj/recording-process-sentinel) + (force-mode-line-update t) + (message "Started recording to %s (mic: %.1fx, all system audio: %.1fx)" + filename cj/recording-mic-boost cj/recording-system-volume)))) + +;;; Stop Recording + +(defun cj/recording--interrupt-child-wf-recorder (shell-pid) + "Send SIGINT to the wf-recorder child of SHELL-PID, if any. +Scopes the producer-first stop to the wf-recorder this module launched +\(a child of our recording shell) via `pkill -P', instead of killing +every wf-recorder on the system by name. Does nothing when SHELL-PID +is nil (the shell already exited, so there is no child to signal)." + (when shell-pid + (call-process "pkill" nil nil nil + "-INT" "-P" (number-to-string shell-pid) "wf-recorder"))) + +(defun cj/video-recording-stop () + "Stop the video recording, waiting for ffmpeg to finalize the file. +On Wayland, kills wf-recorder first so ffmpeg gets a clean EOF on its +video input pipe, then signals the process group. Waits up to 5 seconds +for ffmpeg to write container metadata before giving up." + (interactive) + (if (not cj/video-recording-ffmpeg-process) + (message "No video recording in progress.") + (let ((proc cj/video-recording-ffmpeg-process)) + ;; On Wayland, kill the producer (wf-recorder) FIRST so ffmpeg sees + ;; a clean EOF on pipe:0. This triggers ffmpeg's orderly shutdown: + ;; drain remaining frames, write container metadata, close file. + ;; Without this, simultaneous SIGINT to both causes ffmpeg to abort + ;; without creating a file. + (when (cj/recording--wayland-p) + (cj/recording--interrupt-child-wf-recorder (process-id proc)) + (sit-for 0.3)) ; Brief pause for pipe to close + ;; Now send SIGINT to the process group. On Wayland, this reaches + ;; ffmpeg (which is already shutting down from the pipe EOF) and + ;; reinforces the stop. On X11, this is the primary shutdown signal. + (let ((pid (process-id proc))) + (when pid + (signal-process (- pid) 2))) ; 2 = SIGINT + ;; Wait for ffmpeg to finalize the container. MKV files need index + ;; tables written at the end — without this wait, the file is truncated. + (let ((exited (cj/recording--wait-for-exit proc 5))) + (unless exited + (message "Warning: recording process did not exit within 5 seconds"))) + ;; Safety net: signal our own straggler wf-recorder on Wayland. + ;; If the shell already exited, process-id returns nil and this is + ;; a no-op (the child is already gone with it). + (when (cj/recording--wayland-p) + (cj/recording--interrupt-child-wf-recorder (process-id proc))) + ;; The sentinel handles clearing cj/video-recording-ffmpeg-process + ;; and updating the modeline. If the process already exited during + ;; our wait, the sentinel has already fired. If not, force cleanup. + (when (eq cj/video-recording-ffmpeg-process proc) + (setq cj/video-recording-ffmpeg-process nil) + (force-mode-line-update t)) + (message "Stopped video recording.")))) + +(defun cj/audio-recording-stop () + "Stop the audio recording, waiting for ffmpeg to finalize the file. +Sends SIGINT to the process group and waits up to 3 seconds for ffmpeg +to flush audio frames and write the M4A container trailer." + (interactive) + (if (not cj/audio-recording-ffmpeg-process) + (message "No audio recording in progress.") + (let ((proc cj/audio-recording-ffmpeg-process)) + ;; Send SIGINT to the process group (see video-recording-stop for details) + (let ((pid (process-id proc))) + (when pid + (signal-process (- pid) 2))) + ;; M4A finalization is faster than MKV, but still needs time to write + ;; the AAC trailer and flush the output buffer. + (let ((exited (cj/recording--wait-for-exit proc 3))) + (unless exited + (message "Warning: recording process did not exit within 3 seconds"))) + ;; Fallback cleanup if sentinel hasn't fired yet + (when (eq cj/audio-recording-ffmpeg-process proc) + (setq cj/audio-recording-ffmpeg-process nil) + (force-mode-line-update t)) + (message "Stopped audio recording.")))) + +(provide 'video-audio-recording-capture) +;;; video-audio-recording-capture.el ends here diff --git a/modules/video-audio-recording-devices.el b/modules/video-audio-recording-devices.el new file mode 100644 index 000000000..375a81cf9 --- /dev/null +++ b/modules/video-audio-recording-devices.el @@ -0,0 +1,344 @@ +;;; video-audio-recording-devices.el --- PulseAudio device discovery for recording -*- lexical-binding: t; coding: utf-8; -*- + +;; Author: Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 4 (Optional). +;; Category: D. +;; Load shape: library. +;; Top-level side effects: none (defuns only). +;; Runtime requires: subr-x, seq. +;; Direct test load: yes. +;; +;; Base layer of video-audio-recording: PulseAudio source and sink +;; discovery, the pactl output parsers, device labeling and sort/status +;; helpers for completing-read, and the lookup predicates used to validate +;; a configured device. Pure string and shell-query helpers with no +;; dependency on recording state, configuration, or the capture engine, so +;; the engine and command layers build on it. + +;;; Code: + +(require 'subr-x) +(require 'seq) + +;;; PulseAudio Source/Sink Parsing + +(defun cj/recording--parse-pactl-output (output) + "Parse pactl sources OUTPUT into structured list. +Returns list of (device-name driver state) tuples. +Extracted as a separate function for testability." + (let ((sources nil)) + (dolist (line (split-string output "\n" t)) + (when (string-match "^[0-9]+\t\\([^\t]+\\)\t\\([^\t]+\\)\t\\([^\t]+\\)\t\\([^\t]+\\)" line) + (let ((device (match-string 1 line)) + (driver (match-string 2 line)) + (state (match-string 4 line))) + (push (list device driver state) sources)))) + (nreverse sources))) + +(defun cj/recording-parse-sources () + "Parse pactl sources output into structured list. +Returns list of (device-name driver state) tuples." + (cj/recording--parse-pactl-output + (shell-command-to-string "pactl list sources short 2>/dev/null"))) + +(defun cj/recording-friendly-state (state) + "Convert technical STATE name to user-friendly label. +STATE is the raw state from pactl (SUSPENDED, RUNNING, IDLE, etc.)." + (pcase state + ("SUSPENDED" "Ready") + ("RUNNING" "Active") + ("IDLE" "Ready") + (_ state))) + +(defun cj/recording--get-default-sink-monitor () + "Return the PulseAudio monitor source for the default audio output. +The monitor source captures whatever is playing through the default sink +(music, calls, system sounds, etc.). This is the correct device +for capturing \"what I hear\" regardless of which output hardware is active." + (let ((default-sink (string-trim + (shell-command-to-string + "pactl get-default-sink 2>/dev/null")))) + (if (string-empty-p default-sink) + (user-error "No default audio output found. Is PulseAudio/PipeWire running?") + (concat default-sink ".monitor")))) + +(defun cj/recording--parse-pactl-verbose (output record-type) + "Parse verbose pactl OUTPUT into structured list. +RECORD-TYPE is \"Source\" or \"Sink\" — the record header in pactl output. +Returns list of (name description mute state) tuples." + (let ((entries nil) + (header-re (concat "^" record-type " #")) + (current-name nil) + (current-desc nil) + (current-mute nil) + (current-state nil)) + (dolist (line (split-string output "\n")) + (cond + ((string-match-p header-re line) + (when current-name + (push (list current-name current-desc current-mute current-state) + entries)) + (setq current-name nil current-desc nil + current-mute nil current-state nil)) + ((string-match "^\\s-+Name:\\s-+\\(.+\\)" line) + (setq current-name (match-string 1 line))) + ((string-match "^\\s-+Description:\\s-+\\(.+\\)" line) + (setq current-desc (match-string 1 line))) + ((string-match "^\\s-+Mute:\\s-+\\(.+\\)" line) + (setq current-mute (match-string 1 line))) + ((string-match "^\\s-+State:\\s-+\\(.+\\)" line) + (setq current-state (match-string 1 line))))) + (when current-name + (push (list current-name current-desc current-mute current-state) + entries)) + (nreverse entries))) + +(defun cj/recording--get-available-mics () + "Return available microphone sources as list of (name description state mute). +Filters out monitor sources but includes muted devices (shown with +a [muted] label in the UI). Uses the friendly description from +PulseAudio (e.g. \"Jabra SPEAK 510 Mono\") rather than the raw +device name. State is the PulseAudio state string (RUNNING, IDLE, +or SUSPENDED). Mute is \"yes\" or \"no\"." + (let* ((output (shell-command-to-string "pactl list sources 2>/dev/null")) + (sources (cj/recording--parse-pactl-verbose output "Source")) + (mics nil)) + (dolist (source sources) + (let ((name (nth 0 source)) + (desc (nth 1 source)) + (mute (nth 2 source)) + (state (nth 3 source))) + (when (not (string-match-p "\\.monitor$" name)) + (push (list name (or desc name) state mute) mics)))) + (nreverse mics))) + +(defun cj/recording--get-available-sinks () + "Return available audio sinks as list of (name description state mute). +Includes muted sinks (shown with a [muted] label in the UI). Uses +the friendly description from PulseAudio (e.g. \"JDS Labs Element IV +Analog Stereo\"). State is the PulseAudio state string (RUNNING, +IDLE, or SUSPENDED). Mute is \"yes\" or \"no\"." + (let* ((output (shell-command-to-string "pactl list sinks 2>/dev/null")) + (sinks (cj/recording--parse-pactl-verbose output "Sink")) + (result nil)) + (dolist (sink sinks) + (let ((name (nth 0 sink)) + (desc (nth 1 sink)) + (mute (nth 2 sink)) + (state (nth 3 sink))) + (push (list name (or desc name) state mute) result))) + (nreverse result))) + +(defun cj/recording--get-sink-apps () + "Return alist mapping sink index to list of application names. +Parses `pactl list sink-inputs' to find which apps are playing +audio through each sink." + (let ((output (shell-command-to-string "pactl list sink-inputs 2>/dev/null")) + (apps (make-hash-table :test 'equal)) + (current-sink nil)) + (dolist (line (split-string output "\n")) + (cond + ((string-match "^Sink Input #" line) + (setq current-sink nil)) + ((string-match "^[ \t]+Sink:[ \t]+\\([0-9]+\\)" line) + (setq current-sink (match-string 1 line))) + ((and current-sink + (string-match "application\\.name = \"\\([^\"]+\\)\"" line)) + (let ((existing (gethash current-sink apps))) + (unless (member (match-string 1 line) existing) + (puthash current-sink + (append existing (list (match-string 1 line))) + apps)))))) + ;; Convert hash to alist + (let ((result nil)) + (maphash (lambda (k v) (push (cons k v) result)) apps) + result))) + +;;; Device Lookups + +(defun cj/recording--get-sink-index (sink-name sinks-output) + "Return the numeric index of SINK-NAME from SINKS-OUTPUT. +SINKS-OUTPUT should be the output of `pactl list sinks short'. +Returns the index as a string, or nil if not found." + (let ((index nil)) + (dolist (line (split-string sinks-output "\n" t)) + (when (string-match "^\\([0-9]+\\)\t\\([^\t]+\\)\t" line) + (when (equal sink-name (match-string 2 line)) + (setq index (match-string 1 line))))) + index)) + +(defun cj/recording--source-exists-p (source-name pactl-output) + "Return non-nil if SOURCE-NAME exists in PACTL-OUTPUT. +PACTL-OUTPUT should be the output of `pactl list sources short'." + (let ((found nil)) + (dolist (line (split-string pactl-output "\n" t)) + (when (string-match "^[0-9]+\t\\([^\t]+\\)\t" line) + (when (equal source-name (match-string 1 line)) + (setq found t)))) + found)) + +(defun cj/recording--sink-has-active-audio-p (sink-index pactl-output) + "Return non-nil if SINK-INDEX has active audio streams. +PACTL-OUTPUT should be the output of `pactl list sink-inputs'. +SINK-INDEX is the numeric sink index as a string." + (let ((found nil) + (lines (split-string pactl-output "\n"))) + (dolist (line lines) + (when (string-match "^[ \t]+Sink:[ \t]+\\([0-9]+\\)" line) + (when (equal sink-index (match-string 1 line)) + (setq found t)))) + found)) + +;;; Device Labeling and Selection Primitives + +(defun cj/recording--device-sort-key (state muted) + "Return a numeric sort key for a device with STATE and MUTED flag. +Lower values sort first: RUNNING (0) → IDLE (1) → SUSPENDED (2) → muted (3)." + (if (equal muted "yes") + 3 + (pcase (upcase (or state "")) + ("RUNNING" 0) + ("IDLE" 1) + (_ 2)))) + +(defun cj/recording--device-status-label (state muted) + "Return a human-readable status label for a device. +MUTED is \"yes\" or \"no\". STATE is the PulseAudio state string." + (if (equal muted "yes") + "[muted]" + (pcase (upcase (or state "")) + ("RUNNING" "[in use]") + ("IDLE" "[ready]") + (_ "[available]")))) + +(defun cj/recording--label-devices (devices) + "Build labeled (label . name) alist from DEVICES for `completing-read'. +DEVICES is a list of (name description state mute) as returned by +`cj/recording--get-available-mics' or `cj/recording--get-available-sinks'. +Labels are formatted as \"Description [in use]\" etc. +Sorted: in use → ready → available → muted." + (let* ((labeled (mapcar + (lambda (dev) + (let* ((name (nth 0 dev)) + (desc (nth 1 dev)) + (state (nth 2 dev)) + (muted (nth 3 dev)) + (label (concat desc " " + (cj/recording--device-status-label state muted)))) + (list label name (cj/recording--device-sort-key state muted)))) + devices)) + (sorted (sort labeled (lambda (a b) (< (nth 2 a) (nth 2 b)))))) + (mapcar (lambda (entry) (cons (nth 0 entry) (nth 1 entry))) sorted))) + +(defun cj/recording--label-sinks (sinks) + "Build labeled (label . name) alist from SINKS for `completing-read'. +Like `cj/recording--label-devices' but also appends application names +for sinks with active audio streams. E.g. \"JDS Labs [in use] (Firefox)\"." + (let* ((sink-apps (cj/recording--get-sink-apps)) + (sinks-short (shell-command-to-string "pactl list sinks short 2>/dev/null")) + (labeled + (mapcar + (lambda (dev) + (let* ((name (nth 0 dev)) + (desc (nth 1 dev)) + (state (nth 2 dev)) + (muted (nth 3 dev)) + (index (cj/recording--get-sink-index name sinks-short)) + (apps (and index (cdr (assoc index sink-apps)))) + (status (cj/recording--device-status-label state muted)) + (app-str (if apps (concat " (" (string-join apps ", ") ")") "")) + (label (concat desc " " status app-str))) + (list label name (cj/recording--device-sort-key state muted)))) + sinks)) + (sorted (sort labeled (lambda (a b) (< (nth 2 a) (nth 2 b)))))) + (mapcar (lambda (entry) (cons (nth 0 entry) (nth 1 entry))) sorted))) + +(defun cj/recording--select-from-labeled (prompt entries) + "Prompt user with PROMPT to select from labeled ENTRIES. +ENTRIES is an alist of (label . device-name). Appends a Cancel option. +Returns the selected device name, or signals user-error if cancelled." + (let* ((alist (append entries '(("Cancel" . nil)))) + (choice (completing-read prompt + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (display-sort-function . identity)) + (complete-with-action action alist string pred))) + nil t)) + (device (cdr (assoc choice alist)))) + (unless device + (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. +Monitor devices end in .monitor (they tap system audio output). +Returns selected device name or nil." + (let* ((sources (cj/recording-parse-sources)) + (filtered (if (eq device-type 'monitor) + (seq-filter (lambda (s) (string-match-p "\\.monitor$" (car s))) sources) + (seq-filter (lambda (s) (not (string-match-p "\\.monitor$" (car s)))) sources))) + (choices (mapcar (lambda (s) + (let ((device (nth 0 s)) + (_driver (nth 1 s)) + (_state (nth 2 s)) + (friendly-state (cj/recording-friendly-state (nth 2 s)))) + (cons (format "%-10s %s" friendly-state device) device))) + filtered))) + (if choices + (cdr (assoc (completing-read prompt choices nil t) choices)) + (user-error "No %s devices found" (if (eq device-type 'monitor) "monitor" "input"))))) + +(provide 'video-audio-recording-devices) +;;; video-audio-recording-devices.el ends here diff --git a/modules/video-audio-recording.el b/modules/video-audio-recording.el index 1672529f7..10c108541 100644 --- a/modules/video-audio-recording.el +++ b/modules/video-audio-recording.el @@ -6,108 +6,29 @@ ;; Layer: 4 (Optional). ;; Category: O/D/S. ;; Load shape: eager. -;; Eager reason: none; registers a recording keymap, but device probing should -;; run only on command (command-loaded target). -;; Top-level side effects: defines cj/record-map and conditionally registers it -;; under C-; r. -;; Runtime requires: system-lib, keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Eager reason: none; records only on command, but registers C-; r at load. +;; Top-level side effects: defines cj/record-map and registers it when possible. +;; Runtime requires: system-lib, keybindings, video-audio-recording-devices, +;; video-audio-recording-capture. +;; Direct test load: yes. ;; -;; Desktop video and audio recording from within Emacs using ffmpeg. -;; Records from both microphone and system audio simultaneously, which -;; makes it suitable for capturing meetings, presentations, and desktop activity. -;; -;; Architecture: -;; - Audio recordings use ffmpeg directly with PulseAudio inputs → M4A/AAC -;; - Video recordings differ by display server: -;; - X11: ffmpeg with x11grab + PulseAudio → MKV -;; - Wayland: wf-recorder piped to ffmpeg for audio mixing → MKV -;; (wf-recorder captures the compositor, ffmpeg mixes in audio) -;; -;; Process lifecycle: -;; - Start: `start-process-shell-command` creates a shell running the -;; ffmpeg (or wf-recorder|ffmpeg) pipeline. Process ref is stored in -;; `cj/video-recording-ffmpeg-process' or `cj/audio-recording-ffmpeg-process'. -;; - Stop: SIGINT is sent to the shell's process group so all pipeline -;; children (wf-recorder, ffmpeg) receive it. We then poll until the -;; process actually exits, giving ffmpeg time to finalize the container. -;; - Cleanup: A process sentinel auto-clears the process variable and -;; updates the modeline if the process dies unexpectedly. -;; -;; Note: video-recordings-dir and audio-recordings-dir are defined -;; (and directory created) in user-constants.el -;; -;; Quick Start -;; =========== -;; 1. Press C-; r s to run quick setup -;; 2. Pick a microphone from the list -;; 3. Pick an audio output — [in use] shows which apps are playing -;; 4. Press C-; r a to start/stop audio recording -;; 5. Recording starts - you'll see in your modeline -;; 6. Press C-; r a again to stop (🔴 disappears) -;; -;; Device Setup -;; ============ -;; C-; r a automatically prompts for device selection on first use. -;; Device selection lasts for the current Emacs session only. -;; -;; Manual device selection: -;; -;; C-; r s (cj/recording-quick-setup) - RECOMMENDED -;; Two-step setup: pick a mic, then pick an audio output to capture. -;; Both steps show status: [in use], [ready], [available], [muted]. -;; Audio outputs also show which apps are playing through them. -;; Sorted: in use → ready → available → muted. -;; -;; C-; r S (cj/recording-select-devices) - ADVANCED -;; Manual selection: choose mic and monitor separately. -;; Use when you need different devices for input/output. -;; -;; C-; r d (cj/recording-list-devices) -;; List all available audio devices and current configuration. -;; -;; C-; r w (cj/recording-show-active-audio) - DIAGNOSTIC TOOL -;; Show which apps are currently playing audio and through which device. -;; Use this DURING a phone call to see if the call audio is going through -;; the device you think it is. Helps diagnose "missing one side" issues. -;; -;; Pre-Recording Validation -;; ======================== -;; Every time you start a recording, the system audio device is -;; validated automatically: -;; 1. If the configured monitor device no longer exists (e.g. -;; USB DAC unplugged), it's auto-updated to the current -;; default sink's monitor. -;; 2. If no audio is currently playing through the monitored sink, -;; a warning is shown in the echo area. Recording proceeds -;; without interruption — run C-; r s to see active streams. -;; -;; Testing Devices Before Important Recordings -;; ============================================ -;; Always test devices before important recordings: -;; -;; C-; r t b (cj/recording-test-both) - RECOMMENDED -;; Guided test: mic only, monitor only, then both together. -;; Catches hardware issues before they ruin recordings! -;; -;; C-; r t m (cj/recording-test-mic) -;; Quick 5-second mic test with playback. -;; -;; C-; r t s (cj/recording-test-monitor) -;; Quick 5-second system audio test with playback. -;; -;; To adjust volumes: -;; - Use =M-x cj/recording-adjust-volumes= (or your keybinding =r l=) -;; - Or customize permanently: =M-x customize-group RET cj-recording RET= -;; - Or in your config: -;; #+begin_src emacs-lisp -;; (setq cj/recording-mic-boost 1.5) ; 50% louder -;; (setq cj/recording-system-volume 0.7) ; 30% quieter +;; Starts and stops ffmpeg-backed audio/video recordings from Emacs. Audio +;; captures microphone plus system monitor; video uses x11grab on X11 and +;; wf-recorder piped into ffmpeg on Wayland. ;; +;; This is the public face of the module: it owns configuration and the +;; recording process-handle state, the device-diagnostic and device-test +;; commands, the toggle commands, and the C-; r keymap. PulseAudio +;; discovery lives in video-audio-recording-devices and the ffmpeg capture +;; engine in video-audio-recording-capture, both required here. Every +;; public name is unchanged so existing callers and tests keep working. + ;;; Code: (require 'system-lib) (require 'keybindings) ;; provides cj/custom-keymap +(require 'video-audio-recording-devices) +(require 'video-audio-recording-capture) ;;; ============================================================ ;;; Configuration Variables @@ -141,7 +62,8 @@ If nil, will auto-detect on first use.") ;; These hold the Emacs process objects for running recordings. ;; The process is the shell that runs the ffmpeg (or wf-recorder|ffmpeg) -;; pipeline. When non-nil, a recording is in progress. +;; pipeline. When non-nil, a recording is in progress. The capture engine +;; reads and clears them; the toggle commands below read them. (defvar cj/video-recording-ffmpeg-process nil "Emacs process object for the active video recording shell, or nil.") @@ -150,204 +72,7 @@ If nil, will auto-detect on first use.") "Emacs process object for the active audio recording shell, or nil.") ;;; ============================================================ -;;; Modeline Indicator -;;; ============================================================ - -(defun cj/recording-modeline-indicator () - "Return modeline string showing active recordings. -Shows 🎤 (microphone) for audio, 🎬 (clapper board) for video. -Checks if process is actually alive, not just if variable is set." - (let ((audio-active (and cj/audio-recording-ffmpeg-process - (process-live-p cj/audio-recording-ffmpeg-process))) - (video-active (and cj/video-recording-ffmpeg-process - (process-live-p cj/video-recording-ffmpeg-process)))) - (cond - ((and audio-active video-active) " 🎤🎬 ") - (audio-active " 🎤 ") - (video-active " 🎬 ") - (t "")))) - -;;; ============================================================ -;;; Process Lifecycle (Sentinel and Graceful Shutdown) -;;; ============================================================ - -(defun cj/recording-process-sentinel (process event) - "Sentinel for recording processes — handles unexpected exits. -PROCESS is the ffmpeg shell process, EVENT describes what happened. -This is called by Emacs when the process changes state (exits, is -killed, etc.). It clears the process variable and updates the modeline -so the recording indicator disappears even if the recording crashes or -is killed externally." - (when (memq (process-status process) '(exit signal)) - (cond - ((eq process cj/audio-recording-ffmpeg-process) - (setq cj/audio-recording-ffmpeg-process nil) - (message "Audio recording stopped: %s" (string-trim event))) - ((eq process cj/video-recording-ffmpeg-process) - (setq cj/video-recording-ffmpeg-process nil) - (message "Video recording stopped: %s" (string-trim event)))) - (force-mode-line-update t))) - -(defun cj/recording--wait-for-exit (process timeout-secs) - "Wait for PROCESS to exit, polling until done or TIMEOUT-SECS elapsed. -Returns t if the process exited within the timeout, nil if it timed out. - -This replaces fixed `sit-for' delays with an actual check that ffmpeg has -finished writing its output file. Container finalization (writing index -tables, flushing buffers) can take several seconds for large recordings, -so a fixed 0.5s wait was causing zero-byte output files." - (let ((deadline (+ (float-time) timeout-secs))) - (while (and (process-live-p process) - (< (float-time) deadline)) - (accept-process-output process 0.1)) - (not (process-live-p process)))) - -;;; ============================================================ -;;; 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) - t) - -(defun cj/recording--wayland-p () - "Return non-nil if running under Wayland." - (string= (getenv "XDG_SESSION_TYPE") "wayland")) - -(defun cj/recording--check-wf-recorder () - "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)) - -;;; ============================================================ -;;; PulseAudio Device Discovery -;;; ============================================================ -;; -;; Audio devices are discovered via `pactl list sources short'. -;; Two types of sources matter: -;; - Input sources (microphones): capture your voice -;; - Monitor sources (*.monitor): capture system audio output -;; These tap into what's playing through speakers/headphones, -;; which is how we capture system audio (music, calls, etc.). -;; -;; Device selection is required before first recording. The quick -;; setup (C-; r s) groups hardware devices and lets you pick one -;; device to use for both mic and monitor — ideal for headsets. - -(defun cj/recording--parse-pactl-output (output) - "Parse pactl sources OUTPUT into structured list. -Returns list of (device-name driver state) tuples. -Extracted as a separate function for testability." - (let ((sources nil)) - (dolist (line (split-string output "\n" t)) - (when (string-match "^[0-9]+\t\\([^\t]+\\)\t\\([^\t]+\\)\t\\([^\t]+\\)\t\\([^\t]+\\)" line) - (let ((device (match-string 1 line)) - (driver (match-string 2 line)) - (state (match-string 4 line))) - (push (list device driver state) sources)))) - (nreverse sources))) - -(defun cj/recording-parse-sources () - "Parse pactl sources output into structured list. -Returns list of (device-name driver state) tuples." - (cj/recording--parse-pactl-output - (shell-command-to-string "pactl list sources short 2>/dev/null"))) - -(defun cj/recording-friendly-state (state) - "Convert technical STATE name to user-friendly label. -STATE is the raw state from pactl (SUSPENDED, RUNNING, IDLE, etc.)." - (pcase state - ("SUSPENDED" "Ready") - ("RUNNING" "Active") - ("IDLE" "Ready") - (_ state))) - -(defun cj/recording--get-default-sink-monitor () - "Return the PulseAudio monitor source for the default audio output. -The monitor source captures whatever is playing through the default sink -(music, calls, system sounds, etc.). This is the correct device -for capturing \"what I hear\" regardless of which output hardware is active." - (let ((default-sink (string-trim - (shell-command-to-string - "pactl get-default-sink 2>/dev/null")))) - (if (string-empty-p default-sink) - (user-error "No default audio output found. Is PulseAudio/PipeWire running?") - (concat default-sink ".monitor")))) - -(defun cj/recording--parse-pactl-verbose (output record-type) - "Parse verbose pactl OUTPUT into structured list. -RECORD-TYPE is \"Source\" or \"Sink\" — the record header in pactl output. -Returns list of (name description mute state) tuples." - (let ((entries nil) - (header-re (concat "^" record-type " #")) - (current-name nil) - (current-desc nil) - (current-mute nil) - (current-state nil)) - (dolist (line (split-string output "\n")) - (cond - ((string-match-p header-re line) - (when current-name - (push (list current-name current-desc current-mute current-state) - entries)) - (setq current-name nil current-desc nil - current-mute nil current-state nil)) - ((string-match "^\\s-+Name:\\s-+\\(.+\\)" line) - (setq current-name (match-string 1 line))) - ((string-match "^\\s-+Description:\\s-+\\(.+\\)" line) - (setq current-desc (match-string 1 line))) - ((string-match "^\\s-+Mute:\\s-+\\(.+\\)" line) - (setq current-mute (match-string 1 line))) - ((string-match "^\\s-+State:\\s-+\\(.+\\)" line) - (setq current-state (match-string 1 line))))) - (when current-name - (push (list current-name current-desc current-mute current-state) - entries)) - (nreverse entries))) - -(defun cj/recording--get-available-mics () - "Return available microphone sources as list of (name description state mute). -Filters out monitor sources but includes muted devices (shown with -a [muted] label in the UI). Uses the friendly description from -PulseAudio (e.g. \"Jabra SPEAK 510 Mono\") rather than the raw -device name. State is the PulseAudio state string (RUNNING, IDLE, -or SUSPENDED). Mute is \"yes\" or \"no\"." - (let* ((output (shell-command-to-string "pactl list sources 2>/dev/null")) - (sources (cj/recording--parse-pactl-verbose output "Source")) - (mics nil)) - (dolist (source sources) - (let ((name (nth 0 source)) - (desc (nth 1 source)) - (mute (nth 2 source)) - (state (nth 3 source))) - (when (not (string-match-p "\\.monitor$" name)) - (push (list name (or desc name) state mute) mics)))) - (nreverse mics))) - -(defun cj/recording--get-available-sinks () - "Return available audio sinks as list of (name description state mute). -Includes muted sinks (shown with a [muted] label in the UI). Uses -the friendly description from PulseAudio (e.g. \"JDS Labs Element IV -Analog Stereo\"). State is the PulseAudio state string (RUNNING, -IDLE, or SUSPENDED). Mute is \"yes\" or \"no\"." - (let* ((output (shell-command-to-string "pactl list sinks 2>/dev/null")) - (sinks (cj/recording--parse-pactl-verbose output "Sink")) - (result nil)) - (dolist (sink sinks) - (let ((name (nth 0 sink)) - (desc (nth 1 sink)) - (mute (nth 2 sink)) - (state (nth 3 sink))) - (push (list name (or desc name) state mute) result))) - (nreverse result))) - -;;; ============================================================ -;;; Device Selection UI +;;; Device Diagnostics and Selection Commands ;;; ============================================================ (defun cj/recording-list-devices () @@ -408,26 +133,6 @@ identify which device the phone app is actually using for output." (switch-to-buffer-other-window "*Active Audio Playback*") (message "Showing active audio playback. Press 'g' to refresh, 'q' to quit."))) -(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. -Monitor devices end in .monitor (they tap system audio output). -Returns selected device name or nil." - (let* ((sources (cj/recording-parse-sources)) - (filtered (if (eq device-type 'monitor) - (seq-filter (lambda (s) (string-match-p "\\.monitor$" (car s))) sources) - (seq-filter (lambda (s) (not (string-match-p "\\.monitor$" (car s)))) sources))) - (choices (mapcar (lambda (s) - (let ((device (nth 0 s)) - (_driver (nth 1 s)) - (_state (nth 2 s)) - (friendly-state (cj/recording-friendly-state (nth 2 s)))) - (cons (format "%-10s %s" friendly-state device) device))) - filtered))) - (if choices - (cdr (assoc (completing-read prompt choices nil t) choices)) - (user-error "No %s devices found" (if (eq device-type 'monitor) "monitor" "input"))))) - (defun cj/recording-select-devices () "Interactively select microphone and system audio devices separately. Sets `cj/recording-mic-device' and `cj/recording-system-device'." @@ -440,191 +145,9 @@ Sets `cj/recording-mic-device' and `cj/recording-system-device'." cj/recording-mic-device cj/recording-system-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--device-sort-key (state muted) - "Return a numeric sort key for a device with STATE and MUTED flag. -Lower values sort first: RUNNING (0) → IDLE (1) → SUSPENDED (2) → muted (3)." - (if (equal muted "yes") - 3 - (pcase (upcase (or state "")) - ("RUNNING" 0) - ("IDLE" 1) - (_ 2)))) - -(defun cj/recording--device-status-label (state muted) - "Return a human-readable status label for a device. -MUTED is \"yes\" or \"no\". STATE is the PulseAudio state string." - (if (equal muted "yes") - "[muted]" - (pcase (upcase (or state "")) - ("RUNNING" "[in use]") - ("IDLE" "[ready]") - (_ "[available]")))) - -(defun cj/recording--label-devices (devices) - "Build labeled (label . name) alist from DEVICES for `completing-read'. -DEVICES is a list of (name description state mute) as returned by -`cj/recording--get-available-mics' or `cj/recording--get-available-sinks'. -Labels are formatted as \"Description [in use]\" etc. -Sorted: in use → ready → available → muted." - (let* ((labeled (mapcar - (lambda (dev) - (let* ((name (nth 0 dev)) - (desc (nth 1 dev)) - (state (nth 2 dev)) - (muted (nth 3 dev)) - (label (concat desc " " - (cj/recording--device-status-label state muted)))) - (list label name (cj/recording--device-sort-key state muted)))) - devices)) - (sorted (sort labeled (lambda (a b) (< (nth 2 a) (nth 2 b)))))) - (mapcar (lambda (entry) (cons (nth 0 entry) (nth 1 entry))) sorted))) - -(defun cj/recording--get-sink-apps () - "Return alist mapping sink index to list of application names. -Parses `pactl list sink-inputs' to find which apps are playing -audio through each sink." - (let ((output (shell-command-to-string "pactl list sink-inputs 2>/dev/null")) - (apps (make-hash-table :test 'equal)) - (current-sink nil)) - (dolist (line (split-string output "\n")) - (cond - ((string-match "^Sink Input #" line) - (setq current-sink nil)) - ((string-match "^[ \t]+Sink:[ \t]+\\([0-9]+\\)" line) - (setq current-sink (match-string 1 line))) - ((and current-sink - (string-match "application\\.name = \"\\([^\"]+\\)\"" line)) - (let ((existing (gethash current-sink apps))) - (unless (member (match-string 1 line) existing) - (puthash current-sink - (append existing (list (match-string 1 line))) - apps)))))) - ;; Convert hash to alist - (let ((result nil)) - (maphash (lambda (k v) (push (cons k v) result)) apps) - result))) - -(defun cj/recording--label-sinks (sinks) - "Build labeled (label . name) alist from SINKS for `completing-read'. -Like `cj/recording--label-devices' but also appends application names -for sinks with active audio streams. E.g. \"JDS Labs [in use] (Firefox)\"." - (let* ((sink-apps (cj/recording--get-sink-apps)) - (sinks-short (shell-command-to-string "pactl list sinks short 2>/dev/null")) - (labeled - (mapcar - (lambda (dev) - (let* ((name (nth 0 dev)) - (desc (nth 1 dev)) - (state (nth 2 dev)) - (muted (nth 3 dev)) - (index (cj/recording--get-sink-index name sinks-short)) - (apps (and index (cdr (assoc index sink-apps)))) - (status (cj/recording--device-status-label state muted)) - (app-str (if apps (concat " (" (string-join apps ", ") ")") "")) - (label (concat desc " " status app-str))) - (list label name (cj/recording--device-sort-key state muted)))) - sinks)) - (sorted (sort labeled (lambda (a b) (< (nth 2 a) (nth 2 b)))))) - (mapcar (lambda (entry) (cons (nth 0 entry) (nth 1 entry))) sorted))) - -(defun cj/recording--select-from-labeled (prompt entries) - "Prompt user with PROMPT to select from labeled ENTRIES. -ENTRIES is an alist of (label . device-name). Appends a Cancel option. -Returns the selected device name, or signals user-error if cancelled." - (let* ((alist (append entries '(("Cancel" . nil)))) - (choice (completing-read prompt - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (display-sort-function . identity)) - (complete-with-action action alist string pred))) - nil t)) - (device (cdr (assoc choice alist)))) - (unless device - (user-error "Device setup cancelled")) - device)) - -(defun cj/recording-quick-setup () - "Quick device setup for recording — two-step mic + sink selection. -Step 1: Pick a microphone. Each mic shows its status: - [in use] = an app is actively using this mic - [ready] = recently used, still open - [available] = no app has this mic open - [muted] = device is muted in PulseAudio -Step 2: Pick an audio output to capture. Same status labels, plus -application names for outputs with active streams (e.g. \"Firefox\"). -Devices are sorted: in use → ready → available → muted. -The chosen output's .monitor source is set as the system audio device. - -This approach is portable across systems — plug in a new mic, run this -command, and it appears in the list. No hardware-specific configuration -needed." - (interactive) - (let* ((mic-entries (cj/recording--label-devices (cj/recording--get-available-mics)))) - (unless mic-entries - (user-error "No microphones found. Is a mic connected?")) - (let ((mic-device (cj/recording--select-from-labeled "Select microphone: " mic-entries)) - (sink-entries (cj/recording--label-sinks (cj/recording--get-available-sinks)))) - (let ((sink-device (cj/recording--select-from-labeled "Select audio output to capture: " sink-entries))) - (setq cj/recording-mic-device mic-device) - (setq cj/recording-system-device (concat sink-device ".monitor")) - (message "Recording ready!\n Mic: %s\n System audio: %s.monitor" - (car (rassoc mic-device mic-entries)) - (file-name-nondirectory sink-device)))))) - ;;; ============================================================ ;;; Device Testing ;;; ============================================================ -;; -;; These functions record short clips and play them back so you can -;; verify hardware works BEFORE an important recording. (defun cj/recording--test-device (device prefix prompt-action) "Record 5 seconds from DEVICE and play it back. @@ -698,91 +221,6 @@ Run this before important recordings to verify everything works." (message "Device testing complete. If you heard audio in all tests, recording will work!")) ;;; ============================================================ -;;; Device Validation -;;; ============================================================ - -(defun cj/recording-get-devices () - "Get audio devices, prompting user if not already configured. -Returns (mic-device . system-device) cons cell. -If devices aren't set, goes straight into quick setup (mic selection)." - (unless (and cj/recording-mic-device cj/recording-system-device) - (cj/recording-quick-setup)) - (unless (and cj/recording-mic-device cj/recording-system-device) - (user-error "Audio devices not configured. Run C-; r s (quick setup) or C-; r S (manual select)")) - (cj/recording--validate-system-audio) - (cons cj/recording-mic-device cj/recording-system-device)) - -(defun cj/recording--source-exists-p (source-name pactl-output) - "Return non-nil if SOURCE-NAME exists in PACTL-OUTPUT. -PACTL-OUTPUT should be the output of `pactl list sources short'." - (let ((found nil)) - (dolist (line (split-string pactl-output "\n" t)) - (when (string-match "^[0-9]+\t\\([^\t]+\\)\t" line) - (when (equal source-name (match-string 1 line)) - (setq found t)))) - found)) - -(defun cj/recording--get-sink-index (sink-name sinks-output) - "Return the numeric index of SINK-NAME from SINKS-OUTPUT. -SINKS-OUTPUT should be the output of `pactl list sinks short'. -Returns the index as a string, or nil if not found." - (let ((index nil)) - (dolist (line (split-string sinks-output "\n" t)) - (when (string-match "^\\([0-9]+\\)\t\\([^\t]+\\)\t" line) - (when (equal sink-name (match-string 2 line)) - (setq index (match-string 1 line))))) - index)) - -(defun cj/recording--sink-has-active-audio-p (sink-index pactl-output) - "Return non-nil if SINK-INDEX has active audio streams. -PACTL-OUTPUT should be the output of `pactl list sink-inputs'. -SINK-INDEX is the numeric sink index as a string." - (let ((found nil) - (lines (split-string pactl-output "\n"))) - (dolist (line lines) - (when (string-match "^[ \t]+Sink:[ \t]+\\([0-9]+\\)" line) - (when (equal sink-index (match-string 1 line)) - (setq found t)))) - found)) - -(defun cj/recording--validate-system-audio () - "Validate that the configured system audio device will capture audio. -Checks two things: -1. Does the configured device still exist as a PulseAudio source? -2. Is anything currently playing through the monitored sink? - -Auto-fixes stale devices by falling back to the default sink's monitor. -Warns (but doesn't block) if no audio is currently playing. -Respects the user's explicit sink choice from quick-setup." - (when cj/recording-system-device - (let* ((sources-output (shell-command-to-string "pactl list sources short 2>/dev/null")) - (current-default (cj/recording--get-default-sink-monitor)) - (device-exists (cj/recording--source-exists-p - cj/recording-system-device sources-output))) - ;; Check 1: Device no longer exists — auto-update - (unless device-exists - (let ((old cj/recording-system-device)) - (setq cj/recording-system-device current-default) - (message "System audio device updated: %s → %s (old device no longer exists)" - old current-default))) - ;; Check 2: No active audio on the monitored sink — warn - (let* ((sink-name (if (string-suffix-p ".monitor" cj/recording-system-device) - (substring cj/recording-system-device 0 -8) - cj/recording-system-device)) - (sinks-output (shell-command-to-string "pactl list sinks short 2>/dev/null")) - (sink-index (cj/recording--get-sink-index sink-name sinks-output)) - (sink-inputs (shell-command-to-string "pactl list sink-inputs 2>/dev/null")) - (has-audio (and sink-index - (cj/recording--sink-has-active-audio-p sink-index sink-inputs)))) - (unless has-audio - (message "Warning: No audio connected to %s. Run C-; r s to check devices" - sink-name) - (cj/log-silently - (concat "No audio connected to %s. " - "Run C-; r s to see active streams and switch devices") - sink-name)))))) - -;;; ============================================================ ;;; Toggle Commands (User-Facing) ;;; ============================================================ @@ -825,235 +263,6 @@ Otherwise use the default location in `audio-recordings-dir'." (cj/ffmpeg-record-audio directory)))) ;;; ============================================================ -;;; Start Recording -;;; ============================================================ - -(defun cj/recording--build-video-command (mic-device system-device filename on-wayland) - "Build the shell command string for video recording. -MIC-DEVICE and SYSTEM-DEVICE are PulseAudio device names. -FILENAME is the output .mkv path. ON-WAYLAND selects the capture method. - -On Wayland: wf-recorder captures screen as H.264 in matroska container, -piped to ffmpeg which adds mic + system audio, then writes the final MKV. - -On X11: ffmpeg captures screen directly via x11grab with PulseAudio audio." - (if on-wayland - (progn - (cj/recording--check-wf-recorder) - (format (concat "wf-recorder -y -c libx264 -m matroska -f /dev/stdout 2>/dev/null | " - "ffmpeg -i pipe:0 " - "-f pulse -i %s " - "-f pulse -i %s " - "-filter_complex \"[1:a]volume=%.1f[mic];[2:a]volume=%.1f[sys];[mic][sys]amerge=inputs=2[out]\" " - "-map 0:v -map \"[out]\" " - "-c:v copy " - "%s") - (shell-quote-argument mic-device) - (shell-quote-argument system-device) - cj/recording-mic-boost - cj/recording-system-volume - (shell-quote-argument filename))) - (format (concat "ffmpeg -framerate 30 -f x11grab -i :0.0+ " - "-f pulse -i %s " - "-ac 1 " - "-f pulse -i %s " - "-ac 2 " - "-filter_complex \"[1:a]volume=%.1f[mic];[2:a]volume=%.1f[sys];[mic][sys]amerge=inputs=2[out]\" " - "-map 0:v -map \"[out]\" " - "%s") - (shell-quote-argument mic-device) - (shell-quote-argument system-device) - cj/recording-mic-boost - cj/recording-system-volume - (shell-quote-argument filename)))) - -(defun cj/recording--build-audio-command (mic-device system-device filename) - "Build the ffmpeg shell command string for audio-only recording. -MIC-DEVICE and SYSTEM-DEVICE are PulseAudio device names. FILENAME is -the output .m4a path. Mixes mic + system monitor into a single AAC file." - (format (concat "ffmpeg " - "-f pulse -i %s " ; Input 0: microphone - "-f pulse -i %s " ; Input 1: system audio monitor - "-filter_complex \"" - "[0:a]volume=%.1f[mic];" - "[1:a]volume=%.1f[sys];" - "[mic][sys]amix=inputs=2:duration=longest[out]\" " - "-map \"[out]\" " - "-c:a aac " - "-b:a 64k " - "%s") - (shell-quote-argument mic-device) - (shell-quote-argument system-device) - cj/recording-mic-boost - cj/recording-system-volume - (shell-quote-argument filename))) - -(defun cj/ffmpeg-record-video (directory) - "Start a video recording, saving output to DIRECTORY. -Uses wf-recorder on Wayland, x11grab on X11." - (cj/recording-check-ffmpeg) - (unless cj/video-recording-ffmpeg-process - ;; On Wayland, kill any orphan wf-recorder processes left over from - ;; previous crashes. Without this, old wf-recorders hold the compositor - ;; capture and new ones fail silently. This one stays a broad by-name - ;; kill on purpose: the orphans' launching shells are already dead, so - ;; there is no live PID to scope to. The stop path, by contrast, scopes - ;; to our own shell's child (see cj/recording--interrupt-child-wf-recorder). - (when (cj/recording--wayland-p) - (call-process "pkill" nil nil nil "-INT" "wf-recorder") - (sit-for 0.1)) - (let* ((devices (cj/recording-get-devices)) - (mic-device (car devices)) - (system-device (cdr devices)) - (location (expand-file-name directory)) - (name (format-time-string "%Y-%m-%d-%H-%M-%S")) - (filename (expand-file-name (concat name ".mkv") location)) - (on-wayland (cj/recording--wayland-p)) - (record-command (cj/recording--build-video-command - mic-device system-device filename on-wayland))) - (setq cj/video-recording-ffmpeg-process - (start-process-shell-command "ffmpeg-video-recording" - "*ffmpeg-video-recording*" - record-command)) - (set-process-query-on-exit-flag cj/video-recording-ffmpeg-process nil) - (set-process-sentinel cj/video-recording-ffmpeg-process #'cj/recording-process-sentinel) - (force-mode-line-update t) - (message "Started video recording to %s (%s, mic: %.1fx, system: %.1fx)." - filename - (if on-wayland "Wayland/wf-recorder" "X11") - cj/recording-mic-boost cj/recording-system-volume)))) - -(defun cj/ffmpeg-record-audio (directory) - "Start an audio recording, saving output to DIRECTORY. -Records from microphone and system audio monitor (configured device), -mixing them together into a single M4A/AAC file. - -The filter graph mixes two PulseAudio inputs: - [mic] → volume boost → amerge → AAC encoder → .m4a - [sys] → volume boost ↗" - (cj/recording-check-ffmpeg) - (unless cj/audio-recording-ffmpeg-process - (let* ((devices (cj/recording-get-devices)) - (mic-device (car devices)) - (system-device (cdr devices)) - (location (expand-file-name directory)) - (name (format-time-string "%Y-%m-%d-%H-%M-%S")) - (filename (expand-file-name (concat name ".m4a") location)) - (ffmpeg-command - (cj/recording--build-audio-command mic-device system-device filename))) - (message "Recording from mic: %s + ALL system outputs" mic-device) - (cj/log-silently "Audio recording ffmpeg command: %s" ffmpeg-command) - (setq cj/audio-recording-ffmpeg-process - (start-process-shell-command "ffmpeg-audio-recording" - "*ffmpeg-audio-recording*" - ffmpeg-command)) - (set-process-query-on-exit-flag cj/audio-recording-ffmpeg-process nil) - (set-process-sentinel cj/audio-recording-ffmpeg-process #'cj/recording-process-sentinel) - (force-mode-line-update t) - (message "Started recording to %s (mic: %.1fx, all system audio: %.1fx)" - filename cj/recording-mic-boost cj/recording-system-volume)))) - -;;; ============================================================ -;;; Stop Recording -;;; ============================================================ -;; -;; Stopping a recording requires careful process management, especially -;; on Wayland where we have a two-process pipeline (wf-recorder | ffmpeg). -;; -;; Wayland shutdown order (CRITICAL — order matters!): -;; 1. Kill wf-recorder first (the producer). This closes the pipe -;; to ffmpeg, giving ffmpeg a clean EOF on its video input. -;; 2. Signal the process group with SIGINT so ffmpeg begins its -;; graceful shutdown (flushing audio, writing container metadata). -;; 3. Wait for the shell/ffmpeg to actually exit. MKV container -;; finalization (index tables, seek entries) can take several -;; seconds. A fixed `sit-for' is insufficient. -;; 4. Kill any remaining wf-recorder as a safety net. -;; -;; Why producer-first matters: In a `wf-recorder | ffmpeg` pipeline, -;; sending SIGINT to all processes simultaneously causes ffmpeg to -;; abort mid-stream (no clean EOF on pipe:0). The result is no output -;; file at all. Killing the producer first lets ffmpeg see EOF, start -;; its orderly shutdown, and then SIGINT reinforces "stop now." -;; -;; X11 shutdown: simpler — ffmpeg is the only process, so we just -;; send SIGINT to the process group and wait. - -(defun cj/recording--interrupt-child-wf-recorder (shell-pid) - "Send SIGINT to the wf-recorder child of SHELL-PID, if any. -Scopes the producer-first stop to the wf-recorder this module launched -\(a child of our recording shell) via `pkill -P', instead of killing -every wf-recorder on the system by name. Does nothing when SHELL-PID -is nil (the shell already exited, so there is no child to signal)." - (when shell-pid - (call-process "pkill" nil nil nil - "-INT" "-P" (number-to-string shell-pid) "wf-recorder"))) - -(defun cj/video-recording-stop () - "Stop the video recording, waiting for ffmpeg to finalize the file. -On Wayland, kills wf-recorder first so ffmpeg gets a clean EOF on its -video input pipe, then signals the process group. Waits up to 5 seconds -for ffmpeg to write container metadata before giving up." - (interactive) - (if (not cj/video-recording-ffmpeg-process) - (message "No video recording in progress.") - (let ((proc cj/video-recording-ffmpeg-process)) - ;; On Wayland, kill the producer (wf-recorder) FIRST so ffmpeg sees - ;; a clean EOF on pipe:0. This triggers ffmpeg's orderly shutdown: - ;; drain remaining frames, write container metadata, close file. - ;; Without this, simultaneous SIGINT to both causes ffmpeg to abort - ;; without creating a file. - (when (cj/recording--wayland-p) - (cj/recording--interrupt-child-wf-recorder (process-id proc)) - (sit-for 0.3)) ; Brief pause for pipe to close - ;; Now send SIGINT to the process group. On Wayland, this reaches - ;; ffmpeg (which is already shutting down from the pipe EOF) and - ;; reinforces the stop. On X11, this is the primary shutdown signal. - (let ((pid (process-id proc))) - (when pid - (signal-process (- pid) 2))) ; 2 = SIGINT - ;; Wait for ffmpeg to finalize the container. MKV files need index - ;; tables written at the end — without this wait, the file is truncated. - (let ((exited (cj/recording--wait-for-exit proc 5))) - (unless exited - (message "Warning: recording process did not exit within 5 seconds"))) - ;; Safety net: signal our own straggler wf-recorder on Wayland. - ;; If the shell already exited, process-id returns nil and this is - ;; a no-op (the child is already gone with it). - (when (cj/recording--wayland-p) - (cj/recording--interrupt-child-wf-recorder (process-id proc))) - ;; The sentinel handles clearing cj/video-recording-ffmpeg-process - ;; and updating the modeline. If the process already exited during - ;; our wait, the sentinel has already fired. If not, force cleanup. - (when (eq cj/video-recording-ffmpeg-process proc) - (setq cj/video-recording-ffmpeg-process nil) - (force-mode-line-update t)) - (message "Stopped video recording.")))) - -(defun cj/audio-recording-stop () - "Stop the audio recording, waiting for ffmpeg to finalize the file. -Sends SIGINT to the process group and waits up to 3 seconds for ffmpeg -to flush audio frames and write the M4A container trailer." - (interactive) - (if (not cj/audio-recording-ffmpeg-process) - (message "No audio recording in progress.") - (let ((proc cj/audio-recording-ffmpeg-process)) - ;; Send SIGINT to the process group (see video-recording-stop for details) - (let ((pid (process-id proc))) - (when pid - (signal-process (- pid) 2))) - ;; M4A finalization is faster than MKV, but still needs time to write - ;; the AAC trailer and flush the output buffer. - (let ((exited (cj/recording--wait-for-exit proc 3))) - (unless exited - (message "Warning: recording process did not exit within 3 seconds"))) - ;; Fallback cleanup if sentinel hasn't fired yet - (when (eq cj/audio-recording-ffmpeg-process proc) - (setq cj/audio-recording-ffmpeg-process nil) - (force-mode-line-update t)) - (message "Stopped audio recording.")))) - -;;; ============================================================ ;;; Volume Adjustment ;;; ============================================================ @@ -1106,5 +315,6 @@ Changes take effect on the next recording (not the current one)." "C-; r t s" "test system audio" "C-; r t b" "test both (guided)")) + (provide 'video-audio-recording) ;;; video-audio-recording.el ends here. diff --git a/modules/weather-config.el b/modules/weather-config.el index 93b0a6148..017d9e31b 100644 --- a/modules/weather-config.el +++ b/modules/weather-config.el @@ -1,4 +1,4 @@ -;;; weather-config.el --- -*- lexical-binding: t; coding: utf-8; -*- +;;; weather-config.el --- wttrin weather display and modeline setup -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: ;; @@ -11,19 +11,23 @@ ;; Runtime requires: none (configures packages via use-package). ;; Direct test load: yes. ;; -;; Call M-W to open wttrin with your preferred location list immediately. -;; Adjust the city list by editing `wttrin-default-locations` or answering wttrin prompts when asked. -;; Forecasts arrive in an Emacs buffer, so you can stay keyboard-only while checking weather. +;; Configures wttrin for favorite-location forecasts, mode-line weather, and +;; whereami-backed geolocation. M-S-w opens the weather buffer. ;; ;;; Code: +(defvar wttrin-geolocation-command) + ;; ----------------------------------- Wttrin ---------------------------------- (use-package wttrin - :vc (:url "git@cjennings.net:emacs-wttrin.git" - :branch "main" - :rev :newest) - ;; :load-path "~/code/emacs-wttrin" ;; uncomment + comment :vc above for local dev + ;; Load from the local checkout (currently release/0.4.0) so recent wttrin + ;; changes are testable without a package pull. Swap back to :vc below for + ;; production tracking. + :load-path "~/code/emacs-wttrin" + ;; :vc (:url "git@cjennings.net:emacs-wttrin.git" + ;; :branch "release/0.4.0" + ;; :rev :newest) :demand t ;; REQUIRED: mode-line must start at Emacs startup :preface ;; Change this to t to enable debug logging @@ -32,7 +36,21 @@ ("M-S-w" . wttrin) ;; was M-W, overrides kill-ring-save :config (setopt wttrin-unit-system "u") + ;; Drop the "Follow @igor_chubin for wttr.in updates" footer. "F" is the + ;; wttr.in flag for "no Follow line"; everything else (forecast, header, + ;; colors) is unchanged. + (setopt wttrin-display-options "F") (setopt wttrin-favorite-location "New Orleans, LA") + ;; Scale the weather font to fit the window width, clamped to a floor/cap + ;; (wttrin-font-height-min/-max, default 100/200). + (setopt wttrin-auto-fit-font t) + ;; Higher-accuracy geolocation via the whereami WiFi-scan script (Google-backed), + ;; far better than IP behind a VPN or cellular hotspot. Used by the picker's + ;; "Current location (detect)" entry; wttrin falls back to its IP provider if the + ;; command is missing or fails. setq (not setopt): wttrin-geolocation-command is + ;; defined in the lazily-loaded wttrin-geolocation sub-module, so it may be unbound + ;; at :config time; the later defcustom won't clobber an already-set value. + (setq wttrin-geolocation-command "/home/cjennings/.local/bin/whereami --json") (setopt wttrin-mode-line-refresh-interval (* 30 60)) ;; thirty minutes (setq wttrin-default-locations '( "New Orleans, LA" diff --git a/modules/wrap-up.el b/modules/wrap-up.el index 503d4a6b0..e28ba8458 100644 --- a/modules/wrap-up.el +++ b/modules/wrap-up.el @@ -1,4 +1,4 @@ -;;; wrapup --- Functions Run Before Init Completion -*- lexical-binding: t; coding: utf-8; -*- +;;; wrap-up.el --- Functions Run Before Init Completion -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: |