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