Improve robustness for out-of-band copy in Tramp
[emacs.git] / lisp / notifications.el
blob87dc3c1e55c5abeb4b3e6cd47b33d8e80cafc38c
1 ;;; notifications.el --- Client interface to desktop notifications.
3 ;; Copyright (C) 2010-2016 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 (with-demoted-errors
206 (let ((bus (or (plist-get params :bus) :session))
207 (title (plist-get params :title))
208 (body (plist-get params :body))
209 (app-name (plist-get params :app-name))
210 (replaces-id (plist-get params :replaces-id))
211 (app-icon (plist-get params :app-icon))
212 (actions (plist-get params :actions))
213 (timeout (plist-get params :timeout))
214 ;; Hints
215 (hints '())
216 (urgency (plist-get params :urgency))
217 (category (plist-get params :category))
218 (desktop-entry (plist-get params :desktop-entry))
219 (image-data (plist-get params :image-data))
220 (image-path (plist-get params :image-path))
221 (action-items (plist-get params :action-items))
222 (sound-file (plist-get params :sound-file))
223 (sound-name (plist-get params :sound-name))
224 (suppress-sound (plist-get params :suppress-sound))
225 (resident (plist-get params :resident))
226 (transient (plist-get params :transient))
227 (x (plist-get params :x))
228 (y (plist-get params :y))
230 ;; Build hints array
231 (when urgency
232 (add-to-list 'hints `(:dict-entry
233 "urgency"
234 (:variant :byte ,(pcase urgency
235 (`low 0)
236 (`critical 2)
237 (_ 1)))) t))
238 (when category
239 (add-to-list 'hints `(:dict-entry
240 "category"
241 (:variant :string ,category)) t))
242 (when desktop-entry
243 (add-to-list 'hints `(:dict-entry
244 "desktop-entry"
245 (:variant :string ,desktop-entry)) t))
246 (when image-data
247 (add-to-list 'hints `(:dict-entry
248 "image-data"
249 (:variant :struct ,image-data)) t))
250 (when image-path
251 (add-to-list 'hints `(:dict-entry
252 "image-path"
253 (:variant :string ,image-path)) t))
254 (when action-items
255 (add-to-list 'hints `(:dict-entry
256 "action-items"
257 (:variant :boolean ,action-items)) t))
258 (when sound-file
259 (add-to-list 'hints `(:dict-entry
260 "sound-file"
261 (:variant :string ,sound-file)) t))
262 (when sound-name
263 (add-to-list 'hints `(:dict-entry
264 "sound-name"
265 (:variant :string ,sound-name)) t))
266 (when suppress-sound
267 (add-to-list 'hints `(:dict-entry
268 "suppress-sound"
269 (:variant :boolean ,suppress-sound)) t))
270 (when resident
271 (add-to-list 'hints `(:dict-entry
272 "resident"
273 (:variant :boolean ,resident)) t))
274 (when transient
275 (add-to-list 'hints `(:dict-entry
276 "transient"
277 (:variant :boolean ,transient)) t))
278 (when x
279 (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
280 (when y
281 (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
283 ;; Call Notify method.
284 (setq id
285 (dbus-call-method bus
286 notifications-service
287 notifications-path
288 notifications-interface
289 notifications-notify-method
290 :string (or app-name
291 notifications-application-name)
292 :uint32 (or replaces-id 0)
293 :string (if app-icon
294 (expand-file-name app-icon)
295 ;; If app-icon is nil because user
296 ;; requested it to be so, send the
297 ;; empty string
298 (if (plist-member params :app-icon)
300 ;; Otherwise send the
301 ;; default icon path
302 notifications-application-icon))
303 :string (or title "")
304 :string (or body "")
305 `(:array ,@actions)
306 (or hints '(:array :signature "{sv}"))
307 :int32 (or timeout -1)))
309 ;; Register close/action callback function. We must also
310 ;; remember the daemon's unique name, because the daemon could
311 ;; have restarted.
312 (let ((on-action (plist-get params :on-action))
313 (on-close (plist-get params :on-close))
314 (unique-name (dbus-get-name-owner bus notifications-service)))
315 (when on-action
316 (add-to-list 'notifications-on-action-map
317 (list (list bus unique-name id) on-action))
318 (unless notifications-on-action-object
319 (setq notifications-on-action-object
320 (dbus-register-signal
323 notifications-path
324 notifications-interface
325 notifications-action-signal
326 'notifications-on-action-signal))))
328 (when on-close
329 (add-to-list 'notifications-on-close-map
330 (list (list bus unique-name id) on-close))
331 (unless notifications-on-close-object
332 (setq notifications-on-close-object
333 (dbus-register-signal
336 notifications-path
337 notifications-interface
338 notifications-closed-signal
339 'notifications-on-closed-signal)))))
341 ;; Return notification id
342 id)))
344 (defun notifications-close-notification (id &optional bus)
345 "Close a notification with identifier ID.
346 BUS can be a string denoting a D-Bus connection, the default is `:session'."
347 (dbus-call-method (or bus :session)
348 notifications-service
349 notifications-path
350 notifications-interface
351 notifications-close-notification-method
352 :uint32 id))
354 (defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
356 (defun notifications-get-capabilities (&optional bus)
357 "Return the capabilities of the notification server, a list of symbols.
358 BUS can be a string denoting a D-Bus connection, the default is `:session'.
359 The following capabilities can be expected:
361 :actions The server will provide the specified actions
362 to the user.
363 :action-icons Supports using icons instead of text for
364 displaying actions.
365 :body Supports body text.
366 :body-hyperlinks The server supports hyperlinks in the notifications.
367 :body-images The server supports images in the notifications.
368 :body-markup Supports markup in the body text.
369 :icon-multi The server will render an animation of all the
370 frames in a given image array.
371 :icon-static Supports display of exactly 1 frame of any
372 given image array. This value is mutually exclusive
373 with `:icon-multi'.
374 :persistence The server supports persistence of notifications.
375 :sound The server supports sounds on notifications.
377 Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'."
378 (dbus-ignore-errors
379 (mapcar
380 (lambda (x) (intern (concat ":" x)))
381 (dbus-call-method (or bus :session)
382 notifications-service
383 notifications-path
384 notifications-interface
385 notifications-get-capabilities-method))))
387 (defun notifications-get-server-information (&optional bus)
388 "Return information on the notification server, a list of strings.
389 BUS can be a string denoting a D-Bus connection, the default is `:session'.
390 The returned list is (NAME VENDOR VERSION SPEC-VERSION).
392 NAME The product name of the server.
393 VENDOR The vendor name. For example, \"KDE\", \"GNOME\".
394 VERSION The server's version number.
395 SPEC-VERSION The specification version the server is compliant with.
397 If SPEC_VERSION is missing, the server supports a specification
398 prior to \"1.0\".
400 See `notifications-specification-version' for the specification
401 version this library is compliant with."
402 (dbus-ignore-errors
403 (dbus-call-method (or bus :session)
404 notifications-service
405 notifications-path
406 notifications-interface
407 notifications-get-server-information-method)))
409 (provide 'notifications)