aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorMichael Albinus2012-04-22 16:11:43 +0200
committerMichael Albinus2012-04-22 16:11:43 +0200
commitdcbf5805ac7ade7fc83f3d209e2d56f029918402 (patch)
treeca2d664f76032c4cd39d798ae659e23a30f0b4f8 /src
parentcf20dee0248049a925275f54381cf63bb2017e35 (diff)
downloademacs-dcbf5805ac7ade7fc83f3d209e2d56f029918402.tar.gz
emacs-dcbf5805ac7ade7fc83f3d209e2d56f029918402.zip
Move functions from C to Lisp. Make non-blocking method calls
the default. Implement further D-Bus standard interfaces. * configure.in (dbus_validate_bus_name, dbus_validate_path) (dbus_validate_interface, dbus_validate_member): Check also for these library functions * dbusbind.c (DBUS_NUM_MESSAGE_TYPES): Declare. (QCdbus_request_name_allow_replacement) (QCdbus_request_name_replace_existing) (QCdbus_request_name_do_not_queue) (QCdbus_request_name_reply_primary_owner) (QCdbus_request_name_reply_in_queue) (QCdbus_request_name_reply_exists) (QCdbus_request_name_reply_already_owner): Move to dbus.el. (QCdbus_registered_serial, QCdbus_registered_method) (QCdbus_registered_signal): New Lisp objects. (XD_DEBUG_MESSAGE): Use sizeof. (XD_MESSAGE_TYPE_TO_STRING, XD_OBJECT_TO_STRING) (XD_DBUS_VALIDATE_BUS_ADDRESS, XD_DBUS_VALIDATE_OBJECT) (XD_DBUS_VALIDATE_BUS_NAME, XD_DBUS_VALIDATE_PATH) (XD_DBUS_VALIDATE_INTERFACE, XD_DBUS_VALIDATE_MEMBER): New macros. (XD_CHECK_DBUS_SERIAL): Rename from CHECK_DBUS_SERIAL_GET_SERIAL. (xd_signature, xd_append_arg): Allow float for integer types. (xd_get_connection_references): New function. (xd_get_connection_address): Rename from xd_initialize. Return cached address. (xd_remove_watch): Do not unset $DBUS_SESSION_BUS_ADDRESS. (xd_close_bus): Rename from Fdbus_close_bus. Not needed on Lisp level. (Fdbus_init_bus): New optional arg PRIVATE. Cache address. Return number of recounts. (Fdbus_get_unique_name): Make stronger parameter check. (Fdbus_message_internal): New defun. (Fdbus_call_method, Fdbus_call_method_asynchronously) (Fdbus_method_return_internal, Fdbus_method_error_internal) (Fdbus_send_signal, Fdbus_register_service) (Fdbus_register_signal, Fdbus_register_method): Move to dbus.el. (xd_read_message_1): Obey new structure of Vdbus_registered_objects. (xd_read_queued_messages): Obey new structure of Vdbus_registered_buses. (Vdbus_compiled_version, Vdbus_runtime_version) (Vdbus_message_type_invalid, Vdbus_message_type_method_call) (Vdbus_message_type_method_return, Vdbus_message_type_error) (Vdbus_message_type_signal): New defvars. (Vdbus_registered_buses, Vdbus_registered_objects_table): Adapt docstring. * net/dbus.el (dbus-message-internal): Declare function. Remove unneeded function declarations. (defvar dbus-message-type-invalid, dbus-message-type-method-call) (dbus-message-type-method-return, dbus-message-type-error) (dbus-message-type-signal): Declare variables. Remove local definitions. (dbus-interface-dbus, dbus-interface-peer) (dbus-interface-introspectable, dbus-interface-properties) (dbus-path-emacs, dbus-interface-emacs, dbus-return-values-table): Adapt docstring. (dbus-interface-objectmanager): New defconst. (dbus-call-method, dbus-call-method-asynchronously) (dbus-send-signal, dbus-method-return-internal) (dbus-method-error-internal, dbus-register-service) (dbus-register-signal, dbus-register-method): New defuns, moved from dbusbind.c (dbus-call-method-handler, dbus-setenv) (dbus-get-all-managed-objects, dbus-managed-objects-handler): New defuns. (dbus-call-method-non-blocking): Make it an obsolete function. (dbus-unregister-object, dbus-unregister-service) (dbus-handle-event, dbus-register-property) (dbus-property-handler): Obey the new structure of `bus-registered-objects'. (dbus-introspect): Use `dbus-call-method'. Use a timeout. (dbus-get-property, dbus-set-property, dbus-get-all-properties): Use `dbus-call-method'. * dbus.texi (Version): New node. (Properties and Annotations): Mention the object manager interface. Describe dbus-get-all-managed-objects. (Type Conversion): Floating point numbers are allowed, if an anteger does not fit Emacs's integer range. (Synchronous Methods): Remove obsolete dbus-call-method-non-blocking. (Asynchronous Methods): Fix description of dbus-call-method-asynchronously. (Receiving Method Calls): Fix some minor errors. Add dbus-interface-emacs. (Signals): Describe unicast signals and the new match rules. (Alternative Buses): Add the PRIVATE optional argument to dbus-init-bus. Describe its new return value. Add dbus-setenv.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog45
-rw-r--r--src/dbusbind.c1732
2 files changed, 622 insertions, 1155 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index a1220aeaa7d..205728f91da 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,48 @@
12012-04-22 Michael Albinus <michael.albinus@gmx.de>
2
3 Move functions from C to Lisp. Make non-blocking method calls
4 the default. Implement further D-Bus standard interfaces.
5
6 * dbusbind.c (DBUS_NUM_MESSAGE_TYPES): Declare.
7 (QCdbus_request_name_allow_replacement)
8 (QCdbus_request_name_replace_existing)
9 (QCdbus_request_name_do_not_queue)
10 (QCdbus_request_name_reply_primary_owner)
11 (QCdbus_request_name_reply_in_queue)
12 (QCdbus_request_name_reply_exists)
13 (QCdbus_request_name_reply_already_owner): Move to dbus.el.
14 (QCdbus_registered_serial, QCdbus_registered_method)
15 (QCdbus_registered_signal): New Lisp objects.
16 (XD_DEBUG_MESSAGE): Use sizeof.
17 (XD_MESSAGE_TYPE_TO_STRING, XD_OBJECT_TO_STRING)
18 (XD_DBUS_VALIDATE_BUS_ADDRESS, XD_DBUS_VALIDATE_OBJECT)
19 (XD_DBUS_VALIDATE_BUS_NAME, XD_DBUS_VALIDATE_PATH)
20 (XD_DBUS_VALIDATE_INTERFACE, XD_DBUS_VALIDATE_MEMBER): New macros.
21 (XD_CHECK_DBUS_SERIAL): Rename from CHECK_DBUS_SERIAL_GET_SERIAL.
22 (xd_signature, xd_append_arg): Allow float for integer types.
23 (xd_get_connection_references): New function.
24 (xd_get_connection_address): Rename from xd_initialize. Return
25 cached address.
26 (xd_remove_watch): Do not unset $DBUS_SESSION_BUS_ADDRESS.
27 (xd_close_bus): Rename from Fdbus_close_bus. Not needed on Lisp
28 level.
29 (Fdbus_init_bus): New optional arg PRIVATE. Cache address.
30 Return number of recounts.
31 (Fdbus_get_unique_name): Make stronger parameter check.
32 (Fdbus_message_internal): New defun.
33 (Fdbus_call_method, Fdbus_call_method_asynchronously)
34 (Fdbus_method_return_internal, Fdbus_method_error_internal)
35 (Fdbus_send_signal, Fdbus_register_service)
36 (Fdbus_register_signal, Fdbus_register_method): Move to dbus.el.
37 (xd_read_message_1): Obey new structure of Vdbus_registered_objects.
38 (xd_read_queued_messages): Obey new structure of Vdbus_registered_buses.
39 (Vdbus_compiled_version, Vdbus_runtime_version)
40 (Vdbus_message_type_invalid, Vdbus_message_type_method_call)
41 (Vdbus_message_type_method_return, Vdbus_message_type_error)
42 (Vdbus_message_type_signal): New defvars.
43 (Vdbus_registered_buses, Vdbus_registered_objects_table): Adapt
44 docstring.
45
12012-04-22 Paul Eggert <eggert@cs.ucla.edu> 462012-04-22 Paul Eggert <eggert@cs.ucla.edu>
2 47
3 Fix GC_MALLOC_CHECK debugging output on 64-bit hosts. 48 Fix GC_MALLOC_CHECK debugging output on 64-bit hosts.
diff --git a/src/dbusbind.c b/src/dbusbind.c
index ad1a3f3cbe8..78e5c80baf3 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,10 @@ 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
78/* Whether we are reading a D-Bus event. */ 67/* Whether we are reading a D-Bus event. */
79static int xd_in_read_queued_messages = 0; 68static int xd_in_read_queued_messages = 0;
80 69
@@ -120,14 +109,14 @@ static int xd_in_read_queued_messages = 0;
120 } while (0) 109 } while (0)
121 110
122/* Macros for debugging. In order to enable them, build with 111/* Macros for debugging. In order to enable them, build with
123 "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */ 112 "env MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
124#ifdef DBUS_DEBUG 113#ifdef DBUS_DEBUG
125#define XD_DEBUG_MESSAGE(...) \ 114#define XD_DEBUG_MESSAGE(...) \
126 do { \ 115 do { \
127 char s[1024]; \ 116 char s[1024]; \
128 snprintf (s, sizeof s, __VA_ARGS__); \ 117 snprintf (s, sizeof s, __VA_ARGS__); \
129 printf ("%s: %s\n", __func__, s); \ 118 printf ("%s: %s\n", __func__, s); \
130 message ("%s: %s", __func__, s); \ 119 message ("%s: %s", __func__, s); \
131 } while (0) 120 } while (0)
132#define XD_DEBUG_VALID_LISP_OBJECT_P(object) \ 121#define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
133 do { \ 122 do { \
@@ -144,7 +133,7 @@ static int xd_in_read_queued_messages = 0;
144 if (!NILP (Vdbus_debug)) \ 133 if (!NILP (Vdbus_debug)) \
145 { \ 134 { \
146 char s[1024]; \ 135 char s[1024]; \
147 snprintf (s, 1023, __VA_ARGS__); \ 136 snprintf (s, sizeof s, __VA_ARGS__); \
148 message ("%s: %s", __func__, s); \ 137 message ("%s: %s", __func__, s); \
149 } \ 138 } \
150 } while (0) 139 } while (0)
@@ -241,23 +230,112 @@ xd_symbol_to_dbus_type (Lisp_Object object)
241#define XD_NEXT_VALUE(object) \ 230#define XD_NEXT_VALUE(object) \
242 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object) 231 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
243 232
233/* Transform the message type to its string representation for debug
234 messages. */
235#define XD_MESSAGE_TYPE_TO_STRING(mtype) \
236 ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
237 ? "DBUS_MESSAGE_TYPE_INVALID" \
238 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
239 ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
240 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
241 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
242 : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
243 ? "DBUS_MESSAGE_TYPE_ERROR" \
244 : "DBUS_MESSAGE_TYPE_SIGNAL")
245
246/* Transform the object to its string representation for debug
247 messages. */
248#define XD_OBJECT_TO_STRING(object) \
249 SDATA (format2 ("%s", object, Qnil))
250
244/* Check whether X is a valid dbus serial number. If valid, set 251/* Check whether X is a valid dbus serial number. If valid, set
245 SERIAL to its value. Otherwise, signal an error. */ 252 SERIAL to its value. Otherwise, signal an error. */
246#define CHECK_DBUS_SERIAL_GET_SERIAL(x, serial) \ 253#define XD_CHECK_DBUS_SERIAL(x, serial) \
247 do \ 254 do { \
248 { \ 255 dbus_uint32_t DBUS_SERIAL_MAX = -1; \
249 dbus_uint32_t DBUS_SERIAL_MAX = -1; \ 256 if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \
250 if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \ 257 serial = XINT (x); \
251 serial = XINT (x); \ 258 else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \
252 else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \ 259 && FLOATP (x) \
253 && FLOATP (x) \ 260 && 0 <= XFLOAT_DATA (x) \
254 && 0 <= XFLOAT_DATA (x) \ 261 && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \
255 && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \ 262 serial = XFLOAT_DATA (x); \
256 serial = XFLOAT_DATA (x); \ 263 else \
257 else \ 264 XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \
258 XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \ 265 } while (0)
259 } \ 266
260 while (0) 267#define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
268 do { \
269 if (STRINGP (bus)) \
270 { \
271 DBusAddressEntry **entries; \
272 int len; \
273 DBusError derror; \
274 dbus_error_init (&derror); \
275 if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
276 XD_ERROR (derror); \
277 /* Cleanup. */ \
278 dbus_error_free (&derror); \
279 dbus_address_entries_free (entries); \
280 } \
281 \
282 else \
283 { \
284 CHECK_SYMBOL (bus); \
285 if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
286 XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
287 /* We do not want to have an autolaunch for the session bus. */ \
288 if (EQ (bus, QCdbus_session_bus) \
289 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) \
290 XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
291 } \
292 } while (0)
293
294#define XD_DBUS_VALIDATE_OBJECT(object, func) \
295 do { \
296 if (!NILP (object)) \
297 { \
298 DBusError derror; \
299 CHECK_STRING (object); \
300 dbus_error_init (&derror); \
301 if (!func (SSDATA (object), &derror)) \
302 XD_ERROR (derror); \
303 /* Cleanup. */ \
304 dbus_error_free (&derror); \
305 } \
306 } while (0)
307
308#if HAVE_DBUS_VALIDATE_BUS_NAME
309#define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
310 XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
311#else
312#define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
313 if (!NILP (bus_name)) CHECK_STRING (bus_name);
314#endif
315
316#if HAVE_DBUS_VALIDATE_PATH
317#define XD_DBUS_VALIDATE_PATH(path) \
318 XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
319#else
320#define XD_DBUS_VALIDATE_PATH(path) \
321 if (!NILP (path)) CHECK_STRING (path);
322#endif
323
324#if HAVE_DBUS_VALIDATE_INTERFACE
325#define XD_DBUS_VALIDATE_INTERFACE(interface) \
326 XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
327#else
328#define XD_DBUS_VALIDATE_INTERFACE(interface) \
329 if (!NILP (interface)) CHECK_STRING (interface);
330#endif
331
332#if HAVE_DBUS_VALIDATE_MEMBER
333#define XD_DBUS_VALIDATE_MEMBER(member) \
334 XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
335#else
336#define XD_DBUS_VALIDATE_MEMBER(member) \
337 if (!NILP (member)) CHECK_STRING (member);
338#endif
261 339
262/* Append to SIGNATURE a copy of X, making sure SIGNATURE does 340/* Append to SIGNATURE a copy of X, making sure SIGNATURE does
263 not become too long. */ 341 not become too long. */
@@ -293,11 +371,6 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
293 { 371 {
294 case DBUS_TYPE_BYTE: 372 case DBUS_TYPE_BYTE:
295 case DBUS_TYPE_UINT16: 373 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); 374 CHECK_NATNUM (object);
302 sprintf (signature, "%c", dtype); 375 sprintf (signature, "%c", dtype);
303 break; 376 break;
@@ -309,14 +382,19 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
309 break; 382 break;
310 383
311 case DBUS_TYPE_INT16: 384 case DBUS_TYPE_INT16:
312 case DBUS_TYPE_INT32:
313 case DBUS_TYPE_INT64:
314 CHECK_NUMBER (object); 385 CHECK_NUMBER (object);
315 sprintf (signature, "%c", dtype); 386 sprintf (signature, "%c", dtype);
316 break; 387 break;
317 388
389 case DBUS_TYPE_UINT32:
390 case DBUS_TYPE_UINT64:
391#ifdef DBUS_TYPE_UNIX_FD
392 case DBUS_TYPE_UNIX_FD:
393#endif
394 case DBUS_TYPE_INT32:
395 case DBUS_TYPE_INT64:
318 case DBUS_TYPE_DOUBLE: 396 case DBUS_TYPE_DOUBLE:
319 CHECK_FLOAT (object); 397 CHECK_NUMBER_OR_FLOAT (object);
320 sprintf (signature, "%c", dtype); 398 sprintf (signature, "%c", dtype);
321 break; 399 break;
322 400
@@ -352,8 +430,8 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
352 } 430 }
353 431
354 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the 432 /* 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 433 only element, the value of this element is used as the
356 element signature. */ 434 array's element signature. */
357 if ((subtype == DBUS_TYPE_SIGNATURE) 435 if ((subtype == DBUS_TYPE_SIGNATURE)
358 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt))) 436 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
359 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt)))) 437 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
@@ -505,9 +583,8 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
505 } 583 }
506 584
507 case DBUS_TYPE_INT32: 585 case DBUS_TYPE_INT32:
508 CHECK_NUMBER (object);
509 { 586 {
510 dbus_int32_t val = XINT (object); 587 dbus_int32_t val = extract_float (object);
511 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 588 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
512 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 589 if (!dbus_message_iter_append_basic (iter, dtype, &val))
513 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 590 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -518,9 +595,8 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
518#ifdef DBUS_TYPE_UNIX_FD 595#ifdef DBUS_TYPE_UNIX_FD
519 case DBUS_TYPE_UNIX_FD: 596 case DBUS_TYPE_UNIX_FD:
520#endif 597#endif
521 CHECK_NATNUM (object);
522 { 598 {
523 dbus_uint32_t val = XFASTINT (object); 599 dbus_uint32_t val = extract_float (object);
524 XD_DEBUG_MESSAGE ("%c %u", dtype, val); 600 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
525 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 601 if (!dbus_message_iter_append_basic (iter, dtype, &val))
526 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 602 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -528,9 +604,8 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
528 } 604 }
529 605
530 case DBUS_TYPE_INT64: 606 case DBUS_TYPE_INT64:
531 CHECK_NUMBER (object);
532 { 607 {
533 dbus_int64_t val = XINT (object); 608 dbus_int64_t val = extract_float (object);
534 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); 609 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
535 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 610 if (!dbus_message_iter_append_basic (iter, dtype, &val))
536 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 611 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -538,19 +613,17 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
538 } 613 }
539 614
540 case DBUS_TYPE_UINT64: 615 case DBUS_TYPE_UINT64:
541 CHECK_NATNUM (object);
542 { 616 {
543 dbus_uint64_t val = XFASTINT (object); 617 dbus_uint64_t val = extract_float (object);
544 XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object)); 618 XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, val);
545 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 619 if (!dbus_message_iter_append_basic (iter, dtype, &val))
546 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 620 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
547 return; 621 return;
548 } 622 }
549 623
550 case DBUS_TYPE_DOUBLE: 624 case DBUS_TYPE_DOUBLE:
551 CHECK_FLOAT (object);
552 { 625 {
553 double val = XFLOAT_DATA (object); 626 double val = extract_float (object);
554 XD_DEBUG_MESSAGE ("%c %f", dtype, val); 627 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
555 if (!dbus_message_iter_append_basic (iter, dtype, &val)) 628 if (!dbus_message_iter_append_basic (iter, dtype, &val))
556 XD_SIGNAL2 (build_string ("Unable to append argument"), object); 629 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -614,7 +687,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
614 dtype, CAR_SAFE (XD_NEXT_VALUE (object))); 687 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
615 688
616 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature, 689 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
617 SDATA (format2 ("%s", object, Qnil))); 690 XD_OBJECT_TO_STRING (object));
618 if (!dbus_message_iter_open_container (iter, dtype, 691 if (!dbus_message_iter_open_container (iter, dtype,
619 signature, &subiter)) 692 signature, &subiter))
620 XD_SIGNAL3 (build_string ("Cannot open container"), 693 XD_SIGNAL3 (build_string ("Cannot open container"),
@@ -627,7 +700,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
627 dtype, CAR_SAFE (XD_NEXT_VALUE (object))); 700 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
628 701
629 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature, 702 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
630 SDATA (format2 ("%s", object, Qnil))); 703 XD_OBJECT_TO_STRING (object));
631 if (!dbus_message_iter_open_container (iter, dtype, 704 if (!dbus_message_iter_open_container (iter, dtype,
632 signature, &subiter)) 705 signature, &subiter))
633 XD_SIGNAL3 (build_string ("Cannot open container"), 706 XD_SIGNAL3 (build_string ("Cannot open container"),
@@ -637,8 +710,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
637 case DBUS_TYPE_STRUCT: 710 case DBUS_TYPE_STRUCT:
638 case DBUS_TYPE_DICT_ENTRY: 711 case DBUS_TYPE_DICT_ENTRY:
639 /* These containers do not require a signature. */ 712 /* These containers do not require a signature. */
640 XD_DEBUG_MESSAGE ("%c %s", dtype, 713 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)) 714 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
643 XD_SIGNAL2 (build_string ("Cannot open container"), 715 XD_SIGNAL2 (build_string ("Cannot open container"),
644 make_number (dtype)); 716 make_number (dtype));
@@ -777,7 +849,7 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
777 result = Fcons (xd_retrieve_arg (subtype, &subiter), result); 849 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
778 dbus_message_iter_next (&subiter); 850 dbus_message_iter_next (&subiter);
779 } 851 }
780 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil))); 852 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
781 RETURN_UNGCPRO (Fnreverse (result)); 853 RETURN_UNGCPRO (Fnreverse (result));
782 } 854 }
783 855
@@ -787,85 +859,37 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
787 } 859 }
788} 860}
789 861
790/* Initialize D-Bus connection. BUS is either a Lisp symbol, :system 862/* Return the number of references of the shared CONNECTION. */
791 or :session, or a string denoting the bus address. It tells which 863static int
792 D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error 864xd_get_connection_references (DBusConnection *connection)
793 when the connection cannot be initialized. */ 865{
866 ptrdiff_t *refcount;
867
868 /* We cannot access the DBusConnection structure, it is not public.
869 But we know, that the reference counter is the first field in
870 that structure. */
871 refcount = (void *) &connection;
872 refcount = (void *) *refcount;
873 return *refcount;
874}
875
876/* Return D-Bus connection address. BUS is either a Lisp symbol,
877 :system or :session, or a string denoting the bus address. */
794static DBusConnection * 878static DBusConnection *
795xd_initialize (Lisp_Object bus, int raise_error) 879xd_get_connection_address (Lisp_Object bus)
796{ 880{
797 DBusConnection *connection; 881 DBusConnection *connection;
798 DBusError derror; 882 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 883
812 /* We do not want to have an autolaunch for the session bus. */ 884 val = CDR_SAFE (Fassoc (bus, Vdbus_registered_buses));
813 if (EQ (bus, QCdbus_session_bus) 885 if (NILP (val))
814 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) 886 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 887 else
829 if (EQ (bus, QCdbus_system_bus)) 888 connection = (DBusConnection *) 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 889
862 if (connection == NULL && raise_error) 890 if (!dbus_connection_get_is_connected (connection))
863 XD_SIGNAL2 (build_string ("No connection to bus"), bus); 891 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
864 892
865 /* Cleanup. */
866 dbus_error_free (&derror);
867
868 /* Return the result. */
869 return connection; 893 return connection;
870} 894}
871 895
@@ -896,8 +920,8 @@ xd_add_watch (DBusWatch *watch, void *data)
896 int fd = xd_find_watch_fd (watch); 920 int fd = xd_find_watch_fd (watch);
897 921
898 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d", 922 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
899 fd, flags & DBUS_WATCH_WRITABLE, 923 fd, flags & DBUS_WATCH_WRITABLE,
900 dbus_watch_get_enabled (watch)); 924 dbus_watch_get_enabled (watch));
901 925
902 if (fd == -1) 926 if (fd == -1)
903 return FALSE; 927 return FALSE;
@@ -929,8 +953,8 @@ xd_remove_watch (DBusWatch *watch, void *data)
929 /* Unset session environment. */ 953 /* Unset session environment. */
930 if (XSYMBOL (QCdbus_session_bus) == data) 954 if (XSYMBOL (QCdbus_session_bus) == data)
931 { 955 {
932 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS"); 956 // XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
933 unsetenv ("DBUS_SESSION_BUS_ADDRESS"); 957 // unsetenv ("DBUS_SESSION_BUS_ADDRESS");
934 } 958 }
935 959
936 if (flags & DBUS_WATCH_WRITABLE) 960 if (flags & DBUS_WATCH_WRITABLE)
@@ -949,23 +973,111 @@ xd_toggle_watch (DBusWatch *watch, void *data)
949 xd_remove_watch (watch, data); 973 xd_remove_watch (watch, data);
950} 974}
951 975
952DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0, 976/* Close connection to D-Bus BUS. */
953 doc: /* Initialize connection to D-Bus BUS. */) 977static void
954 (Lisp_Object bus) 978xd_close_bus (Lisp_Object bus)
979{
980 DBusConnection *connection;
981 Lisp_Object val;
982
983 /* Check whether we are connected. */
984 val = Fassoc (bus, Vdbus_registered_buses);
985 if (NILP (val))
986 return;
987
988 /* Retrieve bus address. */
989 connection = xd_get_connection_address (bus);
990
991 /* Close connection, if there isn't another shared application. */
992 if (xd_get_connection_references (connection) == 1)
993 {
994 XD_DEBUG_MESSAGE ("Close connection to bus %s",
995 XD_OBJECT_TO_STRING (bus));
996 dbus_connection_close (connection);
997 }
998
999 /* Decrement reference count. */
1000 dbus_connection_unref (connection);
1001
1002 /* Remove bus from list of registered buses. */
1003 Vdbus_registered_buses = Fdelete (val, Vdbus_registered_buses);
1004
1005 /* Return. */
1006 return;
1007}
1008
1009DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 2, 0,
1010 doc: /* Establish the connection to D-Bus BUS.
1011
1012BUS can be either the symbol `:system' or the symbol `:session', or it
1013can be a string denoting the address of the corresponding bus. For
1014the system and session buses, this function is called when loading
1015`dbus.el', there is no need to call it again.
1016
1017The function returns a number, which counts the connections this Emacs
1018session has established to the BUS under the same unique name (see
1019`dbus-get-unique-name'). It depends on the libraries Emacs is linked
1020with, and on the environment Emacs is running. For example, if Emacs
1021is linked with the gtk toolkit, and it runs in a GTK-aware environment
1022like Gnome, another connection might already be established.
1023
1024When PRIVATE is non-nil, a new connection is established instead of
1025reusing an existing one. It results in a new unique name at the bus.
1026This can be used, if it is necessary to distinguish from another
1027connection used in the same Emacs process, like the one established by
1028GTK+. It should be used with care for at least the `:system' and
1029`:session' buses, because other Emacs Lisp packages might already use
1030this connection to those buses. */)
1031 (Lisp_Object bus, Lisp_Object private)
955{ 1032{
956 DBusConnection *connection; 1033 DBusConnection *connection;
957 void *busp; 1034 DBusError derror;
1035 Lisp_Object val;
1036 int refcount;
958 1037
959 /* Check parameter. */ 1038 /* Check parameter. */
960 if (SYMBOLP (bus)) 1039 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
961 busp = XSYMBOL (bus); 1040
962 else if (STRINGP (bus)) 1041 /* Close bus if it is already open. */
963 busp = XSTRING (bus); 1042 xd_close_bus (bus);
1043
1044 /* Initialize. */
1045 dbus_error_init (&derror);
1046
1047 /* Open the connection. */
1048 if (STRINGP (bus))
1049 if (NILP (private))
1050 connection = dbus_connection_open (SSDATA (bus), &derror);
1051 else
1052 connection = dbus_connection_open_private (SSDATA (bus), &derror);
1053
964 else 1054 else
965 wrong_type_argument (intern ("D-Bus"), bus); 1055 if (NILP (private))
1056 connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
1057 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1058 &derror);
1059 else
1060 connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
1061 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1062 &derror);
1063
1064 if (dbus_error_is_set (&derror))
1065 XD_ERROR (derror);
966 1066
967 /* Open a connection to the bus. */ 1067 if (connection == NULL)
968 connection = xd_initialize (bus, TRUE); 1068 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
1069
1070 /* If it is not the system or session bus, we must register
1071 ourselves. Otherwise, we have called dbus_bus_get, which has
1072 configured us to exit if the connection closes - we undo this
1073 setting. */
1074 if (STRINGP (bus))
1075 dbus_bus_register (connection, &derror);
1076 else
1077 dbus_connection_set_exit_on_disconnect (connection, FALSE);
1078
1079 if (dbus_error_is_set (&derror))
1080 XD_ERROR (derror);
969 1081
970 /* Add the watch functions. We pass also the bus as data, in order 1082 /* Add the watch functions. We pass also the bus as data, in order
971 to distinguish between the buses in xd_remove_watch. */ 1083 to distinguish between the buses in xd_remove_watch. */
@@ -973,36 +1085,27 @@ DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
973 xd_add_watch, 1085 xd_add_watch,
974 xd_remove_watch, 1086 xd_remove_watch,
975 xd_toggle_watch, 1087 xd_toggle_watch,
976 busp, NULL)) 1088 SYMBOLP (bus)
1089 ? (void *) XSYMBOL (bus)
1090 : (void *) XSTRING (bus),
1091 NULL))
977 XD_SIGNAL1 (build_string ("Cannot add watch functions")); 1092 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
978 1093
979 /* Add bus to list of registered buses. */ 1094 /* Add bus to list of registered buses. */
980 Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses); 1095 XSETFASTINT (val, connection);
1096 Vdbus_registered_buses = Fcons (Fcons (bus, val), Vdbus_registered_buses);
981 1097
982 /* We do not want to abort. */ 1098 /* We do not want to abort. */
983 putenv ((char *) "DBUS_FATAL_WARNINGS=0"); 1099 putenv ((char *) "DBUS_FATAL_WARNINGS=0");
984 1100
985 /* Return. */ 1101 /* Cleanup. */
986 return Qnil; 1102 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 1103
1004 /* Return. */ 1104 /* Return reference counter. */
1005 return Qnil; 1105 refcount = xd_get_connection_references (connection);
1106 XD_DEBUG_MESSAGE ("Bus %s, Reference counter %d",
1107 XD_OBJECT_TO_STRING (bus), refcount);
1108 return make_number (refcount);
1006} 1109}
1007 1110
1008DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name, 1111DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
@@ -1013,8 +1116,11 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1013 DBusConnection *connection; 1116 DBusConnection *connection;
1014 const char *name; 1117 const char *name;
1015 1118
1016 /* Open a connection to the bus. */ 1119 /* Check parameter. */
1017 connection = xd_initialize (bus, TRUE); 1120 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1121
1122 /* Retrieve bus address. */
1123 connection = xd_get_connection_address (bus);
1018 1124
1019 /* Request the name. */ 1125 /* Request the name. */
1020 name = dbus_bus_get_unique_name (connection); 1126 name = dbus_bus_get_unique_name (connection);
@@ -1025,341 +1131,241 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1025 return build_string (name); 1131 return build_string (name);
1026} 1132}
1027 1133
1028DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0, 1134DEFUN ("dbus-message-internal", Fdbus_message_internal, Sdbus_message_internal,
1029 doc: /* Call METHOD on the D-Bus BUS. 1135 4, MANY, 0,
1030 1136 doc: /* Send a D-Bus message.
1031BUS is either a Lisp symbol, `:system' or `:session', or a string 1137This is an internal function, it shall not be used outside dbus.el.
1032denoting the bus address. 1138
1033 1139The following usages are expected:
1034SERVICE is the D-Bus service name to be used. PATH is the D-Bus 1140
1035object path SERVICE is registered at. INTERFACE is an interface 1141`dbus-call-method', `dbus-call-method-asynchronously':
1036offered by SERVICE. It must provide METHOD. 1142 \(dbus-message-internal
1037 1143 dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1038If the parameter `:timeout' is given, the following integer TIMEOUT 1144 &optional :timeout TIMEOUT &rest ARGS)
1039specifies the maximum number of milliseconds the method call must 1145
1040return. The default value is 25,000. If the method call doesn't 1146`dbus-send-signal':
1041return in time, a D-Bus error is raised. 1147 \(dbus-message-internal
1042 1148 dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1043All other arguments ARGS are passed to METHOD as arguments. They are 1149
1044converted into D-Bus types via the following rules: 1150`dbus-method-return-internal':
1045 1151 \(dbus-message-internal
1046 t and nil => DBUS_TYPE_BOOLEAN 1152 dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1047 number => DBUS_TYPE_UINT32 1153
1048 integer => DBUS_TYPE_INT32 1154`dbus-method-error-internal':
1049 float => DBUS_TYPE_DOUBLE 1155 \(dbus-message-internal
1050 string => DBUS_TYPE_STRING 1156 dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1051 list => DBUS_TYPE_ARRAY 1157
1052 1158usage: (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) 1159 (ptrdiff_t nargs, Lisp_Object *args)
1099{ 1160{
1100 Lisp_Object bus, service, path, interface, method; 1161 Lisp_Object message_type, bus, service, handler;
1162 Lisp_Object path = Qnil;
1163 Lisp_Object interface = Qnil;
1164 Lisp_Object member = Qnil;
1101 Lisp_Object result; 1165 Lisp_Object result;
1102 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 1166 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1103 DBusConnection *connection; 1167 DBusConnection *connection;
1104 DBusMessage *dmessage; 1168 DBusMessage *dmessage;
1105 DBusMessage *reply;
1106 DBusMessageIter iter; 1169 DBusMessageIter iter;
1107 DBusError derror;
1108 unsigned int dtype; 1170 unsigned int dtype;
1171 unsigned int mtype;
1172 dbus_uint32_t serial = 0;
1109 int timeout = -1; 1173 int timeout = -1;
1110 ptrdiff_t i = 5; 1174 ptrdiff_t count;
1111 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; 1175 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1112 1176
1177 /* Initialize parameters. */
1178 message_type = args[0];
1179 bus = args[1];
1180 service = args[2];
1181 handler = Qnil;
1182
1183 CHECK_NATNUM (message_type);
1184 mtype = XFASTINT (message_type);
1185 if ((mtype <= DBUS_MESSAGE_TYPE_INVALID) || (mtype >= DBUS_NUM_MESSAGE_TYPES))
1186 XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
1187
1188 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1189 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1190 {
1191 path = args[3];
1192 interface = args[4];
1193 member = args[5];
1194 if (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1195 handler = args[6];
1196 count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
1197 }
1198 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1199 {
1200 XD_CHECK_DBUS_SERIAL (args[3], serial);
1201 count = 4;
1202 }
1203
1113 /* Check parameters. */ 1204 /* Check parameters. */
1114 bus = args[0]; 1205 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1115 service = args[1]; 1206 XD_DBUS_VALIDATE_BUS_NAME (service);
1116 path = args[2]; 1207 if (nargs < count)
1117 interface = args[3]; 1208 xsignal2 (Qwrong_number_of_arguments,
1118 method = args[4]; 1209 Qdbus_message_internal,
1119 1210 make_number (nargs));
1120 CHECK_STRING (service); 1211
1121 CHECK_STRING (path); 1212 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1122 CHECK_STRING (interface); 1213 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1123 CHECK_STRING (method); 1214 {
1124 GCPRO5 (bus, service, path, interface, method); 1215 XD_DBUS_VALIDATE_PATH (path);
1125 1216 XD_DBUS_VALIDATE_INTERFACE (interface);
1126 XD_DEBUG_MESSAGE ("%s %s %s %s", 1217 XD_DBUS_VALIDATE_MEMBER (member);
1127 SDATA (service), 1218 if (!NILP (handler) && (!FUNCTIONP (handler)))
1128 SDATA (path), 1219 wrong_type_argument (Qinvalid_function, handler);
1129 SDATA (interface), 1220 }
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 1221
1144 /* Check for timeout parameter. */ 1222 /* Protect Lisp variables. */
1145 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout))) 1223 GCPRO6 (bus, service, path, interface, member, handler);
1224
1225 /* Trace parameters. */
1226 switch (mtype)
1146 { 1227 {
1147 CHECK_NATNUM (args[i+1]); 1228 case DBUS_MESSAGE_TYPE_METHOD_CALL:
1148 timeout = XFASTINT (args[i+1]); 1229 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1149 i = i+2; 1230 XD_MESSAGE_TYPE_TO_STRING (mtype),
1231 XD_OBJECT_TO_STRING (bus),
1232 XD_OBJECT_TO_STRING (service),
1233 XD_OBJECT_TO_STRING (path),
1234 XD_OBJECT_TO_STRING (interface),
1235 XD_OBJECT_TO_STRING (member),
1236 XD_OBJECT_TO_STRING (handler));
1237 break;
1238 case DBUS_MESSAGE_TYPE_SIGNAL:
1239 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1240 XD_MESSAGE_TYPE_TO_STRING (mtype),
1241 XD_OBJECT_TO_STRING (bus),
1242 XD_OBJECT_TO_STRING (service),
1243 XD_OBJECT_TO_STRING (path),
1244 XD_OBJECT_TO_STRING (interface),
1245 XD_OBJECT_TO_STRING (member));
1246 break;
1247 default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1248 XD_DEBUG_MESSAGE ("%s %s %s %u",
1249 XD_MESSAGE_TYPE_TO_STRING (mtype),
1250 XD_OBJECT_TO_STRING (bus),
1251 XD_OBJECT_TO_STRING (service),
1252 serial);
1150 } 1253 }
1151 1254
1152 /* Initialize parameter list of message. */ 1255 /* Retrieve bus address. */
1153 dbus_message_iter_init_append (dmessage, &iter); 1256 connection = xd_get_connection_address (bus);
1154 1257
1155 /* Append parameters to the message. */ 1258 /* Create the D-Bus message. */
1156 for (; i < nargs; ++i) 1259 dmessage = dbus_message_new (mtype);
1260 if (dmessage == NULL)
1157 { 1261 {
1158 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); 1262 UNGCPRO;
1159 if (XD_DBUS_TYPE_P (args[i])) 1263 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1264 }
1265
1266 if (STRINGP (service))
1267 {
1268 if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
1269 /* Set destination. */
1160 { 1270 {
1161 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1271 if (!dbus_message_set_destination (dmessage, SSDATA (service)))
1162 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]); 1272 {
1163 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4, 1273 UNGCPRO;
1164 SDATA (format2 ("%s", args[i], Qnil)), 1274 XD_SIGNAL2 (build_string ("Unable to set the destination"),
1165 SDATA (format2 ("%s", args[i+1], Qnil))); 1275 service);
1166 ++i; 1276 }
1167 } 1277 }
1278
1168 else 1279 else
1280 /* Set destination for unicast signals. */
1169 { 1281 {
1170 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1282 Lisp_Object uname;
1171 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
1172 SDATA (format2 ("%s", args[i], Qnil)));
1173 }
1174 1283
1175 /* Check for valid signature. We use DBUS_TYPE_INVALID as 1284 /* If it is the same unique name as we are registered at the
1176 indication that there is no parent type. */ 1285 bus or an unknown name, we regard it as broadcast message
1177 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]); 1286 due to backward compatibility. */
1287 if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
1288 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1289 else
1290 uname = Qnil;
1178 1291
1179 xd_append_arg (dtype, args[i], &iter); 1292 if (STRINGP (uname)
1293 && (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
1294 != 0)
1295 && (!dbus_message_set_destination (dmessage, SSDATA (service))))
1296 {
1297 UNGCPRO;
1298 XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1299 service);
1300 }
1301 }
1180 } 1302 }
1181 1303
1182 /* Send the message. */ 1304 /* Set message parameters. */
1183 dbus_error_init (&derror); 1305 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1184 reply = dbus_connection_send_with_reply_and_block (connection, 1306 || (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 { 1307 {
1203 /* Loop over the parameters of the D-Bus reply message. Construct a 1308 if ((!dbus_message_set_path (dmessage, SSDATA (path)))
1204 Lisp list, which is returned by `dbus-call-method'. */ 1309 || (!dbus_message_set_interface (dmessage, SSDATA (interface)))
1205 while ((dtype = dbus_message_iter_get_arg_type (&iter)) 1310 || (!dbus_message_set_member (dmessage, SSDATA (member))))
1206 != DBUS_TYPE_INVALID)
1207 { 1311 {
1208 result = Fcons (xd_retrieve_arg (dtype, &iter), result); 1312 UNGCPRO;
1209 dbus_message_iter_next (&iter); 1313 XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1210 } 1314 }
1211 } 1315 }
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 1316
1245If the parameter `:timeout' is given, the following integer TIMEOUT 1317 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1246specifies the maximum number of milliseconds the method call must 1318 {
1247return. The default value is 25,000. If the method call doesn't 1319 if (!dbus_message_set_reply_serial (dmessage, serial))
1248return in time, a D-Bus error is raised. 1320 {
1249 1321 UNGCPRO;
1250All other arguments ARGS are passed to METHOD as arguments. They are 1322 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1251converted into D-Bus types via the following rules: 1323 }
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 1324
1294 /* Check parameters. */ 1325 if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
1295 bus = args[0]; 1326 && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
1296 service = args[1]; 1327 {
1297 path = args[2]; 1328 UNGCPRO;
1298 interface = args[3]; 1329 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1299 method = args[4]; 1330 }
1300 handler = args[5]; 1331 }
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 1332
1327 /* Check for timeout parameter. */ 1333 /* Check for timeout parameter. */
1328 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout))) 1334 if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
1329 { 1335 {
1330 CHECK_NATNUM (args[i+1]); 1336 CHECK_NATNUM (args[count+1]);
1331 timeout = XFASTINT (args[i+1]); 1337 timeout = XFASTINT (args[count+1]);
1332 i = i+2; 1338 count = count+2;
1333 } 1339 }
1334 1340
1335 /* Initialize parameter list of message. */ 1341 /* Initialize parameter list of message. */
1336 dbus_message_iter_init_append (dmessage, &iter); 1342 dbus_message_iter_init_append (dmessage, &iter);
1337 1343
1338 /* Append parameters to the message. */ 1344 /* Append parameters to the message. */
1339 for (; i < nargs; ++i) 1345 for (; count < nargs; ++count)
1340 { 1346 {
1341 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); 1347 dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
1342 if (XD_DBUS_TYPE_P (args[i])) 1348 if (XD_DBUS_TYPE_P (args[count]))
1343 { 1349 {
1344 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1350 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1345 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]); 1351 XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
1346 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4, 1352 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
1347 SDATA (format2 ("%s", args[i], Qnil)), 1353 XD_OBJECT_TO_STRING (args[count]),
1348 SDATA (format2 ("%s", args[i+1], Qnil))); 1354 XD_OBJECT_TO_STRING (args[count+1]));
1349 ++i; 1355 ++count;
1350 } 1356 }
1351 else 1357 else
1352 { 1358 {
1353 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 1359 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1354 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4, 1360 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
1355 SDATA (format2 ("%s", args[i], Qnil))); 1361 XD_OBJECT_TO_STRING (args[count]));
1356 } 1362 }
1357 1363
1358 /* Check for valid signature. We use DBUS_TYPE_INVALID as 1364 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1359 indication that there is no parent type. */ 1365 indication that there is no parent type. */
1360 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]); 1366 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[count]);
1361 1367
1362 xd_append_arg (dtype, args[i], &iter); 1368 xd_append_arg (dtype, args[count], &iter);
1363 } 1369 }
1364 1370
1365 if (!NILP (handler)) 1371 if (!NILP (handler))
@@ -1368,11 +1374,15 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
1368 message queue. */ 1374 message queue. */
1369 if (!dbus_connection_send_with_reply (connection, dmessage, 1375 if (!dbus_connection_send_with_reply (connection, dmessage,
1370 NULL, timeout)) 1376 NULL, timeout))
1371 XD_SIGNAL1 (build_string ("Cannot send message")); 1377 {
1378 UNGCPRO;
1379 XD_SIGNAL1 (build_string ("Cannot send message"));
1380 }
1372 1381
1373 /* The result is the key in Vdbus_registered_objects_table. */ 1382 /* The result is the key in Vdbus_registered_objects_table. */
1374 serial = dbus_message_get_serial (dmessage); 1383 serial = dbus_message_get_serial (dmessage);
1375 result = list2 (bus, make_fixnum_or_float (serial)); 1384 result = list3 (QCdbus_registered_serial,
1385 bus, make_fixnum_or_float (serial));
1376 1386
1377 /* Create a hash table entry. */ 1387 /* Create a hash table entry. */
1378 Fputhash (result, handler, Vdbus_registered_objects_table); 1388 Fputhash (result, handler, Vdbus_registered_objects_table);
@@ -1382,12 +1392,15 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
1382 /* Send the message. The message is just added to the outgoing 1392 /* Send the message. The message is just added to the outgoing
1383 message queue. */ 1393 message queue. */
1384 if (!dbus_connection_send (connection, dmessage, NULL)) 1394 if (!dbus_connection_send (connection, dmessage, NULL))
1385 XD_SIGNAL1 (build_string ("Cannot send message")); 1395 {
1396 UNGCPRO;
1397 XD_SIGNAL1 (build_string ("Cannot send message"));
1398 }
1386 1399
1387 result = Qnil; 1400 result = Qnil;
1388 } 1401 }
1389 1402
1390 XD_DEBUG_MESSAGE ("Message sent"); 1403 XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
1391 1404
1392 /* Cleanup. */ 1405 /* Cleanup. */
1393 dbus_message_unref (dmessage); 1406 dbus_message_unref (dmessage);
@@ -1396,300 +1409,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
1396 RETURN_UNGCPRO (result); 1409 RETURN_UNGCPRO (result);
1397} 1410}
1398 1411
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. 1412/* Read one queued incoming message of the D-Bus BUS.
1694 BUS is either a Lisp symbol, :system or :session, or a string denoting 1413 BUS is either a Lisp symbol, :system or :session, or a string denoting
1695 the bus address. */ 1414 the bus address. */
@@ -1702,7 +1421,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1702 DBusMessage *dmessage; 1421 DBusMessage *dmessage;
1703 DBusMessageIter iter; 1422 DBusMessageIter iter;
1704 unsigned int dtype; 1423 unsigned int dtype;
1705 int mtype; 1424 unsigned int mtype;
1706 dbus_uint32_t serial; 1425 dbus_uint32_t serial;
1707 unsigned int ui_serial; 1426 unsigned int ui_serial;
1708 const char *uname, *path, *interface, *member; 1427 const char *uname, *path, *interface, *member;
@@ -1744,23 +1463,19 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1744 member = dbus_message_get_member (dmessage); 1463 member = dbus_message_get_member (dmessage);
1745 1464
1746 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s", 1465 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1747 (mtype == DBUS_MESSAGE_TYPE_INVALID) 1466 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, 1467 ui_serial, uname, path, interface, member,
1757 SDATA (format2 ("%s", args, Qnil))); 1468 XD_OBJECT_TO_STRING (args));
1469
1470 if (mtype == DBUS_MESSAGE_TYPE_INVALID)
1471 goto cleanup;
1758 1472
1759 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) 1473 else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1760 || (mtype == DBUS_MESSAGE_TYPE_ERROR)) 1474 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1761 { 1475 {
1762 /* Search for a registered function of the message. */ 1476 /* Search for a registered function of the message. */
1763 key = list2 (bus, make_fixnum_or_float (serial)); 1477 key = list3 (QCdbus_registered_serial, bus,
1478 make_fixnum_or_float (serial));
1764 value = Fgethash (key, Vdbus_registered_objects_table, Qnil); 1479 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1765 1480
1766 /* There shall be exactly one entry. Construct an event. */ 1481 /* There shall be exactly one entry. Construct an event. */
@@ -1777,7 +1492,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1777 event.arg = Fcons (value, args); 1492 event.arg = Fcons (value, args);
1778 } 1493 }
1779 1494
1780 else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */ 1495 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
1781 { 1496 {
1782 /* Vdbus_registered_objects_table requires non-nil interface and 1497 /* Vdbus_registered_objects_table requires non-nil interface and
1783 member. */ 1498 member. */
@@ -1785,7 +1500,10 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1785 goto cleanup; 1500 goto cleanup;
1786 1501
1787 /* Search for a registered function of the message. */ 1502 /* Search for a registered function of the message. */
1788 key = list3 (bus, build_string (interface), build_string (member)); 1503 key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1504 ? QCdbus_registered_method
1505 : QCdbus_registered_signal,
1506 bus, build_string (interface), build_string (member));
1789 value = Fgethash (key, Vdbus_registered_objects_table, Qnil); 1507 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1790 1508
1791 /* Loop over the registered functions. Construct an event. */ 1509 /* Loop over the registered functions. Construct an event. */
@@ -1835,8 +1553,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1835 /* Store it into the input event queue. */ 1553 /* Store it into the input event queue. */
1836 kbd_buffer_store_event (&event); 1554 kbd_buffer_store_event (&event);
1837 1555
1838 XD_DEBUG_MESSAGE ("Event stored: %s", 1556 XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
1839 SDATA (format2 ("%s", event.arg, Qnil)));
1840 1557
1841 /* Cleanup. */ 1558 /* Cleanup. */
1842 cleanup: 1559 cleanup:
@@ -1851,8 +1568,8 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1851static Lisp_Object 1568static Lisp_Object
1852xd_read_message (Lisp_Object bus) 1569xd_read_message (Lisp_Object bus)
1853{ 1570{
1854 /* Open a connection to the bus. */ 1571 /* Retrieve bus address. */
1855 DBusConnection *connection = xd_initialize (bus, TRUE); 1572 DBusConnection *connection = xd_get_connection_address (bus);
1856 1573
1857 /* Non blocking read of the next available message. */ 1574 /* Non blocking read of the next available message. */
1858 dbus_connection_read_write (connection, 0); 1575 dbus_connection_read_write (connection, 0);
@@ -1869,14 +1586,16 @@ xd_read_queued_messages (int fd, void *data, int for_read)
1869{ 1586{
1870 Lisp_Object busp = Vdbus_registered_buses; 1587 Lisp_Object busp = Vdbus_registered_buses;
1871 Lisp_Object bus = Qnil; 1588 Lisp_Object bus = Qnil;
1589 Lisp_Object key;
1872 1590
1873 /* Find bus related to fd. */ 1591 /* Find bus related to fd. */
1874 if (data != NULL) 1592 if (data != NULL)
1875 while (!NILP (busp)) 1593 while (!NILP (busp))
1876 { 1594 {
1877 if ((SYMBOLP (CAR_SAFE (busp)) && XSYMBOL (CAR_SAFE (busp)) == data) 1595 key = CAR_SAFE (CAR_SAFE (busp));
1878 || (STRINGP (CAR_SAFE (busp)) && XSTRING (CAR_SAFE (busp)) == data)) 1596 if ((SYMBOLP (key) && XSYMBOL (key) == data)
1879 bus = CAR_SAFE (busp); 1597 || (STRINGP (key) && XSTRING (key) == data))
1598 bus = key;
1880 busp = CDR_SAFE (busp); 1599 busp = CDR_SAFE (busp);
1881 } 1600 }
1882 1601
@@ -1889,327 +1608,6 @@ xd_read_queued_messages (int fd, void *data, int for_read)
1889 xd_in_read_queued_messages = 0; 1608 xd_in_read_queued_messages = 0;
1890} 1609}
1891 1610
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 1611
2214void 1612void
2215syms_of_dbusbind (void) 1613syms_of_dbusbind (void)
@@ -2218,35 +1616,11 @@ syms_of_dbusbind (void)
2218 DEFSYM (Qdbus_init_bus, "dbus-init-bus"); 1616 DEFSYM (Qdbus_init_bus, "dbus-init-bus");
2219 defsubr (&Sdbus_init_bus); 1617 defsubr (&Sdbus_init_bus);
2220 1618
2221 DEFSYM (Qdbus_close_bus, "dbus-close-bus");
2222 defsubr (&Sdbus_close_bus);
2223
2224 DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name"); 1619 DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
2225 defsubr (&Sdbus_get_unique_name); 1620 defsubr (&Sdbus_get_unique_name);
2226 1621
2227 DEFSYM (Qdbus_call_method, "dbus-call-method"); 1622 DEFSYM (Qdbus_message_internal, "dbus-message-internal");
2228 defsubr (&Sdbus_call_method); 1623 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 1624
2251 DEFSYM (Qdbus_error, "dbus-error"); 1625 DEFSYM (Qdbus_error, "dbus-error");
2252 Fput (Qdbus_error, Qerror_conditions, 1626 Fput (Qdbus_error, Qerror_conditions,
@@ -2256,13 +1630,6 @@ syms_of_dbusbind (void)
2256 1630
2257 DEFSYM (QCdbus_system_bus, ":system"); 1631 DEFSYM (QCdbus_system_bus, ":system");
2258 DEFSYM (QCdbus_session_bus, ":session"); 1632 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"); 1633 DEFSYM (QCdbus_timeout, ":timeout");
2267 DEFSYM (QCdbus_type_byte, ":byte"); 1634 DEFSYM (QCdbus_type_byte, ":byte");
2268 DEFSYM (QCdbus_type_boolean, ":boolean"); 1635 DEFSYM (QCdbus_type_boolean, ":boolean");
@@ -2276,19 +1643,73 @@ syms_of_dbusbind (void)
2276 DEFSYM (QCdbus_type_string, ":string"); 1643 DEFSYM (QCdbus_type_string, ":string");
2277 DEFSYM (QCdbus_type_object_path, ":object-path"); 1644 DEFSYM (QCdbus_type_object_path, ":object-path");
2278 DEFSYM (QCdbus_type_signature, ":signature"); 1645 DEFSYM (QCdbus_type_signature, ":signature");
2279
2280#ifdef DBUS_TYPE_UNIX_FD 1646#ifdef DBUS_TYPE_UNIX_FD
2281 DEFSYM (QCdbus_type_unix_fd, ":unix-fd"); 1647 DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
2282#endif 1648#endif
2283
2284 DEFSYM (QCdbus_type_array, ":array"); 1649 DEFSYM (QCdbus_type_array, ":array");
2285 DEFSYM (QCdbus_type_variant, ":variant"); 1650 DEFSYM (QCdbus_type_variant, ":variant");
2286 DEFSYM (QCdbus_type_struct, ":struct"); 1651 DEFSYM (QCdbus_type_struct, ":struct");
2287 DEFSYM (QCdbus_type_dict_entry, ":dict-entry"); 1652 DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
1653 DEFSYM (QCdbus_registered_serial, ":serial");
1654 DEFSYM (QCdbus_registered_method, ":method");
1655 DEFSYM (QCdbus_registered_signal, ":signal");
1656
1657 DEFVAR_LISP ("dbus-compiled-version",
1658 Vdbus_compiled_version,
1659 doc: /* The version of D-Bus Emacs is compiled against. */);
1660#ifdef DBUS_VERSION_STRING
1661 Vdbus_compiled_version = make_pure_c_string (DBUS_VERSION_STRING);
1662#else
1663 Vdbus_compiled_version = Qnil;
1664#endif
1665
1666 DEFVAR_LISP ("dbus-runtime-version",
1667 Vdbus_runtime_version,
1668 doc: /* The version of D-Bus Emacs runs with. */);
1669 {
1670#ifdef DBUS_VERSION
1671 int major, minor, micro;
1672 char s[1024];
1673 dbus_get_version (&major, &minor, &micro);
1674 snprintf (s, sizeof s, "%d.%d.%d", major, minor, micro);
1675 Vdbus_runtime_version = make_string (s, strlen (s));
1676#else
1677 Vdbus_runtime_version = Qnil;
1678#endif
1679 }
1680
1681 DEFVAR_LISP ("dbus-message-type-invalid",
1682 Vdbus_message_type_invalid,
1683 doc: /* This value is never a valid message type. */);
1684 Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
1685
1686 DEFVAR_LISP ("dbus-message-type-method-call",
1687 Vdbus_message_type_method_call,
1688 doc: /* Message type of a method call message. */);
1689 Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
1690
1691 DEFVAR_LISP ("dbus-message-type-method-return",
1692 Vdbus_message_type_method_return,
1693 doc: /* Message type of a method return message. */);
1694 Vdbus_message_type_method_return
1695 = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1696
1697 DEFVAR_LISP ("dbus-message-type-error",
1698 Vdbus_message_type_error,
1699 doc: /* Message type of an error reply message. */);
1700 Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
1701
1702 DEFVAR_LISP ("dbus-message-type-signal",
1703 Vdbus_message_type_signal,
1704 doc: /* Message type of a signal message. */);
1705 Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
2288 1706
2289 DEFVAR_LISP ("dbus-registered-buses", 1707 DEFVAR_LISP ("dbus-registered-buses",
2290 Vdbus_registered_buses, 1708 Vdbus_registered_buses,
2291 doc: /* List of D-Bus buses we are polling for messages. */); 1709 doc: /* Alist of D-Bus buses we are polling for messages.
1710
1711The key is the symbol or string of the bus, and the value is the
1712connection address. */);
2292 Vdbus_registered_buses = Qnil; 1713 Vdbus_registered_buses = Qnil;
2293 1714
2294 DEFVAR_LISP ("dbus-registered-objects-table", 1715 DEFVAR_LISP ("dbus-registered-objects-table",
@@ -2299,27 +1720,28 @@ There are two different uses of the hash table: for accessing
2299registered interfaces properties, targeted by signals or method calls, 1720registered interfaces properties, targeted by signals or method calls,
2300and for calling handlers in case of non-blocking method call returns. 1721and for calling handlers in case of non-blocking method call returns.
2301 1722
2302In the first case, the key in the hash table is the list (BUS 1723In the first case, the key in the hash table is the list (TYPE BUS
2303INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or 1724INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
1725`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
2304`:session', or a string denoting the bus address. INTERFACE is a 1726`:session', or a string denoting the bus address. INTERFACE is a
2305string which denotes a D-Bus interface, and MEMBER, also a string, is 1727string which denotes a D-Bus interface, and MEMBER, also a string, is
2306either a method, a signal or a property INTERFACE is offering. All 1728either a method, a signal or a property INTERFACE is offering. All
2307arguments but BUS must not be nil. 1729arguments but BUS must not be nil.
2308 1730
2309The value in the hash table is a list of quadruple lists 1731The value in the hash table is a list of quadruple lists \((UNAME
2310\((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...). 1732SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
2311SERVICE is the service name as registered, UNAME is the corresponding 1733registered, UNAME is the corresponding unique name. In case of
2312unique name. In case of registered methods and properties, UNAME is 1734registered methods and properties, UNAME is nil. PATH is the object
2313nil. PATH is the object path of the sending object. All of them can 1735path 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 1736wildcard 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, 1737message, which matches the key criteria, arrives (TYPE `:method' and
2316arrives (methods and signals), or a cons cell containing the value of 1738`:signal'), or a cons cell containing the value of the property (TYPE
2317the property. 1739`:property').
2318 1740
2319For signals, there is also a fifth element RULE, which keeps the match 1741For entries of type `:signal', there is also a fifth element RULE,
2320string the signal is registered with. 1742which keeps the match string the signal is registered with.
2321 1743
2322In the second case, the key in the hash table is the list (BUS 1744In 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 1745SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
2324string denoting the bus address. SERIAL is the serial number of the 1746string denoting the bus address. SERIAL is the serial number of the
2325non-blocking method call, a reply is expected. Both arguments must 1747non-blocking method call, a reply is expected. Both arguments must
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-17 01:32:03 +0000