aboutsummaryrefslogtreecommitdiff
path: root/modules
diff options
context:
space:
mode:
Diffstat (limited to 'modules')
-rw-r--r--modules/agenda-query.el607
-rw-r--r--modules/calendar-sync.el149
-rw-r--r--modules/config-utilities.el28
-rw-r--r--modules/custom-buffer-file.el6
-rw-r--r--modules/dirvish-config.el1
-rw-r--r--modules/dwim-shell-config.el4
-rw-r--r--modules/eat-config.el21
-rw-r--r--modules/google-keep-config.el25
-rw-r--r--modules/music-config.el51
-rw-r--r--modules/org-config.el8
-rw-r--r--modules/package-resilience.el369
-rw-r--r--modules/prog-general.el8
-rw-r--r--modules/system-commands.el17
-rw-r--r--modules/system-defaults.el29
-rw-r--r--modules/system-lib.el51
-rw-r--r--modules/telega-config.el63
-rw-r--r--modules/undead-buffers.el20
-rw-r--r--modules/user-constants.el18
-rw-r--r--modules/video-audio-recording.el35
-rw-r--r--modules/weather-config.el7
20 files changed, 1430 insertions, 87 deletions
diff --git a/modules/agenda-query.el b/modules/agenda-query.el
new file mode 100644
index 00000000..c98b7fb7
--- /dev/null
+++ b/modules/agenda-query.el
@@ -0,0 +1,607 @@
+;;; agenda-query.el --- Agenda window as JSON for external renderers -*- lexical-binding: t; coding: utf-8; -*-
+;; author: Craig Jennings <c@cjennings.net>
+;;
+;;; Commentary:
+;;
+;; Layer: 3 (Domain Workflow).
+;; Category: D/S.
+;; Load shape: eager module, lazy dependencies.
+;; Eager reason: the entry point must exist for a headless emacsclient --eval.
+;; Org is required at call time, so loading the BYTE-COMPILED module costs no
+;; startup; loading it from source pays the eval-when-compile requires below.
+;; Top-level side effects: none once compiled.
+;; Runtime requires: org, org-element, org-agenda, calendar -- all deferred.
+;; 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. 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
+;; conversion, and nothing downstream needs to know org's timestamps are naive
+;; local time. DST changeovers stop being a special case for the same reason.
+;;
+;; The window predicate is intersection, not containment: an event is in the
+;; window when it is running at any point during it, so a 23:00-01:00 event
+;; belongs to both days it touches. An all-day entry's extent is its whole day.
+
+;;; Code:
+
+;; Compile-time only, so the byte-compiler sees org's functions while a plain
+;; load of this file still pulls in nothing.
+(eval-when-compile
+ (require 'org)
+ (require 'org-element)
+ (require 'org-agenda)
+ (require 'calendar))
+
+(declare-function org-element--property "org-element-ast")
+(declare-function org-element-map "org-element")
+(declare-function org-element-parse-buffer "org-element")
+(declare-function org-element-type "org-element-ast")
+(declare-function org-entry-get "org")
+(declare-function org-agenda--timestamp-to-absolute "org-agenda")
+(declare-function org-agenda-files "org")
+(declare-function org-get-agenda-file-buffer "org")
+(declare-function calendar-gregorian-from-absolute "calendar")
+(declare-function calendar-absolute-from-gregorian "calendar")
+
+(defconst cj/agenda-query-max-window-seconds (* 366 24 60 60)
+ "Widest window `cj/agenda-window-json' will answer, in seconds.
+
+A guard against a units mistake rather than a policy limit. The consumers are
+Python and JavaScript, and `Date.now' returns MILLISECONDS -- passing that
+unconverted asks for a window tens of thousands of years wide, which builds
+millions of rows and wedges the Emacs daemon Craig is working in. Failing
+loudly costs a renderer one bad frame; the alternative costs him his editor.")
+
+(defconst cj/agenda-query-epoch-floor -2208988800
+ "Earliest epoch second `cj/agenda-window-json' accepts (1900-01-01).")
+
+(defconst cj/agenda-query-epoch-ceiling 7258118400
+ "Latest epoch second `cj/agenda-window-json' accepts (2200-01-01).
+
+Width alone does not catch the units mistake. Passing `Date.now()' for BOTH
+bounds an hour apart is a plausible-looking 41-day window made of milliseconds,
+which sails past the width cap and answers with timestamps in the year 58549.
+Bounding the magnitude catches that shape, while still spanning any date an
+agenda could legitimately hold.")
+
+(defun cj/--agenda-query-load-org ()
+ "Load org at call time.
+Kept off the top level so requiring this module costs nothing at startup --
+the entry point runs headless, long after Emacs is up. Idempotent."
+ (require 'org)
+ (require 'org-element)
+ (require 'org-agenda)
+ (require 'calendar))
+
+;;; ---------- time helpers ----------
+
+(defun cj/--agenda-query-epoch (sec min hour day month year)
+ "Return the epoch second for local time SEC MIN HOUR DAY MONTH YEAR.
+Out-of-range fields normalize, so day 32 of July is the 1st of August."
+ (time-convert (encode-time (list sec min hour day month year nil -1 nil))
+ 'integer))
+
+(defun cj/--agenda-query-day-close (day month year)
+ "Return the last epoch second of the local day DAY MONTH YEAR.
+Reached through the following midnight rather than by adding 86400, so a DST
+changeover day is 23 or 25 hours long as it actually is."
+ (1- (cj/--agenda-query-epoch 0 0 0 (1+ day) month year)))
+
+(defun cj/--agenda-query-epoch-to-absolute (epoch)
+ "Return the absolute day number containing EPOCH, in local time."
+ (let ((d (decode-time epoch)))
+ (calendar-absolute-from-gregorian (list (nth 4 d) (nth 3 d) (nth 5 d)))))
+
+(defun cj/--agenda-query-day-close-of (absolute)
+ "Return the last epoch second of the ABSOLUTE day number."
+ (let ((g (calendar-gregorian-from-absolute absolute)))
+ (cj/--agenda-query-day-close (nth 1 g) (nth 0 g) (nth 2 g))))
+
+(defun cj/--agenda-query-at-time-on (absolute hour minute)
+ "Return the epoch of HOUR:MINUTE local on the ABSOLUTE day number."
+ (let ((g (calendar-gregorian-from-absolute absolute)))
+ (cj/--agenda-query-epoch 0 minute hour (nth 1 g) (nth 0 g) (nth 2 g))))
+
+;;; ---------- timestamp bounds ----------
+
+(defun cj/--agenda-query-timestamp-bounds (timestamp)
+ "Return a bounds plist for org-element TIMESTAMP, or nil when it is nil.
+
+Keys are :start, :end, :all-day and :effective-end, all epoch seconds except
+:all-day. :end is nil when the source carries no range at all; where the
+source does carry one, an all-day range's end is the close of its last day,
+since a day is its own extent. :effective-end is what the window predicate
+uses: the explicit end, or an all-day entry's day close, or a timed point
+event's own instant.
+
+One deliberate divergence from org's literal parse: org records
+<2026-07-31 Fri 23:00-01:00> with its end on the SAME day, which would put the
+end 22 hours before the start. A negative duration is useless to any
+consumer, so an end that precedes its start is read as crossing midnight."
+ (when timestamp
+ (let* ((y0 (org-element-property :year-start timestamp))
+ (m0 (org-element-property :month-start timestamp))
+ (d0 (org-element-property :day-start timestamp))
+ (h0 (org-element-property :hour-start timestamp))
+ (mi0 (org-element-property :minute-start timestamp))
+ (y1 (org-element-property :year-end timestamp))
+ (m1 (org-element-property :month-end timestamp))
+ (d1 (org-element-property :day-end timestamp))
+ (h1 (org-element-property :hour-end timestamp))
+ (mi1 (org-element-property :minute-end timestamp))
+ (all-day (null h0))
+ (start (cj/--agenda-query-epoch 0 (or mi0 0) (or h0 0) d0 m0 y0))
+ (ranged (or (not (equal (list y0 m0 d0) (list y1 m1 d1)))
+ (and h1 (not (equal (list h0 mi0) (list h1 mi1))))))
+ (same-day (equal (list y0 m0 d0) (list y1 m1 d1)))
+ (end (when ranged
+ (if all-day
+ ;; A reversed all-day range (a typo, or a bad ICS
+ ;; import) would otherwise report an end days before
+ ;; its start, and the negative extent would drop the
+ ;; entry from the very window it opens in.
+ (let ((e (cj/--agenda-query-day-close d1 m1 y1)))
+ (and (>= e start) e))
+ (let ((e (cj/--agenda-query-epoch
+ 0 (or mi1 0) (or h1 0) d1 m1 y1)))
+ ;; Roll only a SAME-DAY range: that is the shape org
+ ;; records for <23:00-01:00>. Rolling a genuinely
+ ;; reversed multi-day range would just shift a wrong
+ ;; date by a day and leave it wrong.
+ (when (and same-day (< e start))
+ (setq e (cj/--agenda-query-epoch
+ 0 (or mi1 0) (or h1 0) (1+ d1) m1 y1)))
+ ;; A range that still ends before it starts is
+ ;; malformed. Report the entry as a point rather than
+ ;; hand a consumer a negative-duration bar.
+ (and (>= e start) e))))))
+ (list :start start
+ :end end
+ :all-day (and all-day t)
+ :effective-end (or end
+ (if all-day
+ (cj/--agenda-query-day-close d0 m0 y0)
+ start))))))
+
+(defun cj/--agenda-query-repeater-cookie (timestamp)
+ "Return TIMESTAMP's raw repeater cookie as a string, or nil when it has none."
+ (when timestamp
+ (let ((type (org-element-property :repeater-type timestamp))
+ (value (org-element-property :repeater-value timestamp))
+ (unit (org-element-property :repeater-unit timestamp)))
+ (when (and type value unit)
+ (concat (pcase type
+ ('cumulate "+")
+ ('catch-up "++")
+ ('restart ".+")
+ (_ "+"))
+ (number-to-string value)
+ (pcase unit
+ ('hour "h") ('day "d") ('week "w")
+ ('month "m") ('year "y") (_ "")))))))
+
+;;; ---------- window intersection and repeat expansion ----------
+
+(defun cj/--agenda-query-intersects-p (start effective-end win-start win-end)
+ "Return non-nil when START..EFFECTIVE-END overlaps WIN-START..WIN-END."
+ (and (>= effective-end win-start)
+ (<= start win-end)))
+
+(defun cj/--agenda-query-occurrence-on (day base bounds)
+ "Return the (START . END) cons and effective end for an occurrence on DAY.
+
+DAY is an absolute day number, BASE the base occurrence's own absolute day,
+and BOUNDS its `cj/--agenda-query-timestamp-bounds' plist. Returns a plist
+of :start, :end and :effective-end.
+
+Every field is rebuilt from calendar dates rather than by adding the base's
+duration in seconds. A fixed offset is wrong across a DST boundary: an
+all-day occurrence on a 25-hour day would end an hour early, and on a 23-hour
+day it would spill into the next."
+ (let* ((start (plist-get bounds :start))
+ (end (plist-get bounds :end))
+ (all-day (plist-get bounds :all-day))
+ (decoded (decode-time start))
+ (span (if end
+ (- (cj/--agenda-query-epoch-to-absolute end) base)
+ 0))
+ (occ-start (cj/--agenda-query-at-time-on
+ day (nth 2 decoded) (nth 1 decoded)))
+ (occ-end (when end
+ (if all-day
+ (cj/--agenda-query-day-close-of (+ day span))
+ (let ((de (decode-time end)))
+ (cj/--agenda-query-at-time-on
+ (+ day span) (nth 2 de) (nth 1 de)))))))
+ (list :start occ-start
+ :end occ-end
+ :effective-end (or occ-end
+ (if all-day
+ (cj/--agenda-query-day-close-of day)
+ occ-start)))))
+
+(defun cj/--agenda-query-repeat-occurrences (timestamp bounds win-start win-end)
+ "Return every occurrence of repeating TIMESTAMP inside the window.
+
+BOUNDS is its `cj/--agenda-query-timestamp-bounds' plist. Each candidate day
+is offered to `org-agenda--timestamp-to-absolute', which is org's own repeater
+arithmetic -- so an occurrence lands exactly where Craig's agenda shows it
+rather than where a reimplementation would put it. A day is an occurrence
+when org maps it to itself.
+
+All three repeater styles expand from the base timestamp, including `.+':
+org rewrites a restart repeater's base when the task is completed, so for an
+open task the base already IS the last repeat.
+
+The scan starts before the window by the event's own day span, so an
+occurrence that began earlier and is still running is found -- the same
+intersects-not-contains rule the non-repeating path follows.
+
+Repeats are resolved at day granularity, matching org's agenda: an hourly
+repeater therefore contributes one row per day rather than one per hour.
+
+Returns one cons per occurrence, oldest first. One row per occurrence is
+deliberate -- a count is derivable from rows, rows are not derivable from a
+count."
+ (cj/--agenda-query-load-org)
+ (let* ((raw (org-element-property :raw-value timestamp))
+ (start (plist-get bounds :start))
+ (end (plist-get bounds :end))
+ (base-day (cj/--agenda-query-epoch-to-absolute start))
+ (span (if end
+ (- (cj/--agenda-query-epoch-to-absolute end) base-day)
+ 0))
+ (first-day (- (cj/--agenda-query-epoch-to-absolute win-start)
+ (1+ (max span 0))))
+ (last-day (cj/--agenda-query-epoch-to-absolute win-end))
+ (results '()))
+ (dotimes (offset (max 0 (1+ (- last-day first-day))))
+ (let* ((day (+ first-day offset))
+ (hit (when (>= day base-day)
+ (catch :skip
+ (org-agenda--timestamp-to-absolute raw day 'future)))))
+ (when (and (integerp hit) (= hit day))
+ (let ((occ (cj/--agenda-query-occurrence-on day base-day bounds)))
+ (when (cj/--agenda-query-intersects-p
+ (plist-get occ :start) (plist-get occ :effective-end)
+ win-start win-end)
+ (push (cons (plist-get occ :start) (plist-get occ :end))
+ results))))))
+ (nreverse results)))
+
+(defun cj/--agenda-query-occurrences (timestamp win-start win-end)
+ "Return TIMESTAMP's (START . END) epoch conses inside the window.
+END is nil for an occurrence the source gave no range. A non-repeating
+timestamp yields at most one cons; a repeating one yields every occurrence."
+ (let ((bounds (cj/--agenda-query-timestamp-bounds timestamp)))
+ (when (and bounds (<= win-start win-end))
+ (if (cj/--agenda-query-repeater-cookie timestamp)
+ (cj/--agenda-query-repeat-occurrences timestamp bounds win-start win-end)
+ (when (cj/--agenda-query-intersects-p (plist-get bounds :start)
+ (plist-get bounds :effective-end)
+ win-start win-end)
+ (list (cons (plist-get bounds :start) (plist-get bounds :end))))))))
+
+;;; ---------- collecting events from a buffer ----------
+
+(defun cj/--agenda-query-ancestor-headline (element)
+ "Return the nearest headline ancestor of ELEMENT, or nil when there is none."
+ (let ((node element))
+ (while (and node (not (eq (org-element-type node) 'headline)))
+ (setq node (org-element-property :parent node)))
+ node))
+
+(defun cj/--agenda-query-visible-p (headline)
+ "Return non-nil unless HEADLINE sits in an archived or commented subtree.
+
+Org's agenda skips both, and this query is only useful to the extent it
+agrees with the agenda Craig actually sees. Ancestors count: archiving or
+commenting a parent takes its whole subtree off the agenda."
+ (let ((node headline)
+ (visible t))
+ (while (and node visible)
+ (when (eq (org-element-type node) 'headline)
+ (when (or (org-element-property :archivedp node)
+ (org-element-property :commentedp node))
+ (setq visible nil)))
+ (setq node (org-element-property :parent node)))
+ visible))
+
+(defun cj/--agenda-query-active-p (timestamp)
+ "Return non-nil when TIMESTAMP is active -- the kind org agendas show.
+Inactive stamps and diary sexps are excluded: the first never reaches an
+agenda, and the second cannot be reduced to a plain instant."
+ (memq (org-element-property :type timestamp) '(active active-range)))
+
+(defun cj/--agenda-query-title (headline)
+ "Return HEADLINE's title as display text.
+
+`:raw-value' already drops the keyword, priority cookie and tags, but keeps
+org link syntax verbatim -- a captured web item arrives as
+\"[[https://…][Tracking your habits]]\". Org's own agenda shows the
+description, and a renderer has no business parsing org markup, so the link
+is reduced here."
+ (let ((raw (or (org-element-property :raw-value headline) "")))
+ (if (fboundp 'org-link-display-format)
+ (org-link-display-format raw)
+ raw)))
+
+(defun cj/--agenda-query-event (headline file type timestamp occurrence)
+ "Build one JSON-ready event alist.
+HEADLINE supplies the title and completion state, FILE the source path, TYPE
+the string \"scheduled\", \"deadline\" or \"timestamp\", TIMESTAMP the repeater
+cookie, and OCCURRENCE the (START . END) epochs this row renders."
+ (let* ((begin (org-element-property :begin headline))
+ (keyword (org-element-property :todo-keyword headline))
+ (location (org-entry-get begin "LOCATION"))
+ (organizer (org-entry-get begin "ORGANIZER"))
+ (repeater (cj/--agenda-query-repeater-cookie timestamp))
+ (bounds (cj/--agenda-query-timestamp-bounds timestamp)))
+ ;; Keys are symbols because `json-serialize' requires that of an alist.
+ (list (cons 'title (cj/--agenda-query-title headline))
+ (cons 'start (car occurrence))
+ (cons 'end (or (cdr occurrence) :null))
+ (cons 'all-day (if (plist-get bounds :all-day) t :false))
+ (cons 'type type)
+ (cons 'file file)
+ (cons 'keyword (or keyword :null))
+ (cons 'done (if (eq (org-element-property :todo-type headline) 'done)
+ t :false))
+ (cons 'repeater (or repeater :null))
+ (cons 'location (or location :null))
+ (cons 'organizer (or organizer :null)))))
+
+(defun cj/--agenda-query-collect (headline file type timestamp win-start win-end)
+ "Return every event row TIMESTAMP contributes, or nil."
+ (when (and timestamp
+ (cj/--agenda-query-active-p timestamp)
+ (cj/--agenda-query-visible-p headline))
+ (mapcar (lambda (occurrence)
+ (cj/--agenda-query-event headline file type timestamp occurrence))
+ (cj/--agenda-query-occurrences timestamp win-start win-end))))
+
+(defun cj/--agenda-query-buffer-events (buffer file win-start win-end)
+ "Return the event rows BUFFER contributes for the window, tagged with FILE.
+
+Reads three kinds of timestamp, because org stores them two different ways.
+SCHEDULED and DEADLINE are properties on the entry's `planning' element, NOT
+children in the parse tree -- so the obvious implementation, mapping over
+\\='timestamp, silently returns neither. It does not error; it just omits the
+two entry kinds an agenda is mostly made of. Do not simplify this back into a
+single `org-element-map' over \\='timestamp. Body timestamps are collected
+separately, skipping any whose parent is a planning element so nothing is
+counted twice."
+ (cj/--agenda-query-load-org)
+ (with-current-buffer buffer
+ (let ((tree (org-element-parse-buffer))
+ (events '()))
+ ;; SCHEDULED and DEADLINE, read off the planning element.
+ (dolist (planning (org-element-map tree 'planning #'identity))
+ (let ((headline (cj/--agenda-query-ancestor-headline planning)))
+ (when headline
+ (dolist (spec (list (cons "scheduled" :scheduled)
+ (cons "deadline" :deadline)))
+ (setq events
+ (nconc events
+ (cj/--agenda-query-collect
+ headline file (car spec)
+ (org-element-property (cdr spec) planning)
+ win-start win-end)))))))
+ ;; Plain active timestamps in entry bodies.
+ (dolist (timestamp (org-element-map tree 'timestamp #'identity))
+ (unless (eq (org-element-type (org-element-property :parent timestamp))
+ 'planning)
+ (let ((headline (cj/--agenda-query-ancestor-headline timestamp)))
+ (when headline
+ (setq events
+ (nconc events
+ (cj/--agenda-query-collect
+ headline file "timestamp" timestamp
+ win-start win-end)))))))
+ events)))
+
+;;; ---------- output ----------
+
+(defun cj/--agenda-query-sort (events)
+ "Return EVENTS ordered by start, then title, so output is deterministic."
+ (sort (copy-sequence events)
+ (lambda (a b)
+ (let ((sa (alist-get 'start a))
+ (sb (alist-get 'start b)))
+ (if (= sa sb)
+ (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.
+
+The rename is why this matters: the renderer reads on a timer, so a partially
+written file would be a parse error on a live surface. Replacing the file in
+one step also makes it its own cache -- when Emacs is down the reader still
+gets the last good answer instead of a truncated one.
+
+The temp file is created 0600 by `make-temp-file', so the mode is reset after
+the rename; otherwise a reader running as anyone else could not open it. The
+mask is 666, not `default-file-modes' alone -- that is 777 minus the umask, so
+using it directly would publish the JSON world-EXECUTABLE."
+ (let* ((path (expand-file-name path))
+ (dir (file-name-directory path))
+ (temp (make-temp-file (expand-file-name ".agenda-query-" dir))))
+ (unwind-protect
+ (progn
+ (let ((coding-system-for-write 'utf-8))
+ (write-region text nil temp nil 'silent))
+ (rename-file temp path t)
+ (set-file-modes path (logand #o666 (default-file-modes)))
+ (setq temp nil))
+ (when (and temp (file-exists-p temp))
+ (delete-file temp)))
+ path))
+
+(defun cj/agenda-window-json (start-epoch end-epoch &optional out-path)
+ "Return the agenda between START-EPOCH and END-EPOCH as a JSON string.
+
+Both bounds are epoch SECONDS, inclusive. An event is included when it is
+running at any point in the window, so an event that started before
+START-EPOCH counts while it is still in progress.
+
+Each element of the returned array carries: title (keyword, priority cookie
+and tags already stripped), start, end (null when the source has no range),
+all-day, type (\"scheduled\", \"deadline\" or \"timestamp\"), file, keyword,
+done, repeater (the raw cookie, or null), location and organizer. Absent
+values are JSON null rather than omitted, so the shape is stable to parse.
+
+A repeating entry contributes one row per occurrence inside the window.
+
+With OUT-PATH, also write the JSON there atomically, leaving the previous
+contents intact if anything fails. Reads `org-agenda-files' and modifies no
+buffer, so it is safe to call on a timer or over emacsclient --eval.
+
+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)
+ (signal 'wrong-type-argument (list 'numberp end-epoch)))
+ (cj/--agenda-query-load-org)
+ (let* ((win-start (floor start-epoch))
+ (win-end (floor end-epoch))
+ (events '()))
+ (dolist (bound (list win-start win-end))
+ (unless (and (>= bound cj/agenda-query-epoch-floor)
+ (<= bound cj/agenda-query-epoch-ceiling))
+ (user-error
+ "Agenda bound %s is outside 1900-2200; expected epoch SECONDS (milliseconds?)"
+ bound)))
+ (when (> (- win-end win-start) cj/agenda-query-max-window-seconds)
+ (user-error
+ "Agenda window spans %d days; bounds are epoch SECONDS (milliseconds?)"
+ (/ (- win-end win-start) 86400)))
+ (when (<= win-start win-end)
+ (dolist (file (org-agenda-files))
+ (when (file-readable-p file)
+ (let ((buffer (org-get-agenda-file-buffer file)))
+ (when buffer
+ (setq events
+ (nconc events
+ (cj/--agenda-query-buffer-events
+ buffer file win-start win-end))))))))
+ (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/config-utilities.el b/modules/config-utilities.el
index 4332f407..62fc29d0 100644
--- a/modules/config-utilities.el
+++ b/modules/config-utilities.el
@@ -196,27 +196,27 @@ Returns the count of files deleted."
count user-emacs-directory)))
(keymap-set cj/debug-config-keymap "c d" 'cj/delete-emacs-home-compiled-files)
-(defun cj/compile-this-elisp-buffer ()
- "Compile the current .el: prefer native (.eln), else .elc. Message if neither."
- (interactive)
- (unless (and buffer-file-name (string-match-p "\\.el\\'" buffer-file-name))
- (user-error "Not visiting a .el file"))
- (save-buffer)
- (let ((file buffer-file-name))
+(defun cj/--compile-elisp-file (file &optional available-p)
+ "Compile FILE: prefer async native, then sync native, then byte-compile.
+AVAILABLE-P decides which compilers exist; it defaults to `fboundp'. It is
+a parameter so tests can force each branch without redefining `fboundp':
+an `fset' on that subr pulls in comp-run and bytecomp, whose own `defun'
+of `byte-compile-file' then lands on top of any test double."
+ (let ((available-p (or available-p #'fboundp)))
(cond
;; Native compilation (async preferred)
- ((fboundp 'native-compile-async)
+ ((funcall available-p 'native-compile-async)
(native-compile-async file)
(message "Queued native compilation for %s" file))
;; Native compilation (sync, if async not available)
- ((fboundp 'native-compile)
+ ((funcall available-p 'native-compile)
(condition-case err
(progn
(native-compile file)
(message "Native-compiled %s" file))
(error (message "Native compile failed: %s" (error-message-string err)))))
;; Byte-compile fallback
- ((fboundp 'byte-compile-file)
+ ((funcall available-p 'byte-compile-file)
(let ((out (byte-compile-file file)))
(if out
(message "Byte-compiled -> %s" out)
@@ -224,6 +224,14 @@ Returns the count of files deleted."
;; Neither facility available
(t
(message "No compilation available (no native-compile, no byte-compile)")))))
+
+(defun cj/compile-this-elisp-buffer ()
+ "Compile the current .el: prefer native (.eln), else .elc. Message if neither."
+ (interactive)
+ (unless (and buffer-file-name (string-match-p "\\.el\\'" buffer-file-name))
+ (user-error "Not visiting a .el file"))
+ (save-buffer)
+ (cj/--compile-elisp-file buffer-file-name))
(keymap-set cj/debug-config-keymap "c ." 'cj/compile-this-elisp-buffer)
;; --------------------------- Information Reporting ---------------------------
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/eat-config.el b/modules/eat-config.el
index 01d0fbe6..f764848e 100644
--- a/modules/eat-config.el
+++ b/modules/eat-config.el
@@ -415,7 +415,8 @@ terminal. ai-term's agent buffers are managed separately via M-SPC."
;; Carried over from the ghostel era for the EAT agent terminals (ai-term).
;; Agents run EAT over tmux, so copy-mode is tmux's own copy-mode -- the same UX
;; ghostel-over-tmux had. C-<up> enters it and scrolls up in one stroke; C-; x c
-;; enters it via the menu, and C-; x h grabs the whole pane history into a buffer.
+;; enters it via the menu, C-; x h grabs the whole pane history into a buffer,
+;; and C-; x d detaches the tmux client without going through its prefix.
(declare-function cj/register-prefix-map "keybindings")
(declare-function eat-emacs-mode "eat")
@@ -585,6 +586,20 @@ scrollback) and moves point to the start of the line."
(eat-emacs-mode)
(beginning-of-line)))
+(defun cj/term-tmux-detach ()
+ "Detach the tmux client from inside an agent terminal.
+Writes tmux's prefix and the detach key (C-b d) straight into the pty, the
+same path `cj/term-copy-mode-dwim' uses for C-b [. A keyboard C-b inside
+the Claude Code pane has been observed to land as stray text instead of
+reaching tmux as a prefix (root cause not yet pinned down), so the string
+path is the reliable one. Outside tmux it writes
+nothing and says so, since C-b d typed into a plain shell is just a control
+character."
+ (interactive)
+ (if (cj/term--in-tmux-p)
+ (cj/--term-send-string "\C-bd")
+ (message "cj/term-tmux-detach: not attached to tmux")))
+
(defun cj/term--tmux-pane-in-copy-mode-p (pane-id)
"Return non-nil when tmux PANE-ID is currently displaying a mode.
tmux's `pane_in_mode' is 1 while a pane is in any mode; copy-mode is the only
@@ -613,13 +628,15 @@ pty; without tmux, moves point up in EAT's emacs-mode buffer."
(cj/term-copy-mode-dwim))
(forward-line -1)))))
-;; The C-; x terminal prefix (copy-mode, tmux history, the F12 toggle). C-<up>
+;; The C-; x terminal prefix (copy-mode, tmux detach, tmux history, the F12
+;; toggle). C-<up>
;; enters copy-mode + scrolls in one stroke; bound in EAT's semi-char map so it
;; reaches Emacs from inside an agent terminal.
(defvar-keymap cj/term-map
:doc "Personal terminal command map.")
(cj/register-prefix-map "x" cj/term-map)
(keymap-set cj/term-map "c" #'cj/term-copy-mode-dwim)
+(keymap-set cj/term-map "d" #'cj/term-tmux-detach)
(keymap-set cj/term-map "h" #'cj/term-tmux-history)
(keymap-set cj/term-map "t" #'cj/term-toggle)
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/prog-general.el b/modules/prog-general.el
index 77ff88a5..e9586a97 100644
--- a/modules/prog-general.el
+++ b/modules/prog-general.el
@@ -119,9 +119,11 @@ REGEXP must be a string or an rx form."
;; Manages tree-sitter grammars. Install is 'prompt, never t: with t,
;; merely opening a file could trigger a network download and a compiler
-;; build mid-edit. Batch/test runs never load treesit-auto (no package
-;; init), so they can never install. Fresh-machine bootstrap is the
-;; explicit `cj/install-treesit-grammars' command below.
+;; build mid-edit. `make test' runs with no package init and so never
+;; loads treesit-auto, but a test file that calls `package-initialize'
+;; itself does load it, and a tree-sitter mode then prompts for a missing
+;; grammar; such tests must skip on `treesit-ready-p'. Fresh-machine
+;; bootstrap is the explicit `cj/install-treesit-grammars' command below.
(defun cj/treesit-auto-pin-go-revision (recipes)
"Pin the Go grammar revision in treesit-auto RECIPES.
Return the updated Go recipe, or nil when RECIPES has no Go entry.
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..47bd1505 100644
--- a/modules/system-defaults.el
+++ b/modules/system-defaults.el
@@ -89,6 +89,30 @@ indicate the warning was handled."
(advice-add 'display-warning :before-until #'cj/log-comp-warning)
+;; ------------------ Deferred Daemon Warnings vs. Frame Creation -----------------
+
+;; Emacs 31's warnings.el defers warnings raised during daemon startup: it puts
+;; a one-shot closure on `after-make-frame-functions' holding the *Warnings*
+;; buffer object and calls `warning--display-buffer' on it when the first
+;; client frame is made. If that buffer died in between, `display-buffer'
+;; signals inside `make-frame', server.el reports "-window-system-unsupported",
+;; and emacsclient retries on $DISPLAY -- the first frame of the session
+;; silently opens on XWayland. Keeping *Warnings* alive is the root fix
+;; (undead-buffers.el); this guard is the backstop, so no future buffer sweep
+;; can break frame creation the same way. The function only exists from
+;; Emacs 31; advising an undefined symbol is harmless and takes effect once
+;; warnings.el defines it.
+
+(defun cj/warning--display-buffer-if-live (orig buffer)
+ "Call ORIG with BUFFER only when it names or is a live buffer.
+Around advice for `warning--display-buffer'. BUFFER may be a buffer object
+or a buffer name, like `display-buffer' accepts. Return nil when skipped."
+ (let ((buf (and buffer (get-buffer buffer))))
+ (when (buffer-live-p buf)
+ (funcall orig buf))))
+
+(advice-add 'warning--display-buffer :around #'cj/warning--display-buffer-if-live)
+
;; ---------------------------------- Unicode ----------------------------------
(set-locale-environment "en_US.UTF-8")
@@ -227,8 +251,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/telega-config.el b/modules/telega-config.el
index 5a20d430..b9b80481 100644
--- a/modules/telega-config.el
+++ b/modules/telega-config.el
@@ -18,9 +18,10 @@
;;
;; TDLib (Telegram Database Library) runs in a docker container via
;; `telega-use-docker' so a fresh-clone install does not need a
-;; system-level TDLib build. =scripts/setup-telega.sh= prepares the
-;; container the first time; afterwards telega.el reattaches
-;; automatically.
+;; system-level TDLib build. The image is built locally from
+;; =docker/telega-server/Dockerfile= with =make telega-image= (see the
+;; pin section below for why it is not pulled from the registry);
+;; =scripts/setup-telega.sh= covers the rest of a fresh clone.
;;
;; First-run auth (phone number + Telegram verification code) is
;; interactive and happens inside `M-x telega'. This module does not
@@ -68,20 +69,29 @@
;; telega picks its container image in `telega-docker--image-name', which only
;; pins to a version tag when `telega-tdlib-min-version' equals
;; `telega-tdlib-max-version' and the version ends in ".0". Here min is
-;; "1.8.64" and max is nil, so that test never passes and the image is always
+;; "1.8.66" and max is nil, so that test never passes and the image is always
;; "zevlg/telega-server:latest" -- a floating tag. The elpa package is fixed
;; at whatever version was installed, so the server can be replaced underneath
;; a static elisp without anything announcing it.
;;
-;; Pinning by digest names one immutable image. Set to nil to hand the choice
-;; back to telega.
+;; The pin used to be a registry digest. It became a local tag on 2026-08-25:
+;; the telega package raised its tdlib floor to 1.8.66, and upstream's only
+;; image at that version fails to start (libglycin missing,
+;; zevlg/telega.el#596). docker/telega-server/Dockerfile derives a working
+;; image from that upstream digest plus the one missing package, and
+;; `make telega-image' builds it under the tag below. The digest guarantee
+;; now lives in the Dockerfile's FROM line; the Makefile owns the tag and a
+;; test holds this default equal to it. Set to nil to hand the choice back
+;; to telega.
(defcustom cj/telega-docker-image
- "zevlg/telega-server@sha256:a4b88e029ba381eca7c37c9618c9e3ad73aa9db2097fe07a0c6684d40d32b84e"
+ "cj/telega-server:1.8.66-glycin"
"Container image reference for `telega-server', or nil for telega's default.
-Pin by digest rather than tag: a tag can be re-pushed upstream, a digest
-cannot. The default is the image carrying libtdjson 1.8.64, which matches
-this telega's `telega-tdlib-min-version'."
+The default names the image `make telega-image' builds locally from
+docker/telega-server/Dockerfile, whose base is pinned by upstream digest.
+It must match TELEGA_IMAGE in the Makefile; `cj/telega' refuses to launch
+when the image is not present, since docker would otherwise try to pull a
+local-only tag from the registry and fail confusingly."
:type '(choice (const :tag "Let telega infer the image" nil)
(string :tag "Image reference"))
:group 'telega-docker)
@@ -175,6 +185,21 @@ into telega's sentinel and abort its status handling and relogin path."
(with-eval-after-load 'telega-server
(advice-add 'telega-server--sentinel :after #'cj/--telega-server-notify-death))
+(defun cj/--telega-docker-image-present-p (image)
+ "Return non-nil when IMAGE exists in the local docker image store.
+Uses `docker image inspect' rather than `docker images': the listing hides
+digest-pulled and untagged images, and this check exists because that
+listing lied once. Any failure (docker absent, daemon down) reads as
+not-present, which routes the user to the same make target."
+ (condition-case nil
+ (zerop (call-process "docker" nil nil nil "image" "inspect" image))
+ (error nil)))
+
+(defun cj/--telega-missing-image-message (image)
+ "Return the user-facing message for a pinned IMAGE that is not built yet."
+ (format "telega-server image %s is not built -- run `make telega-image' in %s"
+ image (abbreviate-file-name user-emacs-directory)))
+
(defun cj/telega ()
"Launch telega.el with a helpful message when it isn't installed yet.
@@ -183,14 +208,22 @@ stale MELPA archive index can't take startup down with a 404. The
trade-off: a fresh clone needs a one-time install before this
launcher works. Without this wrapper, the autoload stub fails with
the cryptic =Cannot open load file: telega=; with it, the user gets
-pointed at =scripts/setup-telega.sh= and the manual fallback."
+pointed at =scripts/setup-telega.sh= and the manual fallback.
+
+When `cj/telega-docker-image' is set, the image must already be built:
+it is a local tag, so a missing one would send docker to the registry
+for something that was never there. The check is skipped with no pin,
+where telega infers and pulls its own image."
(interactive)
- (if (or (featurep 'telega)
- (locate-library "telega"))
- (telega)
+ (unless (or (featurep 'telega)
+ (locate-library "telega"))
(user-error
(concat "telega not installed -- run scripts/setup-telega.sh, "
- "or `M-x package-install RET telega'"))))
+ "or `M-x package-install RET telega'")))
+ (let ((image (cj/--telega-docker-pinned-image)))
+ (when (and image (not (cj/--telega-docker-image-present-p image)))
+ (user-error "%s" (cj/--telega-missing-image-message image))))
+ (telega))
(cj/register-command "T" #'cj/telega)
diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el
index e5b8dc00..e6574a0e 100644
--- a/modules/undead-buffers.el
+++ b/modules/undead-buffers.el
@@ -31,7 +31,25 @@
(defvar cj/undead-buffer-list
'("*scratch*" "*EMMS-Playlist*" "*Messages*" "*ert*"
- "*AI-Assistant*")
+ "*AI-Assistant*"
+ ;; *Warnings* stays alive because Emacs 31's warnings.el defers daemon
+ ;; startup warnings into an `after-make-frame-functions' closure that
+ ;; holds this buffer object until the first client frame. The startup
+ ;; sweep in `cj/dashboard-only' used to kill it; the closure then failed
+ ;; inside `make-frame', server.el reported the window system as
+ ;; unsupported, and emacsclient silently retried on $DISPLAY, so the first
+ ;; frame of every 31.1 session opened on XWayland. I bury it instead, the
+ ;; same choice desktop.el makes in `desktop-clear-preserve-buffers'.
+ "*Warnings*"
+ ;; The async native-compile log stays alive for the same reason, one
+ ;; buffer over. comp-run parks every compile worker on this buffer and
+ ;; the worker's sentinel reads it back before starting the next job.
+ ;; The startup sweep killed it, which SIGHUPs every :noquery worker under
+ ;; it; each sentinel then died in `with-current-buffer' on the dead
+ ;; buffer and `comp--run-async-workers' never ran again, so the queue
+ ;; sat stranded for the life of the daemon, nothing was ever cached, and
+ ;; every boot re-ran the same compile storm at the first frame.
+ "*Async-native-compile-log*")
"Buffer names to bury instead of killing (exact match).")
(defvar cj/undead-buffer-regexps nil
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"
diff --git a/modules/weather-config.el b/modules/weather-config.el
index 84920776..ea137578 100644
--- a/modules/weather-config.el
+++ b/modules/weather-config.el
@@ -28,6 +28,13 @@
;; :vc (:url "git@cjennings.net:emacs-wttrin.git"
;; :branch "release/0.4.0"
;; :rev :newest)
+ ;; wttrin declares xterm-color in its own Package-Requires, but nothing here
+ ;; reads that header: `:load-path' keeps package.el out of the picture, and
+ ;; use-package suppresses the `use-package-always-ensure' default whenever
+ ;; `:load-path' is present. The dependency came free under the `:vc' form
+ ;; above and stopped when the local checkout took over. Naming the package
+ ;; here installs it without disturbing the checkout.
+ :ensure xterm-color
:demand t ;; REQUIRED: mode-line must start at Emacs startup
:preface
;; Change this to t to enable debug logging