org-notify.el

;;; org-notify.el --- Notifications for Org-mode  -*- lexical-binding: t; -*-

;; Copyright (C) 2012-2023  Free Software Foundation, Inc.

;; Author: Peter Münster <pm@a16n.net>
;; Keywords: notification, todo-list, alarm, reminder, pop-up, calendar
;; Version: 0.1.1
;; Package-Requires: ((emacs "25.1"))
;; URL: https://github.com/p-m/org-notify

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

;; Get notifications, when there is something to do.
;; Sometimes, you need a reminder a few days before a deadline, e.g. to buy a
;; present for a birthday, and then another notification one hour before to
;; have enough time to choose the right clothes.
;; For other events, e.g. rolling the dustbin to the roadside once per week,
;; you probably need another kind of notification strategy.
;; This package tries to satisfy the various needs.

;; In order to activate this package, you must add the following code
;; into your .emacs:
;;
;;   (require 'org-notify)
;;   (org-notify-start)

;; Example setup:
;;
;; (org-notify-add 'appt
;;                 '(:time "-1s" :period "20s" :duration 10
;;                   :actions (-message -ding))
;;                 '(:time "15m" :period "2m" :duration 100
;;                   :actions -notify)
;;                 '(:time "2h" :period "5m" :actions -message)
;;                 '(:time "3d" :actions -email))
;;
;; This means for todo-items with `notify' property set to `appt': 3 days
;; before deadline, send a reminder-email, 2 hours before deadline, start to
;; send messages every 5 minutes, then 15 minutes before deadline, start to
;; pop up notification windows every 2 minutes.  The timeout of the window is
;; set to 100 seconds.  Finally, when deadline is overdue, send messages and
;; make noise."

;; Take also a look at the function `org-notify-add'.

;;; Todo:

;; - Make use of https://github.com/jwiegley/alert in
;;   org-notify-action-message.
;; - Since character positions can be wrong, when you add something at the
;;   beginning of the org-file, use markers instead.
;; - Options for procrastination (e.g. "do it tomorrow") should be more
;;   configurable.
;; - Add support for tags as in https://github.com/p-m/org-notify/issues/7.

;;; Code:

(eval-when-compile (require 'cl-lib))
(require 'org-element)

(declare-function appt-delete-window    "appt"          ())
(declare-function notifications-notify  "notifications" (&rest prms))
(declare-function article-lapsed-string "gnus-art"      (t &optional ms))

(defgroup org-notify nil
  "Options for Org-mode notifications."
  :tag "Org Notify"
  :group 'org)

(defcustom org-notify-audible t
  "Non-nil means beep to indicate notification."
  :type 'boolean)

(defcustom org-notify-max-notifications-per-run 3
  "Maximum number of notifications per run of `org-notify-process'."
  :type 'integer)

(defcustom org-notify-timestamp-types '(:deadline)
  "Types of timestamps to be notified of."
  :type '(set (const :deadline)
              (const :scheduled)))

(defconst org-notify-actions
  '("show" "show" "done" "done" "hour" "one hour later" "day" "one day later"
    "week" "one week later")
  "Possible actions for call-back functions.")

(defconst org-notify-window-buffer-name "*org-notify-%s*"
  "Buffer-name for the `org-notify-action-window' function.")

(defvar org-notify-map nil
  "Mapping between names and parameter lists.")

(defvar org-notify-timer nil
  "Timer of the notification daemon.")

(defvar org-notify-parse-file nil
  "Index of current file, that `org-element-parse-buffer' is parsing.")

(defvar org-notify-on-action-map nil
  "Mapping between on-action identifiers and parameter lists.")

