diff options
| -rw-r--r-- | chime.el | 101 | ||||
| -rw-r--r-- | tests/test-chime-async-helpers.el | 59 | ||||
| -rw-r--r-- | tests/test-chime-intervals-for-marker.el | 49 |
3 files changed, 152 insertions, 57 deletions
@@ -786,6 +786,10 @@ Set to t to enable debug functions: "Count of consecutive async check failures. After `chime-max-consecutive-failures' failures, a warning is displayed.") +(defvar chime--deprecated-property-warned nil + "Non-nil once the deprecated per-event-property warning has fired this session. +The warning is shown at most once, so this stays set until Emacs restarts.") + (defvar chime--last-check-time (seconds-to-time 0) "Last time checked for events.") @@ -834,6 +838,10 @@ default for a specific environment, `setq' the variable in your init.") ;; (intervals . ((10 . medium) (0 . high))) ;; (marker-file . "/path/to/agenda.org") ;; (marker-pos . 1234)) +;; +;; When a heading sets its intervals through a deprecated per-event property, +;; the event also carries a `deprecated-property' key naming it, so the parent +;; process can warn the user once. (defconst chime--event-required-keys '(times title intervals) "Required keys for internal Chime event alists.") @@ -860,6 +868,10 @@ all-day timestamps." "Return EVENT's source buffer position, or nil for synthesized events." (cdr (assoc 'marker-pos event))) +(defun chime--event-deprecated-property (event) + "Return the deprecated property name that set EVENT's intervals, or nil." + (cdr (assoc 'deprecated-property event))) + (defun chime--event-time-entry-p (entry) "Return non-nil when ENTRY matches Chime's timestamp entry contract." (and (consp entry) @@ -902,15 +914,19 @@ can cross the async process boundary." (and (or (null marker-file) (stringp marker-file)) (or (null marker-pos) (integerp marker-pos)))))) -(defun chime--make-event (times title intervals &optional marker-file marker-pos) +(defun chime--make-event (times title intervals &optional marker-file marker-pos deprecated-property) "Create an internal Chime event alist. TIMES, TITLE, INTERVALS, MARKER-FILE, and MARKER-POS follow the contract -documented by `chime--valid-event-p'." +documented by `chime--valid-event-p'. DEPRECATED-PROPERTY, when non-nil, +is the name of a deprecated per-event property that supplied INTERVALS; it +is carried on the event so the parent process can warn the user once." (let ((event `((times . ,times) (title . ,title) (intervals . ,intervals) (marker-file . ,marker-file) - (marker-pos . ,marker-pos)))) + (marker-pos . ,marker-pos) + ,@(when deprecated-property + (list (cons 'deprecated-property deprecated-property)))))) (unless (chime--valid-event-p event) (error "Invalid Chime event: %S" event)) event)) @@ -1974,18 +1990,63 @@ Title is sanitized to prevent Lisp read syntax errors." (org-heading-components))) (chime--sanitize-title title)))) +(defun chime--parse-notify-before-value (value) + "Parse a per-event notify-before property VALUE string. +Return a non-negative integer number of minutes, or nil when VALUE is not +a string representing one. Negative, fractional, suffixed, empty, and nil +values all return nil." + (when (stringp value) + (let ((trimmed (string-trim value))) + (and (string-match-p "\\`[0-9]+\\'" trimmed) + (string-to-number trimmed))))) + +(defun chime--read-interval-override (marker property deprecated-name) + "Return (INTERVALS . DEPRECATED-NAME) when MARKER's PROPERTY is a valid override. +INTERVALS is ((MINUTES . medium)) for a non-negative integer property value. +Return nil when the property is absent. When the property is present but +malformed, log a message naming the heading and return nil so the caller +can fall through to the next source." + (let ((raw (org-entry-get marker property))) + (when raw + (let ((minutes (chime--parse-notify-before-value raw))) + (if minutes + (cons (list (cons minutes 'medium)) deprecated-name) + (message "chime: ignoring invalid :%s: value %S in heading %S" + property raw (chime--extract-title marker)) + nil))))) + +(defun chime--intervals-for-marker (marker) + "Return MARKER's alert intervals as a cons (INTERVALS . DEPRECATED-PROP). +When the heading sets `:CHIME_NOTIFY_BEFORE:' (or the deprecated +`:WILD_NOTIFIER_NOTIFY_BEFORE:' alias) to a non-negative integer N, +INTERVALS is ((N . medium)) and the global `chime-alert-intervals' is +ignored for this event. `:CHIME_NOTIFY_BEFORE:' wins when both are set. +DEPRECATED-PROP is the property name string when the deprecated alias +supplied the value, nil otherwise. Malformed property values are logged +and fall back to the global setting." + (or (chime--read-interval-override marker "CHIME_NOTIFY_BEFORE" nil) + (chime--read-interval-override marker "WILD_NOTIFIER_NOTIFY_BEFORE" + "WILD_NOTIFIER_NOTIFY_BEFORE") + (cons chime-alert-intervals nil))) + (defun chime--gather-info (marker) "Collect information about an event. MARKER acts like event's identifier. Returns file path and position instead of marker object for proper async serialization (markers can't be serialized across processes, -especially when buffer names contain angle brackets)." - (chime--make-event - (chime--extract-time marker) - (chime--extract-title marker) - chime-alert-intervals - (buffer-file-name (marker-buffer marker)) - (marker-position marker))) +especially when buffer names contain angle brackets). +Alert intervals come from `chime--intervals-for-marker', which honors a +per-event `:CHIME_NOTIFY_BEFORE:' property override." + (let* ((interval-spec (chime--intervals-for-marker marker)) + (intervals (car interval-spec)) + (deprecated (cdr interval-spec))) + (chime--make-event + (chime--extract-time marker) + (chime--extract-title marker) + intervals + (buffer-file-name (marker-buffer marker)) + (marker-position marker) + deprecated))) ;;;; Configuration Validation @@ -2164,6 +2225,20 @@ reaches `chime-max-consecutive-failures'. Only warns once at the threshold." chime--consecutive-async-failures) :warning))) +(defun chime--maybe-warn-deprecated-properties (events) + "Warn once per session if any of EVENTS used a deprecated per-event property. +Does nothing once the session guard `chime--deprecated-property-warned' is set." + (unless chime--deprecated-property-warned + (let ((event (cl-find-if #'chime--event-deprecated-property events))) + (when event + (setq chime--deprecated-property-warned t) + (display-warning + 'chime + (format "Heading %S uses the deprecated property :%s:.\nUse :CHIME_NOTIFY_BEFORE: instead." + (chime--event-title event) + (chime--event-deprecated-property event)) + :warning))))) + (defun chime--record-async-failure (err prefix) "Record an async failure ERR. PREFIX names the failure category in the log. Increments the consecutive-failure counter, sends a debug log when the @@ -2178,11 +2253,13 @@ persistent-failure warning, and switches the modeline to its error state." (defun chime--handle-async-success (callback events) "Process a successful async fetch. Invoke CALLBACK with EVENTS. -Resets the consecutive-failure counter and sends a debug-completion log -when the debug module is loaded." +Resets the consecutive-failure counter, sends a debug-completion log when +the debug module is loaded, and warns once per session if any event used a +deprecated per-event property." (setq chime--consecutive-async-failures 0) (when (featurep 'chime-debug) (chime--debug-log-async-complete events)) + (chime--maybe-warn-deprecated-properties events) (funcall callback events)) (defun chime--fetch-and-process (callback) diff --git a/tests/test-chime-async-helpers.el b/tests/test-chime-async-helpers.el index 86c5ed8..3e0e562 100644 --- a/tests/test-chime-async-helpers.el +++ b/tests/test-chime-async-helpers.el @@ -27,21 +27,32 @@ ;;; Code: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-time (expand-file-name "testutil-time.el")) ;;; Setup and Teardown (defun test-chime-async-helpers-setup () - "Reset counters and modeline state before each test." + "Reset counters, modeline state, and the deprecation-warning guard before each test." (setq chime--consecutive-async-failures 0) (setq chime-max-consecutive-failures 5) (setq chime-modeline-no-events-text "*") - (setq chime-modeline-string nil)) + (setq chime-modeline-string nil) + (setq chime--deprecated-property-warned nil)) (defun test-chime-async-helpers-teardown () - "Restore default state after each test." + "Restore default state after each test, including the deprecation-warning guard." (setq chime--consecutive-async-failures 0) (setq chime-max-consecutive-failures 5) - (setq chime-modeline-string nil)) + (setq chime-modeline-string nil) + (setq chime--deprecated-property-warned nil)) + +(defun test-chime-async-helpers--event (title &optional deprecated-property) + "Build a minimal valid Chime event alist with TITLE. +DEPRECATED-PROPERTY, when given, marks the event as having used a +deprecated per-event property of that name." + (let ((time (test-time-tomorrow-at 14 0))) + (chime--make-event (list (cons (test-timestamp-string time) time)) + title '((10 . medium)) nil nil deprecated-property))) ;;;; Tests for chime--record-async-failure @@ -103,19 +114,22 @@ (setq chime--consecutive-async-failures 3) (chime--handle-async-success (lambda (events) (setq called-with events)) - '(event1 event2)) + (list (test-chime-async-helpers--event "A") + (test-chime-async-helpers--event "B"))) (should (= 0 chime--consecutive-async-failures))) (test-chime-async-helpers-teardown))) (ert-deftest test-chime-handle-async-success-normal-invokes-callback-with-events () - "Normal: calls the supplied callback with the events list." + "Normal: calls the supplied callback with the events list verbatim." (test-chime-async-helpers-setup) (unwind-protect - (let ((called-with 'unset)) + (let* ((called-with 'unset) + (events (list (test-chime-async-helpers--event "A") + (test-chime-async-helpers--event "B")))) (chime--handle-async-success - (lambda (events) (setq called-with events)) - '(a b c)) - (should (equal '(a b c) called-with))) + (lambda (e) (setq called-with e)) + events) + (should (eq events called-with))) (test-chime-async-helpers-teardown))) (ert-deftest test-chime-handle-async-success-boundary-empty-events () @@ -134,13 +148,30 @@ "Boundary: counter starts at zero, stays at zero, callback still fires." (test-chime-async-helpers-setup) (unwind-protect - (let ((called-with 'unset)) + (let* ((called-with 'unset) + (events (list (test-chime-async-helpers--event "X")))) (setq chime--consecutive-async-failures 0) (chime--handle-async-success - (lambda (events) (setq called-with events)) - '(x)) + (lambda (e) (setq called-with e)) + events) (should (= 0 chime--consecutive-async-failures)) - (should (equal '(x) called-with))) + (should (eq events called-with))) + (test-chime-async-helpers-teardown))) + +(ert-deftest test-chime-handle-async-success-normal-warns-on-deprecated-property () + "Normal: warns once when an event used a deprecated per-event property." + (test-chime-async-helpers-setup) + (unwind-protect + (let ((warned nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (_type msg &rest _) (push msg warned)))) + (chime--handle-async-success + #'ignore + (list (test-chime-async-helpers--event "A") + (test-chime-async-helpers--event "B" "WILD_NOTIFIER_NOTIFY_BEFORE")))) + (should (= 1 (length warned))) + (should (string-match-p "WILD_NOTIFIER_NOTIFY_BEFORE" (car warned))) + (should chime--deprecated-property-warned)) (test-chime-async-helpers-teardown))) (provide 'test-chime-async-helpers) diff --git a/tests/test-chime-intervals-for-marker.el b/tests/test-chime-intervals-for-marker.el index 1d74077..9b73394 100644 --- a/tests/test-chime-intervals-for-marker.el +++ b/tests/test-chime-intervals-for-marker.el @@ -32,20 +32,22 @@ ;;; Code: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-time (expand-file-name "testutil-time.el")) (require 'cl-lib) ;;; Helpers (defun test-chime-intervals--org-heading-with-props (props) "Return org content for one heading whose drawer carries PROPS. -PROPS is a list of (NAME . VALUE) string pairs, or nil for no drawer." +PROPS is a list of (NAME . VALUE) string pairs, or nil for no drawer. +A dynamic timestamp is appended so `chime--gather-info' has one to extract." (concat "* Test Heading\n" (when props (concat ":PROPERTIES:\n" (mapconcat (lambda (p) (format ":%s: %s\n" (car p) (cdr p))) props "") ":END:\n")) - "<2026-05-12 Tue 14:00>\n")) + (test-timestamp-string (test-time-tomorrow-at 14 0)) "\n")) (defmacro test-chime-intervals--with-marker (props &rest body) "Run BODY in a temp org buffer with a heading carrying PROPS; bind `marker'." @@ -57,16 +59,6 @@ PROPS is a list of (NAME . VALUE) string pairs, or nil for no drawer." (let ((marker (point-marker))) ,@body))) -(defmacro test-chime-intervals--capture-messages (var &rest body) - "Run BODY with `message' calls captured into VAR (chronological)." - (declare (indent 1) (debug t)) - `(let ((,var nil)) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) - (push (apply #'format fmt args) ,var)))) - ,@body) - (setq ,var (nreverse ,var)))) - ;;; chime--parse-notify-before-value (ert-deftest test-chime-parse-notify-before-value-normal-and-boundary () @@ -116,18 +108,22 @@ PROPS is a list of (NAME . VALUE) string pairs, or nil for no drawer." (ert-deftest test-chime-intervals-for-marker-error-malformed-canonical-falls-back () "Error: a malformed :CHIME_NOTIFY_BEFORE: value logs and falls back to the global." - (let ((chime-alert-intervals '((10 . medium)))) + (let ((chime-alert-intervals '((10 . medium))) + (messages nil)) (test-chime-intervals--with-marker '(("CHIME_NOTIFY_BEFORE" . "soon")) - (test-chime-intervals--capture-messages messages + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (push (apply #'format fmt args) messages)))) (should (equal (cons '((10 . medium)) nil) (chime--intervals-for-marker marker)))) (should (cl-some (lambda (m) (string-match-p "CHIME_NOTIFY_BEFORE" m)) messages))))) (ert-deftest test-chime-intervals-for-marker-error-malformed-alias-falls-back () "Error: a malformed deprecated-alias value logs and falls back to the global." - (let ((chime-alert-intervals '((10 . medium)))) + (let ((chime-alert-intervals '((10 . medium))) + (messages nil)) (test-chime-intervals--with-marker '(("WILD_NOTIFIER_NOTIFY_BEFORE" . "-3")) - (test-chime-intervals--capture-messages messages + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (push (apply #'format fmt args) messages)))) (should (equal (cons '((10 . medium)) nil) (chime--intervals-for-marker marker)))) (should (cl-some (lambda (m) (string-match-p "WILD_NOTIFIER_NOTIFY_BEFORE" m)) messages))))) @@ -136,21 +132,15 @@ PROPS is a list of (NAME . VALUE) string pairs, or nil for no drawer." (ert-deftest test-chime-gather-info-integration-applies-canonical-override () "Integration: a heading with :CHIME_NOTIFY_BEFORE: 25 gathers an event with ((25 . medium))." - (with-temp-buffer - (org-mode) - (insert "* Meeting\n:PROPERTIES:\n:CHIME_NOTIFY_BEFORE: 25\n:END:\n<2026-05-12 Tue 14:00>\n") - (goto-char (point-min)) - (let ((event (chime--gather-info (point-marker)))) + (test-chime-intervals--with-marker '(("CHIME_NOTIFY_BEFORE" . "25")) + (let ((event (chime--gather-info marker))) (should (equal '((25 . medium)) (chime--event-intervals event))) (should-not (chime--event-deprecated-property event))))) (ert-deftest test-chime-gather-info-integration-flags-deprecated-alias () "Integration: a heading with the deprecated alias gathers an event carrying the deprecation flag." - (with-temp-buffer - (org-mode) - (insert "* Meeting\n:PROPERTIES:\n:WILD_NOTIFIER_NOTIFY_BEFORE: 20\n:END:\n<2026-05-12 Tue 14:00>\n") - (goto-char (point-min)) - (let ((event (chime--gather-info (point-marker)))) + (test-chime-intervals--with-marker '(("WILD_NOTIFIER_NOTIFY_BEFORE" . "20")) + (let ((event (chime--gather-info marker))) (should (equal '((20 . medium)) (chime--event-intervals event))) (should (string= "WILD_NOTIFIER_NOTIFY_BEFORE" (chime--event-deprecated-property event)))))) @@ -158,11 +148,8 @@ PROPS is a list of (NAME . VALUE) string pairs, or nil for no drawer." (ert-deftest test-chime-gather-info-integration-no-override-uses-global () "Integration: a heading without the property gathers with chime-alert-intervals." (let ((chime-alert-intervals '((10 . medium) (0 . high)))) - (with-temp-buffer - (org-mode) - (insert "* Meeting\n<2026-05-12 Tue 14:00>\n") - (goto-char (point-min)) - (let ((event (chime--gather-info (point-marker)))) + (test-chime-intervals--with-marker nil + (let ((event (chime--gather-info marker))) (should (equal '((10 . medium) (0 . high)) (chime--event-intervals event))) (should-not (chime--event-deprecated-property event)))))) |