master 96a8e84: Make dbus-unregister-object work for monitors

[Michael Albinus]

branch: master
commit 96a8e846061f255b1a394a5854197aa742dfff84
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Make dbus-unregister-object work for monitors
    
    * doc/misc/dbus.texi (Monitoring Messages): Rename from
    "Monitoring Events".
    (Register Objects, Monitoring Messages):
    Mention returned object.
    
    * lisp/net/dbus.el (dbus-unregister-object): Adapt docstring.
    (dbus-unregister-object): Delete monitor if needed.
    (dbus-register-monitor): Return proper object.
    
    * src/dbusbind.c (dbus-registered-objects-table): Adapt docstring.
    
    * test/lisp/net/dbus-tests.el (dbus--test-signal-handler):
    Adapt docstring.
    (dbus-test08-register-monitor): New test.
---
 doc/misc/dbus.texi          | 35 ++++++++++++++++++++---------------
 lisp/net/dbus.el            | 12 ++++++++----
 src/dbusbind.c              | 18 ++++++++++--------
 test/lisp/net/dbus-tests.el | 42 +++++++++++++++++++++++++++++++++++++++++-
 4 files changed, 79 insertions(+), 28 deletions(-)

diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 4b2eab4..5a1dd55 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -63,7 +63,7 @@ another.  An overview of D-Bus can be found at
 * Signals::                     Sending and receiving signals.
 * Alternative Buses::           Alternative buses and environments.
 * Errors and Events::           Errors and events.
-* Monitoring Events::           Monitoring events.
+* Monitoring Messages::         Monitoring messages.
 * Index::                       Index including concepts, functions, variables.
 
 * GNU Free Documentation License:: The license for this documentation.
@@ -1622,7 +1622,9 @@ are constructed incrementally by adding single methods or 
properties
 at a time, @var{dont-register-service} can be used to prevent other
 clients from discovering the still incomplete interface.
 
-@noindent Example:
+@code{dbus-register-property} returns a Lisp object, which can be used
+as argument in @code{dbus-unregister-object} for removing the
+registration for @var{property}.  Example:
 
 @lisp
 (dbus-register-property
@@ -1687,9 +1689,9 @@ It is also possible to apply the @code{dbus-get-property},
 @defun dbus-unregister-object object
 This function unregisters @var{object} from the D-Bus.  @var{object}
 must be the result of a preceding @code{dbus-register-method},
-@code{dbus-register-property} or @code{dbus-register-signal} call
-(@pxref{Signals}).  It returns @code{t} if @var{object} has been
-unregistered, @code{nil} otherwise.
+@code{dbus-register-property}, @code{dbus-register-signal}
+(@pxref{Signals}) or @code{dbus-register-monitor} call.  It returns
+@code{t} if @var{object} has been unregistered, @code{nil} otherwise.
 
 When @var{object} identifies the last method or property, which is
 registered for the respective service, Emacs releases its association
@@ -2099,24 +2101,24 @@ D-Bus applications running.  They should therefore 
check carefully,
 whether a given D-Bus error is related to them.
 
 
-@node Monitoring Events
-@chapter Monitoring events.
+@node Monitoring Messages
+@chapter Monitoring messages.
 @cindex monitoring
 
 @defun dbus-register-monitor bus &optional handler &key type sender 
destination path interface member
-This function registers @var{handler} for monitor events on the D-Bus
-@var{bus}.
+This function registers @var{handler} for monitoring messages on the
+D-Bus @var{bus}.
 
 @var{bus} is either a Lisp keyword, @code{:system} or @code{:session},
 or a string denoting the bus address.
 
 @findex dbus-monitor-handler
-@var{handler} is the function to be called when a monitor event
-arrives.  It is called with the `args' slot of the monitor event,
-which are stripped off the type keywords.  If @var{handler} is
-@code{nil}, the default handler @code{dbus-monitor-handler} is
-applied.  This default handler behaves similar to the
-@command{dbus-monitor} program.
+@var{handler} is the function to be called when a D-Bus event to be
+monitored arrives.  It is called with the @var{args} slot of the D-Bus
+event (@pxref{Errors and Events}), which are stripped off the type
+keywords.  If @var{handler} is @code{nil}, the default handler
+@code{dbus-monitor-handler} is applied.  This default handler behaves
+similar to the @command{dbus-monitor} program.
 
 The other arguments are keyword-value pairs.  @code{:type @var{type}}
 defines the message type to be monitored.  If given, it must be equal
@@ -2132,6 +2134,9 @@ names.
 @code{:member @var{member}} is either a method name, a signal name, or
 an error name.
 
+@code{dbus-register-monitor} returns a Lisp object, which can be used
+as argument in @code{dbus-unregister-object} for removing the monitor.
+
 The following form shows all D-Bus events on the session bus in buffer
 @samp{*D-Bus Monitor*}:
 
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 48712a9..77ba526 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -912,8 +912,9 @@ discovering the still incomplete interface."
 (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.
+`dbus-register-signal', `dbus-register-property' or
+`dbus-register-monitor' call.  The function 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
@@ -951,7 +952,10 @@ association to the service from D-Bus."
        (when (eq type :signal)
          (dbus-call-method
           bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
-          "RemoveMatch" (nth 4 elt)))))
+          "RemoveMatch" (nth 4 elt)))
+        ;; Delete monitor connection by reestablishing private bus.
+        (when (eq type :monitor)
+          (dbus-init-bus bus 'private))))
 
     ;; Check, whether there is still a registered function or property
     ;; for the given service.  If not, unregister the service from the
@@ -2037,7 +2041,7 @@ either a method name, a signal name, or an error name."
     (when dbus-debug (message "%s" dbus-registered-objects-table))
 
     ;; Return the object.
-    (list key key1)))
+    (list key (list nil nil handler))))
 
 (defconst dbus-monitor-method-call
   (propertize "method-call" 'face 'font-lock-function-name-face)
diff --git a/src/dbusbind.c b/src/dbusbind.c
index cca5f13..1ac7731 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1937,11 +1937,12 @@ syms_of_dbusbind (void)
     doc: /* Hash table of registered functions for D-Bus.
 
 There are two different uses of the hash table: for accessing
-registered interfaces properties, targeted by signals or method calls,
-and for calling handlers in case of non-blocking method call returns.
+registered interfaces properties, targeted by signals, method calls or
+monitors, and for calling handlers in case of non-blocking method call
+returns.
 
 In the first case, the key in the hash table is the list (TYPE BUS
-INTERFACE MEMBER).  TYPE is one of the Lisp symbols `:method',
+[INTERFACE MEMBER]).  TYPE is one of the Lisp symbols `:method',
 `:signal', `:property' or `:monitor'.  BUS is either a Lisp symbol,
 `:system', `:session', `:system-private' or `:session-private', or a
 string denoting the bus address.  INTERFACE is a string which denotes
