1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <dbus/dbus.h>
27 #include "termhooks.h"
33 static Lisp_Object Qdbus_init_bus
;
34 static Lisp_Object Qdbus_close_bus
;
35 static Lisp_Object Qdbus_get_unique_name
;
36 static Lisp_Object Qdbus_call_method
;
37 static Lisp_Object Qdbus_call_method_asynchronously
;
38 static Lisp_Object Qdbus_method_return_internal
;
39 static Lisp_Object Qdbus_method_error_internal
;
40 static Lisp_Object Qdbus_send_signal
;
41 static Lisp_Object Qdbus_register_service
;
42 static Lisp_Object Qdbus_register_signal
;
43 static Lisp_Object Qdbus_register_method
;
45 /* D-Bus error symbol. */
46 static Lisp_Object Qdbus_error
;
48 /* Lisp symbols of the system and session buses. */
49 static Lisp_Object QCdbus_system_bus
, QCdbus_session_bus
;
51 /* Lisp symbol for method call timeout. */
52 static Lisp_Object QCdbus_timeout
;
54 /* Lisp symbols for name request flags. */
55 static Lisp_Object QCdbus_request_name_allow_replacement
;
56 static Lisp_Object QCdbus_request_name_replace_existing
;
57 static Lisp_Object QCdbus_request_name_do_not_queue
;
59 /* Lisp symbols for name request replies. */
60 static Lisp_Object QCdbus_request_name_reply_primary_owner
;
61 static Lisp_Object QCdbus_request_name_reply_in_queue
;
62 static Lisp_Object QCdbus_request_name_reply_exists
;
63 static Lisp_Object QCdbus_request_name_reply_already_owner
;
65 /* Lisp symbols of D-Bus types. */
66 static Lisp_Object QCdbus_type_byte
, QCdbus_type_boolean
;
67 static Lisp_Object QCdbus_type_int16
, QCdbus_type_uint16
;
68 static Lisp_Object QCdbus_type_int32
, QCdbus_type_uint32
;
69 static Lisp_Object QCdbus_type_int64
, QCdbus_type_uint64
;
70 static Lisp_Object QCdbus_type_double
, QCdbus_type_string
;
71 static Lisp_Object QCdbus_type_object_path
, QCdbus_type_signature
;
72 #ifdef DBUS_TYPE_UNIX_FD
73 static Lisp_Object QCdbus_type_unix_fd
;
75 static Lisp_Object QCdbus_type_array
, QCdbus_type_variant
;
76 static Lisp_Object QCdbus_type_struct
, QCdbus_type_dict_entry
;
78 /* Whether we are reading a D-Bus event. */
79 static int xd_in_read_queued_messages
= 0;
82 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
83 we don't want to poison other namespaces with "dbus_". */
85 /* Raise a signal. If we are reading events, we cannot signal; we
86 throw to xd_read_queued_messages then. */
87 #define XD_SIGNAL1(arg) \
89 if (xd_in_read_queued_messages) \
90 Fthrow (Qdbus_error, Qnil); \
92 xsignal1 (Qdbus_error, arg); \
95 #define XD_SIGNAL2(arg1, arg2) \
97 if (xd_in_read_queued_messages) \
98 Fthrow (Qdbus_error, Qnil); \
100 xsignal2 (Qdbus_error, arg1, arg2); \
103 #define XD_SIGNAL3(arg1, arg2, arg3) \
105 if (xd_in_read_queued_messages) \
106 Fthrow (Qdbus_error, Qnil); \
108 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
111 /* Raise a Lisp error from a D-Bus ERROR. */
112 #define XD_ERROR(error) \
114 /* Remove the trailing newline. */ \
115 char const *mess = error.message; \
116 char const *nl = strchr (mess, '\n'); \
117 Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
118 dbus_error_free (&error); \
122 /* Macros for debugging. In order to enable them, build with
123 "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
125 #define XD_DEBUG_MESSAGE(...) \
128 snprintf (s, sizeof s, __VA_ARGS__); \
129 printf ("%s: %s\n", __func__, s); \
130 message ("%s: %s", __func__, s); \
132 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
134 if (!valid_lisp_object_p (object)) \
136 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
137 XD_SIGNAL1 (build_string ("Assertion failure")); \
141 #else /* !DBUS_DEBUG */
142 #define XD_DEBUG_MESSAGE(...) \
144 if (!NILP (Vdbus_debug)) \
147 snprintf (s, 1023, __VA_ARGS__); \
148 message ("%s: %s", __func__, s); \
151 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
154 /* Check whether TYPE is a basic DBusType. */
155 #ifdef DBUS_TYPE_UNIX_FD
156 #define XD_BASIC_DBUS_TYPE(type) \
157 ((type == DBUS_TYPE_BYTE) \
158 || (type == DBUS_TYPE_BOOLEAN) \
159 || (type == DBUS_TYPE_INT16) \
160 || (type == DBUS_TYPE_UINT16) \
161 || (type == DBUS_TYPE_INT32) \
162 || (type == DBUS_TYPE_UINT32) \
163 || (type == DBUS_TYPE_INT64) \
164 || (type == DBUS_TYPE_UINT64) \
165 || (type == DBUS_TYPE_DOUBLE) \
166 || (type == DBUS_TYPE_STRING) \
167 || (type == DBUS_TYPE_OBJECT_PATH) \
168 || (type == DBUS_TYPE_SIGNATURE) \
169 || (type == DBUS_TYPE_UNIX_FD))
171 #define XD_BASIC_DBUS_TYPE(type) \
172 ((type == DBUS_TYPE_BYTE) \
173 || (type == DBUS_TYPE_BOOLEAN) \
174 || (type == DBUS_TYPE_INT16) \
175 || (type == DBUS_TYPE_UINT16) \
176 || (type == DBUS_TYPE_INT32) \
177 || (type == DBUS_TYPE_UINT32) \
178 || (type == DBUS_TYPE_INT64) \
179 || (type == DBUS_TYPE_UINT64) \
180 || (type == DBUS_TYPE_DOUBLE) \
181 || (type == DBUS_TYPE_STRING) \
182 || (type == DBUS_TYPE_OBJECT_PATH) \
183 || (type == DBUS_TYPE_SIGNATURE))
186 /* This was a macro. On Solaris 2.11 it was said to compile for
187 hours, when optimzation is enabled. So we have transferred it into
189 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
190 of the predefined D-Bus type symbols. */
192 xd_symbol_to_dbus_type (Lisp_Object object
)
195 ((EQ (object
, QCdbus_type_byte
)) ? DBUS_TYPE_BYTE
196 : (EQ (object
, QCdbus_type_boolean
)) ? DBUS_TYPE_BOOLEAN
197 : (EQ (object
, QCdbus_type_int16
)) ? DBUS_TYPE_INT16
198 : (EQ (object
, QCdbus_type_uint16
)) ? DBUS_TYPE_UINT16
199 : (EQ (object
, QCdbus_type_int32
)) ? DBUS_TYPE_INT32
200 : (EQ (object
, QCdbus_type_uint32
)) ? DBUS_TYPE_UINT32
201 : (EQ (object
, QCdbus_type_int64
)) ? DBUS_TYPE_INT64
202 : (EQ (object
, QCdbus_type_uint64
)) ? DBUS_TYPE_UINT64
203 : (EQ (object
, QCdbus_type_double
)) ? DBUS_TYPE_DOUBLE
204 : (EQ (object
, QCdbus_type_string
)) ? DBUS_TYPE_STRING
205 : (EQ (object
, QCdbus_type_object_path
)) ? DBUS_TYPE_OBJECT_PATH
206 : (EQ (object
, QCdbus_type_signature
)) ? DBUS_TYPE_SIGNATURE
207 #ifdef DBUS_TYPE_UNIX_FD
208 : (EQ (object
, QCdbus_type_unix_fd
)) ? DBUS_TYPE_UNIX_FD
210 : (EQ (object
, QCdbus_type_array
)) ? DBUS_TYPE_ARRAY
211 : (EQ (object
, QCdbus_type_variant
)) ? DBUS_TYPE_VARIANT
212 : (EQ (object
, QCdbus_type_struct
)) ? DBUS_TYPE_STRUCT
213 : (EQ (object
, QCdbus_type_dict_entry
)) ? DBUS_TYPE_DICT_ENTRY
214 : DBUS_TYPE_INVALID
);
217 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
218 #define XD_DBUS_TYPE_P(object) \
219 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
221 /* Determine the DBusType of a given Lisp OBJECT. It is used to
222 convert Lisp objects, being arguments of `dbus-call-method' or
223 `dbus-send-signal', into corresponding C values appended as
224 arguments to a D-Bus message. */
225 #define XD_OBJECT_TO_DBUS_TYPE(object) \
226 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
227 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
228 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
229 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
230 : (STRINGP (object)) ? DBUS_TYPE_STRING \
231 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
233 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
234 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
236 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
240 /* Return a list pointer which does not have a Lisp symbol as car. */
241 #define XD_NEXT_VALUE(object) \
242 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
244 /* Check whether X is a valid dbus serial number. If valid, set
245 SERIAL to its value. Otherwise, signal an error. */
246 #define CHECK_DBUS_SERIAL_GET_SERIAL(x, serial) \
249 dbus_uint32_t DBUS_SERIAL_MAX = -1; \
250 if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \
252 else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \
254 && 0 <= XFLOAT_DATA (x) \
255 && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \
256 serial = XFLOAT_DATA (x); \
258 XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \
262 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
263 not become too long. */
265 signature_cat (char *signature
, char const *x
)
267 ptrdiff_t siglen
= strlen (signature
);
268 ptrdiff_t xlen
= strlen (x
);
269 if (DBUS_MAXIMUM_SIGNATURE_LENGTH
- xlen
<= siglen
)
271 strcat (signature
, x
);
274 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
275 used in dbus_message_iter_open_container. DTYPE is the DBusType
276 the object is related to. It is passed as argument, because it
277 cannot be detected in basic type objects, when they are preceded by
278 a type symbol. PARENT_TYPE is the DBusType of a container this
279 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
280 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
282 xd_signature (char *signature
, unsigned int dtype
, unsigned int parent_type
, Lisp_Object object
)
284 unsigned int subtype
;
287 char x
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
294 case DBUS_TYPE_UINT16
:
295 case DBUS_TYPE_UINT32
:
296 case DBUS_TYPE_UINT64
:
297 #ifdef DBUS_TYPE_UNIX_FD
298 case DBUS_TYPE_UNIX_FD
:
300 CHECK_NATNUM (object
);
301 sprintf (signature
, "%c", dtype
);
304 case DBUS_TYPE_BOOLEAN
:
305 if (!EQ (object
, Qt
) && !EQ (object
, Qnil
))
306 wrong_type_argument (intern ("booleanp"), object
);
307 sprintf (signature
, "%c", dtype
);
310 case DBUS_TYPE_INT16
:
311 case DBUS_TYPE_INT32
:
312 case DBUS_TYPE_INT64
:
313 CHECK_NUMBER (object
);
314 sprintf (signature
, "%c", dtype
);
317 case DBUS_TYPE_DOUBLE
:
318 CHECK_FLOAT (object
);
319 sprintf (signature
, "%c", dtype
);
322 case DBUS_TYPE_STRING
:
323 case DBUS_TYPE_OBJECT_PATH
:
324 case DBUS_TYPE_SIGNATURE
:
325 CHECK_STRING (object
);
326 sprintf (signature
, "%c", dtype
);
329 case DBUS_TYPE_ARRAY
:
330 /* Check that all list elements have the same D-Bus type. For
331 complex element types, we just check the container type, not
332 the whole element's signature. */
335 /* Type symbol is optional. */
336 if (EQ (QCdbus_type_array
, CAR_SAFE (elt
)))
337 elt
= XD_NEXT_VALUE (elt
);
339 /* If the array is empty, DBUS_TYPE_STRING is the default
343 subtype
= DBUS_TYPE_STRING
;
344 subsig
= DBUS_TYPE_STRING_AS_STRING
;
348 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
349 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
353 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
354 only element, the value of this element is used as he array's
355 element signature. */
356 if ((subtype
== DBUS_TYPE_SIGNATURE
)
357 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt
)))
358 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
359 subsig
= SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt
)));
363 if (subtype
!= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
)))
364 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt
));
365 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
368 if (esnprintf (signature
, DBUS_MAXIMUM_SIGNATURE_LENGTH
,
369 "%c%s", dtype
, subsig
)
370 == DBUS_MAXIMUM_SIGNATURE_LENGTH
- 1)
374 case DBUS_TYPE_VARIANT
:
375 /* Check that there is exactly one list element. */
378 elt
= XD_NEXT_VALUE (elt
);
379 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
380 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
382 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
383 wrong_type_argument (intern ("D-Bus"),
384 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
386 sprintf (signature
, "%c", dtype
);
389 case DBUS_TYPE_STRUCT
:
390 /* A struct list might contain any number of elements with
391 different types. No further check needed. */
394 elt
= XD_NEXT_VALUE (elt
);
396 /* Compose the signature from the elements. It is enclosed by
398 sprintf (signature
, "%c", DBUS_STRUCT_BEGIN_CHAR
);
401 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
402 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
403 signature_cat (signature
, x
);
404 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
406 signature_cat (signature
, DBUS_STRUCT_END_CHAR_AS_STRING
);
409 case DBUS_TYPE_DICT_ENTRY
:
410 /* Check that there are exactly two list elements, and the first
411 one is of basic type. The dictionary entry itself must be an
412 element of an array. */
415 /* Check the parent object type. */
416 if (parent_type
!= DBUS_TYPE_ARRAY
)
417 wrong_type_argument (intern ("D-Bus"), object
);
419 /* Compose the signature from the elements. It is enclosed by
421 sprintf (signature
, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR
);
424 elt
= XD_NEXT_VALUE (elt
);
425 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
426 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
427 signature_cat (signature
, x
);
429 if (!XD_BASIC_DBUS_TYPE (subtype
))
430 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt
)));
432 /* Second element. */
433 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
434 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
435 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
436 signature_cat (signature
, x
);
438 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
439 wrong_type_argument (intern ("D-Bus"),
440 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
442 /* Closing signature. */
443 signature_cat (signature
, DBUS_DICT_ENTRY_END_CHAR_AS_STRING
);
447 wrong_type_argument (intern ("D-Bus"), object
);
450 XD_DEBUG_MESSAGE ("%s", signature
);
453 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
454 DTYPE must be a valid DBusType. It is used to convert Lisp
455 objects, being arguments of `dbus-call-method' or
456 `dbus-send-signal', into corresponding C values appended as
457 arguments to a D-Bus message. */
459 xd_append_arg (unsigned int dtype
, Lisp_Object object
, DBusMessageIter
*iter
)
461 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
462 DBusMessageIter subiter
;
464 if (XD_BASIC_DBUS_TYPE (dtype
))
468 CHECK_NATNUM (object
);
470 unsigned char val
= XFASTINT (object
) & 0xFF;
471 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
472 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
473 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
477 case DBUS_TYPE_BOOLEAN
:
479 dbus_bool_t val
= (NILP (object
)) ? FALSE
: TRUE
;
480 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
481 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
482 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
486 case DBUS_TYPE_INT16
:
487 CHECK_NUMBER (object
);
489 dbus_int16_t val
= XINT (object
);
490 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
491 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
492 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
496 case DBUS_TYPE_UINT16
:
497 CHECK_NATNUM (object
);
499 dbus_uint16_t val
= XFASTINT (object
);
500 XD_DEBUG_MESSAGE ("%c %u", dtype
, (unsigned int) val
);
501 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
502 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
506 case DBUS_TYPE_INT32
:
507 CHECK_NUMBER (object
);
509 dbus_int32_t val
= XINT (object
);
510 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
511 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
512 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
516 case DBUS_TYPE_UINT32
:
517 #ifdef DBUS_TYPE_UNIX_FD
518 case DBUS_TYPE_UNIX_FD
:
520 CHECK_NATNUM (object
);
522 dbus_uint32_t val
= XFASTINT (object
);
523 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
524 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
525 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
529 case DBUS_TYPE_INT64
:
530 CHECK_NUMBER (object
);
532 dbus_int64_t val
= XINT (object
);
533 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
534 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
535 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
539 case DBUS_TYPE_UINT64
:
540 CHECK_NATNUM (object
);
542 dbus_uint64_t val
= XFASTINT (object
);
543 XD_DEBUG_MESSAGE ("%c %"pI
"d", dtype
, XFASTINT (object
));
544 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
545 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
549 case DBUS_TYPE_DOUBLE
:
550 CHECK_FLOAT (object
);
552 double val
= XFLOAT_DATA (object
);
553 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
554 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
555 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
559 case DBUS_TYPE_STRING
:
560 case DBUS_TYPE_OBJECT_PATH
:
561 case DBUS_TYPE_SIGNATURE
:
562 CHECK_STRING (object
);
564 /* We need to send a valid UTF-8 string. We could encode `object'
565 but by not encoding it, we guarantee it's valid utf-8, even if
566 it contains eight-bit-bytes. Of course, you can still send
567 manually-crafted junk by passing a unibyte string. */
568 char *val
= SSDATA (object
);
569 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
570 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
571 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
576 else /* Compound types. */
579 /* All compound types except array have a type symbol. For
580 array, it is optional. Skip it. */
581 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))))
582 object
= XD_NEXT_VALUE (object
);
584 /* Open new subiteration. */
587 case DBUS_TYPE_ARRAY
:
588 /* An array has only elements of the same type. So it is
589 sufficient to check the first element's signature
593 /* If the array is empty, DBUS_TYPE_STRING is the default
595 strcpy (signature
, DBUS_TYPE_STRING_AS_STRING
);
598 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
599 the only element, the value of this element is used as
600 the array's element signature. */
601 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))
602 == DBUS_TYPE_SIGNATURE
)
603 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object
)))
604 && NILP (CDR_SAFE (XD_NEXT_VALUE (object
))))
606 strcpy (signature
, SSDATA (CAR_SAFE (XD_NEXT_VALUE (object
))));
607 object
= CDR_SAFE (XD_NEXT_VALUE (object
));
611 xd_signature (signature
,
612 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
613 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
615 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
616 SDATA (format2 ("%s", object
, Qnil
)));
617 if (!dbus_message_iter_open_container (iter
, dtype
,
618 signature
, &subiter
))
619 XD_SIGNAL3 (build_string ("Cannot open container"),
620 make_number (dtype
), build_string (signature
));
623 case DBUS_TYPE_VARIANT
:
624 /* A variant has just one element. */
625 xd_signature (signature
, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
626 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
628 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
629 SDATA (format2 ("%s", object
, Qnil
)));
630 if (!dbus_message_iter_open_container (iter
, dtype
,
631 signature
, &subiter
))
632 XD_SIGNAL3 (build_string ("Cannot open container"),
633 make_number (dtype
), build_string (signature
));
636 case DBUS_TYPE_STRUCT
:
637 case DBUS_TYPE_DICT_ENTRY
:
638 /* These containers do not require a signature. */
639 XD_DEBUG_MESSAGE ("%c %s", dtype
,
640 SDATA (format2 ("%s", object
, Qnil
)));
641 if (!dbus_message_iter_open_container (iter
, dtype
, NULL
, &subiter
))
642 XD_SIGNAL2 (build_string ("Cannot open container"),
643 make_number (dtype
));
647 /* Loop over list elements. */
648 while (!NILP (object
))
650 dtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
));
651 object
= XD_NEXT_VALUE (object
);
653 xd_append_arg (dtype
, CAR_SAFE (object
), &subiter
);
655 object
= CDR_SAFE (object
);
658 /* Close the subiteration. */
659 if (!dbus_message_iter_close_container (iter
, &subiter
))
660 XD_SIGNAL2 (build_string ("Cannot close container"),
661 make_number (dtype
));
665 /* Retrieve C value from a DBusMessageIter structure ITER, and return
666 a converted Lisp object. The type DTYPE of the argument of the
667 D-Bus message must be a valid DBusType. Compound D-Bus types
668 result always in a Lisp list. */
670 xd_retrieve_arg (unsigned int dtype
, DBusMessageIter
*iter
)
678 dbus_message_iter_get_basic (iter
, &val
);
680 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
681 return make_number (val
);
684 case DBUS_TYPE_BOOLEAN
:
687 dbus_message_iter_get_basic (iter
, &val
);
688 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
689 return (val
== FALSE
) ? Qnil
: Qt
;
692 case DBUS_TYPE_INT16
:
695 dbus_message_iter_get_basic (iter
, &val
);
696 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
697 return make_number (val
);
700 case DBUS_TYPE_UINT16
:
703 dbus_message_iter_get_basic (iter
, &val
);
704 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
705 return make_number (val
);
708 case DBUS_TYPE_INT32
:
711 dbus_message_iter_get_basic (iter
, &val
);
712 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
713 return make_fixnum_or_float (val
);
716 case DBUS_TYPE_UINT32
:
717 #ifdef DBUS_TYPE_UNIX_FD
718 case DBUS_TYPE_UNIX_FD
:
722 dbus_message_iter_get_basic (iter
, &val
);
723 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
724 return make_fixnum_or_float (val
);
727 case DBUS_TYPE_INT64
:
730 dbus_message_iter_get_basic (iter
, &val
);
731 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
732 return make_fixnum_or_float (val
);
735 case DBUS_TYPE_UINT64
:
738 dbus_message_iter_get_basic (iter
, &val
);
739 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
740 return make_fixnum_or_float (val
);
743 case DBUS_TYPE_DOUBLE
:
746 dbus_message_iter_get_basic (iter
, &val
);
747 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
748 return make_float (val
);
751 case DBUS_TYPE_STRING
:
752 case DBUS_TYPE_OBJECT_PATH
:
753 case DBUS_TYPE_SIGNATURE
:
756 dbus_message_iter_get_basic (iter
, &val
);
757 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
758 return build_string (val
);
761 case DBUS_TYPE_ARRAY
:
762 case DBUS_TYPE_VARIANT
:
763 case DBUS_TYPE_STRUCT
:
764 case DBUS_TYPE_DICT_ENTRY
:
768 DBusMessageIter subiter
;
772 dbus_message_iter_recurse (iter
, &subiter
);
773 while ((subtype
= dbus_message_iter_get_arg_type (&subiter
))
774 != DBUS_TYPE_INVALID
)
776 result
= Fcons (xd_retrieve_arg (subtype
, &subiter
), result
);
777 dbus_message_iter_next (&subiter
);
779 XD_DEBUG_MESSAGE ("%c %s", dtype
, SDATA (format2 ("%s", result
, Qnil
)));
780 RETURN_UNGCPRO (Fnreverse (result
));
784 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype
);
789 /* Initialize D-Bus connection. BUS is either a Lisp symbol, :system
790 or :session, or a string denoting the bus address. It tells which
791 D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error
792 when the connection cannot be initialized. */
793 static DBusConnection
*
794 xd_initialize (Lisp_Object bus
, int raise_error
)
796 DBusConnection
*connection
;
799 /* Parameter check. */
803 if (!(EQ (bus
, QCdbus_system_bus
) || EQ (bus
, QCdbus_session_bus
)))
806 XD_SIGNAL2 (build_string ("Wrong bus name"), bus
);
811 /* We do not want to have an autolaunch for the session bus. */
812 if (EQ (bus
, QCdbus_session_bus
)
813 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL
)
816 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
822 /* Open a connection to the bus. */
823 dbus_error_init (&derror
);
826 connection
= dbus_connection_open (SSDATA (bus
), &derror
);
828 if (EQ (bus
, QCdbus_system_bus
))
829 connection
= dbus_bus_get (DBUS_BUS_SYSTEM
, &derror
);
831 connection
= dbus_bus_get (DBUS_BUS_SESSION
, &derror
);
833 if (dbus_error_is_set (&derror
))
841 /* If it is not the system or session bus, we must register
842 ourselves. Otherwise, we have called dbus_bus_get, which has
843 configured us to exit if the connection closes - we undo this
845 if (connection
!= NULL
)
848 dbus_bus_register (connection
, &derror
);
850 dbus_connection_set_exit_on_disconnect (connection
, FALSE
);
853 if (dbus_error_is_set (&derror
))
861 if (connection
== NULL
&& raise_error
)
862 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
865 dbus_error_free (&derror
);
867 /* Return the result. */
871 /* Return the file descriptor for WATCH, -1 if not found. */
873 xd_find_watch_fd (DBusWatch
*watch
)
875 #if HAVE_DBUS_WATCH_GET_UNIX_FD
876 /* TODO: Reverse these on Win32, which prefers the opposite. */
877 int fd
= dbus_watch_get_unix_fd (watch
);
879 fd
= dbus_watch_get_socket (watch
);
881 int fd
= dbus_watch_get_fd (watch
);
888 xd_read_queued_messages (int fd
, void *data
, int for_read
);
890 /* Start monitoring WATCH for possible I/O. */
892 xd_add_watch (DBusWatch
*watch
, void *data
)
894 unsigned int flags
= dbus_watch_get_flags (watch
);
895 int fd
= xd_find_watch_fd (watch
);
897 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
898 fd
, flags
& DBUS_WATCH_WRITABLE
,
899 dbus_watch_get_enabled (watch
));
904 if (dbus_watch_get_enabled (watch
))
906 if (flags
& DBUS_WATCH_WRITABLE
)
907 add_write_fd (fd
, xd_read_queued_messages
, data
);
908 if (flags
& DBUS_WATCH_READABLE
)
909 add_read_fd (fd
, xd_read_queued_messages
, data
);
914 /* Stop monitoring WATCH for possible I/O.
915 DATA is the used bus, either a string or QCdbus_system_bus or
916 QCdbus_session_bus. */
918 xd_remove_watch (DBusWatch
*watch
, void *data
)
920 unsigned int flags
= dbus_watch_get_flags (watch
);
921 int fd
= xd_find_watch_fd (watch
);
923 XD_DEBUG_MESSAGE ("fd %d", fd
);
928 /* Unset session environment. */
929 if (XSYMBOL (QCdbus_session_bus
) == data
)
931 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
932 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
935 if (flags
& DBUS_WATCH_WRITABLE
)
936 delete_write_fd (fd
);
937 if (flags
& DBUS_WATCH_READABLE
)
941 /* Toggle monitoring WATCH for possible I/O. */
943 xd_toggle_watch (DBusWatch
*watch
, void *data
)
945 if (dbus_watch_get_enabled (watch
))
946 xd_add_watch (watch
, data
);
948 xd_remove_watch (watch
, data
);
951 DEFUN ("dbus-init-bus", Fdbus_init_bus
, Sdbus_init_bus
, 1, 1, 0,
952 doc
: /* Initialize connection to D-Bus BUS. */)
955 DBusConnection
*connection
;
958 /* Check parameter. */
960 busp
= XSYMBOL (bus
);
961 else if (STRINGP (bus
))
962 busp
= XSTRING (bus
);
964 wrong_type_argument (intern ("D-Bus"), bus
);
966 /* Open a connection to the bus. */
967 connection
= xd_initialize (bus
, TRUE
);
969 /* Add the watch functions. We pass also the bus as data, in order
970 to distinguish between the busses in xd_remove_watch. */
971 if (!dbus_connection_set_watch_functions (connection
,
976 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
978 /* Add bus to list of registered buses. */
979 Vdbus_registered_buses
= Fcons (bus
, Vdbus_registered_buses
);
981 /* We do not want to abort. */
982 putenv ((char *) "DBUS_FATAL_WARNINGS=0");
988 DEFUN ("dbus-close-bus", Fdbus_close_bus
, Sdbus_close_bus
, 1, 1, 0,
989 doc
: /* Close connection to D-Bus BUS. */)
992 DBusConnection
*connection
;
994 /* Open a connection to the bus. */
995 connection
= xd_initialize (bus
, TRUE
);
997 /* Decrement reference count to the bus. */
998 dbus_connection_unref (connection
);
1000 /* Remove bus from list of registered buses. */
1001 Vdbus_registered_buses
= Fdelete (bus
, Vdbus_registered_buses
);
1007 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name
, Sdbus_get_unique_name
,
1009 doc
: /* Return the unique name of Emacs registered at D-Bus BUS. */)
1012 DBusConnection
*connection
;
1015 /* Open a connection to the bus. */
1016 connection
= xd_initialize (bus
, TRUE
);
1018 /* Request the name. */
1019 name
= dbus_bus_get_unique_name (connection
);
1021 XD_SIGNAL1 (build_string ("No unique name available"));
1024 return build_string (name
);
1027 DEFUN ("dbus-call-method", Fdbus_call_method
, Sdbus_call_method
, 5, MANY
, 0,
1028 doc
: /* Call METHOD on the D-Bus BUS.
1030 BUS is either a Lisp symbol, `:system' or `:session', or a string
1031 denoting the bus address.
1033 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
1034 object path SERVICE is registered at. INTERFACE is an interface
1035 offered by SERVICE. It must provide METHOD.
1037 If the parameter `:timeout' is given, the following integer TIMEOUT
1038 specifies the maximum number of milliseconds the method call must
1039 return. The default value is 25,000. If the method call doesn't
1040 return in time, a D-Bus error is raised.
1042 All other arguments ARGS are passed to METHOD as arguments. They are
1043 converted into D-Bus types via the following rules:
1045 t and nil => DBUS_TYPE_BOOLEAN
1046 number => DBUS_TYPE_UINT32
1047 integer => DBUS_TYPE_INT32
1048 float => DBUS_TYPE_DOUBLE
1049 string => DBUS_TYPE_STRING
1050 list => DBUS_TYPE_ARRAY
1052 All arguments can be preceded by a type symbol. For details about
1053 type symbols, see Info node `(dbus)Type Conversion'.
1055 `dbus-call-method' returns the resulting values of METHOD as a list of
1056 Lisp objects. The type conversion happens the other direction as for
1057 input arguments. It follows the mapping rules:
1059 DBUS_TYPE_BOOLEAN => t or nil
1060 DBUS_TYPE_BYTE => number
1061 DBUS_TYPE_UINT16 => number
1062 DBUS_TYPE_INT16 => integer
1063 DBUS_TYPE_UINT32 => number or float
1064 DBUS_TYPE_UNIX_FD => number or float
1065 DBUS_TYPE_INT32 => integer or float
1066 DBUS_TYPE_UINT64 => number or float
1067 DBUS_TYPE_INT64 => integer or float
1068 DBUS_TYPE_DOUBLE => float
1069 DBUS_TYPE_STRING => string
1070 DBUS_TYPE_OBJECT_PATH => string
1071 DBUS_TYPE_SIGNATURE => string
1072 DBUS_TYPE_ARRAY => list
1073 DBUS_TYPE_VARIANT => list
1074 DBUS_TYPE_STRUCT => list
1075 DBUS_TYPE_DICT_ENTRY => list
1080 :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
1081 "org.gnome.seahorse.Keys" "GetKeyField"
1082 "openpgp:657984B8C7A966DD" "simple-name")
1084 => (t ("Philip R. Zimmermann"))
1086 If the result of the METHOD call is just one value, the converted Lisp
1087 object is returned instead of a list containing this single Lisp object.
1090 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1091 "org.freedesktop.Hal.Device" "GetPropertyString"
1092 "system.kernel.machine")
1096 usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
1097 (ptrdiff_t nargs
, Lisp_Object
*args
)
1099 Lisp_Object bus
, service
, path
, interface
, method
;
1101 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
1102 DBusConnection
*connection
;
1103 DBusMessage
*dmessage
;
1105 DBusMessageIter iter
;
1110 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1112 /* Check parameters. */
1116 interface
= args
[3];
1119 CHECK_STRING (service
);
1120 CHECK_STRING (path
);
1121 CHECK_STRING (interface
);
1122 CHECK_STRING (method
);
1123 GCPRO5 (bus
, service
, path
, interface
, method
);
1125 XD_DEBUG_MESSAGE ("%s %s %s %s",
1131 /* Open a connection to the bus. */
1132 connection
= xd_initialize (bus
, TRUE
);
1134 /* Create the message. */
1135 dmessage
= dbus_message_new_method_call (SSDATA (service
),
1140 if (dmessage
== NULL
)
1141 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1143 /* Check for timeout parameter. */
1144 if ((i
+2 <= nargs
) && (EQ ((args
[i
]), QCdbus_timeout
)))
1146 CHECK_NATNUM (args
[i
+1]);
1147 timeout
= XFASTINT (args
[i
+1]);
1151 /* Initialize parameter list of message. */
1152 dbus_message_iter_init_append (dmessage
, &iter
);
1154 /* Append parameters to the message. */
1155 for (; i
< nargs
; ++i
)
1157 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1158 if (XD_DBUS_TYPE_P (args
[i
]))
1160 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1161 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1162 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s %s", i
- 4,
1163 SDATA (format2 ("%s", args
[i
], Qnil
)),
1164 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1169 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1170 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s", i
- 4,
1171 SDATA (format2 ("%s", args
[i
], Qnil
)));
1174 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1175 indication that there is no parent type. */
1176 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1178 xd_append_arg (dtype
, args
[i
], &iter
);
1181 /* Send the message. */
1182 dbus_error_init (&derror
);
1183 reply
= dbus_connection_send_with_reply_and_block (connection
,
1188 if (dbus_error_is_set (&derror
))
1192 XD_SIGNAL1 (build_string ("No reply"));
1194 XD_DEBUG_MESSAGE ("Message sent");
1196 /* Collect the results. */
1200 if (dbus_message_iter_init (reply
, &iter
))
1202 /* Loop over the parameters of the D-Bus reply message. Construct a
1203 Lisp list, which is returned by `dbus-call-method'. */
1204 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
1205 != DBUS_TYPE_INVALID
)
1207 result
= Fcons (xd_retrieve_arg (dtype
, &iter
), result
);
1208 dbus_message_iter_next (&iter
);
1213 /* No arguments: just return nil. */
1217 dbus_error_free (&derror
);
1218 dbus_message_unref (dmessage
);
1219 dbus_message_unref (reply
);
1221 /* Return the result. If there is only one single Lisp object,
1222 return it as-it-is, otherwise return the reversed list. */
1223 if (XFASTINT (Flength (result
)) == 1)
1224 RETURN_UNGCPRO (CAR_SAFE (result
));
1226 RETURN_UNGCPRO (Fnreverse (result
));
1229 DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously
,
1230 Sdbus_call_method_asynchronously
, 6, MANY
, 0,
1231 doc
: /* Call METHOD on the D-Bus BUS asynchronously.
1233 BUS is either a Lisp symbol, `:system' or `:session', or a string
1234 denoting the bus address.
1236 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
1237 object path SERVICE is registered at. INTERFACE is an interface
1238 offered by SERVICE. It must provide METHOD.
1240 HANDLER is a Lisp function, which is called when the corresponding
1241 return message has arrived. If HANDLER is nil, no return message will
1244 If the parameter `:timeout' is given, the following integer TIMEOUT
1245 specifies the maximum number of milliseconds the method call must
1246 return. The default value is 25,000. If the method call doesn't
1247 return in time, a D-Bus error is raised.
1249 All other arguments ARGS are passed to METHOD as arguments. They are
1250 converted into D-Bus types via the following rules:
1252 t and nil => DBUS_TYPE_BOOLEAN
1253 number => DBUS_TYPE_UINT32
1254 integer => DBUS_TYPE_INT32
1255 float => DBUS_TYPE_DOUBLE
1256 string => DBUS_TYPE_STRING
1257 list => DBUS_TYPE_ARRAY
1259 All arguments can be preceded by a type symbol. For details about
1260 type symbols, see Info node `(dbus)Type Conversion'.
1262 Unless HANDLER is nil, the function returns a key into the hash table
1263 `dbus-registered-objects-table'. The corresponding entry in the hash
1264 table is removed, when the return message has been arrived, and
1269 \(dbus-call-method-asynchronously
1270 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1271 "org.freedesktop.Hal.Device" "GetPropertyString" 'message
1272 "system.kernel.machine")
1278 usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
1279 (ptrdiff_t nargs
, Lisp_Object
*args
)
1281 Lisp_Object bus
, service
, path
, interface
, method
, handler
;
1283 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1284 DBusConnection
*connection
;
1285 DBusMessage
*dmessage
;
1286 DBusMessageIter iter
;
1288 dbus_uint32_t serial
;
1291 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1293 /* Check parameters. */
1297 interface
= args
[3];
1301 CHECK_STRING (service
);
1302 CHECK_STRING (path
);
1303 CHECK_STRING (interface
);
1304 CHECK_STRING (method
);
1305 if (!NILP (handler
) && !FUNCTIONP (handler
))
1306 wrong_type_argument (Qinvalid_function
, handler
);
1307 GCPRO6 (bus
, service
, path
, interface
, method
, handler
);
1309 XD_DEBUG_MESSAGE ("%s %s %s %s",
1315 /* Open a connection to the bus. */
1316 connection
= xd_initialize (bus
, TRUE
);
1318 /* Create the message. */
1319 dmessage
= dbus_message_new_method_call (SSDATA (service
),
1323 if (dmessage
== NULL
)
1324 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1326 /* Check for timeout parameter. */
1327 if ((i
+2 <= nargs
) && (EQ ((args
[i
]), QCdbus_timeout
)))
1329 CHECK_NATNUM (args
[i
+1]);
1330 timeout
= XFASTINT (args
[i
+1]);
1334 /* Initialize parameter list of message. */
1335 dbus_message_iter_init_append (dmessage
, &iter
);
1337 /* Append parameters to the message. */
1338 for (; i
< nargs
; ++i
)
1340 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1341 if (XD_DBUS_TYPE_P (args
[i
]))
1343 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1344 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1345 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s %s", i
- 4,
1346 SDATA (format2 ("%s", args
[i
], Qnil
)),
1347 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1352 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1353 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s", i
- 4,
1354 SDATA (format2 ("%s", args
[i
], Qnil
)));
1357 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1358 indication that there is no parent type. */
1359 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1361 xd_append_arg (dtype
, args
[i
], &iter
);
1364 if (!NILP (handler
))
1366 /* Send the message. The message is just added to the outgoing
1368 if (!dbus_connection_send_with_reply (connection
, dmessage
,
1370 XD_SIGNAL1 (build_string ("Cannot send message"));
1372 /* The result is the key in Vdbus_registered_objects_table. */
1373 serial
= dbus_message_get_serial (dmessage
);
1374 result
= list2 (bus
, make_fixnum_or_float (serial
));
1376 /* Create a hash table entry. */
1377 Fputhash (result
, handler
, Vdbus_registered_objects_table
);
1381 /* Send the message. The message is just added to the outgoing
1383 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1384 XD_SIGNAL1 (build_string ("Cannot send message"));
1389 XD_DEBUG_MESSAGE ("Message sent");
1392 dbus_message_unref (dmessage
);
1394 /* Return the result. */
1395 RETURN_UNGCPRO (result
);
1398 DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal
,
1399 Sdbus_method_return_internal
,
1401 doc
: /* Return for message SERIAL on the D-Bus BUS.
1402 This is an internal function, it shall not be used outside dbus.el.
1404 usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
1405 (ptrdiff_t nargs
, Lisp_Object
*args
)
1407 Lisp_Object bus
, service
;
1408 struct gcpro gcpro1
, gcpro2
;
1409 DBusConnection
*connection
;
1410 DBusMessage
*dmessage
;
1411 DBusMessageIter iter
;
1412 dbus_uint32_t serial
;
1413 unsigned int ui_serial
, dtype
;
1415 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1417 /* Check parameters. */
1421 CHECK_DBUS_SERIAL_GET_SERIAL (args
[1], serial
);
1422 CHECK_STRING (service
);
1423 GCPRO2 (bus
, service
);
1426 XD_DEBUG_MESSAGE ("%u %s ", ui_serial
, SSDATA (service
));
1428 /* Open a connection to the bus. */
1429 connection
= xd_initialize (bus
, TRUE
);
1431 /* Create the message. */
1432 dmessage
= dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN
);
1433 if ((dmessage
== NULL
)
1434 || (!dbus_message_set_reply_serial (dmessage
, serial
))
1435 || (!dbus_message_set_destination (dmessage
, SSDATA (service
))))
1438 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1443 /* Initialize parameter list of message. */
1444 dbus_message_iter_init_append (dmessage
, &iter
);
1446 /* Append parameters to the message. */
1447 for (i
= 3; i
< nargs
; ++i
)
1449 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1450 if (XD_DBUS_TYPE_P (args
[i
]))
1452 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1453 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1454 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s %s", i
- 2,
1455 SDATA (format2 ("%s", args
[i
], Qnil
)),
1456 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1461 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1462 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s", i
- 2,
1463 SDATA (format2 ("%s", args
[i
], Qnil
)));
1466 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1467 indication that there is no parent type. */
1468 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1470 xd_append_arg (dtype
, args
[i
], &iter
);
1473 /* Send the message. The message is just added to the outgoing
1475 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1476 XD_SIGNAL1 (build_string ("Cannot send message"));
1478 XD_DEBUG_MESSAGE ("Message sent");
1481 dbus_message_unref (dmessage
);
1487 DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal
,
1488 Sdbus_method_error_internal
,
1490 doc
: /* Return error message for message SERIAL on the D-Bus BUS.
1491 This is an internal function, it shall not be used outside dbus.el.
1493 usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
1494 (ptrdiff_t nargs
, Lisp_Object
*args
)
1496 Lisp_Object bus
, service
;
1497 struct gcpro gcpro1
, gcpro2
;
1498 DBusConnection
*connection
;
1499 DBusMessage
*dmessage
;
1500 DBusMessageIter iter
;
1501 dbus_uint32_t serial
;
1502 unsigned int ui_serial
, dtype
;
1504 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1506 /* Check parameters. */
1510 CHECK_DBUS_SERIAL_GET_SERIAL (args
[1], serial
);
1511 CHECK_STRING (service
);
1512 GCPRO2 (bus
, service
);
1515 XD_DEBUG_MESSAGE ("%u %s ", ui_serial
, SSDATA (service
));
1517 /* Open a connection to the bus. */
1518 connection
= xd_initialize (bus
, TRUE
);
1520 /* Create the message. */
1521 dmessage
= dbus_message_new (DBUS_MESSAGE_TYPE_ERROR
);
1522 if ((dmessage
== NULL
)
1523 || (!dbus_message_set_error_name (dmessage
, DBUS_ERROR_FAILED
))
1524 || (!dbus_message_set_reply_serial (dmessage
, serial
))
1525 || (!dbus_message_set_destination (dmessage
, SSDATA (service
))))
1528 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1533 /* Initialize parameter list of message. */
1534 dbus_message_iter_init_append (dmessage
, &iter
);
1536 /* Append parameters to the message. */
1537 for (i
= 3; i
< nargs
; ++i
)
1539 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1540 if (XD_DBUS_TYPE_P (args
[i
]))
1542 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1543 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1544 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s %s", i
- 2,
1545 SDATA (format2 ("%s", args
[i
], Qnil
)),
1546 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1551 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1552 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s", i
- 2,
1553 SDATA (format2 ("%s", args
[i
], Qnil
)));
1556 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1557 indication that there is no parent type. */
1558 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1560 xd_append_arg (dtype
, args
[i
], &iter
);
1563 /* Send the message. The message is just added to the outgoing
1565 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1566 XD_SIGNAL1 (build_string ("Cannot send message"));
1568 XD_DEBUG_MESSAGE ("Message sent");
1571 dbus_message_unref (dmessage
);
1577 DEFUN ("dbus-send-signal", Fdbus_send_signal
, Sdbus_send_signal
, 5, MANY
, 0,
1578 doc
: /* Send signal SIGNAL on the D-Bus BUS.
1580 BUS is either a Lisp symbol, `:system' or `:session', or a string
1581 denoting the bus address.
1583 SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
1584 D-Bus object path SERVICE is registered at. INTERFACE is an interface
1585 offered by SERVICE. It must provide signal SIGNAL.
1587 All other arguments ARGS are passed to SIGNAL as arguments. They are
1588 converted into D-Bus types via the following rules:
1590 t and nil => DBUS_TYPE_BOOLEAN
1591 number => DBUS_TYPE_UINT32
1592 integer => DBUS_TYPE_INT32
1593 float => DBUS_TYPE_DOUBLE
1594 string => DBUS_TYPE_STRING
1595 list => DBUS_TYPE_ARRAY
1597 All arguments can be preceded by a type symbol. For details about
1598 type symbols, see Info node `(dbus)Type Conversion'.
1603 :session "org.gnu.Emacs" "/org/gnu/Emacs"
1604 "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1606 usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
1607 (ptrdiff_t nargs
, Lisp_Object
*args
)
1609 Lisp_Object bus
, service
, path
, interface
, signal
;
1610 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
1611 DBusConnection
*connection
;
1612 DBusMessage
*dmessage
;
1613 DBusMessageIter iter
;
1616 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1618 /* Check parameters. */
1622 interface
= args
[3];
1625 CHECK_STRING (service
);
1626 CHECK_STRING (path
);
1627 CHECK_STRING (interface
);
1628 CHECK_STRING (signal
);
1629 GCPRO5 (bus
, service
, path
, interface
, signal
);
1631 XD_DEBUG_MESSAGE ("%s %s %s %s",
1637 /* Open a connection to the bus. */
1638 connection
= xd_initialize (bus
, TRUE
);
1640 /* Create the message. */
1641 dmessage
= dbus_message_new_signal (SSDATA (path
),
1645 if (dmessage
== NULL
)
1646 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1648 /* Initialize parameter list of message. */
1649 dbus_message_iter_init_append (dmessage
, &iter
);
1651 /* Append parameters to the message. */
1652 for (i
= 5; i
< nargs
; ++i
)
1654 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1655 if (XD_DBUS_TYPE_P (args
[i
]))
1657 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1658 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1659 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s %s", i
- 4,
1660 SDATA (format2 ("%s", args
[i
], Qnil
)),
1661 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1666 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1667 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s", i
- 4,
1668 SDATA (format2 ("%s", args
[i
], Qnil
)));
1671 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1672 indication that there is no parent type. */
1673 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1675 xd_append_arg (dtype
, args
[i
], &iter
);
1678 /* Send the message. The message is just added to the outgoing
1680 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1681 XD_SIGNAL1 (build_string ("Cannot send message"));
1683 XD_DEBUG_MESSAGE ("Signal sent");
1686 dbus_message_unref (dmessage
);
1692 /* Read one queued incoming message of the D-Bus BUS.
1693 BUS is either a Lisp symbol, :system or :session, or a string denoting
1696 xd_read_message_1 (DBusConnection
*connection
, Lisp_Object bus
)
1698 Lisp_Object args
, key
, value
;
1699 struct gcpro gcpro1
;
1700 struct input_event event
;
1701 DBusMessage
*dmessage
;
1702 DBusMessageIter iter
;
1705 dbus_uint32_t serial
;
1706 unsigned int ui_serial
;
1707 const char *uname
, *path
, *interface
, *member
;
1709 dmessage
= dbus_connection_pop_message (connection
);
1711 /* Return if there is no queued message. */
1712 if (dmessage
== NULL
)
1715 /* Collect the parameters. */
1719 /* Loop over the resulting parameters. Construct a list. */
1720 if (dbus_message_iter_init (dmessage
, &iter
))
1722 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
1723 != DBUS_TYPE_INVALID
)
1725 args
= Fcons (xd_retrieve_arg (dtype
, &iter
), args
);
1726 dbus_message_iter_next (&iter
);
1728 /* The arguments are stored in reverse order. Reorder them. */
1729 args
= Fnreverse (args
);
1732 /* Read message type, message serial, unique name, object path,
1733 interface and member from the message. */
1734 mtype
= dbus_message_get_type (dmessage
);
1735 ui_serial
= serial
=
1736 ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1737 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1738 ? dbus_message_get_reply_serial (dmessage
)
1739 : dbus_message_get_serial (dmessage
);
1740 uname
= dbus_message_get_sender (dmessage
);
1741 path
= dbus_message_get_path (dmessage
);
1742 interface
= dbus_message_get_interface (dmessage
);
1743 member
= dbus_message_get_member (dmessage
);
1745 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1746 (mtype
== DBUS_MESSAGE_TYPE_INVALID
)
1747 ? "DBUS_MESSAGE_TYPE_INVALID"
1748 : (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1749 ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1750 : (mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1751 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1752 : (mtype
== DBUS_MESSAGE_TYPE_ERROR
)
1753 ? "DBUS_MESSAGE_TYPE_ERROR"
1754 : "DBUS_MESSAGE_TYPE_SIGNAL",
1755 ui_serial
, uname
, path
, interface
, member
,
1756 SDATA (format2 ("%s", args
, Qnil
)));
1758 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1759 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1761 /* Search for a registered function of the message. */
1762 key
= list2 (bus
, make_fixnum_or_float (serial
));
1763 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1765 /* There shall be exactly one entry. Construct an event. */
1769 /* Remove the entry. */
1770 Fremhash (key
, Vdbus_registered_objects_table
);
1772 /* Construct an event. */
1774 event
.kind
= DBUS_EVENT
;
1775 event
.frame_or_window
= Qnil
;
1776 event
.arg
= Fcons (value
, args
);
1779 else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
1781 /* Vdbus_registered_objects_table requires non-nil interface and
1783 if ((interface
== NULL
) || (member
== NULL
))
1786 /* Search for a registered function of the message. */
1787 key
= list3 (bus
, build_string (interface
), build_string (member
));
1788 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1790 /* Loop over the registered functions. Construct an event. */
1791 while (!NILP (value
))
1793 key
= CAR_SAFE (value
);
1794 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1795 if (((uname
== NULL
)
1796 || (NILP (CAR_SAFE (key
)))
1797 || (strcmp (uname
, SSDATA (CAR_SAFE (key
))) == 0))
1799 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1801 SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1803 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))))
1806 event
.kind
= DBUS_EVENT
;
1807 event
.frame_or_window
= Qnil
;
1809 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))), args
);
1812 value
= CDR_SAFE (value
);
1819 /* Add type, serial, uname, path, interface and member to the event. */
1820 event
.arg
= Fcons ((member
== NULL
? Qnil
: build_string (member
)),
1822 event
.arg
= Fcons ((interface
== NULL
? Qnil
: build_string (interface
)),
1824 event
.arg
= Fcons ((path
== NULL
? Qnil
: build_string (path
)),
1826 event
.arg
= Fcons ((uname
== NULL
? Qnil
: build_string (uname
)),
1828 event
.arg
= Fcons (make_fixnum_or_float (serial
), event
.arg
);
1829 event
.arg
= Fcons (make_number (mtype
), event
.arg
);
1831 /* Add the bus symbol to the event. */
1832 event
.arg
= Fcons (bus
, event
.arg
);
1834 /* Store it into the input event queue. */
1835 kbd_buffer_store_event (&event
);
1837 XD_DEBUG_MESSAGE ("Event stored: %s",
1838 SDATA (format2 ("%s", event
.arg
, Qnil
)));
1842 dbus_message_unref (dmessage
);
1847 /* Read queued incoming messages of the D-Bus BUS.
1848 BUS is either a Lisp symbol, :system or :session, or a string denoting
1851 xd_read_message (Lisp_Object bus
)
1853 /* Open a connection to the bus. */
1854 DBusConnection
*connection
= xd_initialize (bus
, TRUE
);
1856 /* Non blocking read of the next available message. */
1857 dbus_connection_read_write (connection
, 0);
1859 while (dbus_connection_get_dispatch_status (connection
)
1860 != DBUS_DISPATCH_COMPLETE
)
1861 xd_read_message_1 (connection
, bus
);
1865 /* Callback called when something is ready to read or write. */
1867 xd_read_queued_messages (int fd
, void *data
, int for_read
)
1869 Lisp_Object busp
= Vdbus_registered_buses
;
1870 Lisp_Object bus
= Qnil
;
1872 /* Find bus related to fd. */
1874 while (!NILP (busp
))
1876 if ((SYMBOLP (CAR_SAFE (busp
)) && XSYMBOL (CAR_SAFE (busp
)) == data
)
1877 || (STRINGP (CAR_SAFE (busp
)) && XSTRING (CAR_SAFE (busp
)) == data
))
1878 bus
= CAR_SAFE (busp
);
1879 busp
= CDR_SAFE (busp
);
1885 /* We ignore all Lisp errors during the call. */
1886 xd_in_read_queued_messages
= 1;
1887 internal_catch (Qdbus_error
, xd_read_message
, bus
);
1888 xd_in_read_queued_messages
= 0;
1891 DEFUN ("dbus-register-service", Fdbus_register_service
, Sdbus_register_service
,
1893 doc
: /* Register known name SERVICE on the D-Bus BUS.
1895 BUS is either a Lisp symbol, `:system' or `:session', or a string
1896 denoting the bus address.
1898 SERVICE is the D-Bus service name that should be registered. It must
1901 FLAGS are keywords, which control how the service name is registered.
1902 The following keywords are recognized:
1904 `:allow-replacement': Allow another service to become the primary
1907 `:replace-existing': Request to replace the current primary owner.
1909 `:do-not-queue': If we can not become the primary owner do not place
1912 The function returns a keyword, indicating the result of the
1913 operation. One of the following keywords is returned:
1915 `:primary-owner': Service has become the primary owner of the
1918 `:in-queue': Service could not become the primary owner and has been
1919 placed in the queue.
1921 `:exists': Service is already in the queue.
1923 `:already-owner': Service is already the primary owner.
1927 \(dbus-register-service :session dbus-service-emacs)
1931 \(dbus-register-service
1932 :session "org.freedesktop.TextEditor"
1933 dbus-service-allow-replacement dbus-service-replace-existing)
1937 usage: (dbus-register-service BUS SERVICE &rest FLAGS) */)
1938 (ptrdiff_t nargs
, Lisp_Object
*args
)
1940 Lisp_Object bus
, service
;
1941 DBusConnection
*connection
;
1944 unsigned int flags
= 0;
1951 /* Check parameters. */
1952 CHECK_STRING (service
);
1954 /* Process flags. */
1955 for (i
= 2; i
< nargs
; ++i
) {
1956 value
= ((EQ (args
[i
], QCdbus_request_name_replace_existing
))
1957 ? DBUS_NAME_FLAG_REPLACE_EXISTING
1958 : (EQ (args
[i
], QCdbus_request_name_allow_replacement
))
1959 ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
1960 : (EQ (args
[i
], QCdbus_request_name_do_not_queue
))
1961 ? DBUS_NAME_FLAG_DO_NOT_QUEUE
1964 XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args
[i
]);
1968 /* Open a connection to the bus. */
1969 connection
= xd_initialize (bus
, TRUE
);
1971 /* Request the known name from the bus. */
1972 dbus_error_init (&derror
);
1973 result
= dbus_bus_request_name (connection
, SSDATA (service
), flags
,
1975 if (dbus_error_is_set (&derror
))
1979 dbus_error_free (&derror
);
1981 /* Return object. */
1984 case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER
:
1985 return QCdbus_request_name_reply_primary_owner
;
1986 case DBUS_REQUEST_NAME_REPLY_IN_QUEUE
:
1987 return QCdbus_request_name_reply_in_queue
;
1988 case DBUS_REQUEST_NAME_REPLY_EXISTS
:
1989 return QCdbus_request_name_reply_exists
;
1990 case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER
:
1991 return QCdbus_request_name_reply_already_owner
;
1993 /* This should not happen. */
1994 XD_SIGNAL2 (build_string ("Could not register service"), service
);
1998 DEFUN ("dbus-register-signal", Fdbus_register_signal
, Sdbus_register_signal
,
2000 doc
: /* Register for signal SIGNAL on the D-Bus BUS.
2002 BUS is either a Lisp symbol, `:system' or `:session', or a string
2003 denoting the bus address.
2005 SERVICE is the D-Bus service name used by the sending D-Bus object.
2006 It can be either a known name or the unique name of the D-Bus object
2007 sending the signal. When SERVICE is nil, related signals from all
2008 D-Bus objects shall be accepted.
2010 PATH is the D-Bus object path SERVICE is registered. It can also be
2011 nil if the path name of incoming signals shall not be checked.
2013 INTERFACE is an interface offered by SERVICE. It must provide SIGNAL.
2014 HANDLER is a Lisp function to be called when the signal is received.
2015 It must accept as arguments the values SIGNAL is sending.
2017 All other arguments ARGS, if specified, must be strings. They stand
2018 for the respective arguments of the signal in their order, and are
2019 used for filtering as well. A nil argument might be used to preserve
2022 INTERFACE, SIGNAL and HANDLER must not be nil. Example:
2024 \(defun my-signal-handler (device)
2025 (message "Device %s added" device))
2027 \(dbus-register-signal
2028 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
2029 "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
2031 => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
2032 ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
2034 `dbus-register-signal' returns an object, which can be used in
2035 `dbus-unregister-object' for removing the registration.
2037 usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
2038 (ptrdiff_t nargs
, Lisp_Object
*args
)
2040 Lisp_Object bus
, service
, path
, interface
, signal
, handler
;
2041 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
2042 Lisp_Object uname
, key
, key1
, value
;
2043 DBusConnection
*connection
;
2045 char rule
[DBUS_MAXIMUM_MATCH_RULE_LENGTH
];
2049 /* Check parameters. */
2053 interface
= args
[3];
2057 if (!NILP (service
)) CHECK_STRING (service
);
2058 if (!NILP (path
)) CHECK_STRING (path
);
2059 CHECK_STRING (interface
);
2060 CHECK_STRING (signal
);
2061 if (!FUNCTIONP (handler
))
2062 wrong_type_argument (Qinvalid_function
, handler
);
2063 GCPRO6 (bus
, service
, path
, interface
, signal
, handler
);
2065 /* Retrieve unique name of service. If service is a known name, we
2066 will register for the corresponding unique name, if any. Signals
2067 are sent always with the unique name as sender. Note: the unique
2068 name of "org.freedesktop.DBus" is that string itself. */
2069 if ((STRINGP (service
))
2070 && (SBYTES (service
) > 0)
2071 && (strcmp (SSDATA (service
), DBUS_SERVICE_DBUS
) != 0)
2072 && (strncmp (SSDATA (service
), ":", 1) != 0))
2074 uname
= call2 (intern ("dbus-get-name-owner"), bus
, service
);
2075 /* When there is no unique name, we mark it with an empty
2078 uname
= empty_unibyte_string
;
2083 /* Create a matching rule if the unique name exists (when no
2085 if (NILP (uname
) || (SBYTES (uname
) > 0))
2087 /* Open a connection to the bus. */
2088 connection
= xd_initialize (bus
, TRUE
);
2090 /* Create a rule to receive related signals. */
2091 rulelen
= esnprintf (rule
, sizeof rule
,
2092 "type='signal',interface='%s',member='%s'",
2096 /* Add unique name and path to the rule if they are non-nil. */
2098 rulelen
+= esnprintf (rule
+ rulelen
, sizeof rule
- rulelen
,
2099 ",sender='%s'", SDATA (uname
));
2102 rulelen
+= esnprintf (rule
+ rulelen
, sizeof rule
- rulelen
,
2103 ",path='%s'", SDATA (path
));
2105 /* Add arguments to the rule if they are non-nil. */
2106 for (i
= 6; i
< nargs
; ++i
)
2107 if (!NILP (args
[i
]))
2109 CHECK_STRING (args
[i
]);
2110 rulelen
+= esnprintf (rule
+ rulelen
, sizeof rule
- rulelen
,
2111 ",arg%"pD
"d='%s'", i
- 6, SDATA (args
[i
]));
2114 if (rulelen
== sizeof rule
- 1)
2117 /* Add the rule to the bus. */
2118 dbus_error_init (&derror
);
2119 dbus_bus_add_match (connection
, rule
, &derror
);
2120 if (dbus_error_is_set (&derror
))
2127 dbus_error_free (&derror
);
2129 XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule
);
2132 /* Create a hash table entry. */
2133 key
= list3 (bus
, interface
, signal
);
2134 key1
= list4 (uname
, service
, path
, handler
);
2135 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
2137 if (NILP (Fmember (key1
, value
)))
2138 Fputhash (key
, Fcons (key1
, value
), Vdbus_registered_objects_table
);
2140 /* Return object. */
2141 RETURN_UNGCPRO (list2 (key
, list3 (service
, path
, handler
)));
2144 DEFUN ("dbus-register-method", Fdbus_register_method
, Sdbus_register_method
,
2146 doc
: /* Register for method METHOD on the D-Bus BUS.
2148 BUS is either a Lisp symbol, `:system' or `:session', or a string
2149 denoting the bus address.
2151 SERVICE is the D-Bus service name of the D-Bus object METHOD is
2152 registered for. It must be a known name (See discussion of
2153 DONT-REGISTER-SERVICE below).
2155 PATH is the D-Bus object path SERVICE is registered (See discussion of
2156 DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
2157 SERVICE. It must provide METHOD. HANDLER is a Lisp function to be
2158 called when a method call is received. It must accept the input
2159 arguments of METHOD. The return value of HANDLER is used for
2160 composing the returning D-Bus message.
2162 When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
2163 registered. This means that other D-Bus clients have no way of
2164 noticing the newly registered method. When interfaces are constructed
2165 incrementally by adding single methods or properties at a time,
2166 DONT-REGISTER-SERVICE can be use to prevent other clients from
2167 discovering the still incomplete interface.*/)
2168 (Lisp_Object bus
, Lisp_Object service
, Lisp_Object path
,
2169 Lisp_Object interface
, Lisp_Object method
, Lisp_Object handler
,
2170 Lisp_Object dont_register_service
)
2172 Lisp_Object key
, key1
, value
;
2173 Lisp_Object args
[2] = { bus
, service
};
2175 /* Check parameters. */
2176 CHECK_STRING (service
);
2177 CHECK_STRING (path
);
2178 CHECK_STRING (interface
);
2179 CHECK_STRING (method
);
2180 if (!FUNCTIONP (handler
))
2181 wrong_type_argument (Qinvalid_function
, handler
);
2182 /* TODO: We must check for a valid service name, otherwise there is
2183 a segmentation fault. */
2185 /* Request the name. */
2186 if (NILP (dont_register_service
))
2187 Fdbus_register_service (2, args
);
2189 /* Create a hash table entry. We use nil for the unique name,
2190 because the method might be called from anybody. */
2191 key
= list3 (bus
, interface
, method
);
2192 key1
= list4 (Qnil
, service
, path
, handler
);
2193 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
2195 if (NILP (Fmember (key1
, value
)))
2196 Fputhash (key
, Fcons (key1
, value
), Vdbus_registered_objects_table
);
2198 /* Return object. */
2199 return list2 (key
, list3 (service
, path
, handler
));
2204 syms_of_dbusbind (void)
2207 DEFSYM (Qdbus_init_bus
, "dbus-init-bus");
2208 defsubr (&Sdbus_init_bus
);
2210 DEFSYM (Qdbus_close_bus
, "dbus-close-bus");
2211 defsubr (&Sdbus_close_bus
);
2213 DEFSYM (Qdbus_get_unique_name
, "dbus-get-unique-name");
2214 defsubr (&Sdbus_get_unique_name
);
2216 DEFSYM (Qdbus_call_method
, "dbus-call-method");
2217 defsubr (&Sdbus_call_method
);
2219 DEFSYM (Qdbus_call_method_asynchronously
, "dbus-call-method-asynchronously");
2220 defsubr (&Sdbus_call_method_asynchronously
);
2222 DEFSYM (Qdbus_method_return_internal
, "dbus-method-return-internal");
2223 defsubr (&Sdbus_method_return_internal
);
2225 DEFSYM (Qdbus_method_error_internal
, "dbus-method-error-internal");
2226 defsubr (&Sdbus_method_error_internal
);
2228 DEFSYM (Qdbus_send_signal
, "dbus-send-signal");
2229 defsubr (&Sdbus_send_signal
);
2231 DEFSYM (Qdbus_register_service
, "dbus-register-service");
2232 defsubr (&Sdbus_register_service
);
2234 DEFSYM (Qdbus_register_signal
, "dbus-register-signal");
2235 defsubr (&Sdbus_register_signal
);
2237 DEFSYM (Qdbus_register_method
, "dbus-register-method");
2238 defsubr (&Sdbus_register_method
);
2240 DEFSYM (Qdbus_error
, "dbus-error");
2241 Fput (Qdbus_error
, Qerror_conditions
,
2242 list2 (Qdbus_error
, Qerror
));
2243 Fput (Qdbus_error
, Qerror_message
,
2244 make_pure_c_string ("D-Bus error"));
2246 DEFSYM (QCdbus_system_bus
, ":system");
2247 DEFSYM (QCdbus_session_bus
, ":session");
2248 DEFSYM (QCdbus_request_name_allow_replacement
, ":allow-replacement");
2249 DEFSYM (QCdbus_request_name_replace_existing
, ":replace-existing");
2250 DEFSYM (QCdbus_request_name_do_not_queue
, ":do-not-queue");
2251 DEFSYM (QCdbus_request_name_reply_primary_owner
, ":primary-owner");
2252 DEFSYM (QCdbus_request_name_reply_exists
, ":exists");
2253 DEFSYM (QCdbus_request_name_reply_in_queue
, ":in-queue");
2254 DEFSYM (QCdbus_request_name_reply_already_owner
, ":already-owner");
2255 DEFSYM (QCdbus_timeout
, ":timeout");
2256 DEFSYM (QCdbus_type_byte
, ":byte");
2257 DEFSYM (QCdbus_type_boolean
, ":boolean");
2258 DEFSYM (QCdbus_type_int16
, ":int16");
2259 DEFSYM (QCdbus_type_uint16
, ":uint16");
2260 DEFSYM (QCdbus_type_int32
, ":int32");
2261 DEFSYM (QCdbus_type_uint32
, ":uint32");
2262 DEFSYM (QCdbus_type_int64
, ":int64");
2263 DEFSYM (QCdbus_type_uint64
, ":uint64");
2264 DEFSYM (QCdbus_type_double
, ":double");
2265 DEFSYM (QCdbus_type_string
, ":string");
2266 DEFSYM (QCdbus_type_object_path
, ":object-path");
2267 DEFSYM (QCdbus_type_signature
, ":signature");
2269 #ifdef DBUS_TYPE_UNIX_FD
2270 DEFSYM (QCdbus_type_unix_fd
, ":unix-fd");
2273 DEFSYM (QCdbus_type_array
, ":array");
2274 DEFSYM (QCdbus_type_variant
, ":variant");
2275 DEFSYM (QCdbus_type_struct
, ":struct");
2276 DEFSYM (QCdbus_type_dict_entry
, ":dict-entry");
2278 DEFVAR_LISP ("dbus-registered-buses",
2279 Vdbus_registered_buses
,
2280 doc
: /* List of D-Bus buses we are polling for messages. */);
2281 Vdbus_registered_buses
= Qnil
;
2283 DEFVAR_LISP ("dbus-registered-objects-table",
2284 Vdbus_registered_objects_table
,
2285 doc
: /* Hash table of registered functions for D-Bus.
2287 There are two different uses of the hash table: for accessing
2288 registered interfaces properties, targeted by signals or method calls,
2289 and for calling handlers in case of non-blocking method call returns.
2291 In the first case, the key in the hash table is the list (BUS
2292 INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or
2293 `:session', or a string denoting the bus address. INTERFACE is a
2294 string which denotes a D-Bus interface, and MEMBER, also a string, is
2295 either a method, a signal or a property INTERFACE is offering. All
2296 arguments but BUS must not be nil.
2298 The value in the hash table is a list of quadruple lists
2299 \((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...).
2300 SERVICE is the service name as registered, UNAME is the corresponding
2301 unique name. In case of registered methods and properties, UNAME is
2302 nil. PATH is the object path of the sending object. All of them can
2303 be nil, which means a wildcard then. OBJECT is either the handler to
2304 be called when a D-Bus message, which matches the key criteria,
2305 arrives (methods and signals), or a cons cell containing the value of
2308 In the second case, the key in the hash table is the list (BUS
2309 SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
2310 string denoting the bus address. SERIAL is the serial number of the
2311 non-blocking method call, a reply is expected. Both arguments must
2312 not be nil. The value in the hash table is HANDLER, the function to
2313 be called when the D-Bus reply message arrives. */);
2315 Lisp_Object args
[2];
2318 Vdbus_registered_objects_table
= Fmake_hash_table (2, args
);
2321 DEFVAR_LISP ("dbus-debug", Vdbus_debug
,
2322 doc
: /* If non-nil, debug messages of D-Bus bindings are raised. */);
2325 /* We can also set environment variable DBUS_VERBOSE=1 in order to
2326 see more traces. This requires libdbus-1 to be configured with
2327 --enable-verbose-mode. */
2332 Fprovide (intern_c_string ("dbusbind"), Qnil
);
2336 #endif /* HAVE_DBUS */