X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/603f0bf0d9bfffaca599687d9a142112a9d4eee7..25a48bd06bd5979d201cddde99e2dec1eb54c184:/src/dbusbind.c
diff --git a/src/dbusbind.c b/src/dbusbind.c
index f4a5c6887d..7e5104026c 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1,5 +1,5 @@
/* Elisp bindings for D-Bus.
- Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+ Copyright (C) 2007-2011 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -16,26 +16,29 @@ GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see . */
-#include "config.h"
+#include
#ifdef HAVE_DBUS
-#include
#include
#include
+#include
#include "lisp.h"
#include "frame.h"
#include "termhooks.h"
#include "keyboard.h"
+#include "process.h"
/* Subroutines. */
Lisp_Object Qdbus_init_bus;
+Lisp_Object Qdbus_close_bus;
Lisp_Object Qdbus_get_unique_name;
Lisp_Object Qdbus_call_method;
Lisp_Object Qdbus_call_method_asynchronously;
Lisp_Object Qdbus_method_return_internal;
Lisp_Object Qdbus_method_error_internal;
Lisp_Object Qdbus_send_signal;
+Lisp_Object Qdbus_register_service;
Lisp_Object Qdbus_register_signal;
Lisp_Object Qdbus_register_method;
@@ -48,6 +51,17 @@ Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
/* Lisp symbol for method call timeout. */
Lisp_Object QCdbus_timeout;
+/* Lisp symbols for name request flags. */
+Lisp_Object QCdbus_request_name_allow_replacement;
+Lisp_Object QCdbus_request_name_replace_existing;
+Lisp_Object QCdbus_request_name_do_not_queue;
+
+/* Lisp symbols for name request replies. */
+Lisp_Object QCdbus_request_name_reply_primary_owner;
+Lisp_Object QCdbus_request_name_reply_in_queue;
+Lisp_Object QCdbus_request_name_reply_exists;
+Lisp_Object QCdbus_request_name_reply_already_owner;
+
/* Lisp symbols of D-Bus types. */
Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
@@ -55,15 +69,12 @@ Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
Lisp_Object QCdbus_type_double, QCdbus_type_string;
Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
+#ifdef DBUS_TYPE_UNIX_FD
+Lisp_Object QCdbus_type_unix_fd;
+#endif
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;
-
-/* Whether to debug D-Bus. */
-Lisp_Object Vdbus_debug;
-
/* Whether we are reading a D-Bus event. */
int xd_in_read_queued_messages = 0;
@@ -110,7 +121,7 @@ int xd_in_read_queued_messages = 0;
} while (0)
/* Macros for debugging. In order to enable them, build with
- "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'". */
+ "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
#ifdef DBUS_DEBUG
#define XD_DEBUG_MESSAGE(...) \
do { \
@@ -142,6 +153,22 @@ int xd_in_read_queued_messages = 0;
#endif
/* Check whether TYPE is a basic DBusType. */
+#ifdef DBUS_TYPE_UNIX_FD
+#define XD_BASIC_DBUS_TYPE(type) \
+ ((type == DBUS_TYPE_BYTE) \
+ || (type == DBUS_TYPE_BOOLEAN) \
+ || (type == DBUS_TYPE_INT16) \
+ || (type == DBUS_TYPE_UINT16) \
+ || (type == DBUS_TYPE_INT32) \
+ || (type == DBUS_TYPE_UINT32) \
+ || (type == DBUS_TYPE_INT64) \
+ || (type == DBUS_TYPE_UINT64) \
+ || (type == DBUS_TYPE_DOUBLE) \
+ || (type == DBUS_TYPE_STRING) \
+ || (type == DBUS_TYPE_OBJECT_PATH) \
+ || (type == DBUS_TYPE_SIGNATURE) \
+ || (type == DBUS_TYPE_UNIX_FD))
+#else
#define XD_BASIC_DBUS_TYPE(type) \
((type == DBUS_TYPE_BYTE) \
|| (type == DBUS_TYPE_BOOLEAN) \
@@ -155,6 +182,7 @@ int xd_in_read_queued_messages = 0;
|| (type == DBUS_TYPE_STRING) \
|| (type == DBUS_TYPE_OBJECT_PATH) \
|| (type == DBUS_TYPE_SIGNATURE))
+#endif
/* 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
@@ -162,8 +190,7 @@ int xd_in_read_queued_messages = 0;
/* Determine the DBusType of a given Lisp symbol. OBJECT must be one
of the predefined D-Bus type symbols. */
static int
-xd_symbol_to_dbus_type (object)
- Lisp_Object object;
+xd_symbol_to_dbus_type (Lisp_Object object)
{
return
((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
@@ -178,6 +205,9 @@ xd_symbol_to_dbus_type (object)
: (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
+#ifdef DBUS_TYPE_UNIX_FD
+ : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD
+#endif
: (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
: (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
: (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
@@ -220,10 +250,7 @@ xd_symbol_to_dbus_type (object)
signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
static void
-xd_signature (signature, dtype, parent_type, object)
- char *signature;
- unsigned int dtype, parent_type;
- Lisp_Object object;
+xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lisp_Object object)
{
unsigned int subtype;
Lisp_Object elt;
@@ -237,6 +264,9 @@ xd_signature (signature, dtype, parent_type, object)
case DBUS_TYPE_UINT16:
case DBUS_TYPE_UINT32:
case DBUS_TYPE_UINT64:
+#ifdef DBUS_TYPE_UNIX_FD
+ case DBUS_TYPE_UNIX_FD:
+#endif
CHECK_NATNUM (object);
sprintf (signature, "%c", dtype);
break;
@@ -392,10 +422,7 @@ xd_signature (signature, dtype, parent_type, object)
`dbus-send-signal', into corresponding C values appended as
arguments to a D-Bus message. */
static void
-xd_append_arg (dtype, object, iter)
- unsigned int dtype;
- Lisp_Object object;
- DBusMessageIter *iter;
+xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
{
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
DBusMessageIter subiter;
@@ -404,6 +431,7 @@ xd_append_arg (dtype, object, iter)
switch (dtype)
{
case DBUS_TYPE_BYTE:
+ CHECK_NUMBER (object);
{
unsigned char val = XUINT (object) & 0xFF;
XD_DEBUG_MESSAGE ("%c %d", dtype, val);
@@ -422,6 +450,7 @@ xd_append_arg (dtype, object, iter)
}
case DBUS_TYPE_INT16:
+ CHECK_NUMBER (object);
{
dbus_int16_t val = XINT (object);
XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
@@ -431,6 +460,7 @@ xd_append_arg (dtype, object, iter)
}
case DBUS_TYPE_UINT16:
+ CHECK_NUMBER (object);
{
dbus_uint16_t val = XUINT (object);
XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
@@ -440,6 +470,7 @@ xd_append_arg (dtype, object, iter)
}
case DBUS_TYPE_INT32:
+ CHECK_NUMBER (object);
{
dbus_int32_t val = XINT (object);
XD_DEBUG_MESSAGE ("%c %d", dtype, val);
@@ -449,6 +480,10 @@ xd_append_arg (dtype, object, iter)
}
case DBUS_TYPE_UINT32:
+#ifdef DBUS_TYPE_UNIX_FD
+ case DBUS_TYPE_UNIX_FD:
+#endif
+ CHECK_NUMBER (object);
{
dbus_uint32_t val = XUINT (object);
XD_DEBUG_MESSAGE ("%c %u", dtype, val);
@@ -458,6 +493,7 @@ xd_append_arg (dtype, object, iter)
}
case DBUS_TYPE_INT64:
+ CHECK_NUMBER (object);
{
dbus_int64_t val = XINT (object);
XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
@@ -467,6 +503,7 @@ xd_append_arg (dtype, object, iter)
}
case DBUS_TYPE_UINT64:
+ CHECK_NUMBER (object);
{
dbus_uint64_t val = XUINT (object);
XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
@@ -476,6 +513,7 @@ xd_append_arg (dtype, object, iter)
}
case DBUS_TYPE_DOUBLE:
+ CHECK_FLOAT (object);
{
double val = XFLOAT_DATA (object);
XD_DEBUG_MESSAGE ("%c %f", dtype, val);
@@ -487,8 +525,13 @@ xd_append_arg (dtype, object, iter)
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
case DBUS_TYPE_SIGNATURE:
+ CHECK_STRING (object);
{
- char *val = SDATA (Fstring_make_unibyte (object));
+ /* We need to send a valid UTF-8 string. We could encode `object'
+ but by not encoding it, we guarantee it's valid utf-8, even if
+ it contains eight-bit-bytes. Of course, you can still send
+ manually-crafted junk by passing a unibyte string. */
+ char *val = SDATA (object);
XD_DEBUG_MESSAGE ("%c %s", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -590,9 +633,7 @@ xd_append_arg (dtype, object, iter)
D-Bus message must be a valid DBusType. Compound D-Bus types
result always in a Lisp list. */
static Lisp_Object
-xd_retrieve_arg (dtype, iter)
- unsigned int dtype;
- DBusMessageIter *iter;
+xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
{
switch (dtype)
@@ -615,6 +656,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;
@@ -624,19 +672,32 @@ 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:
+#ifdef DBUS_TYPE_UNIX_FD
+ case DBUS_TYPE_UNIX_FD:
+#endif
{
- /* 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;
@@ -670,10 +731,10 @@ xd_retrieve_arg (dtype, iter)
{
Lisp_Object result;
struct gcpro gcpro1;
- result = Qnil;
- GCPRO1 (result);
DBusMessageIter subiter;
int subtype;
+ result = Qnil;
+ GCPRO1 (result);
dbus_message_iter_recurse (iter, &subiter);
while ((subtype = dbus_message_iter_get_arg_type (&subiter))
!= DBUS_TYPE_INVALID)
@@ -691,37 +752,79 @@ 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. */
+/* Initialize D-Bus connection. BUS is either a Lisp symbol, :system
+ or :session, or a string denoting the bus address. It tells which
+ D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error
+ when the connection cannot be initialized. */
static DBusConnection *
-xd_initialize (bus)
- Lisp_Object bus;
+xd_initialize (Lisp_Object bus, int raise_error)
{
DBusConnection *connection;
DBusError derror;
/* Parameter check. */
- CHECK_SYMBOL (bus);
- if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
- XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
+ if (!STRINGP (bus))
+ {
+ CHECK_SYMBOL (bus);
+ if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
+ {
+ if (raise_error)
+ XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
+ else
+ return NULL;
+ }
- /* 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);
+ /* We do not want to have an autolaunch for the session bus. */
+ if (EQ (bus, QCdbus_session_bus)
+ && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
+ {
+ if (raise_error)
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus);
+ else
+ return NULL;
+ }
+ }
/* Open a connection to the bus. */
dbus_error_init (&derror);
- if (EQ (bus, QCdbus_system_bus))
- connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
+ if (STRINGP (bus))
+ connection = dbus_connection_open (SDATA (bus), &derror);
else
- connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
+ if (EQ (bus, QCdbus_system_bus))
+ connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
+ else
+ connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
if (dbus_error_is_set (&derror))
- XD_ERROR (derror);
+ {
+ if (raise_error)
+ XD_ERROR (derror);
+ else
+ connection = NULL;
+ }
+
+ /* If it is not the system or session bus, we must register
+ ourselves. Otherwise, we have called dbus_bus_get, which has
+ configured us to exit if the connection closes - we undo this
+ setting. */
+ if (connection != NULL)
+ {
+ if (STRINGP (bus))
+ dbus_bus_register (connection, &derror);
+ else
+ dbus_connection_set_exit_on_disconnect (connection, FALSE);
+ }
- if (connection == NULL)
+ if (dbus_error_is_set (&derror))
+ {
+ if (raise_error)
+ XD_ERROR (derror);
+ else
+ connection = NULL;
+ }
+
+ if (connection == NULL && raise_error)
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
/* Cleanup. */
@@ -731,89 +834,129 @@ xd_initialize (bus)
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;
+/* Return the file descriptor for WATCH, -1 if not found. */
+static int
+xd_find_watch_fd (DBusWatch *watch)
{
- /* 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);
+ /* 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);
+ int fd = dbus_watch_get_fd (watch);
#endif
- XD_DEBUG_MESSAGE ("%d", fd);
+ return fd;
+}
- if (fd == -1)
- return FALSE;
+/* Prototype. */
+static void
+xd_read_queued_messages (int fd, void *data, int for_read);
- /* Add the file descriptor to input_wait_mask. */
- add_keyboard_wait_descriptor (fd);
- }
+/* Start monitoring WATCH for possible I/O. */
+static dbus_bool_t
+xd_add_watch (DBusWatch *watch, void *data)
+{
+ unsigned int flags = dbus_watch_get_flags (watch);
+ int fd = xd_find_watch_fd (watch);
- /* Return. */
+ XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
+ fd, flags & DBUS_WATCH_WRITABLE,
+ dbus_watch_get_enabled (watch));
+
+ if (fd == -1)
+ return FALSE;
+
+ if (dbus_watch_get_enabled (watch))
+ {
+ if (flags & DBUS_WATCH_WRITABLE)
+ add_write_fd (fd, xd_read_queued_messages, data);
+ if (flags & DBUS_WATCH_READABLE)
+ add_read_fd (fd, xd_read_queued_messages, data);
+ }
return TRUE;
}
-/* Remove connection file descriptor from input_wait_mask. */
-void
-xd_remove_watch (watch, data)
- DBusWatch *watch;
- void *data;
+/* Stop monitoring WATCH for possible I/O.
+ DATA is the used bus, either a string or QCdbus_system_bus or
+ QCdbus_session_bus. */
+static void
+xd_remove_watch (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);
+ unsigned int flags = dbus_watch_get_flags (watch);
+ int fd = xd_find_watch_fd (watch);
- if (fd == -1)
- return;
+ XD_DEBUG_MESSAGE ("fd %d", fd);
- /* Remove the file descriptor from input_wait_mask. */
- delete_keyboard_wait_descriptor (fd);
+ if (fd == -1)
+ return;
+
+ /* Unset session environment. */
+ if (data != NULL && data == (void*) XHASH (QCdbus_session_bus))
+ {
+ XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
+ unsetenv ("DBUS_SESSION_BUS_ADDRESS");
}
- /* Return. */
- return;
+ if (flags & DBUS_WATCH_WRITABLE)
+ delete_write_fd (fd);
+ if (flags & DBUS_WATCH_READABLE)
+ delete_read_fd (fd);
+}
+
+/* Toggle monitoring WATCH for possible I/O. */
+static void
+xd_toggle_watch (DBusWatch *watch, void *data)
+{
+ if (dbus_watch_get_enabled (watch))
+ xd_add_watch (watch, data);
+ else
+ xd_remove_watch (watch, data);
}
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;
+ doc: /* Initialize connection to D-Bus BUS. */)
+ (Lisp_Object bus)
{
DBusConnection *connection;
- /* Check parameters. */
- CHECK_SYMBOL (bus);
-
/* Open a connection to the bus. */
- connection = xd_initialize (bus);
+ connection = xd_initialize (bus, TRUE);
- /* Add the watch functions. */
+ /* Add the watch functions. We pass also the bus as data, in order
+ to distinguish between the busses in xd_remove_watch. */
if (!dbus_connection_set_watch_functions (connection,
xd_add_watch,
xd_remove_watch,
- NULL, NULL, NULL))
+ xd_toggle_watch,
+ (void*) XHASH (bus), NULL))
XD_SIGNAL1 (build_string ("Cannot add watch functions"));
+ /* Add bus to list of registered buses. */
+ Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses);
+
+ /* We do not want to abort. */
+ putenv ("DBUS_FATAL_WARNINGS=0");
+
+ /* Return. */
+ return Qnil;
+}
+
+DEFUN ("dbus-close-bus", Fdbus_close_bus, Sdbus_close_bus, 1, 1, 0,
+ doc: /* Close connection to D-Bus BUS. */)
+ (Lisp_Object bus)
+{
+ DBusConnection *connection;
+
+ /* Open a connection to the bus. */
+ connection = xd_initialize (bus, TRUE);
+
+ /* Decrement reference count to the bus. */
+ dbus_connection_unref (connection);
+
+ /* Remove bus from list of registered buses. */
+ Vdbus_registered_buses = Fdelete (bus, Vdbus_registered_buses);
+
/* Return. */
return Qnil;
}
@@ -821,17 +964,13 @@ This is an internal function, it shall not be used outside dbus.el. */)
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. */)
- (bus)
- Lisp_Object bus;
+ (Lisp_Object bus)
{
DBusConnection *connection;
const char *name;
- /* Check parameters. */
- CHECK_SYMBOL (bus);
-
/* Open a connection to the bus. */
- connection = xd_initialize (bus);
+ connection = xd_initialize (bus, TRUE);
/* Request the name. */
name = dbus_bus_get_unique_name (connection);
@@ -845,14 +984,15 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0,
doc: /* Call METHOD on the D-Bus BUS.
-BUS is either the symbol `:system' or the symbol `:session'.
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
SERVICE is the D-Bus service name to be used. PATH is the D-Bus
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
+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.
@@ -878,6 +1018,7 @@ input arguments. It follows the mapping rules:
DBUS_TYPE_UINT16 => number
DBUS_TYPE_INT16 => integer
DBUS_TYPE_UINT32 => number or float
+ DBUS_TYPE_UNIX_FD => number or float
DBUS_TYPE_INT32 => integer or float
DBUS_TYPE_UINT64 => number or float
DBUS_TYPE_INT64 => integer or float
@@ -910,9 +1051,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) */)
- (nargs, args)
- int nargs;
- register Lisp_Object *args;
+ (int nargs, register Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, method;
Lisp_Object result;
@@ -934,7 +1073,6 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI
interface = args[3];
method = args[4];
- CHECK_SYMBOL (bus);
CHECK_STRING (service);
CHECK_STRING (path);
CHECK_STRING (interface);
@@ -948,7 +1086,7 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI
SDATA (method));
/* Open a connection to the bus. */
- connection = xd_initialize (bus);
+ connection = xd_initialize (bus, TRUE);
/* Create the message. */
dmessage = dbus_message_new_method_call (SDATA (service),
@@ -1049,7 +1187,8 @@ DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
Sdbus_call_method_asynchronously, 6, MANY, 0,
doc: /* Call METHOD on the D-Bus BUS asynchronously.
-BUS is either the symbol `:system' or the symbol `:session'.
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
SERVICE is the D-Bus service name to be used. PATH is the D-Bus
object path SERVICE is registered at. INTERFACE is an interface
@@ -1060,7 +1199,7 @@ 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
+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.
@@ -1078,8 +1217,8 @@ All arguments can be preceded by a type symbol. For details about
type symbols, see Info node `(dbus)Type Conversion'.
Unless HANDLER is nil, 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
+`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:
@@ -1094,9 +1233,7 @@ Example:
-| i686
usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
- (nargs, args)
- int nargs;
- register Lisp_Object *args;
+ (int nargs, register Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, method, handler;
Lisp_Object result;
@@ -1117,7 +1254,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
method = args[4];
handler = args[5];
- CHECK_SYMBOL (bus);
CHECK_STRING (service);
CHECK_STRING (path);
CHECK_STRING (interface);
@@ -1133,7 +1269,7 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
SDATA (method));
/* Open a connection to the bus. */
- connection = xd_initialize (bus);
+ connection = xd_initialize (bus, TRUE);
/* Create the message. */
dmessage = dbus_message_new_method_call (SDATA (service),
@@ -1189,11 +1325,11 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
NULL, timeout))
XD_SIGNAL1 (build_string ("Cannot send message"));
- /* The result is the key in Vdbus_registered_functions_table. */
+ /* The result is the key in Vdbus_registered_objects_table. */
result = (list2 (bus, make_number (dbus_message_get_serial (dmessage))));
/* Create a hash table entry. */
- Fputhash (result, handler, Vdbus_registered_functions_table);
+ Fputhash (result, handler, Vdbus_registered_objects_table);
}
else
{
@@ -1205,9 +1341,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
result = Qnil;
}
- /* Flush connection to ensure the message is handled. */
- dbus_connection_flush (connection);
-
XD_DEBUG_MESSAGE ("Message sent");
/* Cleanup. */
@@ -1224,9 +1357,7 @@ DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
This is an internal function, it shall not be used outside dbus.el.
usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
- (nargs, args)
- int nargs;
- register Lisp_Object *args;
+ (int nargs, register Lisp_Object *args)
{
Lisp_Object bus, serial, service;
struct gcpro gcpro1, gcpro2, gcpro3;
@@ -1242,7 +1373,6 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
serial = args[1];
service = args[2];
- CHECK_SYMBOL (bus);
CHECK_NUMBER (serial);
CHECK_STRING (service);
GCPRO3 (bus, serial, service);
@@ -1250,7 +1380,7 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service));
/* Open a connection to the bus. */
- connection = xd_initialize (bus);
+ connection = xd_initialize (bus, TRUE);
/* Create the message. */
dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
@@ -1299,9 +1429,6 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
if (!dbus_connection_send (connection, dmessage, NULL))
XD_SIGNAL1 (build_string ("Cannot send message"));
- /* Flush connection to ensure the message is handled. */
- dbus_connection_flush (connection);
-
XD_DEBUG_MESSAGE ("Message sent");
/* Cleanup. */
@@ -1318,9 +1445,7 @@ DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
This is an internal function, it shall not be used outside dbus.el.
usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
- (nargs, args)
- int nargs;
- register Lisp_Object *args;
+ (int nargs, register Lisp_Object *args)
{
Lisp_Object bus, serial, service;
struct gcpro gcpro1, gcpro2, gcpro3;
@@ -1336,7 +1461,6 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
serial = args[1];
service = args[2];
- CHECK_SYMBOL (bus);
CHECK_NUMBER (serial);
CHECK_STRING (service);
GCPRO3 (bus, serial, service);
@@ -1344,7 +1468,7 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service));
/* Open a connection to the bus. */
- connection = xd_initialize (bus);
+ connection = xd_initialize (bus, TRUE);
/* Create the message. */
dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
@@ -1394,9 +1518,6 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
if (!dbus_connection_send (connection, dmessage, NULL))
XD_SIGNAL1 (build_string ("Cannot send message"));
- /* Flush connection to ensure the message is handled. */
- dbus_connection_flush (connection);
-
XD_DEBUG_MESSAGE ("Message sent");
/* Cleanup. */
@@ -1409,7 +1530,8 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
doc: /* Send signal SIGNAL on the D-Bus BUS.
-BUS is either the symbol `:system' or the symbol `:session'.
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
D-Bus object path SERVICE is registered at. INTERFACE is an interface
@@ -1435,9 +1557,7 @@ Example:
"org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
- (nargs, args)
- int nargs;
- register Lisp_Object *args;
+ (int nargs, register Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, signal;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
@@ -1455,7 +1575,6 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
interface = args[3];
signal = args[4];
- CHECK_SYMBOL (bus);
CHECK_STRING (service);
CHECK_STRING (path);
CHECK_STRING (interface);
@@ -1469,7 +1588,7 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
SDATA (signal));
/* Open a connection to the bus. */
- connection = xd_initialize (bus);
+ connection = xd_initialize (bus, TRUE);
/* Create the message. */
dmessage = dbus_message_new_signal (SDATA (path),
@@ -1514,9 +1633,6 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
if (!dbus_connection_send (connection, dmessage, NULL))
XD_SIGNAL1 (build_string ("Cannot send message"));
- /* Flush connection to ensure the message is handled. */
- dbus_connection_flush (connection);
-
XD_DEBUG_MESSAGE ("Signal sent");
/* Cleanup. */
@@ -1526,69 +1642,26 @@ 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_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. */
- return (HASH_TABLE_P (Vdbus_registered_functions_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. */
-static Lisp_Object
-xd_read_message (bus)
- Lisp_Object bus;
+/* Read one queued incoming message of the D-Bus BUS.
+ BUS is either a Lisp symbol, :system or :session, or a string denoting
+ the bus address. */
+static void
+xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
{
Lisp_Object args, key, value;
struct gcpro gcpro1;
struct input_event event;
- DBusConnection *connection;
DBusMessage *dmessage;
DBusMessageIter iter;
unsigned int dtype;
int mtype, serial;
const char *uname, *path, *interface, *member;
- /* Open a connection to the bus. */
- connection = xd_initialize (bus);
-
- /* Non blocking read of the next available message. */
- dbus_connection_read_write (connection, 0);
dmessage = dbus_connection_pop_message (connection);
/* Return if there is no queued message. */
if (dmessage == NULL)
- return Qnil;
+ return;
/* Collect the parameters. */
args = Qnil;
@@ -1638,14 +1711,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);
@@ -1656,14 +1729,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))
@@ -1719,24 +1792,157 @@ xd_read_message (bus)
cleanup:
dbus_message_unref (dmessage);
- RETURN_UNGCPRO (Qnil);
+ UNGCPRO;
}
-/* Read queued incoming messages from the system and session buses. */
-void
-xd_read_queued_messages ()
+/* Read queued incoming messages of the D-Bus BUS.
+ BUS is either a Lisp symbol, :system or :session, or a string denoting
+ the bus address. */
+static Lisp_Object
+xd_read_message (Lisp_Object bus)
+{
+ /* Open a connection to the bus. */
+ DBusConnection *connection = xd_initialize (bus, TRUE);
+
+ /* Non blocking read of the next available message. */
+ dbus_connection_read_write (connection, 0);
+
+ while (dbus_connection_get_dispatch_status (connection)
+ != DBUS_DISPATCH_COMPLETE)
+ xd_read_message_1 (connection, bus);
+ return Qnil;
+}
+
+/* Callback called when something is ready to read or write. */
+static void
+xd_read_queued_messages (int fd, void *data, int for_read)
{
+ Lisp_Object busp = Vdbus_registered_buses;
+ Lisp_Object bus = Qnil;
+
+ /* Find bus related to fd. */
+ if (data != NULL)
+ while (!NILP (busp))
+ {
+ if (data == (void*) XHASH (CAR_SAFE (busp)))
+ bus = CAR_SAFE (busp);
+ busp = CDR_SAFE (busp);
+ }
+
+ if (NILP(bus))
+ return;
+
+ /* We ignore all Lisp errors during the call. */
+ xd_in_read_queued_messages = 1;
+ internal_catch (Qdbus_error, xd_read_message, bus);
+ xd_in_read_queued_messages = 0;
+}
+
+DEFUN ("dbus-register-service", Fdbus_register_service, Sdbus_register_service,
+ 2, MANY, 0,
+ doc: /* Register known name SERVICE on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name that should be registered. It must
+be a known name.
+
+FLAGS are keywords, which control how the service name is registered.
+The following keywords are recognized:
+
+`:allow-replacement': Allow another service to become the primary
+owner if requested.
+
+`:replace-existing': Request to replace the current primary owner.
+
+`:do-not-queue': If we can not become the primary owner do not place
+us in the queue.
+
+The function returns a keyword, indicating the result of the
+operation. One of the following keywords is returned:
+
+`:primary-owner': Service has become the primary owner of the
+requested name.
+
+`:in-queue': Service could not become the primary owner and has been
+placed in the queue.
+
+`:exists': Service is already in the queue.
- /* 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))
+`:already-owner': Service is already the primary owner.
+
+Example:
+
+\(dbus-register-service :session dbus-service-emacs)
+
+ => :primary-owner.
+
+\(dbus-register-service
+ :session "org.freedesktop.TextEditor"
+ dbus-service-allow-replacement dbus-service-replace-existing)
+
+ => :already-owner.
+
+usage: (dbus-register-service BUS SERVICE &rest FLAGS) */)
+ (int nargs, register Lisp_Object *args)
+{
+ Lisp_Object bus, service;
+ struct gcpro gcpro1, gcpro2;
+ DBusConnection *connection;
+ unsigned int i;
+ unsigned int value;
+ unsigned int flags = 0;
+ int result;
+ DBusError derror;
+
+ bus = args[0];
+ service = args[1];
+
+ /* Check parameters. */
+ CHECK_STRING (service);
+
+ /* Process flags. */
+ for (i = 2; i < nargs; ++i) {
+ value = ((EQ (args[i], QCdbus_request_name_replace_existing))
+ ? DBUS_NAME_FLAG_REPLACE_EXISTING
+ : (EQ (args[i], QCdbus_request_name_allow_replacement))
+ ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
+ : (EQ (args[i], QCdbus_request_name_do_not_queue))
+ ? DBUS_NAME_FLAG_DO_NOT_QUEUE
+ : -1);
+ if (value == -1)
+ XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args[i]);
+ flags |= value;
+ }
+
+ /* Open a connection to the bus. */
+ connection = xd_initialize (bus, TRUE);
+
+ /* Request the known name from the bus. */
+ dbus_error_init (&derror);
+ result = dbus_bus_request_name (connection, SDATA (service), flags,
+ &derror);
+ if (dbus_error_is_set (&derror))
+ XD_ERROR (derror);
+
+ /* Cleanup. */
+ dbus_error_free (&derror);
+
+ /* Return object. */
+ switch (result)
{
- 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;
+ case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER:
+ return QCdbus_request_name_reply_primary_owner;
+ case DBUS_REQUEST_NAME_REPLY_IN_QUEUE:
+ return QCdbus_request_name_reply_in_queue;
+ case DBUS_REQUEST_NAME_REPLY_EXISTS:
+ return QCdbus_request_name_reply_exists;
+ case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER:
+ return QCdbus_request_name_reply_already_owner;
+ default:
+ /* This should not happen. */
+ XD_SIGNAL2 (build_string ("Could not register service"), service);
}
}
@@ -1744,7 +1950,8 @@ DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
6, MANY, 0,
doc: /* Register for signal SIGNAL on the D-Bus BUS.
-BUS is either the symbol `:system' or the symbol `:session'.
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
SERVICE is the D-Bus service name used by the sending D-Bus object.
It can be either a known name or the unique name of the D-Bus object
@@ -1779,9 +1986,7 @@ INTERFACE, SIGNAL and HANDLER must not be nil. Example:
`dbus-unregister-object' for removing the registration.
usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
- (nargs, args)
- int nargs;
- register Lisp_Object *args;
+ (int nargs, register Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, signal, handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
@@ -1800,7 +2005,6 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG
signal = args[4];
handler = args[5];
- CHECK_SYMBOL (bus);
if (!NILP (service)) CHECK_STRING (service);
if (!NILP (path)) CHECK_STRING (path);
CHECK_STRING (interface);
@@ -1832,7 +2036,7 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG
if (NILP (uname) || (SBYTES (uname) > 0))
{
/* Open a connection to the bus. */
- connection = xd_initialize (bus);
+ connection = xd_initialize (bus, TRUE);
/* Create a rule to receive related signals. */
sprintf (rule,
@@ -1880,39 +2084,48 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG
/* 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)));
}
DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
- 6, 6, 0,
+ 6, 7, 0,
doc: /* Register for method METHOD on the D-Bus BUS.
-BUS is either the symbol `:system' or the symbol `:session'.
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
SERVICE is the D-Bus service name of the D-Bus object METHOD is
-registered for. It must be a known name.
-
-PATH is the D-Bus object path SERVICE is registered. INTERFACE is the
-interface offered by SERVICE. It must provide METHOD. HANDLER is a
-Lisp function to be called when a method call is received. It must
-accept the input arguments of METHOD. The return value of HANDLER is
-used for composing the returning D-Bus message. */)
- (bus, service, path, interface, method, handler)
- Lisp_Object bus, service, path, interface, method, handler;
+registered for. It must be a known name (See discussion of
+DONT-REGISTER-SERVICE below).
+
+PATH is the D-Bus object path SERVICE is registered (See discussion of
+DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
+SERVICE. It must provide METHOD. HANDLER is a Lisp function to be
+called when a method call is received. It must accept the input
+arguments of METHOD. The return value of HANDLER is used for
+composing the returning D-Bus message.
+
+When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
+registered. This means that other D-Bus clients have no way of
+noticing the newly registered method. When interfaces are constructed
+incrementally by adding single methods or properties at a time,
+DONT-REGISTER-SERVICE can be use to prevent other clients from
+discovering the still incomplete interface.*/)
+ (Lisp_Object bus, Lisp_Object service, Lisp_Object path,
+ Lisp_Object interface, Lisp_Object method, Lisp_Object handler,
+ Lisp_Object dont_register_service)
{
Lisp_Object key, key1, value;
- DBusConnection *connection;
- int result;
DBusError derror;
+ Lisp_Object args[2] = { bus, service };
/* Check parameters. */
- CHECK_SYMBOL (bus);
CHECK_STRING (service);
CHECK_STRING (path);
CHECK_STRING (interface);
@@ -1922,28 +2135,18 @@ used for composing the returning D-Bus message. */)
/* TODO: We must check for a valid service name, otherwise there is
a segmentation fault. */
- /* Open a connection to the bus. */
- connection = xd_initialize (bus);
-
- /* Request the known name from the bus. We can ignore the result,
- it is set to -1 if there is an error - kind of redundancy. */
- dbus_error_init (&derror);
- result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
- if (dbus_error_is_set (&derror))
- XD_ERROR (derror);
+ /* Request the name. */
+ if (NILP (dont_register_service))
+ Fdbus_register_service (2, args);
- /* 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);
-
- /* Cleanup. */
- dbus_error_free (&derror);
+ Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
/* Return object. */
return list2 (key, list3 (service, path, handler));
@@ -1951,153 +2154,200 @@ used for composing the returning D-Bus message. */)
void
-syms_of_dbusbind ()
+syms_of_dbusbind (void)
{
- Qdbus_init_bus = intern ("dbus-init-bus");
+ Qdbus_init_bus = intern_c_string ("dbus-init-bus");
staticpro (&Qdbus_init_bus);
defsubr (&Sdbus_init_bus);
- Qdbus_get_unique_name = intern ("dbus-get-unique-name");
+ Qdbus_close_bus = intern_c_string ("dbus-close-bus");
+ staticpro (&Qdbus_close_bus);
+ defsubr (&Sdbus_close_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_service = intern_c_string ("dbus-register-service");
+ staticpro (&Qdbus_register_service);
+ defsubr (&Sdbus_register_service);
+
+ 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_request_name_allow_replacement = intern_c_string (":allow-replacement");
+ staticpro (&QCdbus_request_name_allow_replacement);
+
+ QCdbus_request_name_replace_existing = intern_c_string (":replace-existing");
+ staticpro (&QCdbus_request_name_replace_existing);
+
+ QCdbus_request_name_do_not_queue = intern_c_string (":do-not-queue");
+ staticpro (&QCdbus_request_name_do_not_queue);
+
+ QCdbus_request_name_reply_primary_owner = intern_c_string (":primary-owner");
+ staticpro (&QCdbus_request_name_reply_primary_owner);
+
+ QCdbus_request_name_reply_exists = intern_c_string (":exists");
+ staticpro (&QCdbus_request_name_reply_exists);
+
+ QCdbus_request_name_reply_in_queue = intern_c_string (":in-queue");
+ staticpro (&QCdbus_request_name_reply_in_queue);
+
+ QCdbus_request_name_reply_already_owner = intern_c_string (":already-owner");
+ staticpro (&QCdbus_request_name_reply_already_owner);
+
+ 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");
+#ifdef DBUS_TYPE_UNIX_FD
+ QCdbus_type_unix_fd = intern_c_string (":unix-fd");
+ staticpro (&QCdbus_type_unix_fd);
+#endif
+
+ 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-buses",
+ Vdbus_registered_buses,
+ doc: /* List of D-Bus buses we are polling for messages. */);
+ Vdbus_registered_buses = Qnil;
+
+ 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.
+INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or
+`:session', or a string denoting the bus address. INTERFACE is a
+string which denotes a D-Bus interface, 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.
-
-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
-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;
-
- DEFVAR_LISP ("dbus-debug", &Vdbus_debug,
+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 a Lisp symbol, `:system' or `:session', or a
+string denoting the bus address. SERIAL 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. */);
+ {
+ Lisp_Object args[2];
+ args[0] = QCtest;
+ args[1] = Qequal;
+ Vdbus_registered_objects_table = Fmake_hash_table (2, args);
+ }
+
+ DEFVAR_LISP ("dbus-debug", Vdbus_debug,
doc: /* If non-nil, debug messages of D-Bus bindings are raised. */);
#ifdef DBUS_DEBUG
Vdbus_debug = Qt;
+ /* We can also set environment variable DBUS_VERBOSE=1 in order to
+ see more traces. This requires libdbus-1 to be configured with
+ --enable-verbose-mode. */
#else
Vdbus_debug = Qnil;
#endif
- Fprovide (intern ("dbusbind"), Qnil);
+ Fprovide (intern_c_string ("dbusbind"), Qnil);
}
#endif /* HAVE_DBUS */
-/* arch-tag: 0e828477-b571-4fe4-b559-5c9211bc14b8
- (do not change this comment) */