@@ -1951,17 +1952,18 @@ signal or a property INTERFACE is offering.  All 
arguments can be nil.
 The value in the hash table is a list of quadruple lists ((UNAME
 SERVICE PATH OBJECT [RULE]) ...).  SERVICE is the service name as
 registered, UNAME is the corresponding unique name.  In case of
-registered methods and properties, UNAME is nil.  PATH is the object
-path of the sending object.  All of them can be nil, which means a
-wildcard then.
+registered methods, properties and monitors, UNAME is nil.  PATH is
+the object path of the sending object.  All of them can be nil, which
+means a wildcard then.
 
 OBJECT is either the handler to be called when a D-Bus message, which
 matches the key criteria, arrives (TYPE `:method', `:signal' and
 `:monitor'), or a list (ACCESS EMITS-SIGNAL VALUE) for TYPE
 `:property'.
 
-For entries of type `:signal', there is also a fifth element RULE,
-which keeps the match string the signal is registered with.
+For entries of type `:signal' or `:monitor', there is also a fifth
+element RULE, which keeps the match string the signal or monitor is
+registered with.
 
 In the second case, the key in the hash table is the list (:serial BUS
 SERIAL).  BUS is either a Lisp symbol, `:system' or `:session', or a
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 7ebef5d..94816bb 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -697,7 +697,7 @@ is in progress."
   "Received signal value in `dbus--test-signal-handler'.")
 
 (defun dbus--test-signal-handler (&rest args)
-  "Signal handler for `dbus-test*-signal'."
+  "Signal handler for `dbus-test*-signal' and `dbus-test08-register-monitor'."
   (setq dbus--test-signal-received args))
 
 (defun dbus--test-timeout-handler (&rest _ignore)
@@ -1833,6 +1833,46 @@ The argument EXPECTED-ARGS is a list of expected 
arguments for the method."
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))
 
+(ert-deftest dbus-test08-register-monitor ()
+  "Check monitor registration."
+  :tags '(:expensive-test)
+  (skip-unless dbus--test-enabled-session-bus)
+
+  (unwind-protect
+      (let (registered)
+        (should
+         (equal
+          (setq registered
+                (dbus-register-monitor :session #'dbus--test-signal-handler))
+          '((:monitor :session-private)
+           (nil nil dbus--test-signal-handler))))
+
+        ;; Send a signal, shall be traced.
+        (setq dbus--test-signal-received nil)
+        (dbus-send-signal
+         :session dbus--test-service dbus--test-path
+         dbus--test-interface "Foo" "foo")
+       (with-timeout (1 (dbus--test-timeout-handler))
+          (while (null dbus--test-signal-received)
+            (read-event nil nil 0.1)))
+
+        ;; Unregister monitor.
+        (should (dbus-unregister-object registered))
+        (should-not (dbus-unregister-object registered))
+
+        ;; Send a signal, shall not be traced.
+        (setq dbus--test-signal-received nil)
+        (dbus-send-signal
+         :session dbus--test-service dbus--test-path
+         dbus--test-interface "Foo" "foo")
+       (with-timeout (1 (ignore))
+          (while (null dbus--test-signal-received)
+            (read-event nil nil 0.1)))
+        (should-not dbus--test-signal-received))
+
+    ;; Cleanup.
+    (dbus-unregister-service :session dbus--test-service)))
+
 (defun dbus-test-all (&optional interactive)
   "Run all tests for \\[dbus]."
   (interactive "p")