Move functions from C to Lisp. Make non-blocking method calls

the default.  Implement further D-Bus standard interfaces.

* configure.in (dbus_validate_bus_name, dbus_validate_path)
(dbus_validate_interface, dbus_validate_member): Check also for
these library functions

* dbusbind.c (DBUS_NUM_MESSAGE_TYPES): Declare.
(QCdbus_request_name_allow_replacement)
(QCdbus_request_name_replace_existing)
(QCdbus_request_name_do_not_queue)
(QCdbus_request_name_reply_primary_owner)
(QCdbus_request_name_reply_in_queue)
(QCdbus_request_name_reply_exists)
(QCdbus_request_name_reply_already_owner): Move to dbus.el.
(QCdbus_registered_serial, QCdbus_registered_method)
(QCdbus_registered_signal): New Lisp objects.
(XD_DEBUG_MESSAGE): Use sizeof.
(XD_MESSAGE_TYPE_TO_STRING, XD_OBJECT_TO_STRING)
(XD_DBUS_VALIDATE_BUS_ADDRESS, XD_DBUS_VALIDATE_OBJECT)
(XD_DBUS_VALIDATE_BUS_NAME, XD_DBUS_VALIDATE_PATH)
(XD_DBUS_VALIDATE_INTERFACE, XD_DBUS_VALIDATE_MEMBER): New macros.
(XD_CHECK_DBUS_SERIAL): Rename from CHECK_DBUS_SERIAL_GET_SERIAL.
(xd_signature, xd_append_arg): Allow float for integer types.
(xd_get_connection_references): New function.
(xd_get_connection_address): Rename from xd_initialize.  Return
cached address.
(xd_remove_watch): Do not unset $DBUS_SESSION_BUS_ADDRESS.
(xd_close_bus): Rename from Fdbus_close_bus.  Not needed on Lisp
level.
(Fdbus_init_bus): New optional arg PRIVATE.  Cache address.
Return number of recounts.
(Fdbus_get_unique_name): Make stronger parameter check.
(Fdbus_message_internal): New defun.
(Fdbus_call_method, Fdbus_call_method_asynchronously)
(Fdbus_method_return_internal, Fdbus_method_error_internal)
(Fdbus_send_signal, Fdbus_register_service)
(Fdbus_register_signal, Fdbus_register_method): Move to dbus.el.
(xd_read_message_1): Obey new structure of Vdbus_registered_objects.
(xd_read_queued_messages): Obey new structure of Vdbus_registered_buses.
(Vdbus_compiled_version, Vdbus_runtime_version)
(Vdbus_message_type_invalid, Vdbus_message_type_method_call)
(Vdbus_message_type_method_return, Vdbus_message_type_error)
(Vdbus_message_type_signal): New defvars.
(Vdbus_registered_buses, Vdbus_registered_objects_table): Adapt
docstring.

* net/dbus.el (dbus-message-internal): Declare function.  Remove
unneeded function declarations.
(defvar dbus-message-type-invalid, dbus-message-type-method-call)
(dbus-message-type-method-return, dbus-message-type-error)
(dbus-message-type-signal): Declare variables.  Remove local
definitions.
(dbus-interface-dbus, dbus-interface-peer)
(dbus-interface-introspectable, dbus-interface-properties)
(dbus-path-emacs, dbus-interface-emacs, dbus-return-values-table):
Adapt docstring.
(dbus-interface-objectmanager): New defconst.
(dbus-call-method, dbus-call-method-asynchronously)
(dbus-send-signal, dbus-method-return-internal)
(dbus-method-error-internal, dbus-register-service)
(dbus-register-signal, dbus-register-method): New defuns, moved
from dbusbind.c
(dbus-call-method-handler, dbus-setenv)
(dbus-get-all-managed-objects, dbus-managed-objects-handler): New
defuns.
(dbus-call-method-non-blocking): Make it an obsolete function.
(dbus-unregister-object, dbus-unregister-service)
(dbus-handle-event, dbus-register-property)
(dbus-property-handler): Obey the new structure of
`bus-registered-objects'.
(dbus-introspect): Use `dbus-call-method'.  Use a timeout.
(dbus-get-property, dbus-set-property, dbus-get-all-properties):
Use `dbus-call-method'.

* dbus.texi (Version): New node.
(Properties and Annotations): Mention the object manager
interface.  Describe dbus-get-all-managed-objects.
(Type Conversion): Floating point numbers are allowed, if an
anteger does not fit Emacs's integer range.
(Synchronous Methods): Remove obsolete dbus-call-method-non-blocking.
(Asynchronous Methods): Fix description of
dbus-call-method-asynchronously.
(Receiving Method Calls): Fix some minor errors.  Add
dbus-interface-emacs.
(Signals): Describe unicast signals and the new match rules.
(Alternative Buses): Add the PRIVATE optional argument to
dbus-init-bus.  Describe its new return value.  Add dbus-setenv.

2 files changed, 875 insertions, 223 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 14a83de342a..334e34bb712 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,36 @@
+2012-04-22  Michael Albinus  <michael.albinus@gmx.de>
+
+        Move functions from C to Lisp.  Make non-blocking method calls
+        the default.  Implement further D-Bus standard interfaces.
+
+        * net/dbus.el (dbus-message-internal): Declare function.  Remove
+        unneeded function declarations.
+        (defvar dbus-message-type-invalid, dbus-message-type-method-call)
+        (dbus-message-type-method-return, dbus-message-type-error)
+        (dbus-message-type-signal): Declare variables.  Remove local
+        definitions.
+        (dbus-interface-dbus, dbus-interface-peer)
+        (dbus-interface-introspectable, dbus-interface-properties)
+        (dbus-path-emacs, dbus-interface-emacs, dbus-return-values-table):
+        Adapt docstring.
+        (dbus-interface-objectmanager): New defconst.
+        (dbus-call-method, dbus-call-method-asynchronously)
+        (dbus-send-signal, dbus-method-return-internal)
+        (dbus-method-error-internal, dbus-register-service)
+        (dbus-register-signal, dbus-register-method): New defuns, moved
+        from dbusbind.c
+        (dbus-call-method-handler, dbus-setenv)
+        (dbus-get-all-managed-objects, dbus-managed-objects-handler): New
+        defuns.
+        (dbus-call-method-non-blocking): Make it an obsolete function.
+        (dbus-unregister-object, dbus-unregister-service)
+        (dbus-handle-event, dbus-register-property)
+        (dbus-property-handler): Obey the new structure of
+        `bus-registered-objects'.
+        (dbus-introspect): Use `dbus-call-method'.  Use a timeout.
+        (dbus-get-property, dbus-set-property, dbus-get-all-properties):
+        Use `dbus-call-method'.
+
 2012-04-22  Chong Yidong  <cyd@gnu.org>
 
         * cus-edit.el (custom-commands, custom-reset-menu)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index e3144a53fab..ee2bdecb1ac 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -28,19 +28,19 @@
 
 ;; Low-level language bindings are implemented in src/dbusbind.c.
 
