branch: externals/org-notify
commit 1c65ee95977289273b1877173e6950b3190a5157
Author: Peter Münster <p...@free.fr>
Commit: Peter Münster <p...@free.fr>
org-notify.el: update to version in org-mode distribution
---
org-notify.el | 169 ++++++++++++++++++++++++++++++++++------------------------
1 file changed, 99 insertions(+), 70 deletions(-)
diff --git a/org-notify.el b/org-notify.el
index 9ddf15078d..25e88691c0 100644
--- a/org-notify.el
+++ b/org-notify.el
@@ -1,10 +1,12 @@
;;; org-notify.el --- Notifications for Org-mode
-;; Copyright (C) 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Peter Münster <p...@free.fr>
;; Keywords: notification, todo-list, alarm, reminder, pop-up
+;; 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
@@ -16,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -35,6 +37,7 @@
;; (org-notify-start)
;; Example setup:
+;;
;; (org-notify-add 'appt
;; '(:time "-1s" :period "20s" :duration 10
;; :actions (-message -ding))
@@ -42,18 +45,19 @@
;; :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
+;; 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'.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'org-element)
(declare-function appt-delete-window "appt" ())
@@ -70,6 +74,11 @@
:type 'boolean
:group 'org-notify)
+(defcustom org-notify-max-notifications-per-run 3
+ "Maximum number of notifications per run of `org-notify-process'."
+ :type 'integer
+ :group 'org-notify)
+
(defconst org-notify-actions
'("show" "show" "done" "done" "hour" "one hour later" "day" "one day later"
"week" "one week later")
@@ -104,12 +113,21 @@
(cdr (assoc (match-string 3 str) conv))
(if (= (length (match-string 1 str)) 1) -1 1)))))
+(defun org-notify-convert-deadline (orig)
+ "Convert original deadline 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 (heading &rest ignored)
"Create one todo item."
- (macrolet ((get (k) `(plist-get list ,k))
+ (cl-macrolet ((get (k) `(plist-get list ,k))
(pr (k v) `(setq result (plist-put result ,k ,v))))
- (let* ((list (nth 1 heading)) (notify (or (get :notify) "default"))
- (deadline (get :deadline)) (heading (get :raw-value))
+ (let* ((list (nth 1 heading)) (notify (or (get :NOTIFY) "default"))
+ (deadline (org-notify-convert-deadline (get :deadline)))
+ (heading (get :raw-value))
result)
(when (and (eq (get :todo-type) 'todo) heading deadline)
(pr :heading heading) (pr :notify (intern notify))
@@ -117,82 +135,90 @@
(pr :file (nth org-notify-parse-file (org-agenda-files 'unrestricted)))
(pr :timestamp deadline) (pr :uid (md5 (concat heading deadline)))
(pr :deadline (- (org-time-string-to-seconds deadline)
- (org-float-time))))
+ (float-time))))
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))))
- (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))
- (org-element-map (org-element-parse-buffer 'headline)
- 'headline 'org-notify-make-todo)))))
+ (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))
+ (org-element-map (org-element-parse-buffer 'headline)
+ 'headline 'org-notify-make-todo))))))
(defun org-notify-maybe-too-late (diff period heading)
- "Print waring message, when notified significantly later than defined by
+ "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)
-(defun org-notify-process ()
+(cl-defun org-notify-process ()
"Process the todo-list, and possibly notify user about upcoming or
forgotten tasks."
- (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))))
- (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 (org-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))
- (unless (listp actions)
- (setq actions (list actions)))
- (dolist (action actions)
- (funcall (if (fboundp action) action
- (intern (concat "org-notify-action"
- (symbol-name action))))
- plist))))
- (return)))))))
+ (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))
+ (unless (listp actions)
+ (setq actions (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
+ "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.
+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)
+ 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
+ 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.
+ :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.
+ 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
@@ -200,11 +226,12 @@ 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."
+ "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)
@@ -216,8 +243,8 @@ SECS is 20."
(defun org-notify-stop ()
"Stop the notification daemon."
(when org-notify-timer
- (cancel-timer org-notify-timer)
- (setq org-notify-timer nil)))
+ (cancel-timer org-notify-timer)
+ (setq org-notify-timer nil)))
(defun org-notify-on-action (plist key)
"User wants to see action."
@@ -228,9 +255,10 @@ SECS is 20."
(switch-to-buffer (find-file-noselect file))
(org-with-wide-buffer
(goto-char begin)
- (show-entry))
+ (outline-show-entry))
(goto-char begin)
(search-forward "DEADLINE: <")
+ (search-forward ":")
(if (display-graphic-p)
(x-focus-frame nil)))
(save-excursion
@@ -251,7 +279,7 @@ SECS is 20."
(defun org-notify-on-action-button (button)
"User wants to see action after button activation."
- (macrolet ((get (k) `(button-get button ,k)))
+ (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))))
@@ -294,12 +322,12 @@ SECS is 20."
(compose-mail user-mail-address (concat "TODO: " (plist-get plist :heading)))
(insert (org-notify-body-text plist))
(funcall send-mail-function)
- (flet ((yes-or-no-p (prompt) t))
+ (cl-letf (((symbol-function 'yes-or-no-p) (lambda (x) t)))
(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'."
+org-notify window. Mostly copied from `appt-select-lowest-window'."
(let ((highest-window (selected-window))
(bottom-edge (nth 3 (window-edges)))
next-bottom-edge)
@@ -317,7 +345,7 @@ org-notify window. Mostly copied from
`appt-select-lowest-window'."
(defun org-notify-action-window (plist)
"Pop up a window, mostly copied from `appt-disp-window'."
(save-excursion
- (macrolet ((get (k) `(plist-get plist ,k)))
+ (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)))))
@@ -356,6 +384,7 @@ org-notify window. Mostly copied from
`appt-select-lowest-window'."
: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
@@ -370,7 +399,7 @@ terminal an emacs window."
;;; Provide a minimal default setup.
(org-notify-add 'default '(:time "1h" :actions -notify/window
- :period "2m" :duration 60))
+ :period "2m" :duration 60))
(provide 'org-notify)
