From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: "Basil L. Contovounesios" Newsgroups: gmane.emacs.devel Subject: Re: Proposed changes to gnus-notifications.el Date: Sun, 21 Jul 2019 16:54:26 +0100 Message-ID: <87imrvjsct.fsf@tcd.ie> References: <87y30s5hv4.fsf@tcd.ie> <87blxnke8f.fsf@gmx.de> <87wogbraj0.fsf@tcd.ie> <87wogbisby.fsf@gmx.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="203583"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: Julien Danjou , Lars Ingebrigtsen , emacs-devel@gnu.org To: Michael Albinus Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Jul 21 17:54:40 2019 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1hpEAa-000qq1-BJ for ged-emacs-devel@m.gmane.org; Sun, 21 Jul 2019 17:54:40 +0200 Original-Received: from localhost ([::1]:56558 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hpEAY-0002zg-VV for ged-emacs-devel@m.gmane.org; Sun, 21 Jul 2019 11:54:38 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:54289) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hpEAU-0002y5-1C for emacs-devel@gnu.org; Sun, 21 Jul 2019 11:54:36 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hpEAR-0005Fb-KZ for emacs-devel@gnu.org; Sun, 21 Jul 2019 11:54:33 -0400 Original-Received: from mail-wr1-x442.google.com ([2a00:1450:4864:20::442]:40330) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hpEAR-0005F3-2a for emacs-devel@gnu.org; Sun, 21 Jul 2019 11:54:31 -0400 Original-Received: by mail-wr1-x442.google.com with SMTP id r1so36848292wrl.7 for ; Sun, 21 Jul 2019 08:54:30 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tcd-ie.20150623.gappssmtp.com; s=20150623; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=SdNSZw/rpScYkUCz/PjjOVdYhlJI3dOpJYqx0WK2ook=; b=bX3J1kMGT1PQc4ZVtIBkjHhtV//jdWC9rA+qNcJasLcKghrQvnngRdwSdnpIUw1+ez 4sS5mtHtzVwA+paFiQMynwB4BM7gazQmSXHRJdovwALcC9xRK/LWl2UQCYy3k4OZbxCM fppmrY2DOa760T+eVxoXKwpz+jYv68jpbdH9Hm29rTOMTqKTLk2ZCq3qeDo/CdISrcPO a4yJDiWV1pE7D/rpc8h6c3QgmrmoJt24QkM7+za7JsEIofbjCdNQQF9OUIF/A16wsHRb msRqavYOwxM9ZGre0X2I17PJUuvM4IOgAS0PViNNiDvuugG7RlvbrStlAMSIu7ibmdiK YyxQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=SdNSZw/rpScYkUCz/PjjOVdYhlJI3dOpJYqx0WK2ook=; b=Wfk7d5odpEJCN/oofx71zx95u9VYGULWHuBrgS1YTRTWt61qH6mmpFY7aol9okKDR/ Eb9qiRESHAUzqAIx83E5ftD+SQ/YpeBb4xwSaHfQ58wfKKA9CakxiecKd2xsi+t2KNmK Akunn99JMuDU3BXvsOOISwv2DV/6QCVwGzbaHqGebbBJtzNy7fur1rDGx7EfxssnixrS Xbv1qodmSKRqJwA9J661B4b+5ByVTKgH7Guks3DHp8t1j6ua2/RGiPPkwXpVF7wp0iEg wVanNNAdoqG6+jIQejdmT6gp3hhMiWmizMsXmoqEurSgeRL53TT1tmWh2+PXW17ot7lM apmA== X-Gm-Message-State: APjAAAUFWX2YgmTiNg7BTVEMNL2a7VuWfY4DPchRNPMMXmOSY/meLjI4 MlITDhh6jjk/x5LeEG1D5VD+og== X-Google-Smtp-Source: APXvYqw/4/XRASeJAyWuJC6d7yvGW82eh15v5qIfaEz91XTRVIYwASeUU34HZtW0J0WEA+fxrKQP5Q== X-Received: by 2002:a5d:55c2:: with SMTP id i2mr32933930wrw.96.1563724469211; Sun, 21 Jul 2019 08:54:29 -0700 (PDT) Original-Received: from localhost ([2a02:8084:20e2:c380:92bd:1bfd:38fc:fae2]) by smtp.gmail.com with ESMTPSA id x6sm38379247wrt.63.2019.07.21.08.54.27 (version=TLS1_3 cipher=AEAD-AES256-GCM-SHA384 bits=256/256); Sun, 21 Jul 2019 08:54:28 -0700 (PDT) In-Reply-To: <87wogbisby.fsf@gmx.de> (Michael Albinus's message of "Sun, 21 Jul 2019 12:40:17 +0200") X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:4864:20::442 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:238770 Archived-At: --=-=-= Content-Type: text/plain Michael Albinus writes: > "Basil L. Contovounesios" writes: > >> Michael Albinus 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: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Refactor-gnus-notifications.el.patch >From 81d1fda93f71152dd145500fefdfd0df1a40073f Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" 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 --=-=-= Content-Type: text/plain Thanks, -- Basil --=-=-=--