[gnus git] branch master updated: m0-5-90-g7b7db76 =1= gnus-notifications: add

       via  7b7db76666fae115c7ec0cc78ca96ea4e177ba4e (commit)
      from  9836686c6599eaa964c87e0d197b96e6ea558e4e (commit)


- Log -----------------------------------------------------------------
commit 7b7db76666fae115c7ec0cc78ca96ea4e177ba4e
Author: Julien Danjou <[email protected]>
Date:   Wed Aug 29 15:41:39 2012 +0200

    gnus-notifications: add
    
    Signed-off-by: Julien Danjou <[email protected]>

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f91ec67..91b5d68 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2012-08-29  Julien Danjou  <[email protected]>
+
+	* gnus-notifications.el: New file.
+
 2012-08-28  Katsumi Yamaoka  <[email protected]>
 
 	* gnus-sum.el (gnus-summary-enter-digest-group): Decode content
diff --git a/lisp/gnus-notifications.el b/lisp/gnus-notifications.el
new file mode 100644
index 0000000..348bbbe
--- /dev/null
+++ b/lisp/gnus-notifications.el
@@ -0,0 +1,148 @@
+;; gnus-notifications.el -- Send notification on new message in Gnus
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Julien Danjou <[email protected]>
+;; 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 <http://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 'google-contacts nil t)        ; Optional
+
+(defgroup gnus-notifications nil
+  "Send notifications on new message in Gnus."
+  :group 'gnus)
+
+(defcustom gnus-notifications-use-google-contacts t
+  "Use Google Contacts to retrieve photo."
+  :type 'boolean
+  :group 'gnus-notifications)
+
+(defcustom gnus-notifications-use-gravatar t
+  "Use Gravatar to retrieve photo."
+  :type 'boolean
+  :group 'gnus-notifications)
+
+(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
+  :group 'gnus-notifications)
+
+(defvar gnus-notifications-sent nil
+  "Notifications already sent.")
+
+(defun gnus-notifications-get-photo (mail-address)
+  "Get photo for mail address."
+  (let ((google-photo (when (and gnus-notifications-use-google-contacts
+                                 (fboundp 'google-contacts-get-photo))
+                        (ignore-errors
+                          (google-contacts-get-photo mail-address)))))
+    (if google-photo
+        google-photo
+      (when gnus-notifications-use-gravatar
+        (let ((gravatar (ignore-errors
+                          (gravatar-retrieve-synchronously mail-address))))
+          (if (eq gravatar 'error)
+              nil
+            (plist-get (cdr gravatar) :data)))))))
+
+(defun gnus-notifications-get-photo-file (mail-address)
+  "Get a temporary file with an image for MAIL-ADDRESS.
+You have to delete the temporary image yourself using
+`delete-image'.
+
+Returns nil if no image found."
+  (let ((photo (gnus-notifications-get-photo mail-address)))
+    (when photo
+      (let ((photo-file (make-temp-file "gnus-notifications-photo-"))
+            (coding-system-for-write 'binary))
+        (with-temp-file photo-file
+            (insert photo))
+        photo-file))))
+
+;;;###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'"
+  (dolist (entry gnus-newsrc-alist)
+    (let ((group (car entry)))
+      ;; Check that the group level is less than
+      ;; `gnus-notifications-minimum-level' and the 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
+                                              (add-to-list
+                                               'gnus-notifications-sent
+                                               (cons group nil))))))
+          (dolist (article (gnus-list-of-unread-articles group))
+            ;; Check if the article already has been notified
+            (unless (memq article (cdr group-notifications))
+              (with-current-buffer nntp-server-buffer
+                (gnus-request-head article group)
+                (article-decode-encoded-words) ; to decode mail addresses, subjects, etc
+                (let* ((address-components (mail-extract-address-components
+                                            (or (mail-fetch-field "From") "")))
+                       (address (cadr address-components))
+                       (photo-file (gnus-notifications-get-photo-file
+                                    address)))
+                  (when (or
+                         ;; Ignore mails from ourselves
+                         (gnus-string-match-p gnus-ignored-from-addresses
+                                              address)
+                         (notifications-notify :title (concat "New message from "
+                                                              (or (car address-components) address))
+                                               :body (mail-fetch-field "Subject")
+                                               :app-icon (image-search-load-path "gnus/gnus.png")
+                                               :app-name "Gnus"
+                                               :category "email.arrived"
+                                               :image-path photo-file))
+                    ;; Register that we did notify this message
+                    (setcdr group-notifications (cons article (cdr group-notifications))))
+                  (when photo-file
+                    (delete-file photo-file)))))))))))
+
+(provide 'gnus-notifications)
+
+;;; gnus-notifications.el ends here

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog             |    4 +
 lisp/gnus-notifications.el |  148 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 152 insertions(+), 0 deletions(-)
 create mode 100644 lisp/gnus-notifications.el

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project