HCoop / bpt / emacs.git / blob
? search:


8ebc56c72c4bf5fb11504759007a7d30a52b683a
[bpt/emacs.git] / src / dbusbind.c
1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007-2014 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
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.
10
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.
15
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/>. */
18
19 #include <config.h>
20
21 #ifdef HAVE_DBUS
22 #include <stdio.h>
23 #include <dbus/dbus.h>
24
25 #include "lisp.h"
26 #include "frame.h"
27 #include "termhooks.h"
28 #include "keyboard.h"
29 #include "process.h"
30
31 #ifndef DBUS_NUM_MESSAGE_TYPES
32 #define DBUS_NUM_MESSAGE_TYPES 5
33 #endif
34
35
36 /* Some platforms define the symbol "interface", but we want to use it
37 * as a variable name below. */
38
39 #ifdef interface
40 #undef interface
41 #endif
42
43 \f
44 /* Subroutines. */
45 static Lisp_Object Qdbus__init_bus;
46 static Lisp_Object Qdbus_get_unique_name;
47 static Lisp_Object Qdbus_message_internal;
48
49 /* D-Bus error symbol. */
50 static Lisp_Object Qdbus_error;
51
52 /* Lisp symbols of the system and session buses. */
53 static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
54
55 /* Lisp symbol for method call timeout. */
56 static Lisp_Object QCdbus_timeout;
57
58 /* Lisp symbols of D-Bus types. */
59 static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
60 static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
61 static Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
62 static Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
63 static Lisp_Object QCdbus_type_double, QCdbus_type_string;
64 static Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
65 #ifdef DBUS_TYPE_UNIX_FD
66 static Lisp_Object QCdbus_type_unix_fd;
67 #endif
68 static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
69 static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
70
71 /* Lisp symbols of objects in `dbus-registered-objects-table'. */
72 static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method;
73 static Lisp_Object QCdbus_registered_signal;
74
75 /* Alist of D-Bus buses we are polling for messages.
76 The key is the symbol or string of the bus, and the value is the
77 connection address. */
78 static Lisp_Object xd_registered_buses;
79
80 /* Whether we are reading a D-Bus event. */
81 static bool xd_in_read_queued_messages = 0;
82
83 \f
84 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
85 we don't want to poison other namespaces with "dbus_". */
86
87 /* Raise a signal. If we are reading events, we cannot signal; we
88 throw to xd_read_queued_messages then. */
89 #define XD_SIGNAL1(arg) \
90 do { \
91 if (xd_in_read_queued_messages) \
92 Fthrow (Qdbus_error, Qnil); \
93 else \
94 xsignal1 (Qdbus_error, arg); \
95 } while (0)
96
97 #define XD_SIGNAL2(arg1, arg2) \
98 do { \
99 if (xd_in_read_queued_messages) \
100 Fthrow (Qdbus_error, Qnil); \
101 else \
102 xsignal2 (Qdbus_error, arg1, arg2); \
103 } while (0)
104
105 #define XD_SIGNAL3(arg1, arg2, arg3) \
106 do { \
107 if (xd_in_read_queued_messages) \
108 Fthrow (Qdbus_error, Qnil); \
109 else \
110 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
111 } while (0)
112
113 /* Raise a Lisp error from a D-Bus ERROR. */
114 #define XD_ERROR(error) \
115 do { \
116 /* Remove the trailing newline. */ \
117 char const *mess = error.message; \
118 char const *nl = strchr (mess, '\n'); \
119 Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
120 dbus_error_free (&error); \
121 XD_SIGNAL1 (err); \
122 } while (0)
123
124 /* Macros for debugging. In order to enable them, build with
125 "env MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
126 #ifdef DBUS_DEBUG
127 #define XD_DEBUG_MESSAGE(...) \
128 do { \
129 char s[1024]; \
130 snprintf (s, sizeof s, __VA_ARGS__); \
131 if (!noninteractive) \
132 printf ("%s: %s\n", __func__, s); \
133 message ("%s: %s", __func__, s); \
134 } while (0)
135 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
136 do { \
137 if (!valid_lisp_object_p (object)) \
138 { \
139 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
140 XD_SIGNAL1 (build_string ("Assertion failure")); \
141 } \
142 } while (0)
143
144 #else /* !DBUS_DEBUG */
145 # if __STDC_VERSION__ < 199901
146 # define XD_DEBUG_MESSAGE (void) /* Pre-C99 compilers cannot debug. */
147 # else
148 # define XD_DEBUG_MESSAGE(...) \
149 do { \
150 if (!NILP (Vdbus_debug)) \
151 { \
152 char s[1024]; \
153 snprintf (s, sizeof s, __VA_ARGS__); \
154 message ("%s: %s", __func__, s); \
155 } \
156 } while (0)
157 # endif
158 # define XD_DEBUG_VALID_LISP_OBJECT_P(object)
159 #endif
160
161 /* Check whether TYPE is a basic DBusType. */
162 #ifdef HAVE_DBUS_TYPE_IS_VALID
163 #define XD_BASIC_DBUS_TYPE(type) \
164 (dbus_type_is_valid (type) && dbus_type_is_basic (type))
165 #else
166 #ifdef DBUS_TYPE_UNIX_FD
167 #define XD_BASIC_DBUS_TYPE(type) \
168 ((type == DBUS_TYPE_BYTE) \
169 || (type == DBUS_TYPE_BOOLEAN) \
170 || (type == DBUS_TYPE_INT16) \
171 || (type == DBUS_TYPE_UINT16) \
172 || (type == DBUS_TYPE_INT32) \
173 || (type == DBUS_TYPE_UINT32) \
174 || (type == DBUS_TYPE_INT64) \
175 || (type == DBUS_TYPE_UINT64) \
176 || (type == DBUS_TYPE_DOUBLE) \
177 || (type == DBUS_TYPE_STRING) \
178 || (type == DBUS_TYPE_OBJECT_PATH) \
179 || (type == DBUS_TYPE_SIGNATURE) \
180 || (type == DBUS_TYPE_UNIX_FD))
181 #else
182 #define XD_BASIC_DBUS_TYPE(type) \
183 ((type == DBUS_TYPE_BYTE) \
184 || (type == DBUS_TYPE_BOOLEAN) \
185 || (type == DBUS_TYPE_INT16) \
186 || (type == DBUS_TYPE_UINT16) \
187 || (type == DBUS_TYPE_INT32) \
188 || (type == DBUS_TYPE_UINT32) \
189 || (type == DBUS_TYPE_INT64) \
190 || (type == DBUS_TYPE_UINT64) \
191 || (type == DBUS_TYPE_DOUBLE) \
192 || (type == DBUS_TYPE_STRING) \
193 || (type == DBUS_TYPE_OBJECT_PATH) \
194 || (type == DBUS_TYPE_SIGNATURE))
195 #endif
196 #endif
197
198 /* This was a macro. On Solaris 2.11 it was said to compile for
199 hours, when optimization is enabled. So we have transferred it into
200 a function. */
201 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
202 of the predefined D-Bus type symbols. */
203 static int
204 xd_symbol_to_dbus_type (Lisp_Object object)
205 {
206 return
207 ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
208 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
209 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
210 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
211 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
212 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
213 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
214 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
215 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
216 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
217 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
218 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
219 #ifdef DBUS_TYPE_UNIX_FD
220 : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD
221 #endif
222 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
223 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
224 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
225 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
226 : DBUS_TYPE_INVALID);
227 }
228
229 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
230 #define XD_DBUS_TYPE_P(object) \
231 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
232
233 /* Determine the DBusType of a given Lisp OBJECT. It is used to
234 convert Lisp objects, being arguments of `dbus-call-method' or
235 `dbus-send-signal', into corresponding C values appended as
236 arguments to a D-Bus message. */
237 #define XD_OBJECT_TO_DBUS_TYPE(object) \
238 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
239 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
240 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
241 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
242 : (STRINGP (object)) ? DBUS_TYPE_STRING \
243 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
244 : (CONSP (object)) \
245 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
246 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
247 ? DBUS_TYPE_ARRAY \
248 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
249 : DBUS_TYPE_ARRAY) \
250 : DBUS_TYPE_INVALID)
251
252 /* Return a list pointer which does not have a Lisp symbol as car. */
253 #define XD_NEXT_VALUE(object) \
254 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
255
256 /* Transform the message type to its string representation for debug
257 messages. */
258 #define XD_MESSAGE_TYPE_TO_STRING(mtype) \
259 ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
260 ? "DBUS_MESSAGE_TYPE_INVALID" \
261 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
262 ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
263 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
264 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
265 : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
266 ? "DBUS_MESSAGE_TYPE_ERROR" \
267 : "DBUS_MESSAGE_TYPE_SIGNAL")
268
269 /* Transform the object to its string representation for debug
270 messages. */
271 #define XD_OBJECT_TO_STRING(object) \
272 SDATA (format2 ("%s", object, Qnil))
273
274 #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
275 do { \
276 char const *session_bus_address = getenv ("DBUS_SESSION_BUS_ADDRESS"); \
277 if (STRINGP (bus)) \
278 { \
279 DBusAddressEntry **entries; \
280 int len; \
281 DBusError derror; \
282 dbus_error_init (&derror); \
283 if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
284 XD_ERROR (derror); \
285 /* Cleanup. */ \
286 dbus_error_free (&derror); \
287 dbus_address_entries_free (entries); \
288 /* Canonicalize session bus address. */ \
289 if ((session_bus_address != NULL) \
290 && (!NILP (Fstring_equal \
291 (bus, build_string (session_bus_address))))) \
292 bus = QCdbus_session_bus; \
293 } \
294 \
295 else \
296 { \
297 CHECK_SYMBOL (bus); \
298 if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
299 XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
300 /* We do not want to have an autolaunch for the session bus. */ \
301 if (EQ (bus, QCdbus_session_bus) && session_bus_address == NULL) \
302 XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
303 } \
304 } while (0)
305
306 #if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
307 || HAVE_DBUS_VALIDATE_INTERFACE || HAVE_DBUS_VALIDATE_MEMBER)
308 #define XD_DBUS_VALIDATE_OBJECT(object, func) \
309 do { \
310 if (!NILP (object)) \
311 { \
312 DBusError derror; \
313 CHECK_STRING (object); \
314 dbus_error_init (&derror); \
315 if (!func (SSDATA (object), &derror)) \
316 XD_ERROR (derror); \
317 /* Cleanup. */ \
318 dbus_error_free (&derror); \
319 } \
320 } while (0)
321 #endif
322
323 #if HAVE_DBUS_VALIDATE_BUS_NAME
324 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
325 XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
326 #else
327 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
328 if (!NILP (bus_name)) CHECK_STRING (bus_name);
329 #endif
330
331 #if HAVE_DBUS_VALIDATE_PATH
332 #define XD_DBUS_VALIDATE_PATH(path) \
333 XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
334 #else
335 #define XD_DBUS_VALIDATE_PATH(path) \
336 if (!NILP (path)) CHECK_STRING (path);
337 #endif
338
339 #if HAVE_DBUS_VALIDATE_INTERFACE
340 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
341 XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
342 #else
343 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
344 if (!NILP (interface)) CHECK_STRING (interface);
345 #endif
346
347 #if HAVE_DBUS_VALIDATE_MEMBER
348 #define XD_DBUS_VALIDATE_MEMBER(member) \
349 XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
350 #else
351 #define XD_DBUS_VALIDATE_MEMBER(member) \
352 if (!NILP (member)) CHECK_STRING (member);
353 #endif
354
355 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
356 not become too long. */
357 static void
358 xd_signature_cat (char *signature, char const *x)
359 {
360 ptrdiff_t siglen = strlen (signature);
361 ptrdiff_t xlen = strlen (x);
362 if (DBUS_MAXIMUM_SIGNATURE_LENGTH - xlen <= siglen)
363 string_overflow ();
364 strcat (signature, x);
365 }
366
367 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
368 used in dbus_message_iter_open_container. DTYPE is the DBusType
369 the object is related to. It is passed as argument, because it
370 cannot be detected in basic type objects, when they are preceded by
371 a type symbol. PARENT_TYPE is the DBusType of a container this
372 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
373 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
374 static void
375 xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
376 {
377 int subtype;
378 Lisp_Object elt;
379 char const *subsig;
380 int subsiglen;
381 char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
382
383 elt = object;
384
385 switch (dtype)
386 {
387 case DBUS_TYPE_BYTE:
388 case DBUS_TYPE_UINT16:
389 CHECK_NATNUM (object);
390 sprintf (signature, "%c", dtype);
391 break;
392
393 case DBUS_TYPE_BOOLEAN:
394 if (!EQ (object, Qt) && !EQ (object, Qnil))
395 wrong_type_argument (intern ("booleanp"), object);
396 sprintf (signature, "%c", dtype);
397 break;
398
399 case DBUS_TYPE_INT16:
400 CHECK_NUMBER (object);
401 sprintf (signature, "%c", dtype);
402 break;
403
404 case DBUS_TYPE_UINT32:
405 case DBUS_TYPE_UINT64:
406 #ifdef DBUS_TYPE_UNIX_FD
407 case DBUS_TYPE_UNIX_FD:
408 #endif
409 case DBUS_TYPE_INT32:
410 case DBUS_TYPE_INT64:
411 case DBUS_TYPE_DOUBLE:
412 CHECK_NUMBER_OR_FLOAT (object);
413 sprintf (signature, "%c", dtype);
414 break;
415
416 case DBUS_TYPE_STRING:
417 case DBUS_TYPE_OBJECT_PATH:
418 case DBUS_TYPE_SIGNATURE:
419 CHECK_STRING (object);
420 sprintf (signature, "%c", dtype);
421 break;
422
423 case DBUS_TYPE_ARRAY:
424 /* Check that all list elements have the same D-Bus type. For
425 complex element types, we just check the container type, not
426 the whole element's signature. */
427 CHECK_CONS (object);
428
429 /* Type symbol is optional. */
430 if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
431 elt = XD_NEXT_VALUE (elt);
432
433 /* If the array is empty, DBUS_TYPE_STRING is the default
434 element type. */
435 if (NILP (elt))
436 {
437 subtype = DBUS_TYPE_STRING;
438 subsig = DBUS_TYPE_STRING_AS_STRING;
439 }
440 else
441 {
442 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
443 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
444 subsig = x;
445 }
446
447 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
448 only element, the value of this element is used as the
449 array's element signature. */
450 if ((subtype == DBUS_TYPE_SIGNATURE)
451 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
452 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
453 subsig = SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt)));
454
455 while (!NILP (elt))
456 {
457 if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
458 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
459 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
460 }
461
462 subsiglen = snprintf (signature, DBUS_MAXIMUM_SIGNATURE_LENGTH,
463 "%c%s", dtype, subsig);
464 if (! (0 <= subsiglen && subsiglen < DBUS_MAXIMUM_SIGNATURE_LENGTH))
465 string_overflow ();
466 break;
467
468 case DBUS_TYPE_VARIANT:
469 /* Check that there is exactly one list element. */
470 CHECK_CONS (object);
471
472 elt = XD_NEXT_VALUE (elt);
473 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
474 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
475
476 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
477 wrong_type_argument (intern ("D-Bus"),
478 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
479
480 sprintf (signature, "%c", dtype);
481 break;
482
483 case DBUS_TYPE_STRUCT:
484 /* A struct list might contain any number of elements with
485 different types. No further check needed. */
486 CHECK_CONS (object);
487
488 elt = XD_NEXT_VALUE (elt);
489
490 /* Compose the signature from the elements. It is enclosed by
491 parentheses. */
492 sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
493 while (!NILP (elt))
494 {
495 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
496 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
497 xd_signature_cat (signature, x);
498 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
499 }
500 xd_signature_cat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
501 break;
502
503 case DBUS_TYPE_DICT_ENTRY:
504 /* Check that there are exactly two list elements, and the first
505 one is of basic type. The dictionary entry itself must be an
506 element of an array. */
507 CHECK_CONS (object);
508
509 /* Check the parent object type. */
510 if (parent_type != DBUS_TYPE_ARRAY)
511 wrong_type_argument (intern ("D-Bus"), object);
512
513 /* Compose the signature from the elements. It is enclosed by
514 curly braces. */
515 sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
516
517 /* First element. */
518 elt = XD_NEXT_VALUE (elt);
519 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
520 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
521 xd_signature_cat (signature, x);
522
523 if (!XD_BASIC_DBUS_TYPE (subtype))
524 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
525
526 /* Second element. */
527 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
528 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
529 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
530 xd_signature_cat (signature, x);
531
532 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
533 wrong_type_argument (intern ("D-Bus"),
534 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
535
536 /* Closing signature. */
537 xd_signature_cat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
538 break;
539
540 default:
541 wrong_type_argument (intern ("D-Bus"), object);
542 }
543
544 XD_DEBUG_MESSAGE ("%s", signature);
545 }
546
547 /* Convert X to a signed integer with bounds LO and HI. */
548 static intmax_t
549 xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi)
550 {
551 CHECK_NUMBER_OR_FLOAT (x);
552 if (INTEGERP (x))
553 {
554 if (lo <= XINT (x) && XINT (x) <= hi)
555 return XINT (x);
556 }
557 else
558 {
559 double d = XFLOAT_DATA (x);
560 if (lo <= d && d <= hi)
561 {
562 intmax_t n = d;
563 if (n == d)
564 return n;
565 }
566 }
567 if (xd_in_read_queued_messages)
568 Fthrow (Qdbus_error, Qnil);
569 else
570 args_out_of_range_3 (x,
571 make_fixnum_or_float (lo),
572 make_fixnum_or_float (hi));
573 }
574
575 /* Convert X to an unsigned integer with bounds 0 and HI. */
576 static uintmax_t
577 xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
578 {
579 CHECK_NUMBER_OR_FLOAT (x);
580 if (INTEGERP (x))
581 {
582 if (0 <= XINT (x) && XINT (x) <= hi)
583 return XINT (x);
584 }
585 else
586 {
587 double d = XFLOAT_DATA (x);
588 if (0 <= d && d <= hi)
589 {
590 uintmax_t n = d;
591 if (n == d)
592 return n;
593 }
594 }
595 if (xd_in_read_queued_messages)
596 Fthrow (Qdbus_error, Qnil);
597 else
598 args_out_of_range_3 (x, make_number (0), make_fixnum_or_float (hi));
599 }
600
601 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
602 DTYPE must be a valid DBusType. It is used to convert Lisp
603 objects, being arguments of `dbus-call-method' or
604 `dbus-send-signal', into corresponding C values appended as
605 arguments to a D-Bus message. */
606 static void
607 xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
608 {
609 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
610 DBusMessageIter subiter;
611
612 if (XD_BASIC_DBUS_TYPE (dtype))
613 switch (dtype)
614 {
615 case DBUS_TYPE_BYTE:
616 CHECK_NATNUM (object);
617 {
618 unsigned char val = XFASTINT (object) & 0xFF;
619 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
620 if (!dbus_message_iter_append_basic (iter, dtype, &val))
621 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
622 return;
623 }
624
625 case DBUS_TYPE_BOOLEAN:
626 {
627 dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
628 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
629 if (!dbus_message_iter_append_basic (iter, dtype, &val))
630 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
631 return;
632 }
633
634 case DBUS_TYPE_INT16:
635 {
636 dbus_int16_t val =
637 xd_extract_signed (object,
638 TYPE_MINIMUM (dbus_int16_t),
639 TYPE_MAXIMUM (dbus_int16_t));
640 int pval = val;
641 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
642 if (!dbus_message_iter_append_basic (iter, dtype, &val))
643 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
644 return;
645 }
646
647 case DBUS_TYPE_UINT16:
648 {
649 dbus_uint16_t val =
650 xd_extract_unsigned (object,
651 TYPE_MAXIMUM (dbus_uint16_t));
652 unsigned int pval = val;
653 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
654 if (!dbus_message_iter_append_basic (iter, dtype, &val))
655 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
656 return;
657 }
658
659 case DBUS_TYPE_INT32:
660 {
661 dbus_int32_t val =
662 xd_extract_signed (object,
663 TYPE_MINIMUM (dbus_int32_t),
664 TYPE_MAXIMUM (dbus_int32_t));
665 int pval = val;
666 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
667 if (!dbus_message_iter_append_basic (iter, dtype, &val))
668 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
669 return;
670 }
671
672 case DBUS_TYPE_UINT32:
673 #ifdef DBUS_TYPE_UNIX_FD
674 case DBUS_TYPE_UNIX_FD:
675 #endif
676 {
677 dbus_uint32_t val =
678 xd_extract_unsigned (object,
679 TYPE_MAXIMUM (dbus_uint32_t));
680 unsigned int pval = val;
681 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
682 if (!dbus_message_iter_append_basic (iter, dtype, &val))
683 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
684 return;
685 }
686
687 case DBUS_TYPE_INT64:
688 {
689 dbus_int64_t val =
690 xd_extract_signed (object,
691 TYPE_MINIMUM (dbus_int64_t),
692 TYPE_MAXIMUM (dbus_int64_t));
693 printmax_t pval = val;
694 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
695 if (!dbus_message_iter_append_basic (iter, dtype, &val))
696 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
697 return;
698 }
699
700 case DBUS_TYPE_UINT64:
701 {
702 dbus_uint64_t val =
703 xd_extract_unsigned (object,
704 TYPE_MAXIMUM (dbus_uint64_t));
705 uprintmax_t pval = val;
706 XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval);
707 if (!dbus_message_iter_append_basic (iter, dtype, &val))
708 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
709 return;
710 }
711
712 case DBUS_TYPE_DOUBLE:
713 {
714 double val = extract_float (object);
715 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
716 if (!dbus_message_iter_append_basic (iter, dtype, &val))
717 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
718 return;
719 }
720
721 case DBUS_TYPE_STRING:
722 case DBUS_TYPE_OBJECT_PATH:
723 case DBUS_TYPE_SIGNATURE:
724 CHECK_STRING (object);
725 {
726 /* We need to send a valid UTF-8 string. We could encode `object'
727 but by not encoding it, we guarantee it's valid utf-8, even if
728 it contains eight-bit-bytes. Of course, you can still send
729 manually-crafted junk by passing a unibyte string. */
730 char *val = SSDATA (object);
731 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
732 if (!dbus_message_iter_append_basic (iter, dtype, &val))
733 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
734 return;
735 }
736 }
737
738 else /* Compound types. */
739 {
740
741 /* All compound types except array have a type symbol. For
742 array, it is optional. Skip it. */
743 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
744 object = XD_NEXT_VALUE (object);
745
746 /* Open new subiteration. */
747 switch (dtype)
748 {
749 case DBUS_TYPE_ARRAY:
750 /* An array has only elements of the same type. So it is
751 sufficient to check the first element's signature
752 only. */
753
754 if (NILP (object))
755 /* If the array is empty, DBUS_TYPE_STRING is the default
756 element type. */
757 strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
758
759 else
760 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
761 the only element, the value of this element is used as
762 the array's element signature. */
763 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
764 == DBUS_TYPE_SIGNATURE)
765 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
766 && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
767 {
768 strcpy (signature, SSDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
769 object = CDR_SAFE (XD_NEXT_VALUE (object));
770 }
771
772 else
773 xd_signature (signature,
774 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
775 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
776
777 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
778 XD_OBJECT_TO_STRING (object));
779 if (!dbus_message_iter_open_container (iter, dtype,
780 signature, &subiter))
781 XD_SIGNAL3 (build_string ("Cannot open container"),
782 make_number (dtype), build_string (signature));
783 break;
784
785 case DBUS_TYPE_VARIANT:
786 /* A variant has just one element. */
787 xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
788 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
789
790 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
791 XD_OBJECT_TO_STRING (object));
792 if (!dbus_message_iter_open_container (iter, dtype,
793 signature, &subiter))
794 XD_SIGNAL3 (build_string ("Cannot open container"),
795 make_number (dtype), build_string (signature));
796 break;
797
798 case DBUS_TYPE_STRUCT:
799 case DBUS_TYPE_DICT_ENTRY:
800 /* These containers do not require a signature. */
801 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object));
802 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
803 XD_SIGNAL2 (build_string ("Cannot open container"),
804 make_number (dtype));
805 break;
806 }
807
808 /* Loop over list elements. */
809 while (!NILP (object))
810 {
811 dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
812 object = XD_NEXT_VALUE (object);
813
814 xd_append_arg (dtype, CAR_SAFE (object), &subiter);
815
816 object = CDR_SAFE (object);
817 }
818
819 /* Close the subiteration. */
820 if (!dbus_message_iter_close_container (iter, &subiter))
821 XD_SIGNAL2 (build_string ("Cannot close container"),
822 make_number (dtype));
823 }
824 }
825
826 /* Retrieve C value from a DBusMessageIter structure ITER, and return
827 a converted Lisp object. The type DTYPE of the argument of the
828 D-Bus message must be a valid DBusType. Compound D-Bus types
829 result always in a Lisp list. */
830 static Lisp_Object
831 xd_retrieve_arg (int dtype, DBusMessageIter *iter)
832 {
833
834 switch (dtype)
835 {
836 case DBUS_TYPE_BYTE:
837 {
838 unsigned int val;
839 dbus_message_iter_get_basic (iter, &val);
840 val = val & 0xFF;
841 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
842 return make_number (val);
843 }
844
845 case DBUS_TYPE_BOOLEAN:
846 {
847 dbus_bool_t val;
848 dbus_message_iter_get_basic (iter, &val);
849 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
850 return (val == FALSE) ? Qnil : Qt;
851 }
852
853 case DBUS_TYPE_INT16:
854 {
855 dbus_int16_t val;
856 int pval;
857 dbus_message_iter_get_basic (iter, &val);
858 pval = val;
859 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
860 return make_number (val);
861 }
862
863 case DBUS_TYPE_UINT16:
864 {
865 dbus_uint16_t val;
866 int pval;
867 dbus_message_iter_get_basic (iter, &val);
868 pval = val;
869 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
870 return make_number (val);
871 }
872
873 case DBUS_TYPE_INT32:
874 {
875 dbus_int32_t val;
876 int pval;
877 dbus_message_iter_get_basic (iter, &val);
878 pval = val;
879 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
880 return make_fixnum_or_float (val);
881 }
882
883 case DBUS_TYPE_UINT32:
884 #ifdef DBUS_TYPE_UNIX_FD
885 case DBUS_TYPE_UNIX_FD:
886 #endif
887 {
888 dbus_uint32_t val;
889 unsigned int pval;
890 dbus_message_iter_get_basic (iter, &val);
891 pval = val;
892 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
893 return make_fixnum_or_float (val);
894 }
895
896 case DBUS_TYPE_INT64:
897 {
898 dbus_int64_t val;
899 printmax_t pval;
900 dbus_message_iter_get_basic (iter, &val);
901 pval = val;
902 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
903 return make_fixnum_or_float (val);
904 }
905
906 case DBUS_TYPE_UINT64:
907 {
908 dbus_uint64_t val;
909 uprintmax_t pval;
910 dbus_message_iter_get_basic (iter, &val);
911 pval = val;
912 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
913 return make_fixnum_or_float (val);
914 }
915
916 case DBUS_TYPE_DOUBLE:
917 {
918 double val;
919 dbus_message_iter_get_basic (iter, &val);
920 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
921 return make_float (val);
922 }
923
924 case DBUS_TYPE_STRING:
925 case DBUS_TYPE_OBJECT_PATH:
926 case DBUS_TYPE_SIGNATURE:
927 {
928 char *val;
929 dbus_message_iter_get_basic (iter, &val);
930 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
931 return build_string (val);
932 }
933
934 case DBUS_TYPE_ARRAY:
935 case DBUS_TYPE_VARIANT:
936 case DBUS_TYPE_STRUCT:
937 case DBUS_TYPE_DICT_ENTRY:
938 {
939 Lisp_Object result;
940 struct gcpro gcpro1;
941 DBusMessageIter subiter;
942 int subtype;
943 result = Qnil;
944 GCPRO1 (result);
945 dbus_message_iter_recurse (iter, &subiter);
946 while ((subtype = dbus_message_iter_get_arg_type (&subiter))
947 != DBUS_TYPE_INVALID)
948 {
949 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
950 dbus_message_iter_next (&subiter);
951 }
952 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
953 RETURN_UNGCPRO (Fnreverse (result));
954 }
955
956 default:
957 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
958 return Qnil;
959 }
960 }
961
962 /* Return the number of references of the shared CONNECTION. */
963 static ptrdiff_t
964 xd_get_connection_references (DBusConnection *connection)
965 {
966 ptrdiff_t *refcount;
967
968 /* We cannot access the DBusConnection structure, it is not public.
969 But we know, that the reference counter is the first field in
970 that structure. */
971 refcount = (void *) &connection;
972 refcount = (void *) *refcount;
973 return *refcount;
974 }
975
976 /* Convert a Lisp D-Bus object to a pointer. */
977 static DBusConnection*
978 xd_lisp_dbus_to_dbus (Lisp_Object bus)
979 {
980 return (DBusConnection *) (intptr_t) XFASTINT (bus);
981 }
982
983 /* Return D-Bus connection address. BUS is either a Lisp symbol,
984 :system or :session, or a string denoting the bus address. */
985 static DBusConnection *
986 xd_get_connection_address (Lisp_Object bus)
987 {
988 DBusConnection *connection;
989 Lisp_Object val;
990
991 val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
992 if (NILP (val))
993 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
994 else
995 connection = xd_lisp_dbus_to_dbus (val);
996
997 if (!dbus_connection_get_is_connected (connection))
998 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
999
1000 return connection;
1001 }
1002
1003 /* Return the file descriptor for WATCH, -1 if not found. */
1004 static int
1005 xd_find_watch_fd (DBusWatch *watch)
1006 {
1007 #if HAVE_DBUS_WATCH_GET_UNIX_FD
1008 /* TODO: Reverse these on w32, which prefers the opposite. */
1009 int fd = dbus_watch_get_unix_fd (watch);
1010 if (fd == -1)
1011 fd = dbus_watch_get_socket (watch);
1012 #else
1013 int fd = dbus_watch_get_fd (watch);
1014 #endif
1015 return fd;
1016 }
1017
1018 /* Prototype. */
1019 static void xd_read_queued_messages (int fd, void *data);
1020
1021 /* Start monitoring WATCH for possible I/O. */
1022 static dbus_bool_t
1023 xd_add_watch (DBusWatch *watch, void *data)
1024 {
1025 unsigned int flags = dbus_watch_get_flags (watch);
1026 int fd = xd_find_watch_fd (watch);
1027
1028 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
1029 fd, flags & DBUS_WATCH_WRITABLE,
1030 dbus_watch_get_enabled (watch));
1031
1032 if (fd == -1)
1033 return FALSE;
1034
1035 if (dbus_watch_get_enabled (watch))
1036 {
1037 if (flags & DBUS_WATCH_WRITABLE)
1038 add_write_fd (fd, xd_read_queued_messages, data);
1039 if (flags & DBUS_WATCH_READABLE)
1040 add_read_fd (fd, xd_read_queued_messages, data);
1041 }
1042 return TRUE;
1043 }
1044
1045 /* Stop monitoring WATCH for possible I/O.
1046 DATA is the used bus, either a string or QCdbus_system_bus or
1047 QCdbus_session_bus. */
1048 static void
1049 xd_remove_watch (DBusWatch *watch, void *data)
1050 {
1051 unsigned int flags = dbus_watch_get_flags (watch);
1052 int fd = xd_find_watch_fd (watch);
1053
1054 XD_DEBUG_MESSAGE ("fd %d", fd);
1055
1056 if (fd == -1)
1057 return;
1058
1059 /* Unset session environment. */
1060 #if 0
1061 if (XSYMBOL (QCdbus_session_bus) == data)
1062 {
1063 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
1064 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
1065 }
1066 #endif
1067
1068 if (flags & DBUS_WATCH_WRITABLE)
1069 delete_write_fd (fd);
1070 if (flags & DBUS_WATCH_READABLE)
1071 delete_read_fd (fd);
1072 }
1073
1074 /* Toggle monitoring WATCH for possible I/O. */
1075 static void
1076 xd_toggle_watch (DBusWatch *watch, void *data)
1077 {
1078 if (dbus_watch_get_enabled (watch))
1079 xd_add_watch (watch, data);
1080 else
1081 xd_remove_watch (watch, data);
1082 }
1083
1084 /* Close connection to D-Bus BUS. */
1085 static void
1086 xd_close_bus (Lisp_Object bus)
1087 {
1088 DBusConnection *connection;
1089 Lisp_Object val;
1090 Lisp_Object busobj;
1091
1092 /* Check whether we are connected. */
1093 val = Fassoc (bus, xd_registered_buses);
1094 if (NILP (val))
1095 return;
1096
1097 busobj = CDR_SAFE (val);
1098 if (NILP (busobj)) {
1099 xd_registered_buses = Fdelete (val, xd_registered_buses);
1100 return;
1101 }
1102
1103 /* Retrieve bus address. */
1104 connection = xd_lisp_dbus_to_dbus (busobj);
1105
1106 if (xd_get_connection_references (connection) == 1)
1107 {
1108 /* Close connection, if there isn't another shared application. */
1109 XD_DEBUG_MESSAGE ("Close connection to bus %s",
1110 XD_OBJECT_TO_STRING (bus));
1111 dbus_connection_close (connection);
1112
1113 xd_registered_buses = Fdelete (val, xd_registered_buses);
1114 }
1115
1116 else
1117 /* Decrement reference count. */
1118 dbus_connection_unref (connection);
1119
1120 /* Return. */
1121 return;
1122 }
1123
1124 DEFUN ("dbus--init-bus", Fdbus__init_bus, Sdbus__init_bus, 1, 2, 0,
1125 doc: /* Establish the connection to D-Bus BUS.
1126
1127 This function is dbus internal. You almost certainly want to use
1128 `dbus-init-bus'.
1129
1130 BUS can be either the symbol `:system' or the symbol `:session', or it
1131 can be a string denoting the address of the corresponding bus. For
1132 the system and session buses, this function is called when loading
1133 `dbus.el', there is no need to call it again.
1134
1135 The function returns a number, which counts the connections this Emacs
1136 session has established to the BUS under the same unique name (see
1137 `dbus-get-unique-name'). It depends on the libraries Emacs is linked
1138 with, and on the environment Emacs is running. For example, if Emacs
1139 is linked with the gtk toolkit, and it runs in a GTK-aware environment
1140 like Gnome, another connection might already be established.
1141
1142 When PRIVATE is non-nil, a new connection is established instead of
1143 reusing an existing one. It results in a new unique name at the bus.
1144 This can be used, if it is necessary to distinguish from another
1145 connection used in the same Emacs process, like the one established by
1146 GTK+. It should be used with care for at least the `:system' and
1147 `:session' buses, because other Emacs Lisp packages might already use
1148 this connection to those buses. */)
1149 (Lisp_Object bus, Lisp_Object private)
1150 {
1151 DBusConnection *connection;
1152 DBusError derror;
1153 Lisp_Object val;
1154 ptrdiff_t refcount;
1155
1156 /* Check parameter. */
1157 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1158
1159 /* Close bus if it is already open. */
1160 xd_close_bus (bus);
1161
1162 /* Check, whether we are still connected. */
1163 val = Fassoc (bus, xd_registered_buses);
1164 if (!NILP (val))
1165 {
1166 connection = xd_get_connection_address (bus);
1167 dbus_connection_ref (connection);
1168 }
1169
1170 else
1171 {
1172 /* Initialize. */
1173 dbus_error_init (&derror);
1174
1175 /* Open the connection. */
1176 if (STRINGP (bus))
1177 if (NILP (private))
1178 connection = dbus_connection_open (SSDATA (bus), &derror);
1179 else
1180 connection = dbus_connection_open_private (SSDATA (bus), &derror);
1181
1182 else
1183 if (NILP (private))
1184 connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
1185 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1186 &derror);
1187 else
1188 connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
1189 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1190 &derror);
1191
1192 if (dbus_error_is_set (&derror))
1193 XD_ERROR (derror);
1194
1195 if (connection == NULL)
1196 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
1197
1198 /* If it is not the system or session bus, we must register
1199 ourselves. Otherwise, we have called dbus_bus_get, which has
1200 configured us to exit if the connection closes - we undo this
1201 setting. */
1202 if (STRINGP (bus))
1203 dbus_bus_register (connection, &derror);
1204 else
1205 dbus_connection_set_exit_on_disconnect (connection, FALSE);
1206
1207 if (dbus_error_is_set (&derror))
1208 XD_ERROR (derror);
1209
1210 /* Add the watch functions. We pass also the bus as data, in
1211 order to distinguish between the buses in xd_remove_watch. */
1212 if (!dbus_connection_set_watch_functions (connection,
1213 xd_add_watch,
1214 xd_remove_watch,
1215 xd_toggle_watch,
1216 SYMBOLP (bus)
1217 ? (void *) XSYMBOL (bus)
1218 : (void *) XSTRING (bus),
1219 NULL))
1220 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
1221
1222 /* Add bus to list of registered buses. */
1223 XSETFASTINT (val, (intptr_t) connection);
1224 xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
1225
1226 /* We do not want to abort. */
1227 xputenv ("DBUS_FATAL_WARNINGS=0");
1228
1229 /* Cleanup. */
1230 dbus_error_free (&derror);
1231 }
1232
1233 /* Return reference counter. */
1234 refcount = xd_get_connection_references (connection);
1235 XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d",
1236 XD_OBJECT_TO_STRING (bus), refcount);
1237 return make_number (refcount);
1238 }
1239
1240 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1241 1, 1, 0,
1242 doc: /* Return the unique name of Emacs registered at D-Bus BUS. */)
1243 (Lisp_Object bus)
1244 {
1245 DBusConnection *connection;
1246 const char *name;
1247
1248 /* Check parameter. */
1249 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1250
1251 /* Retrieve bus address. */
1252 connection = xd_get_connection_address (bus);
1253
1254 /* Request the name. */
1255 name = dbus_bus_get_unique_name (connection);
1256 if (name == NULL)
1257 XD_SIGNAL1 (build_string ("No unique name available"));
1258
1259 /* Return. */
1260 return build_string (name);
1261 }
1262
1263 DEFUN ("dbus-message-internal", Fdbus_message_internal, Sdbus_message_internal,
1264 4, MANY, 0,
1265 doc: /* Send a D-Bus message.
1266 This is an internal function, it shall not be used outside dbus.el.
1267
1268 The following usages are expected:
1269
1270 `dbus-call-method', `dbus-call-method-asynchronously':
1271 \(dbus-message-internal
1272 dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1273 &optional :timeout TIMEOUT &rest ARGS)
1274
1275 `dbus-send-signal':
1276 \(dbus-message-internal
1277 dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1278
1279 `dbus-method-return-internal':
1280 \(dbus-message-internal
1281 dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1282
1283 `dbus-method-error-internal':
1284 \(dbus-message-internal
1285 dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1286
1287 usage: (dbus-message-internal &rest REST) */)
1288 (ptrdiff_t nargs, Lisp_Object *args)
1289 {
1290 Lisp_Object message_type, bus, service, handler;
1291 Lisp_Object path = Qnil;
1292 Lisp_Object interface = Qnil;
1293 Lisp_Object member = Qnil;
1294 Lisp_Object result;
1295 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1296 DBusConnection *connection;
1297 DBusMessage *dmessage;
1298 DBusMessageIter iter;
1299 int dtype;
1300 int mtype;
1301 dbus_uint32_t serial = 0;
1302 unsigned int ui_serial;
1303 int timeout = -1;
1304 ptrdiff_t count;
1305 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1306
1307 /* Initialize parameters. */
1308 message_type = args[0];
1309 bus = args[1];
1310 service = args[2];
1311 handler = Qnil;
1312
1313 CHECK_NATNUM (message_type);
1314 if (! (DBUS_MESSAGE_TYPE_INVALID < XFASTINT (message_type)
1315 && XFASTINT (message_type) < DBUS_NUM_MESSAGE_TYPES))
1316 XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
1317 mtype = XFASTINT (message_type);
1318
1319 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1320 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1321 {
1322 path = args[3];
1323 interface = args[4];
1324 member = args[5];
1325 if (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1326 handler = args[6];
1327 count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
1328 }
1329 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1330 {
1331 serial = xd_extract_unsigned (args[3], TYPE_MAXIMUM (dbus_uint32_t));
1332 count = 4;
1333 }
1334
1335 /* Check parameters. */
1336 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1337 XD_DBUS_VALIDATE_BUS_NAME (service);
1338 if (nargs < count)
1339 xsignal2 (Qwrong_number_of_arguments,
1340 Qdbus_message_internal,
1341 make_number (nargs));
1342
1343 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1344 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1345 {
1346 XD_DBUS_VALIDATE_PATH (path);
1347 XD_DBUS_VALIDATE_INTERFACE (interface);
1348 XD_DBUS_VALIDATE_MEMBER (member);
1349 if (!NILP (handler) && (!FUNCTIONP (handler)))
1350 wrong_type_argument (Qinvalid_function, handler);
1351 }
1352
1353 /* Protect Lisp variables. */
1354 GCPRO6 (bus, service, path, interface, member, handler);
1355
1356 /* Trace parameters. */
1357 switch (mtype)
1358 {
1359 case DBUS_MESSAGE_TYPE_METHOD_CALL:
1360 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1361 XD_MESSAGE_TYPE_TO_STRING (mtype),
1362 XD_OBJECT_TO_STRING (bus),
1363 XD_OBJECT_TO_STRING (service),
1364 XD_OBJECT_TO_STRING (path),
1365 XD_OBJECT_TO_STRING (interface),
1366 XD_OBJECT_TO_STRING (member),
1367 XD_OBJECT_TO_STRING (handler));
1368 break;
1369 case DBUS_MESSAGE_TYPE_SIGNAL:
1370 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1371 XD_MESSAGE_TYPE_TO_STRING (mtype),
1372 XD_OBJECT_TO_STRING (bus),
1373 XD_OBJECT_TO_STRING (service),
1374 XD_OBJECT_TO_STRING (path),
1375 XD_OBJECT_TO_STRING (interface),
1376 XD_OBJECT_TO_STRING (member));
1377 break;
1378 default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1379 ui_serial = serial;
1380 XD_DEBUG_MESSAGE ("%s %s %s %u",
1381 XD_MESSAGE_TYPE_TO_STRING (mtype),
1382 XD_OBJECT_TO_STRING (bus),
1383 XD_OBJECT_TO_STRING (service),
1384 ui_serial);
1385 }
1386
1387 /* Retrieve bus address. */
1388 connection = xd_get_connection_address (bus);
1389
1390 /* Create the D-Bus message. */
1391 dmessage = dbus_message_new (mtype);
1392 if (dmessage == NULL)
1393 {
1394 UNGCPRO;
1395 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1396 }
1397
1398 if (STRINGP (service))
1399 {
1400 if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
1401 /* Set destination. */
1402 {
1403 if (!dbus_message_set_destination (dmessage, SSDATA (service)))
1404 {
1405 UNGCPRO;
1406 XD_SIGNAL2 (build_string ("Unable to set the destination"),
1407 service);
1408 }
1409 }
1410
1411 else
1412 /* Set destination for unicast signals. */
1413 {
1414 Lisp_Object uname;
1415
1416 /* If it is the same unique name as we are registered at the
1417 bus or an unknown name, we regard it as broadcast message
1418 due to backward compatibility. */
1419 if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
1420 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1421 else
1422 uname = Qnil;
1423
1424 if (STRINGP (uname)
1425 && (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
1426 != 0)
1427 && (!dbus_message_set_destination (dmessage, SSDATA (service))))
1428 {
1429 UNGCPRO;
1430 XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1431 service);
1432 }
1433 }
1434 }
1435
1436 /* Set message parameters. */
1437 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1438 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1439 {
1440 if ((!dbus_message_set_path (dmessage, SSDATA (path)))
1441 || (!dbus_message_set_interface (dmessage, SSDATA (interface)))
1442 || (!dbus_message_set_member (dmessage, SSDATA (member))))
1443 {
1444 UNGCPRO;
1445 XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1446 }
1447 }
1448
1449 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1450 {
1451 if (!dbus_message_set_reply_serial (dmessage, serial))
1452 {
1453 UNGCPRO;
1454 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1455 }
1456
1457 if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
1458 && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
1459 {
1460 UNGCPRO;
1461 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1462 }
1463 }
1464
1465 /* Check for timeout parameter. */
1466 if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
1467 {
1468 CHECK_NATNUM (args[count+1]);
1469 timeout = min (XFASTINT (args[count+1]), INT_MAX);
1470 count = count+2;
1471 }
1472
1473 /* Initialize parameter list of message. */
1474 dbus_message_iter_init_append (dmessage, &iter);
1475
1476 /* Append parameters to the message. */
1477 for (; count < nargs; ++count)
1478 {
1479 dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
1480 if (XD_DBUS_TYPE_P (args[count]))
1481 {
1482 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1483 XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
1484 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
1485 XD_OBJECT_TO_STRING (args[count]),
1486 XD_OBJECT_TO_STRING (args[count+1]));
1487 ++count;
1488 }
1489 else
1490 {
1491 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1492 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
1493 XD_OBJECT_TO_STRING (args[count]));
1494 }
1495
1496 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1497 indication that there is no parent type. */
1498 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[count]);
1499
1500 xd_append_arg (dtype, args[count], &iter);
1501 }
1502
1503 if (!NILP (handler))
1504 {
1505 /* Send the message. The message is just added to the outgoing
1506 message queue. */
1507 if (!dbus_connection_send_with_reply (connection, dmessage,
1508 NULL, timeout))
1509 {
1510 UNGCPRO;
1511 XD_SIGNAL1 (build_string ("Cannot send message"));
1512 }
1513
1514 /* The result is the key in Vdbus_registered_objects_table. */
1515 serial = dbus_message_get_serial (dmessage);
1516 result = list3 (QCdbus_registered_serial,
1517 bus, make_fixnum_or_float (serial));
1518
1519 /* Create a hash table entry. */
1520 Fputhash (result, handler, Vdbus_registered_objects_table);
1521 }
1522 else
1523 {
1524 /* Send the message. The message is just added to the outgoing
1525 message queue. */
1526 if (!dbus_connection_send (connection, dmessage, NULL))
1527 {
1528 UNGCPRO;
1529 XD_SIGNAL1 (build_string ("Cannot send message"));
1530 }
1531
1532 result = Qnil;
1533 }
1534
1535 XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
1536
1537 /* Cleanup. */
1538 dbus_message_unref (dmessage);
1539
1540 /* Return the result. */
1541 RETURN_UNGCPRO (result);
1542 }
1543
1544 /* Read one queued incoming message of the D-Bus BUS.
1545 BUS is either a Lisp symbol, :system or :session, or a string denoting
1546 the bus address. */
1547 static void
1548 xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1549 {
1550 Lisp_Object args, key, value;
1551 struct gcpro gcpro1;
1552 struct input_event event;
1553 DBusMessage *dmessage;
1554 DBusMessageIter iter;
1555 int dtype;
1556 int mtype;
1557 dbus_uint32_t serial;
1558 unsigned int ui_serial;
1559 const char *uname, *path, *interface, *member;
1560
1561 dmessage = dbus_connection_pop_message (connection);
1562
1563 /* Return if there is no queued message. */
1564 if (dmessage == NULL)
1565 return;
1566
1567 /* Collect the parameters. */
1568 args = Qnil;
1569 GCPRO1 (args);
1570
1571 /* Loop over the resulting parameters. Construct a list. */
1572 if (dbus_message_iter_init (dmessage, &iter))
1573 {
1574 while ((dtype = dbus_message_iter_get_arg_type (&iter))
1575 != DBUS_TYPE_INVALID)
1576 {
1577 args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1578 dbus_message_iter_next (&iter);
1579 }
1580 /* The arguments are stored in reverse order. Reorder them. */
1581 args = Fnreverse (args);
1582 }
1583
1584 /* Read message type, message serial, unique name, object path,
1585 interface and member from the message. */
1586 mtype = dbus_message_get_type (dmessage);
1587 ui_serial = serial =
1588 ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1589 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1590 ? dbus_message_get_reply_serial (dmessage)
1591 : dbus_message_get_serial (dmessage);
1592 uname = dbus_message_get_sender (dmessage);
1593 path = dbus_message_get_path (dmessage);
1594 interface = dbus_message_get_interface (dmessage);
1595 member = dbus_message_get_member (dmessage);
1596
1597 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1598 XD_MESSAGE_TYPE_TO_STRING (mtype),
1599 ui_serial, uname, path, interface, member,
1600 XD_OBJECT_TO_STRING (args));
1601
1602 if (mtype == DBUS_MESSAGE_TYPE_INVALID)
1603 goto cleanup;
1604
1605 else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1606 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1607 {
1608 /* Search for a registered function of the message. */
1609 key = list3 (QCdbus_registered_serial, bus,
1610 make_fixnum_or_float (serial));
1611 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1612
1613 /* There shall be exactly one entry. Construct an event. */
1614 if (NILP (value))
1615 goto cleanup;
1616
1617 /* Remove the entry. */
1618 Fremhash (key, Vdbus_registered_objects_table);
1619
1620 /* Construct an event. */
1621 EVENT_INIT (event);
1622 event.kind = DBUS_EVENT;
1623 event.frame_or_window = Qnil;
1624 event.arg = Fcons (value, args);
1625 }
1626
1627 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
1628 {
1629 /* Vdbus_registered_objects_table requires non-nil interface and
1630 member. */
1631 if ((interface == NULL) || (member == NULL))
1632 goto cleanup;
1633
1634 /* Search for a registered function of the message. */
1635 key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1636 ? QCdbus_registered_method
1637 : QCdbus_registered_signal,
1638 bus, build_string (interface), build_string (member));
1639 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1640
1641 /* Loop over the registered functions. Construct an event. */
1642 while (!NILP (value))
1643 {
1644 key = CAR_SAFE (value);
1645 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1646 if (((uname == NULL)
1647 || (NILP (CAR_SAFE (key)))
1648 || (strcmp (uname, SSDATA (CAR_SAFE (key))) == 0))
1649 && ((path == NULL)
1650 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1651 || (strcmp (path,
1652 SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1653 == 0))
1654 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1655 {
1656 EVENT_INIT (event);
1657 event.kind = DBUS_EVENT;
1658 event.frame_or_window = Qnil;
1659 event.arg
1660 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args);
1661 break;
1662 }
1663 value = CDR_SAFE (value);
1664 }
1665
1666 if (NILP (value))
1667 goto cleanup;
1668 }
1669
1670 /* Add type, serial, uname, path, interface and member to the event. */
1671 event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1672 event.arg);
1673 event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1674 event.arg);
1675 event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1676 event.arg);
1677 event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1678 event.arg);
1679 event.arg = Fcons (make_fixnum_or_float (serial), event.arg);
1680 event.arg = Fcons (make_number (mtype), event.arg);
1681
1682 /* Add the bus symbol to the event. */
1683 event.arg = Fcons (bus, event.arg);
1684
1685 /* Store it into the input event queue. */
1686 kbd_buffer_store_event (&event);
1687
1688 XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
1689
1690 /* Cleanup. */
1691 cleanup:
1692 dbus_message_unref (dmessage);
1693
1694 UNGCPRO;
1695 }
1696
1697 /* Read queued incoming messages of the D-Bus BUS.
1698 BUS is either a Lisp symbol, :system or :session, or a string denoting
1699 the bus address. */
1700 static Lisp_Object
1701 xd_read_message (Lisp_Object bus)
1702 {
1703 /* Retrieve bus address. */
1704 DBusConnection *connection = xd_get_connection_address (bus);
1705
1706 /* Non blocking read of the next available message. */
1707 dbus_connection_read_write (connection, 0);
1708
1709 while (dbus_connection_get_dispatch_status (connection)
1710 != DBUS_DISPATCH_COMPLETE)
1711 xd_read_message_1 (connection, bus);
1712 return Qnil;
1713 }
1714
1715 /* Callback called when something is ready to read or write. */
1716 static void
1717 xd_read_queued_messages (int fd, void *data)
1718 {
1719 Lisp_Object busp = xd_registered_buses;
1720 Lisp_Object bus = Qnil;
1721 Lisp_Object key;
1722
1723 /* Find bus related to fd. */
1724 if (data != NULL)
1725 while (!NILP (busp))
1726 {
1727 key = CAR_SAFE (CAR_SAFE (busp));
1728 if ((SYMBOLP (key) && XSYMBOL (key) == data)
1729 || (STRINGP (key) && XSTRING (key) == data))
1730 bus = key;
1731 busp = CDR_SAFE (busp);
1732 }
1733
1734 if (NILP (bus))
1735 return;
1736
1737 /* We ignore all Lisp errors during the call. */
1738 xd_in_read_queued_messages = 1;
1739 internal_catch (Qdbus_error, xd_read_message, bus);
1740 xd_in_read_queued_messages = 0;
1741 }
1742
1743 \f
1744 void
1745 syms_of_dbusbind (void)
1746 {
1747
1748 DEFSYM (Qdbus__init_bus, "dbus--init-bus");
1749 defsubr (&Sdbus__init_bus);
1750
1751 DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
1752 defsubr (&Sdbus_get_unique_name);
1753
1754 DEFSYM (Qdbus_message_internal, "dbus-message-internal");
1755 defsubr (&Sdbus_message_internal);
1756
1757 DEFSYM (Qdbus_error, "dbus-error");
1758 Fput (Qdbus_error, Qerror_conditions,
1759 list2 (Qdbus_error, Qerror));
1760 Fput (Qdbus_error, Qerror_message,
1761 build_pure_c_string ("D-Bus error"));
1762
1763 DEFSYM (QCdbus_system_bus, ":system");
1764 DEFSYM (QCdbus_session_bus, ":session");
1765 DEFSYM (QCdbus_timeout, ":timeout");
1766 DEFSYM (QCdbus_type_byte, ":byte");
1767 DEFSYM (QCdbus_type_boolean, ":boolean");
1768 DEFSYM (QCdbus_type_int16, ":int16");
1769 DEFSYM (QCdbus_type_uint16, ":uint16");
1770 DEFSYM (QCdbus_type_int32, ":int32");
1771 DEFSYM (QCdbus_type_uint32, ":uint32");
1772 DEFSYM (QCdbus_type_int64, ":int64");
1773 DEFSYM (QCdbus_type_uint64, ":uint64");
1774 DEFSYM (QCdbus_type_double, ":double");
1775 DEFSYM (QCdbus_type_string, ":string");
1776 DEFSYM (QCdbus_type_object_path, ":object-path");
1777 DEFSYM (QCdbus_type_signature, ":signature");
1778 #ifdef DBUS_TYPE_UNIX_FD
1779 DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
1780 #endif
1781 DEFSYM (QCdbus_type_array, ":array");
1782 DEFSYM (QCdbus_type_variant, ":variant");
1783 DEFSYM (QCdbus_type_struct, ":struct");
1784 DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
1785 DEFSYM (QCdbus_registered_serial, ":serial");
1786 DEFSYM (QCdbus_registered_method, ":method");
1787 DEFSYM (QCdbus_registered_signal, ":signal");
1788
1789 DEFVAR_LISP ("dbus-compiled-version",
1790 Vdbus_compiled_version,
1791 doc: /* The version of D-Bus Emacs is compiled against. */);
1792 #ifdef DBUS_VERSION_STRING
1793 Vdbus_compiled_version = build_pure_c_string (DBUS_VERSION_STRING);
1794 #else
1795 Vdbus_compiled_version = Qnil;
1796 #endif
1797
1798 DEFVAR_LISP ("dbus-runtime-version",
1799 Vdbus_runtime_version,
1800 doc: /* The version of D-Bus Emacs runs with. */);
1801 {
1802 #ifdef DBUS_VERSION
1803 int major, minor, micro;
1804 char s[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
1805 dbus_get_version (&major, &minor, &micro);
1806 Vdbus_runtime_version
1807 = make_formatted_string (s, "%d.%d.%d", major, minor, micro);
1808 #else
1809 Vdbus_runtime_version = Qnil;
1810 #endif
1811 }
1812
1813 DEFVAR_LISP ("dbus-message-type-invalid",
1814 Vdbus_message_type_invalid,
1815 doc: /* This value is never a valid message type. */);
1816 Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
1817
1818 DEFVAR_LISP ("dbus-message-type-method-call",
1819 Vdbus_message_type_method_call,
1820 doc: /* Message type of a method call message. */);
1821 Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
1822
1823 DEFVAR_LISP ("dbus-message-type-method-return",
1824 Vdbus_message_type_method_return,
1825 doc: /* Message type of a method return message. */);
1826 Vdbus_message_type_method_return
1827 = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1828
1829 DEFVAR_LISP ("dbus-message-type-error",
1830 Vdbus_message_type_error,
1831 doc: /* Message type of an error reply message. */);
1832 Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
1833
1834 DEFVAR_LISP ("dbus-message-type-signal",
1835 Vdbus_message_type_signal,
1836 doc: /* Message type of a signal message. */);
1837 Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
1838
1839 DEFVAR_LISP ("dbus-registered-objects-table",
1840 Vdbus_registered_objects_table,
1841 doc: /* Hash table of registered functions for D-Bus.
1842
1843 There are two different uses of the hash table: for accessing
1844 registered interfaces properties, targeted by signals or method calls,
1845 and for calling handlers in case of non-blocking method call returns.
1846
1847 In the first case, the key in the hash table is the list (TYPE BUS
1848 INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
1849 `:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
1850 `:session', or a string denoting the bus address. INTERFACE is a
1851 string which denotes a D-Bus interface, and MEMBER, also a string, is
1852 either a method, a signal or a property INTERFACE is offering. All
1853 arguments but BUS must not be nil.
1854
1855 The value in the hash table is a list of quadruple lists \((UNAME
1856 SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
1857 registered, UNAME is the corresponding unique name. In case of
1858 registered methods and properties, UNAME is nil. PATH is the object
1859 path of the sending object. All of them can be nil, which means a
1860 wildcard then. OBJECT is either the handler to be called when a D-Bus
1861 message, which matches the key criteria, arrives (TYPE `:method' and
1862 `:signal'), or a cons cell containing the value of the property (TYPE
1863 `:property').
1864
1865 For entries of type `:signal', there is also a fifth element RULE,
1866 which keeps the match string the signal is registered with.
1867
1868 In the second case, the key in the hash table is the list (:serial BUS
1869 SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
1870 string denoting the bus address. SERIAL is the serial number of the
1871 non-blocking method call, a reply is expected. Both arguments must
1872 not be nil. The value in the hash table is HANDLER, the function to
1873 be called when the D-Bus reply message arrives. */);
1874 {
1875 Lisp_Object args[2];
1876 args[0] = QCtest;
1877 args[1] = Qequal;
1878 Vdbus_registered_objects_table = Fmake_hash_table (2, args);
1879 }
1880
1881 DEFVAR_LISP ("dbus-debug", Vdbus_debug,
1882 doc: /* If non-nil, debug messages of D-Bus bindings are raised. */);
1883 #ifdef DBUS_DEBUG
1884 Vdbus_debug = Qt;
1885 /* We can also set environment variable DBUS_VERBOSE=1 in order to
1886 see more traces. This requires libdbus-1 to be configured with
1887 --enable-verbose-mode. */
1888 #else
1889 Vdbus_debug = Qnil;
1890 #endif
1891
1892 /* Initialize internal objects. */
1893 xd_registered_buses = Qnil;
1894 staticpro (&xd_registered_buses);
1895
1896 Fprovide (intern_c_string ("dbusbind"), Qnil);
1897
1898 }
1899
1900 #endif /* HAVE_DBUS */
Unnamed repository; edit this file 'description' to name the repository.