path: root/chime.el

;;; chime.el --- CHIME Heralds Imminent Events -*- lexical-binding: t -*-

;; Copyright (C) 2017 Artem Khramov
;; Copyright (C) 2024 Craig Jennings

;; Current Author/Maintainer: Craig Jennings <c@cjennings.net>
;; Original Author: Artem Khramov <akhramov+emacs@pm.me>
;; Created: 6 Jan 2017
;; Version: 0.6.0
;; Package-Requires: ((alert "1.2") (async "1.9.3") (dash "2.18.0") (emacs "26.1"))
;; Keywords: notification alert org org-agenda agenda calendar chime sound
;; URL: https://github.com/cjennings/chime.el

;; 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:

;; CHIME (CHIME Heralds Imminent Events) - Customizable org-agenda notifications
;;
;; This package provides visual and audible notifications for upcoming org-agenda
;; events with modeline display of the next upcoming event.
;;
;; Features:
;; - Visual notifications with customizable alert times
;; - Audible chime sound when notifications appear
;; - Modeline display of next upcoming event
;; - Support for SCHEDULED, DEADLINE, and plain timestamps
;; - Repeating timestamp support (+1w, .+1d, ++1w)
;; - Per-event notification customization
;; - Async background checking (runs every minute)
;;
;; Quick Start:
;; (require 'chime)
;; (setq chime-alert-time '(5 0))  ; 5 min before and at event time
;; (chime-mode 1)
;;
;; Manual check: M-x chime-check
;;
;; Notification times can be customized globally via `chime-alert-time'
;; or per-event using the `CHIME_NOTIFY_BEFORE` property.
;;
;; Filter notifications using `chime-keyword-whitelist' and
;; `chime-keyword-blacklist' variables.
;;
;; See README.org for complete documentation.

;;; Code:

(require 'dash)
(require 'alert)
(require 'async)
(require 'org-agenda)
(require 'org-duration)
(require 'cl-lib)

(defgroup chime nil
  "Chime customization options."
  :group 'org)

(defcustom chime-alert-time '(10)
  "Time in minutes to get a notification about upcoming event.
Can be a single integer or a list of integers. Each value represents
minutes before the event. Use 0 to notify at event time. Cannot be
negative."
  :package-version '(chime . "0.1.0")
  :group 'chime
  :type '(choice (integer :tag "Notify once")
                 (repeat integer))
  :set (lambda (symbol value)
         (let ((values (if (listp value) value (list value))))
           (dolist (v values)
             (unless (integerp v)
               (user-error "Alert time must be an integer, got: %S" v))
             (when (< v 0)
               (user-error "Alert time cannot be negative, got: %d" v)))
           (set-default symbol value))))

(defcustom chime-alert-times-property "CHIME_NOTIFY_BEFORE"
  "Property name for per-event notification times.
Use this property in your agenda files to add additional
notifications to an event."
  :package-version '(chime . "0.1.0")
  :group 'chime
  :type 'string)

(defcustom chime-notification-title "Agenda"
  "Notifications title."
  :package-version '(chime . "0.1.0")
  :group 'chime
  :type 'string)

(defcustom chime-notification-icon nil
  "Path to notification icon file."
  :package-version '(chime . "0.4.1")
  :group 'chime
  :type 'string)

(defcustom chime-keyword-whitelist nil
  "Receive notifications for these keywords only.
Leave this variable blank if you do not want to filter anything."
  :package-version '(chime . "0.2.2")
  :group 'chime
  :type '(repeat string))

(defcustom chime-keyword-blacklist nil
  "Never receive notifications for these keywords."
  :package-version '(chime . "0.2.2")
  :group 'chime
  :type '(repeat string))

(defcustom chime-tags-whitelist nil
  "Receive notifications for these tags only.
Leave this variable blank if you do not want to filter anything."
  :package-version '(chime . "0.3.1")
  :group 'chime
  :type '(repeat string))

(defcustom chime-tags-blacklist nil
  "Never receive notifications for these tags."
  :package-version '(chime . "0.3.1")
  :group 'chime
  :type '(repeat string))

(defcustom chime-display-time-format-string "%I:%M %p"
  "Format string for displaying event times.
Passed to `format-time-string' when displaying notification times."
  :package-version '(chime . "0.5.0")
  :group 'chime
  :type 'string)

(defcustom chime-predicate-whitelist nil
  "Receive notifications for events matching these predicates only.
Each function should take an event POM and return non-nil iff that event should
trigger a notification. Leave this variable blank if you do not want to filter
anything."
  :package-version '(chime . "0.5.0")
  :group 'chime
  :type '(function))

(defcustom chime-additional-environment-regexes nil
  "Additional regular expressions for async environment injection.
These regexes are provided to `async-inject-environment' before
running the async command to check notifications."
  :package-version '(chime . "0.5.0")
  :group 'chime
  :type '(string))

(defcustom chime-predicate-blacklist
  '(chime-done-keywords-predicate)
  "Never receive notifications for events matching these predicates.
Each function should take an event POM and return non-nil iff that event should
not trigger a notification."
  :package-version '(chime . "0.5.0")
  :group 'chime
  :type '(function))

(defcustom chime-alert-severity 'medium
  "Severity of the alert.
Options: \\='high \\='medium \\='low"
  :package-version '(chime . "0.3.1")
  :group 'chime
  :type 'symbol
  :options '(high medium low))

(defcustom chime-extra-alert-plist nil
  "Additional arguments that should be passed to invocations of `alert'."
  :package-version "v0.5.0"
  :group 'chime
  :type 'plist)

(defcustom chime-day-wide-alert-times nil
  "List of time strings for day-wide event alerts.
Each string specifies a time of day when day-wide events should trigger."
  :package-version '(chime . "0.5.0")
  :group 'chime
  :type 'string)

(defcustom chime-show-any-overdue-with-day-wide-alerts t
  "Show any overdue TODO items along with day wide alerts whenever they are shown."
  :package-version '(chime . "0.5.0")
  :group 'chime
  :type 'string)

(defcustom chime-modeline-lookahead 30
  "Minutes ahead to look for next event to display in modeline.
Should be larger than notification alert times for advance awareness.
Set to 0 to disable modeline display."
  :package-version '(chime . "0.5.1")
  :group 'chime
  :type 'integer)

(defcustom chime-modeline-format " ⏰ %s"
  "Format string for modeline display.
%s will be replaced with the event description (time and title)."
  :package-version '(chime . "0.5.1")
  :group 'chime
  :type 'string)

(defcustom chime-play-sound t
  "Whether to play a sound when notifications are displayed.
When non-nil, plays the sound file specified in `chime-sound-file'."
  :package-version '(chime . "0.6.0")
  :group 'chime
  :type 'boolean)

(defcustom chime-sound-file
  (expand-file-name "sounds/chime.wav"
                    (file-name-directory (or load-file-name buffer-file-name)))
  "Path to sound file to play when notifications are displayed.
Defaults to the bundled chime.wav file.
Set to nil to use Emacs default beep instead.
Should be an absolute path to a .wav, .au, or other sound file
supported by your system."
  :package-version '(chime . "0.6.0")
  :group 'chime
  :type '(choice (const :tag "Use system beep" nil)
                 (file :tag "Sound file path")))

(defvar chime--timer nil
  "Timer value.")

(defvar chime--process nil
  "Currently-running async process.")

(defvar chime--agenda-buffer-name "*org wild notifier affairs*"
  "Name for temporary \\='org-agenda\\=' buffer.")

(defvar chime--last-check-time (seconds-to-time 0)
  "Last time checked for events.")

(defvar chime--next-event nil
  "Next upcoming event for modeline display.
Stored as (EVENT-MSG . MINUTES-UNTIL) or nil if no upcoming event.")

(defvar chime-modeline-string nil
  "Modeline string showing next upcoming event.")
;;;###autoload(put 'chime-modeline-string 'risky-local-variable t)
(put 'chime-modeline-string 'risky-local-variable t)

(defun chime--time= (&rest list)
  "Compare timestamps.
Comparison is performed by converted each element of LIST onto string
in order to ignore seconds."
  (->> list
       (--map (format-time-string "%d:%H:%M" it))
       (-uniq)
       (length)
       (= 1)))

(defun chime--today ()
  "Get the timestamp for the beginning of current day."
  (apply 'encode-time
         (append '(0 0 0) (nthcdr 3 (decode-time (current-time))))))

(defun chime--timestamp-within-interval-p (timestamp interval)
  "Check whether TIMESTAMP is within notification INTERVAL.
Returns non-nil if TIMESTAMP matches current time plus INTERVAL minutes.
Returns nil if TIMESTAMP or INTERVAL is invalid."
  (and timestamp
       interval
       (numberp interval)
       ;; Validate timestamp is a proper time value (list of integers)
       (listp timestamp)
       (chime--time=
        (time-add (current-time) (seconds-to-time (* 60 interval)))
        timestamp)))

(defun chime--notifications (event)
  "Get notifications for given EVENT.
Returns a list of time information interval pairs."
  (->> (list
        (chime--filter-day-wide-events (cadr (assoc 'times event)))
        (cdr (assoc 'intervals event)))
         (apply '-table-flat (lambda (ts int) (list ts int)))
         ;; When no values are provided for table flat, we get the second values
         ;; paired with nil.
         (--filter (not (null (car it))))
         (--filter (chime--timestamp-within-interval-p (cdar it) (cadr it)))))

(defun chime--has-timestamp (s)
  "Check if S contain a timestamp with a time component.
Returns non-nil only if the timestamp includes HH:MM time information."
  (and s
       (stringp s)
       (string-match org-ts-regexp0 s)
       (match-beginning 7)))

(defun chime--filter-day-wide-events (times)
  "Filter TIMES list to include only events with timestamps."
  (--filter (chime--has-timestamp (car it)) times))

(defun chime--time-left (seconds)
  "Human-friendly representation for SECONDS."
  (-> seconds
       (pcase
         ((pred (>= 0)) "right now")
         ((pred (>= 3600)) "in %M")
         (_ "in %H %M"))

       (format-seconds seconds)))

(defun chime--get-hh-mm-from-org-time-string (time-string)
  "Convert given org time-string TIME-STRING into string with \\='hh:mm\\=' format."
  (format-time-string
   chime-display-time-format-string
   (encode-time (org-parse-time-string time-string))))

(defun chime--notification-text (str-interval event)
  "For given STR-INTERVAL list and EVENT get notification wording."
  (format "%s at %s (%s)"
          (cdr (assoc 'title event))
          (chime--get-hh-mm-from-org-time-string (car str-interval))
          (chime--time-left (* 60 (cdr str-interval)))))

(defun chime-get-minutes-into-day (time)
  "Get minutes elapsed since midnight for TIME string."
  (org-duration-to-minutes (org-get-time-of-day time t)))

(defun chime-get-hours-minutes-from-time (time-string)
  "Extract hours and minutes from TIME-STRING.
Returns a list of (HOURS MINUTES)."
  (let ((total-minutes (truncate (chime-get-minutes-into-day time-string))))
    (list (/ total-minutes 60)
          (mod total-minutes 60))))

(defun chime-set-hours-minutes-for-time (time hours minutes)
  "Set HOURS and MINUTES for TIME, preserving date components."
  (cl-destructuring-bind (_s _m _h day month year dow dst utcoff) (decode-time time)
    (encode-time 0 minutes hours day month year dow dst utcoff)))

(defun chime-current-time-matches-time-of-day-string (time-of-day-string)
  "Check if current time matches TIME-OF-DAY-STRING."
  (let ((now (current-time)))
    (chime--time=
     now
     (apply 'chime-set-hours-minutes-for-time
            now
            (chime-get-hours-minutes-from-time time-of-day-string)))))

(defun chime-current-time-is-day-wide-time ()
  "Check if current time matches any day-wide alert time."
  (--any (chime-current-time-matches-time-of-day-string it)
         chime-day-wide-alert-times))

(defun chime-day-wide-notifications (events)
  "Generate notification texts for day-wide EVENTS."
  (->> events
       (-filter 'chime-display-as-day-wide-event)
       (-map 'chime--day-wide-notification-text)
       (-uniq)))

(defun chime-display-as-day-wide-event (event)
  "Check if EVENT should be displayed as a day-wide event.
`chime-event-has-any-passed-time' is a requirement regardless of
whether `chime-show-any-overdue-with-day-wide-alerts' is set,
because the events list can include events scheduled tomorrow.
We only want to alert for things scheduled today."
  (and (chime-event-has-any-passed-time event)
      (or chime-show-any-overdue-with-day-wide-alerts
           (chime-event-has-any-day-wide-timestamp event))))

(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)))
         (car (cdr (assoc 'times event)))))

(defun chime-event-has-any-passed-time (event)
  "Check if EVENT has any timestamps in the past."
  (--any (time-less-p (cdr it) (current-time))
         (car (cdr (assoc 'times event )))))

(defun chime--day-wide-notification-text (event)
  "For given STR-INTERVAL list and EVENT get notification wording."
  (format "%s is due or scheduled today"
          (cdr (assoc 'title event))))

(defun chime--check-event (event)
  "Get notifications for given EVENT.
Returns a list of notification messages"
  (->> (chime--notifications event)
       (--map (chime--notification-text `(,(caar it) . ,(cadr it)) event))))

(defun chime--update-modeline (events)
  "Update modeline with next upcoming event from EVENTS.
Only shows events within `chime-modeline-lookahead' minutes."
  (if (or (not chime-modeline-lookahead)
          (zerop chime-modeline-lookahead))
      (setq chime-modeline-string nil)
    (let ((soonest-event nil)
          (soonest-minutes nil)
          (now (current-time)))
      ;; Find soonest event within lookahead window
      (dolist (event events)
        (let* ((all-times (cadr (assoc 'times event)))
               (times (chime--filter-day-wide-events all-times)))
          (dolist (time-info times)
            (when-let* ((time-str (car time-info))
                        (event-time (cdr time-info))
                        ;; Calculate minutes until event
                        (seconds-until (- (float-time event-time) (float-time now)))
                        (minutes-until (/ seconds-until 60)))
              ;; Only consider future events within lookahead window
              (when (and (> minutes-until 0)
                         (<= minutes-until chime-modeline-lookahead)
                         (or (not soonest-minutes)
                             (< minutes-until soonest-minutes)))
                (setq soonest-minutes minutes-until)
                (setq soonest-event
                      (chime--notification-text
                       `(,time-str . ,minutes-until) event)))))))
      ;; Format and set modeline string
      (setq chime-modeline-string
            (when soonest-event
              (format chime-modeline-format soonest-event)))
      (force-mode-line-update))))

