Re: Proposed changes to gnus-notifications.el

[Basil L. Contovounesios]

Michael Albinus <address@hidden> writes:

> "Basil L. Contovounesios" <address@hidden> writes:
>
>> Michael Albinus <address@hidden> writes:
>>
>>> The patch seems to assume that notifications-notify works
>>> everywhere. That's not the case, since it depends on D-Bus it runs only
>>> for GNU/Linux systems.
>>
>> Thank you for pointing this out.  I had wondered about it while
>> preparing the patch but could not find a description of what happens
>> when notifications are not supported, other than the usual
>> "notifications-notify returns an integer ID".
>>
>> Does notifications-notify return nil in this case?  If so, I would like
>> to document this.  If not, wouldn't this make sense?
>
> Likely yes. It uses with-demoted-errors, which should return nil
> indeed.

In that case I think the proposed patch already behaves as it should,
without changing existing behaviour.  See the last few lines of the
function gnus-notifications:

  (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)))
    ...)

gnus-notifications-notify just calls notifications-notify, and the
resulting ID is not assumed to be non-nil.  Is this acceptable?  Or did
you mean something else when you said the patch assumes too much about
notifications-notify?

Here's the patch again, with an updated docstring for
gnus-notifications-notify:

>From 81d1fda93f71152dd145500fefdfd0df1a40073f Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <address@hidden>
Date: Sat, 20 Jul 2019 23:37:29 +0100
Subject: [PATCH 1/3] Refactor gnus-notifications.el

For discussion, see the following thread:
https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00499.html
* 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 | 207 +++++++++++++++-----------------
 1 file changed, 95 insertions(+), 112 deletions(-)

diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index 3476164583..0dbbd9972e 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,42 @@ 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.
+Return nil on failure."
+  (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 +135,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

Thanks,

-- 
Basil