;;; notifications.el --- Client interface to desktop notifications.
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 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:
;; active D-Bus session bus.
;;; 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")
-
(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-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.
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.
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
- `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-notification'."
- (let ((title (plist-get params :title))
+`notifications-close-notification' or the `:replaces-id' argument
+of another `notifications-notify' call."
+ (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))
(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)
(when urgency
(add-to-list 'hints `(:dict-entry
"urgency"
- (:variant :byte ,(case urgency
- (low 0)
- (critical 2)
- (t 1)))) t))
+ (:variant :byte ,(pcase urgency
+ (`low 0)
+ (`critical 2)
+ (_ 1)))) t))
(when category
(add-to-list 'hints `(:dict-entry
"category"
(:variant :string ,desktop-entry)) t))
(when image-data
(add-to-list 'hints `(:dict-entry
- "image_data"
+ "image-data"
(:variant :struct ,image-data)) t))
(when image-path
(add-to-list 'hints `(:dict-entry
- "image_path"
+ "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"
(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
+ ;; Call Notify method.
(setq id
- (dbus-call-method :session
+ (dbus-call-method bus
notifications-service
notifications-path
notifications-interface
(or hints '(:array :signature "{sv}"))
:int32 (or timeout -1)))
- ;; Register close/action callback function
+ ;; 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)))
+ (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 id 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 id 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)
- "Close a notification with identifier ID."
- (dbus-call-method :session
+(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))
+(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 strings.
+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))))
+
(provide 'notifications)
HCoop / bpt / emacs.git / blobdiff