(defun chime--get-tags (marker)
  "Retrieve tags of MARKER."
  (-> (org-entry-get marker "TAGS")
      (or "")
      (org-split-string  ":")))

(defun chime--whitelist-predicates ()
  "Return list of whitelist predicate functions.
Combines keyword, tag, and custom predicate whitelists."
  (->> `([,chime-keyword-whitelist
          (lambda (it)
            (-contains-p chime-keyword-whitelist
                         (org-entry-get it "TODO")))]

         [,chime-tags-whitelist
          (lambda (it)
            (-intersection chime-tags-whitelist
                           (chime--get-tags it)))]

         [,chime-predicate-whitelist
          (lambda (marker)
            (--some? (funcall it marker) chime-predicate-whitelist))])
       (--filter (aref it 0))
       (--map (aref it 1))))

(defun chime--blacklist-predicates ()
  "Return list of blacklist predicate functions.
Combines keyword, tag, and custom predicate blacklists."
  (->> `([,chime-keyword-blacklist
          (lambda (it)
            (-contains-p chime-keyword-blacklist
                         (org-entry-get it "TODO")))]

         [,chime-tags-blacklist
          (lambda (it)
            (-intersection chime-tags-blacklist
                           (chime--get-tags it)))]

         [,chime-predicate-blacklist
          (lambda (marker)
            (--some? (funcall it marker) chime-predicate-blacklist))])
       (--filter (aref it 0))
       (--map (aref it 1))))

