all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* Proposed changes to gnus-notifications.el
@ 2019-07-21  0:52 Basil L. Contovounesios
  2019-07-21  8:01 ` Michael Albinus
  2019-07-21 13:44 ` Lars Ingebrigtsen
  0 siblings, 2 replies; 10+ messages in thread
From: Basil L. Contovounesios @ 2019-07-21  0:52 UTC (permalink / raw)
  To: emacs-devel; +Cc: Julien Danjou, Lars Ingebrigtsen

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

The following patch for gnus-notifications.el enables lexical-binding
and simplifies and clarifies some of the code and docs.  WDYT?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Refactor-gnus-notifications.el.patch --]
[-- Type: text/x-diff, Size: 13230 bytes --]

From 40e0cf058674d0791b5f8110aba8d9171d640c14 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Sat, 20 Jul 2019 23:37:29 +0100
Subject: [PATCH] Refactor gnus-notifications.el

* lisp/gnus/gnus-notifications.el: Use lexical-binding.  Pass
non-nil NOERROR to 'require' instead of wrapping in ignore-errors.
Add image.el as a dependency.  Remove redundant :group tags.
(gnus-notifications-use-google-contacts): Default to nil if
google-contacts is not installed.
(gnus-notifications-use-gravatar, gnus-notifications-timeout)
(gnus-notifications-sent, gnus-notifications-id-to-msg): Clarify
docstring.
(gnus-notifications-notify, gnus-notifications-get-photo)
(gnus-notifications-get-photo-file): Simplify.
(gnus-notifications): Simplify to reduce indentation.
Call user option gnus-extract-address-components in place of
mail-extract-address-components.
---
 lisp/gnus/gnus-notifications.el | 206 +++++++++++++++-----------------
 1 file changed, 94 insertions(+), 112 deletions(-)

diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index 3476164583..81e09d1fd5 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/gnus-notifications.el
@@ -1,4 +1,4 @@
-;; gnus-notifications.el -- Send notification on new message in Gnus
+;; gnus-notifications.el --- Notify of new Gnus messages -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
 
@@ -24,55 +24,54 @@
 
 ;; This implements notifications using `notifications-notify' on new
 ;; messages received.
-;; Use (add-hook 'gnus-after-getting-new-news-hook 'gnus-notifications)
+;; Use (add-hook 'gnus-after-getting-new-news-hook #'gnus-notifications)
 ;; to get notifications just after getting the new news.
 
 ;;; Code:
 
-(ignore-errors
-  (require 'notifications))
+(require 'notifications)
 (require 'gnus-sum)
 (require 'gnus-group)
 (require 'gnus-int)
 (require 'gnus-art)
 (require 'gnus-util)
-(ignore-errors
-  (require 'google-contacts))        ; Optional
 (require 'gnus-fun)
+(require 'image)
 
 (defgroup gnus-notifications nil
-  "Send notifications on new message in Gnus."
+  "Send notifications on new messages in Gnus."
   :version "24.3"
   :group 'gnus)
 
-(defcustom gnus-notifications-use-google-contacts t
-  "Use Google Contacts to retrieve photo."
+(defcustom gnus-notifications-use-google-contacts
+  (and (require 'google-contacts nil t) t)
+  "Whether to retrieve sender avatars from Google Contacts.
+This requires the external package `google-contacts'."
   :type 'boolean
