1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007-2011 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/>. */
23 #include <dbus/dbus.h>
30 * #include "termhooks.h"
31 * #include "keyboard.h"
36 static Lisp_Object Qdbus_init_bus;
37 static Lisp_Object Qdbus_close_bus;
38 static Lisp_Object Qdbus_get_unique_name;
39 static Lisp_Object Qdbus_call_method;
40 static Lisp_Object Qdbus_call_method_asynchronously;
41 static Lisp_Object Qdbus_method_return_internal;
42 static Lisp_Object Qdbus_method_error_internal;
43 static Lisp_Object Qdbus_send_signal;
44 static Lisp_Object Qdbus_register_service;
45 static Lisp_Object Qdbus_register_signal;
46 static Lisp_Object Qdbus_register_method;
48 /* D-Bus error symbol. */
49 static Lisp_Object Qdbus_error;
51 /* Lisp symbols of the system and session buses. */
52 static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
54 /* Lisp symbol for method call timeout. */
55 static Lisp_Object QCdbus_timeout;
57 /* Lisp symbols for name request flags. */
58 static Lisp_Object QCdbus_request_name_allow_replacement;
59 static Lisp_Object QCdbus_request_name_replace_existing;
60 static Lisp_Object QCdbus_request_name_do_not_queue;
62 /* Lisp symbols for name request replies. */
63 static Lisp_Object QCdbus_request_name_reply_primary_owner;
64 static Lisp_Object QCdbus_request_name_reply_in_queue;
65 static Lisp_Object QCdbus_request_name_reply_exists;
66 static Lisp_Object QCdbus_request_name_reply_already_owner;
68 /* Lisp symbols of D-Bus types. */
69 static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
70 static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
71 static Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
72 static Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
73 static Lisp_Object QCdbus_type_double, QCdbus_type_string;
74 static Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
75 #ifdef DBUS_TYPE_UNIX_FD
76 static Lisp_Object QCdbus_type_unix_fd;
78 static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
79 static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
81 /* Whether we are reading a D-Bus event. */
82 static int xd_in_read_queued_messages = 0;
85 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
86 we don't want to poison other namespaces with "dbus_". */
88 /* Raise a signal. If we are reading events, we cannot signal; we
89 throw to xd_read_queued_messages then. */
90 #define XD_SIGNAL1(arg) \
92 if (xd_in_read_queued_messages) \
93 Fthrow (Qdbus_error, Qnil); \
95 xsignal1 (Qdbus_error, arg); \
98 #define XD_SIGNAL2(arg1, arg2) \
100 if (xd_in_read_queued_messages) \
101 Fthrow (Qdbus_error, Qnil); \
103 xsignal2 (Qdbus_error, arg1, arg2); \
106 #define XD_SIGNAL3(arg1, arg2, arg3) \
108 if (xd_in_read_queued_messages) \
109 Fthrow (Qdbus_error, Qnil); \
111 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
114 /* Raise a Lisp error from a D-Bus ERROR. */
115 #define XD_ERROR(error) \
117 /* Remove the trailing newline. */ \
118 char const *mess = error.message; \
119 char const *nl = strchr (mess, '\n'); \
120 Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
121 dbus_error_free (&error); \
125 /* Macros for debugging. In order to enable them, build with
126 "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
128 #define XD_DEBUG_MESSAGE(...) \
131 snprintf (s, sizeof s, __VA_ARGS__); \
132 printf ("%s: %s\n", __func__, s); \
133 message ("%s: %s", __func__, s); \
135 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
137 if (!valid_lisp_object_p (object)) \
139 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
140 XD_SIGNAL1 (build_string ("Assertion failure")); \
144 #else /* !DBUS_DEBUG */
145 #define XD_DEBUG_MESSAGE(...) \
147 if (!NILP (Vdbus_debug)) \
150 snprintf (s, 1023, __VA_ARGS__); \
151 message ("%s: %s", __func__, s); \
154 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
157 /* Check whether TYPE is a basic DBusType. */
158 #ifdef DBUS_TYPE_UNIX_FD
159 #define XD_BASIC_DBUS_TYPE(type) \
160 ((type == DBUS_TYPE_BYTE) \
161 || (type == DBUS_TYPE_BOOLEAN) \
162 || (type == DBUS_TYPE_INT16) \
163 || (type == DBUS_TYPE_UINT16) \
164 || (type == DBUS_TYPE_INT32) \
165 || (type == DBUS_TYPE_UINT32) \
166 || (type == DBUS_TYPE_INT64) \
167 || (type == DBUS_TYPE_UINT64) \
168 || (type == DBUS_TYPE_DOUBLE) \
169 || (type == DBUS_TYPE_STRING) \
170 || (type == DBUS_TYPE_OBJECT_PATH) \
171 || (type == DBUS_TYPE_SIGNATURE) \
172 || (type == DBUS_TYPE_UNIX_FD))
174 #define XD_BASIC_DBUS_TYPE(type) \
175 ((type == DBUS_TYPE_BYTE) \
176 || (type == DBUS_TYPE_BOOLEAN) \
177 || (type == DBUS_TYPE_INT16) \
178 || (type == DBUS_TYPE_UINT16) \
179 || (type == DBUS_TYPE_INT32) \
180 || (type == DBUS_TYPE_UINT32) \
181 || (type == DBUS_TYPE_INT64) \
182 || (type == DBUS_TYPE_UINT64) \
183 || (type == DBUS_TYPE_DOUBLE) \
184 || (type == DBUS_TYPE_STRING) \
185 || (type == DBUS_TYPE_OBJECT_PATH) \
186 || (type == DBUS_TYPE_SIGNATURE))
189 /* This was a macro. On Solaris 2.11 it was said to compile for
190 hours, when optimization is enabled. So we have transferred it into
192 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
193 of the predefined D-Bus type symbols. */
195 xd_symbol_to_dbus_type (Lisp_Object object)
198 ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
199 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
200 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
201 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
202 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
203 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
204 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
205 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
206 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
207 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
208 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
209 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
210 #ifdef DBUS_TYPE_UNIX_FD
211 : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD
213 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
214 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
215 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
216 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
217 : DBUS_TYPE_INVALID);
220 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
221 #define XD_DBUS_TYPE_P(object) \
222 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
224 /* Determine the DBusType of a given Lisp OBJECT. It is used to
225 convert Lisp objects, being arguments of `dbus-call-method' or
226 `dbus-send-signal', into corresponding C values appended as
227 arguments to a D-Bus message. */
228 #define XD_OBJECT_TO_DBUS_TYPE(object) \
229 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
230 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
231 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
232 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
233 : (STRINGP (object)) ? DBUS_TYPE_STRING \
234 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
236 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
237 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
239 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
243 /* Return a list pointer which does not have a Lisp symbol as car. */
244 #define XD_NEXT_VALUE(object) \
245 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
247 /* Check whether X is a valid dbus serial number. If valid, set
248 SERIAL to its value. Otherwise, signal an error. */
249 #define CHECK_DBUS_SERIAL_GET_SERIAL(x, serial) \
252 dbus_uint32_t DBUS_SERIAL_MAX = -1; \
253 if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \
255 else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \
257 && 0 <= XFLOAT_DATA (x) \
258 && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \
259 serial = XFLOAT_DATA (x); \
261 XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \
265 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
266 not become too long. */
268 xd_signature_cat (char *signature, char const *x)
270 ptrdiff_t siglen = strlen (signature);
271 ptrdiff_t xlen = strlen (x);
272 if (DBUS_MAXIMUM_SIGNATURE_LENGTH - xlen <= siglen)
274 strcat (signature, x);
277 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
278 used in dbus_message_iter_open_container. DTYPE is the DBusType
279 the object is related to. It is passed as argument, because it
280 cannot be detected in basic type objects, when they are preceded by
281 a type symbol. PARENT_TYPE is the DBusType of a container this
282 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
283 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
285 xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lisp_Object object)
287 unsigned int subtype;
291 char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
298 case DBUS_TYPE_UINT16:
299 case DBUS_TYPE_UINT32:
300 case DBUS_TYPE_UINT64:
301 #ifdef DBUS_TYPE_UNIX_FD
302 case DBUS_TYPE_UNIX_FD:
304 CHECK_NATNUM (object);
305 sprintf (signature, "%c", dtype);
308 case DBUS_TYPE_BOOLEAN:
309 if (!EQ (object, Qt) && !EQ (object, Qnil))
310 wrong_type_argument (intern ("booleanp"), object);
311 sprintf (signature, "%c", dtype);
314 case DBUS_TYPE_INT16:
315 case DBUS_TYPE_INT32:
316 case DBUS_TYPE_INT64:
317 CHECK_NUMBER (object);
318 sprintf (signature, "%c", dtype);
321 case DBUS_TYPE_DOUBLE:
322 CHECK_FLOAT (object);
323 sprintf (signature, "%c", dtype);
326 case DBUS_TYPE_STRING:
327 case DBUS_TYPE_OBJECT_PATH:
328 case DBUS_TYPE_SIGNATURE:
329 CHECK_STRING (object);
330 sprintf (signature, "%c", dtype);
333 case DBUS_TYPE_ARRAY:
334 /* Check that all list elements have the same D-Bus type. For
335 complex element types, we just check the container type, not
336 the whole element's signature. */
339 /* Type symbol is optional. */
340 if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
341 elt = XD_NEXT_VALUE (elt);
343 /* If the array is empty, DBUS_TYPE_STRING is the default
347 subtype = DBUS_TYPE_STRING;
348 subsig = DBUS_TYPE_STRING_AS_STRING;
352 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
353 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
357 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
358 only element, the value of this element is used as he array's
359 element signature. */
360 if ((subtype == DBUS_TYPE_SIGNATURE)
361 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
362 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
363 subsig = SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt)));
367 if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
368 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
369 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
372 subsiglen = snprintf (signature, DBUS_MAXIMUM_SIGNATURE_LENGTH,
373 "%c%s", dtype, subsig);
374 if (! (0 <= subsiglen && subsiglen < DBUS_MAXIMUM_SIGNATURE_LENGTH))
378 case DBUS_TYPE_VARIANT:
379 /* Check that there is exactly one list element. */
382 elt = XD_NEXT_VALUE (elt);
383 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
384 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
386 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
387 wrong_type_argument (intern ("D-Bus"),
388 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
390 sprintf (signature, "%c", dtype);
393 case DBUS_TYPE_STRUCT:
394 /* A struct list might contain any number of elements with
395 different types. No further check needed. */
398 elt = XD_NEXT_VALUE (elt);
400 /* Compose the signature from the elements. It is enclosed by
402 sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
405 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
406 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
407 xd_signature_cat (signature, x);
408 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
410 xd_signature_cat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
413 case DBUS_TYPE_DICT_ENTRY:
414 /* Check that there are exactly two list elements, and the first
415 one is of basic type. The dictionary entry itself must be an
416 element of an array. */
419 /* Check the parent object type. */
420 if (parent_type != DBUS_TYPE_ARRAY)
421 wrong_type_argument (intern ("D-Bus"), object);
423 /* Compose the signature from the elements. It is enclosed by
425 sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
428 elt = XD_NEXT_VALUE (elt);
429 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
430 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
431 xd_signature_cat (signature, x);
433 if (!XD_BASIC_DBUS_TYPE (subtype))
434 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
436 /* Second element. */
437 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
438 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
439 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
440 xd_signature_cat (signature, x);
442 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
443 wrong_type_argument (intern ("D-Bus"),
444 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
446 /* Closing signature. */
447 xd_signature_cat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
451 wrong_type_argument (intern ("D-Bus"), object);
454 XD_DEBUG_MESSAGE ("%s", signature);
457 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
458 DTYPE must be a valid DBusType. It is used to convert Lisp
459 objects, being arguments of `dbus-call-method' or
460 `dbus-send-signal', into corresponding C values appended as
461 arguments to a D-Bus message. */
463 xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
465 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
466 DBusMessageIter subiter;
468 if (XD_BASIC_DBUS_TYPE (dtype))
472 CHECK_NATNUM (object);
474 unsigned char val = XFASTINT (object) & 0xFF;
475 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
476 if (!dbus_message_iter_append_basic (iter, dtype, &val))
477 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
481 case DBUS_TYPE_BOOLEAN:
483 dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
484 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
485 if (!dbus_message_iter_append_basic (iter, dtype, &val))
486 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
490 case DBUS_TYPE_INT16:
491 CHECK_NUMBER (object);
493 dbus_int16_t val = XINT (object);
494 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
495 if (!dbus_message_iter_append_basic (iter, dtype, &val))
496 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
500 case DBUS_TYPE_UINT16:
501 CHECK_NATNUM (object);
503 dbus_uint16_t val = XFASTINT (object);
504 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
505 if (!dbus_message_iter_append_basic (iter, dtype, &val))
506 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
510 case DBUS_TYPE_INT32:
511 CHECK_NUMBER (object);
513 dbus_int32_t val = XINT (object);
514 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
515 if (!dbus_message_iter_append_basic (iter, dtype, &val))
516 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
520 case DBUS_TYPE_UINT32:
521 #ifdef DBUS_TYPE_UNIX_FD
522 case DBUS_TYPE_UNIX_FD:
524 CHECK_NATNUM (object);
526 dbus_uint32_t val = XFASTINT (object);
527 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
528 if (!dbus_message_iter_append_basic (iter, dtype, &val))
529 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
533 case DBUS_TYPE_INT64:
534 CHECK_NUMBER (object);
536 dbus_int64_t val = XINT (object);
537 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
538 if (!dbus_message_iter_append_basic (iter, dtype, &val))
539 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
543 case DBUS_TYPE_UINT64:
544 CHECK_NATNUM (object);
546 dbus_uint64_t val = XFASTINT (object);
547 XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object));
548 if (!dbus_message_iter_append_basic (iter, dtype, &val))
549 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
553 case DBUS_TYPE_DOUBLE:
554 CHECK_FLOAT (object);
556 double val = XFLOAT_DATA (object);
557 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
558 if (!dbus_message_iter_append_basic (iter, dtype, &val))
559 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
563 case DBUS_TYPE_STRING:
564 case DBUS_TYPE_OBJECT_PATH:
565 case DBUS_TYPE_SIGNATURE:
566 CHECK_STRING (object);
568 /* We need to send a valid UTF-8 string. We could encode `object'
569 but by not encoding it, we guarantee it's valid utf-8, even if
570 it contains eight-bit-bytes. Of course, you can still send
571 manually-crafted junk by passing a unibyte string. */
572 char *val = SSDATA (object);
573 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
574 if (!dbus_message_iter_append_basic (iter, dtype, &val))
575 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
580 else /* Compound types. */
583 /* All compound types except array have a type symbol. For
584 array, it is optional. Skip it. */
585 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
586 object = XD_NEXT_VALUE (object);
588 /* Open new subiteration. */
591 case DBUS_TYPE_ARRAY:
592 /* An array has only elements of the same type. So it is
593 sufficient to check the first element's signature
597 /* If the array is empty, DBUS_TYPE_STRING is the default
599 strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
602 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
603 the only element, the value of this element is used as
604 the array's element signature. */
605 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
606 == DBUS_TYPE_SIGNATURE)
607 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
608 && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
610 strcpy (signature, SSDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
611 object = CDR_SAFE (XD_NEXT_VALUE (object));
615 xd_signature (signature,
616 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
617 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
619 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
620 SDATA (format2 ("%s", object, Qnil)));
621 if (!dbus_message_iter_open_container (iter, dtype,
622 signature, &subiter))
623 XD_SIGNAL3 (build_string ("Cannot open container"),
624 make_number (dtype), build_string (signature));
627 case DBUS_TYPE_VARIANT:
628 /* A variant has just one element. */
629 xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
630 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
632 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
633 SDATA (format2 ("%s", object, Qnil)));
634 if (!dbus_message_iter_open_container (iter, dtype,
635 signature, &subiter))
636 XD_SIGNAL3 (build_string ("Cannot open container"),
637 make_number (dtype), build_string (signature));
640 case DBUS_TYPE_STRUCT:
641 case DBUS_TYPE_DICT_ENTRY:
642 /* These containers do not require a signature. */
643 XD_DEBUG_MESSAGE ("%c %s", dtype,
644 SDATA (format2 ("%s", object, Qnil)));
645 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
646 XD_SIGNAL2 (build_string ("Cannot open container"),
647 make_number (dtype));
651 /* Loop over list elements. */
652 while (!NILP (object))
654 dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
655 object = XD_NEXT_VALUE (object);
657 xd_append_arg (dtype, CAR_SAFE (object), &subiter);
659 object = CDR_SAFE (object);
662 /* Close the subiteration. */
663 if (!dbus_message_iter_close_container (iter, &subiter))
664 XD_SIGNAL2 (build_string ("Cannot close container"),
665 make_number (dtype));
669 /* Retrieve C value from a DBusMessageIter structure ITER, and return
670 a converted Lisp object. The type DTYPE of the argument of the
671 D-Bus message must be a valid DBusType. Compound D-Bus types
672 result always in a Lisp list. */
674 xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
682 dbus_message_iter_get_basic (iter, &val);
684 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
685 return make_number (val);
688 case DBUS_TYPE_BOOLEAN:
691 dbus_message_iter_get_basic (iter, &val);
692 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
693 return (val == FALSE) ? Qnil : Qt;
696 case DBUS_TYPE_INT16:
699 dbus_message_iter_get_basic (iter, &val);
700 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
701 return make_number (val);
704 case DBUS_TYPE_UINT16:
707 dbus_message_iter_get_basic (iter, &val);
708 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
709 return make_number (val);
712 case DBUS_TYPE_INT32:
715 dbus_message_iter_get_basic (iter, &val);
716 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
717 return make_fixnum_or_float (val);
720 case DBUS_TYPE_UINT32:
721 #ifdef DBUS_TYPE_UNIX_FD
722 case DBUS_TYPE_UNIX_FD:
726 dbus_message_iter_get_basic (iter, &val);
727 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
728 return make_fixnum_or_float (val);
731 case DBUS_TYPE_INT64:
734 dbus_message_iter_get_basic (iter, &val);
735 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
736 return make_fixnum_or_float (val);
739 case DBUS_TYPE_UINT64:
742 dbus_message_iter_get_basic (iter, &val);
743 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
744 return make_fixnum_or_float (val);
747 case DBUS_TYPE_DOUBLE:
750 dbus_message_iter_get_basic (iter, &val);
751 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
752 return make_float (val);
755 case DBUS_TYPE_STRING:
756 case DBUS_TYPE_OBJECT_PATH:
757 case DBUS_TYPE_SIGNATURE:
760 dbus_message_iter_get_basic (iter, &val);
761 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
762 return build_string (val);
765 case DBUS_TYPE_ARRAY:
766 case DBUS_TYPE_VARIANT:
767 case DBUS_TYPE_STRUCT:
768 case DBUS_TYPE_DICT_ENTRY:
772 DBusMessageIter subiter;
776 dbus_message_iter_recurse (iter, &subiter);
777 while ((subtype = dbus_message_iter_get_arg_type (&subiter))
778 != DBUS_TYPE_INVALID)
780 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
781 dbus_message_iter_next (&subiter);
783 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil)));
784 RETURN_UNGCPRO (Fnreverse (result));
788 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
793 /* Initialize D-Bus connection. BUS is either a Lisp symbol, :system
794 or :session, or a string denoting the bus address. It tells which
795 D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error
796 when the connection cannot be initialized. */
797 static DBusConnection *
798 xd_initialize (Lisp_Object bus, int raise_error)
800 DBusConnection *connection;
803 /* Parameter check. */
807 if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
810 XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
815 /* We do not want to have an autolaunch for the session bus. */
816 if (EQ (bus, QCdbus_session_bus)
817 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
820 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
826 /* Open a connection to the bus. */
827 dbus_error_init (&derror);
830 connection = dbus_connection_open (SSDATA (bus), &derror);
832 if (EQ (bus, QCdbus_system_bus))
833 connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
835 connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
837 if (dbus_error_is_set (&derror))
845 /* If it is not the system or session bus, we must register
846 ourselves. Otherwise, we have called dbus_bus_get, which has
847 configured us to exit if the connection closes - we undo this
849 if (connection != NULL)
852 dbus_bus_register (connection, &derror);
854 dbus_connection_set_exit_on_disconnect (connection, FALSE);
857 if (dbus_error_is_set (&derror))
865 if (connection == NULL && raise_error)
866 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
869 dbus_error_free (&derror);
871 /* Return the result. */
875 /* Return the file descriptor for WATCH, -1 if not found. */
877 xd_find_watch_fd (DBusWatch *watch)
879 #if HAVE_DBUS_WATCH_GET_UNIX_FD
880 /* TODO: Reverse these on Win32, which prefers the opposite. */
881 int fd = dbus_watch_get_unix_fd (watch);
883 fd = dbus_watch_get_socket (watch);
885 int fd = dbus_watch_get_fd (watch);
892 xd_read_queued_messages (int fd, void *data, int for_read);
894 /* Start monitoring WATCH for possible I/O. */
896 xd_add_watch (DBusWatch *watch, void *data)
898 unsigned int flags = dbus_watch_get_flags (watch);
899 int fd = xd_find_watch_fd (watch);
901 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
902 fd, flags & DBUS_WATCH_WRITABLE,
903 dbus_watch_get_enabled (watch));
908 if (dbus_watch_get_enabled (watch))
910 if (flags & DBUS_WATCH_WRITABLE)
911 add_write_fd (fd, xd_read_queued_messages, data);
912 if (flags & DBUS_WATCH_READABLE)
913 add_read_fd (fd, xd_read_queued_messages, data);
918 /* Stop monitoring WATCH for possible I/O.
919 DATA is the used bus, either a string or QCdbus_system_bus or
920 QCdbus_session_bus. */
922 xd_remove_watch (DBusWatch *watch, void *data)
924 unsigned int flags = dbus_watch_get_flags (watch);
925 int fd = xd_find_watch_fd (watch);
927 XD_DEBUG_MESSAGE ("fd %d", fd);
932 /* Unset session environment. */
933 if (XSYMBOL (QCdbus_session_bus) == data)
935 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
936 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
939 if (flags & DBUS_WATCH_WRITABLE)
940 delete_write_fd (fd);
941 if (flags & DBUS_WATCH_READABLE)
945 /* Toggle monitoring WATCH for possible I/O. */
947 xd_toggle_watch (DBusWatch *watch, void *data)
949 if (dbus_watch_get_enabled (watch))
950 xd_add_watch (watch, data);
952 xd_remove_watch (watch, data);
955 DEFUN("dbus-init-bus", Fdbus_init_bus, 1, 1, 0, /*
956 Initialize connection to D-Bus BUS.
960 DBusConnection *connection;
963 /* Check parameter. */
965 busp = XSYMBOL (bus);
966 else if (STRINGP (bus))
967 busp = XSTRING (bus);
969 wrong_type_argument (intern ("D-Bus"), bus);
971 /* Open a connection to the bus. */
972 connection = xd_initialize (bus, TRUE);
974 /* Add the watch functions. We pass also the bus as data, in order
975 to distinguish between the buses in xd_remove_watch. */
976 if (!dbus_connection_set_watch_functions (connection,
981 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
983 /* Add bus to list of registered buses. */
984 Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses);
986 /* We do not want to abort. */
987 putenv ((char *) "DBUS_FATAL_WARNINGS=0");
993 DEFUN("dbus-close-bus", Fdbus_close_bus, 1, 1, 0, /*
994 Close connection to D-Bus BUS.
998 DBusConnection *connection;
1000 /* Open a connection to the bus. */
1001 connection = xd_initialize (bus, TRUE);
1003 /* Decrement reference count to the bus. */
1004 dbus_connection_unref (connection);
1006 /* Remove bus from list of registered buses. */
1007 Vdbus_registered_buses = Fdelete (bus, Vdbus_registered_buses);
1013 DEFUN("dbus-get-unique-name", Fdbus_get_unique_name, 1, 1, 0, /*
1014 Return the unique name of Emacs registered at D-Bus BUS.
1018 DBusConnection *connection;
1021 /* Open a connection to the bus. */
1022 connection = xd_initialize (bus, TRUE);
1024 /* Request the name. */
1025 name = dbus_bus_get_unique_name (connection);
1027 XD_SIGNAL1 (build_string ("No unique name available"));
1030 return build_string (name);
1033 DEFUN("dbus-call-method", Fdbus_call_method, 5, MANY, 0, /*
1034 Call METHOD on the D-Bus BUS.
1036 BUS is either a Lisp symbol, `:system' or `:session', or a string
1037 denoting the bus address.
1039 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
1040 object path SERVICE is registered at. INTERFACE is an interface
1041 offered by SERVICE. It must provide METHOD.
1043 If the parameter `:timeout' is given, the following integer TIMEOUT
1044 specifies the maximum number of milliseconds the method call must
1045 return. The default value is 25,000. If the method call doesn't
1046 return in time, a D-Bus error is raised.
1048 All other arguments ARGS are passed to METHOD as arguments. They are
1049 converted into D-Bus types via the following rules:
1051 t and nil => DBUS_TYPE_BOOLEAN
1052 number => DBUS_TYPE_UINT32
1053 integer => DBUS_TYPE_INT32
1054 float => DBUS_TYPE_DOUBLE
1055 string => DBUS_TYPE_STRING
1056 list => DBUS_TYPE_ARRAY
1058 All arguments can be preceded by a type symbol. For details about
1059 type symbols, see Info node `(dbus)Type Conversion'.
1061 `dbus-call-method' returns the resulting values of METHOD as a list of
1062 Lisp objects. The type conversion happens the other direction as for
1063 input arguments. It follows the mapping rules:
1065 DBUS_TYPE_BOOLEAN => t or nil
1066 DBUS_TYPE_BYTE => number
1067 DBUS_TYPE_UINT16 => number
1068 DBUS_TYPE_INT16 => integer
1069 DBUS_TYPE_UINT32 => number or float
1070 DBUS_TYPE_UNIX_FD => number or float
1071 DBUS_TYPE_INT32 => integer or float
1072 DBUS_TYPE_UINT64 => number or float
1073 DBUS_TYPE_INT64 => integer or float
1074 DBUS_TYPE_DOUBLE => float
1075 DBUS_TYPE_STRING => string
1076 DBUS_TYPE_OBJECT_PATH => string
1077 DBUS_TYPE_SIGNATURE => string
1078 DBUS_TYPE_ARRAY => list
1079 DBUS_TYPE_VARIANT => list
1080 DBUS_TYPE_STRUCT => list
1081 DBUS_TYPE_DICT_ENTRY => list
1086 :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
1087 "org.gnome.seahorse.Keys" "GetKeyField"
1088 "openpgp:657984B8C7A966DD" "simple-name")
1090 => (t ("Philip R. Zimmermann"))
1092 If the result of the METHOD call is just one value, the converted Lisp
1093 object is returned instead of a list containing this single Lisp object.
1096 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1097 "org.freedesktop.Hal.Device" "GetPropertyString"
1098 "system.kernel.machine")
1102 usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS)
1104 (ptrdiff_t nargs, Lisp_Object *args))
1106 Lisp_Object bus, service, path, interface, method;
1108 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1109 DBusConnection *connection;
1110 DBusMessage *dmessage;
1112 DBusMessageIter iter;
1117 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1119 /* Check parameters. */
1123 interface = args[3];
1126 CHECK_STRING (service);
1127 CHECK_STRING (path);
1128 CHECK_STRING (interface);
1129 CHECK_STRING (method);
1130 GCPRO5 (bus, service, path, interface, method);
1132 XD_DEBUG_MESSAGE ("%s %s %s %s",
1138 /* Open a connection to the bus. */
1139 connection = xd_initialize (bus, TRUE);
1141 /* Create the message. */
1142 dmessage = dbus_message_new_method_call (SSDATA (service),
1147 if (dmessage == NULL)
1148 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1150 /* Check for timeout parameter. */
1151 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
1153 CHECK_NATNUM (args[i+1]);
1154 timeout = XFASTINT (args[i+1]);
1158 /* Initialize parameter list of message. */
1159 dbus_message_iter_init_append (dmessage, &iter);
1161 /* Append parameters to the message. */
1162 for (; i < nargs; ++i)
1164 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1165 if (XD_DBUS_TYPE_P (args[i]))
1167 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1168 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1169 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
1170 SDATA (format2 ("%s", args[i], Qnil)),
1171 SDATA (format2 ("%s", args[i+1], Qnil)));
1176 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1177 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
1178 SDATA (format2 ("%s", args[i], Qnil)));
1181 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1182 indication that there is no parent type. */
1183 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1185 xd_append_arg (dtype, args[i], &iter);
1188 /* Send the message. */
1189 dbus_error_init (&derror);
1190 reply = dbus_connection_send_with_reply_and_block (connection,
1195 if (dbus_error_is_set (&derror))
1199 XD_SIGNAL1 (build_string ("No reply"));
1201 XD_DEBUG_MESSAGE ("Message sent");
1203 /* Collect the results. */
1207 if (dbus_message_iter_init (reply, &iter))
1209 /* Loop over the parameters of the D-Bus reply message. Construct a
1210 Lisp list, which is returned by `dbus-call-method'. */
1211 while ((dtype = dbus_message_iter_get_arg_type (&iter))
1212 != DBUS_TYPE_INVALID)
1214 result = Fcons (xd_retrieve_arg (dtype, &iter), result);
1215 dbus_message_iter_next (&iter);
1220 /* No arguments: just return nil. */
1224 dbus_error_free (&derror);
1225 dbus_message_unref (dmessage);
1226 dbus_message_unref (reply);
1228 /* Return the result. If there is only one single Lisp object,
1229 return it as-it-is, otherwise return the reversed list. */
1230 if (XFASTINT (Flength (result)) == 1)
1231 RETURN_UNGCPRO (CAR_SAFE (result));
1233 RETURN_UNGCPRO (Fnreverse (result));
1236 DEFUN("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
1238 Call METHOD on the D-Bus BUS asynchronously.
1240 BUS is either a Lisp symbol, `:system' or `:session', or a string
1241 denoting the bus address.
1243 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
1244 object path SERVICE is registered at. INTERFACE is an interface
1245 offered by SERVICE. It must provide METHOD.
1247 HANDLER is a Lisp function, which is called when the corresponding
1248 return message has arrived. If HANDLER is nil, no return message will
1251 If the parameter `:timeout' is given, the following integer TIMEOUT
1252 specifies the maximum number of milliseconds the method call must
1253 return. The default value is 25,000. If the method call doesn't
1254 return in time, a D-Bus error is raised.
1256 All other arguments ARGS are passed to METHOD as arguments. They are
1257 converted into D-Bus types via the following rules:
1259 t and nil => DBUS_TYPE_BOOLEAN
1260 number => DBUS_TYPE_UINT32
1261 integer => DBUS_TYPE_INT32
1262 float => DBUS_TYPE_DOUBLE
1263 string => DBUS_TYPE_STRING
1264 list => DBUS_TYPE_ARRAY
1266 All arguments can be preceded by a type symbol. For details about
1267 type symbols, see Info node `(dbus)Type Conversion'.
1269 Unless HANDLER is nil, the function returns a key into the hash table
1270 `dbus-registered-objects-table'. The corresponding entry in the hash
1271 table is removed, when the return message has been arrived, and
1276 \(dbus-call-method-asynchronously
1277 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1278 "org.freedesktop.Hal.Device" "GetPropertyString" 'message
1279 "system.kernel.machine")
1285 usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS)
1287 (ptrdiff_t nargs, Lisp_Object *args))
1289 Lisp_Object bus, service, path, interface, method, handler;
1291 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1292 DBusConnection *connection;
1293 DBusMessage *dmessage;
1294 DBusMessageIter iter;
1296 dbus_uint32_t serial;
1299 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1301 /* Check parameters. */
1305 interface = args[3];
1309 CHECK_STRING (service);
1310 CHECK_STRING (path);
1311 CHECK_STRING (interface);
1312 CHECK_STRING (method);
1313 if (!NILP (handler) && !FUNCTIONP (handler))
1314 wrong_type_argument (Qinvalid_function, handler);
1315 GCPRO6 (bus, service, path, interface, method, handler);
1317 XD_DEBUG_MESSAGE ("%s %s %s %s",
1323 /* Open a connection to the bus. */
1324 connection = xd_initialize (bus, TRUE);
1326 /* Create the message. */
1327 dmessage = dbus_message_new_method_call (SSDATA (service),
1331 if (dmessage == NULL)
1332 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1334 /* Check for timeout parameter. */
1335 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
1337 CHECK_NATNUM (args[i+1]);
1338 timeout = XFASTINT (args[i+1]);
1342 /* Initialize parameter list of message. */
1343 dbus_message_iter_init_append (dmessage, &iter);
1345 /* Append parameters to the message. */
1346 for (; 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%"pD"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%"pD"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 if (!NILP (handler))
1374 /* Send the message. The message is just added to the outgoing
1376 if (!dbus_connection_send_with_reply (connection, dmessage,
1378 XD_SIGNAL1 (build_string ("Cannot send message"));
1380 /* The result is the key in Vdbus_registered_objects_table. */
1381 serial = dbus_message_get_serial (dmessage);
1382 result = list2 (bus, make_fixnum_or_float (serial));
1384 /* Create a hash table entry. */
1385 Fputhash (result, handler, Vdbus_registered_objects_table);
1389 /* Send the message. The message is just added to the outgoing
1391 if (!dbus_connection_send (connection, dmessage, NULL))
1392 XD_SIGNAL1 (build_string ("Cannot send message"));
1397 XD_DEBUG_MESSAGE ("Message sent");
1400 dbus_message_unref (dmessage);
1402 /* Return the result. */
1403 RETURN_UNGCPRO (result);
1406 DEFUN("dbus-method-return-internal", Fdbus_method_return_internal,
1408 Return for message SERIAL on the D-Bus BUS.
1409 This is an internal function, it shall not be used outside dbus.el.
1411 usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS)
1413 (ptrdiff_t nargs, Lisp_Object *args))
1415 Lisp_Object bus, service;
1416 struct gcpro gcpro1, gcpro2;
1417 DBusConnection *connection;
1418 DBusMessage *dmessage;
1419 DBusMessageIter iter;
1420 dbus_uint32_t serial;
1421 unsigned int ui_serial, dtype;
1423 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1425 /* Check parameters. */
1429 CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
1430 CHECK_STRING (service);
1431 GCPRO2 (bus, service);
1434 XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
1436 /* Open a connection to the bus. */
1437 connection = xd_initialize (bus, TRUE);
1439 /* Create the message. */
1440 dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1441 if ((dmessage == NULL)
1442 || (!dbus_message_set_reply_serial (dmessage, serial))
1443 || (!dbus_message_set_destination (dmessage, SSDATA (service))))
1446 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1451 /* Initialize parameter list of message. */
1452 dbus_message_iter_init_append (dmessage, &iter);
1454 /* Append parameters to the message. */
1455 for (i = 3; i < nargs; ++i)
1457 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1458 if (XD_DBUS_TYPE_P (args[i]))
1460 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1461 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1462 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
1463 SDATA (format2 ("%s", args[i], Qnil)),
1464 SDATA (format2 ("%s", args[i+1], Qnil)));
1469 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1470 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
1471 SDATA (format2 ("%s", args[i], Qnil)));
1474 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1475 indication that there is no parent type. */
1476 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1478 xd_append_arg (dtype, args[i], &iter);
1481 /* Send the message. The message is just added to the outgoing
1483 if (!dbus_connection_send (connection, dmessage, NULL))
1484 XD_SIGNAL1 (build_string ("Cannot send message"));
1486 XD_DEBUG_MESSAGE ("Message sent");
1489 dbus_message_unref (dmessage);
1495 DEFUN("dbus-method-error-internal", Fdbus_method_error_internal,
1497 Return error message for message SERIAL on the D-Bus BUS.
1498 This is an internal function, it shall not be used outside dbus.el.
1500 usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS)
1502 (ptrdiff_t nargs, Lisp_Object *args))
1504 Lisp_Object bus, service;
1505 struct gcpro gcpro1, gcpro2;
1506 DBusConnection *connection;
1507 DBusMessage *dmessage;
1508 DBusMessageIter iter;
1509 dbus_uint32_t serial;
1510 unsigned int ui_serial, dtype;
1512 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1514 /* Check parameters. */
1518 CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
1519 CHECK_STRING (service);
1520 GCPRO2 (bus, service);
1523 XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
1525 /* Open a connection to the bus. */
1526 connection = xd_initialize (bus, TRUE);
1528 /* Create the message. */
1529 dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
1530 if ((dmessage == NULL)
1531 || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
1532 || (!dbus_message_set_reply_serial (dmessage, serial))
1533 || (!dbus_message_set_destination (dmessage, SSDATA (service))))
1536 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1541 /* Initialize parameter list of message. */
1542 dbus_message_iter_init_append (dmessage, &iter);
1544 /* Append parameters to the message. */
1545 for (i = 3; i < nargs; ++i)
1547 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1548 if (XD_DBUS_TYPE_P (args[i]))
1550 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1551 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1552 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
1553 SDATA (format2 ("%s", args[i], Qnil)),
1554 SDATA (format2 ("%s", args[i+1], Qnil)));
1559 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1560 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
1561 SDATA (format2 ("%s", args[i], Qnil)));
1564 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1565 indication that there is no parent type. */
1566 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1568 xd_append_arg (dtype, args[i], &iter);
1571 /* Send the message. The message is just added to the outgoing
1573 if (!dbus_connection_send (connection, dmessage, NULL))
1574 XD_SIGNAL1 (build_string ("Cannot send message"));
1576 XD_DEBUG_MESSAGE ("Message sent");
1579 dbus_message_unref (dmessage);
1585 DEFUN("dbus-send-signal", Fdbus_send_signal, 5, MANY, 0, /*
1586 Send signal SIGNAL on the D-Bus BUS.
1588 BUS is either a Lisp symbol, `:system' or `:session', or a string
1589 denoting the bus address.
1591 SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
1592 D-Bus object path SERVICE is registered at. INTERFACE is an interface
1593 offered by SERVICE. It must provide signal SIGNAL.
1595 All other arguments ARGS are passed to SIGNAL as arguments. They are
1596 converted into D-Bus types via the following rules:
1598 t and nil => DBUS_TYPE_BOOLEAN
1599 number => DBUS_TYPE_UINT32
1600 integer => DBUS_TYPE_INT32
1601 float => DBUS_TYPE_DOUBLE
1602 string => DBUS_TYPE_STRING
1603 list => DBUS_TYPE_ARRAY
1605 All arguments can be preceded by a type symbol. For details about
1606 type symbols, see Info node `(dbus)Type Conversion'.
1611 :session "org.gnu.Emacs" "/org/gnu/Emacs"
1612 "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1614 usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1616 (ptrdiff_t nargs, Lisp_Object *args))
1618 Lisp_Object bus, service, path, interface, signal;
1619 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1620 DBusConnection *connection;
1621 DBusMessage *dmessage;
1622 DBusMessageIter iter;
1625 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1627 /* Check parameters. */
1631 interface = args[3];
1634 CHECK_STRING (service);
1635 CHECK_STRING (path);
1636 CHECK_STRING (interface);
1637 CHECK_STRING (signal);
1638 GCPRO5 (bus, service, path, interface, signal);
1640 XD_DEBUG_MESSAGE ("%s %s %s %s",
1646 /* Open a connection to the bus. */
1647 connection = xd_initialize (bus, TRUE);
1649 /* Create the message. */
1650 dmessage = dbus_message_new_signal (SSDATA (path),
1654 if (dmessage == NULL)
1655 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1657 /* Initialize parameter list of message. */
1658 dbus_message_iter_init_append (dmessage, &iter);
1660 /* Append parameters to the message. */
1661 for (i = 5; i < nargs; ++i)
1663 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1664 if (XD_DBUS_TYPE_P (args[i]))
1666 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1667 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1668 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
1669 SDATA (format2 ("%s", args[i], Qnil)),
1670 SDATA (format2 ("%s", args[i+1], Qnil)));
1675 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1676 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
1677 SDATA (format2 ("%s", args[i], Qnil)));
1680 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1681 indication that there is no parent type. */
1682 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1684 xd_append_arg (dtype, args[i], &iter);
1687 /* Send the message. The message is just added to the outgoing
1689 if (!dbus_connection_send (connection, dmessage, NULL))
1690 XD_SIGNAL1 (build_string ("Cannot send message"));
1692 XD_DEBUG_MESSAGE ("Signal sent");
1695 dbus_message_unref (dmessage);
1701 /* Read one queued incoming message of the D-Bus BUS.
1702 BUS is either a Lisp symbol, :system or :session, or a string denoting
1705 xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1707 Lisp_Object args, key, value;
1708 struct gcpro gcpro1;
1709 struct input_event event;
1710 DBusMessage *dmessage;
1711 DBusMessageIter iter;
1714 dbus_uint32_t serial;
1715 unsigned int ui_serial;
1716 const char *uname, *path, *interface, *member;
1718 dmessage = dbus_connection_pop_message (connection);
1720 /* Return if there is no queued message. */
1721 if (dmessage == NULL)
1724 /* Collect the parameters. */
1728 /* Loop over the resulting parameters. Construct a list. */
1729 if (dbus_message_iter_init (dmessage, &iter))
1731 while ((dtype = dbus_message_iter_get_arg_type (&iter))
1732 != DBUS_TYPE_INVALID)
1734 args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1735 dbus_message_iter_next (&iter);
1737 /* The arguments are stored in reverse order. Reorder them. */
1738 args = Fnreverse (args);
1741 /* Read message type, message serial, unique name, object path,
1742 interface and member from the message. */
1743 mtype = dbus_message_get_type (dmessage);
1744 ui_serial = serial =
1745 ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1746 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1747 ? dbus_message_get_reply_serial (dmessage)
1748 : dbus_message_get_serial (dmessage);
1749 uname = dbus_message_get_sender (dmessage);
1750 path = dbus_message_get_path (dmessage);
1751 interface = dbus_message_get_interface (dmessage);
1752 member = dbus_message_get_member (dmessage);
1754 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1755 (mtype == DBUS_MESSAGE_TYPE_INVALID)
1756 ? "DBUS_MESSAGE_TYPE_INVALID"
1757 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1758 ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1759 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1760 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1761 : (mtype == DBUS_MESSAGE_TYPE_ERROR)
1762 ? "DBUS_MESSAGE_TYPE_ERROR"
1763 : "DBUS_MESSAGE_TYPE_SIGNAL",
1764 ui_serial, uname, path, interface, member,
1765 SDATA (format2 ("%s", args, Qnil)));
1767 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1768 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1770 /* Search for a registered function of the message. */
1771 key = list2 (bus, make_fixnum_or_float (serial));
1772 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1774 /* There shall be exactly one entry. Construct an event. */
1778 /* Remove the entry. */
1779 Fremhash (key, Vdbus_registered_objects_table);
1781 /* Construct an event. */
1783 event.kind = DBUS_EVENT;
1784 event.frame_or_window = Qnil;
1785 event.arg = Fcons (value, args);
1788 else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
1790 /* Vdbus_registered_objects_table requires non-nil interface and
1792 if ((interface == NULL) || (member == NULL))
1795 /* Search for a registered function of the message. */
1796 key = list3 (bus, build_string (interface), build_string (member));
1797 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1799 /* Loop over the registered functions. Construct an event. */
1800 while (!NILP (value))
1802 key = CAR_SAFE (value);
1803 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1804 if (((uname == NULL)
1805 || (NILP (CAR_SAFE (key)))
1806 || (strcmp (uname, SSDATA (CAR_SAFE (key))) == 0))
1808 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1810 SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1812 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1815 event.kind = DBUS_EVENT;
1816 event.frame_or_window = Qnil;
1818 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args);
1821 value = CDR_SAFE (value);
1828 /* Add type, serial, uname, path, interface and member to the event. */
1829 event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1831 event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1833 event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1835 event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1837 event.arg = Fcons (make_fixnum_or_float (serial), event.arg);
1838 event.arg = Fcons (make_number (mtype), event.arg);
1840 /* Add the bus symbol to the event. */
1841 event.arg = Fcons (bus, event.arg);
1843 /* Store it into the input event queue. */
1844 kbd_buffer_store_event (&event);
1846 XD_DEBUG_MESSAGE ("Event stored: %s",
1847 SDATA (format2 ("%s", event.arg, Qnil)));
1851 dbus_message_unref (dmessage);
1856 /* Read queued incoming messages of the D-Bus BUS.
1857 BUS is either a Lisp symbol, :system or :session, or a string denoting
1860 xd_read_message (Lisp_Object bus)
1862 /* Open a connection to the bus. */
1863 DBusConnection *connection = xd_initialize (bus, TRUE);
1865 /* Non blocking read of the next available message. */
1866 dbus_connection_read_write (connection, 0);
1868 while (dbus_connection_get_dispatch_status (connection)
1869 != DBUS_DISPATCH_COMPLETE)
1870 xd_read_message_1 (connection, bus);
1874 /* Callback called when something is ready to read or write. */
1876 xd_read_queued_messages (int fd, void *data, int for_read)
1878 Lisp_Object busp = Vdbus_registered_buses;
1879 Lisp_Object bus = Qnil;
1881 /* Find bus related to fd. */
1883 while (!NILP (busp))
1885 if ((SYMBOLP (CAR_SAFE (busp)) && XSYMBOL (CAR_SAFE (busp)) == data)
1886 || (STRINGP (CAR_SAFE (busp)) && XSTRING (CAR_SAFE (busp)) == data))
1887 bus = CAR_SAFE (busp);
1888 busp = CDR_SAFE (busp);
1894 /* We ignore all Lisp errors during the call. */
1895 xd_in_read_queued_messages = 1;
1896 internal_catch (Qdbus_error, xd_read_message, bus);
1897 xd_in_read_queued_messages = 0;
1900 DEFUN("dbus-register-service", Fdbus_register_service, 2, MANY, 0, /*
1901 Register known name SERVICE on the D-Bus BUS.
1903 BUS is either a Lisp symbol, `:system' or `:session', or a string
1904 denoting the bus address.
1906 SERVICE is the D-Bus service name that should be registered. It must
1909 FLAGS are keywords, which control how the service name is registered.
1910 The following keywords are recognized:
1912 `:allow-replacement': Allow another service to become the primary
1915 `:replace-existing': Request to replace the current primary owner.
1917 `:do-not-queue': If we can not become the primary owner do not place
1920 The function returns a keyword, indicating the result of the
1921 operation. One of the following keywords is returned:
1923 `:primary-owner': Service has become the primary owner of the
1926 `:in-queue': Service could not become the primary owner and has been
1927 placed in the queue.
1929 `:exists': Service is already in the queue.
1931 `:already-owner': Service is already the primary owner.
1935 \(dbus-register-service :session dbus-service-emacs)
1939 \(dbus-register-service
1940 :session "org.freedesktop.TextEditor"
1941 dbus-service-allow-replacement dbus-service-replace-existing)
1945 usage: (dbus-register-service BUS SERVICE &rest FLAGS)
1947 (ptrdiff_t nargs, Lisp_Object *args))
1949 Lisp_Object bus, service;
1950 DBusConnection *connection;
1953 unsigned int flags = 0;
1960 /* Check parameters. */
1961 CHECK_STRING (service);
1963 /* Process flags. */
1964 for (i = 2; i < nargs; ++i) {
1965 value = ((EQ (args[i], QCdbus_request_name_replace_existing))
1966 ? DBUS_NAME_FLAG_REPLACE_EXISTING
1967 : (EQ (args[i], QCdbus_request_name_allow_replacement))
1968 ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
1969 : (EQ (args[i], QCdbus_request_name_do_not_queue))
1970 ? DBUS_NAME_FLAG_DO_NOT_QUEUE
1973 XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args[i]);
1977 /* Open a connection to the bus. */
1978 connection = xd_initialize (bus, TRUE);
1980 /* Request the known name from the bus. */
1981 dbus_error_init (&derror);
1982 result = dbus_bus_request_name (connection, SSDATA (service), flags,
1984 if (dbus_error_is_set (&derror))
1988 dbus_error_free (&derror);
1990 /* Return object. */
1993 case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER:
1994 return QCdbus_request_name_reply_primary_owner;
1995 case DBUS_REQUEST_NAME_REPLY_IN_QUEUE:
1996 return QCdbus_request_name_reply_in_queue;
1997 case DBUS_REQUEST_NAME_REPLY_EXISTS:
1998 return QCdbus_request_name_reply_exists;
1999 case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER:
2000 return QCdbus_request_name_reply_already_owner;
2002 /* This should not happen. */
2003 XD_SIGNAL2 (build_string ("Could not register service"), service);
2007 DEFUN("dbus-register-signal", Fdbus_register_signal, 6, MANY, 0, /*
2008 Register for signal SIGNAL on the D-Bus BUS.
2010 BUS is either a Lisp symbol, `:system' or `:session', or a string
2011 denoting the bus address.
2013 SERVICE is the D-Bus service name used by the sending D-Bus object.
2014 It can be either a known name or the unique name of the D-Bus object
2015 sending the signal. When SERVICE is nil, related signals from all
2016 D-Bus objects shall be accepted.
2018 PATH is the D-Bus object path SERVICE is registered. It can also be
2019 nil if the path name of incoming signals shall not be checked.
2021 INTERFACE is an interface offered by SERVICE. It must provide SIGNAL.
2022 HANDLER is a Lisp function to be called when the signal is received.
2023 It must accept as arguments the values SIGNAL is sending.
2025 All other arguments ARGS, if specified, must be strings. They stand
2026 for the respective arguments of the signal in their order, and are
2027 used for filtering as well. A nil argument might be used to preserve
2030 INTERFACE, SIGNAL and HANDLER must not be nil. Example:
2032 \(defun my-signal-handler (device)
2033 (message "Device %s added" device))
2035 \(dbus-register-signal
2036 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
2037 "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
2039 => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
2040 ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
2042 `dbus-register-signal' returns an object, which can be used in
2043 `dbus-unregister-object' for removing the registration.
2045 usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS)
2047 (ptrdiff_t nargs, Lisp_Object *args))
2049 Lisp_Object bus, service, path, interface, signal, handler;
2050 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
2051 Lisp_Object uname, key, key1, value;
2052 DBusConnection *connection;
2054 char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
2058 /* Check parameters. */
2062 interface = args[3];
2066 if (!NILP (service)) CHECK_STRING (service);
2067 if (!NILP (path)) CHECK_STRING (path);
2068 CHECK_STRING (interface);
2069 CHECK_STRING (signal);
2070 if (!FUNCTIONP (handler))
2071 wrong_type_argument (Qinvalid_function, handler);
2072 GCPRO6 (bus, service, path, interface, signal, handler);
2074 /* Retrieve unique name of service. If service is a known name, we
2075 will register for the corresponding unique name, if any. Signals
2076 are sent always with the unique name as sender. Note: the unique
2077 name of "org.freedesktop.DBus" is that string itself. */
2078 if ((STRINGP (service))
2079 && (SBYTES (service) > 0)
2080 && (strcmp (SSDATA (service), DBUS_SERVICE_DBUS) != 0)
2081 && (strncmp (SSDATA (service), ":", 1) != 0))
2082 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
2086 /* Create a matching rule if the unique name exists (when no
2088 if (NILP (uname) || (SBYTES (uname) > 0))
2090 /* Open a connection to the bus. */
2091 connection = xd_initialize (bus, TRUE);
2093 /* Create a rule to receive related signals. */
2094 rulelen = snprintf (rule, sizeof rule,
2095 "type='signal',interface='%s',member='%s'",
2098 if (! (0 <= rulelen && rulelen < sizeof rule))
2101 /* Add unique name and path to the rule if they are non-nil. */
2104 int len = snprintf (rule + rulelen, sizeof rule - rulelen,
2105 ",sender='%s'", SDATA (uname));
2106 if (! (0 <= len && len < sizeof rule - rulelen))
2113 int len = snprintf (rule + rulelen, sizeof rule - rulelen,
2114 ",path='%s'", SDATA (path));
2115 if (! (0 <= len && len < sizeof rule - rulelen))
2120 /* Add arguments to the rule if they are non-nil. */
2121 for (i = 6; i < nargs; ++i)
2122 if (!NILP (args[i]))
2125 CHECK_STRING (args[i]);
2126 len = snprintf (rule + rulelen, sizeof rule - rulelen,
2127 ",arg%"pD"d='%s'", i - 6, SDATA (args[i]));
2128 if (! (0 <= len && len < sizeof rule - rulelen))
2133 /* Add the rule to the bus. */
2134 dbus_error_init (&derror);
2135 dbus_bus_add_match (connection, rule, &derror);
2136 if (dbus_error_is_set (&derror))
2143 dbus_error_free (&derror);
2145 XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
2148 /* Create a hash table entry. */
2149 key = list3 (bus, interface, signal);
2150 key1 = list5 (uname, service, path, handler, build_string (rule));
2151 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
2153 if (NILP (Fmember (key1, value)))
2154 Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
2156 /* Return object. */
2157 RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
2160 DEFUN("dbus-register-method", Fdbus_register_method, 6, 7, 0, /*
2161 Register for method METHOD on the D-Bus BUS.
2163 BUS is either a Lisp symbol, `:system' or `:session', or a string
2164 denoting the bus address.
2166 SERVICE is the D-Bus service name of the D-Bus object METHOD is
2167 registered for. It must be a known name (See discussion of
2168 DONT-REGISTER-SERVICE below).
2170 PATH is the D-Bus object path SERVICE is registered (See discussion of
2171 DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
2172 SERVICE. It must provide METHOD. HANDLER is a Lisp function to be
2173 called when a method call is received. It must accept the input
2174 arguments of METHOD. The return value of HANDLER is used for
2175 composing the returning D-Bus message.
2177 When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
2178 registered. This means that other D-Bus clients have no way of
2179 noticing the newly registered method. When interfaces are constructed
2180 incrementally by adding single methods or properties at a time,
2181 DONT-REGISTER-SERVICE can be used to prevent other clients from
2182 discovering the still incomplete interface.
2184 (bus, service, path, interface, method, handler,
2185 dont_register_service))
2187 Lisp_Object key, key1, value;
2188 Lisp_Object args[2] = { bus, service };
2190 /* Check parameters. */
2191 CHECK_STRING (service);
2192 CHECK_STRING (path);
2193 CHECK_STRING (interface);
2194 CHECK_STRING (method);
2195 if (!FUNCTIONP (handler))
2196 wrong_type_argument (Qinvalid_function, handler);
2197 /* TODO: We must check for a valid service name, otherwise there is
2198 a segmentation fault. */
2200 /* Request the name. */
2201 if (NILP (dont_register_service))
2202 Fdbus_register_service (2, args);
2204 /* Create a hash table entry. We use nil for the unique name,
2205 because the method might be called from anybody. */
2206 key = list3 (bus, interface, method);
2207 key1 = list4 (Qnil, service, path, handler);
2208 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
2210 if (NILP (Fmember (key1, value)))
2211 Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
2213 /* Return object. */
2214 return list2 (key, list3 (service, path, handler));
2219 syms_of_dbusbind (void)
2222 DEFSYM (Qdbus_init_bus, "dbus-init-bus");
2223 defsubr (&Sdbus_init_bus);
2225 DEFSYM (Qdbus_close_bus, "dbus-close-bus");
2226 defsubr (&Sdbus_close_bus);
2228 DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
2229 defsubr (&Sdbus_get_unique_name);
2231 DEFSYM (Qdbus_call_method, "dbus-call-method");
2232 defsubr (&Sdbus_call_method);
2234 DEFSYM (Qdbus_call_method_asynchronously, "dbus-call-method-asynchronously");
2235 defsubr (&Sdbus_call_method_asynchronously);
2237 DEFSYM (Qdbus_method_return_internal, "dbus-method-return-internal");
2238 defsubr (&Sdbus_method_return_internal);
2240 DEFSYM (Qdbus_method_error_internal, "dbus-method-error-internal");
2241 defsubr (&Sdbus_method_error_internal);
2243 DEFSYM (Qdbus_send_signal, "dbus-send-signal");
2244 defsubr (&Sdbus_send_signal);
2246 DEFSYM (Qdbus_register_service, "dbus-register-service");
2247 defsubr (&Sdbus_register_service);
2249 DEFSYM (Qdbus_register_signal, "dbus-register-signal");
2250 defsubr (&Sdbus_register_signal);
2252 DEFSYM (Qdbus_register_method, "dbus-register-method");
2253 defsubr (&Sdbus_register_method);
2255 DEFSYM (Qdbus_error, "dbus-error");
2256 Fput (Qdbus_error, Qerror_conditions,
2257 list2 (Qdbus_error, Qerror));
2258 Fput (Qdbus_error, Qerror_message,
2259 make_pure_c_string ("D-Bus error"));
2261 DEFSYM (QCdbus_system_bus, ":system");
2262 DEFSYM (QCdbus_session_bus, ":session");
2263 DEFSYM (QCdbus_request_name_allow_replacement, ":allow-replacement");
2264 DEFSYM (QCdbus_request_name_replace_existing, ":replace-existing");
2265 DEFSYM (QCdbus_request_name_do_not_queue, ":do-not-queue");
2266 DEFSYM (QCdbus_request_name_reply_primary_owner, ":primary-owner");
2267 DEFSYM (QCdbus_request_name_reply_exists, ":exists");
2268 DEFSYM (QCdbus_request_name_reply_in_queue, ":in-queue");
2269 DEFSYM (QCdbus_request_name_reply_already_owner, ":already-owner");
2270 DEFSYM (QCdbus_timeout, ":timeout");
2271 DEFSYM (QCdbus_type_byte, ":byte");
2272 DEFSYM (QCdbus_type_boolean, ":boolean");
2273 DEFSYM (QCdbus_type_int16, ":int16");
2274 DEFSYM (QCdbus_type_uint16, ":uint16");
2275 DEFSYM (QCdbus_type_int32, ":int32");
2276 DEFSYM (QCdbus_type_uint32, ":uint32");
2277 DEFSYM (QCdbus_type_int64, ":int64");
2278 DEFSYM (QCdbus_type_uint64, ":uint64");
2279 DEFSYM (QCdbus_type_double, ":double");
2280 DEFSYM (QCdbus_type_string, ":string");
2281 DEFSYM (QCdbus_type_object_path, ":object-path");
2282 DEFSYM (QCdbus_type_signature, ":signature");
2284 #ifdef DBUS_TYPE_UNIX_FD
2285 DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
2288 DEFSYM (QCdbus_type_array, ":array");
2289 DEFSYM (QCdbus_type_variant, ":variant");
2290 DEFSYM (QCdbus_type_struct, ":struct");
2291 DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
2293 DEFVAR_LISP ("dbus-registered-buses", &Vdbus_registered_buses /*
2294 List of D-Bus buses we are polling for messages.
2296 Vdbus_registered_buses = Qnil;
2298 DEFVAR_LISP ("dbus-registered-objects-table",
2299 &Vdbus_registered_objects_table /*
2300 Hash table of registered functions for D-Bus.
2302 There are two different uses of the hash table: for accessing
2303 registered interfaces properties, targeted by signals or method calls,
2304 and for calling handlers in case of non-blocking method call returns.
2306 In the first case, the key in the hash table is the list (BUS
2307 INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or
2308 `:session', or a string denoting the bus address. INTERFACE is a
2309 string which denotes a D-Bus interface, and MEMBER, also a string, is
2310 either a method, a signal or a property INTERFACE is offering. All
2311 arguments but BUS must not be nil.
2313 The value in the hash table is a list of quadruple lists
2314 \((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...).
2315 SERVICE is the service name as registered, UNAME is the corresponding
2316 unique name. In case of registered methods and properties, UNAME is
2317 nil. PATH is the object path of the sending object. All of them can
2318 be nil, which means a wildcard then. OBJECT is either the handler to
2319 be called when a D-Bus message, which matches the key criteria,
2320 arrives (methods and signals), or a cons cell containing the value of
2323 For signals, there is also a fifth element RULE, which keeps the match
2324 string the signal is registered with.
2326 In the second case, the key in the hash table is the list (BUS
2327 SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
2328 string denoting the bus address. SERIAL is the serial number of the
2329 non-blocking method call, a reply is expected. Both arguments must
2330 not be nil. The value in the hash table is HANDLER, the function to
2331 be called when the D-Bus reply message arrives.
2334 Lisp_Object args[2];
2337 Vdbus_registered_objects_table = Fmake_hash_table (2, args);
2340 DEFVAR_LISP ("dbus-debug", &Vdbus_debug /*
2341 If non-nil, debug messages of D-Bus bindings are raised.
2345 /* We can also set environment variable DBUS_VERBOSE=1 in order to
2346 see more traces. This requires libdbus-1 to be configured with
2347 --enable-verbose-mode. */
2352 Fprovide (intern_c_string ("dbusbind"), Qnil);
2356 #endif /* HAVE_DBUS */