diff options
Diffstat (limited to 'modules')
| -rw-r--r-- | modules/agenda-query.el | 118 | ||||
| -rw-r--r-- | modules/calendar-sync.el | 149 | ||||
| -rw-r--r-- | modules/custom-buffer-file.el | 6 | ||||
| -rw-r--r-- | modules/dirvish-config.el | 1 | ||||
| -rw-r--r-- | modules/dwim-shell-config.el | 4 | ||||
| -rw-r--r-- | modules/google-keep-config.el | 25 | ||||
| -rw-r--r-- | modules/music-config.el | 51 | ||||
| -rw-r--r-- | modules/org-config.el | 8 | ||||
| -rw-r--r-- | modules/package-resilience.el | 369 | ||||
| -rw-r--r-- | modules/system-commands.el | 17 | ||||
| -rw-r--r-- | modules/system-defaults.el | 5 | ||||
| -rw-r--r-- | modules/system-lib.el | 51 | ||||
| -rw-r--r-- | modules/user-constants.el | 18 | ||||
| -rw-r--r-- | modules/video-audio-recording.el | 35 |
14 files changed, 795 insertions, 62 deletions
diff --git a/modules/agenda-query.el b/modules/agenda-query.el index a411c89b..c98b7fb7 100644 --- a/modules/agenda-query.el +++ b/modules/agenda-query.el @@ -14,8 +14,15 @@ ;; Direct test load: yes. ;; ;; Answers "what is on the agenda between these two instants" as JSON, so a -;; renderer running outside Emacs can draw it. `cj/agenda-window-json' is the -;; entry point; it reads `org-agenda-files' and leaves every buffer unmodified. +;; renderer running outside Emacs can draw it. Both entry points read +;; `org-agenda-files' and leave every buffer unmodified. +;; +;; Two output profiles over one query. `cj/agenda-window-json' is canonical: +;; epoch seconds, descriptive field names, and a null end where the source has +;; no range. `cj/agenda-render-json' adds what the wallpaper renderer reads -- +;; s and e in epoch MILLISECONDS, t for the title, and an end every row can +;; actually be drawn with. `cj/agenda-render-cache-update' writes that profile +;; for today to `cj/agenda-render-cache-file'. ;; ;; Epoch seconds at the boundary is the load-bearing interface choice. It takes ;; timezone out of the contract entirely: the consumer does its own zoneinfo @@ -416,6 +423,36 @@ counted twice." (string< (alist-get 'title a) (alist-get 'title b)) (< sa sb)))))) +(defun cj/--agenda-query-drawable-end (event) + "Return EVENT's end as something a renderer can draw, in epoch seconds. + +The canonical row reports a null end when the source has no range, which is +faithful but not drawable. Here an all-day entry's extent is its whole day and +a timed point event's is the instant itself, so every row has a width -- even +if that width is zero. Derived from the row, so this stays a pure function of +canonical output." + (let ((start (alist-get 'start event)) + (end (alist-get 'end event))) + (cond + ((integerp end) end) + ((eq t (alist-get 'all-day event)) + (let ((d (decode-time start))) + (cj/--agenda-query-day-close (nth 3 d) (nth 4 d) (nth 5 d)))) + (t start)))) + +(defun cj/--agenda-query-render-row (event) + "Return EVENT in the renderer's contract, adding s, e and t. + +The renderer reads s and e as epoch MILLISECONDS and t as the title; it takes +everything else and drops it before drawing. The canonical fields are kept +alongside rather than replaced, so one file serves both the renderer and any +consumer reading the documented shape. Milliseconds live only in s and e -- +`start' and `end' stay seconds, and the two never mix within a key." + (append (list (cons 's (* 1000 (alist-get 'start event))) + (cons 'e (* 1000 (cj/--agenda-query-drawable-end event))) + (cons 't (alist-get 'title event))) + event)) + (defun cj/--agenda-query-write-atomically (path text) "Write TEXT to PATH through a temp file and a rename, returning PATH. @@ -465,6 +502,15 @@ Signals when either bound falls outside 1900-2200, or when the window is wider than `cj/agenda-query-max-window-seconds'. Both checks exist to surface a milliseconds-for-seconds mistake, which otherwise answers with dates in the year 58549 or builds millions of rows." + (let ((json (json-serialize + (vconcat (cj/--agenda-query-events start-epoch end-epoch))))) + (when out-path + (cj/--agenda-query-write-atomically out-path json)) + json)) + +(defun cj/--agenda-query-events (start-epoch end-epoch) + "Return the sorted event rows between START-EPOCH and END-EPOCH. +Shared by both output profiles; the callers do their own writing." (unless (numberp start-epoch) (signal 'wrong-type-argument (list 'numberp start-epoch))) (unless (numberp end-epoch) @@ -492,10 +538,70 @@ year 58549 or builds millions of rows." (nconc events (cj/--agenda-query-buffer-events buffer file win-start win-end)))))))) - (let ((json (json-serialize (vconcat (cj/--agenda-query-sort events))))) - (when out-path - (cj/--agenda-query-write-atomically out-path json)) - json))) + (cj/--agenda-query-sort events))) + +(defconst cj/agenda-render-cache-file + (expand-file-name + "settings/agenda.json" + (let ((xdg (getenv "XDG_CACHE_HOME"))) + ;; An empty XDG_CACHE_HOME is set-but-useless; `or' would take it and + ;; resolve the whole path relative to whatever the cwd happens to be. + (if (and xdg (not (string-empty-p xdg))) + xdg + (expand-file-name ".cache" (or (getenv "HOME") "~"))))) + "Where the wallpaper renderer reads the day from. + +A stable path is load-bearing on both sides. Because the file is only ever +replaced by a rename, the renderer keeps drawing the last good answer while +Emacs is down, which makes this file its own cache.") + +(defun cj/agenda-render-json (start-epoch end-epoch &optional out-path) + "Return the agenda between START-EPOCH and END-EPOCH in the renderer's shape. + +Bounds are epoch SECONDS, as everywhere else here. Each row carries the +canonical fields plus the three the renderer reads: s and e as epoch +MILLISECONDS, and t as the title. The renderer works in milliseconds +throughout, and converting once here beats converting in three places there. + +Every row has a drawable e, even where the canonical end is null: an all-day +entry spans its day and a point event has zero width. See +`cj/--agenda-query-drawable-end'." + (let ((json (json-serialize + (vconcat (mapcar #'cj/--agenda-query-render-row + (cj/--agenda-query-events start-epoch + end-epoch)))))) + (when out-path + (cj/--agenda-query-write-atomically out-path json)) + json)) + +(defun cj/agenda-render-cache-update () + "Write the agenda around today to `cj/agenda-render-cache-file'. + +The window is three whole local days: yesterday's midnight through tomorrow's +day close. A consumer drawing a rolling window centred on now needs entries +from either side of midnight, and a single calendar day leaves it with nothing +to draw for the part of its span that falls outside today -- half the surface, +late in the evening. Three days covers any rolling span up to a full day +either way, and the consumer filters to what it actually draws. + +Day boundaries are computed rather than assumed, so the span is 71, 72 or 73 +hours across a DST changeover rather than a flat 72. Returns the path. + +Safe to call repeatedly and from a timer: it only reads org files, creates the +cache directory if needed, and replaces the file by rename, so a reader on its +own schedule never sees a partial write." + (interactive) + (let* ((d (decode-time (time-convert nil 'integer))) + (day (nth 3 d)) (month (nth 4 d)) (year (nth 5 d)) + ;; Out-of-range day fields normalize, so day 0 is last month's last + ;; day and day+1 rolls the month or year without special cases. + (start (cj/--agenda-query-epoch 0 0 0 (1- day) month year)) + (end (cj/--agenda-query-day-close (1+ day) month year))) + (make-directory (file-name-directory cj/agenda-render-cache-file) t) + (cj/agenda-render-json start end cj/agenda-render-cache-file) + (when (called-interactively-p 'interactive) + (message "Agenda render cache written to %s" cj/agenda-render-cache-file)) + cj/agenda-render-cache-file)) (provide 'agenda-query) ;;; agenda-query.el ends here diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index d504f246..5338e7d7 100644 --- a/modules/calendar-sync.el +++ b/modules/calendar-sync.el @@ -87,10 +87,22 @@ calendar feed URLs." "Sync interval in minutes. Default: 60 minutes (1 hour).") -(defvar calendar-sync-auto-start t - "Whether to automatically start calendar sync when module loads. -If non-nil, sync starts automatically when calendar-sync is loaded. -If nil, user must manually call `calendar-sync-start'.") +(defvar calendar-sync-auto-start nil + "Whether the editor arms its own periodic sync when this module loads. + +Off by default: the calendar-sync.timer systemd unit owns the schedule now, +running scripts/calendar-sync-run every ten minutes whether or not Emacs is +up. Leaving the in-editor timer armed as well would give two owners writing +the same org files and the same state file, with no coordination between +them. + +Set to t to hand the schedule back to the editor -- the deferred start at the +end of this file still works, and `calendar-sync-start' and +`calendar-sync-now' remain available on demand either way. + +The tradeoff this default accepts: a checkout whose timer has never been +enabled does not sync on its own. Enabling the unit is a one-time step per +machine, alongside symlinking it into ~/.config/systemd/user.") (defvar calendar-sync-user-emails '("craigmartinjennings@gmail.com" "craig.jennings@deepsat.com" "c@cjennings.net") @@ -215,16 +227,27 @@ calendar files do not block the interactive Emacs thread. Skips a calendar whose previous sync is still in flight, so a timer tick that fires before a slow fetch finishes does not launch a second overlapping sync for -the same calendar." +the same calendar. + +A synchronous failure is contained here and recorded against this calendar +alone. The async callbacks record their own failures, but they never run when +the error lands before a process starts -- resolving a `:secret-host' feed +reads authinfo.gpg, which signals outright on a cold gpg-agent. Uncontained, +that first error aborted the whole loop and the remaining calendars never +synced." (let ((name (plist-get calendar :name))) - (cond - ((calendar-sync--syncing-p name) - (calendar-sync--log-silently - "calendar-sync: [%s] sync already in flight; skipping overlapping tick" name)) - ((eq (plist-get calendar :fetcher) 'api) - (calendar-sync--sync-calendar-api calendar)) - (t - (calendar-sync--sync-calendar-ics calendar))))) + (if (calendar-sync--syncing-p name) + (calendar-sync--log-silently + "calendar-sync: [%s] sync already in flight; skipping overlapping tick" name) + (condition-case err + (if (eq (plist-get calendar :fetcher) 'api) + (calendar-sync--sync-calendar-api calendar) + (calendar-sync--sync-calendar-ics calendar)) + (error + (let ((reason (error-message-string err))) + (calendar-sync--log-silently + "calendar-sync: [%s] Sync error: %s" name reason) + (calendar-sync--mark-sync-failed name reason))))))) (defun calendar-sync--require-calendars () "Return non-nil if calendars are configured, else warn and return nil." @@ -297,6 +320,96 @@ When called non-interactively with nil, syncs all calendars." (message "calendar-sync status:\n%s" (string-join (nreverse status-lines) "\n"))))) +;;; Batch entry point + +;; `emacs --batch' exits the moment its top-level form returns, and this +;; pipeline is asynchronous end to end -- curl in one process, the org +;; conversion in a second batch Emacs. So `calendar-sync-now' is the wrong +;; entry point for a timer: it returns as soon as the fetches are launched, +;; and batch Emacs would exit and kill both children mid-flight, having +;; written nothing and reported success. +;; +;; The batch path therefore starts the sync and then blocks on the same +;; per-calendar state the interactive session keeps. Nothing new tracks +;; completion -- the pipeline's own record of what finished is the signal. + +(defvar calendar-sync--batch-poll-seconds 0.2 + "Seconds `calendar-sync--batch-wait' blocks per iteration. +Short enough that the wait ends promptly once the last child exits, long +enough that the loop is not a spin. Rebound in tests.") + +(defvar calendar-sync-batch-timeout 300 + "Seconds `calendar-sync-batch-run' waits for every calendar to settle. +Covers a `calendar-sync-fetch-timeout' fetch plus the org conversion, with +room to spare: the calendars run in parallel, so this is not a per-calendar +budget.") + +(defun calendar-sync--batch-results (names) + "Return one (NAME . STATUS) pair per calendar in NAMES, in that order. +A calendar with no state entry reads `never' rather than nil, so one that +never started still counts when the failures are tallied." + (mapcar (lambda (name) + (cons name + (or (plist-get (calendar-sync--get-calendar-state name) :status) + 'never))) + names)) + +(defun calendar-sync--batch-failures (results) + "Return the rows of RESULTS that did not finish cleanly. +Only `ok' passes. `error' failed outright, `syncing' means the wait expired +with the fetch still in flight, and `never' means the sync never started -- +in all three the org file on disk is not the calendar's current contents, +which is the staleness the timer exists to prevent." + (seq-remove (lambda (row) (eq (cdr row) 'ok)) results)) + +(defun calendar-sync--batch-wait (names timeout) + "Block until no calendar in NAMES is syncing, or TIMEOUT seconds elapse. +Return non-nil when every calendar settled, nil when the timeout expired +first. `accept-process-output' is also what lets the fetch and conversion +sentinels run, so this loop drives the pipeline as well as waiting on it." + (let ((deadline (+ (float-time) timeout))) + (while (and (seq-some #'calendar-sync--syncing-p names) + (< (float-time) deadline)) + (accept-process-output nil calendar-sync--batch-poll-seconds)) + (not (seq-some #'calendar-sync--syncing-p names)))) + +;;;###autoload +(defun calendar-sync-batch-run (&optional timeout) + "Sync every configured calendar, blocking until all of them finish. +Return the (NAME . STATUS) rows. TIMEOUT defaults to +`calendar-sync-batch-timeout'. + +This is the entry point for the systemd timer. Prefer `calendar-sync-now' +in an interactive session, where returning immediately is the point." + (unless (calendar-sync--require-calendars) + (error "calendar-sync: no calendars configured")) + (let ((names (calendar-sync--calendar-names))) + (calendar-sync--sync-all-calendars) + (calendar-sync--batch-wait names (or timeout calendar-sync-batch-timeout)) + (calendar-sync--batch-results names))) + +;;;###autoload +(defun calendar-sync-batch-run-and-report () + "Run a batch sync, print one line per calendar, and return an exit code. +0 when every calendar synced, 1 otherwise. Written for +scripts/calendar-sync-run, which turns the code into the process's own exit +status so systemd records a failed sync instead of swallowing it. + +A failed row carries its recorded `:last-error'. The interactive failure +path logs the reason to *Messages', which batch Emacs discards at exit, so +without this the journal shows only `error' — no way to tell a cold +gpg-agent from a revoked feed token or a dead network without re-running the +sync by hand." + (let* ((results (calendar-sync-batch-run)) + (failures (calendar-sync--batch-failures results))) + (dolist (row results) + (let ((reason (unless (eq (cdr row) 'ok) + (plist-get (calendar-sync--get-calendar-state (car row)) + :last-error)))) + (princ (format "%s: %s%s\n" (car row) (cdr row) + (if reason (format " — %s" reason) ""))))) + (if failures 1 0))) + ;;; Timer management (defun calendar-sync--sync-timer-function () @@ -405,6 +518,11 @@ Syncs all calendars immediately, then every `calendar-sync-interval-minutes'." ;; Defer auto-sync until calendar data is first needed. ;; +;; Dormant unless `calendar-sync-auto-start' is turned back on -- the systemd +;; timer owns the schedule now. Kept because the reasoning below still holds +;; for anyone who hands the schedule back to the editor, and because it is the +;; only safe shape for an in-editor start. +;; ;; The :secret-host feed URLs live in authinfo.gpg, and BOTH the immediate sync ;; and every periodic timer tick resolve them. Calling `calendar-sync-start' at ;; load (immediate sync + recurring timer) therefore decrypts authinfo.gpg right @@ -412,6 +530,11 @@ Syncs all calendars immediately, then every `calendar-sync-interval-minutes'." ;; after a reboot). Defer the whole start to the first org-agenda use, so the ;; unlock happens when the user actually asks for calendar data. A manual ;; `calendar-sync-start' / `calendar-sync-now' still works on demand. +;; +;; That deferral is also what made the timer necessary: hanging the start on +;; `org-agenda-mode-hook' means a session where the agenda is never opened +;; never syncs at all, which after a reboot is every session until the first +;; agenda call. The batch path has no such trigger to miss. (defun calendar-sync--auto-start-on-first-agenda () "Start auto-sync on the first org-agenda use, then remove this hook. One-shot: deferring `calendar-sync-start' until the agenda is first built keeps a diff --git a/modules/custom-buffer-file.el b/modules/custom-buffer-file.el index 0ca06cf9..fdcc4d2f 100644 --- a/modules/custom-buffer-file.el +++ b/modules/custom-buffer-file.el @@ -59,7 +59,7 @@ (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 +(require 'system-lib) ;; cj/confirm-destructive (overwrite confirms), used below ;; cj/kill-buffer-and-window and cj/kill-other-window-buffer defined in undead-buffers.el (declare-function cj/kill-buffer-and-window "undead-buffers") @@ -168,7 +168,7 @@ When called interactively, prompts for confirmation if target file exists." (condition-case _ (cj/--move-buffer-and-file dir nil) (file-already-exists - (if (cj/confirm-strong (format "File %s exists; overwrite? " target)) + (if (cj/confirm-destructive (format "File %s exists; overwrite? " target)) (cj/--move-buffer-and-file dir t) (message "File not moved")))))) @@ -208,7 +208,7 @@ When called interactively, prompts for confirmation if target file exists." (condition-case err (cj/--rename-buffer-and-file new-name nil) (file-already-exists - (if (cj/confirm-strong (format "File %s exists; overwrite? " new-name)) + (if (cj/confirm-destructive (format "File %s exists; overwrite? " new-name)) (cj/--rename-buffer-and-file new-name t) (message "File not renamed"))) (error diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el index edbb0b35..6c849198 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -590,6 +590,7 @@ no popup frame is live." ("ps" ,(concat pix-dir "/screenshots/") "pictures screenshots") ("px" ,pix-dir "pictures directory") ("wp" ,(concat pix-dir "/wallpaper/") "pictures wallpaper") + ("wv" ,(concat videos-dir "wallpaper/") "wallpaper videos") ("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") diff --git a/modules/dwim-shell-config.el b/modules/dwim-shell-config.el index 54272fd5..12908f51 100644 --- a/modules/dwim-shell-config.el +++ b/modules/dwim-shell-config.el @@ -22,7 +22,7 @@ ;;; Code: (require 'cl-lib) -(require 'system-lib) ;; cj/confirm-strong (permanent file destruction confirm) +(require 'system-lib) ;; cj/confirm-destructive (permanent file destruction confirm) (require 'external-open) ;; cj/xdg-open, called to open conversion output files ;; Function declarations (lazily-loaded packages and sibling modules). @@ -765,7 +765,7 @@ switching off the .7z format to gpg-wrapped tar." Uses =shred -u= so the file is unlinked after overwriting, matching the \"delete\" the command name and prompt promise." (interactive) - (when (cj/confirm-strong "This will permanently destroy files. Continue? ") + (when (cj/confirm-destructive "This will permanently destroy files. Continue? ") (dwim-shell-command-on-marked-files "Secure delete" "shred -vfzu -n 3 '<<f>>'" diff --git a/modules/google-keep-config.el b/modules/google-keep-config.el index 1738fa6e..c0a5374f 100644 --- a/modules/google-keep-config.el +++ b/modules/google-keep-config.el @@ -46,6 +46,27 @@ Unset until the one-time setup is done; `cj/keep-refresh' warns when nil." :type 'string :group 'cj/keep) +(defcustom cj/keep-local-config-file + (expand-file-name "google-keep.local.el" user-emacs-directory) + "Machine-local Keep config loaded when readable. +The intended place for `cj/keep-python' (a machine-local venv path) and +`cj/keep-email' -- gitignored, same shape as calendar-sync.local.el." + :type 'file + :group 'cj/keep) + +(defun cj/keep--load-local-config () + "Load the machine-local Keep config when available. +Return non-nil when the file loaded cleanly, nil when it is absent or +broken; a broken file is reported via `message', never signaled." + (when (file-readable-p cj/keep-local-config-file) + (condition-case err + (load cj/keep-local-config-file nil t) + (error + (message "google-keep: Failed to load local config %s: %s" + (abbreviate-file-name cj/keep-local-config-file) + (error-message-string err)) + nil)))) + (defvar cj/keep--bridge-script (expand-file-name "scripts/google-keep/keep-bridge.py" user-emacs-directory) "Path to the gkeepapi bridge script.") @@ -202,6 +223,10 @@ Returns the note count." (keymap-global-set "C-c k" cj/keep-prefix-map) +;; Machine-local settings (venv interpreter, email) load before the +;; interpreter warning below, so a venv path set locally is what gets checked. +(cj/keep--load-local-config) + ;; Warn at load if the interpreter is missing; gkeepapi/token failures surface ;; at refresh time via the bridge's stderr reason token. (cj/executable-find-or-warn cj/keep-python "Google Keep bridge" 'google-keep-config) diff --git a/modules/music-config.el b/modules/music-config.el index 233bae72..47863e41 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -31,7 +31,7 @@ (require 'user-constants) (require 'keybindings) ;; provides cj/custom-keymap (require 'cj-window-toggle-lib) ;; side-window size memory (F10 toggle) -(require 'system-lib) ;; cj/confirm-strong (overwrite confirms) +(require 'system-lib) ;; cj/confirm-destructive (overwrite confirms) ;; Declare these foreign package vars special so `let'-binding them below ;; compiles as a dynamic bind, not a dead lexical local -- otherwise emms / @@ -677,18 +677,39 @@ M3U-FILE should be an existing, writable M3U file path." (unless (file-writable-p m3u-file) (error "M3U file is not writable: %s" m3u-file)) - ;; Convert absolute path to relative path from music root - (let ((relative-path (if (file-name-absolute-p track-path) - (file-relative-name track-path cj/music-root) - track-path))) - ;; Determine if we need a leading newline - (let ((needs-prefix-newline nil) - (file-size (file-attribute-size (file-attributes m3u-file)))) - (when (> file-size 0) - ;; Read the last character of the file to check if it ends with newline - (with-temp-buffer - (insert-file-contents m3u-file nil (max 0 (1- file-size)) file-size) - (setq needs-prefix-newline (not (= (char-after (point-min)) ?\n))))) + ;; Relative when the track sits under the playlist's own directory, absolute + ;; otherwise. + ;; + ;; The base is the playlist rather than `cj/music-root' because that is what + ;; both readers resolve against -- `cj/music--m3u-file-tracks' and EMMS's + ;; `emms-source-playlist-parse-m3u'. Inside the music root the two are the + ;; same directory, which is why basing on the root went unnoticed: it only + ;; wrote an unresolvable line once a playlist lived somewhere else. + ;; + ;; Falling back to absolute keeps a cross-tree reference readable, and it + ;; survives the playlist being moved again. A playlist in the mpd directory + ;; pointing into ~/music would otherwise carry a four-level ../ chain that + ;; breaks the moment anything moves. + (let* ((dir (file-name-directory m3u-file)) + (relative-path + (if (not (file-name-absolute-p track-path)) + track-path + (let ((rel (file-relative-name track-path dir))) + (if (string-prefix-p "../" rel) track-path rel))))) + ;; Does the file need a separating newline first? Read the content and look + ;; at its last character, rather than seeking to a byte offset derived from + ;; `file-attributes'. That call does not follow symlinks, so on a + ;; stow-deployed playlist it measures the link string instead of the file: + ;; every symlinked playlist read the wrong byte and gained a blank line per + ;; append, and where the link string was the longer of the two the range fell + ;; outside the file entirely and the append died on a nil `char-after'. + ;; Playlists are small text files, so reading one is cheaper than being + ;; clever about offsets. + (let ((needs-prefix-newline + (with-temp-buffer + (insert-file-contents m3u-file) + (and (> (buffer-size) 0) + (/= (char-before (point-max)) ?\n))))) ;; Append the track with proper newline handling (with-temp-buffer @@ -833,7 +854,7 @@ reloaded playlist keeps its display name and cover art." (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)))) + (not (cj/confirm-destructive (format "Overwrite %s? " filename)))) (user-error "Aborted saving playlist")) (make-directory dir t) (cj/music--write-playlist-file full tracks entries) @@ -875,7 +896,7 @@ clears its file association." (let ((file (cj/music--select-m3u-file "Delete playlist: "))) (if (not file) (message "Playlist deletion cancelled") - (unless (cj/confirm-strong (format "Delete playlist %s? " + (unless (cj/confirm-destructive (format "Delete playlist %s? " (file-name-nondirectory file))) (user-error "Aborted deleting playlist")) (cj/music--delete-playlist-file file) diff --git a/modules/org-config.el b/modules/org-config.el index a9fc4811..55fdf1d0 100644 --- a/modules/org-config.el +++ b/modules/org-config.el @@ -16,6 +16,7 @@ ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap (used in :init below) +(require 'user-constants) ;; provides cj/org-todo-keywords (used in :config) ;; Declare org variables and functions used before org is loaded so this module ;; byte-compiles standalone. Plain `defvar' (no value) marks the symbol special @@ -284,10 +285,9 @@ a no-op identical-state transition (see `cj/org--noop-state-log-p')." "All org-todo related settings are grouped and set in this function." ;; logging task creation, task start, and task resolved states - (setq org-todo-keywords '((sequence "TODO(t)" "PROJECT(p)" "DOING(i)" - "WAITING(w)" "VERIFY(v)" "STALLED(s)" - "DELEGATED(x)" "|" - "FAILED(f!)" "DONE(d!)" "CANCELLED(c!)"))) + ;; Defined in user-constants so a batch Emacs can load the sequence without + ;; this module's package dependencies. See `cj/org-todo-keywords'. + (setq org-todo-keywords cj/org-todo-keywords) ;; Keyword and priority faces are defined and wired in org-faces-config.el ;; (loaded just after this module): each keyword and priority maps to its own diff --git a/modules/package-resilience.el b/modules/package-resilience.el new file mode 100644 index 00000000..d81eeec0 --- /dev/null +++ b/modules/package-resilience.el @@ -0,0 +1,369 @@ +;;; package-resilience.el --- Survive failed package installs at startup -*- lexical-binding: t -*- + +;;; Commentary: +;; A transient package download must not abort init. +;; +;; `use-package-ensure-elpa' already handles a failed install correctly: it +;; wraps `package-install' in `condition-case-unless-debug', and on error it +;; warns and carries on. That guard does nothing whenever `debug-on-error' is +;; non-nil, and early-init.el sets `debug-on-error' for the whole of startup so +;; my own config errors are loud. The two settings collide. On a fresh +;; install one dead download — a file-error from an ELPA host — escaped into +;; the debugger and stopped init in place, leaving a third of the config +;; loaded and hooks pointing at packages that were never installed. +;; +;; I keep both behaviors by narrowing the loud-errors setting rather than +;; dropping it: package installation runs with the debugger inhibited, +;; everything else in init still gets it. A package that will not install is +;; recorded and reported at the end of startup instead of stopping it. + +;;; Code: + +(require 'cl-lib) +(require 'package) +(require 'seq) +(require 'use-package-ensure) + +(defgroup cj/package-resilience nil + "Keep a failed package install from aborting Emacs startup." + :group 'cj + :prefix "cj/package-") + +(defcustom cj/package-install-retries 2 + "How many extra attempts a failed package install gets. +Retries exist for transient network failures, which is the common case on a +fresh install pulling every package over the wire." + :type 'integer + :group 'cj/package-resilience) + +(defcustom cj/package-install-retry-delay 2 + "Seconds to wait between package install attempts." + :type 'number + :group 'cj/package-resilience) + +(defcustom cj/package-install-retry-budget 60 + "Seconds this session may spend retrying installs, in total. +Retrying is worth it for a transient failure, which fails alone. A machine +that is simply offline fails every package instead, and without a ceiling the +per-package retry cost would be paid ~190 times over — trading the abort this +module removes for a startup that appears to hang. Once the budget is spent +each package still gets its one attempt, and still gets recorded." + :type 'number + :group 'cj/package-resilience) + +(defcustom cj/package-install-failure-limit 5 + "Consecutive failed installs after which this session stops attempting more. +The retry budget bounds retrying, but not the first attempt, and the first +attempt is where the cost lives when a machine is entirely offline: nothing +populates `package-archive-contents', so `use-package-ensure-elpa' runs a full +`package-refresh-contents' across every configured archive before each install +fails. Paid once per package across ~190 packages, that is a startup that +looks hung. Failures this many times in a row mean the network is gone rather +than one package being unlucky, so the rest are recorded without being tried." + :type 'integer + :group 'cj/package-resilience) + +(defvar cj/failed-package-installs nil + "Archive packages that did not install during this session.") + +(defvar cj/failed-source-package-installs nil + "Packages declared with `:vc' that did not install during this session. +Kept apart from `cj/failed-package-installs' because `package-install' cannot +recover them: some are on no archive at all, and one that happens to be on an +archive would be recovered as the archive build rather than the source +checkout that was asked for, silently and permanently.") + +(defvar cj/--package-retry-spent 0.0 + "Seconds spent retrying package installs so far this session.") + +(defvar cj/--package-consecutive-failures 0 + "How many packages have failed to install in a row.") + +;; ------------------------------ Resolving names ------------------------------ + +(defun cj/--package-as-symbol (name) + "Return NAME as a symbol, whether it arrives as a symbol or a string. +This mirrors `use-package-as-symbol' without depending on use-package-core +being loaded at the point early-init installs this." + (if (symbolp name) name (intern name))) + +(defun cj/--package-ensure-packages (name args) + "Return the package symbols a use-package form requests. +NAME is the form's name and ARGS the values of its :ensure keywords, in the +shape `use-package-ensure-elpa' receives them: t means the form's own name, a +symbol names another package, a cons cell is a pinned (PACKAGE . ARCHIVE), and +nil requests nothing." + (delq nil + (mapcar (lambda (ensure) + (let ((package (if (eq ensure t) + (cj/--package-as-symbol name) + ensure))) + (if (consp package) (car package) package))) + args))) + +(defun cj/--package-ensure-missing (name args) + "Return the packages NAME's :ensure ARGS request that are not installed." + (seq-remove #'package-installed-p (cj/--package-ensure-packages name args))) + +(defun cj/--package-any-retryable-p (packages) + "Return non-nil when some of PACKAGES is one an archive actually carries. +A name no archive has heard of will not appear on a retry either, so retrying +it only spends another refresh on a typo." + (seq-some (lambda (package) (assq package package-archive-contents)) packages)) + +;; -------------------------------- Installing --------------------------------- + +(defun cj/--package-ensure-once (name args state no-refresh) + "Make one install attempt for NAME's :ensure ARGS, with STATE and NO-REFRESH. +Binding `debug-on-error' to nil re-arms the `condition-case-unless-debug' +inside `use-package-ensure-elpa', which early-init's loud-errors setting +otherwise disables. The editing hooks are silenced because installing a +package generates autoloads by visiting .el files: a hook belonging to a +package that failed earlier would run there and break unrelated installs." + (let ((debug-on-error nil) + (find-file-hook nil) + (prog-mode-hook nil) + (lisp-data-mode-hook nil) + (emacs-lisp-mode-hook nil)) + (use-package-ensure-elpa name args state no-refresh))) + +(defun cj/--package-retry-budget-left-p () + "Return non-nil while this session may still spend time retrying installs." + (< cj/--package-retry-spent cj/package-install-retry-budget)) + +(defun cj/--package-ensure-retry (name args state no-refresh) + "Retry NAME's missing :ensure ARGS, passing STATE and NO-REFRESH through. +Stops once the session's retry budget is spent, or once nothing still missing +is carried by an archive." + (let ((left cj/package-install-retries)) + (while (and (> left 0) + (cj/--package-retry-budget-left-p) + (cj/--package-any-retryable-p (cj/--package-ensure-missing name args))) + (setq left (1- left)) + (let ((start (float-time))) + (sleep-for cj/package-install-retry-delay) + (cj/--package-ensure-once name args state no-refresh) + (setq cj/--package-retry-spent + (+ cj/--package-retry-spent (- (float-time) start))))))) + +(defun cj/--package-record-one (package) + "Record PACKAGE as one that did not install." + (when package + (cl-pushnew package cj/failed-package-installs))) + +(defun cj/--package-record-source-one (package) + "Record PACKAGE as a source install that did not complete." + (when package + (cl-pushnew package cj/failed-source-package-installs))) + +(defun cj/--package-record-failures (name args) + "Record any of NAME's :ensure ARGS that are still not installed." + (dolist (package (cj/--package-ensure-missing name args)) + (cj/--package-record-one package))) + +(defun cj/--package-giving-up-p () + "Return non-nil once enough installs have failed in a row to stop trying." + (>= cj/--package-consecutive-failures cj/package-install-failure-limit)) + +(defun cj/--package-note-outcome (name args) + "Count NAME's :ensure ARGS outcome toward the consecutive-failure run." + (if (cj/--package-ensure-missing name args) + (setq cj/--package-consecutive-failures + (1+ cj/--package-consecutive-failures)) + (setq cj/--package-consecutive-failures 0))) + +(defun cj/package-ensure (name args state &optional no-refresh) + "Install NAME's :ensure ARGS without letting a failure abort startup. +STATE and NO-REFRESH are passed through to `use-package-ensure-elpa'. This is +the value of `use-package-ensure-function'; see this file's commentary for why +the stock one cannot survive `debug-on-error'. + +A form whose packages are already present is left alone entirely, so it neither +costs anything nor tells us whether the network is up." + (cond + ((null (cj/--package-ensure-missing name args)) nil) + ((cj/--package-giving-up-p) (cj/--package-record-failures name args)) + (t + (cj/--package-ensure-once name args state no-refresh) + (cj/--package-ensure-retry name args state no-refresh) + (cj/--package-note-outcome name args) + (cj/--package-record-failures name args)))) + +;; ------------------------- Packages installed from source -------------------- + +;; A `:vc' form routes around everything above: use-package nulls :ensure +;; whenever :vc is present (use-package-ensure.el, `use-package-handler/:ensure'), +;; so `use-package-ensure-function' is never consulted. And +;; `use-package-vc-install' carries no error handling of its own, so a failed +;; clone signals straight into init under the loud-errors setting -- the +;; original bug, through a second door. A fresh machine without credentials +;; for the git host yet is exactly the case this module exists for, so the +;; clone gets the same treatment: quiet context, recorded, counted. + +(defun cj/--package-vc-install-once (orig arg local-path) + "Call ORIG with ARG and LOCAL-PATH, surviving a failed clone. +Returns non-nil when the clone worked. Unlike the :ensure path there is no +upstream `condition-case' to re-arm, so this supplies one." + (let ((debug-on-error nil) + (find-file-hook nil) + (prog-mode-hook nil) + (lisp-data-mode-hook nil) + (emacs-lisp-mode-hook nil)) + (condition-case err + (progn (funcall orig arg local-path) t) + (error + (display-warning + 'cj/package-resilience + (format "Failed to install %s from source: %s" + (car arg) (error-message-string err)) + :error) + nil)))) + +(defun cj/--package-vc-install-guard (orig arg &optional local-path) + "Around-advice for `use-package-vc-install', called as ORIG. +ARG is (NAME OPTIONS REVISION) and LOCAL-PATH is passed through." + (let ((package (car arg))) + (cond + ;; Already present: ORIG no-ops, and it would tell us nothing about + ;; whether the host is reachable, so the failure run is left alone. + ((and package (package-installed-p package)) + (funcall orig arg local-path)) + ((cj/--package-giving-up-p) + (cj/--package-record-source-one package)) + (t + (cj/--package-vc-install-once orig arg local-path) + (if (and package (package-installed-p package)) + (setq cj/--package-consecutive-failures 0) + (cj/--package-record-source-one package) + (setq cj/--package-consecutive-failures + (1+ cj/--package-consecutive-failures))))))) + +;; --------------------------------- Recovery ---------------------------------- + +(defun cj/package-still-missing () + "Return the recorded failures that are still not installed. +A package that failed on its own `use-package' form is often installed a +moment later as some other package's dependency, so the recorded list +overstates the damage until it is re-checked against reality." + ;; `append' does not copy its last argument and `delete-dups' splices + ;; destructively, so without the copy this read would edit + ;; `cj/failed-source-package-installs' in place -- and it runs from the + ;; startup report, where losing a record silently is the worst place for it. + (seq-remove #'package-installed-p + (delete-dups + (append cj/failed-package-installs + (copy-sequence cj/failed-source-package-installs))))) + +(defun cj/--package-install-quietly (package) + "Attempt to install PACKAGE. Return non-nil if it is installed afterward." + (unless (package-installed-p package) + (let ((debug-on-error nil) + (find-file-hook nil) + (prog-mode-hook nil) + (lisp-data-mode-hook nil) + (emacs-lisp-mode-hook nil)) + (condition-case err + (package-install package) + (error (message "package-resilience: %s still failing: %s" + package (error-message-string err)))))) + (package-installed-p package)) + +(defun cj/--package-retry-pass () + "Try every package in `cj/failed-package-installs' once. +Return how many were installed on this pass." + (let ((installed 0)) + ;; Only the archive list. Source packages are kept out of it entirely, so + ;; no filter is needed here -- and a filter would be actively wrong: on a + ;; first boot before the network came up nothing has populated + ;; `package-archive-contents', so screening on it would skip every recorded + ;; package and make this command a silent no-op in the case it exists for. + ;; `package-install' populates the archives itself when it needs to. + (dolist (package (copy-sequence cj/failed-package-installs)) + (when (cj/--package-install-quietly package) + (setq cj/failed-package-installs + (delq package cj/failed-package-installs)) + (setq installed (1+ installed)))) + installed)) + +(defun cj/retry-failed-package-installs () + "Install everything that failed earlier, passing over the set until it settles. +A failed package leaves hooks that break other installs, so one package +succeeding can unblock others. Passes repeat while any pass installs +something, which also terminates: a pass that installs nothing ends it." + (interactive) + ;; Asking for a retry asserts the network may be back, so clear the run that + ;; stopped this session attempting installs in the first place. + (setq cj/--package-consecutive-failures 0) + (while (> (cj/--package-retry-pass) 0)) + (when (called-interactively-p 'interactive) + (let ((missing (cj/package-still-missing))) + (message (if missing + (format "Still missing: %s" + (mapconcat #'symbol-name missing " ")) + "All packages installed."))))) + +(defun cj/report-failed-package-installs () + "Warn about packages that failed to install, naming every one of them. +Only packages that are still absent are named; one that arrived later as +another package's dependency is not a failure the user needs to act on." + (let* ((missing (cj/package-still-missing)) + (source (seq-filter (lambda (p) + (memq p cj/failed-source-package-installs)) + missing)) + (archive (seq-difference missing source))) + (when missing + (display-warning + 'cj/package-resilience + (concat + (format "%d package(s) are missing: %s +Startup continued without them, so features they back are missing." + (length missing) (mapconcat #'symbol-name missing ", ")) + ;; Two different recoveries, so name which packages each one covers. + ;; Sending the user to the retry command for a source package wastes + ;; their time every startup: it cannot install one. + (when archive + (format " +Run M-x cj/retry-failed-package-installs for: %s" + (mapconcat #'symbol-name archive ", "))) + (when source + (format " +These install from source, so they need working credentials for the git host +and then 'make bootstrap': %s" + (mapconcat #'symbol-name source ", "))) + (when (cj/--package-giving-up-p) + (format " +Installing stopped after %d failures in a row, so most of these were never +attempted. Check the network and your credentials for the git host." + cj/package-install-failure-limit))) + :error)))) + +;; -------------------------------- Bootstrap ---------------------------------- + +(defun cj/package-bootstrap-batch () + "Entry point for the bootstrap script: retry, report, and exit. +Loading init.el in batch installs whatever `use-package' asks for; this retries +anything that pass missed and turns the outcome into an exit status the shell +can loop on. Exits 0 when nothing is missing, 1 otherwise." + (cj/retry-failed-package-installs) + (let ((missing (cj/package-still-missing))) + (if missing + (progn + (message "package-bootstrap: %d missing: %s" + (length missing) + (mapconcat #'symbol-name missing " ")) + (kill-emacs 1)) + (message "package-bootstrap: all packages installed") + (kill-emacs 0)))) + +;; --------------------------------- Wiring ------------------------------------ + +(setq use-package-ensure-function #'cj/package-ensure) + +;; Named function, never a lambda: an anonymous advice cannot be removed by +;; reference, so a live daemon would keep running it after the form is deleted. +(advice-add 'use-package-vc-install :around #'cj/--package-vc-install-guard) + +(add-hook 'emacs-startup-hook #'cj/report-failed-package-installs 90) + +(provide 'package-resilience) +;;; package-resilience.el ends here diff --git a/modules/system-commands.el b/modules/system-commands.el index edc6339d..08a1be5d 100644 --- a/modules/system-commands.el +++ b/modules/system-commands.el @@ -39,7 +39,7 @@ ;; require keeps the module loadable on its own (tests, byte-compile) rather ;; than relying on init.el's load order. (require 'host-environment) -;; `system-lib' provides `cj/confirm-strong', used at runtime by the `strong' +;; `system-lib' provides `cj/confirm-destructive', used at runtime by the `strong' ;; confirm branch of `cj/system-cmd' for irreversible actions (shutdown/reboot). (require 'system-lib) (eval-when-compile (require 'subr-x)) @@ -76,10 +76,11 @@ If CMD is deemed dangerous, ask for confirmation." (label (nth 2 resolved))) (let ((confirm (and sym (get sym 'cj/system-confirm)))) (cond - ;; Strong confirm for irreversible actions (shutdown, reboot): - ;; require an explicit "yes", so a stray RET/space can't trigger them. + ;; Strong confirm for irreversible actions (shutdown, reboot): one + ;; keystroke, but with no default, so a stray RET/space can't trigger + ;; them and type-ahead is discarded before the read. ((eq confirm 'strong) - (unless (cj/confirm-strong (format "Really run %s (%s)? " label cmdstr)) + (unless (cj/confirm-destructive (format "Really run %s (%s)? " label cmdstr)) (user-error "Aborted"))) ;; Quick (Y/n) confirm for recoverable actions (logout, suspend). (confirm @@ -96,9 +97,11 @@ If CMD is deemed dangerous, ask for confirmation." (defmacro cj/defsystem-command (name var cmdstr &optional confirm) "Define VAR with CMDSTR and interactive command NAME to run it. -CONFIRM controls the confirmation prompt: t for a quick (Y/n) prompt, -the symbol `strong' for an explicit yes-or-no-p (used for irreversible -actions like shutdown and reboot), nil for no confirmation." +CONFIRM controls the confirmation prompt: t for a quick (Y/n) prompt where +RET and space mean yes, the symbol `strong' for `cj/confirm-destructive' +\(used for irreversible actions like shutdown and reboot), nil for no +confirmation. Both are one keystroke; the difference is that `strong' has +no default, so RET and space re-prompt rather than confirming." (declare (indent defun)) `(progn (defvar ,var ,cmdstr) diff --git a/modules/system-defaults.el b/modules/system-defaults.el index 9b4652e8..d9ec1878 100644 --- a/modules/system-defaults.el +++ b/modules/system-defaults.el @@ -227,8 +227,9 @@ appears only once per session." (setq ad-redefinition-action 'accept) ;; silence warnings about advised functions getting redefined. (setq large-file-warning-threshold nil) ;; open files regardless of size (setq use-short-answers t) ;; single-key y/n for ordinary yes-or-no-p prompts - ;; (irreversible actions use `cj/confirm-strong', which - ;; forces a typed "yes" by binding this nil for that call) + ;; (irreversible actions use `cj/confirm-destructive', + ;; also one key, but it ignores RET and space so a stray + ;; keystroke re-prompts instead of confirming) (setq auto-revert-verbose nil) ;; turn off auto revert messages (setq custom-safe-themes t) ;; treat all themes as safe (stop asking) (setq server-client-instructions nil) ;; I already know what to do when done with the frame diff --git a/modules/system-lib.el b/modules/system-lib.el index 54e20b74..c6021c9c 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -8,7 +8,8 @@ ;; Eager reason: low-level helpers (executable lookup, process output, silent ;; logging) used by many eager modules during startup. ;; Top-level side effects: none. -;; Runtime requires: none (auth-source loaded on demand inside the helper). +;; Runtime requires: none at load (auth-source is required on demand inside +;; `cj/auth-source-secret-value', so the cost lands only on callers that use it). ;; Direct test load: yes (pure helpers; batch-safe). ;; ;; This module provides low-level system utility functions for checking @@ -125,21 +126,51 @@ This does so without echoing in the minibuffer." With USER, also match on the login. Resolves a function-valued secret \(the netrc backend returns the secret as a function\) by calling it. Callers that must have a secret layer their own error on top." + ;; Loaded here rather than at the top of the file, so a module that merely + ;; requires system-lib does not pay for auth-source. It has to be loaded + ;; *somewhere*, though: `declare-function' only quiets the byte-compiler. + ;; An interactive Emacs always has auth-source in by the time anyone calls + ;; here, which hid the omission until a batch `-Q' sync tried to resolve a + ;; `:secret-host' feed and died on a void `auth-source-search'. + ;; + ;; Guarded on `fboundp' rather than calling `require' unconditionally: a + ;; bare require re-loads auth-source.el over whatever is already in place, + ;; which replaces a caller's stubbed `auth-source-search' mid-call and sends + ;; a test that meant to fake the lookup out to the real authinfo instead. + (unless (fboundp 'auth-source-search) + (require 'auth-source)) (let* ((spec (append (list :host host :require '(:secret) :max 1) (when user (list :user user)))) (secret (plist-get (car (apply #'auth-source-search spec)) :secret))) (if (functionp secret) (funcall secret) secret))) -;; ---------------------------- Strong Confirmation ---------------------------- +;; -------------------------- Destructive Confirmation ------------------------- -(defun cj/confirm-strong (prompt) - "Ask PROMPT, requiring a full typed \"yes\" or \"no\" answer. -For irreversible actions -- file destruction, overwrites, power-off. The -global default makes `yes-or-no-p' a single keystroke (`use-short-answers' -is t); this binds it to nil for the one call so the prompt demands the -long-form answer, keeping a stray RET or space from confirming." - (let ((use-short-answers nil)) - (yes-or-no-p prompt))) +(defun cj/confirm-destructive (prompt) + "Ask PROMPT for an irreversible action. Return non-nil for yes. + +One keystroke, y or n. Nothing else answers: a stray RET or space +re-prompts rather than confirming, so the accidental-confirm protection +survives without the answer costing four keystrokes. + +Pending input is discarded first, and that line is load-bearing. +`read-char-choice' reads from the input queue, so without it a keystroke +typed before the prompt appeared would confirm a shutdown or a file +deletion instantly. The typed-\"yes\" form this replaced absorbed such a +key harmlessly, and dropping the guard without replacing it would have +traded a rare annoyance for a rare catastrophe. + +This used to demand a typed \"yes\", and that was a worse trade than it +looked. On 2026-07-31 one such prompt went unanswered -- a second agent +session held the selected window while the prompt waited in another frame, +so keystrokes went to a terminal instead of the minibuffer, and the session +was killed with buffers unsaved. A single keystroke does not make a prompt +reachable when focus is elsewhere; C-g is still the escape either way. What +it changes is the cost of the situation, and losing unsaved buffers is a far +bigger hazard than a mis-keyed confirm." + (discard-input) + (eq ?y (downcase (read-char-choice (concat prompt "(y or n) ") + '(?y ?Y ?n ?N))))) (defun cj/--font-lock-global-modes-excluding (current mode) "Return CURRENT `font-lock-global-modes' with MODE added to the exclusion. diff --git a/modules/user-constants.el b/modules/user-constants.el index 570b142f..ec387930 100644 --- a/modules/user-constants.el +++ b/modules/user-constants.el @@ -275,5 +275,23 @@ and portable across different machines." ;; bare `(require 'user-constants)' (tests, byte-compile, batch) stays ;; side-effect-free. +(defconst cj/org-todo-keywords + '((sequence "TODO(t)" "PROJECT(p)" "DOING(i)" + "WAITING(w)" "VERIFY(v)" "STALLED(s)" + "DELEGATED(x)" "|" + "FAILED(f!)" "DONE(d!)" "CANCELLED(c!)")) + "The TODO keyword sequence, kept where a batch Emacs can reach it. + +`org-config' sets `org-todo-keywords' from this, and so does any batch process +that has to read the org files the way the editor does. It lives here rather +than in `org-config' because that module loads through `use-package' and needs +packages a batch run has no reason to install. + +The duplication this avoids is not cosmetic. A reader that does not know +DOING is a keyword does not merely mislabel it: org stops parsing the headline +as a task at all, so the keyword and the priority cookie stay glued to the +front of the title and the entry reads as not-done regardless of its real +state.") + (provide 'user-constants) ;;; user-constants.el ends here diff --git a/modules/video-audio-recording.el b/modules/video-audio-recording.el index 10c10854..65a8612f 100644 --- a/modules/video-audio-recording.el +++ b/modules/video-audio-recording.el @@ -300,6 +300,41 @@ Changes take effect on the next recording (not the current one)." (cj/register-prefix-map "r" cj/record-map) +;; Fast chords for the two toggles, alongside C-; r v and C-; r a. F9 is free: +;; ai-term vacated the F9 family when its swap moved to M-SPC, and +;; `test-ai-term-f9-family-removed-globally' keeps it vacated. Both commands +;; still take a prefix argument, so C-u F9 prompts for the recording location. +(keymap-global-set "<f9>" #'cj/video-recording-toggle) +(keymap-global-set "S-<f9>" #'cj/audio-recording-toggle) + +(defvar eat-mode-map) +(defvar eat-semi-char-mode-map) +(defvar eat-char-mode-map) +(defvar eat-eshell-char-mode-map) + +;; EAT builds each input mode's keymap from key categories, and which categories +;; a mode claims is what decides whether a chord reaches Emacs at all. +;; +;; Semi-char mode -- the default, and where every agent buffer sits -- is built +;; from :ascii, :arrow and :navigation. It never claims function keys, so F9 +;; already fell through to the global map. The semi-char entry below is +;; belt-and-braces rather than the fix, which is why it reads as redundant. +;; +;; Char mode is the one that swallows F9. It adds :function, binding f1 through +;; f63 to eat-self-input, and it is a minor mode, so its map outranks +;; eat-mode-map. Without an entry here the pair splits in the worst possible +;; way: :function claims only the unmodified keys, so S-F9 would toggle audio in +;; a char-mode buffer while F9 went to the program under the cursor. That is a +;; recording you believe you started and didn't. +;; +;; Claiming both costs a char-mode program the use of F9. I would rather pay +;; that than ship a toggle that works for audio and silently fails for video. +(with-eval-after-load 'eat + (dolist (map (list eat-semi-char-mode-map eat-mode-map + eat-char-mode-map eat-eshell-char-mode-map)) + (keymap-set map "<f9>" #'cj/video-recording-toggle) + (keymap-set map "S-<f9>" #'cj/audio-recording-toggle))) + (with-eval-after-load 'which-key (which-key-add-key-based-replacements "C-; r" "recording menu" |