/* Elisp bindings for D-Bus.
- Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+ Copyright (C) 2007-2011 Free Software Foundation, Inc.
This file is part of GNU Emacs.
\f
/* 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_signal;
-Lisp_Object Qdbus_register_method;
+static Lisp_Object Qdbus_init_bus;
+static Lisp_Object Qdbus_close_bus;
+static Lisp_Object Qdbus_get_unique_name;
+static Lisp_Object Qdbus_call_method;
+static Lisp_Object Qdbus_call_method_asynchronously;
+static Lisp_Object Qdbus_method_return_internal;
+static Lisp_Object Qdbus_method_error_internal;
+static Lisp_Object Qdbus_send_signal;
+static Lisp_Object Qdbus_register_service;
+static Lisp_Object Qdbus_register_signal;
+static Lisp_Object Qdbus_register_method;
/* D-Bus error symbol. */
-Lisp_Object Qdbus_error;
+static Lisp_Object Qdbus_error;
/* Lisp symbols of the system and session buses. */
-Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
+static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
/* Lisp symbol for method call timeout. */
-Lisp_Object QCdbus_timeout;
+static Lisp_Object QCdbus_timeout;
+
+/* Lisp symbols for name request flags. */
+static Lisp_Object QCdbus_request_name_allow_replacement;
+static Lisp_Object QCdbus_request_name_replace_existing;
+static Lisp_Object QCdbus_request_name_do_not_queue;
+
+/* Lisp symbols for name request replies. */
+static Lisp_Object QCdbus_request_name_reply_primary_owner;
+static Lisp_Object QCdbus_request_name_reply_in_queue;
+static Lisp_Object QCdbus_request_name_reply_exists;
+static 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;
-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;
+static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
+static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
+static Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
+static Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
+static Lisp_Object QCdbus_type_double, QCdbus_type_string;
+static 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;
-
-/* Registered buses. */
-Lisp_Object Vdbus_registered_buses;
-
-/* Hash table which keeps function definitions. */
-Lisp_Object Vdbus_registered_objects_table;
-
-/* Whether to debug D-Bus. */
-Lisp_Object Vdbus_debug;
+static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
+static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
/* Whether we are reading a D-Bus event. */
-int xd_in_read_queued_messages = 0;
+static int xd_in_read_queued_messages = 0;
\f
/* We use "xd_" and "XD_" as prefix for all internal symbols, because
if ((subtype == DBUS_TYPE_SIGNATURE)
&& STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
&& NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
- strcpy (x, SDATA (CAR_SAFE (XD_NEXT_VALUE (elt))));
+ strcpy (x, SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt))));
while (!NILP (elt))
{
CHECK_NUMBER (object);
{
dbus_uint64_t val = XUINT (object);
- XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
+ XD_DEBUG_MESSAGE ("%c %"pI"u", dtype, XUINT (object));
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
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);
+ char *val = SSDATA (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);
&& STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
&& NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
{
- strcpy (signature, SDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
+ strcpy (signature, SSDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
object = CDR_SAFE (XD_NEXT_VALUE (object));
}
dbus_error_init (&derror);
if (STRINGP (bus))
- connection = dbus_connection_open (SDATA (bus), &derror);
+ connection = dbus_connection_open (SSDATA (bus), &derror);
else
if (EQ (bus, QCdbus_system_bus))
connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
return;
/* Unset session environment. */
- if (data != NULL && data == (void*) XHASH (QCdbus_session_bus))
+ if (data != NULL && data == (void *) XPNTR (QCdbus_session_bus))
{
XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
unsetenv ("DBUS_SESSION_BUS_ADDRESS");
xd_add_watch,
xd_remove_watch,
xd_toggle_watch,
- (void*) XHASH (bus), NULL))
+ (void *) XPNTR (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");
+ putenv ((char *) "DBUS_FATAL_WARNINGS=0");
/* Return. */
return Qnil;
=> "i686"
usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, method;
Lisp_Object result;
DBusError derror;
unsigned int dtype;
int timeout = -1;
- int i = 5;
+ size_t i = 5;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
connection = xd_initialize (bus, TRUE);
/* Create the message. */
- dmessage = dbus_message_new_method_call (SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (method));
+ dmessage = dbus_message_new_method_call (SSDATA (service),
+ SSDATA (path),
+ SSDATA (interface),
+ SSDATA (method));
UNGCPRO;
if (dmessage == NULL)
XD_SIGNAL1 (build_string ("Unable to create a new message"));
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
+ XD_DEBUG_MESSAGE ("Parameter%lu %s %s", (unsigned long) (i-4),
SDATA (format2 ("%s", args[i], Qnil)),
SDATA (format2 ("%s", args[i+1], Qnil)));
++i;
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
+ XD_DEBUG_MESSAGE ("Parameter%lu %s", (unsigned long) (i-4),
SDATA (format2 ("%s", args[i], Qnil)));
}
-| i686
usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, method, handler;
Lisp_Object result;
DBusMessageIter iter;
unsigned int dtype;
int timeout = -1;
- int i = 6;
+ size_t i = 6;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
connection = xd_initialize (bus, TRUE);
/* Create the message. */
- dmessage = dbus_message_new_method_call (SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (method));
+ dmessage = dbus_message_new_method_call (SSDATA (service),
+ SSDATA (path),
+ SSDATA (interface),
+ SSDATA (method));
if (dmessage == NULL)
XD_SIGNAL1 (build_string ("Unable to create a new message"));
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
+ XD_DEBUG_MESSAGE ("Parameter%lu %s %s", (unsigned long) (i-4),
SDATA (format2 ("%s", args[i], Qnil)),
SDATA (format2 ("%s", args[i+1], Qnil)));
++i;
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
+ XD_DEBUG_MESSAGE ("Parameter%lu %s", (unsigned long) (i - 4),
SDATA (format2 ("%s", args[i], Qnil)));
}
This is an internal function, it shall not be used outside dbus.el.
usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
Lisp_Object bus, serial, service;
struct gcpro gcpro1, gcpro2, gcpro3;
DBusMessage *dmessage;
DBusMessageIter iter;
unsigned int dtype;
- int i;
+ size_t i;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
CHECK_STRING (service);
GCPRO3 (bus, serial, service);
- XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service));
+ XD_DEBUG_MESSAGE ("%"pI"u %s ", XUINT (serial), SDATA (service));
/* Open a connection to the bus. */
connection = xd_initialize (bus, TRUE);
dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
if ((dmessage == NULL)
|| (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
- || (!dbus_message_set_destination (dmessage, SDATA (service))))
+ || (!dbus_message_set_destination (dmessage, SSDATA (service))))
{
UNGCPRO;
XD_SIGNAL1 (build_string ("Unable to create a return message"));
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
+ XD_DEBUG_MESSAGE ("Parameter%lu %s %s", (unsigned long) (i-2),
SDATA (format2 ("%s", args[i], Qnil)),
SDATA (format2 ("%s", args[i+1], Qnil)));
++i;
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
+ XD_DEBUG_MESSAGE ("Parameter%lu %s", (unsigned long) (i-2),
SDATA (format2 ("%s", args[i], Qnil)));
}
This is an internal function, it shall not be used outside dbus.el.
usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
Lisp_Object bus, serial, service;
struct gcpro gcpro1, gcpro2, gcpro3;
DBusMessage *dmessage;
DBusMessageIter iter;
unsigned int dtype;
- int i;
+ size_t i;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
CHECK_STRING (service);
GCPRO3 (bus, serial, service);
- XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service));
+ XD_DEBUG_MESSAGE ("%"pI"u %s ", XUINT (serial), SDATA (service));
/* Open a connection to the bus. */
connection = xd_initialize (bus, TRUE);
if ((dmessage == NULL)
|| (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
|| (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
- || (!dbus_message_set_destination (dmessage, SDATA (service))))
+ || (!dbus_message_set_destination (dmessage, SSDATA (service))))
{
UNGCPRO;
XD_SIGNAL1 (build_string ("Unable to create a error message"));
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
+ XD_DEBUG_MESSAGE ("Parameter%lu %s %s", (unsigned long) (i-2),
SDATA (format2 ("%s", args[i], Qnil)),
SDATA (format2 ("%s", args[i+1], Qnil)));
++i;
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
+ XD_DEBUG_MESSAGE ("Parameter%lu %s", (unsigned long) (i-2),
SDATA (format2 ("%s", args[i], Qnil)));
}
"org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, signal;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
DBusMessage *dmessage;
DBusMessageIter iter;
unsigned int dtype;
- int i;
+ size_t i;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
connection = xd_initialize (bus, TRUE);
/* Create the message. */
- dmessage = dbus_message_new_signal (SDATA (path),
- SDATA (interface),
- SDATA (signal));
+ dmessage = dbus_message_new_signal (SSDATA (path),
+ SSDATA (interface),
+ SSDATA (signal));
UNGCPRO;
if (dmessage == NULL)
XD_SIGNAL1 (build_string ("Unable to create a new message"));
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
+ XD_DEBUG_MESSAGE ("Parameter%lu %s %s", (unsigned long) (i-4),
SDATA (format2 ("%s", args[i], Qnil)),
SDATA (format2 ("%s", args[i+1], Qnil)));
++i;
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
+ XD_DEBUG_MESSAGE ("Parameter%lu %s", (unsigned long) (i-4),
SDATA (format2 ("%s", args[i], Qnil)));
}
/* key has the structure (UNAME SERVICE PATH HANDLER). */
if (((uname == NULL)
|| (NILP (CAR_SAFE (key)))
- || (strcmp (uname, SDATA (CAR_SAFE (key))) == 0))
+ || (strcmp (uname, SSDATA (CAR_SAFE (key))) == 0))
&& ((path == NULL)
|| (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
|| (strcmp (path,
- SDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
+ SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
== 0))
&& (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
{
if (data != NULL)
while (!NILP (busp))
{
- if (data == (void*) XHASH (CAR_SAFE (busp)))
+ if (data == (void *) XPNTR (CAR_SAFE (busp)))
bus = CAR_SAFE (busp);
busp = CDR_SAFE (busp);
}
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.
+
+`: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) */)
+ (size_t nargs, register Lisp_Object *args)
+{
+ Lisp_Object bus, service;
+ DBusConnection *connection;
+ size_t 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, SSDATA (service), flags,
+ &derror);
+ if (dbus_error_is_set (&derror))
+ XD_ERROR (derror);
+
+ /* Cleanup. */
+ dbus_error_free (&derror);
+
+ /* Return object. */
+ switch (result)
+ {
+ 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);
+ }
+}
+
DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
6, MANY, 0,
doc: /* Register for signal SIGNAL on the D-Bus BUS.
`dbus-unregister-object' for removing the registration.
usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, signal, handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
Lisp_Object uname, key, key1, value;
DBusConnection *connection;
- int i;
+ size_t i;
char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
char x[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
DBusError derror;
name of "org.freedesktop.DBus" is that string itself. */
if ((STRINGP (service))
&& (SBYTES (service) > 0)
- && (strcmp (SDATA (service), DBUS_SERVICE_DBUS) != 0)
- && (strncmp (SDATA (service), ":", 1) != 0))
+ && (strcmp (SSDATA (service), DBUS_SERVICE_DBUS) != 0)
+ && (strncmp (SSDATA (service), ":", 1) != 0))
{
uname = call2 (intern ("dbus-get-name-owner"), bus, service);
/* When there is no unique name, we mark it with an empty
if (!NILP (args[i]))
{
CHECK_STRING (args[i]);
- sprintf (x, ",arg%d='%s'", i-6, SDATA (args[i]));
+ sprintf (x, ",arg%lu='%s'", (unsigned long) (i-6),
+ SDATA (args[i]));
strcat (rule, x);
}
}
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 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. */)
- (Lisp_Object bus, Lisp_Object service, Lisp_Object path, Lisp_Object interface, Lisp_Object method, Lisp_Object 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_STRING (service);
/* 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, TRUE);
-
- /* 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. We use nil for the unique name,
because the method might be called from anybody. */
if (NILP (Fmember (key1, value)))
Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
- /* Cleanup. */
- dbus_error_free (&derror);
-
/* Return object. */
return list2 (key, list3 (service, path, handler));
}
staticpro (&Qdbus_send_signal);
defsubr (&Sdbus_send_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);
QCdbus_session_bus = intern_c_string (":session");
staticpro (&QCdbus_session_bus);
+ 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);
staticpro (&QCdbus_type_dict_entry);
DEFVAR_LISP ("dbus-registered-buses",
- &Vdbus_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,
+ Vdbus_registered_objects_table,
doc: /* Hash table of registered functions for D-Bus.
There are two different uses of the hash table: for accessing
Vdbus_registered_objects_table = Fmake_hash_table (2, args);
}
- DEFVAR_LISP ("dbus-debug", &Vdbus_debug,
+ DEFVAR_LISP ("dbus-debug", Vdbus_debug,
doc: /* If non-nil, debug messages of D-Bus bindings are raised. */);
#ifdef DBUS_DEBUG
Vdbus_debug = Qt;
}
#endif /* HAVE_DBUS */
-
-/* arch-tag: 0e828477-b571-4fe4-b559-5c9211bc14b8
- (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff