org-notify.el 16 KB

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