Add 2012 to FSF copyright years for Emacs files
[bpt/emacs.git] / lisp / notifications.el
1 ;;; notifications.el --- Client interface to desktop notifications.
2
3 ;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
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
33 ;; For proper usage, Emacs must be started in an environment with an
34 ;; active D-Bus session bus.
35
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")
44 (declare-function dbus-register-signal "dbusbind.c")
45
46 (require 'dbus)
47
48 (defconst notifications-specification-version "1.1"
49 "The version of the Desktop Notifications Specification implemented.")
50
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
91 (defvar notifications-on-close-map nil
92 "Mapping between notification and close callback functions.")
93
94 (defun notifications-on-action-signal (id action)
95 "Dispatch signals to callback functions from `notifications-on-action-map'."
96 (let ((entry (assoc id notifications-on-action-map)))
97 (when entry
98 (funcall (cadr entry) id action)
99 (remove entry 'notifications-on-action-map))))
100
101 (when (fboundp 'dbus-register-signal)
102 (dbus-register-signal
103 :session
104 notifications-service
105 notifications-path
106 notifications-interface
107 notifications-action-signal
108 'notifications-on-action-signal))
109
110 (defun notifications-on-closed-signal (id reason)
111 "Dispatch signals to callback functions from `notifications-on-closed-map'."
112 (let ((entry (assoc id notifications-on-close-map)))
113 (when entry
114 (funcall (cadr entry)
115 id (cadr (assoc reason notifications-closed-reason)))
116 (remove entry 'notifications-on-close-map))))
117
118 (when (fboundp 'dbus-register-signal)
119 (dbus-register-signal
120 :session
121 notifications-service
122 notifications-path
123 notifications-interface
124 notifications-closed-signal
125 'notifications-on-closed-signal))
126
127 (defun notifications-notify (&rest params)
128 "Send notification via D-Bus using the Freedesktop notification protocol.
129 Various PARAMS can be set:
130
131 :title The notification title.
132 :body The notification body text.
133 :app-name The name of the application sending the notification.
134 Default to `notifications-application-name'.
135 :replaces-id The notification ID that this notification replaces.
136 :app-icon The notification icon.
137 Default is `notifications-application-icon'.
138 Set to nil if you do not want any icon displayed.
139 :actions A list of actions in the form:
140 (KEY TITLE KEY TITLE ...)
141 where KEY and TITLE are both strings.
142 The default action (usually invoked by clicking the
143 notification) should have a key named \"default\".
144 The title can be anything, though implementations are free
145 not to display it.
146 :timeout The timeout time in milliseconds since the display
147 of the notification at which the notification should
148 automatically close.
149 If -1, the notification's expiration time is dependent
150 on the notification server's settings, and may vary for
151 the type of notification.
152 If 0, the notification never expires.
153 Default value is -1.
154 :urgency The urgency level.
155 Either `low', `normal' or `critical'.
156 :category The type of notification this is.
157 :desktop-entry This specifies the name of the desktop filename representing
158 the calling program.
159 :image-data This is a raw data image format which describes the width,
160 height, rowstride, has alpha, bits per sample, channels and
161 image data respectively.
162 :image-path This is represented either as a URI (file:// is the
163 only URI schema supported right now) or a name
164 in a freedesktop.org-compliant icon theme.
165 :sound-file The path to a sound file to play when the notification pops up.
166 :sound-name A themable named sound from the freedesktop.org sound naming
167 specification to play when the notification pops up.
168 Similar to icon-name,only for sounds. An example would
169 be \"message-new-instant\".
170 :suppress-sound Causes the server to suppress playing any sounds, if it has
171 that ability.
172 :x Specifies the X location on the screen that the notification
173 should point to. The \"y\" hint must also be specified.
174 :y Specifies the Y location on the screen that the notification
175 should point to. The \"x\" hint must also be specified.
176 :on-action Function to call when an action is invoked.
177 The notification id and the key of the action are passed
178 as arguments to the function.
179 :on-close Function to call when the notification has been closed
180 by timeout or by the user.
181 The function receive the notification id and the closing
182 reason as arguments:
183 - `expired' if the notification has expired
184 - `dismissed' if the notification was dismissed by the user
185 - `close-notification' if the notification was closed
186 by a call to CloseNotification
187
188 This function returns a notification id, an integer, which can be
189 used to manipulate the notification item with
190 `notifications-close-notification'."
191 (let ((title (plist-get params :title))
192 (body (plist-get params :body))
193 (app-name (plist-get params :app-name))
194 (replaces-id (plist-get params :replaces-id))
195 (app-icon (plist-get params :app-icon))
196 (actions (plist-get params :actions))
197 (timeout (plist-get params :timeout))
198 ;; Hints
199 (hints '())
200 (urgency (plist-get params :urgency))
201 (category (plist-get params :category))
202 (desktop-entry (plist-get params :desktop-entry))
203 (image-data (plist-get params :image-data))
204 (image-path (plist-get params :image-path))
205 (sound-file (plist-get params :sound-file))
206 (sound-name (plist-get params :sound-name))
207 (suppress-sound (plist-get params :suppress-sound))
208 (x (plist-get params :x))
209 (y (plist-get params :y))
210 id)
211 ;; Build hints array
212 (when urgency
213 (add-to-list 'hints `(:dict-entry
214 "urgency"
215 (:variant :byte ,(case urgency
216 (low 0)
217 (critical 2)
218 (t 1)))) t))
219 (when category
220 (add-to-list 'hints `(:dict-entry
221 "category"
222 (:variant :string ,category)) t))
223 (when desktop-entry
224 (add-to-list 'hints `(:dict-entry
225 "desktop-entry"
226 (:variant :string ,desktop-entry)) t))
227 (when image-data
228 (add-to-list 'hints `(:dict-entry
229 "image_data"
230 (:variant :struct ,image-data)) t))
231 (when image-path
232 (add-to-list 'hints `(:dict-entry
233 "image_path"
234 (:variant :string ,image-path)) t))
235 (when sound-file
236 (add-to-list 'hints `(:dict-entry
237 "sound-file"
238 (:variant :string ,sound-file)) t))
239 (when sound-name
240 (add-to-list 'hints `(:dict-entry
241 "sound-name"
242 (:variant :string ,sound-name)) t))
243 (when suppress-sound
244 (add-to-list 'hints `(:dict-entry
245 "suppress-sound"
246 (:variant :boolean ,suppress-sound)) t))
247 (when x
248 (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
249 (when y
250 (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
251
252 ;; Call Notify method
253 (setq id
254 (dbus-call-method :session
255 notifications-service
256 notifications-path
257 notifications-interface
258 notifications-notify-method
259 :string (or app-name
260 notifications-application-name)
261 :uint32 (or replaces-id 0)
262 :string (if app-icon
263 (expand-file-name app-icon)
264 ;; If app-icon is nil because user
265 ;; requested it to be so, send the
266 ;; empty string
267 (if (plist-member params :app-icon)
268 ""
269 ;; Otherwise send the default icon path
270 notifications-application-icon))
271 :string (or title "")
272 :string (or body "")
273 `(:array ,@actions)
274 (or hints '(:array :signature "{sv}"))
275 :int32 (or timeout -1)))
276
277 ;; Register close/action callback function
278 (let ((on-action (plist-get params :on-action))
279 (on-close (plist-get params :on-close)))
280 (when on-action
281 (add-to-list 'notifications-on-action-map (list id on-action)))
282 (when on-close
283 (add-to-list 'notifications-on-close-map (list id on-close))))
284
285 ;; Return notification id
286 id))
287
288 (defun notifications-close-notification (id)
289 "Close a notification with identifier ID."
290 (dbus-call-method :session
291 notifications-service
292 notifications-path
293 notifications-interface
294 notifications-close-notification-method
295 :int32 id))
296
297 (provide 'notifications)