X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=lsp-dbus-test.lsp;h=82c5ecb4fa8a2402527ff3329e45d9de07e95cbd;hb=121167c737403e2f49231fd5704aae86850b5b38;hp=0c13db4e87eb685185eb8f019fefbdbee2ffcfad;hpb=1898ef96b70cb93c53a84e6a7536d0a3bceb35d6;p=rrq%2Flsp-utils.git

diff --git a/lsp-dbus-test.lsp b/lsp-dbus-test.lsp
index 0c13db4..82c5ecb 100644
--- a/lsp-dbus-test.lsp
+++ b/lsp-dbus-test.lsp
@@ -1,39 +1,27 @@
-#!/usr/bin/newlisp
-
 ;; This is a test program for the lsp-dbus provided dbus API.
 
-(load "misc.lsp")
 (load "lsp-dbus.lsp")
 
-; Log system bus details
-(println Dbus:SYSTEM-BUS)
-(println (setf ME (Dbus "/au/rrq")))
-(println (setf ROOT (Dbus "/org/freedesktop/DBus")))
+;; Connect to system bus and set up core framework API
+
+;; Install my own framework object
+(die nil (setf au.rrq (Dbus "/au/rrq")))
+
+;; 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)
 
-(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 ))
+(println (if (:invoke Dbus:ROOT
+                      (print "GetNameOwner(s)")
+                      (println (list "org.bluez")))
+             ($it -1 -1 -1) ; Returns value
+           ))
+(Dbus:process-all-pending)
 
-(setf M (:invoke ROOT "Hello" "org.freedesktop.DBus"))
-(println (unpack-messages M))
+(reset) ; 
 
 "lsp-dbus-test.lsp"