Implement Properties

all.lisp

@@ -159,4 +159,5 @@
    #:define-dbus-object
    #:define-dbus-method
    #:define-dbus-signal-handler
+   #:define-dbus-property
    #:publish-objects))

examples/publish.lisp

@@ -15,6 +15,10 @@
   (:interface "org.adeht.MyService")
   (concatenate 'string s1 s2))
 
+(define-dbus-property (my-service my-property)
+  (:interface "org.adeht.MyService")
+  "initial-property-value")
+
 (define-dbus-signal-handler (my-service on-signal) ((s :string))
   (:interface "org.adeht.MyService")
   (format t "Got signal with arg ~S~%" s))

publish.lisp

@@ -15,6 +15,7 @@
    #:define-dbus-object
    #:define-dbus-method
    #:define-dbus-signal-handler
+   #:define-dbus-property
    #:publish-objects))
 
 (in-package #:dbus/publish)
@@ -30,7 +31,8 @@
   ((name :initarg :name :reader dbus-object-name)
    (path :initarg :path :accessor dbus-object-path)
    (method-handlers :initform (make-hash-table :test 'equal) :reader dbus-object-method-handlers)
-   (signal-handlers :initform (make-hash-table :test 'equal) :reader dbus-object-signal-handlers)))
+   (signal-handlers :initform (make-hash-table :test 'equal) :reader dbus-object-signal-handlers)
+   (properties      :initform (make-hash-table :test 'equal) :reader dbus-object-properties)))
 
 (defgeneric dbus-object-handler-lookup-table (message object))
 
@@ -81,7 +83,18 @@
     (dolist (option options)
       (when (and (consp option) (eq (car option) :path))
         (setf path (cadr option))))
-    `(register-dbus-object ',name ,path)))
+    `(prog1
+       (register-dbus-object ',name ,path)
+       (define-dbus-method (,name get) ((interface :string) (property :string)) (:variant)
+         (:interface "org.freedesktop.DBus.Properties")
+         (let* ((obj (find-dbus-object ',name))
+                (value (gethash (cons interface property) (dbus-object-properties obj)))
+                (type-to-dbus (typecase value
+                                ((or null boolean) "b")
+                                (string "s")
+                                (integer "t")
+                                (float "d"))))
+           (list type-to-dbus value))))))
 
 ;;; Define handlers
 
@@ -192,6 +205,13 @@ sans dashes."
                                    (lambda (,@parameter-names)
                                      ,@body))))
 
+(defmacro define-dbus-property ((object-name property-name) &body body)
+  `(setf
+     (gethash
+       ',(cons (getf (car body) :interface) (stringify-lisp-name (symbol-name property-name)))
+       (dbus-object-properties (find-dbus-object ',object-name)))
+     ',(cadr body)))
+
 ;;; Publishing objects
 
 (defgeneric publish-objects (connection &optional object-names))