Commit | Line | Data |
---|---|---|
3a993e3d MA |
1 | ;;; dbus.el --- Elisp bindings for D-Bus. |
2 | ||
7d1112ae | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
3a993e3d MA |
4 | |
5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | |
6 | ;; Keywords: comm, hardware | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
874a927a | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
3a993e3d | 11 | ;; it under the terms of the GNU General Public License as published by |
874a927a GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
3a993e3d MA |
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 | |
874a927a | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
3a993e3d MA |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; This package provides language bindings for the D-Bus API. D-Bus | |
26 | ;; is a message bus system, a simple way for applications to talk to | |
27 | ;; one another. See <http://dbus.freedesktop.org/> for details. | |
28 | ||
29 | ;; Low-level language bindings are implemented in src/dbusbind.c. | |
30 | ||
31 | ;;; Code: | |
32 | ||
7bb7efbd | 33 | ;; D-Bus support in the Emacs core can be disabled with configuration |
6981d00a MA |
34 | ;; option "--without-dbus". Declare used subroutines and variables. |
35 | (declare-function dbus-call-method "dbusbind.c") | |
52a39a64 | 36 | (declare-function dbus-call-method-asynchronously "dbusbind.c") |
5e895c06 MA |
37 | (declare-function dbus-method-return-internal "dbusbind.c") |
38 | (declare-function dbus-method-error-internal "dbusbind.c") | |
6981d00a MA |
39 | (declare-function dbus-register-signal "dbusbind.c") |
40 | (defvar dbus-debug) | |
41 | (defvar dbus-registered-functions-table) | |
42 | ||
43 | ;; Pacify byte compiler. | |
44 | (eval-when-compile | |
45 | (require 'cl)) | |
7bb7efbd | 46 | |
3a993e3d MA |
47 | (require 'xml) |
48 | ||
49 | (defconst dbus-service-dbus "org.freedesktop.DBus" | |
50 | "The bus name used to talk to the bus itself.") | |
51 | ||
52 | (defconst dbus-path-dbus "/org/freedesktop/DBus" | |
53 | "The object path used to talk to the bus itself.") | |
54 | ||
55 | (defconst dbus-interface-dbus "org.freedesktop.DBus" | |
56 | "The interface exported by the object with `dbus-service-dbus' and `dbus-path-dbus'.") | |
57 | ||
4ba11bcb MA |
58 | (defconst dbus-interface-peer (concat dbus-interface-dbus ".Peer") |
59 | "The interface for peer objects.") | |
60 | ||
61 | (defconst dbus-interface-introspectable | |
62 | (concat dbus-interface-dbus ".Introspectable") | |
3a993e3d MA |
63 | "The interface supported by introspectable objects.") |
64 | ||
f636d3ca MA |
65 | (defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties") |
66 | "The interface for property objects.") | |
67 | ||
65b7cb2c MA |
68 | (defconst dbus-service-emacs "org.gnu.Emacs" |
69 | "The well known service name of Emacs.") | |
70 | ||
71 | (defconst dbus-path-emacs "/org/gnu/Emacs" | |
72 | "The object path head used by Emacs.") | |
73 | ||
98c38bfc MA |
74 | (defconst dbus-message-type-invalid 0 |
75 | "This value is never a valid message type.") | |
76 | ||
77 | (defconst dbus-message-type-method-call 1 | |
78 | "Message type of a method call message.") | |
79 | ||
80 | (defconst dbus-message-type-method-return 2 | |
81 | "Message type of a method return message.") | |
82 | ||
83 | (defconst dbus-message-type-error 3 | |
84 | "Message type of an error reply message.") | |
85 | ||
86 | (defconst dbus-message-type-signal 4 | |
87 | "Message type of a signal message.") | |
88 | ||
246a286b MA |
89 | (defmacro dbus-ignore-errors (&rest body) |
90 | "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil. | |
91 | Otherwise, return result of last form in BODY, or all other errors." | |
92 | `(condition-case err | |
93 | (progn ,@body) | |
94 | (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) | |
95 | ||
96 | (put 'dbus-ignore-errors 'lisp-indent-function 0) | |
98c38bfc | 97 | (put 'dbus-ignore-errors 'edebug-form-spec '(form body)) |
246a286b MA |
98 | (font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>")) |
99 | ||
5363d8ea MA |
100 | \f |
101 | ;;; Hash table of registered functions. | |
102 | ||
79945ac1 MA |
103 | ;; We create it here. So we have a simple test in dbusbind.c, whether |
104 | ;; the Lisp code has been loaded. | |
105 | (setq dbus-registered-functions-table (make-hash-table :test 'equal)) | |
5363d8ea | 106 | |
98c38bfc MA |
107 | (defvar dbus-return-values-table (make-hash-table :test 'equal) |
108 | "Hash table for temporary storing arguments of reply messages. | |
109 | A key in this hash table is a list (BUS SERIAL). BUS is either the | |
110 | symbol `:system' or the symbol `:session'. SERIAL is the serial number | |
111 | of the reply message. See `dbus-call-method-non-blocking-handler' and | |
112 | `dbus-call-method-non-blocking'.") | |
113 | ||
ef6ce14c | 114 | (defun dbus-list-hash-table () |
e49d337b | 115 | "Returns all registered member registrations to D-Bus. |
ef6ce14c MA |
116 | The return value is a list, with elements of kind (KEY . VALUE). |
117 | See `dbus-registered-functions-table' for a description of the | |
118 | hash table." | |
119 | (let (result) | |
120 | (maphash | |
121 | '(lambda (key value) (add-to-list 'result (cons key value) 'append)) | |
122 | dbus-registered-functions-table) | |
123 | result)) | |
124 | ||
246a286b MA |
125 | (defun dbus-unregister-object (object) |
126 | "Unregister OBJECT from D-Bus. | |
127 | OBJECT must be the result of a preceding `dbus-register-method' | |
f636d3ca MA |
128 | or `dbus-register-signal' call. It returns `t' if OBJECT has |
129 | been unregistered, `nil' otherwise." | |
246a286b MA |
130 | ;; Check parameter. |
131 | (unless (and (consp object) (not (null (car object))) (consp (cdr object))) | |
132 | (signal 'wrong-type-argument (list 'D-Bus object))) | |
133 | ||
134 | ;; Find the corresponding entry in the hash table. | |
135 | (let* ((key (car object)) | |
136 | (value (gethash key dbus-registered-functions-table))) | |
137 | ;; Loop over the registered functions. | |
138 | (while (consp value) | |
139 | ;; (car value) has the structure (UNAME SERVICE PATH HANDLER). | |
140 | ;; (cdr object) has the structure ((SERVICE PATH HANDLER) ...). | |
141 | (if (not (equal (cdr (car value)) (car (cdr object)))) | |
142 | (setq value (cdr value)) | |
143 | ;; Compute new hash value. If it is empty, remove it from | |
144 | ;; hash table. | |
145 | (unless | |
146 | (puthash | |
147 | key | |
148 | (delete (car value) (gethash key dbus-registered-functions-table)) | |
149 | dbus-registered-functions-table) | |
150 | (remhash key dbus-registered-functions-table)) | |
151 | (setq value t))) | |
152 | value)) | |
153 | ||
98c38bfc MA |
154 | (defun dbus-call-method-non-blocking-handler (&rest args) |
155 | "Handler for reply messages of asynchronous D-Bus message calls. | |
156 | It calls the function stored in `dbus-registered-functions-table'. | |
157 | The result will be made available in `dbus-return-values-table'." | |
158 | (puthash (list (dbus-event-bus-name last-input-event) | |
159 | (dbus-event-serial-number last-input-event)) | |
160 | (if (= (length args) 1) (car args) args) | |
161 | dbus-return-values-table)) | |
162 | ||
163 | (defun dbus-call-method-non-blocking | |
164 | (bus service path interface method &rest args) | |
165 | "Call METHOD on the D-Bus BUS, but don't block the event queue. | |
166 | This is necessary for communicating to registered D-Bus methods, | |
167 | which are running in the same Emacs process. | |
168 | ||
169 | The arguments are the same as in `dbus-call-method'. | |
170 | ||
171 | usage: (dbus-call-method-non-blocking | |
172 | BUS SERVICE PATH INTERFACE METHOD | |
173 | &optional :timeout TIMEOUT &rest ARGS)" | |
174 | ||
175 | (let ((key | |
176 | (apply | |
177 | 'dbus-call-method-asynchronously | |
178 | bus service path interface method | |
179 | 'dbus-call-method-non-blocking-handler args))) | |
180 | ;; Wait until `dbus-call-method-non-blocking-handler' has put the | |
181 | ;; result into `dbus-return-values-table'. | |
182 | (while (not (gethash key dbus-return-values-table nil)) | |
183 | (read-event nil nil 0.1)) | |
184 | ||
185 | ;; Cleanup `dbus-return-values-table'. Return the result. | |
186 | (prog1 | |
187 | (gethash key dbus-return-values-table nil) | |
188 | (remhash key dbus-return-values-table)))) | |
189 | ||
0e0c4247 | 190 | (defun dbus-name-owner-changed-handler (&rest args) |
e49d337b | 191 | "Reapplies all member registrations to D-Bus. |
ef6ce14c MA |
192 | This handler is applied when a \"NameOwnerChanged\" signal has |
193 | arrived. SERVICE is the object name for which the name owner has | |
194 | been changed. OLD-OWNER is the previous owner of SERVICE, or the | |
195 | empty string if SERVICE was not owned yet. NEW-OWNER is the new | |
0e0c4247 MA |
196 | owner of SERVICE, or the empty string if SERVICE looses any name owner. |
197 | ||
198 | usage: (dbus-name-owner-changed-handler service old-owner new-owner)" | |
ef6ce14c | 199 | (save-match-data |
0e0c4247 MA |
200 | ;; Check the arguments. We should silently ignore it when they |
201 | ;; are wrong. | |
202 | (if (and (= (length args) 3) | |
203 | (stringp (car args)) | |
204 | (stringp (cadr args)) | |
205 | (stringp (caddr args))) | |
206 | (let ((service (car args)) | |
207 | (old-owner (cadr args)) | |
208 | (new-owner (caddr args))) | |
209 | ;; Check whether SERVICE is a known name. | |
210 | (when (not (string-match "^:" service)) | |
211 | (maphash | |
212 | '(lambda (key value) | |
213 | (dolist (elt value) | |
e49d337b | 214 | ;; key has the structure (BUS INTERFACE MEMBER). |
0e0c4247 MA |
215 | ;; elt has the structure (UNAME SERVICE PATH HANDLER). |
216 | (when (string-equal old-owner (car elt)) | |
217 | ;; Remove old key, and add new entry with changed name. | |
7d1112ae | 218 | (dbus-unregister-object (list key (cdr elt))) |
0e0c4247 MA |
219 | ;; Maybe we could arrange the lists a little bit better |
220 | ;; that we don't need to extract every single element? | |
221 | (dbus-register-signal | |
222 | ;; BUS SERVICE PATH | |
223 | (nth 0 key) (nth 1 elt) (nth 2 elt) | |
e49d337b | 224 | ;; INTERFACE MEMBER HANDLER |
0e0c4247 MA |
225 | (nth 1 key) (nth 2 key) (nth 3 elt))))) |
226 | (copy-hash-table dbus-registered-functions-table)))) | |
227 | ;; The error is reported only in debug mode. | |
228 | (when dbus-debug | |
229 | (signal | |
230 | 'dbus-error | |
231 | (cons | |
232 | (format "Wrong arguments of %s.NameOwnerChanged" dbus-interface-dbus) | |
233 | args)))))) | |
ef6ce14c MA |
234 | |
235 | ;; Register the handler. | |
98c38bfc | 236 | (when nil ;ignore-errors |
246a286b MA |
237 | (dbus-register-signal |
238 | :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus | |
239 | "NameOwnerChanged" 'dbus-name-owner-changed-handler) | |
240 | (dbus-register-signal | |
241 | :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus | |
242 | "NameOwnerChanged" 'dbus-name-owner-changed-handler)) | |
ef6ce14c | 243 | |
5363d8ea MA |
244 | \f |
245 | ;;; D-Bus events. | |
246 | ||
3a993e3d MA |
247 | (defun dbus-check-event (event) |
248 | "Checks whether EVENT is a well formed D-Bus event. | |
249 | EVENT is a list which starts with symbol `dbus-event': | |
250 | ||
98c38bfc | 251 | (dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS) |
3a993e3d | 252 | |
e49d337b | 253 | BUS identifies the D-Bus the message is coming from. It is |
98c38bfc MA |
254 | either the symbol `:system' or the symbol `:session'. TYPE is |
255 | the D-Bus message type which has caused the event, SERIAL is the | |
256 | serial number of the received D-Bus message. SERVICE and PATH | |
257 | are the unique name and the object path of the D-Bus object | |
258 | emitting the message. INTERFACE and MEMBER denote the message | |
259 | which has been sent. HANDLER is the function which has been | |
260 | registered for this message. ARGS are the arguments passed to | |
261 | HANDLER, when it is called during event handling in | |
262 | `dbus-handle-event'. | |
3a993e3d MA |
263 | |
264 | This function raises a `dbus-error' signal in case the event is | |
265 | not well formed." | |
266 | (when dbus-debug (message "DBus-Event %s" event)) | |
267 | (unless (and (listp event) | |
268 | (eq (car event) 'dbus-event) | |
5363d8ea | 269 | ;; Bus symbol. |
ef6ce14c | 270 | (symbolp (nth 1 event)) |
98c38bfc MA |
271 | ;; Type. |
272 | (and (natnump (nth 2 event)) | |
273 | (< dbus-message-type-invalid (nth 2 event))) | |
e49d337b | 274 | ;; Serial. |
98c38bfc | 275 | (natnump (nth 3 event)) |
5363d8ea | 276 | ;; Service. |
98c38bfc | 277 | (or (= dbus-message-type-method-return (nth 2 event)) |
ba0b66b0 | 278 | (= dbus-message-type-error (nth 2 event)) |
98c38bfc | 279 | (stringp (nth 4 event))) |
e49d337b | 280 | ;; Object path. |
98c38bfc | 281 | (or (= dbus-message-type-method-return (nth 2 event)) |
ba0b66b0 | 282 | (= dbus-message-type-error (nth 2 event)) |
98c38bfc | 283 | (stringp (nth 5 event))) |
e49d337b | 284 | ;; Interface. |
98c38bfc | 285 | (or (= dbus-message-type-method-return (nth 2 event)) |
ba0b66b0 | 286 | (= dbus-message-type-error (nth 2 event)) |
98c38bfc | 287 | (stringp (nth 6 event))) |
e49d337b | 288 | ;; Member. |
98c38bfc | 289 | (or (= dbus-message-type-method-return (nth 2 event)) |
ba0b66b0 | 290 | (= dbus-message-type-error (nth 2 event)) |
98c38bfc | 291 | (stringp (nth 7 event))) |
ef6ce14c | 292 | ;; Handler. |
98c38bfc | 293 | (functionp (nth 8 event))) |
3a993e3d MA |
294 | (signal 'dbus-error (list "Not a valid D-Bus event" event)))) |
295 | ||
296 | ;;;###autoload | |
297 | (defun dbus-handle-event (event) | |
298 | "Handle events from the D-Bus. | |
5363d8ea | 299 | EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being |
98c38bfc MA |
300 | part of the event, is called with arguments ARGS. |
301 | If the HANDLER returns an `dbus-error', it is propagated as return message." | |
3a993e3d | 302 | (interactive "e") |
98c38bfc MA |
303 | (condition-case err |
304 | (let (result) | |
ba0b66b0 | 305 | ;; We ignore not well-formed events. |
98c38bfc | 306 | (dbus-check-event event) |
ba0b66b0 MA |
307 | ;; Error messages must be propagated. |
308 | (when (= dbus-message-type-error (nth 2 event)) | |
309 | (signal 'dbus-error (nthcdr 9 event))) | |
310 | ;; Apply the handler. | |
98c38bfc MA |
311 | (setq result (apply (nth 8 event) (nthcdr 9 event))) |
312 | ;; Return a message when it is a message call. | |
313 | (when (= dbus-message-type-method-call (nth 2 event)) | |
314 | (dbus-ignore-errors | |
315 | (dbus-method-return-internal | |
316 | (nth 1 event) (nth 3 event) (nth 4 event) result)))) | |
317 | ;; Error handling. | |
318 | (dbus-error | |
319 | ;; Return an error message when it is a message call. | |
320 | (when (= dbus-message-type-method-call (nth 2 event)) | |
321 | (dbus-ignore-errors | |
322 | (dbus-method-error-internal | |
323 | (nth 1 event) (nth 3 event) (nth 4 event) (cadr err)))) | |
ba0b66b0 MA |
324 | ;; Propagate D-Bus error messages. |
325 | (when (or dbus-debug (= dbus-message-type-error (nth 2 event))) | |
326 | (signal (car err) (cdr err)))))) | |
3a993e3d MA |
327 | |
328 | (defun dbus-event-bus-name (event) | |
329 | "Return the bus name the event is coming from. | |
330 | The result is either the symbol `:system' or the symbol `:session'. | |
331 | EVENT is a D-Bus event, see `dbus-check-event'. This function | |
332 | raises a `dbus-error' signal in case the event is not well | |
333 | formed." | |
334 | (dbus-check-event event) | |
ef6ce14c | 335 | (nth 1 event)) |
3a993e3d | 336 | |
98c38bfc MA |
337 | (defun dbus-event-message-type (event) |
338 | "Return the message type of the corresponding D-Bus message. | |
339 | The result is a number. EVENT is a D-Bus event, see | |
340 | `dbus-check-event'. This function raises a `dbus-error' signal | |
341 | in case the event is not well formed." | |
342 | (dbus-check-event event) | |
343 | (nth 2 event)) | |
344 | ||
e49d337b MA |
345 | (defun dbus-event-serial-number (event) |
346 | "Return the serial number of the corresponding D-Bus message. | |
98c38bfc MA |
347 | The result is a number. The serial number is needed for |
348 | generating a reply message. EVENT is a D-Bus event, see | |
349 | `dbus-check-event'. This function raises a `dbus-error' signal | |
350 | in case the event is not well formed." | |
e49d337b | 351 | (dbus-check-event event) |
98c38bfc | 352 | (nth 3 event)) |
e49d337b | 353 | |
3a993e3d | 354 | (defun dbus-event-service-name (event) |
5363d8ea | 355 | "Return the name of the D-Bus object the event is coming from. |
3a993e3d MA |
356 | The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. |
357 | This function raises a `dbus-error' signal in case the event is | |
358 | not well formed." | |
359 | (dbus-check-event event) | |
98c38bfc | 360 | (nth 4 event)) |
3a993e3d MA |
361 | |
362 | (defun dbus-event-path-name (event) | |
363 | "Return the object path of the D-Bus object the event is coming from. | |
364 | The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. | |
365 | This function raises a `dbus-error' signal in case the event is | |
366 | not well formed." | |
367 | (dbus-check-event event) | |
98c38bfc | 368 | (nth 5 event)) |
3a993e3d MA |
369 | |
370 | (defun dbus-event-interface-name (event) | |
371 | "Return the interface name of the D-Bus object the event is coming from. | |
372 | The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. | |
373 | This function raises a `dbus-error' signal in case the event is | |
374 | not well formed." | |
375 | (dbus-check-event event) | |
98c38bfc | 376 | (nth 6 event)) |
3a993e3d MA |
377 | |
378 | (defun dbus-event-member-name (event) | |
379 | "Return the member name the event is coming from. | |
380 | It is either a signal name or a method name. The result is is a | |
381 | string. EVENT is a D-Bus event, see `dbus-check-event'. This | |
382 | function raises a `dbus-error' signal in case the event is not | |
383 | well formed." | |
384 | (dbus-check-event event) | |
98c38bfc | 385 | (nth 7 event)) |
5363d8ea MA |
386 | |
387 | \f | |
388 | ;;; D-Bus registered names. | |
3a993e3d MA |
389 | |
390 | (defun dbus-list-activatable-names () | |
391 | "Return the D-Bus service names which can be activated as list. | |
f636d3ca | 392 | The result is a list of strings, which is `nil' when there are no |
3a993e3d | 393 | activatable service names at all." |
246a286b MA |
394 | (dbus-ignore-errors |
395 | (dbus-call-method | |
396 | :system dbus-service-dbus | |
397 | dbus-path-dbus dbus-interface-dbus "ListActivatableNames"))) | |
3a993e3d MA |
398 | |
399 | (defun dbus-list-names (bus) | |
400 | "Return the service names registered at D-Bus BUS. | |
f636d3ca MA |
401 | The result is a list of strings, which is `nil' when there are no |
402 | registered service names at all. Well known names are strings | |
403 | like \"org.freedesktop.DBus\". Names starting with \":\" are | |
404 | unique names for services." | |
246a286b MA |
405 | (dbus-ignore-errors |
406 | (dbus-call-method | |
407 | bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames"))) | |
3a993e3d MA |
408 | |
409 | (defun dbus-list-known-names (bus) | |
410 | "Retrieve all services which correspond to a known name in BUS. | |
411 | A service has a known name if it doesn't start with \":\"." | |
412 | (let (result) | |
413 | (dolist (name (dbus-list-names bus) result) | |
414 | (unless (string-equal ":" (substring name 0 1)) | |
415 | (add-to-list 'result name 'append))))) | |
416 | ||
417 | (defun dbus-list-queued-owners (bus service) | |
f636d3ca MA |
418 | "Return the unique names registered at D-Bus BUS and queued for SERVICE. |
419 | The result is a list of strings, or `nil' when there are no | |
420 | queued name owners service names at all." | |
246a286b MA |
421 | (dbus-ignore-errors |
422 | (dbus-call-method | |
423 | bus dbus-service-dbus dbus-path-dbus | |
424 | dbus-interface-dbus "ListQueuedOwners" service))) | |
3a993e3d MA |
425 | |
426 | (defun dbus-get-name-owner (bus service) | |
427 | "Return the name owner of SERVICE registered at D-Bus BUS. | |
f636d3ca | 428 | The result is either a string, or `nil' if there is no name owner." |
246a286b MA |
429 | (dbus-ignore-errors |
430 | (dbus-call-method | |
431 | bus dbus-service-dbus dbus-path-dbus | |
432 | dbus-interface-dbus "GetNameOwner" service))) | |
3a993e3d | 433 | |
4ba11bcb MA |
434 | (defun dbus-ping (bus service) |
435 | "Check whether SERVICE is registered for D-Bus BUS." | |
436 | ;; "Ping" raises a D-Bus error if SERVICE does not exist. | |
437 | ;; Otherwise, it returns silently with `nil'. | |
438 | (condition-case nil | |
439 | (not | |
440 | (dbus-call-method bus service dbus-path-dbus dbus-interface-peer "Ping")) | |
441 | (dbus-error nil))) | |
442 | ||
f636d3ca MA |
443 | \f |
444 | ;;; D-Bus introspection. | |
3a993e3d | 445 | |
f636d3ca MA |
446 | (defun dbus-introspect (bus service path) |
447 | "This function returns all interfaces and sub-nodes of SERVICE, | |
448 | registered at object path PATH at bus BUS. | |
449 | ||
450 | BUS must be either the symbol `:system' or the symbol `:session'. | |
451 | SERVICE must be a known service name, and PATH must be a valid | |
452 | object path. The last two parameters are strings. The result, | |
453 | the introspection data, is a string in XML format." | |
736215fd MA |
454 | ;; We don't want to raise errors. `dbus-call-method-non-blocking' |
455 | ;; is used, because the handler can be registered in our Emacs | |
456 | ;; instance; caller an callee would block each other. | |
246a286b | 457 | (dbus-ignore-errors |
736215fd | 458 | (dbus-call-method-non-blocking |
246a286b | 459 | bus service path dbus-interface-introspectable "Introspect"))) |
3a993e3d | 460 | |
f636d3ca MA |
461 | (defun dbus-introspect-xml (bus service path) |
462 | "Return the introspection data of SERVICE in D-Bus BUS at object path PATH. | |
463 | The data are a parsed list. The root object is a \"node\", | |
464 | representing the object path PATH. The root object can contain | |
465 | \"interface\" and further \"node\" objects." | |
466 | ;; We don't want to raise errors. | |
467 | (xml-node-name | |
468 | (ignore-errors | |
469 | (with-temp-buffer | |
470 | (insert (dbus-introspect bus service path)) | |
471 | (xml-parse-region (point-min) (point-max)))))) | |
472 | ||
473 | (defun dbus-introspect-get-attribute (object attribute) | |
474 | "Return the ATTRIBUTE value of D-Bus introspection OBJECT. | |
475 | ATTRIBUTE must be a string according to the attribute names in | |
476 | the D-Bus specification." | |
477 | (xml-get-attribute-or-nil object (intern attribute))) | |
478 | ||
479 | (defun dbus-introspect-get-node-names (bus service path) | |
480 | "Return all node names of SERVICE in D-Bus BUS at object path PATH. | |
481 | It returns a list of strings. The node names stand for further | |
482 | object paths of the D-Bus service." | |
483 | (let ((object (dbus-introspect-xml bus service path)) | |
484 | result) | |
485 | (dolist (elt (xml-get-children object 'node) result) | |
486 | (add-to-list | |
487 | 'result (dbus-introspect-get-attribute elt "name") 'append)))) | |
488 | ||
489 | (defun dbus-introspect-get-all-nodes (bus service path) | |
490 | "Return all node names of SERVICE in D-Bus BUS at object path PATH. | |
491 | It returns a list of strings, which are further object paths of SERVICE." | |
492 | (let ((result (list path))) | |
493 | (dolist (elt | |
494 | (dbus-introspect-get-node-names bus service path) | |
495 | result) | |
496 | (setq elt (expand-file-name elt path)) | |
497 | (setq result | |
498 | (append result (dbus-introspect-get-all-nodes bus service elt)))))) | |
499 | ||
500 | (defun dbus-introspect-get-interface-names (bus service path) | |
501 | "Return all interface names of SERVICE in D-Bus BUS at object path PATH. | |
502 | It returns a list of strings. | |
503 | ||
504 | There will be always the default interface | |
505 | \"org.freedesktop.DBus.Introspectable\". Another default | |
506 | interface is \"org.freedesktop.DBus.Properties\". If present, | |
507 | \"interface\" objects can also have \"property\" objects as | |
508 | children, beside \"method\" and \"signal\" objects." | |
509 | (let ((object (dbus-introspect-xml bus service path)) | |
510 | result) | |
511 | (dolist (elt (xml-get-children object 'interface) result) | |
512 | (add-to-list | |
513 | 'result (dbus-introspect-get-attribute elt "name") 'append)))) | |
514 | ||
515 | (defun dbus-introspect-get-interface (bus service path interface) | |
516 | "Return the INTERFACE of SERVICE in D-Bus BUS at object path PATH. | |
517 | The return value is an XML object. INTERFACE must be a string, | |
518 | element of the list returned by | |
519 | `dbus-introspect-get-interface-names'. The resulting | |
520 | \"interface\" object can contain \"method\", \"signal\", | |
521 | \"property\" and \"annotation\" children." | |
522 | (let ((elt (xml-get-children | |
523 | (dbus-introspect-xml bus service path) 'interface))) | |
524 | (while (and elt | |
525 | (not (string-equal | |
526 | interface | |
527 | (dbus-introspect-get-attribute (car elt) "name")))) | |
528 | (setq elt (cdr elt))) | |
529 | (car elt))) | |
530 | ||
531 | (defun dbus-introspect-get-method-names (bus service path interface) | |
532 | "Return a list of strings of all method names of INTERFACE. | |
533 | SERVICE is a service of D-Bus BUS at object path PATH." | |
534 | (let ((object (dbus-introspect-get-interface bus service path interface)) | |
535 | result) | |
536 | (dolist (elt (xml-get-children object 'method) result) | |
537 | (add-to-list | |
538 | 'result (dbus-introspect-get-attribute elt "name") 'append)))) | |
539 | ||
540 | (defun dbus-introspect-get-method (bus service path interface method) | |
541 | "Return method METHOD of interface INTERFACE as XML object. | |
542 | It must be located at SERVICE in D-Bus BUS at object path PATH. | |
543 | METHOD must be a string, element of the list returned by | |
544 | `dbus-introspect-get-method-names'. The resulting \"method\" | |
545 | object can contain \"arg\" and \"annotation\" children." | |
546 | (let ((elt (xml-get-children | |
547 | (dbus-introspect-get-interface bus service path interface) | |
548 | 'method))) | |
549 | (while (and elt | |
550 | (not (string-equal | |
551 | method (dbus-introspect-get-attribute (car elt) "name")))) | |
552 | (setq elt (cdr elt))) | |
553 | (car elt))) | |
554 | ||
555 | (defun dbus-introspect-get-signal-names (bus service path interface) | |
556 | "Return a list of strings of all signal names of INTERFACE. | |
557 | SERVICE is a service of D-Bus BUS at object path PATH." | |
558 | (let ((object (dbus-introspect-get-interface bus service path interface)) | |
559 | result) | |
560 | (dolist (elt (xml-get-children object 'signal) result) | |
561 | (add-to-list | |
562 | 'result (dbus-introspect-get-attribute elt "name") 'append)))) | |
563 | ||
564 | (defun dbus-introspect-get-signal (bus service path interface signal) | |
565 | "Return signal SIGNAL of interface INTERFACE as XML object. | |
566 | It must be located at SERVICE in D-Bus BUS at object path PATH. | |
567 | SIGNAL must be a string, element of the list returned by | |
568 | `dbus-introspect-get-signal-names'. The resulting \"signal\" | |
569 | object can contain \"arg\" and \"annotation\" children." | |
570 | (let ((elt (xml-get-children | |
571 | (dbus-introspect-get-interface bus service path interface) | |
572 | 'signal))) | |
573 | (while (and elt | |
574 | (not (string-equal | |
575 | signal (dbus-introspect-get-attribute (car elt) "name")))) | |
576 | (setq elt (cdr elt))) | |
577 | (car elt))) | |
578 | ||
579 | (defun dbus-introspect-get-property-names (bus service path interface) | |
580 | "Return a list of strings of all property names of INTERFACE. | |
581 | SERVICE is a service of D-Bus BUS at object path PATH." | |
582 | (let ((object (dbus-introspect-get-interface bus service path interface)) | |
583 | result) | |
584 | (dolist (elt (xml-get-children object 'property) result) | |
585 | (add-to-list | |
586 | 'result (dbus-introspect-get-attribute elt "name") 'append)))) | |
587 | ||
588 | (defun dbus-introspect-get-property (bus service path interface property) | |
589 | "This function returns PROPERTY of INTERFACE as XML object. | |
590 | It must be located at SERVICE in D-Bus BUS at object path PATH. | |
591 | PROPERTY must be a string, element of the list returned by | |
592 | `dbus-introspect-get-property-names'. The resulting PROPERTY | |
593 | object can contain \"annotation\" children." | |
594 | (let ((elt (xml-get-children | |
595 | (dbus-introspect-get-interface bus service path interface) | |
596 | 'property))) | |
597 | (while (and elt | |
598 | (not (string-equal | |
599 | property | |
600 | (dbus-introspect-get-attribute (car elt) "name")))) | |
601 | (setq elt (cdr elt))) | |
602 | (car elt))) | |
603 | ||
604 | (defun dbus-introspect-get-annotation-names | |
605 | (bus service path interface &optional name) | |
606 | "Return all annotation names as list of strings. | |
607 | If NAME is `nil', the annotations are children of INTERFACE, | |
608 | otherwise NAME must be a \"method\", \"signal\", or \"property\" | |
609 | object, where the annotations belong to." | |
610 | (let ((object | |
611 | (if name | |
612 | (or (dbus-introspect-get-method bus service path interface name) | |
613 | (dbus-introspect-get-signal bus service path interface name) | |
614 | (dbus-introspect-get-property bus service path interface name)) | |
615 | (dbus-introspect-get-interface bus service path interface))) | |
616 | result) | |
617 | (dolist (elt (xml-get-children object 'annotation) result) | |
618 | (add-to-list | |
619 | 'result (dbus-introspect-get-attribute elt "name") 'append)))) | |
620 | ||
621 | (defun dbus-introspect-get-annotation | |
622 | (bus service path interface name annotation) | |
623 | "Return ANNOTATION as XML object. | |
624 | If NAME is `nil', ANNOTATION is a child of INTERFACE, otherwise | |
625 | NAME must be the name of a \"method\", \"signal\", or | |
626 | \"property\" object, where the ANNOTATION belongs to." | |
627 | (let ((elt (xml-get-children | |
628 | (if name | |
629 | (or (dbus-introspect-get-method | |
630 | bus service path interface name) | |
631 | (dbus-introspect-get-signal | |
632 | bus service path interface name) | |
633 | (dbus-introspect-get-property | |
634 | bus service path interface name)) | |
635 | (dbus-introspect-get-interface bus service path interface)) | |
636 | 'annotation))) | |
637 | (while (and elt | |
638 | (not (string-equal | |
639 | annotation | |
640 | (dbus-introspect-get-attribute (car elt) "name")))) | |
641 | (setq elt (cdr elt))) | |
642 | (car elt))) | |
643 | ||
644 | (defun dbus-introspect-get-argument-names (bus service path interface name) | |
645 | "Return a list of all argument names as list of strings. | |
646 | NAME must be a \"method\" or \"signal\" object. | |
647 | ||
648 | Argument names are optional, the function can return `nil' | |
649 | therefore, even if the method or signal has arguments." | |
650 | (let ((object | |
651 | (or (dbus-introspect-get-method bus service path interface name) | |
652 | (dbus-introspect-get-signal bus service path interface name))) | |
653 | result) | |
654 | (dolist (elt (xml-get-children object 'arg) result) | |
655 | (add-to-list | |
656 | 'result (dbus-introspect-get-attribute elt "name") 'append)))) | |
657 | ||
658 | (defun dbus-introspect-get-argument (bus service path interface name arg) | |
659 | "Return argument ARG as XML object. | |
660 | NAME must be a \"method\" or \"signal\" object. ARG must be a | |
661 | string, element of the list returned by `dbus-introspect-get-argument-names'." | |
662 | (let ((elt (xml-get-children | |
663 | (or (dbus-introspect-get-method bus service path interface name) | |
664 | (dbus-introspect-get-signal bus service path interface name)) | |
665 | 'arg))) | |
666 | (while (and elt | |
667 | (not (string-equal | |
668 | arg (dbus-introspect-get-attribute (car elt) "name")))) | |
669 | (setq elt (cdr elt))) | |
670 | (car elt))) | |
671 | ||
672 | (defun dbus-introspect-get-signature | |
673 | (bus service path interface name &optional direction) | |
674 | "Return signature of a `method' or `signal', represented by NAME, as string. | |
675 | If NAME is a `method', DIRECTION can be either \"in\" or \"out\". | |
676 | If DIRECTION is `nil', \"in\" is assumed. | |
677 | ||
678 | If NAME is a `signal', and DIRECTION is non-`nil', DIRECTION must | |
679 | be \"out\"." | |
680 | ;; For methods, we use "in" as default direction. | |
681 | (let ((object (or (dbus-introspect-get-method | |
682 | bus service path interface name) | |
683 | (dbus-introspect-get-signal | |
684 | bus service path interface name)))) | |
685 | (when (and (string-equal | |
686 | "method" (dbus-introspect-get-attribute object "name")) | |
687 | (not (stringp direction))) | |
688 | (setq direction "in")) | |
689 | ;; In signals, no direction is given. | |
690 | (when (string-equal "signal" (dbus-introspect-get-attribute object "name")) | |
691 | (setq direction nil)) | |
692 | ;; Collect the signatures. | |
693 | (mapconcat | |
694 | '(lambda (x) | |
695 | (let ((arg (dbus-introspect-get-argument | |
696 | bus service path interface name x))) | |
697 | (if (or (not (stringp direction)) | |
698 | (string-equal | |
699 | direction | |
700 | (dbus-introspect-get-attribute arg "direction"))) | |
701 | (dbus-introspect-get-attribute arg "type") | |
702 | ""))) | |
703 | (dbus-introspect-get-argument-names bus service path interface name) | |
704 | ""))) | |
3a993e3d | 705 | |
f636d3ca MA |
706 | \f |
707 | ;;; D-Bus properties. | |
3a993e3d | 708 | |
f636d3ca MA |
709 | (defun dbus-get-property (bus service path interface property) |
710 | "Return the value of PROPERTY of INTERFACE. | |
711 | It will be checked at BUS, SERVICE, PATH. The result can be any | |
712 | valid D-Bus value, or `nil' if there is no PROPERTY." | |
246a286b | 713 | (dbus-ignore-errors |
f636d3ca MA |
714 | ;; We must check, whether the "org.freedesktop.DBus.Properties" |
715 | ;; interface is supported; otherwise the call blocks. | |
716 | (when | |
717 | (member | |
718 | "Get" | |
719 | (dbus-introspect-get-method-names | |
720 | bus service path "org.freedesktop.DBus.Properties")) | |
721 | ;; "Get" returns a variant, so we must use the car. | |
722 | (car | |
723 | (dbus-call-method | |
724 | bus service path dbus-interface-properties | |
725 | "Get" interface property))))) | |
726 | ||
727 | (defun dbus-set-property (bus service path interface property value) | |
728 | "Set value of PROPERTY of INTERFACE to VALUE. | |
729 | It will be checked at BUS, SERVICE, PATH. When the value has | |
730 | been set successful, the result is VALUE. Otherwise, `nil' is | |
731 | returned." | |
732 | (dbus-ignore-errors | |
733 | (when | |
734 | (and | |
735 | ;; We must check, whether the | |
736 | ;; "org.freedesktop.DBus.Properties" interface is supported; | |
737 | ;; otherwise the call blocks. | |
738 | (member | |
739 | "Set" | |
740 | (dbus-introspect-get-method-names | |
741 | bus service path "org.freedesktop.DBus.Properties")) | |
742 | ;; PROPERTY must be writable. | |
743 | (string-equal | |
744 | "readwrite" | |
745 | (dbus-introspect-get-attribute | |
ba0b66b0 | 746 | (dbus-introspect-get-property bus service path interface property) |
98c38bfc | 747 | "access"))) |
f636d3ca MA |
748 | ;; "Set" requires a variant. |
749 | (dbus-call-method | |
750 | bus service path dbus-interface-properties | |
751 | "Set" interface property (list :variant value)) | |
752 | ;; Return VALUE. | |
753 | (dbus-get-property bus service path interface property)))) | |
754 | ||
755 | (defun dbus-get-all-properties (bus service path interface) | |
756 | "Return all properties of INTERFACE at BUS, SERVICE, PATH. | |
757 | The result is a list of entries. Every entry is a cons of the | |
758 | name of the property, and its value. If there are no properties, | |
759 | `nil' is returned." | |
760 | ;; "org.freedesktop.DBus.Properties.GetAll" is not supported at | |
761 | ;; all interfaces. Therefore, we do it ourselves. | |
762 | (dbus-ignore-errors | |
763 | (let (result) | |
764 | (dolist (property | |
765 | (dbus-introspect-get-property-names | |
766 | bus service path interface) | |
767 | result) | |
768 | (add-to-list | |
769 | 'result | |
770 | (cons property (dbus-get-property bus service path interface property)) | |
771 | 'append))))) | |
3a993e3d MA |
772 | |
773 | (provide 'dbus) | |
774 | ||
79f10da0 | 775 | ;; arch-tag: a47caf84-9162-4811-90cc-5d388e37b9bd |
3a993e3d | 776 | ;;; dbus.el ends here |