Commit | Line | Data |
---|---|---|
96656012 JD |
1 | ;; gnus-notifications.el -- Send notification on new message in Gnus |
2 | ||
ab422c4d | 3 | ;; Copyright (C) 2012-2013 Free Software Foundation, Inc. |
96656012 JD |
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 | ||
8a8507e9 LI |
32 | (ignore-errors |
33 | (require 'notifications)) | |
96656012 JD |
34 | (require 'gnus-sum) |
35 | (require 'gnus-group) | |
36 | (require 'gnus-int) | |
37 | (require 'gnus-art) | |
38 | (require 'gnus-util) | |
8a8507e9 LI |
39 | (ignore-errors |
40 | (require 'google-contacts)) ; Optional | |
41 | (require 'gnus-fun) | |
96656012 JD |
42 | |
43 | (defgroup gnus-notifications nil | |
44 | "Send notifications on new message in Gnus." | |
d1a1c7e6 | 45 | :version "24.3" |
96656012 JD |
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 | ||
ba7ac1f6 JD |
65 | (defcustom gnus-notifications-timeout nil |
66 | "Timeout used for notifications sent via `notifications-notify'." | |
a931698a GM |
67 | :type '(choice (const :tag "Server default" nil) |
68 | (integer :tag "Milliseconds")) | |
ba7ac1f6 JD |
69 | :group 'gnus-notifications) |
70 | ||
96656012 JD |
71 | (defvar gnus-notifications-sent nil |
72 | "Notifications already sent.") | |
73 | ||
ba7ac1f6 JD |
74 | (defvar gnus-notifications-id-to-msg nil |
75 | "Map notifications ids to messages.") | |
76 | ||
77 | (defun gnus-notifications-action (id key) | |
78 | (when (string= key "read") | |
79 | (let ((group-article (assoc id gnus-notifications-id-to-msg))) | |
80 | (when group-article | |
81 | (let ((group (cadr group-article)) | |
e1991423 | 82 | (article (nth 2 group-article))) |
ba7ac1f6 JD |
83 | (gnus-fetch-group group (list article))))))) |
84 | ||
96656012 | 85 | (defun gnus-notifications-notify (from subject photo-file) |
ba7ac1f6 JD |
86 | "Send a notification about a new mail. |
87 | Return a notification id if any, or t on success." | |
96656012 | 88 | (if (fboundp 'notifications-notify) |
8a8507e9 LI |
89 | (gnus-funcall-no-warning |
90 | 'notifications-notify | |
96656012 JD |
91 | :title from |
92 | :body subject | |
ba7ac1f6 JD |
93 | :actions '("read" "Read") |
94 | :on-action 'gnus-notifications-action | |
8a8507e9 LI |
95 | :app-icon (gnus-funcall-no-warning |
96 | 'image-search-load-path "gnus/gnus.png") | |
96656012 JD |
97 | :app-name "Gnus" |
98 | :category "email.arrived" | |
ba7ac1f6 | 99 | :timeout gnus-notifications-timeout |
96656012 | 100 | :image-path photo-file) |
ba7ac1f6 JD |
101 | (message "New message from %s: %s" from subject) |
102 | ;; Don't return an id | |
103 | t)) | |
96656012 JD |
104 | |
105 | (defun gnus-notifications-get-photo (mail-address) | |
106 | "Get photo for mail address." | |
107 | (let ((google-photo (when (and gnus-notifications-use-google-contacts | |
108 | (fboundp 'google-contacts-get-photo)) | |
109 | (ignore-errors | |
8a8507e9 LI |
110 | (gnus-funcall-no-warning |
111 | 'google-contacts-get-photo mail-address))))) | |
96656012 JD |
112 | (if google-photo |
113 | google-photo | |
114 | (when gnus-notifications-use-gravatar | |
115 | (let ((gravatar (ignore-errors | |
116 | (gravatar-retrieve-synchronously mail-address)))) | |
117 | (if (eq gravatar 'error) | |
118 | nil | |
119 | (plist-get (cdr gravatar) :data))))))) | |
120 | ||
121 | (defun gnus-notifications-get-photo-file (mail-address) | |
122 | "Get a temporary file with an image for MAIL-ADDRESS. | |
123 | You have to delete the temporary image yourself using | |
124 | `delete-image'. | |
125 | ||
126 | Returns nil if no image found." | |
127 | (let ((photo (gnus-notifications-get-photo mail-address))) | |
128 | (when photo | |
129 | (let ((photo-file (make-temp-file "gnus-notifications-photo-")) | |
130 | (coding-system-for-write 'binary)) | |
131 | (with-temp-file photo-file | |
132 | (insert photo)) | |
133 | photo-file)))) | |
134 | ||
135 | ;;;###autoload | |
136 | (defun gnus-notifications () | |
137 | "Send a notification on new message. | |
138 | This check for new messages that are in group with a level lower | |
139 | or equal to `gnus-notifications-minimum-level' and send a | |
140 | notification using `notifications-notify' for it. | |
141 | ||
142 | This is typically a function to add in | |
143 | `gnus-after-getting-new-news-hook'" | |
144 | (dolist (entry gnus-newsrc-alist) | |
145 | (let ((group (car entry))) | |
146 | ;; Check that the group level is less than | |
147 | ;; `gnus-notifications-minimum-level' and the the group has unread | |
148 | ;; messages. | |
149 | (when (and (<= (gnus-group-level group) gnus-notifications-minimum-level) | |
150 | (let ((unread (gnus-group-unread group))) | |
151 | (and (numberp unread) | |
152 | (> unread 0)))) | |
153 | ;; Each group should have an entry in the `gnus-notifications-sent' | |
154 | ;; alist. If not, we add one at this time. | |
155 | (let ((group-notifications (or (assoc group gnus-notifications-sent) | |
156 | ;; Nothing, add one and return it. | |
157 | (assoc group | |
158 | (add-to-list | |
159 | 'gnus-notifications-sent | |
160 | (cons group nil)))))) | |
161 | (dolist (article (gnus-list-of-unread-articles group)) | |
162 | ;; Check if the article already has been notified | |
163 | (unless (memq article (cdr group-notifications)) | |
164 | (with-current-buffer nntp-server-buffer | |
165 | (gnus-request-head article group) | |
166 | (article-decode-encoded-words) ; to decode mail addresses, subjects, etc | |
167 | (let* ((address-components (mail-extract-address-components | |
168 | (or (mail-fetch-field "From") ""))) | |
ba7ac1f6 JD |
169 | (address (cadr address-components))) |
170 | ;; Ignore mails from ourselves | |
95729d50 JD |
171 | (unless (and gnus-ignored-from-addresses |
172 | address | |
173 | (gnus-string-match-p gnus-ignored-from-addresses | |
174 | address)) | |
ba7ac1f6 JD |
175 | (let* ((photo-file (gnus-notifications-get-photo-file address)) |
176 | (notification-id (gnus-notifications-notify | |
177 | (or (car address-components) address) | |
178 | (mail-fetch-field "Subject") | |
179 | photo-file))) | |
180 | (when notification-id | |
181 | ;; Register that we did notify this message | |
182 | (setcdr group-notifications (cons article (cdr group-notifications))) | |
183 | (unless (eq notification-id t) | |
184 | ;; Register the notification id for later actions | |
185 | (add-to-list 'gnus-notifications-id-to-msg (list notification-id group article)))) | |
186 | (when photo-file | |
187 | (delete-file photo-file))))))))))))) | |
96656012 JD |
188 | |
189 | (provide 'gnus-notifications) | |
190 | ||
191 | ;;; gnus-notifications.el ends here |