X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/26e06f4464c58704889bdc536edc25b73e8c0179..1b9ac1453d4263d7e3b6cb52a2207163fe2649c8:/src/dbusbind.c
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 22e64bf004..d83ef4a596 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1,5 +1,5 @@
/* Elisp bindings for D-Bus.
- Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -22,6 +22,7 @@ along with GNU Emacs. If not, see . */
#include
#include
#include
+#include
#include "lisp.h"
#include "frame.h"
#include "termhooks.h"
@@ -29,6 +30,7 @@ along with GNU Emacs. If not, see . */
/* Subroutines. */
+Lisp_Object Qdbus_init_bus;
Lisp_Object Qdbus_get_unique_name;
Lisp_Object Qdbus_call_method;
Lisp_Object Qdbus_call_method_asynchronously;
@@ -58,15 +60,44 @@ Lisp_Object QCdbus_type_array, QCdbus_type_variant;
Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
/* Hash table which keeps function definitions. */
-Lisp_Object Vdbus_registered_functions_table;
+Lisp_Object Vdbus_registered_objects_table;
/* Whether to debug D-Bus. */
Lisp_Object Vdbus_debug;
+/* Whether we are reading a D-Bus event. */
+int xd_in_read_queued_messages = 0;
+
/* We use "xd_" and "XD_" as prefix for all internal symbols, because
we don't want to poison other namespaces with "dbus_". */
+/* Raise a signal. If we are reading events, we cannot signal; we
+ throw to xd_read_queued_messages then. */
+#define XD_SIGNAL1(arg) \
+ do { \
+ if (xd_in_read_queued_messages) \
+ Fthrow (Qdbus_error, Qnil); \
+ else \
+ xsignal1 (Qdbus_error, arg); \
+ } while (0)
+
+#define XD_SIGNAL2(arg1, arg2) \
+ do { \
+ if (xd_in_read_queued_messages) \
+ Fthrow (Qdbus_error, Qnil); \
+ else \
+ xsignal2 (Qdbus_error, arg1, arg2); \
+ } while (0)
+
+#define XD_SIGNAL3(arg1, arg2, arg3) \
+ do { \
+ if (xd_in_read_queued_messages) \
+ Fthrow (Qdbus_error, Qnil); \
+ else \
+ xsignal3 (Qdbus_error, arg1, arg2, arg3); \
+ } while (0)
+
/* Raise a Lisp error from a D-Bus ERROR. */
#define XD_ERROR(error) \
do { \
@@ -76,7 +107,7 @@ Lisp_Object Vdbus_debug;
/* Remove the trailing newline. */ \
if (strchr (s, '\n') != NULL) \
s[strlen (s) - 1] = '\0'; \
- xsignal1 (Qdbus_error, build_string (s)); \
+ XD_SIGNAL1 (build_string (s)); \
} while (0)
/* Macros for debugging. In order to enable them, build with
@@ -94,7 +125,7 @@ Lisp_Object Vdbus_debug;
if (!valid_lisp_object_p (object)) \
{ \
XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
- xsignal1 (Qdbus_error, build_string ("Assertion failure")); \
+ XD_SIGNAL1 (build_string ("Assertion failure")); \
} \
} while (0)
@@ -126,30 +157,38 @@ Lisp_Object Vdbus_debug;
|| (type == DBUS_TYPE_OBJECT_PATH) \
|| (type == DBUS_TYPE_SIGNATURE))
+/* This was a macro. On Solaris 2.11 it was said to compile for
+ hours, when optimzation is enabled. So we have transferred it into
+ a function. */
/* Determine the DBusType of a given Lisp symbol. OBJECT must be one
of the predefined D-Bus type symbols. */
-#define XD_SYMBOL_TO_DBUS_TYPE(object) \
- ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE \
- : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN \
- : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16 \
- : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16 \
- : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32 \
- : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32 \
- : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64 \
- : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64 \
- : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE \
- : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING \
- : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH \
- : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE \
- : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY \
- : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT \
- : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT \
- : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY \
- : DBUS_TYPE_INVALID)
+static int
+xd_symbol_to_dbus_type (object)
+ Lisp_Object object;
+{
+ return
+ ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
+ : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
+ : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
+ : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
+ : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
+ : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
+ : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
+ : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
+ : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
+ : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
+ : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
+ : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
+ : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
+ : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
+ : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
+ : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
+ : DBUS_TYPE_INVALID);
+}
/* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
#define XD_DBUS_TYPE_P(object) \
- (SYMBOLP (object) && ((XD_SYMBOL_TO_DBUS_TYPE (object) != DBUS_TYPE_INVALID)))
+ (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
/* Determine the DBusType of a given Lisp OBJECT. It is used to
convert Lisp objects, being arguments of `dbus-call-method' or
@@ -161,10 +200,13 @@ Lisp_Object Vdbus_debug;
: (INTEGERP (object)) ? DBUS_TYPE_INT32 \
: (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
: (STRINGP (object)) ? DBUS_TYPE_STRING \
- : (XD_DBUS_TYPE_P (object)) ? XD_SYMBOL_TO_DBUS_TYPE (object) \
- : (CONSP (object)) ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
- ? XD_SYMBOL_TO_DBUS_TYPE (CAR_SAFE (object)) \
- : DBUS_TYPE_ARRAY) \
+ : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
+ : (CONSP (object)) \
+ ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
+ ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
+ ? DBUS_TYPE_ARRAY \
+ : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
+ : DBUS_TYPE_ARRAY) \
: DBUS_TYPE_INVALID)
/* Return a list pointer which does not have a Lisp symbol as car. */
@@ -178,7 +220,7 @@ Lisp_Object Vdbus_debug;
a type symbol. PARENT_TYPE is the DBusType of a container this
signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
-void
+static void
xd_signature (signature, dtype, parent_type, object)
char *signature;
unsigned int dtype, parent_type;
@@ -298,7 +340,7 @@ xd_signature (signature, dtype, parent_type, object)
strcat (signature, x);
elt = CDR_SAFE (XD_NEXT_VALUE (elt));
}
- sprintf (signature, "%s%c", signature, DBUS_STRUCT_END_CHAR);
+ strcat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
break;
case DBUS_TYPE_DICT_ENTRY:
@@ -335,7 +377,7 @@ xd_signature (signature, dtype, parent_type, object)
CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
/* Closing signature. */
- sprintf (signature, "%s%c", signature, DBUS_DICT_ENTRY_END_CHAR);
+ strcat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
break;
default:
@@ -350,7 +392,7 @@ xd_signature (signature, dtype, parent_type, object)
objects, being arguments of `dbus-call-method' or
`dbus-send-signal', into corresponding C values appended as
arguments to a D-Bus message. */
-void
+static void
xd_append_arg (dtype, object, iter)
unsigned int dtype;
Lisp_Object object;
@@ -367,8 +409,7 @@ xd_append_arg (dtype, object, iter)
unsigned char val = XUINT (object) & 0xFF;
XD_DEBUG_MESSAGE ("%c %d", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), object);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
@@ -377,8 +418,7 @@ xd_append_arg (dtype, object, iter)
dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
if (!dbus_message_iter_append_basic (iter, dtype, &val))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), object);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
@@ -387,8 +427,7 @@ xd_append_arg (dtype, object, iter)
dbus_int16_t val = XINT (object);
XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), object);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
@@ -397,8 +436,7 @@ xd_append_arg (dtype, object, iter)
dbus_uint16_t val = XUINT (object);
XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), object);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
@@ -407,8 +445,7 @@ xd_append_arg (dtype, object, iter)
dbus_int32_t val = XINT (object);
XD_DEBUG_MESSAGE ("%c %d", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), object);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
@@ -417,8 +454,7 @@ xd_append_arg (dtype, object, iter)
dbus_uint32_t val = XUINT (object);
XD_DEBUG_MESSAGE ("%c %u", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), object);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
@@ -427,8 +463,7 @@ xd_append_arg (dtype, object, iter)
dbus_int64_t val = XINT (object);
XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), object);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
@@ -437,18 +472,18 @@ xd_append_arg (dtype, object, iter)
dbus_uint64_t val = XUINT (object);
XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), object);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_DOUBLE:
- XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT_DATA (object));
- if (!dbus_message_iter_append_basic (iter, dtype,
- &XFLOAT_DATA (object)))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), object);
- return;
+ {
+ double val = XFLOAT_DATA (object);
+ XD_DEBUG_MESSAGE ("%c %f", dtype, val);
+ if (!dbus_message_iter_append_basic (iter, dtype, &val))
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
+ return;
+ }
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
@@ -457,8 +492,7 @@ xd_append_arg (dtype, object, iter)
char *val = SDATA (Fstring_make_unibyte (object));
XD_DEBUG_MESSAGE ("%c %s", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), object);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
}
@@ -506,9 +540,8 @@ xd_append_arg (dtype, object, iter)
SDATA (format2 ("%s", object, Qnil)));
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
- xsignal3 (Qdbus_error,
- build_string ("Cannot open container"),
- make_number (dtype), build_string (signature));
+ XD_SIGNAL3 (build_string ("Cannot open container"),
+ make_number (dtype), build_string (signature));
break;
case DBUS_TYPE_VARIANT:
@@ -520,9 +553,8 @@ xd_append_arg (dtype, object, iter)
SDATA (format2 ("%s", object, Qnil)));
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
- xsignal3 (Qdbus_error,
- build_string ("Cannot open container"),
- make_number (dtype), build_string (signature));
+ XD_SIGNAL3 (build_string ("Cannot open container"),
+ make_number (dtype), build_string (signature));
break;
case DBUS_TYPE_STRUCT:
@@ -531,9 +563,8 @@ xd_append_arg (dtype, object, iter)
XD_DEBUG_MESSAGE ("%c %s", dtype,
SDATA (format2 ("%s", object, Qnil)));
if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
- xsignal2 (Qdbus_error,
- build_string ("Cannot open container"),
- make_number (dtype));
+ XD_SIGNAL2 (build_string ("Cannot open container"),
+ make_number (dtype));
break;
}
@@ -550,9 +581,8 @@ xd_append_arg (dtype, object, iter)
/* Close the subiteration. */
if (!dbus_message_iter_close_container (iter, &subiter))
- xsignal2 (Qdbus_error,
- build_string ("Cannot close container"),
- make_number (dtype));
+ XD_SIGNAL2 (build_string ("Cannot close container"),
+ make_number (dtype));
}
}
@@ -560,7 +590,7 @@ xd_append_arg (dtype, object, iter)
a converted Lisp object. The type DTYPE of the argument of the
D-Bus message must be a valid DBusType. Compound D-Bus types
result always in a Lisp list. */
-Lisp_Object
+static Lisp_Object
xd_retrieve_arg (dtype, iter)
unsigned int dtype;
DBusMessageIter *iter;
@@ -586,6 +616,13 @@ xd_retrieve_arg (dtype, iter)
}
case DBUS_TYPE_INT16:
+ {
+ dbus_int16_t val;
+ dbus_message_iter_get_basic (iter, &val);
+ XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ return make_number (val);
+ }
+
case DBUS_TYPE_UINT16:
{
dbus_uint16_t val;
@@ -595,19 +632,29 @@ xd_retrieve_arg (dtype, iter)
}
case DBUS_TYPE_INT32:
+ {
+ dbus_int32_t val;
+ dbus_message_iter_get_basic (iter, &val);
+ XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ return make_fixnum_or_float (val);
+ }
+
case DBUS_TYPE_UINT32:
{
- /* Assignment to EMACS_INT stops GCC whining about limited
- range of data type. */
dbus_uint32_t val;
- EMACS_INT val1;
dbus_message_iter_get_basic (iter, &val);
XD_DEBUG_MESSAGE ("%c %d", dtype, val);
- val1 = val;
- return make_fixnum_or_float (val1);
+ return make_fixnum_or_float (val);
}
case DBUS_TYPE_INT64:
+ {
+ dbus_int64_t val;
+ dbus_message_iter_get_basic (iter, &val);
+ XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ return make_fixnum_or_float (val);
+ }
+
case DBUS_TYPE_UINT64:
{
dbus_uint64_t val;
@@ -664,7 +711,7 @@ xd_retrieve_arg (dtype, iter)
/* Initialize D-Bus connection. BUS is a Lisp symbol, either :system
or :session. It tells which D-Bus to be initialized. */
-DBusConnection *
+static DBusConnection *
xd_initialize (bus)
Lisp_Object bus;
{
@@ -673,8 +720,13 @@ xd_initialize (bus)
/* Parameter check. */
CHECK_SYMBOL (bus);
- if (!((EQ (bus, QCdbus_system_bus)) || (EQ (bus, QCdbus_session_bus))))
- xsignal2 (Qdbus_error, build_string ("Wrong bus name"), bus);
+ if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
+ XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
+
+ /* We do not want to have an autolaunch for the session bus. */
+ if (EQ (bus, QCdbus_session_bus)
+ && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus);
/* Open a connection to the bus. */
dbus_error_init (&derror);
@@ -688,12 +740,102 @@ xd_initialize (bus)
XD_ERROR (derror);
if (connection == NULL)
- xsignal2 (Qdbus_error, build_string ("No connection"), bus);
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus);
+
+ /* Cleanup. */
+ dbus_error_free (&derror);
/* Return the result. */
return connection;
}
+
+/* Add connection file descriptor to input_wait_mask, in order to
+ let select() detect, whether a new message has been arrived. */
+dbus_bool_t
+xd_add_watch (watch, data)
+ DBusWatch *watch;
+ void *data;
+{
+ /* We check only for incoming data. */
+ if (dbus_watch_get_flags (watch) & DBUS_WATCH_READABLE)
+ {
+#if HAVE_DBUS_WATCH_GET_UNIX_FD
+ /* TODO: Reverse these on Win32, which prefers the opposite. */
+ int fd = dbus_watch_get_unix_fd(watch);
+ if (fd == -1)
+ fd = dbus_watch_get_socket(watch);
+#else
+ int fd = dbus_watch_get_fd(watch);
+#endif
+ XD_DEBUG_MESSAGE ("%d", fd);
+
+ if (fd == -1)
+ return FALSE;
+
+ /* Add the file descriptor to input_wait_mask. */
+ add_keyboard_wait_descriptor (fd);
+ }
+
+ /* Return. */
+ return TRUE;
+}
+
+/* Remove connection file descriptor from input_wait_mask. */
+void
+xd_remove_watch (watch, data)
+ DBusWatch *watch;
+ void *data;
+{
+ /* We check only for incoming data. */
+ if (dbus_watch_get_flags (watch) & DBUS_WATCH_READABLE)
+ {
+#if HAVE_DBUS_WATCH_GET_UNIX_FD
+ /* TODO: Reverse these on Win32, which prefers the opposite. */
+ int fd = dbus_watch_get_unix_fd(watch);
+ if (fd == -1)
+ fd = dbus_watch_get_socket(watch);
+#else
+ int fd = dbus_watch_get_fd(watch);
+#endif
+ XD_DEBUG_MESSAGE ("%d", fd);
+
+ if (fd == -1)
+ return;
+
+ /* Remove the file descriptor from input_wait_mask. */
+ delete_keyboard_wait_descriptor (fd);
+ }
+
+ /* Return. */
+ return;
+}
+
+DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
+ doc: /* Initialize connection to D-Bus BUS.
+This is an internal function, it shall not be used outside dbus.el. */)
+ (bus)
+ Lisp_Object bus;
+{
+ DBusConnection *connection;
+
+ /* Check parameters. */
+ CHECK_SYMBOL (bus);
+
+ /* Open a connection to the bus. */
+ connection = xd_initialize (bus);
+
+ /* Add the watch functions. */
+ if (!dbus_connection_set_watch_functions (connection,
+ xd_add_watch,
+ xd_remove_watch,
+ NULL, NULL, NULL))
+ XD_SIGNAL1 (build_string ("Cannot add watch functions"));
+
+ /* Return. */
+ return Qnil;
+}
+
DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1, 1, 0,
doc: /* Return the unique name of Emacs registered at D-Bus BUS. */)
@@ -712,7 +854,7 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
/* Request the name. */
name = dbus_bus_get_unique_name (connection);
if (name == NULL)
- xsignal1 (Qdbus_error, build_string ("No unique name available"));
+ XD_SIGNAL1 (build_string ("No unique name available"));
/* Return. */
return build_string (name);
@@ -728,8 +870,8 @@ object path SERVICE is registered at. INTERFACE is an interface
offered by SERVICE. It must provide METHOD.
If the parameter `:timeout' is given, the following integer TIMEOUT
-specifies the maximun number of milliseconds the method call must
-return. The default value is 25.000. If the method call doesn't
+specifies the maximum number of milliseconds the method call must
+return. The default value is 25,000. If the method call doesn't
return in time, a D-Bus error is raised.
All other arguments ARGS are passed to METHOD as arguments. They are
@@ -785,9 +927,7 @@ object is returned instead of a list containing this single Lisp object.
=> "i686"
-usage: (dbus-call-method
- BUS SERVICE PATH INTERFACE METHOD
- &optional :timeout TIMEOUT &rest ARGS) */)
+usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
(nargs, args)
int nargs;
register Lisp_Object *args;
@@ -835,7 +975,7 @@ usage: (dbus-call-method
SDATA (method));
UNGCPRO;
if (dmessage == NULL)
- xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
/* Check for timeout parameter. */
if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
@@ -886,7 +1026,7 @@ usage: (dbus-call-method
XD_ERROR (derror);
if (reply == NULL)
- xsignal1 (Qdbus_error, build_string ("No reply"));
+ XD_SIGNAL1 (build_string ("No reply"));
XD_DEBUG_MESSAGE ("Message sent");
@@ -911,6 +1051,7 @@ usage: (dbus-call-method
}
/* Cleanup. */
+ dbus_error_free (&derror);
dbus_message_unref (dmessage);
dbus_message_unref (reply);
@@ -933,11 +1074,12 @@ object path SERVICE is registered at. INTERFACE is an interface
offered by SERVICE. It must provide METHOD.
HANDLER is a Lisp function, which is called when the corresponding
-return message has arrived.
+return message has arrived. If HANDLER is nil, no return message will
+be expected.
If the parameter `:timeout' is given, the following integer TIMEOUT
-specifies the maximun number of milliseconds the method call must
-return. The default value is 25.000. If the method call doesn't
+specifies the maximum number of milliseconds the method call must
+return. The default value is 25,000. If the method call doesn't
return in time, a D-Bus error is raised.
All other arguments ARGS are passed to METHOD as arguments. They are
@@ -953,9 +1095,9 @@ converted into D-Bus types via the following rules:
All arguments can be preceded by a type symbol. For details about
type symbols, see Info node `(dbus)Type Conversion'.
-The function returns a key into the hash table
-`dbus-registered-functions-table'. The corresponding entry in the
-hash table is removed, when the return message has been arrived, and
+Unless HANDLER is nil, the function returns a key into the hash table
+`dbus-registered-objects-table'. The corresponding entry in the hash
+table is removed, when the return message has been arrived, and
HANDLER is called.
Example:
@@ -969,9 +1111,7 @@ Example:
-| i686
-usage: (dbus-call-method-asynchronously
- BUS SERVICE PATH INTERFACE METHOD HANDLER
- &optional :timeout TIMEOUT &rest ARGS) */)
+usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
(nargs, args)
int nargs;
register Lisp_Object *args;
@@ -1000,7 +1140,7 @@ usage: (dbus-call-method-asynchronously
CHECK_STRING (path);
CHECK_STRING (interface);
CHECK_STRING (method);
- if (!FUNCTIONP (handler))
+ if (!NILP (handler) && !FUNCTIONP (handler))
wrong_type_argument (intern ("functionp"), handler);
GCPRO6 (bus, service, path, interface, method, handler);
@@ -1019,7 +1159,7 @@ usage: (dbus-call-method-asynchronously
SDATA (interface),
SDATA (method));
if (dmessage == NULL)
- xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
/* Check for timeout parameter. */
if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
@@ -1059,18 +1199,34 @@ usage: (dbus-call-method-asynchronously
xd_append_arg (dtype, args[i], &iter);
}
- /* Send the message. The message is just added to the outgoing
- message queue. */
- if (!dbus_connection_send_with_reply (connection, dmessage, NULL, timeout))
- xsignal1 (Qdbus_error, build_string ("Cannot send message"));
+ if (!NILP (handler))
+ {
+ /* Send the message. The message is just added to the outgoing
+ message queue. */
+ if (!dbus_connection_send_with_reply (connection, dmessage,
+ NULL, timeout))
+ XD_SIGNAL1 (build_string ("Cannot send message"));
- XD_DEBUG_MESSAGE ("Message sent");
+ /* The result is the key in Vdbus_registered_objects_table. */
+ result = (list2 (bus, make_number (dbus_message_get_serial (dmessage))));
- /* The result is the key in Vdbus_registered_functions_table. */
- result = (list2 (bus, make_number (dbus_message_get_serial (dmessage))));
+ /* Create a hash table entry. */
+ Fputhash (result, handler, Vdbus_registered_objects_table);
+ }
+ else
+ {
+ /* Send the message. The message is just added to the outgoing
+ message queue. */
+ if (!dbus_connection_send (connection, dmessage, NULL))
+ XD_SIGNAL1 (build_string ("Cannot send message"));
- /* Create a hash table entry. */
- Fputhash (result, handler, Vdbus_registered_functions_table);
+ result = Qnil;
+ }
+
+ /* Flush connection to ensure the message is handled. */
+ dbus_connection_flush (connection);
+
+ XD_DEBUG_MESSAGE ("Message sent");
/* Cleanup. */
dbus_message_unref (dmessage);
@@ -1109,7 +1265,7 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
CHECK_STRING (service);
GCPRO3 (bus, serial, service);
- XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial), SDATA (service));
+ XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service));
/* Open a connection to the bus. */
connection = xd_initialize (bus);
@@ -1121,8 +1277,7 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
|| (!dbus_message_set_destination (dmessage, SDATA (service))))
{
UNGCPRO;
- xsignal1 (Qdbus_error,
- build_string ("Unable to create a return message"));
+ XD_SIGNAL1 (build_string ("Unable to create a return message"));
}
UNGCPRO;
@@ -1160,7 +1315,7 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- xsignal1 (Qdbus_error, build_string ("Cannot send message"));
+ XD_SIGNAL1 (build_string ("Cannot send message"));
/* Flush connection to ensure the message is handled. */
dbus_connection_flush (connection);
@@ -1204,7 +1359,7 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
CHECK_STRING (service);
GCPRO3 (bus, serial, service);
- XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial), SDATA (service));
+ XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service));
/* Open a connection to the bus. */
connection = xd_initialize (bus);
@@ -1217,8 +1372,7 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
|| (!dbus_message_set_destination (dmessage, SDATA (service))))
{
UNGCPRO;
- xsignal1 (Qdbus_error,
- build_string ("Unable to create a error message"));
+ XD_SIGNAL1 (build_string ("Unable to create a error message"));
}
UNGCPRO;
@@ -1256,7 +1410,7 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- xsignal1 (Qdbus_error, build_string ("Cannot send message"));
+ XD_SIGNAL1 (build_string ("Cannot send message"));
/* Flush connection to ensure the message is handled. */
dbus_connection_flush (connection);
@@ -1341,7 +1495,7 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
SDATA (signal));
UNGCPRO;
if (dmessage == NULL)
- xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
/* Initialize parameter list of message. */
dbus_message_iter_init_append (dmessage, &iter);
@@ -1376,7 +1530,7 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- xsignal1 (Qdbus_error, build_string ("Cannot send message"));
+ XD_SIGNAL1 (build_string ("Cannot send message"));
/* Flush connection to ensure the message is handled. */
dbus_connection_flush (connection);
@@ -1390,9 +1544,46 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
return Qt;
}
+/* Check, whether there is pending input in the message queue of the
+ D-Bus BUS. BUS is a Lisp symbol, either :system or :session. */
+int
+xd_get_dispatch_status (bus)
+ Lisp_Object bus;
+{
+ DBusConnection *connection;
+
+ /* Open a connection to the bus. */
+ connection = xd_initialize (bus);
+
+ /* Non blocking read of the next available message. */
+ dbus_connection_read_write (connection, 0);
+
+ /* Return. */
+ return
+ (dbus_connection_get_dispatch_status (connection)
+ == DBUS_DISPATCH_DATA_REMAINS)
+ ? TRUE : FALSE;
+}
+
+/* Check for queued incoming messages from the system and session buses. */
+int
+xd_pending_messages ()
+{
+
+ /* Vdbus_registered_objects_table will be initialized as hash table
+ in dbus.el. When this package isn't loaded yet, it doesn't make
+ sense to handle D-Bus messages. */
+ return (HASH_TABLE_P (Vdbus_registered_objects_table)
+ ? (xd_get_dispatch_status (QCdbus_system_bus)
+ || ((getenv ("DBUS_SESSION_BUS_ADDRESS") != NULL)
+ ? xd_get_dispatch_status (QCdbus_session_bus)
+ : FALSE))
+ : FALSE);
+}
+
/* Read queued incoming message of the D-Bus BUS. BUS is a Lisp
symbol, either :system or :session. */
-Lisp_Object
+static Lisp_Object
xd_read_message (bus)
Lisp_Object bus;
{
@@ -1465,14 +1656,14 @@ xd_read_message (bus)
{
/* Search for a registered function of the message. */
key = list2 (bus, make_number (serial));
- value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
+ value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* There shall be exactly one entry. Construct an event. */
if (NILP (value))
goto cleanup;
/* Remove the entry. */
- Fremhash (key, Vdbus_registered_functions_table);
+ Fremhash (key, Vdbus_registered_objects_table);
/* Construct an event. */
EVENT_INIT (event);
@@ -1483,14 +1674,14 @@ xd_read_message (bus)
else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
{
- /* Vdbus_registered_functions_table requires non-nil interface
- and member. */
+ /* Vdbus_registered_objects_table requires non-nil interface and
+ member. */
if ((interface == NULL) || (member == NULL))
goto cleanup;
/* Search for a registered function of the message. */
key = list3 (bus, build_string (interface), build_string (member));
- value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
+ value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* Loop over the registered functions. Construct an event. */
while (!NILP (value))
@@ -1542,8 +1733,10 @@ xd_read_message (bus)
XD_DEBUG_MESSAGE ("Event stored: %s",
SDATA (format2 ("%s", event.arg, Qnil)));
+ /* Cleanup. */
cleanup:
dbus_message_unref (dmessage);
+
RETURN_UNGCPRO (Qnil);
}
@@ -1552,16 +1745,16 @@ void
xd_read_queued_messages ()
{
- /* Vdbus_registered_functions_table will be initialized as hash
- table in dbus.el. When this package isn't loaded yet, it doesn't
- make sense to handle D-Bus messages. Furthermore, we ignore all
- Lisp errors during the call. */
- if (HASH_TABLE_P (Vdbus_registered_functions_table))
+ /* Vdbus_registered_objects_table will be initialized as hash table
+ in dbus.el. When this package isn't loaded yet, it doesn't make
+ sense to handle D-Bus messages. Furthermore, we ignore all Lisp
+ errors during the call. */
+ if (HASH_TABLE_P (Vdbus_registered_objects_table))
{
- internal_condition_case_1 (xd_read_message, QCdbus_system_bus,
- Qerror, Fidentity);
- internal_condition_case_1 (xd_read_message, QCdbus_session_bus,
- Qerror, Fidentity);
+ xd_in_read_queued_messages = 1;
+ internal_catch (Qdbus_error, xd_read_message, QCdbus_system_bus);
+ internal_catch (Qdbus_error, xd_read_message, QCdbus_session_bus);
+ xd_in_read_queued_messages = 0;
}
}
@@ -1647,7 +1840,7 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG
/* When there is no unique name, we mark it with an empty
string. */
if (NILP (uname))
- uname = build_string ("");
+ uname = empty_unibyte_string;
}
else
uname = service;
@@ -1696,16 +1889,19 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG
XD_ERROR (derror);
}
+ /* Cleanup. */
+ dbus_error_free (&derror);
+
XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
}
/* Create a hash table entry. */
key = list3 (bus, interface, signal);
key1 = list4 (uname, service, path, handler);
- value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
+ value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
if (NILP (Fmember (key1, value)))
- Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
+ Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
/* Return object. */
RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
@@ -1754,15 +1950,17 @@ used for composing the returning D-Bus message. */)
if (dbus_error_is_set (&derror))
XD_ERROR (derror);
- /* Create a hash table entry. */
+ /* Create a hash table entry. We use nil for the unique name,
+ because the method might be called from anybody. */
key = list3 (bus, interface, method);
key1 = list4 (Qnil, service, path, handler);
- value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
+ value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
- /* We use nil for the unique name, because the method might be
- called from everybody. */
if (NILP (Fmember (key1, value)))
- Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
+ Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
+
+ /* Cleanup. */
+ dbus_error_free (&derror);
/* Return object. */
return list2 (key, list3 (service, path, handler));
@@ -1773,122 +1971,128 @@ void
syms_of_dbusbind ()
{
- Qdbus_get_unique_name = intern ("dbus-get-unique-name");
+ Qdbus_init_bus = intern_c_string ("dbus-init-bus");
+ staticpro (&Qdbus_init_bus);
+ defsubr (&Sdbus_init_bus);
+
+ Qdbus_get_unique_name = intern_c_string ("dbus-get-unique-name");
staticpro (&Qdbus_get_unique_name);
defsubr (&Sdbus_get_unique_name);
- Qdbus_call_method = intern ("dbus-call-method");
+ Qdbus_call_method = intern_c_string ("dbus-call-method");
staticpro (&Qdbus_call_method);
defsubr (&Sdbus_call_method);
- Qdbus_call_method_asynchronously = intern ("dbus-call-method-asynchronously");
+ Qdbus_call_method_asynchronously = intern_c_string ("dbus-call-method-asynchronously");
staticpro (&Qdbus_call_method_asynchronously);
defsubr (&Sdbus_call_method_asynchronously);
- Qdbus_method_return_internal = intern ("dbus-method-return-internal");
+ Qdbus_method_return_internal = intern_c_string ("dbus-method-return-internal");
staticpro (&Qdbus_method_return_internal);
defsubr (&Sdbus_method_return_internal);
- Qdbus_method_error_internal = intern ("dbus-method-error-internal");
+ Qdbus_method_error_internal = intern_c_string ("dbus-method-error-internal");
staticpro (&Qdbus_method_error_internal);
defsubr (&Sdbus_method_error_internal);
- Qdbus_send_signal = intern ("dbus-send-signal");
+ Qdbus_send_signal = intern_c_string ("dbus-send-signal");
staticpro (&Qdbus_send_signal);
defsubr (&Sdbus_send_signal);
- Qdbus_register_signal = intern ("dbus-register-signal");
+ Qdbus_register_signal = intern_c_string ("dbus-register-signal");
staticpro (&Qdbus_register_signal);
defsubr (&Sdbus_register_signal);
- Qdbus_register_method = intern ("dbus-register-method");
+ Qdbus_register_method = intern_c_string ("dbus-register-method");
staticpro (&Qdbus_register_method);
defsubr (&Sdbus_register_method);
- Qdbus_error = intern ("dbus-error");
+ Qdbus_error = intern_c_string ("dbus-error");
staticpro (&Qdbus_error);
Fput (Qdbus_error, Qerror_conditions,
list2 (Qdbus_error, Qerror));
Fput (Qdbus_error, Qerror_message,
- build_string ("D-Bus error"));
+ make_pure_c_string ("D-Bus error"));
- QCdbus_system_bus = intern (":system");
+ QCdbus_system_bus = intern_c_string (":system");
staticpro (&QCdbus_system_bus);
- QCdbus_session_bus = intern (":session");
+ QCdbus_session_bus = intern_c_string (":session");
staticpro (&QCdbus_session_bus);
- QCdbus_timeout = intern (":timeout");
+ QCdbus_timeout = intern_c_string (":timeout");
staticpro (&QCdbus_timeout);
- QCdbus_type_byte = intern (":byte");
+ QCdbus_type_byte = intern_c_string (":byte");
staticpro (&QCdbus_type_byte);
- QCdbus_type_boolean = intern (":boolean");
+ QCdbus_type_boolean = intern_c_string (":boolean");
staticpro (&QCdbus_type_boolean);
- QCdbus_type_int16 = intern (":int16");
+ QCdbus_type_int16 = intern_c_string (":int16");
staticpro (&QCdbus_type_int16);
- QCdbus_type_uint16 = intern (":uint16");
+ QCdbus_type_uint16 = intern_c_string (":uint16");
staticpro (&QCdbus_type_uint16);
- QCdbus_type_int32 = intern (":int32");
+ QCdbus_type_int32 = intern_c_string (":int32");
staticpro (&QCdbus_type_int32);
- QCdbus_type_uint32 = intern (":uint32");
+ QCdbus_type_uint32 = intern_c_string (":uint32");
staticpro (&QCdbus_type_uint32);
- QCdbus_type_int64 = intern (":int64");
+ QCdbus_type_int64 = intern_c_string (":int64");
staticpro (&QCdbus_type_int64);
- QCdbus_type_uint64 = intern (":uint64");
+ QCdbus_type_uint64 = intern_c_string (":uint64");
staticpro (&QCdbus_type_uint64);
- QCdbus_type_double = intern (":double");
+ QCdbus_type_double = intern_c_string (":double");
staticpro (&QCdbus_type_double);
- QCdbus_type_string = intern (":string");
+ QCdbus_type_string = intern_c_string (":string");
staticpro (&QCdbus_type_string);
- QCdbus_type_object_path = intern (":object-path");
+ QCdbus_type_object_path = intern_c_string (":object-path");
staticpro (&QCdbus_type_object_path);
- QCdbus_type_signature = intern (":signature");
+ QCdbus_type_signature = intern_c_string (":signature");
staticpro (&QCdbus_type_signature);
- QCdbus_type_array = intern (":array");
+ QCdbus_type_array = intern_c_string (":array");
staticpro (&QCdbus_type_array);
- QCdbus_type_variant = intern (":variant");
+ QCdbus_type_variant = intern_c_string (":variant");
staticpro (&QCdbus_type_variant);
- QCdbus_type_struct = intern (":struct");
+ QCdbus_type_struct = intern_c_string (":struct");
staticpro (&QCdbus_type_struct);
- QCdbus_type_dict_entry = intern (":dict-entry");
+ QCdbus_type_dict_entry = intern_c_string (":dict-entry");
staticpro (&QCdbus_type_dict_entry);
- DEFVAR_LISP ("dbus-registered-functions-table",
- &Vdbus_registered_functions_table,
+ DEFVAR_LISP ("dbus-registered-objects-table",
+ &Vdbus_registered_objects_table,
doc: /* Hash table of registered functions for D-Bus.
-There are two different uses of the hash table: for calling registered
-functions, targeted by signals or method calls, and for calling
-handlers in case of non-blocking method call returns.
+There are two different uses of the hash table: for accessing
+registered interfaces properties, targeted by signals or method calls,
+and for calling handlers in case of non-blocking method call returns.
In the first case, the key in the hash table is the list (BUS
INTERFACE MEMBER). BUS is either the symbol `:system' or the symbol
`:session'. INTERFACE is a string which denotes a D-Bus interface,
-and MEMBER, also a string, is either a method or a signal INTERFACE is
-offering. All arguments but BUS must not be nil.
+and MEMBER, also a string, is either a method, a signal or a property
+INTERFACE is offering. All arguments but BUS must not be nil.
The value in the hash table is a list of quadruple lists
-\((UNAME SERVICE PATH HANDLER) (UNAME SERVICE PATH HANDLER) ...).
+\((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...).
SERVICE is the service name as registered, UNAME is the corresponding
-unique name. PATH is the object path of the sending object. All of
-them can be nil, which means a wildcard then. HANDLER is the function
-to be called when a D-Bus message, which matches the key criteria,
-arrives.
+unique name. In case of registered methods and properties, UNAME is
+nil. PATH is the object path of the sending object. All of them can
+be nil, which means a wildcard then. OBJECT is either the handler to
+be called when a D-Bus message, which matches the key criteria,
+arrives (methods and signals), or a cons cell containing the value of
+the property.
In the second case, the key in the hash table is the list (BUS SERIAL).
BUS is either the symbol `:system' or the symbol `:session'. SERIAL
@@ -1896,9 +2100,9 @@ is the serial number of the non-blocking method call, a reply is
expected. Both arguments must not be nil. The value in the hash
table is HANDLER, the function to be called when the D-Bus reply
message arrives. */);
- /* We initialize Vdbus_registered_functions_table in dbus.el,
- because we need to define a hash table function first. */
- Vdbus_registered_functions_table = Qnil;
+ /* We initialize Vdbus_registered_objects_table in dbus.el, because
+ we need to define a hash table function first. */
+ Vdbus_registered_objects_table = Qnil;
DEFVAR_LISP ("dbus-debug", &Vdbus_debug,
doc: /* If non-nil, debug messages of D-Bus bindings are raised. */);
@@ -1908,7 +2112,7 @@ message arrives. */);
Vdbus_debug = Qnil;
#endif
- Fprovide (intern ("dbusbind"), Qnil);
+ Fprovide (intern_c_string ("dbusbind"), Qnil);
}