1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007, 2008 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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.
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.
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/>. */
24 #include <dbus/dbus.h>
27 #include "termhooks.h"
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
;
41 /* D-Bus error symbol. */
42 Lisp_Object Qdbus_error
;
44 /* Lisp symbols of the system and session buses. */
45 Lisp_Object QCdbus_system_bus
, QCdbus_session_bus
;
47 /* Lisp symbol for method call timeout. */
48 Lisp_Object QCdbus_timeout
;
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
;
60 /* Hash table which keeps function definitions. */
61 Lisp_Object Vdbus_registered_functions_table
;
63 /* Whether to debug D-Bus. */
64 Lisp_Object Vdbus_debug
;
67 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
68 we don't want to poison other namespaces with "dbus_". */
70 /* Raise a Lisp error from a D-Bus ERROR. */
71 #define XD_ERROR(error) \
74 strncpy (s, error.message, 1023); \
75 dbus_error_free (&error); \
76 /* Remove the trailing newline. */ \
77 if (strchr (s, '\n') != NULL) \
78 s[strlen (s) - 1] = '\0'; \
79 xsignal1 (Qdbus_error, build_string (s)); \
82 /* Macros for debugging. In order to enable them, build with
83 "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'". */
85 #define XD_DEBUG_MESSAGE(...) \
88 snprintf (s, 1023, __VA_ARGS__); \
89 printf ("%s: %s\n", __func__, s); \
90 message ("%s: %s", __func__, s); \
92 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
94 if (!valid_lisp_object_p (object)) \
96 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
97 xsignal1 (Qdbus_error, build_string ("Assertion failure")); \
101 #else /* !DBUS_DEBUG */
102 #define XD_DEBUG_MESSAGE(...) \
104 if (!NILP (Vdbus_debug)) \
107 snprintf (s, 1023, __VA_ARGS__); \
108 message ("%s: %s", __func__, s); \
111 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
114 /* Check whether TYPE is a basic DBusType. */
115 #define XD_BASIC_DBUS_TYPE(type) \
116 ((type == DBUS_TYPE_BYTE) \
117 || (type == DBUS_TYPE_BOOLEAN) \
118 || (type == DBUS_TYPE_INT16) \
119 || (type == DBUS_TYPE_UINT16) \
120 || (type == DBUS_TYPE_INT32) \
121 || (type == DBUS_TYPE_UINT32) \
122 || (type == DBUS_TYPE_INT64) \
123 || (type == DBUS_TYPE_UINT64) \
124 || (type == DBUS_TYPE_DOUBLE) \
125 || (type == DBUS_TYPE_STRING) \
126 || (type == DBUS_TYPE_OBJECT_PATH) \
127 || (type == DBUS_TYPE_SIGNATURE))
129 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
130 of the predefined D-Bus type symbols. */
131 #define XD_SYMBOL_TO_DBUS_TYPE(object) \
132 ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE \
133 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN \
134 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16 \
135 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16 \
136 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32 \
137 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32 \
138 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64 \
139 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64 \
140 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE \
141 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING \
142 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH \
143 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE \
144 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY \
145 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT \
146 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT \
147 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY \
150 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
151 #define XD_DBUS_TYPE_P(object) \
152 (SYMBOLP (object) && ((XD_SYMBOL_TO_DBUS_TYPE (object) != DBUS_TYPE_INVALID)))
154 /* Determine the DBusType of a given Lisp OBJECT. It is used to
155 convert Lisp objects, being arguments of `dbus-call-method' or
156 `dbus-send-signal', into corresponding C values appended as
157 arguments to a D-Bus message. */
158 #define XD_OBJECT_TO_DBUS_TYPE(object) \
159 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
160 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
161 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
162 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
163 : (STRINGP (object)) ? DBUS_TYPE_STRING \
164 : (XD_DBUS_TYPE_P (object)) ? XD_SYMBOL_TO_DBUS_TYPE (object) \
165 : (CONSP (object)) ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
166 ? XD_SYMBOL_TO_DBUS_TYPE (CAR_SAFE (object)) \
170 /* Return a list pointer which does not have a Lisp symbol as car. */
171 #define XD_NEXT_VALUE(object) \
172 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
174 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
175 used in dbus_message_iter_open_container. DTYPE is the DBusType
176 the object is related to. It is passed as argument, because it
177 cannot be detected in basic type objects, when they are preceded by
178 a type symbol. PARENT_TYPE is the DBusType of a container this
179 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
180 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
182 xd_signature (signature
, dtype
, parent_type
, object
)
184 unsigned int dtype
, parent_type
;
187 unsigned int subtype
;
189 char x
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
196 case DBUS_TYPE_UINT16
:
197 case DBUS_TYPE_UINT32
:
198 case DBUS_TYPE_UINT64
:
199 CHECK_NATNUM (object
);
200 sprintf (signature
, "%c", dtype
);
203 case DBUS_TYPE_BOOLEAN
:
204 if (!EQ (object
, Qt
) && !EQ (object
, Qnil
))
205 wrong_type_argument (intern ("booleanp"), object
);
206 sprintf (signature
, "%c", dtype
);
209 case DBUS_TYPE_INT16
:
210 case DBUS_TYPE_INT32
:
211 case DBUS_TYPE_INT64
:
212 CHECK_NUMBER (object
);
213 sprintf (signature
, "%c", dtype
);
216 case DBUS_TYPE_DOUBLE
:
217 CHECK_FLOAT (object
);
218 sprintf (signature
, "%c", dtype
);
221 case DBUS_TYPE_STRING
:
222 case DBUS_TYPE_OBJECT_PATH
:
223 case DBUS_TYPE_SIGNATURE
:
224 CHECK_STRING (object
);
225 sprintf (signature
, "%c", dtype
);
228 case DBUS_TYPE_ARRAY
:
229 /* Check that all list elements have the same D-Bus type. For
230 complex element types, we just check the container type, not
231 the whole element's signature. */
234 /* Type symbol is optional. */
235 if (EQ (QCdbus_type_array
, CAR_SAFE (elt
)))
236 elt
= XD_NEXT_VALUE (elt
);
238 /* If the array is empty, DBUS_TYPE_STRING is the default
242 subtype
= DBUS_TYPE_STRING
;
243 strcpy (x
, DBUS_TYPE_STRING_AS_STRING
);
247 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
248 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
251 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
252 only element, the value of this element is used as he array's
253 element signature. */
254 if ((subtype
== DBUS_TYPE_SIGNATURE
)
255 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt
)))
256 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
257 strcpy (x
, SDATA (CAR_SAFE (XD_NEXT_VALUE (elt
))));
261 if (subtype
!= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
)))
262 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt
));
263 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
266 sprintf (signature
, "%c%s", dtype
, x
);
269 case DBUS_TYPE_VARIANT
:
270 /* Check that there is exactly one list element. */
273 elt
= XD_NEXT_VALUE (elt
);
274 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
275 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
277 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
278 wrong_type_argument (intern ("D-Bus"),
279 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
281 sprintf (signature
, "%c", dtype
);
284 case DBUS_TYPE_STRUCT
:
285 /* A struct list might contain any number of elements with
286 different types. No further check needed. */
289 elt
= XD_NEXT_VALUE (elt
);
291 /* Compose the signature from the elements. It is enclosed by
293 sprintf (signature
, "%c", DBUS_STRUCT_BEGIN_CHAR
);
296 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
297 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
298 strcat (signature
, x
);
299 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
301 strcat (signature
, DBUS_STRUCT_END_CHAR_AS_STRING
);
304 case DBUS_TYPE_DICT_ENTRY
:
305 /* Check that there are exactly two list elements, and the first
306 one is of basic type. The dictionary entry itself must be an
307 element of an array. */
310 /* Check the parent object type. */
311 if (parent_type
!= DBUS_TYPE_ARRAY
)
312 wrong_type_argument (intern ("D-Bus"), object
);
314 /* Compose the signature from the elements. It is enclosed by
316 sprintf (signature
, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR
);
319 elt
= XD_NEXT_VALUE (elt
);
320 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
321 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
322 strcat (signature
, x
);
324 if (!XD_BASIC_DBUS_TYPE (subtype
))
325 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt
)));
327 /* Second element. */
328 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
329 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
330 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
331 strcat (signature
, x
);
333 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
334 wrong_type_argument (intern ("D-Bus"),
335 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
337 /* Closing signature. */
338 strcat (signature
, DBUS_DICT_ENTRY_END_CHAR_AS_STRING
);
342 wrong_type_argument (intern ("D-Bus"), object
);
345 XD_DEBUG_MESSAGE ("%s", signature
);
348 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
349 DTYPE must be a valid DBusType. It is used to convert Lisp
350 objects, being arguments of `dbus-call-method' or
351 `dbus-send-signal', into corresponding C values appended as
352 arguments to a D-Bus message. */
354 xd_append_arg (dtype
, object
, iter
)
357 DBusMessageIter
*iter
;
359 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
360 DBusMessageIter subiter
;
362 if (XD_BASIC_DBUS_TYPE (dtype
))
367 unsigned char val
= XUINT (object
) & 0xFF;
368 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
369 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
370 xsignal2 (Qdbus_error
,
371 build_string ("Unable to append argument"), object
);
375 case DBUS_TYPE_BOOLEAN
:
377 dbus_bool_t val
= (NILP (object
)) ? FALSE
: TRUE
;
378 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
379 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
380 xsignal2 (Qdbus_error
,
381 build_string ("Unable to append argument"), object
);
385 case DBUS_TYPE_INT16
:
387 dbus_int16_t val
= XINT (object
);
388 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
389 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
390 xsignal2 (Qdbus_error
,
391 build_string ("Unable to append argument"), object
);
395 case DBUS_TYPE_UINT16
:
397 dbus_uint16_t val
= XUINT (object
);
398 XD_DEBUG_MESSAGE ("%c %u", dtype
, (unsigned int) val
);
399 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
400 xsignal2 (Qdbus_error
,
401 build_string ("Unable to append argument"), object
);
405 case DBUS_TYPE_INT32
:
407 dbus_int32_t val
= XINT (object
);
408 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
409 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
410 xsignal2 (Qdbus_error
,
411 build_string ("Unable to append argument"), object
);
415 case DBUS_TYPE_UINT32
:
417 dbus_uint32_t val
= XUINT (object
);
418 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
419 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
420 xsignal2 (Qdbus_error
,
421 build_string ("Unable to append argument"), object
);
425 case DBUS_TYPE_INT64
:
427 dbus_int64_t val
= XINT (object
);
428 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
429 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
430 xsignal2 (Qdbus_error
,
431 build_string ("Unable to append argument"), object
);
435 case DBUS_TYPE_UINT64
:
437 dbus_uint64_t val
= XUINT (object
);
438 XD_DEBUG_MESSAGE ("%c %u", dtype
, (unsigned int) val
);
439 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
440 xsignal2 (Qdbus_error
,
441 build_string ("Unable to append argument"), object
);
445 case DBUS_TYPE_DOUBLE
:
446 XD_DEBUG_MESSAGE ("%c %f", dtype
, XFLOAT_DATA (object
));
447 if (!dbus_message_iter_append_basic (iter
, dtype
,
448 &XFLOAT_DATA (object
)))
449 xsignal2 (Qdbus_error
,
450 build_string ("Unable to append argument"), object
);
453 case DBUS_TYPE_STRING
:
454 case DBUS_TYPE_OBJECT_PATH
:
455 case DBUS_TYPE_SIGNATURE
:
457 char *val
= SDATA (Fstring_make_unibyte (object
));
458 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
459 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
460 xsignal2 (Qdbus_error
,
461 build_string ("Unable to append argument"), object
);
466 else /* Compound types. */
469 /* All compound types except array have a type symbol. For
470 array, it is optional. Skip it. */
471 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))))
472 object
= XD_NEXT_VALUE (object
);
474 /* Open new subiteration. */
477 case DBUS_TYPE_ARRAY
:
478 /* An array has only elements of the same type. So it is
479 sufficient to check the first element's signature
483 /* If the array is empty, DBUS_TYPE_STRING is the default
485 strcpy (signature
, DBUS_TYPE_STRING_AS_STRING
);
488 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
489 the only element, the value of this element is used as
490 the array's element signature. */
491 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))
492 == DBUS_TYPE_SIGNATURE
)
493 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object
)))
494 && NILP (CDR_SAFE (XD_NEXT_VALUE (object
))))
496 strcpy (signature
, SDATA (CAR_SAFE (XD_NEXT_VALUE (object
))));
497 object
= CDR_SAFE (XD_NEXT_VALUE (object
));
501 xd_signature (signature
,
502 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
503 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
505 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
506 SDATA (format2 ("%s", object
, Qnil
)));
507 if (!dbus_message_iter_open_container (iter
, dtype
,
508 signature
, &subiter
))
509 xsignal3 (Qdbus_error
,
510 build_string ("Cannot open container"),
511 make_number (dtype
), build_string (signature
));
514 case DBUS_TYPE_VARIANT
:
515 /* A variant has just one element. */
516 xd_signature (signature
, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
517 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
519 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
520 SDATA (format2 ("%s", object
, Qnil
)));
521 if (!dbus_message_iter_open_container (iter
, dtype
,
522 signature
, &subiter
))
523 xsignal3 (Qdbus_error
,
524 build_string ("Cannot open container"),
525 make_number (dtype
), build_string (signature
));
528 case DBUS_TYPE_STRUCT
:
529 case DBUS_TYPE_DICT_ENTRY
:
530 /* These containers do not require a signature. */
531 XD_DEBUG_MESSAGE ("%c %s", dtype
,
532 SDATA (format2 ("%s", object
, Qnil
)));
533 if (!dbus_message_iter_open_container (iter
, dtype
, NULL
, &subiter
))
534 xsignal2 (Qdbus_error
,
535 build_string ("Cannot open container"),
536 make_number (dtype
));
540 /* Loop over list elements. */
541 while (!NILP (object
))
543 dtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
));
544 object
= XD_NEXT_VALUE (object
);
546 xd_append_arg (dtype
, CAR_SAFE (object
), &subiter
);
548 object
= CDR_SAFE (object
);
551 /* Close the subiteration. */
552 if (!dbus_message_iter_close_container (iter
, &subiter
))
553 xsignal2 (Qdbus_error
,
554 build_string ("Cannot close container"),
555 make_number (dtype
));
559 /* Retrieve C value from a DBusMessageIter structure ITER, and return
560 a converted Lisp object. The type DTYPE of the argument of the
561 D-Bus message must be a valid DBusType. Compound D-Bus types
562 result always in a Lisp list. */
564 xd_retrieve_arg (dtype
, iter
)
566 DBusMessageIter
*iter
;
574 dbus_message_iter_get_basic (iter
, &val
);
576 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
577 return make_number (val
);
580 case DBUS_TYPE_BOOLEAN
:
583 dbus_message_iter_get_basic (iter
, &val
);
584 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
585 return (val
== FALSE
) ? Qnil
: Qt
;
588 case DBUS_TYPE_INT16
:
589 case DBUS_TYPE_UINT16
:
592 dbus_message_iter_get_basic (iter
, &val
);
593 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
594 return make_number (val
);
597 case DBUS_TYPE_INT32
:
598 case DBUS_TYPE_UINT32
:
600 /* Assignment to EMACS_INT stops GCC whining about limited
601 range of data type. */
604 dbus_message_iter_get_basic (iter
, &val
);
605 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
607 return make_fixnum_or_float (val1
);
610 case DBUS_TYPE_INT64
:
611 case DBUS_TYPE_UINT64
:
614 dbus_message_iter_get_basic (iter
, &val
);
615 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
616 return make_fixnum_or_float (val
);
619 case DBUS_TYPE_DOUBLE
:
622 dbus_message_iter_get_basic (iter
, &val
);
623 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
624 return make_float (val
);
627 case DBUS_TYPE_STRING
:
628 case DBUS_TYPE_OBJECT_PATH
:
629 case DBUS_TYPE_SIGNATURE
:
632 dbus_message_iter_get_basic (iter
, &val
);
633 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
634 return build_string (val
);
637 case DBUS_TYPE_ARRAY
:
638 case DBUS_TYPE_VARIANT
:
639 case DBUS_TYPE_STRUCT
:
640 case DBUS_TYPE_DICT_ENTRY
:
646 DBusMessageIter subiter
;
648 dbus_message_iter_recurse (iter
, &subiter
);
649 while ((subtype
= dbus_message_iter_get_arg_type (&subiter
))
650 != DBUS_TYPE_INVALID
)
652 result
= Fcons (xd_retrieve_arg (subtype
, &subiter
), result
);
653 dbus_message_iter_next (&subiter
);
655 XD_DEBUG_MESSAGE ("%c %s", dtype
, SDATA (format2 ("%s", result
, Qnil
)));
656 RETURN_UNGCPRO (Fnreverse (result
));
660 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype
);
665 /* Initialize D-Bus connection. BUS is a Lisp symbol, either :system
666 or :session. It tells which D-Bus to be initialized. */
671 DBusConnection
*connection
;
674 /* Parameter check. */
676 if (!((EQ (bus
, QCdbus_system_bus
)) || (EQ (bus
, QCdbus_session_bus
))))
677 xsignal2 (Qdbus_error
, build_string ("Wrong bus name"), bus
);
679 /* Open a connection to the bus. */
680 dbus_error_init (&derror
);
682 if (EQ (bus
, QCdbus_system_bus
))
683 connection
= dbus_bus_get (DBUS_BUS_SYSTEM
, &derror
);
685 connection
= dbus_bus_get (DBUS_BUS_SESSION
, &derror
);
687 if (dbus_error_is_set (&derror
))
690 if (connection
== NULL
)
691 xsignal2 (Qdbus_error
, build_string ("No connection"), bus
);
693 /* Return the result. */
697 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name
, Sdbus_get_unique_name
,
699 doc
: /* Return the unique name of Emacs registered at D-Bus BUS. */)
703 DBusConnection
*connection
;
706 /* Check parameters. */
709 /* Open a connection to the bus. */
710 connection
= xd_initialize (bus
);
712 /* Request the name. */
713 name
= dbus_bus_get_unique_name (connection
);
715 xsignal1 (Qdbus_error
, build_string ("No unique name available"));
718 return build_string (name
);
721 DEFUN ("dbus-call-method", Fdbus_call_method
, Sdbus_call_method
, 5, MANY
, 0,
722 doc
: /* Call METHOD on the D-Bus BUS.
724 BUS is either the symbol `:system' or the symbol `:session'.
726 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
727 object path SERVICE is registered at. INTERFACE is an interface
728 offered by SERVICE. It must provide METHOD.
730 If the parameter `:timeout' is given, the following integer TIMEOUT
731 specifies the maximun number of milliseconds the method call must
732 return. The default value is 25.000. If the method call doesn't
733 return in time, a D-Bus error is raised.
735 All other arguments ARGS are passed to METHOD as arguments. They are
736 converted into D-Bus types via the following rules:
738 t and nil => DBUS_TYPE_BOOLEAN
739 number => DBUS_TYPE_UINT32
740 integer => DBUS_TYPE_INT32
741 float => DBUS_TYPE_DOUBLE
742 string => DBUS_TYPE_STRING
743 list => DBUS_TYPE_ARRAY
745 All arguments can be preceded by a type symbol. For details about
746 type symbols, see Info node `(dbus)Type Conversion'.
748 `dbus-call-method' returns the resulting values of METHOD as a list of
749 Lisp objects. The type conversion happens the other direction as for
750 input arguments. It follows the mapping rules:
752 DBUS_TYPE_BOOLEAN => t or nil
753 DBUS_TYPE_BYTE => number
754 DBUS_TYPE_UINT16 => number
755 DBUS_TYPE_INT16 => integer
756 DBUS_TYPE_UINT32 => number or float
757 DBUS_TYPE_INT32 => integer or float
758 DBUS_TYPE_UINT64 => number or float
759 DBUS_TYPE_INT64 => integer or float
760 DBUS_TYPE_DOUBLE => float
761 DBUS_TYPE_STRING => string
762 DBUS_TYPE_OBJECT_PATH => string
763 DBUS_TYPE_SIGNATURE => string
764 DBUS_TYPE_ARRAY => list
765 DBUS_TYPE_VARIANT => list
766 DBUS_TYPE_STRUCT => list
767 DBUS_TYPE_DICT_ENTRY => list
772 :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
773 "org.gnome.seahorse.Keys" "GetKeyField"
774 "openpgp:657984B8C7A966DD" "simple-name")
776 => (t ("Philip R. Zimmermann"))
778 If the result of the METHOD call is just one value, the converted Lisp
779 object is returned instead of a list containing this single Lisp object.
782 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
783 "org.freedesktop.Hal.Device" "GetPropertyString"
784 "system.kernel.machine")
788 usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
791 register Lisp_Object
*args
;
793 Lisp_Object bus
, service
, path
, interface
, method
;
795 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
796 DBusConnection
*connection
;
797 DBusMessage
*dmessage
;
799 DBusMessageIter iter
;
804 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
806 /* Check parameters. */
814 CHECK_STRING (service
);
816 CHECK_STRING (interface
);
817 CHECK_STRING (method
);
818 GCPRO5 (bus
, service
, path
, interface
, method
);
820 XD_DEBUG_MESSAGE ("%s %s %s %s",
826 /* Open a connection to the bus. */
827 connection
= xd_initialize (bus
);
829 /* Create the message. */
830 dmessage
= dbus_message_new_method_call (SDATA (service
),
835 if (dmessage
== NULL
)
836 xsignal1 (Qdbus_error
, build_string ("Unable to create a new message"));
838 /* Check for timeout parameter. */
839 if ((i
+2 <= nargs
) && (EQ ((args
[i
]), QCdbus_timeout
)))
841 CHECK_NATNUM (args
[i
+1]);
842 timeout
= XUINT (args
[i
+1]);
846 /* Initialize parameter list of message. */
847 dbus_message_iter_init_append (dmessage
, &iter
);
849 /* Append parameters to the message. */
850 for (; i
< nargs
; ++i
)
852 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
853 if (XD_DBUS_TYPE_P (args
[i
]))
855 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
856 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
857 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i
-4,
858 SDATA (format2 ("%s", args
[i
], Qnil
)),
859 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
864 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
865 XD_DEBUG_MESSAGE ("Parameter%d %s", i
-4,
866 SDATA (format2 ("%s", args
[i
], Qnil
)));
869 /* Check for valid signature. We use DBUS_TYPE_INVALID as
870 indication that there is no parent type. */
871 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
873 xd_append_arg (dtype
, args
[i
], &iter
);
876 /* Send the message. */
877 dbus_error_init (&derror
);
878 reply
= dbus_connection_send_with_reply_and_block (connection
,
883 if (dbus_error_is_set (&derror
))
887 xsignal1 (Qdbus_error
, build_string ("No reply"));
889 XD_DEBUG_MESSAGE ("Message sent");
891 /* Collect the results. */
895 if (dbus_message_iter_init (reply
, &iter
))
897 /* Loop over the parameters of the D-Bus reply message. Construct a
898 Lisp list, which is returned by `dbus-call-method'. */
899 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
900 != DBUS_TYPE_INVALID
)
902 result
= Fcons (xd_retrieve_arg (dtype
, &iter
), result
);
903 dbus_message_iter_next (&iter
);
908 /* No arguments: just return nil. */
912 dbus_message_unref (dmessage
);
913 dbus_message_unref (reply
);
915 /* Return the result. If there is only one single Lisp object,
916 return it as-it-is, otherwise return the reversed list. */
917 if (XUINT (Flength (result
)) == 1)
918 RETURN_UNGCPRO (CAR_SAFE (result
));
920 RETURN_UNGCPRO (Fnreverse (result
));
923 DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously
,
924 Sdbus_call_method_asynchronously
, 6, MANY
, 0,
925 doc
: /* Call METHOD on the D-Bus BUS asynchronously.
927 BUS is either the symbol `:system' or the symbol `:session'.
929 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
930 object path SERVICE is registered at. INTERFACE is an interface
931 offered by SERVICE. It must provide METHOD.
933 HANDLER is a Lisp function, which is called when the corresponding
934 return message has arrived.
936 If the parameter `:timeout' is given, the following integer TIMEOUT
937 specifies the maximun number of milliseconds the method call must
938 return. The default value is 25.000. If the method call doesn't
939 return in time, a D-Bus error is raised.
941 All other arguments ARGS are passed to METHOD as arguments. They are
942 converted into D-Bus types via the following rules:
944 t and nil => DBUS_TYPE_BOOLEAN
945 number => DBUS_TYPE_UINT32
946 integer => DBUS_TYPE_INT32
947 float => DBUS_TYPE_DOUBLE
948 string => DBUS_TYPE_STRING
949 list => DBUS_TYPE_ARRAY
951 All arguments can be preceded by a type symbol. For details about
952 type symbols, see Info node `(dbus)Type Conversion'.
954 The function returns a key into the hash table
955 `dbus-registered-functions-table'. The corresponding entry in the
956 hash table is removed, when the return message has been arrived, and
961 \(dbus-call-method-asynchronously
962 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
963 "org.freedesktop.Hal.Device" "GetPropertyString" 'message
964 "system.kernel.machine")
970 usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
973 register Lisp_Object
*args
;
975 Lisp_Object bus
, service
, path
, interface
, method
, handler
;
977 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
978 DBusConnection
*connection
;
979 DBusMessage
*dmessage
;
980 DBusMessageIter iter
;
984 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
986 /* Check parameters. */
995 CHECK_STRING (service
);
997 CHECK_STRING (interface
);
998 CHECK_STRING (method
);
999 if (!FUNCTIONP (handler
))
1000 wrong_type_argument (intern ("functionp"), handler
);
1001 GCPRO6 (bus
, service
, path
, interface
, method
, handler
);
1003 XD_DEBUG_MESSAGE ("%s %s %s %s",
1009 /* Open a connection to the bus. */
1010 connection
= xd_initialize (bus
);
1012 /* Create the message. */
1013 dmessage
= dbus_message_new_method_call (SDATA (service
),
1017 if (dmessage
== NULL
)
1018 xsignal1 (Qdbus_error
, build_string ("Unable to create a new message"));
1020 /* Check for timeout parameter. */
1021 if ((i
+2 <= nargs
) && (EQ ((args
[i
]), QCdbus_timeout
)))
1023 CHECK_NATNUM (args
[i
+1]);
1024 timeout
= XUINT (args
[i
+1]);
1028 /* Initialize parameter list of message. */
1029 dbus_message_iter_init_append (dmessage
, &iter
);
1031 /* Append parameters to the message. */
1032 for (; i
< nargs
; ++i
)
1034 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1035 if (XD_DBUS_TYPE_P (args
[i
]))
1037 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1038 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1039 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i
-4,
1040 SDATA (format2 ("%s", args
[i
], Qnil
)),
1041 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1046 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1047 XD_DEBUG_MESSAGE ("Parameter%d %s", i
-4,
1048 SDATA (format2 ("%s", args
[i
], Qnil
)));
1051 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1052 indication that there is no parent type. */
1053 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1055 xd_append_arg (dtype
, args
[i
], &iter
);
1058 /* Send the message. The message is just added to the outgoing
1060 if (!dbus_connection_send_with_reply (connection
, dmessage
, NULL
, timeout
))
1061 xsignal1 (Qdbus_error
, build_string ("Cannot send message"));
1063 XD_DEBUG_MESSAGE ("Message sent");
1065 /* The result is the key in Vdbus_registered_functions_table. */
1066 result
= (list2 (bus
, make_number (dbus_message_get_serial (dmessage
))));
1068 /* Create a hash table entry. */
1069 Fputhash (result
, handler
, Vdbus_registered_functions_table
);
1072 dbus_message_unref (dmessage
);
1074 /* Return the result. */
1075 RETURN_UNGCPRO (result
);
1078 DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal
,
1079 Sdbus_method_return_internal
,
1081 doc
: /* Return for message SERIAL on the D-Bus BUS.
1082 This is an internal function, it shall not be used outside dbus.el.
1084 usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
1087 register Lisp_Object
*args
;
1089 Lisp_Object bus
, serial
, service
;
1090 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1091 DBusConnection
*connection
;
1092 DBusMessage
*dmessage
;
1093 DBusMessageIter iter
;
1096 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1098 /* Check parameters. */
1104 CHECK_NUMBER (serial
);
1105 CHECK_STRING (service
);
1106 GCPRO3 (bus
, serial
, service
);
1108 XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial
), SDATA (service
));
1110 /* Open a connection to the bus. */
1111 connection
= xd_initialize (bus
);
1113 /* Create the message. */
1114 dmessage
= dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN
);
1115 if ((dmessage
== NULL
)
1116 || (!dbus_message_set_reply_serial (dmessage
, XUINT (serial
)))
1117 || (!dbus_message_set_destination (dmessage
, SDATA (service
))))
1120 xsignal1 (Qdbus_error
,
1121 build_string ("Unable to create a return message"));
1126 /* Initialize parameter list of message. */
1127 dbus_message_iter_init_append (dmessage
, &iter
);
1129 /* Append parameters to the message. */
1130 for (i
= 3; i
< nargs
; ++i
)
1132 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1133 if (XD_DBUS_TYPE_P (args
[i
]))
1135 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1136 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1137 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i
-2,
1138 SDATA (format2 ("%s", args
[i
], Qnil
)),
1139 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1144 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1145 XD_DEBUG_MESSAGE ("Parameter%d %s", i
-2,
1146 SDATA (format2 ("%s", args
[i
], Qnil
)));
1149 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1150 indication that there is no parent type. */
1151 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1153 xd_append_arg (dtype
, args
[i
], &iter
);
1156 /* Send the message. The message is just added to the outgoing
1158 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1159 xsignal1 (Qdbus_error
, build_string ("Cannot send message"));
1161 /* Flush connection to ensure the message is handled. */
1162 dbus_connection_flush (connection
);
1164 XD_DEBUG_MESSAGE ("Message sent");
1167 dbus_message_unref (dmessage
);
1173 DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal
,
1174 Sdbus_method_error_internal
,
1176 doc
: /* Return error message for message SERIAL on the D-Bus BUS.
1177 This is an internal function, it shall not be used outside dbus.el.
1179 usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
1182 register Lisp_Object
*args
;
1184 Lisp_Object bus
, serial
, service
;
1185 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1186 DBusConnection
*connection
;
1187 DBusMessage
*dmessage
;
1188 DBusMessageIter iter
;
1191 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1193 /* Check parameters. */
1199 CHECK_NUMBER (serial
);
1200 CHECK_STRING (service
);
1201 GCPRO3 (bus
, serial
, service
);
1203 XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial
), SDATA (service
));
1205 /* Open a connection to the bus. */
1206 connection
= xd_initialize (bus
);
1208 /* Create the message. */
1209 dmessage
= dbus_message_new (DBUS_MESSAGE_TYPE_ERROR
);
1210 if ((dmessage
== NULL
)
1211 || (!dbus_message_set_error_name (dmessage
, DBUS_ERROR_FAILED
))
1212 || (!dbus_message_set_reply_serial (dmessage
, XUINT (serial
)))
1213 || (!dbus_message_set_destination (dmessage
, SDATA (service
))))
1216 xsignal1 (Qdbus_error
,
1217 build_string ("Unable to create a error message"));
1222 /* Initialize parameter list of message. */
1223 dbus_message_iter_init_append (dmessage
, &iter
);
1225 /* Append parameters to the message. */
1226 for (i
= 3; i
< nargs
; ++i
)
1228 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1229 if (XD_DBUS_TYPE_P (args
[i
]))
1231 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1232 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1233 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i
-2,
1234 SDATA (format2 ("%s", args
[i
], Qnil
)),
1235 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1240 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1241 XD_DEBUG_MESSAGE ("Parameter%d %s", i
-2,
1242 SDATA (format2 ("%s", args
[i
], Qnil
)));
1245 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1246 indication that there is no parent type. */
1247 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1249 xd_append_arg (dtype
, args
[i
], &iter
);
1252 /* Send the message. The message is just added to the outgoing
1254 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1255 xsignal1 (Qdbus_error
, build_string ("Cannot send message"));
1257 /* Flush connection to ensure the message is handled. */
1258 dbus_connection_flush (connection
);
1260 XD_DEBUG_MESSAGE ("Message sent");
1263 dbus_message_unref (dmessage
);
1269 DEFUN ("dbus-send-signal", Fdbus_send_signal
, Sdbus_send_signal
, 5, MANY
, 0,
1270 doc
: /* Send signal SIGNAL on the D-Bus BUS.
1272 BUS is either the symbol `:system' or the symbol `:session'.
1274 SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
1275 D-Bus object path SERVICE is registered at. INTERFACE is an interface
1276 offered by SERVICE. It must provide signal SIGNAL.
1278 All other arguments ARGS are passed to SIGNAL as arguments. They are
1279 converted into D-Bus types via the following rules:
1281 t and nil => DBUS_TYPE_BOOLEAN
1282 number => DBUS_TYPE_UINT32
1283 integer => DBUS_TYPE_INT32
1284 float => DBUS_TYPE_DOUBLE
1285 string => DBUS_TYPE_STRING
1286 list => DBUS_TYPE_ARRAY
1288 All arguments can be preceded by a type symbol. For details about
1289 type symbols, see Info node `(dbus)Type Conversion'.
1294 :session "org.gnu.Emacs" "/org/gnu/Emacs"
1295 "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1297 usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
1300 register Lisp_Object
*args
;
1302 Lisp_Object bus
, service
, path
, interface
, signal
;
1303 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
1304 DBusConnection
*connection
;
1305 DBusMessage
*dmessage
;
1306 DBusMessageIter iter
;
1309 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1311 /* Check parameters. */
1315 interface
= args
[3];
1319 CHECK_STRING (service
);
1320 CHECK_STRING (path
);
1321 CHECK_STRING (interface
);
1322 CHECK_STRING (signal
);
1323 GCPRO5 (bus
, service
, path
, interface
, signal
);
1325 XD_DEBUG_MESSAGE ("%s %s %s %s",
1331 /* Open a connection to the bus. */
1332 connection
= xd_initialize (bus
);
1334 /* Create the message. */
1335 dmessage
= dbus_message_new_signal (SDATA (path
),
1339 if (dmessage
== NULL
)
1340 xsignal1 (Qdbus_error
, build_string ("Unable to create a new message"));
1342 /* Initialize parameter list of message. */
1343 dbus_message_iter_init_append (dmessage
, &iter
);
1345 /* Append parameters to the message. */
1346 for (i
= 5; i
< nargs
; ++i
)
1348 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1349 if (XD_DBUS_TYPE_P (args
[i
]))
1351 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1352 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1353 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i
-4,
1354 SDATA (format2 ("%s", args
[i
], Qnil
)),
1355 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1360 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1361 XD_DEBUG_MESSAGE ("Parameter%d %s", i
-4,
1362 SDATA (format2 ("%s", args
[i
], Qnil
)));
1365 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1366 indication that there is no parent type. */
1367 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1369 xd_append_arg (dtype
, args
[i
], &iter
);
1372 /* Send the message. The message is just added to the outgoing
1374 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1375 xsignal1 (Qdbus_error
, build_string ("Cannot send message"));
1377 /* Flush connection to ensure the message is handled. */
1378 dbus_connection_flush (connection
);
1380 XD_DEBUG_MESSAGE ("Signal sent");
1383 dbus_message_unref (dmessage
);
1389 /* Read queued incoming message of the D-Bus BUS. BUS is a Lisp
1390 symbol, either :system or :session. */
1392 xd_read_message (bus
)
1395 Lisp_Object args
, key
, value
;
1396 struct gcpro gcpro1
;
1397 struct input_event event
;
1398 DBusConnection
*connection
;
1399 DBusMessage
*dmessage
;
1400 DBusMessageIter iter
;
1403 const char *uname
, *path
, *interface
, *member
;
1405 /* Open a connection to the bus. */
1406 connection
= xd_initialize (bus
);
1408 /* Non blocking read of the next available message. */
1409 dbus_connection_read_write (connection
, 0);
1410 dmessage
= dbus_connection_pop_message (connection
);
1412 /* Return if there is no queued message. */
1413 if (dmessage
== NULL
)
1416 /* Collect the parameters. */
1420 /* Loop over the resulting parameters. Construct a list. */
1421 if (dbus_message_iter_init (dmessage
, &iter
))
1423 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
1424 != DBUS_TYPE_INVALID
)
1426 args
= Fcons (xd_retrieve_arg (dtype
, &iter
), args
);
1427 dbus_message_iter_next (&iter
);
1429 /* The arguments are stored in reverse order. Reorder them. */
1430 args
= Fnreverse (args
);
1433 /* Read message type, message serial, unique name, object path,
1434 interface and member from the message. */
1435 mtype
= dbus_message_get_type (dmessage
);
1437 ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1438 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1439 ? dbus_message_get_reply_serial (dmessage
)
1440 : dbus_message_get_serial (dmessage
);
1441 uname
= dbus_message_get_sender (dmessage
);
1442 path
= dbus_message_get_path (dmessage
);
1443 interface
= dbus_message_get_interface (dmessage
);
1444 member
= dbus_message_get_member (dmessage
);
1446 XD_DEBUG_MESSAGE ("Event received: %s %d %s %s %s %s %s",
1447 (mtype
== DBUS_MESSAGE_TYPE_INVALID
)
1448 ? "DBUS_MESSAGE_TYPE_INVALID"
1449 : (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1450 ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1451 : (mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1452 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1453 : (mtype
== DBUS_MESSAGE_TYPE_ERROR
)
1454 ? "DBUS_MESSAGE_TYPE_ERROR"
1455 : "DBUS_MESSAGE_TYPE_SIGNAL",
1456 serial
, uname
, path
, interface
, member
,
1457 SDATA (format2 ("%s", args
, Qnil
)));
1459 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1460 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1462 /* Search for a registered function of the message. */
1463 key
= list2 (bus
, make_number (serial
));
1464 value
= Fgethash (key
, Vdbus_registered_functions_table
, Qnil
);
1466 /* There shall be exactly one entry. Construct an event. */
1470 /* Remove the entry. */
1471 Fremhash (key
, Vdbus_registered_functions_table
);
1473 /* Construct an event. */
1475 event
.kind
= DBUS_EVENT
;
1476 event
.frame_or_window
= Qnil
;
1477 event
.arg
= Fcons (value
, args
);
1480 else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
1482 /* Vdbus_registered_functions_table requires non-nil interface
1484 if ((interface
== NULL
) || (member
== NULL
))
1487 /* Search for a registered function of the message. */
1488 key
= list3 (bus
, build_string (interface
), build_string (member
));
1489 value
= Fgethash (key
, Vdbus_registered_functions_table
, Qnil
);
1491 /* Loop over the registered functions. Construct an event. */
1492 while (!NILP (value
))
1494 key
= CAR_SAFE (value
);
1495 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1496 if (((uname
== NULL
)
1497 || (NILP (CAR_SAFE (key
)))
1498 || (strcmp (uname
, SDATA (CAR_SAFE (key
))) == 0))
1500 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1502 SDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1504 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))))
1507 event
.kind
= DBUS_EVENT
;
1508 event
.frame_or_window
= Qnil
;
1509 event
.arg
= Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))),
1513 value
= CDR_SAFE (value
);
1520 /* Add type, serial, uname, path, interface and member to the event. */
1521 event
.arg
= Fcons ((member
== NULL
? Qnil
: build_string (member
)),
1523 event
.arg
= Fcons ((interface
== NULL
? Qnil
: build_string (interface
)),
1525 event
.arg
= Fcons ((path
== NULL
? Qnil
: build_string (path
)),
1527 event
.arg
= Fcons ((uname
== NULL
? Qnil
: build_string (uname
)),
1529 event
.arg
= Fcons (make_number (serial
), event
.arg
);
1530 event
.arg
= Fcons (make_number (mtype
), event
.arg
);
1532 /* Add the bus symbol to the event. */
1533 event
.arg
= Fcons (bus
, event
.arg
);
1535 /* Store it into the input event queue. */
1536 kbd_buffer_store_event (&event
);
1538 XD_DEBUG_MESSAGE ("Event stored: %s",
1539 SDATA (format2 ("%s", event
.arg
, Qnil
)));
1542 dbus_message_unref (dmessage
);
1543 RETURN_UNGCPRO (Qnil
);
1546 /* Read queued incoming messages from the system and session buses. */
1548 xd_read_queued_messages ()
1551 /* Vdbus_registered_functions_table will be initialized as hash
1552 table in dbus.el. When this package isn't loaded yet, it doesn't
1553 make sense to handle D-Bus messages. Furthermore, we ignore all
1554 Lisp errors during the call. */
1555 if (HASH_TABLE_P (Vdbus_registered_functions_table
))
1557 internal_condition_case_1 (xd_read_message
, QCdbus_system_bus
,
1559 internal_condition_case_1 (xd_read_message
, QCdbus_session_bus
,
1564 DEFUN ("dbus-register-signal", Fdbus_register_signal
, Sdbus_register_signal
,
1566 doc
: /* Register for signal SIGNAL on the D-Bus BUS.
1568 BUS is either the symbol `:system' or the symbol `:session'.
1570 SERVICE is the D-Bus service name used by the sending D-Bus object.
1571 It can be either a known name or the unique name of the D-Bus object
1572 sending the signal. When SERVICE is nil, related signals from all
1573 D-Bus objects shall be accepted.
1575 PATH is the D-Bus object path SERVICE is registered. It can also be
1576 nil if the path name of incoming signals shall not be checked.
1578 INTERFACE is an interface offered by SERVICE. It must provide SIGNAL.
1579 HANDLER is a Lisp function to be called when the signal is received.
1580 It must accept as arguments the values SIGNAL is sending.
1582 All other arguments ARGS, if specified, must be strings. They stand
1583 for the respective arguments of the signal in their order, and are
1584 used for filtering as well. A nil argument might be used to preserve
1587 INTERFACE, SIGNAL and HANDLER must not be nil. Example:
1589 \(defun my-signal-handler (device)
1590 (message "Device %s added" device))
1592 \(dbus-register-signal
1593 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
1594 "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
1596 => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
1597 ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
1599 `dbus-register-signal' returns an object, which can be used in
1600 `dbus-unregister-object' for removing the registration.
1602 usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
1605 register Lisp_Object
*args
;
1607 Lisp_Object bus
, service
, path
, interface
, signal
, handler
;
1608 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1609 Lisp_Object uname
, key
, key1
, value
;
1610 DBusConnection
*connection
;
1612 char rule
[DBUS_MAXIMUM_MATCH_RULE_LENGTH
];
1613 char x
[DBUS_MAXIMUM_MATCH_RULE_LENGTH
];
1616 /* Check parameters. */
1620 interface
= args
[3];
1625 if (!NILP (service
)) CHECK_STRING (service
);
1626 if (!NILP (path
)) CHECK_STRING (path
);
1627 CHECK_STRING (interface
);
1628 CHECK_STRING (signal
);
1629 if (!FUNCTIONP (handler
))
1630 wrong_type_argument (intern ("functionp"), handler
);
1631 GCPRO6 (bus
, service
, path
, interface
, signal
, handler
);
1633 /* Retrieve unique name of service. If service is a known name, we
1634 will register for the corresponding unique name, if any. Signals
1635 are sent always with the unique name as sender. Note: the unique
1636 name of "org.freedesktop.DBus" is that string itself. */
1637 if ((STRINGP (service
))
1638 && (SBYTES (service
) > 0)
1639 && (strcmp (SDATA (service
), DBUS_SERVICE_DBUS
) != 0)
1640 && (strncmp (SDATA (service
), ":", 1) != 0))
1642 uname
= call2 (intern ("dbus-get-name-owner"), bus
, service
);
1643 /* When there is no unique name, we mark it with an empty
1646 uname
= build_string ("");
1651 /* Create a matching rule if the unique name exists (when no
1653 if (NILP (uname
) || (SBYTES (uname
) > 0))
1655 /* Open a connection to the bus. */
1656 connection
= xd_initialize (bus
);
1658 /* Create a rule to receive related signals. */
1660 "type='signal',interface='%s',member='%s'",
1664 /* Add unique name and path to the rule if they are non-nil. */
1667 sprintf (x
, ",sender='%s'", SDATA (uname
));
1673 sprintf (x
, ",path='%s'", SDATA (path
));
1677 /* Add arguments to the rule if they are non-nil. */
1678 for (i
= 6; i
< nargs
; ++i
)
1679 if (!NILP (args
[i
]))
1681 CHECK_STRING (args
[i
]);
1682 sprintf (x
, ",arg%d='%s'", i
-6, SDATA (args
[i
]));
1686 /* Add the rule to the bus. */
1687 dbus_error_init (&derror
);
1688 dbus_bus_add_match (connection
, rule
, &derror
);
1689 if (dbus_error_is_set (&derror
))
1695 XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule
);
1698 /* Create a hash table entry. */
1699 key
= list3 (bus
, interface
, signal
);
1700 key1
= list4 (uname
, service
, path
, handler
);
1701 value
= Fgethash (key
, Vdbus_registered_functions_table
, Qnil
);
1703 if (NILP (Fmember (key1
, value
)))
1704 Fputhash (key
, Fcons (key1
, value
), Vdbus_registered_functions_table
);
1706 /* Return object. */
1707 RETURN_UNGCPRO (list2 (key
, list3 (service
, path
, handler
)));
1710 DEFUN ("dbus-register-method", Fdbus_register_method
, Sdbus_register_method
,
1712 doc
: /* Register for method METHOD on the D-Bus BUS.
1714 BUS is either the symbol `:system' or the symbol `:session'.
1716 SERVICE is the D-Bus service name of the D-Bus object METHOD is
1717 registered for. It must be a known name.
1719 PATH is the D-Bus object path SERVICE is registered. INTERFACE is the
1720 interface offered by SERVICE. It must provide METHOD. HANDLER is a
1721 Lisp function to be called when a method call is received. It must
1722 accept the input arguments of METHOD. The return value of HANDLER is
1723 used for composing the returning D-Bus message. */)
1724 (bus
, service
, path
, interface
, method
, handler
)
1725 Lisp_Object bus
, service
, path
, interface
, method
, handler
;
1727 Lisp_Object key
, key1
, value
;
1728 DBusConnection
*connection
;
1732 /* Check parameters. */
1734 CHECK_STRING (service
);
1735 CHECK_STRING (path
);
1736 CHECK_STRING (interface
);
1737 CHECK_STRING (method
);
1738 if (!FUNCTIONP (handler
))
1739 wrong_type_argument (intern ("functionp"), handler
);
1740 /* TODO: We must check for a valid service name, otherwise there is
1741 a segmentation fault. */
1743 /* Open a connection to the bus. */
1744 connection
= xd_initialize (bus
);
1746 /* Request the known name from the bus. We can ignore the result,
1747 it is set to -1 if there is an error - kind of redundancy. */
1748 dbus_error_init (&derror
);
1749 result
= dbus_bus_request_name (connection
, SDATA (service
), 0, &derror
);
1750 if (dbus_error_is_set (&derror
))
1753 /* Create a hash table entry. */
1754 key
= list3 (bus
, interface
, method
);
1755 key1
= list4 (Qnil
, service
, path
, handler
);
1756 value
= Fgethash (key
, Vdbus_registered_functions_table
, Qnil
);
1758 /* We use nil for the unique name, because the method might be
1759 called from everybody. */
1760 if (NILP (Fmember (key1
, value
)))
1761 Fputhash (key
, Fcons (key1
, value
), Vdbus_registered_functions_table
);
1763 /* Return object. */
1764 return list2 (key
, list3 (service
, path
, handler
));
1772 Qdbus_get_unique_name
= intern ("dbus-get-unique-name");
1773 staticpro (&Qdbus_get_unique_name
);
1774 defsubr (&Sdbus_get_unique_name
);
1776 Qdbus_call_method
= intern ("dbus-call-method");
1777 staticpro (&Qdbus_call_method
);
1778 defsubr (&Sdbus_call_method
);
1780 Qdbus_call_method_asynchronously
= intern ("dbus-call-method-asynchronously");
1781 staticpro (&Qdbus_call_method_asynchronously
);
1782 defsubr (&Sdbus_call_method_asynchronously
);
1784 Qdbus_method_return_internal
= intern ("dbus-method-return-internal");
1785 staticpro (&Qdbus_method_return_internal
);
1786 defsubr (&Sdbus_method_return_internal
);
1788 Qdbus_method_error_internal
= intern ("dbus-method-error-internal");
1789 staticpro (&Qdbus_method_error_internal
);
1790 defsubr (&Sdbus_method_error_internal
);
1792 Qdbus_send_signal
= intern ("dbus-send-signal");
1793 staticpro (&Qdbus_send_signal
);
1794 defsubr (&Sdbus_send_signal
);
1796 Qdbus_register_signal
= intern ("dbus-register-signal");
1797 staticpro (&Qdbus_register_signal
);
1798 defsubr (&Sdbus_register_signal
);
1800 Qdbus_register_method
= intern ("dbus-register-method");
1801 staticpro (&Qdbus_register_method
);
1802 defsubr (&Sdbus_register_method
);
1804 Qdbus_error
= intern ("dbus-error");
1805 staticpro (&Qdbus_error
);
1806 Fput (Qdbus_error
, Qerror_conditions
,
1807 list2 (Qdbus_error
, Qerror
));
1808 Fput (Qdbus_error
, Qerror_message
,
1809 build_string ("D-Bus error"));
1811 QCdbus_system_bus
= intern (":system");
1812 staticpro (&QCdbus_system_bus
);
1814 QCdbus_session_bus
= intern (":session");
1815 staticpro (&QCdbus_session_bus
);
1817 QCdbus_timeout
= intern (":timeout");
1818 staticpro (&QCdbus_timeout
);
1820 QCdbus_type_byte
= intern (":byte");
1821 staticpro (&QCdbus_type_byte
);
1823 QCdbus_type_boolean
= intern (":boolean");
1824 staticpro (&QCdbus_type_boolean
);
1826 QCdbus_type_int16
= intern (":int16");
1827 staticpro (&QCdbus_type_int16
);
1829 QCdbus_type_uint16
= intern (":uint16");
1830 staticpro (&QCdbus_type_uint16
);
1832 QCdbus_type_int32
= intern (":int32");
1833 staticpro (&QCdbus_type_int32
);
1835 QCdbus_type_uint32
= intern (":uint32");
1836 staticpro (&QCdbus_type_uint32
);
1838 QCdbus_type_int64
= intern (":int64");
1839 staticpro (&QCdbus_type_int64
);
1841 QCdbus_type_uint64
= intern (":uint64");
1842 staticpro (&QCdbus_type_uint64
);
1844 QCdbus_type_double
= intern (":double");
1845 staticpro (&QCdbus_type_double
);
1847 QCdbus_type_string
= intern (":string");
1848 staticpro (&QCdbus_type_string
);
1850 QCdbus_type_object_path
= intern (":object-path");
1851 staticpro (&QCdbus_type_object_path
);
1853 QCdbus_type_signature
= intern (":signature");
1854 staticpro (&QCdbus_type_signature
);
1856 QCdbus_type_array
= intern (":array");
1857 staticpro (&QCdbus_type_array
);
1859 QCdbus_type_variant
= intern (":variant");
1860 staticpro (&QCdbus_type_variant
);
1862 QCdbus_type_struct
= intern (":struct");
1863 staticpro (&QCdbus_type_struct
);
1865 QCdbus_type_dict_entry
= intern (":dict-entry");
1866 staticpro (&QCdbus_type_dict_entry
);
1868 DEFVAR_LISP ("dbus-registered-functions-table",
1869 &Vdbus_registered_functions_table
,
1870 doc
: /* Hash table of registered functions for D-Bus.
1871 There are two different uses of the hash table: for calling registered
1872 functions, targeted by signals or method calls, and for calling
1873 handlers in case of non-blocking method call returns.
1875 In the first case, the key in the hash table is the list (BUS
1876 INTERFACE MEMBER). BUS is either the symbol `:system' or the symbol
1877 `:session'. INTERFACE is a string which denotes a D-Bus interface,
1878 and MEMBER, also a string, is either a method or a signal INTERFACE is
1879 offering. All arguments but BUS must not be nil.
1881 The value in the hash table is a list of quadruple lists
1882 \((UNAME SERVICE PATH HANDLER) (UNAME SERVICE PATH HANDLER) ...).
1883 SERVICE is the service name as registered, UNAME is the corresponding
1884 unique name. PATH is the object path of the sending object. All of
1885 them can be nil, which means a wildcard then. HANDLER is the function
1886 to be called when a D-Bus message, which matches the key criteria,
1889 In the second case, the key in the hash table is the list (BUS SERIAL).
1890 BUS is either the symbol `:system' or the symbol `:session'. SERIAL
1891 is the serial number of the non-blocking method call, a reply is
1892 expected. Both arguments must not be nil. The value in the hash
1893 table is HANDLER, the function to be called when the D-Bus reply
1894 message arrives. */);
1895 /* We initialize Vdbus_registered_functions_table in dbus.el,
1896 because we need to define a hash table function first. */
1897 Vdbus_registered_functions_table
= Qnil
;
1899 DEFVAR_LISP ("dbus-debug", &Vdbus_debug
,
1900 doc
: /* If non-nil, debug messages of D-Bus bindings are raised. */);
1907 Fprovide (intern ("dbusbind"), Qnil
);
1911 #endif /* HAVE_DBUS */
1913 /* arch-tag: 0e828477-b571-4fe4-b559-5c9211bc14b8
1914 (do not change this comment) */