aboutsummaryrefslogtreecommitdiffstats
path: root/src/dbusbind.c
diff options
context:
space:
mode:
authorPaul Eggert2012-05-25 11:19:24 -0700
committerPaul Eggert2012-05-25 11:19:24 -0700
commit42b2a986d9d4b7040fb20c90ec0efeffb78e761a (patch)
treed38e7bf5307837f2f38982757f088100de18a64e /src/dbusbind.c
parente4d81efc58695c19154d5f6733d91172b4c3e5b7 (diff)
parenta8d3cbf75d219d7a249fc0623219511179e959da (diff)
downloademacs-42b2a986d9d4b7040fb20c90ec0efeffb78e761a.tar.gz
emacs-42b2a986d9d4b7040fb20c90ec0efeffb78e761a.zip
Merge from trunk.
Diffstat (limited to 'src/dbusbind.c')
-rw-r--r--src/dbusbind.c1848
1 files changed, 675 insertions, 1173 deletions
diff --git a/src/dbusbind.c b/src/dbusbind.c
index c4e57dad98a..2ed7369c9dc 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -28,19 +28,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
28#include "keyboard.h" 28#include "keyboard.h"
29#include "process.h" 29#include "process.h"
30 30
31#ifndef DBUS_NUM_MESSAGE_TYPES
32#define DBUS_NUM_MESSAGE_TYPES 5
33#endif
34
31 35
32/* Subroutines. */ 36/* Subroutines. */
33static Lisp_Object Qdbus_init_bus; 37static Lisp_Object Qdbus_init_bus;
34static Lisp_Object Qdbus_close_bus;
35static Lisp_Object Qdbus_get_unique_name; 38static Lisp_Object Qdbus_get_unique_name;
36static Lisp_Object Qdbus_call_method; 39static Lisp_Object Qdbus_message_internal;
37static Lisp_Object Qdbus_call_method_asynchronously;
38static Lisp_Object Qdbus_method_return_internal;
39static Lisp_Object Qdbus_method_error_internal;
40static Lisp_Object Qdbus_send_signal;
41static Lisp_Object Qdbus_register_service;
42static Lisp_Object Qdbus_register_signal;
43static Lisp_Object Qdbus_register_method;
44 40
45/* D-Bus error symbol. */ 41/* D-Bus error symbol. */
46static Lisp_Object Qdbus_error; 42static Lisp_Object Qdbus_error;
@@ -51,17 +47,6 @@ static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
51/* Lisp symbol for method call timeout. */ 47/* Lisp symbol for method call timeout. */
52static Lisp_Object QCdbus_timeout; 48static Lisp_Object QCdbus_timeout;
53 49
54/* Lisp symbols for name request flags. */
55static Lisp_Object QCdbus_request_name_allow_replacement;
56static Lisp_Object QCdbus_request_name_replace_existing;
57static Lisp_Object QCdbus_request_name_do_not_queue;
58
59/* Lisp symbols for name request replies. */
60static Lisp_Object QCdbus_request_name_reply_primary_owner;
61static Lisp_Object QCdbus_request_name_reply_in_queue;
62static Lisp_Object QCdbus_request_name_reply_exists;
63static Lisp_Object QCdbus_request_name_reply_already_owner;
64
65/* Lisp symbols of D-Bus types. */ 50/* Lisp symbols of D-Bus types. */
66static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean; 51static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
67static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16; 52static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
@@ -75,6 +60,15 @@ static Lisp_Object QCdbus_type_unix_fd;
75static Lisp_Object QCdbus_type_array, QCdbus_type_variant; 60static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
76static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry; 61static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
77 62
63/* Lisp symbols of objects in `dbus-registered-objects-table'. */
64static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method;
65static Lisp_Object QCdbus_registered_signal;
66
67/* Alist of D-Bus buses we are polling for messages.
68 The key is the symbol or string of the bus, and the value is the
69 connection address. */
70static Lisp_Object xd_registered_buses;
71
78/* Whether we are reading a D-Bus event. */ 72/* Whether we are reading a D-Bus event. */
79static int xd_in_read_queued_messages = 0; 73static int xd_in_read_queued_messages = 0;
80 74
@@ -120,14 +114,15 @@ static int xd_in_read_queued_messages = 0;
120 } while (0) 114 } while (0)
121 115
122/* Macros for debugging. In order to enable them, build with 116/* Macros for debugging. In order to enable them, build with
123 "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */ 117 "env MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
124#ifdef DBUS_DEBUG 118#ifdef DBUS_DEBUG
125#define XD_DEBUG_MESSAGE(...) \ 119#define XD_DEBUG_MESSAGE(...) \
126 do { \ 120 do { \
127 char s[1024]; \ 121 char s[1024]; \
128 snprintf (s, sizeof s, __VA_ARGS__); \ 122 snprintf (s, sizeof s, __VA_ARGS__); \
129 printf ("%s: %s\n", __func__, s); \ 123 if (!noninteractive) \
130 message ("%s: %s", __func__, s); \ 124 printf ("%s: %s\n", __func__, s); \
125 message ("%s: %s", __func__, s); \
131 } while (0) 126 } while (0)
132#define XD_DEBUG_VALID_LISP_OBJECT_P(object) \ 127#define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
133 do { \ 128 do { \
@@ -144,7 +139,7 @@ static int xd_in_read_queued_messages = 0;
144 if (!NILP (Vdbus_debug)) \ 139 if (!NILP (Vdbus_debug)) \
145 { \ 140 { \
146 char s[1024]; \ 141 char s[1024]; \
147 snprintf (s, 1023, __VA_ARGS__); \ 142 snprintf (s, sizeof s, __VA_ARGS__); \
148 message ("%s: %s", __func__, s); \ 143 message ("%s: %s", __func__, s); \
149 } \ 144 } \
150 } while (0) 145 } while (0)
@@ -241,23 +236,115 @@ xd_symbol_to_dbus_type (Lisp_Object object)
241#define XD_NEXT_VALUE(object) \ 236#define XD_NEXT_VALUE(object) \
242 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object) 237 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
243 238
239/* Transform the message type to its string representation for debug
240 messages. */
241#define XD_MESSAGE_TYPE_TO_STRING(mtype) \
242 ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
243 ? "DBUS_MESSAGE_TYPE_INVALID" \
244 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
245 ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
246 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
247 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
248 : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
249 ? "DBUS_MESSAGE_TYPE_ERROR" \
250 : "DBUS_MESSAGE_TYPE_SIGNAL")
251
252/* Transform the object to its string representation for debug
253 messages. */
254#define XD_OBJECT_TO_STRING(object) \
255 SDATA (format2 ("%s", object, Qnil))
256
244/* Check whether X is a valid dbus serial number. If valid, set 257/* Check whether X is a valid dbus serial number. If valid, set
245 SERIAL to its value. Otherwise, signal an error. */ 258 SERIAL to its value. Otherwise, signal an error. */
246#define CHECK_DBUS_SERIAL_GET_SERIAL(x, serial) \ 259#define XD_CHECK_DBUS_SERIAL(x, serial) \
247 do \ 260 do { \
248 { \ 261 dbus_uint32_t DBUS_SERIAL_MAX = -1; \
249 dbus_uint32_t DBUS_SERIAL_MAX = -1; \ 262 if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \
250 if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \ 263 serial = XINT (x); \
251 serial = XINT (x); \ 264 else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \
252 else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \ 265 && FLOATP (x) \
253 && FLOATP (x) \ 266 && 0 <= XFLOAT_DATA (x) \
254 && 0 <= XFLOAT_DATA (x) \ 267 && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \
255 && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \ 268 serial = XFLOAT_DATA (x); \
256 serial = XFLOAT_DATA (x); \ 269 else \
257 else \ 270 XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \
258 XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \ 271 } while (0)
259 } \ 272
260 while (0) 273#define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
274 do { \
275 if (STRINGP (bus)) \
276 { \
277 DBusAddressEntry **entries; \
278 int len; \
279 DBusError derror; \
280 dbus_error_init (&derror); \
281 if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
282 XD_ERROR (derror); \
283 /* Cleanup. */ \
284 dbus_error_free (&derror); \
285 dbus_address_entries_free (entries); \
286 } \
287 \
288 else \
289 { \
290 CHECK_SYMBOL (bus); \
291 if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
292 XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
293 /* We do not want to have an autolaunch for the session bus. */ \
294 if (EQ (bus, QCdbus_session_bus) \
295 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) \
296 XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
297 } \
298 } while (0)
299
300#if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
301 || XD_DBUS_VALIDATE_OBJECT || HAVE_DBUS_VALIDATE_MEMBER)
302#define XD_DBUS_VALIDATE_OBJECT(object, func) \
303 do { \
304 if (!NILP (object)) \
305 { \
306 DBusError derror; \
307 CHECK_STRING (object); \
308 dbus_error_init (&derror); \
309 if (!func (SSDATA (object), &derror)) \
310 XD_ERROR (derror); \
311 /* Cleanup. */ \
312 dbus_error_free (&derror); \
313 } \
314 } while (0)
315#endif
316
317#if HAVE_DBUS_VALIDATE_BUS_NAME
318#define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
319 XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
320#else
321#define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
322 if (!NILP (bus_name)) CHECK_STRING (bus_name);
323#endif
324
325#if HAVE_DBUS_VALIDATE_PATH
326#define XD_DBUS_VALIDATE_PATH(path) \
327 XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
328#else
329#define XD_DBUS_VALIDATE_PATH(path) \
330 if (!NILP (path)) CHECK_STRING (path);
331#endif
332
333#if HAVE_DBUS_VALIDATE_INTERFACE
334#define XD_DBUS_VALIDATE_INTERFACE(interface) \
335 XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
336#else
337#define XD_DBUS_VALIDATE_INTERFACE(interface) \
338 if (!NILP (interface)) CHECK_STRING (interface);
339#endif
340
341#if HAVE_DBUS_VALIDATE_MEMBER
342#define XD_DBUS_VALIDATE_MEMBER(member) \
343 XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
344#else
345#define XD_DBUS_VALIDATE_MEMBER(member) \
346 if (!NILP (member)) CHECK_STRING (member);
347#endif
261 348
262/* Append to SIGNATURE a copy of X, making sure SIGNATURE does 349/* Append to SIGNATURE a copy of X, making sure SIGNATURE does
263 not become too long. */ 350 not become too long. */
@@ -293,11 +380,6 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
293 { 380 {
294 case DBUS_TYPE_BYTE: 381 case DBUS_TYPE_BYTE:
295 case DBUS_TYPE_UINT16: 382 case DBUS_TYPE_UINT16:
296 case DBUS_TYPE_UINT32:
297 case DBUS_TYPE_UINT64:
298#ifdef DBUS_TYPE_UNIX_FD
299 case DBUS_TYPE_UNIX_FD:
300#endif
301 CHECK_NATNUM (object); 383 CHECK_NATNUM (object);
302 sprintf (signature, "%c", dtype); 384 sprintf (signature, "%c", dtype);
303 break; 385 break;
@@ -309,14 +391,19 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
309 break; 391 break;
310 392
311 case DBUS_TYPE_INT16: 393 case DBUS_TYPE_INT16:
312 case DBUS_TYPE_INT32:
313 case DBUS_TYPE_INT64:
314 CHECK_NUMBER (object); 394 CHECK_NUMBER (object);
315 sprintf (signature, "%c", dtype); 395 sprintf (signature, "%c", dtype);
316 break; 396 break;
317 397
398 case DBUS_TYPE_UINT32:
399 case DBUS_TYPE_UINT64:
400#ifdef DBUS_TYPE_UNIX_FD
401 case DBUS_TYPE_UNIX_FD:
402#endif
403 case DBUS_TYPE_INT32:
404 case DBUS_TYPE_INT64:
318 case DBUS_TYPE_DOUBLE: 405 case DBUS_TYPE_DOUBLE:
319 CHECK_FLOAT (object); 406 CHECK_NUMBER_OR_FLOAT (object);
320 sprintf (signature, "%c", dtype); 407 sprintf (signature, "%c", dtype);
321 break; 408 break;
322 409
@@ -352,8 +439,8 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
352 } 439 }
353 440
354 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the 441 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
355 only element, the value of this element is used as he array's 442 only element, the value of this element is used as the
356 element signature. */ 443 array's element signature. */
357 if ((subtype == DBUS_TYPE_SIGNATURE) 444 if ((subtype == DBUS_TYPE_SIGNATURE)
358 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt))) 445 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
359 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt)))) 446 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
@@ -451,6 +538,54 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
451 XD_DEBUG_MESSAGE ("%s", signature); 538 XD_DEBUG_MESSAGE ("%s", signature);
452} 539}
453 540
541/* Convert X to a signed integer with bounds LO and HI. */
542static intmax_t
543extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi)
544{
545 CHECK_NUMBER_OR_FLOAT (x);
546 if (INTEGERP (x))
547 {
548 if (lo <= XINT (x) && XINT (x) <= hi)
549 return XINT (x);
550 }
551 else
552 {
553 double d = XFLOAT_DATA (x);
554 if (lo <= d && d <= hi)
555 {
556 intmax_t n = d;
557 if (n == d)
558 return n;
559 }
560 }
561 args_out_of_range_3 (x,
562 make_fixnum_or_float (lo),
563 make_fixnum_or_float (hi));
564}
565
566/* Convert X to an unsigned integer with bounds 0 and HI. */
567static uintmax_t
568extract_unsigned (Lisp_Object x, uintmax_t hi)
569{
570 CHECK_NUMBER_OR_FLOAT (x);
571 if (INTEGERP (x))
572 {
573 if (0 <= XINT (x) && XINT (x) <= hi)
574 return XINT (x);
575 }
576 else
577 {
578 double d = XFLOAT_DATA (x);
579 if (0 <= d && d <= hi)
580 {
581 uintmax_t n = d;
582 if (n == d)
583 return n;
584 }
585 }
586 args_out_of_range_2 (x, make_fixnum_or_float (hi));
587}
588
454/* Append C value, extracted from Lisp OBJECT, to iteration ITER. 589/* Append C value, extracted from Lisp OBJECT, to iteration ITER.
455 DTYPE must be a valid DBusType. It is used to convert Lisp 590 DTYPE must be a valid DBusType. It is used to convert Lisp
456 objects, being arguments of `dbus-call-method' or 591 objects, being arguments of `dbus-call-method' or
@@ -469,7 +604,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
469 CHECK_NATNUM (object); 604 CHECK_NATNUM (object);
470 { 605 {
471 unsigned char val = XFASTINT (object) & 0xFF; 606 unsigned char val = XFASTINT (object) & 0xFF;
472 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 607 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
473 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 608 if (!dbus_message_iter_append_basic (iter, dtype, &val))
474 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 609 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
475 return; 610 return;
@@ -488,7 +623,8 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
488 CHECK_TYPE_RANGED_INTEGER (dbus_int16_t, object); 623 CHECK_TYPE_RANGED_INTEGER (dbus_int16_t, object);
489 { 624 {
490 dbus_int16_t val = XINT (object); 625 dbus_int16_t val = XINT (object);
491 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); 626 int pval = val;
627 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
492 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 628 if (!dbus_message_iter_append_basic (iter, dtype, &val))
493 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 629 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
494 return; 630 return;
@@ -498,17 +634,20 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
498 CHECK_TYPE_RANGED_INTEGER (dbus_uint16_t, object); 634 CHECK_TYPE_RANGED_INTEGER (dbus_uint16_t, object);
499 { 635 {
500 dbus_uint16_t val = XFASTINT (object); 636 dbus_uint16_t val = XFASTINT (object);
501 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val); 637 unsigned int pval = val;
638 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
502 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 639 if (!dbus_message_iter_append_basic (iter, dtype, &val))
503 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 640 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
504 return; 641 return;
505 } 642 }
506 643
507 case DBUS_TYPE_INT32: 644 case DBUS_TYPE_INT32:
508 CHECK_TYPE_RANGED_INTEGER (dbus_int32_t, object);
509 { 645 {
510 dbus_int32_t val = XINT (object); 646 dbus_int32_t val = extract_signed (object,
511 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 647 TYPE_MINIMUM (dbus_int32_t),
648 TYPE_MAXIMUM (dbus_int32_t));
649 int pval = val;
650 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
512 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 651 if (!dbus_message_iter_append_basic (iter, dtype, &val))
513 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 652 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
514 return; 653 return;
@@ -518,39 +657,43 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
518#ifdef DBUS_TYPE_UNIX_FD 657#ifdef DBUS_TYPE_UNIX_FD
519 case DBUS_TYPE_UNIX_FD: 658 case DBUS_TYPE_UNIX_FD:
520#endif 659#endif
521 CHECK_TYPE_RANGED_INTEGER (dbus_uint32_t, object);
522 { 660 {
523 dbus_uint32_t val = XFASTINT (object); 661 dbus_uint32_t val = extract_unsigned (object,
524 XD_DEBUG_MESSAGE ("%c %u", dtype, val); 662 TYPE_MAXIMUM (dbus_uint32_t));
663 unsigned int pval = val;
664 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
525 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 665 if (!dbus_message_iter_append_basic (iter, dtype, &val))
526 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 666 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
527 return; 667 return;
528 } 668 }
529 669
530 case DBUS_TYPE_INT64: 670 case DBUS_TYPE_INT64:
531 CHECK_NUMBER (object); 671 CHECK_TYPE_RANGED_INTEGER_OR_FLOAT (dbus_int64_t, object);
532 { 672 {
533 dbus_int64_t val = XINT (object); 673 dbus_int64_t val = extract_signed (object,
534 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); 674 TYPE_MINIMUM (dbus_int64_t),
675 TYPE_MAXIMUM (dbus_int64_t));
676 printmax_t pval = val;
677 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
535 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 678 if (!dbus_message_iter_append_basic (iter, dtype, &val))
536 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 679 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
537 return; 680 return;
538 } 681 }
539 682
540 case DBUS_TYPE_UINT64: 683 case DBUS_TYPE_UINT64:
541 CHECK_TYPE_RANGED_INTEGER (dbus_uint64_t, object);
542 { 684 {
543 dbus_uint64_t val = XFASTINT (object); 685 dbus_uint64_t val = extract_unsigned (object,
544 XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object)); 686 TYPE_MAXIMUM (dbus_uint64_t));
687 uprintmax_t pval = val;
688 XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval);
545 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 689 if (!dbus_message_iter_append_basic (iter, dtype, &val))
546 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 690 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
547 return; 691 return;
548 } 692 }
549 693
550 case DBUS_TYPE_DOUBLE: 694 case DBUS_TYPE_DOUBLE:
551 CHECK_FLOAT (object);
552 { 695 {
553 double val = XFLOAT_DATA (object); 696 double val = extract_float (object);
554 XD_DEBUG_MESSAGE ("%c %f", dtype, val); 697 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
555 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 698 if (!dbus_message_iter_append_basic (iter, dtype, &val))
556 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 699 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -614,7 +757,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
614 dtype, CAR_SAFE (XD_NEXT_VALUE (object))); 757 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
615 758
616 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature, 759 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
617 SDATA (format2 ("%s", object, Qnil))); 760 XD_OBJECT_TO_STRING (object));
618 if (!dbus_message_iter_open_container (iter, dtype, 761 if (!dbus_message_iter_open_container (iter, dtype,
619 signature, &subiter)) 762 signature, &subiter))
620 XD_SIGNAL3 (build_string ("Cannot open container"), 763 XD_SIGNAL3 (build_string ("Cannot open container"),
@@ -627,7 +770,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
627 dtype, CAR_SAFE (XD_NEXT_VALUE (object))); 770 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
628 771
629 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature, 772 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
630 SDATA (format2 ("%s", object, Qnil))); 773 XD_OBJECT_TO_STRING (object));
631 if (!dbus_message_iter_open_container (iter, dtype, 774 if (!dbus_message_iter_open_container (iter, dtype,
632 signature, &subiter)) 775 signature, &subiter))
633 XD_SIGNAL3 (build_string ("Cannot open container"), 776 XD_SIGNAL3 (build_string ("Cannot open container"),
@@ -637,8 +780,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
637 case DBUS_TYPE_STRUCT: 780 case DBUS_TYPE_STRUCT:
638 case DBUS_TYPE_DICT_ENTRY: 781 case DBUS_TYPE_DICT_ENTRY:
639 /* These containers do not require a signature. */ 782 /* These containers do not require a signature. */
640 XD_DEBUG_MESSAGE ("%c %s", dtype, 783 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object));
641 SDATA (format2 ("%s", object, Qnil)));
642 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter)) 784 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
643 XD_SIGNAL2 (build_string ("Cannot open container"), 785 XD_SIGNAL2 (build_string ("Cannot open container"),
644 make_number (dtype)); 786 make_number (dtype));
@@ -678,7 +820,7 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
678 unsigned int val; 820 unsigned int val;
679 dbus_message_iter_get_basic (iter, &val); 821 dbus_message_iter_get_basic (iter, &val);
680 val = val & 0xFF; 822 val = val & 0xFF;
681 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 823 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
682 return make_number (val); 824 return make_number (val);
683 } 825 }
684 826
@@ -693,24 +835,30 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
693 case DBUS_TYPE_INT16: 835 case DBUS_TYPE_INT16:
694 { 836 {
695 dbus_int16_t val; 837 dbus_int16_t val;
838 int pval;
696 dbus_message_iter_get_basic (iter, &val); 839 dbus_message_iter_get_basic (iter, &val);
697 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 840 pval = val;
841 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
698 return make_number (val); 842 return make_number (val);
699 } 843 }
700 844
701 case DBUS_TYPE_UINT16: 845 case DBUS_TYPE_UINT16:
702 { 846 {
703 dbus_uint16_t val; 847 dbus_uint16_t val;
848 int pval;
704 dbus_message_iter_get_basic (iter, &val); 849 dbus_message_iter_get_basic (iter, &val);
705 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 850 pval = val;
851 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
706 return make_number (val); 852 return make_number (val);
707 } 853 }
708 854
709 case DBUS_TYPE_INT32: 855 case DBUS_TYPE_INT32:
710 { 856 {
711 dbus_int32_t val; 857 dbus_int32_t val;
858 int pval;
712 dbus_message_iter_get_basic (iter, &val); 859 dbus_message_iter_get_basic (iter, &val);
713 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 860 pval = val;
861 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
714 return make_fixnum_or_float (val); 862 return make_fixnum_or_float (val);
715 } 863 }
716 864
@@ -720,24 +868,30 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
720#endif 868#endif
721 { 869 {
722 dbus_uint32_t val; 870 dbus_uint32_t val;
871 unsigned int pval = val;
723 dbus_message_iter_get_basic (iter, &val); 872 dbus_message_iter_get_basic (iter, &val);
724 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 873 pval = val;
874 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
725 return make_fixnum_or_float (val); 875 return make_fixnum_or_float (val);
726 } 876 }
727 877
728 case DBUS_TYPE_INT64: 878 case DBUS_TYPE_INT64:
729 { 879 {
730 dbus_int64_t val; 880 dbus_int64_t val;
881 printmax_t pval;
731 dbus_message_iter_get_basic (iter, &val); 882 dbus_message_iter_get_basic (iter, &val);
732 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); 883 pval = val;
884 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
733 return make_fixnum_or_float (val); 885 return make_fixnum_or_float (val);
734 } 886 }
735 887
736 case DBUS_TYPE_UINT64: 888 case DBUS_TYPE_UINT64:
737 { 889 {
738 dbus_uint64_t val; 890 dbus_uint64_t val;
891 uprintmax_t pval;
739 dbus_message_iter_get_basic (iter, &val); 892 dbus_message_iter_get_basic (iter, &val);
740 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); 893 pval = val;
894 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
741 return make_fixnum_or_float (val); 895 return make_fixnum_or_float (val);
742 } 896 }
743 897
@@ -777,7 +931,7 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
777 result = Fcons (xd_retrieve_arg (subtype, &subiter), result); 931 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
778 dbus_message_iter_next (&subiter); 932 dbus_message_iter_next (&subiter);
779 } 933 }
780 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil))); 934 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
781 RETURN_UNGCPRO (Fnreverse (result)); 935 RETURN_UNGCPRO (Fnreverse (result));
782 } 936 }
783 937
@@ -787,85 +941,37 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
787 } 941 }
788} 942}
789 943
790/* Initialize D-Bus connection. BUS is either a Lisp symbol, :system 944/* Return the number of references of the shared CONNECTION. */
791 or :session, or a string denoting the bus address. It tells which 945static int
792 D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error 946xd_get_connection_references (DBusConnection *connection)
793 when the connection cannot be initialized. */ 947{
948 ptrdiff_t *refcount;
949
950 /* We cannot access the DBusConnection structure, it is not public.
951 But we know, that the reference counter is the first field in
952 that structure. */
953 refcount = (void *) &connection;
954 refcount = (void *) *refcount;
955 return *refcount;
956}
957
958/* Return D-Bus connection address. BUS is either a Lisp symbol,
959 :system or :session, or a string denoting the bus address. */
794static DBusConnection * 960static DBusConnection *
795xd_initialize (Lisp_Object bus, int raise_error) 961xd_get_connection_address (Lisp_Object bus)
796{ 962{
797 DBusConnection *connection; 963 DBusConnection *connection;
798 DBusError derror; 964 Lisp_Object val;
799
800 /* Parameter check. */
801 if (!STRINGP (bus))
802 {
803 CHECK_SYMBOL (bus);
804 if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
805 {
806 if (raise_error)
807 XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
808 else
809 return NULL;
810 }
811 965
812 /* We do not want to have an autolaunch for the session bus. */ 966 val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
813 if (EQ (bus, QCdbus_session_bus) 967 if (NILP (val))
814 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) 968 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
815 {
816 if (raise_error)
817 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
818 else
819 return NULL;
820 }
821 }
822
823 /* Open a connection to the bus. */
824 dbus_error_init (&derror);
825
826 if (STRINGP (bus))
827 connection = dbus_connection_open (SSDATA (bus), &derror);
828 else 969 else
829 if (EQ (bus, QCdbus_system_bus)) 970 connection = (DBusConnection *) (intptr_t) XFASTINT (val);
830 connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
831 else
832 connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
833
834 if (dbus_error_is_set (&derror))
835 {
836 if (raise_error)
837 XD_ERROR (derror);
838 else
839 connection = NULL;
840 }
841 971
842 /* If it is not the system or session bus, we must register 972 if (!dbus_connection_get_is_connected (connection))
843 ourselves. Otherwise, we have called dbus_bus_get, which has
844 configured us to exit if the connection closes - we undo this
845 setting. */
846 if (connection != NULL)
847 {
848 if (STRINGP (bus))
849 dbus_bus_register (connection, &derror);
850 else
851 dbus_connection_set_exit_on_disconnect (connection, FALSE);
852 }
853
854 if (dbus_error_is_set (&derror))
855 {
856 if (raise_error)
857 XD_ERROR (derror);
858 else
859 connection = NULL;
860 }
861
862 if (connection == NULL && raise_error)
863 XD_SIGNAL2 (build_string ("No connection to bus"), bus); 973 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
864 974
865 /* Cleanup. */
866 dbus_error_free (&derror);
867
868 /* Return the result. */
869 return connection; 975 return connection;
870} 976}
871 977
@@ -896,8 +1002,8 @@ xd_add_watch (DBusWatch *watch, void *data)
896 int fd = xd_find_watch_fd (watch); 1002 int fd = xd_find_watch_fd (watch);
897 1003
898 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d", 1004 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
899 fd, flags & DBUS_WATCH_WRITABLE, 1005 fd, flags & DBUS_WATCH_WRITABLE,
900 dbus_watch_get_enabled (watch)); 1006 dbus_watch_get_enabled (watch));
901 1007
902 if (fd == -1) 1008 if (fd == -1)
903 return FALSE; 1009 return FALSE;
@@ -929,8 +1035,8 @@ xd_remove_watch (DBusWatch *watch, void *data)
929 /* Unset session environment. */ 1035 /* Unset session environment. */
930 if (XSYMBOL (QCdbus_session_bus) == data) 1036 if (XSYMBOL (QCdbus_session_bus) == data)
931 { 1037 {
932 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS"); 1038 // XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
933 unsetenv ("DBUS_SESSION_BUS_ADDRESS"); 1039 // unsetenv ("DBUS_SESSION_BUS_ADDRESS");
934 } 1040 }
935 1041
936 if (flags & DBUS_WATCH_WRITABLE) 1042 if (flags & DBUS_WATCH_WRITABLE)
@@ -949,23 +1055,111 @@ xd_toggle_watch (DBusWatch *watch, void *data)
949 xd_remove_watch (watch, data); 1055 xd_remove_watch (watch, data);
950} 1056}
951 1057
952DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0, 1058/* Close connection to D-Bus BUS. */
953 doc: /* Initialize connection to D-Bus BUS. */) 1059static void
954 (Lisp_Object bus) 1060xd_close_bus (Lisp_Object bus)
1061{
1062 DBusConnection *connection;
1063 Lisp_Object val;
1064
1065 /* Check whether we are connected. */
1066 val = Fassoc (bus, xd_registered_buses);
1067 if (NILP (val))
1068 return;
1069
1070 /* Retrieve bus address. */
1071 connection = xd_get_connection_address (bus);
1072
1073 /* Close connection, if there isn't another shared application. */
1074 if (xd_get_connection_references (connection) == 1)
1075 {
1076 XD_DEBUG_MESSAGE ("Close connection to bus %s",
1077 XD_OBJECT_TO_STRING (bus));
1078 dbus_connection_close (connection);
1079 }
1080
1081 /* Decrement reference count. */
1082 dbus_connection_unref (connection);
1083
1084 /* Remove bus from list of registered buses. */
1085 xd_registered_buses = Fdelete (val, xd_registered_buses);
1086
1087 /* Return. */
1088 return;
1089}
1090
1091DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 2, 0,
1092 doc: /* Establish the connection to D-Bus BUS.
1093
1094BUS can be either the symbol `:system' or the symbol `:session', or it
1095can be a string denoting the address of the corresponding bus. For
1096the system and session buses, this function is called when loading
1097`dbus.el', there is no need to call it again.
1098
1099The function returns a number, which counts the connections this Emacs
1100session has established to the BUS under the same unique name (see
1101`dbus-get-unique-name'). It depends on the libraries Emacs is linked
1102with, and on the environment Emacs is running. For example, if Emacs
1103is linked with the gtk toolkit, and it runs in a GTK-aware environment
1104like Gnome, another connection might already be established.
1105
1106When PRIVATE is non-nil, a new connection is established instead of
1107reusing an existing one. It results in a new unique name at the bus.
1108This can be used, if it is necessary to distinguish from another
1109connection used in the same Emacs process, like the one established by
1110GTK+. It should be used with care for at least the `:system' and
1111`:session' buses, because other Emacs Lisp packages might already use
1112this connection to those buses. */)
1113 (Lisp_Object bus, Lisp_Object private)
955{ 1114{
956 DBusConnection *connection; 1115 DBusConnection *connection;
957 void *busp; 1116 DBusError derror;
1117 Lisp_Object val;
1118 int refcount;
958 1119
959 /* Check parameter. */ 1120 /* Check parameter. */
960 if (SYMBOLP (bus)) 1121 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
961 busp = XSYMBOL (bus); 1122
962 else if (STRINGP (bus)) 1123 /* Close bus if it is already open. */
963 busp = XSTRING (bus); 1124 xd_close_bus (bus);
1125
1126 /* Initialize. */
1127 dbus_error_init (&derror);
1128
1129 /* Open the connection. */
1130 if (STRINGP (bus))
1131 if (NILP (private))
1132 connection = dbus_connection_open (SSDATA (bus), &derror);
1133 else
1134 connection = dbus_connection_open_private (SSDATA (bus), &derror);
1135
1136 else
1137 if (NILP (private))
1138 connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
1139 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1140 &derror);
1141 else
1142 connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
1143 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1144 &derror);
1145
1146 if (dbus_error_is_set (&derror))
1147 XD_ERROR (derror);
1148
1149 if (connection == NULL)
1150 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
1151
1152 /* If it is not the system or session bus, we must register
1153 ourselves. Otherwise, we have called dbus_bus_get, which has
1154 configured us to exit if the connection closes - we undo this
1155 setting. */
1156 if (STRINGP (bus))
1157 dbus_bus_register (connection, &derror);
964 else 1158 else
965 wrong_type_argument (intern ("D-Bus"), bus); 1159 dbus_connection_set_exit_on_disconnect (connection, FALSE);
966 1160
967 /* Open a connection to the bus. */ 1161 if (dbus_error_is_set (&derror))
968 connection = xd_initialize (bus, TRUE); 1162 XD_ERROR (derror);
969 1163
970 /* Add the watch functions. We pass also the bus as data, in order 1164 /* Add the watch functions. We pass also the bus as data, in order
971 to distinguish between the buses in xd_remove_watch. */ 1165 to distinguish between the buses in xd_remove_watch. */
@@ -973,36 +1167,27 @@ DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
973 xd_add_watch, 1167 xd_add_watch,
974 xd_remove_watch, 1168 xd_remove_watch,
975 xd_toggle_watch, 1169 xd_toggle_watch,
976 busp, NULL)) 1170 SYMBOLP (bus)
1171 ? (void *) XSYMBOL (bus)
1172 : (void *) XSTRING (bus),
1173 NULL))
977 XD_SIGNAL1 (build_string ("Cannot add watch functions")); 1174 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
978 1175
979 /* Add bus to list of registered buses. */ 1176 /* Add bus to list of registered buses. */
980 Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses); 1177 XSETFASTINT (val, (intptr_t) connection);
1178 xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
981 1179
982 /* We do not want to abort. */ 1180 /* We do not want to abort. */
983 putenv ((char *) "DBUS_FATAL_WARNINGS=0"); 1181 putenv ((char *) "DBUS_FATAL_WARNINGS=0");
984 1182
985 /* Return. */ 1183 /* Cleanup. */
986 return Qnil; 1184 dbus_error_free (&derror);
987}
988
989DEFUN ("dbus-close-bus", Fdbus_close_bus, Sdbus_close_bus, 1, 1, 0,
990 doc: /* Close connection to D-Bus BUS. */)
991 (Lisp_Object bus)
992{
993 DBusConnection *connection;
994
995 /* Open a connection to the bus. */
996 connection = xd_initialize (bus, TRUE);
997
998 /* Decrement reference count to the bus. */
999 dbus_connection_unref (connection);
1000
1001 /* Remove bus from list of registered buses. */
1002 Vdbus_registered_buses = Fdelete (bus, Vdbus_registered_buses);
1003 1185
1004 /* Return. */ 1186 /* Return reference counter. */
1005 return Qnil; 1187 refcount = xd_get_connection_references (connection);
1188 XD_DEBUG_MESSAGE ("Bus %s, Reference counter %d",
1189 XD_OBJECT_TO_STRING (bus), refcount);
1190 return make_number (refcount);
1006} 1191}
1007 1192
1008DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name, 1193DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
@@ -1013,8 +1198,11 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1013 DBusConnection *connection; 1198 DBusConnection *connection;
1014 const char *name; 1199 const char *name;
1015 1200
1016 /* Open a connection to the bus. */ 1201 /* Check parameter. */
1017 connection = xd_initialize (bus, TRUE); 1202 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1203
1204 /* Retrieve bus address. */
1205 connection = xd_get_connection_address (bus);
1018 1206
1019 /* Request the name. */ 1207 /* Request the name. */
1020 name = dbus_bus_get_unique_name (connection); 1208 name = dbus_bus_get_unique_name (connection);
@@ -1025,341 +1213,243 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1025 return build_string (name); 1213 return build_string (name);
1026} 1214}
1027 1215
1028DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0, 1216DEFUN ("dbus-message-internal", Fdbus_message_internal, Sdbus_message_internal,
1029 doc: /* Call METHOD on the D-Bus BUS. 1217 4, MANY, 0,
1030 1218 doc: /* Send a D-Bus message.
1031BUS is either a Lisp symbol, `:system' or `:session', or a string 1219This is an internal function, it shall not be used outside dbus.el.
1032denoting the bus address. 1220
1033 1221The following usages are expected:
1034SERVICE is the D-Bus service name to be used. PATH is the D-Bus 1222
1035object path SERVICE is registered at. INTERFACE is an interface 1223`dbus-call-method', `dbus-call-method-asynchronously':
1036offered by SERVICE. It must provide METHOD. 1224 \(dbus-message-internal
1037 1225 dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1038If the parameter `:timeout' is given, the following integer TIMEOUT 1226 &optional :timeout TIMEOUT &rest ARGS)
1039specifies the maximum number of milliseconds the method call must 1227
1040return. The default value is 25,000. If the method call doesn't 1228`dbus-send-signal':
1041return in time, a D-Bus error is raised. 1229 \(dbus-message-internal
1042 1230 dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1043All other arguments ARGS are passed to METHOD as arguments. They are 1231
1044converted into D-Bus types via the following rules: 1232`dbus-method-return-internal':
1045 1233 \(dbus-message-internal
1046 t and nil => DBUS_TYPE_BOOLEAN 1234 dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1047 number => DBUS_TYPE_UINT32 1235
1048 integer => DBUS_TYPE_INT32 1236`dbus-method-error-internal':
1049 float => DBUS_TYPE_DOUBLE 1237 \(dbus-message-internal
1050 string => DBUS_TYPE_STRING 1238 dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1051 list => DBUS_TYPE_ARRAY 1239
1052 1240usage: (dbus-message-internal &rest REST) */)
1053All arguments can be preceded by a type symbol. For details about
1054type symbols, see Info node `(dbus)Type Conversion'.
1055
1056`dbus-call-method' returns the resulting values of METHOD as a list of
1057Lisp objects. The type conversion happens the other direction as for
1058input arguments. It follows the mapping rules:
1059
1060 DBUS_TYPE_BOOLEAN => t or nil
1061 DBUS_TYPE_BYTE => number
1062 DBUS_TYPE_UINT16 => number
1063 DBUS_TYPE_INT16 => integer
1064 DBUS_TYPE_UINT32 => number or float
1065 DBUS_TYPE_UNIX_FD => number or float
1066 DBUS_TYPE_INT32 => integer or float
1067 DBUS_TYPE_UINT64 => number or float
1068 DBUS_TYPE_INT64 => integer or float
1069 DBUS_TYPE_DOUBLE => float
1070 DBUS_TYPE_STRING => string
1071 DBUS_TYPE_OBJECT_PATH => string
1072 DBUS_TYPE_SIGNATURE => string
1073 DBUS_TYPE_ARRAY => list
1074 DBUS_TYPE_VARIANT => list
1075 DBUS_TYPE_STRUCT => list
1076 DBUS_TYPE_DICT_ENTRY => list
1077
1078Example:
1079
1080\(dbus-call-method
1081 :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
1082 "org.gnome.seahorse.Keys" "GetKeyField"
1083 "openpgp:657984B8C7A966DD" "simple-name")
1084
1085 => (t ("Philip R. Zimmermann"))
1086
1087If the result of the METHOD call is just one value, the converted Lisp
1088object is returned instead of a list containing this single Lisp object.
1089
1090\(dbus-call-method
1091 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1092 "org.freedesktop.Hal.Device" "GetPropertyString"
1093 "system.kernel.machine")
1094
1095 => "i686"
1096
1097usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
1098 (ptrdiff_t nargs, Lisp_Object *args) 1241 (ptrdiff_t nargs, Lisp_Object *args)
1099{ 1242{
1100 Lisp_Object bus, service, path, interface, method; 1243 Lisp_Object message_type, bus, service, handler;
1244 Lisp_Object path = Qnil;
1245 Lisp_Object interface = Qnil;
1246 Lisp_Object member = Qnil;
1101 Lisp_Object result; 1247 Lisp_Object result;
1102 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 1248 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1103 DBusConnection *connection; 1249 DBusConnection *connection;
1104 DBusMessage *dmessage; 1250 DBusMessage *dmessage;
1105 DBusMessage *reply;
1106 DBusMessageIter iter; 1251 DBusMessageIter iter;
1107 DBusError derror;
1108 unsigned int dtype; 1252 unsigned int dtype;
1253 unsigned int mtype;
1254 dbus_uint32_t serial = 0;
1255 unsigned int ui_serial;
1109 int timeout = -1; 1256 int timeout = -1;
1110 ptrdiff_t i = 5; 1257 ptrdiff_t count;
1111 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; 1258 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1112 1259
1260 /* Initialize parameters. */
1261 message_type = args[0];
1262 bus = args[1];
1263 service = args[2];
1264 handler = Qnil;
1265
1266 CHECK_NATNUM (message_type);
1267 mtype = XFASTINT (message_type);
1268 if ((mtype <= DBUS_MESSAGE_TYPE_INVALID) || (mtype >= DBUS_NUM_MESSAGE_TYPES))
1269 XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
1270
1271 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1272 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1273 {
1274 path = args[3];
1275 interface = args[4];
1276 member = args[5];
1277 if (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1278 handler = args[6];
1279 count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
1280 }
1281 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1282 {
1283 XD_CHECK_DBUS_SERIAL (args[3], serial);
1284 count = 4;
1285 }
1286
1113 /* Check parameters. */ 1287 /* Check parameters. */
1114 bus = args[0]; 1288 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1115 service = args[1]; 1289 XD_DBUS_VALIDATE_BUS_NAME (service);
1116 path = args[2]; 1290 if (nargs < count)
1117 interface = args[3]; 1291 xsignal2 (Qwrong_number_of_arguments,
1118 method = args[4]; 1292 Qdbus_message_internal,
1119 1293 make_number (nargs));
1120 CHECK_STRING (service); 1294
1121 CHECK_STRING (path); 1295 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1122 CHECK_STRING (interface); 1296 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1123 CHECK_STRING (method); 1297 {
1124 GCPRO5 (bus, service, path, interface, method); 1298 XD_DBUS_VALIDATE_PATH (path);
1125 1299 XD_DBUS_VALIDATE_INTERFACE (interface);
1126 XD_DEBUG_MESSAGE ("%s %s %s %s", 1300 XD_DBUS_VALIDATE_MEMBER (member);
1127 SDATA (service), 1301 if (!NILP (handler) && (!FUNCTIONP (handler)))
1128 SDATA (path), 1302 wrong_type_argument (Qinvalid_function, handler);
1129 SDATA (interface), 1303 }
1130 SDATA (method));
1131
1132 /* Open a connection to the bus. */
1133 connection = xd_initialize (bus, TRUE);
1134
1135 /* Create the message. */
1136 dmessage = dbus_message_new_method_call (SSDATA (service),
1137 SSDATA (path),
1138 SSDATA (interface),
1139 SSDATA (method));
1140 UNGCPRO;
1141 if (dmessage == NULL)
1142 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1143 1304
1144 /* Check for timeout parameter. */ 1305 /* Protect Lisp variables. */
1145 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout))) 1306 GCPRO6 (bus, service, path, interface, member, handler);
1307
1308 /* Trace parameters. */
1309 switch (mtype)
1146 { 1310 {
1147 CHECK_NATNUM (args[i+1]); 1311 case DBUS_MESSAGE_TYPE_METHOD_CALL:
1148 timeout = min (XFASTINT (args[i+1]), INT_MAX); 1312 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1149 i = i+2; 1313 XD_MESSAGE_TYPE_TO_STRING (mtype),
1314 XD_OBJECT_TO_STRING (bus),
1315 XD_OBJECT_TO_STRING (service),
1316 XD_OBJECT_TO_STRING (path),
1317 XD_OBJECT_TO_STRING (interface),
1318 XD_OBJECT_TO_STRING (member),
1319 XD_OBJECT_TO_STRING (handler));
1320 break;
1321 case DBUS_MESSAGE_TYPE_SIGNAL:
1322 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1323 XD_MESSAGE_TYPE_TO_STRING (mtype),
1324 XD_OBJECT_TO_STRING (bus),
1325 XD_OBJECT_TO_STRING (service),
1326 XD_OBJECT_TO_STRING (path),
1327 XD_OBJECT_TO_STRING (interface),
1328 XD_OBJECT_TO_STRING (member));
1329 break;
1330 default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1331 ui_serial = serial;
1332 XD_DEBUG_MESSAGE ("%s %s %s %u",
1333 XD_MESSAGE_TYPE_TO_STRING (mtype),
1334 XD_OBJECT_TO_STRING (bus),
1335 XD_OBJECT_TO_STRING (service),
1336 ui_serial);
1150 } 1337 }
1151 1338
1152 /* Initialize parameter list of message. */ 1339 /* Retrieve bus address. */
1153 dbus_message_iter_init_append (dmessage, &iter); 1340 connection = xd_get_connection_address (bus);
1154 1341
1155 /* Append parameters to the message. */ 1342 /* Create the D-Bus message. */
1156 for (; i < nargs; ++i) 1343 dmessage = dbus_message_new (mtype);
1344 if (dmessage == NULL)
1157 { 1345 {
1158 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); 1346 UNGCPRO;
1159 if (XD_DBUS_TYPE_P (args[i])) 1347 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1348 }
1349
1350 if (STRINGP (service))
1351 {
1352 if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
1353 /* Set destination. */
1160 { 1354 {
1161 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1355 if (!dbus_message_set_destination (dmessage, SSDATA (service)))
1162 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]); 1356 {
1163 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4, 1357 UNGCPRO;
1164 SDATA (format2 ("%s", args[i], Qnil)), 1358 XD_SIGNAL2 (build_string ("Unable to set the destination"),
1165 SDATA (format2 ("%s", args[i+1], Qnil))); 1359 service);
1166 ++i; 1360 }
1167 } 1361 }
1362
1168 else 1363 else
1364 /* Set destination for unicast signals. */
1169 { 1365 {
1170 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1366 Lisp_Object uname;
1171 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
1172 SDATA (format2 ("%s", args[i], Qnil)));
1173 }
1174 1367
1175 /* Check for valid signature. We use DBUS_TYPE_INVALID as 1368 /* If it is the same unique name as we are registered at the
1176 indication that there is no parent type. */ 1369 bus or an unknown name, we regard it as broadcast message
1177 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]); 1370 due to backward compatibility. */
1371 if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
1372 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1373 else
1374 uname = Qnil;
1178 1375
1179 xd_append_arg (dtype, args[i], &iter); 1376 if (STRINGP (uname)
1377 && (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
1378 != 0)
1379 && (!dbus_message_set_destination (dmessage, SSDATA (service))))
1380 {
1381 UNGCPRO;
1382 XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1383 service);
1384 }
1385 }
1180 } 1386 }
1181 1387
1182 /* Send the message. */ 1388 /* Set message parameters. */
1183 dbus_error_init (&derror); 1389 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1184 reply = dbus_connection_send_with_reply_and_block (connection, 1390 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1185 dmessage,
1186 timeout,
1187 &derror);
1188
1189 if (dbus_error_is_set (&derror))
1190 XD_ERROR (derror);
1191
1192 if (reply == NULL)
1193 XD_SIGNAL1 (build_string ("No reply"));
1194
1195 XD_DEBUG_MESSAGE ("Message sent");
1196
1197 /* Collect the results. */
1198 result = Qnil;
1199 GCPRO1 (result);
1200
1201 if (dbus_message_iter_init (reply, &iter))
1202 { 1391 {
1203 /* Loop over the parameters of the D-Bus reply message. Construct a 1392 if ((!dbus_message_set_path (dmessage, SSDATA (path)))
1204 Lisp list, which is returned by `dbus-call-method'. */ 1393 || (!dbus_message_set_interface (dmessage, SSDATA (interface)))
1205 while ((dtype = dbus_message_iter_get_arg_type (&iter)) 1394 || (!dbus_message_set_member (dmessage, SSDATA (member))))
1206 != DBUS_TYPE_INVALID)
1207 { 1395 {
1208 result = Fcons (xd_retrieve_arg (dtype, &iter), result); 1396 UNGCPRO;
1209 dbus_message_iter_next (&iter); 1397 XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1210 } 1398 }
1211 } 1399 }
1212 else
1213 {
1214 /* No arguments: just return nil. */
1215 }
1216
1217 /* Cleanup. */
1218 dbus_error_free (&derror);
1219 dbus_message_unref (dmessage);
1220 dbus_message_unref (reply);
1221
1222 /* Return the result. If there is only one single Lisp object,
1223 return it as-it-is, otherwise return the reversed list. */
1224 if (XFASTINT (Flength (result)) == 1)
1225 RETURN_UNGCPRO (CAR_SAFE (result));
1226 else
1227 RETURN_UNGCPRO (Fnreverse (result));
1228}
1229
1230DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
1231 Sdbus_call_method_asynchronously, 6, MANY, 0,
1232 doc: /* Call METHOD on the D-Bus BUS asynchronously.
1233
1234BUS is either a Lisp symbol, `:system' or `:session', or a string
1235denoting the bus address.
1236
1237SERVICE is the D-Bus service name to be used. PATH is the D-Bus
1238object path SERVICE is registered at. INTERFACE is an interface
1239offered by SERVICE. It must provide METHOD.
1240
1241HANDLER is a Lisp function, which is called when the corresponding
1242return message has arrived. If HANDLER is nil, no return message will
1243be expected.
1244
1245If the parameter `:timeout' is given, the following integer TIMEOUT
1246specifies the maximum number of milliseconds the method call must
1247return. The default value is 25,000. If the method call doesn't
1248return in time, a D-Bus error is raised.
1249
1250All other arguments ARGS are passed to METHOD as arguments. They are
1251converted into D-Bus types via the following rules:
1252
1253 t and nil => DBUS_TYPE_BOOLEAN
1254 number => DBUS_TYPE_UINT32
1255 integer => DBUS_TYPE_INT32
1256 float => DBUS_TYPE_DOUBLE
1257 string => DBUS_TYPE_STRING
1258 list => DBUS_TYPE_ARRAY
1259
1260All arguments can be preceded by a type symbol. For details about
1261type symbols, see Info node `(dbus)Type Conversion'.
1262 1400
1263Unless HANDLER is nil, the function returns a key into the hash table 1401 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1264`dbus-registered-objects-table'. The corresponding entry in the hash 1402 {
1265table is removed, when the return message has been arrived, and 1403 if (!dbus_message_set_reply_serial (dmessage, serial))
1266HANDLER is called. 1404 {
1267 1405 UNGCPRO;
1268Example: 1406 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1269 1407 }
1270\(dbus-call-method-asynchronously
1271 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1272 "org.freedesktop.Hal.Device" "GetPropertyString" 'message
1273 "system.kernel.machine")
1274
1275 => (:system 2)
1276
1277 -| i686
1278
1279usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
1280 (ptrdiff_t nargs, Lisp_Object *args)
1281{
1282 Lisp_Object bus, service, path, interface, method, handler;
1283 Lisp_Object result;
1284 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1285 DBusConnection *connection;
1286 DBusMessage *dmessage;
1287 DBusMessageIter iter;
1288 unsigned int dtype;
1289 dbus_uint32_t serial;
1290 int timeout = -1;
1291 ptrdiff_t i = 6;
1292 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1293 1408
1294 /* Check parameters. */ 1409 if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
1295 bus = args[0]; 1410 && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
1296 service = args[1]; 1411 {
1297 path = args[2]; 1412 UNGCPRO;
1298 interface = args[3]; 1413 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1299 method = args[4]; 1414 }
1300 handler = args[5]; 1415 }
1301
1302 CHECK_STRING (service);
1303 CHECK_STRING (path);
1304 CHECK_STRING (interface);
1305 CHECK_STRING (method);
1306 if (!NILP (handler) && !FUNCTIONP (handler))
1307 wrong_type_argument (Qinvalid_function, handler);
1308 GCPRO6 (bus, service, path, interface, method, handler);
1309
1310 XD_DEBUG_MESSAGE ("%s %s %s %s",
1311 SDATA (service),
1312 SDATA (path),
1313 SDATA (interface),
1314 SDATA (method));
1315
1316 /* Open a connection to the bus. */
1317 connection = xd_initialize (bus, TRUE);
1318
1319 /* Create the message. */
1320 dmessage = dbus_message_new_method_call (SSDATA (service),
1321 SSDATA (path),
1322 SSDATA (interface),
1323 SSDATA (method));
1324 if (dmessage == NULL)
1325 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1326 1416
1327 /* Check for timeout parameter. */ 1417 /* Check for timeout parameter. */
1328 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout))) 1418 if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
1329 { 1419 {
1330 CHECK_NATNUM (args[i+1]); 1420 CHECK_NATNUM (args[count+1]);
1331 timeout = min (XFASTINT (args[i+1]), INT_MAX); 1421 timeout = min (XFASTINT (args[count+1]), INT_MAX);
1332 i = i+2; 1422 count = count+2;
1333 } 1423 }
1334 1424
1335 /* Initialize parameter list of message. */ 1425 /* Initialize parameter list of message. */
1336 dbus_message_iter_init_append (dmessage, &iter); 1426 dbus_message_iter_init_append (dmessage, &iter);
1337 1427
1338 /* Append parameters to the message. */ 1428 /* Append parameters to the message. */
1339 for (; i < nargs; ++i) 1429 for (; count < nargs; ++count)
1340 { 1430 {
1341 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); 1431 dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
1342 if (XD_DBUS_TYPE_P (args[i])) 1432 if (XD_DBUS_TYPE_P (args[count]))
1343 { 1433 {
1344 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1434 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1345 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]); 1435 XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
1346 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4, 1436 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
1347 SDATA (format2 ("%s", args[i], Qnil)), 1437 XD_OBJECT_TO_STRING (args[count]),
1348 SDATA (format2 ("%s", args[i+1], Qnil))); 1438 XD_OBJECT_TO_STRING (args[count+1]));
1349 ++i; 1439 ++count;
1350 } 1440 }
1351 else 1441 else
1352 { 1442 {
1353 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1443 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1354 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4, 1444 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
1355 SDATA (format2 ("%s", args[i], Qnil))); 1445 XD_OBJECT_TO_STRING (args[count]));
1356 } 1446 }
1357 1447
1358 /* Check for valid signature. We use DBUS_TYPE_INVALID as 1448 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1359 indication that there is no parent type. */ 1449 indication that there is no parent type. */
1360 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]); 1450 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[count]);
1361 1451
1362 xd_append_arg (dtype, args[i], &iter); 1452 xd_append_arg (dtype, args[count], &iter);
1363 } 1453 }
1364 1454
1365 if (!NILP (handler)) 1455 if (!NILP (handler))
@@ -1368,11 +1458,15 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
1368 message queue. */ 1458 message queue. */
1369 if (!dbus_connection_send_with_reply (connection, dmessage, 1459 if (!dbus_connection_send_with_reply (connection, dmessage,
1370 NULL, timeout)) 1460 NULL, timeout))
1371 XD_SIGNAL1 (build_string ("Cannot send message")); 1461 {
1462 UNGCPRO;
1463 XD_SIGNAL1 (build_string ("Cannot send message"));
1464 }
1372 1465
1373 /* The result is the key in Vdbus_registered_objects_table. */ 1466 /* The result is the key in Vdbus_registered_objects_table. */
1374 serial = dbus_message_get_serial (dmessage); 1467 serial = dbus_message_get_serial (dmessage);
1375 result = list2 (bus, make_fixnum_or_float (serial)); 1468 result = list3 (QCdbus_registered_serial,
1469 bus, make_fixnum_or_float (serial));
1376 1470
1377 /* Create a hash table entry. */ 1471 /* Create a hash table entry. */
1378 Fputhash (result, handler, Vdbus_registered_objects_table); 1472 Fputhash (result, handler, Vdbus_registered_objects_table);
@@ -1382,12 +1476,15 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
1382 /* Send the message. The message is just added to the outgoing 1476 /* Send the message. The message is just added to the outgoing
1383 message queue. */ 1477 message queue. */
1384 if (!dbus_connection_send (connection, dmessage, NULL)) 1478 if (!dbus_connection_send (connection, dmessage, NULL))
1385 XD_SIGNAL1 (build_string ("Cannot send message")); 1479 {
1480 UNGCPRO;
1481 XD_SIGNAL1 (build_string ("Cannot send message"));
1482 }
1386 1483
1387 result = Qnil; 1484 result = Qnil;
1388 } 1485 }
1389 1486
1390 XD_DEBUG_MESSAGE ("Message sent"); 1487 XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
1391 1488
1392 /* Cleanup. */ 1489 /* Cleanup. */
1393 dbus_message_unref (dmessage); 1490 dbus_message_unref (dmessage);
@@ -1396,300 +1493,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
1396 RETURN_UNGCPRO (result); 1493 RETURN_UNGCPRO (result);
1397} 1494}
1398 1495
1399DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
1400 Sdbus_method_return_internal,
1401 3, MANY, 0,
1402 doc: /* Return for message SERIAL on the D-Bus BUS.
1403This is an internal function, it shall not be used outside dbus.el.
1404
1405usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
1406 (ptrdiff_t nargs, Lisp_Object *args)
1407{
1408 Lisp_Object bus, service;
1409 struct gcpro gcpro1, gcpro2;
1410 DBusConnection *connection;
1411 DBusMessage *dmessage;
1412 DBusMessageIter iter;
1413 dbus_uint32_t serial;
1414 unsigned int ui_serial, dtype;
1415 ptrdiff_t i;
1416 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1417
1418 /* Check parameters. */
1419 bus = args[0];
1420 service = args[2];
1421
1422 CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
1423 CHECK_STRING (service);
1424 GCPRO2 (bus, service);
1425
1426 ui_serial = serial;
1427 XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
1428
1429 /* Open a connection to the bus. */
1430 connection = xd_initialize (bus, TRUE);
1431
1432 /* Create the message. */
1433 dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1434 if ((dmessage == NULL)
1435 || (!dbus_message_set_reply_serial (dmessage, serial))
1436 || (!dbus_message_set_destination (dmessage, SSDATA (service))))
1437 {
1438 UNGCPRO;
1439 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1440 }
1441
1442 UNGCPRO;
1443
1444 /* Initialize parameter list of message. */
1445 dbus_message_iter_init_append (dmessage, &iter);
1446
1447 /* Append parameters to the message. */
1448 for (i = 3; i < nargs; ++i)
1449 {
1450 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1451 if (XD_DBUS_TYPE_P (args[i]))
1452 {
1453 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1454 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1455 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
1456 SDATA (format2 ("%s", args[i], Qnil)),
1457 SDATA (format2 ("%s", args[i+1], Qnil)));
1458 ++i;
1459 }
1460 else
1461 {
1462 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1463 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
1464 SDATA (format2 ("%s", args[i], Qnil)));
1465 }
1466
1467 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1468 indication that there is no parent type. */
1469 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1470
1471 xd_append_arg (dtype, args[i], &iter);
1472 }
1473
1474 /* Send the message. The message is just added to the outgoing
1475 message queue. */
1476 if (!dbus_connection_send (connection, dmessage, NULL))
1477 XD_SIGNAL1 (build_string ("Cannot send message"));
1478
1479 XD_DEBUG_MESSAGE ("Message sent");
1480
1481 /* Cleanup. */
1482 dbus_message_unref (dmessage);
1483
1484 /* Return. */
1485 return Qt;
1486}
1487
1488DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
1489 Sdbus_method_error_internal,
1490 3, MANY, 0,
1491 doc: /* Return error message for message SERIAL on the D-Bus BUS.
1492This is an internal function, it shall not be used outside dbus.el.
1493
1494usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
1495 (ptrdiff_t nargs, Lisp_Object *args)
1496{
1497 Lisp_Object bus, service;
1498 struct gcpro gcpro1, gcpro2;
1499 DBusConnection *connection;
1500 DBusMessage *dmessage;
1501 DBusMessageIter iter;
1502 dbus_uint32_t serial;
1503 unsigned int ui_serial, dtype;
1504 ptrdiff_t i;
1505 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1506
1507 /* Check parameters. */
1508 bus = args[0];
1509 service = args[2];
1510
1511 CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
1512 CHECK_STRING (service);
1513 GCPRO2 (bus, service);
1514
1515 ui_serial = serial;
1516 XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
1517
1518 /* Open a connection to the bus. */
1519 connection = xd_initialize (bus, TRUE);
1520
1521 /* Create the message. */
1522 dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
1523 if ((dmessage == NULL)
1524 || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
1525 || (!dbus_message_set_reply_serial (dmessage, serial))
1526 || (!dbus_message_set_destination (dmessage, SSDATA (service))))
1527 {
1528 UNGCPRO;
1529 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1530 }
1531
1532 UNGCPRO;
1533
1534 /* Initialize parameter list of message. */
1535 dbus_message_iter_init_append (dmessage, &iter);
1536
1537 /* Append parameters to the message. */
1538 for (i = 3; i < nargs; ++i)
1539 {
1540 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1541 if (XD_DBUS_TYPE_P (args[i]))
1542 {
1543 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1544 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1545 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
1546 SDATA (format2 ("%s", args[i], Qnil)),
1547 SDATA (format2 ("%s", args[i+1], Qnil)));
1548 ++i;
1549 }
1550 else
1551 {
1552 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1553 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
1554 SDATA (format2 ("%s", args[i], Qnil)));
1555 }
1556
1557 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1558 indication that there is no parent type. */
1559 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1560
1561 xd_append_arg (dtype, args[i], &iter);
1562 }
1563
1564 /* Send the message. The message is just added to the outgoing
1565 message queue. */
1566 if (!dbus_connection_send (connection, dmessage, NULL))
1567 XD_SIGNAL1 (build_string ("Cannot send message"));
1568
1569 XD_DEBUG_MESSAGE ("Message sent");
1570
1571 /* Cleanup. */
1572 dbus_message_unref (dmessage);
1573
1574 /* Return. */
1575 return Qt;
1576}
1577
1578DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
1579 doc: /* Send signal SIGNAL on the D-Bus BUS.
1580
1581BUS is either a Lisp symbol, `:system' or `:session', or a string
1582denoting the bus address.
1583
1584SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
1585D-Bus object path SERVICE is registered at. INTERFACE is an interface
1586offered by SERVICE. It must provide signal SIGNAL.
1587
1588All other arguments ARGS are passed to SIGNAL as arguments. They are
1589converted into D-Bus types via the following rules:
1590
1591 t and nil => DBUS_TYPE_BOOLEAN
1592 number => DBUS_TYPE_UINT32
1593 integer => DBUS_TYPE_INT32
1594 float => DBUS_TYPE_DOUBLE
1595 string => DBUS_TYPE_STRING
1596 list => DBUS_TYPE_ARRAY
1597
1598All arguments can be preceded by a type symbol. For details about
1599type symbols, see Info node `(dbus)Type Conversion'.
1600
1601Example:
1602
1603\(dbus-send-signal
1604 :session "org.gnu.Emacs" "/org/gnu/Emacs"
1605 "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1606
1607usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
1608 (ptrdiff_t nargs, Lisp_Object *args)
1609{
1610 Lisp_Object bus, service, path, interface, signal;
1611 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1612 DBusConnection *connection;
1613 DBusMessage *dmessage;
1614 DBusMessageIter iter;
1615 unsigned int dtype;
1616 ptrdiff_t i;
1617 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1618
1619 /* Check parameters. */
1620 bus = args[0];
1621 service = args[1];
1622 path = args[2];
1623 interface = args[3];
1624 signal = args[4];
1625
1626 CHECK_STRING (service);
1627 CHECK_STRING (path);
1628 CHECK_STRING (interface);
1629 CHECK_STRING (signal);
1630 GCPRO5 (bus, service, path, interface, signal);
1631
1632 XD_DEBUG_MESSAGE ("%s %s %s %s",
1633 SDATA (service),
1634 SDATA (path),
1635 SDATA (interface),
1636 SDATA (signal));
1637
1638 /* Open a connection to the bus. */
1639 connection = xd_initialize (bus, TRUE);
1640
1641 /* Create the message. */
1642 dmessage = dbus_message_new_signal (SSDATA (path),
1643 SSDATA (interface),
1644 SSDATA (signal));
1645 UNGCPRO;
1646 if (dmessage == NULL)
1647 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1648
1649 /* Initialize parameter list of message. */
1650 dbus_message_iter_init_append (dmessage, &iter);
1651
1652 /* Append parameters to the message. */
1653 for (i = 5; i < nargs; ++i)
1654 {
1655 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1656 if (XD_DBUS_TYPE_P (args[i]))
1657 {
1658 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1659 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1660 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
1661 SDATA (format2 ("%s", args[i], Qnil)),
1662 SDATA (format2 ("%s", args[i+1], Qnil)));
1663 ++i;
1664 }
1665 else
1666 {
1667 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1668 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
1669 SDATA (format2 ("%s", args[i], Qnil)));
1670 }
1671
1672 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1673 indication that there is no parent type. */
1674 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1675
1676 xd_append_arg (dtype, args[i], &iter);
1677 }
1678
1679 /* Send the message. The message is just added to the outgoing
1680 message queue. */
1681 if (!dbus_connection_send (connection, dmessage, NULL))
1682 XD_SIGNAL1 (build_string ("Cannot send message"));
1683
1684 XD_DEBUG_MESSAGE ("Signal sent");
1685
1686 /* Cleanup. */
1687 dbus_message_unref (dmessage);
1688
1689 /* Return. */
1690 return Qt;
1691}
1692
1693/* Read one queued incoming message of the D-Bus BUS. 1496/* Read one queued incoming message of the D-Bus BUS.
1694 BUS is either a Lisp symbol, :system or :session, or a string denoting 1497 BUS is either a Lisp symbol, :system or :session, or a string denoting
1695 the bus address. */ 1498 the bus address. */
@@ -1702,7 +1505,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1702 DBusMessage *dmessage; 1505 DBusMessage *dmessage;
1703 DBusMessageIter iter; 1506 DBusMessageIter iter;
1704 unsigned int dtype; 1507 unsigned int dtype;
1705 int mtype; 1508 unsigned int mtype;
1706 dbus_uint32_t serial; 1509 dbus_uint32_t serial;
1707 unsigned int ui_serial; 1510 unsigned int ui_serial;
1708 const char *uname, *path, *interface, *member; 1511 const char *uname, *path, *interface, *member;
@@ -1744,23 +1547,19 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1744 member = dbus_message_get_member (dmessage); 1547 member = dbus_message_get_member (dmessage);
1745 1548
1746 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s", 1549 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1747 (mtype == DBUS_MESSAGE_TYPE_INVALID) 1550 XD_MESSAGE_TYPE_TO_STRING (mtype),
1748 ? "DBUS_MESSAGE_TYPE_INVALID"
1749 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1750 ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1751 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1752 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1753 : (mtype == DBUS_MESSAGE_TYPE_ERROR)
1754 ? "DBUS_MESSAGE_TYPE_ERROR"
1755 : "DBUS_MESSAGE_TYPE_SIGNAL",
1756 ui_serial, uname, path, interface, member, 1551 ui_serial, uname, path, interface, member,
1757 SDATA (format2 ("%s", args, Qnil))); 1552 XD_OBJECT_TO_STRING (args));
1553
1554 if (mtype == DBUS_MESSAGE_TYPE_INVALID)
1555 goto cleanup;
1758 1556
1759 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) 1557 else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1760 || (mtype == DBUS_MESSAGE_TYPE_ERROR)) 1558 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1761 { 1559 {
1762 /* Search for a registered function of the message. */ 1560 /* Search for a registered function of the message. */
1763 key = list2 (bus, make_fixnum_or_float (serial)); 1561 key = list3 (QCdbus_registered_serial, bus,
1562 make_fixnum_or_float (serial));
1764 value = Fgethash (key, Vdbus_registered_objects_table, Qnil); 1563 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1765 1564
1766 /* There shall be exactly one entry. Construct an event. */ 1565 /* There shall be exactly one entry. Construct an event. */
@@ -1777,7 +1576,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1777 event.arg = Fcons (value, args); 1576 event.arg = Fcons (value, args);
1778 } 1577 }
1779 1578
1780 else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */ 1579 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
1781 { 1580 {
1782 /* Vdbus_registered_objects_table requires non-nil interface and 1581 /* Vdbus_registered_objects_table requires non-nil interface and
1783 member. */ 1582 member. */
@@ -1785,7 +1584,10 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1785 goto cleanup; 1584 goto cleanup;
1786 1585
1787 /* Search for a registered function of the message. */ 1586 /* Search for a registered function of the message. */
1788 key = list3 (bus, build_string (interface), build_string (member)); 1587 key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1588 ? QCdbus_registered_method
1589 : QCdbus_registered_signal,
1590 bus, build_string (interface), build_string (member));
1789 value = Fgethash (key, Vdbus_registered_objects_table, Qnil); 1591 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1790 1592
1791 /* Loop over the registered functions. Construct an event. */ 1593 /* Loop over the registered functions. Construct an event. */
@@ -1835,8 +1637,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1835 /* Store it into the input event queue. */ 1637 /* Store it into the input event queue. */
1836 kbd_buffer_store_event (&event); 1638 kbd_buffer_store_event (&event);
1837 1639
1838 XD_DEBUG_MESSAGE ("Event stored: %s", 1640 XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
1839 SDATA (format2 ("%s", event.arg, Qnil)));
1840 1641
1841 /* Cleanup. */ 1642 /* Cleanup. */
1842 cleanup: 1643 cleanup:
@@ -1851,8 +1652,8 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1851static Lisp_Object 1652static Lisp_Object
1852xd_read_message (Lisp_Object bus) 1653xd_read_message (Lisp_Object bus)
1853{ 1654{
1854 /* Open a connection to the bus. */ 1655 /* Retrieve bus address. */
1855 DBusConnection *connection = xd_initialize (bus, TRUE); 1656 DBusConnection *connection = xd_get_connection_address (bus);
1856 1657
1857 /* Non blocking read of the next available message. */ 1658 /* Non blocking read of the next available message. */
1858 dbus_connection_read_write (connection, 0); 1659 dbus_connection_read_write (connection, 0);
@@ -1867,16 +1668,18 @@ xd_read_message (Lisp_Object bus)
1867static void 1668static void
1868xd_read_queued_messages (int fd, void *data, int for_read) 1669xd_read_queued_messages (int fd, void *data, int for_read)
1869{ 1670{
1870 Lisp_Object busp = Vdbus_registered_buses; 1671 Lisp_Object busp = xd_registered_buses;
1871 Lisp_Object bus = Qnil; 1672 Lisp_Object bus = Qnil;
1673 Lisp_Object key;
1872 1674
1873 /* Find bus related to fd. */ 1675 /* Find bus related to fd. */
1874 if (data != NULL) 1676 if (data != NULL)
1875 while (!NILP (busp)) 1677 while (!NILP (busp))
1876 { 1678 {
1877 if ((SYMBOLP (CAR_SAFE (busp)) && XSYMBOL (CAR_SAFE (busp)) == data) 1679 key = CAR_SAFE (CAR_SAFE (busp));
1878 || (STRINGP (CAR_SAFE (busp)) && XSTRING (CAR_SAFE (busp)) == data)) 1680 if ((SYMBOLP (key) && XSYMBOL (key) == data)
1879 bus = CAR_SAFE (busp); 1681 || (STRINGP (key) && XSTRING (key) == data))
1682 bus = key;
1880 busp = CDR_SAFE (busp); 1683 busp = CDR_SAFE (busp);
1881 } 1684 }
1882 1685
@@ -1889,327 +1692,6 @@ xd_read_queued_messages (int fd, void *data, int for_read)
1889 xd_in_read_queued_messages = 0; 1692 xd_in_read_queued_messages = 0;
1890} 1693}
1891 1694
1892DEFUN ("dbus-register-service", Fdbus_register_service, Sdbus_register_service,
1893 2, MANY, 0,
1894 doc: /* Register known name SERVICE on the D-Bus BUS.
1895
1896BUS is either a Lisp symbol, `:system' or `:session', or a string
1897denoting the bus address.
1898
1899SERVICE is the D-Bus service name that should be registered. It must
1900be a known name.
1901
1902FLAGS are keywords, which control how the service name is registered.
1903The following keywords are recognized:
1904
1905`:allow-replacement': Allow another service to become the primary
1906owner if requested.
1907
1908`:replace-existing': Request to replace the current primary owner.
1909
1910`:do-not-queue': If we can not become the primary owner do not place
1911us in the queue.
1912
1913The function returns a keyword, indicating the result of the
1914operation. One of the following keywords is returned:
1915
1916`:primary-owner': Service has become the primary owner of the
1917requested name.
1918
1919`:in-queue': Service could not become the primary owner and has been
1920placed in the queue.
1921
1922`:exists': Service is already in the queue.
1923
1924`:already-owner': Service is already the primary owner.
1925
1926Example:
1927
1928\(dbus-register-service :session dbus-service-emacs)
1929
1930 => :primary-owner.
1931
1932\(dbus-register-service
1933 :session "org.freedesktop.TextEditor"
1934 dbus-service-allow-replacement dbus-service-replace-existing)
1935
1936 => :already-owner.
1937
1938usage: (dbus-register-service BUS SERVICE &rest FLAGS) */)
1939 (ptrdiff_t nargs, Lisp_Object *args)
1940{
1941 Lisp_Object bus, service;
1942 DBusConnection *connection;
1943 ptrdiff_t i;
1944 unsigned int value;
1945 unsigned int flags = 0;
1946 int result;
1947 DBusError derror;
1948
1949 bus = args[0];
1950 service = args[1];
1951
1952 /* Check parameters. */
1953 CHECK_STRING (service);
1954
1955 /* Process flags. */
1956 for (i = 2; i < nargs; ++i) {
1957 value = ((EQ (args[i], QCdbus_request_name_replace_existing))
1958 ? DBUS_NAME_FLAG_REPLACE_EXISTING
1959 : (EQ (args[i], QCdbus_request_name_allow_replacement))
1960 ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
1961 : (EQ (args[i], QCdbus_request_name_do_not_queue))
1962 ? DBUS_NAME_FLAG_DO_NOT_QUEUE
1963 : -1);
1964 if (value == -1)
1965 XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args[i]);
1966 flags |= value;
1967 }
1968
1969 /* Open a connection to the bus. */
1970 connection = xd_initialize (bus, TRUE);
1971
1972 /* Request the known name from the bus. */
1973 dbus_error_init (&derror);
1974 result = dbus_bus_request_name (connection, SSDATA (service), flags,
1975 &derror);
1976 if (dbus_error_is_set (&derror))
1977 XD_ERROR (derror);
1978
1979 /* Cleanup. */
1980 dbus_error_free (&derror);
1981
1982 /* Return object. */
1983 switch (result)
1984 {
1985 case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER:
1986 return QCdbus_request_name_reply_primary_owner;
1987 case DBUS_REQUEST_NAME_REPLY_IN_QUEUE:
1988 return QCdbus_request_name_reply_in_queue;
1989 case DBUS_REQUEST_NAME_REPLY_EXISTS:
1990 return QCdbus_request_name_reply_exists;
1991 case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER:
1992 return QCdbus_request_name_reply_already_owner;
1993 default:
1994 /* This should not happen. */
1995 XD_SIGNAL2 (build_string ("Could not register service"), service);
1996 }
1997}
1998
1999DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
2000 6, MANY, 0,
2001 doc: /* Register for signal SIGNAL on the D-Bus BUS.
2002
2003BUS is either a Lisp symbol, `:system' or `:session', or a string
2004denoting the bus address.
2005
2006SERVICE is the D-Bus service name used by the sending D-Bus object.
2007It can be either a known name or the unique name of the D-Bus object
2008sending the signal. When SERVICE is nil, related signals from all
2009D-Bus objects shall be accepted.
2010
2011PATH is the D-Bus object path SERVICE is registered. It can also be
2012nil if the path name of incoming signals shall not be checked.
2013
2014INTERFACE is an interface offered by SERVICE. It must provide SIGNAL.
2015HANDLER is a Lisp function to be called when the signal is received.
2016It must accept as arguments the values SIGNAL is sending.
2017
2018All other arguments ARGS, if specified, must be strings. They stand
2019for the respective arguments of the signal in their order, and are
2020used for filtering as well. A nil argument might be used to preserve
2021the order.
2022
2023INTERFACE, SIGNAL and HANDLER must not be nil. Example:
2024
2025\(defun my-signal-handler (device)
2026 (message "Device %s added" device))
2027
2028\(dbus-register-signal
2029 :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
2030 "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
2031
2032 => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
2033 ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
2034
2035`dbus-register-signal' returns an object, which can be used in
2036`dbus-unregister-object' for removing the registration.
2037
2038usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
2039 (ptrdiff_t nargs, Lisp_Object *args)
2040{
2041 Lisp_Object bus, service, path, interface, signal, handler;
2042 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
2043 Lisp_Object uname, key, key1, value;
2044 DBusConnection *connection;
2045 ptrdiff_t i;
2046 char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
2047 int rulelen;
2048 DBusError derror;
2049
2050 /* Check parameters. */
2051 bus = args[0];
2052 service = args[1];
2053 path = args[2];
2054 interface = args[3];
2055 signal = args[4];
2056 handler = args[5];
2057
2058 if (!NILP (service)) CHECK_STRING (service);
2059 if (!NILP (path)) CHECK_STRING (path);
2060 CHECK_STRING (interface);
2061 CHECK_STRING (signal);
2062 if (!FUNCTIONP (handler))
2063 wrong_type_argument (Qinvalid_function, handler);
2064 GCPRO6 (bus, service, path, interface, signal, handler);
2065
2066 /* Retrieve unique name of service. If service is a known name, we
2067 will register for the corresponding unique name, if any. Signals
2068 are sent always with the unique name as sender. Note: the unique
2069 name of "org.freedesktop.DBus" is that string itself. */
2070 if ((STRINGP (service))
2071 && (SBYTES (service) > 0)
2072 && (strcmp (SSDATA (service), DBUS_SERVICE_DBUS) != 0)
2073 && (strncmp (SSDATA (service), ":", 1) != 0))
2074 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
2075 else
2076 uname = service;
2077
2078 /* Create a matching rule if the unique name exists (when no
2079 wildcard). */
2080 if (NILP (uname) || (SBYTES (uname) > 0))
2081 {
2082 /* Open a connection to the bus. */
2083 connection = xd_initialize (bus, TRUE);
2084
2085 /* Create a rule to receive related signals. */
2086 rulelen = snprintf (rule, sizeof rule,
2087 "type='signal',interface='%s',member='%s'",
2088 SDATA (interface),
2089 SDATA (signal));
2090 if (! (0 <= rulelen && rulelen < sizeof rule))
2091 string_overflow ();
2092
2093 /* Add unique name and path to the rule if they are non-nil. */
2094 if (!NILP (uname))
2095 {
2096 int len = snprintf (rule + rulelen, sizeof rule - rulelen,
2097 ",sender='%s'", SDATA (uname));
2098 if (! (0 <= len && len < sizeof rule - rulelen))
2099 string_overflow ();
2100 rulelen += len;
2101 }
2102
2103 if (!NILP (path))
2104 {
2105 int len = snprintf (rule + rulelen, sizeof rule - rulelen,
2106 ",path='%s'", SDATA (path));
2107 if (! (0 <= len && len < sizeof rule - rulelen))
2108 string_overflow ();
2109 rulelen += len;
2110 }
2111
2112 /* Add arguments to the rule if they are non-nil. */
2113 for (i = 6; i < nargs; ++i)
2114 if (!NILP (args[i]))
2115 {
2116 int len;
2117 CHECK_STRING (args[i]);
2118 len = snprintf (rule + rulelen, sizeof rule - rulelen,
2119 ",arg%"pD"d='%s'", i - 6, SDATA (args[i]));
2120 if (! (0 <= len && len < sizeof rule - rulelen))
2121 string_overflow ();
2122 rulelen += len;
2123 }
2124
2125 /* Add the rule to the bus. */
2126 dbus_error_init (&derror);
2127 dbus_bus_add_match (connection, rule, &derror);
2128 if (dbus_error_is_set (&derror))
2129 {
2130 UNGCPRO;
2131 XD_ERROR (derror);
2132 }
2133
2134 /* Cleanup. */
2135 dbus_error_free (&derror);
2136
2137 XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
2138 }
2139
2140 /* Create a hash table entry. */
2141 key = list3 (bus, interface, signal);
2142 key1 = list5 (uname, service, path, handler, build_string (rule));
2143 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
2144
2145 if (NILP (Fmember (key1, value)))
2146 Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
2147
2148 /* Return object. */
2149 RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
2150}
2151
2152DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
2153 6, 7, 0,
2154 doc: /* Register for method METHOD on the D-Bus BUS.
2155
2156BUS is either a Lisp symbol, `:system' or `:session', or a string
2157denoting the bus address.
2158
2159SERVICE is the D-Bus service name of the D-Bus object METHOD is
2160registered for. It must be a known name (See discussion of
2161DONT-REGISTER-SERVICE below).
2162
2163PATH is the D-Bus object path SERVICE is registered (See discussion of
2164DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
2165SERVICE. It must provide METHOD.
2166
2167HANDLER is a Lisp function to be called when a method call is
2168received. It must accept the input arguments of METHOD. The return
2169value of HANDLER is used for composing the returning D-Bus message.
2170In case HANDLER shall return a reply message with an empty argument
2171list, HANDLER must return the symbol `:ignore'.
2172
2173When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
2174registered. This means that other D-Bus clients have no way of
2175noticing the newly registered method. When interfaces are constructed
2176incrementally by adding single methods or properties at a time,
2177DONT-REGISTER-SERVICE can be used to prevent other clients from
2178discovering the still incomplete interface.*/)
2179 (Lisp_Object bus, Lisp_Object service, Lisp_Object path,
2180 Lisp_Object interface, Lisp_Object method, Lisp_Object handler,
2181 Lisp_Object dont_register_service)
2182{
2183 Lisp_Object key, key1, value;
2184 Lisp_Object args[2] = { bus, service };
2185
2186 /* Check parameters. */
2187 CHECK_STRING (service);
2188 CHECK_STRING (path);
2189 CHECK_STRING (interface);
2190 CHECK_STRING (method);
2191 if (!FUNCTIONP (handler))
2192 wrong_type_argument (Qinvalid_function, handler);
2193 /* TODO: We must check for a valid service name, otherwise there is
2194 a segmentation fault. */
2195
2196 /* Request the name. */
2197 if (NILP (dont_register_service))
2198 Fdbus_register_service (2, args);
2199
2200 /* Create a hash table entry. We use nil for the unique name,
2201 because the method might be called from anybody. */
2202 key = list3 (bus, interface, method);
2203 key1 = list4 (Qnil, service, path, handler);
2204 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
2205
2206 if (NILP (Fmember (key1, value)))
2207 Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
2208
2209 /* Return object. */
2210 return list2 (key, list3 (service, path, handler));
2211}
2212
2213 1695
2214void 1696void
2215syms_of_dbusbind (void) 1697syms_of_dbusbind (void)
@@ -2218,35 +1700,11 @@ syms_of_dbusbind (void)
2218 DEFSYM (Qdbus_init_bus, "dbus-init-bus"); 1700 DEFSYM (Qdbus_init_bus, "dbus-init-bus");
2219 defsubr (&Sdbus_init_bus); 1701 defsubr (&Sdbus_init_bus);
2220 1702
2221 DEFSYM (Qdbus_close_bus, "dbus-close-bus");
2222 defsubr (&Sdbus_close_bus);
2223
2224 DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name"); 1703 DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
2225 defsubr (&Sdbus_get_unique_name); 1704 defsubr (&Sdbus_get_unique_name);
2226 1705
2227 DEFSYM (Qdbus_call_method, "dbus-call-method"); 1706 DEFSYM (Qdbus_message_internal, "dbus-message-internal");
2228 defsubr (&Sdbus_call_method); 1707 defsubr (&Sdbus_message_internal);
2229
2230 DEFSYM (Qdbus_call_method_asynchronously, "dbus-call-method-asynchronously");
2231 defsubr (&Sdbus_call_method_asynchronously);
2232
2233 DEFSYM (Qdbus_method_return_internal, "dbus-method-return-internal");
2234 defsubr (&Sdbus_method_return_internal);
2235
2236 DEFSYM (Qdbus_method_error_internal, "dbus-method-error-internal");
2237 defsubr (&Sdbus_method_error_internal);
2238
2239 DEFSYM (Qdbus_send_signal, "dbus-send-signal");
2240 defsubr (&Sdbus_send_signal);
2241
2242 DEFSYM (Qdbus_register_service, "dbus-register-service");
2243 defsubr (&Sdbus_register_service);
2244
2245 DEFSYM (Qdbus_register_signal, "dbus-register-signal");
2246 defsubr (&Sdbus_register_signal);
2247
2248 DEFSYM (Qdbus_register_method, "dbus-register-method");
2249 defsubr (&Sdbus_register_method);
2250 1708
2251 DEFSYM (Qdbus_error, "dbus-error"); 1709 DEFSYM (Qdbus_error, "dbus-error");
2252 Fput (Qdbus_error, Qerror_conditions, 1710 Fput (Qdbus_error, Qerror_conditions,
@@ -2256,13 +1714,6 @@ syms_of_dbusbind (void)
2256 1714
2257 DEFSYM (QCdbus_system_bus, ":system"); 1715 DEFSYM (QCdbus_system_bus, ":system");
2258 DEFSYM (QCdbus_session_bus, ":session"); 1716 DEFSYM (QCdbus_session_bus, ":session");
2259 DEFSYM (QCdbus_request_name_allow_replacement, ":allow-replacement");
2260 DEFSYM (QCdbus_request_name_replace_existing, ":replace-existing");
2261 DEFSYM (QCdbus_request_name_do_not_queue, ":do-not-queue");
2262 DEFSYM (QCdbus_request_name_reply_primary_owner, ":primary-owner");
2263 DEFSYM (QCdbus_request_name_reply_exists, ":exists");
2264 DEFSYM (QCdbus_request_name_reply_in_queue, ":in-queue");
2265 DEFSYM (QCdbus_request_name_reply_already_owner, ":already-owner");
2266 DEFSYM (QCdbus_timeout, ":timeout"); 1717 DEFSYM (QCdbus_timeout, ":timeout");
2267 DEFSYM (QCdbus_type_byte, ":byte"); 1718 DEFSYM (QCdbus_type_byte, ":byte");
2268 DEFSYM (QCdbus_type_boolean, ":boolean"); 1719 DEFSYM (QCdbus_type_boolean, ":boolean");
@@ -2276,20 +1727,66 @@ syms_of_dbusbind (void)
2276 DEFSYM (QCdbus_type_string, ":string"); 1727 DEFSYM (QCdbus_type_string, ":string");
2277 DEFSYM (QCdbus_type_object_path, ":object-path"); 1728 DEFSYM (QCdbus_type_object_path, ":object-path");
2278 DEFSYM (QCdbus_type_signature, ":signature"); 1729 DEFSYM (QCdbus_type_signature, ":signature");
2279
2280#ifdef DBUS_TYPE_UNIX_FD 1730#ifdef DBUS_TYPE_UNIX_FD
2281 DEFSYM (QCdbus_type_unix_fd, ":unix-fd"); 1731 DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
2282#endif 1732#endif
2283
2284 DEFSYM (QCdbus_type_array, ":array"); 1733 DEFSYM (QCdbus_type_array, ":array");
2285 DEFSYM (QCdbus_type_variant, ":variant"); 1734 DEFSYM (QCdbus_type_variant, ":variant");
2286 DEFSYM (QCdbus_type_struct, ":struct"); 1735 DEFSYM (QCdbus_type_struct, ":struct");
2287 DEFSYM (QCdbus_type_dict_entry, ":dict-entry"); 1736 DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
1737 DEFSYM (QCdbus_registered_serial, ":serial");
1738 DEFSYM (QCdbus_registered_method, ":method");
1739 DEFSYM (QCdbus_registered_signal, ":signal");
1740
1741 DEFVAR_LISP ("dbus-compiled-version",
1742 Vdbus_compiled_version,
1743 doc: /* The version of D-Bus Emacs is compiled against. */);
1744#ifdef DBUS_VERSION_STRING
1745 Vdbus_compiled_version = make_pure_c_string (DBUS_VERSION_STRING);
1746#else
1747 Vdbus_compiled_version = Qnil;
1748#endif
1749
1750 DEFVAR_LISP ("dbus-runtime-version",
1751 Vdbus_runtime_version,
1752 doc: /* The version of D-Bus Emacs runs with. */);
1753 {
1754#ifdef DBUS_VERSION
1755 int major, minor, micro;
1756 char s[1024];
1757 dbus_get_version (&major, &minor, &micro);
1758 snprintf (s, sizeof s, "%d.%d.%d", major, minor, micro);
1759 Vdbus_runtime_version = make_string (s, strlen (s));
1760#else
1761 Vdbus_runtime_version = Qnil;
1762#endif
1763 }
1764
1765 DEFVAR_LISP ("dbus-message-type-invalid",
1766 Vdbus_message_type_invalid,
1767 doc: /* This value is never a valid message type. */);
1768 Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
2288 1769
2289 DEFVAR_LISP ("dbus-registered-buses", 1770 DEFVAR_LISP ("dbus-message-type-method-call",
2290 Vdbus_registered_buses, 1771 Vdbus_message_type_method_call,
2291 doc: /* List of D-Bus buses we are polling for messages. */); 1772 doc: /* Message type of a method call message. */);
2292 Vdbus_registered_buses = Qnil; 1773 Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
1774
1775 DEFVAR_LISP ("dbus-message-type-method-return",
1776 Vdbus_message_type_method_return,
1777 doc: /* Message type of a method return message. */);
1778 Vdbus_message_type_method_return
1779 = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1780
1781 DEFVAR_LISP ("dbus-message-type-error",
1782 Vdbus_message_type_error,
1783 doc: /* Message type of an error reply message. */);
1784 Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
1785
1786 DEFVAR_LISP ("dbus-message-type-signal",
1787 Vdbus_message_type_signal,
1788 doc: /* Message type of a signal message. */);
1789 Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
2293 1790
2294 DEFVAR_LISP ("dbus-registered-objects-table", 1791 DEFVAR_LISP ("dbus-registered-objects-table",
2295 Vdbus_registered_objects_table, 1792 Vdbus_registered_objects_table,
@@ -2299,27 +1796,28 @@ There are two different uses of the hash table: for accessing
2299registered interfaces properties, targeted by signals or method calls, 1796registered interfaces properties, targeted by signals or method calls,
2300and for calling handlers in case of non-blocking method call returns. 1797and for calling handlers in case of non-blocking method call returns.
2301 1798
2302In the first case, the key in the hash table is the list (BUS 1799In the first case, the key in the hash table is the list (TYPE BUS
2303INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or 1800INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
1801`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
2304`:session', or a string denoting the bus address. INTERFACE is a 1802`:session', or a string denoting the bus address. INTERFACE is a
2305string which denotes a D-Bus interface, and MEMBER, also a string, is 1803string which denotes a D-Bus interface, and MEMBER, also a string, is
2306either a method, a signal or a property INTERFACE is offering. All 1804either a method, a signal or a property INTERFACE is offering. All
2307arguments but BUS must not be nil. 1805arguments but BUS must not be nil.
2308 1806
2309The value in the hash table is a list of quadruple lists 1807The value in the hash table is a list of quadruple lists \((UNAME
2310\((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...). 1808SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
2311SERVICE is the service name as registered, UNAME is the corresponding 1809registered, UNAME is the corresponding unique name. In case of
2312unique name. In case of registered methods and properties, UNAME is 1810registered methods and properties, UNAME is nil. PATH is the object
2313nil. PATH is the object path of the sending object. All of them can 1811path of the sending object. All of them can be nil, which means a
2314be nil, which means a wildcard then. OBJECT is either the handler to 1812wildcard then. OBJECT is either the handler to be called when a D-Bus
2315be called when a D-Bus message, which matches the key criteria, 1813message, which matches the key criteria, arrives (TYPE `:method' and
2316arrives (methods and signals), or a cons cell containing the value of 1814`:signal'), or a cons cell containing the value of the property (TYPE
2317the property. 1815`:property').
2318 1816
2319For signals, there is also a fifth element RULE, which keeps the match 1817For entries of type `:signal', there is also a fifth element RULE,
2320string the signal is registered with. 1818which keeps the match string the signal is registered with.
2321 1819
2322In the second case, the key in the hash table is the list (BUS 1820In the second case, the key in the hash table is the list (:serial BUS
2323SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a 1821SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
2324string denoting the bus address. SERIAL is the serial number of the 1822string denoting the bus address. SERIAL is the serial number of the
2325non-blocking method call, a reply is expected. Both arguments must 1823non-blocking method call, a reply is expected. Both arguments must
@@ -2343,6 +1841,10 @@ be called when the D-Bus reply message arrives. */);
2343 Vdbus_debug = Qnil; 1841 Vdbus_debug = Qnil;
2344#endif 1842#endif
2345 1843
1844 /* Initialize internal objects. */
1845 xd_registered_buses = Qnil;
1846 staticpro (&xd_registered_buses);
1847
2346 Fprovide (intern_c_string ("dbusbind"), Qnil); 1848 Fprovide (intern_c_string ("dbusbind"), Qnil);
2347 1849
2348} 1850}
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-15 01:02:53 +0000