(let ((*trace-output* (make-broadcast-stream)))
  (require :dbus)

  #+sbcl (require :sb-posix)

  (defpackage :dbus-test
    (:use :common-lisp :cffi :libdbus)
    (:documentation "A test of the DBus bindings."))
)
 
(in-package :dbus-test)

#+sbcl (sb-posix:putenv "DBUS_SESSION_BUS_ADDRESS=unix:path=/tmp/dbus-HynH2zdfk2,guid=fb28c1f8c975a53eb3c77500473a57ec")

(defun sysquit (status)
  #+sbcl (sb-ext:quit :unix-status status)
  #+lispworks (lw:quit :status status)
  (error "Don't know how to quit")
)

(defvar *error* (foreign-alloc 'dbus-error))

(dbus-error-init *error*)

(defvar *connection* (dbus-bus-get :DBUS_BUS_SESSION *error*))

(if (null-pointer-p *connection*)
  (progn
    (format *error-output* "Failed to connect to session bus: ~A~%" (foreign-slot-value *error* 'dbus-error 'dbus::message))
    (dbus-error-free *error*)
    (foreign-free *error*)
    (sysquit 1)))
    
(defvar *message* (dbus-message-new-method-call 
                  "org.freedesktop.DBus"
                  "/org/freedesktop/DBus"
                  "org.freedesktop.DBus"
                  "ListNames"))
                  
(defvar *reply* (dbus-connection-send-with-reply-and-block
                *connection*
                *message*
                -1
                *error*))
                
(if (dbus-error-is-set *error*)
  (progn
    (format *error-output* "Error: ~A~%" (foreign-slot-value *error* 'dbus-error 'dbus::message))
    (sysquit 1)
    ))
    
(defvar *service-list* (foreign-alloc :pointer))
(defvar *service-list-len* (foreign-alloc :int))

(if (not (dbus-message-get-args
          *reply* *error*
          :int 97 :int 115 :pointer *service-list* :pointer *service-list-len*
          :int 0))
  (progn
    (format *error-output* "Error: ~A~%" (foreign-slot-value *error* 'dbus-error 'dbus::message))
    (sysquit 1)
))
  
(dbus-message-unref *message*)
(dbus-message-unref *reply*)

(format *standard-output* "Names on the bus:~%")
(loop for i below (mem-ref *service-list-len* :int)
      do (format *standard-output* "~A~%" (foreign-string-to-lisp (mem-aref (mem-ref *service-list* :pointer) :pointer i)))
)
      
(sysquit 0)