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