diff options
Diffstat (limited to 'modules')
78 files changed, 3545 insertions, 1405 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/ai-term-backend-eat.el b/modules/ai-term-backend-eat.el index 9a166ff8..906abd00 100644 --- a/modules/ai-term-backend-eat.el +++ b/modules/ai-term-backend-eat.el @@ -100,14 +100,21 @@ typed into a bare shell. Returns the poll timer." (cancel-timer timer)))))) timer)) -(defun cj/--ai-term-show-or-create (dir name) +(defun cj/--ai-term-show-or-create (dir name &optional agent-command sessions) "Show or create the AI-term buffer for project DIR with buffer NAME. +SESSIONS, when non-nil, is a pre-fetched +`cj/--ai-term-live-tmux-sessions' list threaded from the caller so the +launch path pays for the tmux subprocess once. If a buffer named NAME exists with a live process, display it. If the buffer exists but its process is dead, kill it and recreate. If no such buffer exists, create a new EAT terminal in DIR and send the project's tmux launch command (see `cj/--ai-term-launch-command') so the same project basename reattaches across Emacs restarts. +AGENT-COMMAND, when non-nil, is the full agent launch command for a +fresh session (the multi-backend picker's choice); nil falls back to +`cj/ai-term-agent-command'. A reattach ignores it (`tmux new-session +-A' attaches without running the command). EAT runs a plain shell with no auto-tmux hook, so the named `tmux new-session -A' launch command is the only thing that starts the @@ -131,7 +138,8 @@ buffer." ;; session gets the project /color injected below; a reattach carries ;; whatever color the running Claude already has. (let ((fresh (not (cj/--ai-term-session-active-p - dir (cj/--ai-term-live-tmux-sessions))))) + dir (or sessions + (cj/--ai-term-live-tmux-sessions)))))) ;; `eat' switches to its buffer in the selected window before our ;; display-buffer-alist rule can route it; `save-window-excursion' ;; reverts that, and the explicit display-buffer below routes the buffer @@ -148,19 +156,21 @@ buffer." (with-current-buffer buf (cj/--ai-term-apply-accent buf) (cj/--ai-term-send-string - buf (concat (cj/--ai-term-launch-command dir) "\n"))) + buf (concat (cj/--ai-term-launch-command dir agent-command) "\n"))) (when fresh (cj/--ai-term-schedule-color buf (cj/--ai-term-project-color dir))) (display-buffer buf) buf)))))) ;; In EAT's semi-char mode, keys not bound in `eat-semi-char-mode-map' are -;; forwarded to the pty. M-SPC (swap to the next agent) must reach Emacs from -;; inside an agent buffer, so bind it in that map -- no exception-list or rebuild +;; forwarded to the pty. The swap-to-next chords must reach Emacs from inside +;; an agent buffer, so bind them in that map -- no exception-list or rebuild ;; dance like ghostel needed. C-; is already bound there (eat-config), so the ;; C-; a family resolves through the global prefix without extra wiring. +;; M-SPC cycles attached agents only; M-S-SPC cycles all (attaching a detached). (with-eval-after-load 'eat - (keymap-set eat-semi-char-mode-map "M-SPC" #'cj/ai-term-next)) + (keymap-set eat-semi-char-mode-map "M-SPC" #'cj/ai-term-next-attached) + (keymap-set eat-semi-char-mode-map "M-S-SPC" #'cj/ai-term-next)) (provide 'ai-term-backend-eat) ;;; ai-term-backend-eat.el ends here diff --git a/modules/ai-term-display.el b/modules/ai-term-display.el index b78a2638..fdb2b7ed 100644 --- a/modules/ai-term-display.el +++ b/modules/ai-term-display.el @@ -248,10 +248,13 @@ or a layout split on the other axis), so the chain falls through to nil when the edge window is dedicated -- those are not ours to replace. Records the displaced buffer through `display-buffer-record-window' -\(type `reuse') before swapping, so the native `quit-restore-window' -called at toggle-off puts that buffer back into the slot instead of -deleting the window -- toggling swaps the slot's buffer between the -displaced buffer and the agent, never changing the window count. +\(type `reuse') before swapping. Toggle-off does NOT put that buffer +back: `cj/--ai-term-toggle-off' deletes the agent's window outright in +multi-window layouts, because the slot's `quit-restore' parameter goes +stale when several agents share it (see its docstring). The displaced +buffer stays alive and reachable through normal buffer switching; the +record call just keeps the window's `quit-restore' parameter accurate +for native `quit-window' paths outside the toggle. Runs after `cj/--ai-term-reuse-existing-agent', so an agent already on screen has been handled already; the window reused here always holds a diff --git a/modules/ai-term-sessions.el b/modules/ai-term-sessions.el index 99585a70..57d735d1 100644 --- a/modules/ai-term-sessions.el +++ b/modules/ai-term-sessions.el @@ -65,6 +65,20 @@ the start so names like \"foo agent [bar]\" do not match." (buffer-live-p buffer) (string-prefix-p cj/--ai-term-name-prefix (buffer-name buffer)))) +(defun cj/--ai-term-buffer-basename (buffer) + "Return the project basename embedded in BUFFER's AI-term name, or nil. + +The buffer name is \"agent [<basename>]\" (see +`cj/--ai-term-buffer-name') and never changes for the buffer's life, +unlike `default-directory', which ghostel retargets via OSC 7 every time +the shell cds. Teardown paths must key tmux-session lookups off this, +not the directory, or a close after a cd kills the wrong aiv- session. +Returns nil when BUFFER is not a live AI-term buffer." + (when (cj/--ai-term-buffer-p buffer) + (let ((name (buffer-name buffer))) + (when (string-suffix-p "]" name) + (substring name (length cj/--ai-term-name-prefix) -1))))) + (defun cj/--ai-term-agent-buffers () "Return the live AI-term buffers in `buffer-list' order. @@ -107,6 +121,23 @@ which the step materializes by attaching." (lambda (a b) (string< (cj/--ai-term-buffer-name a) (cj/--ai-term-buffer-name b)))))) +(defun cj/--ai-term-attached-agent-dirs () + "Return project dirs that have a live agent BUFFER (attached only). + +Like `cj/--ai-term-active-agent-dirs' but excludes detached tmux +sessions with no Emacs buffer -- this is the queue `cj/ai-term-next-attached' +\(M-SPC) steps through, so the fast chord stays among agents already on +screen. Detached sessions are reachable only via `cj/ai-term-next' +\(M-S-SPC). Sorted by agent buffer name for a stable rotation." + (let ((live-names (mapcar #'buffer-name (cj/--ai-term-agent-buffers)))) + (sort + (seq-filter + (lambda (dir) + (member (cj/--ai-term-buffer-name dir) live-names)) + (cj/--ai-term-candidates)) + (lambda (a b) + (string< (cj/--ai-term-buffer-name a) (cj/--ai-term-buffer-name b)))))) + (defun cj/--ai-term-tmux-session-name (dir) "Return the tmux session name for project directory DIR. @@ -157,7 +188,7 @@ looked up in SESSIONS, so the lossy whitespace->hyphen transform in `cj/--ai-term-tmux-session-name' never needs reversing." (and (member (cj/--ai-term-tmux-session-name dir) sessions) t)) -(defun cj/--ai-term-launch-command (dir) +(defun cj/--ai-term-launch-command (dir &optional agent-command) "Return the shell command line that runs the AI tool in a project tmux session. Uses `tmux new-session -A' so a second toggle on the same project reattaches @@ -167,9 +198,12 @@ comes from `cj/--ai-term-tmux-session-name'; the first window is named window auto-names after its command and the two read distinctly. The shell command run on first creation is - <cj/ai-term-agent-command>; exec bash + <agent command>; exec bash so the tmux window survives the AI command exiting -- the session stays -alive with a bare bash prompt for recovery, and reattach works the same way." +alive with a bare bash prompt for recovery, and reattach works the same way. +AGENT-COMMAND overrides `cj/ai-term-agent-command' for the fresh-session +case (the multi-backend picker passes the chosen runtime's command); on a +reattach `tmux new-session -A' ignores the command either way." (let ((session (cj/--ai-term-tmux-session-name dir)) (start-dir (expand-file-name dir))) ;; Pass the inner shell-command-string through `shell-quote-argument' @@ -184,7 +218,8 @@ alive with a bare bash prompt for recovery, and reattach works the same way." (shell-quote-argument cj/ai-term-tmux-window-name) (shell-quote-argument start-dir) (shell-quote-argument - (concat cj/ai-term-agent-command "; exec bash"))))) + (concat (or agent-command cj/ai-term-agent-command) + "; exec bash"))))) (defun cj/--ai-term-kill-tmux-session (session) "Kill the tmux SESSION via `tmux kill-session -t SESSION'. @@ -316,8 +351,11 @@ the metadata keeps the order ALIST was built in." (cycle-sort-function . identity)) (complete-with-action action alist string predicate)))) -(defun cj/--ai-term-pick-project () +(defun cj/--ai-term-pick-project (&optional sessions) "Prompt for an AI-agent project; return its absolute path. +SESSIONS, when non-nil, is a pre-fetched result of +`cj/--ai-term-live-tmux-sessions', so a caller that already paid for the +tmux subprocess can thread it through instead of spawning another. Candidates come from `cj/--ai-term-candidates', ordered by `cj/--ai-term-sort-candidates' so projects with a live tmux session @@ -333,7 +371,7 @@ Signals `user-error' when no candidates exist." (append cj/ai-term-project-roots cj/ai-term-container-roots) ", "))) - (let* ((sessions (cj/--ai-term-live-tmux-sessions)) + (let* ((sessions (or sessions (cj/--ai-term-live-tmux-sessions))) (sorted (cj/--ai-term-sort-candidates candidates sessions)) (display-alist (mapcar (lambda (p) diff --git a/modules/ai-term.el b/modules/ai-term.el index e0706abb..52494c18 100644 --- a/modules/ai-term.el +++ b/modules/ai-term.el @@ -46,10 +46,24 @@ (defcustom cj/ai-term-agent-command "claude \"Read .ai/protocols.org and follow all instructions.\"" - "Shell command sent to a fresh AI-term to start the agent. + "Shell command for the default (\"claude\") agent runtime. -The default invokes the Claude Code CLI; set it to whatever terminal -agent you run (aider, an open-source LLM TUI, etc.)." +Sent to a fresh AI-term when no other runtime is picked; also the +fallback when launch paths bypass the runtime picker (e.g. attaching a +detached session, where the command is ignored anyway). Non-Claude +runtimes compose their commands from `cj/ai-term-agent-prompt' instead +-- see `cj/--ai-term-runtime-command'." + :type 'string + :group 'ai-term) + +(defcustom cj/ai-term-agent-prompt + "Read .ai/protocols.org and follow all instructions." + "Opening instructions passed to non-Claude agent runtimes. + +Claude, Codex, and codex --oss all take the opening instructions as a +positional prompt, so this one string serves every runtime; only the +command in front of it varies (the \"claude\" runtime carries its full +line in `cj/ai-term-agent-command' for backward compatibility)." :type 'string :group 'ai-term) @@ -240,6 +254,80 @@ without firing real `display-buffer' or `quit-window' calls." (car buffers)))) (t '(pick-project)))))))) +;; ------------------------- Agent runtime selection --------------------------- +;; A fresh session can run Claude, Codex (ChatGPT), or a local model through +;; codex --oss (ollama). Runtime names and launch strings mirror the rulesets +;; bin/ai launcher so the two launchers stay one mental model: "claude", +;; "codex", "local:<model>". The choice list itself comes from +;; `ai --print-runtimes' when that launcher is installed (single source of +;; truth, including the live ollama model scan with its own timeout); without +;; it a static claude/codex list stands in. + +(defun cj/--ai-term-runtime-command (runtime) + "Return the full agent shell command for RUNTIME. +RUNTIME is \"claude\" (or nil, both meaning `cj/ai-term-agent-command' +verbatim), \"codex\", or \"local:<model>\" for an ollama model via +codex --oss. The non-Claude commands append `cj/ai-term-agent-prompt' +as the positional opening prompt. An unknown RUNTIME signals a +`user-error' rather than launching something half-formed. The explicit +--local-provider flag is deliberate: setting the provider through +config.toml silently does nothing (rulesets, 2026-07-13)." + (cond + ((or (null runtime) (equal runtime "claude")) + cj/ai-term-agent-command) + ((equal runtime "codex") + (concat "codex " (shell-quote-argument cj/ai-term-agent-prompt))) + ((string-prefix-p "local:" runtime) + (let ((model (substring runtime (length "local:")))) + (when (string-empty-p model) + (user-error "Agent runtime %s names no ollama model" runtime)) + (concat "codex --oss --local-provider=ollama -m " + (shell-quote-argument model) " " + (shell-quote-argument cj/ai-term-agent-prompt)))) + (t (user-error "Unknown agent runtime: %s" runtime)))) + +(defun cj/--ai-term-parse-runtime-lines (output) + "Parse `ai --print-runtimes' OUTPUT into an alist of (NAME . LABEL). +Each line is \"NAME — LABEL\"; blank lines and lines without the +separator are dropped, so a stray warning in the output degrades to a +shorter list instead of a parse error." + (delq nil + (mapcar (lambda (line) + (when (string-match "\\`\\(.+?\\) — \\(.+\\)\\'" line) + (cons (match-string 1 line) (match-string 2 line)))) + (split-string output "\n" t)))) + +(defun cj/--ai-term-runtime-choices () + "Return the agent runtime choices as an alist of (NAME . LABEL). +Shells out to `ai --print-runtimes' when the launcher is installed -- +that keeps the two launchers' lists identical and reuses its live +ollama scan (which carries its own dead-server timeout). When the +launcher is absent, errors, or prints nothing parseable, a static +claude-first list stands in." + (or (when-let* ((ai (executable-find "ai"))) + (with-temp-buffer + (when (eq 0 (ignore-errors + (process-file ai nil t nil "--print-runtimes"))) + (cj/--ai-term-parse-runtime-lines (buffer-string))))) + '(("claude" . "Claude Code") + ("codex" . "ChatGPT (Codex CLI)")))) + +(defun cj/--ai-term-pick-runtime () + "Prompt for the agent runtime of a fresh session; RET picks the first. +The first choice is claude, so launching a project stays Enter-Enter +for the common case. Labels annotate the candidates." + (let* ((choices (cj/--ai-term-runtime-choices)) + (default (caar choices))) + (completing-read + (format "Agent runtime (default %s): " default) + (cj/completion-table-annotated + 'ai-term-runtime + (lambda (cand) + (when-let* ((label (cdr (assoc cand choices)))) + (format " %s" label))) + choices) + nil t nil nil default))) + (defun cj/ai-term-pick-project (&optional arg) "Pick an AI-agent project and open or reuse its EAT terminal. @@ -254,12 +342,27 @@ With prefix ARG, display the buffer without selecting its window. Bound to C-; a s -- always shows the project picker, even when an agent buffer is currently displayed. +A genuinely fresh launch (no live agent buffer AND no surviving tmux +session) also asks which agent runtime to run -- claude, codex, or a +local model; RET keeps claude, so the common case stays Enter-Enter. +Reattaches and redisplays never ask: the session already runs whatever +it runs. + EAT renders in terminal frames as well as GUI frames, so this launches from either." (interactive "P") - (let* ((dir (cj/--ai-term-pick-project)) + ;; One tmux fetch per launch: the same list feeds the picker's sorting, + ;; the fresh check here, and show-or-create's own fresh check. + (let* ((sessions (cj/--ai-term-live-tmux-sessions)) + (dir (cj/--ai-term-pick-project sessions)) (name (cj/--ai-term-buffer-name dir)) - (buf (cj/--ai-term-show-or-create dir name))) + (existing (get-buffer name)) + (fresh (and (not (and existing + (cj/--ai-term-process-live-p existing))) + (not (cj/--ai-term-session-active-p dir sessions)))) + (command (when fresh + (cj/--ai-term-runtime-command (cj/--ai-term-pick-runtime)))) + (buf (cj/--ai-term-show-or-create dir name command sessions))) (unless arg (let ((win (get-buffer-window buf))) (when win (select-window win)))) @@ -299,18 +402,22 @@ C-; a k closes an agent via `cj/ai-term-close'." (defun cj/--ai-term-close-buffer (buffer) "Gracefully tear down AI-term BUFFER: tmux session, then buffer. -Derives the tmux session name from BUFFER's `default-directory' (the -project dir the terminal was created in) and kills it so the agent -process stops. When BUFFER is shown, swaps its window to a non-agent -buffer (the working file) rather than deleting the window -- closing an -agent must not collapse the user's window layout; the hide toggle is -what collapses the split. Then kills BUFFER (suppressing the +Derives the tmux session name from BUFFER's immutable name (\"agent +[<basename>]\") and kills it so the agent process stops. The name, not +`default-directory', is the reliable key: ghostel retargets the +directory via OSC 7 as the shell cds, so a directory-derived name after +a cd misses the real session (orphaning the agent) or collides with a +different aiv- session. When BUFFER is shown, swaps its window to a +non-agent buffer (the working file) rather than deleting the window -- +closing an agent must not collapse the user's window layout; the hide +toggle is what collapses the split. Then kills BUFFER (suppressing the process-still-running prompt -- the session is already down). No-op when BUFFER isn't an AI-term buffer." (when (cj/--ai-term-buffer-p buffer) (cj/--ai-term-kill-tmux-session (cj/--ai-term-tmux-session-name - (buffer-local-value 'default-directory buffer))) + (or (cj/--ai-term-buffer-basename buffer) + (buffer-local-value 'default-directory buffer)))) (let ((win (get-buffer-window buffer))) (when (window-live-p win) (cj/--ai-term-swap-to-working-buffer win))) @@ -353,26 +460,18 @@ interrupt work in progress. Bound to C-; a k." ;; ------------------------- Step to the next agent ---------------------------- -(defun cj/ai-term-next () - "Step to the next open AI-term agent in the queue. - -The queue is every active agent ordered by buffer name -- a stable -rotation, unaffected by which agent was most recently selected. Active -means a live agent buffer (attached) OR a live tmux session with no Emacs -buffer (detached); stepping onto a detached agent attaches it (recreates -its terminal, which reattaches the session). When an agent window is on -screen, swap it to the next agent (wrapping after the last) and select it. -When no agent is displayed but agents exist, show the first. When none -are open, open the project picker to launch the first agent rather than -erroring. When the sole agent is already focused, echo that there are -no other ai-terms to switch to instead of swapping to itself. - -Bound to M-SPC. Unlike C-; a a (toggle the most-recent agent on/off), this -is the \"switch among existing agents\" surface; C-; a s opens the project -picker and C-; a k closes an agent." - (interactive) - (let* ((dirs (cj/--ai-term-active-agent-dirs)) - (win (cj/--ai-term-displayed-agent-window)) +(defun cj/--ai-term-step-among (dirs) + "Step to the next AI-term agent among DIRS, an ordered active-dir list. + +Shared body for `cj/ai-term-next' (all active agents) and +`cj/ai-term-next-attached' (attached agents only). When an agent window +is on screen, swap it to the next agent in DIRS (wrapping after the last) +and select it: a live attached agent swaps buffer-only, a detached one is +materialized by `cj/--ai-term-show-or-create'. When DIRS is empty, open +the project picker rather than erroring, so the swap key doubles as a +start-an-agent key. When the sole eligible agent is already focused, echo +that there is nowhere else to go instead of swapping to itself." + (let* ((win (cj/--ai-term-displayed-agent-window)) (current-name (and win (buffer-name (window-buffer win)))) (current-dir (and current-name (seq-find (lambda (d) @@ -381,8 +480,8 @@ picker and C-; a k closes an agent." (next-dir (cj/--ai-term-next-agent-dir current-dir dirs))) (cond ((not next-dir) - ;; No agents open: launch the first via the project picker instead of - ;; erroring, so the swap key doubles as a "start an agent" key. + ;; No eligible agents: launch the first via the project picker instead + ;; of erroring, so the swap key doubles as a "start an agent" key. (cj/ai-term-pick-project)) ;; Sole agent, already focused: the rotation wraps back to the same ;; agent, so a swap would be a silent no-op. Say there's nowhere to @@ -407,16 +506,49 @@ picker and C-; a k closes an agent." (let ((w (get-buffer-window name))) (when w (select-window w))))))))) +(defun cj/ai-term-next () + "Step to the next open AI-term agent -- attached or detached. + +The queue is every active agent ordered by buffer name -- a stable +rotation, unaffected by which agent was most recently selected. Active +means a live agent buffer (attached) OR a live tmux session with no Emacs +buffer (detached); stepping onto a detached agent attaches it (recreates +its terminal, which reattaches the session). + +Bound to M-S-SPC (and C-; a n). For a chord that stays among the agents +already on screen, use `cj/ai-term-next-attached' (M-SPC). Unlike C-; a a +\(toggle the most-recent agent on/off), this is the \"switch among existing +agents\" surface; C-; a s opens the project picker and C-; a k closes an +agent." + (interactive) + (cj/--ai-term-step-among (cj/--ai-term-active-agent-dirs))) + +(defun cj/ai-term-next-attached () + "Step to the next ATTACHED AI-term agent -- live Emacs buffers only. + +Cycles only agents currently on screen (a live agent buffer), skipping +detached tmux sessions. Use `cj/ai-term-next' (M-S-SPC) to include +detached sessions and attach them. When no agent is attached, opens the +project picker. + +Bound to M-SPC -- the fast \"swap to the next visible agent\" chord." + (interactive) + (cj/--ai-term-step-among (cj/--ai-term-attached-agent-dirs))) + ;; ai-term lives under the C-; a prefix (vacated when gptel was archived). -;; The frequent "swap to the next agent" also gets M-SPC for a fast chord. +;; The frequent "swap to the next agent" gets M-SPC (attached only) for a fast +;; chord, with M-S-SPC to include detached sessions. (defvar-keymap cj/ai-term-keymap :doc "Keymap for ai-term agent commands (C-; a)." "a" #'cj/ai-term ;; toggle the most-recent agent on/off "s" #'cj/ai-term-pick-project ;; select / launch via the project picker - "n" #'cj/ai-term-next ;; swap to the next open agent + "n" #'cj/ai-term-next ;; swap to the next open agent (all) "k" #'cj/ai-term-close) ;; kill the current agent (cj/register-prefix-map "a" cj/ai-term-keymap "ai-term") -(keymap-global-set "M-SPC" #'cj/ai-term-next) +;; M-SPC cycles only attached agents (on-screen); M-S-SPC cycles all, attaching +;; a detached tmux session when it lands on one. +(keymap-global-set "M-SPC" #'cj/ai-term-next-attached) +(keymap-global-set "M-S-SPC" #'cj/ai-term-next) (with-eval-after-load 'which-key (which-key-add-key-based-replacements @@ -425,7 +557,8 @@ picker and C-; a k closes an agent." "C-; a s" "select / launch" "C-; a n" "next agent" "C-; a k" "kill agent" - "M-SPC" "ai-term: next agent")) + "M-SPC" "ai-term: next attached" + "M-S-SPC" "ai-term: next (all)")) ;; ------------------- Wrap-it-up teardown + shutdown ------------------------- ;; @@ -446,11 +579,16 @@ A defcustom so development and tests can stub it instead of powering off (defun cj/ai-term-quit (&optional project) "Tear down PROJECT's AI-term: kill its tmux session, buffer, and restore layout. PROJECT is a project basename (as the rulesets Stop hook passes) or a directory; -nil means the current project (`default-directory'). Kills the `aiv-<name>' -tmux session (taking the agent process with it), then, when the agent buffer is -live, swaps its window back to the working buffer and kills it. Idempotent and -safe headless: a session or buffer already gone is a no-op, not an error." - (let* ((key (or project default-directory)) +nil means the current project -- the current agent buffer's embedded basename +when called from inside one (immune to the OSC 7 `default-directory' drift a +cd in the agent shell causes), else `default-directory'. Kills the +`aiv-<name>' tmux session (taking the agent process with it), then, when the +agent buffer is live, swaps its window back to the working buffer and kills +it. Idempotent and safe headless: a session or buffer already gone is a +no-op, not an error." + (let* ((key (or project + (cj/--ai-term-buffer-basename (current-buffer)) + default-directory)) (session (cj/--ai-term-tmux-session-name key)) (buffer (get-buffer (cj/--ai-term-buffer-name key)))) (cj/--ai-term-kill-tmux-session session) diff --git a/modules/auth-config.el b/modules/auth-config.el index c2df244b..c862e916 100644 --- a/modules/auth-config.el +++ b/modules/auth-config.el @@ -26,6 +26,7 @@ ;; below. oauth2-auto is required at runtime inside the advised function; these ;; declarations satisfy the byte-compiler without forcing an eager load. (declare-function oauth2-auto--compute-id "oauth2-auto") +(declare-function plstore-open "plstore") (declare-function plstore-get "plstore") (declare-function plstore-close "plstore") (defvar oauth2-auto--plstore-cache) diff --git a/modules/auto-dim-config.el b/modules/auto-dim-config.el index faa4101c..980d301f 100644 --- a/modules/auto-dim-config.el +++ b/modules/auto-dim-config.el @@ -58,7 +58,11 @@ focus cue on a split-displayed dashboard, accepted as a fair trade." ;; Emacs loses focus -- on Hyprland focus moves to other apps constantly, ;; and the ai-term agents live in their own windows. (auto-dim-other-buffers-dim-on-focus-out nil) - (auto-dim-other-buffers-dim-on-switch-to-minibuffer t) + ;; Entering the minibuffer leaves dimming exactly as it was -- a dim window + ;; stays dim, a lit one stays lit. With this at t, the window being worked + ;; in went dark on every minibuffer prompt, since selecting the minibuffer + ;; deselects it and the dim follows selection. + (auto-dim-other-buffers-dim-on-switch-to-minibuffer nil) :config ;; Remap these faces to auto-dim-other-buffers (pure-black background + ;; faded gray foreground, defined in the theme) in non-selected windows. diff --git a/modules/browser-config.el b/modules/browser-config.el index 564e7a27..4571c1d9 100644 --- a/modules/browser-config.el +++ b/modules/browser-config.el @@ -143,7 +143,23 @@ Persists the choice for future sessions." ('save-failed (message "Failed to save browser choice")) ('invalid-plist (message "Invalid browser configuration")))))))) -;; Initialize: Load saved choice or use first available browser +(defun cj/--preferred-default-browser (browsers) + "Return the browser plist to adopt as the first-run default from BROWSERS. + +Prefers the first entry with a non-nil :executable -- a real external +browser -- and falls back to the first entry overall when none is +installed. Built-in browsers carry a nil :executable and so are always +\"available\", which put EWW at the head of `cj/discover-browsers' on +every machine. Taking the head therefore opened every link in the text +browser on a fresh checkout even with Chrome installed, until the user +happened to run `cj/choose-browser'. EWW stays reachable as the +deliberate fallback when nothing external is on PATH. + +Returns nil for an empty BROWSERS list." + (or (seq-find (lambda (b) (plist-get b :executable)) browsers) + (car browsers))) + +;; Initialize: Load saved choice or use the preferred available browser (defun cj/--do-initialize-browser () "Initialize browser configuration. Returns: (cons \\='loaded browser-plist) if saved choice was loaded, @@ -153,10 +169,10 @@ Returns: (cons \\='loaded browser-plist) if saved choice was loaded, (let ((saved-choice (cj/load-browser-choice))) (if saved-choice (cons 'loaded saved-choice) - ;; No saved choice - try to set first available browser + ;; No saved choice - adopt the preferred available browser (let ((browsers (cj/discover-browsers))) (if browsers - (cons 'first-available (car browsers)) + (cons 'first-available (cj/--preferred-default-browser browsers)) (cons 'no-browsers nil)))))) (defun cj/initialize-browser () diff --git a/modules/calendar-sync-ics.el b/modules/calendar-sync-ics.el index 9cb57e96..7fecce10 100644 --- a/modules/calendar-sync-ics.el +++ b/modules/calendar-sync-ics.el @@ -188,6 +188,22 @@ Monday = 1, Sunday = 7." (dow (nth 6 decoded))) ; 0 = Sunday, 1 = Monday, etc. (if (= dow 0) 7 dow))) +(defun calendar-sync--nth-weekday-of-month (year month weekday n) + "Return the day-of-month of the Nth WEEKDAY in YEAR/MONTH, or nil. +WEEKDAY is 1-7 (Monday = 1), matching `calendar-sync--date-weekday'. +Positive N counts from the start of the month (1 = first); negative N +counts from the end (-1 = last). Returns nil when the month has no such +occurrence (a 5th Friday most months), or when N is zero." + (when (and (integerp n) (not (zerop n))) + (let* ((first-dow (calendar-sync--date-weekday (list year month 1))) + (first-day (1+ (mod (- weekday first-dow) 7))) + (next-month (calendar-sync--add-months (list year month 1) 1)) + (last-day (nth 2 (calendar-sync--add-days next-month -1))) + (total (1+ (/ (- last-day first-day) 7))) + (index (if (> n 0) n (+ total n 1)))) + (when (and (>= index 1) (<= index total)) + (+ first-day (* 7 (1- index))))))) + (defun calendar-sync--add-days (date days) "Add DAYS to DATE (year month day). Returns new (year month day). @@ -218,6 +234,18 @@ Both dates should be lists like (year month day)." (time-less-p (calendar-sync--date-to-time date1) (calendar-sync--date-to-time date2))) +(defun calendar-sync--date-on-or-before-p (date1 date2) + "Return t if DATE1 falls on or before DATE2. +Both dates should be lists like (year month day); like +`calendar-sync--date-to-time', only the first three elements are compared, +so any hour/minute tail is ignored. + +This is the comparison RRULE UNTIL needs. RFC 5545 3.3.10 bounds a +recurrence \"in an inclusive manner\": when UNTIL lines up with the +recurrence, that date is the last instance. A strict +`calendar-sync--before-date-p' drops it." + (not (calendar-sync--before-date-p date2 date1))) + ;;; Datetime Parsing (defun calendar-sync--parse-ics-datetime (value) @@ -492,39 +520,90 @@ Returns nil if parsing fails." (string-to-number (match-string 3 timestamp-str)))) (t nil))) +(defun calendar-sync--format-stamp (date &optional time-str) + "Return one org timestamp for DATE, with TIME-STR appended when non-nil. +DATE is a (year month day) list; TIME-STR is a preformatted leading-space +string such as \" 14:00\" or \" 14:00-15:30\". Produces +`<2025-11-16 Sun 14:00>' or `<2025-11-16 Sun>'. Both the compact same-day +form and each half of a multi-day range are built from this." + (concat (format-time-string + "<%Y-%m-%d %a" + (encode-time 0 0 0 (nth 2 date) (nth 1 date) (nth 0 date))) + time-str + ">")) + +(defun calendar-sync--format-hhmm (hour minute) + "Return \" HH:MM\" for HOUR and MINUTE, or nil unless both are non-nil." + (when (and hour minute) (format " %02d:%02d" hour minute))) + (defun calendar-sync--format-timestamp (start end) - "Format START and END timestamps as org timestamp. + "Format START and END timestamps as an org timestamp. START and END are lists from `calendar-sync--parse-timestamp'. -Returns string like '<2025-11-16 Sun 14:00-15:00>' or '<2025-11-16 Sun>'." - (let* ((year (nth 0 start)) - (month (nth 1 start)) - (day (nth 2 start)) + +Same-day events keep the compact form: `<2025-11-16 Sun 14:00-15:00>' when +timed, `<2025-11-16 Sun>' when all-day. An event whose last day is later +than its start renders as an org range, `<start>--<end>', so the agenda shows +it on every day it covers rather than only the first. + +DTEND is the non-inclusive end of the event (RFC 5545 3.6.1). For an all-day +event that makes DTEND the day AFTER the last day, so the last day is +DTEND-1 and a one-day all-day event (DTEND = start+1) stays a single stamp. +For a timed event DTEND is the end instant, so its date is already the last +day. The decrement is therefore gated on both ends being date-only; a +date-only start with a timed end is malformed, and treating it as all-day +would push the last day BEFORE the start and emit a backwards range." + (let* ((start-date (list (nth 0 start) (nth 1 start) (nth 2 start))) (start-hour (nth 3 start)) (start-min (nth 4 start)) (end-hour (and end (nth 3 end))) (end-min (and end (nth 4 end))) - (date-str (format-time-string - "<%Y-%m-%d %a" - (encode-time 0 0 0 day month year))) - (time-str (when (and start-hour end-hour) - (format " %02d:%02d-%02d:%02d" - start-hour start-min end-hour end-min)))) - (concat date-str time-str ">"))) + (all-day-span (and end (null start-hour) (null end-hour))) + (last-date (when end + (let ((end-date (list (nth 0 end) (nth 1 end) (nth 2 end)))) + (if all-day-span + (calendar-sync--add-days end-date -1) + end-date)))) + (spans-days (and last-date + (calendar-sync--before-date-p start-date last-date)))) + (if spans-days + (concat (calendar-sync--format-stamp + start-date (calendar-sync--format-hhmm start-hour start-min)) + "--" + (calendar-sync--format-stamp + last-date (calendar-sync--format-hhmm end-hour end-min))) + ;; Same-day: the compact HH:MM-HH:MM range lives inside one stamp. + (calendar-sync--format-stamp + start-date + (when (and start-hour end-hour) + (format " %02d:%02d-%02d:%02d" + start-hour start-min end-hour end-min)))))) ;;; Single Event Parsing +(defun calendar-sync--event-cancelled-p (event-str) + "Return non-nil when EVENT-STR carries STATUS:CANCELLED. +This is the VEVENT's own STATUS property (RFC 5545 3.8.1.11), not the +user's attendee PARTSTAT. Matching is case-insensitive." + (let ((status (calendar-sync--get-property event-str "STATUS"))) + (and status (string= (upcase status) "CANCELLED")))) + (defun calendar-sync--parse-event (event-str) "Parse single VEVENT string EVENT-STR into plist. Returns plist with :uid :summary :description :location :start :end :attendees :organizer :url :status. Returns nil if event lacks required fields (DTSTART, SUMMARY). Skips events with RECURRENCE-ID (individual instances of recurring events -are handled separately via exception collection). +are handled separately via exception collection) and events whose own +STATUS is CANCELLED -- a cancelled meeting must not render, and a +cancelled series master kills its whole series because RRULE expansion +builds its base event through this function. Handles TZID-qualified timestamps by converting to local time. Cleans text fields (description, location, summary) via `calendar-sync--clean-text'." - ;; Skip individual instances of recurring events (they're collected as exceptions) - (unless (calendar-sync--get-property event-str "RECURRENCE-ID") + ;; Skip individual instances of recurring events (they're collected as + ;; exceptions) and cancelled events (they must not render). + (unless (or (calendar-sync--get-property event-str "RECURRENCE-ID") + (calendar-sync--event-cancelled-p event-str)) (let* ((uid (calendar-sync--get-property event-str "UID")) (summary (calendar-sync--clean-text (calendar-sync--get-property event-str "SUMMARY"))) diff --git a/modules/calendar-sync-recurrence.el b/modules/calendar-sync-recurrence.el index 72576a6f..9ef12ce5 100644 --- a/modules/calendar-sync-recurrence.el +++ b/modules/calendar-sync-recurrence.el @@ -90,6 +90,9 @@ dropped by `calendar-sync--filter-declined'." (list :recurrence-id (calendar-sync--localize-parsed-datetime recurrence-id-parsed recurrence-id-is-utc recurrence-id-tzid) :recurrence-id-raw recurrence-id + ;; A cancelled override removes its occurrence downstream + ;; rather than rescheduling it. + :cancelled (calendar-sync--event-cancelled-p event-str) :start start-parsed :end end-parsed :summary summary @@ -164,24 +167,30 @@ Compares year, month, day, hour, minute." "Apply EXCEPTIONS to OCCURRENCES list. OCCURRENCES is list of event plists from RRULE expansion. EXCEPTIONS is hash table from `calendar-sync--collect-recurrence-exceptions'. -Returns new list with matching occurrences replaced by exception times." +Returns new list with matching occurrences replaced by exception times. +A cancelled exception (STATUS:CANCELLED override) removes its occurrence +from the list instead of overriding it." (if (or (null occurrences) (null exceptions)) occurrences - (mapcar - (lambda (occurrence) - (let* ((uid (plist-get occurrence :uid)) - (uid-exceptions (and uid (gethash uid exceptions)))) - (if (null uid-exceptions) - occurrence - ;; Check if any exception matches this occurrence - (let ((matching-exception - (cl-find-if (lambda (exc) - (calendar-sync--occurrence-matches-exception-p occurrence exc)) - uid-exceptions))) - (if matching-exception - (calendar-sync--apply-single-exception occurrence matching-exception) - occurrence))))) - occurrences))) + (delq nil + (mapcar + (lambda (occurrence) + (let* ((uid (plist-get occurrence :uid)) + (uid-exceptions (and uid (gethash uid exceptions)))) + (if (null uid-exceptions) + occurrence + ;; Check if any exception matches this occurrence + (let ((matching-exception + (cl-find-if (lambda (exc) + (calendar-sync--occurrence-matches-exception-p occurrence exc)) + uid-exceptions))) + (cond + ((null matching-exception) occurrence) + ;; Cancelled instance: drop it entirely. + ((plist-get matching-exception :cancelled) nil) + (t (calendar-sync--apply-single-exception + occurrence matching-exception))))))) + occurrences)))) ;;; EXDATE (Excluded Date) Handling @@ -193,21 +202,30 @@ Handles both simple values and values with parameters like TZID." (when (and event-str (stringp event-str) (not (string-empty-p event-str))) (let ((exdates '()) (pos 0)) - ;; Find all EXDATE lines + ;; Find all EXDATE lines. One line may carry several comma-separated + ;; datetimes (RFC 5545); split them so each is excluded individually. + ;; Capture the match end BEFORE split-string: its internal matching + ;; clobbers the match data, and reading (match-end 0) afterwards made + ;; pos jump backwards to a comma offset inside the value -- re-matching + ;; the same line forever and growing the list until the OOM killer + ;; intervened (took two agent sessions down on 2026-07-13). (while (string-match "^EXDATE[^:\n]*:\\([^\n]+\\)" event-str pos) - (push (match-string 1 event-str) exdates) - (setq pos (match-end 0))) + (let ((line-end (match-end 0))) + (dolist (val (split-string (match-string 1 event-str) "," t)) + (push val exdates)) + (setq pos line-end))) (nreverse exdates)))) (defun calendar-sync--get-exdate-line (event-str exdate-value) "Find the full EXDATE line containing EXDATE-VALUE from EVENT-STR. Returns the complete line like -`EXDATE;TZID=America/New_York:20260210T130000'. -Returns nil if not found." +`EXDATE;TZID=America/New_York:20260210T130000'. Matches the value anywhere +in the value list, so a comma-separated line's shared TZID reaches every +value on it. Returns nil if not found." (when (and event-str (stringp event-str) exdate-value) - (let ((pattern (format "^\\(EXDATE[^:]*:%s\\)" (regexp-quote exdate-value)))) + (let ((pattern (format "^EXDATE[^:\n]*:[^\n]*%s" (regexp-quote exdate-value)))) (when (string-match pattern event-str) - (match-string 1 event-str))))) + (match-string 0 event-str))))) (defalias 'calendar-sync--parse-exdate #'calendar-sync--parse-ics-datetime "Parse EXDATE value. See `calendar-sync--parse-ics-datetime'.") @@ -282,7 +300,9 @@ OCCURRENCE-DATE should be a list (year month day hour minute second)." (defun calendar-sync--parse-rrule (rrule-str) "Parse RRULE string into plist. -Returns plist with :freq :interval :byday :until :count." +Returns plist with :freq :interval :byday :bysetpos :bymonth :until :count. +BYMONTH keeps only the first value of a comma-separated list -- feeds in +practice emit a single month there." (let ((parts (split-string rrule-str ";")) (result '())) (dolist (part parts) @@ -293,6 +313,8 @@ Returns plist with :freq :interval :byday :until :count." ("FREQ" (setq result (plist-put result :freq (intern (downcase value))))) ("INTERVAL" (setq result (plist-put result :interval (string-to-number value)))) ("BYDAY" (setq result (plist-put result :byday (split-string value ",")))) + ("BYSETPOS" (setq result (plist-put result :bysetpos (string-to-number value)))) + ("BYMONTH" (setq result (plist-put result :bymonth (string-to-number value)))) ("UNTIL" (setq result (plist-put result :until (calendar-sync--parse-timestamp value)))) ("COUNT" (setq result (plist-put result :count (string-to-number value)))))))) ;; Set defaults @@ -313,7 +335,8 @@ ADVANCE-FN takes (current-date interval) and returns the next date." (num-generated 0) (range-end-time (cadr range))) (while (and (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) - (or (not until) (calendar-sync--before-date-p current-date until)) + ;; UNTIL is inclusive (RFC 5545 3.3.10) -- on-or-before, not before. + (or (not until) (calendar-sync--date-on-or-before-p current-date until)) (or (not count) (< num-generated count))) (let ((occurrence-datetime (append current-date (nthcdr 3 start)))) (setq num-generated (1+ num-generated)) @@ -355,7 +378,8 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (while (and (< iterations max-iterations) (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) (or (not count) (< num-generated count)) - (or (not until) (calendar-sync--before-date-p current-date until))) + ;; UNTIL is inclusive (RFC 5545 3.3.10) -- on-or-before, not before. + (or (not until) (calendar-sync--date-on-or-before-p current-date until))) (setq iterations (1+ iterations)) ;; Generate occurrences for each weekday in this week (dolist (weekday weekdays) @@ -363,8 +387,8 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (days-ahead (mod (- weekday current-weekday) 7)) (occurrence-date (calendar-sync--add-days current-date days-ahead)) (occurrence-datetime (append occurrence-date (nthcdr 3 start)))) - ;; Check UNTIL date first - (when (or (not until) (calendar-sync--before-date-p occurrence-date until)) + ;; Check UNTIL date first -- inclusive per RFC 5545 3.3.10. + (when (or (not until) (calendar-sync--date-on-or-before-p occurrence-date until)) ;; Check COUNT - increment BEFORE range check so COUNT is absolute from start (when (or (not count) (< num-generated count)) (setq num-generated (1+ num-generated)) @@ -378,18 +402,149 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (calendar-sync--log-silently "calendar-sync: WARNING: Hit max iterations (%d) expanding weekly event" max-iterations)) (nreverse occurrences))) +(defun calendar-sync--parse-byday-entry (entry) + "Parse a single RRULE BYDAY ENTRY into a cons (ORDINAL . WEEKDAY). +ENTRY is a string like \"2WE\" (2nd Wednesday), \"-1TU\" (last Tuesday), +or \"SU\" (bare weekday). ORDINAL is nil for a bare weekday. WEEKDAY is +1-7 (Monday = 1). Returns nil for unparseable input." + (when (and (stringp entry) + (string-match "\\`\\(-?[0-9]+\\)?\\([A-Z][A-Z]\\)\\'" entry)) + (let ((ordinal (match-string 1 entry)) + (weekday (calendar-sync--weekday-to-number (match-string 2 entry)))) + (when weekday + (cons (and ordinal (string-to-number ordinal)) weekday))))) + +(defun calendar-sync--byday-days-in-month (year month byday-entries bysetpos) + "Return the sorted day-of-month list BYDAY-ENTRIES select in YEAR/MONTH. +An entry with an ordinal (\"2WE\") resolves directly via +`calendar-sync--nth-weekday-of-month'. A bare entry (\"SU\") expands to +every matching weekday in the month. When BYSETPOS is non-nil it then +selects one day from the combined set (1-based; negative counts from the +end), per RFC 5545 3.8.5.3. Months with no match return nil." + (let ((days '())) + (dolist (entry byday-entries) + (let ((parsed (calendar-sync--parse-byday-entry entry))) + (when parsed + (let ((ordinal (car parsed)) + (weekday (cdr parsed))) + (if ordinal + (let ((day (calendar-sync--nth-weekday-of-month year month weekday ordinal))) + (when day (push day days))) + (let ((n 1) day) + (while (setq day (calendar-sync--nth-weekday-of-month year month weekday n)) + (push day days) + (setq n (1+ n))))))))) + (setq days (sort (delete-dups days) #'<)) + (if (and bysetpos days) + (let* ((total (length days)) + (index (if (> bysetpos 0) bysetpos (+ total bysetpos 1)))) + (if (and (>= index 1) (<= index total)) + (list (nth (1- index) days)) + '())) + days))) + +(defun calendar-sync--expand-monthly-byday (base-event rrule range) + "Expand a monthly nth-weekday (BYDAY) recurring event. +BASE-EVENT is the event plist, RRULE is parsed rrule (carrying :byday and +optionally :bysetpos), RANGE is date range. Steps month by month from +DTSTART's month, landing each occurrence on the day its BYDAY rule selects +-- never on DTSTART's day-of-month." + (let* ((start (plist-get base-event :start)) + (interval (plist-get rrule :interval)) + (byday (plist-get rrule :byday)) + (bysetpos (plist-get rrule :bysetpos)) + (until (plist-get rrule :until)) + (count (plist-get rrule :count)) + (occurrences '()) + (month-anchor (list (nth 0 start) (nth 1 start) 1)) + (start-day (nth 2 start)) + (first-month t) + (num-generated 0) + (range-end-time (cadr range)) + (max-iterations 1000) + (iterations 0)) + (when (<= interval 0) + (error "Invalid RRULE interval: %s (must be > 0)" interval)) + (while (and (< iterations max-iterations) + (or count until + (time-less-p (calendar-sync--date-to-time month-anchor) range-end-time)) + (or (not count) (< num-generated count)) + ;; A month starting after UNTIL can't contain an occurrence + ;; on-or-before it (UNTIL is inclusive, RFC 5545 3.3.10). + (or (not until) (calendar-sync--date-on-or-before-p month-anchor until))) + (setq iterations (1+ iterations)) + (dolist (day (calendar-sync--byday-days-in-month + (nth 0 month-anchor) (nth 1 month-anchor) byday bysetpos)) + (let* ((occurrence-date (list (nth 0 month-anchor) (nth 1 month-anchor) day)) + (occurrence-datetime (append occurrence-date (nthcdr 3 start)))) + ;; The series starts at DTSTART: skip earlier days in the first month. + (unless (and first-month (< day start-day)) + (when (or (not until) (calendar-sync--date-on-or-before-p occurrence-date until)) + (when (or (not count) (< num-generated count)) + (setq num-generated (1+ num-generated)) + (when (calendar-sync--date-in-range-p occurrence-datetime range) + (push (calendar-sync--create-occurrence base-event occurrence-datetime) + occurrences))))))) + (setq first-month nil) + (setq month-anchor (calendar-sync--add-months month-anchor interval))) + (when (>= iterations max-iterations) + (calendar-sync--log-silently + "calendar-sync: WARNING: Hit max iterations (%d) expanding monthly BYDAY event" + max-iterations)) + (nreverse occurrences))) + (defun calendar-sync--expand-monthly (base-event rrule range) "Expand monthly recurring event. -BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." - (calendar-sync--expand-simple-recurrence - base-event rrule range #'calendar-sync--add-months)) +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. +A rule with BYDAY (nth weekday, e.g. 2WE, -1TU, or SU with BYSETPOS) +expands via `calendar-sync--expand-monthly-byday'; a plain rule steps +DTSTART's day-of-month, skipping months without that day." + (if (plist-get rrule :byday) + (calendar-sync--expand-monthly-byday base-event rrule range) + (calendar-sync--expand-simple-recurrence + base-event rrule range #'calendar-sync--next-monthly-date))) + +(defun calendar-sync--next-monthly-date (date interval) + "Step DATE forward INTERVAL months, skipping months without DATE's day. +A plain FREQ=MONTHLY on the 31st must skip short months (RFC 5545): +`calendar-sync--add-months' keeps day-of-month verbatim, so Jan 31 would +step to Feb 31, which encode-time normalizes into a phantom Mar 3 +occurrence. Bounded so a pathological input can't loop forever." + (require 'time-date) + (let ((next (calendar-sync--add-months date interval)) + (day (nth 2 date)) + (guard 0)) + (while (and (< guard 100) + (> day (date-days-in-month (nth 0 next) (nth 1 next)))) + (setq guard (1+ guard)) + (setq next (calendar-sync--add-months next interval))) + next)) + +(defun calendar-sync--expand-yearly-byday (base-event rrule range) + "Expand a yearly nth-weekday event (e.g. BYMONTH=3;BYDAY=2SU). +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. +Reuses the monthly BYDAY expander with a 12-month step, anchored on +:bymonth (falling back to DTSTART's month)." + (let* ((start (plist-get base-event :start)) + (month (or (plist-get rrule :bymonth) (nth 1 start))) + (sched-event (plist-put (copy-sequence base-event) :start + (append (list (nth 0 start) month (nth 2 start)) + (nthcdr 3 start)))) + (sched-rrule (plist-put (copy-sequence rrule) :interval + (* 12 (or (plist-get rrule :interval) 1))))) + (calendar-sync--expand-monthly-byday sched-event sched-rrule range))) (defun calendar-sync--expand-yearly (base-event rrule range) "Expand yearly recurring event. -BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." - (calendar-sync--expand-simple-recurrence - base-event rrule range - (lambda (date interval) (calendar-sync--add-months date (* 12 interval))))) +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range. +A rule with BYDAY (the DST clock-change shape, BYMONTH=n;BYDAY=nWD) +expands via `calendar-sync--expand-yearly-byday'; a plain rule repeats +DTSTART's calendar date." + (if (plist-get rrule :byday) + (calendar-sync--expand-yearly-byday base-event rrule range) + (calendar-sync--expand-simple-recurrence + base-event rrule range + (lambda (date interval) (calendar-sync--add-months date (* 12 interval)))))) (defun calendar-sync--expand-recurring-event (event-str range) "Expand recurring event EVENT-STR into individual occurrences within RANGE. diff --git a/modules/calendar-sync-source.el b/modules/calendar-sync-source.el index 15c91c59..10dea66e 100644 --- a/modules/calendar-sync-source.el +++ b/modules/calendar-sync-source.el @@ -138,39 +138,25 @@ Checks `cj/debug-modules' for symbol `calendar-sync' or t (all)." ;;; .ics Fetch -(defun calendar-sync--fetch-ics (url callback) - "Fetch .ics file from URL asynchronously using curl. -Calls CALLBACK with the .ics content as string (normalized to Unix line endings) -or nil on error. CALLBACK signature: (lambda (content) ...). - -The fetch happens asynchronously and doesn't block Emacs. The callback is -invoked when the fetch completes, either successfully or with an error." - (condition-case err - (let ((buffer (generate-new-buffer " *calendar-sync-curl*"))) - (make-process - :name "calendar-sync-curl" - :buffer buffer - :command (list "curl" "-s" "-L" "--fail" - "--connect-timeout" "10" - "--max-time" (number-to-string calendar-sync-fetch-timeout) - url) - :sentinel - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (let ((buf (process-buffer process))) - (when (buffer-live-p buf) - (let ((content - (with-current-buffer buf - (if (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)) - (calendar-sync--normalize-line-endings (buffer-string)) - (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" (string-trim event)) - nil)))) - (kill-buffer buf) - (funcall callback content)))))))) - (error - (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) - (funcall callback nil)))) +(defun calendar-sync--fetch-sentinel-finish (success event temp-file buffer callback) + "Finish an async .ics fetch. +SUCCESS is non-nil when curl exited cleanly, EVENT the process event +string, TEMP-FILE the curl output path, BUFFER the process buffer, and +CALLBACK the continuation. On success CALLBACK receives TEMP-FILE (the +caller owns deleting it); on failure the error is logged, TEMP-FILE is +removed, and CALLBACK receives nil. Extracted from the sentinel so the +success, failure, and cleanup branches are unit-testable without a live +curl process." + (when (buffer-live-p buffer) + (unless success + (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" + (string-trim event))) + (kill-buffer buffer)) + (if success + (funcall callback temp-file) + (when (file-exists-p temp-file) + (delete-file temp-file)) + (funcall callback nil))) (defun calendar-sync--fetch-ics-file (url callback) "Fetch .ics from URL to a temp file asynchronously. @@ -190,19 +176,10 @@ owns deleting the temp file after a successful callback." :sentinel (lambda (process event) (when (memq (process-status process) '(exit signal)) - (let ((buf (process-buffer process)) - (success (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)))) - (when (buffer-live-p buf) - (unless success - (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" - (string-trim event))) - (kill-buffer buf)) - (if success - (funcall callback temp-file) - (when (file-exists-p temp-file) - (delete-file temp-file)) - (funcall callback nil))))))) + (calendar-sync--fetch-sentinel-finish + (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0)) + event temp-file (process-buffer process) callback))))) (error (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) (funcall callback nil)))) diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index 804d71fa..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,19 +320,121 @@ 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 () - "Function called by sync timer. -Checks for timezone changes and triggers re-sync if detected." - (when (calendar-sync--timezone-changed-p) - (let ((old-tz (calendar-sync--format-timezone-offset - calendar-sync--last-timezone-offset)) - (new-tz (calendar-sync--format-timezone-offset - (calendar-sync--current-timezone-offset)))) - (message "calendar-sync: Timezone change detected (%s → %s), re-syncing..." - old-tz new-tz))) - (calendar-sync--sync-all-calendars)) + "Function called by the hourly sync timer. +Checks for timezone changes and triggers re-sync if detected. + +The body is wrapped so a signal — from the timezone check or the sync +fan-out — is caught and logged rather than propagated: this runs from a +`run-at-time' timer, and an unguarded error would repeat on every tick, +once an hour, indefinitely. The timezone-change notice goes to the silent +log, not the echo area, since an hourly timer must not spam `message'." + (condition-case err + (progn + (when (calendar-sync--timezone-changed-p) + (let ((old-tz (calendar-sync--format-timezone-offset + calendar-sync--last-timezone-offset)) + (new-tz (calendar-sync--format-timezone-offset + (calendar-sync--current-timezone-offset)))) + (calendar-sync--log-silently + "calendar-sync: Timezone change detected (%s → %s), re-syncing..." + old-tz new-tz))) + (calendar-sync--sync-all-calendars)) + (error + (calendar-sync--log-silently + "calendar-sync: sync timer error: %s" (error-message-string err))))) ;;;###autoload (defun calendar-sync-start () @@ -393,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 @@ -400,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/calibredb-epub-config.el b/modules/calibredb-epub-config.el index b03d83ed..27fa6369 100644 --- a/modules/calibredb-epub-config.el +++ b/modules/calibredb-epub-config.el @@ -205,22 +205,14 @@ Adjust it live with `cj/nov-widen-text' and `cj/nov-narrow-text'.") (defvar cj/nov-margin-step 2 "Percentage points each `cj/nov-widen-text'/`cj/nov-narrow-text' press changes.") -;; Prevent magic-fallback-mode-alist from opening epub as archive-mode -;; Advise set-auto-mode to force nov-mode for .epub files before magic-fallback runs -(defun cj/force-nov-mode-for-epub (orig-fun &rest args) - "Force nov-mode for .epub files, bypassing archive-mode detection." - (if (and buffer-file-name - (string-match-p "\\.epub\\'" buffer-file-name)) - (progn - (unless (featurep 'nov) - (require 'nov nil t)) - ;; Call nov-mode if available, otherwise fallback to default behavior - (if (fboundp 'nov-mode) - (nov-mode) - (apply orig-fun args))) - (apply orig-fun args))) - -(advice-add 'set-auto-mode :around #'cj/force-nov-mode-for-epub) +;; .epub reaches nov-mode through auto-mode-alist -- nov's use-package :mode +;; below registers "\\.epub\\'" there, and `set-auto-mode' consults +;; auto-mode-alist before magic-fallback-mode-alist, so the zip container never +;; reaches the archive-mode fallback. An :around advice on `set-auto-mode' used +;; to force this and was pure overhead: set-auto-mode runs on every file visit, +;; so it added a frame and a failure surface to every file of every type. +;; Verified live before removal -- a real zip-format .epub opened in nov-mode +;; both with the advice and without it. ;; Define helper functions before use-package so they're available for hooks (defun cj/forward-paragraph-and-center () @@ -519,8 +511,7 @@ computed column based on the window text area width." (goto-char (point-min)) ;; Work in the selected window showing this buffer (if any). (when-let* ((win (get-buffer-window (current-buffer) t)) - (col-width (window-body-width win)) ;; columns - (col-px (* col-width (window-font-width win)))) + (col-width (window-body-width win))) ;; columns (while (let ((m (text-property-search-forward 'display nil (lambda (_ p) (and (consp p) (eq (car-safe p) 'image)))))) diff --git a/modules/coverage-core.el b/modules/coverage-core.el index e8f7a474..c320651d 100644 --- a/modules/coverage-core.el +++ b/modules/coverage-core.el @@ -220,7 +220,7 @@ empty hash table. Malformed hunk headers are skipped silently." "Return the merge-base between HEAD and BASE." (let ((merge-base (string-trim (cj/git-output-or-error "merge-base" "HEAD" base)))) - (unless (not (string-empty-p merge-base)) + (when (string-empty-p merge-base) (user-error "git merge-base HEAD %s returned no commit" base)) merge-base)) 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/custom-case.el b/modules/custom-case.el index dde2d6c1..c203cd9e 100644 --- a/modules/custom-case.el +++ b/modules/custom-case.el @@ -62,6 +62,61 @@ CHARS-SKIP-RESET: : ! ? .), reached by skipping blanks back to PREV-WORD-END." (and (not (zerop (skip-chars-backward "[:blank:]" prev-word-end))) (memq (char-before (point)) chars-skip-reset))))) +(defconst cj/--title-case-reset-chars '(?: ?! ?? ?.) + "Characters that restart capitalization for the following word. +So \"Warning: An Example\" capitalizes the \"An\" and a sentence-ending +period capitalizes the next word (\"End. The Next\").") + +(defconst cj/--title-case-separator-chars '(?\\ ?- ?' ?.) + "Characters whose following character is never capitalized. +Covers \"Foo-bar\", \"Foo\\bar\", and \"Foo's\". The period keeps +\"3.14\" and \"foo.bar\" untouched; a period followed by a blank still +restarts capitalization via `cj/--title-case-reset-chars'.") + +(defconst cj/--title-case-minor-words + '("a" "an" "and" "as" "at" "but" "by" + "for" "if" "in" "nor" "of" + "on" "or" "so" "the" "to" "yet") + "Minor words kept lowercase mid-title. +\"is\" and other linking verbs are major words, so they are not here.") + +(defconst cj/--title-case-word-chars "[:alnum:]" + "skip-chars set that constitutes a word for title-casing.") + +(defun cj/--title-case-region-bounds () + "Return (BEG . END) for the active region, else the current line." + (if (region-active-p) + (cons (region-beginning) (region-end)) + (cons (line-beginning-position) (line-end-position)))) + +(defun cj/--title-case-last-word-start (beg end) + "Return the start position of the last word in BEG..END. +The last word is always capitalized in title case, so it is located once: +from END, skip back over trailing non-word characters, then the word." + (save-excursion + (goto-char end) + (skip-chars-backward (concat "^" cj/--title-case-word-chars) beg) + (skip-chars-backward cj/--title-case-word-chars beg) + (point))) + +(defun cj/--title-case-maybe-capitalize (word-end end is-first last-word-start prev-word-end) + "Capitalize the character at point when title-case rules call for it. +Point sits on a word's first character, WORD-END past its last. END bounds +the operation; IS-FIRST, LAST-WORD-START, and PREV-WORD-END feed +`cj/--title-case-capitalize-word-p'. Modifies the buffer in place." + (unless (or (>= (point) end) + (memq (char-before (point)) cj/--title-case-separator-chars)) + (let* ((c-orig (char-to-string (char-after (point)))) + (c-up (capitalize c-orig))) + (unless (string-equal c-orig c-up) + (let ((word (buffer-substring-no-properties (point) word-end))) + (when (cj/--title-case-capitalize-word-p + word is-first (= (point) last-word-start) + prev-word-end cj/--title-case-minor-words + cj/--title-case-reset-chars) + (delete-region (point) (1+ (point))) + (insert c-up))))))) + (defun cj/title-case-region () "Capitalize the region in title case format. Title case is a capitalization convention where major words are capitalized, @@ -73,43 +128,13 @@ and last words are always capitalized, and a word following a sentence-ending period (or a colon, exclamation mark, or question mark) restarts capitalization even when it is a minor word." (interactive) - (let ((beg nil) - (end nil) - (prev-word-end nil) - (last-word-start nil) - ;; Restart capitalization for a minor word after one of these, so - ;; "Warning: An Example" capitalizes the "An" and a sentence-ending - ;; period capitalizes the next word ("End. The Next"). - (chars-skip-reset '(?: ?! ?? ?.)) - ;; Don't capitalize characters directly after these. e.g. - ;; "Foo-bar" or "Foo\bar" or "Foo's". A period is here too, so - ;; "3.14" and "foo.bar" are left alone; a period followed by a - ;; blank still restarts via `chars-skip-reset' above. - (chars-separator '(?\\ ?- ?' ?.)) - (word-chars "[:alnum:]") - ;; "is" and other linking verbs are major words, so they are not in - ;; this minor-word skip list. - (word-skip - (list "a" "an" "and" "as" "at" "but" "by" - "for" "if" "in" "nor" "of" - "on" "or" "so" "the" "to" "yet")) - (is-first t)) - (cond - ((region-active-p) - (setq beg (region-beginning)) - (setq end (region-end))) - (t - (setq beg (line-beginning-position)) - (setq end (line-end-position)))) - ;; The last word is always capitalized in title case, so find its start - ;; once: from END, skip back over any trailing non-word chars, then over - ;; the word itself. - (setq last-word-start - (save-excursion - (goto-char end) - (skip-chars-backward (concat "^" word-chars) beg) - (skip-chars-backward word-chars beg) - (point))) + (let* ((bounds (cj/--title-case-region-bounds)) + (beg (car bounds)) + (end (cdr bounds)) + (last-word-start (cj/--title-case-last-word-start beg end)) + (word-chars cj/--title-case-word-chars) + (prev-word-end nil) + (is-first t)) (save-excursion ;; work on uppercased text (e.g., headlines) by downcasing first (downcase-region beg end) @@ -123,17 +148,8 @@ capitalization even when it is a minor word." (save-excursion (skip-chars-forward word-chars end) (point)))) - (unless (or (>= (point) end) - (memq (char-before (point)) chars-separator)) - (let* ((c-orig (char-to-string (char-after (point)))) - (c-up (capitalize c-orig))) - (unless (string-equal c-orig c-up) - (let ((word (buffer-substring-no-properties (point) word-end))) - (when (cj/--title-case-capitalize-word-p - word is-first (= (point) last-word-start) - prev-word-end word-skip chars-skip-reset) - (delete-region (point) (1+ (point))) - (insert c-up)))))) + (cj/--title-case-maybe-capitalize + word-end end is-first last-word-start prev-word-end) (goto-char word-end) (setq is-first nil)))))) diff --git a/modules/custom-comments.el b/modules/custom-comments.el index 73d29b0c..2e77af5a 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -72,6 +72,18 @@ is the line-opening prologue shared by the divider and inline-border emitters." (when (equal cmt-start ";") (insert cmt-start)) (insert " ")) +(defun cj/--comment-read-syntax () + "Return the buffer's comment syntax as a cons (COMMENT-START . COMMENT-END). +Falls back to prompting for the start when the buffer has none, and to an +empty end string. The single source of the resolution that was previously +copied into each command wrapper." + (cons (if (and (boundp 'comment-start) comment-start) + comment-start + (read-string "Comment start character(s): ")) + (if (and (boundp 'comment-end) comment-end) + comment-end + ""))) + ;; ----------------------------- Inline Border --------------------------------- (defun cj/--comment-inline-border (cmt-start cmt-end decoration-char text length) @@ -129,12 +141,9 @@ LENGTH is the total width of the line." DECORATION-CHAR defaults to \"#\" if not provided. Uses the lesser of `fill-column\\=' or 80 for line length." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (or decoration-char "#")) (text (capitalize (string-trim (read-from-minibuffer "Comment: ")))) (length (min fill-column 80))) @@ -157,12 +166,9 @@ delegates to `cj/--comment-padded-divider' with PADDING 0." "Insert a simple divider comment banner. Prompts for decoration character, text, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default =): " nil nil "=")) (text (read-string "Comment text: ")) (length-option (completing-read "Comment length: " @@ -200,8 +206,13 @@ PADDING is the number of spaces before the text." (if (string-empty-p cmt-end) 0 (1+ (length cmt-end)))))) (when (< length min-length) (error "Length %d is too small to generate comment (minimum %d)" length min-length)) + ;; Mirror every term the emit path adds: the prologue also inserts a + ;; doubled semicolon (elisp) and a trailing space that this budget used + ;; to omit, rendering dividers LENGTH+2 (elisp) or LENGTH+1 wide. (let* ((available-width (- length current-column-pos (length cmt-start) + (if (equal cmt-start ";") 1 0) ; doubled semicolon + 1 ; space after comment-start (if (string-empty-p cmt-end) 0 (1+ (length cmt-end))))) (line (make-string available-width (string-to-char decoration-char)))) ;; Top line @@ -232,12 +243,9 @@ PADDING is the number of spaces before the text." "Insert a padded divider comment banner. Prompts for decoration character, text, padding, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default =): " nil nil "=")) (text (read-string "Comment text: ")) (padding (string-to-number (read-string "Padding spaces (default 2): " nil nil "2"))) @@ -333,12 +341,9 @@ LENGTH is the total width of each line." "Insert a 3-line comment box with centered text. Prompts for decoration character, text, and uses `fill-column' for length." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default -): " nil nil "-")) (text (capitalize (string-trim (read-from-minibuffer "Comment: ")))) (length (min fill-column 80))) @@ -361,12 +366,9 @@ text, so it delegates to `cj/--comment-box-emit' with HEAVY non-nil." "Insert a heavy box comment with blank lines around centered text. Prompts for decoration character, text, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (decoration-char (read-string "Decoration character (default *): " nil nil "*")) (text (read-string "Comment text: ")) (length-option (completing-read "Comment length: " @@ -444,12 +446,9 @@ BOX-STYLE is either \\='single or \\='double for line style." "Insert a unicode box comment. Prompts for text, box style, and length option." (interactive) - (let* ((comment-start (if (and (boundp 'comment-start) comment-start) - comment-start - (read-string "Comment start character(s): "))) - (comment-end (if (and (boundp 'comment-end) comment-end) - comment-end - "")) + (let* ((comment-syntax (cj/--comment-read-syntax)) + (comment-start (car comment-syntax)) + (comment-end (cdr comment-syntax)) (text (read-string "Comment text: ")) (box-style (intern (completing-read "Comment box style: " '("single" "double") diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 12d2deaf..3c33dcad 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -126,18 +126,27 @@ active, otherwise the entire buffer." (cons (region-beginning) (region-end)) (cons (point-min) (point-max)))) -(defun cj/append-to-lines-in-region-or-buffer (str) - "Append STR to the end of each line in the region or entire buffer." - (interactive "sEnter string to append: ") +(defun cj/--replace-region-or-buffer (transform) + "Replace the region (or whole buffer) with TRANSFORM applied to its text. +TRANSFORM takes the current text and returns the replacement. The +replacement is computed before anything is deleted, so a TRANSFORM error +leaves the buffer untouched. Point lands at the start of the replaced +span. The shared delete/goto/insert tail of the line-transform commands." (let* ((bounds (cj/--region-or-buffer-bounds)) (start-pos (car bounds)) (end-pos (cdr bounds)) (text (buffer-substring start-pos end-pos)) - (insertion (cj/--append-to-lines text str))) + (insertion (funcall transform text))) (delete-region start-pos end-pos) (goto-char start-pos) (insert insertion))) +(defun cj/append-to-lines-in-region-or-buffer (str) + "Append STR to the end of each line in the region or entire buffer." + (interactive "sEnter string to append: ") + (cj/--replace-region-or-buffer + (lambda (text) (cj/--append-to-lines text str)))) + (defun cj/--prepend-to-lines (text prefix) "Internal implementation: Prepend PREFIX to each line in TEXT. TEXT is the string containing one or more lines. @@ -158,14 +167,8 @@ Returns the transformed string without modifying the buffer." (defun cj/prepend-to-lines-in-region-or-buffer (str) "Prepend STR to the beginning of each line in the region or entire buffer." (interactive "sEnter string to prepend: ") - (let* ((bounds (cj/--region-or-buffer-bounds)) - (start-pos (car bounds)) - (end-pos (cdr bounds)) - (text (buffer-substring start-pos end-pos)) - (insertion (cj/--prepend-to-lines text str))) - (delete-region start-pos end-pos) - (goto-char start-pos) - (insert insertion))) + (cj/--replace-region-or-buffer + (lambda (text) (cj/--prepend-to-lines text str)))) (defun cj/--indent-lines (text count use-tabs) "Internal implementation: Indent each line in TEXT by COUNT characters. @@ -188,14 +191,8 @@ mean the count. Call it from Lisp with an explicit USE-TABS to override." (prefix-numeric-value current-prefix-arg) 4) indent-tabs-mode)) - (let* ((bounds (cj/--region-or-buffer-bounds)) - (start-pos (car bounds)) - (end-pos (cdr bounds)) - (text (buffer-substring start-pos end-pos)) - (insertion (cj/--indent-lines text count use-tabs))) - (delete-region start-pos end-pos) - (goto-char start-pos) - (insert insertion))) + (cj/--replace-region-or-buffer + (lambda (text) (cj/--indent-lines text count use-tabs)))) (defun cj/--dedent-lines (text count) "Internal implementation: Remove up to COUNT leading characters from each line. @@ -234,14 +231,8 @@ Works on region if active, otherwise entire buffer." (interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) 4))) - (let* ((bounds (cj/--region-or-buffer-bounds)) - (start-pos (car bounds)) - (end-pos (cdr bounds)) - (text (buffer-substring start-pos end-pos)) - (insertion (cj/--dedent-lines text count))) - (delete-region start-pos end-pos) - (goto-char start-pos) - (insert insertion))) + (cj/--replace-region-or-buffer + (lambda (text) (cj/--dedent-lines text count)))) ;; Text enclosure keymap (defvar-keymap cj/enclose-map diff --git a/modules/dashboard-config.el b/modules/dashboard-config.el index 53f19b72..c7ff39dc 100644 --- a/modules/dashboard-config.el +++ b/modules/dashboard-config.el @@ -68,12 +68,12 @@ (declare-function cj/erc-switch-to-buffer-with-completion "erc-config") (declare-function cj/telega "telega-config") (declare-function cj/slack-start "slack-config") -(declare-function cj/signel-message "signal-config") (declare-function cj/kill-all-other-buffers-and-windows "undead-buffers") ;; External package commands invoked by launchers. (declare-function mu4e "mu4e") (declare-function pearl-list-issues "pearl") +(declare-function wttrin "wttrin") ;; ------------------------ Dashboard Bookmarks Override ----------------------- ;; overrides the bookmark insertion from the dashboard package to provide an @@ -85,38 +85,47 @@ (defvar dashboard-bookmarks-item-format "%s" "Format to use when showing the base of the file name.") -;; `el' is bound dynamically by dashboard's section-insertion machinery, which the -;; override below plugs into. Declare it so the byte-compiler reads the -;; references as that special variable rather than a free variable. The name is -;; dashboard's, not ours, so the missing-prefix lint is suppressed rather than -;; renamed (renaming would break the dynamic binding dashboard supplies). -(with-suppressed-warnings ((lexical el)) - (defvar el)) - -(defun dashboard-insert-bookmarks (list-size) - "Add the list of LIST-SIZE items of bookmarks." - (require 'bookmark) - (dashboard-insert-section - "Bookmarks:" - (dashboard-subseq (bookmark-all-names) list-size) - list-size - 'bookmarks - (dashboard-get-shortcut 'bookmarks) - `(lambda (&rest _) (bookmark-jump ,el)) - (if-let* ((filename el) - (path (bookmark-get-filename el)) - (path-shorten (dashboard-shorten-path path 'bookmarks))) - (cl-case dashboard-bookmarks-show-path - (`align - (unless dashboard--bookmarks-cache-item-format - (let* ((len-align (dashboard--align-length-by-type 'bookmarks)) - (new-fmt (dashboard--generate-align-format - dashboard-bookmarks-item-format len-align))) - (setq dashboard--bookmarks-cache-item-format new-fmt))) - (format dashboard--bookmarks-cache-item-format filename path-shorten)) - (`nil filename) - (t (format dashboard-bookmarks-item-format filename path-shorten))) - el))) +;; No `(defvar el)' here on purpose. `el' is the per-item variable that +;; dashboard's `dashboard-insert-section' macro binds inside its own expansion; +;; the override's forms below reference it within that binding. Declaring `el' +;; special (as an earlier attempt did) is what CREATED a byte-compile warning -- +;; it turned the macro's ordinary lexical binding into one that "shadows the +;; dynamic variable el". Left lexical, the references resolve inside the +;; expansion and the compile is clean. + +;; The override body uses the `dashboard-insert-section' MACRO, so it must be +;; known when this module byte-compiles or the call compiles as a plain +;; function call that evaluates `el' eagerly -- void-variable at render time. +(eval-when-compile (require 'dashboard-widgets nil t)) + +;; Registered after dashboard-widgets, not as a bare top-level defun: the +;; use-package below reloads dashboard-widgets, which would clobber an eager +;; override. Same shape as the banner-title override further down. +(with-eval-after-load 'dashboard-widgets + (defun dashboard-insert-bookmarks (list-size) + "Add the list of LIST-SIZE items of bookmarks." + (require 'bookmark) + (dashboard-insert-section + "Bookmarks:" + (dashboard-subseq (bookmark-all-names) list-size) + list-size + 'bookmarks + (dashboard-get-shortcut 'bookmarks) + `(lambda (&rest _) (bookmark-jump ,el)) + (if-let* ((filename el) + (path (bookmark-get-filename el)) + (path-shorten (dashboard-shorten-path path 'bookmarks))) + (cl-case dashboard-bookmarks-show-path + (`align + (unless dashboard--bookmarks-cache-item-format + (let* ((len-align (dashboard--align-length-by-type 'bookmarks)) + (new-fmt (dashboard--generate-align-format + dashboard-bookmarks-item-format len-align))) + (setq dashboard--bookmarks-cache-item-format new-fmt))) + (format dashboard--bookmarks-cache-item-format filename path-shorten)) + (`nil filename) + (t (format dashboard-bookmarks-item-format filename path-shorten))) + el)))) ;; ------------------------- Banner Title Centering Fix ------------------------ ;; The default centering can be off due to font width calculations. @@ -149,15 +158,15 @@ Adjust this if the title doesn't appear centered under the banner image.") (list "i" #'nerd-icons-faicon "nf-fa-comments" "IRC" "Emacs Relay Chat" (lambda () (cj/erc-switch-to-buffer-with-completion))) (list "G" #'nerd-icons-faicon "nf-fa-telegram" "Telegram" "Telega Telegram Client" (lambda () (cj/telega))) (list "s" #'nerd-icons-faicon "nf-fa-slack" "Slack" "Slack Client" (lambda () (cj/slack-start))) - (list "l" #'nerd-icons-octicon "nf-oct-issue_tracks" "Linear" "Linear Issue Tracker" (lambda () (pearl-list-issues))) - (list "S" #'nerd-icons-mdicon "nf-md-message" "Signal" "Signal Messenger" (lambda () (cj/signel-message)))) + (list "l" #'nerd-icons-octicon "nf-oct-issue_tracks" "Linear" "Linear Issue Tracker" (lambda () (pearl-list-issues)))) "Dashboard launcher table: (KEY ICON-FN ICON-NAME LABEL TOOLTIP ACTION). Drives both `dashboard-navigator-buttons' and the dashboard-mode-map keys.") -(defconst cj/dashboard--row-sizes '(5 4 3 3) +(defconst cj/dashboard--row-sizes '(5 4 3 2) "Navigator row lengths. Must sum to the number of `cj/dashboard--launchers'. -The top row carries Weather alongside the core tools; the last row groups -Slack, Linear, and Signal together.") +The top row carries Weather alongside the core tools; the last row pairs +Slack and Linear. (Signal left the table when the signel client was +retired to archive/ -- agents drive Signal via signal-cli.)") (defun cj/dashboard--navigator-button (l) "Build a `dashboard-navigator-buttons' entry from launcher L." diff --git a/modules/dev-fkeys.el b/modules/dev-fkeys.el index 80b43600..c760e392 100644 --- a/modules/dev-fkeys.el +++ b/modules/dev-fkeys.el @@ -82,13 +82,25 @@ recognized markers both return nil." ;; ---------- Action handlers ---------- +(defun cj/--f4-install-once-hook (buffer then-fn) + "Install a one-shot buffer-local compilation finish hook in BUFFER. +Installing in the compilation buffer itself (rather than globally) +means a quit before the compile starts, or an unrelated concurrent +compile, can never fire the chained THEN-FN. No-op when BUFFER is not +a live buffer." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (add-hook 'compilation-finish-functions + (cj/--f4-make-once-hook then-fn) nil t)))) + (defun cj/--f4-compile-and-run-impl () "Run `projectile-compile-project', then `projectile-run-project' on success. -Installs a one-shot `compilation-finish-functions' hook to chain the run." - (add-hook 'compilation-finish-functions - (cj/--f4-make-once-hook - (lambda () (projectile-run-project nil)))) - (projectile-compile-project nil)) +Chains the run via a one-shot finish hook installed buffer-locally in +the compilation buffer projectile returns." + (let ((result (projectile-compile-project nil))) + (cj/--f4-install-once-hook + (cj/--projectile-compilation-buffer result) + (lambda () (projectile-run-project nil))))) (defun cj/--f4-dispatch (action) "Route ACTION (a symbol from `cj/--f4-candidates') to its handler. @@ -109,24 +121,26 @@ command (prompted-and-cached by projectile) drives the build." (let ((clean-cmd (cj/--f4-derive-clean-cmd root))) (unless clean-cmd (user-error "Clean + Rebuild: no clean command for this project type")) - (add-hook 'compilation-finish-functions - (cj/--f4-make-once-hook - (lambda () (projectile-compile-project nil)))) - (let ((default-directory root)) - (compile clean-cmd)))) + (let* ((default-directory root) + (buffer (compile clean-cmd))) + (cj/--f4-install-once-hook + buffer (lambda () (projectile-compile-project nil)))))) ;; ---------- One-shot compilation-finish hook ---------- (defun cj/--f4-make-once-hook (then-fn) "Build a one-shot `compilation-finish-functions' hook that chains THEN-FN. The returned lambda removes itself from `compilation-finish-functions' on -first invocation regardless of status, then calls THEN-FN only if the -status string starts with \"finished\" (the convention used by compile.el -for a successful compile)." +first invocation regardless of status — from both the global value and +the running buffer's local value, so it is one-shot wherever it was +installed — then calls THEN-FN only if the status string starts with +\"finished\" (the convention used by compile.el for a successful +compile)." (let (hook) (setq hook (lambda (_buf status) (remove-hook 'compilation-finish-functions hook) + (remove-hook 'compilation-finish-functions hook t) (when (and (stringp status) (string-prefix-p "finished" status)) (funcall then-fn)))) @@ -350,9 +364,10 @@ TypeScript / JavaScript and unknown languages return nil." (if (string-empty-p rel-dir) "./" (format "./%s" rel-dir))))) - ('typescript + ((or 'typescript 'javascript) ;; Prefer vitest when present on PATH, fall back to jest otherwise. - ;; Both runners take a path argument and accept relative paths. + ;; Both runners take a path argument and accept relative paths, and + ;; both run JS test files the same way they run TS ones. (let ((runner (or (and (executable-find "vitest") "vitest") (and (executable-find "jest") "jest") "jest"))) ; reasonable default for stack traces diff --git a/modules/diff-config.el b/modules/diff-config.el index 0c09b951..75911587 100644 --- a/modules/diff-config.el +++ b/modules/diff-config.el @@ -40,7 +40,6 @@ :custom (ediff-window-setup-function 'ediff-setup-windows-plain) (ediff-split-window-function 'split-window-horizontally) - (ediff-diff-options "-w") (ediff-highlight-all-diffs nil) :bind-keymap ("C-c D" . cj/ediff-map) :init diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el index 0e22dcee..6c849198 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -8,8 +8,8 @@ ;; Load shape: eager. ;; Eager reason: none; file manager, a command/hook-loaded deferral candidate. ;; Top-level side effects: three add-hook, package configuration via use-package. -;; Runtime requires: user-constants, system-utils, host-environment, system-lib, -;; external-open-lib. +;; Runtime requires: user-constants, system-utils, external-open, +;; host-environment, system-lib, external-open-lib. ;; Direct test load: yes. ;; ;; Enhanced file management via Dirvish (modern dired replacement) with icons, @@ -34,7 +34,8 @@ ;;; Code: (require 'user-constants) ;; code-dir, music-dir, pix-dir et al. used at load time -(require 'system-utils) ;; cj/xdg-open, cj/open-file-with-command bound to keys +(require 'system-utils) ;; cj/open-file-with-command bound to keys +(require 'external-open) ;; cj/xdg-open bound to keys ("o" and OS-handler fallback) (require 'host-environment) (require 'system-lib) (require 'external-open-lib) @@ -589,6 +590,8 @@ 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") ("rtt" "/sshx:cjennings@truenas:~" "remote cjennings@truenas (tailscale)") diff --git a/modules/dwim-shell-config.el b/modules/dwim-shell-config.el index e8790a48..12908f51 100644 --- a/modules/dwim-shell-config.el +++ b/modules/dwim-shell-config.el @@ -7,7 +7,7 @@ ;; Load shape: eager. ;; Eager reason: none; Dired/Dirvish shell commands can load by command. ;; Top-level side effects: package configuration via use-package. -;; Runtime requires: cl-lib, system-lib. +;; Runtime requires: cl-lib, system-lib, external-open. ;; Direct test load: yes. ;; ;; Configures dwim-shell-command actions for marked Dired/Dirvish files: @@ -22,7 +22,8 @@ ;;; 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). (declare-function dwim-shell-command-on-marked-files "dwim-shell-command") @@ -222,7 +223,7 @@ not apply to). Signals a `user-error' when a used second count is negative." :utils "convert")) (defun cj/dwim-shell-commands-flip-image-vertically () - "Horizontally flip image(s)." + "Vertically flip image(s)." (interactive) (dwim-shell-command-on-marked-files "Image vertical flip" @@ -764,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 e5b8f0c5..01d0fbe6 100644 --- a/modules/eat-config.el +++ b/modules/eat-config.el @@ -110,6 +110,102 @@ not recognize (which would later trip (cl-assert charset) on write)." (with-eval-after-load 'eat (advice-add 'eat--t-set-charset :filter-args #'cj/--eat-charset-never-nil)) +;; EAT 0.9.4 XTWINOPS gap. tmux 3.7b has native Sixel but refuses to emit it +;; until it learns the client's cell pixel size, which it asks for with the +;; XTWINOPS window-size requests CSI 14 t (text area in pixels), CSI 16 t (cell +;; size in pixels) and CSI 18 t (text area in characters). EAT's parser +;; (eat--t-handle-output) has no `t' case, so it silently drops these -- tmux +;; never learns the geometry and images never render. We can't add the parser +;; clause without forking the vendored 541-line pcase (see the charset note +;; above), so answer the query from a `:before' advice instead: eat--t-handle-output +;; is called inside (eat--t-with-env terminal ...), which dynamically binds +;; eat--t-term, so the advice can read the live display + cell dimensions and +;; write the report back through the terminal's own input function. The reply +;; format matches EAT's existing XTSMGRAPHICS reply (same char-width/height and +;; display fields). Verified live on ratio 2026-07-13: images render and +;; persist across window switches, scrolling, and resizing. An upstream-shaped +;; patch (a real parser clause) is kept locally for a PR to akib/emacs-eat. +;; The advice does NOT become a no-op when upstream +;; ships that clause: it runs :before the parser and scans raw output, so +;; queries always survive to it, and two answerers means tmux gets a double +;; reply -- it treats the second as unrequested input and forwards the raw +;; escape bytes into the pane as keystrokes (this killed an agent session on +;; 2026-07-13 when a second patched parser was live in the daemon). The +;; advice-add is therefore guarded: it installs only while EAT itself cannot +;; answer, and stays out the day the upstream clause (which defines +;; eat--t-send-window-size-report) lands. + +(declare-function eat--t-handle-output "eat") +(declare-function eat--t-term-display "eat") +(declare-function eat--t-term-input-fn "eat") +(declare-function eat--t-term-char-width "eat") +(declare-function eat--t-term-char-height "eat") +(declare-function eat--t-disp-width "eat") +(declare-function eat--t-disp-height "eat") +(defvar eat--t-term) + +(defun cj/--eat-xtwinops-report (n cols rows char-width char-height) + "Return the XTWINOPS reply string for window-size request N, or nil. +COLS and ROWS are the display size in characters; CHAR-WIDTH and +CHAR-HEIGHT are the pixel size of one cell. N is 14 (text area in +pixels), 16 (cell size in pixels), or 18 (text area in characters); any +other N returns nil so the request goes unanswered." + (pcase n + (14 (format "\e[4;%d;%dt" (* rows char-height) (* cols char-width))) + (16 (format "\e[6;%d;%dt" char-height char-width)) + (18 (format "\e[8;%d;%dt" rows cols)))) + +(defun cj/--eat-xtwinops-queries (output) + "Return the XTWINOPS request numbers found in terminal OUTPUT, in order. +Matches only the bare CSI 14/16/18 t window-size requests EAT drops -- a +parametrized form (e.g. CSI 3 ; 14 t) or a different CSI t op (e.g. the +CSI 24 t resize) is not one we answer and is left alone. Returns nil +when OUTPUT carries no such request. OUTPUT is one pty chunk, so a +query split across two reads would be missed; in practice tmux writes +the few-byte query atomically, so it arrives whole." + (let ((start 0) (found '())) + (while (string-match "\e\\[\\(14\\|16\\|18\\)t" output start) + (push (string-to-number (match-string 1 output)) found) + (setq start (match-end 0))) + (nreverse found))) + +(defun cj/--eat-send-window-size-report (n) + "Answer XTWINOPS window-size request N on the current EAT terminal. +Runs with `eat--t-term' dynamically bound (inside `eat--t-with-env'), +reads the live display and cell dimensions, and writes the report back +through the terminal's own input function. A request number EAT does +not report on (`cj/--eat-xtwinops-report' returns nil) is ignored." + (let* ((disp (eat--t-term-display eat--t-term)) + (reply (cj/--eat-xtwinops-report + n + (eat--t-disp-width disp) + (eat--t-disp-height disp) + (eat--t-term-char-width eat--t-term) + (eat--t-term-char-height eat--t-term)))) + (when reply + (funcall (eat--t-term-input-fn eat--t-term) eat--t-term reply)))) + +(defun cj/--eat-answer-xtwinops (output) + "`:before' advice for `eat--t-handle-output'. +Answer every XTWINOPS window-size request in OUTPUT that EAT 0.9.4 would +otherwise drop, so tmux learns the cell pixel size it needs before it +will emit Sixel. Runs inside `eat--t-with-env', so `eat--t-term' is +bound for the responder." + (mapc #'cj/--eat-send-window-size-report (cj/--eat-xtwinops-queries output))) + +(defun cj/--eat-xtwinops-advice-needed-p () + "Return non-nil when EAT itself cannot answer XTWINOPS window-size queries. +EAT 0.9.4 has no CSI t parser clause, so the advice must answer them. +An EAT that ships the clause defines `eat--t-send-window-size-report' +(the function the upstream-shaped parser patch adds); with that present +the advice must stay out, or every query gets two replies and tmux +types the second one's raw bytes into the pane." + (not (fboundp 'eat--t-send-window-size-report))) + +(with-eval-after-load 'eat + (when (cj/--eat-xtwinops-advice-needed-p) + (advice-add 'eat--t-handle-output :before #'cj/--eat-answer-xtwinops))) + ;; ------------------------------- eat package --------------------------------- (defun cj/--eat-clear-mode-line-process () diff --git a/modules/elfeed-config.el b/modules/elfeed-config.el index dbc7e4a4..f4feef3a 100644 --- a/modules/elfeed-config.el +++ b/modules/elfeed-config.el @@ -142,30 +142,6 @@ (elfeed-search-update--force) (goto-char (point-min))) -;; ----------------------------- Extract Stream URL ---------------------------- -;; TASK: Is this method reused anywhere here or in another file? - -(defun cj/extract-stream-url (url format) - "Extract the direct stream URL from URL using yt-dlp with FORMAT. -Returns the stream URL or nil on failure." - (unless (executable-find "yt-dlp") - (error "The program yt-dlp is not installed or not in PATH")) - (let* ((format-args (if format - (list "-f" format) - nil)) - (cmd-args (append '("yt-dlp" "-q" "-g") - format-args - (list url))) - (output (with-temp-buffer - (let ((exit-code (apply #'call-process - (car cmd-args) nil t nil - (cdr cmd-args)))) - (if (zerop exit-code) - (string-trim (buffer-string)) - nil))))) - (when (and output (string-match-p "^https?://" output)) - output))) - ;; -------------------------- Elfeed Core Processing --------------------------- (defun cj/elfeed-process-entries (action-fn action-name &optional skip-error-handling) diff --git a/modules/erc-config.el b/modules/erc-config.el index 57d4eb56..afcb3901 100644 --- a/modules/erc-config.el +++ b/modules/erc-config.el @@ -38,6 +38,7 @@ ;; without forcing an eager require. ;; Functions provided by the erc package. +(defvar erc-server-process) (declare-function erc-buffer-list "erc") (declare-function erc-server-process-alive "erc") (declare-function erc-server-or-unjoined-channel-buffer-p "erc") diff --git a/modules/external-open.el b/modules/external-open.el index 811c32c2..f7f09816 100644 --- a/modules/external-open.el +++ b/modules/external-open.el @@ -142,6 +142,18 @@ Logs output and exit code to buffer *external-open.log*." ;; ------------------------------- Open File With ------------------------------ +(defun cj/--open-with-argv (command file) + "The argv list to open FILE with the user-typed COMMAND. +COMMAND may carry arguments (\"mpv --fs\"); `split-string-and-unquote' +splits it so a double-quoted argument survives as one word. FILE is +appended as the final element, so paths with spaces or shell +metacharacters never meet a shell. Signals a `user-error' when COMMAND +is empty or whitespace." + (let ((argv (split-string-and-unquote command))) + (unless argv + (user-error "No program given")) + (append argv (list file)))) + (defun cj/open-this-file-with (command) "Open this buffer's file with COMMAND, detached from Emacs." (interactive "MOpen with program: ") @@ -152,12 +164,12 @@ Logs output and exit code to buffer *external-open.log*." ;; Windows: launch via ShellExecute so the child isn't tied to Emacs. ((env-windows-p) (w32-shell-execute "open" command (format "\"%s\"" file))) - ;; POSIX: disown with nohup + background. No child remains. + ;; POSIX: argv launch, DESTINATION 0 detaches with no shell in between. (t - (call-process-shell-command - (format "nohup %s %s >/dev/null 2>&1 &" - command (shell-quote-argument file)) - nil 0))))) + (let ((argv (cj/--open-with-argv command file))) + (unless (executable-find (car argv)) + (user-error "Program not found: %s" (car argv))) + (apply #'call-process (car argv) nil 0 nil (cdr argv))))))) ;; -------------------------- Open Videos On Repeat ---------------------------- @@ -185,6 +197,11 @@ blocks Emacs." (if (env-windows-p) (w32-shell-execute "open" cj/video-open-command (mapconcat (lambda (a) (format "\"%s\"" a)) args " ")) + ;; Guard like `cj/open-this-file-with': this fires via the find-file + ;; advice, so a missing player must fail with a clear message, not an + ;; opaque call-process error mid-visit. + (unless (executable-find cj/video-open-command) + (user-error "Program not found: %s" cj/video-open-command)) (apply #'call-process cj/video-open-command nil 0 nil args)))) ;; -------------------- Open Files With Default File Handler ------------------- diff --git a/modules/flycheck-config.el b/modules/flycheck-config.el index 6ffe3ea2..ad762b3b 100644 --- a/modules/flycheck-config.el +++ b/modules/flycheck-config.el @@ -53,10 +53,12 @@ (:map cj/custom-keymap ("?" . cj/flycheck-list-errors)) :custom - ;; Only disable these two Checkdoc warnings; leave all others intact. - (checkdoc-arguments - '(("sentence-end-double-space" nil) - ("warn-escape" nil))) + ;; No checkdoc suppression here: the old `checkdoc-arguments' entry named a + ;; variable that doesn't exist (checkdoc has no such option and this + ;; flycheck runs checkdoc via a fixed subprocess form), so it never + ;; suppressed anything. Removing it changes no behavior; if specific + ;; checkdoc warnings need silencing, that's a new feature against + ;; `flycheck-emacs-lisp-checkdoc-form'. ;; Modeline customization (rendered via mode-line-format in modeline-config.el). ;; The count portion picks up `error' / `warning' faces because ;; `flycheck-mode-line-color' stays t (the default). diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index b73bfdf3..d0cdd09c 100644 --- a/modules/flyspell-and-abbrev.el +++ b/modules/flyspell-and-abbrev.el @@ -73,8 +73,10 @@ ;; personal directory goes with sync'd files (setq ispell-personal-dictionary (concat org-dir "aspell-personal-dictionary")) - ;; skip code blocks in org mode - (add-to-list 'ispell-skip-region-alist '("^#+BEGIN_SRC" . "^#+END_SRC"))) + ;; Skip code blocks in org mode. The # must be literal and the + escaped: + ;; "#+" in regex means one-or-more #, which matches no real begin_src line, + ;; so ispell used to spell-check inside every org code block. + (add-to-list 'ispell-skip-region-alist '("^#\\+BEGIN_SRC" . "^#\\+END_SRC"))) (use-package flyspell :ensure nil ;; built-in @@ -197,9 +199,10 @@ Without prefix argument, it's created in the global abbrev table. Press C-' repeatedly to step through misspellings one at a time." (interactive "P") (cj/--require-spell-checker) - ;; Run flyspell-buffer only if buffer hasn't been checked yet - (unless (bound-and-true-p flyspell-mode) - (flyspell-buffer)) + ;; Enable Flyspell for the buffer type so the mode sticks and the buffer is + ;; scanned once. A bare flyspell-buffer here never turned the mode on, so + ;; the guard never tripped and every C-' press re-scanned the whole buffer. + (cj/flyspell-on-for-buffer-type) (let ((misspelled-word (cj/flyspell-goto-previous-misspelling (point)))) (if (not misspelled-word) diff --git a/modules/font-config.el b/modules/font-config.el index e5afb361..e4549c95 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -8,12 +8,12 @@ ;; Load shape: eager. ;; Eager reason: first-frame font setup and font keybindings. ;; Top-level side effects: font keys, font checks, package config. -;; Runtime requires: host-environment, keybindings. +;; Runtime requires: host-environment, font-profiles, keybindings. ;; Direct test load: yes. ;; -;; Configures fontaine presets, text scaling keys, icon/emoji fonts, and -;; programming ligatures. Presets are applied per frame so daemon clients get -;; the intended fixed/variable pitch sizes. +;; Configures task-oriented Fontaine profiles, text scaling keys, icon/emoji +;; fonts, and programming ligatures. The selected profile is global, persists +;; across restarts, and applies to every daemon frame without per-frame resets. ;; ;; Also carries font-rendering safeguards for known HarfBuzz/font-cache crashes ;; triggered by emoji and Arabic shaping in this setup. @@ -21,6 +21,7 @@ ;;; Code: (require 'host-environment) +(require 'font-profiles) (require 'keybindings) ;; establishes the C-z prefix used for "C-z F" below (defvar text-scale-mode-step) @@ -50,106 +51,156 @@ (#xFE70 . #xFEFF))) ;; Arabic Presentation Forms-B (set-char-table-range composition-function-table range nil))) -;; ----------------------- Font Family And Size Selection ---------------------- -;; preset your fixed and variable fonts, then apply them to text as a set +;; ------------------------- Workflow Font Profiles ---------------------------- +;; Each choice is a complete destination. Font size adjustments within one +;; buffer remain on C-+/C--; Fontaine owns the global workflow typography. + +(defconst cj/fontaine-profile-order + cj/font-profile-order + "Fontaine profiles in picker order.") + +(defconst cj/fontaine-profile-names + '((everyday . "Everyday") + (writing . "Writing") + (reading . "Reading") + (coding-xs . "Coding XS") + (coding-m . "Coding M") + (coding-l . "Coding L") + (coding-xl . "Coding XL") + (presentation . "Presentation")) + "Human names for Fontaine workflow profiles.") + +(defconst cj/fontaine-profile-fonts + '((everyday . "Berkeley Mono + Lexend") + (writing . "Berkeley Mono + Merriweather") + (reading . "Merriweather") + (coding-xs . "Berkeley Mono") + (coding-m . "Berkeley Mono") + (coding-l . "Berkeley Mono") + (coding-xl . "Berkeley Mono") + (presentation . "Berkeley Mono + Lexend")) + "Human-readable font combinations for Fontaine workflow profiles.") + +(defconst cj/fontaine-profile-heights + (mapcar (lambda (profile) + (cons profile + (plist-get (cj/font-profile-properties profile) + :default-height))) + cj/fontaine-profile-order) + "Default face heights for Fontaine workflow profiles.") + +(defconst cj/fontaine-ui-family "BerkeleyMono Nerd Font" + "Font family reserved for the mode line, echo area, and minibuffer.") + +(defvar fontaine-current-preset) +(defvar fontaine-preset-history) +(defvar fontaine-presets) +(defvar enable-theme-functions) +(defvar cj/fontaine-profile-history nil + "Minibuffer history for `cj/fontaine-select-profile'.") + +(declare-function fontaine-mode "fontaine") +(declare-function fontaine-restore-latest-preset "fontaine") +(declare-function fontaine-set-preset "fontaine") +(declare-function face-remap-set-base "face-remap") + +(defun cj/fontaine-profile-p (profile) + "Return non-nil when PROFILE is a configured workflow profile." + (cj/font-profile-p profile)) + +(defun cj/fontaine-profile-label (profile) + "Return the complete picker label for PROFILE." + (when (cj/fontaine-profile-p profile) + (format "%s — %s · %d pt" + (alist-get profile cj/fontaine-profile-names) + (alist-get profile cj/fontaine-profile-fonts) + (/ (alist-get profile cj/fontaine-profile-heights) 10)))) + +(defun cj/fontaine-profile-candidates () + "Return complete labels for all Fontaine workflow profiles." + (mapcar #'cj/fontaine-profile-label cj/fontaine-profile-order)) + +(defun cj/fontaine-profile-from-label (label) + "Return the workflow profile represented by LABEL, or nil." + (seq-find (lambda (profile) + (equal label (cj/fontaine-profile-label profile))) + cj/fontaine-profile-order)) + +(defun cj/fontaine-profile-annotation (candidate) + "Mark CANDIDATE when it represents the active Fontaine profile." + (if (eq (cj/fontaine-profile-from-label candidate) + fontaine-current-preset) + " current" + "")) + +(defun cj/fontaine-apply-profile (profile) + "Apply workflow PROFILE and record it for Fontaine persistence." + (unless (cj/fontaine-profile-p profile) + (user-error "Unknown font profile: %s" profile)) + (add-to-history 'fontaine-preset-history (symbol-name profile)) + (fontaine-set-preset profile)) + +(defun cj/fontaine-select-profile () + "Select and apply one complete Fontaine workflow profile." + (interactive) + (let* ((candidates (cj/fontaine-profile-candidates)) + (default (cj/fontaine-profile-label + (if (cj/fontaine-profile-p fontaine-current-preset) + fontaine-current-preset + 'everyday))) + (completion-extra-properties + '(:annotation-function cj/fontaine-profile-annotation)) + (choice (completing-read "Font profile: " candidates nil t + nil 'cj/fontaine-profile-history default))) + (cj/fontaine-apply-profile (cj/fontaine-profile-from-label choice)))) + +(defun cj/fontaine-restored-or-default-profile () + "Return the saved Fontaine profile, or the `everyday' fallback." + (let ((restored (fontaine-restore-latest-preset))) + (if (cj/fontaine-profile-p restored) restored 'everyday))) + +(defalias 'cj/fontaine-profile-properties #'cj/font-profile-properties) +(defalias 'cj/fontaine-remap-buffer-to-profile #'cj/font-profile-remap-buffer) + +(defun cj/fontaine-remap-ui-buffer () + "Keep the current minibuffer or echo-area buffer in Berkeley Mono." + (face-remap-set-base + 'default `(:family ,cj/fontaine-ui-family))) + +(defun cj/fontaine-keep-ui-chrome-monospace (&rest _ignored) + "Keep mode-line, minibuffer, and echo-area chrome in Berkeley Mono." + (dolist (face '(mode-line mode-line-active mode-line-inactive + minibuffer-prompt)) + (when (facep face) + (set-face-attribute face nil :family cj/fontaine-ui-family))) + (dolist (name '(" *Echo Area 0*" " *Echo Area 1*")) + (when-let* ((buffer (get-buffer name))) + (with-current-buffer buffer + (cj/fontaine-remap-ui-buffer))))) + +;; Fontaine 3 is global rather than frame-specific. Remove the retired hooks +;; as well as omitting them below, so a live module reload migrates cleanly. +(remove-hook 'server-after-make-frame-hook #'cj/apply-font-settings-to-frame) +(remove-hook 'delete-frame-functions #'cj/cleanup-frame-list) (use-package fontaine :demand t :bind - ("M-S-f" . fontaine-set-preset) ;; was M-F, overrides forward-word + ("M-S-f" . cj/fontaine-select-profile) ;; was M-F, overrides forward-word :config (setq fontaine-presets - `( - (default - :default-family "BerkeleyMono Nerd Font" - :default-weight regular - :default-height ,(if (env-laptop-p) 130 140) - :fixed-pitch-family nil ;; falls back to :default-family - :fixed-pitch-weight nil ;; falls back to :default-weight - :fixed-pitch-height 1.0 - :variable-pitch-family "Lexend" - :variable-pitch-weight regular - :variable-pitch-height 1.0) - (FiraCode - :default-family "FiraCode Nerd Font Mono" - :variable-pitch-family "Merriweather" - :variable-pitch-weight light) - (Hack - :default-family "Hack Nerd Font Mono" - :variable-pitch-family "Hack Nerd Font Mono") - (BerkeleyMono - :default-family "Berkeley Mono" - :variable-pitch-family "Charis SIL") - (FiraCode-Literata - :default-family "Fira Code Nerd Font" - :variable-pitch-family "Literata") - (24-point-font - :default-height 240) - (20-point-font - :default-height 200) - (16-point-font - :default-height 160) - (14-point-font - :default-height 140) - (13-point-font - :default-height 130) - (12-point-font - :default-height 120) - (11-point-font - :default-height 110) - (10-point-font - :default-height 100) - (t ;; shared fallback properties go here - :default-family "FiraCode Nerd Font Mono" - :default-weight regular - :default-height 120 - :fixed-pitch-family nil ;; falls back to :default-family - :fixed-pitch-weight nil ;; falls back to :default-weight - :fixed-pitch-height 1.0 - :fixed-pitch-serif-family nil ;; falls back to :default-family - :fixed-pitch-serif-weight nil ;; falls back to :default-weight - :fixed-pitch-serif-height 1.0 - :variable-pitch-family "Merriweather" - :variable-pitch-weight light - :variable-pitch-height 1.0 - :bold-family nil ;; use whatever the underlying face has - :bold-weight bold - :italic-family nil - :italic-slant italic - :line-spacing nil)))) - -;; Track which frames have had fonts applied -(defvar cj/fontaine-configured-frames nil - "List of frames that have had fontaine configuration applied.") - -(declare-function fontaine-set-preset "fontaine") - -(defun cj/apply-font-settings-to-frame (&optional frame) - "Apply font settings to FRAME if not already configured. -If FRAME is nil, uses the selected frame." - (let ((target-frame (or frame (selected-frame)))) - (unless (member target-frame cj/fontaine-configured-frames) - (with-selected-frame target-frame - (when (env-gui-p) - (fontaine-set-preset 'default) - (push target-frame cj/fontaine-configured-frames)))))) - -(defun cj/cleanup-frame-list (frame) - "Remove FRAME from the configured frames list when deleted." - (setq cj/fontaine-configured-frames - (delq frame cj/fontaine-configured-frames))) - -(with-eval-after-load 'fontaine - ;; Handle daemon mode and regular mode - (if (daemonp) - (progn - ;; Apply to each new frame in daemon mode - (add-hook 'server-after-make-frame-hook #'cj/apply-font-settings-to-frame) - ;; Clean up deleted frames from tracking list - (add-hook 'delete-frame-functions #'cj/cleanup-frame-list)) - ;; Apply immediately in non-daemon mode - (when (env-gui-p) - (cj/apply-font-settings-to-frame)))) + (append (copy-tree cj/font-profile-definitions) + (list (cons t (copy-sequence + cj/font-profile-shared-properties))))) + (fontaine-mode 1) + (add-hook 'fontaine-set-preset-hook + #'cj/fontaine-keep-ui-chrome-monospace) + (add-hook 'enable-theme-functions + #'cj/fontaine-keep-ui-chrome-monospace) + (add-hook 'minibuffer-setup-hook #'cj/fontaine-remap-ui-buffer) + (cj/fontaine-keep-ui-chrome-monospace) + (when (or (daemonp) (env-gui-p)) + (cj/fontaine-apply-profile (cj/fontaine-restored-or-default-profile)))) ;; ----------------------------- Font Install Check ---------------------------- ;; convenience function to indicate whether a font is available by name. diff --git a/modules/font-profiles.el b/modules/font-profiles.el new file mode 100644 index 00000000..a2c40562 --- /dev/null +++ b/modules/font-profiles.el @@ -0,0 +1,116 @@ +;;; font-profiles.el --- Shared Workflow Font Profile Data -*- lexical-binding: t; coding: utf-8; -*- +;; author: Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 1 (Foundation). +;; Category: F/L. +;; Load shape: library. +;; Top-level side effects: none. +;; Runtime requires: host-environment. +;; Direct test load: yes. +;; +;; Owns the effective font properties shared by the global Fontaine adapter and +;; buffer-local mode adapters such as nov-reading. Consumers can therefore use +;; the same named profile without making a global Fontaine selection. + +;;; Code: + +(require 'host-environment) + +(declare-function face-remap-add-relative "face-remap") + +(defconst cj/font-profile-shared-properties + `(:default-family "BerkeleyMono Nerd Font" + :default-weight regular + :default-height ,(if (env-laptop-p) 130 140) + :fixed-pitch-family nil + :fixed-pitch-weight nil + :fixed-pitch-height 1.0 + :fixed-pitch-serif-family nil + :fixed-pitch-serif-weight nil + :fixed-pitch-serif-height 1.0 + :variable-pitch-family "Lexend" + :variable-pitch-weight regular + :variable-pitch-height 1.0 + :bold-family nil + :bold-weight bold + :italic-family nil + :italic-slant italic + :line-spacing nil) + "Properties shared by every workflow font profile unless overridden.") + +(defconst cj/font-profile-definitions + '((everyday) + (writing + :default-height 140 + :variable-pitch-family "Merriweather" + :variable-pitch-weight light) + (reading + :default-family "Merriweather" + :default-height 140 + :fixed-pitch-family "Merriweather" + :fixed-pitch-serif-family "Merriweather" + :variable-pitch-family "Merriweather") + (coding-xs + :default-height 110 + :variable-pitch-family "BerkeleyMono Nerd Font") + (coding-m + :default-height 130 + :variable-pitch-family "BerkeleyMono Nerd Font") + (coding-l + :default-height 140 + :variable-pitch-family "BerkeleyMono Nerd Font") + (coding-xl + :default-height 160 + :variable-pitch-family "BerkeleyMono Nerd Font") + (presentation + :default-height 200)) + "Profile-specific font properties in user-facing order.") + +(defconst cj/font-profile-order + (mapcar #'car cj/font-profile-definitions) + "Workflow font profiles in user-facing order.") + +(defun cj/font-profile-p (profile) + "Return non-nil when PROFILE is a configured workflow font profile." + (memq profile cj/font-profile-order)) + +(defun cj/font-profile-properties (profile) + "Return effective font properties for workflow PROFILE." + (let ((entry (assq profile cj/font-profile-definitions))) + (unless entry + (user-error "Unknown font profile: %s" profile)) + (append (cdr entry) cj/font-profile-shared-properties))) + +(defun cj/font-profile-remap-buffer (profile &optional height) + "Apply PROFILE's face families buffer-locally and return remap cookies. +When HEIGHT is non-nil, use it for every remapped face instead of the profile's +configured heights. No global face or Fontaine state is changed." + (let ((properties (cj/font-profile-properties profile)) + (cookies nil)) + (dolist (face-property '((default + :default-family :default-height) + (fixed-pitch + :fixed-pitch-family :fixed-pitch-height) + (fixed-pitch-serif + :fixed-pitch-serif-family + :fixed-pitch-serif-height) + (variable-pitch + :variable-pitch-family + :variable-pitch-height))) + (pcase-let ((`(,face ,family-property ,height-property) + face-property)) + (let ((family (or (plist-get properties family-property) + (and (memq face '(fixed-pitch fixed-pitch-serif)) + (plist-get properties :default-family)))) + (face-height (or height + (plist-get properties height-property)))) + (when family + (push (face-remap-add-relative + face :family family :height face-height) + cookies))))) + (nreverse cookies))) + +(provide 'font-profiles) +;;; font-profiles.el ends here diff --git a/modules/help-utils.el b/modules/help-utils.el index 9792841a..2709ac45 100644 --- a/modules/help-utils.el +++ b/modules/help-utils.el @@ -65,24 +65,40 @@ ;; on Arch: yay (or whatever your AUR package manager is) -S arch-wiki-docs ;; browse the arch wiki topics offline +(defvar cj/arch-wiki-html-dir "/usr/share/doc/arch-wiki/html/en" + "Directory holding the offline ArchWiki HTML copies. +Populated by the arch-wiki-docs package on Arch systems.") + +(defun cj/--arch-wiki-topics (dir) + "Return an alist of (BASENAME . FULLPATH) for ArchWiki topics under DIR. + +Returns nil when DIR does not exist rather than signaling. This is the +whole point of the helper: `directory-files' raises file-missing on an +absent directory, and the caller's \"is arch-wiki-docs installed?\" hint +sat below that call, so on the one machine state the hint was written for +it could never be reached." + (when (file-directory-p dir) + (mapcar (lambda (f) (cons (file-name-base f) f)) + (directory-files dir t "\\.html\\'")))) + (defun cj/local-arch-wiki-search () "Prompt for an ArchWiki topic and open its local HTML copy in EWW. -Looks for “*.html” files under \"/usr/share/doc/arch-wiki/html/en\", -lets you complete on their basenames, and displays the chosen file -with `eww-browse-url'. If no file is found, reminds you to install +Looks for “*.html” files under `cj/arch-wiki-html-dir', lets you complete +on their basenames, and displays the chosen file with `eww-browse-url'. +If the directory is missing or empty, reminds you to install arch-wiki-docs." (interactive) - (let* ((dir "/usr/share/doc/arch-wiki/html/en") - (full-filenames (directory-files dir t "\\.html\\'")) - (basenames (mapcar 'file-name-base full-filenames)) - (chosen (completing-read "Choose an ArchWiki Topic: " basenames))) - (if (member chosen basenames) - (let* ((idx (cl-position chosen basenames :test 'equal)) - (fullname (nth idx full-filenames)) - (url (concat "file://" fullname))) - (eww-browse-url url)) - (message "File not found! Is arch-wiki-docs installed?")))) + (let ((topics (cj/--arch-wiki-topics cj/arch-wiki-html-dir))) + (if (null topics) + (message "No ArchWiki topics in %s. Is arch-wiki-docs installed?" + cj/arch-wiki-html-dir) + (let* ((chosen (completing-read "Choose an ArchWiki Topic: " + (mapcar #'car topics))) + (fullname (cdr (assoc chosen topics)))) + (if fullname + (eww-browse-url (concat "file://" fullname)) + (message "No ArchWiki topic named %s" chosen)))))) (keymap-global-set "C-h A" #'cj/local-arch-wiki-search) (provide 'help-utils) diff --git a/modules/host-environment.el b/modules/host-environment.el index 0afb39cb..1c33e342 100644 --- a/modules/host-environment.el +++ b/modules/host-environment.el @@ -138,15 +138,13 @@ find /usr/share/zoneinfo -type f ! -name `posixrules' \\ (defun cj/detect-system-timezone () "Detect the system timezone in IANA format (e.g., `America/Los_Angeles'). -Tries multiple methods in order of reliability: -1. File comparison of /etc/localtime with zoneinfo database -2. Environment variable TZ -3. /etc/timezone file contents -4. /etc/localtime symlink target" +Tries the cheap methods first and the exhaustive scan last: +1. Environment variable TZ (most explicit if set) +2. /etc/timezone file contents (Debian/Ubuntu) +3. /etc/localtime symlink target (O(1) on symlinked systems) +4. File comparison of /etc/localtime against the zoneinfo database + (reads hundreds of files; only needed when localtime is a copy)" (or - ;; Compare file contents (reliable on Arch/modern systems) - (cj/match-localtime-to-zoneinfo) - ;; Environment variable (most explicit if set) (getenv "TZ") @@ -156,12 +154,15 @@ Tries multiple methods in order of reliability: (insert-file-contents "/etc/timezone") (string-trim (buffer-string)))) - ;; Method 4: Parse symlink (fallback for older systems) + ;; Parse the symlink -- O(1), answers on any symlinked /etc/localtime (when (file-symlink-p "/etc/localtime") (let ((target (file-truename "/etc/localtime"))) (when (string-match ".*/zoneinfo/\\(.+\\)" target) (match-string 1 target)))) + ;; Compare file contents -- the last resort for a copied /etc/localtime + (cj/match-localtime-to-zoneinfo) + ;; Default to nil if detection fails nil)) diff --git a/modules/httpd-config.el b/modules/httpd-config.el index 1a2a5c61..a3ae0fac 100644 --- a/modules/httpd-config.el +++ b/modules/httpd-config.el @@ -5,8 +5,9 @@ ;; ;; Layer: 4 (Optional). ;; Category: O/D/P. -;; Load shape: eager. -;; Eager reason: none; local web server, a command-loaded deferral candidate. +;; Load shape: deferred. +;; Defer reason: impatient-mode requires simple-httpd on demand; nothing +;; needs the server (or its www/ root) at startup. ;; Top-level side effects: package configuration via use-package. ;; Runtime requires: none. ;; Direct test load: yes. @@ -17,14 +18,15 @@ ;;;; -------------------------- Simple-Httpd ------------------------- (use-package simple-httpd - :defer 1 + :defer t :preface (defconst cj/httpd-wwwdir (concat user-emacs-directory "www")) (defun cj/httpd-check-or-create-wwwdir () (unless (file-exists-p cj/httpd-wwwdir) (make-directory cj/httpd-wwwdir))) - :init (cj/httpd-check-or-create-wwwdir) :config + ;; Create the doc root only when the server package actually loads. + (cj/httpd-check-or-create-wwwdir) (setq httpd-root cj/httpd-wwwdir) (setq httpd-show-backtrace-when-error t) (setq httpd-serve-files t)) diff --git a/modules/hugo-config.el b/modules/hugo-config.el index b26398c6..36f9e07a 100644 --- a/modules/hugo-config.el +++ b/modules/hugo-config.el @@ -28,6 +28,7 @@ (require 'user-constants) (require 'host-environment) (require 'system-lib) ;; completion table + file annotator +(require 'keybindings) ;; cj/register-prefix-map, cj/custom-keymap ;; --------------------------------- Constants --------------------------------- @@ -247,14 +248,18 @@ to /var/www/cjennings/, so a successful push is the deploy." ;; -------------------------------- Keybindings -------------------------------- -(global-set-key (kbd "C-; h n") #'cj/hugo-new-post) -(global-set-key (kbd "C-; h e") #'cj/hugo-export-post) -(global-set-key (kbd "C-; h o") #'cj/hugo-open-blog-dir) -(global-set-key (kbd "C-; h O") #'cj/hugo-open-blog-dir-external) -(global-set-key (kbd "C-; h d") #'cj/hugo-open-draft) -(global-set-key (kbd "C-; h D") #'cj/hugo-toggle-draft) -(global-set-key (kbd "C-; h p") #'cj/hugo-preview) -(global-set-key (kbd "C-; h P") #'cj/hugo-publish) +(defvar-keymap cj/hugo-keymap + :doc "Keymap for Hugo blog commands" + "n" #'cj/hugo-new-post + "e" #'cj/hugo-export-post + "o" #'cj/hugo-open-blog-dir + "O" #'cj/hugo-open-blog-dir-external + "d" #'cj/hugo-open-draft + "D" #'cj/hugo-toggle-draft + "p" #'cj/hugo-preview + "P" #'cj/hugo-publish) + +(cj/register-prefix-map "h" cj/hugo-keymap) (with-eval-after-load 'which-key (which-key-add-key-based-replacements diff --git a/modules/jumper.el b/modules/jumper.el index 1fbd1293..bfafe08b 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -194,6 +194,10 @@ Returns: \\='no-locations if no locations stored, locations)) (choice (completing-read "Jump to: " locations nil t)) (idx (cdr (assoc choice locations)))) + ;; A UI that permits empty input (no vertico) yields a choice with no + ;; entry; nil would crash the index arithmetic downstream. + (unless idx + (user-error "No matching location")) (jumper--do-jump-to-location idx) (message "Jumped to location"))))) @@ -230,7 +234,8 @@ Returns: \\='no-locations if no locations stored, (jumper--location-candidates)) (locations (cons (cons "Cancel" -1) locations)) (choice (completing-read "Remove location: " locations nil t)) - (idx (cdr (assoc choice locations)))) + ;; Empty input (no matching entry) cancels, same as picking Cancel. + (idx (or (cdr (assoc choice locations)) -1))) (pcase (jumper--do-remove-location idx) ('cancelled (message "Operation cancelled")) ('t (message "Location removed")))))) diff --git a/modules/mail-config.el b/modules/mail-config.el index 297e70d4..b410bf1b 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -127,8 +127,17 @@ transport details in debug buffers." "mbsync" "mu4e mail synchronization" 'mail-config))) (concat (shell-quote-argument mbsync) " -a"))) +(defun cj/mail--send-mail-unavailable (&rest _) + "Signal a descriptive error: no mail transport is configured. +Installed as the send function when msmtp is absent, so a send attempt +explains itself instead of dying with \"invalid function: nil\" (the +top-level defvar pre-empts message.el's default)." + (user-error "Cannot send mail: msmtp not found -- install msmtp to enable sending")) + (defun cj/mail-configure-smtpmail () - "Configure SMTP mail transport when msmtp is available." + "Configure SMTP mail transport when msmtp is available. +With msmtp absent, install `cj/mail--send-mail-unavailable' on both send +variables so the failure at send time names the missing transport." (setq smtpmail-debug-info cj/smtpmail-debug-enabled) (if-let ((msmtp (cj/executable-find-or-warn "msmtp" "SMTP mail sending" 'mail-config))) @@ -136,7 +145,9 @@ transport details in debug buffers." send-mail-function 'message-send-mail-with-sendmail message-send-mail-function 'message-send-mail-with-sendmail message-sendmail-envelope-from 'header) - (setq sendmail-program nil))) + (setq sendmail-program nil + send-mail-function #'cj/mail--send-mail-unavailable + message-send-mail-function #'cj/mail--send-mail-unavailable))) ;; -------------------- HarfBuzz Crash Fix: Disable Composition --------------- ;; Disable auto-composition in mu4e headers to prevent SIGSEGV from HarfBuzz @@ -229,9 +240,6 @@ Prompts user for the action when executing." (setq mu4e-context-policy 'pick-first) ;; start with the first (default) context (setq mu4e-headers-auto-update nil) ;; updating headers buffer on email is too jarring (setq mu4e-root-maildir mail-dir) ;; root directory for all email accounts - (with-suppressed-warnings ((obsolete mu4e-maildir) - (free-vars mu4e-maildir)) - (setq mu4e-maildir mail-dir)) ;; same as above (for newer mu4e) (setq mu4e-sent-messages-behavior 'delete) ;; don't save to "Sent", IMAP does this already (setq mu4e-show-images t) ;; show embedded images ;; (setq mu4e-update-interval 600) ;; check for new mail every 10 minutes (600 seconds) @@ -243,9 +251,6 @@ Prompts user for the action when executing." ;; This will be automatically disabled when org-msg is active (setq mu4e-compose-format-flowed t) - (with-suppressed-warnings ((obsolete mu4e-html2text-command) - (free-vars mu4e-html2text-command)) - (setq mu4e-html2text-command 'mu4e-shr2text)) ;; email conversion to html via shr2text (setq mu4e-mu-binary (executable-find "mu")) (setq mu4e-get-mail-command (cj/mail--mbsync-command)) ;; command to sync mail (with-suppressed-warnings ((obsolete mu4e-user-mail-address-list) @@ -257,22 +262,15 @@ Prompts user for the action when executing." ;; ------------------------------ Mu4e Contexts ------------------------------ + ;; cmail (cjennings.net) is listed first deliberately: `pick-first' makes it + ;; the startup context, matching cmail's primary role everywhere else in the + ;; config (shortcuts, bookmarks, refile). Gmail-first here made gmail the + ;; silent default for the first compose. (mu4e-starred-folder was dropped: + ;; it isn't a mu4e variable, so it never had an effect -- flagged searches + ;; use flag:flagged.) (setq mu4e-contexts (list (make-mu4e-context - :name "gmail.com" - :match-func - (lambda (msg) - (when msg - (string-prefix-p "/gmail" (mu4e-message-field msg :maildir)))) - :vars '((user-mail-address . "craigmartinjennings@gmail.com") - (user-full-name . "Craig Jennings") - (mu4e-drafts-folder . "/gmail/Drafts") - (mu4e-sent-folder . "/gmail/Sent") - (mu4e-starred-folder . "/gmail/Starred") - (mu4e-trash-folder . "/gmail/Trash"))) - - (make-mu4e-context :name "cjennings.net" :match-func (lambda (msg) @@ -285,6 +283,18 @@ Prompts user for the action when executing." (mu4e-trash-folder . "/cmail/Trash"))) (make-mu4e-context + :name "gmail.com" + :match-func + (lambda (msg) + (when msg + (string-prefix-p "/gmail" (mu4e-message-field msg :maildir)))) + :vars '((user-mail-address . "craigmartinjennings@gmail.com") + (user-full-name . "Craig Jennings") + (mu4e-drafts-folder . "/gmail/Drafts") + (mu4e-sent-folder . "/gmail/Sent") + (mu4e-trash-folder . "/gmail/Trash"))) + + (make-mu4e-context :name "deepsat.com" :match-func (lambda (msg) @@ -294,7 +304,6 @@ Prompts user for the action when executing." (user-full-name . "Craig Jennings") (mu4e-drafts-folder . "/dmail/Drafts") (mu4e-sent-folder . "/dmail/Sent") - (mu4e-starred-folder . "/dmail/Starred") (mu4e-trash-folder . "/dmail/Trash"))))) ;; Refile target is computed per message (see `cj/mu4e--refile-folder'), not @@ -348,25 +357,11 @@ Prompts user for the action when executing." ;; ------------------------------ HTML Settings ------------------------------ ;; also see org-msg below - - ;; Prefer HTML over plain text when both are available - (with-suppressed-warnings ((obsolete mu4e-view-prefer-html) - (free-vars mu4e-view-prefer-html)) - (setq mu4e-view-prefer-html t)) - - ;; Use a better HTML renderer with more control - (with-suppressed-warnings ((obsolete mu4e-html2text-command) - (free-vars mu4e-html2text-command)) - (setq mu4e-html2text-command - (cond - ;; Best option: pandoc (if available) - ((executable-find "pandoc") - "pandoc -f html -t plain --reference-links") - ;; Good option: w3m (better tables/formatting) - ((executable-find "w3m") - "w3m -dump -T text/html -cols 72 -o display_link_number=true") - ;; Fallback: built-in shr - (t 'mu4e-shr2text)))) + ;; + ;; The view is shr-based since mu4e 1.7; the old knobs + ;; (mu4e-view-prefer-html, mu4e-html2text-command and its pandoc/w3m + ;; renderer selection) are obsolete and ignored on 1.14, so they were + ;; dropped. HTML display is governed by the shr settings below. ;; Configure shr (built-in HTML renderer) for better display (setq shr-use-colors nil) ; Don't use colors in terminal @@ -407,10 +402,12 @@ Echoes the effective state so there's no guessing what a refresh did." (message "Remote images: %s (this message only)" (if (equal gnus-blocked-images "http") "blocked" "shown"))) - ;; first letter is the keybinding + ;; first letter is the keybinding. No save-attachment action here: + ;; mu4e-view-save-attachments reads MIME parts from the view buffer (and + ;; takes no message argument), so it cannot work from headers -- open the + ;; message and save from the view instead. (setq mu4e-headers-actions - '(("asave attachment" . mu4e-view-save-attachments) - ("csave contact" . mu4e-action-add-org-contact) + '(("csave contact" . mu4e-action-add-org-contact) ("ssearch for sender" . cj/search-for-sender) ("tshow this thread" . mu4e-action-show-thread) ("vview in browser" . mu4e-action-view-in-browser))) @@ -483,12 +480,18 @@ INBOX maildir." (defun cj/--mail-make-account-map (account) "Build a mu4e navigation keymap for ACCOUNT (a maildir account name). Keys i/u/s/l run the inbox/unread/flagged/large searches from -`cj/--mail-account-search-queries', each scoped to ACCOUNT." +`cj/--mail-account-search-queries', each scoped to ACCOUNT. Each command +requires mu4e first: these maps register eagerly at startup, but +`mu4e-search' has no autoload cookie, so a nav key pressed before mu4e's +first launch would otherwise signal void-function. With the feature +loaded, mu4e itself starts the server on demand." (let ((map (make-sparse-keymap))) (dolist (entry (cj/--mail-account-search-queries account) map) (let ((query (cdr entry))) (keymap-set map (car entry) - (lambda () (interactive) (mu4e-search query)))))))) + (lambda () (interactive) + (require 'mu4e) + (mu4e-search query)))))))) ;; ---------------------------------- Org-Msg ---------------------------------- ;; user composes org mode; recipient receives html @@ -577,10 +580,12 @@ Keys i/u/s/l run the inbox/unread/flagged/large searches from ;; turn on org-msg in all compose buffers (org-msg-mode +1)) -(advice-add #'mu4e-compose-reply - :after (lambda (&rest _) (org-msg-edit-mode))) -(advice-add #'mu4e-compose-wide-reply - :after (lambda (&rest _) (org-msg-edit-mode))) +;; No reply advice here: org-msg-post-setup runs on mu4e-compose-mode-hook for +;; every compose (replies included) and applies `org-msg-default-alternatives' +;; itself. The old unconditional org-msg-edit-mode :after advice on the two +;; reply commands forced org-msg onto text-only replies, defeating the +;; (reply-to-text . (text)) alternative above and re-running a major mode +;; org-msg had already set up. ;; which-key labels (with-eval-after-load 'which-key diff --git a/modules/markdown-config.el b/modules/markdown-config.el index 815bb3fb..1d4a8b74 100644 --- a/modules/markdown-config.el +++ b/modules/markdown-config.el @@ -108,8 +108,21 @@ Starts the simple-httpd listener automatically when it isn't already running." ;; stub doesn't collide with this file's own definition of the command ;; (that collision is the "defined multiple times" byte-compile warning). ;; Same key as compile, for consistency. +(defun cj/markdown-toggle-view () + "Toggle the current Markdown buffer between edit and read-only view. +Handles the gfm variants too. The cond checks the most-derived mode +first, since the view modes derive from their edit modes." + (interactive) + (cond + ((derived-mode-p 'markdown-view-mode) (markdown-mode)) + ((derived-mode-p 'gfm-view-mode) (gfm-mode)) + ((derived-mode-p 'gfm-mode) (gfm-view-mode)) + ((derived-mode-p 'markdown-mode) (markdown-view-mode)))) + (with-eval-after-load 'markdown-mode - (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview)) + (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview) + (keymap-set markdown-mode-map "C-c C-x v" #'cj/markdown-toggle-view) + (keymap-set markdown-view-mode-map "C-c C-x v" #'cj/markdown-toggle-view)) (provide 'markdown-config) ;;; markdown-config.el ends here diff --git a/modules/media-utils.el b/modules/media-utils.el index 1abbc1b2..7047411f 100644 --- a/modules/media-utils.el +++ b/modules/media-utils.el @@ -119,8 +119,67 @@ stream URL (see the :needs-stream-url flag in `cj/media-players')." ;; ---------------------- Playing Via Default Media Player --------------------- +(defun cj/media--yt-dlp-argv (url formats) + "The argv to resolve URL's stream address: yt-dlp [-f FORMATS] -g URL. +FORMATS is a prioritized list of yt-dlp format codes, or nil for the +default. URL stays one verbatim argv element, so it never meets a shell." + (append (list "yt-dlp") + (when formats (list "-f" (string-join formats "/"))) + (list "-g" url))) + +(defun cj/media--stream-urls (output) + "The non-empty lines of yt-dlp -g OUTPUT, surrounding whitespace trimmed." + (split-string output "\n" t "[ \t\r]+")) + +(defun cj/media--play-argv (command args urls) + "The argv to play URLS with COMMAND. +ARGS is the player's raw option string from `cj/media-players' (nil for +none); it splits with `split-string-and-unquote' so a quoted option +survives as one word." + (append (list command) + (and args (split-string-and-unquote args)) + urls)) + +(defun cj/media--resolve-stream-urls (url formats) + "Resolve URL to direct stream URLs with a synchronous yt-dlp -g capture. +FORMATS is the player's format-preference list. Only stdout is parsed +for URLs -- yt-dlp's warnings go to stderr, captured separately for the +error message. Signals an error when yt-dlp exits non-zero or resolves +nothing." + (let ((err-file (make-temp-file "yt-dlp-stderr"))) + (unwind-protect + (with-temp-buffer + (let* ((argv (cj/media--yt-dlp-argv url formats)) + (exit (apply #'call-process (car argv) nil + (list t err-file) nil (cdr argv)))) + (unless (and (integerp exit) (zerop exit)) + (error "yt-dlp failed (exit %s): %s" exit + (string-trim + (with-temp-buffer + (insert-file-contents err-file) + (buffer-string))))) + (or (cj/media--stream-urls (buffer-string)) + (error "yt-dlp resolved no stream URL for %s" url)))) + (delete-file err-file)))) + +(defun cj/media--play-sentinel (url-display) + "A process sentinel reporting playback of URL-DISPLAY. +Messages success or failure and reaps the process buffer once the +player finishes or exits." + (lambda (proc event) + (cond + ((string-match-p "finished" event) + (message "✓ Finished playing: %s" url-display)) + ((string-match-p "exited abnormally" event) + (message "✗ Playback failed: %s" url-display))) + (when (string-match-p "finished\\|exited" event) + (kill-buffer (process-buffer proc))))) + (defun cj/media-play-it (url) - "Play the URL with the configured media player in an async process." + "Play the URL with the configured media player in an async process. +A player flagged :needs-stream-url gets the URL resolved first via a +synchronous yt-dlp -g capture (blocks briefly); the player then launches +with a plain argv list -- no shell anywhere in the pipeline." (let* ((player-config (alist-get cj/default-media-player cj/media-players)) (command (plist-get player-config :command)) (args (plist-get player-config :args)) @@ -131,56 +190,52 @@ stream URL (see the :needs-stream-url flag in `cj/media-players')." (unless (executable-find command) (error "%s is not installed or not in PATH" player-name)) + (when needs-stream-url + (unless (executable-find "yt-dlp") + (error "The program yt-dlp is not installed or not in PATH"))) - (let* ((buffer-name (format "*%s: %s*" player-name url-display)) - (shell-command - (if needs-stream-url - ;; Use shell substitution with yt-dlp - (let ((format-string (if yt-dlp-formats - (format "-f %s" - (mapconcat #'shell-quote-argument - yt-dlp-formats - "/")) - ""))) - (format "%s %s $(%s %s -g %s)" - command - (or args "") - "yt-dlp" - format-string - (shell-quote-argument url))) - ;; Direct playback without yt-dlp - (format "%s %s %s" - command - (or args "") - (shell-quote-argument url))))) + (let* ((urls (if needs-stream-url + (progn + (message "Resolving stream URL: %s" url-display) + (cj/media--resolve-stream-urls url yt-dlp-formats)) + (list url))) + (argv (cj/media--play-argv command args urls)) + (buffer-name (format "*%s: %s*" player-name url-display))) (message "Playing with %s: %s" player-name url-display) - (cj/log-silently "DEBUG: Executing: %s" shell-command) - - (let ((process (start-process-shell-command - player-name - buffer-name - shell-command))) - (set-process-sentinel - process - (lambda (proc event) - (cond - ((string-match-p "finished" event) - (message "✓ Finished playing: %s" url-display)) - ((string-match-p "exited abnormally" event) - (message "✗ Playback failed: %s" url-display) - (with-current-buffer (process-buffer proc) - (goto-char (point-min)) - (when (re-search-forward "ERROR:" nil t) - (cj/log-silently "DEBUG: yt-dlp error: %s" - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position))))))) - (when (string-match-p "finished\\|exited" event) - (kill-buffer (process-buffer proc))))))))) + (cj/log-silently "DEBUG: Executing: %s" (string-join argv " ")) + + (let ((process (apply #'start-process player-name buffer-name argv))) + (set-process-sentinel process (cj/media--play-sentinel url-display)))))) ;; ------------------------- Media-Download Via yt-dlp ------------------------- +(defun cj/media--yt-dl-message (event url-display) + "Return the message for tsp EVENT on URL-DISPLAY, or nil when it reports nothing. + +Reports queueing, not completion, and the distinction is the point. +`cj/yt-dl-it' launches \"tsp yt-dlp ...\", and tsp enqueues the job and +exits immediately, so this sentinel fires on tsp's exit rather than +yt-dlp's. A clean exit proves the job was accepted by the spooler and +nothing more, so claiming the download finished would be a guess that is +wrong whenever yt-dlp fails minutes later. Check the spooler with +\"tsp\" for real download status." + (cond + ((string-match-p "finished" event) + (format "✓ Queued for download: %s" url-display)) + ((string-match-p "exited abnormally" event) + (format "✗ Could not queue download: %s" url-display)))) + +(defun cj/media--yt-dl-sentinel (url-display) + "A process sentinel reporting the queueing of URL-DISPLAY. +Messages per `cj/media--yt-dl-message' and reaps the process buffer once +tsp finishes or exits." + (lambda (proc event) + (when-let ((msg (cj/media--yt-dl-message event url-display))) + (message "%s" msg)) + (when (string-match-p "finished\\|exited" event) + (kill-buffer (process-buffer proc))))) + (defun cj/yt-dl-it (url) "Downloads the URL in an async shell." (unless (executable-find "yt-dlp") @@ -194,16 +249,8 @@ stream URL (see the :needs-stream-url flag in `cj/media-players')." (process (start-process "yt-dlp" buffer-name "tsp" "yt-dlp" "--add-metadata" "-ic" "-o" output-template url))) - (message "Started download: %s" url-display) - (set-process-sentinel process - (lambda (proc event) - (cond - ((string-match-p "finished" event) - (message "✓ Finished downloading: %s" url-display)) - ((string-match-p "exited abnormally" event) - (message "✗ Download failed: %s" url-display))) - (when (string-match-p "finished\\|exited" event) - (kill-buffer (process-buffer proc))))))) + (message "Queueing download: %s" url-display) + (set-process-sentinel process (cj/media--yt-dl-sentinel url-display)))) (provide 'media-utils) ;;; media-utils.el ends here. diff --git a/modules/mu4e-attachments.el b/modules/mu4e-attachments.el index 6c2be6fb..56b96b87 100644 --- a/modules/mu4e-attachments.el +++ b/modules/mu4e-attachments.el @@ -100,11 +100,21 @@ size; an unknown candidate annotates as nil so marginalia shows nothing." (require 'mu4e-mime-parts))) (defun cj/mu4e--save-attachment-part (part directory) - "Save attachment PART to DIRECTORY and return the final path." + "Save attachment PART to DIRECTORY and return the final path. +Signals a `user-error' when PART's MIME handle is stale: a handle's car +is the buffer holding the part's bytes, and viewing another message kills +it, so saving through it would error deep in mm-decode or write another +message's content. The staleness check runs before +`cj/mu4e--ensure-attachment-save-functions', like the no-handle check." (let ((handle (plist-get part :handle))) (unless handle (user-error "Attachment has no MIME handle: %s" (or (plist-get part :filename) "<unnamed>"))) + (when (and (consp handle) + (bufferp (car handle)) + (not (buffer-live-p (car handle)))) + (user-error "Attachment %s is stale (the message view changed) -- reopen the message and save again" + (or (plist-get part :filename) "<unnamed>"))) (cj/mu4e--ensure-attachment-save-functions) (let* ((path (funcall mu4e-uniquify-save-file-name-function (mu4e-join-paths directory diff --git a/modules/mu4e-org-contacts-integration.el b/modules/mu4e-org-contacts-integration.el index 6062b8cf..a143bdc4 100644 --- a/modules/mu4e-org-contacts-integration.el +++ b/modules/mu4e-org-contacts-integration.el @@ -22,6 +22,7 @@ ;; isolation doesn't warn about free variables / undefined functions; the ;; actual definitions live where named. (eval-when-compile (defvar contacts-file)) ; user-constants.el +(defvar mu4e-compose-complete-addresses) ; mu4e-compose.el (lazy) (declare-function cj/get-all-contact-emails ; org-contacts-config.el "org-contacts-config" ()) @@ -59,13 +60,10 @@ In email header fields (To, Cc, Bcc), complete using org-contacts. Elsewhere, perform the default TAB action." (interactive) (cond - ;; In email header fields, use completion-at-point + ;; In email header fields, use completion-at-point (it both starts a new + ;; completion and cycles an in-progress one, so no mode check is needed). ((mail-abbrev-in-expansion-header-p) - (if (and (boundp 'completion-in-region-mode) completion-in-region-mode) - ;; If we're already in completion mode, cycle through candidates - (completion-at-point) - ;; Start new completion - (completion-at-point))) + (completion-at-point)) ;; In org-msg-edit-mode body, use org-cycle ((and (eq major-mode 'org-msg-edit-mode) (not (mail-abbrev-in-expansion-header-p))) @@ -157,10 +155,10 @@ This bypasses the completion-at-point system for direct selection." ;; Setup hooks for org-msg-edit-mode (HTML email composition) (with-eval-after-load 'org-msg (add-hook 'org-msg-edit-mode-hook #'cj/mu4e-org-contacts-compose-setup)) - - ;; Remove any existing mu4e completion setup - (remove-hook 'mu4e-compose-mode-hook #'mu4e--compose-setup-completion) - + + ;; No hook surgery on mu4e--compose-setup-completion: mu4e 1.14 calls it + ;; directly during compose setup (never via this hook), and it is already + ;; gated by the `mu4e-compose-complete-addresses' nil above. (message "mu4e org-contacts integration activated")) (defun cj/deactivate-mu4e-org-contacts-integration () @@ -170,11 +168,11 @@ This bypasses the completion-at-point system for direct selection." ;; Remove our hooks (remove-hook 'mu4e-compose-mode-hook #'cj/mu4e-org-contacts-compose-setup) (remove-hook 'org-msg-edit-mode-hook #'cj/mu4e-org-contacts-compose-setup) - - ;; Re-enable mu4e's built-in completion if desired + + ;; Re-enable mu4e's built-in completion: the var is enough, since mu4e's + ;; compose setup calls its completion function directly, gated on this. (setq mu4e-compose-complete-addresses t) - (add-hook 'mu4e-compose-mode-hook #'mu4e--compose-setup-completion) - + (message "mu4e org-contacts integration deactivated")) (provide 'mu4e-org-contacts-integration) diff --git a/modules/music-config.el b/modules/music-config.el index 3559930b..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 / @@ -86,7 +86,9 @@ falls back to the plain text player (names, a dim glyph, a thin status line)." :group 'cj/music) (defcustom cj/music-title-family - (if (boundp 'cj/nov-reading-font-family) cj/nov-reading-font-family "Merriweather") + (if (fboundp 'cj/font-profile-properties) + (plist-get (cj/font-profile-properties 'reading) :default-family) + "Merriweather") "Serif family for the fancy now-playing title, mirroring the nov reading view." :type 'string :group 'cj/music) @@ -306,7 +308,9 @@ Directories are suffixed with /; files are plain. Hidden dirs/files skipped." "Completion table for CANDIDATES preserving order and case-insensitive match. Tags the `cj-music-file' category and annotates each candidate (a path relative to `cj/music-root', with a trailing slash for directories) with its size and -modification date so marginalia can show them." +modification date so marginalia can show them. The category is registered +with marginalia (builtin) so the annotations render right-aligned." + (cj/completion-ensure-marginalia-align 'cj-music-file) (let ((annotate (cj/completion-file-annotator (lambda (c) (expand-file-name @@ -322,19 +326,177 @@ modification date so marginalia can show them." (completion-ignore-case . t)) (complete-with-action action candidates string pred))))) +(defun cj/music--playlist-open-position (buffer) + "Return where point should land when the playlist BUFFER is displayed. +The beginning of the playing track's line when a song is playing (during +playback the selected track is the playing one), else the top of the +list. Keying off the selected track alone is wrong: EMMS keeps a stale +selection while stopped, which used to open the playlist deep in the list +at whatever played last." + (with-current-buffer buffer + (if (and (boundp 'emms-player-playing-p) emms-player-playing-p + (boundp 'emms-playlist-selected-marker) + (markerp emms-playlist-selected-marker) + (marker-position emms-playlist-selected-marker) + (eq (marker-buffer emms-playlist-selected-marker) (current-buffer))) + (save-excursion + (goto-char emms-playlist-selected-marker) + (line-beginning-position)) + (point-min)))) + +(defun cj/music--playlist-land-point (win buffer) + "Move WIN's point in BUFFER per the open-position rule and settle the view. +When a song is playing its row lands in the window's upper third, so the +upcoming tracks fill the space below it. When stopped, the view starts at +the top of the list. Point sits at the beginning of its line either way, +so the row reads left-to-right from its number." + (let ((pos (cj/music--playlist-open-position buffer))) + (set-window-point win pos) + (if (> pos (with-current-buffer buffer (point-min))) + (with-selected-window win + (with-current-buffer buffer + (recenter (max 1 (/ (window-body-height) 3))))) + (set-window-start win pos)))) + +(defun cj/music--pin-point-to-bol () + "Keep the playlist cursor in the number gutter (column 0). +The rows are rendered track lines, not editable text: the cursor's home is +the number, and operations on a track (kill, shift, play) act on its row +wherever point sits. Vertical motion over thumbnails and the stretch-space +that right-aligns the metadata drifts point to arbitrary visual columns +(usually line end), so this runs on the buffer-local `post-command-hook' +and snaps every landing back to the row start. An active isearch owns +point until it ends; the snap lands when the search exits." + (unless (or (bolp) (bound-and-true-p isearch-mode)) + (beginning-of-line)) + (cj/music--highlight-current-number)) + +(defvar-local cj/music--renumber-timer nil + "Pending idle timer for the playlist row renumber, or nil.") + +;; Forward declaration: the real `defvar-local' is a few defuns below, next to +;; the highlight helper that owns it. Declared special here so the setq in this +;; function compiles as a dynamic binding, not a free-variable warning. +(defvar cj/music--current-number-overlay) + +(defun cj/music--renumber-rows (&optional buffer) + "Number every playlist row in BUFFER (default: current buffer) via overlays. +Each non-blank line gets an \"NNN \" before-string so the cursor stays +visible when it sits on a cover-art thumbnail and the row's position in +the list is readable at a glance. Overlays rebuild from scratch, so the +numbering survives kills, inserts, and reorders; the buffer text itself is +untouched (EMMS owns it). A dead BUFFER is a silent no-op, since the +debounce timer can outlive the playlist buffer." + (let ((buf (or buffer (current-buffer)))) + (when (buffer-live-p buf) + (with-current-buffer buf + (remove-overlays (point-min) (point-max) 'cj-music-row-number t) + (save-excursion + (goto-char (point-min)) + (let ((n 0)) + (while (not (eobp)) + (unless (looking-at-p "[ \t]*$") + (setq n (1+ n)) + ;; Span one char rather than zero: `overlays-in' (and so + ;; `remove-overlays') can miss an empty overlay sitting + ;; exactly at the region start. + (let ((ov (make-overlay (line-beginning-position) + (1+ (line-beginning-position))))) + (overlay-put ov 'cj-music-row-number t) + ;; Outrank the header overlay (priority 100): both anchor + ;; strings at position 1 on row 1, and without this the + ;; row's number renders above the header block instead of + ;; beside its own track. + (overlay-put ov 'priority 200) + (overlay-put ov 'before-string + (cj/music--number-string (format "%3d " n) nil)))) + (forward-line 1)))) + ;; The rebuild deleted the marked overlay; re-mark the current row. + (setq cj/music--current-number-overlay nil) + (cj/music--highlight-current-number))))) + +(defvar-local cj/music--current-number-overlay nil + "The number overlay currently rendered as the you-are-here mark, or nil.") + +(defun cj/music--number-string (text current) + "Build the number-gutter display string from TEXT. +CURRENT non-nil renders it inverse video (the you-are-here mark). The +single place the gutter string's properties live: the face, and the +cursor property that makes redisplay draw the cursor on the number +instead of invisibly on the album art after it." + (propertize text + 'face (if current + '(:inherit cj/music-keyhint-face :inverse-video t) + 'cj/music-keyhint-face) + 'cursor t)) + +(defun cj/music--set-number-face (ov current) + "Re-render number overlay OV's string; CURRENT non-nil marks it inverse. +Keeps the text, swaps only the rendering (see `cj/music--number-string')." + (let ((s (overlay-get ov 'before-string))) + (overlay-put ov 'before-string + (cj/music--number-string (substring-no-properties s) current)))) + +(defun cj/music--highlight-current-number () + "Render the current row's number in inverse video, restoring the last one. +The block cursor draws only in the selected window, and the playlist dock +is glanced at from other windows constantly, so the number itself carries +the you-are-here mark -- visible whether or not the window has focus." + (let ((ov (seq-find (lambda (o) (overlay-get o 'cj-music-row-number)) + (overlays-in (line-beginning-position) + (min (1+ (line-beginning-position)) (point-max)))))) + (unless (eq ov cj/music--current-number-overlay) + (when (and (overlayp cj/music--current-number-overlay) + (overlay-buffer cj/music--current-number-overlay)) + (cj/music--set-number-face cj/music--current-number-overlay nil)) + (setq cj/music--current-number-overlay ov) + (when ov + (cj/music--set-number-face ov t))))) + +(defun cj/music--schedule-renumber (&rest _) + "Debounced renumber of the current playlist buffer after a text change. +Wired buffer-locally into `after-change-functions' by +`cj/music--ensure-playlist-buffer'; the idle delay coalesces a burst of +inserts or kills into one renumber pass." + (when (timerp cj/music--renumber-timer) + (cancel-timer cj/music--renumber-timer)) + (setq cj/music--renumber-timer + (run-with-idle-timer 0.2 nil #'cj/music--renumber-rows (current-buffer)))) + (defun cj/music--ensure-playlist-buffer () "Ensure EMMS playlist buffer exists and is in playlist mode. Return buffer." (let ((buffer (get-buffer-create cj/music-playlist-buffer-name))) (with-current-buffer buffer (unless (eq major-mode 'emms-playlist-mode) (emms-playlist-mode)) - (setq emms-playlist-buffer-p t)) + (setq emms-playlist-buffer-p t) + ;; Row numbering: renumber after every playlist change, debounced. + (add-hook 'after-change-functions #'cj/music--schedule-renumber nil t) + ;; The highlighted row stays findable even when the cursor sits on + ;; album art (pairs with the row-number prefixes). + (hl-line-mode 1) + ;; Gutter cursor: point lives at the row start (the number column). + (add-hook 'post-command-hook #'cj/music--pin-point-to-bol nil t) + ;; Logical-line motion: the multi-line header overlay string at + ;; position 1 otherwise absorbs next-line from the top row (vertical + ;; motion walks the header's screen lines, which all map back to the + ;; same buffer position, so arrows look dead). Rows are one logical + ;; line each; visual movement buys nothing here. + (setq-local line-move-visual nil) + ;; Sticky header: re-anchor the header block at the window start on + ;; every scroll, so it stays frozen while the list scrolls under it. + (add-hook 'window-scroll-functions #'cj/music--stick-header nil t)) + (cj/music--renumber-rows buffer) ;; Set this as the current EMMS playlist buffer (setq emms-playlist-buffer buffer) buffer)) (defun cj/music--m3u-file-tracks (m3u-file) - "Return list of absolute track paths from M3U-FILE. Ignore # comment lines." + "Return list of absolute track paths from M3U-FILE. Ignore # comment lines. +Stream URLs pass through untouched; a local path must carry an accepted +music extension (`cj/music--valid-file-p') -- old playlists saved before +directory adds were filtered can carry cover.jpg lines, and loading one +would put the cover right back in the playlist." (when (and m3u-file (file-exists-p m3u-file)) (with-temp-buffer (insert-file-contents m3u-file) @@ -344,11 +506,12 @@ modification date so marginalia can show them." (while (re-search-forward "^[^#].*$" nil t) (let ((line (string-trim (match-string 0)))) (unless (string-empty-p line) - (push (if (or (file-name-absolute-p line) - (string-match-p "\\`\\(https?\\|mms\\)://" line)) - line - (expand-file-name line dir)) - tracks)))) + (let* ((url-p (string-match-p "\\`\\(https?\\|mms\\)://" line)) + (path (cond (url-p line) + ((file-name-absolute-p line) line) + (t (expand-file-name line dir))))) + (when (or url-p (cj/music--valid-file-p path)) + (push path tracks)))))) (nreverse tracks))))) (defun cj/music--playlist-track-objects () @@ -435,17 +598,51 @@ Returns the full path to the selected file, or nil if cancelled." (unless (string= choice "(Cancel)") (cdr (assoc choice m3u-files))))) +(defun cj/music--delete-playlist-file (path) + "Delete the playlist file at PATH. +Signals a `user-error' when PATH is nil or missing. When the playlist +buffer's associated file is PATH, the association is cleared (the in-memory +queue is untouched). Refreshes the radio metadata cache since an .m3u just +left the roots." + (unless (and path (file-exists-p path)) + (user-error "Playlist file does not exist: %s" + (if path (file-name-nondirectory path) "nil"))) + (delete-file path) + (with-current-buffer (cj/music--ensure-playlist-buffer) + (when (equal cj/music-playlist-file path) + (setq cj/music-playlist-file nil))) + (cj/music--refresh-radio-name-map)) + ;;; Commands: add/select +(defun cj/music--music-files-recursive (directory) + "Return sorted absolute paths of the music files under DIRECTORY. +Only files passing `cj/music--valid-file-p' (the accepted extensions in +`cj/music-file-extensions') come back; hidden files and hidden +directories are skipped. This is the filter the directory-add commands +route through -- handing the raw tree to EMMS added every file it found, +so cover art and liner notes ended up as playlist rows." + (sort (seq-filter #'cj/music--valid-file-p + (directory-files-recursively + directory "\\`[^.]" nil + (lambda (dir) + (not (string-prefix-p "." (file-name-nondirectory dir)))))) + #'string-lessp)) + (defun cj/music-add-directory-recursive (directory) - "Add all music files under DIRECTORY recursively to the EMMS playlist." + "Add all music files under DIRECTORY recursively to the EMMS playlist. +Only files with accepted music extensions are added; cover art and other +non-music files in album directories stay out." (interactive (list (read-directory-name "Add directory recursively: " cj/music-root nil t))) (unless (file-directory-p directory) (user-error "Not a directory: %s" directory)) (cj/music--ensure-playlist-buffer) - (emms-add-directory-tree directory) - (message "Added recursively: %s" directory)) + (let ((files (cj/music--music-files-recursive directory))) + (dolist (f files) + (emms-add-file f)) + (message "Added %d music file%s from %s" + (length files) (if (= (length files) 1) "" "s") directory))) (defun cj/music-fuzzy-select-and-add () @@ -480,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 @@ -597,6 +815,10 @@ ENTRIES. Nil when neither applies (the caller falls back to a timestamp)." (plist-get (cdr (assoc (emms-track-name tr) entries)) :name))))) +;; Forward declaration: the real `defvar' lives with the radio config block far +;; below. Declared special here so this reference compiles clean. +(defvar cj/music-radio-save-dir) + (defun cj/music--save-directory (tracks) "Directory a saved playlist targets. An all-stream queue is a radio playlist and saves into @@ -632,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) @@ -664,6 +886,23 @@ reloaded playlist keeps its display name and cover art." (message "Reloaded playlist: %s" name))) +(defun cj/music-delete-playlist () + "Delete an .m3u playlist file after strong confirmation. +Candidates are the playlists `cj/music-playlist-load' offers -- every +directory in `cj/music-m3u-roots' (the local library and MPD's playlist +dir). Deleting the loaded playlist's file keeps the in-memory queue but +clears its file association." + (interactive) + (let ((file (cj/music--select-m3u-file "Delete playlist: "))) + (if (not file) + (message "Playlist deletion cancelled") + (unless (cj/confirm-destructive (format "Delete playlist %s? " + (file-name-nondirectory file))) + (user-error "Aborted deleting playlist")) + (cj/music--delete-playlist-file file) + (message "Deleted playlist: %s" (file-name-nondirectory file))))) + + (defun cj/music-playlist-edit () "Open the playlist's M3U file in other window, prompting to save if modified." (interactive) @@ -775,11 +1014,13 @@ Intended for use on `emms-player-finished-hook'." ) -(defvar cj/music-playlist-window-height 0.3 +(defvar cj/music-playlist-window-height 0.5 "Default fraction of frame height for the F10 music playlist side window. -Used when the playlist hasn't been resized and toggled off this session; -after that, the toggled-off height is remembered in -`cj/--music-playlist-height'.") +Half the frame, so a playlist of real length shows enough rows (a third +still read too short in practice). Used when the playlist hasn't been +resized and toggled off this session; after that, the toggled-off height +is remembered in `cj/--music-playlist-height' -- but only when it's at +least this default (see the discard in `cj/music-playlist-toggle').") (defvar cj/--music-playlist-height nil "Last height fraction the playlist was toggled off at. @@ -802,6 +1043,13 @@ resized and toggled off this session, it reopens at that remembered height." (if win (progn (cj/side-window-capture-size win 'bottom 'cj/--music-playlist-height) + ;; Remember enlargements only. Window churn (another side window + ;; opening) squeezes the dock, and remembering the squeeze reopens + ;; it too short on every later toggle. A deliberate shrink is the + ;; rare case; losing it costs one resize. + (when (and (numberp cj/--music-playlist-height) + (< cj/--music-playlist-height cj/music-playlist-window-height)) + (setq cj/--music-playlist-height nil)) (delete-window win) (message "Playlist window closed")) (progn @@ -811,11 +1059,7 @@ resized and toggled off this session, it reopens at that remembered height." buffer 'bottom 'cj/--music-playlist-height cj/music-playlist-window-height)) (select-window win) - (with-current-buffer buffer - (if (and (fboundp 'emms-playlist-current-selected-track) - (emms-playlist-current-selected-track)) - (emms-playlist-mode-center-current) - (goto-char (point-min)))) + (cj/music--playlist-land-point win buffer) (let ((count (with-current-buffer buffer (count-lines (point-min) (point-max))))) (message (if (> count 0) @@ -833,7 +1077,9 @@ Initializes EMMS if needed." (when buffer-exists (with-current-buffer cj/music-playlist-buffer-name (setq has-content (> (point-max) (point-min))))) - (switch-to-buffer (cj/music--ensure-playlist-buffer)) + (let ((buffer (cj/music--ensure-playlist-buffer))) + (switch-to-buffer buffer) + (cj/music--playlist-land-point (selected-window) buffer)) (cond ((not emms-was-loaded) (message "EMMS started. Current playlist empty")) ((and buffer-exists has-content) (message "EMMS running. Displaying current playlist")) @@ -848,9 +1094,10 @@ Dirs added recursively." (unless (derived-mode-p 'dired-mode) (user-error "This command must be run in a Dired buffer")) (cj/music--ensure-playlist-buffer) - (let ((files (if (use-region-p) - (dired-get-marked-files) - (list (dired-get-file-for-visit))))) + ;; dired-get-marked-files already honors m-marks, an active region, or the + ;; file at point; gating it behind use-region-p silently dropped all but + ;; the point file whenever files were marked without a region. + (let ((files (dired-get-marked-files))) (when (null files) (user-error "No files selected")) (dolist (file files) @@ -1160,12 +1407,12 @@ The rule uses a resize-safe :align-to span, not a hardcoded character count." (propertize "Mode " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) (funcall mode-indicator "r" "repeat" (bound-and-true-p emms-repeat-playlist)) " " - (funcall mode-indicator "s" "single" (bound-and-true-p emms-repeat-track)) " " + (funcall mode-indicator "1" "single" (bound-and-true-p emms-repeat-track)) " " (funcall mode-indicator "z" "random" (bound-and-true-p emms-random-playlist)) " " (funcall mode-indicator "x" "consume" cj/music-consume-mode) "\n" (propertize "Keys " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) - (propertize "a:add c:clear L:load v:save S:stop SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" + (propertize "a:add c:clear L:load s:save D:delete SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" 'face 'cj/music-keyhint-face) "\n" (propertize "Radio " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) @@ -1217,14 +1464,51 @@ the controls." (cj/music--fancy-header) (cj/music--text-header))) +(defun cj/music--header-anchor-position () + "Return the position the header overlay should anchor at right now. +The start of the displaying window when the playlist is shown (so the +header stays at the top of the window while the list scrolls under it), +else the top of the buffer. Searches all frames -- the refresh timer can +run with any frame selected, and missing a window on another frame would +anchor at the buffer top and yank a scrolled header back." + (if-let ((win (get-buffer-window (current-buffer) t))) + (max (point-min) (min (window-start win) (point-max))) + (point-min))) + +(defun cj/music--stick-header (win start) + "Re-anchor the header overlay at START, WIN's new display start. +Runs on the buffer-local `window-scroll-functions', so every scroll pins +the header block to the top of the window and the track list scrolls +beneath it. Converges: an already-anchored header is a no-op, so the +redisplay this move triggers doesn't loop. Always returns nil." + (with-current-buffer (window-buffer win) + (when (and (overlayp cj/music--header-overlay) + (overlay-buffer cj/music--header-overlay) + (integer-or-marker-p start)) + (let ((pos (max (point-min) (min start (point-max))))) + (unless (= (overlay-start cj/music--header-overlay) pos) + (move-overlay cj/music--header-overlay pos pos)))) + nil)) + +(defun cj/music--refresh-header-after-toggle (&rest _) + "Refresh the playlist header after a repeat/random/consume toggle. +Named (not an anonymous lambda) so the :config reload can advice-remove +it before re-adding -- anonymous advice stacks a copy per reload." + (cj/music--update-header)) + (defun cj/music--update-header () - "Insert or update the multi-line header overlay in the playlist buffer." + "Insert or update the multi-line header overlay in the playlist buffer. +Anchors at the displaying window's start (see +`cj/music--header-anchor-position') -- the refresh timer calls this every +second, and re-anchoring at the buffer top would yank the sticky header +away whenever the list is scrolled." (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) (with-current-buffer buf (unless cj/music--header-overlay (setq cj/music--header-overlay (make-overlay (point-min) (point-min))) (overlay-put cj/music--header-overlay 'priority 100)) - (move-overlay cj/music--header-overlay (point-min) (point-min)) + (let ((pos (cj/music--header-anchor-position))) + (move-overlay cj/music--header-overlay pos pos)) (overlay-put cj/music--header-overlay 'before-string (cj/music--header-text))))) @@ -1344,19 +1628,22 @@ unless fancy." (add-hook 'emms-player-stopped-hook #'cj/music--stop-bar-timer) (add-hook 'emms-player-finished-hook #'cj/music--stop-bar-timer) - ;; Refresh header immediately when toggling modes + ;; Refresh header immediately when toggling modes. Named advice with a + ;; remove-then-add guard (like the emms-playlist-clear advice above): + ;; an anonymous lambda can't be advice-removed and stacks a copy on every + ;; :config reload, firing the refresh N times per toggle. (dolist (fn '(emms-toggle-repeat-playlist emms-toggle-repeat-track emms-toggle-random-playlist cj/music-toggle-consume)) - (advice-add fn :after (lambda (&rest _) (cj/music--update-header)))) + (advice-remove fn #'cj/music--refresh-header-after-toggle) + (advice-add fn :after #'cj/music--refresh-header-after-toggle)) :bind (:map emms-playlist-mode-map ;; Playback ("p" . emms-playlist-mode-go) ("SPC" . emms-pause) - ("s" . emms-stop) ("n" . cj/music-next) (">" . cj/music-next) ("P" . cj/music-previous) @@ -1379,9 +1666,9 @@ unless fancy." ("c" . cj/music-playlist-clear) ("C" . cj/music-playlist-clear) ("L" . cj/music-playlist-load) + ("D" . cj/music-delete-playlist) ("E" . cj/music-playlist-edit) ("g" . cj/music-playlist-reload) - ("v" . cj/music-playlist-save) ;; Track reordering ("S-<up>" . emms-playlist-mode-shift-track-up) ("S-<down>" . emms-playlist-mode-shift-track-down) @@ -1434,6 +1721,15 @@ On a connection failure the client falls back to a host from /json/servers.") "User-Agent sent with radio-browser requests. The project asks clients to identify themselves.") +(defvar cj/music-radio-tag-limit 500 + "Maximum number of tags fetched from radio-browser for tag completion. +The /json/tags endpoint is fetched ordered by station count, so the limit +keeps the popular tags and drops the long tail of one-station noise tags.") + +(defvar cj/music-radio--tags-cache nil + "Session cache of radio-browser tag names, or nil before the first fetch. +A failed fetch leaves it nil so the next tag search retries.") + (defvar cj/music-radio-search-limit 30 "Maximum number of stations a radio-browser search returns.") @@ -1504,14 +1800,16 @@ TAGS is a comma-separated string or nil; nil or empty yields the empty string." (defun cj/music-radio--format-candidate (st) "Marginalia annotation for station ST. -Variant B: codec, bitrate, country, votes, and the first few tags." +Variant B: codec, bitrate, country, votes, and the first few tags. Every +field pads to a fixed width (votes included) so the listing reads as +aligned columns across stations." (let ((codec (or (plist-get st :codec) "")) (bitrate (let ((b (plist-get st :bitrate))) (if (and (integerp b) (> b 0)) (format "%dk" b) ""))) (cc (or (plist-get st :countrycode) "")) (votes (or (plist-get st :votes) 0)) (tags (cj/music-radio--tags-snippet (plist-get st :tags) 3))) - (format "%-4s %-5s %-2s ♥%d %s" codec bitrate cc votes tags))) + (format "%-4s %-5s %-2s %-7s %s" codec bitrate cc (format "♥%d" votes) tags))) (defun cj/music-radio--search-url (server query &optional field) "Build the radio-browser station-search URL for QUERY against SERVER. @@ -1571,23 +1869,21 @@ to one station. Pure helper." (push (cons disp st) out))))) (defun cj/music-radio--completion-table (candidates) - "Completion table over CANDIDATES carrying the Variant-B marginalia affix." + "Completion table over CANDIDATES carrying the Variant-B annotation. +Tagged `cj-radio-station' and registered with marginalia (builtin), so the +codec/bitrate/country/votes/tags annotation renders right-aligned like the +stock categories. The \"[done]\" sentinel has no station and annotates as +nil rather than a bogus zero row." + (cj/completion-ensure-marginalia-align 'cj-radio-station) (lambda (string pred action) (if (eq action 'metadata) `(metadata (category . cj-radio-station) - (affixation-function - . ,(lambda (cands) - (mapcar (lambda (c) - (let ((st (cdr (assoc c candidates)))) - ;; The "[done]" sentinel has no station, so it gets - ;; no annotation rather than a bogus "0" row. - (list c "" (if st - (concat " " - (propertize (cj/music-radio--format-candidate st) - 'face 'completions-annotations)) - "")))) - cands)))) + (annotation-function + . ,(lambda (c) + (when-let ((st (cdr (assoc c candidates)))) + (concat " " (propertize (cj/music-radio--format-candidate st) + 'face 'completions-annotations)))))) (complete-with-action action (mapcar #'car candidates) string pred)))) (defun cj/music-radio--pick-loop (candidates) @@ -1617,8 +1913,10 @@ bitrate, country, votes, and tags), lets you pick several one at a time, adds each to the playlist as a url track carrying its station metadata, and plays the first pick (interrupting whatever was playing). Nothing is written to disk; save the queue with the normal playlist save, where the station name -pre-fills the prompt." - (when (string-empty-p (string-trim query)) +pre-fills the prompt. QUERY is trimmed of surrounding whitespace first -- +a stray trailing space otherwise reaches the API as %20 and matches nothing." + (setq query (string-trim query)) + (when (string-empty-p query) (user-error "Empty search")) (cj/emms--setup) (let* ((stations (cj/music-radio--search query field)) @@ -1650,9 +1948,44 @@ pre-fills the prompt." (interactive "sRadio search (name): ") (cj/music-radio--search-and-play query "name")) +(defun cj/music-radio--tags-url (server) + "Build the radio-browser tag-list URL against SERVER. +Ordered by station count descending so the limit keeps the popular tags." + (format "https://%s/json/tags?order=stationcount&reverse=true&limit=%d" + server cj/music-radio-tag-limit)) + +(defun cj/music-radio--parse-tags (json-text) + "Parse a radio-browser JSON-TEXT tag array into a clean list of tag names. +Names come back whitespace-trimmed with empties and duplicates dropped -- +the source data is user-generated and carries all three. Signals +`user-error' on unreadable JSON (via `cj/music-radio--parse-search')." + (let ((names '())) + (dolist (tag (cj/music-radio--parse-search json-text)) + (let ((name (string-trim (or (plist-get tag :name) "")))) + (unless (or (string-empty-p name) (member name names)) + (push name names)))) + (nreverse names))) + +(defun cj/music-radio--available-tags () + "Return cached radio-browser tag names, fetching once per session. +Returns nil when the fetch or parse fails, leaving the cache empty so a +later call retries; the tag prompt then falls back to free-form input." + (or cj/music-radio--tags-cache + (setq cj/music-radio--tags-cache + (ignore-errors + (when-let ((body (cj/music-radio--http-get + (cj/music-radio--tags-url cj/music-radio-server)))) + (cj/music-radio--parse-tags body)))))) + (defun cj/music-radio-search-by-tag (tag) - "Search radio-browser.info by tag/genre, then queue and play a selection." - (interactive "sRadio search (tag): ") + "Search radio-browser.info by tag/genre, then queue and play a selection. +The prompt completes over the popular tags fetched from radio-browser +\(cached per session), so you pick from tags that exist instead of +guessing. Free-form input still works for an unlisted tag, and the prompt +degrades to plain input when the tag fetch fails." + (interactive + (list (completing-read "Radio search (tag): " + (cj/music-radio--available-tags)))) (cj/music-radio--search-and-play tag "tag")) ;; ------------------------------- Cover art ----------------------------------- @@ -1789,14 +2122,15 @@ when there is nothing to fetch." (message "Cleared music art cache: %s" cj/music-art-cache-dir)) ;; Radio row in the playlist buffer: n = search by name, t = search by tag, -;; m = enter a station by hand. This moves the "single" mode toggle off t to s -;; and emms-stop off s to S (see the header's Mode/Keys/Radio rows). +;; m = enter a station by hand. Single-track mode is on 1 and s saves the +;; playlist; stop was dropped (SPC/pause covers it). These run after +;; use-package's :map, so they win (see the header's Mode/Keys/Radio rows). (with-eval-after-load 'emms (keymap-set emms-playlist-mode-map "n" #'cj/music-radio-search-by-name) (keymap-set emms-playlist-mode-map "t" #'cj/music-radio-search-by-tag) (keymap-set emms-playlist-mode-map "m" #'cj/music-create-radio-station) - (keymap-set emms-playlist-mode-map "s" #'emms-toggle-repeat-track) - (keymap-set emms-playlist-mode-map "S" #'emms-stop)) + (keymap-set emms-playlist-mode-map "1" #'emms-toggle-repeat-track) + (keymap-set emms-playlist-mode-map "s" #'cj/music-playlist-save)) (provide 'music-config) ;;; music-config.el ends here diff --git a/modules/nov-reading.el b/modules/nov-reading.el index 636a2f53..3af8721c 100644 --- a/modules/nov-reading.el +++ b/modules/nov-reading.el @@ -10,7 +10,7 @@ ;; keymap reference; the faces must exist for theme-studio's inventory too. ;; Top-level side effects: defface x9 (3 palettes + per-palette heading/link), ;; defcustoms, a defgroup, a defvar. -;; Runtime requires: none (face-remap and text-scale are built in). +;; Runtime requires: font-profiles (shared workflow profile data). ;; Direct test load: yes. ;; ;; A small theme layer on top of the stock `nov' package (no fork): how an EPUB @@ -20,8 +20,9 @@ ;; - Reading palette -- the background + foreground, as sepia / dark / light, ;; each a face the dupre theme / theme-studio own (registered as the ;; "nov-reading" bespoke app in theme-studio's face_data.py). -;; - Typography -- a serif family and a base height, with +/-/= adjusting the -;; page font size live via a buffer-local text-scale on top of the base. +;; - Typography -- the shared Reading font profile and a nov-specific base +;; height, with +/-/= adjusting the page font size live via a buffer-local +;; text-scale on top of the base. ;; The live size is remembered globally, so every book opens where you left ;; it; "=" returns to the base height. ;; @@ -31,6 +32,8 @@ ;;; Code: +(require 'font-profiles) + (defgroup cj/nov-reading nil "Reading-view theming for nov-mode EPUBs." :group 'cj) @@ -194,9 +197,9 @@ Interactively prompts among `cj/nov-reading-palettes' plus \"none\"." ;; ------------------------------- Typography ---------------------------------- -(defcustom cj/nov-reading-font-family "Merriweather" - "Variable-pitch serif family for the EPUB reading view." - :type 'string +(defcustom cj/nov-reading-profile 'reading + "Shared font profile applied buffer-locally to the EPUB reading view." + :type 'symbol :group 'cj/nov-reading) (defcustom cj/nov-reading-text-height 180 @@ -214,6 +217,9 @@ returns to this base." A single integer: the buffer-local `text-scale-mode-amount' the +/-/= keys last set, applied on top of `cj/nov-reading-text-height' when a book opens.") +(defvar-local cj/nov--typography-remap-cookies nil + "Face-remap cookies for the shared font profile in this nov buffer.") + (defun cj/nov-reading--parse-text-scale (s) "Parse S (a string or nil) as an integer text-scale offset; 0 when invalid. Surrounding whitespace is tolerated; non-integer content yields 0." @@ -239,15 +245,11 @@ Creates the data directory when absent." (insert (number-to-string amount)))) (defun cj/nov-reading-apply-typography () - "Apply the reading family and base height buffer-local. -Remaps `variable-pitch', `default', and `fixed-pitch' so nov's shr output reads -as a comfortably-sized serif page." - (face-remap-add-relative 'variable-pitch - :family cj/nov-reading-font-family :height 1.0) - (face-remap-add-relative 'default - :family cj/nov-reading-font-family - :height cj/nov-reading-text-height) - (face-remap-add-relative 'fixed-pitch :height cj/nov-reading-text-height)) + "Apply the shared reading profile at nov's base height buffer-locally." + (mapc #'face-remap-remove-relative cj/nov--typography-remap-cookies) + (setq cj/nov--typography-remap-cookies + (cj/font-profile-remap-buffer + cj/nov-reading-profile cj/nov-reading-text-height))) (defun cj/nov-reading-text-bigger () "Increase the page font size and remember it across books and sessions." diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index d4407b28..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,24 +199,41 @@ 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. ;; The TTL+building cache lifecycle is provided by `cj-cache.el'. -(defvar cj/--org-agenda-files-cache (cj/cache-make :ttl 3600) - "Cache state for the agenda files list. See `cj-cache.el'.") +(defvar cj/--org-agenda-files-cache (cj/cache-make :ttl 86400) + "Cache state for the agenda files list. See `cj-cache.el'. + +TTL is 24h. The cache holds only the file *list* (which files are agenda +files), never their contents -- task edits and completions are re-read on +every agenda build/redo regardless of cache age. The list only changes when +a project directory with a todo.org is created or removed, which is rare, so a +long TTL costs little; use `cj/org-agenda-refresh-files' (S-<f8>) to force a +re-scan the moment a new project is added.") ;; ------------------------ Add Files To Org Agenda List ----------------------- ;; Checks immediate subdirectories of DIRECTORY for todo.org files and adds @@ -216,9 +325,13 @@ improves performance from several seconds to instant." "Force rebuild of agenda files cache. Use this after adding new projects or todo.org files. -Bypasses cache and scans directories from scratch." +Bypasses cache and scans directories from scratch. + +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)) +(global-set-key (kbd "S-<f8>") #'cj/org-agenda-refresh-files) (defun cj/todo-list-all-agenda-files () "Displays an \\='org-agenda\\=' todo list. @@ -383,11 +496,14 @@ The agenda is rebuilt from all sources before display, including: ;; ------------------------- Add Timestamp To Org Entry ------------------------ ;; simply adds a timestamp to put the org entry on an agenda +(defvar cj/timeformat "%Y-%m-%d %a" + "Date format for the stamp `cj/add-timestamp-to-org-entry' inserts. +Must stay an org-readable date so the stamped line reaches the agenda.") + (defun cj/add-timestamp-to-org-entry (s) "Add an event with time S to appear underneath the line-at-point. This allows a line to show in an agenda without being scheduled or a deadline." (interactive "sTime: ") - (defvar cj/timeformat "%Y-%m-%d %a") (org-end-of-line) (save-excursion (open-line 1) diff --git a/modules/org-capture-config.el b/modules/org-capture-config.el index 292e26a7..b7250f1e 100644 --- a/modules/org-capture-config.el +++ b/modules/org-capture-config.el @@ -157,6 +157,8 @@ re-scanning large target files after the first successful lookup." (interactive) (user-error "Key disabled during capture -- finalize with C-c C-c or abort with C-c C-k")) +(defvar org-capture-mode-map) + (with-eval-after-load 'org-capture (dolist (key '("<f1>" "<f10>" "<f11>" "<f12>" "M-SPC")) (keymap-set org-capture-mode-map key #'cj/--org-capture-blocked-key))) @@ -381,10 +383,10 @@ A popup still mid-capture has capture UI and is not reapable, so it is spared." (defun cj/org-capture-reap-popup-frames () "Delete every quick-capture popup frame that no longer shows capture UI. Reaps across ALL frames, not just the selected one: a capture that finalizes, -aborts, or errors while the daemon's selected frame is something else (the common -multi-frame case) still cleans up its \"org-capture\" popup, while a popup -mid-capture is spared. Never deletes the last remaining frame. Safe to call -anytime — bound to nothing, run via M-x when a stray popup needs clearing." +aborts, or errors while the daemon's selected frame is something else (the +common multi-frame case) still cleans up its \"org-capture\" popup, while a +popup mid-capture is spared. Never deletes the last remaining frame. Safe to +call anytime — bound to nothing, run via M-x when a stray popup needs clearing." (interactive) (dolist (f (frame-list)) (when (and (frame-live-p f) @@ -395,9 +397,7 @@ anytime — bound to nothing, run via M-x when a stray popup needs clearing." (window-list f 'no-minibuf)))) (delete-frame f)))) -;; Reap on every capture exit. `remove-hook' first so a live module reload swaps -;; the retired narrow (selected-frame) handler for this one without leaving both. -(remove-hook 'org-capture-after-finalize-hook #'cj/org-capture--delete-popup-frame) +;; Reap on every capture exit. (add-hook 'org-capture-after-finalize-hook #'cj/org-capture-reap-popup-frames) ;; The popup opens a fresh emacsclient frame still showing the daemon's last @@ -437,6 +437,55 @@ never split the small floating frame." '(cj/org-capture--popup-display-condition cj/org-capture--display-sole-window)) +;; A fresh "org-capture" popup opens showing the daemon's last buffer (see the +;; comment above), and only the capture UI + the reap-on-finalize hook clear it. +;; If a capture aborts before its UI paints (a C-g, an erroring template, a path +;; that skips `cj/quick-capture'), the popup lingers showing whatever was current +;; -- and if that was a live terminal (an eat/vterm Claude Code buffer), eat +;; sizes the terminal to that small popup window and clamps the real frame down +;; to the popup's rows. These two guards keep the popup from ever holding a +;; size-sensitive live buffer: it only ever shows capture UI or *scratch*. + +(defun cj/org-capture--neutralize-frame (frame) + "Point every non-capture-UI window of the \"org-capture\" popup FRAME at +*scratch*. Capture UI (the *Org Select* menu, a CAPTURE-* buffer) is spared, so +this never disturbs a live capture; it only evicts a stray live buffer (the +daemon's last buffer on open, or a buffer restored on abort) that would +otherwise mirror the popup's size onto its source buffer. Idempotent: a window +already on *scratch* is left alone, so it can't loop through the +`window-buffer-change-functions' it fires." + (when (and (frame-live-p frame) + (equal (frame-parameter frame 'name) "org-capture")) + (dolist (w (window-list frame 'no-minibuf)) + (let ((name (buffer-name (window-buffer w)))) + (unless (or (cj/org-capture--popup-sole-window-p "org-capture" name) + (equal name "*scratch*")) + (set-window-buffer w (get-buffer-create "*scratch*"))))))) + +;; Guard 1 (root cause): neutralize the popup the instant it is created, before +;; any capture UI paints, so it never opens mirroring the daemon's last buffer. +(defun cj/org-capture--neutralize-new-frame (frame) + "Neutralize a freshly-made \"org-capture\" popup FRAME on creation. +See `cj/org-capture--neutralize-frame'." + (cj/org-capture--neutralize-frame frame)) + +(add-hook 'after-make-frame-functions #'cj/org-capture--neutralize-new-frame) + +;; Guard 2 (safety net): catch any path the finalize reap misses. If a live +;; buffer is displayed in the popup after creation (an aborted capture restoring +;; the previous buffer, a stray `switch-to-buffer'), evict it at once. +(defun cj/org-capture--neutralize-on-buffer-change (frame-or-window) + "Neutralize the \"org-capture\" popup after any buffer change in FRAME-OR-WINDOW. +`window-buffer-change-functions' passes a frame (global hook) or a window +(buffer-local); handle both." + (let ((frame (if (windowp frame-or-window) + (window-frame frame-or-window) + frame-or-window))) + (cj/org-capture--neutralize-frame frame))) + +(add-hook 'window-buffer-change-functions + #'cj/org-capture--neutralize-on-buffer-change) + ;; The desktop quick-capture popup is launched globally (no browser selection, ;; no mu4e message, no pdf/epub buffer), so the context-dependent templates make ;; no sense there. `cj/quick-capture' captures a single Task straight into the diff --git a/modules/org-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/org-contacts-config.el b/modules/org-contacts-config.el index 944d75c1..39ff9910 100644 --- a/modules/org-contacts-config.el +++ b/modules/org-contacts-config.el @@ -170,29 +170,40 @@ Added: %U" (require 'system-lib) +(defun cj/--org-contacts-collect (buffer) + "Return an alist of (NAME POSITION INFO) for the contact headings in BUFFER. +NAME is the heading text, POSITION its buffer position, and INFO the +EMAIL or PHONE property value (or nil)." + (with-current-buffer buffer + (org-map-entries + (lambda () + (list (nth 4 (org-heading-components)) + (point) + (or (org-entry-get nil "EMAIL") + (org-entry-get nil "PHONE")))) + nil nil))) + (defun cj/org-contacts-find () - "Find and open a contact." + "Find a contact and jump to its heading. +Collect the contact headings before prompting, so cancelling the prompt +leaves point where it was, and jump to the selected heading's stored +position instead of a text search that could land inside another entry." (interactive) - (find-file contacts-file) - (goto-char (point-min)) - (let* ((alist (org-map-entries - (lambda () - (cons (nth 4 (org-heading-components)) - (or (org-entry-get nil "EMAIL") - (org-entry-get nil "PHONE")))) - nil (list contacts-file))) + (let* ((buf (find-file-noselect contacts-file)) + (alist (cj/--org-contacts-collect buf)) (contact (completing-read "Find contact: " (cj/completion-table-annotated 'contact (lambda (cand) - (let ((info (cdr (assoc cand alist)))) + (let ((info (nth 2 (assoc cand alist)))) (when (and info (> (length info) 0)) (concat " " (propertize info 'face 'completions-annotations))))) - alist)))) - (goto-char (point-min)) - (search-forward contact) + alist) + nil t))) + (switch-to-buffer buf) + (goto-char (nth 1 (assoc contact alist))) (org-fold-show-entry) (org-reveal))) diff --git a/modules/org-drill-config.el b/modules/org-drill-config.el index 29f6130a..f53f36b9 100644 --- a/modules/org-drill-config.el +++ b/modules/org-drill-config.el @@ -134,25 +134,42 @@ With a prefix arg OTHER-DIR, prompt for the directory instead of `drill-dir'." ;; --------------------------------- Org Drill --------------------------------- -(use-package org-drill - ;; :vc (:url "git@cjennings.net:org-drill.git" - ;; :branch "main" - ;; :rev :newest) - :load-path "~/code/org-drill" ;; local dev checkout — switch back to :vc above when done - :after (org org-capture) - :demand t - :commands (org-drill org-drill-resume) - :custom - (org-drill-leech-failure-threshold 50 "leech cards = 50 wrong answers") - (org-drill-leech-method 'warn "leech cards show warnings") - (org-drill-use-visible-cloze-face-p t "cloze text shows up in a different font") - (org-drill-hide-item-headings-p t "don't show heading text") - (org-drill-maximum-items-per-session 100 "drill sessions end after 100 cards") - (org-drill-maximum-duration 30 "each drill session can last up to 30 mins") - (org-drill-add-random-noise-to-intervals-p t "vary the days to repetition slightly") - (org-drill-text-size-during-session 24 "24-point font for comfortable reading") - (org-drill-use-variable-pitch t "variable-pitch font for readability") - (org-drill-hide-modeline-during-session t "hide the modeline for a cleaner display")) +(defconst cj/org-drill-dev-checkout (expand-file-name "org-drill" "~/code/") + "Local org-drill development checkout, preferred when it exists.") + +(defun cj/--org-drill-source-keywords (&optional checkout) + "Return the use-package source keywords for org-drill. +With CHECKOUT (default `cj/org-drill-dev-checkout') an existing directory, +load from it via :load-path. Otherwise install from upstream via :vc, so +drill still loads on a machine without the dev checkout (bare :load-path + +:demand t would fail to load there)." + (let ((dir (or checkout cj/org-drill-dev-checkout))) + (if (file-directory-p dir) + (list :load-path dir) + (list :vc '(:url "git@cjennings.net:org-drill.git" + :branch "main" + :rev :newest))))) + +;; `use-package' keywords must be literals at macro-expansion, so the +;; source keyword is spliced in through `eval' at load time (same idiom as +;; the computed flycheck checker path elsewhere in the config). +(eval + `(use-package org-drill + ,@(cj/--org-drill-source-keywords) + :after (org org-capture) + :demand t + :commands (org-drill org-drill-resume) + :custom + (org-drill-leech-failure-threshold 50 "leech cards = 50 wrong answers") + (org-drill-leech-method 'warn "leech cards show warnings") + (org-drill-use-visible-cloze-face-p t "cloze text shows up in a different font") + (org-drill-hide-item-headings-p t "don't show heading text") + (org-drill-maximum-items-per-session 100 "drill sessions end after 100 cards") + (org-drill-maximum-duration 30 "each drill session can last up to 30 mins") + (org-drill-add-random-noise-to-intervals-p t "vary the days to repetition slightly") + (org-drill-text-size-during-session 24 "24-point font for comfortable reading") + (org-drill-use-variable-pitch t "variable-pitch font for readability") + (org-drill-hide-modeline-during-session t "hide the modeline for a cleaner display"))) (provide 'org-drill-config) ;;; org-drill-config.el ends here. diff --git a/modules/org-refile-config.el b/modules/org-refile-config.el index 5f826cac..d94e4965 100644 --- a/modules/org-refile-config.el +++ b/modules/org-refile-config.el @@ -185,6 +185,25 @@ ARG DEFAULT-BUFFER RFLOC and MSG parameters passed to org-refile." ;; --------------------------------- Org Refile -------------------------------- +(declare-function org-save-all-org-buffers "org") + +(defun cj/org-refile--save-all-buffers (&rest _) + "Save every open Org buffer. Installed as `:after' advice on `org-refile'. +Named (not an anonymous lambda) so the :config reload can `advice-remove' +it by reference and a test can assert its installation." + (org-save-all-org-buffers)) + +(defun cj/org-refile--ensure-targets-in-org-mode (&rest _) + "Put every string-named refile target buffer into `org-mode' first. +Installed as `:before' advice on `org-refile-get-targets'. Fixes targets +opened before Org loaded getting stuck in `fundamental-mode'. A non-string +target car (a function or symbol spec) is skipped. Named for the same +remove-by-reference and testability reasons as the save helper above." + (dolist (target org-refile-targets) + (let ((file (car target))) + (when (stringp file) + (cj/org-refile-ensure-org-mode file))))) + (use-package org-refile :ensure nil ;; built-in :defer .5 @@ -193,20 +212,14 @@ ARG DEFAULT-BUFFER RFLOC and MSG parameters passed to org-refile." ("C-c C-w" . cj/org-refile) ("C-c w" . cj/org-refile-in-file)) :config - ;; save all open org buffers after a refile is complete - (advice-add 'org-refile :after - (lambda (&rest _) - (org-save-all-org-buffers))) - - ;; Ensure refile target buffers are in org-mode before processing - ;; Fixes issue where buffers opened before org loaded get stuck in fundamental-mode - (advice-add 'org-refile-get-targets :before - (lambda (&rest _) - "Ensure all refile target buffers are in org-mode." - (dolist (target org-refile-targets) - (let ((file (car target))) - (when (stringp file) - (cj/org-refile-ensure-org-mode file))))))) + ;; Install both advices by named-function reference with a remove-then-add + ;; guard. Anonymous lambdas here couldn't be `advice-remove'd (deleting the + ;; advice from source left a live daemon still running it) and couldn't be + ;; tested; the named helpers above are both. + (advice-remove 'org-refile #'cj/org-refile--save-all-buffers) + (advice-add 'org-refile :after #'cj/org-refile--save-all-buffers) + (advice-remove 'org-refile-get-targets #'cj/org-refile--ensure-targets-in-org-mode) + (advice-add 'org-refile-get-targets :before #'cj/org-refile--ensure-targets-in-org-mode)) (provide 'org-refile-config) ;;; org-refile-config.el ends here. diff --git a/modules/org-reveal-config.el b/modules/org-reveal-config.el index be702bf7..f842680b 100644 --- a/modules/org-reveal-config.el +++ b/modules/org-reveal-config.el @@ -8,9 +8,10 @@ ;; Load shape: eager. ;; Eager reason: none; presentation export is a command-loaded deferral ;; candidate for Phase 4. -;; Top-level side effects: package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). -;; Direct test load: yes. +;; Top-level side effects: registers a presentation prefix keymap under +;; cj/custom-keymap; package configuration via use-package. +;; Runtime requires: keybindings. +;; Direct test load: yes (requires keybindings explicitly). ;; ;; Integrates ox-reveal for creating reveal.js presentations from Org files. ;; @@ -28,6 +29,8 @@ ;;; Code: +(require 'keybindings) ;; cj/register-prefix-map, cj/custom-keymap + ;; Forward declarations for byte-compiler (ox-reveal loaded via use-package) (defvar org-reveal-root) (defvar org-reveal-single-file) @@ -238,17 +241,25 @@ reveal.js headers pre-filled." ;; -------------------------------- Keybindings -------------------------------- -(global-set-key (kbd "C-; p SPC") #'cj/reveal-present) -(global-set-key (kbd "C-; p e") #'cj/reveal-export) -(global-set-key (kbd "C-; p p") #'cj/reveal-preview-start) -(global-set-key (kbd "C-; p s") #'cj/reveal-preview-stop) -(global-set-key (kbd "C-; p h") #'cj/reveal-insert-header) -(global-set-key (kbd "C-; p H") #'cj/reveal-remove-headers) -(global-set-key (kbd "C-; p n") #'cj/reveal-new) +;; A registered prefix keymap, not raw `global-set-key' chains: binding +;; "C-; p ..." directly depends on keybindings.el having already made "C-;" +;; a live prefix (otherwise "non-prefix key" errors), while +;; `cj/register-prefix-map' binds into `cj/custom-keymap' with no load-order +;; dependency beyond requiring keybindings. +(defvar-keymap cj/reveal-map + :doc "Keymap for reveal.js presentation commands." + "SPC" #'cj/reveal-present + "e" #'cj/reveal-export + "p" #'cj/reveal-preview-start + "s" #'cj/reveal-preview-stop + "h" #'cj/reveal-insert-header + "H" #'cj/reveal-remove-headers + "n" #'cj/reveal-new) + +(cj/register-prefix-map "p" cj/reveal-map "presentations") (with-eval-after-load 'which-key (which-key-add-key-based-replacements - "C-; p" "presentations" "C-; p SPC" "present current buffer" "C-; p e" "export & open" "C-; p p" "start live preview" diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index 867f2d99..e8d003e0 100644 --- a/modules/org-roam-config.el +++ b/modules/org-roam-config.el @@ -30,6 +30,10 @@ ;; Declared special so the `let'-binding in `cj/org-roam-copy-todo-to-today' ;; compiles as a dynamic bind, not a dead lexical local -- otherwise the custom ;; capture template never reaches org-roam-dailies (the foreign-special-var trap). +;; Declared special so cj/org-roam-node-insert-immediate's let-binding is +;; dynamic under lexical-binding; without it the byte-compiled let is a dead +;; lexical binding and :immediate-finish never reaches org-roam-node-insert. +(defvar org-roam-capture-templates) (defvar org-roam-dailies-capture-templates) ;; External variables, declared special so byte-compilation doesn't treat them diff --git a/modules/org-webclipper.el b/modules/org-webclipper.el index 40ceada7..217aecfa 100644 --- a/modules/org-webclipper.el +++ b/modules/org-webclipper.el @@ -186,22 +186,6 @@ Return the yanked content as a string so templates can insert it." ;; extract the webpage content from the kill ring (car kill-ring))) -;; ----------------------------- Webclipper Keymap ----------------------------- - -;; keymaps shouldn't be required for webclipper -;; Setup keymaps -;; -;; (defun cj/webclipper-setup-keymaps () -;; "Setup webclipper keymaps." -;; (define-prefix-command 'cj/webclipper-map nil -;; "Keymap for weblipper operations.") -;; (define-key cj/custom-keymap "c" 'cj/webclipper-map) -;; (define-key cj/webclipper-map "n" 'cj/move-org-branch-to-roam)) - -;; ;; Call keymap setup if cj/custom-keymap is already defined -;; (when (boundp 'cj/custom-keymap) -;; (cj/webclipper-setup-keymaps)) - ;; Register protocol handler early for external calls (with-eval-after-load 'org-protocol (unless (assoc "webclip" org-protocol-protocol-alist) @@ -211,9 +195,5 @@ Return the yanked content as a string so templates can insert it." :function cj/org-protocol-webclip :kill-client t)))) -;; (with-eval-after-load 'cj/custom-keymap -;; (require 'org-webclipper) -;; (cj/webclipper-setup-keymaps)) - (provide 'org-webclipper) ;;; org-webclipper.el ends here diff --git a/modules/prog-c.el b/modules/prog-c.el index 728df018..29a341d5 100644 --- a/modules/prog-c.el +++ b/modules/prog-c.el @@ -8,8 +8,9 @@ ;; Load shape: eager. ;; Eager reason: none necessary; currently eager but should load by C major mode ;; (Phase 6 deferral candidate). -;; Top-level side effects: six add-hook, package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). +;; Top-level side effects: six add-hook, package configuration via use-package; +;; warns at load if clangd or clang-format is missing. +;; Runtime requires: system-lib. ;; Direct test load: yes. ;; ;; Modern C programming environment with LSP, tree-sitter, debugging, and formatting. @@ -59,6 +60,14 @@ (defvar clang-format-path "clang-format" "Path to clang-format executable.") +;; Warn at load time when a C tool is missing. The clang-format block +;; below gates on `:if (executable-find ...)', which evaluates once at +;; startup — an absent binary silently disables the format key until the +;; next restart, so this warn is the only visible trace. +(require 'system-lib) ; for cj/executable-find-or-warn +(cj/executable-find-or-warn clangd-path "clangd LSP" 'prog-c) +(cj/executable-find-or-warn clang-format-path "C formatting" 'prog-c) + ;; -------------------------------- C Mode Setup ------------------------------- ;; preferences for C programming following common conventions diff --git a/modules/prog-general.el b/modules/prog-general.el index 89771cbf..77ff88a5 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") @@ -120,19 +122,27 @@ REGEXP must be a string or an rx form." ;; 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. +(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 - ;; Directly modify the slot value using aset (struct fields are vectors internally) - (aset go-recipe 6 "v0.19.1"))) ; slot 6 is :revision + (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/prog-go.el b/modules/prog-go.el index 7faf92a0..630b725c 100644 --- a/modules/prog-go.el +++ b/modules/prog-go.el @@ -8,8 +8,9 @@ ;; Load shape: eager. ;; Eager reason: none necessary; currently eager but should load by Go major ;; mode (Phase 6 deferral candidate). -;; Top-level side effects: package configuration via use-package (hooks via :hook). -;; Runtime requires: none (configures packages via use-package). +;; Top-level side effects: package configuration via use-package (hooks via +;; :hook); adds ~/go/bin to exec-path; warns at load if gopls is missing. +;; Runtime requires: system-lib. ;; Direct test load: yes. ;; ;; Configuration for Go programming using go-ts-mode (tree-sitter based). @@ -29,14 +30,25 @@ ;;; Code: +(require 'system-lib) ; for cj/executable-find-or-warn + (defvar go-bin-path (expand-file-name "~/go/bin") "Path to Go binaries directory. This is where tools like goimports and staticcheck are installed.") +;; Register the Go bin directory before the gopls check below: go tools +;; install there, so probing PATH without it would warn about a gopls +;; that is in fact present. +(add-to-list 'exec-path go-bin-path) + (defvar gopls-path "gopls" "Path to gopls (Go language server). Install with: go install golang.org/x/tools/gopls@latest") +;; Warn at load time if gopls is missing rather than waiting for the +;; first Go buffer to silently skip the LSP attach. +(cj/executable-find-or-warn gopls-path "gopls LSP" 'prog-go) + (defvar dlv-path "dlv" "Path to Delve debugger. Install with: go install github.com/go-delve/delve/cmd/dlv@latest") @@ -113,11 +125,14 @@ Overrides default prog-mode keybindings with Go-specific commands." ;; never ran. Autoload gofmt so the first format pulls go-mode and its :config. :commands (gofmt) :hook ((go-ts-mode . cj/go-setup) - (go-ts-mode . cj/go-mode-keybindings)) + (go-ts-mode . cj/go-mode-keybindings) + ;; Classic-mode fallback: same setup when the Go grammar is + ;; unavailable and the buffer lands in go-mode. + (go-mode . cj/go-setup) + (go-mode . cj/go-mode-keybindings)) :mode (("\\.go\\'" . go-ts-mode) ;; .go files use go-ts-mode ("go\\.mod\\'" . go-mod-ts-mode)) ;; go.mod uses go-mod-ts-mode :config - (add-to-list 'exec-path go-bin-path) ;; Use goimports for formatting (adds/removes imports automatically) (setq gofmt-command "goimports")) diff --git a/modules/prog-json.el b/modules/prog-json.el index e7abd182..66f4c5f2 100644 --- a/modules/prog-json.el +++ b/modules/prog-json.el @@ -62,9 +62,14 @@ back to the built-in `json-pretty-print-buffer-ordered'." ;; interactive jq queries against JSON buffers (use-package jq-mode - :defer t - :bind (:map json-ts-mode-map - ("C-c C-q" . jq-interactively))) + :defer t) + +;; Bind on json-ts-mode's own map, keyed to its load. The old +;; :bind (:map json-ts-mode-map ...) inside the jq-mode use-package deferred +;; the binding to jq-mode's load -- which nothing triggered, so the key was +;; dead. jq-interactively is autoloaded, so pressing the key loads jq-mode. +(with-eval-after-load 'json-ts-mode + (keymap-set json-ts-mode-map "C-c C-q" #'jq-interactively)) (provide 'prog-json) ;;; prog-json.el ends here. diff --git a/modules/prog-lisp.el b/modules/prog-lisp.el index ba568c9c..16740507 100644 --- a/modules/prog-lisp.el +++ b/modules/prog-lisp.el @@ -119,8 +119,12 @@ (use-package package-lint :commands (package-lint-current-buffer package-lint-batch-and-exit)) +;; Load when flycheck does. The old `:after (flycheck package-lint)' never +;; fired: nothing loads package-lint on its own (it is flycheck-package's +;; dependency, pulled in by its require), so the setup silently never ran +;; and elisp buffers never got the package-lint checker. (use-package flycheck-package - :after (flycheck package-lint) + :after flycheck :config (flycheck-package-setup)) diff --git a/modules/prog-python.el b/modules/prog-python.el index 6354bd90..91670ec0 100644 --- a/modules/prog-python.el +++ b/modules/prog-python.el @@ -69,9 +69,12 @@ Install with: pip install mypy") (setq-local indent-tabs-mode nil) ;; disable tab characters (electric-pair-local-mode t) ;; match delimiters automatically (buffer-local) - ;; Enable LSP if available + ;; Enable LSP if available. lsp-pyright is required here, inside the + ;; guard, so a pyright-less machine never loads it and never sees the + ;; LSP attach prompt the guard exists to prevent. (when (and (fboundp 'lsp-deferred) (executable-find pyright-path)) + (require 'lsp-pyright nil t) (lsp-deferred))) (defun cj/--python-mypy-command (target) @@ -111,8 +114,12 @@ Overrides default prog-mode keybindings with Python-specific commands." (use-package python :ensure nil ;; built-in :hook + ;; Both variants: treesit-auto falls back to classic python-mode when the + ;; grammar is unavailable, and that fallback should keep the same setup. ((python-ts-mode . cj/python-setup) - (python-ts-mode . cj/python-mode-keybindings)) + (python-ts-mode . cj/python-mode-keybindings) + (python-mode . cj/python-setup) + (python-mode . cj/python-mode-keybindings)) :custom (python-shell-interpreter "python3") :config @@ -126,10 +133,12 @@ Overrides default prog-mode keybindings with Python-specific commands." ;; Python-specific LSP configuration via pyright ;; Core LSP setup is in prog-general.el +;; No :hook here: the old unguarded (require 'lsp-pyright) + (lsp-deferred) +;; lambda ran on every python-ts buffer, so pyright-less machines got the +;; LSP attach prompt cj/python-setup's guard exists to prevent. The guarded +;; branch in cj/python-setup owns the require and the attach. (use-package lsp-pyright - :hook (python-ts-mode . (lambda () - (require 'lsp-pyright) - (lsp-deferred)))) + :defer t) ;; ----------------------------------- Poetry ---------------------------------- ;; virtual environments and dependencies diff --git a/modules/prog-shell.el b/modules/prog-shell.el index 3ed51da1..7c0972f0 100644 --- a/modules/prog-shell.el +++ b/modules/prog-shell.el @@ -9,8 +9,9 @@ ;; Eager reason: none necessary; currently eager but should load by shell major ;; mode (Phase 6 deferral candidate). ;; Top-level side effects: five add-hook, including an after-save executable hook -;; the spec flags as needing opt-in/scoping; package config via use-package. -;; Runtime requires: none (configures packages via use-package). +;; the spec flags as needing opt-in/scoping; package config via use-package; +;; warns at load for missing shell tools. +;; Runtime requires: system-lib. ;; Direct test load: yes. ;; ;; Modern shell scripting environment with LSP, tree-sitter, linting, and formatting. @@ -65,6 +66,15 @@ Install with: sudo pacman -S shfmt") "Path to shellcheck executable. Install with: sudo pacman -S shellcheck") +;; Warn at load time when a shell tool is missing. The shfmt and +;; flycheck blocks below gate on `:if (executable-find ...)', which +;; evaluates once at startup — an absent tool silently disables that +;; setup until the next restart, so this warn is the only visible trace. +(require 'system-lib) ; for cj/executable-find-or-warn +(cj/executable-find-or-warn bash-language-server-path "bash LSP" 'prog-shell) +(cj/executable-find-or-warn shfmt-path "shell formatting" 'prog-shell) +(cj/executable-find-or-warn shellcheck-path "shell linting" 'prog-shell) + ;; ------------------------------- Shell Script Setup ------------------------------ ;; preferences for shell scripting diff --git a/modules/prog-training.el b/modules/prog-training.el index 41f3053b..d38208ee 100644 --- a/modules/prog-training.el +++ b/modules/prog-training.el @@ -17,6 +17,7 @@ ;;; Code: +(defvar code-dir) ;; user-constants.el; read lazily in leetcode's :config ;; ----------------------------- Exercism ---------------------------- @@ -33,9 +34,9 @@ :defer t :commands (leetcode) :bind ("C-h L" . leetcode) - :custom - (url-debug t) :config + ;; No (url-debug t) here: that was a debugging leftover, and it turned on + ;; GLOBAL url.el request logging for the whole session once leetcode loaded. (setq leetcode-prefer-language "golang") (setq leetcode-directory (concat code-dir "/leetcode")) (setq leetcode-save-solutions t)) diff --git a/modules/prog-webdev.el b/modules/prog-webdev.el index b228d0cc..f305c65d 100644 --- a/modules/prog-webdev.el +++ b/modules/prog-webdev.el @@ -18,6 +18,7 @@ ;; ;; Installation: ;; sudo pacman -S typescript-language-server typescript prettier +;; sudo pacman -S vscode-html-languageserver # LSP in web-mode buffers ;; ;; Features: ;; - Tree-sitter: Syntax highlighting for TS, TSX, JS (via treesit-auto) @@ -52,6 +53,10 @@ Install with: sudo pacman -S typescript-language-server") "Path to prettier executable. Install with: sudo pacman -S prettier") +(defvar html-language-server-path "vscode-html-language-server" + "Path to the HTML language server executable used in web-mode buffers. +Install with: sudo pacman -S vscode-html-languageserver") + ;; Warn at load time if prettier is missing rather than waiting for the ;; first format-on-save to fail mid-edit. (cj/executable-find-or-warn prettier-path "prettier formatter" 'prog-webdev) @@ -59,8 +64,8 @@ Install with: sudo pacman -S prettier") ;; ------------------------------ Web Dev Setup -------------------------------- ;; shared setup for TypeScript, JavaScript, and TSX modes -(defun cj/webdev-setup () - "Set up common preferences for web development buffers." +(defun cj/--webdev-prefs () + "Apply the shared buffer-local preferences for web development buffers." (company-mode) (flyspell-prog-mode) (superword-mode) @@ -68,13 +73,27 @@ Install with: sudo pacman -S prettier") (setq-local tab-width 2) (setq-local standard-indent 2) (setq-local indent-tabs-mode nil) - (electric-pair-local-mode t) + (electric-pair-local-mode t)) + +(defun cj/webdev-setup () + "Set up common preferences for TypeScript/JavaScript buffers." + (cj/--webdev-prefs) ;; Enable LSP if available (when (and (fboundp 'lsp-deferred) (executable-find ts-language-server-path)) (lsp-deferred))) +(defun cj/web-mode-setup () + "Set up preferences for web-mode (HTML template) buffers. +Same shared preferences as the TS/JS modes, but the LSP attach is +guarded on the HTML language server rather than the TypeScript one, so +machines without it stay silent instead of prompting." + (cj/--webdev-prefs) + (when (and (fboundp 'lsp-deferred) + (executable-find html-language-server-path)) + (lsp-deferred))) + (defun cj/--webdev-format-args (file) "Return the prettier argv list that formats FILE's contents on stdin. No shell quoting is needed: the args are passed to prettier directly @@ -121,6 +140,11 @@ Detects the file type automatically from the filename." ((js-ts-mode . cj/webdev-setup) (js-ts-mode . cj/webdev-keybindings))) +;; Classic-mode fallback: when the JS grammar is unavailable the buffer +;; lands in js-mode; give it the same setup as the tree-sitter modes. +(add-hook 'js-mode-hook #'cj/webdev-setup) +(add-hook 'js-mode-hook #'cj/webdev-keybindings) + ;; ----------------------------------- LSP ------------------------------------- ;; TypeScript/JavaScript LSP configuration ;; Core LSP setup is in prog-general.el @@ -145,7 +169,8 @@ Detects the file type automatically from the filename." (web-mode-code-indent-offset 2) (web-mode-engines-alist '(("django" . "\\.html\\'"))) :mode ("\\.html?$" . web-mode) - :hook (web-mode . cj/webdev-keybindings)) + :hook ((web-mode . cj/web-mode-setup) + (web-mode . cj/webdev-keybindings))) (provide 'prog-webdev) ;;; prog-webdev.el ends here. diff --git a/modules/restclient-config.el b/modules/restclient-config.el index 0511eddb..497f54d0 100644 --- a/modules/restclient-config.el +++ b/modules/restclient-config.el @@ -8,7 +8,7 @@ ;; Load shape: eager. ;; Eager reason: none; API exploration, a command-loaded deferral candidate. ;; Top-level side effects: package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). +;; Runtime requires: keybindings (C-; R prefix registration). ;; Direct test load: yes. ;; ;; Integrates restclient.el for interactive API exploration from within Emacs. @@ -23,6 +23,8 @@ ;;; Code: +(require 'keybindings) ;; cj/register-prefix-map + ;; --------------------------------- Constants --------------------------------- (defvar cj/restclient-data-dir (expand-file-name "data/" user-emacs-directory) @@ -61,12 +63,15 @@ ;; -------------------------------- Keybindings -------------------------------- -(global-set-key (kbd "C-; R n") #'cj/restclient-new-buffer) -(global-set-key (kbd "C-; R o") #'cj/restclient-open-file) +(defvar-keymap cj/restclient-map + :doc "Keymap for restclient operations" + "n" #'cj/restclient-new-buffer + "o" #'cj/restclient-open-file) + +(cj/register-prefix-map "R" cj/restclient-map "REST client") (with-eval-after-load 'which-key (which-key-add-key-based-replacements - "C-; R" "REST client" "C-; R n" "new scratch buffer" "C-; R o" "open .rest file")) diff --git a/modules/selection-framework.el b/modules/selection-framework.el index 8e3ee252..47fbf7c7 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -225,7 +225,7 @@ ("C-p" . company-select-previous)) :custom (company-backends '(company-capf company-files company-keywords)) - (company-idle-delay 2) + (company-idle-delay 4) (company-minimum-prefix-length 2) (company-show-numbers t) (company-tooltip-align-annotations t) diff --git a/modules/signal-config.el b/modules/signal-config.el deleted file mode 100644 index edb7d0dc..00000000 --- a/modules/signal-config.el +++ /dev/null @@ -1,357 +0,0 @@ -;;; signal-config.el --- Signal client (forked signel) configuration -*- lexical-binding: t -*- - -;;; Commentary: -;; cj/-namespaced configuration and helpers layered on the forked `signel' -;; package, a Signal client that drives signal-cli over JSON-RPC. -;; -;; This file currently holds the pure, signal-cli-independent helper layer -;; that the fork edits and `use-package' wiring build on: -;; - contact-list parsing for a completing-read contact picker, and -;; - the predicate that suppresses a notification for the chat the user -;; is actively viewing. -;; Both are unit-tested without a linked account. The use-package wiring, -;; keybindings, and the signel fork edits that call these helpers land once -;; signal-cli is installed and the device is linked. - -;;; Code: - -(require 'seq) -(require 'keybindings) ;; provides cj/custom-keymap + cj/register-prefix-map -(require 'system-lib) ;; for cj/executable-find-or-warn - -(declare-function notifications-notify "notifications") - -(defun cj/signal--jstr (value) - "Return VALUE if it is a non-blank string, else nil. -Normalizes a JSON field that may arrive as nil, the empty string, or a -null sentinel symbol into a plain string-or-nil." - (and (stringp value) - (not (string-empty-p (string-trim value))) - value)) - -(defun cj/signal--combine-name (given family) - "Join GIVEN and FAMILY name parts into a trimmed full name, or nil. -Either part may be nil, the empty string, or a JSON null sentinel." - (let ((parts (delq nil (list (cj/signal--jstr given) (cj/signal--jstr family))))) - (cj/signal--jstr (mapconcat #'identity parts " ")))) - -(defun cj/signal--contact-display-name (contact) - "Return a display name for CONTACT, or nil when none is set. -CONTACT is one entry alist from signal-cli `listContacts'. Picks the -first set source in priority order: the nickname (combined nickName, or -nickGivenName+nickFamilyName), the stored contact name, the top-level -givenName+familyName, the profile givenName+familyName, then username. -signal-cli 0.14 puts givenName/familyName at the top level; the profile -sub-object's name fields are usually null, so it is the deeper fallback." - (let ((profile (alist-get 'profile contact))) - (seq-find - #'cj/signal--jstr - (list (cj/signal--jstr (alist-get 'nickName contact)) - (cj/signal--combine-name (alist-get 'nickGivenName contact) - (alist-get 'nickFamilyName contact)) - (cj/signal--jstr (alist-get 'name contact)) - (cj/signal--combine-name (alist-get 'givenName contact) - (alist-get 'familyName contact)) - (cj/signal--combine-name (alist-get 'givenName profile) - (alist-get 'familyName profile)) - (cj/signal--jstr (alist-get 'username contact)))))) - -(defun cj/signal--parse-contacts (result) - "Parse RESULT from signal-cli `listContacts' into a completing-read alist. -RESULT is the JSON-RPC result value: a sequence (list or vector) of -contact alists. Returns an alist of (LABEL . RECIPIENT) sorted by LABEL, -where RECIPIENT is the contact's phone number (falling back to its UUID) -and LABEL is \"Name (recipient)\" when a name is known, or the bare -recipient otherwise. Contacts with no usable recipient are dropped." - (let (pairs) - (dolist (contact (append result nil)) - (let ((recipient (or (cj/signal--jstr (alist-get 'number contact)) - (cj/signal--jstr (alist-get 'uuid contact)))) - (name (cj/signal--contact-display-name contact))) - (when recipient - (push (cons (if name (format "%s (%s)" name recipient) recipient) - recipient) - pairs)))) - (sort pairs (lambda (a b) (string-lessp (car a) (car b)))))) - -(defun cj/signal--chat-buffer-name (id) - "Return the chat buffer name `signel' uses for chat ID." - (format "*Signel: %s*" id)) - -(defun cj/signal--suppress-notify-p (chat-id viewing-buffer-name frame-focused) - "Return non-nil when a notification for CHAT-ID should be suppressed. -Suppress only while the user is actively viewing that chat: the chat -buffer named by `cj/signal--chat-buffer-name' is VIEWING-BUFFER-NAME and -FRAME-FOCUSED is non-nil. A nil VIEWING-BUFFER-NAME or an unfocused -frame never suppresses." - (and frame-focused - (stringp viewing-buffer-name) - (string= viewing-buffer-name (cj/signal--chat-buffer-name chat-id)))) - -(defun cj/signal--frame-focused-p () - "Return non-nil when the selected frame currently has input focus. -Treats an unknown focus state as focused." - (if (fboundp 'frame-focus-state) - (let ((state (frame-focus-state))) - (if (eq state 'unknown) t state)) - t)) - -(defun cj/signal--should-notify-p (chat-id) - "Return non-nil when an incoming message for CHAT-ID should notify. -Notify unless the user is actively viewing that chat in the selected -window of a focused frame." - (not (cj/signal--suppress-notify-p - chat-id - (buffer-name (window-buffer (selected-window))) - (cj/signal--frame-focused-p)))) - -;;; Notifications - -(defcustom cj/signel-notify-sound nil - "When non-nil, incoming-message notifications play the notify script's sound. -Nil (the default) passes --silent so the toast is visual only." - :type 'boolean - :group 'signel) - -(defconst cj/signal--notify-body-max 120 - "Maximum character length of a desktop-notification body. -Longer message text truncates to this length ending in an ellipsis; -the full text is always in the chat buffer.") - -(defun cj/signal--format-notify-body (text) - "Collapse whitespace in TEXT and truncate it for a notification body. -Whitespace runs (including newlines) become single spaces, the result -is trimmed, and anything over `cj/signal--notify-body-max' characters -truncates to that length with a trailing ellipsis." - (let ((flat (string-trim (replace-regexp-in-string "[ \t\n\r]+" " " text)))) - (if (<= (length flat) cj/signal--notify-body-max) - flat - (concat (substring flat 0 (1- cj/signal--notify-body-max)) "…")))) - -(defun cj/signel--notify (chat-id sender body) - "Raise a desktop notification for an incoming Signal message. -Suppressed via `cj/signal--should-notify-p' when the user is actively -viewing CHAT-ID. Routes through the external notify script when it is -on PATH (type info, sound gated by `cj/signel-notify-sound'), falling -back to `notifications-notify' otherwise. SENDER names the title; -BODY is formatted by `cj/signal--format-notify-body'. Installed as -`signel-notify-function' in the use-package :config below." - (when (cj/signal--should-notify-p chat-id) - (let ((title (format "Signal: %s" sender)) - (text (cj/signal--format-notify-body body)) - (script (executable-find "notify"))) - (if script - (apply #'start-process "signel-notify" nil script "info" title text - (unless cj/signel-notify-sound (list "--silent"))) - (notifications-notify :title title :body text))))) - -;;; signel — fork integration - -(defcustom cj/signal-private-config-file - (expand-file-name "signal-config.local.el" user-emacs-directory) - "Private signal-config file, loaded when readable. -This is the place to set `signel-account' to the linked phone number so -the number stays out of the version-controlled (and publicly mirrored) -config. A phone number is an identifier rather than a credential, so it -lives here rather than in authinfo, which avoids a GPG prompt at connect -time." - :type 'file - :group 'signel) - -(use-package signel - :load-path "~/code/signel" - :ensure nil - :commands (signel-start signel-stop signel-chat signel-dashboard) - :custom - ;; Don't let an incoming message steal a window by auto-popping its chat - ;; buffer; surface arrivals through notifications instead (see child task - ;; "Notify only for the unviewed conversation"). - (signel-auto-open-buffer nil) - :config - (when (file-readable-p cj/signal-private-config-file) - (load cj/signal-private-config-file nil t)) - ;; Route incoming-message notifications through cj/signel--notify - ;; (suppression + notify script + truncation); warn once at load when - ;; the script is missing — the runtime path still falls back to - ;; notifications-notify, so messages are never silently dropped. - (setq signel-notify-function #'cj/signel--notify) - (cj/executable-find-or-warn "notify" "Signal desktop notifications via the notify script (falling back to notifications-notify)" 'signal-config)) - -;; Chat buffers (named `*Signel: <id>*') open in the bottom 30% of the -;; frame rather than wherever display-buffer's fallback rule picks. -;; The fork's `signel-chat' uses `pop-to-buffer', so this entry applies. -(add-to-list - 'display-buffer-alist - '("\\`\\*Signel: " - (display-buffer-reuse-window display-buffer-at-bottom) - (window-height . 0.3) - (reusable-frames . nil))) - -;;; Connection guard, contact fetch, and cache - -;; Forward declarations: signel.el is loaded by the use-package above (with -;; :load-path on the fork), but the byte-compiler doesn't see those symbols -;; statically. Declaring them keeps the compile clean without changing -;; runtime behavior. -(defvar signel-account) -(defvar signel--process-name) -(declare-function signel-start "signel" ()) -(declare-function signel--send-rpc "signel" (method params &optional target-buffer success-callback)) - -(defvar cj/signel--contact-cache nil - "Cached `(LABEL . RECIPIENT)' alist for the contact picker. -Populated by `cj/signel--fetch-contacts' on first invocation (or after a -`cj/signel-refresh-contacts'), and cleared on `signel-stop' / restart so -a stale list can't survive a reconnect. In-memory only.") - -(defcustom cj/signel-fetch-timeout 3.0 - "Seconds the picker blocks on `accept-process-output' for a cold-cache fetch. -On warm cache the picker opens instantly; on cold cache it kicks off a -fetch and waits up to this many seconds for the RPC result before -reporting a `user-error' so a dead or wedged daemon can't hang Emacs." - :type 'number - :group 'signel) - -(defun cj/signel--ensure-started () - "Ensure the signel daemon is live, starting it if needed. -Three branches: -- The process is already live -- no-op, return nil. -- `signel-account' is set but no live process exists -- call `signel-start' - and pre-warm the contact cache with a background `listContacts' fetch so - the picker is instant on first use. -- `signel-account' is nil -- `user-error' naming the remedy (set the - account in `cj/signal-private-config-file'). - -If startup launches but the RPC handshake exits before the first response, -the subsequent `signel--send-rpc' call (in the pre-warm or any later -fetch) signals through its own error path; check =*signel-log*= and -=*signel-stderr*= for detail and link the account manually. - -Loads the `signel' feature explicitly before reading any of its -private variables: the use-package above autoloads only on -`signel-start' / `signel-stop' / `signel-chat' / `signel-dashboard', -so without this require the first branch's read of `signel--process-name' -fires a void-variable error before the autoload would trigger." - (require 'signel) - (cond - ((process-live-p (get-process signel--process-name)) - nil) - ((null signel-account) - (user-error - "signel-account is unset. Set it in %s (or your private config) and link the device manually with `signal-cli link', then retry" - cj/signal-private-config-file)) - (t - (signel-start) - (cj/signel--fetch-contacts)))) - -(defun cj/signel--fetch-contacts (&optional after-callback) - "Fetch the contact list from signal-cli and populate `cj/signel--contact-cache'. -Issues a `listContacts' RPC and registers a success callback that runs -the result through `cj/signal--parse-contacts' (the verified parser) and -stores the resulting `(LABEL . RECIPIENT)' alist in the cache. An empty -result populates the cache as nil; a failure goes through the dispatch -error path and never invokes the callback, so the prior cache survives. - -AFTER-CALLBACK, when non-nil, is invoked with no arguments after the -cache has been populated -- the picker uses this to unblock its -bounded-wait on cold caches." - (signel--send-rpc - "listContacts" nil nil - (lambda (result) - (setq cj/signel--contact-cache (cj/signal--parse-contacts result)) - (when after-callback (funcall after-callback))))) - -(defun cj/signel-refresh-contacts () - "Clear the picker's contact cache and refetch it from signal-cli. -Use when a contact added or renamed on the phone hasn't shown up in the -picker yet; this forces a fresh `listContacts' rather than reading the -cached snapshot." - (interactive) - (setq cj/signel--contact-cache nil) - (cj/signel--fetch-contacts)) - -;;; Picker, self-message, and connect - -(declare-function signel-chat "signel" (recipient)) -(declare-function signel-dashboard "signel" ()) -(declare-function signel-stop "signel" ()) - -(defun cj/signel-connect () - "Connect to signal-cli, starting the daemon if needed. -Thin interactive wrapper around `cj/signel--ensure-started' so the -keymap has a friendly verb to bind." - (interactive) - (cj/signel--ensure-started) - (message "Signel connected.")) - -(defun cj/signel-message () - "Pick a Signal contact by name and open the chat buffer. -Ensures the daemon is connected first (auto-starts and pre-warms on -cold start, or errors with the remedy if the account isn't set). Uses -the cached contact list when warm; on a cold cache, kicks off a fetch -and waits up to `cj/signel-fetch-timeout' seconds for the result before -raising a `user-error' so a dead daemon can't hang Emacs. The picker -offers a pinned \"Note to Self\" entry plus every Signal contact, and -opens the chosen recipient in `signel-chat'." - (interactive) - (cj/signel--ensure-started) - (unless cj/signel--contact-cache - (let ((done nil) - (deadline (+ (float-time) cj/signel-fetch-timeout))) - (cj/signel--fetch-contacts (lambda () (setq done t))) - (while (and (not done) (< (float-time) deadline)) - (accept-process-output nil 0.1)) - (unless done - (user-error - "Signal contact fetch timed out after %.1fs; try again or run M-x cj/signel-refresh-contacts (see *signel-log* for detail)" - cj/signel-fetch-timeout)))) - (let* ((note-self (cons "Note to Self" signel-account)) - (candidates (cons note-self cj/signel--contact-cache)) - (table (lambda (string pred action) - (if (eq action 'metadata) - `(metadata - (category . signal-contact) - (annotation-function - . ,(lambda (cand) - (let ((r (cdr (assoc cand candidates)))) - (when r - (concat " " (propertize r 'face 'completions-annotations)))))) - (display-sort-function . identity) - (cycle-sort-function . identity)) - (complete-with-action action candidates string pred)))) - (label (completing-read "Signal recipient: " table nil t)) - (recipient (cdr (assoc label candidates)))) - (when recipient - (signel-chat recipient)))) - -(defun cj/signel-message-self () - "Open a Signal chat buffer addressed to Note to Self. -Resolves to `signel-account' (the linked phone number). Sending to it -lands in the Signal Note-to-Self thread on the phone; manual-verify -that on first use." - (interactive) - (cj/signel--ensure-started) - (unless signel-account - (user-error "signel-account is unset; cannot send to self")) - (signel-chat signel-account)) - -(defvar cj/signel-prefix-map - (let ((map (make-sparse-keymap))) - (keymap-set map "m" #'cj/signel-message) - (keymap-set map "s" #'cj/signel-message-self) - (keymap-set map "d" #'signel-dashboard) - (keymap-set map "q" #'signel-stop) - (keymap-set map "SPC" #'cj/signel-connect) - map) - "Signel \"Messages\" prefix keymap, bound under `C-; M'. -Leaves =l= unbound for now -- the future =cj/signel-link= command lands -in a later pass. See =docs/specs/signal-client-spec-doing.org= scope summary.") - -;; Register the messages prefix under C-; M via the documented helper. -;; keybindings.el owns cj/custom-keymap; the (require 'keybindings) above -;; guarantees it is loaded before this runs, so no load-order guard is -;; needed. This is the same pattern every other feature module uses. -(cj/register-prefix-map "M" cj/signel-prefix-map "signal messages") - -(provide 'signal-config) -;;; signal-config.el ends here diff --git a/modules/slack-config.el b/modules/slack-config.el index adf38804..e0ad5b75 100644 --- a/modules/slack-config.el +++ b/modules/slack-config.el @@ -52,6 +52,7 @@ (defvar slack-message-custom-notifier) (defvar slack-teams) +(declare-function notifications-notify "notifications") (declare-function slack-buffer-add-reaction-to-message "slack-buffer") (declare-function slack-buffer-latest-ts "slack-buffer") (declare-function slack-buffer-team "slack-buffer") @@ -196,7 +197,10 @@ so the Slack buffer stays usable." "Add a reaction to the current Slack message using a curated shortlist. Errors if called outside a Slack message buffer." (interactive) - (let ((buf (or slack-current-buffer + ;; boundp guard: the defvar above declares the var with no value, so it is + ;; void until slack.el loads -- a bare read on a cold call would signal + ;; void-variable instead of this friendly error. + (let ((buf (or (and (boundp 'slack-current-buffer) slack-current-buffer) (user-error "Not in a Slack buffer")))) (when-let* ((team (slack-buffer-team buf)) (reaction (cj/slack-select-reaction team))) @@ -207,6 +211,46 @@ Errors if called outside a Slack message buffer." :around #'cj/slack--safe-reaction-echo-description)) ;; ----------------------------- Notifications --------------------------------- +;; Mirrors signel's notification hardening (body truncation, sound gating, +;; script-with-fallback delivery). The shared cj/messenger-notify extraction +;; that collapses the two copies belongs to the messenger-unification task. + +(defcustom cj/slack-notify-sound nil + "When non-nil, Slack notifications play the notify script's sound. +Nil (the default) passes --silent so the toast is visual only." + :type 'boolean + :group 'slack) + +(defconst cj/slack--notify-body-max 120 + "Maximum character length of a desktop-notification body. +Longer message text truncates to this length ending in an ellipsis; +the full text is always in the Slack buffer.") + +(defun cj/slack--format-notify-body (text) + "Collapse whitespace in TEXT and truncate it for a notification body. +Whitespace runs (including newlines) become single spaces, the result +is trimmed, and anything over `cj/slack--notify-body-max' characters +truncates to that length with a trailing ellipsis." + (let ((flat (string-trim (replace-regexp-in-string "[ \t\n\r]+" " " text)))) + (if (<= (length flat) cj/slack--notify-body-max) + flat + (concat (substring flat 0 (1- cj/slack--notify-body-max)) "…")))) + +(defun cj/slack--send-notification (title body) + "Deliver a desktop notification with TITLE and BODY. +Routes through the external notify script when it is on PATH (type +info, sound gated by `cj/slack-notify-sound'), falling back to +`notifications-notify' otherwise. Previously a missing script made +`start-process' error inside the caller's condition-case, so the +notification silently vanished." + (let ((script (executable-find "notify"))) + (if script + (apply #'start-process "slack-notify" nil script "info" title body + (unless cj/slack-notify-sound (list "--silent"))) + ;; notifications.el is not autoloaded; load it on the first fallback. + (unless (fboundp 'notifications-notify) + (require 'notifications)) + (notifications-notify :title title :body body)))) (defun cj/slack-notify (message room team) "Send desktop notification for DMs and @mentions only. @@ -218,18 +262,17 @@ swallows exceptions via `websocket-try-callback'." (when (and (not (slack-message-minep message team)) (or (slack-im-p room) (slack-message-mentioned-p message team))) - (let ((title (format "Slack: %s" (slack-room-display-name room team))) - (body (or (slack-message-body message team) ""))) - (start-process "slack-notify" nil - "notify" "info" title body))) + (cj/slack--send-notification + (format "Slack: %s" (slack-room-display-name room team)) + (cj/slack--format-notify-body + (or (slack-message-body message team) "")))) (error (message "cj/slack-notify error: %S" err)))) (defun cj/slack-test-notify () "Send a test desktop notification to verify the notify pipeline works." (interactive) (condition-case err - (start-process "slack-notify-test" nil - "notify" "info" "Slack: Test" "Notification pipeline works") + (cj/slack--send-notification "Slack: Test" "Notification pipeline works") (error (message "cj/slack-test-notify error: %S" err)))) (defun cj/slack-mark-read-and-bury () diff --git a/modules/system-commands.el b/modules/system-commands.el index de5e8853..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) @@ -115,8 +118,21 @@ actions like shutdown and reboot), nil for no confirmation." ;; directly: logind emits the Lock signal, hypridle catches it and runs its ;; lock_cmd (hyprlock), the same path idle/before-sleep locking already uses. ;; X11 machines keep slock. -(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd - (if (env-wayland-p) "loginctl lock-session" "slock")) +;; +;; Unlike its siblings, the locker is resolved at COMMAND time, not baked into +;; the defvar at load: a daemon started before WAYLAND_DISPLAY reaches its +;; environment would freeze the locker to slock forever, and Lock would then +;; fail silently on Wayland. `lockscreen-cmd' stays as an override knob. +(defvar lockscreen-cmd nil + "Explicit lock command, overriding session-type resolution when non-nil.") + +(defun cj/system-cmd-lock () + "Lock the session, resolving the locker from the live session type. +Runs `lockscreen-cmd' when set; otherwise `loginctl lock-session' on +Wayland and slock on X11, decided per call via `env-wayland-p'." + (interactive) + (cj/system-cmd (or lockscreen-cmd + (if (env-wayland-p) "loginctl lock-session" "slock")))) (cj/defsystem-command cj/system-cmd-suspend suspend-cmd "systemctl suspend" t) (cj/defsystem-command cj/system-cmd-shutdown shutdown-cmd "systemctl poweroff" strong) (cj/defsystem-command cj/system-cmd-reboot reboot-cmd "systemctl reboot" strong) diff --git a/modules/system-defaults.el b/modules/system-defaults.el index 7f369a5e..d9ec1878 100644 --- a/modules/system-defaults.el +++ b/modules/system-defaults.el @@ -55,6 +55,10 @@ (expand-file-name "comp-warnings.log" user-emacs-directory) "File where native-comp warnings will be appended.") +(defvar cj/comp-warnings-log-max-bytes (* 512 1024) + "Cap on `comp-warnings-log' size. Once it exceeds this, the log is reset +before the next write, so native-comp warnings can't grow it without bound.") + (defun cj/log-comp-warning (type message &rest args) "Log native-comp warnings of TYPE with MESSAGE & ARGS. Log to buffer `comp-warnings-log'. Suppress warnings from appearing in the @@ -62,13 +66,24 @@ Log to buffer `comp-warnings-log'. Suppress warnings from appearing in the timestamp to the file specified by `comp-warnings-log'. Return non-nil to indicate the warning was handled." (when (memq 'comp (if (listp type) type (list type))) - (with-temp-buffer - (insert (format-time-string "[%Y-%m-%d %H:%M:%S] ")) - (insert (if (stringp message) - (apply #'format message args) - (format "%S %S" message args))) - (insert "\n") - (append-to-file (point-min) (point-max) comp-warnings-log)) + ;; Reset the log if it has grown past the cap, so async comp warnings can't + ;; grow it without bound. + (when (ignore-errors + (> (or (file-attribute-size (file-attributes comp-warnings-log)) 0) + cj/comp-warnings-log-max-bytes)) + (ignore-errors (delete-file comp-warnings-log))) + ;; Guard the write: this runs as `:before-until' advice on `display-warning', + ;; so a signal here (an unwritable log path) would propagate out and break + ;; warning display for every async comp notice. Swallow the failure; the + ;; warning stays suppressed either way. + (ignore-errors + (with-temp-buffer + (insert (format-time-string "[%Y-%m-%d %H:%M:%S] ")) + (insert (if (stringp message) + (apply #'format message args) + (format "%S %S" message args))) + (insert "\n") + (append-to-file (point-min) (point-max) comp-warnings-log))) ;; Return non-nil to tell `display-warning' “we handled it.” t)) @@ -212,8 +227,9 @@ appears only once per session." (setq ad-redefinition-action 'accept) ;; silence warnings about advised functions getting redefined. (setq large-file-warning-threshold nil) ;; open files regardless of size (setq use-short-answers t) ;; single-key y/n for ordinary yes-or-no-p prompts - ;; (irreversible actions use `cj/confirm-strong', which - ;; forces a typed "yes" by binding this nil for that call) + ;; (irreversible actions use `cj/confirm-destructive', + ;; also one key, but it ignores RET and space so a stray + ;; keystroke re-prompts instead of confirming) (setq auto-revert-verbose nil) ;; turn off auto revert messages (setq custom-safe-themes t) ;; treat all themes as safe (stop asking) (setq server-client-instructions nil) ;; I already know what to do when done with the frame diff --git a/modules/system-lib.el b/modules/system-lib.el index f1049c02..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. @@ -164,6 +195,22 @@ contributes its own modes regardless of load order." (setq font-lock-global-modes (cj/--font-lock-global-modes-excluding font-lock-global-modes mode)))) +;; Declared special here for the compiler; marginalia owns the defvar. +(defvar marginalia-annotator-registry) + +(defun cj/completion-ensure-marginalia-align (category) + "Register CATEGORY with marginalia as builtin-annotated, once. +A custom completion category bypasses marginalia entirely, so the table's +own annotation function renders unaligned even with `marginalia-align' +set. A builtin registry entry tells marginalia to use the table's +annotation function inside its aligned field, so custom annotations line +up like every stock category. A category that already has an entry is +left alone (someone chose its annotators deliberately). Silent no-op +when marginalia isn't loaded." + (when (and (boundp 'marginalia-annotator-registry) + (not (assq category marginalia-annotator-registry))) + (push (list category 'builtin 'none) marginalia-annotator-registry))) + (defun cj/completion-table (category collection) "Return a completion table over COLLECTION tagged with completion CATEGORY. COLLECTION is anything `completing-read' accepts (list, alist, obarray, hash @@ -180,7 +227,9 @@ the candidates match one; marginalia then annotates them with no further work." "Like `cj/completion-table' but also attach ANNOTATE as the annotation function. ANNOTATE is called with a candidate string and returns its annotation suffix, or nil. Use this for a custom CATEGORY that marginalia has no built-in annotator -for: marginalia falls back to the table's own annotation function." +for; the category is registered with marginalia (builtin) so ANNOTATE's output +renders right-aligned like stock annotations." + (cj/completion-ensure-marginalia-align category) (lambda (string predicate action) (if (eq action 'metadata) `(metadata (category . ,category) diff --git a/modules/telega-config.el b/modules/telega-config.el index 0ae5116b..5a20d430 100644 --- a/modules/telega-config.el +++ b/modules/telega-config.el @@ -48,13 +48,132 @@ ;;; Code: (require 'keybindings) +(require 'system-lib) ; cj/log-silently, used by the death alert (use-package telega :defer t :ensure nil :commands (telega) :custom - (telega-use-docker t)) + (telega-use-docker t) + :config + ;; Without this, incoming Telegram messages are invisible unless their + ;; buffer is on screen -- telega ships desktop notifications but leaves + ;; the mode off by default. Runs at telega load (M-x telega), respects + ;; telega's own per-chat mute settings. From the 2026-06 config audit; + ;; routing through a shared messenger notifier is the unification task. + (telega-notifications-mode 1)) + +;; --------------------------- 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.64" and max is nil, so that test never passes and the image is always +;; "zevlg/telega-server:latest" -- a floating tag. The elpa package is fixed +;; at whatever version was installed, so the server can be replaced underneath +;; a static elisp without anything announcing it. +;; +;; Pinning by digest names one immutable image. Set to nil to hand the choice +;; back to telega. + +(defcustom cj/telega-docker-image + "zevlg/telega-server@sha256:a4b88e029ba381eca7c37c9618c9e3ad73aa9db2097fe07a0c6684d40d32b84e" + "Container image reference for `telega-server', or nil for telega's default. +Pin by digest rather than tag: a tag can be re-pushed upstream, a digest +cannot. The default is the image carrying libtdjson 1.8.64, which matches +this telega's `telega-tdlib-min-version'." + :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 () "Launch telega.el with a helpful message when it isn't installed yet. diff --git a/modules/test-runner.el b/modules/test-runner.el index 7f157f1c..6cb35275 100644 --- a/modules/test-runner.el +++ b/modules/test-runner.el @@ -139,9 +139,11 @@ if not found or not in a project." (t cj/test-global-directory)))))) (defun cj/test--get-test-files () - "Return list of test file names (without path) in test directory." + "Return list of test file names (without path) in test directory. +Returns nil when no test directory is available (outside a project +with `cj/test-global-directory' unset)." (let ((dir (cj/test--get-test-directory))) - (when (file-directory-p dir) + (when (and dir (file-directory-p dir)) (mapcar #'file-name-nondirectory (directory-files dir t "^test-.*\\.el$"))))) @@ -169,6 +171,8 @@ Returns: (cons \\='success loaded-count) on success, (interactive) (cj/test--ensure-test-dir-in-load-path) (let ((dir (cj/test--get-test-directory))) + (unless dir + (user-error "No test directory: not in a project and cj/test-global-directory is unset")) (unless (file-directory-p dir) (user-error "Test directory %s does not exist" dir)) (let ((test-files (directory-files dir t "^test-.*\\.el$"))) @@ -200,11 +204,12 @@ Returns: \\='success if added successfully, (cj/test--ensure-test-dir-in-load-path) (let* ((focused-files (cj/test--current-focused-files)) (dir (cj/test--get-test-directory)) - (available-files (when (file-directory-p dir) + (available-files (when (and dir (file-directory-p dir)) (mapcar #'file-name-nondirectory (directory-files dir t "^test-.*\\.el$"))))) (if (null available-files) - (user-error "No test files found in %s" dir) + (user-error "No test files found in %s" + (or dir "any test directory (not in a project)")) (let* ((unfocused-files (cl-set-difference available-files focused-files :test #'string=)) diff --git a/modules/tramp-config.el b/modules/tramp-config.el index f2bc8457..1c8a8ab9 100644 --- a/modules/tramp-config.el +++ b/modules/tramp-config.el @@ -26,6 +26,7 @@ ;; Silence byte-compiler "assignment to free variable" warnings for vars ;; defined by lazily-loaded packages (tramp, dirtrack, magit). These are ;; only set inside the use-package :config block, after the package loads. +(defvar ange-ftp-try-passive-mode) (defvar tramp-copy-size-limit) (defvar tramp-use-ssh-controlmaster-options) (defvar tramp-cleanup-idle-time) @@ -76,9 +77,10 @@ ;; Cache remote file attributes for better performance (setq remote-file-name-inhibit-cache nil) - ;; Don't check for modified buffers before revert - ;; to avoid unnecessary remote operations - (setq revert-without-query '(".*")) + ;; Skip the revert confirmation for remote files only, to avoid + ;; unnecessary remote round-trips. Scoped to the TRAMP path regexp so + ;; local files keep their normal revert prompt. + (setq revert-without-query (list tramp-file-name-regexp)) ;; Refresh buffers when needed rather than automatically (setq auto-revert-remote-files nil) @@ -119,21 +121,8 @@ ;; Default transfer method (use scp for most efficient transfer) (setq tramp-default-method "scp") - ;; Use different methods based on host/domain patterns - (add-to-list 'tramp-methods - '("sshfast" - (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") - ("-e" "none") ("-t" "-t") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-connection-timeout 10))) - ;; Remote shell and project settings - ;; Support for Docker containers - (add-to-list 'tramp-remote-path 'tramp-own-remote-path) + ;; Extend the remote PATH (tramp-own-remote-path already added above) (add-to-list 'tramp-remote-path "/usr/local/bin") (add-to-list 'tramp-remote-path "/usr/local/sbin") @@ -147,5 +136,11 @@ ;; Cleanup TRAMP buffers when idle (every 15 min) (setq tramp-cleanup-idle-time 900)) +;; FTP (ange-ftp) settings — TRAMP's /ftp: method delegates to ange-ftp. +;; Passive mode is required for servers that can't open a data connection +;; back to this machine (NAT, phone FTP servers); active mode hangs on LIST. +(with-eval-after-load 'ange-ftp + (setq ange-ftp-try-passive-mode t)) + (provide 'tramp-config) ;;; tramp-config.el ends here diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el index 21a04de9..e5b8dc00 100644 --- a/modules/undead-buffers.el +++ b/modules/undead-buffers.el @@ -96,7 +96,10 @@ Undead-buffers are buffers in `cj/undead-buffer-list'." (let ((buf (current-buffer))) (unless (one-window-p) (delete-window)) - (cj/kill-buffer-or-bury-alive buf))) + ;; The delegate reads current-prefix-arg; a C-u meant for this wrapper + ;; must not flip it into add-to-undead-list mode. + (let ((current-prefix-arg nil)) + (cj/kill-buffer-or-bury-alive buf)))) ;; Keybinding moved to custom-buffer-file.el (C-; b k) (defun cj/kill-other-window () @@ -109,7 +112,8 @@ window and acting would kill the buffer being viewed." (other-window 1) (let ((buf (current-buffer))) (delete-window) - (cj/kill-buffer-or-bury-alive buf))) + (let ((current-prefix-arg nil)) + (cj/kill-buffer-or-bury-alive buf)))) (keymap-global-set "M-S-o" #'cj/kill-other-window) (defun cj/kill-other-window-buffer () @@ -123,7 +127,8 @@ split is preserved. Buffers in `cj/undead-buffer-list' are buried." (if (one-window-p) (user-error "No other window") (with-selected-window (next-window) - (cj/kill-buffer-or-bury-alive (current-buffer))))) + (let ((current-prefix-arg nil)) + (cj/kill-buffer-or-bury-alive (current-buffer)))))) ;; Keybinding in custom-buffer-file.el (C-; b K) (defun cj/kill-all-other-buffers-and-windows () @@ -131,8 +136,9 @@ split is preserved. Buffers in `cj/undead-buffer-list' are buried." (interactive) (save-some-buffers nil #'cj/undead-buffer-p) (delete-other-windows) - (mapc #'cj/kill-buffer-or-bury-alive - (delq (current-buffer) (buffer-list)))) + (let ((current-prefix-arg nil)) + (mapc #'cj/kill-buffer-or-bury-alive + (delq (current-buffer) (buffer-list))))) (keymap-global-set "M-S-m" #'cj/kill-all-other-buffers-and-windows) ;; was M-M (provide 'undead-buffers) 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/vc-config.el b/modules/vc-config.el index 60fcaeb8..3da9266f 100644 --- a/modules/vc-config.el +++ b/modules/vc-config.el @@ -37,9 +37,13 @@ (defvar forge-pull-notifications) (defvar forge-topic-list-limit) +;; External package variables (buffer-local hunk list from git-gutter). +(defvar git-gutter:diffinfos) + ;; External package functions (from lazily-loaded packages). (declare-function git-gutter:next-hunk "git-gutter") (declare-function git-gutter:previous-hunk "git-gutter") +(declare-function git-gutter-hunk-start-line "git-gutter") (declare-function git-timemachine--start "git-timemachine") (declare-function git-timemachine--revisions "git-timemachine") (declare-function git-timemachine-show-revision "git-timemachine") @@ -100,8 +104,7 @@ (use-package git-timemachine :commands (git-timemachine - git-timemachine-show-revision - git-timemachine-show-selected-revision) + git-timemachine-show-revision) :init (defun cj/git-timemachine-show-selected-revision () "Displays git revisions of file in chronological order adding metadata." @@ -157,13 +160,33 @@ (forge-create-issue) (user-error "Not in a forge repository"))) +(defun cj/--git-gutter-hunk-candidates (start-lines) + "Build completion candidates for hunk START-LINES in the current buffer. +Each candidate is a cons of a \"LINE: text\" label and the line number." + (mapcar (lambda (line) + (cons (format "%4d: %s" line + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + line)) + start-lines)) + (defun cj/goto-git-gutter-diff-hunks () - "Jump to git-gutter diff hunks using consult. -Searches for lines starting with + or - (diff markers) and allows -interactive selection to jump to any changed line in the buffer." + "Jump to a git-gutter hunk in the current buffer chosen with completion." (interactive) (require 'git-gutter) - (consult-line "^[+\\-]")) + (let ((candidates (cj/--git-gutter-hunk-candidates + (mapcar #'git-gutter-hunk-start-line + (and (boundp 'git-gutter:diffinfos) + git-gutter:diffinfos))))) + (unless candidates + (user-error "No git-gutter hunks in this buffer")) + (let ((line (cdr (assoc (completing-read "Hunk: " candidates nil t) + candidates)))) + (goto-char (point-min)) + (forward-line (1- line))))) ;; ------------------------------ Git Clone Clipboard ----------------------------- ;; Quick git clone from clipboard URL @@ -180,6 +203,33 @@ scp form." (last (car (last (split-string trimmed "[/:]" t))))) (and last (file-name-sans-extension last)))) +(defun cj/--git-clone-open (clone-dir) + "Open CLONE-DIR's README when one exists, else `dired' the directory." + (let ((readme (seq-find + (lambda (file) + (string-match-p "\\`README" (upcase file))) + (directory-files clone-dir)))) + (if readme + (find-file (expand-file-name readme clone-dir)) + (dired clone-dir)))) + +(defun cj/--git-clone-make-sentinel (url clone-dir) + "Return a sentinel reporting the git clone of URL into CLONE-DIR. +On a zero exit the sentinel announces success and opens the clone; on +any other exit or a signal it surfaces the process buffer." + (lambda (process _event) + (when (memq (process-status process) '(exit signal)) + (if (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + (progn + (message "Cloned %s into %s" url clone-dir) + (cj/--git-clone-open clone-dir)) + (let ((buf (process-buffer process))) + (when (buffer-live-p buf) + (pop-to-buffer buf)) + (message "git clone of %s failed (status %s)" + url (process-exit-status process))))))) + (defun cj/git-clone-clipboard-url (url target-dir) "Clone git repository from clipboard URL to TARGET-DIR. @@ -187,11 +237,13 @@ With no prefix argument: uses first directory in `cj/git-clone-dirs'. With \\[universal-argument]: choose from `cj/git-clone-dirs'. With \\[universal-argument] \\[universal-argument]: choose any directory. -Clones with a direct `git' process (no shell), into a path derived -robustly from URL. Aborts with a clear message when the clipboard is -empty, the target is not a writable directory, the destination already -exists, or `git' exits non-zero. After a successful clone, opens the -repository's README if found, else `dired's the clone." +Clones with a direct asynchronous `git' process (no shell, no frozen +frames), into a path derived robustly from URL. Aborts with a clear +message when the clipboard is empty, the target is not a writable +directory, or the destination already exists. The process sentinel +reports the result: on success it opens the repository's README if +found (else `dired's the clone); on failure it surfaces the process +buffer." (interactive (list (current-kill 0) ;; Get URL from clipboard (cond @@ -219,21 +271,14 @@ repository's README if found, else `dired's the clone." (when (file-exists-p clone-dir) (user-error "Clone destination already exists: %s" clone-dir)) (message "Cloning %s into %s..." url clone-dir) - ;; Direct process, no shell. `--' stops option parsing so a URL - ;; beginning with `-' can't be read as a git flag. - (let ((status (call-process "git" nil "*git-clone*" nil - "clone" "--" url clone-dir))) - (unless (zerop status) - (pop-to-buffer "*git-clone*") - (user-error "git clone failed (exit %d); see *git-clone*" status))) - ;; Find and open README - (let ((readme (seq-find - (lambda (file) - (string-match-p "\\`README" (upcase file))) - (directory-files clone-dir)))) - (if readme - (find-file (expand-file-name readme clone-dir)) - (dired clone-dir)))))) + ;; Direct async process, no shell, so no emacsclient frame blocks + ;; for the duration of the clone. `--' stops option parsing so a + ;; URL beginning with `-' can't be read as a git flag. + (make-process + :name "git-clone" + :buffer "*git-clone*" + :command (list "git" "clone" "--" url clone-dir) + :sentinel (cj/--git-clone-make-sentinel url clone-dir))))) ;; -------------------------------- Difftastic --------------------------------- ;; Structural diffs for better git change visualization @@ -243,7 +288,7 @@ repository's README if found, else `dired's the clone." :defer t :commands (difftastic-magit-diff difftastic-magit-show) :bind (:map magit-blame-read-only-mode-map - ("D" . difftastic-magit-show) + ("D" . difftastic-magit-diff) ("S" . difftastic-magit-show)) :config (eval-after-load 'magit-diff diff --git a/modules/video-audio-recording-capture.el b/modules/video-audio-recording-capture.el index 41b72ebd..a56a5906 100644 --- a/modules/video-audio-recording-capture.el +++ b/modules/video-audio-recording-capture.el @@ -56,6 +56,10 @@ Checks if process is actually alive, not just if variable is set." ;;; Process Lifecycle (Sentinel and Graceful Shutdown) +;; Forward declaration: the real `defvar' is defined below with the other +;; recording thresholds. Declared special here so this reference compiles clean. +(defvar cj/recording-start-fail-threshold) + (defun cj/recording-process-sentinel (process event) "Sentinel for recording processes — handles unexpected exits. PROCESS is the ffmpeg shell process, EVENT describes what happened. @@ -76,9 +80,13 @@ is killed externally." (cj/recording--start-failed-p (- (float-time) start) cj/recording-start-fail-threshold)) ;; Died almost immediately and the user didn't stop it: wf-recorder - ;; couldn't grab the screen. Say so instead of silently clearing, - ;; so Craig isn't left blind-retrying (which bursts fragment files). - (message "Video recording failed to start (wf-recorder couldn't grab the screen). Try again.") + ;; couldn't grab the screen. Delete the ~0.5s stub file the failed + ;; start wrote (it would otherwise litter the recordings directory + ;; and get swept up by *.mkv globs downstream), then say so instead + ;; of silently clearing, so Craig isn't left blind-retrying. + (progn + (cj/recording--delete-failed-start-stub process) + (message "Video recording failed to start (wf-recorder couldn't grab the screen). Try again.")) (message "Video recording stopped: %s" (string-trim event)))))) (force-mode-line-update t))) @@ -129,13 +137,21 @@ launching too soon loses the grab and produces a ~0.5s fragment file." A failed wf-recorder start exits almost immediately; a real recording does not." (< elapsed threshold)) +(defun cj/recording--delete-failed-start-stub (process) + "Delete the stub output file a failed video start left behind. +Reads the output path from PROCESS's `cj-output-file' property (stamped +by `cj/ffmpeg-record-video'). A no-op when the property is absent (a +process started before the property existed) or the file never hit disk." + (let ((file (process-get process 'cj-output-file))) + (when (and file (file-exists-p file)) + (delete-file file)))) + ;;; Dependency Checks (defun cj/recording-check-ffmpeg () "Check if ffmpeg is available. Error if not found." (unless (executable-find "ffmpeg") - (user-error "Ffmpeg not found. Install with: sudo pacman -S ffmpeg") - nil) + (user-error "Ffmpeg not found. Install with: sudo pacman -S ffmpeg")) t) (defun cj/recording--wayland-p () @@ -146,8 +162,7 @@ A failed wf-recorder start exits almost immediately; a real recording does not." "Check if wf-recorder is available (needed for Wayland video capture)." (if (executable-find "wf-recorder") t - (user-error "wf-recorder not found. Install with: sudo pacman -S wf-recorder") - nil)) + (user-error "wf-recorder not found. Install with: sudo pacman -S wf-recorder"))) ;;; Device Acquisition and Validation @@ -332,8 +347,10 @@ Uses wf-recorder on Wayland, x11grab on X11." (set-process-query-on-exit-flag cj/video-recording-ffmpeg-process nil) (set-process-sentinel cj/video-recording-ffmpeg-process #'cj/recording-process-sentinel) ;; Stamp the start time so the sentinel can tell a ~0.5s failed start - ;; (wf-recorder couldn't grab the screen) from a normal recording. + ;; (wf-recorder couldn't grab the screen) from a normal recording, and + ;; the output path so the failed-start branch can delete the stub file. (process-put cj/video-recording-ffmpeg-process 'cj-start-time (float-time)) + (process-put cj/video-recording-ffmpeg-process 'cj-output-file filename) (force-mode-line-update t) (message "Started video recording to %s (%s, mic: %.1fx, system: %.1fx)." filename diff --git a/modules/video-audio-recording-devices.el b/modules/video-audio-recording-devices.el index 375a81cf..8adcd347 100644 --- a/modules/video-audio-recording-devices.el +++ b/modules/video-audio-recording-devices.el @@ -272,54 +272,6 @@ Returns the selected device name, or signals user-error if cancelled." (user-error "Device setup cancelled")) device)) -(defun cj/recording-group-devices-by-hardware () - "Group audio sources by physical hardware device. -Returns alist of (friendly-name . (mic-source . monitor-source)). -Only includes devices that have BOTH a mic and a monitor source, -since recording needs both to capture your voice and system audio." - (let ((sources (cj/recording-parse-sources)) - (devices (make-hash-table :test 'equal)) - (result nil)) - ;; Group sources by base device name (hardware identifier) - (dolist (source sources) - (let* ((device (nth 0 source)) - ;; Extract hardware ID — the unique part identifying the physical device. - ;; Different device types use different naming conventions in PulseAudio. - (base-name (cond - ;; USB devices: extract usb-XXXXX-XX part - ((string-match "\\.\\(usb-[^.]+\\-[0-9]+\\)\\." device) - (match-string 1 device)) - ;; Built-in (PCI) devices: extract pci-XXXXX part - ((string-match "\\.\\(pci-[^.]+\\)\\." device) - (match-string 1 device)) - ;; Bluetooth devices: extract and normalize MAC address - ;; (input uses colons, output uses underscores) - ((string-match "bluez_\\(?:input\\|output\\)\\.\\([^.]+\\)" device) - (replace-regexp-in-string "_" ":" (match-string 1 device))) - (t device))) - (is-monitor (string-match-p "\\.monitor$" device)) - (device-entry (gethash base-name devices))) - (unless device-entry - (setf device-entry (cons nil nil)) - (puthash base-name device-entry devices)) - (if is-monitor - (setcdr device-entry device) - (setcar device-entry device)))) - - ;; Convert hash table to alist with user-friendly names - (maphash (lambda (base-name pair) - (when (and (car pair) (cdr pair)) - (let ((friendly-name - (cond - ((string-match-p "usb.*[Jj]abra" base-name) "Jabra SPEAK 510 USB") - ((string-match-p "^usb-" base-name) "USB Audio Device") - ((string-match-p "^pci-" base-name) "Built-in Audio") - ((string-match-p "^[0-9A-Fa-f:]+$" base-name) "Bluetooth Headset") - (t base-name)))) - (push (cons friendly-name pair) result)))) - devices) - (nreverse result))) - (defun cj/recording-select-device (prompt device-type) "Interactively select an audio device. PROMPT is shown to user. DEVICE-TYPE is \\='mic or \\='monitor for filtering. 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/wrap-up.el b/modules/wrap-up.el index e28ba845..6901901f 100644 --- a/modules/wrap-up.el +++ b/modules/wrap-up.el @@ -23,12 +23,12 @@ "Bury comint and compilation buffers." (dolist (buf (buffer-list)) (with-current-buffer buf + ;; Byte-compilation output arrives in `emacs-lisp-compilation-mode', + ;; which derives from `compilation-mode' and so is covered by that clause. (when (or (derived-mode-p 'comint-mode) (derived-mode-p 'compilation-mode) (derived-mode-p 'debugger-mode) - (derived-mode-p 'elisp-compile-mode) - (derived-mode-p 'messages-buffer-mode) - ) ;; byte-compilations + (derived-mode-p 'messages-buffer-mode)) (bury-buffer))))) (defun cj/bury-buffers-after-delay () |