[bpt/emacs.git] / lisp / notifications.el

;;; notifications.el --- Client interface to desktop notifications.

;; Copyright (C) 2010-2012 Free Software Foundation, Inc.

;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: comm desktop notifications

;; 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 package provides an implementation of the Desktop Notifications
;; <http://www.galago-project.org/specs/notification/>.

;; In order to activate this package, you must add the following code
;; into your .emacs:
;;
;;   (require 'notifications)

;; For proper usage, Emacs must be started in an environment with an
;; 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"
  "The version of the Desktop Notifications Specification implemented.")

(defconst notifications-application-name "Emacs"
  "Default application name.")

(defconst notifications-application-icon
  (expand-file-name
   "images/icons/hicolor/scalable/apps/emacs.svg"
   data-directory)
  "Default application icon.")

(defconst notifications-service "org.freedesktop.Notifications"
  "D-Bus notifications service name.")

(defconst notifications-path "/org/freedesktop/Notifications"
  "D-Bus notifications service path.")

(defconst notifications-interface "org.freedesktop.Notifications"
  "D-Bus notifications service path.")

(defconst notifications-notify-method "Notify"
  "D-Bus notifications service path.")

(defconst notifications-close-notification-method "CloseNotification"
  "D-Bus notifications service path.")

(defconst notifications-action-signal "ActionInvoked"
  "D-Bus notifications action signal.")

(defconst notifications-closed-signal "NotificationClosed"
  "D-Bus notifications closed signal.")

(defconst notifications-closed-reason
  '((1 expired)
    (2 dismissed)
    (3 close-notification)
    (4 undefined))
  "List of reasons why a notification has been closed.")

