X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=lsp-dbus-test.lsp;h=af8af95a0e18c86cb7d6558026c52811d31d129e;hb=fa2637324868c9f23ac700635ae54633290aad9f;hp=3482305526c5ea7b6bc6cee82d7575c66ca991bb;hpb=90e871adbef72ed838434281b1be4c93a820a130;p=rrq%2Flsp-utils.git

diff --git a/lsp-dbus-test.lsp b/lsp-dbus-test.lsp
index 3482305..af8af95 100644
--- a/lsp-dbus-test.lsp
+++ b/lsp-dbus-test.lsp
@@ -1,32 +1,48 @@
 ;; This is a test program for the lsp-dbus provided dbus API.
 
 (load "lsp-dbus.lsp")
+;; Loading that module sets up core framework API and connects to
+;; dbus' system bus registering this application. This includes
+;; Dbus:ROOT for the "/org/freedektop/DBus" path, and Dbus:DBus for
+;; the interrface "org.freedektop.DBus".
+
+;; Register a handler for the NameAcquired signal, to replace the one
+;; installed by lsp-dbus.lsp
+
+;; Request a bus name "au.rrq" for this client
+(println "RequestName: "
+         (if (:invoke Dbus:ROOT (:m ObjectManager "RequestName(su)")
+                      '("au.rrq" 0))
+             (!= ($it -1 -1 -1)) ; returns BOOLEAN
+           ))
 
-;; Connect to system bus and set up core framework API
+;; Set up a Match rule to see stuff
+(setf MATCH-RULE
+      (join (list "type='signal'"
+                  ;;"sender='org.example.App2'"
+                  ;;"path_namespace='/au/rrq'"
+                  ;;"eavesdrop='true'"
+                  )
+            ","))
+(println "AddMatch:\n" MATCH-RULE "\n"
+         (if (:invoke Dbus:ROOT (:m Dbus:DBus "AddMatch(s)")
+                      (list MATCH-RULE))
+             ($it -1 -1 -1) ; returns OOM on error
+           ))
 
-;; Install my own framework object
-(die nil (setf au.rrq (Dbus "/au/rrq")))
+(reset)
 
-;; Request a bus name
-(println (if (:invoke Dbus:ROOT
-                      (print "RequestName(su)")
-                      (println (list (:bus-name au.rrq) 0)))
-             (!= ($it -1 -1 -1)) ; returns BOOLEAN
-           ))
-(Dbus:process-all-pending)
 
 (println (if (:invoke Dbus:ROOT
                       (print "GetNameOwner(s)")
                       (println (list "org.bluez")))
-             ($it -1 -1 -1) ; Returns value
+             ($it -1 -1 -1) ; Return value
            ))
 (Dbus:process-all-pending)
 
-(setf org.bluez (Dbus "/org/bluez"))
-(println (if (:invoke org.bluez
-                      (print "/:org.freedesktop.DBus.ObjectManager.GetManagedObjects()")
-                      )
-             ($it -1 -1 -1) ; Returns value
+(println (setf org.bluez (Dbus "/" "org.bluez")))
+(println (if (:invoke org.bluez (:m ObjectManager "GetManagedObjects()"))
+             ($it -1 -1 -1) ; Return value
            ))