-#!/usr/bin/newlisp
-
;; This is a test program for the lsp-dbus provided dbus API.
-(load "misc.lsp")
(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
+ ))
+
+;; 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
+ ))
+
+(reset)
+
+
+(println (if (:invoke Dbus:ROOT
+ (print "GetNameOwner(s)")
+ (println (list "org.bluez")))
+ ($it -1 -1 -1) ; Return value
+ ))
+(Dbus:process-all-pending)
+
+(println (setf org.bluez (Dbus "/" "org.bluez")))
+(println (if (:invoke org.bluez (:m ObjectManager "GetManagedObjects()"))
+ ($it -1 -1 -1) ; Return value
+ ))
+
-; Log system bus details
-(println Dbus:SYSTEM-BUS)
-(println (setf ME (Dbus "/au/rrq")))
-(println (setf ROOT (Dbus "/org/freedesktop/DBus")))
-
-(define (unpack-messages DATA)
- (let ((AT 0) (OUT '()) (M nil) (D nil))
- (while (and (< AT (length DATA))
- (setf M (Dbus:unpack-data "yyyyuua(yv)" DATA AT)))
- ;;(println M)
- (dotimes (i (length (M 0 -1)))
- (setf (M 0 -1 i 0) (Dbus:MESSAGE-HEADERS (M 0 -1 i 0) 0)))
- (println M)
- (setf AT (M 1))
- (setf S ((lookup 'Dbus:SIGNATURE (M 0 -1)) 0))
- (println "AT=" AT " " (unpack (dup "b" 20) (AT DATA)))
- (if (and (< AT (length DATA)) (!= s ""))
- (when (setf D (Dbus:unpack-data S DATA AT))
- (println D)
- (setf AT (D 1))
- (push (list M (D 0)) OUT -1))
- (push (list M nil) OUT -1))
- (setf DATA (AT DATA))
- (setf AT 0)
- ;;(println (octals-string (AT DATA)))
- )
- OUT ))
-
-(setf M (:invoke ROOT "Hello" "org.freedesktop.DBus"))
-(println (unpack-messages M))
+(reset) ;
"lsp-dbus-test.lsp"