diff options
Diffstat (limited to 'chime.el')
| -rw-r--r-- | chime.el | 355 |
1 files changed, 263 insertions, 92 deletions
@@ -725,6 +725,59 @@ supported by your system." :type '(choice (const :tag "No sound" nil) (file :tag "Sound file path"))) +(defcustom chime-sound-player 'auto + "How `chime-sound-file' is played. + +Emacs' built-in `play-sound-file' opens an ALSA device directly and +blocks until the clip finishes. On a system whose ALSA `default' PCM +does not resolve -- common under PipeWire, where nothing points +`pcm.!default' at the sound server -- it fails outright with \"No usable +sound device driver found\". An external player avoids both problems: it +speaks to the sound server and it runs asynchronously. + +The value is one of: + +`auto' Use the first available player from + `chime--sound-player-candidates', falling back to + `play-sound-file' when none is installed. The default. +`emacs' Always use `play-sound-file'. +STRING Name or path of an external player command. It is invoked as + \"COMMAND SOUND-FILE\". Falls back to `play-sound-file' when + the command is not on `exec-path'." + :package-version '(chime . "0.8.0") + :group 'chime + :type '(choice (const :tag "Auto-detect an external player" auto) + (const :tag "Emacs' built-in play-sound-file" emacs) + (string :tag "External player command")) + :set (lambda (symbol value) + (unless (or (memq value '(auto emacs)) (stringp value)) + (user-error "%s must be `auto', `emacs', or a command name, got: %S" + symbol value)) + (set-default symbol value))) + +(defcustom chime-sound-device nil + "Sound device passed to Emacs' built-in `play-sound-file'. + +Only consulted when `play-sound-file' is used -- that is, when +`chime-sound-player' is `emacs', or when it is `auto' and no external +player was found. nil lets the system choose, which on Linux means the +ALSA `default' PCM. + +Set this when `default' is unusable but a named device works. Under +PipeWire that is usually \"pipewire\" or \"pulse\"; test a candidate with + + (play-sound-file \"/path/to/chime.wav\" nil \"pipewire\") + +before setting it here." + :package-version '(chime . "0.8.0") + :group 'chime + :type '(choice (const :tag "System default" nil) + (string :tag "Device name")) + :set (lambda (symbol value) + (unless (or (null value) (stringp value)) + (user-error "%s must be nil or a string, got: %S" symbol value)) + (set-default symbol value))) + (defcustom chime-startup-delay 10 "Seconds to wait before first event check after chime-mode is enabled. This delay allows org-agenda-files and related infrastructure to finish @@ -861,6 +914,14 @@ you theme it." Consulted by the watchdog in `chime--fetch-and-process' to detect a child that exceeded `chime-async-timeout'.") +(defvar chime--process-generation 0 + "Counter identifying the current async child. +Incremented on every spawn, and on every event that abandons a child (the +watchdog interrupt, and `chime--stop'). Each child's callback captures the +generation it was spawned under and compares it here, so a straggler that +returns after its child was abandoned can be discarded rather than clobber +the replacement child's state.") + (defvar chime--consecutive-async-failures 0 "Count of consecutive async check failures. After `chime-max-consecutive-failures' failures, a warning is displayed.") @@ -1257,20 +1318,26 @@ For timed events, checks if the time is today (past or future)." (defun chime--days-until-event (all-times) "Calculate minimum days until the soonest all-day timestamp in ALL-TIMES. ALL-TIMES is a list of (TIMESTAMP-STR . TIME-OBJECT) cons cells. -Returns integer days (ceiling), or nil if no all-day timestamps found." - (let ((now (current-time))) - (-min - (--map - (when-let* ((timestamp-str (car it)) - (is-all-day (not (chime--has-timestamp timestamp-str))) - (parsed (org-parse-time-string timestamp-str)) - (year (nth 5 parsed)) - (month (nth 4 parsed)) - (day (nth 3 parsed))) - (let* ((event-time (encode-time 0 0 0 day month year)) - (seconds-until (time-subtract event-time now))) - (ceiling (/ (float-time seconds-until) 86400.0)))) - all-times)))) +Returns integer days (ceiling), or nil if no all-day timestamps found. + +A timed timestamp contributes no day count, so an event mixing timed and +all-day timestamps yields nils that must be dropped before `-min' sees +them. An event with no all-day timestamp at all leaves nothing to +minimize, hence the nil return the docstring promises." + (let* ((now (current-time)) + (days (-non-nil + (--map + (when-let* ((timestamp-str (car it)) + (is-all-day (not (chime--has-timestamp timestamp-str))) + (parsed (org-parse-time-string timestamp-str)) + (year (nth 5 parsed)) + (month (nth 4 parsed)) + (day (nth 3 parsed))) + (let* ((event-time (encode-time 0 0 0 day month year)) + (seconds-until (time-subtract event-time now))) + (ceiling (/ (float-time seconds-until) 86400.0)))) + all-times)))) + (when days (-min days)))) (defun chime--day-wide-notification-text (event) "Generate notification text for day-wide EVENT. @@ -1285,6 +1352,10 @@ Handles both same-day events and advance notices." (is-advance-notice (let ((days-until (chime--days-until-event (chime--event-times event)))) (cond + ;; No all-day timestamp means no day count to report. The + ;; advance-notice window should have excluded such an event, so + ;; this is a belt-and-braces guard against a nil reaching `='. + ((null days-until) (format "%s is due or scheduled today" title)) ((= days-until 1) (format "%s is tomorrow" title)) ((= days-until 2) (format "%s is in 2 days" title)) (t (format "%s is in %d days" title days-until))))) @@ -1776,7 +1847,13 @@ because that is what real org-gcal exports use." "org-todo-keywords" "chime-alert-intervals" "chime-include-filters" - "chime-exclude-filters"))) + "chime-exclude-filters" + ;; The child sizes its agenda span from these two. The + ;; child requires chime, so an uninjected one is bound at + ;; its default there and a user's customization is + ;; silently ignored rather than erroring. + "chime-modeline-lookahead-minutes" + "chime-tooltip-lookahead-hours"))) string-end))) (defun chime--environment-regex () @@ -1838,6 +1915,71 @@ list of internal event alists." (chime--apply-exclude-filters) (-map 'chime--gather-info)))) +;;;; Sound Playback + +(defconst chime--sound-player-candidates + '("pw-play" "paplay" "afplay" "aplay") + "External player commands tried, in order, when `chime-sound-player' is `auto'. +Each is invoked as \"COMMAND SOUND-FILE\". Sound-server players come +first: they respect the user's default sink and per-application volume. +`aplay' is last because it talks to ALSA directly and so shares +`play-sound-file''s failure mode on a system with no usable `default' +PCM. `afplay' is the macOS player.") + +(defun chime--find-sound-player () + "Return the external player command to use, or nil to use `play-sound-file'. +Honors `chime-sound-player': `emacs' selects no player, a string selects +that command when it is installed, and `auto' picks the first installed +candidate from `chime--sound-player-candidates'." + (cond + ((eq chime-sound-player 'emacs) nil) + ((stringp chime-sound-player) + (and (executable-find chime-sound-player) chime-sound-player)) + (t (cl-find-if #'executable-find chime--sound-player-candidates)))) + +(defun chime--play-sound-external (player file) + "Play FILE by spawning PLAYER asynchronously. +Return the process on success, or nil if the spawn failed. Playback +itself is not awaited, so a clip never blocks the notification. + +Because the clip is not awaited, a player that starts and *then* fails -- +an unsupported file, or a device that turns out to be unusable -- can +only be caught after the fact. A sentinel reports that non-zero exit, so +the failure lands in *Messages* rather than vanishing into silence." + (condition-case nil + (let ((process (start-process "chime-sound" nil player file))) + (set-process-query-on-exit-flag process nil) + (set-process-sentinel + process + (lambda (proc _event) + (when (memq (process-status proc) '(exit signal)) + (let ((status (process-exit-status proc))) + (unless (zerop status) + (message "chime: Failed to play sound: %s exited with status %s" + player status)))))) + process) + (error nil))) + +(defun chime--play-sound () + "Play `chime-sound-file', when one is configured and present. +Prefer an external player and fall back to Emacs' `play-sound-file'. +A playback failure is reported but never signalled -- losing the sound +must not cost the user the visual notification. + +Return the player process when an external player was used, t when Emacs +played the file, and nil when nothing was played." + (when (and chime-sound-file (file-exists-p chime-sound-file)) + (let* ((player (chime--find-sound-player)) + (process (and player + (chime--play-sound-external player chime-sound-file)))) + (or process + (condition-case err + (progn (play-sound-file chime-sound-file nil chime-sound-device) t) + (error + (message "chime: Failed to play sound: %s" + (error-message-string err)) + nil)))))) + ;;;; Notification Dispatch (defun chime--notify (msg-severity) @@ -1847,21 +1989,23 @@ notification text and SEVERITY is one of high, medium, or low." (let* ((event-msg (if (consp msg-severity) (car msg-severity) msg-severity)) (severity (if (consp msg-severity) (cdr msg-severity) 'medium))) ;; Play sound if a file is configured (set chime-sound-file to nil to disable) - (when chime-sound-file - (condition-case err - (when (file-exists-p chime-sound-file) - (play-sound-file chime-sound-file)) - (error - (message "chime: Failed to play sound: %s" - (error-message-string err))))) - ;; Show visual notification - (apply - 'alert event-msg - :icon chime-notification-icon - :title chime-notification-title - :severity severity - :category 'chime - chime-extra-alert-plist))) + (chime--play-sound) + ;; Show visual notification. `chime--process-notifications' maps this + ;; over every due event, so an alert that signals -- a dbus error, a + ;; misbehaving notification daemon -- would drop every notification + ;; after it and be miscounted as a fetch failure by the caller's + ;; condition-case. Guard each event's alert on its own. + (condition-case err + (apply + 'alert event-msg + :icon chime-notification-icon + :title chime-notification-title + :severity severity + :category 'chime + chime-extra-alert-plist) + (error + (message "chime: Failed to show notification: %s" + (error-message-string err)))))) ;;;; Timestamp Parsing @@ -2038,48 +2182,28 @@ delimiters for unmatched openings. Returns sanitized title or empty string if TITLE is nil." (if (not title) "" - (let ((chars (string-to-list title)) - (stack '()) ; Stack to track opening delimiters in order + (let ((pairs '((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}))) + (stack '()) ; opening delimiters seen, most recent first (result '())) - ;; Process each character - (dolist (char chars) + (dolist (char (string-to-list title)) (cond - ;; Opening delimiters - add to stack and result - ((memq char '(?\( ?\[ ?\{)) + ;; Opening delimiter - remember it and keep it. + ((assq char pairs) (push char stack) (push char result)) - ;; Closing delimiters - check if they match - ((eq char ?\)) - (if (and stack (eq (car stack) ?\()) - (progn - (pop stack) - (push char result)) - ;; Unmatched closing paren - skip it - nil)) - ((eq char ?\]) - (if (and stack (eq (car stack) ?\[)) - (progn - (pop stack) - (push char result)) - ;; Unmatched closing bracket - skip it - nil)) - ((eq char ?\}) - (if (and stack (eq (car stack) ?\{)) - (progn - (pop stack) - (push char result)) - ;; Unmatched closing brace - skip it - nil)) - ;; Regular characters - add to result + ;; Closing delimiter - keep only when it closes the current opener; + ;; an unmatched closer is dropped. + ((rassq char pairs) + (when (and stack (eq (cdr (assq (car stack) pairs)) char)) + (pop stack) + (push char result))) + ;; Regular character. (t (push char result)))) - ;; Add closing delimiters for any remaining opening delimiters + ;; Close any still-open delimiters, innermost first. (dolist (opener stack) - (cond - ((eq opener ?\() (push ?\) result)) - ((eq opener ?\[) (push ?\] result)) - ((eq opener ?\{) (push ?\} result)))) - ;; Convert back to string (reverse because we built it backwards) + (push (cdr (assq opener pairs)) result)) + ;; Convert back to string (reverse because we built it backwards). (concat (nreverse result))))) (defun chime--extract-title (marker) @@ -2265,12 +2389,18 @@ When called programmatically, returns structured validation results." ;;;; Core Lifecycle (defun chime--stop () - "Stop the notification timer and cancel any in-progress check." + "Stop the notification timer and cancel any in-progress check. +Leaves no state behind: a later `chime-mode' must not resume with the old +failure count, a stale spawn time, or a callback from the child this stop +abandoned." (-some-> chime--timer (cancel-timer)) (setq chime--timer nil) - (when chime--process - (interrupt-process chime--process) - (setq chime--process nil)) + (chime--kill-async-process chime--process) + (setq chime--process nil) + (setq chime--process-start-time nil) + ;; Orphan the abandoned child's callback, if it is still in flight. + (cl-incf chime--process-generation) + (setq chime--consecutive-async-failures 0) ;; Reset validation state so it runs again on next start (setq chime--validation-done nil) (setq chime--validation-retry-count 0)) @@ -2363,15 +2493,40 @@ deprecated per-event property." (chime--maybe-warn-deprecated-properties events) (funcall callback events)) +(defun chime--kill-async-process (process) + "Kill PROCESS and reap the buffer async.el leaves behind. +Does nothing when PROCESS is nil or already dead. + +`interrupt-process' only asks: a child stuck in a blocking read ignores +SIGINT and survives as a zombie, invisible because `chime--process' has +already been cleared. `delete-process' does not ask. + +async.el's sentinel kills the child's process buffer only on a zero exit, +so a signalled child leaks its buffer. A persistent hang leaks one per +`chime-async-timeout' until Emacs restarts, which is why the buffer is +killed here rather than left to async. The sentinel is silenced first so +async cannot act on a child we have already abandoned." + (when (processp process) + (let ((buffer (process-buffer process))) + (set-process-sentinel process #'ignore) + (when (process-live-p process) + (delete-process process)) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + (defun chime--interrupt-stale-process () - "Interrupt an async child that has outlived `chime-async-timeout'. + "Kill an async child that has outlived `chime-async-timeout'. A child that never returns (e.g. stuck on an interactive prompt in batch mode) is invisible to every failure path — it returns no error sexp, so `chime--consecutive-async-failures' never increments while the overlap -guard silently skips every subsequent check. Interrupting it and -recording the timeout through `chime--record-async-failure' routes the -hang into the existing failure machinery and frees the next check to -spawn a fresh child. Does nothing when `chime-async-timeout' is nil." +guard silently skips every subsequent check. Killing it and recording the +timeout through `chime--record-async-failure' routes the hang into the +existing failure machinery and frees the next check to spawn a fresh +child. Does nothing when `chime-async-timeout' is nil. + +Bumping `chime--process-generation' orphans the abandoned child's +callback, so a straggler that returns just past the timeout cannot clobber +the replacement child's state." (when (and chime-async-timeout chime--process (process-live-p chime--process) @@ -2379,38 +2534,54 @@ spawn a fresh child. Does nothing when `chime-async-timeout' is nil." (> (float-time (time-subtract (current-time) chime--process-start-time)) chime-async-timeout)) - (interrupt-process chime--process) + (chime--kill-async-process chime--process) (setq chime--process nil) + (setq chime--process-start-time nil) + (cl-incf chime--process-generation) (chime--record-async-failure (list 'error (format "Async fetch exceeded chime-async-timeout (%ds)" chime-async-timeout)) "Async watchdog"))) +(defun chime--handle-async-result (generation callback events) + "Handle EVENTS returned by the async child spawned under GENERATION. +CALLBACK receives the events on success. + +Discards the result when GENERATION is no longer current — the child was +abandoned by the watchdog or by `chime--stop', and a replacement may +already be running. Acting on a straggler would clear the replacement's +process handle (breaking the overlap guard, so a third child could spawn) +and reset the failure counter the watchdog had just incremented." + (when (= generation chime--process-generation) + (setq chime--process nil) + (setq chime--process-start-time nil) + (setq chime--last-check-time (current-time)) + (condition-case err + (if (and (listp events) + (eq (car events) 'async-signal)) + (chime--record-async-failure (cdr events) "Async error") + (chime--handle-async-success callback events)) + (error + (chime--record-async-failure err "Error processing events"))))) + (defun chime--fetch-and-process (callback) "Asynchronously fetch events from agenda and invoke CALLBACK with them. Manages async process state and last-check-time internally. Does nothing if a check is already in progress, unless that check has -exceeded `chime-async-timeout' — then it is interrupted and replaced." +exceeded `chime-async-timeout' — then it is killed and replaced." (chime--interrupt-stale-process) (unless (and chime--process (process-live-p chime--process)) (setq chime--process-start-time (current-time)) - (setq chime--process - (let ((default-directory user-emacs-directory) - (async-prompt-for-password nil) - (async-process-noquery-on-exit t)) - (async-start - (chime--retrieve-events) - (lambda (events) - (setq chime--process nil) - (setq chime--last-check-time (current-time)) - (condition-case err - (if (and (listp events) - (eq (car events) 'async-signal)) - (chime--record-async-failure (cdr events) "Async error") - (chime--handle-async-success callback events)) - (error - (chime--record-async-failure err "Error processing events"))))))))) + (let ((generation (cl-incf chime--process-generation))) + (setq chime--process + (let ((default-directory user-emacs-directory) + (async-prompt-for-password nil) + (async-process-noquery-on-exit t)) + (async-start + (chime--retrieve-events) + (lambda (events) + (chime--handle-async-result generation callback events)))))))) (defun chime--log-silently (format-string &rest args) "Append formatted message to *Messages* buffer without echoing. |