From 40e0cf058674d0791b5f8110aba8d9171d640c14 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" 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