[Emacs-diffs] /srv/bzr/emacs/trunk r109824: gnus-notifications.el: Add defcustom for timeout and actions support

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 109824
author: Julien Danjou <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Thu 2012-08-30 22:14:27 +0000
message:
  gnus-notifications.el: Add defcustom for timeout and actions support
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/gnus-notifications.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2012-08-30 12:11:57 +0000
+++ b/lisp/gnus/ChangeLog       2012-08-30 22:14:27 +0000
@@ -1,3 +1,15 @@
+2012-08-30  Julien Danjou  <address@hidden>
+
+       * gnus-notifications.el (gnus-notifications-notify): Use timeout from
+       `gnus-notifications-timeout'.
+       (gnus-notifications-timeout): Add.
+       (gnus-notifications-action): New function.
+       (gnus-notifications-notify): Add :action using
+       `gnus-notifications-action'.
+       (gnus-notifications-id-to-msg): New variable.
+       (gnus-notifications): Use `gnus-notifications-id-to-msg' to map
+       notifications id to messages.
+
 2012-08-30  Kenichi Handa  <address@hidden>
 
        * qp.el (quoted-printable-decode-region): Decode multiple bytes at

=== modified file 'lisp/gnus/gnus-notifications.el'
--- a/lisp/gnus/gnus-notifications.el   2012-08-29 22:04:05 +0000
+++ b/lisp/gnus/gnus-notifications.el   2012-08-30 22:14:27 +0000
@@ -58,20 +58,42 @@
   :type 'integer
   :group 'gnus-notifications)
 
+(defcustom gnus-notifications-timeout nil
+  "Timeout used for notifications sent via `notifications-notify'."
+  :type 'integer
+  :group 'gnus-notifications)
+
 (defvar gnus-notifications-sent nil
   "Notifications already sent.")
 
+(defvar gnus-notifications-id-to-msg nil
+  "Map notifications ids to messages.")
+
+(defun gnus-notifications-action (id key)
+  (when (string= key "read")
+    (let ((group-article (assoc id gnus-notifications-id-to-msg)))
+      (when group-article
+        (let ((group (cadr group-article))
+              (article (caddr group-article)))
+          (gnus-fetch-group group (list article)))))))
+
 (defun gnus-notifications-notify (from subject photo-file)
-  "Send a notification about a new mail."
+  "Send a notification about a new mail.
+Return a notification id if any, or t on success."
   (if (fboundp 'notifications-notify)
       (notifications-notify
        :title from
        :body subject
+       :actions '("read" "Read")
+       :on-action 'gnus-notifications-action
        :app-icon (image-search-load-path "gnus/gnus.png")
        :app-name "Gnus"
        :category "email.arrived"
+       :timeout gnus-notifications-timeout
        :image-path photo-file)
-    (message "New message from %s: %s" from subject)))
+    (message "New message from %s: %s" from subject)
+    ;; Don't return an id
+    t))
 
 (defun gnus-notifications-get-photo (mail-address)
   "Get photo for mail address."
@@ -136,21 +158,23 @@
                 (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)
-                         (gnus-notifications-notify
-                          (or (car address-components) address)
-                          (mail-fetch-field "Subject")
-                          photo-file))
-                    ;; Register that we did notify this message
-                    (setcdr group-notifications (cons article (cdr 
group-notifications))))
-                  (when photo-file
-                    (delete-file photo-file)))))))))))
+                       (address (cadr address-components)))
+                  ;; Ignore mails from ourselves
+                  (unless (gnus-string-match-p gnus-ignored-from-addresses
+                                               address)
+                    (let* ((photo-file (gnus-notifications-get-photo-file 
address))
+                           (notification-id (gnus-notifications-notify
+                                             (or (car address-components) 
address)
+                                             (mail-fetch-field "Subject")
+                                             photo-file)))
+                      (when notification-id
+                        ;; Register that we did notify this message
+                        (setcdr group-notifications (cons article (cdr 
group-notifications)))
+                        (unless (eq notification-id t)
+                          ;; Register the notification id for later actions
+                          (add-to-list 'gnus-notifications-id-to-msg (list 
notification-id group article))))
+                      (when photo-file
+                        (delete-file photo-file)))))))))))))
 
 (provide 'gnus-notifications)