3 files changed, 81 insertions(+), 51 deletions(-)

M bluez.lisp
M dbus-tools.lisp
M package.lisp

@@ 15,75 15,92 @@
 ;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 
 (in-package :dbus-tools)
-(defun inspect-bluetooth-device (which-bus &optional (device-path "/org/bluez/hci0/dev_00_0A_45_1A_13_5E"))
-  (declare (type bus-type which-bus))
-  (inspect-introspected-object which-bus
+
+(defun inspect-bt-device (&optional (device-path (managed-object-name
+                                                     (first-bt-with-interface "org.bluez.MediaControl1"))))
+  "Inspect a Bluez bt device object."
+  (inspect-introspected-object :system
                                "org.bluez"
                                device-path))
+(defun first-bt-with-interface (interface)
+  (loop :for device :in (list-bt-devices)
+        :when (has-interface device interface)
+          :return device))
+
+(defun volume-up (&optional (device-path (managed-object-name
+                                          (first-bt-with-interface "org.bluez.MediaControl1"))))
 
-(defun volume-up (which-bus &optional (device-path "/org/bluez/hci0/dev_00_0A_45_1A_13_5E"))
-  (declare (type bus-type which-bus))
-  (dbus:with-open-bus (bus (get-bus which-bus))
+  (dbus:with-open-bus (bus (get-bus :system))
     (dbus:invoke-method (dbus:bus-connection bus)
                         "VolumeUp"
                         :path device-path
                         :interface "org.bluez.MediaControl1"
                         :destination "org.bluez")))
 
-(defun volume-down (which-bus &optional (device-path "/org/bluez/hci0/dev_00_0A_45_1A_13_5E"))
-  (declare (type bus-type which-bus))
-  (dbus:with-open-bus (bus (get-bus which-bus))
+(defun volume-down (&optional (device-path (managed-object-name
+                                            (first-bt-with-interface "org.bluez.MediaControl1"))))
+
+  (dbus:with-open-bus (bus (get-bus :system))
     (dbus:invoke-method (dbus:bus-connection bus)
                         "VolumeDown"
                         :path device-path
                         :interface "org.bluez.MediaControl1"
                         :destination "org.bluez")))
 
-(defun list-bluetooth-objects ()
-  (declare (type bus-type :system))
+(defun list-bt-objects ()
+
   (dbus:with-open-bus (bus (get-bus :system))
     (dbus:get-managed-objects bus "org.bluez" "/")))
 
-(defun is-bluetooth-device (object)
-  (cl-ppcre:scan-to-strings "^/org/bluez/hci[0-9]+/dev_\(..\)_\(..\)_\(..\)_\(..\)_\(..\)_\(..\)$" (car object)))
+(defun is-bt-device (object)
+  (cl-ppcre:scan-to-strings
+   "^/org/bluez/hci[0-9]+/dev_\(..\)_\(..\)_\(..\)_\(..\)_\(..\)_\(..\)$"
+   (managed-object-name object)))
+
+(defun is-bt-service (object)
+  (cl-ppcre:scan-to-strings
+   "^/org/bluez/hci[0-9]+/dev_\(..\)_\(..\)_\(..\)_\(..\)_\(..\)_\(..\)/service.*$"
+   (managed-object-name object)))
+
 
-(defun is-bluetooth-service (object)
-  (cl-ppcre:scan-to-strings "^/org/bluez/hci[0-9]+/dev_\(..\)_\(..\)_\(..\)_\(..\)_\(..\)_\(..\)/service.*$" (car object)))
+(defun list-bt-adapters ()
+  (remove-if-not (rcurry #'has-interface "org.bluez.Adapter1") (list-bt-objects)))
 
-(defun list-bluetooth-adapters ()
-  (remove-if-not (curry #'has-interface "org.bluez.Adapter1") (list-bluetooth-objects)))
+(defun list-bt-media-controllers ()
+  (remove-if-not (rcurry #'has-interface "org.bluez.MediaControl1") (list-bt-objects)))
 
-(defun list-bluetooth-devices ()
-  (remove-if-not (curry #'has-interface "org.bluez.Device1") (list-bluetooth-objects)))
+(defun list-bt-devices ()
+  (remove-if-not (rcurry #'has-interface "org.bluez.Device1") (list-bt-objects)))
 
-(defun bluetooth-connect (device-name)
+(defun bt-connect (device-name)
   (dbus-tools:invoke-method-simple :system
                                    "org.bluez"
                                    device-name
                                    "org.bluez.Device1"
                                    "Connect"))
 
-(defun bluetooth-disconnect (device-name)
+(defun bt-disconnect (device-name)
   (dbus-tools:invoke-method-simple :system
                                    "org.bluez"
                                    device-name
                                    "org.bluez.Device1"
                                    "Disconnect"))
 
-(defun list-bluetooth-services (&optional device)
+(defun list-bt-services (&optional device)
   (remove-if-not (lambda (value)
-                   (and (is-bluetooth-service value)
+                   (and (is-bt-service value)
                         (if device
                             (cl-ppcre:scan (format nil "^~a.*" device) (car value))
                             t)))
-                 (list-bluetooth-objects)))
+                 (list-bt-objects)))
 
-(defun list-bluetooth-battery-levels ()
+(defun list-bt-battery-levels ()
+  ""
   (loop
-    :for device :in (dbus-tools:list-bluetooth-devices)
-    :when (dbus-tools::has-interface "org.bluez.Battery1" device)
+    :for device :in (list-bt-devices)
+    :when (has-interface device "org.bluez.Battery1")
       :collect (cons (dbus-tools::managed-object-name device)
                      (dbus-tools:get-all-properties :system
                                                     "org.bluez"
-                                                    (dbus-tools::managed-object-name device)
+                                                    (managed-object-name device)
                                                     "org.bluez.Battery1"))))

@@ 80,7 80,8 @@ For example (list-paths-at :system \:org.bluez\" \"/\") -> (\"/org\")"
     :when (not next)
       :nconc (list path)))
 
-(defun get-managed-objects (which-bus service object)
+(defun list-managed-objects (which-bus service object)
+  "List all managed objects under object."
   (declare (type bus-type which-bus)
            (string service object))
   (dbus:with-open-bus (bus (get-bus which-bus))


@@ 98,7 99,7 @@ For example (list-paths-at :system \:org.bluez\" \"/\") -> (\"/org\")"
   (declare (type list object))
   (cadr object))
 
-(defun get-value (object name)
+(defun find-value (object name)
   "Returns a child value in a DBus list object.
 (get-value (name1 ((name2 value2) (name3 value3))) name3) -> value3"
   (declare (type list object)


@@ 143,6 144,7 @@ For example (list-paths-at :system \:org.bluez\" \"/\") -> (\"/org\")"
                         :destination service)))
 
 (defun inspect-introspected-object (which-bus service object)
+  "Open an instrospected object in the Slime Inspector."
   (declare (type bus-type which-bus)
            (type string service object))
   (dbus:with-open-bus (bus (get-bus which-bus))


@@ 150,6 152,7 @@ For example (list-paths-at :system \:org.bluez\" \"/\") -> (\"/org\")"
       (swank:inspect-in-emacs obj))))
 
 (defun list-interfaces (which-bus service object)
+  "List all interfaces that object satisfies."
   (declare (type bus-type which-bus)
            (type string service object))
   (dbus:with-open-bus (bus (get-bus which-bus))


@@ 157,6 160,7 @@ For example (list-paths-at :system \:org.bluez\" \"/\") -> (\"/org\")"
       (hash-table-keys (slot-value obj 'DBUS/INTROSPECT::interfaces)))))
 
 (defun who-owns (which-bus service)
+  "See which process owns a service."
   (declare (type bus-type which-bus)
            (type string service))
   (invoke-method-simple which-bus


@@ 167,23 171,24 @@ For example (list-paths-at :system \:org.bluez\" \"/\") -> (\"/org\")"
                         service
                         ""))
 
-(defun has-interface (interface object)
+(defun has-interface (object interface)
+  "Check if object satisfies interface."
   (declare (type string interface)
            (type list object))
   (loop
     :for obj :in (cdr object)
-    :do
-       (loop
-         :for (interface-name interface-data) :in obj
-         :when (string= interface interface-name)
-           :do (return-from has-interface t)))
+    :do (loop
+          :for (interface-name interface-data) :in obj
+          :when (string= interface interface-name)
+            :do (return-from has-interface t)))
   nil)
 
 (defun describe-type (type-string)
   type-string)
 
-(defun pp (result &key (stream t) (indent 0))
-  (loop :for thing :in result
+(defun pp (values &key (stream t) (indent 0))
+  "Pretty print values - a list structure returned by the dbus API."
+  (loop :for thing :in values
         :do (typecase thing
               (cons
                (cond ((= (length thing) 1)


@@ 198,6 203,7 @@ For example (list-paths-at :system \:org.bluez\" \"/\") -> (\"/org\")"
                (format stream "~a" thing)))))
 
 (defun read-gatt-characteristic-by-service (service-path)
+  "Read a GATT characteristic by service path."
   (declare (type string service-path))
   (let ((values (dbus-tools:invoke-method-simple :system
                                                  "org.bluez"


@@ 211,11 217,12 @@ For example (list-paths-at :system \:org.bluez\" \"/\") -> (\"/org\")"
                 :element-type '(unsigned-byte 8))))
 
 (defun read-gatt-characteristic-by-uuid (device uuid)
+  "Read a GATT characteristic by UUID."
   (declare (type string device uuid))
-  (let ((services (list-bluetooth-services device)))
+  (let ((services (list-bt-services device)))
     (flet ((matches-uuid (service)
-             (string= (dbt:get-value
-                       (dbt:get-value (dbt:managed-object-value service)
+             (string= (find-value
+                       (find-value (dbt:managed-object-value service)
                                       "org.bluez.GattCharacteristic1")
                        "UUID")
                       uuid)))


@@ 223,6 230,7 @@ For example (list-paths-at :system \:org.bluez\" \"/\") -> (\"/org\")"
                                                          services))))))
 
 (defun to-string (buffer)
+  "Convert an octet buffer into a string."
   (declare (type vector buffer))
   ;; Chop the trailing 0 bytes
   (babel:octets-to-string (subseq buffer

@@ 19,14 19,17 @@
   (:nicknames :dbt)
 
   (:use #:cl #:alexandria)
-  (:export #:list-bluetooth-objects
-           #:list-bluetooth-devices
-           #:list-bluetooth-services
-           #:list-bluetooth-battery-levels
-           #:bluetooth-connect
-           #:bluetooth-disconnect
-           #:is-bluetooth-device
-           #:inspect-bluetooth-device
+  (:export #:list-bt-objects
+           #:list-bt-devices
+           #:list-bt-services
+           #:list-bt-battery-levels
+           #:first-bt-with-interface
+           #:bt-connect
+           #:bt-disconnect
+           #:is-bt-device
+
+           #:inspect-bt-device
+
            #:volume-up
            #:volume-down
 


@@ 40,7 43,7 @@
            #:read-gatt-characteristic-by-service
            #:read-gatt-characteristic-by-uuid
            #:to-string
-           #:get-managed-objects
+           #:list-managed-objects
            #:get-all-properties
 
            #:query-objects-in-service


@@ 51,8 54,10 @@
 
            ;; Not yet implemented...
            #:describe-type
+
            #:managed-object-name
-           #:get-value
            #:managed-object-value
+           #:find-value
+
            #:pp
            ))