# HG changeset patch # User Michael Albinus # Date 1294653377 -3600 # Node ID e79369283aa120a3886e1556b7be1d93a855b3e2 # Parent af71852e09a2a0bc1f10a1346a4c194bbc308fd6 * dbusbind.c (QCdbus_request_name_allow_replacement): New symbol; used by Fdbus_register_service. (QCdbus_request_name_replace_existing): Likewise. (QCdbus_request_name_do_not_queue): Likewise. (QCdbus_request_name_reply_primary_owner): Likewise. (QCdbus_request_name_reply_in_queue): Likewise. (QCdbus_request_name_reply_exists): Likewise. (QCdbus_request_name_reply_already_owner): Likewise. (Fdbus_register_service): New function. (Fdbus_register_method): Use Fdbus_register_service to do the name registration. (syms_of_dbusbind): Add symbols dbus-register-service, :allow-replacement, :replace-existing, :do-not-queue, :primary-owner, :existing, :in-queue and :already-owner. diff -r af71852e09a2 -r e79369283aa1 src/ChangeLog --- a/src/ChangeLog Mon Jan 10 10:46:19 2011 +0100 +++ b/src/ChangeLog Mon Jan 10 10:56:17 2011 +0100 @@ -1,3 +1,20 @@ +2011-01-08 Jan Moringen + + * dbusbind.c (QCdbus_request_name_allow_replacement): New symbol; + used by Fdbus_register_service. + (QCdbus_request_name_replace_existing): Likewise. + (QCdbus_request_name_do_not_queue): Likewise. + (QCdbus_request_name_reply_primary_owner): Likewise. + (QCdbus_request_name_reply_in_queue): Likewise. + (QCdbus_request_name_reply_exists): Likewise. + (QCdbus_request_name_reply_already_owner): Likewise. + (Fdbus_register_service): New function. + (Fdbus_register_method): Use Fdbus_register_service to do the name + registration. + (syms_of_dbusbind): Add symbols dbus-register-service, + :allow-replacement, :replace-existing, :do-not-queue, + :primary-owner, :existing, :in-queue and :already-owner. + 2011-01-09 Chong Yidong * gtkutil.c (update_frame_tool_bar): Don't advance tool-bar index diff -r af71852e09a2 -r e79369283aa1 src/dbusbind.c --- a/src/dbusbind.c Mon Jan 10 10:46:19 2011 +0100 +++ b/src/dbusbind.c Mon Jan 10 10:56:17 2011 +0100 @@ -38,6 +38,7 @@ 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; @@ -50,6 +51,17 @@ /* 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; @@ -1835,6 +1847,112 @@ 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) */) + (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) { + 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: + return Qnil; + } +} + DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal, 6, MANY, 0, doc: /* Register for signal SIGNAL on the D-Bus BUS. @@ -2014,6 +2132,7 @@ DBusConnection *connection; int result; DBusError derror; + Lisp_Object args[2] = { bus, service }; /* Check parameters. */ CHECK_STRING (service); @@ -2028,18 +2147,9 @@ /* 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. */ - if (NILP (dont_register_service)) - { - dbus_error_init (&derror); - result = dbus_bus_request_name (connection, SDATA (service), 0, &derror); - if (dbus_error_is_set (&derror)) - XD_ERROR (derror); - - /* Cleanup. */ - dbus_error_free (&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. */ @@ -2091,6 +2201,10 @@ 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); @@ -2112,6 +2226,27 @@ 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);