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