Make called-interactively-p work for edebug or advised code.
[emacs.git] / lisp / notifications.el
blob6f477eb4cdd43c3a2618d649b592c380763ba966
1 ;;; notifications.el --- Client interface to desktop notifications.
3 ;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
5 ;; Author: Julien Danjou <julien@danjou.info>
6 ;; Keywords: comm desktop notifications
8 ;; This file is part of GNU Emacs.
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.
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.
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/>.
23 ;;; Commentary:
25 ;; This package provides an implementation of the Desktop Notifications
26 ;; <http://developer.gnome.org/notification-spec/>.
28 ;; In order to activate this package, you must add the following code
29 ;; into your .emacs:
31 ;; (require 'notifications)
33 ;; For proper usage, Emacs must be started in an environment with an
34 ;; active D-Bus session bus.
36 ;;; Code:
37 (require 'dbus)
39 (defconst notifications-specification-version "1.2"
40 "The version of the Desktop Notifications Specification implemented.")
42 (defconst notifications-application-name "Emacs"
43 "Default application name.")
45 (defconst notifications-application-icon
46 (expand-file-name
47 "images/icons/hicolor/scalable/apps/emacs.svg"
48 data-directory)
49 "Default application icon.")
51 (defconst notifications-service "org.freedesktop.Notifications"
52 "D-Bus notifications service name.")
54 (defconst notifications-path "/org/freedesktop/Notifications"
55 "D-Bus notifications service path.")
57 (defconst notifications-interface "org.freedesktop.Notifications"
58 "D-Bus notifications service interface.")
60 (defconst notifications-notify-method "Notify"
61 "D-Bus notifications notify method.")
63 (defconst notifications-close-notification-method "CloseNotification"
64 "D-Bus notifications close notification method.")
66 (defconst notifications-get-capabilities-method "GetCapabilities"
67 "D-Bus notifications get capabilities method.")
69 (defconst notifications-get-server-information-method "GetServerInformation"
70 "D-Bus notifications get server information method.")
72 (defconst notifications-action-signal "ActionInvoked"
73 "D-Bus notifications action signal.")
75 (defconst notifications-closed-signal "NotificationClosed"
76 "D-Bus notifications closed signal.")
78 (defconst notifications-closed-reason
79 '((1 expired)
80 (2 dismissed)
81 (3 close-notification)
82 (4 undefined))
83 "List of reasons why a notification has been closed.")
85 (defvar notifications-on-action-map nil
86 "Mapping between notification and action callback functions.")
88 (defvar notifications-on-action-object nil
89 "Object for registered on-action signal.")
91 (defvar notifications-on-close-map nil
92 "Mapping between notification and close callback functions.")
94 (defvar notifications-on-close-object nil
95 "Object for registered on-close signal.")
97 (defun notifications-on-action-signal (id action)
98 "Dispatch signals to callback functions from `notifications-on-action-map'."
99 (let* ((bus (dbus-event-bus-name last-input-event))
100 (unique-name (dbus-event-service-name last-input-event))
101 (entry (assoc (list bus unique-name id) notifications-on-action-map)))
102 (when entry
103 (funcall (cadr entry) id action)
104 (when (and (not (setq notifications-on-action-map
105 (remove entry notifications-on-action-map)))
106 notifications-on-action-object)
107 (dbus-unregister-object notifications-on-action-object)
108 (setq notifications-on-action-object nil)))))
110 (defun notifications-on-closed-signal (id &optional reason)
111 "Dispatch signals to callback functions from `notifications-on-closed-map'."
112 ;; notification-daemon prior 0.4.0 does not send a reason. So we
113 ;; make it optional, and assume `undefined' as default.
114 (let* ((bus (dbus-event-bus-name last-input-event))
115 (unique-name (dbus-event-service-name last-input-event))
116 (entry (assoc (list bus unique-name id) notifications-on-close-map))
117 (reason (or reason 4)))
118 (when entry
119 (funcall (cadr entry)
120 id (cadr (assoc reason notifications-closed-reason)))
121 (when (and (not (setq notifications-on-close-map
122 (remove entry notifications-on-close-map)))
123 notifications-on-close-object)
124 (dbus-unregister-object notifications-on-close-object)
125 (setq notifications-on-close-object nil)))))
127 (defun notifications-notify (&rest params)
128 "Send notification via D-Bus using the Freedesktop notification protocol.
129 Various PARAMS can be set:
131 :bus The D-Bus bus, if different from `:session'.
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.
143 The default action (usually invoked by clicking the
144 notification) should have a key named \"default\".
145 The title can be anything, though implementations are free
146 not to display it.
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 :action-items Whether the TITLE of the actions is interpreted as
158 a named icon.
159 :category The type of notification this is.
160 :desktop-entry This specifies the name of the desktop filename representing
161 the calling program.
162 :image-data This is a raw data image format which describes the width,
163 height, rowstride, has alpha, bits per sample, channels and
164 image data respectively.
165 :image-path This is represented either as a URI (file:// is the
166 only URI schema supported right now) or a name
167 in a freedesktop.org-compliant icon theme.
168 :sound-file The path to a sound file to play when the notification pops up.
169 :sound-name A themable named sound from the freedesktop.org sound naming
170 specification to play when the notification pops up.
171 Similar to icon-name,only for sounds. An example would
172 be \"message-new-instant\".
173 :suppress-sound Causes the server to suppress playing any sounds, if it has
174 that ability.
175 :resident When set the server will not automatically remove the
176 notification when an action has been invoked.
177 :transient When set the server will treat the notification as transient
178 and by-pass the server's persistence capability, if it
179 should exist.
180 :x Specifies the X location on the screen that the notification
181 should point to. The \"y\" hint must also be specified.
182 :y Specifies the Y location on the screen that the notification
183 should point to. The \"x\" hint must also be specified.
184 :on-action Function to call when an action is invoked.
185 The notification id and the key of the action are passed
186 as arguments to the function.
187 :on-close Function to call when the notification has been closed
188 by timeout or by the user.
189 The function receive the notification id and the closing
190 reason as arguments:
191 - `expired' if the notification has expired
192 - `dismissed' if the notification was dismissed by the user
193 - `close-notification' if the notification was closed
194 by a call to CloseNotification
195 - `undefined' if the notification server hasn't provided
196 a reason
198 Which parameters are accepted by the notification server can be
199 checked via `notifications-get-capabilities'.
201 This function returns a notification id, an integer, which can be
202 used to manipulate the notification item with
203 `notifications-close-notification' or the `:replaces-id' argument
204 of another `notifications-notify' call."
205 (let ((bus (or (plist-get params :bus) :session))
206 (title (plist-get params :title))
207 (body (plist-get params :body))
208 (app-name (plist-get params :app-name))
209 (replaces-id (plist-get params :replaces-id))
210 (app-icon (plist-get params :app-icon))
211 (actions (plist-get params :actions))
212 (timeout (plist-get params :timeout))
213 ;; Hints
214 (hints '())
215 (urgency (plist-get params :urgency))
216 (category (plist-get params :category))
217 (desktop-entry (plist-get params :desktop-entry))
218 (image-data (plist-get params :image-data))
219 (image-path (plist-get params :image-path))
220 (action-items (plist-get params :action-items))
221 (sound-file (plist-get params :sound-file))
222 (sound-name (plist-get params :sound-name))
223 (suppress-sound (plist-get params :suppress-sound))
224 (resident (plist-get params :resident))
225 (transient (plist-get params :transient))
226 (x (plist-get params :x))
227 (y (plist-get params :y))
229 ;; Build hints array
230 (when urgency
231 (add-to-list 'hints `(:dict-entry
232 "urgency"
233 (:variant :byte ,(pcase urgency
234 (`low 0)
235 (`critical 2)
236 (_ 1)))) t))
237 (when category
238 (add-to-list 'hints `(:dict-entry
239 "category"
240 (:variant :string ,category)) t))
241 (when desktop-entry
242 (add-to-list 'hints `(:dict-entry
243 "desktop-entry"
244 (:variant :string ,desktop-entry)) t))
245 (when image-data
246 (add-to-list 'hints `(:dict-entry
247 "image-data"
248 (:variant :struct ,image-data)) t))
249 (when image-path
250 (add-to-list 'hints `(:dict-entry
251 "image-path"
252 (:variant :string ,image-path)) t))
253 (when action-items
254 (add-to-list 'hints `(:dict-entry
255 "action-items"
256 (:variant :boolean ,action-items)) t))
257 (when sound-file
258 (add-to-list 'hints `(:dict-entry
259 "sound-file"
260 (:variant :string ,sound-file)) t))
261 (when sound-name
262 (add-to-list 'hints `(:dict-entry
263 "sound-name"
264 (:variant :string ,sound-name)) t))
265 (when suppress-sound
266 (add-to-list 'hints `(:dict-entry
267 "suppress-sound"
268 (:variant :boolean ,suppress-sound)) t))
269 (when resident
270 (add-to-list 'hints `(:dict-entry
271 "resident"
272 (:variant :boolean ,resident)) t))
273 (when transient
274 (add-to-list 'hints `(:dict-entry
275 "transient"
276 (:variant :boolean ,transient)) t))
277 (when x
278 (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
279 (when y
280 (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
282 ;; Call Notify method.
283 (setq id
284 (dbus-call-method bus
285 notifications-service
286 notifications-path
287 notifications-interface
288 notifications-notify-method
289 :string (or app-name
290 notifications-application-name)
291 :uint32 (or replaces-id 0)
292 :string (if app-icon
293 (expand-file-name app-icon)
294 ;; If app-icon is nil because user
295 ;; requested it to be so, send the
296 ;; empty string
297 (if (plist-member params :app-icon)
299 ;; Otherwise send the default icon path
300 notifications-application-icon))
301 :string (or title "")
302 :string (or body "")
303 `(:array ,@actions)
304 (or hints '(:array :signature "{sv}"))
305 :int32 (or timeout -1)))
307 ;; Register close/action callback function. We must also remember
308 ;; the daemon's unique name, because the daemon could have
309 ;; restarted.
310 (let ((on-action (plist-get params :on-action))
311 (on-close (plist-get params :on-close))
312 (unique-name (dbus-get-name-owner bus notifications-service)))
313 (when on-action
314 (add-to-list 'notifications-on-action-map
315 (list (list bus unique-name id) on-action))
316 (unless notifications-on-action-object
317 (setq notifications-on-action-object
318 (dbus-register-signal
321 notifications-path
322 notifications-interface
323 notifications-action-signal
324 'notifications-on-action-signal))))
326 (when on-close
327 (add-to-list 'notifications-on-close-map
328 (list (list bus unique-name id) on-close))
329 (unless notifications-on-close-object
330 (setq notifications-on-close-object
331 (dbus-register-signal
334 notifications-path
335 notifications-interface
336 notifications-closed-signal
337 'notifications-on-closed-signal)))))
339 ;; Return notification id
340 id))
342 (defun notifications-close-notification (id &optional bus)
343 "Close a notification with identifier ID.
344 BUS can be a string denoting a D-Bus connection, the default is `:session'."
345 (dbus-call-method (or bus :session)
346 notifications-service
347 notifications-path
348 notifications-interface
349 notifications-close-notification-method
350 :int32 id))
352 (defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
354 (defun notifications-get-capabilities (&optional bus)
355 "Return the capabilities of the notification server, a list of symbols.
356 BUS can be a string denoting a D-Bus connection, the default is `:session'.
357 The following capabilities can be expected:
359 :actions The server will provide the specified actions
360 to the user.
361 :action-icons Supports using icons instead of text for
362 displaying actions.
363 :body Supports body text.
364 :body-hyperlinks The server supports hyperlinks in the notifications.
365 :body-images The server supports images in the notifications.
366 :body-markup Supports markup in the body text.
367 :icon-multi The server will render an animation of all the
368 frames in a given image array.
369 :icon-static Supports display of exactly 1 frame of any
370 given image array. This value is mutually exclusive
371 with `:icon-multi'.
372 :persistence The server supports persistence of notifications.
373 :sound The server supports sounds on notifications.
375 Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'."
376 (dbus-ignore-errors
377 (mapcar
378 (lambda (x) (intern (concat ":" x)))
379 (dbus-call-method (or bus :session)
380 notifications-service
381 notifications-path
382 notifications-interface
383 notifications-get-capabilities-method))))
385 (defun notifications-get-server-information (&optional bus)
386 "Return information on the notification server, a list of strings.
387 BUS can be a string denoting a D-Bus connection, the default is `:session'.
388 The returned list is (NAME VENDOR VERSION SPEC-VERSION).
390 NAME The product name of the server.
391 VENDOR The vendor name. For example, \"KDE\", \"GNOME\".
392 VERSION The server's version number.
393 SPEC-VERSION The specification version the server is compliant with.
395 If SPEC_VERSION is missing, the server supports a specification
396 prior to \"1.0\".
398 See `notifications-specification-version' for the specification
399 version this library is compliant with."
400 (dbus-ignore-errors
401 (dbus-call-method (or bus :session)
402 notifications-service
403 notifications-path
404 notifications-interface
405 notifications-get-server-information-method)))
407 (provide 'notifications)