aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-05-10 16:36:47 -0500
committerCraig Jennings <c@cjennings.net>2026-05-10 16:36:47 -0500
commit3c64dac1b98049d475be838294349326c32248ae (patch)
tree626917ca3660d34b48195a77123b1def3d418282
parent0772736d2bca36472f623d5258784f41db9b4f9a (diff)
downloadchime-3c64dac1b98049d475be838294349326c32248ae.tar.gz
chime-3c64dac1b98049d475be838294349326c32248ae.zip
feat: tighten chime runtime validation and tooltip behavior
-rw-r--r--chime.el611
-rw-r--r--tests/test-chime-day-wide-time-matching.el74
-rw-r--r--tests/test-chime-debug-functions.el39
-rw-r--r--tests/test-chime-event-contract.el103
-rw-r--r--tests/test-chime-modeline.el142
-rw-r--r--tests/test-chime-refresh-modeline.el92
-rw-r--r--tests/test-chime-tooltip-day-calculation.el358
-rw-r--r--tests/test-chime-validate-configuration.el74
-rw-r--r--tests/test-chime-validation-retry.el574
-rw-r--r--tests/testutil-events.el19
10 files changed, 1344 insertions, 742 deletions
diff --git a/chime.el b/chime.el
index de603ef..c9ac491 100644
--- a/chime.el
+++ b/chime.el
@@ -96,6 +96,27 @@ surfaces it as a configuration problem rather than a generic error."
(user-error "%s must be >= %d, got: %d" symbol min value))
(t value)))
+(defun chime--validate-day-wide-alert-times (symbol value)
+ "Reject bad day-wide alert time VALUE for SYMBOL at customize time.
+VALUE must be nil or a list of strings accepted by `org-get-time-of-day'
+as clock times within a single day. Returns VALUE on success."
+ (unless (listp value)
+ (user-error "%s must be nil or a list of time strings, got: %S"
+ symbol value))
+ (dolist (time-string value)
+ (unless (stringp time-string)
+ (user-error "%s entries must be strings, got: %S"
+ symbol time-string))
+ (let ((parsed-time (org-get-time-of-day time-string t)))
+ (unless parsed-time
+ (user-error "%s contains invalid time string: %S"
+ symbol time-string))
+ (let ((minutes (org-duration-to-minutes parsed-time)))
+ (unless (< -1 minutes 1440)
+ (user-error "%s time must be between 00:00 and 23:59, got: %S"
+ symbol time-string)))))
+ value)
+
(defcustom chime-alert-intervals '((10 . medium) (0 . high))
"Alert intervals with severity levels for upcoming events.
Each element is a cons cell (MINUTES . SEVERITY) where:
@@ -284,13 +305,19 @@ declined."
(defcustom chime-day-wide-alert-times '("08:00")
"List of time strings for day-wide event alerts.
Each string specifies a time of day when day-wide events should trigger.
+Accepted formats are the Org time-of-day formats accepted by
+`org-get-time-of-day', including 24-hour strings like \"08:00\" and
+12-hour strings like \"8:00am\".
Defaults to 08:00 (morning reminder for all-day events happening today).
Set to nil to disable all-day event notifications entirely.
Example: \\='(\"08:00\" \"17:00\") for morning and evening reminders."
:package-version '(chime . "0.6.0")
:group 'chime
- :type '(repeat string))
+ :type '(repeat string)
+ :set (lambda (symbol value)
+ (chime--validate-day-wide-alert-times symbol value)
+ (set-default symbol value)))
(defcustom chime-show-any-overdue-with-day-wide-alerts t
"Show any overdue TODO items along with day wide alerts whenever they are shown."
@@ -502,6 +529,111 @@ Result: \"Upcoming Events as of Tue Nov 04 2025 @ 08:25 PM\""
:group 'chime
:type 'string)
+(defcustom chime-tooltip-event-format "%t at %T %u"
+ "Format string for one event line in the tooltip.
+Available placeholders:
+ %t - Event title
+ %T - Event time, formatted per `chime-display-time-format-string'
+ %u - Time until event, wrapped in parentheses by default"
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-today-label "Today"
+ "Relative day label for today's events in the tooltip."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-tomorrow-label "Tomorrow"
+ "Relative day label for tomorrow's events in the tooltip."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-relative-day-format "%s, %b %d"
+ "Format string for today/tomorrow tooltip section labels.
+The first `%s' is replaced with `chime-tooltip-today-label' or
+`chime-tooltip-tomorrow-label'. Other format codes are passed to
+`format-time-string'."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-future-day-format "%A, %b %d"
+ "Format string for non-relative tooltip section labels.
+Passed to `format-time-string'."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-section-separator "─────────────"
+ "Separator text inserted below each tooltip day section heading."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-no-events-separator "─────────────────────"
+ "Separator text inserted below the no-events tooltip header."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-more-events-format "... and %d more event%s"
+ "Format string for the tooltip overflow line.
+The first format argument is the remaining event count. The second is
+the English plural suffix, either \"\" or \"s\", for backward-compatible
+defaults."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-countdown-wrapper "(%s)"
+ "Format string that wraps tooltip countdown text."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-countdown-prefix "in"
+ "Prefix used by tooltip-specific day/hour countdown text."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-day-unit-labels '("day" . "days")
+ "Singular and plural day unit labels for tooltip countdown text."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type '(cons (string :tag "Singular")
+ (string :tag "Plural")))
+
+(defcustom chime-tooltip-hour-unit-labels '("hour" . "hours")
+ "Singular and plural hour unit labels for tooltip countdown text."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type '(cons (string :tag "Singular")
+ (string :tag "Plural")))
+
+(defcustom chime-tooltip-no-events-format "No calendar events in\nthe next %s."
+ "Format string for no-events tooltip body.
+The single format argument is the lookahead timeframe."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-increase-lookahead-format "Increase `%s`\nto expand scope."
+ "Format string for no-events tooltip lookahead guidance.
+The single format argument is the option name to customize."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
+(defcustom chime-tooltip-left-click-label "Left-click: Open calendar"
+ "Tooltip text describing the left-click calendar action."
+ :package-version '(chime . "0.8.0")
+ :group 'chime
+ :type 'string)
+
(defcustom chime-sound-file
(expand-file-name "sounds/chime.wav"
(file-name-directory
@@ -601,8 +733,11 @@ After `chime-max-consecutive-failures' failures, a warning is displayed.")
"Last time checked for events.")
(defvar chime--upcoming-events nil
- "List of upcoming events with full data for tooltip and clicking.
-Each event includes marker, title, times, and intervals.")
+ "Cached tooltip event tuples for the current modeline state.
+Each element has the shape (EVENT TIME-INFO MINUTES-UNTIL), where EVENT
+is the internal event alist documented by `chime--valid-event-p',
+TIME-INFO is (TIMESTAMP-STRING . PARSED-TIME), and MINUTES-UNTIL is the
+numeric offset from the last modeline refresh time.")
(defvar chime--validation-done nil
"Whether configuration validation has been performed.
@@ -629,6 +764,99 @@ default for a specific environment, `setq' the variable in your init.")
;;;###autoload(put 'chime-modeline-string 'risky-local-variable t)
(put 'chime-modeline-string 'risky-local-variable t)
+;;;; Event Data Contract
+
+;; Internal events are serialized through async.el, so they intentionally use a
+;; plain alist instead of markers or structs. Keep all production event
+;; construction funneled through `chime--make-event' so the shape stays explicit.
+;;
+;; Example:
+;; ((times . (("<2026-05-10 Sun 09:30>" . (26760 32460))))
+;; (title . "Planning")
+;; (intervals . ((10 . medium) (0 . high)))
+;; (marker-file . "/path/to/agenda.org")
+;; (marker-pos . 1234))
+
+(defconst chime--event-required-keys '(times title intervals)
+ "Required keys for internal Chime event alists.")
+
+(defun chime--event-times (event)
+ "Return EVENT's timestamp entries.
+Each entry is (TIMESTAMP-STRING . PARSED-TIME). PARSED-TIME is nil for
+all-day timestamps."
+ (cdr (assoc 'times event)))
+
+(defun chime--event-title (event)
+ "Return EVENT's display title."
+ (cdr (assoc 'title event)))
+
+(defun chime--event-intervals (event)
+ "Return EVENT's alert intervals."
+ (cdr (assoc 'intervals event)))
+
+(defun chime--event-marker-file (event)
+ "Return EVENT's source org file path, or nil for synthesized events."
+ (cdr (assoc 'marker-file event)))
+
+(defun chime--event-marker-pos (event)
+ "Return EVENT's source buffer position, or nil for synthesized events."
+ (cdr (assoc 'marker-pos event)))
+
+(defun chime--event-time-entry-p (entry)
+ "Return non-nil when ENTRY matches Chime's timestamp entry contract."
+ (and (consp entry)
+ (stringp (car entry))
+ (let ((time-value (cdr entry)))
+ (or (null time-value)
+ (listp time-value)
+ (numberp time-value)))))
+
+(defun chime--event-interval-entry-p (entry)
+ "Return non-nil when ENTRY matches Chime's alert interval contract."
+ (and (consp entry)
+ (integerp (car entry))
+ (<= 0 (car entry))
+ (memq (cdr entry) '(high medium low))))
+
+(defun chime--valid-event-p (event)
+ "Return non-nil when EVENT follows Chime's internal event alist contract.
+
+The canonical event alist has these keys:
+- `times': list of (TIMESTAMP-STRING . PARSED-TIME) entries
+- `title': sanitized display string
+- `intervals': list of (MINUTES . SEVERITY) alert intervals
+- `marker-file': optional source org file path
+- `marker-pos': optional source buffer position
+
+`marker-file' and `marker-pos' are stored instead of marker objects so events
+can cross the async process boundary."
+ (and (listp event)
+ (--all? (assoc it event) chime--event-required-keys)
+ (listp (chime--event-times event))
+ (--all? (chime--event-time-entry-p it)
+ (chime--event-times event))
+ (stringp (chime--event-title event))
+ (listp (chime--event-intervals event))
+ (--all? (chime--event-interval-entry-p it)
+ (chime--event-intervals event))
+ (let ((marker-file (chime--event-marker-file event))
+ (marker-pos (chime--event-marker-pos event)))
+ (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)
+ "Create an internal Chime event alist.
+TIMES, TITLE, INTERVALS, MARKER-FILE, and MARKER-POS follow the contract
+documented by `chime--valid-event-p'."
+ (let ((event `((times . ,times)
+ (title . ,title)
+ (intervals . ,intervals)
+ (marker-file . ,marker-file)
+ (marker-pos . ,marker-pos))))
+ (unless (chime--valid-event-p event)
+ (error "Invalid Chime event: %S" event))
+ event))
+
;;;; Time/Date Utilities
(defun chime--time= (&rest list)
@@ -663,8 +891,8 @@ Each pair is ((TIMESTAMP . TIME-VALUE) (MINUTES . SEVERITY))."
;; then filter to pairs where the timestamp falls within the interval window.
;; Each result is ((ts-str . time-val) (minutes . severity)).
(->> (list
- (chime--filter-day-wide-events (cdr (assoc 'times event)))
- (cdr (assoc 'intervals event)))
+ (chime--filter-day-wide-events (chime--event-times event))
+ (chime--event-intervals event))
(apply '-table-flat (lambda (ts int) (list ts int)))
;; -table-flat pairs nil with intervals when times list is empty
(--filter (not (null (car it))))
@@ -721,7 +949,7 @@ Returns empty string if TITLE is nil."
STR-INTERVAL is (TIMESTAMP-STRING . (MINUTES . SEVERITY)).
Format is controlled by `chime-notification-text-format'.
Title is truncated per `chime-max-title-length' if set."
- (let* ((title (cdr (assoc 'title event)))
+ (let* ((title (chime--event-title event))
(minutes (car (cdr str-interval))))
(format-spec chime-notification-text-format
`((?t . ,(chime--truncate-title title))
@@ -795,7 +1023,7 @@ When nil:
(defun chime--event-has-any-day-wide-timestamp (event)
"Check if EVENT has any day-wide (no time component) timestamps."
(--any (not (chime--has-timestamp (car it)))
- (cdr (assoc 'times event))))
+ (chime--event-times event)))
(defun chime--event-within-advance-notice-window (event)
"Check if EVENT has any day-wide timestamps within advance notice window.
@@ -806,7 +1034,7 @@ where N is `chime-day-wide-advance-notice'."
;; Calculate time range: start of tomorrow to end of N days from now
(window-end (time-add now (seconds-to-time
(* 86400 (1+ chime-day-wide-advance-notice)))))
- (all-times (cdr (assoc 'times event))))
+ (all-times (chime--event-times event)))
(--any
(when-let* ((timestamp-str (car it))
;; Only check all-day events (those without time component)
@@ -844,7 +1072,7 @@ For all-day events, checks if the date is today or earlier."
(day (nth 3 parsed)))
(let ((event-date (encode-time 0 0 0 day month year)))
(not (time-less-p today-start event-date))))))
- (cdr (assoc 'times event)))))
+ (chime--event-times event))))
(defun chime--event-is-today (event)
"Check if EVENT has any timestamps that are specifically today (not past days).
@@ -871,7 +1099,7 @@ For timed events, checks if the time is today (past or future)."
(month (nth 4 parsed))
(day (nth 3 parsed)))
(time-equal-p (encode-time 0 0 0 day month year) today-start))))
- (cdr (assoc 'times event)))))
+ (chime--event-times event))))
(defun chime--days-until-event (all-times)
"Calculate minimum days until the soonest all-day timestamp in ALL-TIMES.
@@ -894,7 +1122,7 @@ Returns integer days (ceiling), or nil if no all-day timestamps found."
(defun chime--day-wide-notification-text (event)
"Generate notification text for day-wide EVENT.
Handles both same-day events and advance notices."
- (let* ((title (cdr (assoc 'title event)))
+ (let* ((title (chime--event-title event))
(is-today (chime--event-has-any-passed-time event))
(is-advance-notice (and chime-day-wide-advance-notice
(chime--event-within-advance-notice-window event))))
@@ -902,7 +1130,7 @@ Handles both same-day events and advance notices."
(is-today
(format "%s is due or scheduled today" title))
(is-advance-notice
- (let ((days-until (chime--days-until-event (cdr (assoc 'times event)))))
+ (let ((days-until (chime--days-until-event (chime--event-times event))))
(cond
((= days-until 1) (format "%s is tomorrow" title))
((= days-until 2) (format "%s is in 2 days" title))
@@ -913,8 +1141,14 @@ Handles both same-day events and advance notices."
;;;; Event Checking & Navigation
(defun chime--check-event (event)
- "Get notifications for given EVENT.
-Returns a list of (MESSAGE . SEVERITY) cons cells."
+ "Return notification messages currently due for EVENT.
+EVENT must follow the internal event contract documented by
+`chime--valid-event-p'. Each timestamp in EVENT is paired with each
+configured alert interval; pairs whose timestamp equals current time plus
+the interval become user-facing (MESSAGE . SEVERITY) cons cells.
+
+All-day timestamps are ignored here because day-wide notifications are
+scheduled separately by `chime--day-wide-notifications'."
;; Each notif from chime--notifications is ((ts-str . time-val) (min . sev))
(->> (chime--notifications event)
(--map (let* ((notif it)
@@ -930,8 +1164,8 @@ Returns a list of (MESSAGE . SEVERITY) cons cells."
"Jump to EVENT's org entry in its file.
Reconstructs marker from serialized file path and position."
(interactive)
- (when-let* ((file (cdr (assoc 'marker-file event)))
- (pos (cdr (assoc 'marker-pos event))))
+ (when-let* ((file (chime--event-marker-file event))
+ (pos (chime--event-marker-pos event)))
(when (file-exists-p file)
(find-file file)
(goto-char pos)
@@ -960,22 +1194,46 @@ Reconstructs marker from serialized file path and position."
"Format a single event line for tooltip display.
EVENT-TIME-STR is the time string, MINUTES-UNTIL is minutes until event,
TITLE is the event title."
- (let ((time-display (chime--get-hh-mm-from-org-time-string event-time-str))
- (countdown (cond
- ((< minutes-until 1440) ;; Less than 24 hours
- (format "(%s)" (chime--time-left (* minutes-until 60))))
- (t
- ;; 24+ hours: show days and hours
- (let* ((days (truncate (/ minutes-until 1440)))
- (remaining-minutes (truncate (mod minutes-until 1440)))
- (hours (truncate (/ remaining-minutes 60))))
- (if (> hours 0)
- (format "(in %d day%s %d hour%s)"
- days (if (= days 1) "" "s")
- hours (if (= hours 1) "" "s"))
- (format "(in %d day%s)"
- days (if (= days 1) "" "s"))))))))
- (format "%s at %s %s" title time-display countdown)))
+ (let* ((title (or title ""))
+ (time-display (or (chime--get-hh-mm-from-org-time-string event-time-str) ""))
+ (countdown (cond
+ ((< minutes-until 1440) ;; Less than 24 hours
+ (format chime-tooltip-countdown-wrapper
+ (chime--time-left (* minutes-until 60))))
+ (t
+ ;; 24+ hours: show days and hours
+ (let* ((days (truncate (/ minutes-until 1440)))
+ (remaining-minutes (truncate (mod minutes-until 1440)))
+ (hours (truncate (/ remaining-minutes 60)))
+ (day-label (if (= days 1)
+ (car chime-tooltip-day-unit-labels)
+ (cdr chime-tooltip-day-unit-labels)))
+ (hour-label (if (= hours 1)
+ (car chime-tooltip-hour-unit-labels)
+ (cdr chime-tooltip-hour-unit-labels)))
+ (countdown-text (if (> hours 0)
+ (format "%s %d %s %d %s"
+ chime-tooltip-countdown-prefix
+ days day-label
+ hours hour-label)
+ (format "%s %d %s"
+ chime-tooltip-countdown-prefix
+ days day-label))))
+ (format chime-tooltip-countdown-wrapper countdown-text))))))
+ (replace-regexp-in-string
+ "%[tTu]"
+ (lambda (placeholder)
+ (pcase placeholder
+ ("%t" title)
+ ("%T" time-display)
+ ("%u" countdown)
+ (_ placeholder)))
+ chime-tooltip-event-format t t)))
+
+(defun chime--tooltip-relative-day-format (label)
+ "Return tooltip relative day format with LABEL substituted."
+ (replace-regexp-in-string "%s" label chime-tooltip-relative-day-format
+ t t))
(defun chime--day-label-for-event-time (event-time now tomorrow)
"Return the date-group label for EVENT-TIME.
@@ -991,17 +1249,24 @@ Otherwise returns the full weekday and date, e.g. \"Wednesday, Nov 05\"."
((and (= (decoded-time-day event-decoded) (decoded-time-day now-decoded))
(= (decoded-time-month event-decoded) (decoded-time-month now-decoded))
(= (decoded-time-year event-decoded) (decoded-time-year now-decoded)))
- (format-time-string "Today, %b %d" now))
+ (format-time-string
+ (chime--tooltip-relative-day-format chime-tooltip-today-label)
+ now))
((and (= (decoded-time-day event-decoded) (decoded-time-day tomorrow-decoded))
(= (decoded-time-month event-decoded) (decoded-time-month tomorrow-decoded))
(= (decoded-time-year event-decoded) (decoded-time-year tomorrow-decoded)))
- (format-time-string "Tomorrow, %b %d" tomorrow))
+ (format-time-string
+ (chime--tooltip-relative-day-format chime-tooltip-tomorrow-label)
+ tomorrow))
(t
- (format-time-string "%A, %b %d" event-time)))))
+ (format-time-string chime-tooltip-future-day-format event-time)))))
(defun chime--group-events-by-day (upcoming-events)
"Group UPCOMING-EVENTS by day.
-Returns an alist of (DATE-STRING . EVENTS-LIST)."
+UPCOMING-EVENTS is a list of \\=(EVENT TIME-INFO MINUTES-UNTIL) tuples, as
+stored in `chime--upcoming-events'. Returns an alist of
+\\=(DATE-STRING . EVENTS-LIST), preserving the order of first appearance in
+UPCOMING-EVENTS."
(let* ((grouped '())
(now (current-time))
(tomorrow (time-add now (days-to-time 1))))
@@ -1016,7 +1281,9 @@ Returns an alist of (DATE-STRING . EVENTS-LIST)."
(nreverse grouped)))
(defun chime--make-tooltip (upcoming-events)
- "Generate tooltip text showing UPCOMING-EVENTS grouped by day."
+ "Generate tooltip text showing UPCOMING-EVENTS grouped by day.
+UPCOMING-EVENTS is a list of (EVENT TIME-INFO MINUTES-UNTIL) tuples.
+The result is plain text suitable for the modeline `help-echo' property."
(if (null upcoming-events)
nil
(let* ((max-events (or chime-modeline-tooltip-max-events (length upcoming-events)))
@@ -1030,22 +1297,23 @@ Returns an alist of (DATE-STRING . EVENTS-LIST)."
(let ((date-str (car day-group))
(day-events (cdr day-group)))
(push (format "\n%s:\n" date-str) lines)
- (push "─────────────\n" lines)
+ (push (format "%s\n" chime-tooltip-section-separator) lines)
;; Each item is (event (ts-str . time-val) minutes-until)
(dolist (item day-events)
(let* ((event (car item))
(event-time-str (car (nth 1 item)))
(minutes-until (nth 2 item))
- (title (cdr (assoc 'title event))))
+ (title (chime--event-title event)))
(push (format "%s\n"
(chime--format-event-for-tooltip
event-time-str minutes-until title))
lines)))))
;; Add "... and N more" if needed
(when (> remaining 0)
- (push (format "\n... and %d more event%s"
- remaining
- (if (> remaining 1) "s" ""))
+ (push (format "\n%s"
+ (format chime-tooltip-more-events-format
+ remaining
+ (if (> remaining 1) "s" "")))
lines))
(apply #'concat (nreverse lines)))))
@@ -1063,10 +1331,12 @@ Returns an alist of (DATE-STRING . EVENTS-LIST)."
(header (format-time-string chime-tooltip-header-format))
(increase-var "chime-tooltip-lookahead-hours"))
(concat header "\n"
- "─────────────────────\n"
- (format "No calendar events in\nthe next %s.\n\n" timeframe)
- (format "Increase `%s`\nto expand scope.\n\n" increase-var)
- "Left-click: Open calendar")))
+ chime-tooltip-no-events-separator "\n"
+ (format "%s\n\n"
+ (format chime-tooltip-no-events-format timeframe))
+ (format "%s\n\n"
+ (format chime-tooltip-increase-lookahead-format increase-var))
+ chime-tooltip-left-click-label)))
(defun chime--propertize-modeline-string (text)
"Add tooltip and click handlers to modeline TEXT.
@@ -1105,11 +1375,11 @@ marker; those collapse to a single soonest tooltip line."
(dolist (item upcoming-events)
(let* ((event (car item))
(minutes (caddr item))
- (marker-file (cdr (assoc 'marker-file event)))
- (marker-pos (cdr (assoc 'marker-pos event)))
+ (marker-file (chime--event-marker-file event))
+ (marker-pos (chime--event-marker-pos event))
(key (if (and marker-file marker-pos)
(cons marker-file marker-pos)
- (cdr (assoc 'title event))))
+ (chime--event-title event)))
(existing (gethash key id-hash)))
(when (or (not existing)
(< minutes (caddr existing)))
@@ -1138,13 +1408,15 @@ Returns (TIME-STRING . TIME-OBJECT MINUTES-UNTIL) or nil if none found."
(defun chime--build-upcoming-events-list (events now tooltip-lookahead-minutes show-all-day-p)
"Build list of upcoming events within TOOLTIP-LOOKAHEAD-MINUTES from NOW.
-EVENTS is the list of events to process.
-If SHOW-ALL-DAY-P is non-nil, include all-day events in the list.
+EVENTS is the list of internal event alists to process. If
+SHOW-ALL-DAY-P is non-nil, all-day timestamps are eligible for tooltip
+display; otherwise only timed timestamps are considered.
+
Returns sorted, deduplicated list of (EVENT TIME-INFO MINUTES-UNTIL) tuples."
(let ((upcoming '()))
;; Collect events with their soonest timestamp within tooltip window
(dolist (event events)
- (let* ((all-times (cdr (assoc 'times event)))
+ (let* ((all-times (chime--event-times event))
(times-for-tooltip (if show-all-day-p
all-times
(chime--filter-day-wide-events all-times)))
@@ -1160,15 +1432,20 @@ Returns sorted, deduplicated list of (EVENT TIME-INFO MINUTES-UNTIL) tuples."
(defun chime--find-soonest-modeline-event (events now modeline-lookahead-minutes)
"Find soonest timed event for modeline from EVENTS.
-NOW is the current time. Search is limited to events within
-MODELINE-LOOKAHEAD-MINUTES of NOW.
-Returns (EVENT TIME-STR MINUTES-UNTIL EVENT-TEXT) or nil if none found."
+EVENTS is a list of internal event alists. NOW is the reference time.
+Search is limited to timed timestamps within MODELINE-LOOKAHEAD-MINUTES
+of NOW. All-day timestamps are deliberately excluded because the modeline
+shows a clock-relative next event, while all-day awareness belongs in the
+day-wide notification and tooltip paths.
+
+Returns (EVENT TIME-STR MINUTES-UNTIL EVENT-TEXT), or nil if no timed
+event falls inside the modeline window."
(let ((soonest-event nil)
(soonest-event-text nil)
(soonest-minutes nil)
(soonest-time-info nil))
(dolist (event events)
- (let* ((all-times (cdr (assoc 'times event)))
+ (let* ((all-times (chime--event-times event))
;; Always filter all-day events for modeline (need specific time)
(times-for-modeline (chime--filter-day-wide-events all-times))
(soonest (chime--find-soonest-time-in-window
@@ -1213,10 +1490,17 @@ Returns a propertized string, or nil when nothing should be shown."
'local-map map)))))
(defun chime--update-modeline (events)
- "Update modeline with next upcoming event from EVENTS.
-Orchestrates filtering, finding soonest event, and updating display.
-Shows soonest event within `chime-modeline-lookahead-minutes' in modeline.
-Tooltip shows events within `chime-tooltip-lookahead-hours' hours."
+ "Update Chime's modeline cache and rendered modeline text from EVENTS.
+EVENTS is a list of internal event alists returned by
+`chime--retrieve-events'. This function computes two related views:
+
+- `chime-modeline-string' shows the soonest timed event inside
+ `chime-modeline-lookahead-minutes'.
+- `chime--upcoming-events' stores sorted tooltip tuples for all events
+ inside `chime-tooltip-lookahead-hours'.
+
+When the modeline is disabled, or its lookahead is nil/zero, both caches
+are cleared so stale tooltip click targets are not left behind."
(if (or (not chime-enable-modeline)
(not chime-modeline-lookahead-minutes)
(zerop chime-modeline-lookahead-minutes))
@@ -1334,7 +1618,12 @@ because that is what real org-gcal exports use."
chime-additional-environment-regexes))))))
(defun chime--retrieve-events ()
- "Get events from agenda view."
+ "Return an async child-process form that retrieves Chime events.
+The returned lambda runs in a separate Emacs process so agenda parsing,
+filtering, and timestamp extraction do not block the user's interactive
+session. It reconstructs enough parent configuration with
+`async-inject-variables' to build the same agenda view, then returns a
+list of internal event alists."
;; Returns a backquoted lambda that runs in a separate Emacs process via async.
;; The unquoted ,(async-inject-variables ...) splices variable bindings from
;; the parent process; everything else executes in the child.
@@ -1355,9 +1644,8 @@ because that is what real org-gcal exports use."
;; warning that won't break event retrieval.
(require 'org-contacts nil t)
- ;; Calculate agenda span based on max lookahead (convert to days, round up)
- ;; Use the larger of modeline-lookahead (minutes) and tooltip-lookahead (hours) to ensure
- ;; we fetch enough events for both. Add 1 day buffer to account for partial days.
+ ;; Fetch enough agenda days to satisfy both the modeline and tooltip.
+ ;; The extra day covers partial-day lookaheads near midnight.
(let* ((tooltip-lookahead-minutes (if chime-tooltip-lookahead-hours
(* chime-tooltip-lookahead-hours 60)
chime-modeline-lookahead-minutes))
@@ -1426,10 +1714,18 @@ Returns converted hour in 24-hour format (0-23):
(t hour))))
(defun chime--timestamp-parse (timestamp &optional context)
- "Parse TIMESTAMP and return time in list-of-integer format.
-Returns nil if parsing fails or timestamp is malformed.
-Optional CONTEXT string is included in error messages to help
-identify the source (e.g., event title)."
+ "Parse timed org TIMESTAMP into Chime's serialized time value.
+Returns a two-integer Emacs time list suitable for async serialization, or
+nil when TIMESTAMP is nil, malformed, all-day, or otherwise unparsable.
+
+TIMESTAMP must be an org timestamp string with a clock component, such as
+\"<2026-05-10 Sun 09:30>\" or \"<2026-05-10 Sun 9:30am>\". Repeating
+timestamps are resolved through `org-closest-date' relative to today, so a
+recurring event contributes the nearest relevant occurrence rather than the
+literal date embedded in the source text.
+
+Optional CONTEXT is included in parse error messages and is typically the
+event title."
(condition-case err
(when (and timestamp
(stringp timestamp)
@@ -1541,7 +1837,11 @@ For regular org events:
- Fall back to plain timestamps in entry body
Timestamps are extracted as cons cells:
-\(org-formatted-string . parsed-time)."
+\(org-formatted-string . parsed-time).
+
+The org-gcal branch is intentionally stricter than regular org extraction:
+org-gcal keeps the authoritative event time in its :org-gcal: drawer, while
+planning lines can lag behind after remote calendar edits."
(org-with-point-at marker
(let ((is-gcal-event (org-entry-get marker "entry-id"))
(heading (nth 4 (org-heading-components))))
@@ -1554,7 +1854,12 @@ Timestamps are extracted as cons cells:
(defun chime--sanitize-title (title)
"Sanitize TITLE to prevent Lisp read syntax errors during async serialization.
-Balances unmatched parentheses, brackets, and braces by adding matching pairs.
+TITLE comes from `org-heading-components' and is later carried through
+async.el as part of an event alist. Unbalanced delimiters in headings can
+produce strings that are awkward to serialize or inspect in tests, so this
+helper removes unmatched closing delimiters and appends matching closing
+delimiters for unmatched openings.
+
Returns sanitized title or empty string if TITLE is nil."
(if (not title)
""
@@ -1617,25 +1922,103 @@ 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)."
- `((times . ,(chime--extract-time marker))
- (title . ,(chime--extract-title marker))
- (intervals . ,chime-alert-intervals)
- (marker-file . ,(buffer-file-name (marker-buffer marker)))
- (marker-pos . ,(marker-position marker))))
+ (chime--make-event
+ (chime--extract-time marker)
+ (chime--extract-title marker)
+ chime-alert-intervals
+ (buffer-file-name (marker-buffer marker))
+ (marker-position marker)))
;;;; Configuration Validation
-(defun chime--display-validation-results (issues)
- "Display validation ISSUES via message/warning system.
-ISSUES is a list of (SEVERITY MESSAGE) pairs."
- (if (null issues)
- (message "Chime: ✓ All validation checks passed!")
- (let ((errors (cl-remove-if-not (lambda (i) (eq (car i) :error)) issues))
- (warnings (cl-remove-if-not (lambda (i) (eq (car i) :warning)) issues)))
- (dolist (err errors)
- (display-warning 'chime (cadr err) :error))
- (dolist (warn warnings)
- (display-warning 'chime (cadr warn) :warning)))))
+(defun chime--missing-org-agenda-files-message (missing)
+ "Return validation warning text for missing org agenda file entries MISSING."
+ (format "%d org-agenda-files entries don't exist:\n %s\n\nChime will skip these during event checks."
+ (length missing)
+ (mapconcat (lambda (path)
+ (format "%s (%s)" path
+ (if (string-suffix-p "/" path)
+ "directory" "file")))
+ missing "\n ")))
+
+(defun chime--configuration-check-results ()
+ "Return full configuration validation check results.
+Each result has shape (SEVERITY DESCRIPTION MESSAGE), where SEVERITY is
+`:ok', `:warning', or `:error'. DESCRIPTION names the check performed.
+MESSAGE is nil for passing checks and contains issue details otherwise."
+ (let* ((agenda-files-valid
+ (and (boundp 'org-agenda-files)
+ org-agenda-files
+ (listp org-agenda-files)
+ (> (length org-agenda-files) 0)))
+ (results
+ (list
+ (if agenda-files-valid
+ (list :ok "org-agenda-files is set" nil)
+ (list :error
+ "org-agenda-files is set"
+ "Org-agenda-files is not set or empty.\nChime cannot check for events without org files to monitor.\n\nSet org-agenda-files in your config:\n (setq org-agenda-files '(\"~/org/inbox.org\" \"~/org/work.org\"))")))))
+
+ (when agenda-files-valid
+ (let ((missing (cl-remove-if #'file-exists-p org-agenda-files)))
+ (push (if missing
+ (list :warning
+ (format "org-agenda-files entries exist on disk (%d entries)"
+ (length org-agenda-files))
+ (chime--missing-org-agenda-files-message missing))
+ (list :ok
+ (format "org-agenda-files entries exist on disk (%d entries)"
+ (length org-agenda-files))
+ nil))
+ results)))
+
+ (push (if (require 'org-agenda nil t)
+ (list :ok "org-agenda is loadable" nil)
+ (list :error
+ "org-agenda is loadable"
+ "Cannot load org-agenda\nEnsure org-mode is installed and available in load-path"))
+ results)
+
+ (push (if chime-enable-modeline
+ (if (boundp 'global-mode-string)
+ (list :ok "global-mode-string is available" nil)
+ (list :warning
+ "global-mode-string is available"
+ "global-mode-string not available.\nModeline display may not work in this Emacs version."))
+ (list :ok "global-mode-string check skipped because modeline is disabled" nil))
+ results)
+
+ (nreverse results)))
+
+(defun chime--validation-issues-from-results (results)
+ "Project validation RESULTS to public (SEVERITY MESSAGE) issue pairs."
+ (->> results
+ (cl-remove-if (lambda (result) (eq (car result) :ok)))
+ (mapcar (lambda (result) (list (car result) (caddr result))))))
+
+(defun chime--display-validation-results (results)
+ "Display full validation RESULTS in the *Messages* buffer."
+ (let ((errors 0)
+ (warnings 0))
+ (message "Chime: Validating configuration...")
+ (dolist (result results)
+ (pcase-let ((`(,severity ,description ,detail) result))
+ (pcase severity
+ (:error (cl-incf errors))
+ (:warning (cl-incf warnings)))
+ (message "[%s] %s"
+ (pcase severity
+ (:ok "ok")
+ (:warning "warn")
+ (:error "error"))
+ description)
+ (when detail
+ (message " %s" detail))))
+ (message "Chime: %d error%s, %d warning%s."
+ errors
+ (if (= errors 1) "" "s")
+ warnings
+ (if (= warnings 1) "" "s"))))
;;;###autoload
(defun chime-validate-configuration ()
@@ -1649,48 +2032,14 @@ Checks performed:
- `org-agenda' package is loadable
- `global-mode-string' available (for modeline display)
-When called interactively, displays results via message/warning system.
+When called interactively, displays all check results in the *Messages*
+buffer.
When called programmatically, returns structured validation results."
(interactive)
- (let ((issues '()))
-
- ;; Critical: org-agenda-files must be set and non-empty
- (unless (and (boundp 'org-agenda-files)
- org-agenda-files
- (listp org-agenda-files)
- (> (length org-agenda-files) 0))
- (push '(:error "Org-agenda-files is not set or empty.\nChime cannot check for events without org files to monitor.\n\nSet org-agenda-files in your config:\n (setq org-agenda-files '(\"~/org/inbox.org\" \"~/org/work.org\"))")
- issues))
-
- ;; Warning: Check if files/directories actually exist
- (when (and (boundp 'org-agenda-files)
- org-agenda-files
- (listp org-agenda-files))
- (let ((missing (cl-remove-if #'file-exists-p org-agenda-files)))
- (when missing
- (push `(:warning ,(format "%d org-agenda-files entries don't exist:\n %s\n\nChime will skip these during event checks."
- (length missing)
- (mapconcat (lambda (path)
- (format "%s (%s)" path
- (if (string-suffix-p "/" path)
- "directory" "file")))
- missing "\n ")))
- issues))))
-
- ;; Check org-agenda is loadable
- (unless (require 'org-agenda nil t)
- (push '(:error "Cannot load org-agenda\nEnsure org-mode is installed and available in load-path")
- issues))
-
- ;; Check modeline support (if enabled)
- (when (and chime-enable-modeline
- (not (boundp 'global-mode-string)))
- (push '(:warning "global-mode-string not available.\nModeline display may not work in this Emacs version.")
- issues))
-
+ (let* ((results (chime--configuration-check-results))
+ (issues (chime--validation-issues-from-results results)))
(when (called-interactively-p 'any)
- (chime--display-validation-results issues))
-
+ (chime--display-validation-results results))
issues))
;;;; Core Lifecycle
@@ -1873,11 +2222,15 @@ error and skips the check."
"Update modeline display with latest events without sending notifications.
Useful after external calendar sync operations (e.g., org-gcal-sync).
-Does nothing if a check is already in progress in the background."
+Does nothing if a check is already in progress in the background.
+
+Validates configuration through the same startup gate as `chime-check'
+before fetching events."
(interactive)
- (chime--fetch-and-process
- (lambda (events)
- (chime--update-modeline events))))
+ (when (chime--maybe-validate)
+ (chime--fetch-and-process
+ (lambda (events)
+ (chime--update-modeline events)))))
(defun chime--set-modeline-error-state (error-message)
"Update modeline icon tooltip to show ERROR-MESSAGE.
diff --git a/tests/test-chime-day-wide-time-matching.el b/tests/test-chime-day-wide-time-matching.el
index 7a7c7d4..88242e2 100644
--- a/tests/test-chime-day-wide-time-matching.el
+++ b/tests/test-chime-day-wide-time-matching.el
@@ -37,6 +37,80 @@
(require 'testutil-general (expand-file-name "testutil-general.el"))
(require 'testutil-time (expand-file-name "testutil-time.el"))
+(defmacro test-chime-with-restored-day-wide-alert-times (&rest body)
+ "Run BODY and restore default `chime-day-wide-alert-times' afterwards."
+ (declare (indent 0) (debug t))
+ `(let ((original-value (default-value 'chime-day-wide-alert-times)))
+ (unwind-protect
+ (progn ,@body)
+ (set-default 'chime-day-wide-alert-times original-value))))
+
+;;;; Tests for chime--validate-day-wide-alert-times
+
+(ert-deftest test-chime-validate-day-wide-alert-times-accepts-24-hour ()
+ "Normal: 24-hour HH:MM entries are valid."
+ (should (equal '("08:00" "17:00")
+ (chime--validate-day-wide-alert-times
+ 'fake-symbol '("08:00" "17:00")))))
+
+(ert-deftest test-chime-validate-day-wide-alert-times-accepts-12-hour ()
+ "Normal: Org-supported 12-hour entries are valid."
+ (should (equal '("8:00am" "5:30pm")
+ (chime--validate-day-wide-alert-times
+ 'fake-symbol '("8:00am" "5:30pm")))))
+
+(ert-deftest test-chime-validate-day-wide-alert-times-accepts-nil ()
+ "Boundary: nil disables day-wide alerts."
+ (should (null (chime--validate-day-wide-alert-times 'fake-symbol nil))))
+
+(ert-deftest test-chime-validate-day-wide-alert-times-accepts-empty-list ()
+ "Boundary: an empty list disables day-wide alerts."
+ (should (equal '()
+ (chime--validate-day-wide-alert-times 'fake-symbol '()))))
+
+(ert-deftest test-chime-validate-day-wide-alert-times-rejects-invalid-string ()
+ "Error: unparseable strings fail before timer matching."
+ (should-error (chime--validate-day-wide-alert-times
+ 'fake-symbol '("08:00" "not-a-time"))
+ :type 'user-error))
+
+(ert-deftest test-chime-validate-day-wide-alert-times-rejects-non-list ()
+ "Error: the value must be nil or a list."
+ (should-error (chime--validate-day-wide-alert-times
+ 'fake-symbol "08:00")
+ :type 'user-error))
+
+(ert-deftest test-chime-validate-day-wide-alert-times-rejects-non-string-entry ()
+ "Error: every configured alert time must be a string."
+ (should-error (chime--validate-day-wide-alert-times
+ 'fake-symbol '("08:00" 1700))
+ :type 'user-error))
+
+(ert-deftest test-chime-validate-day-wide-alert-times-rejects-out-of-day-time ()
+ "Error: Org durations beyond 23:59 are not valid clock times."
+ (should-error (chime--validate-day-wide-alert-times
+ 'fake-symbol '("25:00"))
+ :type 'user-error))
+
+(ert-deftest test-chime-day-wide-alert-times-setter-accepts-valid-list ()
+ "Normal: customize-time setter accepts valid alert times."
+ (test-chime-with-restored-day-wide-alert-times
+ (customize-set-variable 'chime-day-wide-alert-times '("08:00" "5:30pm"))
+ (should (equal '("08:00" "5:30pm") chime-day-wide-alert-times))))
+
+(ert-deftest test-chime-day-wide-alert-times-setter-accepts-nil ()
+ "Boundary: customize-time setter accepts nil."
+ (test-chime-with-restored-day-wide-alert-times
+ (customize-set-variable 'chime-day-wide-alert-times nil)
+ (should (null chime-day-wide-alert-times))))
+
+(ert-deftest test-chime-day-wide-alert-times-setter-rejects-invalid-list ()
+ "Error: customize-time setter rejects invalid alert times."
+ (test-chime-with-restored-day-wide-alert-times
+ (should-error (customize-set-variable
+ 'chime-day-wide-alert-times '("08:00" "nope"))
+ :type 'user-error)))
+
;;;; Tests for chime--current-time-matches-time-of-day-string
;;; Normal Cases
diff --git a/tests/test-chime-debug-functions.el b/tests/test-chime-debug-functions.el
index a01fd5f..7ef85e5 100644
--- a/tests/test-chime-debug-functions.el
+++ b/tests/test-chime-debug-functions.el
@@ -26,6 +26,7 @@
;;; Code:
(setq chime-debug t)
+(require 'cl-lib)
(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
(require 'chime-debug (expand-file-name "../chime-debug.el"))
@@ -46,6 +47,13 @@
(chime-delete-test-base-dir)
(setq chime--upcoming-events nil))
+(defmacro test-chime-debug-functions--without-echo (&rest body)
+ "Run BODY while preserving debug logs without echoing messages."
+ `(cl-letf (((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (apply #'chime--log-silently format-string args))))
+ ,@body))
+
;;; Tests for chime-debug-dump-events
(ert-deftest test-chime-debug-dump-events-normal-with-events ()
@@ -67,7 +75,8 @@
(let ((inhibit-read-only t))
(erase-buffer)))
;; Call debug function
- (chime-debug-dump-events)
+ (test-chime-debug-functions--without-echo
+ (chime-debug-dump-events))
;; Verify output in *Messages* buffer
(with-current-buffer "*Messages*"
(let ((content (buffer-string)))
@@ -85,7 +94,10 @@
(setq chime--upcoming-events nil)
;; Should not error
(should-not (condition-case nil
- (progn (chime-debug-dump-events) nil)
+ (progn
+ (test-chime-debug-functions--without-echo
+ (chime-debug-dump-events))
+ nil)
(error t))))
(test-chime-debug-functions-teardown)))
@@ -110,7 +122,8 @@
(let ((inhibit-read-only t))
(erase-buffer)))
;; Call debug function
- (chime-debug-dump-tooltip)
+ (test-chime-debug-functions--without-echo
+ (chime-debug-dump-tooltip))
;; Verify output in *Messages* buffer
(with-current-buffer "*Messages*"
(let ((content (buffer-string)))
@@ -128,7 +141,10 @@
(setq chime--upcoming-events nil)
;; Should not error
(should-not (condition-case nil
- (progn (chime-debug-dump-tooltip) nil)
+ (progn
+ (test-chime-debug-functions--without-echo
+ (chime-debug-dump-tooltip))
+ nil)
(error t))))
(test-chime-debug-functions-teardown)))
@@ -147,7 +163,8 @@
(let ((inhibit-read-only t))
(erase-buffer)))
;; Call debug function
- (chime-debug-config)
+ (test-chime-debug-functions--without-echo
+ (chime-debug-config))
;; Verify output in *Messages* buffer
(with-current-buffer "*Messages*"
(let ((content (buffer-string)))
@@ -171,7 +188,10 @@
(erase-buffer)))
;; Should not error
(should-not (condition-case nil
- (progn (chime-debug-config) nil)
+ (progn
+ (test-chime-debug-functions--without-echo
+ (chime-debug-config))
+ nil)
(error t)))
;; Verify output mentions 0 files
(with-current-buffer "*Messages*"
@@ -200,9 +220,10 @@
;; Call all three debug functions - should not error
(should-not (condition-case nil
(progn
- (chime-debug-dump-events)
- (chime-debug-dump-tooltip)
- (chime-debug-config)
+ (test-chime-debug-functions--without-echo
+ (chime-debug-dump-events)
+ (chime-debug-dump-tooltip)
+ (chime-debug-config))
nil)
(error t))))))
(test-chime-debug-functions-teardown)))
diff --git a/tests/test-chime-event-contract.el b/tests/test-chime-event-contract.el
new file mode 100644
index 0000000..697dccb
--- /dev/null
+++ b/tests/test-chime-event-contract.el
@@ -0,0 +1,103 @@
+;;; test-chime-event-contract.el --- Tests for Chime event alist contract -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026 Craig Jennings
+
+;; Author: Craig Jennings <c@cjennings.net>
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for the explicit internal event alist contract.
+
+;;; Code:
+
+(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
+
+(require 'testutil-general (expand-file-name "testutil-general.el"))
+(require 'testutil-time (expand-file-name "testutil-time.el"))
+(require 'testutil-events (expand-file-name "testutil-events.el"))
+
+(ert-deftest test-chime-event-contract-make-event-creates-valid-event ()
+ "Constructor returns an event matching the documented contract."
+ (let* ((event-time (test-time-tomorrow-at 9 30))
+ (timestamp (test-timestamp-string event-time))
+ (event (chime--make-event
+ (list (cons timestamp event-time))
+ "Planning"
+ '((10 . medium) (0 . high))
+ "/tmp/chime-test.org"
+ 42)))
+ (should (chime--valid-event-p event))
+ (should (equal (list (cons timestamp event-time))
+ (chime--event-times event)))
+ (should (string= "Planning" (chime--event-title event)))
+ (should (equal '((10 . medium) (0 . high))
+ (chime--event-intervals event)))
+ (should (string= "/tmp/chime-test.org"
+ (chime--event-marker-file event)))
+ (should (= 42 (chime--event-marker-pos event)))))
+
+(ert-deftest test-chime-event-contract-validates-all-day-timestamps ()
+ "All-day timestamps are valid when their parsed time value is nil."
+ (let ((event (chime--make-event
+ '(("<2026-05-11 Mon>" . nil))
+ "All Day"
+ '((10 . medium)))))
+ (should (chime--valid-event-p event))))
+
+(ert-deftest test-chime-event-contract-rejects-missing-required-keys ()
+ "Validator rejects event alists missing required keys."
+ (should-not (chime--valid-event-p
+ '((times . nil)
+ (intervals . ((10 . medium)))))))
+
+(ert-deftest test-chime-event-contract-rejects-malformed-time-entry ()
+ "Constructor rejects malformed timestamp entries."
+ (should-error
+ (chime--make-event
+ '((not-a-string . nil))
+ "Bad Time"
+ '((10 . medium)))))
+
+(ert-deftest test-chime-event-contract-rejects-malformed-interval-entry ()
+ "Constructor rejects malformed alert intervals."
+ (should-error
+ (chime--make-event
+ '(("<2026-05-11 Mon 09:30>" . nil))
+ "Bad Interval"
+ '((10 . urgent)))))
+
+(ert-deftest test-chime-event-contract-rejects-malformed-marker-identity ()
+ "Constructor rejects partial or wrongly typed marker identity values."
+ (should-error
+ (chime--make-event
+ '(("<2026-05-11 Mon 09:30>" . nil))
+ "Bad Marker"
+ '((10 . medium))
+ "/tmp/chime-test.org"
+ "42")))
+
+(ert-deftest test-chime-event-contract-test-builder-uses-valid-shape ()
+ "Shared test event builder emits contract-valid event alists."
+ (let ((event (test-make-simple-event
+ "Builder Event"
+ (test-time-tomorrow-at 11 0)
+ 5
+ 'low)))
+ (should (chime--valid-event-p event))
+ (should (string= "Builder Event" (chime--event-title event)))))
+
+(provide 'test-chime-event-contract)
+;;; test-chime-event-contract.el ends here
diff --git a/tests/test-chime-modeline.el b/tests/test-chime-modeline.el
index cb046b5..63ba26c 100644
--- a/tests/test-chime-modeline.el
+++ b/tests/test-chime-modeline.el
@@ -32,6 +32,7 @@
;; Load test utilities
(require 'testutil-general (expand-file-name "testutil-general.el"))
(require 'testutil-time (expand-file-name "testutil-time.el"))
+(require 'testutil-events (expand-file-name "testutil-events.el"))
;;; Setup and Teardown
@@ -204,15 +205,14 @@ REFACTORED: Uses dynamic timestamps"
;; Generate tooltip
(let ((tooltip (chime--make-tooltip chime--upcoming-events)))
- (message "DEBUG: Tooltip content:\n%s" tooltip)
-
- ;; Tooltip should contain "Team Meeting" exactly once
- (let ((count (test-chime-modeline--count-in-string "Team Meeting" tooltip)))
- (should (= 1 count)))
-
- ;; "Upcoming Events" header should appear exactly once
- (let ((header-count (test-chime-modeline--count-in-string "Upcoming Events" tooltip)))
- (should (= 1 header-count))))))
+ (ert-info ((format "Tooltip content:\n%s" tooltip))
+ ;; Tooltip should contain "Team Meeting" exactly once
+ (let ((count (test-chime-modeline--count-in-string "Team Meeting" tooltip)))
+ (should (= 1 count)))
+
+ ;; "Upcoming Events" header should appear exactly once
+ (let ((header-count (test-chime-modeline--count-in-string "Upcoming Events" tooltip)))
+ (should (= 1 header-count)))))))
(test-chime-modeline-teardown)))
(ert-deftest test-chime-modeline-tooltip-correct-order ()
@@ -244,14 +244,13 @@ REFACTORED: Uses dynamic timestamps"
;; Generate tooltip
(let ((tooltip (chime--make-tooltip chime--upcoming-events)))
- (message "DEBUG: Tooltip for order test:\n%s" tooltip)
-
- ;; "Meeting A" should appear before "Meeting B" in tooltip
- (let ((pos-a (string-match "Meeting A" tooltip))
- (pos-b (string-match "Meeting B" tooltip)))
- (should pos-a)
- (should pos-b)
- (should (< pos-a pos-b))))))
+ (ert-info ((format "Tooltip content:\n%s" tooltip))
+ ;; "Meeting A" should appear before "Meeting B" in tooltip
+ (let ((pos-a (string-match "Meeting A" tooltip))
+ (pos-b (string-match "Meeting B" tooltip)))
+ (should pos-a)
+ (should pos-b)
+ (should (< pos-a pos-b)))))))
(test-chime-modeline-teardown)))
(ert-deftest test-chime-modeline-tooltip-structure ()
@@ -283,18 +282,113 @@ REFACTORED: Uses dynamic timestamps"
;; Generate tooltip
(let ((tooltip (chime--make-tooltip chime--upcoming-events)))
- (message "DEBUG: Tooltip structure:\n%s" tooltip)
+ (ert-info ((format "Tooltip content:\n%s" tooltip))
+ ;; Should have exactly one "Upcoming Events" header
+ (should (= 1 (test-chime-modeline--count-in-string "Upcoming Events" tooltip)))
- ;; Should have exactly one "Upcoming Events" header
- (should (= 1 (test-chime-modeline--count-in-string "Upcoming Events" tooltip)))
+ ;; Should start with "Upcoming Events as of" (new header format with timestamp)
+ (should (string-match-p "^Upcoming Events as of" tooltip))
- ;; Should start with "Upcoming Events as of" (new header format with timestamp)
- (should (string-match-p "^Upcoming Events as of" tooltip))
+ ;; Event should appear exactly once
+ (should (= 1 (test-chime-modeline--count-in-string "Team Meeting" tooltip)))))))
+ (test-chime-modeline-teardown)))
- ;; Event should appear exactly once
- (should (= 1 (test-chime-modeline--count-in-string "Team Meeting" tooltip))))))
+(ert-deftest test-chime-modeline-tooltip-custom-event-format ()
+ "Tooltip event line uses chime-tooltip-event-format."
+ (test-chime-modeline-setup)
+ (unwind-protect
+ (let* ((now (test-time-now))
+ (event-time (test-time-tomorrow-at 14 0))
+ (event (test-make-simple-event "Team Meeting" event-time))
+ (upcoming (list (list event
+ (cons (test-timestamp-string event-time)
+ event-time)
+ 1440)))
+ (chime-tooltip-event-format "%T -- %t -- %u"))
+ (with-test-time now
+ (let ((tooltip (chime--make-tooltip upcoming)))
+ (should (string-match-p "02:00 PM -- Team Meeting -- (in 1 day)" tooltip)))))
(test-chime-modeline-teardown)))
+(ert-deftest test-chime-modeline-tooltip-custom-day-labels ()
+ "Tooltip day labels use custom today, tomorrow, and future formats."
+ (test-chime-modeline-setup)
+ (unwind-protect
+ (let* ((now (test-time-today-at 9 0))
+ (today (time-add now (seconds-to-time (* 2 3600))))
+ (tomorrow (time-add now (days-to-time 1)))
+ (future (time-add now (days-to-time 3)))
+ (chime-tooltip-today-label "Hoy")
+ (chime-tooltip-tomorrow-label "Manana")
+ (chime-tooltip-relative-day-format "%s :: %Y-%m-%d")
+ (chime-tooltip-future-day-format "Dia %Y-%m-%d"))
+ (with-test-time now
+ (should (string-match-p "^Hoy :: "
+ (chime--day-label-for-event-time
+ today now tomorrow)))
+ (should (string-match-p "^Manana :: "
+ (chime--day-label-for-event-time
+ tomorrow now tomorrow)))
+ (should (string-match-p "^Dia "
+ (chime--day-label-for-event-time
+ future now tomorrow)))))
+ (test-chime-modeline-teardown)))
+
+(ert-deftest test-chime-modeline-tooltip-custom-overflow-and-separator ()
+ "Tooltip overflow and section separator strings are customizable."
+ (test-chime-modeline-setup)
+ (unwind-protect
+ (let* ((now (test-time-now))
+ (first-time (test-time-tomorrow-at 14 0))
+ (second-time (test-time-tomorrow-at 15 0))
+ (first-event (test-make-simple-event "First Event" first-time))
+ (second-event (test-make-simple-event "Second Event" second-time))
+ (upcoming (list (list first-event
+ (cons (test-timestamp-string first-time)
+ first-time)
+ 1440)
+ (list second-event
+ (cons (test-timestamp-string second-time)
+ second-time)
+ 1500)))
+ (chime-modeline-tooltip-max-events 1)
+ (chime-tooltip-section-separator "---")
+ (chime-tooltip-more-events-format "plus %d hidden%s"))
+ (with-test-time now
+ (let ((tooltip (chime--make-tooltip upcoming)))
+ (should (string-match-p "---" tooltip))
+ (should (string-match-p "plus 1 hidden" tooltip))
+ (should-not (string-match-p "Second Event" tooltip)))))
+ (test-chime-modeline-teardown)))
+
+(ert-deftest test-chime-modeline-tooltip-custom-no-events-text ()
+ "No-events tooltip guidance strings are customizable."
+ (test-chime-modeline-setup)
+ (unwind-protect
+ (let ((chime-tooltip-header-format "Agenda %Y")
+ (chime-tooltip-no-events-separator "---")
+ (chime-tooltip-no-events-format "Nada por %s.")
+ (chime-tooltip-increase-lookahead-format "Aumenta %s.")
+ (chime-tooltip-left-click-label "Click: calendario"))
+ (let ((tooltip (chime--make-no-events-tooltip 120)))
+ (should (string-match-p "^Agenda " tooltip))
+ (should (string-match-p "---" tooltip))
+ (should (string-match-p "Nada por 2 hours\\." tooltip))
+ (should (string-match-p "Aumenta chime-tooltip-lookahead-hours\\." tooltip))
+ (should (string-match-p "Click: calendario" tooltip))))
+ (test-chime-modeline-teardown)))
+
+(ert-deftest test-chime-modeline-tooltip-custom-day-hour-countdown ()
+ "Tooltip-specific day/hour countdown units are customizable."
+ (let ((chime-tooltip-countdown-prefix "en")
+ (chime-tooltip-day-unit-labels '("dia" . "dias"))
+ (chime-tooltip-hour-unit-labels '("hora" . "horas")))
+ (should (string-match-p "(en 2 dias 1 hora)"
+ (chime--format-event-for-tooltip
+ "<2026-05-12 Tue 10:00>"
+ 2940
+ "Evento")))))
+
;;; Tests for tooltip max events limit
(ert-deftest test-chime-modeline-tooltip-max-events ()
diff --git a/tests/test-chime-refresh-modeline.el b/tests/test-chime-refresh-modeline.el
new file mode 100644
index 0000000..1001b06
--- /dev/null
+++ b/tests/test-chime-refresh-modeline.el
@@ -0,0 +1,92 @@
+;;; test-chime-refresh-modeline.el --- Tests for manual modeline refresh -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026 Craig Jennings
+
+;;; Commentary:
+
+;; Tests for `chime-refresh-modeline'. Manual refresh should share the
+;; startup validation gate used by `chime-check', but it must remain a
+;; modeline-only operation and never send notifications.
+
+;;; Code:
+
+(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
+
+(defmacro test-chime-refresh-modeline--with-validation-state (&rest body)
+ "Run BODY with isolated chime validation state."
+ (declare (indent 0) (debug t))
+ `(let ((original-validation-done chime--validation-done)
+ (original-validation-retry-count chime--validation-retry-count)
+ (original-validation-max-retries chime--validation-max-retries)
+ (original-org-agenda-files org-agenda-files))
+ (unwind-protect
+ (progn
+ (setq chime--validation-done nil)
+ (setq chime--validation-retry-count 0)
+ (setq chime--validation-max-retries 3)
+ ,@body)
+ (setq chime--validation-done original-validation-done)
+ (setq chime--validation-retry-count original-validation-retry-count)
+ (setq chime--validation-max-retries original-validation-max-retries)
+ (setq org-agenda-files original-org-agenda-files))))
+
+(ert-deftest test-chime-refresh-modeline-nil-agenda-files-skips-fetch ()
+ "Error: nil `org-agenda-files' should validate and skip fetch."
+ (test-chime-refresh-modeline--with-validation-state
+ (setq org-agenda-files nil)
+ (let ((fetch-called nil)
+ (messages nil))
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (_callback)
+ (setq fetch-called t)))
+ ((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages))))
+ (chime-refresh-modeline)
+ (should-not fetch-called)
+ (should (= 1 chime--validation-retry-count))
+ (should (cl-some (lambda (msg)
+ (string-match-p "Waiting for org-agenda-files" msg))
+ messages))))))
+
+(ert-deftest test-chime-refresh-modeline-empty-agenda-files-skips-fetch ()
+ "Error: empty `org-agenda-files' should validate and skip fetch."
+ (test-chime-refresh-modeline--with-validation-state
+ (setq org-agenda-files '())
+ (let ((fetch-called nil))
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (_callback)
+ (setq fetch-called t)))
+ ((symbol-function 'message)
+ (lambda (&rest _args) nil)))
+ (chime-refresh-modeline)
+ (should-not fetch-called)
+ (should (= 1 chime--validation-retry-count))
+ (should-not chime--validation-done)))))
+
+(ert-deftest test-chime-refresh-modeline-valid-agenda-files-fetches-events ()
+ "Normal: valid configuration should fetch and update the modeline."
+ (test-chime-refresh-modeline--with-validation-state
+ (setq org-agenda-files '("/tmp/chime-refresh-test.org"))
+ (let ((update-called nil)
+ (notifications-called nil)
+ (events '(((title . "Meeting")
+ (times . nil)
+ (intervals . nil)))))
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (callback)
+ (funcall callback events)))
+ ((symbol-function 'chime--update-modeline)
+ (lambda (received-events)
+ (setq update-called received-events)))
+ ((symbol-function 'chime--process-notifications)
+ (lambda (_events)
+ (setq notifications-called t))))
+ (chime-refresh-modeline)
+ (should (eq update-called events))
+ (should-not notifications-called)
+ (should chime--validation-done)
+ (should (= 0 chime--validation-retry-count))))))
+
+(provide 'test-chime-refresh-modeline)
+;;; test-chime-refresh-modeline.el ends here
diff --git a/tests/test-chime-tooltip-day-calculation.el b/tests/test-chime-tooltip-day-calculation.el
index 1a25767..6e4f778 100644
--- a/tests/test-chime-tooltip-day-calculation.el
+++ b/tests/test-chime-tooltip-day-calculation.el
@@ -15,6 +15,18 @@
(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
(require 'testutil-time (expand-file-name "testutil-time.el"))
(require 'testutil-general (expand-file-name "testutil-general.el"))
+(require 'testutil-events (expand-file-name "testutil-events.el"))
+
+(defmacro test-chime-tooltip-day-calculation--with-tooltip (now content &rest body)
+ "Bind tooltip for CONTENT at NOW and run BODY with common test config."
+ (declare (indent 2))
+ `(with-test-setup
+ (with-chime-config
+ chime-modeline-lookahead-minutes 10080
+ chime-tooltip-lookahead-hours 168
+ (with-test-time ,now
+ (with-chime-tooltip-from-content ,content tooltip
+ ,@body)))))
(ert-deftest test-chime-tooltip-day-calculation-fractional-days ()
"Test that fractional days show both days and hours correctly.
@@ -24,65 +36,36 @@ User scenario: Viewing tooltip on Sunday 9pm, sees:
- Wednesday 2pm event: 65 hours = 2.7 days → 'in 2 days 17 hours'
This test prevents regression of the integer division truncation bug."
- (chime-create-test-base-dir)
- (unwind-protect
- (let* ((now (test-time-today-at 21 0)) ; Sunday 9pm
- ;; Create events at specific future times
- (tuesday-9pm (time-add now (seconds-to-time (* 48 3600)))) ; +48 hours
- (wednesday-2pm (time-add now (seconds-to-time (* 65 3600)))) ; +65 hours
- (content (format "* Tuesday Event\n<%s>\n* Wednesday Event\n<%s>\n"
- (format-time-string "<%Y-%m-%d %a %H:%M>" tuesday-9pm)
- (format-time-string "<%Y-%m-%d %a %H:%M>" wednesday-2pm)))
- (test-file (chime-create-temp-test-file-with-content content))
- (test-buffer (find-file-noselect test-file))
- (events nil))
-
- ;; Gather events
- (with-current-buffer test-buffer
- (org-mode)
- (goto-char (point-min))
- (while (re-search-forward "^\\*+ " nil t)
- (beginning-of-line)
- (push (chime--gather-info (point-marker)) events)
- (forward-line 1)))
- (kill-buffer test-buffer)
- (setq events (nreverse events))
-
- ;; Set lookahead to cover events (7 days)
- (setq chime-modeline-lookahead-minutes 10080)
- (setq chime-tooltip-lookahead-hours 168)
-
- (with-test-time now
- ;; Update modeline and get tooltip
- (chime--update-modeline events)
- (let ((tooltip (chime--make-tooltip chime--upcoming-events)))
-
- ;; Verify tooltip contains both events
- (should (string-match-p "Tuesday Event" tooltip))
- (should (string-match-p "Wednesday Event" tooltip))
-
- ;; Print tooltip for manual inspection
- (message "TOOLTIP CONTENT:\n%s" tooltip)
-
- ;; AFTER FIX: Tuesday shows "in 2 days", Wednesday shows "in 2 days 17 hours"
- ;; Verify Tuesday shows exactly 2 days (no "hours" in countdown)
- (should (string-match-p "Tuesday Event.*(in 2 days)" tooltip))
- ;; Make sure Tuesday doesn't have hours
- (should-not (string-match-p "Tuesday Event.*hours" tooltip))
-
- ;; Verify Wednesday shows 2 days AND 17 hours
- (should (string-match-p "Wednesday Event.*(in 2 days 17 hours)" tooltip))
-
- ;; Verify they show DIFFERENT countdowns
- (let ((tuesday-line (progn
- (string-match "Tuesday Event[^\n]*" tooltip)
- (match-string 0 tooltip)))
- (wednesday-line (progn
- (string-match "Wednesday Event[^\n]*" tooltip)
- (match-string 0 tooltip))))
- (should-not (string= tuesday-line wednesday-line))))))
-
- (chime-delete-test-base-dir)))
+ (let* ((now (test-time-today-at 21 0)) ; Sunday 9pm
+ ;; Create events at specific future times
+ (tuesday-9pm (time-add now (seconds-to-time (* 48 3600)))) ; +48 hours
+ (wednesday-2pm (time-add now (seconds-to-time (* 65 3600)))) ; +65 hours
+ (content (format "* Tuesday Event\n<%s>\n* Wednesday Event\n<%s>\n"
+ (format-time-string "<%Y-%m-%d %a %H:%M>" tuesday-9pm)
+ (format-time-string "<%Y-%m-%d %a %H:%M>" wednesday-2pm))))
+ (test-chime-tooltip-day-calculation--with-tooltip now content
+ (ert-info ((format "Tooltip content:\n%s" tooltip))
+ ;; Verify tooltip contains both events
+ (should (string-match-p "Tuesday Event" tooltip))
+ (should (string-match-p "Wednesday Event" tooltip))
+
+ ;; AFTER FIX: Tuesday shows "in 2 days", Wednesday shows "in 2 days 17 hours"
+ ;; Verify Tuesday shows exactly 2 days (no "hours" in countdown)
+ (should (string-match-p "Tuesday Event.*(in 2 days)" tooltip))
+ ;; Make sure Tuesday doesn't have hours
+ (should-not (string-match-p "Tuesday Event.*hours" tooltip))
+
+ ;; Verify Wednesday shows 2 days AND 17 hours
+ (should (string-match-p "Wednesday Event.*(in 2 days 17 hours)" tooltip))
+
+ ;; Verify they show DIFFERENT countdowns
+ (let ((tuesday-line (progn
+ (string-match "Tuesday Event[^\n]*" tooltip)
+ (match-string 0 tooltip)))
+ (wednesday-line (progn
+ (string-match "Wednesday Event[^\n]*" tooltip)
+ (match-string 0 tooltip))))
+ (should-not (string= tuesday-line wednesday-line)))))))
;;; Helper function for creating test events
@@ -103,116 +86,47 @@ Returns formatted org content string."
(ert-deftest test-chime-tooltip-day-calculation-boundary-exactly-24-hours ()
"Test event exactly 24 hours away shows 'in 1 day' not hours."
- (chime-create-test-base-dir)
- (unwind-protect
- (let* ((now (test-time-today-at 12 0))
- (content (test-chime-tooltip-day-calculation--create-event-at-hours now "Tomorrow Same Time" 24))
- (test-file (chime-create-temp-test-file-with-content content))
- (events (with-current-buffer (find-file-noselect test-file)
- (org-mode)
- (goto-char (point-min))
- (let ((evs nil))
- (while (re-search-forward "^\\*+ " nil t)
- (push (chime--gather-info (point-marker)) evs))
- (nreverse evs)))))
- (kill-buffer (get-file-buffer test-file))
-
- (setq chime-modeline-lookahead-minutes 10080)
- (setq chime-tooltip-lookahead-hours 168)
-
- (with-test-time now
- (chime--update-modeline events)
- (let ((tooltip (chime--make-tooltip chime--upcoming-events)))
- ;; Should show "in 1 day" not hours
- (should (string-match-p "(in 1 day)" tooltip))
- (should-not (string-match-p "hours" tooltip)))))
- (chime-delete-test-base-dir)))
+ (let* ((now (test-time-today-at 12 0))
+ (content (test-chime-tooltip-day-calculation--create-event-at-hours
+ now "Tomorrow Same Time" 24)))
+ (test-chime-tooltip-day-calculation--with-tooltip now content
+ ;; Should show "in 1 day" not hours
+ (should (string-match-p "(in 1 day)" tooltip))
+ (should-not (string-match-p "hours" tooltip)))))
(ert-deftest test-chime-tooltip-day-calculation-boundary-23-hours-59-minutes ()
"Test event 23h59m away shows hours, not days (just under 24h threshold)."
- (chime-create-test-base-dir)
- (unwind-protect
- (let* ((now (test-time-today-at 12 0))
- ;; 23 hours 59 minutes = 1439 minutes = just under 1440
- (event-time (time-add now (seconds-to-time (* 1439 60))))
- (content (format "* Almost Tomorrow\n<%s>\n"
- (format-time-string "%Y-%m-%d %a %H:%M" event-time)))
- (test-file (chime-create-temp-test-file-with-content content))
- (events (with-current-buffer (find-file-noselect test-file)
- (org-mode)
- (goto-char (point-min))
- (let ((evs nil))
- (while (re-search-forward "^\\*+ " nil t)
- (push (chime--gather-info (point-marker)) evs))
- (nreverse evs)))))
- (kill-buffer (get-file-buffer test-file))
-
- (setq chime-modeline-lookahead-minutes 10080)
- (setq chime-tooltip-lookahead-hours 168)
-
- (with-test-time now
- (chime--update-modeline events)
- (let ((tooltip (chime--make-tooltip chime--upcoming-events)))
- ;; Should show hours format (< 24 hours)
- (should (string-match-p "hours" tooltip))
- (should-not (string-match-p "days?" tooltip)))))
- (chime-delete-test-base-dir)))
+ (let* ((now (test-time-today-at 12 0))
+ ;; 23 hours 59 minutes = 1439 minutes = just under 1440
+ (event-time (time-add now (seconds-to-time (* 1439 60))))
+ (content (format "* Almost Tomorrow\n<%s>\n"
+ (format-time-string "%Y-%m-%d %a %H:%M" event-time))))
+ (test-chime-tooltip-day-calculation--with-tooltip now content
+ ;; Should show hours format (< 24 hours)
+ (should (string-match-p "hours" tooltip))
+ (should-not (string-match-p "days?" tooltip)))))
(ert-deftest test-chime-tooltip-day-calculation-boundary-25-hours ()
"Test event 25 hours away shows 'in 1 day 1 hour'."
- (chime-create-test-base-dir)
- (unwind-protect
- (let* ((now (test-time-today-at 12 0))
- (content (test-chime-tooltip-day-calculation--create-event-at-hours now "Day Plus One" 25))
- (test-file (chime-create-temp-test-file-with-content content))
- (events (with-current-buffer (find-file-noselect test-file)
- (org-mode)
- (goto-char (point-min))
- (let ((evs nil))
- (while (re-search-forward "^\\*+ " nil t)
- (push (chime--gather-info (point-marker)) evs))
- (nreverse evs)))))
- (kill-buffer (get-file-buffer test-file))
-
- (setq chime-modeline-lookahead-minutes 10080)
- (setq chime-tooltip-lookahead-hours 168)
-
- (with-test-time now
- (chime--update-modeline events)
- (let ((tooltip (chime--make-tooltip chime--upcoming-events)))
- ;; Should show "in 1 day 1 hour"
- (should (string-match-p "(in 1 day 1 hour)" tooltip)))))
- (chime-delete-test-base-dir)))
+ (let* ((now (test-time-today-at 12 0))
+ (content (test-chime-tooltip-day-calculation--create-event-at-hours
+ now "Day Plus One" 25)))
+ (test-chime-tooltip-day-calculation--with-tooltip now content
+ ;; Should show "in 1 day 1 hour"
+ (should (string-match-p "(in 1 day 1 hour)" tooltip)))))
(ert-deftest test-chime-tooltip-day-calculation-boundary-exactly-48-hours ()
"Test event exactly 48 hours away shows 'in 2 days' without hours."
- (chime-create-test-base-dir)
- (unwind-protect
- (let* ((now (test-time-today-at 12 0))
- (content (test-chime-tooltip-day-calculation--create-event-at-hours now "Two Days Exact" 48))
- (test-file (chime-create-temp-test-file-with-content content))
- (events (with-current-buffer (find-file-noselect test-file)
- (org-mode)
- (goto-char (point-min))
- (let ((evs nil))
- (while (re-search-forward "^\\*+ " nil t)
- (push (chime--gather-info (point-marker)) evs))
- (nreverse evs)))))
- (kill-buffer (get-file-buffer test-file))
-
- (setq chime-modeline-lookahead-minutes 10080)
- (setq chime-tooltip-lookahead-hours 168)
-
- (with-test-time now
- (chime--update-modeline events)
- (let ((tooltip (chime--make-tooltip chime--upcoming-events))
- (line (test-chime-tooltip-day-calculation--get-formatted-line
- (chime--make-tooltip chime--upcoming-events) "Two Days Exact")))
- ;; Should show exactly "in 2 days" with NO hours
- (should (string-match-p "(in 2 days)" tooltip))
- ;; Verify the line doesn't contain "hour" (would be "2 days 0 hours")
- (should-not (string-match-p "hour" line)))))
- (chime-delete-test-base-dir)))
+ (let* ((now (test-time-today-at 12 0))
+ (content (test-chime-tooltip-day-calculation--create-event-at-hours
+ now "Two Days Exact" 48)))
+ (test-chime-tooltip-day-calculation--with-tooltip now content
+ (let ((line (test-chime-tooltip-day-calculation--get-formatted-line
+ tooltip "Two Days Exact")))
+ ;; Should show exactly "in 2 days" with NO hours
+ (should (string-match-p "(in 2 days)" tooltip))
+ ;; Verify the line doesn't contain "hour" (would be "2 days 0 hours")
+ (should-not (string-match-p "hour" line))))))
;;; Midnight Boundaries
@@ -221,102 +135,50 @@ Returns formatted org content string."
Scenario: 11pm now, event at 2am (3 hours later, next calendar day)
Should show hours, not '1 day' since it's only 3 hours away."
- (chime-create-test-base-dir)
- (unwind-protect
- (let* ((now (test-time-today-at 23 0)) ; 11pm
- ;; 3 hours later = 2am next day
- (content (test-chime-tooltip-day-calculation--create-event-at-hours now "Early Morning" 3))
- (test-file (chime-create-temp-test-file-with-content content))
- (events (with-current-buffer (find-file-noselect test-file)
- (org-mode)
- (goto-char (point-min))
- (let ((evs nil))
- (while (re-search-forward "^\\*+ " nil t)
- (push (chime--gather-info (point-marker)) evs))
- (nreverse evs)))))
- (kill-buffer (get-file-buffer test-file))
-
- (setq chime-modeline-lookahead-minutes 10080)
- (setq chime-tooltip-lookahead-hours 168)
-
- (with-test-time now
- (chime--update-modeline events)
- (let ((tooltip (chime--make-tooltip chime--upcoming-events)))
- ;; Should show "in 3 hours" not "in 1 day"
- (should (string-match-p "3 hours" tooltip))
- (should-not (string-match-p "days?" tooltip)))))
- (chime-delete-test-base-dir)))
+ (let* ((now (test-time-today-at 23 0)) ; 11pm
+ ;; 3 hours later = 2am next day
+ (content (test-chime-tooltip-day-calculation--create-event-at-hours
+ now "Early Morning" 3)))
+ (test-chime-tooltip-day-calculation--with-tooltip now content
+ ;; Should show "in 3 hours" not "in 1 day"
+ (should (string-match-p "3 hours" tooltip))
+ (should-not (string-match-p "days?" tooltip)))))
(ert-deftest test-chime-tooltip-day-calculation-midnight-plus-one-day ()
"Test event at midnight tomorrow (24h exactly) shows '1 day'."
- (chime-create-test-base-dir)
- (unwind-protect
- (let* ((now (test-time-today-at 0 0)) ; Midnight today
- (content (test-chime-tooltip-day-calculation--create-event-at-hours now "Midnight Tomorrow" 24))
- (test-file (chime-create-temp-test-file-with-content content))
- (events (with-current-buffer (find-file-noselect test-file)
- (org-mode)
- (goto-char (point-min))
- (let ((evs nil))
- (while (re-search-forward "^\\*+ " nil t)
- (push (chime--gather-info (point-marker)) evs))
- (nreverse evs)))))
- (kill-buffer (get-file-buffer test-file))
-
- (setq chime-modeline-lookahead-minutes 10080)
- (setq chime-tooltip-lookahead-hours 168)
-
- (with-test-time now
- (chime--update-modeline events)
- (let ((tooltip (chime--make-tooltip chime--upcoming-events)))
- (should (string-match-p "(in 1 day)" tooltip))
- (should-not (string-match-p "hour" tooltip)))))
- (chime-delete-test-base-dir)))
+ (let* ((now (test-time-today-at 0 0)) ; Midnight today
+ (content (test-chime-tooltip-day-calculation--create-event-at-hours
+ now "Midnight Tomorrow" 24)))
+ (test-chime-tooltip-day-calculation--with-tooltip now content
+ (should (string-match-p "(in 1 day)" tooltip))
+ (should-not (string-match-p "hour" tooltip)))))
;;; Multiple Events - Verify distinct formatting
(ert-deftest test-chime-tooltip-day-calculation-multiple-events-distinct ()
"Test multiple events at different fractional-day offsets show distinct times."
- (chime-create-test-base-dir)
- (unwind-protect
- (let* ((now (test-time-today-at 12 0))
- (content (concat
- (test-chime-tooltip-day-calculation--create-event-at-hours now "Event 1 Day" 24)
- (test-chime-tooltip-day-calculation--create-event-at-hours now "Event 1.5 Days" 36)
- (test-chime-tooltip-day-calculation--create-event-at-hours now "Event 2 Days" 48)
- (test-chime-tooltip-day-calculation--create-event-at-hours now "Event 2.75 Days" 66)))
- (test-file (chime-create-temp-test-file-with-content content))
- (events (with-current-buffer (find-file-noselect test-file)
- (org-mode)
- (goto-char (point-min))
- (let ((evs nil))
- (while (re-search-forward "^\\*+ " nil t)
- (push (chime--gather-info (point-marker)) evs))
- (nreverse evs)))))
- (kill-buffer (get-file-buffer test-file))
-
- (setq chime-modeline-lookahead-minutes 10080)
- (setq chime-tooltip-lookahead-hours 168)
-
- (with-test-time now
- (chime--update-modeline events)
- (let ((tooltip (chime--make-tooltip chime--upcoming-events)))
- ;; Verify each event shows correctly
- (should (string-match-p "Event 1 Day.*(in 1 day)" tooltip))
- (should (string-match-p "Event 1.5 Days.*(in 1 day 12 hours)" tooltip))
- (should (string-match-p "Event 2 Days.*(in 2 days)" tooltip))
- (should (string-match-p "Event 2.75 Days.*(in 2 days 18 hours)" tooltip))
-
- ;; Verify they're all different
- (let ((lines (split-string tooltip "\n")))
- (let ((countdowns (cl-remove-if-not
- (lambda (line) (string-match-p "Event.*day" line))
- lines)))
- ;; Should have 4 distinct countdown lines
- (should (= 4 (length countdowns)))
- ;; All should be unique
- (should (= 4 (length (delete-dups (copy-sequence countdowns))))))))))
- (chime-delete-test-base-dir)))
+ (let* ((now (test-time-today-at 12 0))
+ (content (concat
+ (test-chime-tooltip-day-calculation--create-event-at-hours now "Event 1 Day" 24)
+ (test-chime-tooltip-day-calculation--create-event-at-hours now "Event 1.5 Days" 36)
+ (test-chime-tooltip-day-calculation--create-event-at-hours now "Event 2 Days" 48)
+ (test-chime-tooltip-day-calculation--create-event-at-hours now "Event 2.75 Days" 66))))
+ (test-chime-tooltip-day-calculation--with-tooltip now content
+ ;; Verify each event shows correctly
+ (should (string-match-p "Event 1 Day.*(in 1 day)" tooltip))
+ (should (string-match-p "Event 1.5 Days.*(in 1 day 12 hours)" tooltip))
+ (should (string-match-p "Event 2 Days.*(in 2 days)" tooltip))
+ (should (string-match-p "Event 2.75 Days.*(in 2 days 18 hours)" tooltip))
+
+ ;; Verify they're all different
+ (let ((lines (split-string tooltip "\n")))
+ (let ((countdowns (cl-remove-if-not
+ (lambda (line) (string-match-p "Event.*day" line))
+ lines)))
+ ;; Should have 4 distinct countdown lines
+ (should (= 4 (length countdowns)))
+ ;; All should be unique
+ (should (= 4 (length (delete-dups (copy-sequence countdowns))))))))))
(provide 'test-chime-tooltip-day-calculation)
;;; test-chime-tooltip-day-calculation.el ends here
diff --git a/tests/test-chime-validate-configuration.el b/tests/test-chime-validate-configuration.el
index 8bcc16e..c971632 100644
--- a/tests/test-chime-validate-configuration.el
+++ b/tests/test-chime-validate-configuration.el
@@ -15,7 +15,7 @@
;; External dependencies mocked:
;; - file-exists-p (file I/O)
;; - require (package loading)
-;; - display-warning (UI side effect)
+;; - message (interactive UI side effect)
;;
;; NOT mocked:
;; - Validation logic itself
@@ -238,35 +238,77 @@
;;; Interactive Behavior Tests
-(ert-deftest test-chime-validate-configuration-interactive-calls-display-warning ()
- "Test validation displays warnings when called interactively."
+(ert-deftest test-chime-validate-configuration-interactive-prints-all-checks-with-issues ()
+ "Interactive validation prints ok, warning, error, and summary lines."
(test-chime-validate-configuration-setup)
- (let ((org-agenda-files nil)
- (warning-called nil)
- (chime-enable-modeline t))
- (cl-letf (((symbol-function 'display-warning)
- (lambda (&rest _) (setq warning-called t)))
+ (let ((org-agenda-files '("/exists.org" "/missing.org"))
+ (chime-enable-modeline t)
+ (messages nil))
+ (cl-letf (((symbol-function 'file-exists-p)
+ (lambda (path) (string= path "/exists.org")))
+ ((symbol-function 'require) (lambda (_ &optional _ _) t))
+ ((symbol-function 'boundp)
+ (lambda (sym) (not (eq sym 'global-mode-string))))
+ ((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages)))
((symbol-function 'called-interactively-p) (lambda (_) t)))
(chime-validate-configuration)
- (should warning-called)))
+ (setq messages (nreverse messages))
+ (should (member "Chime: Validating configuration..." messages))
+ (should (member "[ok] org-agenda-files is set" messages))
+ (should (cl-some (lambda (msg)
+ (string-match-p
+ "\\[warn\\] org-agenda-files entries exist on disk (2 entries)"
+ msg))
+ messages))
+ (should (member "[ok] org-agenda is loadable" messages))
+ (should (member "[warn] global-mode-string is available" messages))
+ (should (cl-some (lambda (msg)
+ (string-match-p "/missing.org (file)" msg))
+ messages))
+ (should (member "Chime: 0 errors, 2 warnings." messages))))
(test-chime-validate-configuration-teardown))
-(ert-deftest test-chime-validate-configuration-interactive-success-shows-message ()
- "Test validation shows success message when called interactively with valid config."
+(ert-deftest test-chime-validate-configuration-interactive-success-prints-ok-checklist ()
+ "Interactive validation prints every passing check and a zero summary."
(test-chime-validate-configuration-setup)
(let ((org-agenda-files '("/tmp/inbox.org"))
- (message-shown nil)
+ (messages nil)
(chime-enable-modeline t)
(global-mode-string '("")))
(cl-letf (((symbol-function 'file-exists-p) (lambda (_) t))
((symbol-function 'require) (lambda (_ &optional _ _) t))
((symbol-function 'message)
- (lambda (fmt &rest _)
- (when (string-match-p "validation checks passed" fmt)
- (setq message-shown t))))
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages)))
((symbol-function 'called-interactively-p) (lambda (_) t)))
(chime-validate-configuration)
- (should message-shown)))
+ (setq messages (nreverse messages))
+ (should (member "Chime: Validating configuration..." messages))
+ (should (member "[ok] org-agenda-files is set" messages))
+ (should (member "[ok] org-agenda-files entries exist on disk (1 entries)"
+ messages))
+ (should (member "[ok] org-agenda is loadable" messages))
+ (should (member "[ok] global-mode-string is available" messages))
+ (should (member "Chime: 0 errors, 0 warnings." messages))))
+ (test-chime-validate-configuration-teardown))
+
+(ert-deftest test-chime-validate-configuration-programmatic-shape-unchanged ()
+ "Programmatic validation returns only (SEVERITY MESSAGE) issue pairs."
+ (test-chime-validate-configuration-setup)
+ (let ((org-agenda-files '("/missing.org"))
+ (chime-enable-modeline t)
+ (global-mode-string '("")))
+ (cl-letf (((symbol-function 'file-exists-p) (lambda (_) nil))
+ ((symbol-function 'require) (lambda (_ &optional _ _) t))
+ ((symbol-function 'called-interactively-p) (lambda (_) nil)))
+ (let ((issues (chime-validate-configuration)))
+ (should (= 1 (length issues)))
+ (should (= 2 (length (car issues))))
+ (should (eq :warning (caar issues)))
+ (should (string-match-p "1 org-agenda-files entries don't exist"
+ (cadar issues))))))
(test-chime-validate-configuration-teardown))
(provide 'test-chime-validate-configuration)
diff --git a/tests/test-chime-validation-retry.el b/tests/test-chime-validation-retry.el
index 70188bc..a2765f4 100644
--- a/tests/test-chime-validation-retry.el
+++ b/tests/test-chime-validation-retry.el
@@ -20,37 +20,21 @@
;;; Code:
(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
+(require 'testutil-general (expand-file-name "testutil-general.el"))
+(require 'testutil-time (expand-file-name "testutil-time.el"))
+(require 'testutil-events (expand-file-name "testutil-events.el"))
;;; Setup and Teardown
-(defvar test-chime-validation-retry--original-max-retries nil
- "Original value of chime--validation-max-retries for restoration.")
-
-(defvar test-chime-validation-retry--original-agenda-files nil
- "Original value of org-agenda-files for restoration.")
-
-(defun test-chime-validation-retry-setup ()
- "Set up test environment before each test."
- ;; Save original values
- (setq test-chime-validation-retry--original-max-retries chime--validation-max-retries)
- (setq test-chime-validation-retry--original-agenda-files org-agenda-files)
-
- ;; Reset validation state
- (setq chime--validation-done nil)
- (setq chime--validation-retry-count 0)
-
- ;; Set predictable defaults
- (setq chime--validation-max-retries 3))
-
-(defun test-chime-validation-retry-teardown ()
- "Clean up test environment after each test."
- ;; Restore original values
- (setq chime--validation-max-retries test-chime-validation-retry--original-max-retries)
- (setq org-agenda-files test-chime-validation-retry--original-agenda-files)
-
- ;; Reset validation state
- (setq chime--validation-done nil)
- (setq chime--validation-retry-count 0))
+(defmacro test-chime-validation-retry--with-state (&rest body)
+ "Run BODY with isolated validation retry state."
+ (declare (indent 0))
+ `(with-chime-config
+ chime--validation-max-retries 3
+ org-agenda-files nil
+ (let ((chime--validation-done nil)
+ (chime--validation-retry-count 0))
+ ,@body)))
;;; Normal Cases - Retry Behavior
@@ -60,35 +44,32 @@
When org-agenda-files is empty on the first check, chime should show
a friendly waiting message instead of immediately displaying the full
error. This accommodates async org-agenda-files initialization."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- ;; Empty org-agenda-files to trigger validation failure
- (setq org-agenda-files nil)
-
- ;; Capture message output
- (let ((messages nil))
- (cl-letf (((symbol-function 'message)
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages)))
- ;; Mock fetch to prevent actual agenda processing
- ((symbol-function 'chime--fetch-and-process)
- (lambda (callback) nil)))
-
- ;; Call chime-check
- (chime-check)
-
- ;; Should show waiting message
- (should (= chime--validation-retry-count 1))
- (should-not chime--validation-done)
- (should (cl-some (lambda (msg)
- (string-match-p "Waiting for org-agenda-files" msg))
- messages))
- ;; Should NOT show error message
- (should-not (cl-some (lambda (msg)
- (string-match-p "Configuration errors detected" msg))
- messages)))))
- (test-chime-validation-retry-teardown)))
+ (test-chime-validation-retry--with-state
+ ;; Empty org-agenda-files to trigger validation failure
+ (setq org-agenda-files nil)
+
+ ;; Capture message output
+ (let ((messages nil))
+ (cl-letf (((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages)))
+ ;; Mock fetch to prevent actual agenda processing
+ ((symbol-function 'chime--fetch-and-process)
+ (lambda (callback) nil)))
+
+ ;; Call chime-check
+ (chime-check)
+
+ ;; Should show waiting message
+ (should (= chime--validation-retry-count 1))
+ (should-not chime--validation-done)
+ (should (cl-some (lambda (msg)
+ (string-match-p "Waiting for org-agenda-files" msg))
+ messages))
+ ;; Should NOT show error message
+ (should-not (cl-some (lambda (msg)
+ (string-match-p "Configuration errors detected" msg))
+ messages))))))
(ert-deftest test-chime-validation-retry-normal-success-resets-counter ()
"Test successful validation after retry resets counter to zero.
@@ -96,83 +77,74 @@ error. This accommodates async org-agenda-files initialization."
When validation succeeds on a retry attempt, the retry counter should
be reset to 0, allowing fresh retry attempts if validation fails again
later (e.g., after mode restart)."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- ;; Simulate one failed attempt
- (setq chime--validation-retry-count 1)
+ (test-chime-validation-retry--with-state
+ ;; Simulate one failed attempt
+ (setq chime--validation-retry-count 1)
- ;; Set valid org-agenda-files
- (setq org-agenda-files '("/tmp/test.org"))
+ ;; Set valid org-agenda-files
+ (setq org-agenda-files '("/tmp/test.org"))
- ;; Mock fetch to prevent actual agenda processing
- (cl-letf (((symbol-function 'chime--fetch-and-process)
- (lambda (callback) nil)))
+ ;; Mock fetch to prevent actual agenda processing
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (callback) nil)))
- ;; Call chime-check - should succeed
- (chime-check)
+ ;; Call chime-check - should succeed
+ (chime-check)
- ;; Counter should be reset
- (should (= chime--validation-retry-count 0))
- ;; Validation marked as done
- (should chime--validation-done)))
- (test-chime-validation-retry-teardown)))
+ ;; Counter should be reset
+ (should (= chime--validation-retry-count 0))
+ ;; Validation marked as done
+ (should chime--validation-done))))
(ert-deftest test-chime-validation-retry-normal-multiple-retries-increment ()
"Test multiple validation failures increment counter correctly.
Each validation failure should increment the retry counter by 1,
allowing the system to track how many retries have been attempted."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- ;; Empty org-agenda-files
- (setq org-agenda-files nil)
-
- ;; Mock fetch
- (cl-letf (((symbol-function 'chime--fetch-and-process)
- (lambda (callback) nil))
- ((symbol-function 'message)
- (lambda (&rest args) nil)))
-
- ;; First attempt
- (chime-check)
- (should (= chime--validation-retry-count 1))
-
- ;; Second attempt
- (chime-check)
- (should (= chime--validation-retry-count 2))
-
- ;; Third attempt
- (chime-check)
- (should (= chime--validation-retry-count 3))))
- (test-chime-validation-retry-teardown)))
+ (test-chime-validation-retry--with-state
+ ;; Empty org-agenda-files
+ (setq org-agenda-files nil)
+
+ ;; Mock fetch
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (callback) nil))
+ ((symbol-function 'message)
+ (lambda (&rest args) nil)))
+
+ ;; First attempt
+ (chime-check)
+ (should (= chime--validation-retry-count 1))
+
+ ;; Second attempt
+ (chime-check)
+ (should (= chime--validation-retry-count 2))
+
+ ;; Third attempt
+ (chime-check)
+ (should (= chime--validation-retry-count 3)))))
(ert-deftest test-chime-validation-retry-normal-successful-validation-proceeds ()
"Test successful validation proceeds with event checking.
When validation passes, chime-check should proceed to fetch and
process events normally."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- ;; Valid org-agenda-files
- (setq org-agenda-files '("/tmp/test.org"))
-
- ;; Track if fetch was called
- (let ((fetch-called nil))
- (cl-letf (((symbol-function 'chime--fetch-and-process)
- (lambda (callback)
- (setq fetch-called t))))
-
- ;; Call chime-check
- (chime-check)
-
- ;; Should proceed to fetch
- (should fetch-called)
- (should chime--validation-done)
- (should (= chime--validation-retry-count 0)))))
- (test-chime-validation-retry-teardown)))
+ (test-chime-validation-retry--with-state
+ ;; Valid org-agenda-files
+ (setq org-agenda-files '("/tmp/test.org"))
+
+ ;; Track if fetch was called
+ (let ((fetch-called nil))
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (callback)
+ (setq fetch-called t))))
+
+ ;; Call chime-check
+ (chime-check)
+
+ ;; Should proceed to fetch
+ (should fetch-called)
+ (should chime--validation-done)
+ (should (= chime--validation-retry-count 0))))))
;;; Boundary Cases - Edge Conditions
@@ -182,159 +154,144 @@ process events normally."
When chime--validation-max-retries is set to 0, validation failures
should immediately show the full error message without any retry
attempts."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- ;; Set max retries to 0
- (setq chime--validation-max-retries 0)
-
- ;; Empty org-agenda-files
- (setq org-agenda-files nil)
-
- ;; Capture message output
- (let ((messages nil))
- (cl-letf (((symbol-function 'message)
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages)))
- ((symbol-function 'chime--fetch-and-process)
- (lambda (callback) nil)))
-
- ;; Call chime-check
- (chime-check)
-
- ;; Counter incremented
- (should (= chime--validation-retry-count 1))
- ;; Should show error, not waiting message
- (should (cl-some (lambda (msg)
- (string-match-p "Configuration errors detected" msg))
- messages))
- (should-not (cl-some (lambda (msg)
- (string-match-p "Waiting for" msg))
- messages)))))
- (test-chime-validation-retry-teardown)))
+ (test-chime-validation-retry--with-state
+ ;; Set max retries to 0
+ (setq chime--validation-max-retries 0)
+
+ ;; Empty org-agenda-files
+ (setq org-agenda-files nil)
+
+ ;; Capture message output
+ (let ((messages nil))
+ (cl-letf (((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages)))
+ ((symbol-function 'chime--fetch-and-process)
+ (lambda (callback) nil)))
+
+ ;; Call chime-check
+ (chime-check)
+
+ ;; Counter incremented
+ (should (= chime--validation-retry-count 1))
+ ;; Should show error, not waiting message
+ (should (cl-some (lambda (msg)
+ (string-match-p "Configuration errors detected" msg))
+ messages))
+ (should-not (cl-some (lambda (msg)
+ (string-match-p "Waiting for" msg))
+ messages))))))
(ert-deftest test-chime-validation-retry-boundary-max-retries-one ()
"Test max-retries=1 allows one retry before showing error.
First attempt should show waiting message, second attempt should
show full error."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- ;; Set max retries to 1
- (setq chime--validation-max-retries 1)
-
- ;; Empty org-agenda-files
- (setq org-agenda-files nil)
-
- (cl-letf (((symbol-function 'chime--fetch-and-process)
- (lambda (callback) nil)))
-
- ;; First attempt - should show waiting
- (let ((messages nil))
- (cl-letf (((symbol-function 'message)
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages))))
- (chime-check)
- (should (= chime--validation-retry-count 1))
- (should (cl-some (lambda (msg)
- (string-match-p "Waiting for" msg))
- messages))))
-
- ;; Second attempt - should show error
- (let ((messages nil))
- (cl-letf (((symbol-function 'message)
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages))))
- (chime-check)
- (should (= chime--validation-retry-count 2))
- (should (cl-some (lambda (msg)
- (string-match-p "Configuration errors detected" msg))
- messages))))))
- (test-chime-validation-retry-teardown)))
+ (test-chime-validation-retry--with-state
+ ;; Set max retries to 1
+ (setq chime--validation-max-retries 1)
+
+ ;; Empty org-agenda-files
+ (setq org-agenda-files nil)
+
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (callback) nil)))
+
+ ;; First attempt - should show waiting
+ (let ((messages nil))
+ (cl-letf (((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages))))
+ (chime-check)
+ (should (= chime--validation-retry-count 1))
+ (should (cl-some (lambda (msg)
+ (string-match-p "Waiting for" msg))
+ messages))))
+
+ ;; Second attempt - should show error
+ (let ((messages nil))
+ (cl-letf (((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages))))
+ (chime-check)
+ (should (= chime--validation-retry-count 2))
+ (should (cl-some (lambda (msg)
+ (string-match-p "Configuration errors detected" msg))
+ messages)))))))
(ert-deftest test-chime-validation-retry-boundary-exactly-at-threshold ()
"Test behavior exactly at max-retries threshold.
The (retry_count + 1)th attempt should show the error message."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- ;; Default max retries = 3
- (setq chime--validation-max-retries 3)
- (setq org-agenda-files nil)
-
- (cl-letf (((symbol-function 'chime--fetch-and-process)
- (lambda (callback) nil)))
-
- ;; Attempts 1-3: waiting messages
- (dotimes (_ 3)
- (let ((messages nil))
- (cl-letf (((symbol-function 'message)
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages))))
- (chime-check)
- (should (cl-some (lambda (msg)
- (string-match-p "Waiting for" msg))
- messages)))))
-
- ;; Attempt 4: should show error
- (let ((messages nil))
- (cl-letf (((symbol-function 'message)
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages))))
- (chime-check)
- (should (= chime--validation-retry-count 4))
- (should (cl-some (lambda (msg)
- (string-match-p "Configuration errors detected" msg))
- messages))))))
- (test-chime-validation-retry-teardown)))
+ (test-chime-validation-retry--with-state
+ ;; Default max retries = 3
+ (setq chime--validation-max-retries 3)
+ (setq org-agenda-files nil)
+
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (callback) nil)))
+
+ ;; Attempts 1-3: waiting messages
+ (dotimes (_ 3)
+ (let ((messages nil))
+ (cl-letf (((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages))))
+ (chime-check)
+ (should (cl-some (lambda (msg)
+ (string-match-p "Waiting for" msg))
+ messages)))))
+
+ ;; Attempt 4: should show error
+ (let ((messages nil))
+ (cl-letf (((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages))))
+ (chime-check)
+ (should (= chime--validation-retry-count 4))
+ (should (cl-some (lambda (msg)
+ (string-match-p "Configuration errors detected" msg))
+ messages)))))))
(ert-deftest test-chime-validation-retry-boundary-stop-resets-counter ()
"Test chime--stop resets retry counter to zero.
When chime-mode is stopped, the retry counter should be reset to
allow fresh retry attempts on next start."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- ;; Simulate some failed attempts
- (setq chime--validation-retry-count 5)
- (setq chime--validation-done nil)
+ (test-chime-validation-retry--with-state
+ ;; Simulate some failed attempts
+ (setq chime--validation-retry-count 5)
+ (setq chime--validation-done nil)
- ;; Call stop
- (chime--stop)
+ ;; Call stop
+ (chime--stop)
- ;; Counter should be reset
- (should (= chime--validation-retry-count 0))
- (should-not chime--validation-done))
- (test-chime-validation-retry-teardown)))
+ ;; Counter should be reset
+ (should (= chime--validation-retry-count 0))
+ (should-not chime--validation-done)))
(ert-deftest test-chime-validation-retry-boundary-empty-agenda-files ()
"Test empty org-agenda-files list triggers retry.
An empty list should be treated the same as nil - both should
trigger validation failure and retry."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- ;; Empty list (not nil)
- (setq org-agenda-files '())
-
- (let ((messages nil))
- (cl-letf (((symbol-function 'message)
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages)))
- ((symbol-function 'chime--fetch-and-process)
- (lambda (callback) nil)))
-
- ;; Should trigger retry
- (chime-check)
- (should (= chime--validation-retry-count 1))
- (should (cl-some (lambda (msg)
- (string-match-p "Waiting for" msg))
- messages)))))
- (test-chime-validation-retry-teardown)))
+ (test-chime-validation-retry--with-state
+ ;; Empty list (not nil)
+ (setq org-agenda-files '())
+
+ (let ((messages nil))
+ (cl-letf (((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages)))
+ ((symbol-function 'chime--fetch-and-process)
+ (lambda (callback) nil)))
+
+ ;; Should trigger retry
+ (chime-check)
+ (should (= chime--validation-retry-count 1))
+ (should (cl-some (lambda (msg)
+ (string-match-p "Waiting for" msg))
+ messages))))))
;;; Error Cases - Failure Scenarios
@@ -343,85 +300,76 @@ trigger validation failure and retry."
After max retries exceeded, the full validation error should be
displayed with all error details in the *Messages* buffer."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- (setq chime--validation-max-retries 2)
- (setq org-agenda-files nil)
-
- (cl-letf (((symbol-function 'chime--fetch-and-process)
- (lambda (callback) nil)))
-
- ;; Exhaust retries
- (dotimes (_ 3)
- (let ((messages nil))
- (cl-letf (((symbol-function 'message)
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages))))
- (chime-check))))
-
- ;; Verify error message on next attempt
- (let ((messages nil))
- (cl-letf (((symbol-function 'message)
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages))))
- (chime-check)
- ;; Should show error message (detailed error with retry count goes to *Messages* buffer via chime--log-silently)
- (should (cl-some (lambda (msg)
- (string-match-p "Configuration errors detected" msg))
- messages))))))
- (test-chime-validation-retry-teardown)))
+ (test-chime-validation-retry--with-state
+ (setq chime--validation-max-retries 2)
+ (setq org-agenda-files nil)
+
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (callback) nil)))
+
+ ;; Exhaust retries
+ (dotimes (_ 3)
+ (let ((messages nil))
+ (cl-letf (((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages))))
+ (chime-check))))
+
+ ;; Verify error message on next attempt
+ (let ((messages nil))
+ (cl-letf (((symbol-function 'message)
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages))))
+ (chime-check)
+ ;; Should show error message (detailed error with retry count goes to *Messages* buffer via chime--log-silently)
+ (should (cl-some (lambda (msg)
+ (string-match-p "Configuration errors detected" msg))
+ messages)))))))
(ert-deftest test-chime-validation-retry-error-persistent-failure ()
"Test validation failure persisting through all retries.
If org-agenda-files remains empty through all retry attempts,
validation should never be marked as done."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- (setq chime--validation-max-retries 3)
- (setq org-agenda-files nil)
-
- (cl-letf (((symbol-function 'chime--fetch-and-process)
- (lambda (callback) nil))
- ((symbol-function 'message)
- (lambda (&rest args) nil)))
-
- ;; Multiple attempts, all failing
- (dotimes (_ 10)
- (chime-check)
- ;; Should never mark as done
- (should-not chime--validation-done))
-
- ;; Counter keeps incrementing
- (should (= chime--validation-retry-count 10))))
- (test-chime-validation-retry-teardown)))
+ (test-chime-validation-retry--with-state
+ (setq chime--validation-max-retries 3)
+ (setq org-agenda-files nil)
+
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (callback) nil))
+ ((symbol-function 'message)
+ (lambda (&rest args) nil)))
+
+ ;; Multiple attempts, all failing
+ (dotimes (_ 10)
+ (chime-check)
+ ;; Should never mark as done
+ (should-not chime--validation-done))
+
+ ;; Counter keeps incrementing
+ (should (= chime--validation-retry-count 10)))))
(ert-deftest test-chime-validation-retry-error-counter-large-value ()
"Test retry counter handles large values without overflow.
The retry counter should continue incrementing correctly even with
many retry attempts, ensuring no integer overflow issues."
- (test-chime-validation-retry-setup)
- (unwind-protect
- (progn
- (setq chime--validation-max-retries 1000)
- (setq org-agenda-files nil)
-
- (cl-letf (((symbol-function 'chime--fetch-and-process)
- (lambda (callback) nil))
- ((symbol-function 'message)
- (lambda (&rest args) nil)))
-
- ;; Many attempts
- (dotimes (i 100)
- (chime-check)
- (should (= chime--validation-retry-count (1+ i))))
-
- ;; Should still be counting correctly
- (should (= chime--validation-retry-count 100))))
- (test-chime-validation-retry-teardown)))
+ (test-chime-validation-retry--with-state
+ (setq chime--validation-max-retries 1000)
+ (setq org-agenda-files nil)
+
+ (cl-letf (((symbol-function 'chime--fetch-and-process)
+ (lambda (callback) nil))
+ ((symbol-function 'message)
+ (lambda (&rest args) nil)))
+
+ ;; Many attempts
+ (dotimes (i 100)
+ (chime-check)
+ (should (= chime--validation-retry-count (1+ i))))
+
+ ;; Should still be counting correctly
+ (should (= chime--validation-retry-count 100)))))
(provide 'test-chime-validation-retry)
;;; test-chime-validation-retry.el ends here
diff --git a/tests/testutil-events.el b/tests/testutil-events.el
index 0ee3d57..91fdcfc 100644
--- a/tests/testutil-events.el
+++ b/tests/testutil-events.el
@@ -128,9 +128,9 @@ Example:
(list (cons ts-str time))
'((10 . medium)))))
(should (string= \"Meeting\" (cdr (assoc 'title event)))))"
- `((times . ,time-alist)
- (title . ,title)
- (intervals . ,(or intervals '((10 . medium))))))
+ (chime--make-event time-alist
+ title
+ (or intervals '((10 . medium)))))
(defun test-make-simple-event (title time &optional interval-minutes severity)
"Create simple event data structure with single time and interval.
@@ -182,6 +182,19 @@ Example:
`(let ((,events-var (test-gather-events-from-content ,content)))
,@body))
+(defmacro with-chime-tooltip-from-content (content tooltip-var &rest body)
+ "Create org CONTENT, update modeline events, and bind TOOLTIP-VAR.
+The helper keeps modeline globals dynamically isolated so tests can assert on
+tooltip text without leaking `chime--upcoming-events' or `chime-modeline-string'."
+ (declare (indent 2))
+ (let ((events-var (make-symbol "events")))
+ `(let ((chime--upcoming-events nil)
+ (chime-modeline-string nil))
+ (with-gathered-events ,content ,events-var
+ (chime--update-modeline ,events-var)
+ (let ((,tooltip-var (chime--make-tooltip chime--upcoming-events)))
+ ,@body)))))
+
;;; Setup/Teardown Helpers
(defun test-standard-setup ()