]> code.delx.au - gnu-emacs/blobdiff - lisp/notifications.el
Wrap around error in coreutil's ls
[gnu-emacs] / lisp / notifications.el
index dc4904db4ca2c3ab06ff20f39f571f0da11e380c..87dc3c1e55c5abeb4b3e6cd47b33d8e80cafc38c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; notifications.el --- Client interface to desktop notifications.
 
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
 
 ;; Author: Julien Danjou <julien@danjou.info>
 ;; Keywords: comm desktop notifications
 ;;; Commentary:
 
 ;; This package provides an implementation of the Desktop Notifications
-;; <http://www.galago-project.org/specs/notification/>.
+;; <http://developer.gnome.org/notification-spec/>.
 
 ;; In order to activate this package, you must add the following code
 ;; into your .emacs:
 ;;
 ;;   (require 'notifications)
 
-;;; Code:
-(eval-when-compile
-  (require 'cl))
-
-;; Pacify byte-compiler.  D-Bus support in the Emacs core can be
-;; disabled with configuration option "--without-dbus".  Declare used
-;; subroutines and variables of `dbus' therefore.
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
+;; For proper usage, Emacs must be started in an environment with an
+;; active D-Bus session bus.
 
+;;; Code:
 (require 'dbus)
 
-(defconst notifications-specification-version "1.1"
+(defconst notifications-specification-version "1.2"
   "The version of the Desktop Notifications Specification implemented.")
 
 (defconst notifications-application-name "Emacs"
   "D-Bus notifications service path.")
 
 (defconst notifications-interface "org.freedesktop.Notifications"
-  "D-Bus notifications service path.")
+  "D-Bus notifications service interface.")
 
 (defconst notifications-notify-method "Notify"
-  "D-Bus notifications service path.")
+  "D-Bus notifications notify method.")
 
 (defconst notifications-close-notification-method "CloseNotification"
-  "D-Bus notifications service path.")
+  "D-Bus notifications close notification method.")
+
+(defconst notifications-get-capabilities-method "GetCapabilities"
+  "D-Bus notifications get capabilities method.")
+
+(defconst notifications-get-server-information-method "GetServerInformation"
+  "D-Bus notifications get server information method.")
 
 (defconst notifications-action-signal "ActionInvoked"
   "D-Bus notifications action signal.")
 (defvar notifications-on-action-map nil
   "Mapping between notification and action callback functions.")
 
+(defvar notifications-on-action-object nil
+  "Object for registered on-action signal.")
+
 (defvar notifications-on-close-map nil
   "Mapping between notification and close callback functions.")
 
+(defvar notifications-on-close-object nil
+  "Object for registered on-close signal.")
+
 (defun notifications-on-action-signal (id action)
   "Dispatch signals to callback functions from `notifications-on-action-map'."
-  (let ((entry (assoc id notifications-on-action-map)))
+  (let* ((bus (dbus-event-bus-name last-input-event))
+        (unique-name (dbus-event-service-name last-input-event))
+        (entry (assoc (list bus unique-name id) notifications-on-action-map)))
     (when entry
       (funcall (cadr entry) id action)
-      (remove entry 'notifications-on-action-map))))
-
-(when (fboundp 'dbus-register-signal)
-  (dbus-register-signal
-   :session
-   notifications-service
-   notifications-path
-   notifications-interface
-   notifications-action-signal
-   'notifications-on-action-signal))
-
-(defun notifications-on-closed-signal (id reason)
+      (when (and (not (setq notifications-on-action-map
+                           (remove entry notifications-on-action-map)))
+                notifications-on-action-object)
+       (dbus-unregister-object notifications-on-action-object)
+       (setq notifications-on-action-object nil)))))
+
+(defun notifications-on-closed-signal (id &optional reason)
   "Dispatch signals to callback functions from `notifications-on-closed-map'."
-  (let ((entry (assoc id notifications-on-close-map)))
+  ;; notification-daemon prior 0.4.0 does not send a reason.  So we
+  ;; make it optional, and assume `undefined' as default.
+  (let* ((bus (dbus-event-bus-name last-input-event))
+        (unique-name (dbus-event-service-name last-input-event))
+        (entry (assoc (list bus unique-name id) notifications-on-close-map))
+        (reason (or reason 4)))
     (when entry
       (funcall (cadr entry)
               id (cadr (assoc reason notifications-closed-reason)))
-      (remove entry 'notifications-on-close-map))))
-
-(when (fboundp 'dbus-register-signal)
-  (dbus-register-signal
-   :session
-   notifications-service
-   notifications-path
-   notifications-interface
-   notifications-closed-signal
-   'notifications-on-closed-signal))
+      (when (and (not (setq notifications-on-close-map
+                           (remove entry notifications-on-close-map)))
+                notifications-on-close-object)
+       (dbus-unregister-object notifications-on-close-object)
+       (setq notifications-on-close-object nil)))))
 
 (defun notifications-notify (&rest params)
   "Send notification via D-Bus using the Freedesktop notification protocol.
 Various PARAMS can be set:
 
+ :bus            The D-Bus bus, if different from `:session'.
  :title          The notification title.
  :body           The notification body text.
  :app-name       The name of the application sending the notification.
@@ -150,6 +154,8 @@ Various PARAMS can be set:
                  Default value is -1.
  :urgency        The urgency level.
                  Either `low', `normal' or `critical'.
+ :action-items   Whether the TITLE of the actions is interpreted as
+                 a named icon.
  :category       The type of notification this is.
  :desktop-entry  This specifies the name of the desktop filename representing
                  the calling program.
@@ -160,12 +166,17 @@ Various PARAMS can be set:
                  only URI schema supported right now) or a name
                  in a freedesktop.org-compliant icon theme.
  :sound-file     The path to a sound file to play when the notification pops up.
- :sound-name     A themeable named sound from the freedesktop.org sound naming
+ :sound-name     A themable named sound from the freedesktop.org sound naming
                  specification to play when the notification pops up.
                  Similar to icon-name,only for sounds. An example would
                  be \"message-new-instant\".
  :suppress-sound Causes the server to suppress playing any sounds, if it has
                  that ability.
+ :resident       When set the server will not automatically remove the
+                 notification when an action has been invoked.
+ :transient      When set the server will treat the notification as transient
+                 and by-pass the server's persistence capability, if it
+                 should exist.
  :x              Specifies the X location on the screen that the notification
                  should point to.  The \"y\" hint must also be specified.
  :y              Specifies the Y location on the screen that the notification
@@ -181,114 +192,218 @@ Various PARAMS can be set:
                    - `dismissed' if the notification was dismissed by the user
                    - `close-notification' if the notification was closed
                      by a call to CloseNotification
+                   - `undefined' if the notification server hasn't provided
+                     a reason
+
+Which parameters are accepted by the notification server can be
+checked via `notifications-get-capabilities'.
 
 This function returns a notification id, an integer, which can be
 used to manipulate the notification item with
-`notifications-close'."
-  (let ((title (plist-get params :title))
-        (body (plist-get params :body))
-        (app-name (plist-get params :app-name))
-        (replaces-id (plist-get params :replaces-id))
-        (app-icon (plist-get params :app-icon))
-        (actions (plist-get params :actions))
-        (timeout (plist-get params :timeout))
-        ;; Hints
-        (hints '())
-        (urgency (plist-get params :urgency))
-        (category (plist-get params :category))
-        (desktop-entry (plist-get params :desktop-entry))
-        (image-data (plist-get params :image-data))
-        (image-path (plist-get params :image-path))
-        (sound-file (plist-get params :sound-file))
-        (sound-name (plist-get params :sound-name))
-        (suppress-sound (plist-get params :suppress-sound))
-        (x (plist-get params :x))
-        (y (plist-get params :y))
-        id)
-    ;; Build hints array
-    (when urgency
-      (add-to-list 'hints `(:dict-entry
-                            "urgency"
-                            (:variant :byte ,(case urgency
-                                               ('low 0)
-                                               ('critical 2)
-                                               (t 1)))) t))
-    (when category
-      (add-to-list 'hints `(:dict-entry
-                            "category"
-                            (:variant :string ,category)) t))
-    (when desktop-entry
-      (add-to-list 'hints `(:dict-entry
-                            "desktop-entry"
-                            (:variant :string ,desktop-entry)) t))
-    (when image-data
-      (add-to-list 'hints `(:dict-entry
-                            "image_data"
-                            (:variant :struct ,image-data)) t))
-    (when image-path
-      (add-to-list 'hints `(:dict-entry
-                            "image_path"
-                            (:variant :string ,image-path)) t))
-    (when sound-file
-      (add-to-list 'hints `(:dict-entry
-                            "sound-file"
-                            (:variant :string ,sound-file)) t))
-    (when sound-name
-      (add-to-list 'hints `(:dict-entry
-                            "sound-name"
-                            (:variant :string ,sound-name)) t))
-    (when suppress-sound
-      (add-to-list 'hints `(:dict-entry
-                            "suppress-sound"
-                            (:variant :boolean ,suppress-sound)) t))
-    (when x
-      (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
-    (when y
-      (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
-
-    ;; Call Notify method
-    (setq id
-          (dbus-call-method :session
-                            notifications-service
-                            notifications-path
-                            notifications-interface
-                            notifications-notify-method
-                            :string (or app-name
-                                        notifications-application-name)
-                            :uint32 (or replaces-id 0)
-                            :string (if app-icon
-                                        (expand-file-name app-icon)
-                                      ;; If app-icon is nil because user
-                                      ;; requested it to be so, send the
-                                      ;; empty string
-                                      (if (plist-member params :app-icon)
-                                          ""
-                                        ;; Otherwise send the default icon path
-                                        notifications-application-icon))
-                            :string (or title "")
-                            :string (or body "")
-                            `(:array ,@actions)
-                            (or hints '(:array :signature "{sv}"))
-                            :int32 (or timeout -1)))
-
-    ;; Register close/action callback function
-    (let ((on-action (plist-get params :on-action))
-          (on-close (plist-get params :on-close)))
-      (when on-action
-        (add-to-list 'notifications-on-action-map (list id on-action)))
-      (when on-close
-        (add-to-list 'notifications-on-close-map (list id on-close))))
-
-    ;; Return notification id
-    id))
-
-(defun notifications-close-notification (id)
-  "Close a notification with identifier ID."
-  (dbus-call-method :session
+`notifications-close-notification' or the `:replaces-id' argument
+of another `notifications-notify' call."
+  (with-demoted-errors
+    (let ((bus (or (plist-get params :bus) :session))
+         (title (plist-get params :title))
+         (body (plist-get params :body))
+         (app-name (plist-get params :app-name))
+         (replaces-id (plist-get params :replaces-id))
+         (app-icon (plist-get params :app-icon))
+         (actions (plist-get params :actions))
+         (timeout (plist-get params :timeout))
+         ;; Hints
+         (hints '())
+         (urgency (plist-get params :urgency))
+         (category (plist-get params :category))
+         (desktop-entry (plist-get params :desktop-entry))
+         (image-data (plist-get params :image-data))
+         (image-path (plist-get params :image-path))
+         (action-items (plist-get params :action-items))
+         (sound-file (plist-get params :sound-file))
+         (sound-name (plist-get params :sound-name))
+         (suppress-sound (plist-get params :suppress-sound))
+         (resident (plist-get params :resident))
+         (transient (plist-get params :transient))
+         (x (plist-get params :x))
+         (y (plist-get params :y))
+         id)
+      ;; Build hints array
+      (when urgency
+       (add-to-list 'hints `(:dict-entry
+                             "urgency"
+                             (:variant :byte ,(pcase urgency
+                                                (`low 0)
+                                                (`critical 2)
+                                                (_ 1)))) t))
+      (when category
+       (add-to-list 'hints `(:dict-entry
+                             "category"
+                             (:variant :string ,category)) t))
+      (when desktop-entry
+       (add-to-list 'hints `(:dict-entry
+                             "desktop-entry"
+                             (:variant :string ,desktop-entry)) t))
+      (when image-data
+       (add-to-list 'hints `(:dict-entry
+                             "image-data"
+                             (:variant :struct ,image-data)) t))
+      (when image-path
+       (add-to-list 'hints `(:dict-entry
+                             "image-path"
+                             (:variant :string ,image-path)) t))
+      (when action-items
+       (add-to-list 'hints `(:dict-entry
+                             "action-items"
+                             (:variant :boolean ,action-items)) t))
+      (when sound-file
+       (add-to-list 'hints `(:dict-entry
+                             "sound-file"
+                             (:variant :string ,sound-file)) t))
+      (when sound-name
+       (add-to-list 'hints `(:dict-entry
+                             "sound-name"
+                             (:variant :string ,sound-name)) t))
+      (when suppress-sound
+       (add-to-list 'hints `(:dict-entry
+                             "suppress-sound"
+                             (:variant :boolean ,suppress-sound)) t))
+      (when resident
+       (add-to-list 'hints `(:dict-entry
+                             "resident"
+                             (:variant :boolean ,resident)) t))
+      (when transient
+       (add-to-list 'hints `(:dict-entry
+                             "transient"
+                             (:variant :boolean ,transient)) t))
+      (when x
+       (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
+      (when y
+       (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
+
+      ;; Call Notify method.
+      (setq id
+           (dbus-call-method bus
+                             notifications-service
+                             notifications-path
+                             notifications-interface
+                             notifications-notify-method
+                             :string (or app-name
+                                         notifications-application-name)
+                             :uint32 (or replaces-id 0)
+                             :string (if app-icon
+                                         (expand-file-name app-icon)
+                                       ;; If app-icon is nil because user
+                                       ;; requested it to be so, send the
+                                       ;; empty string
+                                       (if (plist-member params :app-icon)
+                                           ""
+                                         ;; Otherwise send the
+                                         ;; default icon path
+                                         notifications-application-icon))
+                             :string (or title "")
+                             :string (or body "")
+                             `(:array ,@actions)
+                             (or hints '(:array :signature "{sv}"))
+                             :int32 (or timeout -1)))
+
+      ;; Register close/action callback function.  We must also
+      ;; remember the daemon's unique name, because the daemon could
+      ;; have restarted.
+      (let ((on-action (plist-get params :on-action))
+           (on-close (plist-get params :on-close))
+           (unique-name (dbus-get-name-owner bus notifications-service)))
+       (when on-action
+         (add-to-list 'notifications-on-action-map
+                      (list (list bus unique-name id) on-action))
+         (unless notifications-on-action-object
+           (setq notifications-on-action-object
+                 (dbus-register-signal
+                  bus
+                  nil
+                  notifications-path
+                  notifications-interface
+                  notifications-action-signal
+                  'notifications-on-action-signal))))
+
+       (when on-close
+         (add-to-list 'notifications-on-close-map
+                      (list (list bus unique-name id) on-close))
+         (unless notifications-on-close-object
+           (setq notifications-on-close-object
+                 (dbus-register-signal
+                  bus
+                  nil
+                  notifications-path
+                  notifications-interface
+                  notifications-closed-signal
+                  'notifications-on-closed-signal)))))
+
+      ;; Return notification id
+      id)))
+
+(defun notifications-close-notification (id &optional bus)
+  "Close a notification with identifier ID.
+BUS can be a string denoting a D-Bus connection, the default is `:session'."
+  (dbus-call-method (or bus :session)
                     notifications-service
                     notifications-path
                     notifications-interface
                     notifications-close-notification-method
-                    :int32 id))
+                    :uint32 id))
+
+(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
+
+(defun notifications-get-capabilities (&optional bus)
+  "Return the capabilities of the notification server, a list of symbols.
+BUS can be a string denoting a D-Bus connection, the default is `:session'.
+The following capabilities can be expected:
+
+  :actions         The server will provide the specified actions
+                   to the user.
+  :action-icons    Supports using icons instead of text for
+                   displaying actions.
+  :body            Supports body text.
+  :body-hyperlinks The server supports hyperlinks in the notifications.
+  :body-images     The server supports images in the notifications.
+  :body-markup     Supports markup in the body text.
+  :icon-multi      The server will render an animation of all the
+                   frames in a given image array.
+  :icon-static     Supports display of exactly 1 frame of any
+                   given image array.  This value is mutually exclusive
+                   with `:icon-multi'.
+  :persistence     The server supports persistence of notifications.
+  :sound           The server supports sounds on notifications.
+
+Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'."
+  (dbus-ignore-errors
+    (mapcar
+     (lambda (x) (intern (concat ":" x)))
+     (dbus-call-method (or bus :session)
+                      notifications-service
+                      notifications-path
+                      notifications-interface
+                      notifications-get-capabilities-method))))
+
+(defun notifications-get-server-information (&optional bus)
+  "Return information on the notification server, a list of strings.
+BUS can be a string denoting a D-Bus connection, the default is `:session'.
+The returned list is (NAME VENDOR VERSION SPEC-VERSION).
+
+  NAME         The product name of the server.
+  VENDOR       The vendor name.  For example, \"KDE\", \"GNOME\".
+  VERSION      The server's version number.
+  SPEC-VERSION The specification version the server is compliant with.
+
+If SPEC_VERSION is missing, the server supports a specification
+prior to \"1.0\".
+
+See `notifications-specification-version' for the specification
+version this library is compliant with."
+  (dbus-ignore-errors
+    (dbus-call-method (or bus :session)
+                     notifications-service
+                     notifications-path
+                     notifications-interface
+                     notifications-get-server-information-method)))
 
 (provide 'notifications)