Backport Bug#9990 fix from trunk
[emacs.git] / src / dbusbind.c
blob1f3168ee67484aac37f71db532e97fc7f5773e77
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/>. */
19 #include "config.h"
21 #ifdef HAVE_DBUS
22 #include <stdlib.h>
23 #include <stdio.h>
24 #include <dbus/dbus.h>
25 #include <setjmp.h>
26 #include "lisp.h"
27 #include "frame.h"
28 #include "termhooks.h"
29 #include "keyboard.h"
32 /* Subroutines. */
33 Lisp_Object Qdbus_init_bus;
34 Lisp_Object Qdbus_get_unique_name;
35 Lisp_Object Qdbus_call_method;
36 Lisp_Object Qdbus_call_method_asynchronously;
37 Lisp_Object Qdbus_method_return_internal;
38 Lisp_Object Qdbus_method_error_internal;
39 Lisp_Object Qdbus_send_signal;
40 Lisp_Object Qdbus_register_signal;
41 Lisp_Object Qdbus_register_method;
43 /* D-Bus error symbol. */
44 Lisp_Object Qdbus_error;
46 /* Lisp symbols of the system and session buses. */
47 Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
49 /* Lisp symbol for method call timeout. */
50 Lisp_Object QCdbus_timeout;
52 /* Lisp symbols of D-Bus types. */
53 Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
54 Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
55 Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
56 Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
57 Lisp_Object QCdbus_type_double, QCdbus_type_string;
58 Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
59 Lisp_Object QCdbus_type_array, QCdbus_type_variant;
60 Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
62 /* Hash table which keeps function definitions. */
63 Lisp_Object Vdbus_registered_objects_table;
65 /* Whether to debug D-Bus. */
66 Lisp_Object Vdbus_debug;
68 /* Whether we are reading a D-Bus event. */
69 int xd_in_read_queued_messages = 0;
72 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
73 we don't want to poison other namespaces with "dbus_". */
75 /* Raise a signal. If we are reading events, we cannot signal; we
76 throw to xd_read_queued_messages then. */
77 #define XD_SIGNAL1(arg) \
78 do { \
79 if (xd_in_read_queued_messages) \
80 Fthrow (Qdbus_error, Qnil); \
81 else \
82 xsignal1 (Qdbus_error, arg); \
83 } while (0)
85 #define XD_SIGNAL2(arg1, arg2) \
86 do { \
87 if (xd_in_read_queued_messages) \
88 Fthrow (Qdbus_error, Qnil); \
89 else \
90 xsignal2 (Qdbus_error, arg1, arg2); \
91 } while (0)
93 #define XD_SIGNAL3(arg1, arg2, arg3) \
94 do { \
95 if (xd_in_read_queued_messages) \
96 Fthrow (Qdbus_error, Qnil); \
97 else \
98 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
99 } while (0)
101 /* Raise a Lisp error from a D-Bus ERROR. */
102 #define XD_ERROR(error) \
103 do { \
104 char s[1024]; \
105 strncpy (s, error.message, 1023); \
106 dbus_error_free (&error); \
107 /* Remove the trailing newline. */ \
108 if (strchr (s, '\n') != NULL) \
109 s[strlen (s) - 1] = '\0'; \
110 XD_SIGNAL1 (build_string (s)); \
111 } while (0)
113 /* Macros for debugging. In order to enable them, build with
114 "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'". */
115 #ifdef DBUS_DEBUG
116 #define XD_DEBUG_MESSAGE(...) \
117 do { \
118 char s[1024]; \
119 snprintf (s, 1023, __VA_ARGS__); \
120 printf ("%s: %s\n", __func__, s); \
121 message ("%s: %s", __func__, s); \
122 } while (0)
123 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
124 do { \
125 if (!valid_lisp_object_p (object)) \
127 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
128 XD_SIGNAL1 (build_string ("Assertion failure")); \
130 } while (0)
132 #else /* !DBUS_DEBUG */
133 #define XD_DEBUG_MESSAGE(...) \
134 do { \
135 if (!NILP (Vdbus_debug)) \
137 char s[1024]; \
138 snprintf (s, 1023, __VA_ARGS__); \
139 message ("%s: %s", __func__, s); \
141 } while (0)
142 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
143 #endif
145 /* Check whether TYPE is a basic DBusType. */
146 #define XD_BASIC_DBUS_TYPE(type) \
147 ((type == DBUS_TYPE_BYTE) \
148 || (type == DBUS_TYPE_BOOLEAN) \
149 || (type == DBUS_TYPE_INT16) \
150 || (type == DBUS_TYPE_UINT16) \
151 || (type == DBUS_TYPE_INT32) \
152 || (type == DBUS_TYPE_UINT32) \
153 || (type == DBUS_TYPE_INT64) \
154 || (type == DBUS_TYPE_UINT64) \
155 || (type == DBUS_TYPE_DOUBLE) \
156 || (type == DBUS_TYPE_STRING) \
157 || (type == DBUS_TYPE_OBJECT_PATH) \
158 || (type == DBUS_TYPE_SIGNATURE))
160 /* This was a macro. On Solaris 2.11 it was said to compile for
161 hours, when optimzation is enabled. So we have transferred it into
162 a function. */
163 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
164 of the predefined D-Bus type symbols. */
165 static int
166 xd_symbol_to_dbus_type (object)
167 Lisp_Object object;
169 return
170 ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
171 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
172 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
173 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
174 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
175 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
176 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
177 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
178 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
179 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
180 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
181 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
182 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
183 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
184 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
185 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
186 : DBUS_TYPE_INVALID);
189 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
190 #define XD_DBUS_TYPE_P(object) \
191 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
193 /* Determine the DBusType of a given Lisp OBJECT. It is used to
194 convert Lisp objects, being arguments of `dbus-call-method' or
195 `dbus-send-signal', into corresponding C values appended as
196 arguments to a D-Bus message. */
197 #define XD_OBJECT_TO_DBUS_TYPE(object) \
198 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
199 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
200 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
201 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
202 : (STRINGP (object)) ? DBUS_TYPE_STRING \
203 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
204 : (CONSP (object)) \
205 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
206 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
207 ? DBUS_TYPE_ARRAY \
208 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
209 : DBUS_TYPE_ARRAY) \
210 : DBUS_TYPE_INVALID)
212 /* Return a list pointer which does not have a Lisp symbol as car. */
213 #define XD_NEXT_VALUE(object) \
214 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
216 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
217 used in dbus_message_iter_open_container. DTYPE is the DBusType
218 the object is related to. It is passed as argument, because it
219 cannot be detected in basic type objects, when they are preceded by
220 a type symbol. PARENT_TYPE is the DBusType of a container this
221 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
222 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
223 static void
224 xd_signature (signature, dtype, parent_type, object)
225 char *signature;
226 unsigned int dtype, parent_type;
227 Lisp_Object object;
229 unsigned int subtype;
230 Lisp_Object elt;
231 char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
233 elt = object;
235 switch (dtype)
237 case DBUS_TYPE_BYTE:
238 case DBUS_TYPE_UINT16:
239 case DBUS_TYPE_UINT32:
240 case DBUS_TYPE_UINT64:
241 CHECK_NATNUM (object);
242 sprintf (signature, "%c", dtype);
243 break;
245 case DBUS_TYPE_BOOLEAN:
246 if (!EQ (object, Qt) && !EQ (object, Qnil))
247 wrong_type_argument (intern ("booleanp"), object);
248 sprintf (signature, "%c", dtype);
249 break;
251 case DBUS_TYPE_INT16:
252 case DBUS_TYPE_INT32:
253 case DBUS_TYPE_INT64:
254 CHECK_NUMBER (object);
255 sprintf (signature, "%c", dtype);
256 break;
258 case DBUS_TYPE_DOUBLE:
259 CHECK_FLOAT (object);
260 sprintf (signature, "%c", dtype);
261 break;
263 case DBUS_TYPE_STRING:
264 case DBUS_TYPE_OBJECT_PATH:
265 case DBUS_TYPE_SIGNATURE:
266 CHECK_STRING (object);
267 sprintf (signature, "%c", dtype);
268 break;
270 case DBUS_TYPE_ARRAY:
271 /* Check that all list elements have the same D-Bus type. For
272 complex element types, we just check the container type, not
273 the whole element's signature. */
274 CHECK_CONS (object);
276 /* Type symbol is optional. */
277 if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
278 elt = XD_NEXT_VALUE (elt);
280 /* If the array is empty, DBUS_TYPE_STRING is the default
281 element type. */
282 if (NILP (elt))
284 subtype = DBUS_TYPE_STRING;
285 strcpy (x, DBUS_TYPE_STRING_AS_STRING);
287 else
289 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
290 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
293 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
294 only element, the value of this element is used as he array's
295 element signature. */
296 if ((subtype == DBUS_TYPE_SIGNATURE)
297 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
298 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
299 strcpy (x, SDATA (CAR_SAFE (XD_NEXT_VALUE (elt))));
301 while (!NILP (elt))
303 if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
304 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
305 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
308 sprintf (signature, "%c%s", dtype, x);
309 break;
311 case DBUS_TYPE_VARIANT:
312 /* Check that there is exactly one list element. */
313 CHECK_CONS (object);
315 elt = XD_NEXT_VALUE (elt);
316 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
317 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
319 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
320 wrong_type_argument (intern ("D-Bus"),
321 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
323 sprintf (signature, "%c", dtype);
324 break;
326 case DBUS_TYPE_STRUCT:
327 /* A struct list might contain any number of elements with
328 different types. No further check needed. */
329 CHECK_CONS (object);
331 elt = XD_NEXT_VALUE (elt);
333 /* Compose the signature from the elements. It is enclosed by
334 parentheses. */
335 sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
336 while (!NILP (elt))
338 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
339 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
340 strcat (signature, x);
341 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
343 strcat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
344 break;
346 case DBUS_TYPE_DICT_ENTRY:
347 /* Check that there are exactly two list elements, and the first
348 one is of basic type. The dictionary entry itself must be an
349 element of an array. */
350 CHECK_CONS (object);
352 /* Check the parent object type. */
353 if (parent_type != DBUS_TYPE_ARRAY)
354 wrong_type_argument (intern ("D-Bus"), object);
356 /* Compose the signature from the elements. It is enclosed by
357 curly braces. */
358 sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
360 /* First element. */
361 elt = XD_NEXT_VALUE (elt);
362 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
363 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
364 strcat (signature, x);
366 if (!XD_BASIC_DBUS_TYPE (subtype))
367 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
369 /* Second element. */
370 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
371 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
372 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
373 strcat (signature, x);
375 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
376 wrong_type_argument (intern ("D-Bus"),
377 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
379 /* Closing signature. */
380 strcat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
381 break;
383 default:
384 wrong_type_argument (intern ("D-Bus"), object);
387 XD_DEBUG_MESSAGE ("%s", signature);
390 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
391 DTYPE must be a valid DBusType. It is used to convert Lisp
392 objects, being arguments of `dbus-call-method' or
393 `dbus-send-signal', into corresponding C values appended as
394 arguments to a D-Bus message. */
395 static void
396 xd_append_arg (dtype, object, iter)
397 unsigned int dtype;
398 Lisp_Object object;
399 DBusMessageIter *iter;
401 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
402 DBusMessageIter subiter;
404 if (XD_BASIC_DBUS_TYPE (dtype))
405 switch (dtype)
407 case DBUS_TYPE_BYTE:
408 CHECK_NUMBER (object);
410 unsigned char val = XUINT (object) & 0xFF;
411 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
412 if (!dbus_message_iter_append_basic (iter, dtype, &val))
413 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
414 return;
417 case DBUS_TYPE_BOOLEAN:
419 dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
420 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
421 if (!dbus_message_iter_append_basic (iter, dtype, &val))
422 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
423 return;
426 case DBUS_TYPE_INT16:
427 CHECK_NUMBER (object);
429 dbus_int16_t val = XINT (object);
430 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
431 if (!dbus_message_iter_append_basic (iter, dtype, &val))
432 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
433 return;
436 case DBUS_TYPE_UINT16:
437 CHECK_NUMBER (object);
439 dbus_uint16_t val = XUINT (object);
440 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
441 if (!dbus_message_iter_append_basic (iter, dtype, &val))
442 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
443 return;
446 case DBUS_TYPE_INT32:
447 CHECK_NUMBER (object);
449 dbus_int32_t val = XINT (object);
450 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
451 if (!dbus_message_iter_append_basic (iter, dtype, &val))
452 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
453 return;
456 case DBUS_TYPE_UINT32:
457 CHECK_NUMBER (object);
459 dbus_uint32_t val = XUINT (object);
460 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
461 if (!dbus_message_iter_append_basic (iter, dtype, &val))
462 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
463 return;
466 case DBUS_TYPE_INT64:
467 CHECK_NUMBER (object);
469 dbus_int64_t val = XINT (object);
470 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
471 if (!dbus_message_iter_append_basic (iter, dtype, &val))
472 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
473 return;
476 case DBUS_TYPE_UINT64:
477 CHECK_NUMBER (object);
479 dbus_uint64_t val = XUINT (object);
480 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
481 if (!dbus_message_iter_append_basic (iter, dtype, &val))
482 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
483 return;
486 case DBUS_TYPE_DOUBLE:
487 CHECK_FLOAT (object);
489 double val = XFLOAT_DATA (object);
490 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
491 if (!dbus_message_iter_append_basic (iter, dtype, &val))
492 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
493 return;
496 case DBUS_TYPE_STRING:
497 case DBUS_TYPE_OBJECT_PATH:
498 case DBUS_TYPE_SIGNATURE:
499 CHECK_STRING (object);
501 /* We need to send a valid UTF-8 string. We could encode `object'
502 but by not encoding it, we guarantee it's valid utf-8, even if
503 it contains eight-bit-bytes. Of course, you can still send
504 manually-crafted junk by passing a unibyte string. */
505 char *val = SDATA (object);
506 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
507 if (!dbus_message_iter_append_basic (iter, dtype, &val))
508 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
509 return;
513 else /* Compound types. */
516 /* All compound types except array have a type symbol. For
517 array, it is optional. Skip it. */
518 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
519 object = XD_NEXT_VALUE (object);
521 /* Open new subiteration. */
522 switch (dtype)
524 case DBUS_TYPE_ARRAY:
525 /* An array has only elements of the same type. So it is
526 sufficient to check the first element's signature
527 only. */
529 if (NILP (object))
530 /* If the array is empty, DBUS_TYPE_STRING is the default
531 element type. */
532 strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
534 else
535 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
536 the only element, the value of this element is used as
537 the array's element signature. */
538 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
539 == DBUS_TYPE_SIGNATURE)
540 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
541 && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
543 strcpy (signature, SDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
544 object = CDR_SAFE (XD_NEXT_VALUE (object));
547 else
548 xd_signature (signature,
549 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
550 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
552 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
553 SDATA (format2 ("%s", object, Qnil)));
554 if (!dbus_message_iter_open_container (iter, dtype,
555 signature, &subiter))
556 XD_SIGNAL3 (build_string ("Cannot open container"),
557 make_number (dtype), build_string (signature));
558 break;
560 case DBUS_TYPE_VARIANT:
561 /* A variant has just one element. */
562 xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
563 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
565 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
566 SDATA (format2 ("%s", object, Qnil)));
567 if (!dbus_message_iter_open_container (iter, dtype,
568 signature, &subiter))
569 XD_SIGNAL3 (build_string ("Cannot open container"),
570 make_number (dtype), build_string (signature));
571 break;
573 case DBUS_TYPE_STRUCT:
574 case DBUS_TYPE_DICT_ENTRY:
575 /* These containers do not require a signature. */
576 XD_DEBUG_MESSAGE ("%c %s", dtype,
577 SDATA (format2 ("%s", object, Qnil)));
578 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
579 XD_SIGNAL2 (build_string ("Cannot open container"),
580 make_number (dtype));
581 break;
584 /* Loop over list elements. */
585 while (!NILP (object))
587 dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
588 object = XD_NEXT_VALUE (object);
590 xd_append_arg (dtype, CAR_SAFE (object), &subiter);
592 object = CDR_SAFE (object);
595 /* Close the subiteration. */
596 if (!dbus_message_iter_close_container (iter, &subiter))
597 XD_SIGNAL2 (build_string ("Cannot close container"),
598 make_number (dtype));
602 /* Retrieve C value from a DBusMessageIter structure ITER, and return
603 a converted Lisp object. The type DTYPE of the argument of the
604 D-Bus message must be a valid DBusType. Compound D-Bus types
605 result always in a Lisp list. */
606 static Lisp_Object
607 xd_retrieve_arg (dtype, iter)
608 unsigned int dtype;
609 DBusMessageIter *iter;
612 switch (dtype)
614 case DBUS_TYPE_BYTE:
616 unsigned int val;
617 dbus_message_iter_get_basic (iter, &val);
618 val = val & 0xFF;
619 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
620 return make_number (val);
623 case DBUS_TYPE_BOOLEAN:
625 dbus_bool_t val;
626 dbus_message_iter_get_basic (iter, &val);
627 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
628 return (val == FALSE) ? Qnil : Qt;
631 case DBUS_TYPE_INT16:
633 dbus_int16_t val;
634 dbus_message_iter_get_basic (iter, &val);
635 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
636 return make_number (val);
639 case DBUS_TYPE_UINT16:
641 dbus_uint16_t val;
642 dbus_message_iter_get_basic (iter, &val);
643 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
644 return make_number (val);
647 case DBUS_TYPE_INT32:
649 dbus_int32_t val;
650 dbus_message_iter_get_basic (iter, &val);
651 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
652 return make_fixnum_or_float (val);
655 case DBUS_TYPE_UINT32:
657 dbus_uint32_t val;
658 dbus_message_iter_get_basic (iter, &val);
659 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
660 return make_fixnum_or_float (val);
663 case DBUS_TYPE_INT64:
665 dbus_int64_t val;
666 dbus_message_iter_get_basic (iter, &val);
667 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
668 return make_fixnum_or_float (val);
671 case DBUS_TYPE_UINT64:
673 dbus_uint64_t val;
674 dbus_message_iter_get_basic (iter, &val);
675 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
676 return make_fixnum_or_float (val);
679 case DBUS_TYPE_DOUBLE:
681 double val;
682 dbus_message_iter_get_basic (iter, &val);
683 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
684 return make_float (val);
687 case DBUS_TYPE_STRING:
688 case DBUS_TYPE_OBJECT_PATH:
689 case DBUS_TYPE_SIGNATURE:
691 char *val;
692 dbus_message_iter_get_basic (iter, &val);
693 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
694 return build_string (val);
697 case DBUS_TYPE_ARRAY:
698 case DBUS_TYPE_VARIANT:
699 case DBUS_TYPE_STRUCT:
700 case DBUS_TYPE_DICT_ENTRY:
702 Lisp_Object result;
703 struct gcpro gcpro1;
704 DBusMessageIter subiter;
705 int subtype;
706 result = Qnil;
707 GCPRO1 (result);
708 dbus_message_iter_recurse (iter, &subiter);
709 while ((subtype = dbus_message_iter_get_arg_type (&subiter))
710 != DBUS_TYPE_INVALID)
712 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
713 dbus_message_iter_next (&subiter);
715 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil)));
716 RETURN_UNGCPRO (Fnreverse (result));
719 default:
720 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
721 return Qnil;
725 /* Initialize D-Bus connection. BUS is a Lisp symbol, either :system
726 or :session. It tells which D-Bus to be initialized. */
727 static DBusConnection *
728 xd_initialize (bus)
729 Lisp_Object bus;
731 DBusConnection *connection;
732 DBusError derror;
734 /* Parameter check. */
735 CHECK_SYMBOL (bus);
736 if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
737 XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
739 /* We do not want to have an autolaunch for the session bus. */
740 if (EQ (bus, QCdbus_session_bus)
741 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
742 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
744 /* Open a connection to the bus. */
745 dbus_error_init (&derror);
747 if (EQ (bus, QCdbus_system_bus))
748 connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
749 else
750 connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
752 if (dbus_error_is_set (&derror))
753 XD_ERROR (derror);
755 if (connection == NULL)
756 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
758 /* Cleanup. */
759 dbus_error_free (&derror);
761 /* Return the result. */
762 return connection;
766 /* Add connection file descriptor to input_wait_mask, in order to
767 let select() detect, whether a new message has been arrived. */
768 dbus_bool_t
769 xd_add_watch (watch, data)
770 DBusWatch *watch;
771 void *data;
773 /* We check only for incoming data. */
774 if (dbus_watch_get_flags (watch) & DBUS_WATCH_READABLE)
776 #if HAVE_DBUS_WATCH_GET_UNIX_FD
777 /* TODO: Reverse these on Win32, which prefers the opposite. */
778 int fd = dbus_watch_get_unix_fd(watch);
779 if (fd == -1)
780 fd = dbus_watch_get_socket(watch);
781 #else
782 int fd = dbus_watch_get_fd(watch);
783 #endif
784 XD_DEBUG_MESSAGE ("fd %d", fd);
786 if (fd == -1)
787 return FALSE;
789 /* Add the file descriptor to input_wait_mask. */
790 add_keyboard_wait_descriptor (fd);
793 /* Return. */
794 return TRUE;
797 /* Remove connection file descriptor from input_wait_mask. DATA is
798 the used bus, either QCdbus_system_bus or QCdbus_session_bus. */
799 void
800 xd_remove_watch (watch, data)
801 DBusWatch *watch;
802 void *data;
804 /* We check only for incoming data. */
805 if (dbus_watch_get_flags (watch) & DBUS_WATCH_READABLE)
807 #if HAVE_DBUS_WATCH_GET_UNIX_FD
808 /* TODO: Reverse these on Win32, which prefers the opposite. */
809 int fd = dbus_watch_get_unix_fd(watch);
810 if (fd == -1)
811 fd = dbus_watch_get_socket(watch);
812 #else
813 int fd = dbus_watch_get_fd(watch);
814 #endif
815 XD_DEBUG_MESSAGE ("fd %d", fd);
817 if (fd == -1)
818 return;
820 /* Unset session environment. */
821 if ((data != NULL) && (data == (void*) XHASH (QCdbus_session_bus)))
823 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
824 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
827 /* Remove the file descriptor from input_wait_mask. */
828 delete_keyboard_wait_descriptor (fd);
831 /* Return. */
832 return;
835 DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
836 doc: /* Initialize connection to D-Bus BUS.
837 This is an internal function, it shall not be used outside dbus.el. */)
838 (bus)
839 Lisp_Object bus;
841 DBusConnection *connection;
843 /* Check parameters. */
844 CHECK_SYMBOL (bus);
846 /* Open a connection to the bus. */
847 connection = xd_initialize (bus);
849 /* Add the watch functions. We pass also the bus as data, in order
850 to distinguish between the busses in xd_remove_watch. */
851 if (!dbus_connection_set_watch_functions (connection,
852 xd_add_watch,
853 xd_remove_watch,
854 NULL, (void*) XHASH (bus), NULL))
855 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
857 /* We do not want to abort. */
858 putenv ("DBUS_FATAL_WARNINGS=0");
860 /* Return. */
861 return Qnil;
864 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
865 1, 1, 0,
866 doc: /* Return the unique name of Emacs registered at D-Bus BUS. */)
867 (bus)
868 Lisp_Object bus;
870 DBusConnection *connection;
871 const char *name;
873 /* Check parameters. */
874 CHECK_SYMBOL (bus);
876 /* Open a connection to the bus. */
877 connection = xd_initialize (bus);
879 /* Request the name. */
880 name = dbus_bus_get_unique_name (connection);
881 if (name == NULL)
882 XD_SIGNAL1 (build_string ("No unique name available"));
884 /* Return. */
885 return build_string (name);
888 DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0,
889 doc: /* Call METHOD on the D-Bus BUS.
891 BUS is either the symbol `:system' or the symbol `:session'.
893 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
894 object path SERVICE is registered at. INTERFACE is an interface
895 offered by SERVICE. It must provide METHOD.
897 If the parameter `:timeout' is given, the following integer TIMEOUT
898 specifies the maximum number of milliseconds the method call must
899 return. The default value is 25,000. If the method call doesn't
900 return in time, a D-Bus error is raised.
902 All other arguments ARGS are passed to METHOD as arguments. They are
903 converted into D-Bus types via the following rules:
905 t and nil => DBUS_TYPE_BOOLEAN
906 number => DBUS_TYPE_UINT32
907 integer => DBUS_TYPE_INT32
908 float => DBUS_TYPE_DOUBLE
909 string => DBUS_TYPE_STRING
910 list => DBUS_TYPE_ARRAY
912 All arguments can be preceded by a type symbol. For details about
913 type symbols, see Info node `(dbus)Type Conversion'.
915 `dbus-call-method' returns the resulting values of METHOD as a list of
916 Lisp objects. The type conversion happens the other direction as for
917 input arguments. It follows the mapping rules:
919 DBUS_TYPE_BOOLEAN => t or nil
920 DBUS_TYPE_BYTE => number
921 DBUS_TYPE_UINT16 => number
922 DBUS_TYPE_INT16 => integer
923 DBUS_TYPE_UINT32 => number or float
924 DBUS_TYPE_INT32 => integer or float
925 DBUS_TYPE_UINT64 => number or float
926 DBUS_TYPE_INT64 => integer or float
927 DBUS_TYPE_DOUBLE => float
928 DBUS_TYPE_STRING => string
929 DBUS_TYPE_OBJECT_PATH => string
930 DBUS_TYPE_SIGNATURE => string
931 DBUS_TYPE_ARRAY => list
932 DBUS_TYPE_VARIANT => list
933 DBUS_TYPE_STRUCT => list
934 DBUS_TYPE_DICT_ENTRY => list
936 Example:
938 \(dbus-call-method
939 :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
940 "org.gnome.seahorse.Keys" "GetKeyField"
941 "openpgp:657984B8C7A966DD" "simple-name")
943 => (t ("Philip R. Zimmermann"))
945 If the result of the METHOD call is just one value, the converted Lisp
946 object is returned instead of a list containing this single Lisp object.
948 \(dbus-call-method
949 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
950 "org.freedesktop.Hal.Device" "GetPropertyString"
951 "system.kernel.machine")
953 => "i686"
955 usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
956 (nargs, args)
957 int nargs;
958 register Lisp_Object *args;
960 Lisp_Object bus, service, path, interface, method;
961 Lisp_Object result;
962 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
963 DBusConnection *connection;
964 DBusMessage *dmessage;
965 DBusMessage *reply;
966 DBusMessageIter iter;
967 DBusError derror;
968 unsigned int dtype;
969 int timeout = -1;
970 int i = 5;
971 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
973 /* Check parameters. */
974 bus = args[0];
975 service = args[1];
976 path = args[2];
977 interface = args[3];
978 method = args[4];
980 CHECK_SYMBOL (bus);
981 CHECK_STRING (service);
982 CHECK_STRING (path);
983 CHECK_STRING (interface);
984 CHECK_STRING (method);
985 GCPRO5 (bus, service, path, interface, method);
987 XD_DEBUG_MESSAGE ("%s %s %s %s",
988 SDATA (service),
989 SDATA (path),
990 SDATA (interface),
991 SDATA (method));
993 /* Open a connection to the bus. */
994 connection = xd_initialize (bus);
996 /* Create the message. */
997 dmessage = dbus_message_new_method_call (SDATA (service),
998 SDATA (path),
999 SDATA (interface),
1000 SDATA (method));
1001 UNGCPRO;
1002 if (dmessage == NULL)
1003 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1005 /* Check for timeout parameter. */
1006 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
1008 CHECK_NATNUM (args[i+1]);
1009 timeout = XUINT (args[i+1]);
1010 i = i+2;
1013 /* Initialize parameter list of message. */
1014 dbus_message_iter_init_append (dmessage, &iter);
1016 /* Append parameters to the message. */
1017 for (; i < nargs; ++i)
1019 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1020 if (XD_DBUS_TYPE_P (args[i]))
1022 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1023 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1024 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1025 SDATA (format2 ("%s", args[i], Qnil)),
1026 SDATA (format2 ("%s", args[i+1], Qnil)));
1027 ++i;
1029 else
1031 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1032 XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1033 SDATA (format2 ("%s", args[i], Qnil)));
1036 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1037 indication that there is no parent type. */
1038 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1040 xd_append_arg (dtype, args[i], &iter);
1043 /* Send the message. */
1044 dbus_error_init (&derror);
1045 reply = dbus_connection_send_with_reply_and_block (connection,
1046 dmessage,
1047 timeout,
1048 &derror);
1050 if (dbus_error_is_set (&derror))
1051 XD_ERROR (derror);
1053 if (reply == NULL)
1054 XD_SIGNAL1 (build_string ("No reply"));
1056 XD_DEBUG_MESSAGE ("Message sent");
1058 /* Collect the results. */
1059 result = Qnil;
1060 GCPRO1 (result);
1062 if (dbus_message_iter_init (reply, &iter))
1064 /* Loop over the parameters of the D-Bus reply message. Construct a
1065 Lisp list, which is returned by `dbus-call-method'. */
1066 while ((dtype = dbus_message_iter_get_arg_type (&iter))
1067 != DBUS_TYPE_INVALID)
1069 result = Fcons (xd_retrieve_arg (dtype, &iter), result);
1070 dbus_message_iter_next (&iter);
1073 else
1075 /* No arguments: just return nil. */
1078 /* Cleanup. */
1079 dbus_error_free (&derror);
1080 dbus_message_unref (dmessage);
1081 dbus_message_unref (reply);
1083 /* Return the result. If there is only one single Lisp object,
1084 return it as-it-is, otherwise return the reversed list. */
1085 if (XUINT (Flength (result)) == 1)
1086 RETURN_UNGCPRO (CAR_SAFE (result));
1087 else
1088 RETURN_UNGCPRO (Fnreverse (result));
1091 DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
1092 Sdbus_call_method_asynchronously, 6, MANY, 0,
1093 doc: /* Call METHOD on the D-Bus BUS asynchronously.
1095 BUS is either the symbol `:system' or the symbol `:session'.
1097 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
1098 object path SERVICE is registered at. INTERFACE is an interface
1099 offered by SERVICE. It must provide METHOD.
1101 HANDLER is a Lisp function, which is called when the corresponding
1102 return message has arrived. If HANDLER is nil, no return message will
1103 be expected.
1105 If the parameter `:timeout' is given, the following integer TIMEOUT
1106 specifies the maximum number of milliseconds the method call must
1107 return. The default value is 25,000. If the method call doesn't
1108 return in time, a D-Bus error is raised.
1110 All other arguments ARGS are passed to METHOD as arguments. They are
1111 converted into D-Bus types via the following rules:
1113 t and nil => DBUS_TYPE_BOOLEAN
1114 number => DBUS_TYPE_UINT32
1115 integer => DBUS_TYPE_INT32
1116 float => DBUS_TYPE_DOUBLE
1117 string => DBUS_TYPE_STRING
1118 list => DBUS_TYPE_ARRAY
1120 All arguments can be preceded by a type symbol. For details about
1121 type symbols, see Info node `(dbus)Type Conversion'.
1123 Unless HANDLER is nil, the function returns a key into the hash table
1124 `dbus-registered-objects-table'. The corresponding entry in the hash
1125 table is removed, when the return message has been arrived, and
1126 HANDLER is called.
1128 Example:
1130 \(dbus-call-method-asynchronously
1131 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1132 "org.freedesktop.Hal.Device" "GetPropertyString" 'message
1133 "system.kernel.machine")
1135 => (:system 2)
1137 -| i686
1139 usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
1140 (nargs, args)
1141 int nargs;
1142 register Lisp_Object *args;
1144 Lisp_Object bus, service, path, interface, method, handler;
1145 Lisp_Object result;
1146 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1147 DBusConnection *connection;
1148 DBusMessage *dmessage;
1149 DBusMessageIter iter;
1150 unsigned int dtype;
1151 int timeout = -1;
1152 int i = 6;
1153 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1155 /* Check parameters. */
1156 bus = args[0];
1157 service = args[1];
1158 path = args[2];
1159 interface = args[3];
1160 method = args[4];
1161 handler = args[5];
1163 CHECK_SYMBOL (bus);
1164 CHECK_STRING (service);
1165 CHECK_STRING (path);
1166 CHECK_STRING (interface);
1167 CHECK_STRING (method);
1168 if (!NILP (handler) && !FUNCTIONP (handler))
1169 wrong_type_argument (intern ("functionp"), handler);
1170 GCPRO6 (bus, service, path, interface, method, handler);
1172 XD_DEBUG_MESSAGE ("%s %s %s %s",
1173 SDATA (service),
1174 SDATA (path),
1175 SDATA (interface),
1176 SDATA (method));
1178 /* Check dbus-registered-objects-table. */
1179 if (!HASH_TABLE_P (Vdbus_registered_objects_table))
1180 XD_SIGNAL1 (build_string ("dbus.el is not loaded"));
1182 /* Open a connection to the bus. */
1183 connection = xd_initialize (bus);
1185 /* Create the message. */
1186 dmessage = dbus_message_new_method_call (SDATA (service),
1187 SDATA (path),
1188 SDATA (interface),
1189 SDATA (method));
1190 if (dmessage == NULL)
1191 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1193 /* Check for timeout parameter. */
1194 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
1196 CHECK_NATNUM (args[i+1]);
1197 timeout = XUINT (args[i+1]);
1198 i = i+2;
1201 /* Initialize parameter list of message. */
1202 dbus_message_iter_init_append (dmessage, &iter);
1204 /* Append parameters to the message. */
1205 for (; i < nargs; ++i)
1207 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1208 if (XD_DBUS_TYPE_P (args[i]))
1210 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1211 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1212 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1213 SDATA (format2 ("%s", args[i], Qnil)),
1214 SDATA (format2 ("%s", args[i+1], Qnil)));
1215 ++i;
1217 else
1219 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1220 XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1221 SDATA (format2 ("%s", args[i], Qnil)));
1224 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1225 indication that there is no parent type. */
1226 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1228 xd_append_arg (dtype, args[i], &iter);
1231 if (!NILP (handler))
1233 /* Send the message. The message is just added to the outgoing
1234 message queue. */
1235 if (!dbus_connection_send_with_reply (connection, dmessage,
1236 NULL, timeout))
1237 XD_SIGNAL1 (build_string ("Cannot send message"));
1239 /* The result is the key in Vdbus_registered_objects_table. */
1240 result = (list2 (bus, make_number (dbus_message_get_serial (dmessage))));
1242 /* Create a hash table entry. */
1243 Fputhash (result, handler, Vdbus_registered_objects_table);
1245 else
1247 /* Send the message. The message is just added to the outgoing
1248 message queue. */
1249 if (!dbus_connection_send (connection, dmessage, NULL))
1250 XD_SIGNAL1 (build_string ("Cannot send message"));
1252 result = Qnil;
1255 /* Flush connection to ensure the message is handled. */
1256 dbus_connection_flush (connection);
1258 XD_DEBUG_MESSAGE ("Message sent");
1260 /* Cleanup. */
1261 dbus_message_unref (dmessage);
1263 /* Return the result. */
1264 RETURN_UNGCPRO (result);
1267 DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
1268 Sdbus_method_return_internal,
1269 3, MANY, 0,
1270 doc: /* Return for message SERIAL on the D-Bus BUS.
1271 This is an internal function, it shall not be used outside dbus.el.
1273 usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
1274 (nargs, args)
1275 int nargs;
1276 register Lisp_Object *args;
1278 Lisp_Object bus, serial, service;
1279 struct gcpro gcpro1, gcpro2, gcpro3;
1280 DBusConnection *connection;
1281 DBusMessage *dmessage;
1282 DBusMessageIter iter;
1283 unsigned int dtype;
1284 int i;
1285 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1287 /* Check parameters. */
1288 bus = args[0];
1289 serial = args[1];
1290 service = args[2];
1292 CHECK_SYMBOL (bus);
1293 CHECK_NUMBER (serial);
1294 CHECK_STRING (service);
1295 GCPRO3 (bus, serial, service);
1297 XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service));
1299 /* Open a connection to the bus. */
1300 connection = xd_initialize (bus);
1302 /* Create the message. */
1303 dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1304 if ((dmessage == NULL)
1305 || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
1306 || (!dbus_message_set_destination (dmessage, SDATA (service))))
1308 UNGCPRO;
1309 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1312 UNGCPRO;
1314 /* Initialize parameter list of message. */
1315 dbus_message_iter_init_append (dmessage, &iter);
1317 /* Append parameters to the message. */
1318 for (i = 3; i < nargs; ++i)
1320 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1321 if (XD_DBUS_TYPE_P (args[i]))
1323 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1324 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1325 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
1326 SDATA (format2 ("%s", args[i], Qnil)),
1327 SDATA (format2 ("%s", args[i+1], Qnil)));
1328 ++i;
1330 else
1332 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1333 XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
1334 SDATA (format2 ("%s", args[i], Qnil)));
1337 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1338 indication that there is no parent type. */
1339 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1341 xd_append_arg (dtype, args[i], &iter);
1344 /* Send the message. The message is just added to the outgoing
1345 message queue. */
1346 if (!dbus_connection_send (connection, dmessage, NULL))
1347 XD_SIGNAL1 (build_string ("Cannot send message"));
1349 /* Flush connection to ensure the message is handled. */
1350 dbus_connection_flush (connection);
1352 XD_DEBUG_MESSAGE ("Message sent");
1354 /* Cleanup. */
1355 dbus_message_unref (dmessage);
1357 /* Return. */
1358 return Qt;
1361 DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
1362 Sdbus_method_error_internal,
1363 3, MANY, 0,
1364 doc: /* Return error message for message SERIAL on the D-Bus BUS.
1365 This is an internal function, it shall not be used outside dbus.el.
1367 usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
1368 (nargs, args)
1369 int nargs;
1370 register Lisp_Object *args;
1372 Lisp_Object bus, serial, service;
1373 struct gcpro gcpro1, gcpro2, gcpro3;
1374 DBusConnection *connection;
1375 DBusMessage *dmessage;
1376 DBusMessageIter iter;
1377 unsigned int dtype;
1378 int i;
1379 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1381 /* Check parameters. */
1382 bus = args[0];
1383 serial = args[1];
1384 service = args[2];
1386 CHECK_SYMBOL (bus);
1387 CHECK_NUMBER (serial);
1388 CHECK_STRING (service);
1389 GCPRO3 (bus, serial, service);
1391 XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service));
1393 /* Open a connection to the bus. */
1394 connection = xd_initialize (bus);
1396 /* Create the message. */
1397 dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
1398 if ((dmessage == NULL)
1399 || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
1400 || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
1401 || (!dbus_message_set_destination (dmessage, SDATA (service))))
1403 UNGCPRO;
1404 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1407 UNGCPRO;
1409 /* Initialize parameter list of message. */
1410 dbus_message_iter_init_append (dmessage, &iter);
1412 /* Append parameters to the message. */
1413 for (i = 3; i < nargs; ++i)
1415 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1416 if (XD_DBUS_TYPE_P (args[i]))
1418 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1419 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1420 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
1421 SDATA (format2 ("%s", args[i], Qnil)),
1422 SDATA (format2 ("%s", args[i+1], Qnil)));
1423 ++i;
1425 else
1427 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1428 XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
1429 SDATA (format2 ("%s", args[i], Qnil)));
1432 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1433 indication that there is no parent type. */
1434 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1436 xd_append_arg (dtype, args[i], &iter);
1439 /* Send the message. The message is just added to the outgoing
1440 message queue. */
1441 if (!dbus_connection_send (connection, dmessage, NULL))
1442 XD_SIGNAL1 (build_string ("Cannot send message"));
1444 /* Flush connection to ensure the message is handled. */
1445 dbus_connection_flush (connection);
1447 XD_DEBUG_MESSAGE ("Message sent");
1449 /* Cleanup. */
1450 dbus_message_unref (dmessage);
1452 /* Return. */
1453 return Qt;
1456 DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
1457 doc: /* Send signal SIGNAL on the D-Bus BUS.
1459 BUS is either the symbol `:system' or the symbol `:session'.
1461 SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
1462 D-Bus object path SERVICE is registered at. INTERFACE is an interface
1463 offered by SERVICE. It must provide signal SIGNAL.
1465 All other arguments ARGS are passed to SIGNAL as arguments. They are
1466 converted into D-Bus types via the following rules:
1468 t and nil => DBUS_TYPE_BOOLEAN
1469 number => DBUS_TYPE_UINT32
1470 integer => DBUS_TYPE_INT32
1471 float => DBUS_TYPE_DOUBLE
1472 string => DBUS_TYPE_STRING
1473 list => DBUS_TYPE_ARRAY
1475 All arguments can be preceded by a type symbol. For details about
1476 type symbols, see Info node `(dbus)Type Conversion'.
1478 Example:
1480 \(dbus-send-signal
1481 :session "org.gnu.Emacs" "/org/gnu/Emacs"
1482 "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1484 usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
1485 (nargs, args)
1486 int nargs;
1487 register Lisp_Object *args;
1489 Lisp_Object bus, service, path, interface, signal;
1490 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1491 DBusConnection *connection;
1492 DBusMessage *dmessage;
1493 DBusMessageIter iter;
1494 unsigned int dtype;
1495 int i;
1496 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1498 /* Check parameters. */
1499 bus = args[0];
1500 service = args[1];
1501 path = args[2];
1502 interface = args[3];
1503 signal = args[4];
1505 CHECK_SYMBOL (bus);
1506 CHECK_STRING (service);
1507 CHECK_STRING (path);
1508 CHECK_STRING (interface);
1509 CHECK_STRING (signal);
1510 GCPRO5 (bus, service, path, interface, signal);
1512 XD_DEBUG_MESSAGE ("%s %s %s %s",
1513 SDATA (service),
1514 SDATA (path),
1515 SDATA (interface),
1516 SDATA (signal));
1518 /* Open a connection to the bus. */
1519 connection = xd_initialize (bus);
1521 /* Create the message. */
1522 dmessage = dbus_message_new_signal (SDATA (path),
1523 SDATA (interface),
1524 SDATA (signal));
1525 UNGCPRO;
1526 if (dmessage == NULL)
1527 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1529 /* Initialize parameter list of message. */
1530 dbus_message_iter_init_append (dmessage, &iter);
1532 /* Append parameters to the message. */
1533 for (i = 5; i < nargs; ++i)
1535 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1536 if (XD_DBUS_TYPE_P (args[i]))
1538 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1539 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1540 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1541 SDATA (format2 ("%s", args[i], Qnil)),
1542 SDATA (format2 ("%s", args[i+1], Qnil)));
1543 ++i;
1545 else
1547 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1548 XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1549 SDATA (format2 ("%s", args[i], Qnil)));
1552 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1553 indication that there is no parent type. */
1554 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1556 xd_append_arg (dtype, args[i], &iter);
1559 /* Send the message. The message is just added to the outgoing
1560 message queue. */
1561 if (!dbus_connection_send (connection, dmessage, NULL))
1562 XD_SIGNAL1 (build_string ("Cannot send message"));
1564 /* Flush connection to ensure the message is handled. */
1565 dbus_connection_flush (connection);
1567 XD_DEBUG_MESSAGE ("Signal sent");
1569 /* Cleanup. */
1570 dbus_message_unref (dmessage);
1572 /* Return. */
1573 return Qt;
1576 /* Check, whether there is pending input in the message queue of the
1577 D-Bus BUS. BUS is a Lisp symbol, either :system or :session. */
1578 static Lisp_Object
1579 xd_get_dispatch_status (bus)
1580 Lisp_Object bus;
1582 DBusConnection *connection;
1584 /* Open a connection to the bus. */
1585 connection = xd_initialize (bus);
1587 /* Non blocking read of the next available message. */
1588 dbus_connection_read_write (connection, 0);
1590 /* Return. */
1591 return
1592 (dbus_connection_get_dispatch_status (connection)
1593 == DBUS_DISPATCH_DATA_REMAINS)
1594 ? Qt : Qnil;
1597 /* Check for queued incoming messages from the system and session buses. */
1599 xd_pending_messages ()
1601 int ret = FALSE;
1602 xd_in_read_queued_messages = 1;
1604 /* Vdbus_registered_objects_table will be initialized as hash table
1605 in dbus.el. When this package isn't loaded yet, it doesn't make
1606 sense to handle D-Bus messages. */
1607 if (HASH_TABLE_P (Vdbus_registered_objects_table))
1609 ret = (!NILP (internal_catch (Qdbus_error, xd_get_dispatch_status,
1610 QCdbus_system_bus)));
1611 if (ret) goto theend;
1613 ret = ((getenv ("DBUS_SESSION_BUS_ADDRESS") != NULL) &&
1614 (!NILP (internal_catch (Qdbus_error, xd_get_dispatch_status,
1615 QCdbus_session_bus))));
1618 /* Return. */
1619 theend:
1620 xd_in_read_queued_messages = 0;
1621 return ret;
1624 /* Read queued incoming message of the D-Bus BUS. BUS is a Lisp
1625 symbol, either :system or :session. */
1626 static Lisp_Object
1627 xd_read_message (bus)
1628 Lisp_Object bus;
1630 Lisp_Object args, key, value;
1631 struct gcpro gcpro1;
1632 struct input_event event;
1633 DBusConnection *connection;
1634 DBusMessage *dmessage;
1635 DBusMessageIter iter;
1636 unsigned int dtype;
1637 int mtype, serial;
1638 const char *uname, *path, *interface, *member;
1640 /* Open a connection to the bus. */
1641 connection = xd_initialize (bus);
1643 /* Non blocking read of the next available message. */
1644 dbus_connection_read_write (connection, 0);
1645 dmessage = dbus_connection_pop_message (connection);
1647 /* Return if there is no queued message. */
1648 if (dmessage == NULL)
1649 return Qnil;
1651 /* Collect the parameters. */
1652 args = Qnil;
1653 GCPRO1 (args);
1655 /* Loop over the resulting parameters. Construct a list. */
1656 if (dbus_message_iter_init (dmessage, &iter))
1658 while ((dtype = dbus_message_iter_get_arg_type (&iter))
1659 != DBUS_TYPE_INVALID)
1661 args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1662 dbus_message_iter_next (&iter);
1664 /* The arguments are stored in reverse order. Reorder them. */
1665 args = Fnreverse (args);
1668 /* Read message type, message serial, unique name, object path,
1669 interface and member from the message. */
1670 mtype = dbus_message_get_type (dmessage);
1671 serial =
1672 ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1673 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1674 ? dbus_message_get_reply_serial (dmessage)
1675 : dbus_message_get_serial (dmessage);
1676 uname = dbus_message_get_sender (dmessage);
1677 path = dbus_message_get_path (dmessage);
1678 interface = dbus_message_get_interface (dmessage);
1679 member = dbus_message_get_member (dmessage);
1681 XD_DEBUG_MESSAGE ("Event received: %s %d %s %s %s %s %s",
1682 (mtype == DBUS_MESSAGE_TYPE_INVALID)
1683 ? "DBUS_MESSAGE_TYPE_INVALID"
1684 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1685 ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1686 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1687 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1688 : (mtype == DBUS_MESSAGE_TYPE_ERROR)
1689 ? "DBUS_MESSAGE_TYPE_ERROR"
1690 : "DBUS_MESSAGE_TYPE_SIGNAL",
1691 serial, uname, path, interface, member,
1692 SDATA (format2 ("%s", args, Qnil)));
1694 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1695 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1697 /* Search for a registered function of the message. */
1698 key = list2 (bus, make_number (serial));
1699 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1701 /* There shall be exactly one entry. Construct an event. */
1702 if (NILP (value))
1703 goto cleanup;
1705 /* Remove the entry. */
1706 Fremhash (key, Vdbus_registered_objects_table);
1708 /* Construct an event. */
1709 EVENT_INIT (event);
1710 event.kind = DBUS_EVENT;
1711 event.frame_or_window = Qnil;
1712 event.arg = Fcons (value, args);
1715 else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
1717 /* Vdbus_registered_objects_table requires non-nil interface and
1718 member. */
1719 if ((interface == NULL) || (member == NULL))
1720 goto cleanup;
1722 /* Search for a registered function of the message. */
1723 key = list3 (bus, build_string (interface), build_string (member));
1724 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1726 /* Loop over the registered functions. Construct an event. */
1727 while (!NILP (value))
1729 key = CAR_SAFE (value);
1730 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1731 if (((uname == NULL)
1732 || (NILP (CAR_SAFE (key)))
1733 || (strcmp (uname, SDATA (CAR_SAFE (key))) == 0))
1734 && ((path == NULL)
1735 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1736 || (strcmp (path,
1737 SDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1738 == 0))
1739 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1741 EVENT_INIT (event);
1742 event.kind = DBUS_EVENT;
1743 event.frame_or_window = Qnil;
1744 event.arg = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))),
1745 args);
1746 break;
1748 value = CDR_SAFE (value);
1751 if (NILP (value))
1752 goto cleanup;
1755 /* Add type, serial, uname, path, interface and member to the event. */
1756 event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1757 event.arg);
1758 event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1759 event.arg);
1760 event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1761 event.arg);
1762 event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1763 event.arg);
1764 event.arg = Fcons (make_number (serial), event.arg);
1765 event.arg = Fcons (make_number (mtype), event.arg);
1767 /* Add the bus symbol to the event. */
1768 event.arg = Fcons (bus, event.arg);
1770 /* Store it into the input event queue. */
1771 kbd_buffer_store_event (&event);
1773 XD_DEBUG_MESSAGE ("Event stored: %s",
1774 SDATA (format2 ("%s", event.arg, Qnil)));
1776 /* Cleanup. */
1777 cleanup:
1778 dbus_message_unref (dmessage);
1780 RETURN_UNGCPRO (Qnil);
1783 /* Read queued incoming messages from the system and session buses. */
1784 void
1785 xd_read_queued_messages ()
1788 /* Vdbus_registered_objects_table will be initialized as hash table
1789 in dbus.el. When this package isn't loaded yet, it doesn't make
1790 sense to handle D-Bus messages. Furthermore, we ignore all Lisp
1791 errors during the call. */
1792 if (HASH_TABLE_P (Vdbus_registered_objects_table))
1794 xd_in_read_queued_messages = 1;
1795 internal_catch (Qdbus_error, xd_read_message, QCdbus_system_bus);
1796 internal_catch (Qdbus_error, xd_read_message, QCdbus_session_bus);
1797 xd_in_read_queued_messages = 0;
1801 DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
1802 6, MANY, 0,
1803 doc: /* Register for signal SIGNAL on the D-Bus BUS.
1805 BUS is either the symbol `:system' or the symbol `:session'.
1807 SERVICE is the D-Bus service name used by the sending D-Bus object.
1808 It can be either a known name or the unique name of the D-Bus object
1809 sending the signal. When SERVICE is nil, related signals from all
1810 D-Bus objects shall be accepted.
1812 PATH is the D-Bus object path SERVICE is registered. It can also be
1813 nil if the path name of incoming signals shall not be checked.
1815 INTERFACE is an interface offered by SERVICE. It must provide SIGNAL.
1816 HANDLER is a Lisp function to be called when the signal is received.
1817 It must accept as arguments the values SIGNAL is sending.
1819 All other arguments ARGS, if specified, must be strings. They stand
1820 for the respective arguments of the signal in their order, and are
1821 used for filtering as well. A nil argument might be used to preserve
1822 the order.
1824 INTERFACE, SIGNAL and HANDLER must not be nil. Example:
1826 \(defun my-signal-handler (device)
1827 (message "Device %s added" device))
1829 \(dbus-register-signal
1830 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
1831 "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
1833 => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
1834 ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
1836 `dbus-register-signal' returns an object, which can be used in
1837 `dbus-unregister-object' for removing the registration.
1839 usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
1840 (nargs, args)
1841 int nargs;
1842 register Lisp_Object *args;
1844 Lisp_Object bus, service, path, interface, signal, handler;
1845 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1846 Lisp_Object uname, key, key1, value;
1847 DBusConnection *connection;
1848 int i;
1849 char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1850 char x[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1851 DBusError derror;
1853 /* Check parameters. */
1854 bus = args[0];
1855 service = args[1];
1856 path = args[2];
1857 interface = args[3];
1858 signal = args[4];
1859 handler = args[5];
1861 CHECK_SYMBOL (bus);
1862 if (!NILP (service)) CHECK_STRING (service);
1863 if (!NILP (path)) CHECK_STRING (path);
1864 CHECK_STRING (interface);
1865 CHECK_STRING (signal);
1866 if (!FUNCTIONP (handler))
1867 wrong_type_argument (intern ("functionp"), handler);
1868 GCPRO6 (bus, service, path, interface, signal, handler);
1870 /* Check dbus-registered-objects-table. */
1871 if (!HASH_TABLE_P (Vdbus_registered_objects_table))
1872 XD_SIGNAL1 (build_string ("dbus.el is not loaded"));
1874 /* Retrieve unique name of service. If service is a known name, we
1875 will register for the corresponding unique name, if any. Signals
1876 are sent always with the unique name as sender. Note: the unique
1877 name of "org.freedesktop.DBus" is that string itself. */
1878 if ((STRINGP (service))
1879 && (SBYTES (service) > 0)
1880 && (strcmp (SDATA (service), DBUS_SERVICE_DBUS) != 0)
1881 && (strncmp (SDATA (service), ":", 1) != 0))
1883 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1884 /* When there is no unique name, we mark it with an empty
1885 string. */
1886 if (NILP (uname))
1887 uname = empty_unibyte_string;
1889 else
1890 uname = service;
1892 /* Create a matching rule if the unique name exists (when no
1893 wildcard). */
1894 if (NILP (uname) || (SBYTES (uname) > 0))
1896 /* Open a connection to the bus. */
1897 connection = xd_initialize (bus);
1899 /* Create a rule to receive related signals. */
1900 sprintf (rule,
1901 "type='signal',interface='%s',member='%s'",
1902 SDATA (interface),
1903 SDATA (signal));
1905 /* Add unique name and path to the rule if they are non-nil. */
1906 if (!NILP (uname))
1908 sprintf (x, ",sender='%s'", SDATA (uname));
1909 strcat (rule, x);
1912 if (!NILP (path))
1914 sprintf (x, ",path='%s'", SDATA (path));
1915 strcat (rule, x);
1918 /* Add arguments to the rule if they are non-nil. */
1919 for (i = 6; i < nargs; ++i)
1920 if (!NILP (args[i]))
1922 CHECK_STRING (args[i]);
1923 sprintf (x, ",arg%d='%s'", i-6, SDATA (args[i]));
1924 strcat (rule, x);
1927 /* Add the rule to the bus. */
1928 dbus_error_init (&derror);
1929 dbus_bus_add_match (connection, rule, &derror);
1930 if (dbus_error_is_set (&derror))
1932 UNGCPRO;
1933 XD_ERROR (derror);
1936 /* Cleanup. */
1937 dbus_error_free (&derror);
1939 XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
1942 /* Create a hash table entry. */
1943 key = list3 (bus, interface, signal);
1944 key1 = list4 (uname, service, path, handler);
1945 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1947 if (NILP (Fmember (key1, value)))
1948 Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
1950 /* Return object. */
1951 RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
1954 DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
1955 6, 6, 0,
1956 doc: /* Register for method METHOD on the D-Bus BUS.
1958 BUS is either the symbol `:system' or the symbol `:session'.
1960 SERVICE is the D-Bus service name of the D-Bus object METHOD is
1961 registered for. It must be a known name.
1963 PATH is the D-Bus object path SERVICE is registered. INTERFACE is the
1964 interface offered by SERVICE. It must provide METHOD. HANDLER is a
1965 Lisp function to be called when a method call is received. It must
1966 accept the input arguments of METHOD. The return value of HANDLER is
1967 used for composing the returning D-Bus message. */)
1968 (bus, service, path, interface, method, handler)
1969 Lisp_Object bus, service, path, interface, method, handler;
1971 Lisp_Object key, key1, value;
1972 DBusConnection *connection;
1973 int result;
1974 DBusError derror;
1976 /* Check parameters. */
1977 CHECK_SYMBOL (bus);
1978 CHECK_STRING (service);
1979 CHECK_STRING (path);
1980 CHECK_STRING (interface);
1981 CHECK_STRING (method);
1982 if (!FUNCTIONP (handler))
1983 wrong_type_argument (intern ("functionp"), handler);
1984 /* TODO: We must check for a valid service name, otherwise there is
1985 a segmentation fault. */
1987 /* Check dbus-registered-objects-table. */
1988 if (!HASH_TABLE_P (Vdbus_registered_objects_table))
1989 XD_SIGNAL1 (build_string ("dbus.el is not loaded"));
1991 /* Open a connection to the bus. */
1992 connection = xd_initialize (bus);
1994 /* Request the known name from the bus. We can ignore the result,
1995 it is set to -1 if there is an error - kind of redundancy. */
1996 dbus_error_init (&derror);
1997 result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
1998 if (dbus_error_is_set (&derror))
1999 XD_ERROR (derror);
2001 /* Create a hash table entry. We use nil for the unique name,
2002 because the method might be called from anybody. */
2003 key = list3 (bus, interface, method);
2004 key1 = list4 (Qnil, service, path, handler);
2005 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
2007 if (NILP (Fmember (key1, value)))
2008 Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
2010 /* Cleanup. */
2011 dbus_error_free (&derror);
2013 /* Return object. */
2014 return list2 (key, list3 (service, path, handler));
2018 void
2019 syms_of_dbusbind ()
2022 Qdbus_init_bus = intern_c_string ("dbus-init-bus");
2023 staticpro (&Qdbus_init_bus);
2024 defsubr (&Sdbus_init_bus);
2026 Qdbus_get_unique_name = intern_c_string ("dbus-get-unique-name");
2027 staticpro (&Qdbus_get_unique_name);
2028 defsubr (&Sdbus_get_unique_name);
2030 Qdbus_call_method = intern_c_string ("dbus-call-method");
2031 staticpro (&Qdbus_call_method);
2032 defsubr (&Sdbus_call_method);
2034 Qdbus_call_method_asynchronously = intern_c_string ("dbus-call-method-asynchronously");
2035 staticpro (&Qdbus_call_method_asynchronously);
2036 defsubr (&Sdbus_call_method_asynchronously);
2038 Qdbus_method_return_internal = intern_c_string ("dbus-method-return-internal");
2039 staticpro (&Qdbus_method_return_internal);
2040 defsubr (&Sdbus_method_return_internal);
2042 Qdbus_method_error_internal = intern_c_string ("dbus-method-error-internal");
2043 staticpro (&Qdbus_method_error_internal);
2044 defsubr (&Sdbus_method_error_internal);
2046 Qdbus_send_signal = intern_c_string ("dbus-send-signal");
2047 staticpro (&Qdbus_send_signal);
2048 defsubr (&Sdbus_send_signal);
2050 Qdbus_register_signal = intern_c_string ("dbus-register-signal");
2051 staticpro (&Qdbus_register_signal);
2052 defsubr (&Sdbus_register_signal);
2054 Qdbus_register_method = intern_c_string ("dbus-register-method");
2055 staticpro (&Qdbus_register_method);
2056 defsubr (&Sdbus_register_method);
2058 Qdbus_error = intern_c_string ("dbus-error");
2059 staticpro (&Qdbus_error);
2060 Fput (Qdbus_error, Qerror_conditions,
2061 list2 (Qdbus_error, Qerror));
2062 Fput (Qdbus_error, Qerror_message,
2063 make_pure_c_string ("D-Bus error"));
2065 QCdbus_system_bus = intern_c_string (":system");
2066 staticpro (&QCdbus_system_bus);
2068 QCdbus_session_bus = intern_c_string (":session");
2069 staticpro (&QCdbus_session_bus);
2071 QCdbus_timeout = intern_c_string (":timeout");
2072 staticpro (&QCdbus_timeout);
2074 QCdbus_type_byte = intern_c_string (":byte");
2075 staticpro (&QCdbus_type_byte);
2077 QCdbus_type_boolean = intern_c_string (":boolean");
2078 staticpro (&QCdbus_type_boolean);
2080 QCdbus_type_int16 = intern_c_string (":int16");
2081 staticpro (&QCdbus_type_int16);
2083 QCdbus_type_uint16 = intern_c_string (":uint16");
2084 staticpro (&QCdbus_type_uint16);
2086 QCdbus_type_int32 = intern_c_string (":int32");
2087 staticpro (&QCdbus_type_int32);
2089 QCdbus_type_uint32 = intern_c_string (":uint32");
2090 staticpro (&QCdbus_type_uint32);
2092 QCdbus_type_int64 = intern_c_string (":int64");
2093 staticpro (&QCdbus_type_int64);
2095 QCdbus_type_uint64 = intern_c_string (":uint64");
2096 staticpro (&QCdbus_type_uint64);
2098 QCdbus_type_double = intern_c_string (":double");
2099 staticpro (&QCdbus_type_double);
2101 QCdbus_type_string = intern_c_string (":string");
2102 staticpro (&QCdbus_type_string);
2104 QCdbus_type_object_path = intern_c_string (":object-path");
2105 staticpro (&QCdbus_type_object_path);
2107 QCdbus_type_signature = intern_c_string (":signature");
2108 staticpro (&QCdbus_type_signature);
2110 QCdbus_type_array = intern_c_string (":array");
2111 staticpro (&QCdbus_type_array);
2113 QCdbus_type_variant = intern_c_string (":variant");
2114 staticpro (&QCdbus_type_variant);
2116 QCdbus_type_struct = intern_c_string (":struct");
2117 staticpro (&QCdbus_type_struct);
2119 QCdbus_type_dict_entry = intern_c_string (":dict-entry");
2120 staticpro (&QCdbus_type_dict_entry);
2122 DEFVAR_LISP ("dbus-registered-objects-table",
2123 &Vdbus_registered_objects_table,
2124 doc: /* Hash table of registered functions for D-Bus.
2125 There are two different uses of the hash table: for accessing
2126 registered interfaces properties, targeted by signals or method calls,
2127 and for calling handlers in case of non-blocking method call returns.
2129 In the first case, the key in the hash table is the list (BUS
2130 INTERFACE MEMBER). BUS is either the symbol `:system' or the symbol
2131 `:session'. INTERFACE is a string which denotes a D-Bus interface,
2132 and MEMBER, also a string, is either a method, a signal or a property
2133 INTERFACE is offering. All arguments but BUS must not be nil.
2135 The value in the hash table is a list of quadruple lists
2136 \((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...).
2137 SERVICE is the service name as registered, UNAME is the corresponding
2138 unique name. In case of registered methods and properties, UNAME is
2139 nil. PATH is the object path of the sending object. All of them can
2140 be nil, which means a wildcard then. OBJECT is either the handler to
2141 be called when a D-Bus message, which matches the key criteria,
2142 arrives (methods and signals), or a cons cell containing the value of
2143 the property.
2145 In the second case, the key in the hash table is the list (BUS SERIAL).
2146 BUS is either the symbol `:system' or the symbol `:session'. SERIAL
2147 is the serial number of the non-blocking method call, a reply is
2148 expected. Both arguments must not be nil. The value in the hash
2149 table is HANDLER, the function to be called when the D-Bus reply
2150 message arrives. */);
2151 /* We initialize Vdbus_registered_objects_table in dbus.el, because
2152 we need to define a hash table function first. */
2153 Vdbus_registered_objects_table = Qnil;
2155 DEFVAR_LISP ("dbus-debug", &Vdbus_debug,
2156 doc: /* If non-nil, debug messages of D-Bus bindings are raised. */);
2157 #ifdef DBUS_DEBUG
2158 Vdbus_debug = Qt;
2159 /* We can also set environment variable DBUS_VERBOSE=1 in order to
2160 see more traces. This requires libdbus-1 to be configured with
2161 --enable-verbose-mode. */
2162 #else
2163 Vdbus_debug = Qnil;
2164 #endif
2166 Fprovide (intern_c_string ("dbusbind"), Qnil);
2170 #endif /* HAVE_DBUS */
2172 /* arch-tag: 0e828477-b571-4fe4-b559-5c9211bc14b8
2173 (do not change this comment) */