1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007-2012 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>
27 #include "termhooks.h"
31 #ifndef DBUS_NUM_MESSAGE_TYPES
32 #define DBUS_NUM_MESSAGE_TYPES 5
37 static Lisp_Object Qdbus_init_bus
;
38 static Lisp_Object Qdbus_get_unique_name
;
39 static Lisp_Object Qdbus_message_internal
;
41 /* D-Bus error symbol. */
42 static Lisp_Object Qdbus_error
;
44 /* Lisp symbols of the system and session buses. */
45 static Lisp_Object QCdbus_system_bus
, QCdbus_session_bus
;
47 /* Lisp symbol for method call timeout. */
48 static Lisp_Object QCdbus_timeout
;
50 /* Lisp symbols of D-Bus types. */
51 static Lisp_Object QCdbus_type_byte
, QCdbus_type_boolean
;
52 static Lisp_Object QCdbus_type_int16
, QCdbus_type_uint16
;
53 static Lisp_Object QCdbus_type_int32
, QCdbus_type_uint32
;
54 static Lisp_Object QCdbus_type_int64
, QCdbus_type_uint64
;
55 static Lisp_Object QCdbus_type_double
, QCdbus_type_string
;
56 static Lisp_Object QCdbus_type_object_path
, QCdbus_type_signature
;
57 #ifdef DBUS_TYPE_UNIX_FD
58 static Lisp_Object QCdbus_type_unix_fd
;
60 static Lisp_Object QCdbus_type_array
, QCdbus_type_variant
;
61 static Lisp_Object QCdbus_type_struct
, QCdbus_type_dict_entry
;
63 /* Lisp symbols of objects in `dbus-registered-objects-table'. */
64 static Lisp_Object QCdbus_registered_serial
, QCdbus_registered_method
;
65 static Lisp_Object QCdbus_registered_signal
;
67 /* Alist of D-Bus buses we are polling for messages.
68 The key is the symbol or string of the bus, and the value is the
69 connection address. */
70 static Lisp_Object xd_registered_buses
;
72 /* Whether we are reading a D-Bus event. */
73 static int xd_in_read_queued_messages
= 0;
76 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
77 we don't want to poison other namespaces with "dbus_". */
79 /* Raise a signal. If we are reading events, we cannot signal; we
80 throw to xd_read_queued_messages then. */
81 #define XD_SIGNAL1(arg) \
83 if (xd_in_read_queued_messages) \
84 Fthrow (Qdbus_error, Qnil); \
86 xsignal1 (Qdbus_error, arg); \
89 #define XD_SIGNAL2(arg1, arg2) \
91 if (xd_in_read_queued_messages) \
92 Fthrow (Qdbus_error, Qnil); \
94 xsignal2 (Qdbus_error, arg1, arg2); \
97 #define XD_SIGNAL3(arg1, arg2, arg3) \
99 if (xd_in_read_queued_messages) \
100 Fthrow (Qdbus_error, Qnil); \
102 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
105 /* Raise a Lisp error from a D-Bus ERROR. */
106 #define XD_ERROR(error) \
108 /* Remove the trailing newline. */ \
109 char const *mess = error.message; \
110 char const *nl = strchr (mess, '\n'); \
111 Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
112 dbus_error_free (&error); \
116 /* Macros for debugging. In order to enable them, build with
117 "env MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
119 #define XD_DEBUG_MESSAGE(...) \
122 snprintf (s, sizeof s, __VA_ARGS__); \
123 if (!noninteractive) \
124 printf ("%s: %s\n", __func__, s); \
125 message ("%s: %s", __func__, s); \
127 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
129 if (!valid_lisp_object_p (object)) \
131 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
132 XD_SIGNAL1 (build_string ("Assertion failure")); \
136 #else /* !DBUS_DEBUG */
137 #define XD_DEBUG_MESSAGE(...) \
139 if (!NILP (Vdbus_debug)) \
142 snprintf (s, sizeof s, __VA_ARGS__); \
143 message ("%s: %s", __func__, s); \
146 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
149 /* Check whether TYPE is a basic DBusType. */
150 #ifdef DBUS_TYPE_UNIX_FD
151 #define XD_BASIC_DBUS_TYPE(type) \
152 ((type == DBUS_TYPE_BYTE) \
153 || (type == DBUS_TYPE_BOOLEAN) \
154 || (type == DBUS_TYPE_INT16) \
155 || (type == DBUS_TYPE_UINT16) \
156 || (type == DBUS_TYPE_INT32) \
157 || (type == DBUS_TYPE_UINT32) \
158 || (type == DBUS_TYPE_INT64) \
159 || (type == DBUS_TYPE_UINT64) \
160 || (type == DBUS_TYPE_DOUBLE) \
161 || (type == DBUS_TYPE_STRING) \
162 || (type == DBUS_TYPE_OBJECT_PATH) \
163 || (type == DBUS_TYPE_SIGNATURE) \
164 || (type == DBUS_TYPE_UNIX_FD))
166 #define XD_BASIC_DBUS_TYPE(type) \
167 ((type == DBUS_TYPE_BYTE) \
168 || (type == DBUS_TYPE_BOOLEAN) \
169 || (type == DBUS_TYPE_INT16) \
170 || (type == DBUS_TYPE_UINT16) \
171 || (type == DBUS_TYPE_INT32) \
172 || (type == DBUS_TYPE_UINT32) \
173 || (type == DBUS_TYPE_INT64) \
174 || (type == DBUS_TYPE_UINT64) \
175 || (type == DBUS_TYPE_DOUBLE) \
176 || (type == DBUS_TYPE_STRING) \
177 || (type == DBUS_TYPE_OBJECT_PATH) \
178 || (type == DBUS_TYPE_SIGNATURE))
181 /* This was a macro. On Solaris 2.11 it was said to compile for
182 hours, when optimization is enabled. So we have transferred it into
184 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
185 of the predefined D-Bus type symbols. */
187 xd_symbol_to_dbus_type (Lisp_Object object
)
190 ((EQ (object
, QCdbus_type_byte
)) ? DBUS_TYPE_BYTE
191 : (EQ (object
, QCdbus_type_boolean
)) ? DBUS_TYPE_BOOLEAN
192 : (EQ (object
, QCdbus_type_int16
)) ? DBUS_TYPE_INT16
193 : (EQ (object
, QCdbus_type_uint16
)) ? DBUS_TYPE_UINT16
194 : (EQ (object
, QCdbus_type_int32
)) ? DBUS_TYPE_INT32
195 : (EQ (object
, QCdbus_type_uint32
)) ? DBUS_TYPE_UINT32
196 : (EQ (object
, QCdbus_type_int64
)) ? DBUS_TYPE_INT64
197 : (EQ (object
, QCdbus_type_uint64
)) ? DBUS_TYPE_UINT64
198 : (EQ (object
, QCdbus_type_double
)) ? DBUS_TYPE_DOUBLE
199 : (EQ (object
, QCdbus_type_string
)) ? DBUS_TYPE_STRING
200 : (EQ (object
, QCdbus_type_object_path
)) ? DBUS_TYPE_OBJECT_PATH
201 : (EQ (object
, QCdbus_type_signature
)) ? DBUS_TYPE_SIGNATURE
202 #ifdef DBUS_TYPE_UNIX_FD
203 : (EQ (object
, QCdbus_type_unix_fd
)) ? DBUS_TYPE_UNIX_FD
205 : (EQ (object
, QCdbus_type_array
)) ? DBUS_TYPE_ARRAY
206 : (EQ (object
, QCdbus_type_variant
)) ? DBUS_TYPE_VARIANT
207 : (EQ (object
, QCdbus_type_struct
)) ? DBUS_TYPE_STRUCT
208 : (EQ (object
, QCdbus_type_dict_entry
)) ? DBUS_TYPE_DICT_ENTRY
209 : DBUS_TYPE_INVALID
);
212 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
213 #define XD_DBUS_TYPE_P(object) \
214 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
216 /* Determine the DBusType of a given Lisp OBJECT. It is used to
217 convert Lisp objects, being arguments of `dbus-call-method' or
218 `dbus-send-signal', into corresponding C values appended as
219 arguments to a D-Bus message. */
220 #define XD_OBJECT_TO_DBUS_TYPE(object) \
221 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
222 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
223 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
224 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
225 : (STRINGP (object)) ? DBUS_TYPE_STRING \
226 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
228 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
229 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
231 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
235 /* Return a list pointer which does not have a Lisp symbol as car. */
236 #define XD_NEXT_VALUE(object) \
237 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
239 /* Transform the message type to its string representation for debug
241 #define XD_MESSAGE_TYPE_TO_STRING(mtype) \
242 ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
243 ? "DBUS_MESSAGE_TYPE_INVALID" \
244 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
245 ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
246 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
247 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
248 : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
249 ? "DBUS_MESSAGE_TYPE_ERROR" \
250 : "DBUS_MESSAGE_TYPE_SIGNAL")
252 /* Transform the object to its string representation for debug
254 #define XD_OBJECT_TO_STRING(object) \
255 SDATA (format2 ("%s", object, Qnil))
257 #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
261 DBusAddressEntry **entries; \
264 dbus_error_init (&derror); \
265 if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
268 dbus_error_free (&derror); \
269 dbus_address_entries_free (entries); \
274 CHECK_SYMBOL (bus); \
275 if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
276 XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
277 /* We do not want to have an autolaunch for the session bus. */ \
278 if (EQ (bus, QCdbus_session_bus) \
279 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) \
280 XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
284 #if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
285 || XD_DBUS_VALIDATE_OBJECT || HAVE_DBUS_VALIDATE_MEMBER)
286 #define XD_DBUS_VALIDATE_OBJECT(object, func) \
288 if (!NILP (object)) \
291 CHECK_STRING (object); \
292 dbus_error_init (&derror); \
293 if (!func (SSDATA (object), &derror)) \
296 dbus_error_free (&derror); \
301 #if HAVE_DBUS_VALIDATE_BUS_NAME
302 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
303 XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
305 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
306 if (!NILP (bus_name)) CHECK_STRING (bus_name);
309 #if HAVE_DBUS_VALIDATE_PATH
310 #define XD_DBUS_VALIDATE_PATH(path) \
311 XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
313 #define XD_DBUS_VALIDATE_PATH(path) \
314 if (!NILP (path)) CHECK_STRING (path);
317 #if HAVE_DBUS_VALIDATE_INTERFACE
318 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
319 XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
321 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
322 if (!NILP (interface)) CHECK_STRING (interface);
325 #if HAVE_DBUS_VALIDATE_MEMBER
326 #define XD_DBUS_VALIDATE_MEMBER(member) \
327 XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
329 #define XD_DBUS_VALIDATE_MEMBER(member) \
330 if (!NILP (member)) CHECK_STRING (member);
333 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
334 not become too long. */
336 xd_signature_cat (char *signature
, char const *x
)
338 ptrdiff_t siglen
= strlen (signature
);
339 ptrdiff_t xlen
= strlen (x
);
340 if (DBUS_MAXIMUM_SIGNATURE_LENGTH
- xlen
<= siglen
)
342 strcat (signature
, x
);
345 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
346 used in dbus_message_iter_open_container. DTYPE is the DBusType
347 the object is related to. It is passed as argument, because it
348 cannot be detected in basic type objects, when they are preceded by
349 a type symbol. PARENT_TYPE is the DBusType of a container this
350 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
351 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
353 xd_signature (char *signature
, int dtype
, int parent_type
, Lisp_Object object
)
359 char x
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
366 case DBUS_TYPE_UINT16
:
367 CHECK_NATNUM (object
);
368 sprintf (signature
, "%c", dtype
);
371 case DBUS_TYPE_BOOLEAN
:
372 if (!EQ (object
, Qt
) && !EQ (object
, Qnil
))
373 wrong_type_argument (intern ("booleanp"), object
);
374 sprintf (signature
, "%c", dtype
);
377 case DBUS_TYPE_INT16
:
378 CHECK_NUMBER (object
);
379 sprintf (signature
, "%c", dtype
);
382 case DBUS_TYPE_UINT32
:
383 case DBUS_TYPE_UINT64
:
384 #ifdef DBUS_TYPE_UNIX_FD
385 case DBUS_TYPE_UNIX_FD
:
387 case DBUS_TYPE_INT32
:
388 case DBUS_TYPE_INT64
:
389 case DBUS_TYPE_DOUBLE
:
390 CHECK_NUMBER_OR_FLOAT (object
);
391 sprintf (signature
, "%c", dtype
);
394 case DBUS_TYPE_STRING
:
395 case DBUS_TYPE_OBJECT_PATH
:
396 case DBUS_TYPE_SIGNATURE
:
397 CHECK_STRING (object
);
398 sprintf (signature
, "%c", dtype
);
401 case DBUS_TYPE_ARRAY
:
402 /* Check that all list elements have the same D-Bus type. For
403 complex element types, we just check the container type, not
404 the whole element's signature. */
407 /* Type symbol is optional. */
408 if (EQ (QCdbus_type_array
, CAR_SAFE (elt
)))
409 elt
= XD_NEXT_VALUE (elt
);
411 /* If the array is empty, DBUS_TYPE_STRING is the default
415 subtype
= DBUS_TYPE_STRING
;
416 subsig
= DBUS_TYPE_STRING_AS_STRING
;
420 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
421 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
425 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
426 only element, the value of this element is used as the
427 array's element signature. */
428 if ((subtype
== DBUS_TYPE_SIGNATURE
)
429 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt
)))
430 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
431 subsig
= SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt
)));
435 if (subtype
!= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
)))
436 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt
));
437 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
440 subsiglen
= snprintf (signature
, DBUS_MAXIMUM_SIGNATURE_LENGTH
,
441 "%c%s", dtype
, subsig
);
442 if (! (0 <= subsiglen
&& subsiglen
< DBUS_MAXIMUM_SIGNATURE_LENGTH
))
446 case DBUS_TYPE_VARIANT
:
447 /* Check that there is exactly one list element. */
450 elt
= XD_NEXT_VALUE (elt
);
451 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
452 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
454 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
455 wrong_type_argument (intern ("D-Bus"),
456 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
458 sprintf (signature
, "%c", dtype
);
461 case DBUS_TYPE_STRUCT
:
462 /* A struct list might contain any number of elements with
463 different types. No further check needed. */
466 elt
= XD_NEXT_VALUE (elt
);
468 /* Compose the signature from the elements. It is enclosed by
470 sprintf (signature
, "%c", DBUS_STRUCT_BEGIN_CHAR
);
473 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
474 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
475 xd_signature_cat (signature
, x
);
476 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
478 xd_signature_cat (signature
, DBUS_STRUCT_END_CHAR_AS_STRING
);
481 case DBUS_TYPE_DICT_ENTRY
:
482 /* Check that there are exactly two list elements, and the first
483 one is of basic type. The dictionary entry itself must be an
484 element of an array. */
487 /* Check the parent object type. */
488 if (parent_type
!= DBUS_TYPE_ARRAY
)
489 wrong_type_argument (intern ("D-Bus"), object
);
491 /* Compose the signature from the elements. It is enclosed by
493 sprintf (signature
, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR
);
496 elt
= XD_NEXT_VALUE (elt
);
497 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
498 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
499 xd_signature_cat (signature
, x
);
501 if (!XD_BASIC_DBUS_TYPE (subtype
))
502 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt
)));
504 /* Second element. */
505 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
506 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
507 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
508 xd_signature_cat (signature
, x
);
510 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
511 wrong_type_argument (intern ("D-Bus"),
512 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
514 /* Closing signature. */
515 xd_signature_cat (signature
, DBUS_DICT_ENTRY_END_CHAR_AS_STRING
);
519 wrong_type_argument (intern ("D-Bus"), object
);
522 XD_DEBUG_MESSAGE ("%s", signature
);
525 /* Convert X to a signed integer with bounds LO and HI. */
527 extract_signed (Lisp_Object x
, intmax_t lo
, intmax_t hi
)
529 CHECK_NUMBER_OR_FLOAT (x
);
532 if (lo
<= XINT (x
) && XINT (x
) <= hi
)
537 double d
= XFLOAT_DATA (x
);
538 if (lo
<= d
&& d
<= hi
)
545 if (xd_in_read_queued_messages
)
546 Fthrow (Qdbus_error
, Qnil
);
548 args_out_of_range_3 (x
,
549 make_fixnum_or_float (lo
),
550 make_fixnum_or_float (hi
));
553 /* Convert X to an unsigned integer with bounds 0 and HI. */
555 extract_unsigned (Lisp_Object x
, uintmax_t hi
)
557 CHECK_NUMBER_OR_FLOAT (x
);
560 if (0 <= XINT (x
) && XINT (x
) <= hi
)
565 double d
= XFLOAT_DATA (x
);
566 if (0 <= d
&& d
<= hi
)
573 if (xd_in_read_queued_messages
)
574 Fthrow (Qdbus_error
, Qnil
);
576 args_out_of_range_3 (x
, make_number (0), make_fixnum_or_float (hi
));
579 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
580 DTYPE must be a valid DBusType. It is used to convert Lisp
581 objects, being arguments of `dbus-call-method' or
582 `dbus-send-signal', into corresponding C values appended as
583 arguments to a D-Bus message. */
585 xd_append_arg (int dtype
, Lisp_Object object
, DBusMessageIter
*iter
)
587 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
588 DBusMessageIter subiter
;
590 if (XD_BASIC_DBUS_TYPE (dtype
))
594 CHECK_NATNUM (object
);
596 unsigned char val
= XFASTINT (object
) & 0xFF;
597 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
598 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
599 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
603 case DBUS_TYPE_BOOLEAN
:
605 dbus_bool_t val
= (NILP (object
)) ? FALSE
: TRUE
;
606 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
607 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
608 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
612 case DBUS_TYPE_INT16
:
614 dbus_int16_t val
= extract_signed (object
,
615 TYPE_MINIMUM (dbus_int16_t
),
616 TYPE_MAXIMUM (dbus_int16_t
));
618 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
619 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
620 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
624 case DBUS_TYPE_UINT16
:
626 dbus_uint16_t val
= extract_unsigned (object
,
627 TYPE_MAXIMUM (dbus_uint16_t
));
628 unsigned int pval
= val
;
629 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
630 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
631 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
635 case DBUS_TYPE_INT32
:
637 dbus_int32_t val
= extract_signed (object
,
638 TYPE_MINIMUM (dbus_int32_t
),
639 TYPE_MAXIMUM (dbus_int32_t
));
641 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
642 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
643 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
647 case DBUS_TYPE_UINT32
:
648 #ifdef DBUS_TYPE_UNIX_FD
649 case DBUS_TYPE_UNIX_FD
:
652 dbus_uint32_t val
= extract_unsigned (object
,
653 TYPE_MAXIMUM (dbus_uint32_t
));
654 unsigned int pval
= val
;
655 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
656 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
657 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
661 case DBUS_TYPE_INT64
:
663 dbus_int64_t val
= extract_signed (object
,
664 TYPE_MINIMUM (dbus_int64_t
),
665 TYPE_MAXIMUM (dbus_int64_t
));
666 printmax_t pval
= val
;
667 XD_DEBUG_MESSAGE ("%c %"pMd
, dtype
, pval
);
668 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
669 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
673 case DBUS_TYPE_UINT64
:
675 dbus_uint64_t val
= extract_unsigned (object
,
676 TYPE_MAXIMUM (dbus_uint64_t
));
677 uprintmax_t pval
= val
;
678 XD_DEBUG_MESSAGE ("%c %"pMu
, dtype
, pval
);
679 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
680 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
684 case DBUS_TYPE_DOUBLE
:
686 double val
= extract_float (object
);
687 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
688 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
689 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
693 case DBUS_TYPE_STRING
:
694 case DBUS_TYPE_OBJECT_PATH
:
695 case DBUS_TYPE_SIGNATURE
:
696 CHECK_STRING (object
);
698 /* We need to send a valid UTF-8 string. We could encode `object'
699 but by not encoding it, we guarantee it's valid utf-8, even if
700 it contains eight-bit-bytes. Of course, you can still send
701 manually-crafted junk by passing a unibyte string. */
702 char *val
= SSDATA (object
);
703 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
704 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
705 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
710 else /* Compound types. */
713 /* All compound types except array have a type symbol. For
714 array, it is optional. Skip it. */
715 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))))
716 object
= XD_NEXT_VALUE (object
);
718 /* Open new subiteration. */
721 case DBUS_TYPE_ARRAY
:
722 /* An array has only elements of the same type. So it is
723 sufficient to check the first element's signature
727 /* If the array is empty, DBUS_TYPE_STRING is the default
729 strcpy (signature
, DBUS_TYPE_STRING_AS_STRING
);
732 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
733 the only element, the value of this element is used as
734 the array's element signature. */
735 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))
736 == DBUS_TYPE_SIGNATURE
)
737 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object
)))
738 && NILP (CDR_SAFE (XD_NEXT_VALUE (object
))))
740 strcpy (signature
, SSDATA (CAR_SAFE (XD_NEXT_VALUE (object
))));
741 object
= CDR_SAFE (XD_NEXT_VALUE (object
));
745 xd_signature (signature
,
746 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
747 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
749 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
750 XD_OBJECT_TO_STRING (object
));
751 if (!dbus_message_iter_open_container (iter
, dtype
,
752 signature
, &subiter
))
753 XD_SIGNAL3 (build_string ("Cannot open container"),
754 make_number (dtype
), build_string (signature
));
757 case DBUS_TYPE_VARIANT
:
758 /* A variant has just one element. */
759 xd_signature (signature
, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
760 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
762 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
763 XD_OBJECT_TO_STRING (object
));
764 if (!dbus_message_iter_open_container (iter
, dtype
,
765 signature
, &subiter
))
766 XD_SIGNAL3 (build_string ("Cannot open container"),
767 make_number (dtype
), build_string (signature
));
770 case DBUS_TYPE_STRUCT
:
771 case DBUS_TYPE_DICT_ENTRY
:
772 /* These containers do not require a signature. */
773 XD_DEBUG_MESSAGE ("%c %s", dtype
, XD_OBJECT_TO_STRING (object
));
774 if (!dbus_message_iter_open_container (iter
, dtype
, NULL
, &subiter
))
775 XD_SIGNAL2 (build_string ("Cannot open container"),
776 make_number (dtype
));
780 /* Loop over list elements. */
781 while (!NILP (object
))
783 dtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
));
784 object
= XD_NEXT_VALUE (object
);
786 xd_append_arg (dtype
, CAR_SAFE (object
), &subiter
);
788 object
= CDR_SAFE (object
);
791 /* Close the subiteration. */
792 if (!dbus_message_iter_close_container (iter
, &subiter
))
793 XD_SIGNAL2 (build_string ("Cannot close container"),
794 make_number (dtype
));
798 /* Retrieve C value from a DBusMessageIter structure ITER, and return
799 a converted Lisp object. The type DTYPE of the argument of the
800 D-Bus message must be a valid DBusType. Compound D-Bus types
801 result always in a Lisp list. */
803 xd_retrieve_arg (int dtype
, DBusMessageIter
*iter
)
811 dbus_message_iter_get_basic (iter
, &val
);
813 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
814 return make_number (val
);
817 case DBUS_TYPE_BOOLEAN
:
820 dbus_message_iter_get_basic (iter
, &val
);
821 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
822 return (val
== FALSE
) ? Qnil
: Qt
;
825 case DBUS_TYPE_INT16
:
829 dbus_message_iter_get_basic (iter
, &val
);
831 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
832 return make_number (val
);
835 case DBUS_TYPE_UINT16
:
839 dbus_message_iter_get_basic (iter
, &val
);
841 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
842 return make_number (val
);
845 case DBUS_TYPE_INT32
:
849 dbus_message_iter_get_basic (iter
, &val
);
851 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
852 return make_fixnum_or_float (val
);
855 case DBUS_TYPE_UINT32
:
856 #ifdef DBUS_TYPE_UNIX_FD
857 case DBUS_TYPE_UNIX_FD
:
861 unsigned int pval
= val
;
862 dbus_message_iter_get_basic (iter
, &val
);
864 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
865 return make_fixnum_or_float (val
);
868 case DBUS_TYPE_INT64
:
872 dbus_message_iter_get_basic (iter
, &val
);
874 XD_DEBUG_MESSAGE ("%c %"pMd
, dtype
, pval
);
875 return make_fixnum_or_float (val
);
878 case DBUS_TYPE_UINT64
:
882 dbus_message_iter_get_basic (iter
, &val
);
884 XD_DEBUG_MESSAGE ("%c %"pMd
, dtype
, pval
);
885 return make_fixnum_or_float (val
);
888 case DBUS_TYPE_DOUBLE
:
891 dbus_message_iter_get_basic (iter
, &val
);
892 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
893 return make_float (val
);
896 case DBUS_TYPE_STRING
:
897 case DBUS_TYPE_OBJECT_PATH
:
898 case DBUS_TYPE_SIGNATURE
:
901 dbus_message_iter_get_basic (iter
, &val
);
902 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
903 return build_string (val
);
906 case DBUS_TYPE_ARRAY
:
907 case DBUS_TYPE_VARIANT
:
908 case DBUS_TYPE_STRUCT
:
909 case DBUS_TYPE_DICT_ENTRY
:
913 DBusMessageIter subiter
;
917 dbus_message_iter_recurse (iter
, &subiter
);
918 while ((subtype
= dbus_message_iter_get_arg_type (&subiter
))
919 != DBUS_TYPE_INVALID
)
921 result
= Fcons (xd_retrieve_arg (subtype
, &subiter
), result
);
922 dbus_message_iter_next (&subiter
);
924 XD_DEBUG_MESSAGE ("%c %s", dtype
, XD_OBJECT_TO_STRING (result
));
925 RETURN_UNGCPRO (Fnreverse (result
));
929 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype
);
934 /* Return the number of references of the shared CONNECTION. */
936 xd_get_connection_references (DBusConnection
*connection
)
940 /* We cannot access the DBusConnection structure, it is not public.
941 But we know, that the reference counter is the first field in
943 refcount
= (void *) &connection
;
944 refcount
= (void *) *refcount
;
948 /* Return D-Bus connection address. BUS is either a Lisp symbol,
949 :system or :session, or a string denoting the bus address. */
950 static DBusConnection
*
951 xd_get_connection_address (Lisp_Object bus
)
953 DBusConnection
*connection
;
956 val
= CDR_SAFE (Fassoc (bus
, xd_registered_buses
));
958 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
960 connection
= (DBusConnection
*) (intptr_t) XFASTINT (val
);
962 if (!dbus_connection_get_is_connected (connection
))
963 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
968 /* Return the file descriptor for WATCH, -1 if not found. */
970 xd_find_watch_fd (DBusWatch
*watch
)
972 #if HAVE_DBUS_WATCH_GET_UNIX_FD
973 /* TODO: Reverse these on Win32, which prefers the opposite. */
974 int fd
= dbus_watch_get_unix_fd (watch
);
976 fd
= dbus_watch_get_socket (watch
);
978 int fd
= dbus_watch_get_fd (watch
);
985 xd_read_queued_messages (int fd
, void *data
, int for_read
);
987 /* Start monitoring WATCH for possible I/O. */
989 xd_add_watch (DBusWatch
*watch
, void *data
)
991 unsigned int flags
= dbus_watch_get_flags (watch
);
992 int fd
= xd_find_watch_fd (watch
);
994 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
995 fd
, flags
& DBUS_WATCH_WRITABLE
,
996 dbus_watch_get_enabled (watch
));
1001 if (dbus_watch_get_enabled (watch
))
1003 if (flags
& DBUS_WATCH_WRITABLE
)
1004 add_write_fd (fd
, xd_read_queued_messages
, data
);
1005 if (flags
& DBUS_WATCH_READABLE
)
1006 add_read_fd (fd
, xd_read_queued_messages
, data
);
1011 /* Stop monitoring WATCH for possible I/O.
1012 DATA is the used bus, either a string or QCdbus_system_bus or
1013 QCdbus_session_bus. */
1015 xd_remove_watch (DBusWatch
*watch
, void *data
)
1017 unsigned int flags
= dbus_watch_get_flags (watch
);
1018 int fd
= xd_find_watch_fd (watch
);
1020 XD_DEBUG_MESSAGE ("fd %d", fd
);
1025 /* Unset session environment. */
1026 if (XSYMBOL (QCdbus_session_bus
) == data
)
1028 // XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
1029 // unsetenv ("DBUS_SESSION_BUS_ADDRESS");
1032 if (flags
& DBUS_WATCH_WRITABLE
)
1033 delete_write_fd (fd
);
1034 if (flags
& DBUS_WATCH_READABLE
)
1035 delete_read_fd (fd
);
1038 /* Toggle monitoring WATCH for possible I/O. */
1040 xd_toggle_watch (DBusWatch
*watch
, void *data
)
1042 if (dbus_watch_get_enabled (watch
))
1043 xd_add_watch (watch
, data
);
1045 xd_remove_watch (watch
, data
);
1048 /* Close connection to D-Bus BUS. */
1050 xd_close_bus (Lisp_Object bus
)
1052 DBusConnection
*connection
;
1055 /* Check whether we are connected. */
1056 val
= Fassoc (bus
, xd_registered_buses
);
1060 /* Retrieve bus address. */
1061 connection
= xd_get_connection_address (bus
);
1063 /* Close connection, if there isn't another shared application. */
1064 if (xd_get_connection_references (connection
) == 1)
1066 XD_DEBUG_MESSAGE ("Close connection to bus %s",
1067 XD_OBJECT_TO_STRING (bus
));
1068 dbus_connection_close (connection
);
1071 /* Decrement reference count. */
1072 dbus_connection_unref (connection
);
1074 /* Remove bus from list of registered buses. */
1075 xd_registered_buses
= Fdelete (val
, xd_registered_buses
);
1081 DEFUN ("dbus-init-bus", Fdbus_init_bus
, Sdbus_init_bus
, 1, 2, 0,
1082 doc
: /* Establish the connection to D-Bus BUS.
1084 BUS can be either the symbol `:system' or the symbol `:session', or it
1085 can be a string denoting the address of the corresponding bus. For
1086 the system and session buses, this function is called when loading
1087 `dbus.el', there is no need to call it again.
1089 The function returns a number, which counts the connections this Emacs
1090 session has established to the BUS under the same unique name (see
1091 `dbus-get-unique-name'). It depends on the libraries Emacs is linked
1092 with, and on the environment Emacs is running. For example, if Emacs
1093 is linked with the gtk toolkit, and it runs in a GTK-aware environment
1094 like Gnome, another connection might already be established.
1096 When PRIVATE is non-nil, a new connection is established instead of
1097 reusing an existing one. It results in a new unique name at the bus.
1098 This can be used, if it is necessary to distinguish from another
1099 connection used in the same Emacs process, like the one established by
1100 GTK+. It should be used with care for at least the `:system' and
1101 `:session' buses, because other Emacs Lisp packages might already use
1102 this connection to those buses. */)
1103 (Lisp_Object bus
, Lisp_Object
private)
1105 DBusConnection
*connection
;
1110 /* Check parameter. */
1111 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1113 /* Close bus if it is already open. */
1117 dbus_error_init (&derror
);
1119 /* Open the connection. */
1122 connection
= dbus_connection_open (SSDATA (bus
), &derror
);
1124 connection
= dbus_connection_open_private (SSDATA (bus
), &derror
);
1128 connection
= dbus_bus_get (EQ (bus
, QCdbus_system_bus
)
1129 ? DBUS_BUS_SYSTEM
: DBUS_BUS_SESSION
,
1132 connection
= dbus_bus_get_private (EQ (bus
, QCdbus_system_bus
)
1133 ? DBUS_BUS_SYSTEM
: DBUS_BUS_SESSION
,
1136 if (dbus_error_is_set (&derror
))
1139 if (connection
== NULL
)
1140 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
1142 /* If it is not the system or session bus, we must register
1143 ourselves. Otherwise, we have called dbus_bus_get, which has
1144 configured us to exit if the connection closes - we undo this
1147 dbus_bus_register (connection
, &derror
);
1149 dbus_connection_set_exit_on_disconnect (connection
, FALSE
);
1151 if (dbus_error_is_set (&derror
))
1154 /* Add the watch functions. We pass also the bus as data, in order
1155 to distinguish between the buses in xd_remove_watch. */
1156 if (!dbus_connection_set_watch_functions (connection
,
1161 ? (void *) XSYMBOL (bus
)
1162 : (void *) XSTRING (bus
),
1164 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
1166 /* Add bus to list of registered buses. */
1167 XSETFASTINT (val
, (intptr_t) connection
);
1168 xd_registered_buses
= Fcons (Fcons (bus
, val
), xd_registered_buses
);
1170 /* We do not want to abort. */
1171 putenv ((char *) "DBUS_FATAL_WARNINGS=0");
1174 dbus_error_free (&derror
);
1176 /* Return reference counter. */
1177 refcount
= xd_get_connection_references (connection
);
1178 XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD
"d",
1179 XD_OBJECT_TO_STRING (bus
), refcount
);
1180 return make_number (refcount
);
1183 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name
, Sdbus_get_unique_name
,
1185 doc
: /* Return the unique name of Emacs registered at D-Bus BUS. */)
1188 DBusConnection
*connection
;
1191 /* Check parameter. */
1192 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1194 /* Retrieve bus address. */
1195 connection
= xd_get_connection_address (bus
);
1197 /* Request the name. */
1198 name
= dbus_bus_get_unique_name (connection
);
1200 XD_SIGNAL1 (build_string ("No unique name available"));
1203 return build_string (name
);
1206 DEFUN ("dbus-message-internal", Fdbus_message_internal
, Sdbus_message_internal
,
1208 doc
: /* Send a D-Bus message.
1209 This is an internal function, it shall not be used outside dbus.el.
1211 The following usages are expected:
1213 `dbus-call-method', `dbus-call-method-asynchronously':
1214 \(dbus-message-internal
1215 dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1216 &optional :timeout TIMEOUT &rest ARGS)
1219 \(dbus-message-internal
1220 dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1222 `dbus-method-return-internal':
1223 \(dbus-message-internal
1224 dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1226 `dbus-method-error-internal':
1227 \(dbus-message-internal
1228 dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1230 usage: (dbus-message-internal &rest REST) */)
1231 (ptrdiff_t nargs
, Lisp_Object
*args
)
1233 Lisp_Object message_type
, bus
, service
, handler
;
1234 Lisp_Object path
= Qnil
;
1235 Lisp_Object interface
= Qnil
;
1236 Lisp_Object member
= Qnil
;
1238 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1239 DBusConnection
*connection
;
1240 DBusMessage
*dmessage
;
1241 DBusMessageIter iter
;
1244 dbus_uint32_t serial
= 0;
1245 unsigned int ui_serial
;
1248 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1250 /* Initialize parameters. */
1251 message_type
= args
[0];
1256 CHECK_NATNUM (message_type
);
1257 if (! (DBUS_MESSAGE_TYPE_INVALID
< XFASTINT (message_type
)
1258 && XFASTINT (message_type
) < DBUS_NUM_MESSAGE_TYPES
))
1259 XD_SIGNAL2 (build_string ("Invalid message type"), message_type
);
1260 mtype
= XFASTINT (message_type
);
1262 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1263 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1266 interface
= args
[4];
1268 if (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1270 count
= (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
) ? 7 : 6;
1272 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1274 serial
= extract_unsigned (args
[3], TYPE_MAXIMUM (dbus_uint32_t
));
1278 /* Check parameters. */
1279 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1280 XD_DBUS_VALIDATE_BUS_NAME (service
);
1282 xsignal2 (Qwrong_number_of_arguments
,
1283 Qdbus_message_internal
,
1284 make_number (nargs
));
1286 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1287 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1289 XD_DBUS_VALIDATE_PATH (path
);
1290 XD_DBUS_VALIDATE_INTERFACE (interface
);
1291 XD_DBUS_VALIDATE_MEMBER (member
);
1292 if (!NILP (handler
) && (!FUNCTIONP (handler
)))
1293 wrong_type_argument (Qinvalid_function
, handler
);
1296 /* Protect Lisp variables. */
1297 GCPRO6 (bus
, service
, path
, interface
, member
, handler
);
1299 /* Trace parameters. */
1302 case DBUS_MESSAGE_TYPE_METHOD_CALL
:
1303 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1304 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1305 XD_OBJECT_TO_STRING (bus
),
1306 XD_OBJECT_TO_STRING (service
),
1307 XD_OBJECT_TO_STRING (path
),
1308 XD_OBJECT_TO_STRING (interface
),
1309 XD_OBJECT_TO_STRING (member
),
1310 XD_OBJECT_TO_STRING (handler
));
1312 case DBUS_MESSAGE_TYPE_SIGNAL
:
1313 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1314 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1315 XD_OBJECT_TO_STRING (bus
),
1316 XD_OBJECT_TO_STRING (service
),
1317 XD_OBJECT_TO_STRING (path
),
1318 XD_OBJECT_TO_STRING (interface
),
1319 XD_OBJECT_TO_STRING (member
));
1321 default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1323 XD_DEBUG_MESSAGE ("%s %s %s %u",
1324 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1325 XD_OBJECT_TO_STRING (bus
),
1326 XD_OBJECT_TO_STRING (service
),
1330 /* Retrieve bus address. */
1331 connection
= xd_get_connection_address (bus
);
1333 /* Create the D-Bus message. */
1334 dmessage
= dbus_message_new (mtype
);
1335 if (dmessage
== NULL
)
1338 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1341 if (STRINGP (service
))
1343 if (mtype
!= DBUS_MESSAGE_TYPE_SIGNAL
)
1344 /* Set destination. */
1346 if (!dbus_message_set_destination (dmessage
, SSDATA (service
)))
1349 XD_SIGNAL2 (build_string ("Unable to set the destination"),
1355 /* Set destination for unicast signals. */
1359 /* If it is the same unique name as we are registered at the
1360 bus or an unknown name, we regard it as broadcast message
1361 due to backward compatibility. */
1362 if (dbus_bus_name_has_owner (connection
, SSDATA (service
), NULL
))
1363 uname
= call2 (intern ("dbus-get-name-owner"), bus
, service
);
1368 && (strcmp (dbus_bus_get_unique_name (connection
), SSDATA (uname
))
1370 && (!dbus_message_set_destination (dmessage
, SSDATA (service
))))
1373 XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1379 /* Set message parameters. */
1380 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1381 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1383 if ((!dbus_message_set_path (dmessage
, SSDATA (path
)))
1384 || (!dbus_message_set_interface (dmessage
, SSDATA (interface
)))
1385 || (!dbus_message_set_member (dmessage
, SSDATA (member
))))
1388 XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1392 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1394 if (!dbus_message_set_reply_serial (dmessage
, serial
))
1397 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1400 if ((mtype
== DBUS_MESSAGE_TYPE_ERROR
)
1401 && (!dbus_message_set_error_name (dmessage
, DBUS_ERROR_FAILED
)))
1404 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1408 /* Check for timeout parameter. */
1409 if ((count
+2 <= nargs
) && (EQ ((args
[count
]), QCdbus_timeout
)))
1411 CHECK_NATNUM (args
[count
+1]);
1412 timeout
= min (XFASTINT (args
[count
+1]), INT_MAX
);
1416 /* Initialize parameter list of message. */
1417 dbus_message_iter_init_append (dmessage
, &iter
);
1419 /* Append parameters to the message. */
1420 for (; count
< nargs
; ++count
)
1422 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[count
]);
1423 if (XD_DBUS_TYPE_P (args
[count
]))
1425 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
]);
1426 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
+1]);
1427 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s %s", count
- 4,
1428 XD_OBJECT_TO_STRING (args
[count
]),
1429 XD_OBJECT_TO_STRING (args
[count
+1]));
1434 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
]);
1435 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s", count
- 4,
1436 XD_OBJECT_TO_STRING (args
[count
]));
1439 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1440 indication that there is no parent type. */
1441 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[count
]);
1443 xd_append_arg (dtype
, args
[count
], &iter
);
1446 if (!NILP (handler
))
1448 /* Send the message. The message is just added to the outgoing
1450 if (!dbus_connection_send_with_reply (connection
, dmessage
,
1454 XD_SIGNAL1 (build_string ("Cannot send message"));
1457 /* The result is the key in Vdbus_registered_objects_table. */
1458 serial
= dbus_message_get_serial (dmessage
);
1459 result
= list3 (QCdbus_registered_serial
,
1460 bus
, make_fixnum_or_float (serial
));
1462 /* Create a hash table entry. */
1463 Fputhash (result
, handler
, Vdbus_registered_objects_table
);
1467 /* Send the message. The message is just added to the outgoing
1469 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1472 XD_SIGNAL1 (build_string ("Cannot send message"));
1478 XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result
));
1481 dbus_message_unref (dmessage
);
1483 /* Return the result. */
1484 RETURN_UNGCPRO (result
);
1487 /* Read one queued incoming message of the D-Bus BUS.
1488 BUS is either a Lisp symbol, :system or :session, or a string denoting
1491 xd_read_message_1 (DBusConnection
*connection
, Lisp_Object bus
)
1493 Lisp_Object args
, key
, value
;
1494 struct gcpro gcpro1
;
1495 struct input_event event
;
1496 DBusMessage
*dmessage
;
1497 DBusMessageIter iter
;
1500 dbus_uint32_t serial
;
1501 unsigned int ui_serial
;
1502 const char *uname
, *path
, *interface
, *member
;
1504 dmessage
= dbus_connection_pop_message (connection
);
1506 /* Return if there is no queued message. */
1507 if (dmessage
== NULL
)
1510 /* Collect the parameters. */
1514 /* Loop over the resulting parameters. Construct a list. */
1515 if (dbus_message_iter_init (dmessage
, &iter
))
1517 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
1518 != DBUS_TYPE_INVALID
)
1520 args
= Fcons (xd_retrieve_arg (dtype
, &iter
), args
);
1521 dbus_message_iter_next (&iter
);
1523 /* The arguments are stored in reverse order. Reorder them. */
1524 args
= Fnreverse (args
);
1527 /* Read message type, message serial, unique name, object path,
1528 interface and member from the message. */
1529 mtype
= dbus_message_get_type (dmessage
);
1530 ui_serial
= serial
=
1531 ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1532 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1533 ? dbus_message_get_reply_serial (dmessage
)
1534 : dbus_message_get_serial (dmessage
);
1535 uname
= dbus_message_get_sender (dmessage
);
1536 path
= dbus_message_get_path (dmessage
);
1537 interface
= dbus_message_get_interface (dmessage
);
1538 member
= dbus_message_get_member (dmessage
);
1540 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1541 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1542 ui_serial
, uname
, path
, interface
, member
,
1543 XD_OBJECT_TO_STRING (args
));
1545 if (mtype
== DBUS_MESSAGE_TYPE_INVALID
)
1548 else if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1549 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1551 /* Search for a registered function of the message. */
1552 key
= list3 (QCdbus_registered_serial
, bus
,
1553 make_fixnum_or_float (serial
));
1554 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1556 /* There shall be exactly one entry. Construct an event. */
1560 /* Remove the entry. */
1561 Fremhash (key
, Vdbus_registered_objects_table
);
1563 /* Construct an event. */
1565 event
.kind
= DBUS_EVENT
;
1566 event
.frame_or_window
= Qnil
;
1567 event
.arg
= Fcons (value
, args
);
1570 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
1572 /* Vdbus_registered_objects_table requires non-nil interface and
1574 if ((interface
== NULL
) || (member
== NULL
))
1577 /* Search for a registered function of the message. */
1578 key
= list4 ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1579 ? QCdbus_registered_method
1580 : QCdbus_registered_signal
,
1581 bus
, build_string (interface
), build_string (member
));
1582 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1584 /* Loop over the registered functions. Construct an event. */
1585 while (!NILP (value
))
1587 key
= CAR_SAFE (value
);
1588 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1589 if (((uname
== NULL
)
1590 || (NILP (CAR_SAFE (key
)))
1591 || (strcmp (uname
, SSDATA (CAR_SAFE (key
))) == 0))
1593 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1595 SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1597 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))))
1600 event
.kind
= DBUS_EVENT
;
1601 event
.frame_or_window
= Qnil
;
1603 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))), args
);
1606 value
= CDR_SAFE (value
);
1613 /* Add type, serial, uname, path, interface and member to the event. */
1614 event
.arg
= Fcons ((member
== NULL
? Qnil
: build_string (member
)),
1616 event
.arg
= Fcons ((interface
== NULL
? Qnil
: build_string (interface
)),
1618 event
.arg
= Fcons ((path
== NULL
? Qnil
: build_string (path
)),
1620 event
.arg
= Fcons ((uname
== NULL
? Qnil
: build_string (uname
)),
1622 event
.arg
= Fcons (make_fixnum_or_float (serial
), event
.arg
);
1623 event
.arg
= Fcons (make_number (mtype
), event
.arg
);
1625 /* Add the bus symbol to the event. */
1626 event
.arg
= Fcons (bus
, event
.arg
);
1628 /* Store it into the input event queue. */
1629 kbd_buffer_store_event (&event
);
1631 XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event
.arg
));
1635 dbus_message_unref (dmessage
);
1640 /* Read queued incoming messages of the D-Bus BUS.
1641 BUS is either a Lisp symbol, :system or :session, or a string denoting
1644 xd_read_message (Lisp_Object bus
)
1646 /* Retrieve bus address. */
1647 DBusConnection
*connection
= xd_get_connection_address (bus
);
1649 /* Non blocking read of the next available message. */
1650 dbus_connection_read_write (connection
, 0);
1652 while (dbus_connection_get_dispatch_status (connection
)
1653 != DBUS_DISPATCH_COMPLETE
)
1654 xd_read_message_1 (connection
, bus
);
1658 /* Callback called when something is ready to read or write. */
1660 xd_read_queued_messages (int fd
, void *data
, int for_read
)
1662 Lisp_Object busp
= xd_registered_buses
;
1663 Lisp_Object bus
= Qnil
;
1666 /* Find bus related to fd. */
1668 while (!NILP (busp
))
1670 key
= CAR_SAFE (CAR_SAFE (busp
));
1671 if ((SYMBOLP (key
) && XSYMBOL (key
) == data
)
1672 || (STRINGP (key
) && XSTRING (key
) == data
))
1674 busp
= CDR_SAFE (busp
);
1680 /* We ignore all Lisp errors during the call. */
1681 xd_in_read_queued_messages
= 1;
1682 internal_catch (Qdbus_error
, xd_read_message
, bus
);
1683 xd_in_read_queued_messages
= 0;
1688 syms_of_dbusbind (void)
1691 DEFSYM (Qdbus_init_bus
, "dbus-init-bus");
1692 defsubr (&Sdbus_init_bus
);
1694 DEFSYM (Qdbus_get_unique_name
, "dbus-get-unique-name");
1695 defsubr (&Sdbus_get_unique_name
);
1697 DEFSYM (Qdbus_message_internal
, "dbus-message-internal");
1698 defsubr (&Sdbus_message_internal
);
1700 DEFSYM (Qdbus_error
, "dbus-error");
1701 Fput (Qdbus_error
, Qerror_conditions
,
1702 list2 (Qdbus_error
, Qerror
));
1703 Fput (Qdbus_error
, Qerror_message
,
1704 make_pure_c_string ("D-Bus error"));
1706 DEFSYM (QCdbus_system_bus
, ":system");
1707 DEFSYM (QCdbus_session_bus
, ":session");
1708 DEFSYM (QCdbus_timeout
, ":timeout");
1709 DEFSYM (QCdbus_type_byte
, ":byte");
1710 DEFSYM (QCdbus_type_boolean
, ":boolean");
1711 DEFSYM (QCdbus_type_int16
, ":int16");
1712 DEFSYM (QCdbus_type_uint16
, ":uint16");
1713 DEFSYM (QCdbus_type_int32
, ":int32");
1714 DEFSYM (QCdbus_type_uint32
, ":uint32");
1715 DEFSYM (QCdbus_type_int64
, ":int64");
1716 DEFSYM (QCdbus_type_uint64
, ":uint64");
1717 DEFSYM (QCdbus_type_double
, ":double");
1718 DEFSYM (QCdbus_type_string
, ":string");
1719 DEFSYM (QCdbus_type_object_path
, ":object-path");
1720 DEFSYM (QCdbus_type_signature
, ":signature");
1721 #ifdef DBUS_TYPE_UNIX_FD
1722 DEFSYM (QCdbus_type_unix_fd
, ":unix-fd");
1724 DEFSYM (QCdbus_type_array
, ":array");
1725 DEFSYM (QCdbus_type_variant
, ":variant");
1726 DEFSYM (QCdbus_type_struct
, ":struct");
1727 DEFSYM (QCdbus_type_dict_entry
, ":dict-entry");
1728 DEFSYM (QCdbus_registered_serial
, ":serial");
1729 DEFSYM (QCdbus_registered_method
, ":method");
1730 DEFSYM (QCdbus_registered_signal
, ":signal");
1732 DEFVAR_LISP ("dbus-compiled-version",
1733 Vdbus_compiled_version
,
1734 doc
: /* The version of D-Bus Emacs is compiled against. */);
1735 #ifdef DBUS_VERSION_STRING
1736 Vdbus_compiled_version
= make_pure_c_string (DBUS_VERSION_STRING
);
1738 Vdbus_compiled_version
= Qnil
;
1741 DEFVAR_LISP ("dbus-runtime-version",
1742 Vdbus_runtime_version
,
1743 doc
: /* The version of D-Bus Emacs runs with. */);
1746 int major
, minor
, micro
;
1747 char s
[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
1748 dbus_get_version (&major
, &minor
, µ
);
1749 sprintf (s
, "%d.%d.%d", major
, minor
, micro
);
1750 Vdbus_runtime_version
= build_string (s
);
1752 Vdbus_runtime_version
= Qnil
;
1756 DEFVAR_LISP ("dbus-message-type-invalid",
1757 Vdbus_message_type_invalid
,
1758 doc
: /* This value is never a valid message type. */);
1759 Vdbus_message_type_invalid
= make_number (DBUS_MESSAGE_TYPE_INVALID
);
1761 DEFVAR_LISP ("dbus-message-type-method-call",
1762 Vdbus_message_type_method_call
,
1763 doc
: /* Message type of a method call message. */);
1764 Vdbus_message_type_method_call
= make_number (DBUS_MESSAGE_TYPE_METHOD_CALL
);
1766 DEFVAR_LISP ("dbus-message-type-method-return",
1767 Vdbus_message_type_method_return
,
1768 doc
: /* Message type of a method return message. */);
1769 Vdbus_message_type_method_return
1770 = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN
);
1772 DEFVAR_LISP ("dbus-message-type-error",
1773 Vdbus_message_type_error
,
1774 doc
: /* Message type of an error reply message. */);
1775 Vdbus_message_type_error
= make_number (DBUS_MESSAGE_TYPE_ERROR
);
1777 DEFVAR_LISP ("dbus-message-type-signal",
1778 Vdbus_message_type_signal
,
1779 doc
: /* Message type of a signal message. */);
1780 Vdbus_message_type_signal
= make_number (DBUS_MESSAGE_TYPE_SIGNAL
);
1782 DEFVAR_LISP ("dbus-registered-objects-table",
1783 Vdbus_registered_objects_table
,
1784 doc
: /* Hash table of registered functions for D-Bus.
1786 There are two different uses of the hash table: for accessing
1787 registered interfaces properties, targeted by signals or method calls,
1788 and for calling handlers in case of non-blocking method call returns.
1790 In the first case, the key in the hash table is the list (TYPE BUS
1791 INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
1792 `:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
1793 `:session', or a string denoting the bus address. INTERFACE is a
1794 string which denotes a D-Bus interface, and MEMBER, also a string, is
1795 either a method, a signal or a property INTERFACE is offering. All
1796 arguments but BUS must not be nil.
1798 The value in the hash table is a list of quadruple lists \((UNAME
1799 SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
1800 registered, UNAME is the corresponding unique name. In case of
1801 registered methods and properties, UNAME is nil. PATH is the object
1802 path of the sending object. All of them can be nil, which means a
1803 wildcard then. OBJECT is either the handler to be called when a D-Bus
1804 message, which matches the key criteria, arrives (TYPE `:method' and
1805 `:signal'), or a cons cell containing the value of the property (TYPE
1808 For entries of type `:signal', there is also a fifth element RULE,
1809 which keeps the match string the signal is registered with.
1811 In the second case, the key in the hash table is the list (:serial BUS
1812 SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
1813 string denoting the bus address. SERIAL is the serial number of the
1814 non-blocking method call, a reply is expected. Both arguments must
1815 not be nil. The value in the hash table is HANDLER, the function to
1816 be called when the D-Bus reply message arrives. */);
1818 Lisp_Object args
[2];
1821 Vdbus_registered_objects_table
= Fmake_hash_table (2, args
);
1824 DEFVAR_LISP ("dbus-debug", Vdbus_debug
,
1825 doc
: /* If non-nil, debug messages of D-Bus bindings are raised. */);
1828 /* We can also set environment variable DBUS_VERBOSE=1 in order to
1829 see more traces. This requires libdbus-1 to be configured with
1830 --enable-verbose-mode. */
1835 /* Initialize internal objects. */
1836 xd_registered_buses
= Qnil
;
1837 staticpro (&xd_registered_buses
);
1839 Fprovide (intern_c_string ("dbusbind"), Qnil
);
1843 #endif /* HAVE_DBUS */