1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007, 2008, 2009, 2010, 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 Lisp_Object Qdbus_init_bus
;
34 Lisp_Object Qdbus_close_bus
;
35 Lisp_Object Qdbus_get_unique_name
;
36 Lisp_Object Qdbus_call_method
;
37 Lisp_Object Qdbus_call_method_asynchronously
;
38 Lisp_Object Qdbus_method_return_internal
;
39 Lisp_Object Qdbus_method_error_internal
;
40 Lisp_Object Qdbus_send_signal
;
41 Lisp_Object Qdbus_register_service
;
42 Lisp_Object Qdbus_register_signal
;
43 Lisp_Object Qdbus_register_method
;
45 /* D-Bus error symbol. */
46 Lisp_Object Qdbus_error
;
48 /* Lisp symbols of the system and session buses. */
49 Lisp_Object QCdbus_system_bus
, QCdbus_session_bus
;
51 /* Lisp symbol for method call timeout. */
52 Lisp_Object QCdbus_timeout
;
54 /* Lisp symbols for name request flags. */
55 Lisp_Object QCdbus_request_name_allow_replacement
;
56 Lisp_Object QCdbus_request_name_replace_existing
;
57 Lisp_Object QCdbus_request_name_do_not_queue
;
59 /* Lisp symbols for name request replies. */
60 Lisp_Object QCdbus_request_name_reply_primary_owner
;
61 Lisp_Object QCdbus_request_name_reply_in_queue
;
62 Lisp_Object QCdbus_request_name_reply_exists
;
63 Lisp_Object QCdbus_request_name_reply_already_owner
;
65 /* Lisp symbols of D-Bus types. */
66 Lisp_Object QCdbus_type_byte
, QCdbus_type_boolean
;
67 Lisp_Object QCdbus_type_int16
, QCdbus_type_uint16
;
68 Lisp_Object QCdbus_type_int32
, QCdbus_type_uint32
;
69 Lisp_Object QCdbus_type_int64
, QCdbus_type_uint64
;
70 Lisp_Object QCdbus_type_double
, QCdbus_type_string
;
71 Lisp_Object QCdbus_type_object_path
, QCdbus_type_signature
;
72 #ifdef DBUS_TYPE_UNIX_FD
73 Lisp_Object QCdbus_type_unix_fd
;
75 Lisp_Object QCdbus_type_array
, QCdbus_type_variant
;
76 Lisp_Object QCdbus_type_struct
, QCdbus_type_dict_entry
;
78 /* Registered buses. */
79 Lisp_Object Vdbus_registered_buses
;
81 /* Hash table which keeps function definitions. */
82 Lisp_Object Vdbus_registered_objects_table
;
84 /* Whether to debug D-Bus. */
85 Lisp_Object Vdbus_debug
;
87 /* Whether we are reading a D-Bus event. */
88 int xd_in_read_queued_messages
= 0;
91 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
92 we don't want to poison other namespaces with "dbus_". */
94 /* Raise a signal. If we are reading events, we cannot signal; we
95 throw to xd_read_queued_messages then. */
96 #define XD_SIGNAL1(arg) \
98 if (xd_in_read_queued_messages) \
99 Fthrow (Qdbus_error, Qnil); \
101 xsignal1 (Qdbus_error, arg); \
104 #define XD_SIGNAL2(arg1, arg2) \
106 if (xd_in_read_queued_messages) \
107 Fthrow (Qdbus_error, Qnil); \
109 xsignal2 (Qdbus_error, arg1, arg2); \
112 #define XD_SIGNAL3(arg1, arg2, arg3) \
114 if (xd_in_read_queued_messages) \
115 Fthrow (Qdbus_error, Qnil); \
117 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
120 /* Raise a Lisp error from a D-Bus ERROR. */
121 #define XD_ERROR(error) \
124 strncpy (s, error.message, 1023); \
125 dbus_error_free (&error); \
126 /* Remove the trailing newline. */ \
127 if (strchr (s, '\n') != NULL) \
128 s[strlen (s) - 1] = '\0'; \
129 XD_SIGNAL1 (build_string (s)); \
132 /* Macros for debugging. In order to enable them, build with
133 "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
135 #define XD_DEBUG_MESSAGE(...) \
138 snprintf (s, 1023, __VA_ARGS__); \
139 printf ("%s: %s\n", __func__, s); \
140 message ("%s: %s", __func__, s); \
142 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
144 if (!valid_lisp_object_p (object)) \
146 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
147 XD_SIGNAL1 (build_string ("Assertion failure")); \
151 #else /* !DBUS_DEBUG */
152 #define XD_DEBUG_MESSAGE(...) \
154 if (!NILP (Vdbus_debug)) \
157 snprintf (s, 1023, __VA_ARGS__); \
158 message ("%s: %s", __func__, s); \
161 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
164 /* Check whether TYPE is a basic DBusType. */
165 #ifdef DBUS_TYPE_UNIX_FD
166 #define XD_BASIC_DBUS_TYPE(type) \
167 ((type == DBUS_TYPE_BYTE) \
168 || (type == DBUS_TYPE_BOOLEAN) \
169 || (type == DBUS_TYPE_INT16) \
170 || (type == DBUS_TYPE_UINT16) \
171 || (type == DBUS_TYPE_INT32) \
172 || (type == DBUS_TYPE_UINT32) \
173 || (type == DBUS_TYPE_INT64) \
174 || (type == DBUS_TYPE_UINT64) \
175 || (type == DBUS_TYPE_DOUBLE) \
176 || (type == DBUS_TYPE_STRING) \
177 || (type == DBUS_TYPE_OBJECT_PATH) \
178 || (type == DBUS_TYPE_SIGNATURE) \
179 || (type == DBUS_TYPE_UNIX_FD))
181 #define XD_BASIC_DBUS_TYPE(type) \
182 ((type == DBUS_TYPE_BYTE) \
183 || (type == DBUS_TYPE_BOOLEAN) \
184 || (type == DBUS_TYPE_INT16) \
185 || (type == DBUS_TYPE_UINT16) \
186 || (type == DBUS_TYPE_INT32) \
187 || (type == DBUS_TYPE_UINT32) \
188 || (type == DBUS_TYPE_INT64) \
189 || (type == DBUS_TYPE_UINT64) \
190 || (type == DBUS_TYPE_DOUBLE) \
191 || (type == DBUS_TYPE_STRING) \
192 || (type == DBUS_TYPE_OBJECT_PATH) \
193 || (type == DBUS_TYPE_SIGNATURE))
196 /* This was a macro. On Solaris 2.11 it was said to compile for
197 hours, when optimzation is enabled. So we have transferred it into
199 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
200 of the predefined D-Bus type symbols. */
202 xd_symbol_to_dbus_type (Lisp_Object object
)
205 ((EQ (object
, QCdbus_type_byte
)) ? DBUS_TYPE_BYTE
206 : (EQ (object
, QCdbus_type_boolean
)) ? DBUS_TYPE_BOOLEAN
207 : (EQ (object
, QCdbus_type_int16
)) ? DBUS_TYPE_INT16
208 : (EQ (object
, QCdbus_type_uint16
)) ? DBUS_TYPE_UINT16
209 : (EQ (object
, QCdbus_type_int32
)) ? DBUS_TYPE_INT32
210 : (EQ (object
, QCdbus_type_uint32
)) ? DBUS_TYPE_UINT32
211 : (EQ (object
, QCdbus_type_int64
)) ? DBUS_TYPE_INT64
212 : (EQ (object
, QCdbus_type_uint64
)) ? DBUS_TYPE_UINT64
213 : (EQ (object
, QCdbus_type_double
)) ? DBUS_TYPE_DOUBLE
214 : (EQ (object
, QCdbus_type_string
)) ? DBUS_TYPE_STRING
215 : (EQ (object
, QCdbus_type_object_path
)) ? DBUS_TYPE_OBJECT_PATH
216 : (EQ (object
, QCdbus_type_signature
)) ? DBUS_TYPE_SIGNATURE
217 #ifdef DBUS_TYPE_UNIX_FD
218 : (EQ (object
, QCdbus_type_unix_fd
)) ? DBUS_TYPE_UNIX_FD
220 : (EQ (object
, QCdbus_type_array
)) ? DBUS_TYPE_ARRAY
221 : (EQ (object
, QCdbus_type_variant
)) ? DBUS_TYPE_VARIANT
222 : (EQ (object
, QCdbus_type_struct
)) ? DBUS_TYPE_STRUCT
223 : (EQ (object
, QCdbus_type_dict_entry
)) ? DBUS_TYPE_DICT_ENTRY
224 : DBUS_TYPE_INVALID
);
227 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
228 #define XD_DBUS_TYPE_P(object) \
229 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
231 /* Determine the DBusType of a given Lisp OBJECT. It is used to
232 convert Lisp objects, being arguments of `dbus-call-method' or
233 `dbus-send-signal', into corresponding C values appended as
234 arguments to a D-Bus message. */
235 #define XD_OBJECT_TO_DBUS_TYPE(object) \
236 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
237 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
238 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
239 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
240 : (STRINGP (object)) ? DBUS_TYPE_STRING \
241 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
243 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
244 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
246 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
250 /* Return a list pointer which does not have a Lisp symbol as car. */
251 #define XD_NEXT_VALUE(object) \
252 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
254 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
255 used in dbus_message_iter_open_container. DTYPE is the DBusType
256 the object is related to. It is passed as argument, because it
257 cannot be detected in basic type objects, when they are preceded by
258 a type symbol. PARENT_TYPE is the DBusType of a container this
259 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
260 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
262 xd_signature (char *signature
, unsigned int dtype
, unsigned int parent_type
, Lisp_Object object
)
264 unsigned int subtype
;
266 char x
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
273 case DBUS_TYPE_UINT16
:
274 case DBUS_TYPE_UINT32
:
275 case DBUS_TYPE_UINT64
:
276 #ifdef DBUS_TYPE_UNIX_FD
277 case DBUS_TYPE_UNIX_FD
:
279 CHECK_NATNUM (object
);
280 sprintf (signature
, "%c", dtype
);
283 case DBUS_TYPE_BOOLEAN
:
284 if (!EQ (object
, Qt
) && !EQ (object
, Qnil
))
285 wrong_type_argument (intern ("booleanp"), object
);
286 sprintf (signature
, "%c", dtype
);
289 case DBUS_TYPE_INT16
:
290 case DBUS_TYPE_INT32
:
291 case DBUS_TYPE_INT64
:
292 CHECK_NUMBER (object
);
293 sprintf (signature
, "%c", dtype
);
296 case DBUS_TYPE_DOUBLE
:
297 CHECK_FLOAT (object
);
298 sprintf (signature
, "%c", dtype
);
301 case DBUS_TYPE_STRING
:
302 case DBUS_TYPE_OBJECT_PATH
:
303 case DBUS_TYPE_SIGNATURE
:
304 CHECK_STRING (object
);
305 sprintf (signature
, "%c", dtype
);
308 case DBUS_TYPE_ARRAY
:
309 /* Check that all list elements have the same D-Bus type. For
310 complex element types, we just check the container type, not
311 the whole element's signature. */
314 /* Type symbol is optional. */
315 if (EQ (QCdbus_type_array
, CAR_SAFE (elt
)))
316 elt
= XD_NEXT_VALUE (elt
);
318 /* If the array is empty, DBUS_TYPE_STRING is the default
322 subtype
= DBUS_TYPE_STRING
;
323 strcpy (x
, DBUS_TYPE_STRING_AS_STRING
);
327 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
328 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
331 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
332 only element, the value of this element is used as he array's
333 element signature. */
334 if ((subtype
== DBUS_TYPE_SIGNATURE
)
335 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt
)))
336 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
337 strcpy (x
, SDATA (CAR_SAFE (XD_NEXT_VALUE (elt
))));
341 if (subtype
!= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
)))
342 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt
));
343 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
346 sprintf (signature
, "%c%s", dtype
, x
);
349 case DBUS_TYPE_VARIANT
:
350 /* Check that there is exactly one list element. */
353 elt
= XD_NEXT_VALUE (elt
);
354 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
355 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
357 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
358 wrong_type_argument (intern ("D-Bus"),
359 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
361 sprintf (signature
, "%c", dtype
);
364 case DBUS_TYPE_STRUCT
:
365 /* A struct list might contain any number of elements with
366 different types. No further check needed. */
369 elt
= XD_NEXT_VALUE (elt
);
371 /* Compose the signature from the elements. It is enclosed by
373 sprintf (signature
, "%c", DBUS_STRUCT_BEGIN_CHAR
);
376 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
377 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
378 strcat (signature
, x
);
379 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
381 strcat (signature
, DBUS_STRUCT_END_CHAR_AS_STRING
);
384 case DBUS_TYPE_DICT_ENTRY
:
385 /* Check that there are exactly two list elements, and the first
386 one is of basic type. The dictionary entry itself must be an
387 element of an array. */
390 /* Check the parent object type. */
391 if (parent_type
!= DBUS_TYPE_ARRAY
)
392 wrong_type_argument (intern ("D-Bus"), object
);
394 /* Compose the signature from the elements. It is enclosed by
396 sprintf (signature
, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR
);
399 elt
= XD_NEXT_VALUE (elt
);
400 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
401 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
402 strcat (signature
, x
);
404 if (!XD_BASIC_DBUS_TYPE (subtype
))
405 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt
)));
407 /* Second element. */
408 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
409 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
410 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
411 strcat (signature
, x
);
413 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
414 wrong_type_argument (intern ("D-Bus"),
415 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
417 /* Closing signature. */
418 strcat (signature
, DBUS_DICT_ENTRY_END_CHAR_AS_STRING
);
422 wrong_type_argument (intern ("D-Bus"), object
);
425 XD_DEBUG_MESSAGE ("%s", signature
);
428 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
429 DTYPE must be a valid DBusType. It is used to convert Lisp
430 objects, being arguments of `dbus-call-method' or
431 `dbus-send-signal', into corresponding C values appended as
432 arguments to a D-Bus message. */
434 xd_append_arg (unsigned int dtype
, Lisp_Object object
, DBusMessageIter
*iter
)
436 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
437 DBusMessageIter subiter
;
439 if (XD_BASIC_DBUS_TYPE (dtype
))
443 CHECK_NUMBER (object
);
445 unsigned char val
= XUINT (object
) & 0xFF;
446 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
447 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
448 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
452 case DBUS_TYPE_BOOLEAN
:
454 dbus_bool_t val
= (NILP (object
)) ? FALSE
: TRUE
;
455 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
456 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
457 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
461 case DBUS_TYPE_INT16
:
462 CHECK_NUMBER (object
);
464 dbus_int16_t val
= XINT (object
);
465 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
466 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
467 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
471 case DBUS_TYPE_UINT16
:
472 CHECK_NUMBER (object
);
474 dbus_uint16_t val
= XUINT (object
);
475 XD_DEBUG_MESSAGE ("%c %u", dtype
, (unsigned int) val
);
476 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
477 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
481 case DBUS_TYPE_INT32
:
482 CHECK_NUMBER (object
);
484 dbus_int32_t val
= XINT (object
);
485 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
486 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
487 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
491 case DBUS_TYPE_UINT32
:
492 #ifdef DBUS_TYPE_UNIX_FD
493 case DBUS_TYPE_UNIX_FD
:
495 CHECK_NUMBER (object
);
497 dbus_uint32_t val
= XUINT (object
);
498 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
499 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
500 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
504 case DBUS_TYPE_INT64
:
505 CHECK_NUMBER (object
);
507 dbus_int64_t val
= XINT (object
);
508 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
509 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
510 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
514 case DBUS_TYPE_UINT64
:
515 CHECK_NUMBER (object
);
517 dbus_uint64_t val
= XUINT (object
);
518 XD_DEBUG_MESSAGE ("%c %u", dtype
, (unsigned int) val
);
519 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
520 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
524 case DBUS_TYPE_DOUBLE
:
525 CHECK_FLOAT (object
);
527 double val
= XFLOAT_DATA (object
);
528 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
529 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
530 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
534 case DBUS_TYPE_STRING
:
535 case DBUS_TYPE_OBJECT_PATH
:
536 case DBUS_TYPE_SIGNATURE
:
537 CHECK_STRING (object
);
539 /* We need to send a valid UTF-8 string. We could encode `object'
540 but by not encoding it, we guarantee it's valid utf-8, even if
541 it contains eight-bit-bytes. Of course, you can still send
542 manually-crafted junk by passing a unibyte string. */
543 char *val
= SDATA (object
);
544 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
545 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
546 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
551 else /* Compound types. */
554 /* All compound types except array have a type symbol. For
555 array, it is optional. Skip it. */
556 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))))
557 object
= XD_NEXT_VALUE (object
);
559 /* Open new subiteration. */
562 case DBUS_TYPE_ARRAY
:
563 /* An array has only elements of the same type. So it is
564 sufficient to check the first element's signature
568 /* If the array is empty, DBUS_TYPE_STRING is the default
570 strcpy (signature
, DBUS_TYPE_STRING_AS_STRING
);
573 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
574 the only element, the value of this element is used as
575 the array's element signature. */
576 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))
577 == DBUS_TYPE_SIGNATURE
)
578 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object
)))
579 && NILP (CDR_SAFE (XD_NEXT_VALUE (object
))))
581 strcpy (signature
, SDATA (CAR_SAFE (XD_NEXT_VALUE (object
))));
582 object
= CDR_SAFE (XD_NEXT_VALUE (object
));
586 xd_signature (signature
,
587 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
588 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
590 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
591 SDATA (format2 ("%s", object
, Qnil
)));
592 if (!dbus_message_iter_open_container (iter
, dtype
,
593 signature
, &subiter
))
594 XD_SIGNAL3 (build_string ("Cannot open container"),
595 make_number (dtype
), build_string (signature
));
598 case DBUS_TYPE_VARIANT
:
599 /* A variant has just one element. */
600 xd_signature (signature
, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
601 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
603 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
604 SDATA (format2 ("%s", object
, Qnil
)));
605 if (!dbus_message_iter_open_container (iter
, dtype
,
606 signature
, &subiter
))
607 XD_SIGNAL3 (build_string ("Cannot open container"),
608 make_number (dtype
), build_string (signature
));
611 case DBUS_TYPE_STRUCT
:
612 case DBUS_TYPE_DICT_ENTRY
:
613 /* These containers do not require a signature. */
614 XD_DEBUG_MESSAGE ("%c %s", dtype
,
615 SDATA (format2 ("%s", object
, Qnil
)));
616 if (!dbus_message_iter_open_container (iter
, dtype
, NULL
, &subiter
))
617 XD_SIGNAL2 (build_string ("Cannot open container"),
618 make_number (dtype
));
622 /* Loop over list elements. */
623 while (!NILP (object
))
625 dtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
));
626 object
= XD_NEXT_VALUE (object
);
628 xd_append_arg (dtype
, CAR_SAFE (object
), &subiter
);
630 object
= CDR_SAFE (object
);
633 /* Close the subiteration. */
634 if (!dbus_message_iter_close_container (iter
, &subiter
))
635 XD_SIGNAL2 (build_string ("Cannot close container"),
636 make_number (dtype
));
640 /* Retrieve C value from a DBusMessageIter structure ITER, and return
641 a converted Lisp object. The type DTYPE of the argument of the
642 D-Bus message must be a valid DBusType. Compound D-Bus types
643 result always in a Lisp list. */
645 xd_retrieve_arg (unsigned int dtype
, DBusMessageIter
*iter
)
653 dbus_message_iter_get_basic (iter
, &val
);
655 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
656 return make_number (val
);
659 case DBUS_TYPE_BOOLEAN
:
662 dbus_message_iter_get_basic (iter
, &val
);
663 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
664 return (val
== FALSE
) ? Qnil
: Qt
;
667 case DBUS_TYPE_INT16
:
670 dbus_message_iter_get_basic (iter
, &val
);
671 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
672 return make_number (val
);
675 case DBUS_TYPE_UINT16
:
678 dbus_message_iter_get_basic (iter
, &val
);
679 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
680 return make_number (val
);
683 case DBUS_TYPE_INT32
:
686 dbus_message_iter_get_basic (iter
, &val
);
687 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
688 return make_fixnum_or_float (val
);
691 case DBUS_TYPE_UINT32
:
692 #ifdef DBUS_TYPE_UNIX_FD
693 case DBUS_TYPE_UNIX_FD
:
697 dbus_message_iter_get_basic (iter
, &val
);
698 XD_DEBUG_MESSAGE ("%c %d", dtype
, val
);
699 return make_fixnum_or_float (val
);
702 case DBUS_TYPE_INT64
:
705 dbus_message_iter_get_basic (iter
, &val
);
706 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
707 return make_fixnum_or_float (val
);
710 case DBUS_TYPE_UINT64
:
713 dbus_message_iter_get_basic (iter
, &val
);
714 XD_DEBUG_MESSAGE ("%c %d", dtype
, (int) val
);
715 return make_fixnum_or_float (val
);
718 case DBUS_TYPE_DOUBLE
:
721 dbus_message_iter_get_basic (iter
, &val
);
722 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
723 return make_float (val
);
726 case DBUS_TYPE_STRING
:
727 case DBUS_TYPE_OBJECT_PATH
:
728 case DBUS_TYPE_SIGNATURE
:
731 dbus_message_iter_get_basic (iter
, &val
);
732 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
733 return build_string (val
);
736 case DBUS_TYPE_ARRAY
:
737 case DBUS_TYPE_VARIANT
:
738 case DBUS_TYPE_STRUCT
:
739 case DBUS_TYPE_DICT_ENTRY
:
743 DBusMessageIter subiter
;
747 dbus_message_iter_recurse (iter
, &subiter
);
748 while ((subtype
= dbus_message_iter_get_arg_type (&subiter
))
749 != DBUS_TYPE_INVALID
)
751 result
= Fcons (xd_retrieve_arg (subtype
, &subiter
), result
);
752 dbus_message_iter_next (&subiter
);
754 XD_DEBUG_MESSAGE ("%c %s", dtype
, SDATA (format2 ("%s", result
, Qnil
)));
755 RETURN_UNGCPRO (Fnreverse (result
));
759 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype
);
764 /* Initialize D-Bus connection. BUS is either a Lisp symbol, :system
765 or :session, or a string denoting the bus address. It tells which
766 D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error
767 when the connection cannot be initialized. */
768 static DBusConnection
*
769 xd_initialize (Lisp_Object bus
, int raise_error
)
771 DBusConnection
*connection
;
774 /* Parameter check. */
778 if (!(EQ (bus
, QCdbus_system_bus
) || EQ (bus
, QCdbus_session_bus
)))
781 XD_SIGNAL2 (build_string ("Wrong bus name"), bus
);
786 /* We do not want to have an autolaunch for the session bus. */
787 if (EQ (bus
, QCdbus_session_bus
)
788 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL
)
791 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
797 /* Open a connection to the bus. */
798 dbus_error_init (&derror
);
801 connection
= dbus_connection_open (SDATA (bus
), &derror
);
803 if (EQ (bus
, QCdbus_system_bus
))
804 connection
= dbus_bus_get (DBUS_BUS_SYSTEM
, &derror
);
806 connection
= dbus_bus_get (DBUS_BUS_SESSION
, &derror
);
808 if (dbus_error_is_set (&derror
))
816 /* If it is not the system or session bus, we must register
817 ourselves. Otherwise, we have called dbus_bus_get, which has
818 configured us to exit if the connection closes - we undo this
820 if (connection
!= NULL
)
823 dbus_bus_register (connection
, &derror
);
825 dbus_connection_set_exit_on_disconnect (connection
, FALSE
);
828 if (dbus_error_is_set (&derror
))
836 if (connection
== NULL
&& raise_error
)
837 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
840 dbus_error_free (&derror
);
842 /* Return the result. */
846 /* Return the file descriptor for WATCH, -1 if not found. */
848 xd_find_watch_fd (DBusWatch
*watch
)
850 #if HAVE_DBUS_WATCH_GET_UNIX_FD
851 /* TODO: Reverse these on Win32, which prefers the opposite. */
852 int fd
= dbus_watch_get_unix_fd (watch
);
854 fd
= dbus_watch_get_socket (watch
);
856 int fd
= dbus_watch_get_fd (watch
);
863 xd_read_queued_messages (int fd
, void *data
, int for_read
);
865 /* Start monitoring WATCH for possible I/O. */
867 xd_add_watch (DBusWatch
*watch
, void *data
)
869 unsigned int flags
= dbus_watch_get_flags (watch
);
870 int fd
= xd_find_watch_fd (watch
);
872 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
873 fd
, flags
& DBUS_WATCH_WRITABLE
,
874 dbus_watch_get_enabled (watch
));
879 if (dbus_watch_get_enabled (watch
))
881 if (flags
& DBUS_WATCH_WRITABLE
)
882 add_write_fd (fd
, xd_read_queued_messages
, data
);
883 if (flags
& DBUS_WATCH_READABLE
)
884 add_read_fd (fd
, xd_read_queued_messages
, data
);
889 /* Stop monitoring WATCH for possible I/O.
890 DATA is the used bus, either a string or QCdbus_system_bus or
891 QCdbus_session_bus. */
893 xd_remove_watch (DBusWatch
*watch
, void *data
)
895 unsigned int flags
= dbus_watch_get_flags (watch
);
896 int fd
= xd_find_watch_fd (watch
);
898 XD_DEBUG_MESSAGE ("fd %d", fd
);
903 /* Unset session environment. */
904 if (data
!= NULL
&& data
== (void*) XHASH (QCdbus_session_bus
))
906 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
907 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
910 if (flags
& DBUS_WATCH_WRITABLE
)
911 delete_write_fd (fd
);
912 if (flags
& DBUS_WATCH_READABLE
)
916 /* Toggle monitoring WATCH for possible I/O. */
918 xd_toggle_watch (DBusWatch
*watch
, void *data
)
920 if (dbus_watch_get_enabled (watch
))
921 xd_add_watch (watch
, data
);
923 xd_remove_watch (watch
, data
);
926 DEFUN ("dbus-init-bus", Fdbus_init_bus
, Sdbus_init_bus
, 1, 1, 0,
927 doc
: /* Initialize connection to D-Bus BUS. */)
930 DBusConnection
*connection
;
932 /* Open a connection to the bus. */
933 connection
= xd_initialize (bus
, TRUE
);
935 /* Add the watch functions. We pass also the bus as data, in order
936 to distinguish between the busses in xd_remove_watch. */
937 if (!dbus_connection_set_watch_functions (connection
,
941 (void*) XHASH (bus
), NULL
))
942 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
944 /* Add bus to list of registered buses. */
945 Vdbus_registered_buses
= Fcons (bus
, Vdbus_registered_buses
);
947 /* We do not want to abort. */
948 putenv ("DBUS_FATAL_WARNINGS=0");
954 DEFUN ("dbus-close-bus", Fdbus_close_bus
, Sdbus_close_bus
, 1, 1, 0,
955 doc
: /* Close connection to D-Bus BUS. */)
958 DBusConnection
*connection
;
960 /* Open a connection to the bus. */
961 connection
= xd_initialize (bus
, TRUE
);
963 /* Decrement reference count to the bus. */
964 dbus_connection_unref (connection
);
966 /* Remove bus from list of registered buses. */
967 Vdbus_registered_buses
= Fdelete (bus
, Vdbus_registered_buses
);
973 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name
, Sdbus_get_unique_name
,
975 doc
: /* Return the unique name of Emacs registered at D-Bus BUS. */)
978 DBusConnection
*connection
;
981 /* Open a connection to the bus. */
982 connection
= xd_initialize (bus
, TRUE
);
984 /* Request the name. */
985 name
= dbus_bus_get_unique_name (connection
);
987 XD_SIGNAL1 (build_string ("No unique name available"));
990 return build_string (name
);
993 DEFUN ("dbus-call-method", Fdbus_call_method
, Sdbus_call_method
, 5, MANY
, 0,
994 doc
: /* Call METHOD on the D-Bus BUS.
996 BUS is either a Lisp symbol, `:system' or `:session', or a string
997 denoting the bus address.
999 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
1000 object path SERVICE is registered at. INTERFACE is an interface
1001 offered by SERVICE. It must provide METHOD.
1003 If the parameter `:timeout' is given, the following integer TIMEOUT
1004 specifies the maximum number of milliseconds the method call must
1005 return. The default value is 25,000. If the method call doesn't
1006 return in time, a D-Bus error is raised.
1008 All other arguments ARGS are passed to METHOD as arguments. They are
1009 converted into D-Bus types via the following rules:
1011 t and nil => DBUS_TYPE_BOOLEAN
1012 number => DBUS_TYPE_UINT32
1013 integer => DBUS_TYPE_INT32
1014 float => DBUS_TYPE_DOUBLE
1015 string => DBUS_TYPE_STRING
1016 list => DBUS_TYPE_ARRAY
1018 All arguments can be preceded by a type symbol. For details about
1019 type symbols, see Info node `(dbus)Type Conversion'.
1021 `dbus-call-method' returns the resulting values of METHOD as a list of
1022 Lisp objects. The type conversion happens the other direction as for
1023 input arguments. It follows the mapping rules:
1025 DBUS_TYPE_BOOLEAN => t or nil
1026 DBUS_TYPE_BYTE => number
1027 DBUS_TYPE_UINT16 => number
1028 DBUS_TYPE_INT16 => integer
1029 DBUS_TYPE_UINT32 => number or float
1030 DBUS_TYPE_UNIX_FD => number or float
1031 DBUS_TYPE_INT32 => integer or float
1032 DBUS_TYPE_UINT64 => number or float
1033 DBUS_TYPE_INT64 => integer or float
1034 DBUS_TYPE_DOUBLE => float
1035 DBUS_TYPE_STRING => string
1036 DBUS_TYPE_OBJECT_PATH => string
1037 DBUS_TYPE_SIGNATURE => string
1038 DBUS_TYPE_ARRAY => list
1039 DBUS_TYPE_VARIANT => list
1040 DBUS_TYPE_STRUCT => list
1041 DBUS_TYPE_DICT_ENTRY => list
1046 :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
1047 "org.gnome.seahorse.Keys" "GetKeyField"
1048 "openpgp:657984B8C7A966DD" "simple-name")
1050 => (t ("Philip R. Zimmermann"))
1052 If the result of the METHOD call is just one value, the converted Lisp
1053 object is returned instead of a list containing this single Lisp object.
1056 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1057 "org.freedesktop.Hal.Device" "GetPropertyString"
1058 "system.kernel.machine")
1062 usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
1063 (int nargs
, register Lisp_Object
*args
)
1065 Lisp_Object bus
, service
, path
, interface
, method
;
1067 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
1068 DBusConnection
*connection
;
1069 DBusMessage
*dmessage
;
1071 DBusMessageIter iter
;
1076 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1078 /* Check parameters. */
1082 interface
= args
[3];
1085 CHECK_STRING (service
);
1086 CHECK_STRING (path
);
1087 CHECK_STRING (interface
);
1088 CHECK_STRING (method
);
1089 GCPRO5 (bus
, service
, path
, interface
, method
);
1091 XD_DEBUG_MESSAGE ("%s %s %s %s",
1097 /* Open a connection to the bus. */
1098 connection
= xd_initialize (bus
, TRUE
);
1100 /* Create the message. */
1101 dmessage
= dbus_message_new_method_call (SDATA (service
),
1106 if (dmessage
== NULL
)
1107 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1109 /* Check for timeout parameter. */
1110 if ((i
+2 <= nargs
) && (EQ ((args
[i
]), QCdbus_timeout
)))
1112 CHECK_NATNUM (args
[i
+1]);
1113 timeout
= XUINT (args
[i
+1]);
1117 /* Initialize parameter list of message. */
1118 dbus_message_iter_init_append (dmessage
, &iter
);
1120 /* Append parameters to the message. */
1121 for (; i
< nargs
; ++i
)
1123 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1124 if (XD_DBUS_TYPE_P (args
[i
]))
1126 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1127 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1128 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i
-4,
1129 SDATA (format2 ("%s", args
[i
], Qnil
)),
1130 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1135 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1136 XD_DEBUG_MESSAGE ("Parameter%d %s", i
-4,
1137 SDATA (format2 ("%s", args
[i
], Qnil
)));
1140 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1141 indication that there is no parent type. */
1142 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1144 xd_append_arg (dtype
, args
[i
], &iter
);
1147 /* Send the message. */
1148 dbus_error_init (&derror
);
1149 reply
= dbus_connection_send_with_reply_and_block (connection
,
1154 if (dbus_error_is_set (&derror
))
1158 XD_SIGNAL1 (build_string ("No reply"));
1160 XD_DEBUG_MESSAGE ("Message sent");
1162 /* Collect the results. */
1166 if (dbus_message_iter_init (reply
, &iter
))
1168 /* Loop over the parameters of the D-Bus reply message. Construct a
1169 Lisp list, which is returned by `dbus-call-method'. */
1170 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
1171 != DBUS_TYPE_INVALID
)
1173 result
= Fcons (xd_retrieve_arg (dtype
, &iter
), result
);
1174 dbus_message_iter_next (&iter
);
1179 /* No arguments: just return nil. */
1183 dbus_error_free (&derror
);
1184 dbus_message_unref (dmessage
);
1185 dbus_message_unref (reply
);
1187 /* Return the result. If there is only one single Lisp object,
1188 return it as-it-is, otherwise return the reversed list. */
1189 if (XUINT (Flength (result
)) == 1)
1190 RETURN_UNGCPRO (CAR_SAFE (result
));
1192 RETURN_UNGCPRO (Fnreverse (result
));
1195 DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously
,
1196 Sdbus_call_method_asynchronously
, 6, MANY
, 0,
1197 doc
: /* Call METHOD on the D-Bus BUS asynchronously.
1199 BUS is either a Lisp symbol, `:system' or `:session', or a string
1200 denoting the bus address.
1202 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
1203 object path SERVICE is registered at. INTERFACE is an interface
1204 offered by SERVICE. It must provide METHOD.
1206 HANDLER is a Lisp function, which is called when the corresponding
1207 return message has arrived. If HANDLER is nil, no return message will
1210 If the parameter `:timeout' is given, the following integer TIMEOUT
1211 specifies the maximum number of milliseconds the method call must
1212 return. The default value is 25,000. If the method call doesn't
1213 return in time, a D-Bus error is raised.
1215 All other arguments ARGS are passed to METHOD as arguments. They are
1216 converted into D-Bus types via the following rules:
1218 t and nil => DBUS_TYPE_BOOLEAN
1219 number => DBUS_TYPE_UINT32
1220 integer => DBUS_TYPE_INT32
1221 float => DBUS_TYPE_DOUBLE
1222 string => DBUS_TYPE_STRING
1223 list => DBUS_TYPE_ARRAY
1225 All arguments can be preceded by a type symbol. For details about
1226 type symbols, see Info node `(dbus)Type Conversion'.
1228 Unless HANDLER is nil, the function returns a key into the hash table
1229 `dbus-registered-objects-table'. The corresponding entry in the hash
1230 table is removed, when the return message has been arrived, and
1235 \(dbus-call-method-asynchronously
1236 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1237 "org.freedesktop.Hal.Device" "GetPropertyString" 'message
1238 "system.kernel.machine")
1244 usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
1245 (int nargs
, register Lisp_Object
*args
)
1247 Lisp_Object bus
, service
, path
, interface
, method
, handler
;
1249 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1250 DBusConnection
*connection
;
1251 DBusMessage
*dmessage
;
1252 DBusMessageIter iter
;
1256 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1258 /* Check parameters. */
1262 interface
= args
[3];
1266 CHECK_STRING (service
);
1267 CHECK_STRING (path
);
1268 CHECK_STRING (interface
);
1269 CHECK_STRING (method
);
1270 if (!NILP (handler
) && !FUNCTIONP (handler
))
1271 wrong_type_argument (intern ("functionp"), handler
);
1272 GCPRO6 (bus
, service
, path
, interface
, method
, handler
);
1274 XD_DEBUG_MESSAGE ("%s %s %s %s",
1280 /* Open a connection to the bus. */
1281 connection
= xd_initialize (bus
, TRUE
);
1283 /* Create the message. */
1284 dmessage
= dbus_message_new_method_call (SDATA (service
),
1288 if (dmessage
== NULL
)
1289 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1291 /* Check for timeout parameter. */
1292 if ((i
+2 <= nargs
) && (EQ ((args
[i
]), QCdbus_timeout
)))
1294 CHECK_NATNUM (args
[i
+1]);
1295 timeout
= XUINT (args
[i
+1]);
1299 /* Initialize parameter list of message. */
1300 dbus_message_iter_init_append (dmessage
, &iter
);
1302 /* Append parameters to the message. */
1303 for (; i
< nargs
; ++i
)
1305 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1306 if (XD_DBUS_TYPE_P (args
[i
]))
1308 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1309 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1310 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i
-4,
1311 SDATA (format2 ("%s", args
[i
], Qnil
)),
1312 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1317 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1318 XD_DEBUG_MESSAGE ("Parameter%d %s", i
-4,
1319 SDATA (format2 ("%s", args
[i
], Qnil
)));
1322 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1323 indication that there is no parent type. */
1324 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1326 xd_append_arg (dtype
, args
[i
], &iter
);
1329 if (!NILP (handler
))
1331 /* Send the message. The message is just added to the outgoing
1333 if (!dbus_connection_send_with_reply (connection
, dmessage
,
1335 XD_SIGNAL1 (build_string ("Cannot send message"));
1337 /* The result is the key in Vdbus_registered_objects_table. */
1338 result
= (list2 (bus
, make_number (dbus_message_get_serial (dmessage
))));
1340 /* Create a hash table entry. */
1341 Fputhash (result
, handler
, Vdbus_registered_objects_table
);
1345 /* Send the message. The message is just added to the outgoing
1347 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1348 XD_SIGNAL1 (build_string ("Cannot send message"));
1353 XD_DEBUG_MESSAGE ("Message sent");
1356 dbus_message_unref (dmessage
);
1358 /* Return the result. */
1359 RETURN_UNGCPRO (result
);
1362 DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal
,
1363 Sdbus_method_return_internal
,
1365 doc
: /* Return for message SERIAL on the D-Bus BUS.
1366 This is an internal function, it shall not be used outside dbus.el.
1368 usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
1369 (int nargs
, register Lisp_Object
*args
)
1371 Lisp_Object bus
, serial
, service
;
1372 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1373 DBusConnection
*connection
;
1374 DBusMessage
*dmessage
;
1375 DBusMessageIter iter
;
1378 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1380 /* Check parameters. */
1385 CHECK_NUMBER (serial
);
1386 CHECK_STRING (service
);
1387 GCPRO3 (bus
, serial
, service
);
1389 XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial
), SDATA (service
));
1391 /* Open a connection to the bus. */
1392 connection
= xd_initialize (bus
, TRUE
);
1394 /* Create the message. */
1395 dmessage
= dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN
);
1396 if ((dmessage
== NULL
)
1397 || (!dbus_message_set_reply_serial (dmessage
, XUINT (serial
)))
1398 || (!dbus_message_set_destination (dmessage
, SDATA (service
))))
1401 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1406 /* Initialize parameter list of message. */
1407 dbus_message_iter_init_append (dmessage
, &iter
);
1409 /* Append parameters to the message. */
1410 for (i
= 3; i
< nargs
; ++i
)
1412 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1413 if (XD_DBUS_TYPE_P (args
[i
]))
1415 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1416 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1417 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i
-2,
1418 SDATA (format2 ("%s", args
[i
], Qnil
)),
1419 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1424 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1425 XD_DEBUG_MESSAGE ("Parameter%d %s", i
-2,
1426 SDATA (format2 ("%s", args
[i
], Qnil
)));
1429 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1430 indication that there is no parent type. */
1431 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1433 xd_append_arg (dtype
, args
[i
], &iter
);
1436 /* Send the message. The message is just added to the outgoing
1438 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1439 XD_SIGNAL1 (build_string ("Cannot send message"));
1441 XD_DEBUG_MESSAGE ("Message sent");
1444 dbus_message_unref (dmessage
);
1450 DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal
,
1451 Sdbus_method_error_internal
,
1453 doc
: /* Return error message for message SERIAL on the D-Bus BUS.
1454 This is an internal function, it shall not be used outside dbus.el.
1456 usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
1457 (int nargs
, register Lisp_Object
*args
)
1459 Lisp_Object bus
, serial
, service
;
1460 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1461 DBusConnection
*connection
;
1462 DBusMessage
*dmessage
;
1463 DBusMessageIter iter
;
1466 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1468 /* Check parameters. */
1473 CHECK_NUMBER (serial
);
1474 CHECK_STRING (service
);
1475 GCPRO3 (bus
, serial
, service
);
1477 XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial
), SDATA (service
));
1479 /* Open a connection to the bus. */
1480 connection
= xd_initialize (bus
, TRUE
);
1482 /* Create the message. */
1483 dmessage
= dbus_message_new (DBUS_MESSAGE_TYPE_ERROR
);
1484 if ((dmessage
== NULL
)
1485 || (!dbus_message_set_error_name (dmessage
, DBUS_ERROR_FAILED
))
1486 || (!dbus_message_set_reply_serial (dmessage
, XUINT (serial
)))
1487 || (!dbus_message_set_destination (dmessage
, SDATA (service
))))
1490 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1495 /* Initialize parameter list of message. */
1496 dbus_message_iter_init_append (dmessage
, &iter
);
1498 /* Append parameters to the message. */
1499 for (i
= 3; i
< nargs
; ++i
)
1501 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1502 if (XD_DBUS_TYPE_P (args
[i
]))
1504 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1505 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1506 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i
-2,
1507 SDATA (format2 ("%s", args
[i
], Qnil
)),
1508 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1513 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1514 XD_DEBUG_MESSAGE ("Parameter%d %s", i
-2,
1515 SDATA (format2 ("%s", args
[i
], Qnil
)));
1518 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1519 indication that there is no parent type. */
1520 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1522 xd_append_arg (dtype
, args
[i
], &iter
);
1525 /* Send the message. The message is just added to the outgoing
1527 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1528 XD_SIGNAL1 (build_string ("Cannot send message"));
1530 XD_DEBUG_MESSAGE ("Message sent");
1533 dbus_message_unref (dmessage
);
1539 DEFUN ("dbus-send-signal", Fdbus_send_signal
, Sdbus_send_signal
, 5, MANY
, 0,
1540 doc
: /* Send signal SIGNAL on the D-Bus BUS.
1542 BUS is either a Lisp symbol, `:system' or `:session', or a string
1543 denoting the bus address.
1545 SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
1546 D-Bus object path SERVICE is registered at. INTERFACE is an interface
1547 offered by SERVICE. It must provide signal SIGNAL.
1549 All other arguments ARGS are passed to SIGNAL as arguments. They are
1550 converted into D-Bus types via the following rules:
1552 t and nil => DBUS_TYPE_BOOLEAN
1553 number => DBUS_TYPE_UINT32
1554 integer => DBUS_TYPE_INT32
1555 float => DBUS_TYPE_DOUBLE
1556 string => DBUS_TYPE_STRING
1557 list => DBUS_TYPE_ARRAY
1559 All arguments can be preceded by a type symbol. For details about
1560 type symbols, see Info node `(dbus)Type Conversion'.
1565 :session "org.gnu.Emacs" "/org/gnu/Emacs"
1566 "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1568 usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
1569 (int nargs
, register Lisp_Object
*args
)
1571 Lisp_Object bus
, service
, path
, interface
, signal
;
1572 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
1573 DBusConnection
*connection
;
1574 DBusMessage
*dmessage
;
1575 DBusMessageIter iter
;
1578 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1580 /* Check parameters. */
1584 interface
= args
[3];
1587 CHECK_STRING (service
);
1588 CHECK_STRING (path
);
1589 CHECK_STRING (interface
);
1590 CHECK_STRING (signal
);
1591 GCPRO5 (bus
, service
, path
, interface
, signal
);
1593 XD_DEBUG_MESSAGE ("%s %s %s %s",
1599 /* Open a connection to the bus. */
1600 connection
= xd_initialize (bus
, TRUE
);
1602 /* Create the message. */
1603 dmessage
= dbus_message_new_signal (SDATA (path
),
1607 if (dmessage
== NULL
)
1608 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1610 /* Initialize parameter list of message. */
1611 dbus_message_iter_init_append (dmessage
, &iter
);
1613 /* Append parameters to the message. */
1614 for (i
= 5; i
< nargs
; ++i
)
1616 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[i
]);
1617 if (XD_DBUS_TYPE_P (args
[i
]))
1619 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1620 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
+1]);
1621 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i
-4,
1622 SDATA (format2 ("%s", args
[i
], Qnil
)),
1623 SDATA (format2 ("%s", args
[i
+1], Qnil
)));
1628 XD_DEBUG_VALID_LISP_OBJECT_P (args
[i
]);
1629 XD_DEBUG_MESSAGE ("Parameter%d %s", i
-4,
1630 SDATA (format2 ("%s", args
[i
], Qnil
)));
1633 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1634 indication that there is no parent type. */
1635 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[i
]);
1637 xd_append_arg (dtype
, args
[i
], &iter
);
1640 /* Send the message. The message is just added to the outgoing
1642 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1643 XD_SIGNAL1 (build_string ("Cannot send message"));
1645 XD_DEBUG_MESSAGE ("Signal sent");
1648 dbus_message_unref (dmessage
);
1654 /* Read one queued incoming message of the D-Bus BUS.
1655 BUS is either a Lisp symbol, :system or :session, or a string denoting
1658 xd_read_message_1 (DBusConnection
*connection
, Lisp_Object bus
)
1660 Lisp_Object args
, key
, value
;
1661 struct gcpro gcpro1
;
1662 struct input_event event
;
1663 DBusMessage
*dmessage
;
1664 DBusMessageIter iter
;
1667 const char *uname
, *path
, *interface
, *member
;
1669 dmessage
= dbus_connection_pop_message (connection
);
1671 /* Return if there is no queued message. */
1672 if (dmessage
== NULL
)
1675 /* Collect the parameters. */
1679 /* Loop over the resulting parameters. Construct a list. */
1680 if (dbus_message_iter_init (dmessage
, &iter
))
1682 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
1683 != DBUS_TYPE_INVALID
)
1685 args
= Fcons (xd_retrieve_arg (dtype
, &iter
), args
);
1686 dbus_message_iter_next (&iter
);
1688 /* The arguments are stored in reverse order. Reorder them. */
1689 args
= Fnreverse (args
);
1692 /* Read message type, message serial, unique name, object path,
1693 interface and member from the message. */
1694 mtype
= dbus_message_get_type (dmessage
);
1696 ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1697 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1698 ? dbus_message_get_reply_serial (dmessage
)
1699 : dbus_message_get_serial (dmessage
);
1700 uname
= dbus_message_get_sender (dmessage
);
1701 path
= dbus_message_get_path (dmessage
);
1702 interface
= dbus_message_get_interface (dmessage
);
1703 member
= dbus_message_get_member (dmessage
);
1705 XD_DEBUG_MESSAGE ("Event received: %s %d %s %s %s %s %s",
1706 (mtype
== DBUS_MESSAGE_TYPE_INVALID
)
1707 ? "DBUS_MESSAGE_TYPE_INVALID"
1708 : (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1709 ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1710 : (mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1711 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1712 : (mtype
== DBUS_MESSAGE_TYPE_ERROR
)
1713 ? "DBUS_MESSAGE_TYPE_ERROR"
1714 : "DBUS_MESSAGE_TYPE_SIGNAL",
1715 serial
, uname
, path
, interface
, member
,
1716 SDATA (format2 ("%s", args
, Qnil
)));
1718 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1719 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1721 /* Search for a registered function of the message. */
1722 key
= list2 (bus
, make_number (serial
));
1723 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1725 /* There shall be exactly one entry. Construct an event. */
1729 /* Remove the entry. */
1730 Fremhash (key
, Vdbus_registered_objects_table
);
1732 /* Construct an event. */
1734 event
.kind
= DBUS_EVENT
;
1735 event
.frame_or_window
= Qnil
;
1736 event
.arg
= Fcons (value
, args
);
1739 else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
1741 /* Vdbus_registered_objects_table requires non-nil interface and
1743 if ((interface
== NULL
) || (member
== NULL
))
1746 /* Search for a registered function of the message. */
1747 key
= list3 (bus
, build_string (interface
), build_string (member
));
1748 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1750 /* Loop over the registered functions. Construct an event. */
1751 while (!NILP (value
))
1753 key
= CAR_SAFE (value
);
1754 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1755 if (((uname
== NULL
)
1756 || (NILP (CAR_SAFE (key
)))
1757 || (strcmp (uname
, SDATA (CAR_SAFE (key
))) == 0))
1759 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1761 SDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1763 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))))
1766 event
.kind
= DBUS_EVENT
;
1767 event
.frame_or_window
= Qnil
;
1768 event
.arg
= Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))),
1772 value
= CDR_SAFE (value
);
1779 /* Add type, serial, uname, path, interface and member to the event. */
1780 event
.arg
= Fcons ((member
== NULL
? Qnil
: build_string (member
)),
1782 event
.arg
= Fcons ((interface
== NULL
? Qnil
: build_string (interface
)),
1784 event
.arg
= Fcons ((path
== NULL
? Qnil
: build_string (path
)),
1786 event
.arg
= Fcons ((uname
== NULL
? Qnil
: build_string (uname
)),
1788 event
.arg
= Fcons (make_number (serial
), event
.arg
);
1789 event
.arg
= Fcons (make_number (mtype
), event
.arg
);
1791 /* Add the bus symbol to the event. */
1792 event
.arg
= Fcons (bus
, event
.arg
);
1794 /* Store it into the input event queue. */
1795 kbd_buffer_store_event (&event
);
1797 XD_DEBUG_MESSAGE ("Event stored: %s",
1798 SDATA (format2 ("%s", event
.arg
, Qnil
)));
1802 dbus_message_unref (dmessage
);
1807 /* Read queued incoming messages of the D-Bus BUS.
1808 BUS is either a Lisp symbol, :system or :session, or a string denoting
1811 xd_read_message (Lisp_Object bus
)
1813 /* Open a connection to the bus. */
1814 DBusConnection
*connection
= xd_initialize (bus
, TRUE
);
1816 /* Non blocking read of the next available message. */
1817 dbus_connection_read_write (connection
, 0);
1819 while (dbus_connection_get_dispatch_status (connection
)
1820 != DBUS_DISPATCH_COMPLETE
)
1821 xd_read_message_1 (connection
, bus
);
1825 /* Callback called when something is ready to read or write. */
1827 xd_read_queued_messages (int fd
, void *data
, int for_read
)
1829 Lisp_Object busp
= Vdbus_registered_buses
;
1830 Lisp_Object bus
= Qnil
;
1832 /* Find bus related to fd. */
1834 while (!NILP (busp
))
1836 if (data
== (void*) XHASH (CAR_SAFE (busp
)))
1837 bus
= CAR_SAFE (busp
);
1838 busp
= CDR_SAFE (busp
);
1844 /* We ignore all Lisp errors during the call. */
1845 xd_in_read_queued_messages
= 1;
1846 internal_catch (Qdbus_error
, xd_read_message
, bus
);
1847 xd_in_read_queued_messages
= 0;
1850 DEFUN ("dbus-register-service", Fdbus_register_service
, Sdbus_register_service
,
1852 doc
: /* Register known name SERVICE on the D-Bus BUS.
1854 BUS is either a Lisp symbol, `:system' or `:session', or a string
1855 denoting the bus address.
1857 SERVICE is the D-Bus service name that should be registered. It must
1860 FLAGS are keywords, which control how the service name is registered.
1861 The following keywords are recognized:
1863 `:allow-replacement': Allow another service to become the primary
1866 `:replace-existing': Request to replace the current primary owner.
1868 `:do-not-queue': If we can not become the primary owner do not place
1871 The function returns a keyword, indicating the result of the
1872 operation. One of the following keywords is returned:
1874 `:primary-owner': Service has become the primary owner of the
1877 `:in-queue': Service could not become the primary owner and has been
1878 placed in the queue.
1880 `:exists': Service is already in the queue.
1882 `:already-owner': Service is already the primary owner.
1886 \(dbus-register-service :session dbus-service-emacs)
1890 \(dbus-register-service
1891 :session "org.freedesktop.TextEditor"
1892 dbus-service-allow-replacement dbus-service-replace-existing)
1896 usage: (dbus-register-service BUS SERVICE &rest FLAGS) */)
1897 (int nargs
, register Lisp_Object
*args
)
1899 Lisp_Object bus
, service
;
1900 struct gcpro gcpro1
, gcpro2
;
1901 DBusConnection
*connection
;
1904 unsigned int flags
= 0;
1911 /* Check parameters. */
1912 CHECK_STRING (service
);
1914 /* Process flags. */
1915 for (i
= 2; i
< nargs
; ++i
) {
1916 value
= ((EQ (args
[i
], QCdbus_request_name_replace_existing
))
1917 ? DBUS_NAME_FLAG_REPLACE_EXISTING
1918 : (EQ (args
[i
], QCdbus_request_name_allow_replacement
))
1919 ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
1920 : (EQ (args
[i
], QCdbus_request_name_do_not_queue
))
1921 ? DBUS_NAME_FLAG_DO_NOT_QUEUE
1924 XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args
[i
]);
1928 /* Open a connection to the bus. */
1929 connection
= xd_initialize (bus
, TRUE
);
1931 /* Request the known name from the bus. */
1932 dbus_error_init (&derror
);
1933 result
= dbus_bus_request_name (connection
, SDATA (service
), flags
,
1935 if (dbus_error_is_set (&derror
))
1939 dbus_error_free (&derror
);
1941 /* Return object. */
1944 case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER
:
1945 return QCdbus_request_name_reply_primary_owner
;
1946 case DBUS_REQUEST_NAME_REPLY_IN_QUEUE
:
1947 return QCdbus_request_name_reply_in_queue
;
1948 case DBUS_REQUEST_NAME_REPLY_EXISTS
:
1949 return QCdbus_request_name_reply_exists
;
1950 case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER
:
1951 return QCdbus_request_name_reply_already_owner
;
1953 /* This should not happen. */
1954 XD_SIGNAL2 (build_string ("Could not register service"), service
);
1958 DEFUN ("dbus-register-signal", Fdbus_register_signal
, Sdbus_register_signal
,
1960 doc
: /* Register for signal SIGNAL on the D-Bus BUS.
1962 BUS is either a Lisp symbol, `:system' or `:session', or a string
1963 denoting the bus address.
1965 SERVICE is the D-Bus service name used by the sending D-Bus object.
1966 It can be either a known name or the unique name of the D-Bus object
1967 sending the signal. When SERVICE is nil, related signals from all
1968 D-Bus objects shall be accepted.
1970 PATH is the D-Bus object path SERVICE is registered. It can also be
1971 nil if the path name of incoming signals shall not be checked.
1973 INTERFACE is an interface offered by SERVICE. It must provide SIGNAL.
1974 HANDLER is a Lisp function to be called when the signal is received.
1975 It must accept as arguments the values SIGNAL is sending.
1977 All other arguments ARGS, if specified, must be strings. They stand
1978 for the respective arguments of the signal in their order, and are
1979 used for filtering as well. A nil argument might be used to preserve
1982 INTERFACE, SIGNAL and HANDLER must not be nil. Example:
1984 \(defun my-signal-handler (device)
1985 (message "Device %s added" device))
1987 \(dbus-register-signal
1988 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
1989 "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
1991 => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
1992 ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
1994 `dbus-register-signal' returns an object, which can be used in
1995 `dbus-unregister-object' for removing the registration.
1997 usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
1998 (int nargs
, register Lisp_Object
*args
)
2000 Lisp_Object bus
, service
, path
, interface
, signal
, handler
;
2001 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
2002 Lisp_Object uname
, key
, key1
, value
;
2003 DBusConnection
*connection
;
2005 char rule
[DBUS_MAXIMUM_MATCH_RULE_LENGTH
];
2006 char x
[DBUS_MAXIMUM_MATCH_RULE_LENGTH
];
2009 /* Check parameters. */
2013 interface
= args
[3];
2017 if (!NILP (service
)) CHECK_STRING (service
);
2018 if (!NILP (path
)) CHECK_STRING (path
);
2019 CHECK_STRING (interface
);
2020 CHECK_STRING (signal
);
2021 if (!FUNCTIONP (handler
))
2022 wrong_type_argument (intern ("functionp"), handler
);
2023 GCPRO6 (bus
, service
, path
, interface
, signal
, handler
);
2025 /* Retrieve unique name of service. If service is a known name, we
2026 will register for the corresponding unique name, if any. Signals
2027 are sent always with the unique name as sender. Note: the unique
2028 name of "org.freedesktop.DBus" is that string itself. */
2029 if ((STRINGP (service
))
2030 && (SBYTES (service
) > 0)
2031 && (strcmp (SDATA (service
), DBUS_SERVICE_DBUS
) != 0)
2032 && (strncmp (SDATA (service
), ":", 1) != 0))
2034 uname
= call2 (intern ("dbus-get-name-owner"), bus
, service
);
2035 /* When there is no unique name, we mark it with an empty
2038 uname
= empty_unibyte_string
;
2043 /* Create a matching rule if the unique name exists (when no
2045 if (NILP (uname
) || (SBYTES (uname
) > 0))
2047 /* Open a connection to the bus. */
2048 connection
= xd_initialize (bus
, TRUE
);
2050 /* Create a rule to receive related signals. */
2052 "type='signal',interface='%s',member='%s'",
2056 /* Add unique name and path to the rule if they are non-nil. */
2059 sprintf (x
, ",sender='%s'", SDATA (uname
));
2065 sprintf (x
, ",path='%s'", SDATA (path
));
2069 /* Add arguments to the rule if they are non-nil. */
2070 for (i
= 6; i
< nargs
; ++i
)
2071 if (!NILP (args
[i
]))
2073 CHECK_STRING (args
[i
]);
2074 sprintf (x
, ",arg%d='%s'", i
-6, SDATA (args
[i
]));
2078 /* Add the rule to the bus. */
2079 dbus_error_init (&derror
);
2080 dbus_bus_add_match (connection
, rule
, &derror
);
2081 if (dbus_error_is_set (&derror
))
2088 dbus_error_free (&derror
);
2090 XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule
);
2093 /* Create a hash table entry. */
2094 key
= list3 (bus
, interface
, signal
);
2095 key1
= list4 (uname
, service
, path
, handler
);
2096 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
2098 if (NILP (Fmember (key1
, value
)))
2099 Fputhash (key
, Fcons (key1
, value
), Vdbus_registered_objects_table
);
2101 /* Return object. */
2102 RETURN_UNGCPRO (list2 (key
, list3 (service
, path
, handler
)));
2105 DEFUN ("dbus-register-method", Fdbus_register_method
, Sdbus_register_method
,
2107 doc
: /* Register for method METHOD on the D-Bus BUS.
2109 BUS is either a Lisp symbol, `:system' or `:session', or a string
2110 denoting the bus address.
2112 SERVICE is the D-Bus service name of the D-Bus object METHOD is
2113 registered for. It must be a known name (See discussion of
2114 DONT-REGISTER-SERVICE below).
2116 PATH is the D-Bus object path SERVICE is registered (See discussion of
2117 DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
2118 SERVICE. It must provide METHOD. HANDLER is a Lisp function to be
2119 called when a method call is received. It must accept the input
2120 arguments of METHOD. The return value of HANDLER is used for
2121 composing the returning D-Bus message.
2123 When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
2124 registered. This means that other D-Bus clients have no way of
2125 noticing the newly registered method. When interfaces are constructed
2126 incrementally by adding single methods or properties at a time,
2127 DONT-REGISTER-SERVICE can be use to prevent other clients from
2128 discovering the still incomplete interface.*/)
2129 (Lisp_Object bus
, Lisp_Object service
, Lisp_Object path
,
2130 Lisp_Object interface
, Lisp_Object method
, Lisp_Object handler
,
2131 Lisp_Object dont_register_service
)
2133 Lisp_Object key
, key1
, value
;
2135 Lisp_Object args
[2] = { bus
, service
};
2137 /* Check parameters. */
2138 CHECK_STRING (service
);
2139 CHECK_STRING (path
);
2140 CHECK_STRING (interface
);
2141 CHECK_STRING (method
);
2142 if (!FUNCTIONP (handler
))
2143 wrong_type_argument (intern ("functionp"), handler
);
2144 /* TODO: We must check for a valid service name, otherwise there is
2145 a segmentation fault. */
2147 /* Request the name. */
2148 if (NILP (dont_register_service
))
2149 Fdbus_register_service (2, args
);
2151 /* Create a hash table entry. We use nil for the unique name,
2152 because the method might be called from anybody. */
2153 key
= list3 (bus
, interface
, method
);
2154 key1
= list4 (Qnil
, service
, path
, handler
);
2155 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
2157 if (NILP (Fmember (key1
, value
)))
2158 Fputhash (key
, Fcons (key1
, value
), Vdbus_registered_objects_table
);
2160 /* Return object. */
2161 return list2 (key
, list3 (service
, path
, handler
));
2166 syms_of_dbusbind (void)
2169 Qdbus_init_bus
= intern_c_string ("dbus-init-bus");
2170 staticpro (&Qdbus_init_bus
);
2171 defsubr (&Sdbus_init_bus
);
2173 Qdbus_close_bus
= intern_c_string ("dbus-close-bus");
2174 staticpro (&Qdbus_close_bus
);
2175 defsubr (&Sdbus_close_bus
);
2177 Qdbus_get_unique_name
= intern_c_string ("dbus-get-unique-name");
2178 staticpro (&Qdbus_get_unique_name
);
2179 defsubr (&Sdbus_get_unique_name
);
2181 Qdbus_call_method
= intern_c_string ("dbus-call-method");
2182 staticpro (&Qdbus_call_method
);
2183 defsubr (&Sdbus_call_method
);
2185 Qdbus_call_method_asynchronously
= intern_c_string ("dbus-call-method-asynchronously");
2186 staticpro (&Qdbus_call_method_asynchronously
);
2187 defsubr (&Sdbus_call_method_asynchronously
);
2189 Qdbus_method_return_internal
= intern_c_string ("dbus-method-return-internal");
2190 staticpro (&Qdbus_method_return_internal
);
2191 defsubr (&Sdbus_method_return_internal
);
2193 Qdbus_method_error_internal
= intern_c_string ("dbus-method-error-internal");
2194 staticpro (&Qdbus_method_error_internal
);
2195 defsubr (&Sdbus_method_error_internal
);
2197 Qdbus_send_signal
= intern_c_string ("dbus-send-signal");
2198 staticpro (&Qdbus_send_signal
);
2199 defsubr (&Sdbus_send_signal
);
2201 Qdbus_register_service
= intern_c_string ("dbus-register-service");
2202 staticpro (&Qdbus_register_service
);
2203 defsubr (&Sdbus_register_service
);
2205 Qdbus_register_signal
= intern_c_string ("dbus-register-signal");
2206 staticpro (&Qdbus_register_signal
);
2207 defsubr (&Sdbus_register_signal
);
2209 Qdbus_register_method
= intern_c_string ("dbus-register-method");
2210 staticpro (&Qdbus_register_method
);
2211 defsubr (&Sdbus_register_method
);
2213 Qdbus_error
= intern_c_string ("dbus-error");
2214 staticpro (&Qdbus_error
);
2215 Fput (Qdbus_error
, Qerror_conditions
,
2216 list2 (Qdbus_error
, Qerror
));
2217 Fput (Qdbus_error
, Qerror_message
,
2218 make_pure_c_string ("D-Bus error"));
2220 QCdbus_system_bus
= intern_c_string (":system");
2221 staticpro (&QCdbus_system_bus
);
2223 QCdbus_session_bus
= intern_c_string (":session");
2224 staticpro (&QCdbus_session_bus
);
2226 QCdbus_request_name_allow_replacement
= intern_c_string (":allow-replacement");
2227 staticpro (&QCdbus_request_name_allow_replacement
);
2229 QCdbus_request_name_replace_existing
= intern_c_string (":replace-existing");
2230 staticpro (&QCdbus_request_name_replace_existing
);
2232 QCdbus_request_name_do_not_queue
= intern_c_string (":do-not-queue");
2233 staticpro (&QCdbus_request_name_do_not_queue
);
2235 QCdbus_request_name_reply_primary_owner
= intern_c_string (":primary-owner");
2236 staticpro (&QCdbus_request_name_reply_primary_owner
);
2238 QCdbus_request_name_reply_exists
= intern_c_string (":exists");
2239 staticpro (&QCdbus_request_name_reply_exists
);
2241 QCdbus_request_name_reply_in_queue
= intern_c_string (":in-queue");
2242 staticpro (&QCdbus_request_name_reply_in_queue
);
2244 QCdbus_request_name_reply_already_owner
= intern_c_string (":already-owner");
2245 staticpro (&QCdbus_request_name_reply_already_owner
);
2247 QCdbus_timeout
= intern_c_string (":timeout");
2248 staticpro (&QCdbus_timeout
);
2250 QCdbus_type_byte
= intern_c_string (":byte");
2251 staticpro (&QCdbus_type_byte
);
2253 QCdbus_type_boolean
= intern_c_string (":boolean");
2254 staticpro (&QCdbus_type_boolean
);
2256 QCdbus_type_int16
= intern_c_string (":int16");
2257 staticpro (&QCdbus_type_int16
);
2259 QCdbus_type_uint16
= intern_c_string (":uint16");
2260 staticpro (&QCdbus_type_uint16
);
2262 QCdbus_type_int32
= intern_c_string (":int32");
2263 staticpro (&QCdbus_type_int32
);
2265 QCdbus_type_uint32
= intern_c_string (":uint32");
2266 staticpro (&QCdbus_type_uint32
);
2268 QCdbus_type_int64
= intern_c_string (":int64");
2269 staticpro (&QCdbus_type_int64
);
2271 QCdbus_type_uint64
= intern_c_string (":uint64");
2272 staticpro (&QCdbus_type_uint64
);
2274 QCdbus_type_double
= intern_c_string (":double");
2275 staticpro (&QCdbus_type_double
);
2277 QCdbus_type_string
= intern_c_string (":string");
2278 staticpro (&QCdbus_type_string
);
2280 QCdbus_type_object_path
= intern_c_string (":object-path");
2281 staticpro (&QCdbus_type_object_path
);
2283 QCdbus_type_signature
= intern_c_string (":signature");
2284 staticpro (&QCdbus_type_signature
);
2286 #ifdef DBUS_TYPE_UNIX_FD
2287 QCdbus_type_unix_fd
= intern_c_string (":unix-fd");
2288 staticpro (&QCdbus_type_unix_fd
);
2291 QCdbus_type_array
= intern_c_string (":array");
2292 staticpro (&QCdbus_type_array
);
2294 QCdbus_type_variant
= intern_c_string (":variant");
2295 staticpro (&QCdbus_type_variant
);
2297 QCdbus_type_struct
= intern_c_string (":struct");
2298 staticpro (&QCdbus_type_struct
);
2300 QCdbus_type_dict_entry
= intern_c_string (":dict-entry");
2301 staticpro (&QCdbus_type_dict_entry
);
2303 DEFVAR_LISP ("dbus-registered-buses",
2304 &Vdbus_registered_buses
,
2305 doc
: /* List of D-Bus buses we are polling for messages. */);
2306 Vdbus_registered_buses
= Qnil
;
2308 DEFVAR_LISP ("dbus-registered-objects-table",
2309 &Vdbus_registered_objects_table
,
2310 doc
: /* Hash table of registered functions for D-Bus.
2312 There are two different uses of the hash table: for accessing
2313 registered interfaces properties, targeted by signals or method calls,
2314 and for calling handlers in case of non-blocking method call returns.
2316 In the first case, the key in the hash table is the list (BUS
2317 INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or
2318 `:session', or a string denoting the bus address. INTERFACE is a
2319 string which denotes a D-Bus interface, and MEMBER, also a string, is
2320 either a method, a signal or a property INTERFACE is offering. All
2321 arguments but BUS must not be nil.
2323 The value in the hash table is a list of quadruple lists
2324 \((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...).
2325 SERVICE is the service name as registered, UNAME is the corresponding
2326 unique name. In case of registered methods and properties, UNAME is
2327 nil. PATH is the object path of the sending object. All of them can
2328 be nil, which means a wildcard then. OBJECT is either the handler to
2329 be called when a D-Bus message, which matches the key criteria,
2330 arrives (methods and signals), or a cons cell containing the value of
2333 In the second case, the key in the hash table is the list (BUS
2334 SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
2335 string denoting the bus address. SERIAL is the serial number of the
2336 non-blocking method call, a reply is expected. Both arguments must
2337 not be nil. The value in the hash table is HANDLER, the function to
2338 be called when the D-Bus reply message arrives. */);
2340 Lisp_Object args
[2];
2343 Vdbus_registered_objects_table
= Fmake_hash_table (2, args
);
2346 DEFVAR_LISP ("dbus-debug", &Vdbus_debug
,
2347 doc
: /* If non-nil, debug messages of D-Bus bindings are raised. */);
2350 /* We can also set environment variable DBUS_VERBOSE=1 in order to
2351 see more traces. This requires libdbus-1 to be configured with
2352 --enable-verbose-mode. */
2357 Fprovide (intern_c_string ("dbusbind"), Qnil
);
2361 #endif /* HAVE_DBUS */
2363 /* arch-tag: 0e828477-b571-4fe4-b559-5c9211bc14b8
2364 (do not change this comment) */