cgit.sxemacs.org Git - gnus/blob - lisp/gnus-notifications.el

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