path: root/tmr.el

;;; tmr.el --- Set timers using a convenient notation -*- lexical-binding: t -*-

;; Copyright (C) 2020-2026  Free Software Foundation, Inc.

;; Author: Protesilaos <info@protesilaos.com>,
;;         Damien Cassou <damien@cassou.me>,
;;         Daniel Mendler <mail@daniel-mendler.de>
;;         Steven Allen <steven@stebalien.com>
;; Maintainer: Protesilaos <info@protesilaos.com>
;; URL: https://github.com/protesilaos/tmr
;; Version: 1.3.0
;; Package-Requires: ((emacs "29.1"))
;; Keywords: convenience, timer

;; This file is NOT part of GNU Emacs.

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; TMR is an Emacs package that provides facilities for setting timers
;; using a convenient notation.
;;
;; Please read the manual for all the technicalities.  Either evaluate
;; (info "(tmr) Top") or visit <https://protesilaos.com/emacs/tmr>.

;;; Code:

(require 'seq)
(require 'format-spec)
(eval-when-compile
  (require 'cl-lib)
  (require 'subr-x))

(defgroup tmr ()
  "TMR May Ring: set timers using a simple notation."
  :link '(info-link :tag "Info Manual" "(tmr)")
  :link '(url-link :tag "Homepage" "https://protesilaos.com/emacs/tmr")
  :link '(emacs-library-link :tag "Library Source" "tmr.el")
  :group 'data)

;;;; User options

(defcustom tmr-description-list 'tmr-description-history
  "List of timer description presets.
The value can be either a list of strings or the symbol of a
variable that holds a list of strings.

The default value of `tmr-description-history', is the name of a
variable that contains input provided by the user at the relevant
prompt of the `tmr' and `tmr-with-details' commands."
  :type '(choice symbol (repeat string)))

(defcustom tmr-notification-urgency 'normal
  "The urgency level of the desktop notification.
Values can be `low', `normal' (default), or `critical'.

The desktop environment or notification daemon is responsible for
such notifications."
  :type '(choice
          (const :tag "Low" low)
          (const :tag "Normal" normal)
          (const :tag "Critical" critical)))

(defcustom tmr-sound-file
  "/usr/share/sounds/freedesktop/stereo/alarm-clock-elapsed.oga"
  "Path to sound file used by `tmr-sound-play'.
If nil, don't play any sound."
  :type '(choice
          file
          (const :tag "Off" nil)))

(defcustom tmr-confirm-single-timer t
  "Whether to act on the sole timer outright or with confirmation.

If non-nil (the default), TMR will use the minibuffer to select a
timer object to operate on, even when there is only one candidate
available.

If set to nil, TMR will not ask for confirmation when there is
one timer available: the operatation will be carried out
outright."
  :type 'boolean)

(defcustom tmr-timer-created-functions
  (list #'tmr-print-message-for-created-timer)
  "Functions to execute when a timer is created.
Each function must accept a timer as argument."
  :type 'hook
  :options '(tmr-print-message-for-created-timer))

(defcustom tmr-timer-finished-functions
  (list #'tmr-sound-play
        #'tmr-notification-notify
        #'tmr-print-message-for-finished-timer
        #'tmr-acknowledge-minibuffer)
  "Functions to execute when a timer is finished.
Each function must accept a timer as argument."
  :type 'hook
  :options (list #'tmr-sound-play
                 #'tmr-notification-notify
                 #'tmr-print-message-for-finished-timer
                 #'tmr-acknowledge-minibuffer
                 #'tmr-acknowledge-dialog))

(defcustom tmr-timer-repeat-functions
  (list #'tmr-sound-play
        #'tmr-notification-notify
        #'tmr-print-message-for-repeating-timer)
  "Functions to execute when a timer is about to repeat.
Each function must accept a timer as argument."
  :type 'hook
  :options (list #'tmr-sound-play
                 #'tmr-notification-notify
                 #'tmr-print-message-for-repeating-timer
                 #'tmr-acknowledge-minibuffer
                 #'tmr-acknowledge-dialog))

(defcustom tmr-timer-cancelled-functions
  (list #'tmr-print-message-for-cancelled-timer)
  "Functions to execute when a timer is cancelled.
Each function must accept a timer as argument."
  :type 'hook)

(defcustom tmr-timer-paused-functions
  (list #'tmr-print-message-for-paused-timer)
  "Functions to execute when a timer is paused.
Each function must accept a timer as argument."
  :package-version '(tmr . "1.3.0")
  :type 'hook)

(defcustom tmr-timer-resumed-functions
  (list #'tmr-print-message-for-resumed-timer)
  "Functions to execute when a timer is resumed.
Each function must accept a timer as argument."
  :package-version '(tmr . "1.3.0")
  :type 'hook)

(defcustom tmr-finished-indicator "✔"
  "Indicator for a finished timer, shown in `tmr-tabulated-view'."
  :package-version '(tmr . "1.0.0")
  :type 'string)

(defcustom tmr-acknowledge-timer-text "ack"
  "Text to confirm that a timer is acknowledged.
This is the input to be given to the minibuffer prompt that asks for
confirmation when a timer has to be acknowledged (acknowledgement here
means that the user confirms that the timer has elapsed)."
  :package-version '(tmr . "1.3.0")
  :type 'string)

(defcustom tmr-tabulated-refresh-interval 5
  "Refresh the `tmr-tabulated-view' buffer after these many seconds.
If the value is nil, then never automatically refresh that buffer: the
user can do that manually by invoking the command `revert-buffer'."
  :package-version '(tmr . "1.3.0")
  :type '(choice
          (natnum :tag "Seconds to auto-refresh the `tmr-tabulated-view' buffer")
          (const :tag "Never auto-refresh the `tmr-tabulated-view' buffer" nil)))

(defun tmr-select-and-resize (window)
  "Select WINDOW and fit it to its buffer."
  (select-window window)
  (fit-window-to-buffer window))

(defcustom tmr-list-timers-action-alist
  '((display-buffer-reuse-mode-window display-buffer-at-bottom)
    (mode . tmr-tabulated-mode)
    (dedicated . t)
    (preserve-size . (t . t))
    (body-function . tmr-select-and-resize))
  "Action alist used by `tmr-tabulated-view' in interactive use.
This is the same data that is passed to `display-buffer-alist'.
Read Info node `(elisp) Displaying Buffers'.  As such, it is
meant for experienced users."
  :risky t
  :type `(alist
          :key-type (choice :tag "Condition" regexp
                            (function :tag "Matcher function"))
          :value-type ,display-buffer--action-custom-type)
  :package-version '(tmr . "1.1.0"))

(defcustom tmr-mode-line-format "%r%d"
  "Format string for displaying a timer in the mode-line.
Available format specifiers:
- %r: Remaining time.
- %d: Timer description (truncated to `tmr-mode-line-max-desc-length')."
  :type 'string
  :package-version '(tmr . "1.2.0")
  :group 'tmr)

(defcustom tmr-mode-line-separator " | "
  "String used to separate multiple timers in the mode-line."
  :type 'string
  :package-version '(tmr . "1.2.0")
  :group 'tmr)

(defcustom tmr-mode-line-max-timers 3
  "Maximum number of timers to display in the mode-line.
Set to nil to show all timers."
  :type '(choice (const :tag "Show all" nil)
                 (integer :tag "Maximum number"))
  :package-version '(tmr . "1.2.0")
  :group 'tmr)

(defcustom tmr-mode-line-max-desc-length 15
  "Maximum length for timer descriptions in the mode-line.
Longer descriptions will be truncated."
  :type '(choice (const :tag "Don't truncate" nil)
                 (integer :tag "Truncate"))
  :package-version '(tmr . "1.2.0")
  :group 'tmr)

(defcustom tmr-mode-line-prefix
  (cond
   ((char-displayable-p ?⏰) "⏰")
   ((char-displayable-p ?∞) "∞")
   (t "!"))
  "Prefix string displayed before the timer list."
  :type 'string
  :package-version '(tmr . "1.2.0")
  :group 'tmr)

;;;; Faces

(defgroup tmr-faces ()
  "Faces for `tmr'."
  :link '(info-link :tag "Info Manual" "(tmr)")
  :link '(url-link :tag "Homepage" "https://protesilaos.com/emacs/tmr")
  :link '(emacs-library-link :tag "Library Source" "tmr.el")
  :group 'tmr)

(defface tmr-duration nil
  "Face for styling the duration of a timer."
  :package-version '(tmr . "1.0.0")
  :group 'tmr-faces)

(defface tmr-description '((t :inherit bold))
  "Face for styling the description of a timer."
  :package-version '(tmr . "1.0.0")
  :group 'tmr-faces)

(defface tmr-start-time '((t :inherit success))
  "Face for styling the start time of a timer."
  :package-version '(tmr . "1.0.0")
  :group 'tmr-faces)

(defface tmr-end-time '((t :inherit error))
  "Face for styling the start time of a timer."
  :package-version '(tmr . "1.0.0")
  :group 'tmr-faces)

(defface tmr-is-acknowledged '((t :inherit success))
  "Face for styling the acknowledgment confirmation."
  :package-version '(tmr . "1.0.0")
  :group 'tmr-faces)

(defface tmr-must-be-acknowledged '((t :inherit warning))
  "Face for styling the acknowledgment confirmation."
  :package-version '(tmr . "1.0.0")
  :group 'tmr-faces)

(defface tmr-finished '((t :inherit error))
  "Face for styling the description of a finished timer."
  :package-version '(tmr . "1.0.0")
  :group 'tmr-faces)

(defface tmr-paused '((t :inherit bold))
  "Face for styling the description of a paused timer."
  :package-version '(tmr . "1.3.0")
  :group 'tmr-faces)

(defface tmr-tabulated-start-time
  '((((class color) (min-colors 88) (background light))
     :foreground "#004476")
    (((class color) (min-colors 88) (background dark))
     :foreground "#c0d0ef")
    (t :foreground "cyan"))
  "Start time in the `tmr-tabulated-view'."
  :package-version '(tmr . "1.1.0")
  :group 'tmr-faces)

(defface tmr-tabulated-end-time
  '((((class color) (min-colors 88) (background light))
     :foreground "#800040")
    (((class color) (min-colors 88) (background dark))
     :foreground "#e59fc6")
    (t :foreground "magenta"))
  "End time in the `tmr-tabulated-view'."
  :package-version '(tmr . "1.1.0")
  :group 'tmr-faces)

(defface tmr-tabulated-remaining-time
  '((((class color) (min-colors 88) (background light))
     :foreground "#603f00")
    (((class color) (min-colors 88) (background dark))
     :foreground "#deba66")
    (t :foreground "yellow"))
  "Remaining time in the `tmr-tabulated-view'."
  :package-version '(tmr . "1.1.0")
  :group 'tmr-faces)

(defface tmr-tabulated-paused '((t :inherit bold))
  "Face for styling the description of a paused timer."
  :package-version '(tmr . "1.3.0")
  :group 'tmr-faces)

(defface tmr-tabulated-acknowledgement
  '((t :inherit bold))
  "Acknowledgement indicator in the `tmr-tabulated-view'."
  :package-version '(tmr . "1.1.0")
  :group 'tmr-faces)

(defface tmr-tabulated-description
  '((t :inherit font-lock-doc-face))
  "Description of timer in the `tmr-tabulated-view'."
  :package-version '(tmr . "1.1.0")
  :group 'tmr-faces)

(defface tmr-mode-line-active
  '((t :inherit mode-line-emphasis))
  "Face for active timers in the mode-line."
  :package-version '(tmr . "1.2.0")
  :group 'tmr-faces)

(defface tmr-mode-line-soon
  '((t :inherit warning))
  "Face for timers that will expire in the next 2 minutes."
  :package-version '(tmr . "1.2.0")
  :group 'tmr-faces)

(defface tmr-mode-line-urgent
  '((t :inherit error))
  "Face for timers that will expire in the next 30 seconds."
  :package-version '(tmr . "1.2.0")
  :group 'tmr-faces)

;;;; Common helpers

(cl-defstruct (tmr--timer
               (:constructor tmr--timer-create)
               (:copier tmr--timer-copy))
  (creation-date
   nil
   :read-only t
   :documentation "Time at which the timer was created.")
  (end-date
   nil
   :documentation "Time at which the timer finishes.")
  (finishedp
   nil
   :read-only nil
   :documentation "Non-nil if the timer is finished.")
  (acknowledgep
   nil
   :read-only nil
   :documentation "Non-nil if the timer must be acknowledged.")
  (repeat-count
   0
   :read-only nil
   :documentation "Remaining repetitions.")
  (duration
   nil
   :read-only t
   :documentation "Duration of this timer.")
  (timer-object
   nil
   :read-only nil
   :documentation "The object returned by `run-with-timer'.")
  (input
   nil
   :read-only t
   :documentation "The original input which is internally interpreted as a duration.")
  (description
   nil
   :read-only nil
   :documentation "Optional string describing the purpose of the timer, e.g., \"Stop the oven\".")
  (paused-remaining
   nil
   :read-only nil
   :documentation "Remaining seconds when the timer was paused or nil if not paused."))

(defun tmr--long-description (timer)
  "Return a human-readable description for TIMER."
  (let ((start (tmr--format-creation-date timer))
        (end (tmr--format-end-date timer))
        (description (tmr--timer-description timer)))
    ;; We prefix it with TMR just so it is easier to find in
    ;; `view-echo-area-messages'.  The concise wording makes it flexible
    ;; enough to be used when starting a timer but also when cancelling
    ;; one: check `tmr-print-message-for-created-timer' and
    ;; `tmr-print-message-for-cancelled-timer'.
    (format "TMR start %s; end %s; %s%s %s%s%s"
            (propertize start 'face 'tmr-start-time)
            (propertize end 'face 'tmr-end-time)
            (if (< 0 (tmr--timer-repeat-count timer))
                (format "repeat %d; " (tmr--timer-repeat-count timer))
              "")
            (if (string-search ":" (tmr--timer-input timer))
                "until"
              "duration")
            (propertize (tmr--timer-input timer) 'face 'tmr-duration)
            (cond
             ((and (tmr--timer-acknowledgep timer)
                   (tmr--timer-finishedp timer))
              (concat "; " (propertize "acknowledged" 'face 'tmr-is-acknowledged)))
             ((tmr--timer-acknowledgep timer)
              (concat "; " (propertize "acknowledge" 'face 'tmr-must-be-acknowledged)))
             ((tmr--timer-finishedp timer)
              (concat "; " (propertize "finished" 'face 'tmr-finished)))
             ((when-let* ((remaining (tmr--timer-paused-remaining timer)))
              (format "; %s: remaining %s" (propertize "PAUSED" 'face 'tmr-paused) (tmr--format-seconds remaining))))
             (t ""))
            (if description
                (concat "; " (propertize description 'face 'tmr-description))
              ""))))

(defun tmr--long-description-for-finished-timer (timer)
  "Return a human-readable description of finished TIMER.
This includes the creation and completion dates as well as the
optional `tmr--timer-description'."
  (let ((start (tmr--format-creation-date timer))
        (end (tmr--format-end-date timer))
        (description (tmr--timer-description timer)))
    ;; For the TMR prefix, see comment in `tmr--long-description'.
    (format "TMR Time is up!\n%s%s %s\n%s %s"
            (if description (concat (propertize description 'face 'tmr-description) "\n") "")
            (propertize "Started" 'face 'tmr-start-time)
            start
            (propertize "Ended" 'face 'tmr-end-time)
            end)))

(defun tmr--long-description-for-repeated-timer (timer)
  "Return a human-readable description of repeating TIMER.
This includes the creation and completion dates as well as the
optional `tmr--timer-description'."
  (let ((start (tmr--format-creation-date timer))
        (end (tmr--format-end-date timer))
        (description (tmr--timer-description timer)))
    ;; For the TMR prefix, see comment in `tmr--long-description'.
    (format "TMR Time is up! %d repetitions remain.\n%s%s %s\n%s %s"
            (tmr--timer-repeat-count timer)
            (if description (concat (propertize description 'face 'tmr-description) "\n") "")
            (propertize "Started" 'face 'tmr-start-time)
            start
            (propertize "Ends" 'face 'tmr-end-time)
            end)))

(defun tmr--format-creation-date (timer)
  "Return a string representing when TIMER was created."
  (tmr--format-time (tmr--timer-creation-date timer)))

(defun tmr--format-end-date (timer)
  "Return a string representing when TIMER should finish."
  (tmr--format-time (tmr--timer-end-date timer)))

(defun tmr--format-seconds (seconds)
  "Format the SECONDS in a human-readable way."
  (cond
   ((>= seconds 3600) (format "%sh %sm" (/ seconds 3600) (/ (% seconds 3600) 60)))
   ((>= seconds 60) (format "%sm %ss" (/ seconds 60) (% seconds 60)))
   (t (format "%ss" seconds))))

(defun tmr--get-seconds (timer)
  "Get the TIMER in seconds."
  (round (- (float-time (tmr--timer-end-date timer)) (float-time))))

(defun tmr--format-remaining (timer)
  "Format remaining time of TIMER."
  (cond
   ((tmr--timer-finishedp timer)
    tmr-finished-indicator)
   ((when-let* ((remaining (tmr--timer-paused-remaining timer)))
      (tmr--format-seconds remaining)))
   (t
    (let* ((seconds (tmr--get-seconds timer))
           (str (tmr--format-seconds seconds)))
      (if (< seconds 0)
          ;; Negative remaining time occurs for non-acknowledged timers with
          ;; additional duration.
          (propertize str 'face 'tmr-must-be-acknowledged)
        str)))))

(defun tmr--format-duration (timer)
  "Format duration of TIMER."
  (let ((input (tmr--timer-input timer)))
    (cond
     ((string-match-p ":" input)
      (tmr--format-seconds (tmr--get-seconds timer)))
     ((string-match-p "\\`[0-9]+\\(?:\\.[0-9]+\\)?\\'" input)
      (concat input "m"))
     (t
      input))))

(defun tmr--format-time (time)
  "Return a human-readable string representing TIME."
  (format-time-string "%T" time))

(defun tmr--parse-duration (now time)
  "Parse TIME string given current time NOW."
  (save-match-data
    (cond
     ((string-match-p "\\`[0-9]+\\(?:\\.[0-9]+\\)?\\'" time)
      (* (string-to-number time) 60))
     ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\'" time)
      (let ((val (decode-time now)))
        (setf (decoded-time-hour val) (string-to-number (match-string 1 time))
              (decoded-time-minute val) (string-to-number (match-string 2 time))
              (decoded-time-second val) (if (match-end 3)
                                            (string-to-number (match-string 3 time))
                                          0)
              val (encode-time val))
        (when (time-less-p val now)
          (user-error "Time %s is already over" time))
        (ceiling (float-time (time-subtract val now)))))
     ((string-match "\\`\\([0-9]+\\(?:\\.[0-9]+\\)?\\)[mhs]\\'" time)
      (let ((num (string-to-number (match-string 1 time))))
        (pcase (aref time (1- (length time)))
          (?s num)
          (?h (* num 60 60))
          (?m (* num 60)))))
     (t (user-error "TMR Made Ridiculous; append character for [m]inutes, [h]ours, [s]econds")))))

(defvar tmr--timers nil
  "List of timer objects.")

(defvar tmr--update-hook nil
  "Hooks to execute when timers are changed.")

;;;; Commands

(defun tmr-remove (timer)
  "Cancel and remove TIMER object set with `tmr' command.
Interactively, let the user choose which timer to cancel with
completion."
  (interactive (list (tmr--read-timer "Remove timer: ")))
  (cancel-timer (tmr--timer-timer-object timer))
  (setq tmr--timers (delete timer tmr--timers))
  (run-hooks 'tmr--update-hook)
  (run-hook-with-args 'tmr-timer-cancelled-functions timer))

(defun tmr-cancel (timer)
  "Cancel TIMER object set with `tmr' command.
Interactively, let the user choose which timer to cancel with
completion.  This command is the same as `tmr-remove' but
chooses only among active timers."
  (interactive (list (tmr--read-timer "Cancel timer: " :active)))
  (tmr-remove timer))

(defun tmr-reschedule (timer)
  "Reschedule TIMER.
This is the same as cloning it, prompting for duration and
cancelling the original one."
  (interactive (list (tmr--read-timer "Reschedule timer: ")))
  (tmr-clone timer :prompt)
  (let (tmr-timer-cancelled-functions)
    (tmr-cancel timer)))

(defun tmr-edit-description (timer description)
  "Change TIMER description with that of DESCRIPTION."
  (interactive
   (list
    (tmr--read-timer "Edit description of timer: ")
    (tmr--description-prompt)))
  (setf (tmr--timer-description timer) description)
  (run-hooks 'tmr--update-hook))

(defun tmr-toggle-pause (timer)
  "Toggle pause/resume state of TIMER."
  (interactive (list (tmr--read-timer "Pause/resume timer: " :active)))
  (if-let* ((remaining (tmr--timer-paused-remaining timer)))
      (progn
        (setf (tmr--timer-end-date timer) (time-add (current-time) remaining))
        (setf (tmr--timer-timer-object timer) (run-with-timer remaining nil #'tmr--complete timer))
        (setf (tmr--timer-paused-remaining timer) nil)
        (run-hooks 'tmr--update-hook)
        (run-hook-with-args 'tmr-timer-resumed-functions timer))
    (let ((remaining (tmr--get-seconds timer)))
      (when (> remaining 0)
        (cancel-timer (tmr--timer-timer-object timer))
        (setf (tmr--timer-paused-remaining timer) remaining)
        (run-hooks 'tmr--update-hook)
        (run-hook-with-args 'tmr-timer-paused-functions timer)))))


(defun tmr-toggle-acknowledge (timer)
  "Toggle ackowledge flag of TIMER."
  (interactive
   (list
    (tmr--read-timer "Toggle acknowledge flag of timer: ")))
  (setf (tmr--timer-acknowledgep timer) (not (tmr--timer-acknowledgep timer)))
  (run-hooks 'tmr--update-hook))

(defun tmr-remove-finished ()
  "Remove all finished timers."
  (interactive)
  (setq tmr--timers (seq-remove #'tmr--timer-finishedp tmr--timers))
  (run-hooks 'tmr--update-hook))

(defvar tmr--read-timer-hook nil
  "Hooks to execute to find current timer.")

(defun tmr--timer-annotation (timer)
  "Annotate TIMER completion candidate with remaining time."
  (setq timer (get-text-property 0 'tmr-timer timer))
  (if (tmr--timer-finishedp timer)
      " (finished)"
    (format " (%s remaining)" (tmr--format-remaining timer))))

(defun tmr--read-timer (prompt &optional active)
  "Let the user choose a timer among all (or ACTIVE) timers.

Return the selected timer.  If there is a single timer and
`tmr-confirm-single-timer' is nil, use that.  If there are
multiple timers, prompt for one with completion with PROMPT text.
If there are no timers, throw an error."
  (or
   (run-hook-with-args-until-success 'tmr--read-timer-hook)
   (pcase
       (if active
           (seq-remove #'tmr--timer-finishedp tmr--timers)
         tmr--timers)
     ('nil (user-error "No timers available"))
     ((and `(,timer) (guard (not tmr-confirm-single-timer))) timer)
     (timers
      (let* ((timer-list (mapcar
                          (lambda (x)
                            (propertize
                             (tmr--long-description x)
                             'tmr-timer x))
                          timers))
             (selected
              (car (member (completing-read
                            prompt
                            (tmr--completion-table
                             timer-list 'tmr-timer #'tmr--timer-annotation)
                            nil t)
                           timer-list))))
        (or (and selected (get-text-property 0 'tmr-timer selected))
            (user-error "No timer selected")))))))

(declare-function notifications-notify "notifications" (&rest params))
(declare-function android-notifications-notify "androidselect.c" (&rest params))
(declare-function w32-notification-notify "w32fns.c" (&rest params))
(declare-function haiku-notifications-notify "haikuselect.c" (&rest params))
(defvar notifications-application-icon)

(defun tmr-notification-notify (timer)
  "Dispatch a notification for TIMER.
Read Info node `(elisp) Desktop Notifications' for details."
  (if (or (featurep 'dbusbind)
          (seq-some #'fboundp
                    (list #'android-notifications-notify
                          #'w32-notification-notify
                          #'haiku-notifications-notify)))
      (let ((title "TMR May Ring (Emacs tmr package)")
            (body (tmr--long-description-for-finished-timer timer)))
        (cond ((fboundp 'android-notifications-notify)
               (android-notifications-notify
                :title title
                :body body
                :urgency tmr-notification-urgency))
              ((fboundp 'w32-notification-notify)
               (w32-notification-notify
                :title title
                :body body))
              ((fboundp 'haiku-notifications-notify)
               (haiku-notifications-notify
                :title title
                :body body
                :app-icon 'emacs
                :urgency tmr-notification-urgency))
              (t
               (unless (fboundp 'notifications-notify)
                 (require 'notifications))
               (notifications-notify
                :title title
                :body body
                :app-name "GNU Emacs"
                :app-icon notifications-application-icon
                :urgency tmr-notification-urgency
                :sound-file tmr-sound-file))))
    (display-warning 'tmr "Emacs has no DBUS support, TMR notifications unavailable")))

;; NOTE 2022-04-21: Emacs has a `play-sound' function but it only
;; supports .wav and .au formats.  Also, it does not work on all
;; platforms and Emacs needs to be compiled --with-sound capabilities.
(defun tmr-sound-play (&rest _)
  "Play `tmr-sound-file' using the ffplay executable (ffmpeg)."
  (if (executable-find "ffplay")
      (when-let* ((sound (and tmr-sound-file (expand-file-name tmr-sound-file)))
                  (_ (file-exists-p sound)))
        (call-process "ffplay" nil 0 nil "-nodisp" "-autoexit" sound))
    (display-warning 'tmr "`ffplay' is not available to play back `tmr-sound-file'")))

(defun tmr-print-message-for-created-timer (timer)
  "Show a `message' informing the user that TIMER was created."
  (message "%s" (tmr--long-description timer)))

(defun tmr-print-message-for-finished-timer (timer)
  "Show a `message' informing the user that TIMER has finished."
  (if (< 0 (tmr--timer-repeat-count timer))
      (message "%s" (tmr--long-description-for-repeated-timer timer))
    (message "%s" (tmr--long-description-for-finished-timer timer))))

(defun tmr-print-message-for-cancelled-timer (timer)
  "Show a `message' informing the user that TIMER is cancelled."
  (message "Cancelled: <<%s>>" (tmr--long-description timer)))

(defun tmr-print-message-for-paused-timer (timer)
  "Show a `message' informing the user that TIMER is paused."
  (message "Paused: <<%s>> (REMAINING %s)" (tmr--long-description timer) (tmr--format-remaining timer)))

(defun tmr-print-message-for-resumed-timer (timer)
  "Show a `message' informing the user that TIMER is resumed."
  (message "Resumed: <<%s>> (REMAINING %s)" (tmr--long-description timer) (tmr--format-remaining timer)))

(defvar tmr-duration-history nil
  "Minibuffer history of `tmr' durations.")

(defun tmr--read-duration (&optional default)
  "Ask the user to type a duration.
If DEFAULT is provided, use that as a default."
  (let ((def (or default (car tmr-duration-history))))
    (read-string
     (format-prompt
      "N minutes for timer (append `h' or `s' for other units)" def)
     nil 'tmr-duration-history def)))

(defvar tmr-description-history nil
  "Minibuffer history of `tmr' descriptions.")

(defun tmr--description-prompt (&optional default)
  "Helper prompt for descriptions in `tmr'.
If optional DEFAULT is provided use it as a default candidate."
  (completing-read
   (format-prompt "Description for this tmr" default)
   (tmr--completion-table
    (if (listp tmr-description-list)
        tmr-description-list
      (symbol-value tmr-description-list)))
   nil nil nil 'tmr-description-history default))

(defvar tmr-repeat-prompt-history nil
  "Minibuffer history for `tmr-repeat-prompt'.")

(defun tmr-repeat-prompt ()
  "Prompt for a repeat count."
  (let ((default (car tmr-repeat-prompt-history)))
    (read-number
     "Repeat N times: "
     (when default
       (string-to-number default))
     'tmr-repeat-prompt-history)))

(defun tmr--acknowledge-prompt ()
  "Ask the user if a timer must be acknowledged."
  (y-or-n-p "Acknowledge timer after finish? "))

(defun tmr-acknowledge-dialog (timer)
  "Acknowledge TIMER by showing a GUI dialog."
  (when-let* (((tmr--timer-acknowledgep timer))
              (duration
               (x-popup-dialog
                t
                `(,(tmr--long-description-for-finished-timer timer)
                  ("Acknowledge" . nil)
                  ("+ 1 m" . 60)
                  ("+ 5 m" . 300)
                  ("+ 10 min" . 600)
                  ("+ 15 min" . 900)
                  nil))))
    (tmr--continue-overtime timer duration)))

(defun tmr-acknowledge-minibuffer (timer)
  "Acknowledge TIMER using the minibuffer."
  (when (tmr--timer-acknowledgep timer)
    (while
        (let ((input
               (read-from-minibuffer
                (format "%s\nAcknowledge with `%s' or additional duration: "
                        (tmr--long-description-for-finished-timer timer)
                        tmr-acknowledge-timer-text))))
          (not (or (equal input tmr-acknowledge-timer-text)
                   (when-let* ((duration
                                (ignore-errors
                                  (tmr--parse-duration (current-time) input))))
                     (tmr--continue-overtime timer duration)
                     t)))))))

(defun tmr--continue-overtime (timer duration)
  "Continue TIMER even after it expired for DURATION.
This function is used if a timer is not acknowledged."
  (setf (tmr--timer-finishedp timer) nil
        (tmr--timer-timer-object timer)
        (run-with-timer duration nil #'tmr--complete timer))
  (run-hooks 'tmr--update-hook)
  (run-hook-with-args 'tmr-timer-created-functions timer))

(defun tmr-print-message-for-repeating-timer (timer)
  "Print message for how many times TIMER repeats."
  (when-let* ((count (tmr--timer-repeat-count timer)))
    (message "TMR repeats another %d times" count)))

(defun tmr--complete (timer)
  "Mark TIMER as finished or repeat it and execute hooks."
  (if (>= 0 (tmr--timer-repeat-count timer))
      (progn
        (setf (tmr--timer-finishedp timer) t)
        (run-hooks 'tmr--update-hook)
        (run-hook-with-args 'tmr-timer-finished-functions timer))
    (setf (tmr--timer-repeat-count timer) (1- (tmr--timer-repeat-count timer)))
    (setf (tmr--timer-end-date timer) (time-add (tmr--timer-end-date timer)
                                                (tmr--timer-duration timer)))
    (setf (tmr--timer-timer-object timer)
          (run-with-timer (tmr--timer-duration timer) nil #'tmr--complete timer))
    (run-hooks 'tmr--update-hook)
    (run-hook-with-args 'tmr-timer-repeat-functions timer)))

;; TODO 2026-04-23: How best to include the REPEAT-N in the
;; `interactive' spec of `tmr'.  What we have now suggests we should
;; use the double prefix arg, but I do not like that.  Maybe we can
;; leave it as-is and not use the repeat interactively in this way:
;; users can rely on `tmr-repeat'.
;;;###autoload
(defun tmr (time &optional description acknowledgep repeat-n)
  "Set timer to TIME duration and notify after it elapses.

When TIME is a number, it is interpreted as a count of minutes.
Otherwise TIME must be a string that consists of a number and a
special final character denoting a unit of time: h for hours, s
for seconds.

With optional DESCRIPTION as a prefix (\\[universal-argument]),
prompt for a description among `tmr-description-list', though
allow for any string to serve as valid input.

With optional ACKNOWLEDGEP non-nil the timer must be acknowledged
after it finished, such that the timer cannot be missed.

Optional integer REPEAT-N indicates how many times the timer shall
repeated.

This command also plays back `tmr-sound-file' if it is available.

To cancel the timer, use the `tmr-cancel' command.

To always prompt for a DESCRIPTION when setting a timer, use the
command `tmr-with-details' instead of this one."
  (interactive
   (list
    (tmr--read-duration)
    (when current-prefix-arg (tmr--description-prompt))
    (when current-prefix-arg (tmr--acknowledge-prompt))))
  (when (natnump time)
    (setq time (number-to-string time)))
  (let* ((creation-date (current-time))
         (duration (tmr--parse-duration creation-date time))
         (timer (tmr--timer-create
                 :description description
                 :acknowledgep acknowledgep
                 :repeat-count (or repeat-n 0)
                 :duration duration
                 :creation-date creation-date
                 :end-date (time-add creation-date duration)
                 :input time)))
    (setf (tmr--timer-timer-object timer)
          (run-with-timer duration nil #'tmr--complete timer))
    (push timer tmr--timers)
    (run-hooks 'tmr--update-hook)
    (run-hook-with-args 'tmr-timer-created-functions timer)))

;;;###autoload
(defun tmr-with-details (time &optional description acknowledgep)
  "Set timer to TIME duration and notify after it elapses.

See `tmr' for a description of the arguments DESCRIPTION and
ACKNOWLEDGEP.  The difference between the two commands is that
`tmr-with-details' always asks for a description and if the timer
should be acknowledged whereas `tmr' only asks for it when the
user uses a prefix argument (\\[universal-argument]).

Also see `tmr-repeat'."
  (interactive
   (list
    (tmr--read-duration)
    (tmr--description-prompt)
    (tmr--acknowledge-prompt)))
  (tmr time description acknowledgep))

;;;###autoload
(defun tmr-repeat (time repeat-n &optional description acknowledgep)
  "Set timer to TIME duration and repeat it REPEAT-N times.

REPEAT-N is an integer indicating how many times the timer shall be
repeated.

See `tmr' for a description of the arguments DESCRIPTION and
ACKNOWLEDGEP.

Also see `tmr-with-details'."
  (interactive
   (list
    (tmr--read-duration)
    (tmr-repeat-prompt)
    (when current-prefix-arg (tmr--description-prompt))
    (when current-prefix-arg (tmr--acknowledge-prompt))))
  (tmr time description acknowledgep repeat-n))

(defun tmr-clone (timer &optional prompt)
  "Create a new timer by cloning TIMER.
With optional PROMPT, such as a prefix argument, ask for
confirmation about the duration.  When PROMPT is a double prefix
argument, ask for a description as well and ask if the timer must
be acknowledged.

Without a PROMPT, clone TIMER outright."
  (interactive
   (list
    (tmr--read-timer "Clone timer: ")
    current-prefix-arg))
  (tmr
   (if prompt
       (tmr--read-duration (format "%s" (tmr--timer-input timer)))
     (format "%s" (tmr--timer-input timer)))
   (if (equal prompt '(16))
       (tmr--description-prompt (tmr--timer-description timer))
     (tmr--timer-description timer))
   (if (equal prompt '(16))
       (tmr--acknowledge-prompt)
     (tmr--timer-acknowledgep timer))))

(defun tmr--completion-table (candidates &optional category annotation)
  "Make completion table for CANDIDATES with sorting disabled.
CATEGORY is the completion category.
ANNOTATION is an annotation function."
  (lambda (str pred action)
    (if (eq action 'metadata)
        `(metadata (display-sort-function . identity)
                   (cycle-sort-function . identity)
                   (annotation-function . ,annotation)
                   (category . ,category))
      (complete-with-action action candidates str pred))))

;;;; Key bindings

(defvar-keymap tmr-prefix-map
  :doc "Global prefix map for TMRs.
This map should be bound to a global prefix key."
  "+" #'tmr
  "*" #'tmr-with-details
  "t" #'tmr
  "T" #'tmr-with-details
  "l" #'tmr-tabulated-view
  "s" #'tmr-reschedule
  "P" #'tmr-toggle-pause
  "a" #'tmr-toggle-acknowledge
  "e" #'tmr-edit-description
  "r" #'tmr-remove
  "R" #'tmr-remove-finished
  "k" #'tmr-cancel
  "n" #'tmr-repeat)

;;;###autoload (autoload 'tmr-prefix-map "tmr" nil t 'keymap)
(defalias 'tmr-prefix-map tmr-prefix-map)

(defvar-keymap tmr-tabulated-mode-map
  :doc "Keybindings for `tmr-tabulated-mode'."
  "k" #'tmr-remove
  "r" #'tmr-remove
  "R" #'tmr-remove-finished
  "+" #'tmr
  "t" #'tmr
  "*" #'tmr-with-details
  "T" #'tmr-with-details
  "c" #'tmr-clone
  "a" #'tmr-toggle-acknowledge
  "e" #'tmr-edit-description
  "s" #'tmr-reschedule
  "P" #'tmr-toggle-pause)

;;;;; Integration with the `embark' package

(defvar-keymap tmr-action-map
  :doc "Action map for TMRs, which can be utilized by Embark."
  "k" #'tmr-remove
  "r" #'tmr-remove
  "R" #'tmr-remove-finished
  "c" #'tmr-clone
  "a" #'tmr-toggle-acknowledge
  "e" #'tmr-edit-description
  "s" #'tmr-reschedule
  "p" #'tmr-toggle-pause)

(defvar embark-keymap-alist)
(defvar embark-post-action-hooks)
(with-eval-after-load 'embark
  (add-to-list 'embark-keymap-alist '(tmr-timer . tmr-action-map))
  (cl-loop
   for cmd the key-bindings of tmr-action-map
   if (commandp cmd) do
   (add-to-list 'embark-post-action-hooks (list cmd 'embark--restart))))

;;;; Tabulated view

;;;###autoload
(defun tmr-tabulated-view (buffer action-alist)
  "Open a tabulated list buffer listing tmr timers.
BUFFER is the buffer to use and ACTION-ALIST is what `display-buffer'
uses.  Those parameters are meant for use in Lisp.  In interactive use,
they are set to reasonable default values."
  (interactive
   (list
    (get-buffer-create "*tmr-tabulated-view*")
    tmr-list-timers-action-alist))
  (with-current-buffer buffer
    (tmr-tabulated-mode))
  (display-buffer buffer action-alist))

(defalias 'tmr-list-timers 'tmr-tabulated-view
  "Alias for `tmr-tabulated-view' command.")

(defun tmr-tabulated--set-entries ()
  "Set the value of `tabulated-list-entries' with timers."
  (setq-local tabulated-list-entries
              (mapcar #'tmr-tabulated--timer-to-entry tmr--timers)))

(defun tmr-tabulated--timer-to-entry (timer)
  "Convert TIMER into an entry suitable for `tabulated-list-entries'."
  (list
   timer
   (vector
    (propertize (tmr--format-creation-date timer) 'face 'tmr-tabulated-start-time)
    (propertize (tmr--format-end-date timer) 'face 'tmr-tabulated-end-time)
    (propertize (tmr--format-duration timer) 'face 'tmr-duration)
    (propertize (tmr--format-remaining timer) 'face 'tmr-tabulated-remaining-time)
    (propertize (if (tmr--timer-paused-remaining timer) "Yes" "") 'face 'tmr-tabulated-paused)
    (propertize (if (tmr--timer-acknowledgep timer) "Yes" "") 'face 'tmr-tabulated-acknowledgement)
    (propertize (or (tmr--timer-description timer) "") 'face 'tmr-tabulated-description))))

(defvar-local tmr-tabulated--refresh-timer nil
  "Timer used to refresh tabulated view.")

(defun tmr-tabulated--window-hook ()
  "Setup timer to refresh tabulated view."
  (if (get-buffer-window)
      (unless tmr-tabulated--refresh-timer
        (let* ((timer nil)
               (buf (current-buffer))
               (refresh
                (lambda ()
                  (if (buffer-live-p buf)
                      (with-current-buffer buf
                        (if-let* ((win (get-buffer-window)))
                            (with-selected-window win
                              (let ((end (eobp)))
                                ;; Optimized refreshing
                                (dolist (entry tabulated-list-entries)
                                  (setf (aref (cadr entry) 3)
                                        (propertize (tmr--format-remaining (car entry)) 'face 'tmr-tabulated-remaining-time)))
                                (tabulated-list-print t)
                                (when end (goto-char (point-max))))
                              ;; HACK: For some reason the hl-line highlighting gets lost here
                              (when (and (bound-and-true-p hl-line-mode)
                                         (fboundp 'hl-line-highlight))
                                (hl-line-highlight)))
                          (cancel-timer timer)
                          (setq tmr-tabulated--refresh-timer nil)))
                    (cancel-timer timer)))))
          (when (natnump tmr-tabulated-refresh-interval)
            (setq timer (run-at-time nil tmr-tabulated-refresh-interval refresh)
                  tmr-tabulated--refresh-timer timer))))
    (when tmr-tabulated--refresh-timer
      (cancel-timer tmr-tabulated--refresh-timer)
      (setq tmr-tabulated--refresh-timer nil))))

(defun tmr-tabulated--compare-remaining (a b)
  "Compare remaining time of timers A and B."
  (time-less-p (tmr--timer-end-date (car a))
               (tmr--timer-end-date (car b))))

(define-derived-mode tmr-tabulated-mode tabulated-list-mode "TMR"
  "Major mode to display tmr timers."
  (setq-local tabulated-list-format
              [("Start" 10 t)
               ("End" 10 t)
               ("Duration" 10 t)
               ("Remaining" 10 tmr-tabulated--compare-remaining)
               ("Paused?" 8 t)
               ("Acknowledge?" 14 t)
               ("Description" 0 t)])
  (add-hook 'window-configuration-change-hook #'tmr-tabulated--window-hook nil t)
  (add-hook 'tabulated-list-revert-hook #'tmr-tabulated--set-entries nil t)
  (tmr-tabulated--set-entries)
  (tabulated-list-init-header)
  (tabulated-list-print))

(defun tmr-tabulated--timer-at-point ()
  "Return the timer on the current line or nil."
  (and (eq major-mode #'tmr-tabulated-mode) (tabulated-list-get-id)))

(defun tmr-tabulated--refresh ()
  "Refresh *tmr-tabulated-view* buffer if it exists."
  (when-let* ((buf (get-buffer "*tmr-tabulated-view*")))
    (with-current-buffer buf
      (let ((lines (line-number-at-pos)))
        (revert-buffer)
        (when (and (bobp) (> lines 1))
          (forward-line (1- lines))
          (unless (tabulated-list-get-id)
            (forward-line -1)))))))

(add-hook 'tmr--update-hook #'tmr-tabulated--refresh)
(add-hook 'tmr--read-timer-hook #'tmr-tabulated--timer-at-point)

;;;; Mode-line indicator

(defvar tmr-mode-line-string nil
  "TMR mode-line string.")
(put 'tmr-mode-line-string 'risky-local-variable t)

(defvar tmr-mode-line--update-timer nil
  "Timer to update the mode-line.")

(defun tmr-mode-line--format-remaining (timer)
  "Format remaining time for TIMER with appropriate face."
  (if-let* ((remaining (tmr--timer-paused-remaining timer)))
      (propertize (format "PAUSED %s" (tmr--format-seconds remaining)) 'face 'tmr-paused)
    (let* ((secs (float-time (time-subtract (tmr--timer-end-date timer) nil)))
           (face (cond ((and (< secs 5) (= (% (truncate secs) 2) 0))
                        '(tmr-mode-line-urgent (:inverse-video t)))
                       ((< secs 30) 'tmr-mode-line-urgent)
                       ((= (truncate secs) 30)
                        '(tmr-mode-line-urgent (:inverse-video t)))
                       ((= (truncate secs) 60)
                        '(tmr-mode-line-soon (:inverse-video t)))
                       ((< secs 120) 'tmr-mode-line-soon)
                       ((= (truncate secs) 120)
                        '(tmr-mode-line-soon (:inverse-video t)))
                       (t 'tmr-mode-line-active)))
           (formatted (format-seconds
                       (cond ((< secs 120) "%mm %ss%z")
                             ((< secs (* 24 60 60)) "%hh %mm%z")
                             (t "%dd %hh%z"))
                       secs)))
      (propertize formatted 'face face))))

(defun tmr-mode-line--format-description (timer)
  "Format description for TIMER, truncating if necessary."
  (if-let* ((desc (tmr--timer-description timer)))
      (concat " " (if tmr-mode-line-max-desc-length
                      (truncate-string-to-width
                       desc tmr-mode-line-max-desc-length
                       nil nil t)
                    desc))
    ""))

(defun tmr-mode-line--format-timer (timer)
  "Format a single TIMER for display in the mode-line."
  (let ((map (make-sparse-keymap)))
    (define-key map [mode-line mouse-1]
                (lambda ()
                  (interactive)
                  (call-interactively 'tmr-tabulated-view)))
    (propertize
     (format-spec tmr-mode-line-format
                  `((?r . ,(tmr-mode-line--format-remaining timer))
                    (?d . ,(tmr-mode-line--format-description timer))))
     'mouse-face 'mode-line-highlight
     'help-echo (tmr--long-description timer)
     'local-map map)))

(defun tmr-mode-line--get-active-timers ()
  "Return a sorted list of active timers."
  (thread-last tmr--timers
               (seq-remove #'tmr--timer-finishedp)
               (seq-sort-by #'tmr--timer-end-date #'time-less-p)))

(defun tmr-mode-line--update ()
  "Update `tmr-mode-line-string' based on the current timer state."
  (setq
   tmr-mode-line-string
   (if-let* ((active-timers (tmr-mode-line--get-active-timers)))
       (let* ((truncate (and tmr-mode-line-max-timers
                             (length> active-timers tmr-mode-line-max-timers)))
              (timers-to-show (if truncate
                                  (seq-take active-timers
                                            tmr-mode-line-max-timers)
                                active-timers)))
         (concat
          " " tmr-mode-line-prefix " "
          (string-join (mapcar #'tmr-mode-line--format-timer timers-to-show)
                       tmr-mode-line-separator)
          (when truncate
            (format " +%d" (- (length active-timers) tmr-mode-line-max-timers)))
          " "))
     ""))
  (force-mode-line-update t))

;;;###autoload
(define-minor-mode tmr-mode-line-mode
  "Display TMR May Ring timers in the global mode line."
  :global t
  :group 'tmr-mode-line
  (if tmr-mode-line-mode
      (progn
        (unless global-mode-string (setq global-mode-string '("")))
        (unless (memq 'tmr-mode-line-string global-mode-string)
          (setq global-mode-string
                (append global-mode-string '(tmr-mode-line-string))))
        (setq tmr-mode-line--update-timer
              (run-at-time t 1 #'tmr-mode-line--update))
        (add-hook 'tmr--update-hook #'tmr-mode-line--update))
    (when tmr-mode-line--update-timer
      (cancel-timer tmr-mode-line--update-timer)
      (setq tmr-mode-line--update-timer nil))
    (setq tmr-mode-line-string nil)
    (remove-hook 'tmr--update-hook #'tmr-mode-line--update)))

;;;; Ask if there are timers before exiting Emacs

(defun tmr-running-timers-p ()
  "Return non-nil if there are running timers."
  (and tmr--timers (seq-remove #'tmr--timer-finishedp tmr--timers)))

(defun tmr-kill-emacs-query-function ()
  "Ask before exiting Emacs if there are any active TMR timers."
  (if (not (tmr-running-timers-p))
      t
    (tmr-tabulated-view
     (get-buffer-create "*tmr-tabulated-view*")
     '((display-buffer-reuse-mode-window display-buffer-at-bottom)
       (mode . tmr-tabulated-mode)
       (window-height . fit-window-to-buffer)
       (dedicated . t)
       (preserve-size . (t . t))))
    (yes-or-no-p "TMR has running timers; exit anyway? ")))

(add-hook 'kill-emacs-query-functions #'tmr-kill-emacs-query-function)

(provide 'tmr)
;;; tmr.el ends here