+;; D-Bus support in the Emacs core can be disabled with configuration
+;; option "--without-dbus".
+
 ;;; Code:
 
-;; D-Bus support in the Emacs core can be disabled with configuration
-;; option "--without-dbus".  Declare used subroutines and variables.
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-call-method-asynchronously "dbusbind.c")
+;; Declare used subroutines and variables.
+(declare-function dbus-message-internal "dbusbind.c")
 (declare-function dbus-init-bus "dbusbind.c")
-(declare-function dbus-method-return-internal "dbusbind.c")
-(declare-function dbus-method-error-internal "dbusbind.c")
-(declare-function dbus-register-service "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
-(declare-function dbus-register-method "dbusbind.c")
-(declare-function dbus-send-signal "dbusbind.c")
+(defvar dbus-message-type-invalid)
+(defvar dbus-message-type-method-call)
+(defvar dbus-message-type-method-return)
+(defvar dbus-message-type-error)
+(defvar dbus-message-type-signal)
 (defvar dbus-debug)
 (defvar dbus-registered-objects-table)
 
@@ -56,39 +56,93 @@
 (defconst dbus-path-dbus "/org/freedesktop/DBus"
   "The object path used to talk to the bus itself.")
 
+;; Default D-Bus interfaces.
+
 (defconst dbus-interface-dbus "org.freedesktop.DBus"
-  "The interface exported by the object with `dbus-service-dbus' and `dbus-path-dbus'.")
+  "The interface exported by the service `dbus-service-dbus'.")
 
 (defconst dbus-interface-peer (concat dbus-interface-dbus ".Peer")
-  "The interface for peer objects.")
+  "The interface for peer objects.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-peer'.")
+
+;; <interface name="org.freedesktop.DBus.Peer">
+;;   <method name="Ping">
+;;   </method>
+;;   <method name="GetMachineId">
+;;     <arg name="machine_uuid" type="s" direction="out"/>
+;;   </method>
+;; </interface>
 
 (defconst dbus-interface-introspectable
   (concat dbus-interface-dbus ".Introspectable")
-  "The interface supported by introspectable objects.")
+  "The interface supported by introspectable objects.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-introspectable'.")
 
-(defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties")
-  "The interface for property objects.")
+;; <interface name="org.freedesktop.DBus.Introspectable">
+;;   <method name="Introspect">
+;;     <arg name="data" type="s" direction="out"/>
+;;   </method>
+;; </interface>
 
+(defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties")
+  "The interface for property objects.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-properties'.")
+
+;; <interface name="org.freedesktop.DBus.Properties">
+;;   <method name="Get">
+;;     <arg name="interface" type="s" direction="in"/>
+;;     <arg name="propname"  type="s" direction="in"/>
+;;     <arg name="value"     type="v" direction="out"/>
+;;   </method>
+;;   <method name="Set">
+;;     <arg name="interface" type="s" direction="in"/>
+;;     <arg name="propname"  type="s" direction="in"/>
+;;     <arg name="value"     type="v" direction="in"/>
+;;   </method>
+;;   <method name="GetAll">
+;;     <arg name="interface" type="s" direction="in"/>
+;;     <arg name="props"     type="a{sv}" direction="out"/>
+;;   </method>
+;;   <signal name="PropertiesChanged">
+;;     <arg name="interface" type="s"/>
+;;     <arg name="changed_properties"     type="a{sv}"/>
+;;     <arg name="invalidated_properties" type="as"/>
+;;   </signal>
+;; </interface>
+
+(defconst dbus-interface-objectmanager
+  (concat dbus-interface-dbus ".ObjectManager")
+  "The object manager interface.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-objectmanager'.")
+
+;; <interface name="org.freedesktop.DBus.ObjectManager">
+;;   <method name="GetManagedObjects">
+;;     <arg name="object_paths_interfaces_and_properties"
+;;          type="a{oa{sa{sv}}}" direction="out"/>
+;;   </method>
+;;   <signal name="InterfacesAdded">
+;;     <arg name="object_path"               type="o"/>
+;;     <arg name="interfaces_and_properties" type="a{sa{sv}}"/>
+;;   </signal>
+;;   <signal name="InterfacesRemoved">
+;;     <arg name="object_path"               type="o"/>
+;;     <arg name="interfaces"                type="as"/>
+;;   </signal>
+;; </interface>
+
+;; Emacs defaults.
 (defconst dbus-service-emacs "org.gnu.Emacs"
   "The well known service name of Emacs.")
 
 (defconst dbus-path-emacs "/org/gnu/Emacs"
-  "The object path head used by Emacs.")
+  "The object path namespace used by Emacs.
+All object paths provided by the service `dbus-service-emacs'
+shall be subdirectories of this path.")
 
-(defconst dbus-message-type-invalid 0
-  "This value is never a valid message type.")
+(defconst dbus-interface-emacs "org.gnu.Emacs"
+  "The interface namespace used by Emacs.")
 
-(defconst dbus-message-type-method-call 1
-  "Message type of a method call message.")
-
-(defconst dbus-message-type-method-return 2
-  "Message type of a method return message.")
-
-(defconst dbus-message-type-error 3
-  "Message type of an error reply message.")
-
-(defconst dbus-message-type-signal 4
-  "Message type of a signal message.")
+;; D-Bus constants.
 
 (defmacro dbus-ignore-errors (&rest body)
   "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
@@ -105,15 +159,267 @@ Every function must accept two arguments, the event and the error variable
 caught in `condition-case' by `dbus-error'.")
 
 
