diff options
Diffstat (limited to 'modules')
50 files changed, 1776 insertions, 581 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 be84ef25..906abd00 100644 --- a/modules/ai-term-backend-eat.el +++ b/modules/ai-term-backend-eat.el @@ -100,8 +100,11 @@ typed into a bare shell. Returns the poll timer." (cancel-timer timer)))))) timer)) -(defun cj/--ai-term-show-or-create (dir name &optional agent-command) +(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 @@ -135,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 @@ -159,12 +163,14 @@ buffer." 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-sessions.el b/modules/ai-term-sessions.el index 58532f7e..57d735d1 100644 --- a/modules/ai-term-sessions.el +++ b/modules/ai-term-sessions.el @@ -121,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. @@ -334,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 @@ -351,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 bedc0681..52494c18 100644 --- a/modules/ai-term.el +++ b/modules/ai-term.el @@ -351,16 +351,18 @@ 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)) (existing (get-buffer name)) (fresh (and (not (and existing (cj/--ai-term-process-live-p existing))) - (not (cj/--ai-term-session-active-p - dir (cj/--ai-term-live-tmux-sessions))))) + (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))) + (buf (cj/--ai-term-show-or-create dir name command sessions))) (unless arg (let ((win (get-buffer-window buf))) (when win (select-window win)))) @@ -458,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) @@ -486,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 @@ -512,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 @@ -530,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 ------------------------- ;; 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-recurrence.el b/modules/calendar-sync-recurrence.el index a3bd4dc4..9ef12ce5 100644 --- a/modules/calendar-sync-recurrence.el +++ b/modules/calendar-sync-recurrence.el @@ -498,11 +498,27 @@ DTSTART's month, landing each occurrence on the day its BYDAY rule selects 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." +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--add-months))) + 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). diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index 804d71fa..d504f246 100644 --- a/modules/calendar-sync.el +++ b/modules/calendar-sync.el @@ -300,16 +300,28 @@ When called non-interactively with nil, syncs all calendars." ;;; 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 () 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 d5aa501d..c7ff39dc 100644 --- a/modules/dashboard-config.el +++ b/modules/dashboard-config.el @@ -73,6 +73,7 @@ ;; 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 @@ -84,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. diff --git a/modules/dev-fkeys.el b/modules/dev-fkeys.el index 0f120a8d..c760e392 100644 --- a/modules/dev-fkeys.el +++ b/modules/dev-fkeys.el @@ -364,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/dirvish-config.el b/modules/dirvish-config.el index ef41ab33..edbb0b35 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) 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/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 306db94f..f7f09816 100644 --- a/modules/external-open.el +++ b/modules/external-open.el @@ -197,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/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index ebe4898e..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 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/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/media-utils.el b/modules/media-utils.el index 99b5dc37..7047411f 100644 --- a/modules/media-utils.el +++ b/modules/media-utils.el @@ -210,6 +210,32 @@ with a plain argv list -- no shell anywhere in the pipeline." ;; ------------------------- 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") @@ -223,16 +249,8 @@ with a plain argv list -- no shell anywhere in the pipeline." (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-org-contacts-integration.el b/modules/mu4e-org-contacts-integration.el index fc0a7325..a143bdc4 100644 --- a/modules/mu4e-org-contacts-integration.el +++ b/modules/mu4e-org-contacts-integration.el @@ -60,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))) diff --git a/modules/music-config.el b/modules/music-config.el index 78ea49d9..92b04782 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) @@ -372,6 +374,11 @@ point until it ends; the snap lands when the search exits." (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 @@ -787,6 +794,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 @@ -822,7 +833,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) @@ -864,7 +875,7 @@ clears its file association." (let ((file (cj/music--select-m3u-file "Delete playlist: "))) (if (not file) (message "Playlist deletion cancelled") - (unless (cj/confirm-strong (format "Delete playlist %s? " + (unless (cj/confirm-destructive (format "Delete playlist %s? " (file-name-nondirectory file))) (user-error "Aborted deleting playlist")) (cj/music--delete-playlist-file file) @@ -1062,9 +1073,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) @@ -1374,12 +1386,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 D:delete 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) @@ -1457,6 +1469,12 @@ redisplay this move triggers doesn't loop. Always returns nil." (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. Anchors at the displaying window's start (see @@ -1589,19 +1607,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) @@ -1627,7 +1648,6 @@ unless fancy." ("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) @@ -2081,14 +2101,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 3cff9d95..20714d5d 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -20,21 +20,25 @@ ;; keep normal agenda opens fast. ;;; Code: +(require 'seq) (require 'user-constants) (require 'system-lib) (require 'cj-cache-lib) -(defcustom cj/org-agenda-window-height 0.75 - "Fraction of the selected frame used for the org agenda window." - :type 'number - :group 'org-agenda) - (defun cj/--org-agenda-display-rule () - "Return the display-buffer rule for the org agenda buffer." - `("\\*Org Agenda\\*" - (display-buffer-reuse-mode-window display-buffer-below-selected) - (dedicated . t) - (window-height . ,cj/org-agenda-window-height))) + "Return the display-buffer rule for the org agenda buffer. +`display-buffer-full-frame' gives the agenda the whole frame rather than a +fraction of it, so the view is a surface you read rather than a strip you +squint at. `org-agenda-restore-windows-after-quit' (set below) is what +makes that non-destructive: quitting the agenda puts the previous window +layout back. + +The window is deliberately not `dedicated': with the agenda owning the only +window, a dedicated one leaves `org-agenda-switch-to' (RET on an item) with +nowhere to put the file, and it splits or opens a frame instead of simply +replacing the agenda." + '("\\*Org Agenda\\*" + (display-buffer-reuse-mode-window display-buffer-full-frame))) ;; Load debug functions if enabled (when (or (eq cj/debug-modules t) @@ -65,7 +69,12 @@ ;; that reaches `org-agenda-files' another way. (setq org-agenda-skip-unavailable-files t) - ;; display the agenda from the bottom + ;; The agenda takes the whole frame, so quitting it has to give the previous + ;; window layout back -- otherwise every F8 costs the arrangement of windows + ;; that were up when it was pressed. + (setq org-agenda-restore-windows-after-quit t) + + ;; display the agenda across the whole frame (add-to-list 'display-buffer-alist (cj/--org-agenda-display-rule)) @@ -75,6 +84,89 @@ (local-set-key (kbd "s-<left>") #'org-agenda-todo-previousset)))) +;; ---------------------------- Agenda Auto-Refresh ---------------------------- +;; A full-frame agenda is meant to be left up and glanced at, so it has to stay +;; current on its own: the now-line moves, and calendar-sync writes new events +;; into the agenda files behind it. One repeating timer rebuilds whichever +;; agenda is actually on screen. + +(defcustom cj/org-agenda-refresh-seconds 300 + "Cadence, in seconds, of the org-agenda auto-refresh. +The timer fires on wall-clock multiples of this value, so the default 300 +refreshes on the :00/:05/:10 marks rather than five minutes after whenever +the agenda happened to open." + :type 'integer + :group 'org-agenda) + +(defvar cj/--org-agenda-refresh-timer nil + "The repeating auto-refresh timer, or nil when auto-refresh is stopped.") + +(declare-function org-agenda-redo "org-agenda" (&optional all)) + +(defun cj/--org-agenda-seconds-to-next-mark (time period) + "Return seconds from TIME to the next wall-clock multiple of PERIOD. +TIME is any Emacs time value; PERIOD is a positive number of seconds, so +300 gives the :00/:05 marks. A TIME landing exactly on a mark returns a +full PERIOD rather than zero, so the timer never fires twice back to back." + (unless (and (numberp period) (> period 0)) + (error "Refresh period must be a positive number of seconds: %S" period)) + (let ((remainder (mod (floor (float-time time)) period))) + (if (zerop remainder) period (- period remainder)))) + +(defun cj/--org-agenda-refresh-window () + "Return a live window displaying an org-agenda buffer, or nil. +Only a visible agenda is worth rebuilding: an off-screen one costs the same +full rescan and shows it to nobody, and it will be rebuilt on the next tick +after it comes back into view." + (seq-find (lambda (window) + (with-current-buffer (window-buffer window) + (derived-mode-p 'org-agenda-mode))) + (window-list-1 nil 'nomini 'visible))) + +(defun cj/--org-agenda-auto-refresh () + "Rebuild the on-screen agenda, leaving point on the line it was on. +Does nothing when no agenda is displayed. + +The body is wrapped in `condition-case' deliberately. This runs from a +repeating timer, where an unguarded signal resignals on every tick and +buries Emacs in identical backtraces -- the failure mode that made +calendar-sync's hourly timer unusable. A failed rebuild is logged and the +timer keeps its cadence." + (condition-case err + (when-let* ((window (cj/--org-agenda-refresh-window))) + (with-selected-window window + (let ((line (line-number-at-pos))) + (org-agenda-redo) + (goto-char (point-min)) + (forward-line (1- line))))) + (error + (cj/log-silently + (format "org-agenda auto-refresh failed: %s" (error-message-string err)))))) + +(defun cj/org-agenda-auto-refresh-start () + "Start the wall-clock-aligned agenda auto-refresh timer. +Cancels any existing timer first, so re-loading this module into a running +daemon replaces the ticker rather than stacking a second one." + (interactive) + (cj/org-agenda-auto-refresh-stop) + (setq cj/--org-agenda-refresh-timer + (run-at-time (cj/--org-agenda-seconds-to-next-mark + (current-time) cj/org-agenda-refresh-seconds) + cj/org-agenda-refresh-seconds + #'cj/--org-agenda-auto-refresh))) + +(defun cj/org-agenda-auto-refresh-stop () + "Cancel the agenda auto-refresh timer. A no-op when already stopped." + (interactive) + (when (timerp cj/--org-agenda-refresh-timer) + (cancel-timer cj/--org-agenda-refresh-timer)) + (setq cj/--org-agenda-refresh-timer nil)) + +;; Arm at load. Skipped under `noninteractive' so a batch test run doesn't +;; carry a live repeating timer it has nothing to refresh. +(unless noninteractive + (cj/org-agenda-auto-refresh-start)) + ;; ----------------------- Project-name Category Override --------------------- ;; The default `org-category' for a todo.org buffer is "todo" (the filename ;; without extension), which renders as "todo:" in every agenda `%c' column @@ -107,17 +199,27 @@ nil so the org default category applies." (defun cj/--org-set-todo-category () "Set buffer-local `org-category' to the project name for a todo.org buffer. -Runs from `org-mode-hook'. Only overrides when `org-category' is still -the default-from-filename (\"todo\"), so an explicit `#+CATEGORY:' in -the file keeps precedence." +Runs from `org-mode-hook'. Only overrides when nothing has set +`org-category', so an explicit `#+CATEGORY:' in the file keeps precedence. + +The nil test is the whole guard, and it took a while to get right. Org does +not assign the filename fallback to `org-category': with no `#+CATEGORY:' the +variable stays nil and `org-get-category' derives \"todo\" at read time. An +earlier version guarded on `(string= \"todo\" org-category)', which is a state +org never produces, so this hook did nothing from the day it shipped." (when (and buffer-file-name (boundp 'org-category) - (stringp org-category) - (string= "todo" org-category)) + (null org-category)) (when-let* ((project (cj/--org-todo-category-from-file buffer-file-name))) (setq-local org-category project)))) -(add-hook 'org-mode-hook #'cj/--org-set-todo-category) +;; Depth -100 so this runs FIRST, and it is load-bearing. `org-get-category' +;; resolves a deferred `:CATEGORY' that the org-element cache then holds, so any +;; hook that reads the category before this one freezes "todo" in that cache and +;; leaves the `setq-local' below inert -- `org-category' reads correct while the +;; agenda still shows "todo". `add-hook' prepends by default, so without the +;; depth every hook added later would run earlier, and three already do. +(add-hook 'org-mode-hook #'cj/--org-set-todo-category -100) ;; ------------------------ Org Agenda File List Cache ------------------------- ;; Cache agenda file list to avoid expensive directory scanning on every view. 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-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-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/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/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/slack-config.el b/modules/slack-config.el index 9eb9f838..e0ad5b75 100644 --- a/modules/slack-config.el +++ b/modules/slack-config.el @@ -197,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))) 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 54e20b74..bde53d82 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -130,16 +130,33 @@ Callers that must have a secret layer their own error on top." (secret (plist-get (car (apply #'auth-source-search spec)) :secret))) (if (functionp secret) (funcall secret) secret))) -;; ---------------------------- Strong 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))) +;; -------------------------- Destructive Confirmation ------------------------- + +(defun cj/confirm-destructive (prompt) + "Ask PROMPT for an irreversible action. Return non-nil for yes. + +One keystroke, y or n. Nothing else answers: a stray RET or space +re-prompts rather than confirming, so the accidental-confirm protection +survives without the answer costing four keystrokes. + +Pending input is discarded first, and that line is load-bearing. +`read-char-choice' reads from the input queue, so without it a keystroke +typed before the prompt appeared would confirm a shutdown or a file +deletion instantly. The typed-\"yes\" form this replaced absorbed such a +key harmlessly, and dropping the guard without replacing it would have +traded a rare annoyance for a rare catastrophe. + +This used to demand a typed \"yes\", and that was a worse trade than it +looked. On 2026-07-31 one such prompt went unanswered -- a second agent +session held the selected window while the prompt waited in another frame, +so keystrokes went to a terminal instead of the minibuffer, and the session +was killed with buffers unsaved. A single keystroke does not make a prompt +reachable when focus is elsewhere; C-g is still the escape either way. What +it changes is the cost of the situation, and losing unsaved buffers is a far +bigger hazard than a mis-keyed confirm." + (discard-input) + (eq ?y (downcase (read-char-choice (concat prompt "(y or n) ") + '(?y ?Y ?n ?N))))) (defun cj/--font-lock-global-modes-excluding (current mode) "Return CURRENT `font-lock-global-modes' with MODE added to the exclusion. diff --git a/modules/telega-config.el b/modules/telega-config.el index acc9e482..5a20d430 100644 --- a/modules/telega-config.el +++ b/modules/telega-config.el @@ -48,6 +48,7 @@ ;;; Code: (require 'keybindings) +(require 'system-lib) ; cj/log-silently, used by the death alert (use-package telega :defer t @@ -63,6 +64,117 @@ ;; 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/tramp-config.el b/modules/tramp-config.el index 95fa83db..1c8a8ab9 100644 --- a/modules/tramp-config.el +++ b/modules/tramp-config.el @@ -77,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) @@ -120,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") 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/video-audio-recording-capture.el b/modules/video-audio-recording-capture.el index 5e7860fc..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. @@ -147,8 +151,7 @@ process started before the property existed) or the file never hit disk." (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 () @@ -159,8 +162,7 @@ process started before the property existed) or the file never hit disk." "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 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/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 () |