emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: "Peter Münster" <pm@a16n.net>
To: emacs-orgmode@gnu.org
Subject: [PATCH] patches for org-notify.el
Date: Sun, 13 Sep 2020 17:03:12 +0200	[thread overview]
Message-ID: <87sgbln2hb.fsf@a16n.net> (raw)

[-- Attachment #1: Type: text/plain, Size: 91 bytes --]

Hi,

Please find attached 2 patches for org-notify.el.

Kind regards,
-- 
           Peter

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-contrib-lisp-org-notify.el-use-cl-prefixed-functions.patch --]
[-- Type: text/x-patch, Size: 1991 bytes --]

From 9ffa89dc99bfe967d9c591948d84dddb2eccdc38 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Peter=20M=C3=BCnster?= <pm@a16n.net>
Date: Sun, 13 Sep 2020 15:44:00 +0200
Subject: [PATCH 1/2] org-notify.el: Use cl- prefixed functions, and require cl-lib

---
 contrib/lisp/org-notify.el | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el
index 9f8677871..56d565c74 100644
--- a/contrib/lisp/org-notify.el
+++ b/contrib/lisp/org-notify.el
@@ -57,7 +57,7 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 (require 'org-element)
 
 (declare-function appt-delete-window    "appt"          ())
@@ -155,7 +155,7 @@ PERIOD."
       (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."
   (cl-macrolet ((prm (k) `(plist-get prms ,k))  (td (k) `(plist-get todo ,k)))
@@ -163,7 +163,7 @@ forgotten tasks."
       (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)))
+        (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))
@@ -184,7 +184,7 @@ forgotten tasks."
                              (intern (concat "org-notify-action"
                                              (symbol-name action))))
                            plist))))
-            (return)))))))
+            (cl-return)))))))
 
 (defun org-notify-add (name &rest params)
   "Add a new notification type.
-- 
2.26.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-contrib-lisp-org-notify.el-org-notify-max-notificati.patch --]
[-- Type: text/x-patch, Size: 4524 bytes --]

From 54134c8d07bafee3d8fc7492658c3a1c067aea5d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Peter=20M=C3=BCnster?= <pm@a16n.net>
Date: Sun, 13 Sep 2020 16:18:56 +0200
Subject: [PATCH 2/2] org-notify.el: Limit the number of notifications

(org-notify-max-notifications-per-run): New option for limiting the
notifications.
(org-notify-process): Use it.

---
 contrib/lisp/org-notify.el | 63 ++++++++++++++++++++++----------------
 1 file changed, 36 insertions(+), 27 deletions(-)

diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el





diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el
index 56d565c74..7f610a0df 100644
--- a/contrib/lisp/org-notify.el
+++ b/contrib/lisp/org-notify.el
@@ -74,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")
@@ -158,33 +163,37 @@ PERIOD."
 (cl-defun org-notify-process ()
   "Process the todo-list, and possibly notify user about upcoming or
 forgotten tasks."
-  (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)))
-                (dolist (action actions)
-                  (funcall (if (fboundp action) action
-                             (intern (concat "org-notify-action"
-                                             (symbol-name action))))
-                           plist))))
-            (cl-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.
-- 
2.26.2


             reply	other threads:[~2020-09-13 15:07 UTC|newest]

Thread overview: 3+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-09-13 15:03 Peter Münster [this message]
2020-09-13 16:43 ` [PATCH] patches for org-notify.el Bastien
2020-09-13 19:33   ` Peter Münster

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87sgbln2hb.fsf@a16n.net \
    --to=pm@a16n.net \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).