X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/233ba4d924933cb56129bd7511e6137b7c0b8e3e..5725bd2cc0e691dadc31bd958f210b1bbcf17c49:/lisp/notifications.el diff --git a/lisp/notifications.el b/lisp/notifications.el index 893b9ed095..792298c26b 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -1,6 +1,6 @@ ;;; 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 ;; Keywords: comm desktop notifications @@ -23,26 +23,20 @@ ;;; Commentary: ;; This package provides an implementation of the Desktop Notifications -;; . +;; . ;; 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" @@ -61,13 +55,16 @@ "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.") @@ -85,46 +82,50 @@ (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 +151,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 +163,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,11 +189,18 @@ 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)) +`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)) @@ -199,9 +214,12 @@ used to manipulate the notification item with (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) @@ -209,10 +227,10 @@ used to manipulate the notification item with (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" @@ -223,12 +241,16 @@ used to manipulate the notification item with (: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" @@ -241,14 +263,22 @@ used to manipulate the notification item with (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 @@ -271,24 +301,82 @@ used to manipulate the notification item with (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)