diff options
| -rw-r--r-- | README.org | 1 | ||||
| -rw-r--r-- | chime.el | 88 | ||||
| -rw-r--r-- | docs/CONFIGURATION.org | 32 | ||||
| -rw-r--r-- | tests/test-chime-modeline-faces.el | 180 |
4 files changed, 294 insertions, 7 deletions
@@ -24,6 +24,7 @@ CHIME (backronym: *CHIME Heralds Imminent Modeline Events*) keeps your org-agend - Desktop notifications with configurable alert intervals and urgency - Optional audible chime sound, using the bundled WAV or a custom file - Interactive modeline display for the next timed event +- Themeable modeline faces that shift color as the next event gets closer - Hover tooltip with upcoming events grouped by day - Left-click calendar URL and right-click jump-to-org-entry actions - SCHEDULED, DEADLINE, plain timestamp, and repeating timestamp support @@ -460,6 +460,23 @@ Examples: :type '(choice (const :tag "Show nothing" nil) (string :tag "Custom text"))) +(defcustom chime-modeline-soon-threshold-minutes 30 + "Minutes-until threshold for the \"soon\" modeline face. +When the soonest modeline event is this many minutes away or fewer (but +more than `chime-modeline-urgent-threshold-minutes'), the modeline event +display uses `chime-modeline-soon-face'." + :package-version '(chime . "0.7.0") + :group 'chime + :type 'number) + +(defcustom chime-modeline-urgent-threshold-minutes 5 + "Minutes-until threshold for the \"urgent\" modeline face. +When the soonest modeline event is this many minutes away or fewer, the +modeline event display uses `chime-modeline-urgent-face'." + :package-version '(chime . "0.7.0") + :group 'chime + :type 'number) + (defcustom chime-notification-text-format "%t at %T (%u)" "Format string for notification text display. Available placeholders: @@ -793,6 +810,44 @@ Set to t to enable debug functions: ;; `(with-eval-after-load 'org-capture (require 'chime-org-contacts))' or ;; `use-package chime-org-contacts :after org-capture' setup. +;;;; Faces + +(defface chime-modeline-face + '((t :inherit mode-line)) + "Face for the modeline event display when the next event is not soon. +This is the default appearance. It inherits `mode-line', so the modeline +looks unchanged until you theme it or the soonest event crosses the +soon/urgent thresholds." + :package-version '(chime . "0.7.0") + :group 'chime) + +(defface chime-modeline-soon-face + '((t :inherit warning)) + "Face for the modeline event display when the next event is soon. +Applied when the soonest event is within +`chime-modeline-soon-threshold-minutes'. Inherits `warning' so it stands +out sensibly across themes." + :package-version '(chime . "0.7.0") + :group 'chime) + +(defface chime-modeline-urgent-face + '((t :inherit error)) + "Face for the modeline event display when the next event is imminent. +Applied when the soonest event is within +`chime-modeline-urgent-threshold-minutes'. Inherits `error' so it draws +the eye across themes." + :package-version '(chime . "0.7.0") + :group 'chime) + +(defface chime-modeline-no-events-face + '((t :inherit mode-line)) + "Face for the modeline idle indicator when no event is in range. +Applied to `chime-modeline-no-events-text' and to the loading and error +indicators. Inherits `mode-line' so the idle icon looks unchanged until +you theme it." + :package-version '(chime . "0.7.0") + :group 'chime) + ;;;; Internal State (defvar chime--timer nil @@ -1436,21 +1491,36 @@ The result is plain text suitable for the modeline `help-echo' property." (format chime-tooltip-increase-lookahead-format increase-var)) chime-tooltip-left-click-label))) -(defun chime--propertize-modeline-string (text) +(defun chime--modeline-urgency-face (minutes) + "Return the modeline face symbol for an event MINUTES away. +Maps to `chime-modeline-urgent-face' at or under +`chime-modeline-urgent-threshold-minutes', `chime-modeline-soon-face' at or +under `chime-modeline-soon-threshold-minutes', otherwise +`chime-modeline-face'." + (cond + ((<= minutes chime-modeline-urgent-threshold-minutes) + 'chime-modeline-urgent-face) + ((<= minutes chime-modeline-soon-threshold-minutes) + 'chime-modeline-soon-face) + (t 'chime-modeline-face))) + +(defun chime--propertize-modeline-string (text &optional face) "Add tooltip and click handlers to modeline TEXT. +Apply FACE (a face symbol) as the `face' text property when non-nil. Left-click opens calendar URL (if set), right-click jumps to event." (if (null chime--upcoming-events) - text + (if face (propertize text 'face face) text) (let ((map (make-sparse-keymap)) (tooltip (chime--make-tooltip chime--upcoming-events))) ;; Left-click: open calendar URL (define-key map [mode-line mouse-1] #'chime--open-calendar-url) ;; Right-click: jump to event (define-key map [mode-line mouse-3] #'chime--jump-to-first-event) - (propertize text - 'help-echo tooltip - 'mouse-face 'mode-line-highlight - 'local-map map)))) + (apply #'propertize text + (append (when face (list 'face face)) + (list 'help-echo tooltip + 'mouse-face 'mode-line-highlight + 'local-map map)))))) (defun chime--deduplicate-events-by-title (upcoming-events) "Collapse UPCOMING-EVENTS that come from the same source heading. @@ -1573,7 +1643,8 @@ Returns a propertized string, or nil when nothing should be shown." (cond (soonest-modeline (chime--propertize-modeline-string - (format chime-modeline-format (nth 3 soonest-modeline)))) + (format chime-modeline-format (nth 3 soonest-modeline)) + (chime--modeline-urgency-face (nth 2 soonest-modeline)))) (chime-modeline-no-events-text (let ((map (make-sparse-keymap)) (tooltip-text (if upcoming @@ -1583,6 +1654,7 @@ Returns a propertized string, or nil when nothing should be shown." (when upcoming (define-key map [mode-line mouse-3] #'chime--jump-to-first-event)) (propertize chime-modeline-no-events-text + 'face 'chime-modeline-no-events-face 'help-echo tooltip-text 'mouse-face 'mode-line-highlight 'local-map map))))) @@ -2430,6 +2502,7 @@ Keeps the icon visible so the user knows chime is running but has a problem." (define-key map [mode-line mouse-1] #'chime--open-calendar-url) (setq chime-modeline-string (propertize chime-modeline-no-events-text + 'face 'chime-modeline-no-events-face 'help-echo (format "Chime: %s" error-message) 'mouse-face 'mode-line-highlight 'local-map map)) @@ -2442,6 +2515,7 @@ Uses `chime-modeline-no-events-text' with a loading tooltip." (let ((map (make-sparse-keymap))) (define-key map [mode-line mouse-1] #'chime--open-calendar-url) (propertize chime-modeline-no-events-text + 'face 'chime-modeline-no-events-face 'help-echo chime-modeline-initial-tooltip 'mouse-face 'mode-line-highlight 'local-map map)))) diff --git a/docs/CONFIGURATION.org b/docs/CONFIGURATION.org index a6dc979..3565c4a 100644 --- a/docs/CONFIGURATION.org +++ b/docs/CONFIGURATION.org @@ -208,6 +208,38 @@ Larger values increase the agenda span fetched by the async subprocess and can s (setq chime-calendar-url "https://calendar.google.com") #+END_SRC +** Faces + +The modeline event display is themeable. Chime colors it by how soon the next +event is, using three faces, plus a fourth for the idle indicator: + +- =chime-modeline-face= — the next event is more than + =chime-modeline-soon-threshold-minutes= away. Inherits =mode-line=, so the + modeline looks unchanged until you theme it. +- =chime-modeline-soon-face= — the next event is within the soon threshold. + Inherits =warning=. +- =chime-modeline-urgent-face= — the next event is within + =chime-modeline-urgent-threshold-minutes=. Inherits =error=. +- =chime-modeline-no-events-face= — shown for the idle indicator + (=chime-modeline-no-events-text=, and the loading and error icons). + Inherits =mode-line=. + +The two thresholds control where the soon and urgent faces kick in (in +minutes until the event): + +#+BEGIN_SRC elisp +(setq chime-modeline-soon-threshold-minutes 30) ;; soon face at 30 min or less +(setq chime-modeline-urgent-threshold-minutes 5) ;; urgent face at 5 min or less +#+END_SRC + +Customize the faces like any other. They inherit sensible built-ins, so they +adapt to your theme out of the box; override when you want something specific: + +#+BEGIN_SRC elisp +(custom-set-faces + '(chime-modeline-urgent-face ((t :foreground "red" :weight bold)))) +#+END_SRC + * Notification Text Control what appears in notifications and the modeline event text: diff --git a/tests/test-chime-modeline-faces.el b/tests/test-chime-modeline-faces.el new file mode 100644 index 0000000..dc8eae8 --- /dev/null +++ b/tests/test-chime-modeline-faces.el @@ -0,0 +1,180 @@ +;;; test-chime-modeline-faces.el --- Tests for themeable modeline faces -*- 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 chime's themeable modeline faces: +;; - the four deffaces are defined +;; - chime--modeline-urgency-face maps minutes-until to the right face +;; - chime--propertize-modeline-string applies a passed face +;; - chime--render-modeline-string applies the urgency / no-events faces + +;;; 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/Teardown + +(defun test-chime-faces-setup () + "Set tooltip formats so render paths produce a tooltip string." + (chime-create-test-base-dir) + (setq chime-tooltip-header-format "Upcoming Events as of %a %b %d %Y @ %I:%M %p") + (setq chime-display-time-format-string "%I:%M %p") + (setq chime-time-left-formats + (list (cons 'at-event "right now") + (cons 'short "in %M") + (cons 'long "in %H %M")))) + +(defun test-chime-faces-teardown () + "Teardown." + (chime-delete-test-base-dir) + (setq chime--upcoming-events nil)) + +;;; Faces are defined + +(ert-deftest test-chime-modeline-faces-are-defined () + "Normal: chime defines the four themeable modeline faces." + (should (facep 'chime-modeline-face)) + (should (facep 'chime-modeline-soon-face)) + (should (facep 'chime-modeline-urgent-face)) + (should (facep 'chime-modeline-no-events-face))) + +;;; Urgency-face mapping — Normal + +(ert-deftest test-chime-modeline-urgency-face-default-when-distant () + "Normal: an event beyond the soon threshold maps to the default face." + (let ((chime-modeline-urgent-threshold-minutes 5) + (chime-modeline-soon-threshold-minutes 30)) + (should (eq 'chime-modeline-face (chime--modeline-urgency-face 60))))) + +(ert-deftest test-chime-modeline-urgency-face-soon () + "Normal: an event inside the soon window maps to the soon face." + (let ((chime-modeline-urgent-threshold-minutes 5) + (chime-modeline-soon-threshold-minutes 30)) + (should (eq 'chime-modeline-soon-face (chime--modeline-urgency-face 20))))) + +(ert-deftest test-chime-modeline-urgency-face-urgent () + "Normal: an imminent event maps to the urgent face." + (let ((chime-modeline-urgent-threshold-minutes 5) + (chime-modeline-soon-threshold-minutes 30)) + (should (eq 'chime-modeline-urgent-face (chime--modeline-urgency-face 2))))) + +;;; Urgency-face mapping — Boundary + +(ert-deftest test-chime-modeline-urgency-face-at-urgent-threshold () + "Boundary: minutes exactly at the urgent threshold is urgent." + (let ((chime-modeline-urgent-threshold-minutes 5) + (chime-modeline-soon-threshold-minutes 30)) + (should (eq 'chime-modeline-urgent-face (chime--modeline-urgency-face 5))))) + +(ert-deftest test-chime-modeline-urgency-face-at-soon-threshold () + "Boundary: minutes exactly at the soon threshold is soon." + (let ((chime-modeline-urgent-threshold-minutes 5) + (chime-modeline-soon-threshold-minutes 30)) + (should (eq 'chime-modeline-soon-face (chime--modeline-urgency-face 30))))) + +(ert-deftest test-chime-modeline-urgency-face-zero-is-urgent () + "Boundary: an event happening now (0 minutes) is urgent." + (let ((chime-modeline-urgent-threshold-minutes 5) + (chime-modeline-soon-threshold-minutes 30)) + (should (eq 'chime-modeline-urgent-face (chime--modeline-urgency-face 0))))) + +(ert-deftest test-chime-modeline-urgency-face-fractional-minutes () + "Boundary: fractional minutes (minutes-until is a float) bucket correctly." + (let ((chime-modeline-urgent-threshold-minutes 5) + (chime-modeline-soon-threshold-minutes 30)) + (should (eq 'chime-modeline-urgent-face (chime--modeline-urgency-face 4.5))) + (should (eq 'chime-modeline-soon-face (chime--modeline-urgency-face 5.5))))) + +;;; propertize applies face + +(ert-deftest test-chime-propertize-applies-face-when-passed () + "Normal: a non-nil FACE argument becomes the `face' text property." + (test-chime-faces-setup) + (unwind-protect + (let* ((now (test-time-now)) + (event-time (time-add now (seconds-to-time 120))) + (ts (test-timestamp-string event-time))) + (setq chime--upcoming-events + (list (list `((title . "Meeting") (times . ((,ts . ,event-time)))) + (cons ts event-time) 2))) + (with-test-time now + (let ((result (chime--propertize-modeline-string + " ⏰ Meeting" 'chime-modeline-urgent-face))) + (should (eq 'chime-modeline-urgent-face + (get-text-property 0 'face result)))))) + (test-chime-faces-teardown))) + +(ert-deftest test-chime-propertize-no-face-when-omitted () + "Boundary: with no FACE argument, no `face' property is added." + (test-chime-faces-setup) + (unwind-protect + (let* ((now (test-time-now)) + (event-time (time-add now (seconds-to-time 1800))) + (ts (test-timestamp-string event-time))) + (setq chime--upcoming-events + (list (list `((title . "Meeting") (times . ((,ts . ,event-time)))) + (cons ts event-time) 30))) + (with-test-time now + (let ((result (chime--propertize-modeline-string " ⏰ Meeting"))) + (should-not (get-text-property 0 'face result))))) + (test-chime-faces-teardown))) + +;;; render applies the urgency / no-events faces + +(ert-deftest test-chime-render-applies-urgency-face-to-soonest () + "Normal: render applies the urgency face matching the soonest event." + (test-chime-faces-setup) + (unwind-protect + (let* ((chime-modeline-urgent-threshold-minutes 5) + (chime-modeline-soon-threshold-minutes 30) + (chime-modeline-format " ⏰ %s") + (now (test-time-now)) + (event-time (time-add now (seconds-to-time 120))) + (ts (test-timestamp-string event-time)) + (soonest (list `((title . "Meeting")) ts 2 "Meeting in 2 min"))) + (setq chime--upcoming-events + (list (list `((title . "Meeting") (times . ((,ts . ,event-time)))) + (cons ts event-time) 2))) + (with-test-time now + (let ((result (chime--render-modeline-string + soonest chime--upcoming-events 168))) + (should (eq 'chime-modeline-urgent-face + (get-text-property 0 'face result)))))) + (test-chime-faces-teardown))) + +(ert-deftest test-chime-render-no-events-applies-no-events-face () + "Normal: the no-events modeline applies the no-events face." + (test-chime-faces-setup) + (unwind-protect + (let ((chime-modeline-no-events-text " ⏰") + (now (test-time-now))) + (setq chime--upcoming-events nil) + (with-test-time now + (let ((result (chime--render-modeline-string nil nil 168))) + (should (eq 'chime-modeline-no-events-face + (get-text-property 0 'face result)))))) + (test-chime-faces-teardown))) + +(provide 'test-chime-modeline-faces) +;;; test-chime-modeline-faces.el ends here |