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: Proposed changes to gnus-notifications.el Date: Sun, 21 Jul 2019 01:52:31 +0100 Message-ID: <87y30s5hv4.fsf@tcd.ie> 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="211406"; 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 To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Jul 21 02:52:58 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 1hp05x-000stN-Jw for ged-emacs-devel@m.gmane.org; Sun, 21 Jul 2019 02:52:57 +0200 Original-Received: from localhost ([::1]:54082 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hp05v-0000P6-RW for ged-emacs-devel@m.gmane.org; Sat, 20 Jul 2019 20:52:55 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:48464) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hp05k-0000Az-O7 for emacs-devel@gnu.org; Sat, 20 Jul 2019 20:52:46 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hp05i-0003xQ-Ug for emacs-devel@gnu.org; Sat, 20 Jul 2019 20:52:44 -0400 Original-Received: from mail-wm1-x344.google.com ([2a00:1450:4864:20::344]:55478) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hp05h-0003ux-7K for emacs-devel@gnu.org; Sat, 20 Jul 2019 20:52:42 -0400 Original-Received: by mail-wm1-x344.google.com with SMTP id a15so31872452wmj.5 for ; Sat, 20 Jul 2019 17:52:40 -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:date:message-id:user-agent:mime-version; bh=d34FtKur/i8xzlOlT0fG+txX7NwAth7CZm8n8FbdyjA=; b=XXx4yRQRSs1BR+cB1s7a/QQ936kfPcKd45QTD0ehLEAvH9WpoMBCW4aWsQMv4au+W9 ivZssL8MyXQRzwf5e8kTzJvEf/WucIc6M5AmpNgfxMJ7v5I3rS4T8pnXM5TaE0fDduQg G5P1mZWx70qH0rgEzueQCP9B5z2VCCWDzdNBpaU0wAHWvLCJrlvXv98Y2RhSGJVuIIv6 jnJVsqmzizCIQ33gUHXe77Ita4fE1uYEfiU0luZTeI+gPOeypWoKbxn80XhVkEgtZxcp 5ADZixlueghj7PalH5031oFp1ScL2XhLMBh9+qZKmecW3GlLK0Y2cyxkXdezGk/hvabc fx0Q== 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:date:message-id:user-agent :mime-version; bh=d34FtKur/i8xzlOlT0fG+txX7NwAth7CZm8n8FbdyjA=; b=gxXLUL15ME7dOFAAYP5mVl0oU910kSApulKdD5ltyuOl75UEm4Gr6KYOVdxCeefVaD raiKJfBP7PJrG2inRMQGbVNQEjPgYfvOar/YA997cM+sRKkwCv14NI/Jc1HDgykqIiC4 pZp1jpN08sxjLPHcAcR/FUHP/WjRXiTSIUDIuPU/Pb3nLGLgo9uGxNvpJPTr7HOSLZyd Hel6z5NoJX8f5ioRIRonhZhdDBSyJaHLoRWDsyC2HyG4SPycFqF+enaoCJfyiZmcJ10F 6ETGqPoKjVHp2OVINhBYw0xljqx/QqBzz22Zo+do9vh7oYfSdRw9W0EM1y5ZMmSg8GT/ PzEg== X-Gm-Message-State: APjAAAVybieTENf86Dm7M/pjlQfE4OqXScaf0Sz+EvuBCUmgnA0gqAfx ZUbTX66hQ8kpRvQmtF4LrVguTdjjGYk= X-Google-Smtp-Source: APXvYqzzXiGo6QLSUegBcxOOXVpQnXihQjs7+m5hTneId39b6hgXJEBQlKcstnlZPmLWf094vvFFYg== X-Received: by 2002:a1c:7c11:: with SMTP id x17mr51529548wmc.22.1563670359110; Sat, 20 Jul 2019 17:52:39 -0700 (PDT) Original-Received: from localhost ([2a02:8084:20e2:c380:92bd:1bfd:38fc:fae2]) by smtp.gmail.com with ESMTPSA id d10sm42195882wro.18.2019.07.20.17.52.37 (version=TLS1_3 cipher=AEAD-AES256-GCM-SHA384 bits=256/256); Sat, 20 Jul 2019 17:52:37 -0700 (PDT) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:4864:20::344 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:238755 Archived-At: --=-=-= Content-Type: text/plain The following patch for gnus-notifications.el enables lexical-binding and simplifies and clarifies some of the code and docs. WDYT? --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Refactor-gnus-notifications.el.patch >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 --=-=-= Content-Type: text/plain Thanks, -- Basil --=-=-=--