(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* ((unique-name (dbus-event-service-name last-input-event))
	 (entry (assoc (cons unique-name id) notifications-on-action-map)))
    (when entry
      (funcall (cadr entry) id action)
      (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'."
  ;; notification-daemon prior 0.4.0 does not send a reason.  So we
  ;; make it optional, and assume `undefined' as default.
  (let* ((unique-name (dbus-event-service-name last-input-event))
	 (entry (assoc (cons unique-name id) notifications-on-close-map))
	 (reason (or reason 4)))
    (when entry
      (funcall (cadr entry)
	       id (cadr (assoc reason notifications-closed-reason)))
      (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:

 :title          The notification title.
 :body           The notification body text.
 :app-name       The name of the application sending the notification.
                 Default to `notifications-application-name'.
 :replaces-id    The notification ID that this notification replaces.
 :app-icon       The notification icon.
                 Default is `notifications-application-icon'.
                 Set to nil if you do not want any icon displayed.
 :actions        A list of actions in the form:
                   (KEY TITLE KEY TITLE ...)
                 where KEY and TITLE are both strings.
                 The default action (usually invoked by clicking the
                 notification) should have a key named \"default\".
                 The title can be anything, though implementations are free
                 not to display it.
 :timeout        The timeout time in milliseconds since the display
                 of the notification at which the notification should
                 automatically close.
                 If -1, the notification's expiration time is dependent
                 on the notification server's settings, and may vary for
                 the type of notification.
                 If 0, the notification never expires.
                 Default value is -1.
 :urgency        The urgency level.
                 Either `low', `normal' or `critical'.
 :category       The type of notification this is.
 :desktop-entry  This specifies the name of the desktop filename representing
                 the calling program.
 :image-data     This is a raw data image format which describes the width,
                 height, rowstride, has alpha, bits per sample, channels and
                 image data respectively.
 :image-path     This is represented either as a URI (file:// is the
                 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 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.
 :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
                 should point to.  The \"x\" hint must also be specified.
 :on-action      Function to call when an action is invoked.
                 The notification id and the key of the action are passed
                 as arguments to the function.
 :on-close       Function to call when the notification has been closed
                 by timeout or by the user.
                 The function receive the notification id and the closing
                 reason as arguments:
                   - `expired' if the notification has expired
                   - `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

This function returns a notification id, an integer, which can be
used to manipulate the notification item with
`notifications-close-notification' or the `:replaces-id' argument
of another `notifications-notify' call."
  (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.  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 :session notifications-service)))
      (when on-action
        (add-to-list 'notifications-on-action-map
		     (list (cons unique-name id) on-action))
	(unless notifications-on-action-object
	  (setq notifications-on-action-object
		(dbus-register-signal
		 :session
		 nil
		 notifications-path
		 notifications-interface
		 notifications-action-signal
		 'notifications-on-action-signal))))

      (when on-close
        (add-to-list 'notifications-on-close-map
		     (list (cons unique-name id) on-close))
	(unless notifications-on-close-object
	  (setq notifications-on-close-object
		(dbus-register-signal
		 :session
		 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
                    notifications-service
                    notifications-path
                    notifications-interface
                    notifications-close-notification-method
                    :int32 id))

(provide 'notifications)
Commit	Line	Data
41a86354 MA	1	;;; notifications.el --- Client interface to desktop notifications.
41a86354 MA	2
acaf905b	3	;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
41a86354 MA	4
	5	;; Author: Julien Danjou <julien@danjou.info>
	6	;; Keywords: comm desktop notifications
	7
	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software: you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
	12	;; the Free Software Foundation, either version 3 of the License, or
	13	;; (at your option) any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
	21	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
	22
	23	;;; Commentary:
	24
	25	;; This package provides an implementation of the Desktop Notifications
	26	;; <http://www.galago-project.org/specs/notification/>.
	27
	28	;; In order to activate this package, you must add the following code
	29	;; into your .emacs:
	30	;;
	31	;; (require 'notifications)
	32
7f5c46c7 MA	33	;; For proper usage, Emacs must be started in an environment with an
	34	;; active D-Bus session bus.
	35
41a86354 MA	36	;;; Code:
	37	(eval-when-compile
	38	(require 'cl))
	39
	40	;; Pacify byte-compiler. D-Bus support in the Emacs core can be
	41	;; disabled with configuration option "--without-dbus". Declare used
	42	;; subroutines and variables of `dbus' therefore.
	43	(declare-function dbus-call-method "dbusbind.c")
b978141d	44	(declare-function dbus-register-signal "dbusbind.c")
41a86354 MA	45
	46	(require 'dbus)
	47
7ea2d383 MA	48	(defconst notifications-specification-version "1.1"
	49	"The version of the Desktop Notifications Specification implemented.")
	50
41a86354 MA	51	(defconst notifications-application-name "Emacs"
	52	"Default application name.")
	53
	54	(defconst notifications-application-icon
	55	(expand-file-name
	56	"images/icons/hicolor/scalable/apps/emacs.svg"
	57	data-directory)
	58	"Default application icon.")
	59
	60	(defconst notifications-service "org.freedesktop.Notifications"
	61	"D-Bus notifications service name.")
	62
	63	(defconst notifications-path "/org/freedesktop/Notifications"
	64	"D-Bus notifications service path.")
	65
	66	(defconst notifications-interface "org.freedesktop.Notifications"
	67	"D-Bus notifications service path.")
	68
	69	(defconst notifications-notify-method "Notify"
	70	"D-Bus notifications service path.")
	71
	72	(defconst notifications-close-notification-method "CloseNotification"
	73	"D-Bus notifications service path.")
	74
	75	(defconst notifications-action-signal "ActionInvoked"
	76	"D-Bus notifications action signal.")
	77
	78	(defconst notifications-closed-signal "NotificationClosed"
	79	"D-Bus notifications closed signal.")
	80
	81	(defconst notifications-closed-reason
	82	'((1 expired)
	83	(2 dismissed)
	84	(3 close-notification)
	85	(4 undefined))
	86	"List of reasons why a notification has been closed.")
	87
	88	(defvar notifications-on-action-map nil
	89	"Mapping between notification and action callback functions.")
	90
6612a284 MA	91	(defvar notifications-on-action-object nil
	92	"Object for registered on-action signal.")
	93
41a86354 MA	94	(defvar notifications-on-close-map nil
	95	"Mapping between notification and close callback functions.")
	96
6612a284 MA	97	(defvar notifications-on-close-object nil
	98	"Object for registered on-close signal.")
	99
41a86354	100	(defun notifications-on-action-signal (id action)
fa4003da	101	"Dispatch signals to callback functions from `notifications-on-action-map'."
a41a6cf4 MA	102	(let* ((unique-name (dbus-event-service-name last-input-event))
	103	(entry (assoc (cons unique-name id) notifications-on-action-map)))
	104	(when entry
fa4003da	105	(funcall (cadr entry) id action)
6612a284 MA	106	(when (and (not (setq notifications-on-action-map
	107	(remove entry notifications-on-action-map)))
	108	notifications-on-action-object)
	109	(dbus-unregister-object notifications-on-action-object)
	110	(setq notifications-on-action-object nil)))))
41a86354	111
5b77774d	112	(defun notifications-on-closed-signal (id &optional reason)
fa4003da	113	"Dispatch signals to callback functions from `notifications-on-closed-map'."
5b77774d MA	114	;; notification-daemon prior 0.4.0 does not send a reason. So we
5b77774d MA	115	;; make it optional, and assume `undefined' as default.
a41a6cf4 MA	116	(let* ((unique-name (dbus-event-service-name last-input-event))
	117	(entry (assoc (cons unique-name id) notifications-on-close-map))
	118	(reason (or reason 4)))
	119	(when entry
fa4003da MA	120	(funcall (cadr entry)
fa4003da MA	121	id (cadr (assoc reason notifications-closed-reason)))
6612a284 MA	122	(when (and (not (setq notifications-on-close-map
	123	(remove entry notifications-on-close-map)))
	124	notifications-on-close-object)
	125	(dbus-unregister-object notifications-on-close-object)
	126	(setq notifications-on-close-object nil)))))
41a86354 MA	127
	128	(defun notifications-notify (&rest params)
	129	"Send notification via D-Bus using the Freedesktop notification protocol.
	130	Various PARAMS can be set:
	131
	132	:title The notification title.
	133	:body The notification body text.
	134	:app-name The name of the application sending the notification.
	135	Default to `notifications-application-name'.
	136	:replaces-id The notification ID that this notification replaces.
	137	:app-icon The notification icon.
	138	Default is `notifications-application-icon'.
	139	Set to nil if you do not want any icon displayed.
	140	:actions A list of actions in the form:
	141	(KEY TITLE KEY TITLE ...)
	142	where KEY and TITLE are both strings.
b978141d JB	143	The default action (usually invoked by clicking the
b978141d JB	144	notification) should have a key named \"default\".
890a18d6	145	The title can be anything, though implementations are free
b978141d	146	not to display it.
41a86354 MA	147	:timeout The timeout time in milliseconds since the display
	148	of the notification at which the notification should
	149	automatically close.
	150	If -1, the notification's expiration time is dependent
	151	on the notification server's settings, and may vary for
	152	the type of notification.
	153	If 0, the notification never expires.
	154	Default value is -1.
	155	:urgency The urgency level.
	156	Either `low', `normal' or `critical'.
	157	:category The type of notification this is.
	158	:desktop-entry This specifies the name of the desktop filename representing
	159	the calling program.
	160	:image-data This is a raw data image format which describes the width,
	161	height, rowstride, has alpha, bits per sample, channels and
	162	image data respectively.
7ea2d383 MA	163	:image-path This is represented either as a URI (file:// is the
	164	only URI schema supported right now) or a name
	165	in a freedesktop.org-compliant icon theme.
41a86354	166	:sound-file The path to a sound file to play when the notification pops up.
40ba43b4	167	:sound-name A themable named sound from the freedesktop.org sound naming
7ea2d383 MA	168	specification to play when the notification pops up.
	169	Similar to icon-name,only for sounds. An example would
	170	be \"message-new-instant\".
41a86354 MA	171	:suppress-sound Causes the server to suppress playing any sounds, if it has
	172	that ability.
	173	:x Specifies the X location on the screen that the notification
b978141d	174	should point to. The \"y\" hint must also be specified.
41a86354	175	:y Specifies the Y location on the screen that the notification
b978141d	176	should point to. The \"x\" hint must also be specified.
fa4003da MA	177	:on-action Function to call when an action is invoked.
	178	The notification id and the key of the action are passed
	179	as arguments to the function.
41a86354 MA	180	:on-close Function to call when the notification has been closed
41a86354 MA	181	by timeout or by the user.
fa4003da MA	182	The function receive the notification id and the closing
fa4003da MA	183	reason as arguments:
41a86354 MA	184	- `expired' if the notification has expired
	185	- `dismissed' if the notification was dismissed by the user
	186	- `close-notification' if the notification was closed
	187	by a call to CloseNotification
66b907dc MA	188	- `undefined' if the notification server hasn't provided
66b907dc MA	189	a reason
41a86354 MA	190
	191	This function returns a notification id, an integer, which can be
	192	used to manipulate the notification item with
66b907dc MA	193	`notifications-close-notification' or the `:replaces-id' argument
66b907dc MA	194	of another `notifications-notify' call."
41a86354 MA	195	(let ((title (plist-get params :title))
	196	(body (plist-get params :body))
	197	(app-name (plist-get params :app-name))
	198	(replaces-id (plist-get params :replaces-id))
	199	(app-icon (plist-get params :app-icon))
	200	(actions (plist-get params :actions))
	201	(timeout (plist-get params :timeout))
	202	;; Hints
	203	(hints '())
	204	(urgency (plist-get params :urgency))
	205	(category (plist-get params :category))
	206	(desktop-entry (plist-get params :desktop-entry))
	207	(image-data (plist-get params :image-data))
7ea2d383	208	(image-path (plist-get params :image-path))
41a86354	209	(sound-file (plist-get params :sound-file))
7ea2d383	210	(sound-name (plist-get params :sound-name))
41a86354 MA	211	(suppress-sound (plist-get params :suppress-sound))
	212	(x (plist-get params :x))
	213	(y (plist-get params :y))
	214	id)
	215	;; Build hints array
	216	(when urgency
	217	(add-to-list 'hints `(:dict-entry
	218	"urgency"
	219	(:variant :byte ,(case urgency
0adf5618 SM	220	(low 0)
0adf5618 SM	221	(critical 2)
41a86354 MA	222	(t 1)))) t))
	223	(when category
	224	(add-to-list 'hints `(:dict-entry
	225	"category"
	226	(:variant :string ,category)) t))
	227	(when desktop-entry
	228	(add-to-list 'hints `(:dict-entry
	229	"desktop-entry"
	230	(:variant :string ,desktop-entry)) t))
	231	(when image-data
	232	(add-to-list 'hints `(:dict-entry
	233	"image_data"
	234	(:variant :struct ,image-data)) t))