(defun org-notify-string->seconds (str)
  "Convert time string STR to number of seconds."
  (when str
    (let* ((conv `(("s" . 1) ("m" . 60) ("h" . ,(* 60 60))
                   ("d" . ,(* 24 60 60)) ("w" . ,(* 7 24 60 60))
                   ("M" . ,(* 30 24 60 60))))
           (letters (concat
                     (mapcar (lambda (x) (string-to-char (car x))) conv)))
           (case-fold-search nil))
      (string-match (concat "\\(-?\\)\\([0-9]+\\)\\([" letters "]\\)") str)
      (* (string-to-number (match-string 2 str))
         (cdr (assoc (match-string 3 str) conv))
         (if (= (length (match-string 1 str)) 1) -1 1)))))

(defun org-notify-convert-timestamp (orig)
  "Convert original timestamp from `org-element-parse-buffer' to
simple timestamp string."
  (if orig
      (replace-regexp-in-string "^<\\|>$" ""
                                (plist-get (plist-get orig 'timestamp)
                                           :raw-value))))

(defun org-notify-make-todo (type elt &rest _ignored)
  "Create one todo item."
  (cl-macrolet ((get (k) `(org-element-property ,k elt))
                (pr (k v) `(setq result (plist-put result ,k ,v))))
    (let* ((notify    (or (get :NOTIFY) "default"))
           (timestamp (org-notify-convert-timestamp (get type)))
           (heading   (get :raw-value))
           result)
      (when (and (eq (get :todo-type) 'todo) heading timestamp)
        (pr :heading heading)     (pr :notify (intern notify))
        (pr :begin (get :begin))
        (pr :file (nth org-notify-parse-file (org-agenda-files 'unrestricted)))
        (pr :timestamp timestamp)
        (pr :uid (md5 (concat heading timestamp (symbol-name type))))
        (pr :deadline (- (org-time-string-to-seconds timestamp)
                         (float-time)))
        (pr :type type))
      result)))

(defun org-notify-todo-list ()
  "Create the todo-list for one org-agenda file."
  (let* ((files (org-agenda-files 'unrestricted))
         (max (1- (length files))))
    (when files
      (setq org-notify-parse-file
            (if (or (not org-notify-parse-file) (>= org-notify-parse-file max))
                0
              (1+ org-notify-parse-file)))
      (save-excursion
        (with-current-buffer (find-file-noselect
                              (nth org-notify-parse-file files))
          (let ((parse-tree (org-element-parse-buffer 'headline)))
            (mapcan (lambda (type)
                      (org-element-map parse-tree 'headline
                        (apply-partially #'org-notify-make-todo type)))
                    org-notify-timestamp-types)))))))

(defun org-notify-maybe-too-late (diff period heading)
  "Print warning message, when notified significantly later than defined by
PERIOD."
  (if (> (/ diff period) 1.5)
      (message "Warning: notification for \"%s\" behind schedule!" heading))
  t)

(cl-defun org-notify-process ()
  "Process the todo-list, and possibly notify user about upcoming or
forgotten tasks."
  (let ((notification-cnt 0))
    (cl-macrolet ((prm (k) `(plist-get prms ,k))  (td (k) `(plist-get todo ,k)))
      (dolist (todo (org-notify-todo-list))
        (let* ((deadline (td :deadline))  (heading (td :heading))
               (uid (td :uid))            (last-run-sym
                                           (intern (concat ":last-run-" uid))))
          (cl-dolist (prms (plist-get org-notify-map (td :notify)))
            (when (< deadline (org-notify-string->seconds (prm :time)))
              (let ((period (org-notify-string->seconds (prm :period)))
                    (last-run (prm last-run-sym))  (now (float-time))
                    (actions (prm :actions))       diff  plist)
                (when (or (not last-run)
                          (and period (< period (setq diff (- now last-run)))
                               (org-notify-maybe-too-late diff period heading)))
                  (setq prms (plist-put prms last-run-sym now)
                        plist (append todo prms))
                  (if (if (plist-member prms :audible)
                          (prm :audible)
                        org-notify-audible)
                      (ding))
                  (setq actions (ensure-list actions))
                  (cl-incf notification-cnt)
                  (dolist (action actions)
                    (funcall (if (fboundp action) action
                               (intern (concat "org-notify-action"
                                               (symbol-name action))))
                             plist))
                  (when (>= notification-cnt
                            org-notify-max-notifications-per-run)
                    (cl-return-from org-notify-process))))
              (cl-return))))))))

(defun org-notify-add (name &rest params)
  "Add a new notification type.
The NAME can be used in Org-mode property `notify'.  If NAME is
`default', the notification type applies for todo items without
the `notify' property.  This file predefines such a default
notification type.

Each element of PARAMS is a list with parameters for a given time
distance to the deadline.  This distance must increase from one
element to the next.

List of possible parameters:

  :time      Time distance to deadline, when this type of notification shall
             start.  It's a string: an integral value (positive or negative)
             followed by a unit (s, m, h, d, w, M).
  :actions   A function or a list of functions to be called to notify the
             user.  Instead of a function name, you can also supply a suffix
             of one of the various predefined `org-notify-action-xxx'
             functions.
  :period    Optional: can be used to repeat the actions periodically.
             Same format as :time.
  :duration  Some actions use this parameter to specify the duration of the
             notification.  It's an integral number in seconds.
  :audible   Overwrite the value of `org-notify-audible' for this action.

For the actions, you can use your own functions or some of the predefined
ones, whose names are prefixed with `org-notify-action-'."
  (setq org-notify-map (plist-put org-notify-map name params)))

(defun org-notify-start (&optional secs)
  "Start the notification daemon.
If SECS is positive, it's the period in seconds for processing
the notifications of one org-agenda file, and if negative,
notifications will be checked only when Emacs is idle for -SECS
seconds.  The default value for SECS is 20."
  (interactive)
  (if org-notify-timer
      (org-notify-stop))
  (setq secs (or secs 20)
        org-notify-timer (if (< secs 0)
                             (run-with-idle-timer (* -1 secs) t
                                                  #'org-notify-process)
                           (run-with-timer secs secs #'org-notify-process))))

(defun org-notify-stop ()
  "Stop the notification daemon."
  (when org-notify-timer
    (cancel-timer org-notify-timer)
    (setq org-notify-timer nil)))

(defun org-notify-on-action (plist key)
  "User wants to see action."
  (let ((file (plist-get plist :file))
        (begin (plist-get plist :begin))
        (search-prefix (pcase (plist-get plist :type)
                         (:deadline "DEADLINE")
                         (:scheduled "SCHEDULED"))))
    (if (string-equal key "show")
        (progn
          (switch-to-buffer (find-file-noselect file))
          (org-with-wide-buffer
           (goto-char begin)
           (outline-show-entry))
          (goto-char begin)
          (search-forward (concat search-prefix ": <"))
          (search-forward ":")
          (if (display-graphic-p)
              (x-focus-frame nil)))
      (save-excursion
        (with-current-buffer (find-file-noselect file)
          (org-with-wide-buffer
           (goto-char begin)
           (search-forward (concat search-prefix ": <"))
           (cond
            ((string-equal key "done")
             (let ((org-loop-over-headlines-in-active-region nil)) (org-todo)))
            ((string-equal key "hour")  (org-timestamp-change 60 'minute))
            ((string-equal key "day")   (org-timestamp-up-day))
            ((string-equal key "week")  (org-timestamp-change 7 'day)))))))))

(defun org-notify-on-action-notify (id key)
  "User wants to see action after mouse-click in notify window."
  (org-notify-on-action (plist-get org-notify-on-action-map id) key)
  (org-notify-on-close id nil))

(defun org-notify-on-action-button (button)
  "User wants to see action after button activation."
  (cl-macrolet ((get (k) `(button-get button ,k)))
    (org-notify-on-action (get 'plist) (get 'key))
    (org-notify-delete-window (get 'buffer))
    (cancel-timer (get 'timer))))

(defun org-notify-delete-window (buffer)
  "Delete the notification window."
  (require 'appt)
  (defvar appt-buffer-name) (defvar appt-audible)
  (let ((appt-buffer-name buffer)
        (appt-audible nil))
    (appt-delete-window)))

(defun org-notify-on-close (id _reason)
  "Notification window has been closed."
  (setq org-notify-on-action-map (plist-put org-notify-on-action-map id nil)))

(defun org-notify-action-message (plist)
  "Print a message."
  (message "TODO: \"%s\" at %s!" (plist-get plist :heading)
           (plist-get plist :timestamp)))

(defun org-notify-action-ding (plist)
  "Make noise."
  (let ((timer (run-with-timer 0 1 #'ding)))
    (run-with-timer (or (plist-get plist :duration) 3) nil
                    #'cancel-timer timer)))

(defun org-notify-body-text (plist)
  "Make human readable string for remaining time to deadline."
  (require 'gnus-art)
  (format "%s\n(%s)"
          (replace-regexp-in-string
           " in the future" ""
           (article-lapsed-string
            (time-add nil (seconds-to-time (plist-get plist :deadline))) 2))
          (plist-get plist :timestamp)))

(defun org-notify-action-email (plist)
  "Send email to user."
  (compose-mail user-mail-address (concat "TODO: " (plist-get plist :heading)))
  (insert (org-notify-body-text plist))
  (funcall send-mail-function)
  (set-visited-file-name nil)
  (kill-buffer))

(defun org-notify-select-highest-window ()
  "Select the highest window on the frame, that is not is not an
org-notify window.  Mostly copied from `appt-select-lowest-window'."
  (let ((highest-window (selected-window))
        (bottom-edge (nth 3 (window-edges)))
        next-bottom-edge)
    (walk-windows (lambda (w)
                    (when (and
                           (not (string-match "^\\*org-notify-.*\\*$"
                                              (buffer-name
                                               (window-buffer w))))
                           (> bottom-edge (setq next-bottom-edge
                                                (nth 3 (window-edges w)))))
                      (setq bottom-edge next-bottom-edge
                            highest-window w))) 'nomini)
    (select-window highest-window)))

(defun org-notify-action-window (plist)
  "Pop up a window, mostly copied from `appt-disp-window'."
  (save-excursion
    (cl-macrolet ((get (k) `(plist-get plist ,k)))
      (let ((this-window (selected-window))
            (buf (get-buffer-create
                  (format org-notify-window-buffer-name (get :uid)))))
        (when (minibufferp)
          (other-window 1)
          (and (minibufferp) (display-multi-frame-p) (other-frame 1)))
        (if (cdr (assq 'unsplittable (frame-parameters)))
            (progn (set-buffer buf) (display-buffer buf))
          (unless (or (special-display-p (buffer-name buf))
                      (same-window-p (buffer-name buf)))
            (org-notify-select-highest-window)
            (when (>= (window-height) (* 2 window-min-height))
              (select-window (split-window nil nil 'above))))
          (switch-to-buffer buf))
        (setq buffer-read-only nil  buffer-undo-list t)
        (erase-buffer)
        (insert (format "TODO: %s, %s.\n" (get :heading)
                        (org-notify-body-text plist)))
        (let ((timer (run-with-timer (or (get :duration) 10) nil
                                     #'org-notify-delete-window buf)))
          (dotimes (i (/ (length org-notify-actions) 2))
            (let ((key (nth (* i 2) org-notify-actions))
                  (text (nth (1+ (* i 2)) org-notify-actions)))
              (insert-button text 'action 'org-notify-on-action-button
                             'key key 'buffer buf 'plist plist 'timer timer)
              (insert "    "))))
        (shrink-window-if-larger-than-buffer (get-buffer-window buf t))
        (set-buffer-modified-p nil)       (setq buffer-read-only t)
        (raise-frame (selected-frame))    (select-window this-window)))))

(defun org-notify-action-notify (plist)
  "Pop up a notification window."
  (require 'notifications)
  (let* ((duration (plist-get plist :duration))
         (id (notifications-notify
              :title     (plist-get plist :heading)
              :body      (org-notify-body-text plist)
              :timeout   (if duration (* duration 1000))
              :urgency   (plist-get plist :urgency)
              :actions   org-notify-actions
              :on-action 'org-notify-on-action-notify)))
    (setq org-notify-on-action-map
          (plist-put org-notify-on-action-map id plist))))

(defun org-notify-action-notify/window (plist)
  "For a graphics display, pop up a notification window, for a text
terminal an Emacs window."
  (if (display-graphic-p)
      (org-notify-action-notify plist)
    (org-notify-action-window plist)))

;;; Provide a minimal default setup.
(org-notify-add 'default '(:time "1h" :actions -notify/window
                                 :period "2m" :duration 60))

(provide 'org-notify)

;;; org-notify.el ends here