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