2021-04-19 12:21:01 +02:00
|
|
|
;;; gnus-notifications.el --- Send notification on new message in Gnus -*- lexical-binding: t; -*-
|
2012-08-29 22:04:05 +00:00
|
|
|
|
2022-01-01 02:45:51 -05:00
|
|
|
;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
|
2012-08-29 22:04:05 +00:00
|
|
|
|
|
|
|
|
;; Author: Julien Danjou <julien@danjou.info>
|
|
|
|
|
;; 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
|
2017-09-13 15:52:52 -07:00
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
2012-08-29 22:04:05 +00:00
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;; This implements notifications using `notifications-notify' on new
|
|
|
|
|
;; messages received.
|
2021-01-30 00:35:24 -05:00
|
|
|
;; Use (add-hook 'gnus-after-getting-new-news-hook #'gnus-notifications)
|
2012-08-29 22:04:05 +00:00
|
|
|
;; to get notifications just after getting the new news.
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
2012-09-03 22:12:02 +00:00
|
|
|
(ignore-errors
|
|
|
|
|
(require 'notifications))
|
2012-08-29 22:04:05 +00:00
|
|
|
(require 'gnus-sum)
|
|
|
|
|
(require 'gnus-group)
|
|
|
|
|
(require 'gnus-int)
|
|
|
|
|
(require 'gnus-art)
|
|
|
|
|
(require 'gnus-util)
|
2012-09-03 22:12:02 +00:00
|
|
|
(ignore-errors
|
|
|
|
|
(require 'google-contacts)) ; Optional
|
|
|
|
|
(require 'gnus-fun)
|
2012-08-29 22:04:05 +00:00
|
|
|
|
|
|
|
|
(defgroup gnus-notifications nil
|
|
|
|
|
"Send notifications on new message in Gnus."
|
2012-10-06 13:30:26 -07:00
|
|
|
:version "24.3"
|
2012-08-29 22:04:05 +00:00
|
|
|
:group 'gnus)
|
|
|
|
|
|
|
|
|
|
(defcustom gnus-notifications-use-google-contacts t
|
|
|
|
|
"Use Google Contacts to retrieve photo."
|
2021-01-30 14:27:40 -05:00
|
|
|
:type 'boolean)
|
2012-08-29 22:04:05 +00:00
|
|
|
|
|
|
|
|
(defcustom gnus-notifications-use-gravatar t
|
|
|
|
|
"Use Gravatar to retrieve photo."
|
2021-01-30 14:27:40 -05:00
|
|
|
:type 'boolean)
|
2012-08-29 22:04:05 +00:00
|
|
|
|
|
|
|
|
(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."
|
2021-01-30 14:27:40 -05:00
|
|
|
:type 'integer)
|
2012-08-29 22:04:05 +00:00
|
|
|
|
2012-08-30 22:14:27 +00:00
|
|
|
(defcustom gnus-notifications-timeout nil
|
|
|
|
|
"Timeout used for notifications sent via `notifications-notify'."
|
2013-05-08 21:40:20 -04:00
|
|
|
:type '(choice (const :tag "Server default" nil)
|
2021-01-30 14:27:40 -05:00
|
|
|
(integer :tag "Milliseconds")))
|
2012-08-30 22:14:27 +00:00
|
|
|
|
2012-08-29 22:04:05 +00:00
|
|
|
(defvar gnus-notifications-sent nil
|
|
|
|
|
"Notifications already sent.")
|
|
|
|
|
|
2012-08-30 22:14:27 +00:00
|
|
|
(defvar gnus-notifications-id-to-msg nil
|
|
|
|
|
"Map notifications ids to messages.")
|
|
|
|
|
|
|
|
|
|
(defun gnus-notifications-action (id key)
|
2015-03-08 10:10:37 +00:00
|
|
|
(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))
|
2016-02-11 16:39:23 +11:00
|
|
|
(select-frame-set-input-focus (selected-frame)))
|
2015-03-08 10:10:37 +00:00
|
|
|
((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)))))))
|
2012-08-30 22:14:27 +00:00
|
|
|
|
2012-08-29 22:04:05 +00:00
|
|
|
(defun gnus-notifications-notify (from subject photo-file)
|
2012-08-30 22:14:27 +00:00
|
|
|
"Send a notification about a new mail.
|
|
|
|
|
Return a notification id if any, or t on success."
|
2012-08-29 22:04:05 +00:00
|
|
|
(if (fboundp 'notifications-notify)
|
2012-09-03 22:12:02 +00:00
|
|
|
(gnus-funcall-no-warning
|
|
|
|
|
'notifications-notify
|
2012-08-29 22:04:05 +00:00
|
|
|
:title from
|
|
|
|
|
:body subject
|
2015-03-08 10:10:37 +00:00
|
|
|
:actions '("read" "Read" "mark-read" "Mark As Read")
|
2012-08-30 22:14:27 +00:00
|
|
|
:on-action 'gnus-notifications-action
|
2014-11-13 22:11:48 +00:00
|
|
|
:app-icon (gnus-funcall-no-warning
|
|
|
|
|
'image-search-load-path "gnus/gnus.png")
|
|
|
|
|
:image-path photo-file
|
2012-08-29 22:04:05 +00:00
|
|
|
:app-name "Gnus"
|
|
|
|
|
:category "email.arrived"
|
2013-05-16 22:31:47 +00:00
|
|
|
:timeout gnus-notifications-timeout)
|
2012-08-30 22:14:27 +00:00
|
|
|
(message "New message from %s: %s" from subject)
|
|
|
|
|
;; Don't return an id
|
|
|
|
|
t))
|
2012-08-29 22:04:05 +00:00
|
|
|
|
2014-03-23 23:13:36 +00:00
|
|
|
(declare-function gravatar-retrieve-synchronously "gravatar.el"
|
|
|
|
|
(mail-address))
|
|
|
|
|
|
2012-08-29 22:04:05 +00:00
|
|
|
(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
|
2012-09-03 22:12:02 +00:00
|
|
|
(gnus-funcall-no-warning
|
|
|
|
|
'google-contacts-get-photo mail-address)))))
|
2012-08-29 22:04:05 +00:00
|
|
|
(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)))))))
|
|
|
|
|
|
|
|
|
|
(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'.
|
|
|
|
|
|
|
|
|
|
Returns nil if no image found."
|
|
|
|
|
(let ((photo (gnus-notifications-get-photo mail-address)))
|
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
;;;###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'"
|
|
|
|
|
(dolist (entry gnus-newsrc-alist)
|
|
|
|
|
(let ((group (car entry)))
|
|
|
|
|
;; Check that the group level is less than
|
2017-10-27 20:04:47 -04:00
|
|
|
;; `gnus-notifications-minimum-level' and the group has unread
|
2012-08-29 22:04:05 +00:00
|
|
|
;; 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") "")))
|
2012-08-30 22:14:27 +00:00
|
|
|
(address (cadr address-components)))
|
|
|
|
|
;; Ignore mails from ourselves
|
2012-09-11 10:08:59 +00:00
|
|
|
(unless (and gnus-ignored-from-addresses
|
|
|
|
|
address
|
2016-02-08 13:28:37 +11:00
|
|
|
(cond ((functionp gnus-ignored-from-addresses)
|
|
|
|
|
(funcall gnus-ignored-from-addresses address))
|
2016-02-13 17:40:34 +11:00
|
|
|
(t (string-match-p
|
|
|
|
|
(gnus-ignored-from-addresses)
|
|
|
|
|
address))))
|
2012-08-30 22:14:27 +00:00
|
|
|
(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)))))))))))))
|
2012-08-29 22:04:05 +00:00
|
|
|
|
|
|
|
|
(provide 'gnus-notifications)
|
|
|
|
|
|
|
|
|
|
;;; gnus-notifications.el ends here
|