-;;; Hash table of registered functions.
+;;; Basic D-Bus message functions.
 
 (defvar dbus-return-values-table (make-hash-table :test 'equal)
   "Hash table for temporary storing arguments of reply messages.
-A key in this hash table is a 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 reply message.
-See `dbus-call-method-non-blocking-handler' and
-`dbus-call-method-non-blocking'.")
+A key in this hash table is a list (:serial BUS SERIAL), like in
+`dbus-registered-objects-table'.  BUS is either a Lisp symbol,
+`:system' or `:session', or a string denoting the bus address.
+SERIAL is the serial number of the reply message.")
+
+(defun dbus-call-method-handler (&rest args)
+  "Handler for reply messages of asynchronous D-Bus message calls.
+It calls the function stored in `dbus-registered-objects-table'.
+The result will be made available in `dbus-return-values-table'."
+  (puthash (list  :serial
+                  (dbus-event-bus-name last-input-event)
+                 (dbus-event-serial-number last-input-event))
+           (if (= (length args) 1) (car args) args)
+           dbus-return-values-table))
+
+(defun dbus-call-method (bus service path interface method &rest args)
+  "Call 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 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 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
+converted into D-Bus types via the following rules:
+
+  t and nil => DBUS_TYPE_BOOLEAN
+  number    => DBUS_TYPE_UINT32
+  integer   => DBUS_TYPE_INT32
+  float     => DBUS_TYPE_DOUBLE
+  string    => DBUS_TYPE_STRING
+  list      => DBUS_TYPE_ARRAY
+
+All arguments can be preceded by a type symbol.  For details about
+type symbols, see Info node `(dbus)Type Conversion'.
+
+`dbus-call-method' returns the resulting values of METHOD as a list of
+Lisp objects.  The type conversion happens the other direction as for
+input arguments.  It follows the mapping rules:
+
+  DBUS_TYPE_BOOLEAN     => t or nil
+  DBUS_TYPE_BYTE        => number
+  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
+  DBUS_TYPE_DOUBLE      => float
+  DBUS_TYPE_STRING      => string
+  DBUS_TYPE_OBJECT_PATH => string
+  DBUS_TYPE_SIGNATURE   => string
+  DBUS_TYPE_ARRAY       => list
+  DBUS_TYPE_VARIANT     => list
+  DBUS_TYPE_STRUCT      => list
+  DBUS_TYPE_DICT_ENTRY  => list
+
+Example:
+
+\(dbus-call-method
+  :session \"org.gnome.seahorse\" \"/org/gnome/seahorse/keys/openpgp\"
+  \"org.gnome.seahorse.Keys\" \"GetKeyField\"
+  \"openpgp:657984B8C7A966DD\" \"simple-name\")
+
+  => (t (\"Philip R. Zimmermann\"))
+
+If the result of the METHOD call is just one value, the converted Lisp
+object is returned instead of a list containing this single Lisp object.
+
+\(dbus-call-method
+  :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
+  \"org.freedesktop.Hal.Device\" \"GetPropertyString\"
+  \"system.kernel.machine\")
+
+  => \"i686\""
+
+  (or (memq bus '(:system :session)) (stringp bus)
+      (signal 'wrong-type-argument (list 'keywordp bus)))
+  (or (stringp service)
+      (signal 'wrong-type-argument (list 'stringp service)))
+  (or (stringp path)
+      (signal 'wrong-type-argument (list 'stringp path)))
+  (or (stringp interface)
+      (signal 'wrong-type-argument (list 'stringp interface)))
+  (or (stringp method)
+      (signal 'wrong-type-argument (list 'stringp method)))
+
+  (let ((timeout (plist-get args :timeout))
+        (key
+         (apply
+          'dbus-message-internal dbus-message-type-method-call
+          bus service path interface method 'dbus-call-method-handler args)))
+    ;; Wait until `dbus-call-method-handler' has put the result into
+    ;; `dbus-return-values-table'.  If no timeout is given, use the
+    ;; default 25".
+    (with-timeout ((if timeout (/ timeout 1000.0) 25))
+      (while (eq (gethash key dbus-return-values-table :ignore) :ignore)
+        (read-event nil nil 0.1)))
+
+    ;; Cleanup `dbus-return-values-table'.  Return the result.
+    (prog1
+        (gethash key dbus-return-values-table)
+      (remhash key dbus-return-values-table))))
+
+;; `dbus-call-method' works non-blocking now.
+(defalias 'dbus-call-method-non-blocking 'dbus-call-method)
+(make-obsolete 'dbus-call-method-non-blocking 'dbus-call-method "24.2")
+
+(defun dbus-call-method-asynchronously
+ (bus service path interface method handler &rest args)
+ "Call METHOD on the D-Bus BUS asynchronously.
+
+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.
+
+HANDLER is a Lisp function, which is called when the corresponding
+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 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
+converted into D-Bus types via the following rules:
+
+  t and nil => DBUS_TYPE_BOOLEAN
+  number    => DBUS_TYPE_UINT32
+  integer   => DBUS_TYPE_INT32
+  float     => DBUS_TYPE_DOUBLE
+  string    => DBUS_TYPE_STRING
+  list      => DBUS_TYPE_ARRAY
+
+All arguments can be preceded by a type symbol.  For details about
+type symbols, see Info node `(dbus)Type Conversion'.
+
+If HANDLER is a Lisp function, 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:
+
+\(dbus-call-method-asynchronously
+  :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
+  \"org.freedesktop.Hal.Device\" \"GetPropertyString\" 'message
+  \"system.kernel.machine\")
+
+  => \(:serial :system 2)
+
+  -| i686"
+
+  (or (memq bus '(:system :session)) (stringp bus)
+      (signal 'wrong-type-argument (list 'keywordp bus)))
+  (or (stringp service)
+      (signal 'wrong-type-argument (list 'stringp service)))
+  (or (stringp path)
+      (signal 'wrong-type-argument (list 'stringp path)))
+  (or (stringp interface)
+      (signal 'wrong-type-argument (list 'stringp interface)))
+  (or (stringp method)
+      (signal 'wrong-type-argument (list 'stringp method)))
+  (or (null handler) (functionp handler)
+      (signal 'wrong-type-argument (list 'functionp handler)))
+
+  (apply 'dbus-message-internal dbus-message-type-method-call
+         bus service path interface method handler args))
+
+(defun dbus-send-signal (bus service path interface signal &rest args)
+  "Send signal SIGNAL on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.  The signal is sent from the D-Bus object
+Emacs is registered at BUS.
+
+SERVICE is the D-Bus name SIGNAL is sent to.  It can be either a known
+name or a unique name.  If SERVICE is nil, the signal is sent as
+broadcast message.  PATH is the D-Bus object path SIGNAL is sent from.
+INTERFACE is an interface available at PATH.  It must provide signal
+SIGNAL.
+
+All other arguments ARGS are passed to SIGNAL as arguments.  They are
+converted into D-Bus types via the following rules:
+
+  t and nil => DBUS_TYPE_BOOLEAN
+  number    => DBUS_TYPE_UINT32
+  integer   => DBUS_TYPE_INT32
+  float     => DBUS_TYPE_DOUBLE
+  string    => DBUS_TYPE_STRING
+  list      => DBUS_TYPE_ARRAY
+
+All arguments can be preceded by a type symbol.  For details about
+type symbols, see Info node `(dbus)Type Conversion'.
+
+Example:
+
+\(dbus-send-signal
+  :session nil \"/org/gnu/Emacs\" \"org.gnu.Emacs.FileManager\"
+  \"FileModified\" \"/home/albinus/.emacs\")"
+
+  (or (memq bus '(:system :session)) (stringp bus)
+      (signal 'wrong-type-argument (list 'keywordp bus)))
+  (or (null service) (stringp service)
+      (signal 'wrong-type-argument (list 'stringp service)))
+  (or (stringp path)
+      (signal 'wrong-type-argument (list 'stringp path)))
+  (or (stringp interface)
+      (signal 'wrong-type-argument (list 'stringp interface)))
+  (or (stringp signal)
+      (signal 'wrong-type-argument (list 'stringp signal)))
+
+  (apply 'dbus-message-internal dbus-message-type-signal
+         bus service path interface signal args))
+
+(defun dbus-method-return-internal (bus service serial &rest args)
+  "Return for message SERIAL on the D-Bus BUS.
+This is an internal function, it shall not be used outside dbus.el."
+
+  (or (memq bus '(:system :session)) (stringp bus)
+      (signal 'wrong-type-argument (list 'keywordp bus)))
+  (or (stringp service)
+      (signal 'wrong-type-argument (list 'stringp service)))
+  (or (natnump serial)
+      (signal 'wrong-type-argument (list 'natnump serial)))
+
+  (apply 'dbus-message-internal dbus-message-type-method-return
+         bus service serial args))
+
+(defun dbus-method-error-internal (bus service serial &rest args)
+  "Return error message for message SERIAL on the D-Bus BUS.
+This is an internal function, it shall not be used outside dbus.el."
+
+  (or (memq bus '(:system :session)) (stringp bus)
+      (signal 'wrong-type-argument (list 'keywordp bus)))
+  (or (stringp service)
+      (signal 'wrong-type-argument (list 'stringp service)))
+  (or (natnump serial)
+      (signal 'wrong-type-argument (list 'natnump serial)))
+
+  (apply 'dbus-message-internal dbus-message-type-error
+         bus service serial args))
+
+
+;;; Hash table of registered functions.
 
 (defun dbus-list-hash-table ()
   "Returns all registered member registrations to D-Bus.
@@ -126,69 +432,78 @@ hash table."
      dbus-registered-objects-table)
     result))
 
