]> code.delx.au - gnu-emacs/blob - src/dbusbind.c
delx.au / code / gnu-emacs / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Simplify last change.
[gnu-emacs] / src / dbusbind.c
1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19 #include "config.h"
20
21 #ifdef HAVE_DBUS
22 #include <stdlib.h>
23 #include <stdio.h>
24 #include <dbus/dbus.h>
25 #include "lisp.h"
26 #include "frame.h"
27 #include "termhooks.h"
28 #include "keyboard.h"
29
30 \f
31 /* Subroutines. */
32 Lisp_Object Qdbus_get_unique_name;
33 Lisp_Object Qdbus_call_method;
34 Lisp_Object Qdbus_call_method_asynchronously;
35 Lisp_Object Qdbus_method_return_internal;
36 Lisp_Object Qdbus_method_error_internal;
37 Lisp_Object Qdbus_send_signal;
38 Lisp_Object Qdbus_register_signal;
39 Lisp_Object Qdbus_register_method;
40
41 /* D-Bus error symbol. */
42 Lisp_Object Qdbus_error;
43
44 /* Lisp symbols of the system and session buses. */
45 Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
46
47 /* Lisp symbol for method call timeout. */
48 Lisp_Object QCdbus_timeout;
49
50 /* Lisp symbols of D-Bus types. */
51 Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
52 Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
53 Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
54 Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
55 Lisp_Object QCdbus_type_double, QCdbus_type_string;
56 Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
57 Lisp_Object QCdbus_type_array, QCdbus_type_variant;
58 Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
59
60 /* Hash table which keeps function definitions. */
61 Lisp_Object Vdbus_registered_functions_table;
62
63 /* Whether to debug D-Bus. */
64 Lisp_Object Vdbus_debug;
65
66 /* Whether we are reading a D-Bus event. */
67 int xd_in_read_queued_messages = 0;
68
69 \f
70 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
71 we don't want to poison other namespaces with "dbus_". */
72
73 /* Raise a signal. If we are reading events, we cannot signal; we
74 throw to xd_read_queued_messages then. */
75 #define XD_SIGNAL1(arg) \
76 do { \
77 if (xd_in_read_queued_messages) \
78 Fthrow (Qdbus_error, Qnil); \
79 else \
80 xsignal1 (Qdbus_error, arg); \
81 } while (0)
82
83 #define XD_SIGNAL2(arg1, arg2) \
84 do { \
85 if (xd_in_read_queued_messages) \
86 Fthrow (Qdbus_error, Qnil); \
87 else \
88 xsignal2 (Qdbus_error, arg1, arg2); \
89 } while (0)
90
91 #define XD_SIGNAL3(arg1, arg2, arg3) \
92 do { \
93 if (xd_in_read_queued_messages) \
94 Fthrow (Qdbus_error, Qnil); \
95 else \
96 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
97 } while (0)
98
99 /* Raise a Lisp error from a D-Bus ERROR. */
100 #define XD_ERROR(error) \
101 do { \
102 char s[1024]; \
103 strncpy (s, error.message, 1023); \
104 dbus_error_free (&error); \
105 /* Remove the trailing newline. */ \
106 if (strchr (s, '\n') != NULL) \
107 s[strlen (s) - 1] = '\0'; \
108 XD_SIGNAL1 (build_string (s)); \
109 } while (0)
110
111 /* Macros for debugging. In order to enable them, build with
112 "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'". */
113 #ifdef DBUS_DEBUG
114 #define XD_DEBUG_MESSAGE(...) \
115 do { \
116 char s[1024]; \
117 snprintf (s, 1023, __VA_ARGS__); \
118 printf ("%s: %s\n", __func__, s); \
119 message ("%s: %s", __func__, s); \
120 } while (0)
121 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
122 do { \
123 if (!valid_lisp_object_p (object)) \
124 { \
125 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
126 XD_SIGNAL1 (build_string ("Assertion failure")); \
127 } \
128 } while (0)
129
130 #else /* !DBUS_DEBUG */
131 #define XD_DEBUG_MESSAGE(...) \
132 do { \
133 if (!NILP (Vdbus_debug)) \
134 { \
135 char s[1024]; \
136 snprintf (s, 1023, __VA_ARGS__); \
137 message ("%s: %s", __func__, s); \
138 } \
139 } while (0)
140 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
141 #endif
142
143 /* Check whether TYPE is a basic DBusType. */
144 #define XD_BASIC_DBUS_TYPE(type) \
145 ((type == DBUS_TYPE_BYTE) \
146 || (type == DBUS_TYPE_BOOLEAN) \
147 || (type == DBUS_TYPE_INT16) \
148 || (type == DBUS_TYPE_UINT16) \
149 || (type == DBUS_TYPE_INT32) \
150 || (type == DBUS_TYPE_UINT32) \
151 || (type == DBUS_TYPE_INT64) \
152 || (type == DBUS_TYPE_UINT64) \
153 || (type == DBUS_TYPE_DOUBLE) \
154 || (type == DBUS_TYPE_STRING) \
155 || (type == DBUS_TYPE_OBJECT_PATH) \
156 || (type == DBUS_TYPE_SIGNATURE))
157
158 /* This was a macro. On Solaris 2.11 it was said to compile for
159 hours, when optimzation is enabled. So we have transferred it into
160 a function. */
161 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
162 of the predefined D-Bus type symbols. */
163 static int
164 xd_symbol_to_dbus_type (object)
165 Lisp_Object object;
166 {
167 return
168 ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
169 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
170 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
171 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
172 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
173 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
174 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
175 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
176 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
177 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
178 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
179 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
180 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
181 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
182 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
183 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
184 : DBUS_TYPE_INVALID);
185 }
186
187 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
188 #define XD_DBUS_TYPE_P(object) \
189 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
190
191 /* Determine the DBusType of a given Lisp OBJECT. It is used to
192 convert Lisp objects, being arguments of `dbus-call-method' or
193 `dbus-send-signal', into corresponding C values appended as
194 arguments to a D-Bus message. */
195 #define XD_OBJECT_TO_DBUS_TYPE(object) \
196 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
197 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
198 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
199 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
200 : (STRINGP (object)) ? DBUS_TYPE_STRING \
201 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
202 : (CONSP (object)) \
203 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
204 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
205 ? DBUS_TYPE_ARRAY \
206 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
207 : DBUS_TYPE_ARRAY) \
208 : DBUS_TYPE_INVALID)
209
210 /* Return a list pointer which does not have a Lisp symbol as car. */
211 #define XD_NEXT_VALUE(object) \
212 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
213
214 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
215 used in dbus_message_iter_open_container. DTYPE is the DBusType
216 the object is related to. It is passed as argument, because it
217 cannot be detected in basic type objects, when they are preceded by
218 a type symbol. PARENT_TYPE is the DBusType of a container this
219 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
220 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
221 static void
222 xd_signature (signature, dtype, parent_type, object)
223 char *signature;
224 unsigned int dtype, parent_type;
225 Lisp_Object object;
226 {
227 unsigned int subtype;
228 Lisp_Object elt;
229 char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
230
231 elt = object;
232
233 switch (dtype)
234 {
235 case DBUS_TYPE_BYTE:
236 case DBUS_TYPE_UINT16:
237 case DBUS_TYPE_UINT32:
238 case DBUS_TYPE_UINT64:
239 CHECK_NATNUM (object);
240 sprintf (signature, "%c", dtype);
241 break;
242
243 case DBUS_TYPE_BOOLEAN:
244 if (!EQ (object, Qt) && !EQ (object, Qnil))
245 wrong_type_argument (intern ("booleanp"), object);
246 sprintf (signature, "%c", dtype);
247 break;
248
249 case DBUS_TYPE_INT16:
250 case DBUS_TYPE_INT32:
251 case DBUS_TYPE_INT64:
252 CHECK_NUMBER (object);
253 sprintf (signature, "%c", dtype);
254 break;
255
256 case DBUS_TYPE_DOUBLE:
257 CHECK_FLOAT (object);
258 sprintf (signature, "%c", dtype);
259 break;
260
261 case DBUS_TYPE_STRING:
262 case DBUS_TYPE_OBJECT_PATH:
263 case DBUS_TYPE_SIGNATURE:
264 CHECK_STRING (object);
265 sprintf (signature, "%c", dtype);
266 break;
267
268 case DBUS_TYPE_ARRAY:
269 /* Check that all list elements have the same D-Bus type. For
270 complex element types, we just check the container type, not
271 the whole element's signature. */
272 CHECK_CONS (object);
273
274 /* Type symbol is optional. */
275 if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
276 elt = XD_NEXT_VALUE (elt);
277
278 /* If the array is empty, DBUS_TYPE_STRING is the default
279 element type. */
280 if (NILP (elt))
281 {
282 subtype = DBUS_TYPE_STRING;
283 strcpy (x, DBUS_TYPE_STRING_AS_STRING);
284 }
285 else
286 {
287 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
288 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
289 }
290
291 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
292 only element, the value of this element is used as he array's
293 element signature. */
294 if ((subtype == DBUS_TYPE_SIGNATURE)
295 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
296 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
297 strcpy (x, SDATA (CAR_SAFE (XD_NEXT_VALUE (elt))));
298
299 while (!NILP (elt))
300 {
301 if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
302 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
303 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
304 }
305
306 sprintf (signature, "%c%s", dtype, x);
307 break;
308
309 case DBUS_TYPE_VARIANT:
310 /* Check that there is exactly one list element. */
311 CHECK_CONS (object);
312
313 elt = XD_NEXT_VALUE (elt);
314 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
315 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
316
317 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
318 wrong_type_argument (intern ("D-Bus"),
319 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
320
321 sprintf (signature, "%c", dtype);
322 break;
323
324 case DBUS_TYPE_STRUCT:
325 /* A struct list might contain any number of elements with
326 different types. No further check needed. */
327 CHECK_CONS (object);
328
329 elt = XD_NEXT_VALUE (elt);
330
331 /* Compose the signature from the elements. It is enclosed by
332 parentheses. */
333 sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
334 while (!NILP (elt))
335 {
336 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
337 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
338 strcat (signature, x);
339 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
340 }
341 strcat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
342 break;
343
344 case DBUS_TYPE_DICT_ENTRY:
345 /* Check that there are exactly two list elements, and the first
346 one is of basic type. The dictionary entry itself must be an
347 element of an array. */
348 CHECK_CONS (object);
349
350 /* Check the parent object type. */
351 if (parent_type != DBUS_TYPE_ARRAY)
352 wrong_type_argument (intern ("D-Bus"), object);
353
354 /* Compose the signature from the elements. It is enclosed by
355 curly braces. */
356 sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
357
358 /* First element. */
359 elt = XD_NEXT_VALUE (elt);
360 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
361 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
362 strcat (signature, x);
363
364 if (!XD_BASIC_DBUS_TYPE (subtype))
365 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
366
367 /* Second element. */
368 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
369 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
370 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
371 strcat (signature, x);
372
373 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
374 wrong_type_argument (intern ("D-Bus"),
375 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
376
377 /* Closing signature. */
378 strcat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
379 break;
380
381 default:
382 wrong_type_argument (intern ("D-Bus"), object);
383 }
384
385 XD_DEBUG_MESSAGE ("%s", signature);
386 }
387
388 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
389 DTYPE must be a valid DBusType. It is used to convert Lisp
390 objects, being arguments of `dbus-call-method' or
391 `dbus-send-signal', into corresponding C values appended as
392 arguments to a D-Bus message. */
393 static void
394 xd_append_arg (dtype, object, iter)
395 unsigned int dtype;
396 Lisp_Object object;
397 DBusMessageIter *iter;
398 {
399 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
400 DBusMessageIter subiter;
401
402 if (XD_BASIC_DBUS_TYPE (dtype))
403 switch (dtype)
404 {
405 case DBUS_TYPE_BYTE:
406 {
407 unsigned char val = XUINT (object) & 0xFF;
408 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
409 if (!dbus_message_iter_append_basic (iter, dtype, &val))
410 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
411 return;
412 }
413
414 case DBUS_TYPE_BOOLEAN:
415 {
416 dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
417 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
418 if (!dbus_message_iter_append_basic (iter, dtype, &val))
419 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
420 return;
421 }
422
423 case DBUS_TYPE_INT16:
424 {
425 dbus_int16_t val = XINT (object);
426 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
427 if (!dbus_message_iter_append_basic (iter, dtype, &val))
428 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
429 return;
430 }
431
432 case DBUS_TYPE_UINT16:
433 {
434 dbus_uint16_t val = XUINT (object);
435 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
436 if (!dbus_message_iter_append_basic (iter, dtype, &val))
437 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
438 return;
439 }
440
441 case DBUS_TYPE_INT32:
442 {
443 dbus_int32_t val = XINT (object);
444 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
445 if (!dbus_message_iter_append_basic (iter, dtype, &val))
446 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
447 return;
448 }
449
450 case DBUS_TYPE_UINT32:
451 {
452 dbus_uint32_t val = XUINT (object);
453 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
454 if (!dbus_message_iter_append_basic (iter, dtype, &val))
455 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
456 return;
457 }
458
459 case DBUS_TYPE_INT64:
460 {
461 dbus_int64_t val = XINT (object);
462 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
463 if (!dbus_message_iter_append_basic (iter, dtype, &val))
464 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
465 return;
466 }
467
468 case DBUS_TYPE_UINT64:
469 {
470 dbus_uint64_t val = XUINT (object);
471 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
472 if (!dbus_message_iter_append_basic (iter, dtype, &val))
473 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
474 return;
475 }
476
477 case DBUS_TYPE_DOUBLE:
478 XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT_DATA (object));
479 if (!dbus_message_iter_append_basic (iter, dtype,
480 &XFLOAT_DATA (object)))
481 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
482 return;
483
484 case DBUS_TYPE_STRING:
485 case DBUS_TYPE_OBJECT_PATH:
486 case DBUS_TYPE_SIGNATURE:
487 {
488 char *val = SDATA (Fstring_make_unibyte (object));
489 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
490 if (!dbus_message_iter_append_basic (iter, dtype, &val))
491 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
492 return;
493 }
494 }
495
496 else /* Compound types. */
497 {
498
499 /* All compound types except array have a type symbol. For
500 array, it is optional. Skip it. */
501 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
502 object = XD_NEXT_VALUE (object);
503
504 /* Open new subiteration. */
505 switch (dtype)
506 {
507 case DBUS_TYPE_ARRAY:
508 /* An array has only elements of the same type. So it is
509 sufficient to check the first element's signature
510 only. */
511
512 if (NILP (object))
513 /* If the array is empty, DBUS_TYPE_STRING is the default
514 element type. */
515 strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
516
517 else
518 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
519 the only element, the value of this element is used as
520 the array's element signature. */
521 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
522 == DBUS_TYPE_SIGNATURE)
523 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
524 && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
525 {
526 strcpy (signature, SDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
527 object = CDR_SAFE (XD_NEXT_VALUE (object));
528 }
529
530 else
531 xd_signature (signature,
532 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
533 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
534
535 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
536 SDATA (format2 ("%s", object, Qnil)));
537 if (!dbus_message_iter_open_container (iter, dtype,
538 signature, &subiter))
539 XD_SIGNAL3 (build_string ("Cannot open container"),
540 make_number (dtype), build_string (signature));
541 break;
542
543 case DBUS_TYPE_VARIANT:
544 /* A variant has just one element. */
545 xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
546 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
547
548 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
549 SDATA (format2 ("%s", object, Qnil)));
550 if (!dbus_message_iter_open_container (iter, dtype,
551 signature, &subiter))
552 XD_SIGNAL3 (build_string ("Cannot open container"),
553 make_number (dtype), build_string (signature));
554 break;
555
556 case DBUS_TYPE_STRUCT:
557 case DBUS_TYPE_DICT_ENTRY:
558 /* These containers do not require a signature. */
559 XD_DEBUG_MESSAGE ("%c %s", dtype,
560 SDATA (format2 ("%s", object, Qnil)));
561 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
562 XD_SIGNAL2 (build_string ("Cannot open container"),
563 make_number (dtype));
564 break;
565 }
566
567 /* Loop over list elements. */
568 while (!NILP (object))
569 {
570 dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
571 object = XD_NEXT_VALUE (object);
572
573 xd_append_arg (dtype, CAR_SAFE (object), &subiter);
574
575 object = CDR_SAFE (object);
576 }
577
578 /* Close the subiteration. */
579 if (!dbus_message_iter_close_container (iter, &subiter))
580 XD_SIGNAL2 (build_string ("Cannot close container"),
581 make_number (dtype));
582 }
583 }
584
585 /* Retrieve C value from a DBusMessageIter structure ITER, and return
586 a converted Lisp object. The type DTYPE of the argument of the
587 D-Bus message must be a valid DBusType. Compound D-Bus types
588 result always in a Lisp list. */
589 static Lisp_Object
590 xd_retrieve_arg (dtype, iter)
591 unsigned int dtype;
592 DBusMessageIter *iter;
593 {
594
595 switch (dtype)
596 {
597 case DBUS_TYPE_BYTE:
598 {
599 unsigned int val;
600 dbus_message_iter_get_basic (iter, &val);
601 val = val & 0xFF;
602 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
603 return make_number (val);
604 }
605
606 case DBUS_TYPE_BOOLEAN:
607 {
608 dbus_bool_t val;
609 dbus_message_iter_get_basic (iter, &val);
610 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
611 return (val == FALSE) ? Qnil : Qt;
612 }
613
614 case DBUS_TYPE_INT16:
615 case DBUS_TYPE_UINT16:
616 {
617 dbus_uint16_t val;
618 dbus_message_iter_get_basic (iter, &val);
619 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
620 return make_number (val);
621 }
622
623 case DBUS_TYPE_INT32:
624 case DBUS_TYPE_UINT32:
625 {
626 /* Assignment to EMACS_INT stops GCC whining about limited
627 range of data type. */
628 dbus_uint32_t val;
629 EMACS_INT val1;
630 dbus_message_iter_get_basic (iter, &val);
631 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
632 val1 = val;
633 return make_fixnum_or_float (val1);
634 }
635
636 case DBUS_TYPE_INT64:
637 case DBUS_TYPE_UINT64:
638 {
639 dbus_uint64_t val;
640 dbus_message_iter_get_basic (iter, &val);
641 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
642 return make_fixnum_or_float (val);
643 }
644
645 case DBUS_TYPE_DOUBLE:
646 {
647 double val;
648 dbus_message_iter_get_basic (iter, &val);
649 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
650 return make_float (val);
651 }
652
653 case DBUS_TYPE_STRING:
654 case DBUS_TYPE_OBJECT_PATH:
655 case DBUS_TYPE_SIGNATURE:
656 {
657 char *val;
658 dbus_message_iter_get_basic (iter, &val);
659 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
660 return build_string (val);
661 }
662
663 case DBUS_TYPE_ARRAY:
664 case DBUS_TYPE_VARIANT:
665 case DBUS_TYPE_STRUCT:
666 case DBUS_TYPE_DICT_ENTRY:
667 {
668 Lisp_Object result;
669 struct gcpro gcpro1;
670 result = Qnil;
671 GCPRO1 (result);
672 DBusMessageIter subiter;
673 int subtype;
674 dbus_message_iter_recurse (iter, &subiter);
675 while ((subtype = dbus_message_iter_get_arg_type (&subiter))
676 != DBUS_TYPE_INVALID)
677 {
678 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
679 dbus_message_iter_next (&subiter);
680 }
681 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil)));
682 RETURN_UNGCPRO (Fnreverse (result));
683 }
684
685 default:
686 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
687 return Qnil;
688 }
689 }
690
691 /* Initialize D-Bus connection. BUS is a Lisp symbol, either :system
692 or :session. It tells which D-Bus to be initialized. */
693 static DBusConnection *
694 xd_initialize (bus)
695 Lisp_Object bus;
696 {
697 DBusConnection *connection;
698 DBusError derror;
699
700 /* Parameter check. */
701 CHECK_SYMBOL (bus);
702 if (!((EQ (bus, QCdbus_system_bus)) || (EQ (bus, QCdbus_session_bus))))
703 XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
704
705 /* Open a connection to the bus. */
706 dbus_error_init (&derror);
707
708 if (EQ (bus, QCdbus_system_bus))
709 connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
710 else
711 connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
712
713 if (dbus_error_is_set (&derror))
714 XD_ERROR (derror);
715
716 if (connection == NULL)
717 XD_SIGNAL2 (build_string ("No connection"), bus);
718
719 /* Return the result. */
720 return connection;
721 }
722
723 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
724 1, 1, 0,
725 doc: /* Return the unique name of Emacs registered at D-Bus BUS. */)
726 (bus)
727 Lisp_Object bus;
728 {
729 DBusConnection *connection;
730 const char *name;
731
732 /* Check parameters. */
733 CHECK_SYMBOL (bus);
734
735 /* Open a connection to the bus. */
736 connection = xd_initialize (bus);
737
738 /* Request the name. */
739 name = dbus_bus_get_unique_name (connection);
740 if (name == NULL)
741 XD_SIGNAL1 (build_string ("No unique name available"));
742
743 /* Return. */
744 return build_string (name);
745 }
746
747 DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0,
748 doc: /* Call METHOD on the D-Bus BUS.
749
750 BUS is either the symbol `:system' or the symbol `:session'.
751
752 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
753 object path SERVICE is registered at. INTERFACE is an interface
754 offered by SERVICE. It must provide METHOD.
755
756 If the parameter `:timeout' is given, the following integer TIMEOUT
757 specifies the maximun number of milliseconds the method call must
758 return. The default value is 25.000. If the method call doesn't
759 return in time, a D-Bus error is raised.
760
761 All other arguments ARGS are passed to METHOD as arguments. They are
762 converted into D-Bus types via the following rules:
763
764 t and nil => DBUS_TYPE_BOOLEAN
765 number => DBUS_TYPE_UINT32
766 integer => DBUS_TYPE_INT32
767 float => DBUS_TYPE_DOUBLE
768 string => DBUS_TYPE_STRING
769 list => DBUS_TYPE_ARRAY
770
771 All arguments can be preceded by a type symbol. For details about
772 type symbols, see Info node `(dbus)Type Conversion'.
773
774 `dbus-call-method' returns the resulting values of METHOD as a list of
775 Lisp objects. The type conversion happens the other direction as for
776 input arguments. It follows the mapping rules:
777
778 DBUS_TYPE_BOOLEAN => t or nil
779 DBUS_TYPE_BYTE => number
780 DBUS_TYPE_UINT16 => number
781 DBUS_TYPE_INT16 => integer
782 DBUS_TYPE_UINT32 => number or float
783 DBUS_TYPE_INT32 => integer or float
784 DBUS_TYPE_UINT64 => number or float
785 DBUS_TYPE_INT64 => integer or float
786 DBUS_TYPE_DOUBLE => float
787 DBUS_TYPE_STRING => string
788 DBUS_TYPE_OBJECT_PATH => string
789 DBUS_TYPE_SIGNATURE => string
790 DBUS_TYPE_ARRAY => list
791 DBUS_TYPE_VARIANT => list
792 DBUS_TYPE_STRUCT => list
793 DBUS_TYPE_DICT_ENTRY => list
794
795 Example:
796
797 \(dbus-call-method
798 :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
799 "org.gnome.seahorse.Keys" "GetKeyField"
800 "openpgp:657984B8C7A966DD" "simple-name")
801
802 => (t ("Philip R. Zimmermann"))
803
804 If the result of the METHOD call is just one value, the converted Lisp
805 object is returned instead of a list containing this single Lisp object.
806
807 \(dbus-call-method
808 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
809 "org.freedesktop.Hal.Device" "GetPropertyString"
810 "system.kernel.machine")
811
812 => "i686"
813
814 usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
815 (nargs, args)
816 int nargs;
817 register Lisp_Object *args;
818 {
819 Lisp_Object bus, service, path, interface, method;
820 Lisp_Object result;
821 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
822 DBusConnection *connection;
823 DBusMessage *dmessage;
824 DBusMessage *reply;
825 DBusMessageIter iter;
826 DBusError derror;
827 unsigned int dtype;
828 int timeout = -1;
829 int i = 5;
830 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
831
832 /* Check parameters. */
833 bus = args[0];
834 service = args[1];
835 path = args[2];
836 interface = args[3];
837 method = args[4];
838
839 CHECK_SYMBOL (bus);
840 CHECK_STRING (service);
841 CHECK_STRING (path);
842 CHECK_STRING (interface);
843 CHECK_STRING (method);
844 GCPRO5 (bus, service, path, interface, method);
845
846 XD_DEBUG_MESSAGE ("%s %s %s %s",
847 SDATA (service),
848 SDATA (path),
849 SDATA (interface),
850 SDATA (method));
851
852 /* Open a connection to the bus. */
853 connection = xd_initialize (bus);
854
855 /* Create the message. */
856 dmessage = dbus_message_new_method_call (SDATA (service),
857 SDATA (path),
858 SDATA (interface),
859 SDATA (method));
860 UNGCPRO;
861 if (dmessage == NULL)
862 XD_SIGNAL1 (build_string ("Unable to create a new message"));
863
864 /* Check for timeout parameter. */
865 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
866 {
867 CHECK_NATNUM (args[i+1]);
868 timeout = XUINT (args[i+1]);
869 i = i+2;
870 }
871
872 /* Initialize parameter list of message. */
873 dbus_message_iter_init_append (dmessage, &iter);
874
875 /* Append parameters to the message. */
876 for (; i < nargs; ++i)
877 {
878 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
879 if (XD_DBUS_TYPE_P (args[i]))
880 {
881 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
882 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
883 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
884 SDATA (format2 ("%s", args[i], Qnil)),
885 SDATA (format2 ("%s", args[i+1], Qnil)));
886 ++i;
887 }
888 else
889 {
890 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
891 XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
892 SDATA (format2 ("%s", args[i], Qnil)));
893 }
894
895 /* Check for valid signature. We use DBUS_TYPE_INVALID as
896 indication that there is no parent type. */
897 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
898
899 xd_append_arg (dtype, args[i], &iter);
900 }
901
902 /* Send the message. */
903 dbus_error_init (&derror);
904 reply = dbus_connection_send_with_reply_and_block (connection,
905 dmessage,
906 timeout,
907 &derror);
908
909 if (dbus_error_is_set (&derror))
910 XD_ERROR (derror);
911
912 if (reply == NULL)
913 XD_SIGNAL1 (build_string ("No reply"));
914
915 XD_DEBUG_MESSAGE ("Message sent");
916
917 /* Collect the results. */
918 result = Qnil;
919 GCPRO1 (result);
920
921 if (dbus_message_iter_init (reply, &iter))
922 {
923 /* Loop over the parameters of the D-Bus reply message. Construct a
924 Lisp list, which is returned by `dbus-call-method'. */
925 while ((dtype = dbus_message_iter_get_arg_type (&iter))
926 != DBUS_TYPE_INVALID)
927 {
928 result = Fcons (xd_retrieve_arg (dtype, &iter), result);
929 dbus_message_iter_next (&iter);
930 }
931 }
932 else
933 {
934 /* No arguments: just return nil. */
935 }
936
937 /* Cleanup. */
938 dbus_message_unref (dmessage);
939 dbus_message_unref (reply);
940
941 /* Return the result. If there is only one single Lisp object,
942 return it as-it-is, otherwise return the reversed list. */
943 if (XUINT (Flength (result)) == 1)
944 RETURN_UNGCPRO (CAR_SAFE (result));
945 else
946 RETURN_UNGCPRO (Fnreverse (result));
947 }
948
949 DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
950 Sdbus_call_method_asynchronously, 6, MANY, 0,
951 doc: /* Call METHOD on the D-Bus BUS asynchronously.
952
953 BUS is either the symbol `:system' or the symbol `:session'.
954
955 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
956 object path SERVICE is registered at. INTERFACE is an interface
957 offered by SERVICE. It must provide METHOD.
958
959 HANDLER is a Lisp function, which is called when the corresponding
960 return message has arrived.
961
962 If the parameter `:timeout' is given, the following integer TIMEOUT
963 specifies the maximun number of milliseconds the method call must
964 return. The default value is 25.000. If the method call doesn't
965 return in time, a D-Bus error is raised.
966
967 All other arguments ARGS are passed to METHOD as arguments. They are
968 converted into D-Bus types via the following rules:
969
970 t and nil => DBUS_TYPE_BOOLEAN
971 number => DBUS_TYPE_UINT32
972 integer => DBUS_TYPE_INT32
973 float => DBUS_TYPE_DOUBLE
974 string => DBUS_TYPE_STRING
975 list => DBUS_TYPE_ARRAY
976
977 All arguments can be preceded by a type symbol. For details about
978 type symbols, see Info node `(dbus)Type Conversion'.
979
980 The function returns a key into the hash table
981 `dbus-registered-functions-table'. The corresponding entry in the
982 hash table is removed, when the return message has been arrived, and
983 HANDLER is called.
984
985 Example:
986
987 \(dbus-call-method-asynchronously
988 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
989 "org.freedesktop.Hal.Device" "GetPropertyString" 'message
990 "system.kernel.machine")
991
992 => (:system 2)
993
994 -| i686
995
996 usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
997 (nargs, args)
998 int nargs;
999 register Lisp_Object *args;
1000 {
1001 Lisp_Object bus, service, path, interface, method, handler;
1002 Lisp_Object result;
1003 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1004 DBusConnection *connection;
1005 DBusMessage *dmessage;
1006 DBusMessageIter iter;
1007 unsigned int dtype;
1008 int timeout = -1;
1009 int i = 6;
1010 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1011
1012 /* Check parameters. */
1013 bus = args[0];
1014 service = args[1];
1015 path = args[2];
1016 interface = args[3];
1017 method = args[4];
1018 handler = args[5];
1019
1020 CHECK_SYMBOL (bus);
1021 CHECK_STRING (service);
1022 CHECK_STRING (path);
1023 CHECK_STRING (interface);
1024 CHECK_STRING (method);
1025 if (!FUNCTIONP (handler))
1026 wrong_type_argument (intern ("functionp"), handler);
1027 GCPRO6 (bus, service, path, interface, method, handler);
1028
1029 XD_DEBUG_MESSAGE ("%s %s %s %s",
1030 SDATA (service),
1031 SDATA (path),
1032 SDATA (interface),
1033 SDATA (method));
1034
1035 /* Open a connection to the bus. */
1036 connection = xd_initialize (bus);
1037
1038 /* Create the message. */
1039 dmessage = dbus_message_new_method_call (SDATA (service),
1040 SDATA (path),
1041 SDATA (interface),
1042 SDATA (method));
1043 if (dmessage == NULL)
1044 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1045
1046 /* Check for timeout parameter. */
1047 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
1048 {
1049 CHECK_NATNUM (args[i+1]);
1050 timeout = XUINT (args[i+1]);
1051 i = i+2;
1052 }
1053
1054 /* Initialize parameter list of message. */
1055 dbus_message_iter_init_append (dmessage, &iter);
1056
1057 /* Append parameters to the message. */
1058 for (; i < nargs; ++i)
1059 {
1060 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1061 if (XD_DBUS_TYPE_P (args[i]))
1062 {
1063 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1064 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1065 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1066 SDATA (format2 ("%s", args[i], Qnil)),
1067 SDATA (format2 ("%s", args[i+1], Qnil)));
1068 ++i;
1069 }
1070 else
1071 {
1072 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1073 XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1074 SDATA (format2 ("%s", args[i], Qnil)));
1075 }
1076
1077 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1078 indication that there is no parent type. */
1079 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1080
1081 xd_append_arg (dtype, args[i], &iter);
1082 }
1083
1084 /* Send the message. The message is just added to the outgoing
1085 message queue. */
1086 if (!dbus_connection_send_with_reply (connection, dmessage, NULL, timeout))
1087 XD_SIGNAL1 (build_string ("Cannot send message"));
1088
1089 XD_DEBUG_MESSAGE ("Message sent");
1090
1091 /* The result is the key in Vdbus_registered_functions_table. */
1092 result = (list2 (bus, make_number (dbus_message_get_serial (dmessage))));
1093
1094 /* Create a hash table entry. */
1095 Fputhash (result, handler, Vdbus_registered_functions_table);
1096
1097 /* Cleanup. */
1098 dbus_message_unref (dmessage);
1099
1100 /* Return the result. */
1101 RETURN_UNGCPRO (result);
1102 }
1103
1104 DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
1105 Sdbus_method_return_internal,
1106 3, MANY, 0,
1107 doc: /* Return for message SERIAL on the D-Bus BUS.
1108 This is an internal function, it shall not be used outside dbus.el.
1109
1110 usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
1111 (nargs, args)
1112 int nargs;
1113 register Lisp_Object *args;
1114 {
1115 Lisp_Object bus, serial, service;
1116 struct gcpro gcpro1, gcpro2, gcpro3;
1117 DBusConnection *connection;
1118 DBusMessage *dmessage;
1119 DBusMessageIter iter;
1120 unsigned int dtype;
1121 int i;
1122 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1123
1124 /* Check parameters. */
1125 bus = args[0];
1126 serial = args[1];
1127 service = args[2];
1128
1129 CHECK_SYMBOL (bus);
1130 CHECK_NUMBER (serial);
1131 CHECK_STRING (service);
1132 GCPRO3 (bus, serial, service);
1133
1134 XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial), SDATA (service));
1135
1136 /* Open a connection to the bus. */
1137 connection = xd_initialize (bus);
1138
1139 /* Create the message. */
1140 dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1141 if ((dmessage == NULL)
1142 || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
1143 || (!dbus_message_set_destination (dmessage, SDATA (service))))
1144 {
1145 UNGCPRO;
1146 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1147 }
1148
1149 UNGCPRO;
1150
1151 /* Initialize parameter list of message. */
1152 dbus_message_iter_init_append (dmessage, &iter);
1153
1154 /* Append parameters to the message. */
1155 for (i = 3; i < nargs; ++i)
1156 {
1157 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1158 if (XD_DBUS_TYPE_P (args[i]))
1159 {
1160 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1161 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1162 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
1163 SDATA (format2 ("%s", args[i], Qnil)),
1164 SDATA (format2 ("%s", args[i+1], Qnil)));
1165 ++i;
1166 }
1167 else
1168 {
1169 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1170 XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
1171 SDATA (format2 ("%s", args[i], Qnil)));
1172 }
1173
1174 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1175 indication that there is no parent type. */
1176 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1177
1178 xd_append_arg (dtype, args[i], &iter);
1179 }
1180
1181 /* Send the message. The message is just added to the outgoing
1182 message queue. */
1183 if (!dbus_connection_send (connection, dmessage, NULL))
1184 XD_SIGNAL1 (build_string ("Cannot send message"));
1185
1186 /* Flush connection to ensure the message is handled. */
1187 dbus_connection_flush (connection);
1188
1189 XD_DEBUG_MESSAGE ("Message sent");
1190
1191 /* Cleanup. */
1192 dbus_message_unref (dmessage);
1193
1194 /* Return. */
1195 return Qt;
1196 }
1197
1198 DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
1199 Sdbus_method_error_internal,
1200 3, MANY, 0,
1201 doc: /* Return error message for message SERIAL on the D-Bus BUS.
1202 This is an internal function, it shall not be used outside dbus.el.
1203
1204 usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
1205 (nargs, args)
1206 int nargs;
1207 register Lisp_Object *args;
1208 {
1209 Lisp_Object bus, serial, service;
1210 struct gcpro gcpro1, gcpro2, gcpro3;
1211 DBusConnection *connection;
1212 DBusMessage *dmessage;
1213 DBusMessageIter iter;
1214 unsigned int dtype;
1215 int i;
1216 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1217
1218 /* Check parameters. */
1219 bus = args[0];
1220 serial = args[1];
1221 service = args[2];
1222
1223 CHECK_SYMBOL (bus);
1224 CHECK_NUMBER (serial);
1225 CHECK_STRING (service);
1226 GCPRO3 (bus, serial, service);
1227
1228 XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial), SDATA (service));
1229
1230 /* Open a connection to the bus. */
1231 connection = xd_initialize (bus);
1232
1233 /* Create the message. */
1234 dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
1235 if ((dmessage == NULL)
1236 || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
1237 || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
1238 || (!dbus_message_set_destination (dmessage, SDATA (service))))
1239 {
1240 UNGCPRO;
1241 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1242 }
1243
1244 UNGCPRO;
1245
1246 /* Initialize parameter list of message. */
1247 dbus_message_iter_init_append (dmessage, &iter);
1248
1249 /* Append parameters to the message. */
1250 for (i = 3; i < nargs; ++i)
1251 {
1252 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1253 if (XD_DBUS_TYPE_P (args[i]))
1254 {
1255 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1256 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1257 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
1258 SDATA (format2 ("%s", args[i], Qnil)),
1259 SDATA (format2 ("%s", args[i+1], Qnil)));
1260 ++i;
1261 }
1262 else
1263 {
1264 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1265 XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
1266 SDATA (format2 ("%s", args[i], Qnil)));
1267 }
1268
1269 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1270 indication that there is no parent type. */
1271 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1272
1273 xd_append_arg (dtype, args[i], &iter);
1274 }
1275
1276 /* Send the message. The message is just added to the outgoing
1277 message queue. */
1278 if (!dbus_connection_send (connection, dmessage, NULL))
1279 XD_SIGNAL1 (build_string ("Cannot send message"));
1280
1281 /* Flush connection to ensure the message is handled. */
1282 dbus_connection_flush (connection);
1283
1284 XD_DEBUG_MESSAGE ("Message sent");
1285
1286 /* Cleanup. */
1287 dbus_message_unref (dmessage);
1288
1289 /* Return. */
1290 return Qt;
1291 }
1292
1293 DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
1294 doc: /* Send signal SIGNAL on the D-Bus BUS.
1295
1296 BUS is either the symbol `:system' or the symbol `:session'.
1297
1298 SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
1299 D-Bus object path SERVICE is registered at. INTERFACE is an interface
1300 offered by SERVICE. It must provide signal SIGNAL.
1301
1302 All other arguments ARGS are passed to SIGNAL as arguments. They are
1303 converted into D-Bus types via the following rules:
1304
1305 t and nil => DBUS_TYPE_BOOLEAN
1306 number => DBUS_TYPE_UINT32
1307 integer => DBUS_TYPE_INT32
1308 float => DBUS_TYPE_DOUBLE
1309 string => DBUS_TYPE_STRING
1310 list => DBUS_TYPE_ARRAY
1311
1312 All arguments can be preceded by a type symbol. For details about
1313 type symbols, see Info node `(dbus)Type Conversion'.
1314
1315 Example:
1316
1317 \(dbus-send-signal
1318 :session "org.gnu.Emacs" "/org/gnu/Emacs"
1319 "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1320
1321 usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
1322 (nargs, args)
1323 int nargs;
1324 register Lisp_Object *args;
1325 {
1326 Lisp_Object bus, service, path, interface, signal;
1327 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1328 DBusConnection *connection;
1329 DBusMessage *dmessage;
1330 DBusMessageIter iter;
1331 unsigned int dtype;
1332 int i;
1333 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1334
1335 /* Check parameters. */
1336 bus = args[0];
1337 service = args[1];
1338 path = args[2];
1339 interface = args[3];
1340 signal = args[4];
1341
1342 CHECK_SYMBOL (bus);
1343 CHECK_STRING (service);
1344 CHECK_STRING (path);
1345 CHECK_STRING (interface);
1346 CHECK_STRING (signal);
1347 GCPRO5 (bus, service, path, interface, signal);
1348
1349 XD_DEBUG_MESSAGE ("%s %s %s %s",
1350 SDATA (service),
1351 SDATA (path),
1352 SDATA (interface),
1353 SDATA (signal));
1354
1355 /* Open a connection to the bus. */
1356 connection = xd_initialize (bus);
1357
1358 /* Create the message. */
1359 dmessage = dbus_message_new_signal (SDATA (path),
1360 SDATA (interface),
1361 SDATA (signal));
1362 UNGCPRO;
1363 if (dmessage == NULL)
1364 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1365
1366 /* Initialize parameter list of message. */
1367 dbus_message_iter_init_append (dmessage, &iter);
1368
1369 /* Append parameters to the message. */
1370 for (i = 5; i < nargs; ++i)
1371 {
1372 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1373 if (XD_DBUS_TYPE_P (args[i]))
1374 {
1375 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1376 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1377 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1378 SDATA (format2 ("%s", args[i], Qnil)),
1379 SDATA (format2 ("%s", args[i+1], Qnil)));
1380 ++i;
1381 }
1382 else
1383 {
1384 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1385 XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1386 SDATA (format2 ("%s", args[i], Qnil)));
1387 }
1388
1389 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1390 indication that there is no parent type. */
1391 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1392
1393 xd_append_arg (dtype, args[i], &iter);
1394 }
1395
1396 /* Send the message. The message is just added to the outgoing
1397 message queue. */
1398 if (!dbus_connection_send (connection, dmessage, NULL))
1399 XD_SIGNAL1 (build_string ("Cannot send message"));
1400
1401 /* Flush connection to ensure the message is handled. */
1402 dbus_connection_flush (connection);
1403
1404 XD_DEBUG_MESSAGE ("Signal sent");
1405
1406 /* Cleanup. */
1407 dbus_message_unref (dmessage);
1408
1409 /* Return. */
1410 return Qt;
1411 }
1412
1413 /* Read queued incoming message of the D-Bus BUS. BUS is a Lisp
1414 symbol, either :system or :session. */
1415 static Lisp_Object
1416 xd_read_message (bus)
1417 Lisp_Object bus;
1418 {
1419 Lisp_Object args, key, value;
1420 struct gcpro gcpro1;
1421 struct input_event event;
1422 DBusConnection *connection;
1423 DBusMessage *dmessage;
1424 DBusMessageIter iter;
1425 unsigned int dtype;
1426 int mtype, serial;
1427 const char *uname, *path, *interface, *member;
1428
1429 /* Open a connection to the bus. */
1430 connection = xd_initialize (bus);
1431
1432 /* Non blocking read of the next available message. */
1433 dbus_connection_read_write (connection, 0);
1434 dmessage = dbus_connection_pop_message (connection);
1435
1436 /* Return if there is no queued message. */
1437 if (dmessage == NULL)
1438 return Qnil;
1439
1440 /* Collect the parameters. */
1441 args = Qnil;
1442 GCPRO1 (args);
1443
1444 /* Loop over the resulting parameters. Construct a list. */
1445 if (dbus_message_iter_init (dmessage, &iter))
1446 {
1447 while ((dtype = dbus_message_iter_get_arg_type (&iter))
1448 != DBUS_TYPE_INVALID)
1449 {
1450 args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1451 dbus_message_iter_next (&iter);
1452 }
1453 /* The arguments are stored in reverse order. Reorder them. */
1454 args = Fnreverse (args);
1455 }
1456
1457 /* Read message type, message serial, unique name, object path,
1458 interface and member from the message. */
1459 mtype = dbus_message_get_type (dmessage);
1460 serial =
1461 ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1462 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1463 ? dbus_message_get_reply_serial (dmessage)
1464 : dbus_message_get_serial (dmessage);
1465 uname = dbus_message_get_sender (dmessage);
1466 path = dbus_message_get_path (dmessage);
1467 interface = dbus_message_get_interface (dmessage);
1468 member = dbus_message_get_member (dmessage);
1469
1470 XD_DEBUG_MESSAGE ("Event received: %s %d %s %s %s %s %s",
1471 (mtype == DBUS_MESSAGE_TYPE_INVALID)
1472 ? "DBUS_MESSAGE_TYPE_INVALID"
1473 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1474 ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1475 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1476 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1477 : (mtype == DBUS_MESSAGE_TYPE_ERROR)
1478 ? "DBUS_MESSAGE_TYPE_ERROR"
1479 : "DBUS_MESSAGE_TYPE_SIGNAL",
1480 serial, uname, path, interface, member,
1481 SDATA (format2 ("%s", args, Qnil)));
1482
1483 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1484 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1485 {
1486 /* Search for a registered function of the message. */
1487 key = list2 (bus, make_number (serial));
1488 value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1489
1490 /* There shall be exactly one entry. Construct an event. */
1491 if (NILP (value))
1492 goto cleanup;
1493
1494 /* Remove the entry. */
1495 Fremhash (key, Vdbus_registered_functions_table);
1496
1497 /* Construct an event. */
1498 EVENT_INIT (event);
1499 event.kind = DBUS_EVENT;
1500 event.frame_or_window = Qnil;
1501 event.arg = Fcons (value, args);
1502 }
1503
1504 else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
1505 {
1506 /* Vdbus_registered_functions_table requires non-nil interface
1507 and member. */
1508 if ((interface == NULL) || (member == NULL))
1509 goto cleanup;
1510
1511 /* Search for a registered function of the message. */
1512 key = list3 (bus, build_string (interface), build_string (member));
1513 value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1514
1515 /* Loop over the registered functions. Construct an event. */
1516 while (!NILP (value))
1517 {
1518 key = CAR_SAFE (value);
1519 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1520 if (((uname == NULL)
1521 || (NILP (CAR_SAFE (key)))
1522 || (strcmp (uname, SDATA (CAR_SAFE (key))) == 0))
1523 && ((path == NULL)
1524 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1525 || (strcmp (path,
1526 SDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1527 == 0))
1528 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1529 {
1530 EVENT_INIT (event);
1531 event.kind = DBUS_EVENT;
1532 event.frame_or_window = Qnil;
1533 event.arg = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))),
1534 args);
1535 break;
1536 }
1537 value = CDR_SAFE (value);
1538 }
1539
1540 if (NILP (value))
1541 goto cleanup;
1542 }
1543
1544 /* Add type, serial, uname, path, interface and member to the event. */
1545 event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1546 event.arg);
1547 event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1548 event.arg);
1549 event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1550 event.arg);
1551 event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1552 event.arg);
1553 event.arg = Fcons (make_number (serial), event.arg);
1554 event.arg = Fcons (make_number (mtype), event.arg);
1555
1556 /* Add the bus symbol to the event. */
1557 event.arg = Fcons (bus, event.arg);
1558
1559 /* Store it into the input event queue. */
1560 kbd_buffer_store_event (&event);
1561
1562 XD_DEBUG_MESSAGE ("Event stored: %s",
1563 SDATA (format2 ("%s", event.arg, Qnil)));
1564
1565 cleanup:
1566 dbus_message_unref (dmessage);
1567 RETURN_UNGCPRO (Qnil);
1568 }
1569
1570 /* Read queued incoming messages from the system and session buses. */
1571 void
1572 xd_read_queued_messages ()
1573 {
1574
1575 /* Vdbus_registered_functions_table will be initialized as hash
1576 table in dbus.el. When this package isn't loaded yet, it doesn't
1577 make sense to handle D-Bus messages. Furthermore, we ignore all
1578 Lisp errors during the call. */
1579 if (HASH_TABLE_P (Vdbus_registered_functions_table))
1580 {
1581 xd_in_read_queued_messages = 1;
1582 internal_catch (Qdbus_error, xd_read_message, QCdbus_system_bus);
1583 internal_catch (Qdbus_error, xd_read_message, QCdbus_session_bus);
1584 xd_in_read_queued_messages = 0;
1585 }
1586 }
1587
1588 DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
1589 6, MANY, 0,
1590 doc: /* Register for signal SIGNAL on the D-Bus BUS.
1591
1592 BUS is either the symbol `:system' or the symbol `:session'.
1593
1594 SERVICE is the D-Bus service name used by the sending D-Bus object.
1595 It can be either a known name or the unique name of the D-Bus object
1596 sending the signal. When SERVICE is nil, related signals from all
1597 D-Bus objects shall be accepted.
1598
1599 PATH is the D-Bus object path SERVICE is registered. It can also be
1600 nil if the path name of incoming signals shall not be checked.
1601
1602 INTERFACE is an interface offered by SERVICE. It must provide SIGNAL.
1603 HANDLER is a Lisp function to be called when the signal is received.
1604 It must accept as arguments the values SIGNAL is sending.
1605
1606 All other arguments ARGS, if specified, must be strings. They stand
1607 for the respective arguments of the signal in their order, and are
1608 used for filtering as well. A nil argument might be used to preserve
1609 the order.
1610
1611 INTERFACE, SIGNAL and HANDLER must not be nil. Example:
1612
1613 \(defun my-signal-handler (device)
1614 (message "Device %s added" device))
1615
1616 \(dbus-register-signal
1617 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
1618 "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
1619
1620 => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
1621 ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
1622
1623 `dbus-register-signal' returns an object, which can be used in
1624 `dbus-unregister-object' for removing the registration.
1625
1626 usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
1627 (nargs, args)
1628 int nargs;
1629 register Lisp_Object *args;
1630 {
1631 Lisp_Object bus, service, path, interface, signal, handler;
1632 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1633 Lisp_Object uname, key, key1, value;
1634 DBusConnection *connection;
1635 int i;
1636 char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1637 char x[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1638 DBusError derror;
1639
1640 /* Check parameters. */
1641 bus = args[0];
1642 service = args[1];
1643 path = args[2];
1644 interface = args[3];
1645 signal = args[4];
1646 handler = args[5];
1647
1648 CHECK_SYMBOL (bus);
1649 if (!NILP (service)) CHECK_STRING (service);
1650 if (!NILP (path)) CHECK_STRING (path);
1651 CHECK_STRING (interface);
1652 CHECK_STRING (signal);
1653 if (!FUNCTIONP (handler))
1654 wrong_type_argument (intern ("functionp"), handler);
1655 GCPRO6 (bus, service, path, interface, signal, handler);
1656
1657 /* Retrieve unique name of service. If service is a known name, we
1658 will register for the corresponding unique name, if any. Signals
1659 are sent always with the unique name as sender. Note: the unique
1660 name of "org.freedesktop.DBus" is that string itself. */
1661 if ((STRINGP (service))
1662 && (SBYTES (service) > 0)
1663 && (strcmp (SDATA (service), DBUS_SERVICE_DBUS) != 0)
1664 && (strncmp (SDATA (service), ":", 1) != 0))
1665 {
1666 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1667 /* When there is no unique name, we mark it with an empty
1668 string. */
1669 if (NILP (uname))
1670 uname = empty_unibyte_string;
1671 }
1672 else
1673 uname = service;
1674
1675 /* Create a matching rule if the unique name exists (when no
1676 wildcard). */
1677 if (NILP (uname) || (SBYTES (uname) > 0))
1678 {
1679 /* Open a connection to the bus. */
1680 connection = xd_initialize (bus);
1681
1682 /* Create a rule to receive related signals. */
1683 sprintf (rule,
1684 "type='signal',interface='%s',member='%s'",
1685 SDATA (interface),
1686 SDATA (signal));
1687
1688 /* Add unique name and path to the rule if they are non-nil. */
1689 if (!NILP (uname))
1690 {
1691 sprintf (x, ",sender='%s'", SDATA (uname));
1692 strcat (rule, x);
1693 }
1694
1695 if (!NILP (path))
1696 {
1697 sprintf (x, ",path='%s'", SDATA (path));
1698 strcat (rule, x);
1699 }
1700
1701 /* Add arguments to the rule if they are non-nil. */
1702 for (i = 6; i < nargs; ++i)
1703 if (!NILP (args[i]))
1704 {
1705 CHECK_STRING (args[i]);
1706 sprintf (x, ",arg%d='%s'", i-6, SDATA (args[i]));
1707 strcat (rule, x);
1708 }
1709
1710 /* Add the rule to the bus. */
1711 dbus_error_init (&derror);
1712 dbus_bus_add_match (connection, rule, &derror);
1713 if (dbus_error_is_set (&derror))
1714 {
1715 UNGCPRO;
1716 XD_ERROR (derror);
1717 }
1718
1719 XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
1720 }
1721
1722 /* Create a hash table entry. */
1723 key = list3 (bus, interface, signal);
1724 key1 = list4 (uname, service, path, handler);
1725 value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1726
1727 if (NILP (Fmember (key1, value)))
1728 Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
1729
1730 /* Return object. */
1731 RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
1732 }
1733
1734 DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
1735 6, 6, 0,
1736 doc: /* Register for method METHOD on the D-Bus BUS.
1737
1738 BUS is either the symbol `:system' or the symbol `:session'.
1739
1740 SERVICE is the D-Bus service name of the D-Bus object METHOD is
1741 registered for. It must be a known name.
1742
1743 PATH is the D-Bus object path SERVICE is registered. INTERFACE is the
1744 interface offered by SERVICE. It must provide METHOD. HANDLER is a
1745 Lisp function to be called when a method call is received. It must
1746 accept the input arguments of METHOD. The return value of HANDLER is
1747 used for composing the returning D-Bus message. */)
1748 (bus, service, path, interface, method, handler)
1749 Lisp_Object bus, service, path, interface, method, handler;
1750 {
1751 Lisp_Object key, key1, value;
1752 DBusConnection *connection;
1753 int result;
1754 DBusError derror;
1755
1756 /* Check parameters. */
1757 CHECK_SYMBOL (bus);
1758 CHECK_STRING (service);
1759 CHECK_STRING (path);
1760 CHECK_STRING (interface);
1761 CHECK_STRING (method);
1762 if (!FUNCTIONP (handler))
1763 wrong_type_argument (intern ("functionp"), handler);
1764 /* TODO: We must check for a valid service name, otherwise there is
1765 a segmentation fault. */
1766
1767 /* Open a connection to the bus. */
1768 connection = xd_initialize (bus);
1769
1770 /* Request the known name from the bus. We can ignore the result,
1771 it is set to -1 if there is an error - kind of redundancy. */
1772 dbus_error_init (&derror);
1773 result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
1774 if (dbus_error_is_set (&derror))
1775 XD_ERROR (derror);
1776
1777 /* Create a hash table entry. */
1778 key = list3 (bus, interface, method);
1779 key1 = list4 (Qnil, service, path, handler);
1780 value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1781
1782 /* We use nil for the unique name, because the method might be
1783 called from everybody. */
1784 if (NILP (Fmember (key1, value)))
1785 Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
1786
1787 /* Return object. */
1788 return list2 (key, list3 (service, path, handler));
1789 }
1790
1791 \f
1792 void
1793 syms_of_dbusbind ()
1794 {
1795
1796 Qdbus_get_unique_name = intern ("dbus-get-unique-name");
1797 staticpro (&Qdbus_get_unique_name);
1798 defsubr (&Sdbus_get_unique_name);
1799
1800 Qdbus_call_method = intern ("dbus-call-method");
1801 staticpro (&Qdbus_call_method);
1802 defsubr (&Sdbus_call_method);
1803
1804 Qdbus_call_method_asynchronously = intern ("dbus-call-method-asynchronously");
1805 staticpro (&Qdbus_call_method_asynchronously);
1806 defsubr (&Sdbus_call_method_asynchronously);
1807
1808 Qdbus_method_return_internal = intern ("dbus-method-return-internal");
1809 staticpro (&Qdbus_method_return_internal);
1810 defsubr (&Sdbus_method_return_internal);
1811
1812 Qdbus_method_error_internal = intern ("dbus-method-error-internal");
1813 staticpro (&Qdbus_method_error_internal);
1814 defsubr (&Sdbus_method_error_internal);
1815
1816 Qdbus_send_signal = intern ("dbus-send-signal");
1817 staticpro (&Qdbus_send_signal);
1818 defsubr (&Sdbus_send_signal);
1819
1820 Qdbus_register_signal = intern ("dbus-register-signal");
1821 staticpro (&Qdbus_register_signal);
1822 defsubr (&Sdbus_register_signal);
1823
1824 Qdbus_register_method = intern ("dbus-register-method");
1825 staticpro (&Qdbus_register_method);
1826 defsubr (&Sdbus_register_method);
1827
1828 Qdbus_error = intern ("dbus-error");
1829 staticpro (&Qdbus_error);
1830 Fput (Qdbus_error, Qerror_conditions,
1831 list2 (Qdbus_error, Qerror));
1832 Fput (Qdbus_error, Qerror_message,
1833 build_string ("D-Bus error"));
1834
1835 QCdbus_system_bus = intern (":system");
1836 staticpro (&QCdbus_system_bus);
1837
1838 QCdbus_session_bus = intern (":session");
1839 staticpro (&QCdbus_session_bus);
1840
1841 QCdbus_timeout = intern (":timeout");
1842 staticpro (&QCdbus_timeout);
1843
1844 QCdbus_type_byte = intern (":byte");
1845 staticpro (&QCdbus_type_byte);
1846
1847 QCdbus_type_boolean = intern (":boolean");
1848 staticpro (&QCdbus_type_boolean);
1849
1850 QCdbus_type_int16 = intern (":int16");
1851 staticpro (&QCdbus_type_int16);
1852
1853 QCdbus_type_uint16 = intern (":uint16");
1854 staticpro (&QCdbus_type_uint16);
1855
1856 QCdbus_type_int32 = intern (":int32");
1857 staticpro (&QCdbus_type_int32);
1858
1859 QCdbus_type_uint32 = intern (":uint32");
1860 staticpro (&QCdbus_type_uint32);
1861
1862 QCdbus_type_int64 = intern (":int64");
1863 staticpro (&QCdbus_type_int64);
1864
1865 QCdbus_type_uint64 = intern (":uint64");
1866 staticpro (&QCdbus_type_uint64);
1867
1868 QCdbus_type_double = intern (":double");
1869 staticpro (&QCdbus_type_double);
1870
1871 QCdbus_type_string = intern (":string");
1872 staticpro (&QCdbus_type_string);
1873
1874 QCdbus_type_object_path = intern (":object-path");
1875 staticpro (&QCdbus_type_object_path);
1876
1877 QCdbus_type_signature = intern (":signature");
1878 staticpro (&QCdbus_type_signature);
1879
1880 QCdbus_type_array = intern (":array");
1881 staticpro (&QCdbus_type_array);
1882
1883 QCdbus_type_variant = intern (":variant");
1884 staticpro (&QCdbus_type_variant);
1885
1886 QCdbus_type_struct = intern (":struct");
1887 staticpro (&QCdbus_type_struct);
1888
1889 QCdbus_type_dict_entry = intern (":dict-entry");
1890 staticpro (&QCdbus_type_dict_entry);
1891
1892 DEFVAR_LISP ("dbus-registered-functions-table",
1893 &Vdbus_registered_functions_table,
1894 doc: /* Hash table of registered functions for D-Bus.
1895 There are two different uses of the hash table: for calling registered
1896 functions, targeted by signals or method calls, and for calling
1897 handlers in case of non-blocking method call returns.
1898
1899 In the first case, the key in the hash table is the list (BUS
1900 INTERFACE MEMBER). BUS is either the symbol `:system' or the symbol
1901 `:session'. INTERFACE is a string which denotes a D-Bus interface,
1902 and MEMBER, also a string, is either a method or a signal INTERFACE is
1903 offering. All arguments but BUS must not be nil.
1904
1905 The value in the hash table is a list of quadruple lists
1906 \((UNAME SERVICE PATH HANDLER) (UNAME SERVICE PATH HANDLER) ...).
1907 SERVICE is the service name as registered, UNAME is the corresponding
1908 unique name. PATH is the object path of the sending object. All of
1909 them can be nil, which means a wildcard then. HANDLER is the function
1910 to be called when a D-Bus message, which matches the key criteria,
1911 arrives.
1912
1913 In the second case, the key in the hash table is the list (BUS SERIAL).
1914 BUS is either the symbol `:system' or the symbol `:session'. SERIAL
1915 is the serial number of the non-blocking method call, a reply is
1916 expected. Both arguments must not be nil. The value in the hash
1917 table is HANDLER, the function to be called when the D-Bus reply
1918 message arrives. */);
1919 /* We initialize Vdbus_registered_functions_table in dbus.el,
1920 because we need to define a hash table function first. */
1921 Vdbus_registered_functions_table = Qnil;
1922
1923 DEFVAR_LISP ("dbus-debug", &Vdbus_debug,
1924 doc: /* If non-nil, debug messages of D-Bus bindings are raised. */);
1925 #ifdef DBUS_DEBUG
1926 Vdbus_debug = Qt;
1927 #else
1928 Vdbus_debug = Qnil;
1929 #endif
1930
1931 Fprovide (intern ("dbusbind"), Qnil);
1932
1933 }
1934
1935 #endif /* HAVE_DBUS */
1936
1937 /* arch-tag: 0e828477-b571-4fe4-b559-5c9211bc14b8
1938 (do not change this comment) */