7ea2d383 MA	235	(when image-path
	236	(add-to-list 'hints `(:dict-entry
	237	"image_path"
	238	(:variant :string ,image-path)) t))
41a86354 MA	239	(when sound-file
	240	(add-to-list 'hints `(:dict-entry
	241	"sound-file"
	242	(:variant :string ,sound-file)) t))
7ea2d383 MA	243	(when sound-name
	244	(add-to-list 'hints `(:dict-entry
	245	"sound-name"
	246	(:variant :string ,sound-name)) t))
41a86354 MA	247	(when suppress-sound
	248	(add-to-list 'hints `(:dict-entry
	249	"suppress-sound"
	250	(:variant :boolean ,suppress-sound)) t))
	251	(when x
	252	(add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
	253	(when y
	254	(add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
	255
	256	;; Call Notify method
	257	(setq id
	258	(dbus-call-method :session
	259	notifications-service
	260	notifications-path
	261	notifications-interface
	262	notifications-notify-method
	263	:string (or app-name
	264	notifications-application-name)
	265	:uint32 (or replaces-id 0)
	266	:string (if app-icon
	267	(expand-file-name app-icon)
	268	;; If app-icon is nil because user
	269	;; requested it to be so, send the
	270	;; empty string
	271	(if (plist-member params :app-icon)
	272	""
	273	;; Otherwise send the default icon path
	274	notifications-application-icon))
	275	:string (or title "")
	276	:string (or body "")
	277	`(:array ,@actions)
	278	(or hints '(:array :signature "{sv}"))
	279	:int32 (or timeout -1)))
	280
db976e3c MA	281	;; Register close/action callback function. We must also remember
	282	;; the daemon's unique name, because the daemon could have
	283	;; restarted.
41a86354	284	(let ((on-action (plist-get params :on-action))
a41a6cf4 MA	285	(on-close (plist-get params :on-close))
a41a6cf4 MA	286	(unique-name (dbus-get-name-owner :session notifications-service)))
41a86354	287	(when on-action
a41a6cf4	288	(add-to-list 'notifications-on-action-map
6612a284 MA	289	(list (cons unique-name id) on-action))
	290	(unless notifications-on-action-object
	291	(setq notifications-on-action-object
	292	(dbus-register-signal
	293	:session
	294	nil
	295	notifications-path
	296	notifications-interface
	297	notifications-action-signal
	298	'notifications-on-action-signal))))
	299
41a86354	300	(when on-close
a41a6cf4	301	(add-to-list 'notifications-on-close-map
6612a284 MA	302	(list (cons unique-name id) on-close))
	303	(unless notifications-on-close-object
	304	(setq notifications-on-close-object
	305	(dbus-register-signal
	306	:session
	307	nil
	308	notifications-path
	309	notifications-interface
	310	notifications-closed-signal
	311	'notifications-on-closed-signal)))))
41a86354 MA	312
	313	;; Return notification id
	314	id))
	315
	316	(defun notifications-close-notification (id)
	317	"Close a notification with identifier ID."
	318	(dbus-call-method :session
	319	notifications-service
	320	notifications-path
	321	notifications-interface
	322	notifications-close-notification-method
	323	:int32 id))
	324
	325	(provide 'notifications)