Fix thinko in dbus.el

* doc/misc/dbus.texi (Register Objects): Rename from "Receiving
Method Calls".  Add reference to D-Bus API Design document.

* lisp/net/dbus.el (dbus-managed-objects-handler): Fix thinko.

* test/lisp/net/dbus-tests.el (dbus-test05-register-property)
(dbus-test05-register-property-several-paths): Extend tests.

diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 4b2a5dc212299fc5fd3064755d8a4ebb5faec546..2880b7f7430a6043f8dc2f44aa2608a1c4cfa105 100644 (file)
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -59,7 +59,7 @@ another.  An overview of D-Bus can be found at
 * Type Conversion::             Mapping Lisp types and D-Bus types.
 * Synchronous Methods::         Calling methods in a blocking way.
 * Asynchronous Methods::        Calling methods non-blocking.
-* Receiving Method Calls::      Offering own methods.
+* Register Objects::            Offering own services.
 * Signals::                     Sending and receiving signals.
 * Alternative Buses::           Alternative buses and environments.
 * Errors and Events::           Errors and events.
@@ -1341,11 +1341,15 @@ message arrives, and @var{handler} is called.  Example:
 @end defun
 
 
-@node Receiving Method Calls
-@chapter Offering own methods.
+@node Register Objects
+@chapter Offering own services.
 @cindex method calls, returning
 @cindex returning method calls
 
+You can offer an own service in D-Bus, which will be visible by other
+D-Bus clients.  See @uref{https://dbus.freedesktop.org/doc/dbus-api-design.html}
+for a discussion of the design.
+
 In order to register methods on the D-Bus, Emacs has to request a well
 known name on the D-Bus under which it will be available for other
 clients.  Names on the D-Bus can be registered and unregistered using

diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 525036caed7d8dffcfb34b9e7506e6c3e51eb5ff..5afc7f111f87eadc8bd97e70465d62272a6353e9 100644 (file)
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -1780,7 +1780,7 @@ It will be registered for all objects created by `dbus-register-service'."
       ;; Check for object path wildcard interfaces.
       (maphash
        (lambda (key val)
-        (when (and (equal (butlast key 2) (list :method bus))
+        (when (and (equal (butlast key 2) (list :property bus))
                    (null (nth 2 (car-safe val))))
           (push (nth 2 key) interfaces)))
        dbus-registered-objects-table)
@@ -1789,7 +1789,7 @@ It will be registered for all objects created by `dbus-register-service'."
       (maphash
        (lambda (key val)
         (let ((object (or (nth 2 (car-safe val)) "")))
-          (when (and (equal (butlast key 2) (list :method bus))
+          (when (and (equal (butlast key 2) (list :property bus))
                      (string-prefix-p path object))
             (dolist (interface (cons (nth 2 key) interfaces))
               (unless (assoc object result)

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index cc4bdc11ec644b072f06c5c8c2a43dbba65ff7ff..8b456c3551fab900475969cfe4b14a2f23e1185a 100644 (file)
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -348,17 +348,18 @@ This includes initialization and closing the bus."
                 dbus--test-interface)))
           (should (string-equal (cdr (assoc property1 result)) "foo"))
           (should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
-          (should-not (assoc property2 result))))
+          (should-not (assoc property2 result)))
 
-        ;; FIXME: This is wrong! The properties are missing.
-        ;; (should
-        ;;  (equal
-        ;;   (dbus-get-all-managed-objects
-        ;;    :session dbus--test-service dbus--test-path)
-        ;;   `((,dbus--test-path
-        ;;      ((,dbus-interface-peer)
-        ;;       (,dbus-interface-objectmanager)
-        ;;       (,dbus-interface-properties)))))))
+        ;; `dbus-get-all-managed-objects'.  We cannot retrieve a value for
+        ;; the property with `:write' access type.
+        (let ((result
+               (dbus-get-all-managed-objects
+                :session dbus--test-service dbus--test-path)))
+          (should (setq result (cadr (assoc dbus--test-path result))))
+          (should (setq result (cadr (assoc dbus--test-interface result))))
+          (should (string-equal (cdr (assoc property1 result)) "foo"))
+          (should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
+          (should-not (assoc property2 result))))
 
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))
@@ -488,13 +489,33 @@ This includes initialization and closing the bus."
           (should (string-equal (cdr (assoc property1 result)) "foofoo"))
           (should (string-equal (cdr (assoc property2 result)) "barbar"))
           (should-not (assoc property3 result)))
+
         (let ((result
                (dbus-get-all-properties
                 :session dbus--test-service
                 (concat dbus--test-path dbus--test-path) dbus--test-interface)))
           (should (string-equal (cdr (assoc property2 result)) "foofoo"))
           (should (string-equal (cdr (assoc property3 result)) "barbar"))
-          (should-not (assoc property1 result))))
+          (should-not (assoc property1 result)))
+
+        ;; Final check with `dbus-get-all-managed-objects'.
+        (let ((result
+               (dbus-get-all-managed-objects :session dbus--test-service "/"))
+              result1)
+          (should (setq result1 (cadr (assoc dbus--test-path result))))
+          (should (setq result1 (cadr (assoc dbus--test-interface result1))))
+          (should (string-equal (cdr (assoc property1 result1)) "foofoo"))
+          (should (string-equal (cdr (assoc property2 result1)) "barbar"))
+          (should-not (assoc property3 result1))
+
+          (should
+           (setq
+            result1
+            (cadr (assoc (concat dbus--test-path dbus--test-path) result))))
+          (should (setq result1 (cadr (assoc dbus--test-interface result1))))
+          (should (string-equal (cdr (assoc property2 result1)) "foofoo"))
+          (should (string-equal (cdr (assoc property3 result1)) "barbar"))
+          (should-not (assoc property1 result1))))
 
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))