aboutsummaryrefslogtreecommitdiffstats
path: root/src/dbusbind.c
diff options
context:
space:
mode:
authorJoakim Verona2012-05-21 00:37:29 +0200
committerJoakim Verona2012-05-21 00:37:29 +0200
commit74f082445c1dd0c92d5bb187db0d50287e3a7bae (patch)
tree48e3d8fd9df3876665654eab9bcf96ec492a31e9 /src/dbusbind.c
parent52862ad482e030e4d54cd7d6e250d76e59ee0554 (diff)
parent1b170bc63c2f3a3fbe6ba6996d5a015e82634909 (diff)
downloademacs-74f082445c1dd0c92d5bb187db0d50287e3a7bae.tar.gz
emacs-74f082445c1dd0c92d5bb187db0d50287e3a7bae.zip
upstream, fix conflicts
Diffstat (limited to 'src/dbusbind.c')
-rw-r--r--src/dbusbind.c1793
1 files changed, 620 insertions, 1173 deletions
diff --git a/src/dbusbind.c b/src/dbusbind.c
index ad1a3f3cbe8..62923b462b5 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))))
@@ -469,7 +556,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
469 CHECK_NATNUM (object); 556 CHECK_NATNUM (object);
470 { 557 {
471 unsigned char val = XFASTINT (object) & 0xFF; 558 unsigned char val = XFASTINT (object) & 0xFF;
472 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 559 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
473 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 560 if (!dbus_message_iter_append_basic (iter, dtype, &val))
474 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 561 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
475 return; 562 return;
@@ -488,7 +575,8 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
488 CHECK_NUMBER (object); 575 CHECK_NUMBER (object);
489 { 576 {
490 dbus_int16_t val = XINT (object); 577 dbus_int16_t val = XINT (object);
491 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); 578 int pval = val;
579 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
492 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 580 if (!dbus_message_iter_append_basic (iter, dtype, &val))
493 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 581 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
494 return; 582 return;
@@ -498,17 +586,18 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
498 CHECK_NATNUM (object); 586 CHECK_NATNUM (object);
499 { 587 {
500 dbus_uint16_t val = XFASTINT (object); 588 dbus_uint16_t val = XFASTINT (object);
501 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val); 589 unsigned int pval = val;
590 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
502 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 591 if (!dbus_message_iter_append_basic (iter, dtype, &val))
503 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 592 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
504 return; 593 return;
505 } 594 }
506 595
507 case DBUS_TYPE_INT32: 596 case DBUS_TYPE_INT32:
508 CHECK_NUMBER (object);
509 { 597 {
510 dbus_int32_t val = XINT (object); 598 dbus_int32_t val = extract_float (object);
511 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 599 int pval = val;
600 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
512 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 601 if (!dbus_message_iter_append_basic (iter, dtype, &val))
513 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 602 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
514 return; 603 return;
@@ -518,39 +607,38 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
518#ifdef DBUS_TYPE_UNIX_FD 607#ifdef DBUS_TYPE_UNIX_FD
519 case DBUS_TYPE_UNIX_FD: 608 case DBUS_TYPE_UNIX_FD:
520#endif 609#endif
521 CHECK_NATNUM (object);
522 { 610 {
523 dbus_uint32_t val = XFASTINT (object); 611 dbus_uint32_t val = extract_float (object);
524 XD_DEBUG_MESSAGE ("%c %u", dtype, val); 612 unsigned int pval = val;
613 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
525 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 614 if (!dbus_message_iter_append_basic (iter, dtype, &val))
526 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 615 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
527 return; 616 return;
528 } 617 }
529 618
530 case DBUS_TYPE_INT64: 619 case DBUS_TYPE_INT64:
531 CHECK_NUMBER (object);
532 { 620 {
533 dbus_int64_t val = XINT (object); 621 dbus_int64_t val = extract_float (object);
534 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); 622 printmax_t pval = val;
623 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
535 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 624 if (!dbus_message_iter_append_basic (iter, dtype, &val))
536 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 625 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
537 return; 626 return;
538 } 627 }
539 628
540 case DBUS_TYPE_UINT64: 629 case DBUS_TYPE_UINT64:
541 CHECK_NATNUM (object);
542 { 630 {
543 dbus_uint64_t val = XFASTINT (object); 631 dbus_uint64_t val = extract_float (object);
544 XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object)); 632 uprintmax_t pval = val;
633 XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval);
545 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 634 if (!dbus_message_iter_append_basic (iter, dtype, &val))
546 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 635 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
547 return; 636 return;
548 } 637 }
549 638
550 case DBUS_TYPE_DOUBLE: 639 case DBUS_TYPE_DOUBLE:
551 CHECK_FLOAT (object);
552 { 640 {
553 double val = XFLOAT_DATA (object); 641 double val = extract_float (object);
554 XD_DEBUG_MESSAGE ("%c %f", dtype, val); 642 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
555 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 643 if (!dbus_message_iter_append_basic (iter, dtype, &val))
556 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 644 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -614,7 +702,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
614 dtype, CAR_SAFE (XD_NEXT_VALUE (object))); 702 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
615 703
616 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature, 704 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
617 SDATA (format2 ("%s", object, Qnil))); 705 XD_OBJECT_TO_STRING (object));
618 if (!dbus_message_iter_open_container (iter, dtype, 706 if (!dbus_message_iter_open_container (iter, dtype,
619 signature, &subiter)) 707 signature, &subiter))
620 XD_SIGNAL3 (build_string ("Cannot open container"), 708 XD_SIGNAL3 (build_string ("Cannot open container"),
@@ -627,7 +715,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
627 dtype, CAR_SAFE (XD_NEXT_VALUE (object))); 715 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
628 716
629 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature, 717 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
630 SDATA (format2 ("%s", object, Qnil))); 718 XD_OBJECT_TO_STRING (object));
631 if (!dbus_message_iter_open_container (iter, dtype, 719 if (!dbus_message_iter_open_container (iter, dtype,
632 signature, &subiter)) 720 signature, &subiter))
633 XD_SIGNAL3 (build_string ("Cannot open container"), 721 XD_SIGNAL3 (build_string ("Cannot open container"),
@@ -637,8 +725,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
637 case DBUS_TYPE_STRUCT: 725 case DBUS_TYPE_STRUCT:
638 case DBUS_TYPE_DICT_ENTRY: 726 case DBUS_TYPE_DICT_ENTRY:
639 /* These containers do not require a signature. */ 727 /* These containers do not require a signature. */
640 XD_DEBUG_MESSAGE ("%c %s", dtype, 728 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)) 729 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
643 XD_SIGNAL2 (build_string ("Cannot open container"), 730 XD_SIGNAL2 (build_string ("Cannot open container"),
644 make_number (dtype)); 731 make_number (dtype));
@@ -678,7 +765,7 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
678 unsigned int val; 765 unsigned int val;
679 dbus_message_iter_get_basic (iter, &val); 766 dbus_message_iter_get_basic (iter, &val);
680 val = val & 0xFF; 767 val = val & 0xFF;
681 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 768 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
682 return make_number (val); 769 return make_number (val);
683 } 770 }
684 771
@@ -693,24 +780,30 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
693 case DBUS_TYPE_INT16: 780 case DBUS_TYPE_INT16:
694 { 781 {
695 dbus_int16_t val; 782 dbus_int16_t val;
783 int pval;
696 dbus_message_iter_get_basic (iter, &val); 784 dbus_message_iter_get_basic (iter, &val);
697 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 785 pval = val;
786 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
698 return make_number (val); 787 return make_number (val);
699 } 788 }
700 789
701 case DBUS_TYPE_UINT16: 790 case DBUS_TYPE_UINT16:
702 { 791 {
703 dbus_uint16_t val; 792 dbus_uint16_t val;
793 int pval;
704 dbus_message_iter_get_basic (iter, &val); 794 dbus_message_iter_get_basic (iter, &val);
705 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 795 pval = val;
796 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
706 return make_number (val); 797 return make_number (val);
707 } 798 }
708 799
709 case DBUS_TYPE_INT32: 800 case DBUS_TYPE_INT32:
710 { 801 {
711 dbus_int32_t val; 802 dbus_int32_t val;
803 int pval;
712 dbus_message_iter_get_basic (iter, &val); 804 dbus_message_iter_get_basic (iter, &val);
713 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 805 pval = val;
806 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
714 return make_fixnum_or_float (val); 807 return make_fixnum_or_float (val);
715 } 808 }
716 809
@@ -720,24 +813,30 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
720#endif 813#endif
721 { 814 {
722 dbus_uint32_t val; 815 dbus_uint32_t val;
816 unsigned int pval = val;
723 dbus_message_iter_get_basic (iter, &val); 817 dbus_message_iter_get_basic (iter, &val);
724 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 818 pval = val;
819 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
725 return make_fixnum_or_float (val); 820 return make_fixnum_or_float (val);
726 } 821 }
727 822
728 case DBUS_TYPE_INT64: 823 case DBUS_TYPE_INT64:
729 { 824 {
730 dbus_int64_t val; 825 dbus_int64_t val;
826 printmax_t pval;
731 dbus_message_iter_get_basic (iter, &val); 827 dbus_message_iter_get_basic (iter, &val);
732 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); 828 pval = val;
829 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
733 return make_fixnum_or_float (val); 830 return make_fixnum_or_float (val);
734 } 831 }
735 832
736 case DBUS_TYPE_UINT64: 833 case DBUS_TYPE_UINT64:
737 { 834 {
738 dbus_uint64_t val; 835 dbus_uint64_t val;
836 uprintmax_t pval;
739 dbus_message_iter_get_basic (iter, &val); 837 dbus_message_iter_get_basic (iter, &val);
740 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); 838 pval = val;
839 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
741 return make_fixnum_or_float (val); 840 return make_fixnum_or_float (val);
742 } 841 }
743 842
@@ -777,7 +876,7 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
777 result = Fcons (xd_retrieve_arg (subtype, &subiter), result); 876 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
778 dbus_message_iter_next (&subiter); 877 dbus_message_iter_next (&subiter);
779 } 878 }
780 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil))); 879 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
781 RETURN_UNGCPRO (Fnreverse (result)); 880 RETURN_UNGCPRO (Fnreverse (result));
782 } 881 }
783 882
@@ -787,85 +886,37 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
787 } 886 }
788} 887}
789 888
790/* Initialize D-Bus connection. BUS is either a Lisp symbol, :system 889/* Return the number of references of the shared CONNECTION. */
791 or :session, or a string denoting the bus address. It tells which 890static int
792 D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error 891xd_get_connection_references (DBusConnection *connection)
793 when the connection cannot be initialized. */ 892{
893 ptrdiff_t *refcount;
894
895 /* We cannot access the DBusConnection structure, it is not public.
896 But we know, that the reference counter is the first field in
897 that structure. */
898 refcount = (void *) &connection;
899 refcount = (void *) *refcount;
900 return *refcount;
901}
902
903/* Return D-Bus connection address. BUS is either a Lisp symbol,
904 :system or :session, or a string denoting the bus address. */
794static DBusConnection * 905static DBusConnection *
795xd_initialize (Lisp_Object bus, int raise_error) 906xd_get_connection_address (Lisp_Object bus)
796{ 907{
797 DBusConnection *connection; 908 DBusConnection *connection;
798 DBusError derror; 909 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
812 /* We do not want to have an autolaunch for the session bus. */
813 if (EQ (bus, QCdbus_session_bus)
814 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
815 {
816 if (raise_error)
817 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
818 else
819 return NULL;
820 }
821 }
822 910
823 /* Open a connection to the bus. */ 911 val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
824 dbus_error_init (&derror); 912 if (NILP (val))
825 913 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
826 if (STRINGP (bus))
827 connection = dbus_connection_open (SSDATA (bus), &derror);
828 else 914 else
829 if (EQ (bus, QCdbus_system_bus)) 915 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
842 /* If it is not the system or session bus, we must register
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 916
862 if (connection == NULL && raise_error) 917 if (!dbus_connection_get_is_connected (connection))
863 XD_SIGNAL2 (build_string ("No connection to bus"), bus); 918 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
864 919
865 /* Cleanup. */
866 dbus_error_free (&derror);
867
868 /* Return the result. */
869 return connection; 920 return connection;
870} 921}
871 922
@@ -896,8 +947,8 @@ xd_add_watch (DBusWatch *watch, void *data)
896 int fd = xd_find_watch_fd (watch); 947 int fd = xd_find_watch_fd (watch);
897 948
898 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d", 949 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
899 fd, flags & DBUS_WATCH_WRITABLE, 950 fd, flags & DBUS_WATCH_WRITABLE,
900 dbus_watch_get_enabled (watch)); 951 dbus_watch_get_enabled (watch));
901 952
902 if (fd == -1) 953 if (fd == -1)
903 return FALSE; 954 return FALSE;
@@ -929,8 +980,8 @@ xd_remove_watch (DBusWatch *watch, void *data)
929 /* Unset session environment. */ 980 /* Unset session environment. */
930 if (XSYMBOL (QCdbus_session_bus) == data) 981 if (XSYMBOL (QCdbus_session_bus) == data)
931 { 982 {
932 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS"); 983 // XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
933 unsetenv ("DBUS_SESSION_BUS_ADDRESS"); 984 // unsetenv ("DBUS_SESSION_BUS_ADDRESS");
934 } 985 }
935 986
936 if (flags & DBUS_WATCH_WRITABLE) 987 if (flags & DBUS_WATCH_WRITABLE)
@@ -949,23 +1000,111 @@ xd_toggle_watch (DBusWatch *watch, void *data)
949 xd_remove_watch (watch, data); 1000 xd_remove_watch (watch, data);
950} 1001}
951 1002
952DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0, 1003/* Close connection to D-Bus BUS. */
953 doc: /* Initialize connection to D-Bus BUS. */) 1004static void
954 (Lisp_Object bus) 1005xd_close_bus (Lisp_Object bus)
1006{
1007 DBusConnection *connection;
1008 Lisp_Object val;
1009
1010 /* Check whether we are connected. */
1011 val = Fassoc (bus, xd_registered_buses);
1012 if (NILP (val))
1013 return;
1014
1015 /* Retrieve bus address. */
1016 connection = xd_get_connection_address (bus);
1017
1018 /* Close connection, if there isn't another shared application. */
1019 if (xd_get_connection_references (connection) == 1)
1020 {
1021 XD_DEBUG_MESSAGE ("Close connection to bus %s",
1022 XD_OBJECT_TO_STRING (bus));
1023 dbus_connection_close (connection);
1024 }
1025
1026 /* Decrement reference count. */
1027 dbus_connection_unref (connection);
1028
1029 /* Remove bus from list of registered buses. */
1030 xd_registered_buses = Fdelete (val, xd_registered_buses);
1031
1032 /* Return. */
1033 return;
1034}
1035
1036DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 2, 0,
1037 doc: /* Establish the connection to D-Bus BUS.
1038
1039BUS can be either the symbol `:system' or the symbol `:session', or it
1040can be a string denoting the address of the corresponding bus. For
1041the system and session buses, this function is called when loading
1042`dbus.el', there is no need to call it again.
1043
1044The function returns a number, which counts the connections this Emacs
1045session has established to the BUS under the same unique name (see
1046`dbus-get-unique-name'). It depends on the libraries Emacs is linked
1047with, and on the environment Emacs is running. For example, if Emacs
1048is linked with the gtk toolkit, and it runs in a GTK-aware environment
1049like Gnome, another connection might already be established.
1050
1051When PRIVATE is non-nil, a new connection is established instead of
1052reusing an existing one. It results in a new unique name at the bus.
1053This can be used, if it is necessary to distinguish from another
1054connection used in the same Emacs process, like the one established by
1055GTK+. It should be used with care for at least the `:system' and
1056`:session' buses, because other Emacs Lisp packages might already use
1057this connection to those buses. */)
1058 (Lisp_Object bus, Lisp_Object private)
955{ 1059{
956 DBusConnection *connection; 1060 DBusConnection *connection;
957 void *busp; 1061 DBusError derror;
1062 Lisp_Object val;
1063 int refcount;
958 1064
959 /* Check parameter. */ 1065 /* Check parameter. */
960 if (SYMBOLP (bus)) 1066 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
961 busp = XSYMBOL (bus); 1067
962 else if (STRINGP (bus)) 1068 /* Close bus if it is already open. */
963 busp = XSTRING (bus); 1069 xd_close_bus (bus);
1070
1071 /* Initialize. */
1072 dbus_error_init (&derror);
1073
1074 /* Open the connection. */
1075 if (STRINGP (bus))
1076 if (NILP (private))
1077 connection = dbus_connection_open (SSDATA (bus), &derror);
1078 else
1079 connection = dbus_connection_open_private (SSDATA (bus), &derror);
1080
1081 else
1082 if (NILP (private))
1083 connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
1084 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1085 &derror);
1086 else
1087 connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
1088 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1089 &derror);
1090
1091 if (dbus_error_is_set (&derror))
1092 XD_ERROR (derror);
1093
1094 if (connection == NULL)
1095 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
1096
1097 /* If it is not the system or session bus, we must register
1098 ourselves. Otherwise, we have called dbus_bus_get, which has
1099 configured us to exit if the connection closes - we undo this
1100 setting. */
1101 if (STRINGP (bus))
1102 dbus_bus_register (connection, &derror);
964 else 1103 else
965 wrong_type_argument (intern ("D-Bus"), bus); 1104 dbus_connection_set_exit_on_disconnect (connection, FALSE);
966 1105
967 /* Open a connection to the bus. */ 1106 if (dbus_error_is_set (&derror))
968 connection = xd_initialize (bus, TRUE); 1107 XD_ERROR (derror);
969 1108
970 /* Add the watch functions. We pass also the bus as data, in order 1109 /* Add the watch functions. We pass also the bus as data, in order
971 to distinguish between the buses in xd_remove_watch. */ 1110 to distinguish between the buses in xd_remove_watch. */
@@ -973,36 +1112,27 @@ DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
973 xd_add_watch, 1112 xd_add_watch,
974 xd_remove_watch, 1113 xd_remove_watch,
975 xd_toggle_watch, 1114 xd_toggle_watch,
976 busp, NULL)) 1115 SYMBOLP (bus)
1116 ? (void *) XSYMBOL (bus)
1117 : (void *) XSTRING (bus),
1118 NULL))
977 XD_SIGNAL1 (build_string ("Cannot add watch functions")); 1119 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
978 1120
979 /* Add bus to list of registered buses. */ 1121 /* Add bus to list of registered buses. */
980 Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses); 1122 XSETFASTINT (val, (intptr_t) connection);
1123 xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
981 1124
982 /* We do not want to abort. */ 1125 /* We do not want to abort. */
983 putenv ((char *) "DBUS_FATAL_WARNINGS=0"); 1126 putenv ((char *) "DBUS_FATAL_WARNINGS=0");
984 1127
985 /* Return. */ 1128 /* Cleanup. */
986 return Qnil; 1129 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 1130
1004 /* Return. */ 1131 /* Return reference counter. */
1005 return Qnil; 1132 refcount = xd_get_connection_references (connection);
1133 XD_DEBUG_MESSAGE ("Bus %s, Reference counter %d",
1134 XD_OBJECT_TO_STRING (bus), refcount);
1135 return make_number (refcount);
1006} 1136}
1007 1137
1008DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name, 1138DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
@@ -1013,8 +1143,11 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1013 DBusConnection *connection; 1143 DBusConnection *connection;
1014 const char *name; 1144 const char *name;
1015 1145
1016 /* Open a connection to the bus. */ 1146 /* Check parameter. */
1017 connection = xd_initialize (bus, TRUE); 1147 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1148
1149 /* Retrieve bus address. */
1150 connection = xd_get_connection_address (bus);
1018 1151
1019 /* Request the name. */ 1152 /* Request the name. */
1020 name = dbus_bus_get_unique_name (connection); 1153 name = dbus_bus_get_unique_name (connection);
@@ -1025,341 +1158,243 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1025 return build_string (name); 1158 return build_string (name);
1026} 1159}
1027 1160
1028DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0, 1161DEFUN ("dbus-message-internal", Fdbus_message_internal, Sdbus_message_internal,
1029 doc: /* Call METHOD on the D-Bus BUS. 1162 4, MANY, 0,
1030 1163 doc: /* Send a D-Bus message.
1031BUS is either a Lisp symbol, `:system' or `:session', or a string 1164This is an internal function, it shall not be used outside dbus.el.
1032denoting the bus address. 1165
1033 1166The following usages are expected:
1034SERVICE is the D-Bus service name to be used. PATH is the D-Bus 1167
1035object path SERVICE is registered at. INTERFACE is an interface 1168`dbus-call-method', `dbus-call-method-asynchronously':
1036offered by SERVICE. It must provide METHOD. 1169 \(dbus-message-internal
1037 1170 dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1038If the parameter `:timeout' is given, the following integer TIMEOUT 1171 &optional :timeout TIMEOUT &rest ARGS)
1039specifies the maximum number of milliseconds the method call must 1172
1040return. The default value is 25,000. If the method call doesn't 1173`dbus-send-signal':
1041return in time, a D-Bus error is raised. 1174 \(dbus-message-internal
1042 1175 dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1043All other arguments ARGS are passed to METHOD as arguments. They are 1176
1044converted into D-Bus types via the following rules: 1177`dbus-method-return-internal':
1045 1178 \(dbus-message-internal
1046 t and nil => DBUS_TYPE_BOOLEAN 1179 dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1047 number => DBUS_TYPE_UINT32 1180
1048 integer => DBUS_TYPE_INT32 1181`dbus-method-error-internal':
1049 float => DBUS_TYPE_DOUBLE 1182 \(dbus-message-internal
1050 string => DBUS_TYPE_STRING 1183 dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1051 list => DBUS_TYPE_ARRAY 1184
1052 1185usage: (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) 1186 (ptrdiff_t nargs, Lisp_Object *args)
1099{ 1187{
1100 Lisp_Object bus, service, path, interface, method; 1188 Lisp_Object message_type, bus, service, handler;
1189 Lisp_Object path = Qnil;
1190 Lisp_Object interface = Qnil;
1191 Lisp_Object member = Qnil;
1101 Lisp_Object result; 1192 Lisp_Object result;
1102 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 1193 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1103 DBusConnection *connection; 1194 DBusConnection *connection;
1104 DBusMessage *dmessage; 1195 DBusMessage *dmessage;
1105 DBusMessage *reply;
1106 DBusMessageIter iter; 1196 DBusMessageIter iter;
1107 DBusError derror;
1108 unsigned int dtype; 1197 unsigned int dtype;
1198 unsigned int mtype;
1199 dbus_uint32_t serial = 0;
1200 unsigned int ui_serial;
1109 int timeout = -1; 1201 int timeout = -1;
1110 ptrdiff_t i = 5; 1202 ptrdiff_t count;
1111 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; 1203 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1112 1204
1205 /* Initialize parameters. */
1206 message_type = args[0];
1207 bus = args[1];
1208 service = args[2];
1209 handler = Qnil;
1210
1211 CHECK_NATNUM (message_type);
1212 mtype = XFASTINT (message_type);
1213 if ((mtype <= DBUS_MESSAGE_TYPE_INVALID) || (mtype >= DBUS_NUM_MESSAGE_TYPES))
1214 XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
1215
1216 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1217 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1218 {
1219 path = args[3];
1220 interface = args[4];
1221 member = args[5];
1222 if (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1223 handler = args[6];
1224 count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
1225 }
1226 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1227 {
1228 XD_CHECK_DBUS_SERIAL (args[3], serial);
1229 count = 4;
1230 }
1231
1113 /* Check parameters. */ 1232 /* Check parameters. */
1114 bus = args[0]; 1233 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1115 service = args[1]; 1234 XD_DBUS_VALIDATE_BUS_NAME (service);
1116 path = args[2]; 1235 if (nargs < count)
1117 interface = args[3]; 1236 xsignal2 (Qwrong_number_of_arguments,
1118 method = args[4]; 1237 Qdbus_message_internal,
1119 1238 make_number (nargs));
1120 CHECK_STRING (service); 1239
1121 CHECK_STRING (path); 1240 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1122 CHECK_STRING (interface); 1241 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1123 CHECK_STRING (method); 1242 {
1124 GCPRO5 (bus, service, path, interface, method); 1243 XD_DBUS_VALIDATE_PATH (path);
1125 1244 XD_DBUS_VALIDATE_INTERFACE (interface);
1126 XD_DEBUG_MESSAGE ("%s %s %s %s", 1245 XD_DBUS_VALIDATE_MEMBER (member);
1127 SDATA (service), 1246 if (!NILP (handler) && (!FUNCTIONP (handler)))
1128 SDATA (path), 1247 wrong_type_argument (Qinvalid_function, handler);
1129 SDATA (interface), 1248 }
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 1249
1144 /* Check for timeout parameter. */ 1250 /* Protect Lisp variables. */
1145 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout))) 1251 GCPRO6 (bus, service, path, interface, member, handler);
1252
1253 /* Trace parameters. */
1254 switch (mtype)
1146 { 1255 {
1147 CHECK_NATNUM (args[i+1]); 1256 case DBUS_MESSAGE_TYPE_METHOD_CALL:
1148 timeout = XFASTINT (args[i+1]); 1257 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1149 i = i+2; 1258 XD_MESSAGE_TYPE_TO_STRING (mtype),
1259 XD_OBJECT_TO_STRING (bus),
1260 XD_OBJECT_TO_STRING (service),
1261 XD_OBJECT_TO_STRING (path),
1262 XD_OBJECT_TO_STRING (interface),
1263 XD_OBJECT_TO_STRING (member),
1264 XD_OBJECT_TO_STRING (handler));
1265 break;
1266 case DBUS_MESSAGE_TYPE_SIGNAL:
1267 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1268 XD_MESSAGE_TYPE_TO_STRING (mtype),
1269 XD_OBJECT_TO_STRING (bus),
1270 XD_OBJECT_TO_STRING (service),
1271 XD_OBJECT_TO_STRING (path),
1272 XD_OBJECT_TO_STRING (interface),
1273 XD_OBJECT_TO_STRING (member));
1274 break;
1275 default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1276 ui_serial = serial;
1277 XD_DEBUG_MESSAGE ("%s %s %s %u",
1278 XD_MESSAGE_TYPE_TO_STRING (mtype),
1279 XD_OBJECT_TO_STRING (bus),
1280 XD_OBJECT_TO_STRING (service),
1281 ui_serial);
1150 } 1282 }
1151 1283
1152 /* Initialize parameter list of message. */ 1284 /* Retrieve bus address. */
1153 dbus_message_iter_init_append (dmessage, &iter); 1285 connection = xd_get_connection_address (bus);
1154 1286
1155 /* Append parameters to the message. */ 1287 /* Create the D-Bus message. */
1156 for (; i < nargs; ++i) 1288 dmessage = dbus_message_new (mtype);
1289 if (dmessage == NULL)
1290 {
1291 UNGCPRO;
1292 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1293 }
1294
1295 if (STRINGP (service))
1157 { 1296 {
1158 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); 1297 if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
1159 if (XD_DBUS_TYPE_P (args[i])) 1298 /* Set destination. */
1160 { 1299 {
1161 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1300 if (!dbus_message_set_destination (dmessage, SSDATA (service)))
1162 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]); 1301 {
1163 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4, 1302 UNGCPRO;
1164 SDATA (format2 ("%s", args[i], Qnil)), 1303 XD_SIGNAL2 (build_string ("Unable to set the destination"),
1165 SDATA (format2 ("%s", args[i+1], Qnil))); 1304 service);
1166 ++i; 1305 }
1167 } 1306 }
1307
1168 else 1308 else
1309 /* Set destination for unicast signals. */
1169 { 1310 {
1170 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1311 Lisp_Object uname;
1171 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
1172 SDATA (format2 ("%s", args[i], Qnil)));
1173 }
1174 1312
1175 /* Check for valid signature. We use DBUS_TYPE_INVALID as 1313 /* If it is the same unique name as we are registered at the
1176 indication that there is no parent type. */ 1314 bus or an unknown name, we regard it as broadcast message
1177 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]); 1315 due to backward compatibility. */
1316 if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
1317 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1318 else
1319 uname = Qnil;
1178 1320
1179 xd_append_arg (dtype, args[i], &iter); 1321 if (STRINGP (uname)
1322 && (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
1323 != 0)
1324 && (!dbus_message_set_destination (dmessage, SSDATA (service))))
1325 {
1326 UNGCPRO;
1327 XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1328 service);
1329 }
1330 }
1180 } 1331 }
1181 1332
1182 /* Send the message. */ 1333 /* Set message parameters. */
1183 dbus_error_init (&derror); 1334 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1184 reply = dbus_connection_send_with_reply_and_block (connection, 1335 || (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 { 1336 {
1203 /* Loop over the parameters of the D-Bus reply message. Construct a 1337 if ((!dbus_message_set_path (dmessage, SSDATA (path)))
1204 Lisp list, which is returned by `dbus-call-method'. */ 1338 || (!dbus_message_set_interface (dmessage, SSDATA (interface)))
1205 while ((dtype = dbus_message_iter_get_arg_type (&iter)) 1339 || (!dbus_message_set_member (dmessage, SSDATA (member))))
1206 != DBUS_TYPE_INVALID)
1207 { 1340 {
1208 result = Fcons (xd_retrieve_arg (dtype, &iter), result); 1341 UNGCPRO;
1209 dbus_message_iter_next (&iter); 1342 XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1210 } 1343 }
1211 } 1344 }
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 1345
1230DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously, 1346 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1231 Sdbus_call_method_asynchronously, 6, MANY, 0, 1347 {
1232 doc: /* Call METHOD on the D-Bus BUS asynchronously. 1348 if (!dbus_message_set_reply_serial (dmessage, serial))
1233 1349 {
1234BUS is either a Lisp symbol, `:system' or `:session', or a string 1350 UNGCPRO;
1235denoting the bus address. 1351 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1236 1352 }
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
1263Unless HANDLER is nil, the function returns a key into the hash table
1264`dbus-registered-objects-table'. The corresponding entry in the hash
1265table is removed, when the return message has been arrived, and
1266HANDLER is called.
1267
1268Example:
1269
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 1353
1294 /* Check parameters. */ 1354 if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
1295 bus = args[0]; 1355 && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
1296 service = args[1]; 1356 {
1297 path = args[2]; 1357 UNGCPRO;
1298 interface = args[3]; 1358 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1299 method = args[4]; 1359 }
1300 handler = args[5]; 1360 }
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 1361
1327 /* Check for timeout parameter. */ 1362 /* Check for timeout parameter. */
1328 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout))) 1363 if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
1329 { 1364 {
1330 CHECK_NATNUM (args[i+1]); 1365 CHECK_NATNUM (args[count+1]);
1331 timeout = XFASTINT (args[i+1]); 1366 timeout = XFASTINT (args[count+1]);
1332 i = i+2; 1367 count = count+2;
1333 } 1368 }
1334 1369
1335 /* Initialize parameter list of message. */ 1370 /* Initialize parameter list of message. */
1336 dbus_message_iter_init_append (dmessage, &iter); 1371 dbus_message_iter_init_append (dmessage, &iter);
1337 1372
1338 /* Append parameters to the message. */ 1373 /* Append parameters to the message. */
1339 for (; i < nargs; ++i) 1374 for (; count < nargs; ++count)
1340 { 1375 {
1341 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); 1376 dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
1342 if (XD_DBUS_TYPE_P (args[i])) 1377 if (XD_DBUS_TYPE_P (args[count]))
1343 { 1378 {
1344 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1379 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1345 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]); 1380 XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
1346 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4, 1381 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
1347 SDATA (format2 ("%s", args[i], Qnil)), 1382 XD_OBJECT_TO_STRING (args[count]),
1348 SDATA (format2 ("%s", args[i+1], Qnil))); 1383 XD_OBJECT_TO_STRING (args[count+1]));
1349 ++i; 1384 ++count;
1350 } 1385 }
1351 else 1386 else
1352 { 1387 {
1353 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1388 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1354 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4, 1389 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
1355 SDATA (format2 ("%s", args[i], Qnil))); 1390 XD_OBJECT_TO_STRING (args[count]));
1356 } 1391 }
1357 1392
1358 /* Check for valid signature. We use DBUS_TYPE_INVALID as 1393 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1359 indication that there is no parent type. */ 1394 indication that there is no parent type. */
1360 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]); 1395 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[count]);
1361 1396
1362 xd_append_arg (dtype, args[i], &iter); 1397 xd_append_arg (dtype, args[count], &iter);
1363 } 1398 }
1364 1399
1365 if (!NILP (handler)) 1400 if (!NILP (handler))
@@ -1368,11 +1403,15 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
1368 message queue. */ 1403 message queue. */
1369 if (!dbus_connection_send_with_reply (connection, dmessage, 1404 if (!dbus_connection_send_with_reply (connection, dmessage,
1370 NULL, timeout)) 1405 NULL, timeout))
1371 XD_SIGNAL1 (build_string ("Cannot send message")); 1406 {
1407 UNGCPRO;
1408 XD_SIGNAL1 (build_string ("Cannot send message"));
1409 }
1372 1410
1373 /* The result is the key in Vdbus_registered_objects_table. */ 1411 /* The result is the key in Vdbus_registered_objects_table. */
1374 serial = dbus_message_get_serial (dmessage); 1412 serial = dbus_message_get_serial (dmessage);
1375 result = list2 (bus, make_fixnum_or_float (serial)); 1413 result = list3 (QCdbus_registered_serial,
1414 bus, make_fixnum_or_float (serial));
1376 1415
1377 /* Create a hash table entry. */ 1416 /* Create a hash table entry. */
1378 Fputhash (result, handler, Vdbus_registered_objects_table); 1417 Fputhash (result, handler, Vdbus_registered_objects_table);
@@ -1382,12 +1421,15 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
1382 /* Send the message. The message is just added to the outgoing 1421 /* Send the message. The message is just added to the outgoing
1383 message queue. */ 1422 message queue. */
1384 if (!dbus_connection_send (connection, dmessage, NULL)) 1423 if (!dbus_connection_send (connection, dmessage, NULL))
1385 XD_SIGNAL1 (build_string ("Cannot send message")); 1424 {
1425 UNGCPRO;
1426 XD_SIGNAL1 (build_string ("Cannot send message"));
1427 }
1386 1428
1387 result = Qnil; 1429 result = Qnil;
1388 } 1430 }
1389 1431
1390 XD_DEBUG_MESSAGE ("Message sent"); 1432 XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
1391 1433
1392 /* Cleanup. */ 1434 /* Cleanup. */
1393 dbus_message_unref (dmessage); 1435 dbus_message_unref (dmessage);
@@ -1396,300 +1438,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
1396 RETURN_UNGCPRO (result); 1438 RETURN_UNGCPRO (result);
1397} 1439}
1398 1440
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. 1441/* Read one queued incoming message of the D-Bus BUS.
1694 BUS is either a Lisp symbol, :system or :session, or a string denoting 1442 BUS is either a Lisp symbol, :system or :session, or a string denoting
1695 the bus address. */ 1443 the bus address. */
@@ -1702,7 +1450,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1702 DBusMessage *dmessage; 1450 DBusMessage *dmessage;
1703 DBusMessageIter iter; 1451 DBusMessageIter iter;
1704 unsigned int dtype; 1452 unsigned int dtype;
1705 int mtype; 1453 unsigned int mtype;
1706 dbus_uint32_t serial; 1454 dbus_uint32_t serial;
1707 unsigned int ui_serial; 1455 unsigned int ui_serial;
1708 const char *uname, *path, *interface, *member; 1456 const char *uname, *path, *interface, *member;
@@ -1744,23 +1492,19 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1744 member = dbus_message_get_member (dmessage); 1492 member = dbus_message_get_member (dmessage);
1745 1493
1746 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s", 1494 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1747 (mtype == DBUS_MESSAGE_TYPE_INVALID) 1495 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, 1496 ui_serial, uname, path, interface, member,
1757 SDATA (format2 ("%s", args, Qnil))); 1497 XD_OBJECT_TO_STRING (args));
1498
1499 if (mtype == DBUS_MESSAGE_TYPE_INVALID)
1500 goto cleanup;
1758 1501
1759 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) 1502 else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1760 || (mtype == DBUS_MESSAGE_TYPE_ERROR)) 1503 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1761 { 1504 {
1762 /* Search for a registered function of the message. */ 1505 /* Search for a registered function of the message. */
1763 key = list2 (bus, make_fixnum_or_float (serial)); 1506 key = list3 (QCdbus_registered_serial, bus,
1507 make_fixnum_or_float (serial));
1764 value = Fgethash (key, Vdbus_registered_objects_table, Qnil); 1508 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1765 1509
1766 /* There shall be exactly one entry. Construct an event. */ 1510 /* There shall be exactly one entry. Construct an event. */
@@ -1777,7 +1521,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1777 event.arg = Fcons (value, args); 1521 event.arg = Fcons (value, args);
1778 } 1522 }
1779 1523
1780 else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */ 1524 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
1781 { 1525 {
1782 /* Vdbus_registered_objects_table requires non-nil interface and 1526 /* Vdbus_registered_objects_table requires non-nil interface and
1783 member. */ 1527 member. */
@@ -1785,7 +1529,10 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1785 goto cleanup; 1529 goto cleanup;
1786 1530
1787 /* Search for a registered function of the message. */ 1531 /* Search for a registered function of the message. */
1788 key = list3 (bus, build_string (interface), build_string (member)); 1532 key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1533 ? QCdbus_registered_method
1534 : QCdbus_registered_signal,
1535 bus, build_string (interface), build_string (member));
1789 value = Fgethash (key, Vdbus_registered_objects_table, Qnil); 1536 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1790 1537
1791 /* Loop over the registered functions. Construct an event. */ 1538 /* Loop over the registered functions. Construct an event. */
@@ -1835,8 +1582,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1835 /* Store it into the input event queue. */ 1582 /* Store it into the input event queue. */
1836 kbd_buffer_store_event (&event); 1583 kbd_buffer_store_event (&event);
1837 1584
1838 XD_DEBUG_MESSAGE ("Event stored: %s", 1585 XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
1839 SDATA (format2 ("%s", event.arg, Qnil)));
1840 1586
1841 /* Cleanup. */ 1587 /* Cleanup. */
1842 cleanup: 1588 cleanup:
@@ -1851,8 +1597,8 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1851static Lisp_Object 1597static Lisp_Object
1852xd_read_message (Lisp_Object bus) 1598xd_read_message (Lisp_Object bus)
1853{ 1599{
1854 /* Open a connection to the bus. */ 1600 /* Retrieve bus address. */
1855 DBusConnection *connection = xd_initialize (bus, TRUE); 1601 DBusConnection *connection = xd_get_connection_address (bus);
1856 1602
1857 /* Non blocking read of the next available message. */ 1603 /* Non blocking read of the next available message. */
1858 dbus_connection_read_write (connection, 0); 1604 dbus_connection_read_write (connection, 0);
@@ -1867,16 +1613,18 @@ xd_read_message (Lisp_Object bus)
1867static void 1613static void
1868xd_read_queued_messages (int fd, void *data, int for_read) 1614xd_read_queued_messages (int fd, void *data, int for_read)
1869{ 1615{
1870 Lisp_Object busp = Vdbus_registered_buses; 1616 Lisp_Object busp = xd_registered_buses;
1871 Lisp_Object bus = Qnil; 1617 Lisp_Object bus = Qnil;
1618 Lisp_Object key;
1872 1619
1873 /* Find bus related to fd. */ 1620 /* Find bus related to fd. */
1874 if (data != NULL) 1621 if (data != NULL)
1875 while (!NILP (busp)) 1622 while (!NILP (busp))
1876 { 1623 {
1877 if ((SYMBOLP (CAR_SAFE (busp)) && XSYMBOL (CAR_SAFE (busp)) == data) 1624 key = CAR_SAFE (CAR_SAFE (busp));
1878 || (STRINGP (CAR_SAFE (busp)) && XSTRING (CAR_SAFE (busp)) == data)) 1625 if ((SYMBOLP (key) && XSYMBOL (key) == data)
1879 bus = CAR_SAFE (busp); 1626 || (STRINGP (key) && XSTRING (key) == data))
1627 bus = key;
1880 busp = CDR_SAFE (busp); 1628 busp = CDR_SAFE (busp);
1881 } 1629 }
1882 1630
@@ -1889,327 +1637,6 @@ xd_read_queued_messages (int fd, void *data, int for_read)
1889 xd_in_read_queued_messages = 0; 1637 xd_in_read_queued_messages = 0;
1890} 1638}
1891 1639
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 1640
2214void 1641void
2215syms_of_dbusbind (void) 1642syms_of_dbusbind (void)
@@ -2218,35 +1645,11 @@ syms_of_dbusbind (void)
2218 DEFSYM (Qdbus_init_bus, "dbus-init-bus"); 1645 DEFSYM (Qdbus_init_bus, "dbus-init-bus");
2219 defsubr (&Sdbus_init_bus); 1646 defsubr (&Sdbus_init_bus);
2220 1647
2221 DEFSYM (Qdbus_close_bus, "dbus-close-bus");
2222 defsubr (&Sdbus_close_bus);
2223
2224 DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name"); 1648 DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
2225 defsubr (&Sdbus_get_unique_name); 1649 defsubr (&Sdbus_get_unique_name);
2226 1650
2227 DEFSYM (Qdbus_call_method, "dbus-call-method"); 1651 DEFSYM (Qdbus_message_internal, "dbus-message-internal");
2228 defsubr (&Sdbus_call_method); 1652 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 1653
2251 DEFSYM (Qdbus_error, "dbus-error"); 1654 DEFSYM (Qdbus_error, "dbus-error");
2252 Fput (Qdbus_error, Qerror_conditions, 1655 Fput (Qdbus_error, Qerror_conditions,
@@ -2256,13 +1659,6 @@ syms_of_dbusbind (void)
2256 1659
2257 DEFSYM (QCdbus_system_bus, ":system"); 1660 DEFSYM (QCdbus_system_bus, ":system");
2258 DEFSYM (QCdbus_session_bus, ":session"); 1661 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"); 1662 DEFSYM (QCdbus_timeout, ":timeout");
2267 DEFSYM (QCdbus_type_byte, ":byte"); 1663 DEFSYM (QCdbus_type_byte, ":byte");
2268 DEFSYM (QCdbus_type_boolean, ":boolean"); 1664 DEFSYM (QCdbus_type_boolean, ":boolean");
@@ -2276,20 +1672,66 @@ syms_of_dbusbind (void)
2276 DEFSYM (QCdbus_type_string, ":string"); 1672 DEFSYM (QCdbus_type_string, ":string");
2277 DEFSYM (QCdbus_type_object_path, ":object-path"); 1673 DEFSYM (QCdbus_type_object_path, ":object-path");
2278 DEFSYM (QCdbus_type_signature, ":signature"); 1674 DEFSYM (QCdbus_type_signature, ":signature");
2279
2280#ifdef DBUS_TYPE_UNIX_FD 1675#ifdef DBUS_TYPE_UNIX_FD
2281 DEFSYM (QCdbus_type_unix_fd, ":unix-fd"); 1676 DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
2282#endif 1677#endif
2283
2284 DEFSYM (QCdbus_type_array, ":array"); 1678 DEFSYM (QCdbus_type_array, ":array");
2285 DEFSYM (QCdbus_type_variant, ":variant"); 1679 DEFSYM (QCdbus_type_variant, ":variant");
2286 DEFSYM (QCdbus_type_struct, ":struct"); 1680 DEFSYM (QCdbus_type_struct, ":struct");
2287 DEFSYM (QCdbus_type_dict_entry, ":dict-entry"); 1681 DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
1682 DEFSYM (QCdbus_registered_serial, ":serial");
1683 DEFSYM (QCdbus_registered_method, ":method");
1684 DEFSYM (QCdbus_registered_signal, ":signal");
1685
1686 DEFVAR_LISP ("dbus-compiled-version",
1687 Vdbus_compiled_version,
1688 doc: /* The version of D-Bus Emacs is compiled against. */);
1689#ifdef DBUS_VERSION_STRING
1690 Vdbus_compiled_version = make_pure_c_string (DBUS_VERSION_STRING);
1691#else
1692 Vdbus_compiled_version = Qnil;
1693#endif
1694
1695 DEFVAR_LISP ("dbus-runtime-version",
1696 Vdbus_runtime_version,
1697 doc: /* The version of D-Bus Emacs runs with. */);
1698 {
1699#ifdef DBUS_VERSION
1700 int major, minor, micro;
1701 char s[1024];
1702 dbus_get_version (&major, &minor, &micro);
1703 snprintf (s, sizeof s, "%d.%d.%d", major, minor, micro);
1704 Vdbus_runtime_version = make_string (s, strlen (s));
1705#else
1706 Vdbus_runtime_version = Qnil;
1707#endif
1708 }
1709
1710 DEFVAR_LISP ("dbus-message-type-invalid",
1711 Vdbus_message_type_invalid,
1712 doc: /* This value is never a valid message type. */);
1713 Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
2288 1714
2289 DEFVAR_LISP ("dbus-registered-buses", 1715 DEFVAR_LISP ("dbus-message-type-method-call",
2290 Vdbus_registered_buses, 1716 Vdbus_message_type_method_call,
2291 doc: /* List of D-Bus buses we are polling for messages. */); 1717 doc: /* Message type of a method call message. */);
2292 Vdbus_registered_buses = Qnil; 1718 Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
1719
1720 DEFVAR_LISP ("dbus-message-type-method-return",
1721 Vdbus_message_type_method_return,
1722 doc: /* Message type of a method return message. */);
1723 Vdbus_message_type_method_return
1724 = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1725
1726 DEFVAR_LISP ("dbus-message-type-error",
1727 Vdbus_message_type_error,
1728 doc: /* Message type of an error reply message. */);
1729 Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
1730
1731 DEFVAR_LISP ("dbus-message-type-signal",
1732 Vdbus_message_type_signal,
1733 doc: /* Message type of a signal message. */);
1734 Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
2293 1735
2294 DEFVAR_LISP ("dbus-registered-objects-table", 1736 DEFVAR_LISP ("dbus-registered-objects-table",
2295 Vdbus_registered_objects_table, 1737 Vdbus_registered_objects_table,
@@ -2299,27 +1741,28 @@ There are two different uses of the hash table: for accessing
2299registered interfaces properties, targeted by signals or method calls, 1741registered interfaces properties, targeted by signals or method calls,
2300and for calling handlers in case of non-blocking method call returns. 1742and for calling handlers in case of non-blocking method call returns.
2301 1743
2302In the first case, the key in the hash table is the list (BUS 1744In the first case, the key in the hash table is the list (TYPE BUS
2303INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or 1745INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
1746`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
2304`:session', or a string denoting the bus address. INTERFACE is a 1747`:session', or a string denoting the bus address. INTERFACE is a
2305string which denotes a D-Bus interface, and MEMBER, also a string, is 1748string which denotes a D-Bus interface, and MEMBER, also a string, is
2306either a method, a signal or a property INTERFACE is offering. All 1749either a method, a signal or a property INTERFACE is offering. All
2307arguments but BUS must not be nil. 1750arguments but BUS must not be nil.
2308 1751
2309The value in the hash table is a list of quadruple lists 1752The value in the hash table is a list of quadruple lists \((UNAME
2310\((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...). 1753SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
2311SERVICE is the service name as registered, UNAME is the corresponding 1754registered, UNAME is the corresponding unique name. In case of
2312unique name. In case of registered methods and properties, UNAME is 1755registered methods and properties, UNAME is nil. PATH is the object
2313nil. PATH is the object path of the sending object. All of them can 1756path 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 1757wildcard 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, 1758message, which matches the key criteria, arrives (TYPE `:method' and
2316arrives (methods and signals), or a cons cell containing the value of 1759`:signal'), or a cons cell containing the value of the property (TYPE
2317the property. 1760`:property').
2318 1761
2319For signals, there is also a fifth element RULE, which keeps the match 1762For entries of type `:signal', there is also a fifth element RULE,
2320string the signal is registered with. 1763which keeps the match string the signal is registered with.
2321 1764
2322In the second case, the key in the hash table is the list (BUS 1765In 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 1766SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
2324string denoting the bus address. SERIAL is the serial number of the 1767string denoting the bus address. SERIAL is the serial number of the
2325non-blocking method call, a reply is expected. Both arguments must 1768non-blocking method call, a reply is expected. Both arguments must
@@ -2343,6 +1786,10 @@ be called when the D-Bus reply message arrives. */);
2343 Vdbus_debug = Qnil; 1786 Vdbus_debug = Qnil;
2344#endif 1787#endif
2345 1788
1789 /* Initialize internal objects. */
1790 xd_registered_buses = Qnil;
1791 staticpro (&xd_registered_buses);
1792
2346 Fprovide (intern_c_string ("dbusbind"), Qnil); 1793 Fprovide (intern_c_string ("dbusbind"), Qnil);
2347 1794
2348} 1795}
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-16 04:55:58 +0000