Drop support for deprecated (since 23.1) forms of diary-display-function
[emacs.git] / src / dbusbind.c
blobf81666ba7bd42c107995194b7ea7c2905357855f
1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007-2014 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/>. */
19 #include <config.h>
21 #ifdef HAVE_DBUS
22 #include <stdio.h>
23 #include <dbus/dbus.h>
25 #include "lisp.h"
26 #include "frame.h"
27 #include "termhooks.h"
28 #include "keyboard.h"
29 #include "process.h"
31 #ifndef DBUS_NUM_MESSAGE_TYPES
32 #define DBUS_NUM_MESSAGE_TYPES 5
33 #endif
36 /* Some platforms define the symbol "interface", but we want to use it
37 * as a variable name below. */
39 #ifdef interface
40 #undef interface
41 #endif
44 /* Subroutines. */
45 static Lisp_Object Qdbus__init_bus;
46 static Lisp_Object Qdbus_get_unique_name;
47 static Lisp_Object Qdbus_message_internal;
49 /* D-Bus error symbol. */
50 static Lisp_Object Qdbus_error;
52 /* Lisp symbols of the system and session buses. */
53 static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
55 /* Lisp symbol for method call timeout. */
56 static Lisp_Object QCdbus_timeout;
58 /* Lisp symbols of D-Bus types. */
59 static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
60 static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
61 static Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
62 static Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
63 static Lisp_Object QCdbus_type_double, QCdbus_type_string;
64 static Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
65 #ifdef DBUS_TYPE_UNIX_FD
66 static Lisp_Object QCdbus_type_unix_fd;
67 #endif
68 static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
69 static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
71 /* Lisp symbols of objects in `dbus-registered-objects-table'. */
72 static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method;
73 static Lisp_Object QCdbus_registered_signal;
75 /* Alist of D-Bus buses we are polling for messages.
76 The key is the symbol or string of the bus, and the value is the
77 connection address. */
78 static Lisp_Object xd_registered_buses;
80 /* Whether we are reading a D-Bus event. */
81 static bool xd_in_read_queued_messages = 0;
84 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
85 we don't want to poison other namespaces with "dbus_". */
87 /* Raise a signal. If we are reading events, we cannot signal; we
88 throw to xd_read_queued_messages then. */
89 #define XD_SIGNAL1(arg) \
90 do { \
91 if (xd_in_read_queued_messages) \
92 Fthrow (Qdbus_error, Qnil); \
93 else \
94 xsignal1 (Qdbus_error, arg); \
95 } while (0)
97 #define XD_SIGNAL2(arg1, arg2) \
98 do { \
99 if (xd_in_read_queued_messages) \
100 Fthrow (Qdbus_error, Qnil); \
101 else \
102 xsignal2 (Qdbus_error, arg1, arg2); \
103 } while (0)
105 #define XD_SIGNAL3(arg1, arg2, arg3) \
106 do { \
107 if (xd_in_read_queued_messages) \
108 Fthrow (Qdbus_error, Qnil); \
109 else \
110 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
111 } while (0)
113 /* Raise a Lisp error from a D-Bus ERROR. */
114 #define XD_ERROR(error) \
115 do { \
116 /* Remove the trailing newline. */ \
117 char const *mess = error.message; \
118 char const *nl = strchr (mess, '\n'); \
119 Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
120 dbus_error_free (&error); \
121 XD_SIGNAL1 (err); \
122 } while (0)
124 /* Macros for debugging. In order to enable them, build with
125 "env MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
126 #ifdef DBUS_DEBUG
127 #define XD_DEBUG_MESSAGE(...) \
128 do { \
129 char s[1024]; \
130 snprintf (s, sizeof s, __VA_ARGS__); \
131 if (!noninteractive) \
132 printf ("%s: %s\n", __func__, s); \
133 message ("%s: %s", __func__, s); \
134 } while (0)
135 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
136 do { \
137 if (!valid_lisp_object_p (object)) \
139 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
140 XD_SIGNAL1 (build_string ("Assertion failure")); \
142 } while (0)
144 #else /* !DBUS_DEBUG */
145 # define XD_DEBUG_MESSAGE(...) \
146 do { \
147 if (!NILP (Vdbus_debug)) \
149 char s[1024]; \
150 snprintf (s, sizeof s, __VA_ARGS__); \
151 message ("%s: %s", __func__, s); \
153 } while (0)
154 # define XD_DEBUG_VALID_LISP_OBJECT_P(object)
155 #endif
157 /* Check whether TYPE is a basic DBusType. */
158 #ifdef HAVE_DBUS_TYPE_IS_VALID
159 #define XD_BASIC_DBUS_TYPE(type) \
160 (dbus_type_is_valid (type) && dbus_type_is_basic (type))
161 #else
162 #ifdef DBUS_TYPE_UNIX_FD
163 #define XD_BASIC_DBUS_TYPE(type) \
164 ((type == DBUS_TYPE_BYTE) \
165 || (type == DBUS_TYPE_BOOLEAN) \
166 || (type == DBUS_TYPE_INT16) \
167 || (type == DBUS_TYPE_UINT16) \
168 || (type == DBUS_TYPE_INT32) \
169 || (type == DBUS_TYPE_UINT32) \
170 || (type == DBUS_TYPE_INT64) \
171 || (type == DBUS_TYPE_UINT64) \
172 || (type == DBUS_TYPE_DOUBLE) \
173 || (type == DBUS_TYPE_STRING) \
174 || (type == DBUS_TYPE_OBJECT_PATH) \
175 || (type == DBUS_TYPE_SIGNATURE) \
176 || (type == DBUS_TYPE_UNIX_FD))
177 #else
178 #define XD_BASIC_DBUS_TYPE(type) \
179 ((type == DBUS_TYPE_BYTE) \
180 || (type == DBUS_TYPE_BOOLEAN) \
181 || (type == DBUS_TYPE_INT16) \
182 || (type == DBUS_TYPE_UINT16) \
183 || (type == DBUS_TYPE_INT32) \
184 || (type == DBUS_TYPE_UINT32) \
185 || (type == DBUS_TYPE_INT64) \
186 || (type == DBUS_TYPE_UINT64) \
187 || (type == DBUS_TYPE_DOUBLE) \
188 || (type == DBUS_TYPE_STRING) \
189 || (type == DBUS_TYPE_OBJECT_PATH) \
190 || (type == DBUS_TYPE_SIGNATURE))
191 #endif
192 #endif
194 /* This was a macro. On Solaris 2.11 it was said to compile for
195 hours, when optimization is enabled. So we have transferred it into
196 a function. */
197 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
198 of the predefined D-Bus type symbols. */
199 static int
200 xd_symbol_to_dbus_type (Lisp_Object object)
202 return
203 ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
204 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
205 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
206 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
207 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
208 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
209 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
210 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
211 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
212 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
213 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
214 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
215 #ifdef DBUS_TYPE_UNIX_FD
216 : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD
217 #endif
218 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
219 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
220 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
221 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
222 : DBUS_TYPE_INVALID);
225 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
226 #define XD_DBUS_TYPE_P(object) \
227 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
229 /* Determine the DBusType of a given Lisp OBJECT. It is used to
230 convert Lisp objects, being arguments of `dbus-call-method' or
231 `dbus-send-signal', into corresponding C values appended as
232 arguments to a D-Bus message. */
233 #define XD_OBJECT_TO_DBUS_TYPE(object) \
234 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
235 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
236 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
237 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
238 : (STRINGP (object)) ? DBUS_TYPE_STRING \
239 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
240 : (CONSP (object)) \
241 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
242 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
243 ? DBUS_TYPE_ARRAY \
244 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
245 : DBUS_TYPE_ARRAY) \
246 : DBUS_TYPE_INVALID)
248 /* Return a list pointer which does not have a Lisp symbol as car. */
249 #define XD_NEXT_VALUE(object) \
250 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
252 /* Transform the message type to its string representation for debug
253 messages. */
254 #define XD_MESSAGE_TYPE_TO_STRING(mtype) \
255 ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
256 ? "DBUS_MESSAGE_TYPE_INVALID" \
257 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
258 ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
259 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
260 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
261 : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
262 ? "DBUS_MESSAGE_TYPE_ERROR" \
263 : "DBUS_MESSAGE_TYPE_SIGNAL")
265 /* Transform the object to its string representation for debug
266 messages. */
267 #define XD_OBJECT_TO_STRING(object) \
268 SDATA (format2 ("%s", object, Qnil))
270 #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
271 do { \
272 char const *session_bus_address = getenv ("DBUS_SESSION_BUS_ADDRESS"); \
273 if (STRINGP (bus)) \
275 DBusAddressEntry **entries; \
276 int len; \
277 DBusError derror; \
278 dbus_error_init (&derror); \
279 if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
280 XD_ERROR (derror); \
281 /* Cleanup. */ \
282 dbus_error_free (&derror); \
283 dbus_address_entries_free (entries); \
284 /* Canonicalize session bus address. */ \
285 if ((session_bus_address != NULL) \
286 && (!NILP (Fstring_equal \
287 (bus, build_string (session_bus_address))))) \
288 bus = QCdbus_session_bus; \
291 else \
293 CHECK_SYMBOL (bus); \
294 if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
295 XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
296 /* We do not want to have an autolaunch for the session bus. */ \
297 if (EQ (bus, QCdbus_session_bus) && session_bus_address == NULL) \
298 XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
300 } while (0)
302 #if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
303 || HAVE_DBUS_VALIDATE_INTERFACE || HAVE_DBUS_VALIDATE_MEMBER)
304 #define XD_DBUS_VALIDATE_OBJECT(object, func) \
305 do { \
306 if (!NILP (object)) \
308 DBusError derror; \
309 CHECK_STRING (object); \
310 dbus_error_init (&derror); \
311 if (!func (SSDATA (object), &derror)) \
312 XD_ERROR (derror); \
313 /* Cleanup. */ \
314 dbus_error_free (&derror); \
316 } while (0)
317 #endif
319 #if HAVE_DBUS_VALIDATE_BUS_NAME
320 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
321 XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
322 #else
323 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
324 if (!NILP (bus_name)) CHECK_STRING (bus_name);
325 #endif
327 #if HAVE_DBUS_VALIDATE_PATH
328 #define XD_DBUS_VALIDATE_PATH(path) \
329 XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
330 #else
331 #define XD_DBUS_VALIDATE_PATH(path) \
332 if (!NILP (path)) CHECK_STRING (path);
333 #endif
335 #if HAVE_DBUS_VALIDATE_INTERFACE
336 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
337 XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
338 #else
339 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
340 if (!NILP (interface)) CHECK_STRING (interface);
341 #endif
343 #if HAVE_DBUS_VALIDATE_MEMBER
344 #define XD_DBUS_VALIDATE_MEMBER(member) \
345 XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
346 #else
347 #define XD_DBUS_VALIDATE_MEMBER(member) \
348 if (!NILP (member)) CHECK_STRING (member);
349 #endif
351 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
352 not become too long. */
353 static void
354 xd_signature_cat (char *signature, char const *x)
356 ptrdiff_t siglen = strlen (signature);
357 ptrdiff_t xlen = strlen (x);
358 if (DBUS_MAXIMUM_SIGNATURE_LENGTH - xlen <= siglen)
359 string_overflow ();
360 strcat (signature, x);
363 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
364 used in dbus_message_iter_open_container. DTYPE is the DBusType
365 the object is related to. It is passed as argument, because it
366 cannot be detected in basic type objects, when they are preceded by
367 a type symbol. PARENT_TYPE is the DBusType of a container this
368 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
369 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
370 static void
371 xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
373 int subtype;
374 Lisp_Object elt;
375 char const *subsig;
376 int subsiglen;
377 char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
379 elt = object;
381 switch (dtype)
383 case DBUS_TYPE_BYTE:
384 case DBUS_TYPE_UINT16:
385 CHECK_NATNUM (object);
386 sprintf (signature, "%c", dtype);
387 break;
389 case DBUS_TYPE_BOOLEAN:
390 if (!EQ (object, Qt) && !EQ (object, Qnil))
391 wrong_type_argument (intern ("booleanp"), object);
392 sprintf (signature, "%c", dtype);
393 break;
395 case DBUS_TYPE_INT16:
396 CHECK_NUMBER (object);
397 sprintf (signature, "%c", dtype);
398 break;
400 case DBUS_TYPE_UINT32:
401 case DBUS_TYPE_UINT64:
402 #ifdef DBUS_TYPE_UNIX_FD
403 case DBUS_TYPE_UNIX_FD:
404 #endif
405 case DBUS_TYPE_INT32:
406 case DBUS_TYPE_INT64:
407 case DBUS_TYPE_DOUBLE:
408 CHECK_NUMBER_OR_FLOAT (object);
409 sprintf (signature, "%c", dtype);
410 break;
412 case DBUS_TYPE_STRING:
413 case DBUS_TYPE_OBJECT_PATH:
414 case DBUS_TYPE_SIGNATURE:
415 CHECK_STRING (object);
416 sprintf (signature, "%c", dtype);
417 break;
419 case DBUS_TYPE_ARRAY:
420 /* Check that all list elements have the same D-Bus type. For
421 complex element types, we just check the container type, not
422 the whole element's signature. */
423 CHECK_CONS (object);
425 /* Type symbol is optional. */
426 if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
427 elt = XD_NEXT_VALUE (elt);
429 /* If the array is empty, DBUS_TYPE_STRING is the default
430 element type. */
431 if (NILP (elt))
433 subtype = DBUS_TYPE_STRING;
434 subsig = DBUS_TYPE_STRING_AS_STRING;
436 else
438 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
439 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
440 subsig = x;
443 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
444 only element, the value of this element is used as the
445 array's element signature. */
446 if ((subtype == DBUS_TYPE_SIGNATURE)
447 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
448 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
449 subsig = SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt)));
451 while (!NILP (elt))
453 if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
454 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
455 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
458 subsiglen = snprintf (signature, DBUS_MAXIMUM_SIGNATURE_LENGTH,
459 "%c%s", dtype, subsig);
460 if (! (0 <= subsiglen && subsiglen < DBUS_MAXIMUM_SIGNATURE_LENGTH))
461 string_overflow ();
462 break;
464 case DBUS_TYPE_VARIANT:
465 /* Check that there is exactly one list element. */
466 CHECK_CONS (object);
468 elt = XD_NEXT_VALUE (elt);
469 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
470 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
472 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
473 wrong_type_argument (intern ("D-Bus"),
474 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
476 sprintf (signature, "%c", dtype);
477 break;
479 case DBUS_TYPE_STRUCT:
480 /* A struct list might contain any number of elements with
481 different types. No further check needed. */
482 CHECK_CONS (object);
484 elt = XD_NEXT_VALUE (elt);
486 /* Compose the signature from the elements. It is enclosed by
487 parentheses. */
488 sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
489 while (!NILP (elt))
491 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
492 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
493 xd_signature_cat (signature, x);
494 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
496 xd_signature_cat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
497 break;
499 case DBUS_TYPE_DICT_ENTRY:
500 /* Check that there are exactly two list elements, and the first
501 one is of basic type. The dictionary entry itself must be an
502 element of an array. */
503 CHECK_CONS (object);
505 /* Check the parent object type. */
506 if (parent_type != DBUS_TYPE_ARRAY)
507 wrong_type_argument (intern ("D-Bus"), object);
509 /* Compose the signature from the elements. It is enclosed by
510 curly braces. */
511 sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
513 /* First element. */
514 elt = XD_NEXT_VALUE (elt);
515 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
516 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
517 xd_signature_cat (signature, x);
519 if (!XD_BASIC_DBUS_TYPE (subtype))
520 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
522 /* Second element. */
523 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
524 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
525 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
526 xd_signature_cat (signature, x);
528 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
529 wrong_type_argument (intern ("D-Bus"),
530 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
532 /* Closing signature. */
533 xd_signature_cat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
534 break;
536 default:
537 wrong_type_argument (intern ("D-Bus"), object);
540 XD_DEBUG_MESSAGE ("%s", signature);
543 /* Convert X to a signed integer with bounds LO and HI. */
544 static intmax_t
545 xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi)
547 CHECK_NUMBER_OR_FLOAT (x);
548 if (INTEGERP (x))
550 if (lo <= XINT (x) && XINT (x) <= hi)
551 return XINT (x);
553 else
555 double d = XFLOAT_DATA (x);
556 if (lo <= d && d <= hi)
558 intmax_t n = d;
559 if (n == d)
560 return n;
563 if (xd_in_read_queued_messages)
564 Fthrow (Qdbus_error, Qnil);
565 else
566 args_out_of_range_3 (x,
567 make_fixnum_or_float (lo),
568 make_fixnum_or_float (hi));
571 /* Convert X to an unsigned integer with bounds 0 and HI. */
572 static uintmax_t
573 xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
575 CHECK_NUMBER_OR_FLOAT (x);
576 if (INTEGERP (x))
578 if (0 <= XINT (x) && XINT (x) <= hi)
579 return XINT (x);
581 else
583 double d = XFLOAT_DATA (x);
584 if (0 <= d && d <= hi)
586 uintmax_t n = d;
587 if (n == d)
588 return n;
591 if (xd_in_read_queued_messages)
592 Fthrow (Qdbus_error, Qnil);
593 else
594 args_out_of_range_3 (x, make_number (0), make_fixnum_or_float (hi));
597 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
598 DTYPE must be a valid DBusType. It is used to convert Lisp
599 objects, being arguments of `dbus-call-method' or
600 `dbus-send-signal', into corresponding C values appended as
601 arguments to a D-Bus message. */
602 static void
603 xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
605 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
606 DBusMessageIter subiter;
608 if (XD_BASIC_DBUS_TYPE (dtype))
609 switch (dtype)
611 case DBUS_TYPE_BYTE:
612 CHECK_NATNUM (object);
614 unsigned char val = XFASTINT (object) & 0xFF;
615 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
616 if (!dbus_message_iter_append_basic (iter, dtype, &val))
617 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
618 return;
621 case DBUS_TYPE_BOOLEAN:
623 dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
624 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
625 if (!dbus_message_iter_append_basic (iter, dtype, &val))
626 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
627 return;
630 case DBUS_TYPE_INT16:
632 dbus_int16_t val =
633 xd_extract_signed (object,
634 TYPE_MINIMUM (dbus_int16_t),
635 TYPE_MAXIMUM (dbus_int16_t));
636 int pval = val;
637 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
638 if (!dbus_message_iter_append_basic (iter, dtype, &val))
639 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
640 return;
643 case DBUS_TYPE_UINT16:
645 dbus_uint16_t val =
646 xd_extract_unsigned (object,
647 TYPE_MAXIMUM (dbus_uint16_t));
648 unsigned int pval = val;
649 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
650 if (!dbus_message_iter_append_basic (iter, dtype, &val))
651 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
652 return;
655 case DBUS_TYPE_INT32:
657 dbus_int32_t val =
658 xd_extract_signed (object,
659 TYPE_MINIMUM (dbus_int32_t),
660 TYPE_MAXIMUM (dbus_int32_t));
661 int pval = val;
662 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
663 if (!dbus_message_iter_append_basic (iter, dtype, &val))
664 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
665 return;
668 case DBUS_TYPE_UINT32:
669 #ifdef DBUS_TYPE_UNIX_FD
670 case DBUS_TYPE_UNIX_FD:
671 #endif
673 dbus_uint32_t val =
674 xd_extract_unsigned (object,
675 TYPE_MAXIMUM (dbus_uint32_t));
676 unsigned int pval = val;
677 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
678 if (!dbus_message_iter_append_basic (iter, dtype, &val))
679 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
680 return;
683 case DBUS_TYPE_INT64:
685 dbus_int64_t val =
686 xd_extract_signed (object,
687 TYPE_MINIMUM (dbus_int64_t),
688 TYPE_MAXIMUM (dbus_int64_t));
689 printmax_t pval = val;
690 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
691 if (!dbus_message_iter_append_basic (iter, dtype, &val))
692 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
693 return;
696 case DBUS_TYPE_UINT64:
698 dbus_uint64_t val =
699 xd_extract_unsigned (object,
700 TYPE_MAXIMUM (dbus_uint64_t));
701 uprintmax_t pval = val;
702 XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval);
703 if (!dbus_message_iter_append_basic (iter, dtype, &val))
704 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
705 return;
708 case DBUS_TYPE_DOUBLE:
710 double val = extract_float (object);
711 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
712 if (!dbus_message_iter_append_basic (iter, dtype, &val))
713 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
714 return;
717 case DBUS_TYPE_STRING:
718 case DBUS_TYPE_OBJECT_PATH:
719 case DBUS_TYPE_SIGNATURE:
720 CHECK_STRING (object);
722 /* We need to send a valid UTF-8 string. We could encode `object'
723 but by not encoding it, we guarantee it's valid utf-8, even if
724 it contains eight-bit-bytes. Of course, you can still send
725 manually-crafted junk by passing a unibyte string. */
726 char *val = SSDATA (object);
727 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
728 if (!dbus_message_iter_append_basic (iter, dtype, &val))
729 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
730 return;
734 else /* Compound types. */
737 /* All compound types except array have a type symbol. For
738 array, it is optional. Skip it. */
739 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
740 object = XD_NEXT_VALUE (object);
742 /* Open new subiteration. */
743 switch (dtype)
745 case DBUS_TYPE_ARRAY:
746 /* An array has only elements of the same type. So it is
747 sufficient to check the first element's signature
748 only. */
750 if (NILP (object))
751 /* If the array is empty, DBUS_TYPE_STRING is the default
752 element type. */
753 strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
755 else
756 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
757 the only element, the value of this element is used as
758 the array's element signature. */
759 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
760 == DBUS_TYPE_SIGNATURE)
761 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
762 && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
764 lispstpcpy (signature, CAR_SAFE (XD_NEXT_VALUE (object)));
765 object = CDR_SAFE (XD_NEXT_VALUE (object));
768 else
769 xd_signature (signature,
770 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
771 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
773 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
774 XD_OBJECT_TO_STRING (object));
775 if (!dbus_message_iter_open_container (iter, dtype,
776 signature, &subiter))
777 XD_SIGNAL3 (build_string ("Cannot open container"),
778 make_number (dtype), build_string (signature));
779 break;
781 case DBUS_TYPE_VARIANT:
782 /* A variant has just one element. */
783 xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
784 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
786 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
787 XD_OBJECT_TO_STRING (object));
788 if (!dbus_message_iter_open_container (iter, dtype,
789 signature, &subiter))
790 XD_SIGNAL3 (build_string ("Cannot open container"),
791 make_number (dtype), build_string (signature));
792 break;
794 case DBUS_TYPE_STRUCT:
795 case DBUS_TYPE_DICT_ENTRY:
796 /* These containers do not require a signature. */
797 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object));
798 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
799 XD_SIGNAL2 (build_string ("Cannot open container"),
800 make_number (dtype));
801 break;
804 /* Loop over list elements. */
805 while (!NILP (object))
807 dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
808 object = XD_NEXT_VALUE (object);
810 xd_append_arg (dtype, CAR_SAFE (object), &subiter);
812 object = CDR_SAFE (object);
815 /* Close the subiteration. */
816 if (!dbus_message_iter_close_container (iter, &subiter))
817 XD_SIGNAL2 (build_string ("Cannot close container"),
818 make_number (dtype));
822 /* Retrieve C value from a DBusMessageIter structure ITER, and return
823 a converted Lisp object. The type DTYPE of the argument of the
824 D-Bus message must be a valid DBusType. Compound D-Bus types
825 result always in a Lisp list. */
826 static Lisp_Object
827 xd_retrieve_arg (int dtype, DBusMessageIter *iter)
830 switch (dtype)
832 case DBUS_TYPE_BYTE:
834 unsigned int val;
835 dbus_message_iter_get_basic (iter, &val);
836 val = val & 0xFF;
837 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
838 return make_number (val);
841 case DBUS_TYPE_BOOLEAN:
843 dbus_bool_t val;
844 dbus_message_iter_get_basic (iter, &val);
845 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
846 return (val == FALSE) ? Qnil : Qt;
849 case DBUS_TYPE_INT16:
851 dbus_int16_t val;
852 int pval;
853 dbus_message_iter_get_basic (iter, &val);
854 pval = val;
855 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
856 return make_number (val);
859 case DBUS_TYPE_UINT16:
861 dbus_uint16_t val;
862 int pval;
863 dbus_message_iter_get_basic (iter, &val);
864 pval = val;
865 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
866 return make_number (val);
869 case DBUS_TYPE_INT32:
871 dbus_int32_t val;
872 int pval;
873 dbus_message_iter_get_basic (iter, &val);
874 pval = val;
875 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
876 return make_fixnum_or_float (val);
879 case DBUS_TYPE_UINT32:
880 #ifdef DBUS_TYPE_UNIX_FD
881 case DBUS_TYPE_UNIX_FD:
882 #endif
884 dbus_uint32_t val;
885 unsigned int pval;
886 dbus_message_iter_get_basic (iter, &val);
887 pval = val;
888 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
889 return make_fixnum_or_float (val);
892 case DBUS_TYPE_INT64:
894 dbus_int64_t val;
895 printmax_t pval;
896 dbus_message_iter_get_basic (iter, &val);
897 pval = val;
898 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
899 return make_fixnum_or_float (val);
902 case DBUS_TYPE_UINT64:
904 dbus_uint64_t val;
905 uprintmax_t pval;
906 dbus_message_iter_get_basic (iter, &val);
907 pval = val;
908 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
909 return make_fixnum_or_float (val);
912 case DBUS_TYPE_DOUBLE:
914 double val;
915 dbus_message_iter_get_basic (iter, &val);
916 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
917 return make_float (val);
920 case DBUS_TYPE_STRING:
921 case DBUS_TYPE_OBJECT_PATH:
922 case DBUS_TYPE_SIGNATURE:
924 char *val;
925 dbus_message_iter_get_basic (iter, &val);
926 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
927 return build_string (val);
930 case DBUS_TYPE_ARRAY:
931 case DBUS_TYPE_VARIANT:
932 case DBUS_TYPE_STRUCT:
933 case DBUS_TYPE_DICT_ENTRY:
935 Lisp_Object result;
936 struct gcpro gcpro1;
937 DBusMessageIter subiter;
938 int subtype;
939 result = Qnil;
940 GCPRO1 (result);
941 dbus_message_iter_recurse (iter, &subiter);
942 while ((subtype = dbus_message_iter_get_arg_type (&subiter))
943 != DBUS_TYPE_INVALID)
945 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
946 dbus_message_iter_next (&subiter);
948 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
949 RETURN_UNGCPRO (Fnreverse (result));
952 default:
953 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
954 return Qnil;
958 /* Return the number of references of the shared CONNECTION. */
959 static ptrdiff_t
960 xd_get_connection_references (DBusConnection *connection)
962 ptrdiff_t *refcount;
964 /* We cannot access the DBusConnection structure, it is not public.
965 But we know, that the reference counter is the first field in
966 that structure. */
967 refcount = (void *) &connection;
968 refcount = (void *) *refcount;
969 return *refcount;
972 /* Convert a Lisp D-Bus object to a pointer. */
973 static DBusConnection*
974 xd_lisp_dbus_to_dbus (Lisp_Object bus)
976 return (DBusConnection *) (intptr_t) XFASTINT (bus);
979 /* Return D-Bus connection address. BUS is either a Lisp symbol,
980 :system or :session, or a string denoting the bus address. */
981 static DBusConnection *
982 xd_get_connection_address (Lisp_Object bus)
984 DBusConnection *connection;
985 Lisp_Object val;
987 val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
988 if (NILP (val))
989 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
990 else
991 connection = xd_lisp_dbus_to_dbus (val);
993 if (!dbus_connection_get_is_connected (connection))
994 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
996 return connection;
999 /* Return the file descriptor for WATCH, -1 if not found. */
1000 static int
1001 xd_find_watch_fd (DBusWatch *watch)
1003 #if HAVE_DBUS_WATCH_GET_UNIX_FD
1004 /* TODO: Reverse these on w32, which prefers the opposite. */
1005 int fd = dbus_watch_get_unix_fd (watch);
1006 if (fd == -1)
1007 fd = dbus_watch_get_socket (watch);
1008 #else
1009 int fd = dbus_watch_get_fd (watch);
1010 #endif
1011 return fd;
1014 /* Prototype. */
1015 static void xd_read_queued_messages (int fd, void *data);
1017 /* Start monitoring WATCH for possible I/O. */
1018 static dbus_bool_t
1019 xd_add_watch (DBusWatch *watch, void *data)
1021 unsigned int flags = dbus_watch_get_flags (watch);
1022 int fd = xd_find_watch_fd (watch);
1024 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
1025 fd, flags & DBUS_WATCH_WRITABLE,
1026 dbus_watch_get_enabled (watch));
1028 if (fd == -1)
1029 return FALSE;
1031 if (dbus_watch_get_enabled (watch))
1033 if (flags & DBUS_WATCH_WRITABLE)
1034 add_write_fd (fd, xd_read_queued_messages, data);
1035 if (flags & DBUS_WATCH_READABLE)
1036 add_read_fd (fd, xd_read_queued_messages, data);
1038 return TRUE;
1041 /* Stop monitoring WATCH for possible I/O.
1042 DATA is the used bus, either a string or QCdbus_system_bus or
1043 QCdbus_session_bus. */
1044 static void
1045 xd_remove_watch (DBusWatch *watch, void *data)
1047 unsigned int flags = dbus_watch_get_flags (watch);
1048 int fd = xd_find_watch_fd (watch);
1050 XD_DEBUG_MESSAGE ("fd %d", fd);
1052 if (fd == -1)
1053 return;
1055 /* Unset session environment. */
1056 #if 0
1057 if (XSYMBOL (QCdbus_session_bus) == data)
1059 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
1060 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
1062 #endif
1064 if (flags & DBUS_WATCH_WRITABLE)
1065 delete_write_fd (fd);
1066 if (flags & DBUS_WATCH_READABLE)
1067 delete_read_fd (fd);
1070 /* Toggle monitoring WATCH for possible I/O. */
1071 static void
1072 xd_toggle_watch (DBusWatch *watch, void *data)
1074 if (dbus_watch_get_enabled (watch))
1075 xd_add_watch (watch, data);
1076 else
1077 xd_remove_watch (watch, data);
1080 /* Close connection to D-Bus BUS. */
1081 static void
1082 xd_close_bus (Lisp_Object bus)
1084 DBusConnection *connection;
1085 Lisp_Object val;
1086 Lisp_Object busobj;
1088 /* Check whether we are connected. */
1089 val = Fassoc (bus, xd_registered_buses);
1090 if (NILP (val))
1091 return;
1093 busobj = CDR_SAFE (val);
1094 if (NILP (busobj)) {
1095 xd_registered_buses = Fdelete (val, xd_registered_buses);
1096 return;
1099 /* Retrieve bus address. */
1100 connection = xd_lisp_dbus_to_dbus (busobj);
1102 if (xd_get_connection_references (connection) == 1)
1104 /* Close connection, if there isn't another shared application. */
1105 XD_DEBUG_MESSAGE ("Close connection to bus %s",
1106 XD_OBJECT_TO_STRING (bus));
1107 dbus_connection_close (connection);
1109 xd_registered_buses = Fdelete (val, xd_registered_buses);
1112 else
1113 /* Decrement reference count. */
1114 dbus_connection_unref (connection);
1116 /* Return. */
1117 return;
1120 DEFUN ("dbus--init-bus", Fdbus__init_bus, Sdbus__init_bus, 1, 2, 0,
1121 doc: /* Establish the connection to D-Bus BUS.
1123 This function is dbus internal. You almost certainly want to use
1124 `dbus-init-bus'.
1126 BUS can be either the symbol `:system' or the symbol `:session', or it
1127 can be a string denoting the address of the corresponding bus. For
1128 the system and session buses, this function is called when loading
1129 `dbus.el', there is no need to call it again.
1131 The function returns a number, which counts the connections this Emacs
1132 session has established to the BUS under the same unique name (see
1133 `dbus-get-unique-name'). It depends on the libraries Emacs is linked
1134 with, and on the environment Emacs is running. For example, if Emacs
1135 is linked with the gtk toolkit, and it runs in a GTK-aware environment
1136 like Gnome, another connection might already be established.
1138 When PRIVATE is non-nil, a new connection is established instead of
1139 reusing an existing one. It results in a new unique name at the bus.
1140 This can be used, if it is necessary to distinguish from another
1141 connection used in the same Emacs process, like the one established by
1142 GTK+. It should be used with care for at least the `:system' and
1143 `:session' buses, because other Emacs Lisp packages might already use
1144 this connection to those buses. */)
1145 (Lisp_Object bus, Lisp_Object private)
1147 DBusConnection *connection;
1148 DBusError derror;
1149 Lisp_Object val;
1150 ptrdiff_t refcount;
1152 /* Check parameter. */
1153 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1155 /* Close bus if it is already open. */
1156 xd_close_bus (bus);
1158 /* Check, whether we are still connected. */
1159 val = Fassoc (bus, xd_registered_buses);
1160 if (!NILP (val))
1162 connection = xd_get_connection_address (bus);
1163 dbus_connection_ref (connection);
1166 else
1168 /* Initialize. */
1169 dbus_error_init (&derror);
1171 /* Open the connection. */
1172 if (STRINGP (bus))
1173 if (NILP (private))
1174 connection = dbus_connection_open (SSDATA (bus), &derror);
1175 else
1176 connection = dbus_connection_open_private (SSDATA (bus), &derror);
1178 else
1179 if (NILP (private))
1180 connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
1181 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1182 &derror);
1183 else
1184 connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
1185 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1186 &derror);
1188 if (dbus_error_is_set (&derror))
1189 XD_ERROR (derror);
1191 if (connection == NULL)
1192 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
1194 /* If it is not the system or session bus, we must register
1195 ourselves. Otherwise, we have called dbus_bus_get, which has
1196 configured us to exit if the connection closes - we undo this
1197 setting. */
1198 if (STRINGP (bus))
1199 dbus_bus_register (connection, &derror);
1200 else
1201 dbus_connection_set_exit_on_disconnect (connection, FALSE);
1203 if (dbus_error_is_set (&derror))
1204 XD_ERROR (derror);
1206 /* Add the watch functions. We pass also the bus as data, in
1207 order to distinguish between the buses in xd_remove_watch. */
1208 if (!dbus_connection_set_watch_functions (connection,
1209 xd_add_watch,
1210 xd_remove_watch,
1211 xd_toggle_watch,
1212 SYMBOLP (bus)
1213 ? (void *) XSYMBOL (bus)
1214 : (void *) XSTRING (bus),
1215 NULL))
1216 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
1218 /* Add bus to list of registered buses. */
1219 XSETFASTINT (val, (intptr_t) connection);
1220 xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
1222 /* We do not want to abort. */
1223 xputenv ("DBUS_FATAL_WARNINGS=0");
1225 /* Cleanup. */
1226 dbus_error_free (&derror);
1229 /* Return reference counter. */
1230 refcount = xd_get_connection_references (connection);
1231 XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d",
1232 XD_OBJECT_TO_STRING (bus), refcount);
1233 return make_number (refcount);
1236 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1237 1, 1, 0,
1238 doc: /* Return the unique name of Emacs registered at D-Bus BUS. */)
1239 (Lisp_Object bus)
1241 DBusConnection *connection;
1242 const char *name;
1244 /* Check parameter. */
1245 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1247 /* Retrieve bus address. */
1248 connection = xd_get_connection_address (bus);
1250 /* Request the name. */
1251 name = dbus_bus_get_unique_name (connection);
1252 if (name == NULL)
1253 XD_SIGNAL1 (build_string ("No unique name available"));
1255 /* Return. */
1256 return build_string (name);
1259 DEFUN ("dbus-message-internal", Fdbus_message_internal, Sdbus_message_internal,
1260 4, MANY, 0,
1261 doc: /* Send a D-Bus message.
1262 This is an internal function, it shall not be used outside dbus.el.
1264 The following usages are expected:
1266 `dbus-call-method', `dbus-call-method-asynchronously':
1267 \(dbus-message-internal
1268 dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1269 &optional :timeout TIMEOUT &rest ARGS)
1271 `dbus-send-signal':
1272 \(dbus-message-internal
1273 dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1275 `dbus-method-return-internal':
1276 \(dbus-message-internal
1277 dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1279 `dbus-method-error-internal':
1280 \(dbus-message-internal
1281 dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1283 usage: (dbus-message-internal &rest REST) */)
1284 (ptrdiff_t nargs, Lisp_Object *args)
1286 Lisp_Object message_type, bus, service, handler;
1287 Lisp_Object path = Qnil;
1288 Lisp_Object interface = Qnil;
1289 Lisp_Object member = Qnil;
1290 Lisp_Object result;
1291 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1292 DBusConnection *connection;
1293 DBusMessage *dmessage;
1294 DBusMessageIter iter;
1295 int dtype;
1296 int mtype;
1297 dbus_uint32_t serial = 0;
1298 unsigned int ui_serial;
1299 int timeout = -1;
1300 ptrdiff_t count;
1301 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1303 /* Initialize parameters. */
1304 message_type = args[0];
1305 bus = args[1];
1306 service = args[2];
1307 handler = Qnil;
1309 CHECK_NATNUM (message_type);
1310 if (! (DBUS_MESSAGE_TYPE_INVALID < XFASTINT (message_type)
1311 && XFASTINT (message_type) < DBUS_NUM_MESSAGE_TYPES))
1312 XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
1313 mtype = XFASTINT (message_type);
1315 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1316 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1318 path = args[3];
1319 interface = args[4];
1320 member = args[5];
1321 if (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1322 handler = args[6];
1323 count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
1325 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1327 serial = xd_extract_unsigned (args[3], TYPE_MAXIMUM (dbus_uint32_t));
1328 count = 4;
1331 /* Check parameters. */
1332 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1333 XD_DBUS_VALIDATE_BUS_NAME (service);
1334 if (nargs < count)
1335 xsignal2 (Qwrong_number_of_arguments,
1336 Qdbus_message_internal,
1337 make_number (nargs));
1339 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1340 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1342 XD_DBUS_VALIDATE_PATH (path);
1343 XD_DBUS_VALIDATE_INTERFACE (interface);
1344 XD_DBUS_VALIDATE_MEMBER (member);
1345 if (!NILP (handler) && (!FUNCTIONP (handler)))
1346 wrong_type_argument (Qinvalid_function, handler);
1349 /* Protect Lisp variables. */
1350 GCPRO6 (bus, service, path, interface, member, handler);
1352 /* Trace parameters. */
1353 switch (mtype)
1355 case DBUS_MESSAGE_TYPE_METHOD_CALL:
1356 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1357 XD_MESSAGE_TYPE_TO_STRING (mtype),
1358 XD_OBJECT_TO_STRING (bus),
1359 XD_OBJECT_TO_STRING (service),
1360 XD_OBJECT_TO_STRING (path),
1361 XD_OBJECT_TO_STRING (interface),
1362 XD_OBJECT_TO_STRING (member),
1363 XD_OBJECT_TO_STRING (handler));
1364 break;
1365 case DBUS_MESSAGE_TYPE_SIGNAL:
1366 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1367 XD_MESSAGE_TYPE_TO_STRING (mtype),
1368 XD_OBJECT_TO_STRING (bus),
1369 XD_OBJECT_TO_STRING (service),
1370 XD_OBJECT_TO_STRING (path),
1371 XD_OBJECT_TO_STRING (interface),
1372 XD_OBJECT_TO_STRING (member));
1373 break;
1374 default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1375 ui_serial = serial;
1376 XD_DEBUG_MESSAGE ("%s %s %s %u",
1377 XD_MESSAGE_TYPE_TO_STRING (mtype),
1378 XD_OBJECT_TO_STRING (bus),
1379 XD_OBJECT_TO_STRING (service),
1380 ui_serial);
1383 /* Retrieve bus address. */
1384 connection = xd_get_connection_address (bus);
1386 /* Create the D-Bus message. */
1387 dmessage = dbus_message_new (mtype);
1388 if (dmessage == NULL)
1390 UNGCPRO;
1391 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1394 if (STRINGP (service))
1396 if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
1397 /* Set destination. */
1399 if (!dbus_message_set_destination (dmessage, SSDATA (service)))
1401 UNGCPRO;
1402 XD_SIGNAL2 (build_string ("Unable to set the destination"),
1403 service);
1407 else
1408 /* Set destination for unicast signals. */
1410 Lisp_Object uname;
1412 /* If it is the same unique name as we are registered at the
1413 bus or an unknown name, we regard it as broadcast message
1414 due to backward compatibility. */
1415 if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
1416 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1417 else
1418 uname = Qnil;
1420 if (STRINGP (uname)
1421 && (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
1422 != 0)
1423 && (!dbus_message_set_destination (dmessage, SSDATA (service))))
1425 UNGCPRO;
1426 XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1427 service);
1432 /* Set message parameters. */
1433 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1434 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1436 if ((!dbus_message_set_path (dmessage, SSDATA (path)))
1437 || (!dbus_message_set_interface (dmessage, SSDATA (interface)))
1438 || (!dbus_message_set_member (dmessage, SSDATA (member))))
1440 UNGCPRO;
1441 XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1445 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1447 if (!dbus_message_set_reply_serial (dmessage, serial))
1449 UNGCPRO;
1450 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1453 if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
1454 && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
1456 UNGCPRO;
1457 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1461 /* Check for timeout parameter. */
1462 if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
1464 CHECK_NATNUM (args[count+1]);
1465 timeout = min (XFASTINT (args[count+1]), INT_MAX);
1466 count = count+2;
1469 /* Initialize parameter list of message. */
1470 dbus_message_iter_init_append (dmessage, &iter);
1472 /* Append parameters to the message. */
1473 for (; count < nargs; ++count)
1475 dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
1476 if (XD_DBUS_TYPE_P (args[count]))
1478 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1479 XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
1480 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
1481 XD_OBJECT_TO_STRING (args[count]),
1482 XD_OBJECT_TO_STRING (args[count+1]));
1483 ++count;
1485 else
1487 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1488 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
1489 XD_OBJECT_TO_STRING (args[count]));
1492 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1493 indication that there is no parent type. */
1494 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[count]);
1496 xd_append_arg (dtype, args[count], &iter);
1499 if (!NILP (handler))
1501 /* Send the message. The message is just added to the outgoing
1502 message queue. */
1503 if (!dbus_connection_send_with_reply (connection, dmessage,
1504 NULL, timeout))
1506 UNGCPRO;
1507 XD_SIGNAL1 (build_string ("Cannot send message"));
1510 /* The result is the key in Vdbus_registered_objects_table. */
1511 serial = dbus_message_get_serial (dmessage);
1512 result = list3 (QCdbus_registered_serial,
1513 bus, make_fixnum_or_float (serial));
1515 /* Create a hash table entry. */
1516 Fputhash (result, handler, Vdbus_registered_objects_table);
1518 else
1520 /* Send the message. The message is just added to the outgoing
1521 message queue. */
1522 if (!dbus_connection_send (connection, dmessage, NULL))
1524 UNGCPRO;
1525 XD_SIGNAL1 (build_string ("Cannot send message"));
1528 result = Qnil;
1531 XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
1533 /* Cleanup. */
1534 dbus_message_unref (dmessage);
1536 /* Return the result. */
1537 RETURN_UNGCPRO (result);
1540 /* Read one queued incoming message of the D-Bus BUS.
1541 BUS is either a Lisp symbol, :system or :session, or a string denoting
1542 the bus address. */
1543 static void
1544 xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1546 Lisp_Object args, key, value;
1547 struct gcpro gcpro1;
1548 struct input_event event;
1549 DBusMessage *dmessage;
1550 DBusMessageIter iter;
1551 int dtype;
1552 int mtype;
1553 dbus_uint32_t serial;
1554 unsigned int ui_serial;
1555 const char *uname, *path, *interface, *member;
1557 dmessage = dbus_connection_pop_message (connection);
1559 /* Return if there is no queued message. */
1560 if (dmessage == NULL)
1561 return;
1563 /* Collect the parameters. */
1564 args = Qnil;
1565 GCPRO1 (args);
1567 /* Loop over the resulting parameters. Construct a list. */
1568 if (dbus_message_iter_init (dmessage, &iter))
1570 while ((dtype = dbus_message_iter_get_arg_type (&iter))
1571 != DBUS_TYPE_INVALID)
1573 args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1574 dbus_message_iter_next (&iter);
1576 /* The arguments are stored in reverse order. Reorder them. */
1577 args = Fnreverse (args);
1580 /* Read message type, message serial, unique name, object path,
1581 interface and member from the message. */
1582 mtype = dbus_message_get_type (dmessage);
1583 ui_serial = serial =
1584 ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1585 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1586 ? dbus_message_get_reply_serial (dmessage)
1587 : dbus_message_get_serial (dmessage);
1588 uname = dbus_message_get_sender (dmessage);
1589 path = dbus_message_get_path (dmessage);
1590 interface = dbus_message_get_interface (dmessage);
1591 member = dbus_message_get_member (dmessage);
1593 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1594 XD_MESSAGE_TYPE_TO_STRING (mtype),
1595 ui_serial, uname, path, interface, member,
1596 XD_OBJECT_TO_STRING (args));
1598 if (mtype == DBUS_MESSAGE_TYPE_INVALID)
1599 goto cleanup;
1601 else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1602 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1604 /* Search for a registered function of the message. */
1605 key = list3 (QCdbus_registered_serial, bus,
1606 make_fixnum_or_float (serial));
1607 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1609 /* There shall be exactly one entry. Construct an event. */
1610 if (NILP (value))
1611 goto cleanup;
1613 /* Remove the entry. */
1614 Fremhash (key, Vdbus_registered_objects_table);
1616 /* Construct an event. */
1617 EVENT_INIT (event);
1618 event.kind = DBUS_EVENT;
1619 event.frame_or_window = Qnil;
1620 event.arg = Fcons (value, args);
1623 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
1625 /* Vdbus_registered_objects_table requires non-nil interface and
1626 member. */
1627 if ((interface == NULL) || (member == NULL))
1628 goto cleanup;
1630 /* Search for a registered function of the message. */
1631 key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1632 ? QCdbus_registered_method
1633 : QCdbus_registered_signal,
1634 bus, build_string (interface), build_string (member));
1635 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1637 /* Loop over the registered functions. Construct an event. */
1638 while (!NILP (value))
1640 key = CAR_SAFE (value);
1641 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1642 if (((uname == NULL)
1643 || (NILP (CAR_SAFE (key)))
1644 || (strcmp (uname, SSDATA (CAR_SAFE (key))) == 0))
1645 && ((path == NULL)
1646 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1647 || (strcmp (path,
1648 SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1649 == 0))
1650 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1652 EVENT_INIT (event);
1653 event.kind = DBUS_EVENT;
1654 event.frame_or_window = Qnil;
1655 event.arg
1656 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args);
1657 break;
1659 value = CDR_SAFE (value);
1662 if (NILP (value))
1663 goto cleanup;
1666 /* Add type, serial, uname, path, interface and member to the event. */
1667 event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1668 event.arg);
1669 event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1670 event.arg);
1671 event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1672 event.arg);
1673 event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1674 event.arg);
1675 event.arg = Fcons (make_fixnum_or_float (serial), event.arg);
1676 event.arg = Fcons (make_number (mtype), event.arg);
1678 /* Add the bus symbol to the event. */
1679 event.arg = Fcons (bus, event.arg);
1681 /* Store it into the input event queue. */
1682 kbd_buffer_store_event (&event);
1684 XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
1686 /* Cleanup. */
1687 cleanup:
1688 dbus_message_unref (dmessage);
1690 UNGCPRO;
1693 /* Read queued incoming messages of the D-Bus BUS.
1694 BUS is either a Lisp symbol, :system or :session, or a string denoting
1695 the bus address. */
1696 static Lisp_Object
1697 xd_read_message (Lisp_Object bus)
1699 /* Retrieve bus address. */
1700 DBusConnection *connection = xd_get_connection_address (bus);
1702 /* Non blocking read of the next available message. */
1703 dbus_connection_read_write (connection, 0);
1705 while (dbus_connection_get_dispatch_status (connection)
1706 != DBUS_DISPATCH_COMPLETE)
1707 xd_read_message_1 (connection, bus);
1708 return Qnil;
1711 /* Callback called when something is ready to read or write. */
1712 static void
1713 xd_read_queued_messages (int fd, void *data)
1715 Lisp_Object busp = xd_registered_buses;
1716 Lisp_Object bus = Qnil;
1717 Lisp_Object key;
1719 /* Find bus related to fd. */
1720 if (data != NULL)
1721 while (!NILP (busp))
1723 key = CAR_SAFE (CAR_SAFE (busp));
1724 if ((SYMBOLP (key) && XSYMBOL (key) == data)
1725 || (STRINGP (key) && XSTRING (key) == data))
1726 bus = key;
1727 busp = CDR_SAFE (busp);
1730 if (NILP (bus))
1731 return;
1733 /* We ignore all Lisp errors during the call. */
1734 xd_in_read_queued_messages = 1;
1735 internal_catch (Qdbus_error, xd_read_message, bus);
1736 xd_in_read_queued_messages = 0;
1740 void
1741 syms_of_dbusbind (void)
1744 DEFSYM (Qdbus__init_bus, "dbus--init-bus");
1745 defsubr (&Sdbus__init_bus);
1747 DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
1748 defsubr (&Sdbus_get_unique_name);
1750 DEFSYM (Qdbus_message_internal, "dbus-message-internal");
1751 defsubr (&Sdbus_message_internal);
1753 DEFSYM (Qdbus_error, "dbus-error");
1754 Fput (Qdbus_error, Qerror_conditions,
1755 list2 (Qdbus_error, Qerror));
1756 Fput (Qdbus_error, Qerror_message,
1757 build_pure_c_string ("D-Bus error"));
1759 DEFSYM (QCdbus_system_bus, ":system");
1760 DEFSYM (QCdbus_session_bus, ":session");
1761 DEFSYM (QCdbus_timeout, ":timeout");
1762 DEFSYM (QCdbus_type_byte, ":byte");
1763 DEFSYM (QCdbus_type_boolean, ":boolean");
1764 DEFSYM (QCdbus_type_int16, ":int16");
1765 DEFSYM (QCdbus_type_uint16, ":uint16");
1766 DEFSYM (QCdbus_type_int32, ":int32");
1767 DEFSYM (QCdbus_type_uint32, ":uint32");
1768 DEFSYM (QCdbus_type_int64, ":int64");
1769 DEFSYM (QCdbus_type_uint64, ":uint64");
1770 DEFSYM (QCdbus_type_double, ":double");
1771 DEFSYM (QCdbus_type_string, ":string");
1772 DEFSYM (QCdbus_type_object_path, ":object-path");
1773 DEFSYM (QCdbus_type_signature, ":signature");
1774 #ifdef DBUS_TYPE_UNIX_FD
1775 DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
1776 #endif
1777 DEFSYM (QCdbus_type_array, ":array");
1778 DEFSYM (QCdbus_type_variant, ":variant");
1779 DEFSYM (QCdbus_type_struct, ":struct");
1780 DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
1781 DEFSYM (QCdbus_registered_serial, ":serial");
1782 DEFSYM (QCdbus_registered_method, ":method");
1783 DEFSYM (QCdbus_registered_signal, ":signal");
1785 DEFVAR_LISP ("dbus-compiled-version",
1786 Vdbus_compiled_version,
1787 doc: /* The version of D-Bus Emacs is compiled against. */);
1788 #ifdef DBUS_VERSION_STRING
1789 Vdbus_compiled_version = build_pure_c_string (DBUS_VERSION_STRING);
1790 #else
1791 Vdbus_compiled_version = Qnil;
1792 #endif
1794 DEFVAR_LISP ("dbus-runtime-version",
1795 Vdbus_runtime_version,
1796 doc: /* The version of D-Bus Emacs runs with. */);
1798 #ifdef DBUS_VERSION
1799 int major, minor, micro;
1800 char s[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
1801 dbus_get_version (&major, &minor, &micro);
1802 Vdbus_runtime_version
1803 = make_formatted_string (s, "%d.%d.%d", major, minor, micro);
1804 #else
1805 Vdbus_runtime_version = Qnil;
1806 #endif
1809 DEFVAR_LISP ("dbus-message-type-invalid",
1810 Vdbus_message_type_invalid,
1811 doc: /* This value is never a valid message type. */);
1812 Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
1814 DEFVAR_LISP ("dbus-message-type-method-call",
1815 Vdbus_message_type_method_call,
1816 doc: /* Message type of a method call message. */);
1817 Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
1819 DEFVAR_LISP ("dbus-message-type-method-return",
1820 Vdbus_message_type_method_return,
1821 doc: /* Message type of a method return message. */);
1822 Vdbus_message_type_method_return
1823 = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1825 DEFVAR_LISP ("dbus-message-type-error",
1826 Vdbus_message_type_error,
1827 doc: /* Message type of an error reply message. */);
1828 Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
1830 DEFVAR_LISP ("dbus-message-type-signal",
1831 Vdbus_message_type_signal,
1832 doc: /* Message type of a signal message. */);
1833 Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
1835 DEFVAR_LISP ("dbus-registered-objects-table",
1836 Vdbus_registered_objects_table,
1837 doc: /* Hash table of registered functions for D-Bus.
1839 There are two different uses of the hash table: for accessing
1840 registered interfaces properties, targeted by signals or method calls,
1841 and for calling handlers in case of non-blocking method call returns.
1843 In the first case, the key in the hash table is the list (TYPE BUS
1844 INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
1845 `:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
1846 `:session', or a string denoting the bus address. INTERFACE is a
1847 string which denotes a D-Bus interface, and MEMBER, also a string, is
1848 either a method, a signal or a property INTERFACE is offering. All
1849 arguments but BUS must not be nil.
1851 The value in the hash table is a list of quadruple lists \((UNAME
1852 SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
1853 registered, UNAME is the corresponding unique name. In case of
1854 registered methods and properties, UNAME is nil. PATH is the object
1855 path of the sending object. All of them can be nil, which means a
1856 wildcard then. OBJECT is either the handler to be called when a D-Bus
1857 message, which matches the key criteria, arrives (TYPE `:method' and
1858 `:signal'), or a cons cell containing the value of the property (TYPE
1859 `:property').
1861 For entries of type `:signal', there is also a fifth element RULE,
1862 which keeps the match string the signal is registered with.
1864 In the second case, the key in the hash table is the list (:serial BUS
1865 SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
1866 string denoting the bus address. SERIAL is the serial number of the
1867 non-blocking method call, a reply is expected. Both arguments must
1868 not be nil. The value in the hash table is HANDLER, the function to
1869 be called when the D-Bus reply message arrives. */);
1871 Lisp_Object args[2];
1872 args[0] = QCtest;
1873 args[1] = Qequal;
1874 Vdbus_registered_objects_table = Fmake_hash_table (2, args);
1877 DEFVAR_LISP ("dbus-debug", Vdbus_debug,
1878 doc: /* If non-nil, debug messages of D-Bus bindings are raised. */);
1879 #ifdef DBUS_DEBUG
1880 Vdbus_debug = Qt;
1881 /* We can also set environment variable DBUS_VERBOSE=1 in order to
1882 see more traces. This requires libdbus-1 to be configured with
1883 --enable-verbose-mode. */
1884 #else
1885 Vdbus_debug = Qnil;
1886 #endif
1888 /* Initialize internal objects. */
1889 xd_registered_buses = Qnil;
1890 staticpro (&xd_registered_buses);
1892 Fprovide (intern_c_string ("dbusbind"), Qnil);
1896 #endif /* HAVE_DBUS */