1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007, 2008, 2009 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
;
66 /* Whether we are reading a D-Bus event. */
67 int xd_in_read_queued_messages
= 0;
70 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
71 we don't want to poison other namespaces with "dbus_". */
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) \
77 if (xd_in_read_queued_messages) \
78 Fthrow (Qdbus_error, Qnil); \
80 xsignal1 (Qdbus_error, arg); \
83 #define XD_SIGNAL2(arg1, arg2) \
85 if (xd_in_read_queued_messages) \
86 Fthrow (Qdbus_error, Qnil); \
88 xsignal2 (Qdbus_error, arg1, arg2); \
91 #define XD_SIGNAL3(arg1, arg2, arg3) \
93 if (xd_in_read_queued_messages) \
94 Fthrow (Qdbus_error, Qnil); \
96 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
99 /* Raise a Lisp error from a D-Bus ERROR. */
100 #define XD_ERROR(error) \
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)); \
111 /* Macros for debugging. In order to enable them, build with
112 "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'". */
114 #define XD_DEBUG_MESSAGE(...) \
117 snprintf (s, 1023, __VA_ARGS__); \
118 printf ("%s: %s\n", __func__, s); \
119 message ("%s: %s", __func__, s); \
121 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
123 if (!valid_lisp_object_p (object)) \
125 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
126 XD_SIGNAL1 (build_string ("Assertion failure")); \
130 #else /* !DBUS_DEBUG */
131 #define XD_DEBUG_MESSAGE(...) \
133 if (!NILP (Vdbus_debug)) \
136 snprintf (s, 1023, __VA_ARGS__); \
137 message ("%s: %s", __func__, s); \
140 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
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))
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
161 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
162 of the predefined D-Bus type symbols. */
164 xd_symbol_to_dbus_type (object
)
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
);
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)))
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) \
203 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
204 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
206 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
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)
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. */
222 xd_signature (signature
, dtype
, parent_type
, object
)
224 unsigned int dtype
, parent_type
;
227 unsigned int subtype
;
229 char x
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
236 case DBUS_TYPE_UINT16
:
237 case DBUS_TYPE_UINT32
:
238 case DBUS_TYPE_UINT64
:
239 CHECK_NATNUM (object
);
240 sprintf (signature
, "%c", dtype
);
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
);
249 case DBUS_TYPE_INT16
:
250 case DBUS_TYPE_INT32
:
251 case DBUS_TYPE_INT64
:
252 CHECK_NUMBER (object
);
253 sprintf (signature
, "%c", dtype
);
256 case DBUS_TYPE_DOUBLE
:
257 CHECK_FLOAT (object
);
258 sprintf (signature
, "%c", dtype
);
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
);
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. */
274 /* Type symbol is optional. */
275 if (EQ (QCdbus_type_array
, CAR_SAFE (elt
)))
276 elt
= XD_NEXT_VALUE (elt
);
278 /* If the array is empty, DBUS_TYPE_STRING is the default
282 subtype
= DBUS_TYPE_STRING
;
283 strcpy (x
, DBUS_TYPE_STRING_AS_STRING
);
287 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
288 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
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
))));
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
));
306 sprintf (signature
, "%c%s", dtype
, x
);
309 case DBUS_TYPE_VARIANT
:
310 /* Check that there is exactly one list element. */
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
)));
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
))));
321 sprintf (signature
, "%c", dtype
);
324 case DBUS_TYPE_STRUCT
:
325 /* A struct list might contain any number of elements with
326 different types. No further check needed. */
329 elt
= XD_NEXT_VALUE (elt
);
331 /* Compose the signature from the elements. It is enclosed by
333 sprintf (signature
, "%c", DBUS_STRUCT_BEGIN_CHAR
);
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
));
341 strcat (signature
, DBUS_STRUCT_END_CHAR_AS_STRING
);
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. */
350 /* Check the parent object type. */
351 if (parent_type
!= DBUS_TYPE_ARRAY
)
352 wrong_type_argument (intern ("D-Bus"), object
);
354 /* Compose the signature from the elements. It is enclosed by
356 sprintf (signature
, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR
);
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
);
364 if (!XD_BASIC_DBUS_TYPE (subtype
))
365 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt
)));
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
);
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
))));
377 /* Closing signature. */
378 strcat (signature
, DBUS_DICT_ENTRY_END_CHAR_AS_STRING
);
382 wrong_type_argument (intern ("D-Bus"), object
);
385 XD_DEBUG_MESSAGE ("%s", signature
);
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. */
394 xd_append_arg (dtype
, object
, iter
)
397 DBusMessageIter
*iter
;
399 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
400 DBusMessageIter subiter
;
402 if (XD_BASIC_DBUS_TYPE (dtype
))
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
);
414 case DBUS_TYPE_BOOLEAN
:
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
);
423 case DBUS_TYPE_INT16
:
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
);
432 case DBUS_TYPE_UINT16
:
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
);
441 case DBUS_TYPE_INT32
:
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
);
450 case DBUS_TYPE_UINT32
:
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
);
459 case DBUS_TYPE_INT64
:
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
);
468 case DBUS_TYPE_UINT64
:
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
);
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
);
484 case DBUS_TYPE_STRING
:
485 case DBUS_TYPE_OBJECT_PATH
:
486 case DBUS_TYPE_SIGNATURE
:
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
);
496 else /* Compound types. */
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
);
504 /* Open new subiteration. */
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
513 /* If the array is empty, DBUS_TYPE_STRING is the default
515 strcpy (signature
, DBUS_TYPE_STRING_AS_STRING
);
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
))))
526 strcpy (signature
, SDATA (CAR_SAFE (XD_NEXT_VALUE (object
))));
527 object
= CDR_SAFE (XD_NEXT_VALUE (object
));
531 xd_signature (signature
,
532 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
533 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
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
));
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
)));
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
));
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
));
567 /* Loop over list elements. */
568 while (!NILP (object
))
570 dtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
));
571 object
= XD_NEXT_VALUE (object
);
573 xd_append_arg (dtype
, CAR_SAFE (object
), &subiter
);
575 object
= CDR_SAFE (object
);
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
));
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. */
590 xd_retrieve_arg (dtype
, iter
)
592 DBusMessageIter
*iter
;
600 dbus_message_iter_get_basic (iter
, &val
);
602 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
603 return make_number (val
);
606 case DBUS_TYPE_BOOLEAN
:
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
;
614 case DBUS_TYPE_INT16
:
615 case DBUS_TYPE_UINT16
:
618 dbus_message_iter_get_basic (iter
, &val
);
619 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
620 return make_number (val
);
623 case DBUS_TYPE_INT32
:
624 case DBUS_TYPE_UINT32
:
626 /* Assignment to EMACS_INT stops GCC whining about limited
627 range of data type. */
630 dbus_message_iter_get_basic (iter
, &val
);
631 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
633 return make_fixnum_or_float (val1
);
636 case DBUS_TYPE_INT64
:
637 case DBUS_TYPE_UINT64
:
640 dbus_message_iter_get_basic (iter
, &val
);
641 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
642 return make_fixnum_or_float (val
);
645 case DBUS_TYPE_DOUBLE
:
648 dbus_message_iter_get_basic (iter
, &val
);
649 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
650 return make_float (val
);
653 case DBUS_TYPE_STRING
:
654 case DBUS_TYPE_OBJECT_PATH
:
655 case DBUS_TYPE_SIGNATURE
:
658 dbus_message_iter_get_basic (iter
, &val
);
659 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
660 return build_string (val
);
663 case DBUS_TYPE_ARRAY
:
664 case DBUS_TYPE_VARIANT
:
665 case DBUS_TYPE_STRUCT
:
666 case DBUS_TYPE_DICT_ENTRY
:
672 DBusMessageIter subiter
;
674 dbus_message_iter_recurse (iter
, &subiter
);
675 while ((subtype
= dbus_message_iter_get_arg_type (&subiter
))
676 != DBUS_TYPE_INVALID
)
678 result
= Fcons (xd_retrieve_arg (subtype
, &subiter
), result
);
679 dbus_message_iter_next (&subiter
);
681 XD_DEBUG_MESSAGE ("%c %s", dtype
, SDATA (format2 ("%s", result
, Qnil
)));
682 RETURN_UNGCPRO (Fnreverse (result
));
686 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype
);
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
*
697 DBusConnection
*connection
;
700 /* Parameter check. */
702 if (!((EQ (bus
, QCdbus_system_bus
)) || (EQ (bus
, QCdbus_session_bus
))))
703 XD_SIGNAL2 (build_string ("Wrong bus name"), bus
);
705 /* Open a connection to the bus. */
706 dbus_error_init (&derror
);
708 if (EQ (bus
, QCdbus_system_bus
))
709 connection
= dbus_bus_get (DBUS_BUS_SYSTEM
, &derror
);
711 connection
= dbus_bus_get (DBUS_BUS_SESSION
, &derror
);
713 if (dbus_error_is_set (&derror
))
716 if (connection
== NULL
)
717 XD_SIGNAL2 (build_string ("No connection"), bus
);
719 /* Return the result. */
723 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name
, Sdbus_get_unique_name
,
725 doc
: /* Return the unique name of Emacs registered at D-Bus BUS. */)
729 DBusConnection
*connection
;
732 /* Check parameters. */
735 /* Open a connection to the bus. */
736 connection
= xd_initialize (bus
);
738 /* Request the name. */
739 name
= dbus_bus_get_unique_name (connection
);
741 XD_SIGNAL1 (build_string ("No unique name available"));
744 return build_string (name
);
747 DEFUN ("dbus-call-method", Fdbus_call_method
, Sdbus_call_method
, 5, MANY
, 0,
748 doc
: /* Call METHOD on the D-Bus BUS.
750 BUS is either the symbol `:system' or the symbol `:session'.
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.
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.
761 All other arguments ARGS are passed to METHOD as arguments. They are
762 converted into D-Bus types via the following rules:
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
771 All arguments can be preceded by a type symbol. For details about
772 type symbols, see Info node `(dbus)Type Conversion'.
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:
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
798 :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
799 "org.gnome.seahorse.Keys" "GetKeyField"
800 "openpgp:657984B8C7A966DD" "simple-name")
802 => (t ("Philip R. Zimmermann"))
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.
808 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
809 "org.freedesktop.Hal.Device" "GetPropertyString"
810 "system.kernel.machine")
814 usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
817 register Lisp_Object
*args
;
819 Lisp_Object bus
, service
, path
, interface
, method
;
821 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
822 DBusConnection
*connection
;
823 DBusMessage
*dmessage
;
825 DBusMessageIter iter
;
830 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
832 /* Check parameters. */
840 CHECK_STRING (service
);
842 CHECK_STRING (interface
);
843 CHECK_STRING (method
);
844 GCPRO5 (bus
, service
, path
, interface
, method
);
846 XD_DEBUG_MESSAGE ("%s %s %s %s",
852 /* Open a connection to the bus. */
853 connection
= xd_initialize (bus
);
855 /* Create the message. */
856 dmessage
= dbus_message_new_method_call (SDATA (service
),
861 if (dmessage
== NULL
)
862 XD_SIGNAL1 (build_string ("Unable to create a new message"));
864 /* Check for timeout parameter. */
865 if ((i
+2 <= nargs
) && (EQ ((args
[i
]), QCdbus_timeout
)))
867 CHECK_NATNUM (args
[i
+1]);
868 timeout
= XUINT (args
[i
+1]);
872 /* Initialize parameter list of message. */
873 dbus_message_iter_init_append (dmessage
, &iter
);
875 /* Append parameters to the message. */
876 for (; i
< nargs
; ++i
)
878 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
879 if (XD_DBUS_TYPE_P (args
[i
]))
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
)));
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
)));
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
]);
899 xd_append_arg (dtype
, args
[i
], &iter
);
902 /* Send the message. */
903 dbus_error_init (&derror
);
904 reply
= dbus_connection_send_with_reply_and_block (connection
,
909 if (dbus_error_is_set (&derror
))
913 XD_SIGNAL1 (build_string ("No reply"));
915 XD_DEBUG_MESSAGE ("Message sent");
917 /* Collect the results. */
921 if (dbus_message_iter_init (reply
, &iter
))
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
)
928 result
= Fcons (xd_retrieve_arg (dtype
, &iter
), result
);
929 dbus_message_iter_next (&iter
);
934 /* No arguments: just return nil. */
938 dbus_message_unref (dmessage
);
939 dbus_message_unref (reply
);
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
));
946 RETURN_UNGCPRO (Fnreverse (result
));
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.
953 BUS is either the symbol `:system' or the symbol `:session'.
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.
959 HANDLER is a Lisp function, which is called when the corresponding
960 return message has arrived.
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.
967 All other arguments ARGS are passed to METHOD as arguments. They are
968 converted into D-Bus types via the following rules:
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
977 All arguments can be preceded by a type symbol. For details about
978 type symbols, see Info node `(dbus)Type Conversion'.
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
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")
996 usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
999 register Lisp_Object
*args
;
1001 Lisp_Object bus
, service
, path
, interface
, method
, handler
;
1003 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1004 DBusConnection
*connection
;
1005 DBusMessage
*dmessage
;
1006 DBusMessageIter iter
;
1010 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1012 /* Check parameters. */
1016 interface
= args
[3];
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
);
1029 XD_DEBUG_MESSAGE ("%s %s %s %s",
1035 /* Open a connection to the bus. */
1036 connection
= xd_initialize (bus
);
1038 /* Create the message. */
1039 dmessage
= dbus_message_new_method_call (SDATA (service
),
1043 if (dmessage
== NULL
)
1044 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1046 /* Check for timeout parameter. */
1047 if ((i
+2 <= nargs
) && (EQ ((args
[i
]), QCdbus_timeout
)))
1049 CHECK_NATNUM (args
[i
+1]);
1050 timeout
= XUINT (args
[i
+1]);
1054 /* Initialize parameter list of message. */
1055 dbus_message_iter_init_append (dmessage
, &iter
);
1057 /* Append parameters to the message. */
1058 for (; i
< nargs
; ++i
)
1060 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1061 if (XD_DBUS_TYPE_P (args
[i
]))
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
)));
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
)));
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
]);
1081 xd_append_arg (dtype
, args
[i
], &iter
);
1084 /* Send the message. The message is just added to the outgoing
1086 if (!dbus_connection_send_with_reply (connection
, dmessage
, NULL
, timeout
))
1087 XD_SIGNAL1 (build_string ("Cannot send message"));
1089 XD_DEBUG_MESSAGE ("Message sent");
1091 /* The result is the key in Vdbus_registered_functions_table. */
1092 result
= (list2 (bus
, make_number (dbus_message_get_serial (dmessage
))));
1094 /* Create a hash table entry. */
1095 Fputhash (result
, handler
, Vdbus_registered_functions_table
);
1098 dbus_message_unref (dmessage
);
1100 /* Return the result. */
1101 RETURN_UNGCPRO (result
);
1104 DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal
,
1105 Sdbus_method_return_internal
,
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.
1110 usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
1113 register Lisp_Object
*args
;
1115 Lisp_Object bus
, serial
, service
;
1116 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1117 DBusConnection
*connection
;
1118 DBusMessage
*dmessage
;
1119 DBusMessageIter iter
;
1122 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1124 /* Check parameters. */
1130 CHECK_NUMBER (serial
);
1131 CHECK_STRING (service
);
1132 GCPRO3 (bus
, serial
, service
);
1134 XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial
), SDATA (service
));
1136 /* Open a connection to the bus. */
1137 connection
= xd_initialize (bus
);
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
))))
1146 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1151 /* Initialize parameter list of message. */
1152 dbus_message_iter_init_append (dmessage
, &iter
);
1154 /* Append parameters to the message. */
1155 for (i
= 3; i
< nargs
; ++i
)
1157 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1158 if (XD_DBUS_TYPE_P (args
[i
]))
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
)));
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
)));
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
]);
1178 xd_append_arg (dtype
, args
[i
], &iter
);
1181 /* Send the message. The message is just added to the outgoing
1183 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1184 XD_SIGNAL1 (build_string ("Cannot send message"));
1186 /* Flush connection to ensure the message is handled. */
1187 dbus_connection_flush (connection
);
1189 XD_DEBUG_MESSAGE ("Message sent");
1192 dbus_message_unref (dmessage
);
1198 DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal
,
1199 Sdbus_method_error_internal
,
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.
1204 usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
1207 register Lisp_Object
*args
;
1209 Lisp_Object bus
, serial
, service
;
1210 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1211 DBusConnection
*connection
;
1212 DBusMessage
*dmessage
;
1213 DBusMessageIter iter
;
1216 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1218 /* Check parameters. */
1224 CHECK_NUMBER (serial
);
1225 CHECK_STRING (service
);
1226 GCPRO3 (bus
, serial
, service
);
1228 XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial
), SDATA (service
));
1230 /* Open a connection to the bus. */
1231 connection
= xd_initialize (bus
);
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
))))
1241 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1246 /* Initialize parameter list of message. */
1247 dbus_message_iter_init_append (dmessage
, &iter
);
1249 /* Append parameters to the message. */
1250 for (i
= 3; i
< nargs
; ++i
)
1252 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1253 if (XD_DBUS_TYPE_P (args
[i
]))
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
)));
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
)));
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
]);
1273 xd_append_arg (dtype
, args
[i
], &iter
);
1276 /* Send the message. The message is just added to the outgoing
1278 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1279 XD_SIGNAL1 (build_string ("Cannot send message"));
1281 /* Flush connection to ensure the message is handled. */
1282 dbus_connection_flush (connection
);
1284 XD_DEBUG_MESSAGE ("Message sent");
1287 dbus_message_unref (dmessage
);
1293 DEFUN ("dbus-send-signal", Fdbus_send_signal
, Sdbus_send_signal
, 5, MANY
, 0,
1294 doc
: /* Send signal SIGNAL on the D-Bus BUS.
1296 BUS is either the symbol `:system' or the symbol `:session'.
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.
1302 All other arguments ARGS are passed to SIGNAL as arguments. They are
1303 converted into D-Bus types via the following rules:
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
1312 All arguments can be preceded by a type symbol. For details about
1313 type symbols, see Info node `(dbus)Type Conversion'.
1318 :session "org.gnu.Emacs" "/org/gnu/Emacs"
1319 "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1321 usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
1324 register Lisp_Object
*args
;
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
;
1333 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1335 /* Check parameters. */
1339 interface
= args
[3];
1343 CHECK_STRING (service
);
1344 CHECK_STRING (path
);
1345 CHECK_STRING (interface
);
1346 CHECK_STRING (signal
);
1347 GCPRO5 (bus
, service
, path
, interface
, signal
);
1349 XD_DEBUG_MESSAGE ("%s %s %s %s",
1355 /* Open a connection to the bus. */
1356 connection
= xd_initialize (bus
);
1358 /* Create the message. */
1359 dmessage
= dbus_message_new_signal (SDATA (path
),
1363 if (dmessage
== NULL
)
1364 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1366 /* Initialize parameter list of message. */
1367 dbus_message_iter_init_append (dmessage
, &iter
);
1369 /* Append parameters to the message. */
1370 for (i
= 5; i
< nargs
; ++i
)
1372 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1373 if (XD_DBUS_TYPE_P (args
[i
]))
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
)));
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
)));
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
]);
1393 xd_append_arg (dtype
, args
[i
], &iter
);
1396 /* Send the message. The message is just added to the outgoing
1398 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1399 XD_SIGNAL1 (build_string ("Cannot send message"));
1401 /* Flush connection to ensure the message is handled. */
1402 dbus_connection_flush (connection
);
1404 XD_DEBUG_MESSAGE ("Signal sent");
1407 dbus_message_unref (dmessage
);
1413 /* Read queued incoming message of the D-Bus BUS. BUS is a Lisp
1414 symbol, either :system or :session. */
1416 xd_read_message (bus
)
1419 Lisp_Object args
, key
, value
;
1420 struct gcpro gcpro1
;
1421 struct input_event event
;
1422 DBusConnection
*connection
;
1423 DBusMessage
*dmessage
;
1424 DBusMessageIter iter
;
1427 const char *uname
, *path
, *interface
, *member
;
1429 /* Open a connection to the bus. */
1430 connection
= xd_initialize (bus
);
1432 /* Non blocking read of the next available message. */
1433 dbus_connection_read_write (connection
, 0);
1434 dmessage
= dbus_connection_pop_message (connection
);
1436 /* Return if there is no queued message. */
1437 if (dmessage
== NULL
)
1440 /* Collect the parameters. */
1444 /* Loop over the resulting parameters. Construct a list. */
1445 if (dbus_message_iter_init (dmessage
, &iter
))
1447 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
1448 != DBUS_TYPE_INVALID
)
1450 args
= Fcons (xd_retrieve_arg (dtype
, &iter
), args
);
1451 dbus_message_iter_next (&iter
);
1453 /* The arguments are stored in reverse order. Reorder them. */
1454 args
= Fnreverse (args
);
1457 /* Read message type, message serial, unique name, object path,
1458 interface and member from the message. */
1459 mtype
= dbus_message_get_type (dmessage
);
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
);
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
)));
1483 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1484 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
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
);
1490 /* There shall be exactly one entry. Construct an event. */
1494 /* Remove the entry. */
1495 Fremhash (key
, Vdbus_registered_functions_table
);
1497 /* Construct an event. */
1499 event
.kind
= DBUS_EVENT
;
1500 event
.frame_or_window
= Qnil
;
1501 event
.arg
= Fcons (value
, args
);
1504 else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
1506 /* Vdbus_registered_functions_table requires non-nil interface
1508 if ((interface
== NULL
) || (member
== NULL
))
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
);
1515 /* Loop over the registered functions. Construct an event. */
1516 while (!NILP (value
))
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))
1524 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1526 SDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1528 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))))
1531 event
.kind
= DBUS_EVENT
;
1532 event
.frame_or_window
= Qnil
;
1533 event
.arg
= Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))),
1537 value
= CDR_SAFE (value
);
1544 /* Add type, serial, uname, path, interface and member to the event. */
1545 event
.arg
= Fcons ((member
== NULL
? Qnil
: build_string (member
)),
1547 event
.arg
= Fcons ((interface
== NULL
? Qnil
: build_string (interface
)),
1549 event
.arg
= Fcons ((path
== NULL
? Qnil
: build_string (path
)),
1551 event
.arg
= Fcons ((uname
== NULL
? Qnil
: build_string (uname
)),
1553 event
.arg
= Fcons (make_number (serial
), event
.arg
);
1554 event
.arg
= Fcons (make_number (mtype
), event
.arg
);
1556 /* Add the bus symbol to the event. */
1557 event
.arg
= Fcons (bus
, event
.arg
);
1559 /* Store it into the input event queue. */
1560 kbd_buffer_store_event (&event
);
1562 XD_DEBUG_MESSAGE ("Event stored: %s",
1563 SDATA (format2 ("%s", event
.arg
, Qnil
)));
1566 dbus_message_unref (dmessage
);
1567 RETURN_UNGCPRO (Qnil
);
1570 /* Read queued incoming messages from the system and session buses. */
1572 xd_read_queued_messages ()
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
))
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;
1588 DEFUN ("dbus-register-signal", Fdbus_register_signal
, Sdbus_register_signal
,
1590 doc
: /* Register for signal SIGNAL on the D-Bus BUS.
1592 BUS is either the symbol `:system' or the symbol `:session'.
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.
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.
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.
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
1611 INTERFACE, SIGNAL and HANDLER must not be nil. Example:
1613 \(defun my-signal-handler (device)
1614 (message "Device %s added" device))
1616 \(dbus-register-signal
1617 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
1618 "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
1620 => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
1621 ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
1623 `dbus-register-signal' returns an object, which can be used in
1624 `dbus-unregister-object' for removing the registration.
1626 usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
1629 register Lisp_Object
*args
;
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
;
1636 char rule
[DBUS_MAXIMUM_MATCH_RULE_LENGTH
];
1637 char x
[DBUS_MAXIMUM_MATCH_RULE_LENGTH
];
1640 /* Check parameters. */
1644 interface
= args
[3];
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
);
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))
1666 uname
= call2 (intern ("dbus-get-name-owner"), bus
, service
);
1667 /* When there is no unique name, we mark it with an empty
1670 uname
= empty_unibyte_string
;
1675 /* Create a matching rule if the unique name exists (when no
1677 if (NILP (uname
) || (SBYTES (uname
) > 0))
1679 /* Open a connection to the bus. */
1680 connection
= xd_initialize (bus
);
1682 /* Create a rule to receive related signals. */
1684 "type='signal',interface='%s',member='%s'",
1688 /* Add unique name and path to the rule if they are non-nil. */
1691 sprintf (x
, ",sender='%s'", SDATA (uname
));
1697 sprintf (x
, ",path='%s'", SDATA (path
));
1701 /* Add arguments to the rule if they are non-nil. */
1702 for (i
= 6; i
< nargs
; ++i
)
1703 if (!NILP (args
[i
]))
1705 CHECK_STRING (args
[i
]);
1706 sprintf (x
, ",arg%d='%s'", i
-6, SDATA (args
[i
]));
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
))
1719 XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule
);
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
);
1727 if (NILP (Fmember (key1
, value
)))
1728 Fputhash (key
, Fcons (key1
, value
), Vdbus_registered_functions_table
);
1730 /* Return object. */
1731 RETURN_UNGCPRO (list2 (key
, list3 (service
, path
, handler
)));
1734 DEFUN ("dbus-register-method", Fdbus_register_method
, Sdbus_register_method
,
1736 doc
: /* Register for method METHOD on the D-Bus BUS.
1738 BUS is either the symbol `:system' or the symbol `:session'.
1740 SERVICE is the D-Bus service name of the D-Bus object METHOD is
1741 registered for. It must be a known name.
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
;
1751 Lisp_Object key
, key1
, value
;
1752 DBusConnection
*connection
;
1756 /* Check parameters. */
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. */
1767 /* Open a connection to the bus. */
1768 connection
= xd_initialize (bus
);
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
))
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
);
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
);
1787 /* Return object. */
1788 return list2 (key
, list3 (service
, path
, handler
));
1796 Qdbus_get_unique_name
= intern ("dbus-get-unique-name");
1797 staticpro (&Qdbus_get_unique_name
);
1798 defsubr (&Sdbus_get_unique_name
);
1800 Qdbus_call_method
= intern ("dbus-call-method");
1801 staticpro (&Qdbus_call_method
);
1802 defsubr (&Sdbus_call_method
);
1804 Qdbus_call_method_asynchronously
= intern ("dbus-call-method-asynchronously");
1805 staticpro (&Qdbus_call_method_asynchronously
);
1806 defsubr (&Sdbus_call_method_asynchronously
);
1808 Qdbus_method_return_internal
= intern ("dbus-method-return-internal");
1809 staticpro (&Qdbus_method_return_internal
);
1810 defsubr (&Sdbus_method_return_internal
);
1812 Qdbus_method_error_internal
= intern ("dbus-method-error-internal");
1813 staticpro (&Qdbus_method_error_internal
);
1814 defsubr (&Sdbus_method_error_internal
);
1816 Qdbus_send_signal
= intern ("dbus-send-signal");
1817 staticpro (&Qdbus_send_signal
);
1818 defsubr (&Sdbus_send_signal
);
1820 Qdbus_register_signal
= intern ("dbus-register-signal");
1821 staticpro (&Qdbus_register_signal
);
1822 defsubr (&Sdbus_register_signal
);
1824 Qdbus_register_method
= intern ("dbus-register-method");
1825 staticpro (&Qdbus_register_method
);
1826 defsubr (&Sdbus_register_method
);
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"));
1835 QCdbus_system_bus
= intern (":system");
1836 staticpro (&QCdbus_system_bus
);
1838 QCdbus_session_bus
= intern (":session");
1839 staticpro (&QCdbus_session_bus
);
1841 QCdbus_timeout
= intern (":timeout");
1842 staticpro (&QCdbus_timeout
);
1844 QCdbus_type_byte
= intern (":byte");
1845 staticpro (&QCdbus_type_byte
);
1847 QCdbus_type_boolean
= intern (":boolean");
1848 staticpro (&QCdbus_type_boolean
);
1850 QCdbus_type_int16
= intern (":int16");
1851 staticpro (&QCdbus_type_int16
);
1853 QCdbus_type_uint16
= intern (":uint16");
1854 staticpro (&QCdbus_type_uint16
);
1856 QCdbus_type_int32
= intern (":int32");
1857 staticpro (&QCdbus_type_int32
);
1859 QCdbus_type_uint32
= intern (":uint32");
1860 staticpro (&QCdbus_type_uint32
);
1862 QCdbus_type_int64
= intern (":int64");
1863 staticpro (&QCdbus_type_int64
);
1865 QCdbus_type_uint64
= intern (":uint64");
1866 staticpro (&QCdbus_type_uint64
);
1868 QCdbus_type_double
= intern (":double");
1869 staticpro (&QCdbus_type_double
);
1871 QCdbus_type_string
= intern (":string");
1872 staticpro (&QCdbus_type_string
);
1874 QCdbus_type_object_path
= intern (":object-path");
1875 staticpro (&QCdbus_type_object_path
);
1877 QCdbus_type_signature
= intern (":signature");
1878 staticpro (&QCdbus_type_signature
);
1880 QCdbus_type_array
= intern (":array");
1881 staticpro (&QCdbus_type_array
);
1883 QCdbus_type_variant
= intern (":variant");
1884 staticpro (&QCdbus_type_variant
);
1886 QCdbus_type_struct
= intern (":struct");
1887 staticpro (&QCdbus_type_struct
);
1889 QCdbus_type_dict_entry
= intern (":dict-entry");
1890 staticpro (&QCdbus_type_dict_entry
);
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.
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.
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,
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
;
1923 DEFVAR_LISP ("dbus-debug", &Vdbus_debug
,
1924 doc
: /* If non-nil, debug messages of D-Bus bindings are raised. */);
1931 Fprovide (intern ("dbusbind"), Qnil
);
1935 #endif /* HAVE_DBUS */
1937 /* arch-tag: 0e828477-b571-4fe4-b559-5c9211bc14b8
1938 (do not change this comment) */