;; gnus-notifications.el --- Notify of new Gnus messages -*- lexical-binding: t -*- ;; Copyright (C) 2012-2019 Free Software Foundation, Inc. ;; Author: Julien Danjou ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This implements notifications using `notifications-notify' on new ;; messages received. ;; Use (add-hook 'gnus-after-getting-new-news-hook #'gnus-notifications) ;; to get notifications just after getting the new news. ;;; Code: (require 'notifications) (require 'gnus-sum) (require 'gnus-group) (require 'gnus-int) (require 'gnus-art) (require 'gnus-util) (require 'gnus-fun) (require 'image) (defgroup gnus-notifications nil "Send notifications on new messages in Gnus." :version "24.3" :group 'gnus) (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 :version "27.1") (defcustom gnus-notifications-use-gravatar t "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) (defcustom gnus-notifications-timeout nil "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"))) (defvar gnus-notifications-sent nil "Map group names to lists of sent notification IDs.") (defvar gnus-notifications-id-to-msg nil "Map notification IDs to messages.") (defun gnus-notifications-action (id key) (let ((group-article (assoc id gnus-notifications-id-to-msg))) (when group-article (let ((group (cadr group-article)) (article (nth 2 group-article))) (cond ((string= key "read") (gnus-fetch-group group (list article)) (select-frame-set-input-focus (selected-frame))) ((string= key "mark-read") (gnus-update-read-articles group (delq article (gnus-list-of-unread-articles group))) ;; gnus-group-refresh-group (gnus-group-update-group group))))))) (defun gnus-notifications-notify (from subject photo-file) "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) "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) "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 is found." (let ((photo (gnus-notifications-get-photo mail-address)) (coding-system-for-write 'binary)) (when photo (make-temp-file "gnus-notifications-photo-" nil nil photo)))) ;;;###autoload (defun gnus-notifications () "Send a notification on new message. This check for new messages that are in group with a level lower or equal to `gnus-notifications-minimum-level' and send a notification using `notifications-notify' for it. This is typically a function to add in `gnus-after-getting-new-news-hook'" (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) ;;; gnus-notifications.el ends here