(defun chime-done-keywords-predicate (marker)
  "Check if entry at MARKER has a done keyword."
  (with-current-buffer (marker-buffer marker)
    (save-excursion
      (goto-char (marker-position marker))
      (member (nth 2 (org-heading-components)) org-done-keywords))))

(defun chime--apply-whitelist (markers)
  "Apply whitelist to MARKERS."
  (-if-let (whitelist-predicates (chime--whitelist-predicates))
      (-> (apply '-orfn whitelist-predicates)
          (-filter markers))
    markers))

(defun chime--apply-blacklist (markers)
  "Apply blacklist to MARKERS."
  (-if-let (blacklist-predicates (chime--blacklist-predicates))
      (-> (apply '-orfn blacklist-predicates)
          (-remove markers))
    markers))

(defconst chime-default-environment-regex
  (macroexpand
   `(rx string-start
        (or ,@(mapcar (lambda (literal) (list 'literal literal))
                (list
                 "org-agenda-files"
                 "load-path"
                 "org-todo-keywords"
                 "chime-alert-time"
                 "chime-keyword-whitelist"
                 "chime-keyword-blacklist"
                 "chime-tags-whitelist"
                 "chime-tags-blacklist"
                 "chime-predicate-whitelist"
                 "chime-predicate-blacklist")))
        string-end)))


(defun chime-environment-regex ()
  "Generate regex for environment variables to inject into async process."
  (macroexpand
   `(rx (or
         ,@(mapcar (lambda (regexp) (list 'regexp regexp))
                   (cons chime-default-environment-regex
                         chime-additional-environment-regexes))))))

(defun chime--retrieve-events ()
  "Get events from agenda view."
  `(lambda ()
    (setf org-agenda-use-time-grid nil)
    (setf org-agenda-compact-blocks t)
    ,(async-inject-variables (chime-environment-regex))

    (package-initialize)
    (require 'chime)

    (org-agenda-list 2 (org-read-date nil nil "today"))

    (->> (org-split-string (buffer-string) "\n")
         (--map (plist-get
                 (org-fix-agenda-info (text-properties-at 0 it))
                 'org-marker))
         (-non-nil)
         (chime--apply-whitelist)
         (chime--apply-blacklist)
         (-map 'chime--gather-info))))

(defun chime--notify (event-msg)
  "Notify about an event using `alert' library.
EVENT-MSG is a string representation of the event."
  ;; Play sound if enabled
  (when chime-play-sound
    (condition-case err
        (if chime-sound-file
            (when (file-exists-p chime-sound-file)
              (play-sound-file chime-sound-file))
          ;; Use default Emacs bell/beep if no file specified
          (beep))
      (error
       (message "chime: Failed to play sound: %s"
                (error-message-string err)))))
  ;; Show visual notification
  (apply
   'alert event-msg
   :icon chime-notification-icon
   :title chime-notification-title
   :severity chime-alert-severity
   :category 'chime
   chime-extra-alert-plist))

(defun chime--timestamp-parse (timestamp)
  "Parse TIMESTAMP and return time in list-of-integer format.
Returns nil if parsing fails or timestamp is malformed."
  (condition-case err
      (when (and timestamp
                 (stringp timestamp)
                 (not (string-empty-p timestamp))
                 ;; Validate angle bracket format
                 (string-match-p "<.*>" timestamp)
                 ;; Ensure timestamp has time component (HH:MM format)
                 (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" timestamp))
        (let ((parsed (org-parse-time-string timestamp))
              (today (format-time-string "<%Y-%m-%d>")))
          (when (and parsed
                     (decoded-time-hour parsed)
                     (decoded-time-minute parsed))
            ;; Validate date components are in reasonable ranges
            (let ((month (decoded-time-month parsed))
                  (day (decoded-time-day parsed))
                  (hour (decoded-time-hour parsed))
                  (minute (decoded-time-minute parsed)))
              (when (and month day hour minute
                         (>= month 1) (<= month 12)
                         (>= day 1) (<= day 31)
                         (>= hour 0) (<= hour 23)
                         (>= minute 0) (<= minute 59))
                ;; seconds-to-time returns also milliseconds and nanoseconds so we
                ;; have to "trim" the list
                (butlast
                 (seconds-to-time
                  (time-add
                   ;; we get the cycled absolute day (not hour and minutes)
                   (org-time-from-absolute (org-closest-date timestamp today 'past))
                   ;; so we have to add the minutes too
                   (+ (* hour 3600)
                      (* minute 60))))
                 2))))))
    (error
     (message "chime: Failed to parse timestamp '%s': %s"
              timestamp (error-message-string err))
     nil)))

(defun chime--extract-time (marker)
  "Extract timestamps from MARKER.
Timestamps are extracted as cons cells.  car holds org-formatted
string, cdr holds time in list-of-integer format."
  (-non-nil
   (--map
    (let ((org-timestamp (org-entry-get marker it)))
      (and org-timestamp
           (cons org-timestamp
                 (chime--timestamp-parse org-timestamp))))
    '("DEADLINE" "SCHEDULED" "TIMESTAMP"))))

(defun chime--extract-title (marker)
  "Extract event title from MARKER.
MARKER acts like the event's identifier."
  (org-with-point-at marker
    (-let (((_lvl _reduced-lvl _todo _priority title _tags)
            (org-heading-components)))
      title)))

(defun chime--extract-notication-intervals (marker)
  "Extract notification intervals from the event's properties.
MARKER acts like the event's identifier.  Resulting list also contains
standard notification interval (`chime-alert-time')."
  `(,@(-flatten (list chime-alert-time))
    ,@(-map 'string-to-number
           (org-entry-get-multivalued-property
            marker
            chime-alert-times-property))))

(defun chime--gather-info (marker)
  "Collect information about an event.
MARKER acts like event's identifier."
  `((times . (,(chime--extract-time marker)))
    (title . ,(chime--extract-title marker))
    (intervals . ,(chime--extract-notication-intervals marker))))

(defun chime--stop ()
  "Stop the notification timer and cancel any in-progress check."
  (-some-> chime--timer (cancel-timer))
  (when chime--process
    (interrupt-process chime--process)
    (setq chime--process nil)))

(defun chime--start ()
  "Start the notification timer.  Cancel old one, if any.
Timer is scheduled on the beginning of every minute, so for
smoother experience this function also runs a check without timer."
  (chime--stop)
  (chime-check)

  (--> (format-time-string "%H:%M" (time-add (current-time) 60))
       (run-at-time it 60 'chime-check)
       (setf chime--timer it)))

(defun chime--check-events (events)
  "Process EVENTS and send notifications for upcoming items.
Clears the async process flag, sends notifications for matching
events, handles day-wide alerts, and updates the modeline."
  (setq chime--process nil)
  ;; Handle notifications
  (-each
      (->> events
           (-map 'chime--check-event)
           (-flatten)
           (-uniq))
    'chime--notify)
  (when (chime-current-time-is-day-wide-time)
    (mapc 'chime--notify
          (chime-day-wide-notifications events)))
  ;; Update modeline with next upcoming event
  (chime--update-modeline events)
  (setq chime--last-check-time (current-time)))

;;;###autoload
(defun chime-check ()
  "Parse agenda view and notify about upcoming events.

Do nothing if a check is already in progress in the background."
  (interactive)
  (unless (and chime--process
               (process-live-p chime--process))
    (setq chime--process
          (let ((default-directory user-emacs-directory)
                (async-prompt-for-password nil)
                (async-process-noquery-on-exit t))
            (async-start
             (chime--retrieve-events)
             'chime--check-events)))))

;;;###autoload
(define-minor-mode chime-mode
  "Toggle org notifications globally.
When enabled parses your agenda once a minute and emits notifications
if needed."
  :global
  :lighter "Chime"
  (if chime-mode
      (progn
        (chime--start)
        ;; Add modeline string to global-mode-string
        (when (> chime-modeline-lookahead 0)
          (if global-mode-string
              (add-to-list 'global-mode-string 'chime-modeline-string 'append)
            (setq global-mode-string '("" chime-modeline-string)))))
    (progn
      (chime--stop)
      ;; Remove modeline string from global-mode-string
      (setq global-mode-string
            (delq 'chime-modeline-string global-mode-string))
      (setq chime-modeline-string nil)
      (force-mode-line-update))))

(provide 'chime)

;;; chime.el ends here