-  :group 'gnus-notifications)
+  :version "27.1")
 
 (defcustom gnus-notifications-use-gravatar t
-  "Use Gravatar to retrieve photo."
-  :type 'boolean
-  :group 'gnus-notifications)
+  "Whether to retrieve sender avatars from Gravatar."
+  :type 'boolean)
 
 (defcustom gnus-notifications-minimum-level 1
   "Minimum group level the message should have to be notified.
 Any message in a group that has a greater value than this will
 not get notifications."
-  :type 'integer
-  :group 'gnus-notifications)
+  :type 'integer)
 
 (defcustom gnus-notifications-timeout nil
-  "Timeout used for notifications sent via `notifications-notify'."
+  "Timeout used for notifications sent via `notifications-notify'.
+Value is either a duration in milliseconds or nil, which means to
+use the notification server's default timeout."
   :type '(choice (const :tag "Server default" nil)
-                 (integer :tag "Milliseconds"))
-  :group 'gnus-notifications)
+                 (integer :tag "Milliseconds")))
 
 (defvar gnus-notifications-sent nil
-  "Notifications already sent.")
+  "Map group names to lists of sent notification IDs.")
 
 (defvar gnus-notifications-id-to-msg nil
-  "Map notifications ids to messages.")
+  "Map notification IDs to messages.")
 
 (defun gnus-notifications-action (id key)
   (let ((group-article (assoc id gnus-notifications-id-to-msg)))
@@ -90,57 +89,41 @@ gnus-notifications-action
                (gnus-group-update-group group)))))))
 
 (defun gnus-notifications-notify (from subject photo-file)
-  "Send a notification about a new mail.
-Return a notification id if any, or t on success."
-  (if (fboundp 'notifications-notify)
-      (gnus-funcall-no-warning
-       'notifications-notify
-       :title from
-       :body subject
-       :actions '("read" "Read" "mark-read" "Mark As Read")
-       :on-action 'gnus-notifications-action
-       :app-icon (gnus-funcall-no-warning
-                  'image-search-load-path "gnus/gnus.png")
-       :image-path photo-file
-       :app-name "Gnus"
-       :category "email.arrived"
-       :timeout gnus-notifications-timeout)
-    (message "New message from %s: %s" from subject)
-    ;; Don't return an id
-    t))
-
-(declare-function gravatar-retrieve-synchronously "gravatar.el"
-		  (mail-address))
+  "Send a notification about a new mail and return its ID."
+  (notifications-notify
+   :title from
+   :body subject
+   :actions '("read" "Read" "mark-read" "Mark As Read")
+   :on-action #'gnus-notifications-action
+   :app-icon (image-search-load-path "gnus/gnus.png")
+   :image-path photo-file
+   :app-name "Gnus"
+   :category "email.arrived"
+   :timeout gnus-notifications-timeout))
 
 (defun gnus-notifications-get-photo (mail-address)
-  "Get photo for mail address."
-  (let ((google-photo (when (and gnus-notifications-use-google-contacts
-                                 (fboundp 'google-contacts-get-photo))
-                        (ignore-errors
-                          (gnus-funcall-no-warning
-			   'google-contacts-get-photo mail-address)))))
-    (if google-photo
-        google-photo
-      (when gnus-notifications-use-gravatar
-        (let ((gravatar (ignore-errors
-                          (gravatar-retrieve-synchronously mail-address))))
-          (if (eq gravatar 'error)
-              nil
-            (plist-get (cdr gravatar) :data)))))))
+  "Return an avatar for MAIL-ADDRESS.
+Value is either a string of raw image data, or nil on failure."
+  (or (and gnus-notifications-use-google-contacts
+           (fboundp 'google-contacts-get-photo)
+           (ignore-errors
+             (google-contacts-get-photo mail-address)))
+      (let ((gravatar (and gnus-notifications-use-gravatar
+                           (ignore-errors
+                             (gravatar-retrieve-synchronously mail-address)))))
+        (and (eq (car-safe gravatar) 'image)
+             (image-property gravatar :data)))))
 
 (defun gnus-notifications-get-photo-file (mail-address)
-  "Get a temporary file with an image for MAIL-ADDRESS.
-You have to delete the temporary image yourself using
-`delete-image'.
+  "Return a temporary file name containing an image for MAIL-ADDRESS.
+Callers must themselves delete the file; it is not done
+automatically.
 
-Returns nil if no image found."
-  (let ((photo (gnus-notifications-get-photo mail-address)))
+Returns nil if no image is found."
+  (let ((photo (gnus-notifications-get-photo mail-address))
+        (coding-system-for-write 'binary))
     (when photo
-      (let ((photo-file (make-temp-file "gnus-notifications-photo-"))
-            (coding-system-for-write 'binary))
-        (with-temp-file photo-file
-          (insert photo))
-        photo-file))))
+      (make-temp-file "gnus-notifications-photo-" nil nil photo))))
 
 ;;;###autoload
 (defun gnus-notifications ()
@@ -151,53 +134,52 @@ gnus-notifications
 
 This is typically a function to add in
 `gnus-after-getting-new-news-hook'"
-  (dolist (entry gnus-newsrc-alist)
-    (let ((group (car entry)))
-      ;; Check that the group level is less than
-      ;; `gnus-notifications-minimum-level' and the group has unread
-      ;; messages.
-      (when (and (<= (gnus-group-level group) gnus-notifications-minimum-level)
-                 (let ((unread (gnus-group-unread group)))
-                   (and (numberp unread)
-                        (> unread 0))))
-        ;; Each group should have an entry in the `gnus-notifications-sent'
-        ;; alist. If not, we add one at this time.
-        (let ((group-notifications (or (assoc group gnus-notifications-sent)
-                                       ;; Nothing, add one and return it.
-                                       (assoc group
-                                              (add-to-list
-                                               'gnus-notifications-sent
-                                               (cons group nil))))))
-          (dolist (article (gnus-list-of-unread-articles group))
-            ;; Check if the article already has been notified
-            (unless (memq article (cdr group-notifications))
-              (with-current-buffer nntp-server-buffer
-                (gnus-request-head article group)
-                (article-decode-encoded-words) ; to decode mail addresses, subjects, etc
-                (let* ((address-components (mail-extract-address-components
-                                            (or (mail-fetch-field "From") "")))
-                       (address (cadr address-components)))
-                  ;; Ignore mails from ourselves
-                  (unless (and gnus-ignored-from-addresses
-                               address
-                               (cond ((functionp gnus-ignored-from-addresses)
-                                      (funcall gnus-ignored-from-addresses address))
-                                     (t (string-match-p
-					 (gnus-ignored-from-addresses)
-					 address))))
-                    (let* ((photo-file (gnus-notifications-get-photo-file address))
-                           (notification-id (gnus-notifications-notify
-                                             (or (car address-components) address)
-                                             (mail-fetch-field "Subject")
-                                             photo-file)))
-                      (when notification-id
-                        ;; Register that we did notify this message
-                        (setcdr group-notifications (cons article (cdr group-notifications)))
-                        (unless (eq notification-id t)
-                          ;; Register the notification id for later actions
-                          (add-to-list 'gnus-notifications-id-to-msg (list notification-id group article))))
-                      (when photo-file
-                        (delete-file photo-file)))))))))))))
+  (pcase-dolist (`(,group . ,_) gnus-newsrc-alist)
+    ;; Check that the group level is less than
+    ;; `gnus-notifications-minimum-level' and the group has unread
+    ;; messages.
+    (when (and (<= (gnus-group-level group) gnus-notifications-minimum-level)
+               (let ((unread (gnus-group-unread group)))
+                 (and (numberp unread)
+                      (> unread 0))))
+      ;; Each group should have an entry in the `gnus-notifications-sent'
+      ;; alist.  If not, we add one at this time.
+      (let ((group-notifications
+             (or (assoc group gnus-notifications-sent)
+                 ;; Nothing, add one and return it.
+                 (assoc group (push (list group) gnus-notifications-sent)))))
+        (dolist (article (gnus-list-of-unread-articles group))
+          ;; Check if the article has already been notified.
+          (unless (memq article (cdr group-notifications))
+            (with-current-buffer nntp-server-buffer
+              (gnus-request-head article group)
+              ;; To decode mail addresses, subjects, etc.
+              (article-decode-encoded-words)
+              (let* ((address-components
+                      (funcall gnus-extract-address-components
+                               (or (mail-fetch-field "From") "")))
+                     (address (cadr address-components)))
+                ;; Ignore mail from ourselves.
+                (unless (and gnus-ignored-from-addresses
+                             (> (length address) 0)
+                             (if (functionp gnus-ignored-from-addresses)
+                                 (funcall gnus-ignored-from-addresses address)
+                               (string-match-p (gnus-ignored-from-addresses)
+                                               address)))
+                  (let* ((photo-file (gnus-notifications-get-photo-file address))
+                         (notification-id (gnus-notifications-notify
+                                           (or (car address-components) address)
+                                           (mail-fetch-field "Subject")
+                                           photo-file)))
+                    (when notification-id
+                      ;; Register that we did notify this message.
+                      (push article (cdr group-notifications))
+                      ;; Register the notification ID for later actions.
+                      (setf (alist-get notification-id
+                                       gnus-notifications-id-to-msg)
+                            (list group article)))
+                    (when photo-file
+                      (delete-file photo-file))))))))))))
 
 (provide 'gnus-notifications)
 
-- 
2.20.1


[-- Attachment #3: Type: text/plain, Size: 20 bytes --]


Thanks,

-- 
Basil

^ permalink raw reply related	[flat|nested] 10+ messages in thread
end of thread, other threads:[~2019-07-21 17:21 UTC | newest]

Thread overview: 10+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2019-07-21  0:52 Proposed changes to gnus-notifications.el Basil L. Contovounesios
2019-07-21  8:01 ` Michael Albinus
2019-07-21  9:40   ` Basil L. Contovounesios
2019-07-21 10:40     ` Michael Albinus
2019-07-21 15:54       ` Basil L. Contovounesios
2019-07-21 17:16         ` Michael Albinus
2019-07-21 15:55       ` Error handling in notifications-notify (was: Proposed changes to gnus-notifications.el) Basil L. Contovounesios
2019-07-21 17:21         ` Error handling in notifications-notify Michael Albinus
2019-07-21 14:34     ` Proposed changes to gnus-notifications.el Eli Zaretskii
2019-07-21 13:44 ` Lars Ingebrigtsen

Code repositories for project(s) associated with this external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.