Update copyright year to 2016
[gnus] / lisp / gnus-notifications.el
1 ;; gnus-notifications.el -- Send notification on new message in Gnus
2
3 ;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
4
5 ;; Author: Julien Danjou <julien@danjou.info>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24
25 ;; This implements notifications using `notifications-notify' on new
26 ;; messages received.
27 ;; Use (add-hook 'gnus-after-getting-new-news-hook 'gnus-notifications)
28 ;; to get notifications just after getting the new news.
29
30 ;;; Code:
31
32 (ignore-errors
33   (require 'notifications))
34 (require 'gnus-sum)
35 (require 'gnus-group)
36 (require 'gnus-int)
37 (require 'gnus-art)
38 (require 'gnus-util)
39 (ignore-errors
40   (require 'google-contacts))        ; Optional
41 (require 'gnus-fun)
42
43 (defgroup gnus-notifications nil
44   "Send notifications on new message in Gnus."
45   :version "24.3"
46   :group 'gnus)
47
48 (defcustom gnus-notifications-use-google-contacts t
49   "Use Google Contacts to retrieve photo."
50   :type 'boolean
51   :group 'gnus-notifications)
52
53 (defcustom gnus-notifications-use-gravatar t
54   "Use Gravatar to retrieve photo."
55   :type 'boolean
56   :group 'gnus-notifications)
57
58 (defcustom gnus-notifications-minimum-level 1
59   "Minimum group level the message should have to be notified.
60 Any message in a group that has a greater value than this will
61 not get notifications."
62   :type 'integer
63   :group 'gnus-notifications)
64
65 (defcustom gnus-notifications-timeout nil
66   "Timeout used for notifications sent via `notifications-notify'."
67   :type '(choice (const :tag "Server default" nil)
68                  (integer :tag "Milliseconds"))
69   :group 'gnus-notifications)
70
71 (defvar gnus-notifications-sent nil
72   "Notifications already sent.")
73
74 (defvar gnus-notifications-id-to-msg nil
75   "Map notifications ids to messages.")
76
77 (defun gnus-notifications-action (id key)
78   (let ((group-article (assoc id gnus-notifications-id-to-msg)))
79     (when group-article
80       (let ((group (cadr group-article))
81             (article (nth 2 group-article)))
82         (cond ((string= key "read")
83                (gnus-fetch-group group (list article))
84                (gnus-select-frame-set-input-focus (selected-frame)))
85               ((string= key "mark-read")
86                (gnus-update-read-articles
87                 group
88                 (delq article (gnus-list-of-unread-articles group)))
89                ;; gnus-group-refresh-group
90                (gnus-group-update-group group)))))))
91
92 (defun gnus-notifications-notify (from subject photo-file)
93   "Send a notification about a new mail.
94 Return a notification id if any, or t on success."
95   (if (fboundp 'notifications-notify)
96       (gnus-funcall-no-warning
97        'notifications-notify
98        :title from
99        :body subject
100        :actions '("read" "Read" "mark-read" "Mark As Read")
101        :on-action 'gnus-notifications-action
102        :app-icon (gnus-funcall-no-warning
103                   'image-search-load-path "gnus/gnus.png")
104        :image-path photo-file
105        :app-name "Gnus"
106        :category "email.arrived"
107        :timeout gnus-notifications-timeout)
108     (message "New message from %s: %s" from subject)
109     ;; Don't return an id
110     t))
111
112 (declare-function gravatar-retrieve-synchronously "gravatar.el"
113                   (mail-address))
114
115 (defun gnus-notifications-get-photo (mail-address)
116   "Get photo for mail address."
117   (let ((google-photo (when (and gnus-notifications-use-google-contacts
118                                  (fboundp 'google-contacts-get-photo))
119                         (ignore-errors
120                           (gnus-funcall-no-warning
121                            'google-contacts-get-photo mail-address)))))
122     (if google-photo
123         google-photo
124       (when gnus-notifications-use-gravatar
125         (let ((gravatar (ignore-errors
126                           (gravatar-retrieve-synchronously mail-address))))
127           (if (eq gravatar 'error)
128               nil
129             (plist-get (cdr gravatar) :data)))))))
130
131 (defun gnus-notifications-get-photo-file (mail-address)
132   "Get a temporary file with an image for MAIL-ADDRESS.
133 You have to delete the temporary image yourself using
134 `delete-image'.
135
136 Returns nil if no image found."
137   (let ((photo (gnus-notifications-get-photo mail-address)))
138     (when photo
139       (let ((photo-file (make-temp-file "gnus-notifications-photo-"))
140             (coding-system-for-write 'binary))
141         (with-temp-file photo-file
142           (insert photo))
143         photo-file))))
144
145 ;;;###autoload
146 (defun gnus-notifications ()
147   "Send a notification on new message.
148 This check for new messages that are in group with a level lower
149 or equal to `gnus-notifications-minimum-level' and send a
150 notification using `notifications-notify' for it.
151
152 This is typically a function to add in
153 `gnus-after-getting-new-news-hook'"
154   (dolist (entry gnus-newsrc-alist)
155     (let ((group (car entry)))
156       ;; Check that the group level is less than
157       ;; `gnus-notifications-minimum-level' and the the group has unread
158       ;; messages.
159       (when (and (<= (gnus-group-level group) gnus-notifications-minimum-level)
160                  (let ((unread (gnus-group-unread group)))
161                    (and (numberp unread)
162                         (> unread 0))))
163         ;; Each group should have an entry in the `gnus-notifications-sent'
164         ;; alist. If not, we add one at this time.
165         (let ((group-notifications (or (assoc group gnus-notifications-sent)
166                                        ;; Nothing, add one and return it.
167                                        (assoc group
168                                               (add-to-list
169                                                'gnus-notifications-sent
170                                                (cons group nil))))))
171           (dolist (article (gnus-list-of-unread-articles group))
172             ;; Check if the article already has been notified
173             (unless (memq article (cdr group-notifications))
174               (with-current-buffer nntp-server-buffer
175                 (gnus-request-head article group)
176                 (article-decode-encoded-words) ; to decode mail addresses, subjects, etc
177                 (let* ((address-components (mail-extract-address-components
178                                             (or (mail-fetch-field "From") "")))
179                        (address (cadr address-components)))
180                   ;; Ignore mails from ourselves
181                   (unless (and gnus-ignored-from-addresses
182                                address
183                                (gnus-string-match-p gnus-ignored-from-addresses
184                                                     address))
185                     (let* ((photo-file (gnus-notifications-get-photo-file address))
186                            (notification-id (gnus-notifications-notify
187                                              (or (car address-components) address)
188                                              (mail-fetch-field "Subject")
189                                              photo-file)))
190                       (when notification-id
191                         ;; Register that we did notify this message
192                         (setcdr group-notifications (cons article (cdr group-notifications)))
193                         (unless (eq notification-id t)
194                           ;; Register the notification id for later actions
195                           (add-to-list 'gnus-notifications-id-to-msg (list notification-id group article))))
196                       (when photo-file
197                         (delete-file photo-file)))))))))))))
198
199 (provide 'gnus-notifications)
200
201 ;;; gnus-notifications.el ends here