contrib/lisp/org-notify.el

   1 ;;; org-notify.el --- Notifications for Org-mode
   2
   3 ;; Copyright (C) 2012, 2013  Free Software Foundation, Inc.
   4
   5 ;; Author: Peter Münster <pmrb@free.fr>
   6 ;; Keywords: notification, todo-list, alarm, reminder, pop-up
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; Get notifications, when there is something to do.
  24 ;; Sometimes, you need a reminder a few days before a deadline, e.g. to buy a
  25 ;; present for a birthday, and then another notification one hour before to
  26 ;; have enough time to choose the right clothes.
  27 ;; For other events, e.g. rolling the dustbin to the roadside once per week,
  28 ;; you probably need another kind of notification strategy.
  29 ;; This package tries to satisfy the various needs.
  30
  31 ;; In order to activate this package, you must add the following code
  32 ;; into your .emacs:
  33 ;;
  34 ;;   (require 'org-notify)
  35 ;;   (org-notify-start)
  36
  37 ;; Example setup:
  38 ;;
  39 ;; (org-notify-add 'appt
  40 ;;                 '(:time "-1s" :period "20s" :duration 10
  41 ;;                   :actions (-message -ding))
  42 ;;                 '(:time "15m" :period "2m" :duration 100
  43 ;;                   :actions -notify)
  44 ;;                 '(:time "2h" :period "5m" :actions -message)
  45 ;;                 '(:time "3d" :actions -email))
  46 ;;
  47 ;; This means for todo-items with `notify' property set to `appt': 3 days
  48 ;; before deadline, send a reminder-email, 2 hours before deadline, start to
  49 ;; send messages every 5 minutes, then 15 minutes before deadline, start to
  50 ;; pop up notification windows every 2 minutes.  The timeout of the window is
  51 ;; set to 100 seconds.  Finally, when deadline is overdue, send messages and
  52 ;; make noise."
  53
  54 ;; Take also a look at the function `org-notify-add'.
  55
  56 ;;; Code:
  57
  58 (eval-when-compile (require 'cl))
  59 (require 'org-element)
  60
  61 (declare-function appt-delete-window    "appt"          ())
  62 (declare-function notifications-notify  "notifications" (&rest prms))
  63 (declare-function article-lapsed-string "gnus-art"      (t &optional ms))
  64
  65 (defgroup org-notify nil
  66   "Options for Org-mode notifications."
  67   :tag "Org Notify"
  68   :group 'org)
  69
  70 (defcustom org-notify-audible t
  71   "Non-nil means beep to indicate notification."
  72   :type 'boolean
  73   :group 'org-notify)
  74
  75 (defconst org-notify-actions
  76   '("show" "show" "done" "done" "hour" "one hour later" "day" "one day later"
  77     "week" "one week later")
  78   "Possible actions for call-back functions.")
  79
  80 (defconst org-notify-window-buffer-name "*org-notify-%s*"
  81   "Buffer-name for the `org-notify-action-window' function.")
  82
  83 (defvar org-notify-map nil
  84   "Mapping between names and parameter lists.")
  85
  86 (defvar org-notify-timer nil
  87   "Timer of the notification daemon.")
  88
  89 (defvar org-notify-parse-file nil
  90   "Index of current file, that `org-element-parse-buffer' is parsing.")
  91
  92 (defvar org-notify-on-action-map nil
  93   "Mapping between on-action identifiers and parameter lists.")
  94
  95 (defun org-notify-string->seconds (str)
  96   "Convert time string STR to number of seconds."
  97   (when str
  98     (let* ((conv `(("s" . 1) ("m" . 60) ("h" . ,(* 60 60))
  99                    ("d" . ,(* 24 60 60)) ("w" . ,(* 7 24 60 60))
 100                    ("M" . ,(* 30 24 60 60))))
 101            (letters (concat
 102                      (mapcar (lambda (x) (string-to-char (car x))) conv)))
 103            (case-fold-search nil))
 104       (string-match (concat "\\(-?\\)\\([0-9]+\\)\\([" letters "]\\)") str)
 105       (* (string-to-number (match-string 2 str))
 106          (cdr (assoc (match-string 3 str) conv))
 107          (if (= (length (match-string 1 str)) 1) -1 1)))))
 108
 109 (defun org-notify-convert-deadline (orig)
 110   "Convert original deadline from `org-element-parse-buffer' to
 111 simple timestamp string."
 112   (if orig
 113       (replace-regexp-in-string "^<\\|>$" ""
 114                                 (plist-get (plist-get orig 'timestamp)
 115                                            :raw-value))))
 116
 117 (defun org-notify-make-todo (heading &rest ignored)
 118   "Create one todo item."
 119   (macrolet ((get (k) `(plist-get list ,k))
 120              (pr (k v) `(setq result (plist-put result ,k ,v))))
 121     (let* ((list (nth 1 heading))      (notify (or (get :notify) "default"))
 122            (deadline (org-notify-convert-deadline (get :deadline)))
 123            (heading (get :raw-value))
 124            result)
 125       (when (and (eq (get :todo-type) 'todo) heading deadline)
 126         (pr :heading heading)     (pr :notify (intern notify))
 127         (pr :begin (get :begin))
 128         (pr :file (nth org-notify-parse-file (org-agenda-files 'unrestricted)))
 129         (pr :timestamp deadline)  (pr :uid (md5 (concat heading deadline)))
 130         (pr :deadline (- (org-time-string-to-seconds deadline)
 131                          (org-float-time))))
 132       result)))
 133
 134 (defun org-notify-todo-list ()
 135   "Create the todo-list for one org-agenda file."
 136   (let* ((files (org-agenda-files 'unrestricted))
 137          (max (1- (length files))))
 138     (setq org-notify-parse-file
 139           (if (or (not org-notify-parse-file) (>= org-notify-parse-file max))
 140               0
 141             (1+ org-notify-parse-file)))
 142     (save-excursion
 143       (with-current-buffer (find-file-noselect
 144                             (nth org-notify-parse-file files))
 145         (org-element-map (org-element-parse-buffer 'headline)
 146                          'headline 'org-notify-make-todo)))))
 147
 148 (defun org-notify-maybe-too-late (diff period heading)
 149   "Print waring message, when notified significantly later than defined by
 150 PERIOD."
 151   (if (> (/ diff period) 1.5)
 152       (message "Warning: notification for \"%s\" behind schedule!" heading))
 153   t)
 154
 155 (defun org-notify-process ()
 156   "Process the todo-list, and possibly notify user about upcoming or
 157 forgotten tasks."
 158   (macrolet ((prm (k) `(plist-get prms ,k))  (td (k) `(plist-get todo ,k)))
 159     (dolist (todo (org-notify-todo-list))
 160       (let* ((deadline (td :deadline))  (heading (td :heading))
 161              (uid (td :uid))            (last-run-sym
 162                                          (intern (concat ":last-run-" uid))))
 163         (dolist (prms (plist-get org-notify-map (td :notify)))
 164           (when (< deadline (org-notify-string->seconds (prm :time)))
 165             (let ((period (org-notify-string->seconds (prm :period)))
 166                   (last-run (prm last-run-sym))  (now (org-float-time))
 167                   (actions (prm :actions))       diff  plist)
 168               (when (or (not last-run)
 169                         (and period (< period (setq diff (- now last-run)))
 170                              (org-notify-maybe-too-late diff period heading)))
 171                 (setq prms (plist-put prms last-run-sym now)
 172                       plist (append todo prms))
 173                 (if (if (plist-member prms :audible)
 174                         (prm :audible)
 175                       org-notify-audible)
 176                     (ding))
 177                 (unless (listp actions)
 178                   (setq actions (list actions)))
 179                 (dolist (action actions)
 180                   (funcall (if (fboundp action) action
 181                              (intern (concat "org-notify-action"
 182                                              (symbol-name action))))
 183                            plist))))
 184             (return)))))))
 185
 186 (defun org-notify-add (name &rest params)
 187   "Add a new notification type.
 188 The NAME can be used in Org-mode property `notify'.  If NAME is
 189 `default', the notification type applies for todo items without
 190 the `notify' property.  This file predefines such a default
 191 notification type.
 192
 193 Each element of PARAMS is a list with parameters for a given time
 194 distance to the deadline.  This distance must increase from one
 195 element to the next.
 196
 197 List of possible parameters:
 198
 199   :time      Time distance to deadline, when this type of notification shall
 200              start.  It's a string: an integral value (positive or negative)
 201              followed by a unit (s, m, h, d, w, M).
 202   :actions   A function or a list of functions to be called to notify the
 203              user.  Instead of a function name, you can also supply a suffix
 204              of one of the various predefined `org-notify-action-xxx'
 205              functions.
 206   :period    Optional: can be used to repeat the actions periodically.
 207              Same format as :time.
 208   :duration  Some actions use this parameter to specify the duration of the
 209              notification.  It's an integral number in seconds.
 210   :audible   Overwrite the value of `org-notify-audible' for this action.
 211
 212 For the actions, you can use your own functions or some of the predefined
 213 ones, whose names are prefixed with `org-notify-action-'."
 214   (setq org-notify-map (plist-put org-notify-map name params)))
 215
 216 (defun org-notify-start (&optional secs)
 217   "Start the notification daemon.
 218 If SECS is positive, it's the period in seconds for processing
 219 the notifications of one org-agenda file, and if negative,
 220 notifications will be checked only when emacs is idle for -SECS
 221 seconds.  The default value for SECS is 20."
 222   (interactive)
 223   (if org-notify-timer
 224       (org-notify-stop))
 225   (setq secs (or secs 20)
 226         org-notify-timer (if (< secs 0)
 227                              (run-with-idle-timer (* -1 secs) t
 228                                                   'org-notify-process)
 229                            (run-with-timer secs secs 'org-notify-process))))
 230
 231 (defun org-notify-stop ()
 232   "Stop the notification daemon."
 233   (when org-notify-timer
 234     (cancel-timer org-notify-timer)
 235     (setq org-notify-timer nil)))
 236
 237 (defun org-notify-on-action (plist key)
 238   "User wants to see action."
 239   (let ((file (plist-get plist :file))
 240         (begin (plist-get plist :begin)))
 241     (if (string-equal key "show")
 242         (progn
 243           (switch-to-buffer (find-file-noselect file))
 244           (org-with-wide-buffer
 245            (goto-char begin)
 246            (show-entry))
 247           (goto-char begin)
 248           (search-forward "DEADLINE: <")
 249           (if (display-graphic-p)
 250               (x-focus-frame nil)))
 251       (save-excursion
 252         (with-current-buffer (find-file-noselect file)
 253           (org-with-wide-buffer
 254            (goto-char begin)
 255            (search-forward "DEADLINE: <")
 256            (cond
 257             ((string-equal key "done")  (org-todo))
 258             ((string-equal key "hour")  (org-timestamp-change 60 'minute))
 259             ((string-equal key "day")   (org-timestamp-up-day))
 260             ((string-equal key "week")  (org-timestamp-change 7 'day)))))))))
 261
 262 (defun org-notify-on-action-notify (id key)
 263   "User wants to see action after mouse-click in notify window."
 264   (org-notify-on-action (plist-get org-notify-on-action-map id) key)
 265   (org-notify-on-close id nil))
 266
 267 (defun org-notify-on-action-button (button)
 268   "User wants to see action after button activation."
 269   (macrolet ((get (k) `(button-get button ,k)))
 270     (org-notify-on-action (get 'plist) (get 'key))
 271     (org-notify-delete-window (get 'buffer))
 272     (cancel-timer (get 'timer))))
 273
 274 (defun org-notify-delete-window (buffer)
 275   "Delete the notification window."
 276   (require 'appt)
 277   (let ((appt-buffer-name buffer)
 278         (appt-audible nil))
 279     (appt-delete-window)))
 280
 281 (defun org-notify-on-close (id reason)
 282   "Notification window has been closed."
 283   (setq org-notify-on-action-map (plist-put org-notify-on-action-map id nil)))
 284
 285 (defun org-notify-action-message (plist)
 286   "Print a message."
 287   (message "TODO: \"%s\" at %s!" (plist-get plist :heading)
 288            (plist-get plist :timestamp)))
 289
 290 (defun org-notify-action-ding (plist)
 291   "Make noise."
 292   (let ((timer (run-with-timer 0 1 'ding)))
 293     (run-with-timer (or (plist-get plist :duration) 3) nil
 294                     'cancel-timer timer)))
 295
 296 (defun org-notify-body-text (plist)
 297   "Make human readable string for remaining time to deadline."
 298   (require 'gnus-art)
 299   (format "%s\n(%s)"
 300           (replace-regexp-in-string
 301            " in the future" ""
 302            (article-lapsed-string
 303             (time-add (current-time)
 304                       (seconds-to-time (plist-get plist :deadline))) 2))
 305           (plist-get plist :timestamp)))
 306
 307 (defun org-notify-action-email (plist)
 308   "Send email to user."
 309   (compose-mail user-mail-address (concat "TODO: " (plist-get plist :heading)))
 310   (insert (org-notify-body-text plist))
 311   (funcall send-mail-function)
 312   (flet ((yes-or-no-p (prompt) t))
 313     (kill-buffer)))
 314
 315 (defun org-notify-select-highest-window ()
 316   "Select the highest window on the frame, that is not is not an
 317 org-notify window.  Mostly copied from `appt-select-lowest-window'."
 318   (let ((highest-window (selected-window))
 319         (bottom-edge (nth 3 (window-edges)))
 320         next-bottom-edge)
 321     (walk-windows (lambda (w)
 322                     (when (and
 323                            (not (string-match "^\\*org-notify-.*\\*$"
 324                                               (buffer-name
 325                                                (window-buffer w))))
 326                            (> bottom-edge (setq next-bottom-edge
 327                                                 (nth 3 (window-edges w)))))
 328                       (setq bottom-edge next-bottom-edge
 329                             highest-window w))) 'nomini)
 330     (select-window highest-window)))
 331
 332 (defun org-notify-action-window (plist)
 333   "Pop up a window, mostly copied from `appt-disp-window'."
 334   (save-excursion
 335     (macrolet ((get (k) `(plist-get plist ,k)))
 336       (let ((this-window (selected-window))
 337             (buf (get-buffer-create
 338                   (format org-notify-window-buffer-name (get :uid)))))
 339         (when (minibufferp)
 340           (other-window 1)
 341           (and (minibufferp) (display-multi-frame-p) (other-frame 1)))
 342         (if (cdr (assq 'unsplittable (frame-parameters)))
 343             (progn (set-buffer buf) (display-buffer buf))
 344           (unless (or (special-display-p (buffer-name buf))
 345                       (same-window-p (buffer-name buf)))
 346             (org-notify-select-highest-window)
 347             (when (>= (window-height) (* 2 window-min-height))
 348               (select-window (split-window nil nil 'above))))
 349           (switch-to-buffer buf))
 350         (setq buffer-read-only nil  buffer-undo-list t)
 351         (erase-buffer)
 352         (insert (format "TODO: %s, %s.\n" (get :heading)
 353                         (org-notify-body-text plist)))
 354         (let ((timer (run-with-timer (or (get :duration) 10) nil
 355                                      'org-notify-delete-window buf)))
 356           (dotimes (i (/ (length org-notify-actions) 2))
 357             (let ((key (nth (* i 2) org-notify-actions))
 358                   (text (nth (1+ (* i 2)) org-notify-actions)))
 359               (insert-button text 'action 'org-notify-on-action-button
 360                              'key key 'buffer buf 'plist plist 'timer timer)
 361               (insert "    "))))
 362         (shrink-window-if-larger-than-buffer (get-buffer-window buf t))
 363         (set-buffer-modified-p nil)       (setq buffer-read-only t)
 364         (raise-frame (selected-frame))    (select-window this-window)))))
 365
 366 (defun org-notify-action-notify (plist)
 367   "Pop up a notification window."
 368   (require 'notifications)
 369   (let* ((duration (plist-get plist :duration))
 370          (id (notifications-notify
 371               :title     (plist-get plist :heading)
 372               :body      (org-notify-body-text plist)
 373               :timeout   (if duration (* duration 1000))
 374               :actions   org-notify-actions
 375               :on-action 'org-notify-on-action-notify)))
 376     (setq org-notify-on-action-map
 377           (plist-put org-notify-on-action-map id plist))))
 378
 379 (defun org-notify-action-notify/window (plist)
 380   "For a graphics display, pop up a notification window, for a text
 381 terminal an emacs window."
 382   (if (display-graphic-p)
 383       (org-notify-action-notify plist)
 384     (org-notify-action-window plist)))
 385
 386 ;;; Provide a minimal default setup.
 387 (org-notify-add 'default '(:time "1h" :actions -notify/window
 388                                  :period "2m" :duration 60))
 389
 390 (provide 'org-notify)
 391
 392 ;;; org-notify.el ends here