;;; High-level bindings for DBus bus connection

(in-package :dbus)

(export '(make-dbus-bus
          dbus-bus-pump
          dbus-bus-connection
          dbus-bus-request-name))

(defclass dbus-bus ()
  ((connection :accessor dbus-bus-connection
               :initform nil
               :initarg :connection
  ))
  (:documentation "A model object for the connetion to a single bus.")
)

(defun make-dbus-bus (type)
  (with-error (lambda (error)
    (make-instance 'dbus-bus 
                   :connection (libdbus:dbus-bus-get 
                                 (case type
                                   (:session :DBUS_BUS_SESSION)
                                   (:system :DBUS_BUS_SYSTEM)) error)
    ))))
    
(defgeneric dbus-bus-send-message (bus message))

(defmethod dbus-bus-send-message ((bus dbus-bus) (message dbus-message))
  (libdbus:dbus-connection-send (dbus-bus-connection bus) (dbus-message-message message) (null-pointer))
  ;(libdbus:dbus-connection-flush (dbus-bus-connection bus))
  (format *standard-output* "Sending a message~%")
)
    
(defgeneric dbus-bus-pump (bus))

(defvar param (foreign-alloc :pointer))

(defmethod dbus-bus-pump ((bus dbus-bus))
  (with-slots (connection) bus
   ;(libdbus:dbus-connection-read-write-dispatch connection -1)
   (libdbus:dbus-connection-read-write connection 0)
    (let ((message (libdbus:dbus-connection-pop-message connection)))
      (if (null-pointer-p message)
          nil;(sleep 1)
          (let* ((path (libdbus:dbus-message-get-path message))
                 (member (libdbus:dbus-message-get-member message))
                 (obj (gethash path *dbus-callbacks*)))
            (format *standard-output* "Message ~A ~A ~A~%" path member obj)
            (if (not (eql obj nil))
              (let ((return-value 
                      (apply 
                        (symbol-function 
                          (find-symbol 
                            (format nil "~A-~A" 
                              (symbol-name (class-name (class-of obj))) 
                              (string-upcase member)
                            ) 
                            (gethash (class-of obj) *dbus-packages*)
                          )
                        )
                        (cons
                          obj
                          (decode-message message))
                        )
                        ) (reply (libdbus:dbus-message-new-method-return message)))
                
                
                (format *standard-output* "Trying to add an argument~%")
               
                ;(let ((param (foreign-alloc :pointer)))  ; (foreign-buf (foreign-string-alloc return-value)))
                  (with-foreign-string (foreign-buf return-value)
                    (format *standard-output* "Allocated pointer~%")
                    (format *standard-output* "Allocated foreign string ~A~%" foreign-buf)
                    (setf (mem-ref param :pointer) foreign-buf)
                    (format *standard-output* "Set pointer ~A~%" param)
                    (format *standard-output* "Set pointer to ~A~%" (mem-ref param :pointer))
                    ;(format *standard-output* "Grabbing string '~A'~%" (foreign-string-to-lisp (mem-ref param :pointer)))
                    ;(libdbus:dbus-message-iter-init-append reply iter)
                    ;(libdbus:dbus-message-iter-append-basic iter libdbus:+dbus-type-string+ param)
                    (libdbus:dbus-message-append-args reply libdbus:+dbus-type-string+ :pointer param :int libdbus:+dbus-type-invalid+)
                    (format *standard-output* "Appended arg~%")
                    (libdbus:dbus-connection-send connection reply (null-pointer))
                    (format *standard-output* "Sent message~%")
                    (libdbus:dbus-connection-flush connection)
                    (format *standard-output* "Flushed~%")
                    (libdbus:dbus-message-unref reply)
                    (format *standard-output* "Unref reply~%")
                    (libdbus:dbus-message-unref message)
                    (format *standard-output* "Unref message~%")
                    (foreign-string-free foreign-buf)
                    (format *standard-output* "Free foreign-buf~%")
                    (foreign-free param)
                    (format *standard-output* "Free param~%")
                  )
                
                (format *standard-output* "Done adding an argument~%")
                
                ;(libdbus:dbus-connection-send connection reply (null-pointer))
                ;(libdbus:dbus-connection-flush connection)
              )
            )
          )
      )
    )
  )
)

; (defmethod dbus-bus-pump ((bus dbus-bus))
;   (with-slots (connection) bus
;     (libdbus:dbus-connection-read-write connection 0)
;     (let ((msg (libdbus:dbus-connection-pop-message connection)))
;       (if (null-pointer-p msg) (sleep 2)
;         (progn
;           (format *standard-output* "Got a message ~A ~A~%" (libdbus:dbus-message-get-interface msg) (libdbus:dbus-message-get-member msg))
;           (if (libdbus:dbus-message-is-method-call msg "net.coderanger.DBusLisp" "Method") 
;             (let ((args (foreign-alloc :pointer)) (param (foreign-alloc :pointer)))
;               (cond
;                 ((not (libdbus:dbus-message-iter-init msg args)) (die "No message arguments~%"))
;                 ((/= (char-int #\s) (libdbus:dbus-message-iter-get-arg-type args)) (die "Argument not a string~%"))
;                 (t (libdbus:dbus-message-iter-get-basic args param)))
;               (let* ((reply (libdbus:dbus-message-new-method-return msg)) 
;                      (reply-param (format nil "Hello ~A" (foreign-string-to-lisp (mem-ref param :pointer))))
;                      (reply-param-buf (foreign-string-alloc reply-param)))
;                 (libdbus:dbus-message-iter-init-append reply args)
;                 (setf (mem-ref param :pointer) reply-param-buf)
;                 (libdbus:dbus-message-iter-append-basic args (char-int #\s) param)
;                 (libdbus:dbus-connection-send connection reply (null-pointer))
;                 (libdbus:dbus-connection-flush connection)
;                 (libdbus:dbus-message-unref reply)
;               )
;             )
;           )
;           (libdbus:dbus-message-unref msg)
;         )
;       )
;     )
;   )
; )

(defclass dbus-bus-name ()
  ((name :accessor dbus-bus-name-name
                  :initform nil
                  :initarg :name
  ))
  (:documentation "A model object for a single bus name.")
)

(defgeneric dbus-bus-request-name (connection name)
  (:documentation "Request the given name on the bus.")
)

(defmethod dbus-bus-request-name ((connection dbus-bus) (name string))
  (with-error (lambda (error)
    (libdbus:dbus-bus-request-name (dbus-bus-connection connection) name libdbus:+dbus-name-flag-replace-existing+ error)
  ))
)