diff options
Diffstat (limited to 'modules')
| -rw-r--r-- | modules/agenda-query.el | 607 | ||||
| -rw-r--r-- | modules/calendar-sync.el | 149 | ||||
| -rw-r--r-- | modules/config-utilities.el | 28 | ||||
| -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/eat-config.el | 21 | ||||
| -rw-r--r-- | modules/google-keep-config.el | 25 | ||||
| -rw-r--r-- | modules/music-config.el | 51 | ||||
| -rw-r--r-- | modules/org-agenda-config.el | 145 | ||||
| -rw-r--r-- | modules/org-agenda-frame.el | 847 | ||||
| -rw-r--r-- | modules/org-config.el | 8 | ||||
| -rw-r--r-- | modules/package-resilience.el | 369 | ||||
| -rw-r--r-- | modules/prog-general.el | 35 | ||||
| -rw-r--r-- | modules/system-commands.el | 17 | ||||
| -rw-r--r-- | modules/system-defaults.el | 29 | ||||
| -rw-r--r-- | modules/system-lib.el | 51 | ||||
| -rw-r--r-- | modules/telega-config.el | 161 | ||||
| -rw-r--r-- | modules/undead-buffers.el | 20 | ||||
| -rw-r--r-- | modules/user-constants.el | 18 | ||||
| -rw-r--r-- | modules/video-audio-recording.el | 35 | ||||
| -rw-r--r-- | modules/weather-config.el | 7 |
22 files changed, 1675 insertions, 959 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-agenda-config.el b/modules/org-agenda-config.el index 1e91fa48..20714d5d 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -20,21 +20,25 @@ ;; keep normal agenda opens fast. ;;; Code: +(require 'seq) (require 'user-constants) (require 'system-lib) (require 'cj-cache-lib) -(defcustom cj/org-agenda-window-height 0.75 - "Fraction of the selected frame used for the org agenda window." - :type 'number - :group 'org-agenda) - (defun cj/--org-agenda-display-rule () - "Return the display-buffer rule for the org agenda buffer." - `("\\*Org Agenda\\*" - (display-buffer-reuse-mode-window display-buffer-below-selected) - (dedicated . t) - (window-height . ,cj/org-agenda-window-height))) + "Return the display-buffer rule for the org agenda buffer. +`display-buffer-full-frame' gives the agenda the whole frame rather than a +fraction of it, so the view is a surface you read rather than a strip you +squint at. `org-agenda-restore-windows-after-quit' (set below) is what +makes that non-destructive: quitting the agenda puts the previous window +layout back. + +The window is deliberately not `dedicated': with the agenda owning the only +window, a dedicated one leaves `org-agenda-switch-to' (RET on an item) with +nowhere to put the file, and it splits or opens a frame instead of simply +replacing the agenda." + '("\\*Org Agenda\\*" + (display-buffer-reuse-mode-window display-buffer-full-frame))) ;; Load debug functions if enabled (when (or (eq cj/debug-modules t) @@ -65,7 +69,12 @@ ;; that reaches `org-agenda-files' another way. (setq org-agenda-skip-unavailable-files t) - ;; display the agenda from the bottom + ;; The agenda takes the whole frame, so quitting it has to give the previous + ;; window layout back -- otherwise every F8 costs the arrangement of windows + ;; that were up when it was pressed. + (setq org-agenda-restore-windows-after-quit t) + + ;; display the agenda across the whole frame (add-to-list 'display-buffer-alist (cj/--org-agenda-display-rule)) @@ -75,6 +84,89 @@ (local-set-key (kbd "s-<left>") #'org-agenda-todo-previousset)))) +;; ---------------------------- Agenda Auto-Refresh ---------------------------- +;; A full-frame agenda is meant to be left up and glanced at, so it has to stay +;; current on its own: the now-line moves, and calendar-sync writes new events +;; into the agenda files behind it. One repeating timer rebuilds whichever +;; agenda is actually on screen. + +(defcustom cj/org-agenda-refresh-seconds 300 + "Cadence, in seconds, of the org-agenda auto-refresh. +The timer fires on wall-clock multiples of this value, so the default 300 +refreshes on the :00/:05/:10 marks rather than five minutes after whenever +the agenda happened to open." + :type 'integer + :group 'org-agenda) + +(defvar cj/--org-agenda-refresh-timer nil + "The repeating auto-refresh timer, or nil when auto-refresh is stopped.") + +(declare-function org-agenda-redo "org-agenda" (&optional all)) + +(defun cj/--org-agenda-seconds-to-next-mark (time period) + "Return seconds from TIME to the next wall-clock multiple of PERIOD. +TIME is any Emacs time value; PERIOD is a positive number of seconds, so +300 gives the :00/:05 marks. A TIME landing exactly on a mark returns a +full PERIOD rather than zero, so the timer never fires twice back to back." + (unless (and (numberp period) (> period 0)) + (error "Refresh period must be a positive number of seconds: %S" period)) + (let ((remainder (mod (floor (float-time time)) period))) + (if (zerop remainder) period (- period remainder)))) + +(defun cj/--org-agenda-refresh-window () + "Return a live window displaying an org-agenda buffer, or nil. +Only a visible agenda is worth rebuilding: an off-screen one costs the same +full rescan and shows it to nobody, and it will be rebuilt on the next tick +after it comes back into view." + (seq-find (lambda (window) + (with-current-buffer (window-buffer window) + (derived-mode-p 'org-agenda-mode))) + (window-list-1 nil 'nomini 'visible))) + +(defun cj/--org-agenda-auto-refresh () + "Rebuild the on-screen agenda, leaving point on the line it was on. +Does nothing when no agenda is displayed. + +The body is wrapped in `condition-case' deliberately. This runs from a +repeating timer, where an unguarded signal resignals on every tick and +buries Emacs in identical backtraces -- the failure mode that made +calendar-sync's hourly timer unusable. A failed rebuild is logged and the +timer keeps its cadence." + (condition-case err + (when-let* ((window (cj/--org-agenda-refresh-window))) + (with-selected-window window + (let ((line (line-number-at-pos))) + (org-agenda-redo) + (goto-char (point-min)) + (forward-line (1- line))))) + (error + (cj/log-silently + (format "org-agenda auto-refresh failed: %s" (error-message-string err)))))) + +(defun cj/org-agenda-auto-refresh-start () + "Start the wall-clock-aligned agenda auto-refresh timer. +Cancels any existing timer first, so re-loading this module into a running +daemon replaces the ticker rather than stacking a second one." + (interactive) + (cj/org-agenda-auto-refresh-stop) + (setq cj/--org-agenda-refresh-timer + (run-at-time (cj/--org-agenda-seconds-to-next-mark + (current-time) cj/org-agenda-refresh-seconds) + cj/org-agenda-refresh-seconds + #'cj/--org-agenda-auto-refresh))) + +(defun cj/org-agenda-auto-refresh-stop () + "Cancel the agenda auto-refresh timer. A no-op when already stopped." + (interactive) + (when (timerp cj/--org-agenda-refresh-timer) + (cancel-timer cj/--org-agenda-refresh-timer)) + (setq cj/--org-agenda-refresh-timer nil)) + +;; Arm at load. Skipped under `noninteractive' so a batch test run doesn't +;; carry a live repeating timer it has nothing to refresh. +(unless noninteractive + (cj/org-agenda-auto-refresh-start)) + ;; ----------------------- Project-name Category Override --------------------- ;; The default `org-category' for a todo.org buffer is "todo" (the filename ;; without extension), which renders as "todo:" in every agenda `%c' column @@ -107,17 +199,27 @@ nil so the org default category applies." (defun cj/--org-set-todo-category () "Set buffer-local `org-category' to the project name for a todo.org buffer. -Runs from `org-mode-hook'. Only overrides when `org-category' is still -the default-from-filename (\"todo\"), so an explicit `#+CATEGORY:' in -the file keeps precedence." +Runs from `org-mode-hook'. Only overrides when nothing has set +`org-category', so an explicit `#+CATEGORY:' in the file keeps precedence. + +The nil test is the whole guard, and it took a while to get right. Org does +not assign the filename fallback to `org-category': with no `#+CATEGORY:' the +variable stays nil and `org-get-category' derives \"todo\" at read time. An +earlier version guarded on `(string= \"todo\" org-category)', which is a state +org never produces, so this hook did nothing from the day it shipped." (when (and buffer-file-name (boundp 'org-category) - (stringp org-category) - (string= "todo" org-category)) + (null org-category)) (when-let* ((project (cj/--org-todo-category-from-file buffer-file-name))) (setq-local org-category project)))) -(add-hook 'org-mode-hook #'cj/--org-set-todo-category) +;; Depth -100 so this runs FIRST, and it is load-bearing. `org-get-category' +;; resolves a deferred `:CATEGORY' that the org-element cache then holds, so any +;; hook that reads the category before this one freezes "todo" in that cache and +;; leaves the `setq-local' below inert -- `org-category' reads correct while the +;; agenda still shows "todo". `add-hook' prepends by default, so without the +;; depth every hook added later would run earlier, and three already do. +(add-hook 'org-mode-hook #'cj/--org-set-todo-category -100) ;; ------------------------ Org Agenda File List Cache ------------------------- ;; Cache agenda file list to avoid expensive directory scanning on every view. @@ -225,14 +327,11 @@ improves performance from several seconds to instant." Use this after adding new projects or todo.org files. Bypasses cache and scans directories from scratch. -Bound to C-M-<f8>, the force-rebuild sibling of the F8 agenda family -\(<f8> display, s-<f8> all files, C-<f8> single project, M-<f8> this buffer). -The binding lives in `org-agenda-frame.el', which took S-<f8> for the -agenda-frame toggle and moved the force-rescan here." +Bound to S-<f8>, the force-rebuild sibling of the F8 agenda family +\(<f8> display, s-<f8> all files, C-<f8> single project, M-<f8> this buffer)." (interactive) (cj/build-org-agenda-list 'force-rebuild)) -;; S-<f8> and C-M-<f8> are bound by `org-agenda-frame.el' (cj/--agenda-frame-install-keys): -;; S-<f8> toggles the dedicated agenda frame; C-M-<f8> runs the force-rescan above. +(global-set-key (kbd "S-<f8>") #'cj/org-agenda-refresh-files) (defun cj/todo-list-all-agenda-files () "Displays an \\='org-agenda\\=' todo list. diff --git a/modules/org-agenda-frame.el b/modules/org-agenda-frame.el deleted file mode 100644 index f0de99ce..00000000 --- a/modules/org-agenda-frame.el +++ /dev/null @@ -1,847 +0,0 @@ -;;; org-agenda-frame.el --- Dedicated agenda frame -*- lexical-binding: t; -*- -;; author: Craig Jennings <c@cjennings.net> - -;;; Commentary: -;; -;; Layer: 4 (Optional). -;; Category: O/D. -;; Load shape: eager (binds keys in Phase 2; Phase 1 defines helpers only). -;; Top-level side effects: none yet (Phase 1 is private helpers). -;; Runtime requires: none. -;; Direct test load: yes. -;; -;; A dedicated Emacs frame of the running daemon that shows a today-anchored -;; seven-day org-agenda, refreshing itself, kept read-only and focus-locked. -;; A normal (non-fullscreen) frame, so a tiling WM places it side by side with -;; the working frame. Spawned/raised/closed by one key. See the spec: -;; docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org. -;; -;; Phase 1 (this pass) builds non-interactive helpers only: frame lookup, -;; spawn/raise/delete, the dedicated view, the default-deny read-only policy, -;; and working-frame routing. No interactive command or key is bound until -;; Phase 2, so nothing user-visible changes yet. - -;;; Code: - -(require 'seq) - -;; Declared, not required: `org-agenda-config' pulls in vc packages that don't -;; load under `make test' (no package-initialize). The frame module references -;; org-agenda symbols through these declarations and does its real wiring inside -;; `with-eval-after-load' so a batch test-load runs no org-agenda side effects. -(defvar org-agenda-custom-commands) -(defvar org-agenda-finalize-hook) -(defvar org-agenda-mode-map) -(defvar org-agenda-sticky) -(defvar org-agenda-window-setup) -(declare-function cj/build-org-agenda-list "org-agenda-config" (&optional force-rebuild)) -(declare-function cj/org-agenda-refresh-files "org-agenda-config" ()) -(declare-function org-agenda-redo "org-agenda" (&optional all)) -(declare-function org-agenda-next-line "org-agenda" ()) -(declare-function org-agenda-previous-line "org-agenda" ()) -(declare-function org-agenda-next-item "org-agenda" (n)) -(declare-function org-agenda-previous-item "org-agenda" (n)) -(declare-function org-agenda-open-link "org-agenda" (&optional arg)) -(declare-function org-get-at-bol "org" (property)) -(declare-function org-fold-show-context "org-fold" (&optional key)) -(declare-function org-agenda "org-agenda" (&optional arg org-keys restriction)) -;; No declare-function for -safe-redo / -delete: they are defined later in THIS -;; file, and the byte-compiler resolves same-file forward references at end of -;; compilation. A declare-function for a same-file function instead counts as a -;; second definition ("defined multiple times") and, worse, its declared arglist -;; overrides the real one for arg-count checking -- the empty () shadowed -;; -safe-redo's actual (&optional frame), disabling that check. - -(defconst cj/--agenda-frame-parameter 'cj/agenda-frame - "Frame parameter marking the dedicated agenda frame. -Its presence (non-nil) is how `cj/--agenda-frame' locates the frame among -all of the daemon's frames.") - -(defvar cj/--agenda-frame-launch-frame nil - "The frame selected when the agenda frame was last spawned. -Preferred routing target for source files opened from the agenda (see -`cj/--agenda-frame-working-frame'); ignored once it is dead or is itself -the agenda frame.") - -(defun cj/--agenda-frame-p (frame) - "Return non-nil when FRAME is a live agenda frame. -FRAME is an agenda frame when it is live and carries the -`cj/--agenda-frame-parameter' marker; a dead frame is never one." - (and (frame-live-p frame) - (frame-parameter frame cj/--agenda-frame-parameter))) - -(defun cj/--agenda-frame () - "Return the live agenda frame, or nil. -The frame is identified by the `cj/--agenda-frame-parameter' marker; a -dead frame is never returned even if it still carries the marker." - (seq-find #'cj/--agenda-frame-p (frame-list))) - -(defun cj/--agenda-frame-working-frame () - "Return a live non-agenda frame to route source files into, or nil. -Prefer `cj/--agenda-frame-launch-frame' when it is still live and not the -agenda frame; otherwise the first live non-agenda frame among all frames. -Return nil when the agenda frame is the only live frame -- the caller then -creates a normal frame." - (or (and (frame-live-p cj/--agenda-frame-launch-frame) - (not (cj/--agenda-frame-p cj/--agenda-frame-launch-frame)) - cj/--agenda-frame-launch-frame) - (seq-find (lambda (frame) - (and (frame-live-p frame) - (not (cj/--agenda-frame-p frame)))) - (frame-list)))) - -;;; The dedicated seven-day view (org-agenda-custom-commands key F) - -(defconst cj/--agenda-frame-command-key "F" - "The `org-agenda-custom-commands' key for the agenda-frame view. -The existing top-level key is `d' (org-agenda-config.el:344), so `F' is -collision-free. The sticky buffer derives its name from this key -\(*Org Agenda(F)*).") - -(defvar cj/--agenda-frame-span 7 - "Span, in days, of the agenda-frame view. -The `F' custom command reads this via its `org-agenda-span' setting, which -Org evaluates on every build and every redo, so `cj/--agenda-frame-day-view' -\(span 1) and `cj/--agenda-frame-week-view' (span 7) change it and the next -redo picks up the new span. Reset to 7 on each spawn so a fresh frame opens -at the documented default.") - -(defun cj/--agenda-frame-command () - "Return the `org-agenda-custom-commands' entry for the agenda frame. -A one-block agenda: a `cj/--agenda-frame-span'-day span anchored to today -rather than -Monday (`org-agenda-list' otherwise anchors any seven-day span to the -week start in Org 9.7.11), rendered in the frame's sole window -\(`current-window', so Org's default `reorganize-frame' can't split it), -as its own sticky *Org Agenda(F)* buffer, with follow-mode forced off so -a non-nil global default can't open a second window at build time." - `(,cj/--agenda-frame-command-key "Agenda frame: 7-day today-anchored" - ((agenda "" - ((org-agenda-span cj/--agenda-frame-span) - (org-agenda-start-day "0d") - (org-agenda-start-on-weekday nil) - (org-agenda-start-with-follow-mode nil) - ;; Narrow category column: the global agenda format pads the - ;; category to 25 chars, leaving a wide blank gutter between - ;; the source name (todo:, dcal:) and the item. - (org-agenda-prefix-format " %i %-10:c%?-12t% s")))) - ;; No `org-agenda-sticky' here, deliberately: these settings are baked - ;; into the buffer's series-redo-cmd and re-applied by every redo, and a - ;; sticky t mid-redo makes `org-agenda-use-sticky-p' true while the - ;; buffer exists -- `org-agenda-prepare' then throws \\='exit ("use `r' - ;; to refresh") with no catch, failing every refresh tick. Stickiness - ;; is bound in the spawn wrapper instead, where it names the buffer. - ((org-agenda-window-setup 'current-window)))) - -(defun cj/--agenda-frame-register-command () - "Register the agenda-frame view in `org-agenda-custom-commands'. -Idempotent: any existing entry for `cj/--agenda-frame-command-key' is -replaced, so a module reload never accumulates duplicate keys." - (setq org-agenda-custom-commands - (cons (cj/--agenda-frame-command) - (assoc-delete-all cj/--agenda-frame-command-key - org-agenda-custom-commands)))) - -;;; Engage routing — open the item's source outside the agenda frame - -(defun cj/--agenda-frame-item-marker () - "Return the source marker for the agenda item at point, or nil. -Prefers the item's own marker, falling back to the heading marker. Reads -the text property directly (like `org-get-at-bol') so point restoration -is exercisable without loading org." - (or (get-text-property (line-beginning-position) 'org-marker) - (get-text-property (line-beginning-position) 'org-hd-marker))) - -(defun cj/--agenda-frame-target-frame () - "Return the frame to open agenda source in, creating one when needed. -The engage action never opens into the agenda frame: it targets the -working frame (`cj/--agenda-frame-working-frame'), and when the agenda -frame is the only live frame it creates a normal, non-fullscreen frame." - (or (cj/--agenda-frame-working-frame) - (make-frame))) - -(defun cj/--agenda-frame-engage-open () - "Open the source of the agenda item at point in the working frame. -Routes to the MRU non-agenda frame (or a new normal frame when the agenda -frame is the only one), so the agenda frame keeps showing the agenda. -Signals a `user-error' when point is not on an agenda item." - (interactive) - (let ((marker (cj/--agenda-frame-item-marker))) - (unless (and marker (marker-buffer marker)) - (user-error "No agenda item on this line")) - (let ((buffer (marker-buffer marker)) - (pos (marker-position marker)) - (frame (cj/--agenda-frame-target-frame))) - (select-frame-set-input-focus frame) - (pop-to-buffer-same-window buffer) - (widen) - (goto-char pos) - (when (derived-mode-p 'org-mode) - (org-fold-show-context 'agenda)) - (beginning-of-line)))) - -(defun cj/--agenda-frame-engage-mouse (event) - "Open the agenda item clicked by EVENT in the working frame." - (interactive "e") - (mouse-set-point event) - (cj/--agenda-frame-engage-open)) - -(defun cj/--agenda-frame-open-link () - "Follow the link in the agenda item at point, in the working frame." - (interactive) - (select-frame-set-input-focus (cj/--agenda-frame-target-frame)) - (org-agenda-open-link)) - -(defun cj/--agenda-frame-close () - "Close the agenda frame from within it. -Bound to q, Q, and x so Org's own quit keys delete the whole frame -\(and cancel its timer) rather than leaving a sole-window agenda -frame stranded on a non-agenda buffer." - (interactive) - (cj/--agenda-frame-delete)) - -;;; Default-deny read-only policy - -(defconst cj/--agenda-frame-readonly-message - "Agenda frame is read-only — press RET to edit in your working frame" - "Shown when a mutating or buffer-opening command is denied in the frame.") - -(defconst cj/--agenda-frame-fixed-view-message - "Agenda frame shows only the day (d) and week (w) views" - "Shown when a view-changing command is denied in the frame.") - -(defun cj/--agenda-frame-denied-readonly () - "Deny a mutating or buffer-opening command in the agenda frame. -The default binding for every key not on the allowlist." - (interactive) - (message "%s" cj/--agenda-frame-readonly-message)) - -(defun cj/--agenda-frame-denied-fixed-view () - "Deny a view-changing command that would break the today-anchored span." - (interactive) - (message "%s" cj/--agenda-frame-fixed-view-message)) - -(defvar cj/agenda-frame-mode-map - (let ((map (make-sparse-keymap))) - ;; Default-deny: every key/mouse event not rebound below funnels through - ;; this one catch-all, so mutations (present and future) are read-only. - (define-key map [t] #'cj/--agenda-frame-denied-readonly) - ;; Hide the Org Agenda menu-bar entry so there is no menu path to a mutation. - (define-key map [menu-bar org-agenda] #'undefined) - ;; (a) Navigation — allowlisted to their org-agenda commands. - (define-key map (kbd "n") #'org-agenda-next-line) - (define-key map (kbd "p") #'org-agenda-previous-line) - (define-key map (kbd "<down>") #'org-agenda-next-line) - (define-key map (kbd "<up>") #'org-agenda-previous-line) - (define-key map (kbd "C-n") #'org-agenda-next-line) - (define-key map (kbd "C-p") #'org-agenda-previous-line) - (define-key map (kbd "N") #'org-agenda-next-item) - (define-key map (kbd "P") #'org-agenda-previous-item) - (define-key map (kbd "C-v") #'scroll-up-command) - (define-key map (kbd "M-v") #'scroll-down-command) - (define-key map (kbd "M-<") #'beginning-of-buffer) - (define-key map (kbd "M->") #'end-of-buffer) - ;; Read-only point motion and search within the agenda. - (define-key map (kbd "C-a") #'move-beginning-of-line) - (define-key map (kbd "C-e") #'move-end-of-line) - (define-key map (kbd "C-f") #'forward-char) - (define-key map (kbd "C-b") #'backward-char) - (define-key map (kbd "C-s") #'isearch-forward) - (define-key map (kbd "C-r") #'isearch-backward) - (define-key map (kbd "C-g") #'keyboard-quit) - ;; (b) Engage / open — routed to the working frame, never the agenda frame. - ;; Bind the GUI function-key events ([return]/[tab]) as well as the ASCII - ;; forms: the [t] catch-all otherwise gives `return'/`tab' a binding, which - ;; suppresses their function-key translation to RET/TAB, so a bare RET would - ;; hit the deny handler instead of engaging in a graphical frame. - (define-key map (kbd "RET") #'cj/--agenda-frame-engage-open) - (define-key map (kbd "TAB") #'cj/--agenda-frame-engage-open) - (define-key map [return] #'cj/--agenda-frame-engage-open) - (define-key map [tab] #'cj/--agenda-frame-engage-open) - (define-key map (kbd "<mouse-2>") #'cj/--agenda-frame-engage-mouse) - (define-key map (kbd "C-c C-o") #'cj/--agenda-frame-open-link) - ;; (c) The frame's own controls. - (define-key map (kbd "q") #'cj/--agenda-frame-close) - (define-key map (kbd "Q") #'cj/--agenda-frame-close) - (define-key map (kbd "x") #'cj/--agenda-frame-close) - (define-key map (kbd "r") #'cj/--agenda-frame-safe-redo) - ;; g is the muscle-memory agenda refresh; keep it working here (the - ;; frame-scoped safe redo, same as r) rather than denying it as a - ;; view-change. C-M-<f8> stays the force-rescan. - (define-key map (kbd "g") #'cj/--agenda-frame-safe-redo) - ;; d / w toggle the span (today's day vs the seven-day view) in place; the - ;; other view-changers stay denied to keep the today-anchored frame stable. - (define-key map (kbd "d") #'cj/--agenda-frame-day-view) - (define-key map (kbd "w") #'cj/--agenda-frame-week-view) - (define-key map (kbd "S-<f8>") #'cj/agenda-frame-toggle) - (define-key map (kbd "C-M-<f8>") #'cj/org-agenda-refresh-files) - ;; C-x C-c means "close this frame" here. The global - ;; `save-buffers-kill-terminal' must never run in this frame: it was made - ;; by `make-frame', not emacsclient, so with no client to close it falls - ;; back to killing the daemon itself. - (define-key map (kbd "C-x C-c") #'cj/--agenda-frame-close) - ;; (d) Input machinery punched through the catch-all. An explicit nil - ;; shadows the [t] default in this map, so these fall through to their - ;; global bindings. Without the punches, every frame-focus change - ;; (switch-frame), every wheel scroll, and every mouse click hits the - ;; deny handler -- message spam and broken frame switching. - (dolist (key (list [switch-frame] - [wheel-up] [wheel-down] [wheel-left] [wheel-right] - [double-wheel-up] [double-wheel-down] - [triple-wheel-up] [triple-wheel-down] - [mouse-1] [down-mouse-1] [drag-mouse-1] - (kbd "C-h"))) - (define-key map key nil)) - ;; (e) Global chords that would pull focus out of the frame must be - ;; denied *explicitly*. The [t] catch-all can't reach them: a keymap's - ;; default binding does not shadow an *explicit* binding in a - ;; lower-priority map, and these are bound in the global map (M-SPC / - ;; M-S-SPC swap ai-term agents). Left to the catch-all, M-SPC follows - ;; its global binding and escapes the read-only frame into ai-term. - (dolist (key '("M-SPC" "M-S-SPC")) - (define-key map (kbd key) #'cj/--agenda-frame-denied-readonly)) - ;; The remaining view-changers get the distinct fixed-view message, not the - ;; read-only one. d/w are handled above (they toggle the span in place). - (dolist (key '("y" "f" "b" "j")) - (define-key map (kbd key) #'cj/--agenda-frame-denied-fixed-view)) - map) - "Keymap for `cj/agenda-frame-mode'. -Shadows `org-agenda-mode-map' by default-deny: the `[t]' catch-all denies -every key that is not explicitly allowlisted here, so a future Org binding -is denied by default and there is nothing to keep in sync.") - -(define-minor-mode cj/agenda-frame-mode - "Read-only, focus-locked policy for the dedicated agenda frame. -Only the allowlist in `cj/agenda-frame-mode-map' is permitted: navigation, -the engage/open keys (routed to the working frame), and the frame's own -controls. Every other key/mouse command is denied. The enforcement -boundary is keys and mouse; a direct \\[execute-extended-command] is out -of contract." - :init-value nil - :lighter " AgendaFrame" - :keymap cj/agenda-frame-mode-map) - -(defun cj/--agenda-frame-shadow-mutations (&optional source-map prefix) - "Deny every SOURCE-MAP key sequence not on the frame map's allowlist. -Walk SOURCE-MAP (default `org-agenda-mode-map') recursively. For each -sequence it binds to a command, if `cj/agenda-frame-mode-map' doesn't already -bind that sequence to a command or manage it as a prefix, add an explicit -read-only deny. - -This closes the default-deny hole: a keymap's `[t]' default never shadows an -explicit binding in a lower-priority map, so a single `[t]' catch-all denies -only keys that are unbound everywhere. Every key `org-agenda-mode-map' binds -\(t, I, k, z, s, ., the C-c mutators, C-x C-s, ...) would otherwise sail -through the catch-all and mutate source files from the read-only frame. -Explicitly denying each non-allowlisted sequence makes the catch-all's intent -actually hold. - -PREFIX is the accumulated key vector during recursion (internal). Idempotent: -re-running rebinds the same denials. Runs from `with-eval-after-load' once -`org-agenda-mode-map' exists." - (let ((source (or source-map org-agenda-mode-map)) - (prefix (or prefix []))) - (map-keymap - (lambda (event binding) - (unless (or (eq event t) (eq event 'menu-bar) (eq event 'remap) - (consp event)) - (let ((seq (vconcat prefix (vector event)))) - (cond - ((keymapp binding) - (cj/--agenda-frame-shadow-mutations binding seq)) - ((commandp binding) - (let ((ours (lookup-key cj/agenda-frame-mode-map seq))) - ;; A command we allowlisted or a prefix we manage: leave it. - ;; Anything else (only the `[t]' default, or unbound under a - ;; shared prefix) escapes to org's command -- deny it here. - (unless (or (commandp ours) (keymapp ours)) - (define-key cj/agenda-frame-mode-map seq - #'cj/--agenda-frame-denied-readonly)))))))) - source))) - -;; The shadow walk is installed at the END of this file, not here: it reads -;; `commandp' on each allowlisted binding to decide whether to keep it, and the -;; view/redo handlers (day-view, week-view, safe-redo) are defined further down. -;; If org-agenda is already loaded when this file loads (the normal startup order, -;; and every reload), `with-eval-after-load' fires immediately -- so the walk must -;; not run until those defuns exist, or it reads them as undefined, fails the -;; commandp guard, and denies the very keys the allowlist grants. See the bottom -;; of the file. - -(defun cj/--agenda-frame-maybe-enable-mode () - "Re-enable `cj/agenda-frame-mode' after an agenda build in the agenda frame. -Added to `org-agenda-finalize-hook'. `org-agenda-redo' rebuilds through -`org-agenda-mode', whose `kill-all-local-variables' strips the buffer-local -minor mode; this reinstates it whenever the just-built buffer is displayed -in the frame carrying the `cj/agenda-frame' marker (a frame parameter, which -survives the buffer reset). Ordinary agenda builds in working frames are -left untouched. - -The same reset also strips the buffer-local `kill-buffer-hook' installed at -spawn, so it is re-added here too -- otherwise, after the first refresh -tick, killing the buffer would no longer delete the frame." - (let ((frame (cj/--agenda-frame))) - (when (and frame (get-buffer-window (current-buffer) frame)) - (cj/agenda-frame-mode 1) - (add-hook 'kill-buffer-hook #'cj/--agenda-frame-on-kill-buffer nil t)))) - -;;; Frame lifecycle — spawn, raise, delete, toggle, cleanup - -(defconst cj/--agenda-frame-timer-parameter 'cj/agenda-frame-timer - "Frame parameter holding the agenda frame's refresh timer (set in Phase 2).") - -(declare-function auto-dim-other-buffers-mode "auto-dim-other-buffers" (&optional arg)) - -(defvar cj/--agenda-frame-dim-was-on nil - "Non-nil when the agenda frame's spawn turned `auto-dim-other-buffers-mode' off. -The refresh tick's selection swing marks the working window non-selected, -and auto-dim's debounced dim lands after the tick -- the working frame -visibly dims every five minutes. Spawn suspends the mode and remembers it -here; closing the frame restores it.") - -(defun cj/--agenda-frame-suspend-dim () - "Turn auto-dim off for the agenda frame's lifetime, remembering it was on." - (when (and (bound-and-true-p auto-dim-other-buffers-mode) - (fboundp 'auto-dim-other-buffers-mode)) - (setq cj/--agenda-frame-dim-was-on t) - (auto-dim-other-buffers-mode -1))) - -(defun cj/--agenda-frame-restore-dim () - "Restore auto-dim if the agenda frame's spawn suspended it." - (when (and cj/--agenda-frame-dim-was-on - (fboundp 'auto-dim-other-buffers-mode)) - (setq cj/--agenda-frame-dim-was-on nil) - (auto-dim-other-buffers-mode 1))) - -(defvar cj/--agenda-frame-tearing-down nil - "Non-nil while the agenda frame is being torn down. -Breaks the `delete-frame' / `kill-buffer-hook' re-entrancy loop: deleting -the frame kills its buffer and killing the buffer deletes the frame, so -whichever fires first sets this to skip the other.") - -(defun cj/--agenda-frame-sticky-buffer () - "Return the dedicated *Org Agenda(F)* sticky buffer, or nil if none." - (get-buffer (format "*Org Agenda(%s)*" cj/--agenda-frame-command-key))) - -(defun cj/--agenda-frame-cancel-timer (&optional frame) - "Cancel and clear the refresh timer on FRAME (default: the agenda frame). -Safe when no timer is set or FRAME is dead. Returns nil." - (let* ((frame (or frame (cj/--agenda-frame))) - (timer (and (frame-live-p frame) - (frame-parameter frame cj/--agenda-frame-timer-parameter)))) - (when (timerp timer) - (cancel-timer timer)) - (when (frame-live-p frame) - (set-frame-parameter frame cj/--agenda-frame-timer-parameter nil)) - nil)) - -(defun cj/--agenda-frame-on-delete-frame (frame) - "Clean up when the agenda FRAME dies by any path. -Registered on `delete-frame-functions': cancels the refresh timer and -kills the dedicated sticky buffer, so the next spawn regenerates fresh -rather than reusing stale sticky content. A non-agenda frame is ignored." - (when (cj/--agenda-frame-p frame) - (cj/--agenda-frame-cancel-timer frame) - (cj/--agenda-frame-restore-dim) - (let ((buffer (cj/--agenda-frame-sticky-buffer)) - (cj/--agenda-frame-tearing-down t)) - (when (buffer-live-p buffer) - (kill-buffer buffer))))) - -(defun cj/--agenda-frame-on-kill-buffer () - "Delete the agenda frame when its dedicated buffer is killed. -A buffer-local `kill-buffer-hook' on the sticky buffer, so killing it from -anywhere takes the frame with it. Guarded against re-entry during a -frame-initiated teardown." - (unless cj/--agenda-frame-tearing-down - (let ((frame (cj/--agenda-frame))) - (when (frame-live-p frame) - (delete-frame frame))))) - -(defun cj/--agenda-frame-delete () - "Delete the agenda frame; a no-op when none exists. -`delete-frame' fires `cj/--agenda-frame-on-delete-frame', which cancels -the timer and kills the sticky buffer." - (let ((frame (cj/--agenda-frame))) - (when (frame-live-p frame) - (delete-frame frame)))) - -(defun cj/--agenda-frame-raise (frame) - "Raise FRAME and give it input focus. Returns FRAME." - (select-frame-set-input-focus frame) - frame) - -(defun cj/--agenda-frame-make-parameters () - "Return the frame parameters for the dedicated agenda frame. -A normal frame -- not fullscreen -- so a tiling window manager places it -side by side with the working frame rather than covering the whole output. -It carries the `cj/agenda-frame' marker and a distinct, noticeable name -\(\"Full Agenda\") so the frame is recognizable at a glance and -window-manager rules can target it." - `((,cj/--agenda-frame-parameter . t) - (name . "Full Agenda"))) - -(defun cj/--agenda-frame-spawn () - "Create, display, and focus the dedicated agenda frame. -Transactional: on any failure after `make-frame', delete the partial -frame (which cleans up its buffer and timer via the delete hook), restore -focus to the launching frame, and signal a `user-error' naming the cause. -Returns the new agenda frame on success." - (let ((launch (selected-frame)) - (frame nil)) - (condition-case err - (progn - (setq cj/--agenda-frame-launch-frame launch) - ;; A fresh frame opens at the documented seven-day default, even if a - ;; prior session left the span on the day view (d). - (setq cj/--agenda-frame-span 7) - (setq frame (make-frame (cj/--agenda-frame-make-parameters))) - (select-frame-set-input-focus frame) - ;; Cached, non-forced: a frame spawned early after daemon startup - ;; still shows the full project agenda, not the base-files-only view. - (cj/build-org-agenda-list) - ;; Bind sticky + current-window dynamically around the render. The - ;; custom command's own settings apply too late to name the buffer; - ;; without these the buffer is plain *Org Agenda*, which matches the - ;; 0.75 below-selected display rule in org-agenda-config.el -- the - ;; new frame gets split with the launch buffer left in the top 25%. - ;; Sticky names it *Org Agenda(F)*, which no display rule matches. - (let ((org-agenda-sticky t) - (org-agenda-window-setup 'current-window)) - (org-agenda "a" cj/--agenda-frame-command-key)) - ;; Belt: whatever a display rule did, the frame is one agenda window. - (delete-other-windows) - (let ((buffer (cj/--agenda-frame-sticky-buffer))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (add-hook 'kill-buffer-hook - #'cj/--agenda-frame-on-kill-buffer nil t)))) - (cj/--agenda-frame-start-timer frame) - (cj/--agenda-frame-suspend-dim) - frame) - (error - (when (frame-live-p frame) - (delete-frame frame)) - (when (frame-live-p launch) - (select-frame-set-input-focus launch)) - (user-error "Agenda frame: spawn failed: %s" - (error-message-string err)))))) - -(defun cj/--agenda-frame-toggle () - "Spawn, raise, or delete the dedicated agenda frame. -Spawn when none exists, delete when the agenda frame is the selected -frame, raise and focus it otherwise. - -Non-interactive by design in Phase 1: reachable only from ERT, never from -\\[execute-extended-command] or a key. Phase 2 wraps this in the public -`cj/agenda-frame-toggle' and binds it to S-<f8>." - (let ((frame (cj/--agenda-frame))) - (cond - ((null frame) (cj/--agenda-frame-spawn)) - ((eq frame (selected-frame)) (cj/--agenda-frame-delete) nil) - (t (cj/--agenda-frame-raise frame))))) - -;;; Phase 2 — refresh timer, snapshot restore, and the public command - -(defconst cj/--agenda-frame-refresh-seconds 300 - "Refresh cadence for the agenda frame, in seconds (five minutes).") - -(defconst cj/--agenda-frame-fail-count-parameter 'cj/agenda-frame-fail-count - "Frame parameter holding the consecutive-failure count for the refresh timer.") - -(defconst cj/--agenda-frame-overlay-property 'cj/agenda-frame-failure - "Overlay property tagging the refresh-failed banner. -The banner is found by scanning for this property, never held in a -buffer-local variable: `org-agenda-redo' runs `kill-all-local-variables', -which would wipe the variable while the overlay object survives -`erase-buffer' -- leaving a banner nothing could ever remove.") - -(defun cj/--agenda-frame-seconds-to-next-mark (time period) - "Return seconds from TIME to the next wall-clock multiple of PERIOD. -TIME is any Emacs time value, PERIOD is seconds (300 gives the :00/:05 -marks). A TIME exactly on a mark returns a full PERIOD, so the timer -never fires twice back-to-back." - (let ((rem (mod (floor (float-time time)) period))) - (if (zerop rem) period (- period rem)))) - -;; -- Point restoration ------------------------------------------------------- - -(defun cj/--agenda-frame-goto-first-item () - "Move point to the first agenda item, or `point-min' when the view is empty." - (goto-char (point-min)) - (let ((found nil)) - (while (and (not found) (not (eobp))) - (if (get-text-property (line-beginning-position) 'org-marker) - (setq found t) - (forward-line 1))) - (unless found (goto-char (point-min))))) - -(defun cj/--agenda-frame-restore-point (old-marker old-line) - "Restore point in the rebuilt agenda buffer after a redo. -Prefer the line whose org-marker points at the same source location as -OLD-MARKER, choosing the occurrence nearest OLD-LINE when a source line -appears twice. When the marker is gone, clamp OLD-LINE into range; if -that lands on a header (no item), move to the first item; an item-less -view leaves point at buffer start." - (let ((max-line (line-number-at-pos (point-max))) - (targets '())) - (when (and (markerp old-marker) (marker-buffer old-marker)) - (let ((src-buf (marker-buffer old-marker)) - (src-pos (marker-position old-marker))) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (let ((m (get-text-property (line-beginning-position) 'org-marker))) - (when (and (markerp m) - (eq (marker-buffer m) src-buf) - (eql (marker-position m) src-pos)) - (push (line-number-at-pos) targets))) - (forward-line 1))))) - (cond - (targets - (let ((best (car (sort targets - (lambda (a b) - (< (abs (- a old-line)) (abs (- b old-line)))))))) - (goto-char (point-min)) - (forward-line (1- best)))) - (t - (let ((line (max 1 (min old-line max-line)))) - (goto-char (point-min)) - (forward-line (1- line)) - (unless (get-text-property (line-beginning-position) 'org-marker) - (cj/--agenda-frame-goto-first-item))))))) - -;; -- Snapshot with cloned markers -------------------------------------------- - -(defun cj/--agenda-frame-snapshot-markers (buffer) - "Return a list of (POSITION . CLONE) for every org-marker in BUFFER. -CLONE is an independent `copy-marker' into the same source location, so -it survives `org-agenda-reset-markers' nulling BUFFER's own markers on a -rebuild." - (with-current-buffer buffer - (let ((clones '()) - (pos (point-min))) - (while (< pos (point-max)) - (let ((m (get-text-property pos 'org-marker))) - (when (and (markerp m) (marker-buffer m)) - (push (cons pos (copy-marker m)) clones))) - (setq pos (or (next-single-property-change pos 'org-marker buffer) - (point-max)))) - (nreverse clones)))) - -(defun cj/--agenda-frame-reinstall-markers (buffer clones) - "Reapply CLONES (from `cj/--agenda-frame-snapshot-markers') to BUFFER. -Restores each cloned marker as the org-marker text property at its -recorded position, so RET/TAB resolve to the right source line after a -snapshot restore." - (with-current-buffer buffer - (dolist (entry clones) - (let ((pos (car entry))) - (when (and (>= pos (point-min)) (< pos (point-max))) - (put-text-property pos (1+ pos) 'org-marker (cdr entry))))))) - -(defun cj/--agenda-frame-snapshot (buffer window) - "Capture BUFFER's last-good state for restore after a failed redo. -Returns a plist of the propertized :text (carrying org-redo-cmd/org-lprops), -:point, :window-start, and :markers (cloned, source-owned)." - (with-current-buffer buffer - (list :text (buffer-substring (point-min) (point-max)) - :point (point) - :window-start (and (window-live-p window) (window-start window)) - :markers (cj/--agenda-frame-snapshot-markers buffer)))) - -(defun cj/--agenda-frame-restore-snapshot (buffer snapshot window) - "Restore SNAPSHOT verbatim into BUFFER, reinstating cloned markers. -Sets point and, when WINDOW is live, window-start from the snapshot." - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (plist-get snapshot :text)) - (cj/--agenda-frame-reinstall-markers buffer (plist-get snapshot :markers)) - (goto-char (min (plist-get snapshot :point) (point-max)))) - (when (and (window-live-p window) (plist-get snapshot :window-start)) - (set-window-start window (min (plist-get snapshot :window-start) - (point-max)))))) - -(defun cj/--agenda-frame-release-snapshot (snapshot) - "Release SNAPSHOT's cloned markers so repeated redoes don't leak markers. -Called on a successful redo (the snapshot is discarded); never on the -error path, where the clones become the buffer's live org-markers." - (dolist (entry (plist-get snapshot :markers)) - (when (markerp (cdr entry)) - (set-marker (cdr entry) nil)))) - -;; -- Failure latch and overlay ----------------------------------------------- - -(defun cj/--agenda-frame-record-failure (frame) - "Increment FRAME's consecutive-failure count; return non-nil to report. -Reports only on the first failure of a run (the 0 -> 1 transition)." - (let ((n (1+ (or (frame-parameter frame cj/--agenda-frame-fail-count-parameter) - 0)))) - (set-frame-parameter frame cj/--agenda-frame-fail-count-parameter n) - (= n 1))) - -(defun cj/--agenda-frame-clear-failure (frame) - "Reset FRAME's consecutive-failure count (the next tick reports again)." - (set-frame-parameter frame cj/--agenda-frame-fail-count-parameter 0)) - -(defun cj/--agenda-frame-failure-overlays (buffer) - "Return the refresh-failed banner overlays in BUFFER (normally 0 or 1)." - (with-current-buffer buffer - (seq-filter (lambda (o) (overlay-get o cj/--agenda-frame-overlay-property)) - (overlays-in (point-min) (point-max))))) - -(defun cj/--agenda-frame-show-failure-overlay (buffer) - "Show the refresh-failed notice as an overlay at the top of BUFFER. -Idempotent: an existing banner is reused, so consecutive failures never -stack a second one." - (with-current-buffer buffer - (let ((overlay (or (car (cj/--agenda-frame-failure-overlays buffer)) - (make-overlay (point-min) (point-min))))) - (overlay-put overlay cj/--agenda-frame-overlay-property t) - (overlay-put overlay 'before-string - (propertize "Agenda frame: refresh failed (C-M-<f8> to force-rescan)\n" - 'face 'warning))))) - -(defun cj/--agenda-frame-remove-overlay (buffer) - "Remove the refresh-failed banner from BUFFER, if present." - (when (buffer-live-p buffer) - (mapc #'delete-overlay (cj/--agenda-frame-failure-overlays buffer)))) - -;; -- The refresh itself ------------------------------------------------------ - -(defun cj/--agenda-frame-do-redo (frame buffer window) - "Redo the agenda in BUFFER, degrading to the last-good snapshot on failure. -On success: drop the failure overlay, restore point, clear the failure -latch, and release the pre-redo snapshot. On error: restore the snapshot -verbatim, re-enable the policy (the finalize hook runs only on success), -show the failure overlay, and report once per consecutive-failure run. -Either way the frame is never blank, unrestricted, or non-retryable." - (with-current-buffer buffer - ;; Clone the point marker: `org-agenda-redo' calls `org-agenda-reset-markers' - ;; which nulls the buffer's own org-markers, so the raw marker would be dead - ;; by the time `cj/--agenda-frame-restore-point' runs -- collapsing the - ;; "follow the same source item" restoration to the line-number clamp on - ;; every normal tick. An independent clone survives the reset. - (let ((old-marker (let ((m (cj/--agenda-frame-item-marker))) - (and (markerp m) (marker-buffer m) (copy-marker m)))) - (old-line (line-number-at-pos)) - (snapshot (cj/--agenda-frame-snapshot buffer window))) - (unwind-protect - (condition-case nil - ;; Never bind sticky here: `org-agenda-redo' handles the - ;; in-place rebuild itself (binds sticky nil, redirects the - ;; buffer name). A sticky t reaching `org-agenda-prepare' - ;; mid-redo makes it throw \\='exit with no catch, failing - ;; every tick. current-window is bound as a belt so a rule - ;; can't split the frame during the rebuild. - (let ((inhibit-message t) - (org-agenda-window-setup 'current-window)) - (org-agenda-redo) - (cj/--agenda-frame-remove-overlay buffer) - (cj/--agenda-frame-restore-point old-marker old-line) - (cj/--agenda-frame-clear-failure frame) - (cj/--agenda-frame-release-snapshot snapshot)) - (error - (cj/--agenda-frame-restore-snapshot buffer snapshot window) - (cj/agenda-frame-mode 1) - (cj/--agenda-frame-show-failure-overlay buffer) - (when (cj/--agenda-frame-record-failure frame) - (message "Agenda frame: refresh failed (C-M-<f8> to force-rescan)")))) - (when (markerp old-marker) - (set-marker old-marker nil)))))) - -(defun cj/--agenda-frame-safe-redo (&optional frame) - "Refresh the agenda buffer in FRAME safely (the timer tick and manual `r'). -Runs with the dedicated window selected for the redo's dynamic extent and -restores the prior window afterward, never calling an input-focus -function, so a tick while another frame is active neither errors on an -out-of-range window-start nor steals focus." - (interactive) - (let* ((frame (or frame (cj/--agenda-frame))) - (buffer (cj/--agenda-frame-sticky-buffer)) - (window (and (frame-live-p frame) (buffer-live-p buffer) - (get-buffer-window buffer frame)))) - (when (and (window-live-p window) - ;; Skip the tick while a minibuffer is active anywhere -- - ;; reselecting windows under an active minibuffer session can - ;; break it, and the next tick catches up. - (not (active-minibuffer-window))) - (let ((prev-window (selected-window)) - ;; The rebuild takes visible time, and for its duration the - ;; agenda window is the selected window. Without inhibiting - ;; redisplay the user's cursor visibly goes hollow for the whole - ;; rebuild every tick -- indistinguishable from focus theft. - ;; The rebuild blocks Emacs either way (it is synchronous), so - ;; this hides the selection flicker at no extra cost; redisplay - ;; resumes after the selection is restored. - (inhibit-redisplay t)) - (unwind-protect - (progn - (select-window window t) - (cj/--agenda-frame-do-redo frame buffer window)) - (when (window-live-p prev-window) - (select-window prev-window t))))))) - -(defun cj/--agenda-frame-day-view () - "Shrink the Full Agenda frame to today's single-day view. -Sets the span to 1 and refreshes. The redo re-evaluates the span, so the -day view survives the wall-clock refresh tick until `w' widens it again." - (interactive) - (setq cj/--agenda-frame-span 1) - (cj/--agenda-frame-safe-redo)) - -(defun cj/--agenda-frame-week-view () - "Restore the Full Agenda frame to the seven-day today-anchored view. -Sets the span back to 7 and refreshes." - (interactive) - (setq cj/--agenda-frame-span 7) - (cj/--agenda-frame-safe-redo)) - -(defun cj/--agenda-frame-start-timer (frame) - "Start FRAME's five-minute wall-clock refresh timer, unless one exists. -Idempotent: a frame already carrying a live timer keeps it (no duplicate). -Returns the timer." - (unless (timerp (frame-parameter frame cj/--agenda-frame-timer-parameter)) - (let* ((period cj/--agenda-frame-refresh-seconds) - (delay (cj/--agenda-frame-seconds-to-next-mark (current-time) period)) - (timer (run-at-time delay period #'cj/--agenda-frame-safe-redo frame))) - (set-frame-parameter frame cj/--agenda-frame-timer-parameter timer) - timer))) - -;; -- Public command and key install ------------------------------------------ - -(defun cj/agenda-frame-toggle () - "Toggle the dedicated agenda frame. -Spawn it when none exists, raise and focus it when it exists but is -unfocused, and close it when it is the selected frame." - (interactive) - (cj/--agenda-frame-toggle)) - -(defun cj/--agenda-frame-install-keys (&optional map) - "Bind the F8-family keys for the agenda frame in MAP (default: the global map). -S-<f8> toggles the agenda frame; the force-rescan -\(`cj/org-agenda-refresh-files') moves to C-M-<f8>, keeping the whole -force-refresh idea in the F8 family." - (let ((map (or map (current-global-map)))) - (define-key map (kbd "S-<f8>") #'cj/agenda-frame-toggle) - (define-key map (kbd "C-M-<f8>") #'cj/org-agenda-refresh-files))) - -;;; Wiring — registered once org-agenda is loaded (no batch side effects) - -(with-eval-after-load 'org-agenda - (cj/--agenda-frame-register-command) - (add-hook 'org-agenda-finalize-hook #'cj/--agenda-frame-maybe-enable-mode) - (add-hook 'delete-frame-functions #'cj/--agenda-frame-on-delete-frame)) - -;; The public gesture appears only now that the feature is complete and live. -(cj/--agenda-frame-install-keys) - -;; Install the read-only shadow now that every allowlist handler above is -;; defined, so the walk's `commandp' guard recognizes them and preserves the -;; allowlist regardless of whether org-agenda loaded before or after this file. -(with-eval-after-load 'org-agenda - (cj/--agenda-frame-shadow-mutations)) - -(provide 'org-agenda-frame) -;;; org-agenda-frame.el ends here diff --git a/modules/org-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 a1377160..e9586a97 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -39,6 +39,7 @@ ;;; Code: (require 'user-constants) ;; code-dir, projects-dir, snippets-dir +(require 'cl-lib) (defvar display-line-numbers-type) (defvar outline-minor-mode-map) @@ -57,6 +58,7 @@ (declare-function dired-get-filename "dired") (declare-function global-treesit-auto-mode "treesit-auto") (declare-function treesit-auto-add-to-auto-mode-alist "treesit-auto") +(declare-function treesit-auto-install-all "treesit-auto") (declare-function treesit-auto-recipe-lang "treesit-auto") (declare-function highlight-indent-guides-mode "highlight-indent-guides") (declare-function electric-pair-default-inhibit "elec-pair") @@ -117,23 +119,32 @@ 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. +Discover the `revision' slot at runtime because treesit-auto is not loaded +when this file's `use-package' form is macro-expanded." + (when-let ((go-recipe + (cl-find-if + (lambda (recipe) + (eq (treesit-auto-recipe-lang recipe) 'go)) + recipes))) + (aset go-recipe + (cl-struct-slot-offset 'treesit-auto-recipe 'revision) + "v0.19.1") + go-recipe)) + (use-package treesit-auto :custom (treesit-auto-install 'prompt) :config - (require 'cl-lib) ;; Pin Go grammar to v0.19.1 for compatibility with Emacs 30.2 font-lock queries - (let* ((go-idx (cl-position-if (lambda (recipe) - (eq (treesit-auto-recipe-lang recipe) 'go)) - treesit-auto-recipe-list)) - (go-recipe (and go-idx (nth go-idx treesit-auto-recipe-list)))) - (when go-recipe - ;; Use the struct accessor so a treesit-auto slot reorder can't silently - ;; write the pin into the wrong field. - (setf (treesit-auto-recipe-revision go-recipe) "v0.19.1"))) + (cj/treesit-auto-pin-go-revision treesit-auto-recipe-list) (treesit-auto-add-to-auto-mode-alist 'all) (global-treesit-auto-mode)) diff --git a/modules/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 acc9e482..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 @@ -48,6 +49,7 @@ ;;; Code: (require 'keybindings) +(require 'system-lib) ; cj/log-silently, used by the death alert (use-package telega :defer t @@ -63,6 +65,141 @@ ;; routing through a shared messenger notifier is the unification task. (telega-notifications-mode 1)) +;; --------------------------- telega Docker Image Pin ------------------------- +;; 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.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. +;; +;; 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 + "cj/telega-server:1.8.66-glycin" + "Container image reference for `telega-server', or nil for telega's default. +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) + +(defun cj/--telega-docker-pinned-image () + "Return the configured image pin, or nil when none is usable. +A blank or non-string setting yields nil rather than reaching the docker +command line, where it would fail in a way that looks unrelated to this." + (when (stringp cj/telega-docker-image) + (let ((pin (string-trim cj/telega-docker-image))) + (unless (string-empty-p pin) pin)))) + +(defun cj/--telega-docker-image-name (orig-fun &rest args) + "Return the pinned telega-server image, else call ORIG-FUN with ARGS. +`:around' advice on `telega-docker--image-name', so clearing the pin +restores telega's own inference instead of breaking the image name." + (or (cj/--telega-docker-pinned-image) + (apply orig-fun args))) + +(with-eval-after-load 'telega-util + (advice-add 'telega-docker--image-name :around #'cj/--telega-docker-image-name)) + +;; ------------------------- telega-server Death Alert ------------------------- +;; telega's own sentinel reports an abnormal server exit with `message', which +;; scrolls out of the echo area unseen. That is how a dead server reads as a +;; quiet Telegram: the scan stops partway and the unscanned chats look like +;; chats with nothing in them. It has happened twice (2026-07-10, 2026-07-27), +;; caught both times only because something downstream noticed. A desktop +;; notification makes the death itself visible. + +(declare-function notifications-notify "notifications") + +(defun cj/--telega-server-death-p (status) + "Return non-nil when exit STATUS means the server died abnormally. +Any non-zero integer counts, which covers both a non-zero exit code and a +fatal signal number (`process-exit-status' reports SIGSEGV as 11). A +non-integer STATUS returns nil rather than signalling: this runs inside +telega's sentinel, where an error would abort telega's own cleanup." + (and (integerp status) + (not (zerop status)))) + +(defun cj/--telega-server-exit-status (proc) + "Return PROC's exit status, or nil when it can't be determined. +Guarded because the sentinel hands over whatever process object it has, +and a bad one must not break telega's status handling." + (condition-case nil + (and (processp proc) (process-exit-status proc)) + (error nil))) + +(defun cj/--telega-server-death-body (status event) + "Build the notification body for a server death with STATUS and EVENT. +EVENT is the sentinel's event string, which carries a trailing newline that +would render as dead space in a desktop notification." + (let ((detail (string-trim (or event "")))) + (concat (format "telega-server died (status %s). " status) + (unless (string-empty-p detail) (concat detail ". ")) + "Telegram coverage is down until it restarts."))) + +(defun cj/--telega-server-send-notification (title body) + "Deliver a desktop notification with TITLE and BODY. +Prefers the external notify script (persistent, so it waits rather than +auto-dismissing while away), falling back to `notifications-notify'. +Mirrors `cj/slack--send-notification'." + (let ((script (executable-find "notify"))) + (if script + (start-process "telega-death-notify" nil script "fail" title body "--persist") + (unless (fboundp 'notifications-notify) + (require 'notifications)) + (notifications-notify :title title :body body)))) + +(defun cj/--telega-server-notify-death (proc event) + "Notify when the telega-server PROC dies abnormally. EVENT is its event string. +Installed as `:after' advice on `telega-server--sentinel'. Silent on a +clean exit, so quitting telega deliberately never pages. + +The whole body is guarded: a notifier failure here would otherwise escape +into telega's sentinel and abort its status handling and relogin path." + (condition-case err + (let ((status (cj/--telega-server-exit-status proc))) + (when (cj/--telega-server-death-p status) + (cj/--telega-server-send-notification + "Telegram: telega-server died" + (cj/--telega-server-death-body status event)))) + (error + (cj/log-silently + (format "telega death notify failed: %s" (error-message-string err)))))) + +;; Named, never a lambda: anonymous advice can't be `advice-remove'd by +;; reference, so a live daemon keeps running it after the source stops +;; installing it. +(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. @@ -71,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 |