1 ;; gnus-notifications.el -- Send notification on new message in Gnus
3 ;; Copyright (C) 2012 Free Software Foundation, Inc.
5 ;; Author: Julien Danjou <julien@danjou.info>
8 ;; This file is part of GNU Emacs.
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.
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.
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/>.
25 ;; This implements notifications using `notifications-notify' on new
27 ;; Use (add-hook 'gnus-after-getting-new-news-hook 'gnus-notifications)
28 ;; to get notifications just after getting the new news.
32 (require 'notifications nil t)
38 (require 'google-contacts nil t) ; Optional
40 (defgroup gnus-notifications nil
41 "Send notifications on new message in Gnus."
44 (defcustom gnus-notifications-use-google-contacts t
45 "Use Google Contacts to retrieve photo."
47 :group 'gnus-notifications)
49 (defcustom gnus-notifications-use-gravatar t
50 "Use Gravatar to retrieve photo."
52 :group 'gnus-notifications)
54 (defcustom gnus-notifications-minimum-level 1
55 "Minimum group level the message should have to be notified.
56 Any message in a group that has a greater value than this will
57 not get notifications."
59 :group 'gnus-notifications)
61 (defcustom gnus-notifications-timeout nil
62 "Timeout used for notifications sent via `notifications-notify'."
64 :group 'gnus-notifications)
66 (defvar gnus-notifications-sent nil
67 "Notifications already sent.")
69 (defun gnus-notifications-notify (from subject photo-file)
70 "Send a notification about a new mail."
71 (if (fboundp 'notifications-notify)
75 :app-icon (image-search-load-path "gnus/gnus.png")
77 :category "email.arrived"
78 :timeout gnus-notifications-timeout
79 :image-path photo-file)
80 (message "New message from %s: %s" from subject)))
82 (defun gnus-notifications-get-photo (mail-address)
83 "Get photo for mail address."
84 (let ((google-photo (when (and gnus-notifications-use-google-contacts
85 (fboundp 'google-contacts-get-photo))
87 (google-contacts-get-photo mail-address)))))
90 (when gnus-notifications-use-gravatar
91 (let ((gravatar (ignore-errors
92 (gravatar-retrieve-synchronously mail-address))))
93 (if (eq gravatar 'error)
95 (plist-get (cdr gravatar) :data)))))))
97 (defun gnus-notifications-get-photo-file (mail-address)
98 "Get a temporary file with an image for MAIL-ADDRESS.
99 You have to delete the temporary image yourself using
102 Returns nil if no image found."
103 (let ((photo (gnus-notifications-get-photo mail-address)))
105 (let ((photo-file (make-temp-file "gnus-notifications-photo-"))
106 (coding-system-for-write 'binary))
107 (with-temp-file photo-file
112 (defun gnus-notifications ()
113 "Send a notification on new message.
114 This check for new messages that are in group with a level lower
115 or equal to `gnus-notifications-minimum-level' and send a
116 notification using `notifications-notify' for it.
118 This is typically a function to add in
119 `gnus-after-getting-new-news-hook'"
120 (dolist (entry gnus-newsrc-alist)
121 (let ((group (car entry)))
122 ;; Check that the group level is less than
123 ;; `gnus-notifications-minimum-level' and the the group has unread
125 (when (and (<= (gnus-group-level group) gnus-notifications-minimum-level)
126 (let ((unread (gnus-group-unread group)))
127 (and (numberp unread)
129 ;; Each group should have an entry in the `gnus-notifications-sent'
130 ;; alist. If not, we add one at this time.
131 (let ((group-notifications (or (assoc group gnus-notifications-sent)
132 ;; Nothing, add one and return it.
135 'gnus-notifications-sent
136 (cons group nil))))))
137 (dolist (article (gnus-list-of-unread-articles group))
138 ;; Check if the article already has been notified
139 (unless (memq article (cdr group-notifications))
140 (with-current-buffer nntp-server-buffer
141 (gnus-request-head article group)
142 (article-decode-encoded-words) ; to decode mail addresses, subjects, etc
143 (let* ((address-components (mail-extract-address-components
144 (or (mail-fetch-field "From") "")))
145 (address (cadr address-components))
146 (photo-file (gnus-notifications-get-photo-file
149 ;; Ignore mails from ourselves
150 (gnus-string-match-p gnus-ignored-from-addresses
152 (gnus-notifications-notify
153 (or (car address-components) address)
154 (mail-fetch-field "Subject")
156 ;; Register that we did notify this message
157 (setcdr group-notifications (cons article (cdr group-notifications))))
159 (delete-file photo-file)))))))))))
161 (provide 'gnus-notifications)
163 ;;; gnus-notifications.el ends here