1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007-2018 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 (at
9 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 <https://www.gnu.org/licenses/>. */
24 #include <dbus/dbus.h>
27 #include "termhooks.h"
31 #ifndef DBUS_NUM_MESSAGE_TYPES
32 #define DBUS_NUM_MESSAGE_TYPES 5
36 /* Some platforms define the symbol "interface", but we want to use it
37 * as a variable name below. */
44 /* Alist of D-Bus buses we are polling for messages.
45 The key is the symbol or string of the bus, and the value is the
46 connection address. */
47 static Lisp_Object xd_registered_buses
;
49 /* Whether we are reading a D-Bus event. */
50 static bool xd_in_read_queued_messages
= 0;
53 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
54 we don't want to poison other namespaces with "dbus_". */
56 /* Raise a signal. If we are reading events, we cannot signal; we
57 throw to xd_read_queued_messages then. */
58 #define XD_SIGNAL1(arg) \
60 if (xd_in_read_queued_messages) \
61 Fthrow (Qdbus_error, Qnil); \
63 xsignal1 (Qdbus_error, arg); \
66 #define XD_SIGNAL2(arg1, arg2) \
68 if (xd_in_read_queued_messages) \
69 Fthrow (Qdbus_error, Qnil); \
71 xsignal2 (Qdbus_error, arg1, arg2); \
74 #define XD_SIGNAL3(arg1, arg2, arg3) \
76 if (xd_in_read_queued_messages) \
77 Fthrow (Qdbus_error, Qnil); \
79 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
82 /* Raise a Lisp error from a D-Bus ERROR. */
83 #define XD_ERROR(error) \
85 /* Remove the trailing newline. */ \
86 char const *mess = error.message; \
87 char const *nl = strchr (mess, '\n'); \
88 Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
89 dbus_error_free (&error); \
93 /* Macros for debugging. In order to enable them, build with
94 "make MYCPPFLAGS='-DDBUS_DEBUG'". */
96 #define XD_DEBUG_MESSAGE(...) \
99 snprintf (s, sizeof s, __VA_ARGS__); \
100 if (!noninteractive) \
101 printf ("%s: %s\n", __func__, s); \
102 message ("%s: %s", __func__, s); \
104 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
106 if (!valid_lisp_object_p (object)) \
108 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
109 XD_SIGNAL1 (build_string ("Assertion failure")); \
113 #else /* !DBUS_DEBUG */
114 # define XD_DEBUG_MESSAGE(...) \
116 if (!NILP (Vdbus_debug)) \
119 snprintf (s, sizeof s, __VA_ARGS__); \
120 message ("%s: %s", __func__, s); \
123 # define XD_DEBUG_VALID_LISP_OBJECT_P(object)
126 /* Check whether TYPE is a basic DBusType. */
127 #ifdef HAVE_DBUS_TYPE_IS_VALID
128 #define XD_BASIC_DBUS_TYPE(type) \
129 (dbus_type_is_valid (type) && dbus_type_is_basic (type))
131 #ifdef DBUS_TYPE_UNIX_FD
132 #define XD_BASIC_DBUS_TYPE(type) \
133 ((type == DBUS_TYPE_BYTE) \
134 || (type == DBUS_TYPE_BOOLEAN) \
135 || (type == DBUS_TYPE_INT16) \
136 || (type == DBUS_TYPE_UINT16) \
137 || (type == DBUS_TYPE_INT32) \
138 || (type == DBUS_TYPE_UINT32) \
139 || (type == DBUS_TYPE_INT64) \
140 || (type == DBUS_TYPE_UINT64) \
141 || (type == DBUS_TYPE_DOUBLE) \
142 || (type == DBUS_TYPE_STRING) \
143 || (type == DBUS_TYPE_OBJECT_PATH) \
144 || (type == DBUS_TYPE_SIGNATURE) \
145 || (type == DBUS_TYPE_UNIX_FD))
147 #define XD_BASIC_DBUS_TYPE(type) \
148 ((type == DBUS_TYPE_BYTE) \
149 || (type == DBUS_TYPE_BOOLEAN) \
150 || (type == DBUS_TYPE_INT16) \
151 || (type == DBUS_TYPE_UINT16) \
152 || (type == DBUS_TYPE_INT32) \
153 || (type == DBUS_TYPE_UINT32) \
154 || (type == DBUS_TYPE_INT64) \
155 || (type == DBUS_TYPE_UINT64) \
156 || (type == DBUS_TYPE_DOUBLE) \
157 || (type == DBUS_TYPE_STRING) \
158 || (type == DBUS_TYPE_OBJECT_PATH) \
159 || (type == DBUS_TYPE_SIGNATURE))
163 /* This was a macro. On Solaris 2.11 it was said to compile for
164 hours, when optimization is enabled. So we have transferred it into
166 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
167 of the predefined D-Bus type symbols. */
169 xd_symbol_to_dbus_type (Lisp_Object object
)
172 (EQ (object
, QCbyte
) ? DBUS_TYPE_BYTE
173 : EQ (object
, QCboolean
) ? DBUS_TYPE_BOOLEAN
174 : EQ (object
, QCint16
) ? DBUS_TYPE_INT16
175 : EQ (object
, QCuint16
) ? DBUS_TYPE_UINT16
176 : EQ (object
, QCint32
) ? DBUS_TYPE_INT32
177 : EQ (object
, QCuint32
) ? DBUS_TYPE_UINT32
178 : EQ (object
, QCint64
) ? DBUS_TYPE_INT64
179 : EQ (object
, QCuint64
) ? DBUS_TYPE_UINT64
180 : EQ (object
, QCdouble
) ? DBUS_TYPE_DOUBLE
181 : EQ (object
, QCstring
) ? DBUS_TYPE_STRING
182 : EQ (object
, QCobject_path
) ? DBUS_TYPE_OBJECT_PATH
183 : EQ (object
, QCsignature
) ? DBUS_TYPE_SIGNATURE
184 #ifdef DBUS_TYPE_UNIX_FD
185 : EQ (object
, QCunix_fd
) ? DBUS_TYPE_UNIX_FD
187 : EQ (object
, QCarray
) ? DBUS_TYPE_ARRAY
188 : EQ (object
, QCvariant
) ? DBUS_TYPE_VARIANT
189 : EQ (object
, QCstruct
) ? DBUS_TYPE_STRUCT
190 : EQ (object
, QCdict_entry
) ? DBUS_TYPE_DICT_ENTRY
191 : DBUS_TYPE_INVALID
);
194 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
195 #define XD_DBUS_TYPE_P(object) \
196 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
198 /* Determine the DBusType of a given Lisp OBJECT. It is used to
199 convert Lisp objects, being arguments of `dbus-call-method' or
200 `dbus-send-signal', into corresponding C values appended as
201 arguments to a D-Bus message. */
202 #define XD_OBJECT_TO_DBUS_TYPE(object) \
203 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
204 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
205 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
206 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
207 : (STRINGP (object)) ? DBUS_TYPE_STRING \
208 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
210 ? ((XD_DBUS_TYPE_P (XCAR (object))) \
211 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (XCAR (object)))) \
213 : xd_symbol_to_dbus_type (XCAR (object))) \
217 /* Return a list pointer which does not have a Lisp symbol as car. */
218 #define XD_NEXT_VALUE(object) \
219 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
221 /* Transform the message type to its string representation for debug
223 #define XD_MESSAGE_TYPE_TO_STRING(mtype) \
224 ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
225 ? "DBUS_MESSAGE_TYPE_INVALID" \
226 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
227 ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
228 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
229 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
230 : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
231 ? "DBUS_MESSAGE_TYPE_ERROR" \
232 : "DBUS_MESSAGE_TYPE_SIGNAL")
234 /* Transform the object to its string representation for debug
237 XD_OBJECT_TO_STRING (Lisp_Object object
)
239 AUTO_STRING (format
, "%s");
240 return SSDATA (CALLN (Fformat
, format
, object
));
243 #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
245 char const *session_bus_address = getenv ("DBUS_SESSION_BUS_ADDRESS"); \
248 DBusAddressEntry **entries; \
251 dbus_error_init (&derror); \
252 if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
255 dbus_error_free (&derror); \
256 dbus_address_entries_free (entries); \
257 /* Canonicalize session bus address. */ \
258 if ((session_bus_address != NULL) \
259 && (!NILP (Fstring_equal \
260 (bus, build_string (session_bus_address))))) \
266 CHECK_SYMBOL (bus); \
267 if (!(EQ (bus, QCsystem) || EQ (bus, QCsession))) \
268 XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
269 /* We do not want to have an autolaunch for the session bus. */ \
270 if (EQ (bus, QCsession) && session_bus_address == NULL) \
271 XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
275 #if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
276 || HAVE_DBUS_VALIDATE_INTERFACE || HAVE_DBUS_VALIDATE_MEMBER)
277 #define XD_DBUS_VALIDATE_OBJECT(object, func) \
279 if (!NILP (object)) \
282 CHECK_STRING (object); \
283 dbus_error_init (&derror); \
284 if (!func (SSDATA (object), &derror)) \
287 dbus_error_free (&derror); \
292 #if HAVE_DBUS_VALIDATE_BUS_NAME
293 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
294 XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
296 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
297 if (!NILP (bus_name)) CHECK_STRING (bus_name);
300 #if HAVE_DBUS_VALIDATE_PATH
301 #define XD_DBUS_VALIDATE_PATH(path) \
302 XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
304 #define XD_DBUS_VALIDATE_PATH(path) \
305 if (!NILP (path)) CHECK_STRING (path);
308 #if HAVE_DBUS_VALIDATE_INTERFACE
309 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
310 XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
312 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
313 if (!NILP (interface)) CHECK_STRING (interface);
316 #if HAVE_DBUS_VALIDATE_MEMBER
317 #define XD_DBUS_VALIDATE_MEMBER(member) \
318 XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
320 #define XD_DBUS_VALIDATE_MEMBER(member) \
321 if (!NILP (member)) CHECK_STRING (member);
324 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
325 not become too long. */
327 xd_signature_cat (char *signature
, char const *x
)
329 ptrdiff_t siglen
= strlen (signature
);
330 ptrdiff_t xlen
= strlen (x
);
331 if (DBUS_MAXIMUM_SIGNATURE_LENGTH
- xlen
<= siglen
)
333 strcpy (signature
+ siglen
, x
);
336 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
337 used in dbus_message_iter_open_container. DTYPE is the DBusType
338 the object is related to. It is passed as argument, because it
339 cannot be detected in basic type objects, when they are preceded by
340 a type symbol. PARENT_TYPE is the DBusType of a container this
341 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
342 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
344 xd_signature (char *signature
, int dtype
, int parent_type
, Lisp_Object object
)
350 char x
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
357 case DBUS_TYPE_UINT16
:
358 CHECK_NATNUM (object
);
359 sprintf (signature
, "%c", dtype
);
362 case DBUS_TYPE_BOOLEAN
:
363 if (!EQ (object
, Qt
) && !EQ (object
, Qnil
))
364 wrong_type_argument (intern ("booleanp"), object
);
365 sprintf (signature
, "%c", dtype
);
368 case DBUS_TYPE_INT16
:
369 CHECK_NUMBER (object
);
370 sprintf (signature
, "%c", dtype
);
373 case DBUS_TYPE_UINT32
:
374 case DBUS_TYPE_UINT64
:
375 #ifdef DBUS_TYPE_UNIX_FD
376 case DBUS_TYPE_UNIX_FD
:
378 case DBUS_TYPE_INT32
:
379 case DBUS_TYPE_INT64
:
380 case DBUS_TYPE_DOUBLE
:
381 CHECK_NUMBER_OR_FLOAT (object
);
382 sprintf (signature
, "%c", dtype
);
385 case DBUS_TYPE_STRING
:
386 case DBUS_TYPE_OBJECT_PATH
:
387 case DBUS_TYPE_SIGNATURE
:
388 CHECK_STRING (object
);
389 sprintf (signature
, "%c", dtype
);
392 case DBUS_TYPE_ARRAY
:
393 /* Check that all list elements have the same D-Bus type. For
394 complex element types, we just check the container type, not
395 the whole element's signature. */
398 /* Type symbol is optional. */
399 if (EQ (QCarray
, XCAR (elt
)))
400 elt
= XD_NEXT_VALUE (elt
);
402 /* If the array is empty, DBUS_TYPE_STRING is the default
406 subtype
= DBUS_TYPE_STRING
;
407 subsig
= DBUS_TYPE_STRING_AS_STRING
;
411 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
412 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
416 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
417 only element, the value of this element is used as the
418 array's element signature. */
419 if (subtype
== DBUS_TYPE_SIGNATURE
)
421 Lisp_Object elt1
= XD_NEXT_VALUE (elt
);
422 if (CONSP (elt1
) && STRINGP (XCAR (elt1
)) && NILP (XCDR (elt1
)))
423 subsig
= SSDATA (XCAR (elt1
));
428 if (subtype
!= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
)))
429 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt
));
430 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
433 subsiglen
= snprintf (signature
, DBUS_MAXIMUM_SIGNATURE_LENGTH
,
434 "%c%s", dtype
, subsig
);
435 if (! (0 <= subsiglen
&& subsiglen
< DBUS_MAXIMUM_SIGNATURE_LENGTH
))
439 case DBUS_TYPE_VARIANT
:
440 /* Check that there is exactly one list element. */
443 elt
= XD_NEXT_VALUE (elt
);
444 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
445 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
447 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
448 wrong_type_argument (intern ("D-Bus"),
449 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
451 sprintf (signature
, "%c", dtype
);
454 case DBUS_TYPE_STRUCT
:
455 /* A struct list might contain any number of elements with
456 different types. No further check needed. */
459 elt
= XD_NEXT_VALUE (elt
);
461 /* Compose the signature from the elements. It is enclosed by
463 sprintf (signature
, "%c", DBUS_STRUCT_BEGIN_CHAR
);
466 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
467 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
468 xd_signature_cat (signature
, x
);
469 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
471 xd_signature_cat (signature
, DBUS_STRUCT_END_CHAR_AS_STRING
);
474 case DBUS_TYPE_DICT_ENTRY
:
475 /* Check that there are exactly two list elements, and the first
476 one is of basic type. The dictionary entry itself must be an
477 element of an array. */
480 /* Check the parent object type. */
481 if (parent_type
!= DBUS_TYPE_ARRAY
)
482 wrong_type_argument (intern ("D-Bus"), object
);
484 /* Compose the signature from the elements. It is enclosed by
486 sprintf (signature
, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR
);
489 elt
= XD_NEXT_VALUE (elt
);
490 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
491 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
492 xd_signature_cat (signature
, x
);
494 if (!XD_BASIC_DBUS_TYPE (subtype
))
495 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt
)));
497 /* Second element. */
498 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
499 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
500 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
501 xd_signature_cat (signature
, x
);
503 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
504 wrong_type_argument (intern ("D-Bus"),
505 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
507 /* Closing signature. */
508 xd_signature_cat (signature
, DBUS_DICT_ENTRY_END_CHAR_AS_STRING
);
512 wrong_type_argument (intern ("D-Bus"), object
);
515 XD_DEBUG_MESSAGE ("%s", signature
);
518 /* Convert X to a signed integer with bounds LO and HI. */
520 xd_extract_signed (Lisp_Object x
, intmax_t lo
, intmax_t hi
)
522 CHECK_NUMBER_OR_FLOAT (x
);
525 if (lo
<= XINT (x
) && XINT (x
) <= hi
)
530 double d
= XFLOAT_DATA (x
);
531 if (lo
<= d
&& d
< 1.0 + hi
)
538 if (xd_in_read_queued_messages
)
539 Fthrow (Qdbus_error
, Qnil
);
541 args_out_of_range_3 (x
,
542 make_fixnum_or_float (lo
),
543 make_fixnum_or_float (hi
));
546 /* Convert X to an unsigned integer with bounds 0 and HI. */
548 xd_extract_unsigned (Lisp_Object x
, uintmax_t hi
)
550 CHECK_NUMBER_OR_FLOAT (x
);
553 if (0 <= XINT (x
) && XINT (x
) <= hi
)
558 double d
= XFLOAT_DATA (x
);
559 if (0 <= d
&& d
< 1.0 + hi
)
566 if (xd_in_read_queued_messages
)
567 Fthrow (Qdbus_error
, Qnil
);
569 args_out_of_range_3 (x
, make_number (0), make_fixnum_or_float (hi
));
572 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
573 DTYPE must be a valid DBusType. It is used to convert Lisp
574 objects, being arguments of `dbus-call-method' or
575 `dbus-send-signal', into corresponding C values appended as
576 arguments to a D-Bus message. */
578 xd_append_arg (int dtype
, Lisp_Object object
, DBusMessageIter
*iter
)
580 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
581 DBusMessageIter subiter
;
583 if (XD_BASIC_DBUS_TYPE (dtype
))
587 CHECK_NATNUM (object
);
589 unsigned char val
= XFASTINT (object
) & 0xFF;
590 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
591 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
592 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
596 case DBUS_TYPE_BOOLEAN
:
598 dbus_bool_t val
= (NILP (object
)) ? FALSE
: TRUE
;
599 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
600 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
601 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
605 case DBUS_TYPE_INT16
:
608 xd_extract_signed (object
,
609 TYPE_MINIMUM (dbus_int16_t
),
610 TYPE_MAXIMUM (dbus_int16_t
));
612 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
613 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
614 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
618 case DBUS_TYPE_UINT16
:
621 xd_extract_unsigned (object
,
622 TYPE_MAXIMUM (dbus_uint16_t
));
623 unsigned int pval
= val
;
624 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
625 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
626 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
630 case DBUS_TYPE_INT32
:
633 xd_extract_signed (object
,
634 TYPE_MINIMUM (dbus_int32_t
),
635 TYPE_MAXIMUM (dbus_int32_t
));
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
);
643 case DBUS_TYPE_UINT32
:
644 #ifdef DBUS_TYPE_UNIX_FD
645 case DBUS_TYPE_UNIX_FD
:
649 xd_extract_unsigned (object
,
650 TYPE_MAXIMUM (dbus_uint32_t
));
651 unsigned int pval
= val
;
652 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
653 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
654 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
658 case DBUS_TYPE_INT64
:
661 xd_extract_signed (object
,
662 TYPE_MINIMUM (dbus_int64_t
),
663 TYPE_MAXIMUM (dbus_int64_t
));
664 printmax_t pval
= val
;
665 XD_DEBUG_MESSAGE ("%c %"pMd
, dtype
, pval
);
666 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
667 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
671 case DBUS_TYPE_UINT64
:
674 xd_extract_unsigned (object
,
675 TYPE_MAXIMUM (dbus_uint64_t
));
676 uprintmax_t pval
= val
;
677 XD_DEBUG_MESSAGE ("%c %"pMu
, dtype
, pval
);
678 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
679 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
683 case DBUS_TYPE_DOUBLE
:
685 double val
= extract_float (object
);
686 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
687 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
688 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
692 case DBUS_TYPE_STRING
:
693 case DBUS_TYPE_OBJECT_PATH
:
694 case DBUS_TYPE_SIGNATURE
:
695 CHECK_STRING (object
);
697 /* We need to send a valid UTF-8 string. We could encode `object'
698 but by not encoding it, we guarantee it's valid utf-8, even if
699 it contains eight-bit-bytes. Of course, you can still send
700 manually-crafted junk by passing a unibyte string. */
701 char *val
= SSDATA (object
);
702 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
703 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
704 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
709 else /* Compound types. */
712 /* All compound types except array have a type symbol. For
713 array, it is optional. Skip it. */
714 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))))
715 object
= XD_NEXT_VALUE (object
);
717 /* Open new subiteration. */
720 case DBUS_TYPE_ARRAY
:
721 /* An array has only elements of the same type. So it is
722 sufficient to check the first element's signature
726 /* If the array is empty, DBUS_TYPE_STRING is the default
728 strcpy (signature
, DBUS_TYPE_STRING_AS_STRING
);
731 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
732 the only element, the value of this element is used as
733 the array's element signature. */
734 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))
735 == DBUS_TYPE_SIGNATURE
)
736 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object
)))
737 && NILP (CDR_SAFE (XD_NEXT_VALUE (object
))))
739 lispstpcpy (signature
, CAR_SAFE (XD_NEXT_VALUE (object
)));
740 object
= CDR_SAFE (XD_NEXT_VALUE (object
));
744 xd_signature (signature
,
745 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
746 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
748 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
749 XD_OBJECT_TO_STRING (object
));
750 if (!dbus_message_iter_open_container (iter
, dtype
,
751 signature
, &subiter
))
752 XD_SIGNAL3 (build_string ("Cannot open container"),
753 make_number (dtype
), build_string (signature
));
756 case DBUS_TYPE_VARIANT
:
757 /* A variant has just one element. */
758 xd_signature (signature
, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
759 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
761 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
762 XD_OBJECT_TO_STRING (object
));
763 if (!dbus_message_iter_open_container (iter
, dtype
,
764 signature
, &subiter
))
765 XD_SIGNAL3 (build_string ("Cannot open container"),
766 make_number (dtype
), build_string (signature
));
769 case DBUS_TYPE_STRUCT
:
770 case DBUS_TYPE_DICT_ENTRY
:
771 /* These containers do not require a signature. */
772 XD_DEBUG_MESSAGE ("%c %s", dtype
, XD_OBJECT_TO_STRING (object
));
773 if (!dbus_message_iter_open_container (iter
, dtype
, NULL
, &subiter
))
774 XD_SIGNAL2 (build_string ("Cannot open container"),
775 make_number (dtype
));
779 /* Loop over list elements. */
780 while (!NILP (object
))
782 dtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
));
783 object
= XD_NEXT_VALUE (object
);
785 xd_append_arg (dtype
, CAR_SAFE (object
), &subiter
);
787 object
= CDR_SAFE (object
);
790 /* Close the subiteration. */
791 if (!dbus_message_iter_close_container (iter
, &subiter
))
792 XD_SIGNAL2 (build_string ("Cannot close container"),
793 make_number (dtype
));
797 /* Retrieve C value from a DBusMessageIter structure ITER, and return
798 a converted Lisp object. The type DTYPE of the argument of the
799 D-Bus message must be a valid DBusType. Compound D-Bus types
800 result always in a Lisp list. */
802 xd_retrieve_arg (int dtype
, DBusMessageIter
*iter
)
810 dbus_message_iter_get_basic (iter
, &val
);
812 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
813 return make_number (val
);
816 case DBUS_TYPE_BOOLEAN
:
819 dbus_message_iter_get_basic (iter
, &val
);
820 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
821 return (val
== FALSE
) ? Qnil
: Qt
;
824 case DBUS_TYPE_INT16
:
828 dbus_message_iter_get_basic (iter
, &val
);
830 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
831 return make_number (val
);
834 case DBUS_TYPE_UINT16
:
838 dbus_message_iter_get_basic (iter
, &val
);
840 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
841 return make_number (val
);
844 case DBUS_TYPE_INT32
:
848 dbus_message_iter_get_basic (iter
, &val
);
850 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
851 return make_fixnum_or_float (val
);
854 case DBUS_TYPE_UINT32
:
855 #ifdef DBUS_TYPE_UNIX_FD
856 case DBUS_TYPE_UNIX_FD
:
861 dbus_message_iter_get_basic (iter
, &val
);
863 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
864 return make_fixnum_or_float (val
);
867 case DBUS_TYPE_INT64
:
871 dbus_message_iter_get_basic (iter
, &val
);
873 XD_DEBUG_MESSAGE ("%c %"pMd
, dtype
, pval
);
874 return make_fixnum_or_float (val
);
877 case DBUS_TYPE_UINT64
:
881 dbus_message_iter_get_basic (iter
, &val
);
883 XD_DEBUG_MESSAGE ("%c %"pMu
, dtype
, pval
);
884 return make_fixnum_or_float (val
);
887 case DBUS_TYPE_DOUBLE
:
890 dbus_message_iter_get_basic (iter
, &val
);
891 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
892 return make_float (val
);
895 case DBUS_TYPE_STRING
:
896 case DBUS_TYPE_OBJECT_PATH
:
897 case DBUS_TYPE_SIGNATURE
:
900 dbus_message_iter_get_basic (iter
, &val
);
901 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
902 return build_string (val
);
905 case DBUS_TYPE_ARRAY
:
906 case DBUS_TYPE_VARIANT
:
907 case DBUS_TYPE_STRUCT
:
908 case DBUS_TYPE_DICT_ENTRY
:
911 DBusMessageIter subiter
;
914 dbus_message_iter_recurse (iter
, &subiter
);
915 while ((subtype
= dbus_message_iter_get_arg_type (&subiter
))
916 != DBUS_TYPE_INVALID
)
918 result
= Fcons (xd_retrieve_arg (subtype
, &subiter
), result
);
919 dbus_message_iter_next (&subiter
);
921 XD_DEBUG_MESSAGE ("%c %s", dtype
, XD_OBJECT_TO_STRING (result
));
922 return Fnreverse (result
);
926 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype
);
931 /* Return the number of references of the shared CONNECTION. */
933 xd_get_connection_references (DBusConnection
*connection
)
937 /* We cannot access the DBusConnection structure, it is not public.
938 But we know, that the reference counter is the first field in
940 refcount
= (void *) &connection
;
941 refcount
= (void *) *refcount
;
945 /* Convert a Lisp D-Bus object to a pointer. */
946 static DBusConnection
*
947 xd_lisp_dbus_to_dbus (Lisp_Object bus
)
949 return xmint_pointer (bus
);
952 /* Return D-Bus connection address. BUS is either a Lisp symbol,
953 :system or :session, or a string denoting the bus address. */
954 static DBusConnection
*
955 xd_get_connection_address (Lisp_Object bus
)
957 DBusConnection
*connection
;
960 val
= CDR_SAFE (Fassoc (bus
, xd_registered_buses
, Qnil
));
962 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
964 connection
= xd_lisp_dbus_to_dbus (val
);
966 if (!dbus_connection_get_is_connected (connection
))
967 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
972 /* Return the file descriptor for WATCH, -1 if not found. */
974 xd_find_watch_fd (DBusWatch
*watch
)
976 #if HAVE_DBUS_WATCH_GET_UNIX_FD
977 /* TODO: Reverse these on w32, which prefers the opposite. */
978 int fd
= dbus_watch_get_unix_fd (watch
);
980 fd
= dbus_watch_get_socket (watch
);
982 int fd
= dbus_watch_get_fd (watch
);
988 static void xd_read_queued_messages (int fd
, void *data
);
990 /* Start monitoring WATCH for possible I/O. */
992 xd_add_watch (DBusWatch
*watch
, void *data
)
994 unsigned int flags
= dbus_watch_get_flags (watch
);
995 int fd
= xd_find_watch_fd (watch
);
997 XD_DEBUG_MESSAGE ("fd %d, write %u, enabled %u",
998 fd
, flags
& DBUS_WATCH_WRITABLE
,
999 dbus_watch_get_enabled (watch
));
1004 if (dbus_watch_get_enabled (watch
))
1006 if (flags
& DBUS_WATCH_WRITABLE
)
1007 add_write_fd (fd
, xd_read_queued_messages
, data
);
1008 if (flags
& DBUS_WATCH_READABLE
)
1009 add_read_fd (fd
, xd_read_queued_messages
, data
);
1014 /* Stop monitoring WATCH for possible I/O.
1015 DATA is the used bus, either a string or QCsystem or QCsession. */
1017 xd_remove_watch (DBusWatch
*watch
, void *data
)
1019 unsigned int flags
= dbus_watch_get_flags (watch
);
1020 int fd
= xd_find_watch_fd (watch
);
1022 XD_DEBUG_MESSAGE ("fd %d", fd
);
1027 /* Unset session environment. */
1029 /* This is buggy, since unsetenv is not thread-safe. */
1030 if (XSYMBOL (QCsession
) == data
)
1032 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
1033 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
1037 if (flags
& DBUS_WATCH_WRITABLE
)
1038 delete_write_fd (fd
);
1039 if (flags
& DBUS_WATCH_READABLE
)
1040 delete_read_fd (fd
);
1043 /* Toggle monitoring WATCH for possible I/O. */
1045 xd_toggle_watch (DBusWatch
*watch
, void *data
)
1047 if (dbus_watch_get_enabled (watch
))
1048 xd_add_watch (watch
, data
);
1050 xd_remove_watch (watch
, data
);
1053 /* Close connection to D-Bus BUS. */
1055 xd_close_bus (Lisp_Object bus
)
1057 DBusConnection
*connection
;
1061 /* Check whether we are connected. */
1062 val
= Fassoc (bus
, xd_registered_buses
, Qnil
);
1066 busobj
= CDR_SAFE (val
);
1067 if (NILP (busobj
)) {
1068 xd_registered_buses
= Fdelete (val
, xd_registered_buses
);
1072 /* Retrieve bus address. */
1073 connection
= xd_lisp_dbus_to_dbus (busobj
);
1075 if (xd_get_connection_references (connection
) == 1)
1077 /* Close connection, if there isn't another shared application. */
1078 XD_DEBUG_MESSAGE ("Close connection to bus %s",
1079 XD_OBJECT_TO_STRING (bus
));
1080 dbus_connection_close (connection
);
1082 xd_registered_buses
= Fdelete (val
, xd_registered_buses
);
1086 /* Decrement reference count. */
1087 dbus_connection_unref (connection
);
1093 DEFUN ("dbus--init-bus", Fdbus__init_bus
, Sdbus__init_bus
, 1, 2, 0,
1094 doc
: /* Establish the connection to D-Bus BUS.
1096 This function is dbus internal. You almost certainly want to use
1099 BUS can be either the symbol `:system' or the symbol `:session', or it
1100 can be a string denoting the address of the corresponding bus. For
1101 the system and session buses, this function is called when loading
1102 `dbus.el', there is no need to call it again.
1104 The function returns a number, which counts the connections this Emacs
1105 session has established to the BUS under the same unique name (see
1106 `dbus-get-unique-name'). It depends on the libraries Emacs is linked
1107 with, and on the environment Emacs is running. For example, if Emacs
1108 is linked with the gtk toolkit, and it runs in a GTK-aware environment
1109 like Gnome, another connection might already be established.
1111 When PRIVATE is non-nil, a new connection is established instead of
1112 reusing an existing one. It results in a new unique name at the bus.
1113 This can be used, if it is necessary to distinguish from another
1114 connection used in the same Emacs process, like the one established by
1115 GTK+. It should be used with care for at least the `:system' and
1116 `:session' buses, because other Emacs Lisp packages might already use
1117 this connection to those buses. */)
1118 (Lisp_Object bus
, Lisp_Object
private)
1120 DBusConnection
*connection
;
1125 /* Check parameter. */
1126 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1128 /* Close bus if it is already open. */
1131 /* Check, whether we are still connected. */
1132 val
= Fassoc (bus
, xd_registered_buses
, Qnil
);
1135 connection
= xd_get_connection_address (bus
);
1136 dbus_connection_ref (connection
);
1142 dbus_error_init (&derror
);
1144 /* Open the connection. */
1147 connection
= dbus_connection_open (SSDATA (bus
), &derror
);
1149 connection
= dbus_connection_open_private (SSDATA (bus
), &derror
);
1153 DBusBusType bustype
= (EQ (bus
, QCsystem
)
1154 ? DBUS_BUS_SYSTEM
: DBUS_BUS_SESSION
);
1156 connection
= dbus_bus_get (bustype
, &derror
);
1158 connection
= dbus_bus_get_private (bustype
, &derror
);
1161 if (dbus_error_is_set (&derror
))
1164 if (connection
== NULL
)
1165 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
1167 /* If it is not the system or session bus, we must register
1168 ourselves. Otherwise, we have called dbus_bus_get, which has
1169 configured us to exit if the connection closes - we undo this
1172 dbus_bus_register (connection
, &derror
);
1174 dbus_connection_set_exit_on_disconnect (connection
, FALSE
);
1176 if (dbus_error_is_set (&derror
))
1179 /* Add the watch functions. We pass also the bus as data, in
1180 order to distinguish between the buses in xd_remove_watch. */
1181 if (!dbus_connection_set_watch_functions (connection
,
1186 ? (void *) XSYMBOL (bus
)
1187 : (void *) XSTRING (bus
),
1189 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
1191 /* Add bus to list of registered buses. */
1192 val
= make_mint_ptr (connection
);
1193 xd_registered_buses
= Fcons (Fcons (bus
, val
), xd_registered_buses
);
1196 dbus_error_free (&derror
);
1199 /* Return reference counter. */
1200 refcount
= xd_get_connection_references (connection
);
1201 XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD
"d",
1202 XD_OBJECT_TO_STRING (bus
), refcount
);
1203 return make_number (refcount
);
1206 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name
, Sdbus_get_unique_name
,
1208 doc
: /* Return the unique name of Emacs registered at D-Bus BUS. */)
1211 DBusConnection
*connection
;
1214 /* Check parameter. */
1215 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1217 /* Retrieve bus address. */
1218 connection
= xd_get_connection_address (bus
);
1220 /* Request the name. */
1221 name
= dbus_bus_get_unique_name (connection
);
1223 XD_SIGNAL1 (build_string ("No unique name available"));
1226 return build_string (name
);
1229 DEFUN ("dbus-message-internal", Fdbus_message_internal
, Sdbus_message_internal
,
1231 doc
: /* Send a D-Bus message.
1232 This is an internal function, it shall not be used outside dbus.el.
1234 The following usages are expected:
1236 `dbus-call-method', `dbus-call-method-asynchronously':
1237 (dbus-message-internal
1238 dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1239 &optional :timeout TIMEOUT &rest ARGS)
1242 (dbus-message-internal
1243 dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1245 `dbus-method-return-internal':
1246 (dbus-message-internal
1247 dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1249 `dbus-method-error-internal':
1250 (dbus-message-internal
1251 dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1253 usage: (dbus-message-internal &rest REST) */)
1254 (ptrdiff_t nargs
, Lisp_Object
*args
)
1256 Lisp_Object message_type
, bus
, service
, handler
;
1257 Lisp_Object path
= Qnil
;
1258 Lisp_Object interface
= Qnil
;
1259 Lisp_Object member
= Qnil
;
1261 DBusConnection
*connection
;
1262 DBusMessage
*dmessage
;
1263 DBusMessageIter iter
;
1266 dbus_uint32_t serial
= 0;
1267 unsigned int ui_serial
;
1270 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1272 /* Initialize parameters. */
1273 message_type
= args
[0];
1278 CHECK_NATNUM (message_type
);
1279 if (! (DBUS_MESSAGE_TYPE_INVALID
< XFASTINT (message_type
)
1280 && XFASTINT (message_type
) < DBUS_NUM_MESSAGE_TYPES
))
1281 XD_SIGNAL2 (build_string ("Invalid message type"), message_type
);
1282 mtype
= XFASTINT (message_type
);
1284 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1285 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1288 interface
= args
[4];
1290 if (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1292 count
= (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
) ? 7 : 6;
1294 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1296 serial
= xd_extract_unsigned (args
[3], TYPE_MAXIMUM (dbus_uint32_t
));
1300 /* Check parameters. */
1301 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1302 XD_DBUS_VALIDATE_BUS_NAME (service
);
1304 xsignal2 (Qwrong_number_of_arguments
,
1305 Qdbus_message_internal
,
1306 make_number (nargs
));
1308 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1309 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1311 XD_DBUS_VALIDATE_PATH (path
);
1312 XD_DBUS_VALIDATE_INTERFACE (interface
);
1313 XD_DBUS_VALIDATE_MEMBER (member
);
1314 if (!NILP (handler
) && !FUNCTIONP (handler
))
1315 wrong_type_argument (Qinvalid_function
, handler
);
1318 /* Trace parameters. */
1321 case DBUS_MESSAGE_TYPE_METHOD_CALL
:
1322 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1323 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1324 XD_OBJECT_TO_STRING (bus
),
1325 XD_OBJECT_TO_STRING (service
),
1326 XD_OBJECT_TO_STRING (path
),
1327 XD_OBJECT_TO_STRING (interface
),
1328 XD_OBJECT_TO_STRING (member
),
1329 XD_OBJECT_TO_STRING (handler
));
1331 case DBUS_MESSAGE_TYPE_SIGNAL
:
1332 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1333 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1334 XD_OBJECT_TO_STRING (bus
),
1335 XD_OBJECT_TO_STRING (service
),
1336 XD_OBJECT_TO_STRING (path
),
1337 XD_OBJECT_TO_STRING (interface
),
1338 XD_OBJECT_TO_STRING (member
));
1340 default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1342 XD_DEBUG_MESSAGE ("%s %s %s %u",
1343 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1344 XD_OBJECT_TO_STRING (bus
),
1345 XD_OBJECT_TO_STRING (service
),
1349 /* Retrieve bus address. */
1350 connection
= xd_get_connection_address (bus
);
1352 /* Create the D-Bus message. */
1353 dmessage
= dbus_message_new (mtype
);
1354 if (dmessage
== NULL
)
1355 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1357 if (STRINGP (service
))
1359 if (mtype
!= DBUS_MESSAGE_TYPE_SIGNAL
)
1360 /* Set destination. */
1362 if (!dbus_message_set_destination (dmessage
, SSDATA (service
)))
1363 XD_SIGNAL2 (build_string ("Unable to set the destination"),
1368 /* Set destination for unicast signals. */
1372 /* If it is the same unique name as we are registered at the
1373 bus or an unknown name, we regard it as broadcast message
1374 due to backward compatibility. */
1375 if (dbus_bus_name_has_owner (connection
, SSDATA (service
), NULL
))
1376 uname
= call2 (intern ("dbus-get-name-owner"), bus
, service
);
1381 && (strcmp (dbus_bus_get_unique_name (connection
), SSDATA (uname
))
1383 && (!dbus_message_set_destination (dmessage
, SSDATA (service
))))
1384 XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1389 /* Set message parameters. */
1390 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1391 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1393 if ((!dbus_message_set_path (dmessage
, SSDATA (path
)))
1394 || (!dbus_message_set_interface (dmessage
, SSDATA (interface
)))
1395 || (!dbus_message_set_member (dmessage
, SSDATA (member
))))
1396 XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1399 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1401 if (!dbus_message_set_reply_serial (dmessage
, serial
))
1402 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1404 if ((mtype
== DBUS_MESSAGE_TYPE_ERROR
)
1405 && (!dbus_message_set_error_name (dmessage
, DBUS_ERROR_FAILED
)))
1406 XD_SIGNAL1 (build_string ("Unable to create an error message"));
1409 /* Check for timeout parameter. */
1410 if ((count
+ 2 <= nargs
) && EQ (args
[count
], QCtimeout
))
1412 CHECK_NATNUM (args
[count
+1]);
1413 timeout
= min (XFASTINT (args
[count
+1]), INT_MAX
);
1417 /* Initialize parameter list of message. */
1418 dbus_message_iter_init_append (dmessage
, &iter
);
1420 /* Append parameters to the message. */
1421 for (; count
< nargs
; ++count
)
1423 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[count
]);
1424 if (XD_DBUS_TYPE_P (args
[count
]))
1426 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
]);
1427 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
+1]);
1428 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s %s", count
- 4,
1429 XD_OBJECT_TO_STRING (args
[count
]),
1430 XD_OBJECT_TO_STRING (args
[count
+1]));
1435 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
]);
1436 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s", count
- 4,
1437 XD_OBJECT_TO_STRING (args
[count
]));
1440 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1441 indication that there is no parent type. */
1442 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[count
]);
1444 xd_append_arg (dtype
, args
[count
], &iter
);
1447 if (!NILP (handler
))
1449 /* Send the message. The message is just added to the outgoing
1451 if (!dbus_connection_send_with_reply (connection
, dmessage
,
1453 XD_SIGNAL1 (build_string ("Cannot send message"));
1455 /* The result is the key in Vdbus_registered_objects_table. */
1456 serial
= dbus_message_get_serial (dmessage
);
1457 result
= list3 (QCserial
, bus
, make_fixnum_or_float (serial
));
1459 /* Create a hash table entry. */
1460 Fputhash (result
, handler
, Vdbus_registered_objects_table
);
1464 /* Send the message. The message is just added to the outgoing
1466 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1467 XD_SIGNAL1 (build_string ("Cannot send message"));
1472 XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result
));
1475 dbus_message_unref (dmessage
);
1477 /* Return the result. */
1481 /* Read one queued incoming message of the D-Bus BUS.
1482 BUS is either a Lisp symbol, :system or :session, or a string denoting
1485 xd_read_message_1 (DBusConnection
*connection
, Lisp_Object bus
)
1487 Lisp_Object args
, key
, value
;
1488 struct input_event event
;
1489 DBusMessage
*dmessage
;
1490 DBusMessageIter iter
;
1493 dbus_uint32_t serial
;
1494 unsigned int ui_serial
;
1495 const char *uname
, *path
, *interface
, *member
;
1497 dmessage
= dbus_connection_pop_message (connection
);
1499 /* Return if there is no queued message. */
1500 if (dmessage
== NULL
)
1503 /* Collect the parameters. */
1506 /* Loop over the resulting parameters. Construct a list. */
1507 if (dbus_message_iter_init (dmessage
, &iter
))
1509 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
1510 != DBUS_TYPE_INVALID
)
1512 args
= Fcons (xd_retrieve_arg (dtype
, &iter
), args
);
1513 dbus_message_iter_next (&iter
);
1515 /* The arguments are stored in reverse order. Reorder them. */
1516 args
= Fnreverse (args
);
1519 /* Read message type, message serial, unique name, object path,
1520 interface and member from the message. */
1521 mtype
= dbus_message_get_type (dmessage
);
1522 ui_serial
= serial
=
1523 ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1524 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1525 ? dbus_message_get_reply_serial (dmessage
)
1526 : dbus_message_get_serial (dmessage
);
1527 uname
= dbus_message_get_sender (dmessage
);
1528 path
= dbus_message_get_path (dmessage
);
1529 interface
= dbus_message_get_interface (dmessage
);
1530 member
= dbus_message_get_member (dmessage
);
1532 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1533 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1534 ui_serial
, uname
, path
, interface
, member
,
1535 XD_OBJECT_TO_STRING (args
));
1537 if (mtype
== DBUS_MESSAGE_TYPE_INVALID
)
1540 else if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1541 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1543 /* Search for a registered function of the message. */
1544 key
= list3 (QCserial
, bus
, make_fixnum_or_float (serial
));
1545 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1547 /* There shall be exactly one entry. Construct an event. */
1551 /* Remove the entry. */
1552 Fremhash (key
, Vdbus_registered_objects_table
);
1554 /* Construct an event. */
1556 event
.kind
= DBUS_EVENT
;
1557 event
.frame_or_window
= Qnil
;
1558 event
.arg
= Fcons (value
, args
);
1561 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
1563 /* Vdbus_registered_objects_table requires non-nil interface and
1565 if ((interface
== NULL
) || (member
== NULL
))
1568 /* Search for a registered function of the message. */
1569 key
= list4 (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
? QCmethod
: QCsignal
,
1570 bus
, build_string (interface
), build_string (member
));
1571 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1573 /* Loop over the registered functions. Construct an event. */
1574 while (!NILP (value
))
1576 key
= CAR_SAFE (value
);
1577 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1578 if (((uname
== NULL
)
1579 || (NILP (CAR_SAFE (key
)))
1580 || (strcmp (uname
, SSDATA (CAR_SAFE (key
))) == 0))
1582 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1584 SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1586 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))))
1589 event
.kind
= DBUS_EVENT
;
1590 event
.frame_or_window
= Qnil
;
1592 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))), args
);
1595 value
= CDR_SAFE (value
);
1602 /* Add type, serial, uname, path, interface and member to the event. */
1603 event
.arg
= Fcons ((member
== NULL
? Qnil
: build_string (member
)),
1605 event
.arg
= Fcons ((interface
== NULL
? Qnil
: build_string (interface
)),
1607 event
.arg
= Fcons ((path
== NULL
? Qnil
: build_string (path
)),
1609 event
.arg
= Fcons ((uname
== NULL
? Qnil
: build_string (uname
)),
1611 event
.arg
= Fcons (make_fixnum_or_float (serial
), event
.arg
);
1612 event
.arg
= Fcons (make_number (mtype
), event
.arg
);
1614 /* Add the bus symbol to the event. */
1615 event
.arg
= Fcons (bus
, event
.arg
);
1617 /* Store it into the input event queue. */
1618 kbd_buffer_store_event (&event
);
1620 XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event
.arg
));
1624 dbus_message_unref (dmessage
);
1627 /* Read queued incoming messages of the D-Bus BUS.
1628 BUS is either a Lisp symbol, :system or :session, or a string denoting
1631 xd_read_message (Lisp_Object bus
)
1633 /* Retrieve bus address. */
1634 DBusConnection
*connection
= xd_get_connection_address (bus
);
1636 /* Non blocking read of the next available message. */
1637 dbus_connection_read_write (connection
, 0);
1639 while (dbus_connection_get_dispatch_status (connection
)
1640 != DBUS_DISPATCH_COMPLETE
)
1641 xd_read_message_1 (connection
, bus
);
1645 /* Callback called when something is ready to read or write. */
1647 xd_read_queued_messages (int fd
, void *data
)
1649 Lisp_Object busp
= xd_registered_buses
;
1650 Lisp_Object bus
= Qnil
;
1653 /* Find bus related to fd. */
1655 while (!NILP (busp
))
1657 key
= CAR_SAFE (CAR_SAFE (busp
));
1658 if ((SYMBOLP (key
) && XSYMBOL (key
) == data
)
1659 || (STRINGP (key
) && XSTRING (key
) == data
))
1661 busp
= CDR_SAFE (busp
);
1667 /* We ignore all Lisp errors during the call. */
1668 xd_in_read_queued_messages
= 1;
1669 internal_catch (Qdbus_error
, xd_read_message
, bus
);
1670 xd_in_read_queued_messages
= 0;
1675 init_dbusbind (void)
1677 /* We do not want to abort. */
1678 xputenv ("DBUS_FATAL_WARNINGS=0");
1682 syms_of_dbusbind (void)
1684 defsubr (&Sdbus__init_bus
);
1685 defsubr (&Sdbus_get_unique_name
);
1687 DEFSYM (Qdbus_message_internal
, "dbus-message-internal");
1688 defsubr (&Sdbus_message_internal
);
1690 /* D-Bus error symbol. */
1691 DEFSYM (Qdbus_error
, "dbus-error");
1692 Fput (Qdbus_error
, Qerror_conditions
,
1693 list2 (Qdbus_error
, Qerror
));
1694 Fput (Qdbus_error
, Qerror_message
,
1695 build_pure_c_string ("D-Bus error"));
1697 /* Lisp symbols of the system and session buses. */
1698 DEFSYM (QCsystem
, ":system");
1699 DEFSYM (QCsession
, ":session");
1701 /* Lisp symbol for method call timeout. */
1702 DEFSYM (QCtimeout
, ":timeout");
1704 /* Lisp symbols of D-Bus types. */
1705 DEFSYM (QCbyte
, ":byte");
1706 DEFSYM (QCboolean
, ":boolean");
1707 DEFSYM (QCint16
, ":int16");
1708 DEFSYM (QCuint16
, ":uint16");
1709 DEFSYM (QCint32
, ":int32");
1710 DEFSYM (QCuint32
, ":uint32");
1711 DEFSYM (QCint64
, ":int64");
1712 DEFSYM (QCuint64
, ":uint64");
1713 DEFSYM (QCdouble
, ":double");
1714 DEFSYM (QCstring
, ":string");
1715 DEFSYM (QCobject_path
, ":object-path");
1716 DEFSYM (QCsignature
, ":signature");
1717 #ifdef DBUS_TYPE_UNIX_FD
1718 DEFSYM (QCunix_fd
, ":unix-fd");
1720 DEFSYM (QCarray
, ":array");
1721 DEFSYM (QCvariant
, ":variant");
1722 DEFSYM (QCstruct
, ":struct");
1723 DEFSYM (QCdict_entry
, ":dict-entry");
1725 /* Lisp symbols of objects in `dbus-registered-objects-table'. */
1726 DEFSYM (QCserial
, ":serial");
1727 DEFSYM (QCmethod
, ":method");
1728 DEFSYM (QCsignal
, ":signal");
1730 DEFVAR_LISP ("dbus-compiled-version",
1731 Vdbus_compiled_version
,
1732 doc
: /* The version of D-Bus Emacs is compiled against. */);
1733 #ifdef DBUS_VERSION_STRING
1734 Vdbus_compiled_version
= build_pure_c_string (DBUS_VERSION_STRING
);
1736 Vdbus_compiled_version
= Qnil
;
1739 DEFVAR_LISP ("dbus-runtime-version",
1740 Vdbus_runtime_version
,
1741 doc
: /* The version of D-Bus Emacs runs with. */);
1744 int major
, minor
, micro
;
1745 char s
[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
1746 dbus_get_version (&major
, &minor
, µ
);
1747 Vdbus_runtime_version
1748 = make_formatted_string (s
, "%d.%d.%d", major
, minor
, micro
);
1750 Vdbus_runtime_version
= Qnil
;
1754 DEFVAR_LISP ("dbus-message-type-invalid",
1755 Vdbus_message_type_invalid
,
1756 doc
: /* This value is never a valid message type. */);
1757 Vdbus_message_type_invalid
= make_number (DBUS_MESSAGE_TYPE_INVALID
);
1759 DEFVAR_LISP ("dbus-message-type-method-call",
1760 Vdbus_message_type_method_call
,
1761 doc
: /* Message type of a method call message. */);
1762 Vdbus_message_type_method_call
= make_number (DBUS_MESSAGE_TYPE_METHOD_CALL
);
1764 DEFVAR_LISP ("dbus-message-type-method-return",
1765 Vdbus_message_type_method_return
,
1766 doc
: /* Message type of a method return message. */);
1767 Vdbus_message_type_method_return
1768 = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN
);
1770 DEFVAR_LISP ("dbus-message-type-error",
1771 Vdbus_message_type_error
,
1772 doc
: /* Message type of an error reply message. */);
1773 Vdbus_message_type_error
= make_number (DBUS_MESSAGE_TYPE_ERROR
);
1775 DEFVAR_LISP ("dbus-message-type-signal",
1776 Vdbus_message_type_signal
,
1777 doc
: /* Message type of a signal message. */);
1778 Vdbus_message_type_signal
= make_number (DBUS_MESSAGE_TYPE_SIGNAL
);
1780 DEFVAR_LISP ("dbus-registered-objects-table",
1781 Vdbus_registered_objects_table
,
1782 doc
: /* Hash table of registered functions for D-Bus.
1784 There are two different uses of the hash table: for accessing
1785 registered interfaces properties, targeted by signals or method calls,
1786 and for calling handlers in case of non-blocking method call returns.
1788 In the first case, the key in the hash table is the list (TYPE BUS
1789 INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
1790 `:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
1791 `:session', or a string denoting the bus address. INTERFACE is a
1792 string which denotes a D-Bus interface, and MEMBER, also a string, is
1793 either a method, a signal or a property INTERFACE is offering. All
1794 arguments but BUS must not be nil.
1796 The value in the hash table is a list of quadruple lists ((UNAME
1797 SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
1798 registered, UNAME is the corresponding unique name. In case of
1799 registered methods and properties, UNAME is nil. PATH is the object
1800 path of the sending object. All of them can be nil, which means a
1801 wildcard then. OBJECT is either the handler to be called when a D-Bus
1802 message, which matches the key criteria, arrives (TYPE `:method' and
1803 `:signal'), or a cons cell containing the value of the property (TYPE
1806 For entries of type `:signal', there is also a fifth element RULE,
1807 which keeps the match string the signal is registered with.
1809 In the second case, the key in the hash table is the list (:serial BUS
1810 SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
1811 string denoting the bus address. SERIAL is the serial number of the
1812 non-blocking method call, a reply is expected. Both arguments must
1813 not be nil. The value in the hash table is HANDLER, the function to
1814 be called when the D-Bus reply message arrives. */);
1815 Vdbus_registered_objects_table
= CALLN (Fmake_hash_table
, QCtest
, Qequal
);
1817 DEFVAR_LISP ("dbus-debug", Vdbus_debug
,
1818 doc
: /* If non-nil, debug messages of D-Bus bindings are raised. */);
1821 /* We can also set environment variable DBUS_VERBOSE=1 in order to
1822 see more traces. This requires libdbus-1 to be configured with
1823 --enable-verbose-mode. */
1828 /* Initialize internal objects. */
1829 xd_registered_buses
= Qnil
;
1830 staticpro (&xd_registered_buses
);
1832 Fprovide (intern_c_string ("dbusbind"), Qnil
);
1836 #endif /* HAVE_DBUS */