lsp-dbus-test.lsp

   1 #!/usr/bin/newlisp
   2
   3 ;; This is a test program for the lsp-dbus provided dbus API.
   4
   5 (load "misc.lsp")
   6 (load "lsp-dbus.lsp")
   7
   8 ; Log system bus details
   9 (println Dbus:SYSTEM-BUS)
  10 (println (setf ME (Dbus "/au/rrq")))
  11 (println (setf ROOT (Dbus "/org/freedesktop/DBus")))
  12
  13 (define (unpack-messages DATA)
  14   (let ((AT 0) (OUT '()) (M nil) (D nil))
  15     (while (and (< AT (length DATA))
  16                 (setf M (Dbus:unpack-data "yyyyuua(yv)" DATA AT)))
  17       ;;(println M)
  18       (dotimes (i (length (M 0 -1)))
  19         (setf (M 0 -1 i 0) (Dbus:MESSAGE-HEADERS (M 0 -1 i 0) 0)))
  20       (println M)
  21       (setf AT (M 1))
  22       (setf S ((lookup 'Dbus:SIGNATURE (M 0 -1)) 0))
  23       (println "AT=" AT " " (unpack (dup "b" 20) (AT DATA)))
  24       (if (and (< AT (length DATA)) (!= s ""))
  25           (when (setf D (Dbus:unpack-data S DATA AT))
  26             (println D)
  27             (setf AT (D 1))
  28             (push (list M (D 0)) OUT -1))
  29         (push (list M nil) OUT -1))
  30       (setf DATA (AT DATA))
  31       (setf AT 0)
  32       ;;(println (octals-string (AT DATA)))
  33       )
  34     OUT ))
  35
  36 (setf M (:invoke ROOT "Hello" "org.freedesktop.DBus"))
  37 (println (unpack-messages M))
  38
  39 "lsp-dbus-test.lsp"