1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
| | ;;; gnus-notifications.el --- Notify of new Gnus messages -*- lexical-binding: t -*-
;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
;; 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
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; 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.
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)
"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
|