From: "Basil L. Contovounesios" <contovob@tcd.ie>
To: emacs-devel@gnu.org
Cc: Julien Danjou <julien@danjou.info>, Lars Ingebrigtsen <larsi@gnus.org>
Subject: Proposed changes to gnus-notifications.el
Date: Sun, 21 Jul 2019 01:52:31 +0100 [thread overview]
Message-ID: <87y30s5hv4.fsf@tcd.ie> (raw)
[-- 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
next reply other threads:[~2019-07-21 0:52 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-07-21 0:52 Basil L. Contovounesios [this message]
2019-07-21 8:01 ` Proposed changes to gnus-notifications.el 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
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87y30s5hv4.fsf@tcd.ie \
--to=contovob@tcd.ie \
--cc=emacs-devel@gnu.org \
--cc=julien@danjou.info \
--cc=larsi@gnus.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 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.