diff options
| -rw-r--r-- | doc/misc/dbus.texi | 10 | ||||
| -rw-r--r-- | lisp/net/dbus.el | 4 | ||||
| -rw-r--r-- | test/lisp/net/dbus-tests.el | 43 |
3 files changed, 41 insertions, 16 deletions
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 4b2a5dc2122..2880b7f7430 100644 --- 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 525036caed7..5afc7f111f8 100644 --- 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 cc4bdc11ec6..8b456c3551f 100644 --- 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))) |