contrib/lisp/org-notify.el

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