-(defun dbus-unregister-object (object)
-  "Unregister OBJECT from D-Bus.
-OBJECT must be the result of a preceding `dbus-register-method',
-`dbus-register-property' or `dbus-register-signal' call.  It
-returns `t' if OBJECT has been unregistered, `nil' otherwise.
+(defun dbus-setenv (bus variable value)
+  "Set the value of the BUS environment variable named VARIABLE to VALUE.
 
-When OBJECT identifies the last method or property, which is
-registered for the respective service, Emacs releases its
-association to the service from D-Bus."
-  ;; Check parameter.
-  (unless (and (consp object) (not (null (car object))) (consp (cdr object)))
-    (signal 'wrong-type-argument (list 'D-Bus object)))
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.  Both VARIABLE and VALUE should be strings.
 
-  ;; Find the corresponding entry in the hash table.
-  (let* ((key (car object))
-         (value (cadr object))
-         (bus (car key))
-         (service (car value))
-         (entry (gethash key dbus-registered-objects-table))
-         ret)
-    ;; key has the structure (BUS INTERFACE MEMBER).
-    ;; value has the structure (SERVICE PATH [HANDLER]).
-    ;; entry has the structure ((UNAME SERVICE PATH MEMBER [RULE]) ...).
-    ;; MEMBER is either a string (the handler), or a cons cell (a
-    ;; property value).  UNAME and property values are not taken into
-    ;; account for comparison.
+Normally, services inherit the environment of the BUS daemon.  This
+function adds to or modifies that environment when activating services.
 
-    ;; Loop over the registered functions.
-    (dolist (elt entry)
-      (when (equal
-             value
-             (butlast (cdr elt) (- (length (cdr elt)) (length value))))
-        (setq ret t)
-        ;; Compute new hash value.  If it is empty, remove it from the
-        ;; hash table.
-        (unless (puthash key (delete elt entry) dbus-registered-objects-table)
-          (remhash key dbus-registered-objects-table))
-        ;; Remove match rule of signals.
-        (let ((rule (nth 4 elt)))
-          (when (stringp rule)
-            (setq service nil) ; We do not need to unregister the service.
-            (dbus-call-method
-             bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
-             "RemoveMatch" rule)))))
-    ;; Check, whether there is still a registered function or property
-    ;; for the given service.  If not, unregister the service from the
-    ;; bus.
-    (when service
-      (dolist (elt entry)
-        (let (found)
-          (maphash
-           (lambda (k v)
-             (dolist (e v)
-               (ignore-errors
-                 (when (and (equal bus (car k)) (string-equal service (cadr e)))
-                   (setq found t)))))
-           dbus-registered-objects-table)
-          (unless found
-            (dbus-call-method
-             bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
-             "ReleaseName" service)))))
-    ;; Return.
-    ret))
+Some bus instances, such as `:system', may disable setting the environment."
+  (dbus-call-method
+   bus dbus-service-dbus dbus-path-dbus
+   dbus-interface-dbus "UpdateActivationEnvironment"
+   `(:array (:dict-entry ,variable ,value))))
+
+(defun dbus-register-service (bus service &rest flags)
+  "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."
+
+  ;; Add ObjectManager handler.
+  (dbus-register-method
+   bus service nil dbus-interface-objectmanager "GetManagedObjects"
+   'dbus-managed-objects-handler 'dont-register)
+
+  (let ((arg 0)
+        reply)
+    (dolist (flag flags)
+      (setq arg
+            (+ arg
+               (case flag
+                 (:allow-replacement 1)
+                 (:replace-existing 2)
+                 (:do-not-queue 4)
+                 (t (signal 'wrong-type-argument (list flag)))))))
+    (setq reply (dbus-call-method
+                 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+                 "RequestName" service arg))
+    (case reply
+      (1 :primary-owner)
+      (2 :in-queue)
+      (3 :exists)
+      (4 :already-owner)
+      (t (signal 'dbus-error (list "Could not register service" service))))))
 
 (defun dbus-unregister-service (bus service)
   "Unregister all objects related to SERVICE from D-Bus BUS.
@@ -209,7 +524,7 @@ queue of this service."
    (lambda (key value)
      (dolist (elt value)
        (ignore-errors
-         (when (and (equal bus (car key)) (string-equal service (cadr elt)))
+         (when (and (equal bus (cadr key)) (string-equal service (cadr elt)))
            (unless
                (puthash key (delete elt value) dbus-registered-objects-table)
              (remhash key dbus-registered-objects-table))))))
@@ -223,94 +538,274 @@ queue of this service."
       (3 :not-owner)
       (t (signal 'dbus-error (list "Could not unregister service" service))))))
 
-(defun dbus-call-method-non-blocking-handler (&rest args)
-  "Handler for reply messages of asynchronous D-Bus message calls.
-It calls the function stored in `dbus-registered-objects-table'.
-The result will be made available in `dbus-return-values-table'."
-  (puthash (list (dbus-event-bus-name last-input-event)
-                 (dbus-event-serial-number last-input-event))
-           (if (= (length args) 1) (car args) args)
-           dbus-return-values-table))
+(defun dbus-register-signal
+  (bus service path interface signal handler &rest args)
+  "Register for a signal on the D-Bus BUS.
 
-(defun dbus-call-method-non-blocking
-  (bus service path interface method &rest args)
-  "Call METHOD on the D-Bus BUS, but don't block the event queue.
-This is necessary for communicating to registered D-Bus methods,
-which are running in the same Emacs process.
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
 
-The arguments are the same as in `dbus-call-method'.
+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
+sending the signal.
+
+PATH is the D-Bus object path SERVICE is registered.  INTERFACE
+is an interface offered by SERVICE.  It must provide SIGNAL.
+HANDLER is a Lisp function to be called when the signal is
+received.  It must accept as arguments the values SIGNAL is
+sending.
+
+SERVICE, PATH, INTERFACE and SIGNAL can be nil.  This is
+interpreted as a wildcard for the respective argument.
+
+The remaining arguments ARGS can be keywords or keyword string pairs.
+The meaning is as follows:
+
+`:argN' STRING:
+`:pathN' STRING: This stands for the Nth argument of the
+signal.  `:pathN' arguments can be used for object path wildcard
+matches as specified by D-Bus, whilest an `:argN' argument
+requires an exact match.
+
+`:arg-namespace' STRING: Register for the signals, which first
+argument defines the service or interface namespace STRING.
+
+`:path-namespace' STRING: Register for the object path namespace
+STRING.  All signals sent from an object path, which has STRING as
+the preceding string, are matched.  This requires PATH to be nil.
+
+`:eavesdrop': Register for unicast signals which are not directed
+to the D-Bus object Emacs is registered at D-Bus BUS, if the
+security policy of BUS allows this.
+
+Example:
+
+\(defun my-signal-handler (device)
+  (message \"Device %s added\" device))
+
+\(dbus-register-signal
+  :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
+  \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" 'my-signal-handler)
+
+  => \(\(:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
+      \(\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler))
+
+`dbus-register-signal' returns an object, which can be used in
+`dbus-unregister-object' for removing the registration."
+
+  (let ((counter 0)
+        (rule "type='signal'")
+        uname key key1 value)
+
+    ;; Retrieve unique name of service.  If service is a known name,
+    ;; we will register for the corresponding unique name, if any.
+    ;; Signals are sent always with the unique name as sender.  Note:
+    ;; the unique name of `dbus-service-dbus' is that string itself.
+    (if (and (stringp service)
+             (not (zerop (length service)))
+             (not (string-equal service dbus-service-dbus))
+             (not (string-match "^:" service)))
+        (setq uname (dbus-get-name-owner bus service))
+      (setq uname service))
+
+    (setq rule (concat rule
+                       (when uname (format ",sender='%s'" uname))
+                       (when interface (format ",interface='%s'" interface))
+                       (when signal (format ",member='%s'" signal))
+                       (when path (format ",path='%s'" path))))
+
+    ;; Add arguments to the rule.
+    (if (or (stringp (car args)) (null (car args)))
+        ;; As backward compatibility option, we allow just strings.
+        (dolist (arg args)
+          (if (stringp arg)
+              (setq rule (concat rule (format ",arg%d='%s'" counter arg)))
+            (if arg (signal 'wrong-type-argument (list "Wrong argument" arg))))
+          (setq counter (1+ counter)))
+
+      ;; Parse keywords.
+      (while args
+        (setq
+         key (car args)
+         rule (concat
+               rule
+               (cond
+                ;; `:arg0' .. `:arg63', `:path0' .. `:path63'.
+                ((and (keywordp key)
+                      (string-match
+                       "^:\\(arg\\|path\\)\\([[:digit:]]+\\)$"
+                       (symbol-name key)))
+                 (setq counter (match-string 2 (symbol-name key))
+                       args (cdr args)
+                       value (car args))
+                 (unless (and (<= counter 63) (stringp value))
+                   (signal 'wrong-type-argument
+                           (list "Wrong argument" key value)))
+                 (format
+                  ",arg%s%s='%s'"
+                  counter
+                  (if (string-equal (match-string 1 (symbol-name key)) "path")
+                      "path" "")
+                  value))
+                ;; `:arg-namespace', `:path-namespace'.
+                ((and (keywordp key)
+                      (string-match
+                       "^:\\(arg\\|path\\)-namespace$" (symbol-name key)))
+                 (setq args (cdr args)
+                       value (car args))
+                 (unless (stringp value)
+                   (signal 'wrong-type-argument
+                           (list "Wrong argument" key value)))
+                 (format
+                  ",%s='%s'"
+                  (if (string-equal (match-string 1 (symbol-name key)) "path")
+                      "path_namespace" "arg0namespace")
+                  value))
+                ;; `:eavesdrop'.
+                ((eq key :eavesdrop)
+                 ",eavesdrop='true'")
+                (t (signal 'wrong-type-argument (list "Wrong argument" key)))))
+         args (cdr args))))
+
+    ;; Add the rule to the bus.
+    (condition-case err
+        (dbus-call-method
+         bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+         "AddMatch" rule)
+      (dbus-error
+       (if (not (string-match "eavesdrop" rule))
+           (signal (car err) (cdr err))
+         ;; The D-Bus spec says we shall fall back to a rule without eavesdrop.
+         (when dbus-debug (message "Removing eavesdrop from rule %s" rule))
+         (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule))
+         (dbus-call-method
+          bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+          "AddMatch" rule))))
 
-usage: (dbus-call-method-non-blocking
-         BUS SERVICE PATH INTERFACE METHOD
-         &optional :timeout TIMEOUT &rest ARGS)"
+    (when dbus-debug (message "Matching rule \"%s\" created" rule))
 
-  (let ((key
-         (apply
-          'dbus-call-method-asynchronously
-          bus service path interface method
-          'dbus-call-method-non-blocking-handler args)))
-    ;; Wait until `dbus-call-method-non-blocking-handler' has put the
-    ;; result into `dbus-return-values-table'.
-    (while (eq (gethash key dbus-return-values-table :ignore) :ignore)
-      (read-event nil nil 0.1))
+    ;; Create a hash table entry.
+    (setq key (list :signal bus interface signal)
+          key1 (list uname service path handler rule)
+          value (gethash key dbus-registered-objects-table))
+    (unless  (member key1 value)
+      (puthash key (cons key1 value) dbus-registered-objects-table))
 
-    ;; Cleanup `dbus-return-values-table'.  Return the result.
-    (prog1
-        (gethash key dbus-return-values-table nil)
-      (remhash key dbus-return-values-table))))
+    ;; Return the object.
+    (list key (list service path handler))))
 
-(defun dbus-name-owner-changed-handler (&rest args)
-  "Reapplies all member registrations to D-Bus.
-This handler is applied when a \"NameOwnerChanged\" signal has
-arrived.  SERVICE is the object name for which the name owner has
-been changed.  OLD-OWNER is the previous owner of SERVICE, or the
-empty string if SERVICE was not owned yet.  NEW-OWNER is the new
-owner of SERVICE, or the empty string if SERVICE loses any name owner.
-
-usage: (dbus-name-owner-changed-handler service old-owner new-owner)"
-  (save-match-data
-    ;; Check the arguments.  We should silently ignore it when they
-    ;; are wrong.
-    (if (and (= (length args) 3)
-             (stringp (car args))
-             (stringp (cadr args))
-             (stringp (caddr args)))
-        (let ((service (car args))
-              (old-owner (cadr args)))
-          ;; Check whether SERVICE is a known name.
-          (when (not (string-match "^:" service))
-            (maphash
-             (lambda (key value)
-               (dolist (elt value)
-                 ;; key has the structure (BUS INTERFACE MEMBER).
-                 ;; elt has the structure (UNAME SERVICE PATH HANDLER).
-                 (when (string-equal old-owner (car elt))
-                   ;; Remove old key, and add new entry with changed name.
-                   (dbus-unregister-object (list key (cdr elt)))
-                   ;; Maybe we could arrange the lists a little bit better
-                   ;; that we don't need to extract every single element?
-                   (dbus-register-signal
-                    ;; BUS      SERVICE     PATH
-                    (nth 0 key) (nth 1 elt) (nth 2 elt)
-                    ;; INTERFACE MEMBER     HANDLER
-                    (nth 1 key) (nth 2 key) (nth 3 elt)))))
-             (copy-hash-table dbus-registered-objects-table))))
-      ;; The error is reported only in debug mode.
-      (when  dbus-debug
-        (signal
-         'dbus-error
-         (cons
-          (format "Wrong arguments of %s.NameOwnerChanged" dbus-interface-dbus)
-          args))))))
-
-;; Register the handler.
-(when nil ;ignore-errors
-  (dbus-register-signal
-   :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus
-   "NameOwnerChanged" 'dbus-name-owner-changed-handler)
-  (dbus-register-signal
-   :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus
-   "NameOwnerChanged" 'dbus-name-owner-changed-handler))
+(defun dbus-register-method
+  (bus service path interface method handler &optional dont-register-service)
+  "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 (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.
+In case HANDLER shall return a reply message with an empty argument
+list, HANDLER must return the symbol `:ignore'.
+
+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 used to prevent other clients from
+discovering the still incomplete interface."
+
+  ;; Register SERVICE.
+  (unless (or dont-register-service
+              (member service (dbus-list-names bus)))
+    (dbus-register-service bus service))
+
+  ;; Create a hash table entry.  We use nil for the unique name,
+  ;; because the method might be called from anybody.
+  (let* ((key (list :method bus interface method))
+         (key1 (list nil service path handler))
+         (value (gethash key dbus-registered-objects-table)))
+
+    (unless  (member key1 value)
+      (puthash key (cons key1 value) dbus-registered-objects-table))
+
+    ;; Return the object.
+    (list key (list service path handler))))
+
+(defun dbus-unregister-object (object)
+  "Unregister OBJECT from D-Bus.
+OBJECT must be the result of a preceding `dbus-register-method',
+`dbus-register-property' or `dbus-register-signal' call.  It
+returns `t' if OBJECT has been unregistered, `nil' otherwise.
+
+When OBJECT identifies the last method or property, which is
+registered for the respective service, Emacs releases its
+association to the service from D-Bus."
+  ;; Check parameter.
+  (unless (and (consp object) (not (null (car object))) (consp (cdr object)))
+    (signal 'wrong-type-argument (list 'D-Bus object)))
+
+  ;; Find the corresponding entry in the hash table.
+  (let* ((key (car object))
+         (type (car key))
+         (bus (cadr key))
+         (value (cadr object))
+         (service (car value))
+         (entry (gethash key dbus-registered-objects-table))
+         ret)
+    ;; key has the structure (TYPE BUS INTERFACE MEMBER).
+    ;; value has the structure (SERVICE PATH [HANDLER]).
+    ;; entry has the structure ((UNAME SERVICE PATH MEMBER [RULE]) ...).
+    ;; MEMBER is either a string (the handler), or a cons cell (a
+    ;; property value).  UNAME and property values are not taken into
+    ;; account for comparison.
+
+    ;; Loop over the registered functions.
+    (dolist (elt entry)
+      (when (equal
+             value
+             (butlast (cdr elt) (- (length (cdr elt)) (length value))))
+        (setq ret t)
+        ;; Compute new hash value.  If it is empty, remove it from the
+        ;; hash table.
+        (unless (puthash key (delete elt entry) dbus-registered-objects-table)
+          (remhash key dbus-registered-objects-table))
+        ;; Remove match rule of signals.
+        (when (eq type :signal)
+          (dbus-call-method
+           bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+           "RemoveMatch" (nth 4 elt)))))
+
+    ;; Check, whether there is still a registered function or property
+    ;; for the given service.  If not, unregister the service from the
+    ;; bus.
+    (when (and service (memq type '(:method :property))
+               (not (catch :found
+                      (progn
+                        (maphash
+                         (lambda (k v)
+                           (dolist (e v)
+                             (ignore-errors
+                               (and
+                                ;; Bus.
+                                (equal bus (cadr k))
+                                ;; Service.
+                                (string-equal service (cadr e))
+                                ;; Non-empty object path.
+                                (caddr e)
+                                (throw :found t)))))
+                         dbus-registered-objects-table)
+                        nil))))
+      (dbus-unregister-service bus service))
+    ;; Return.
+    ret))
 
 
 ;;; D-Bus type conversion.
@@ -437,9 +932,9 @@ If the HANDLER returns a `dbus-error', it is propagated as return message."
           (dbus-ignore-errors
             (if (eq result :ignore)
                 (dbus-method-return-internal
-                 (nth 1 event) (nth 3 event) (nth 4 event))
+                 (nth 1 event) (nth 4 event) (nth 3 event))
               (apply 'dbus-method-return-internal
-                     (nth 1 event) (nth 3 event) (nth 4 event)
+                     (nth 1 event) (nth 4 event) (nth 3 event)
                      (if (consp result) result (list result)))))))
     ;; Error handling.
     (dbus-error
@@ -447,7 +942,7 @@ If the HANDLER returns a `dbus-error', it is propagated as return message."
      (when (= dbus-message-type-method-call (nth 2 event))
        (dbus-ignore-errors
          (dbus-method-error-internal
-          (nth 1 event) (nth 3 event) (nth 4 event) (cadr err))))
+          (nth 1 event) (nth 4 event) (nth 3 event) (cadr err))))
      ;; Propagate D-Bus error messages.
      (run-hook-with-args 'dbus-event-error-hooks event err)
      (when (or dbus-debug (= dbus-message-type-error (nth 2 event)))
@@ -596,11 +1091,11 @@ are strings.  The result, the introspection data, is a string in
 XML format."
   ;; We don't want to raise errors.  `dbus-call-method-non-blocking'
   ;; is used, because the handler can be registered in our Emacs
-  ;; instance; caller an callee would block each other.
+  ;; instance; caller and callee would block each other.
   (dbus-ignore-errors
-    (funcall
-     (if noninteractive 'dbus-call-method 'dbus-call-method-non-blocking)
-     bus service path dbus-interface-introspectable "Introspect")))
+    (dbus-call-method
+     bus service path dbus-interface-introspectable "Introspect"
+     :timeout 1000)))
 
 (defun dbus-introspect-xml (bus service path)
   "Return the introspection data of SERVICE in D-Bus BUS at object path PATH.
@@ -854,12 +1349,11 @@ be \"out\"."
 It will be checked at BUS, SERVICE, PATH.  The result can be any
 valid D-Bus value, or `nil' if there is no PROPERTY."
   (dbus-ignore-errors
-    ;; "Get" returns a variant, so we must use the `car'.
-    (car
-     (funcall
-      (if noninteractive 'dbus-call-method 'dbus-call-method-non-blocking)
-      bus service path dbus-interface-properties
-      "Get" :timeout 500 interface property))))
+   ;; "Get" returns a variant, so we must use the `car'.
+   (car
+    (dbus-call-method
+     bus service path dbus-interface-properties
+     "Get" :timeout 500 interface property))))
 
 (defun dbus-set-property (bus service path interface property value)
   "Set value of PROPERTY of INTERFACE to VALUE.
@@ -867,13 +1361,12 @@ It will be checked at BUS, SERVICE, PATH.  When the value has
 been set successful, the result is VALUE.  Otherwise, `nil' is
 returned."
   (dbus-ignore-errors
-    ;; "Set" requires a variant.
-    (funcall
-     (if noninteractive 'dbus-call-method 'dbus-call-method-non-blocking)
-     bus service path dbus-interface-properties
-     "Set" :timeout 500 interface property (list :variant value))
-    ;; Return VALUE.
-    (dbus-get-property bus service path interface property)))
+   ;; "Set" requires a variant.
+   (dbus-call-method
+    bus service path dbus-interface-properties
+    "Set" :timeout 500 interface property (list :variant value))
+   ;; Return VALUE.
+   (dbus-get-property bus service path interface property)))
 
 (defun dbus-get-all-properties (bus service path interface)
   "Return all properties of INTERFACE at BUS, SERVICE, PATH.
@@ -884,10 +1377,7 @@ name of the property, and its value.  If there are no properties,
     ;; "GetAll" returns "a{sv}".
     (let (result)
       (dolist (dict
-               (funcall
-                (if noninteractive
-                    'dbus-call-method
-                  'dbus-call-method-non-blocking)
+               (dbus-call-method
                 bus service path dbus-interface-properties
                 "GetAll" :timeout 500 interface)
                result)
@@ -931,14 +1421,7 @@ constructed incrementally by adding single methods or properties
 at a time, DONT-REGISTER-SERVICE can be used to prevent other
 clients from discovering the still incomplete interface."
   (unless (member access '(:read :readwrite))
-    (signal 'dbus-error (list "Access type invalid" access)))
-
-  ;; Register SERVICE.
-  (unless (or dont-register-service
-              (member service (dbus-list-names bus)))
-    (dbus-call-method
-     bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
-     "RequestName" service 0))
+    (signal 'wrong-type-argument (list "Access type invalid" access)))
 
   ;; Add handlers for the three property-related methods.
   (dbus-register-method
@@ -951,20 +1434,20 @@ clients from discovering the still incomplete interface."
    bus service path dbus-interface-properties "Set"
    'dbus-property-handler 'dont-register)
 
-  ;; Register the name SERVICE with BUS.
-  (unless dont-register-service
+  ;; Register SERVICE.
+  (unless (or dont-register-service (member service (dbus-list-names bus)))
     (dbus-register-service bus service))
 
   ;; Send the PropertiesChanged signal.
   (when emits-signal
     (dbus-send-signal
      bus service path dbus-interface-properties "PropertiesChanged"
-     (list (list :dict-entry property (list :variant value)))
+     `((:dict-entry ,property (:variant ,value)))
      '(:array)))
 
   ;; Create a hash table entry.  We use nil for the unique name,
   ;; because the property might be accessed from anybody.
-  (let ((key (list bus interface property))
+  (let ((key (list :property bus interface property))
         (val
          (list
           (list
@@ -979,7 +1462,7 @@ clients from discovering the still incomplete interface."
 
 (defun dbus-property-handler (&rest args)
   "Default handler for the \"org.freedesktop.DBus.Properties\" interface.
-It will be registered for all objects created by `dbus-register-object'."
+It will be registered for all objects created by `dbus-register-property'."
   (let ((bus (dbus-event-bus-name last-input-event))
         (service (dbus-event-service-name last-input-event))
         (path (dbus-event-path-name last-input-event))
@@ -989,15 +1472,15 @@ It will be registered for all objects created by `dbus-register-object'."
     (cond
      ;; "Get" returns a variant.
      ((string-equal method "Get")
-      (let ((entry (gethash (list bus interface property)
+      (let ((entry (gethash (list :property bus interface property)
                             dbus-registered-objects-table)))
         (when (string-equal path (nth 2 (car entry)))
-          (list (list :variant (cdar (last (car entry))))))))
+          `((:variant ,(cdar (last (car entry))))))))
 
      ;; "Set" expects a variant.
      ((string-equal method "Set")
       (let* ((value (caar (cddr args)))
-             (entry (gethash (list bus interface property)
+             (entry (gethash (list :property bus interface property)
                              dbus-registered-objects-table))
              ;; The value of the hash table is a list; in case of
              ;; properties it contains just one element (UNAME SERVICE
@@ -1012,7 +1495,7 @@ It will be registered for all objects created by `dbus-register-object'."
         (unless (member :readwrite (car object))
           (signal 'dbus-error
                   (list "Property not writable at path" property path)))
-        (puthash (list bus interface property)
+        (puthash (list :property bus interface property)
                  (list (append (butlast (car entry))
                                (list (cons (car object) value))))
                  dbus-registered-objects-table)
@@ -1020,7 +1503,7 @@ It will be registered for all objects created by `dbus-register-object'."
         (when (member :emits-signal (car object))
           (dbus-send-signal
            bus service path dbus-interface-properties "PropertiesChanged"
-           (list (list :dict-entry property (list :variant value)))
+           `((:dict-entry ,property (:variant ,value)))
            '(:array)))
         ;; Return empty reply.
         :ignore))
@@ -1030,7 +1513,7 @@ It will be registered for all objects created by `dbus-register-object'."
       (let (result)
         (maphash
          (lambda (key val)
-           (when (and (equal (butlast key) (list bus interface))
+           (when (and (equal (butlast key) (list :property bus interface))
                       (string-equal path (nth 2 (car val)))
                       (not (functionp (car (last (car val))))))
              (add-to-list
@@ -1042,15 +1525,151 @@ It will be registered for all objects created by `dbus-register-object'."
         ;; Return the result, or an empty array.
         (list :array (or result '(:signature "{sv}"))))))))
 
+
+;;; D-Bus object manager.
+
+(defun dbus-get-all-managed-objects (bus service path)
+  "Return all objects at BUS, SERVICE, PATH, and the children of PATH.
+The result is a list of objects.  Every object is a cons of an
+existing path name, and the list of available interface objects.
+An interface object is another cons, which car is the interface
+name, and the cdr is the list of properties as returned by
+`dbus-get-all-properties' for that path and interface. Example:
+
+\(dbus-get-all-managed-objects :session \"org.gnome.SettingsDaemon\" \"/\")
+
+  => \(\(\"/org/gnome/SettingsDaemon/MediaKeys\"
+       \(\"org.gnome.SettingsDaemon.MediaKeys\")
+       \(\"org.freedesktop.DBus.Peer\")
+       \(\"org.freedesktop.DBus.Introspectable\")
+       \(\"org.freedesktop.DBus.Properties\")
+       \(\"org.freedesktop.DBus.ObjectManager\"))
+      \(\"/org/gnome/SettingsDaemon/Power\"
+       \(\"org.gnome.SettingsDaemon.Power.Keyboard\")
+       \(\"org.gnome.SettingsDaemon.Power.Screen\")
+       \(\"org.gnome.SettingsDaemon.Power\"
+        \(\"Icon\" . \". GThemedIcon battery-full-charged-symbolic \")
+        \(\"Tooltip\" . \"Laptop battery is charged\"))
+       \(\"org.freedesktop.DBus.Peer\")
+       \(\"org.freedesktop.DBus.Introspectable\")
+       \(\"org.freedesktop.DBus.Properties\")
+       \(\"org.freedesktop.DBus.ObjectManager\"))
+      ...)
+
+If possible, \"org.freedesktop.DBus.ObjectManager.GetManagedObjects\"
+is used for retrieving the information.  Otherwise, the information
+is collected via \"org.freedesktop.DBus.Introspectable.Introspect\"
+and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
+    (let ((result
+           ;; Direct call.  Fails, if the target does not support the
+           ;; object manager interface.
+           (dbus-ignore-errors
+            (dbus-call-method
+             bus service path dbus-interface-objectmanager
+             "GetManagedObjects" :timeout 1000))))
+
+      (if result
+          ;; Massage the returned structure.
+          (dolist (entry result result)
+            ;; "a{oa{sa{sv}}}".
+            (dolist (entry1 (cdr entry))
+              ;; "a{sa{sv}}".
+              (dolist (entry2 entry1)
+                ;; "a{sv}".
+                (if (cadr entry2)
+                    ;; "sv".
+                    (dolist (entry3 (cadr entry2))
+                      (setcdr entry3 (caadr entry3)))
+                  (setcdr entry2 nil)))))
+
+        ;; Fallback: collect the information.  Slooow!
+        (dolist (object
+                 (dbus-introspect-get-all-nodes bus service path)
+                 result)
+          (let (result1)
+            (dolist
+                (interface
+                 (dbus-introspect-get-interface-names bus service object)
+                 result1)
+              (add-to-list
+               'result1
+               (cons interface
+                     (dbus-get-all-properties bus service object interface))))
+            (when result1
+              (add-to-list 'result (cons object result1))))))))
+
+(defun dbus-managed-objects-handler ()
+  "Default handler for the \"org.freedesktop.DBus.ObjectManager\" interface.
+It will be registered for all objects created by `dbus-register-method'."
+  (let* ((last-input-event last-input-event)
+         (bus (dbus-event-bus-name last-input-event))
+         (service (dbus-event-service-name last-input-event))
+         (path (dbus-event-path-name last-input-event)))
+    ;; "GetManagedObjects" returns "a{oa{sa{sv}}}".
+    (let (interfaces result)
+
+      ;; Check for object path wildcard interfaces.
+      (maphash
+       (lambda (key val)
+         (when (and (equal (butlast key 2) (list :method bus))
+                    (null (nth 2 (car-safe val))))
+           (add-to-list 'interfaces (nth 2 key))))
+       dbus-registered-objects-table)
+
+      ;; Check all registered object paths.
+      (maphash
+       (lambda (key val)
+         (let ((object (or (nth 2 (car-safe val)) ""))
+               (interface (nth 2 key)))
+           (when (and (equal (butlast key 2) (list :method bus))
+                      (string-prefix-p path object))
+             (dolist (interface (cons (nth 2 key) interfaces))
+               (unless (assoc object result)
+                 (add-to-list 'result (list object)))
+               (unless (assoc interface (cdr (assoc object result)))
+                 (setcdr
+                  (assoc object result)
+                  (append
+                   (list (cons
+                    interface
+                    ;; We simulate "org.freedesktop.DBus.Properties.GetAll"
+                    ;; by using an appropriate D-Bus event.
+                    (let ((last-input-event
+                           (append
+                            (butlast last-input-event 4)
+                            (list object dbus-interface-properties
+                                  "GetAll" 'dbus-property-handler))))
+                      (dbus-property-handler interface))))
+                   (cdr (assoc object result)))))))))
+       dbus-registered-objects-table)
+
+      ;; Return the result, or an empty array.
+      (list
+       :array
+       (or
+        (mapcar
+         (lambda (x)
+           (list
+            :dict-entry :object-path (car x)
+            (cons :array (mapcar (lambda (y) (cons :dict-entry y)) (cdr x)))))
+         result)
+        '(:signature "{oa{sa{sv}}}"))))))
+
  
-;; Initialize :system and :session buses.  This adds their file
+;; Initialize `:system' and `:session' buses.  This adds their file
 ;; descriptors to input_wait_mask, in order to detect incoming
 ;; messages immediately.
 (when (featurep 'dbusbind)
   (dbus-ignore-errors
-    (dbus-init-bus :system)
+    (dbus-init-bus :system))
+  (dbus-ignore-errors
     (dbus-init-bus :session)))
 
 (provide 'dbus)
 
+;;; TODO:
+
+;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
+;;   org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
+
 ;;; dbus.el ends here