3 files changed, 44 insertions(+), 29 deletions(-)

M bluez.lisp
M dbus-tools.asd
M dbus-tools.lisp

@@ 27,35 27,40 @@
         :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 (&key
+                    (steps 1)
+                    (device-path (managed-object-name
+                                  (first-bt-with-interface "org.bluez.MediaControl1"))))
+  "Execute VolumeUp method one or more times on a org.bluez.MediaControl1 object."
   (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 (&optional (device-path (managed-object-name
-                                            (first-bt-with-interface "org.bluez.MediaControl1"))))
-
+    (dotimes (i steps)
+      (dbus:invoke-method (dbus:bus-connection bus)
+                          "VolumeUp"
+                          :path device-path
+                          :interface "org.bluez.MediaControl1"
+                          :destination "org.bluez"))))
+
+(defun volume-down (&key
+                      (steps 1)
+                      (device-path (managed-object-name
+                                    (first-bt-with-interface "org.bluez.MediaControl1"))))
+  "Execute VolumeDown method one or more times on a org.bluez.MediaControl1 object."
   (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")))
+    (dotimes (i steps)
+      (dbus:invoke-method (dbus:bus-connection bus)
+                          "VolumeDown"
+                          :path device-path
+                          :interface "org.bluez.MediaControl1"
+                          :destination "org.bluez"))))
 
 (defun list-bt-objects ()
-
+  "List all org.bluez managed objects."
   (dbus:with-open-bus (bus (get-bus :system))
     (dbus:get-managed-objects bus "org.bluez" "/")))
 
 (defun is-bt-device (object)
-  (cl-ppcre:scan-to-strings
-   "^/org/bluez/hci[0-9]+/dev_\(..\)_\(..\)_\(..\)_\(..\)_\(..\)_\(..\)$"
-   (managed-object-name object)))
+  "Test if object looks like a bluetooth device."
+  (has-interface object "org.bluez.Device1"))
 
 (defun is-bt-service (object)
   (cl-ppcre:scan-to-strings


@@ 98,9 103,17 @@
   ""
   (loop
     :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"
-                                                    (managed-object-name device)
-                                                    "org.bluez.Battery1"))))
+    :for is-connected = (find-value (find-value (managed-object-value device)
+                                                "org.bluez.Device1")
+                                    "Connected")
+    :for is-paired = (find-value (find-value (managed-object-value device)
+                                             "org.bluez.Device1")
+                                 "Paired")
+    :when  (and (or is-paired
+                    is-connected)
+                (has-interface device "org.bluez.Battery1"))
+      :collect (cons device
+                     (get-all-properties :system
+                                         "org.bluez"
+                                         (managed-object-name device)
+                                         "org.bluez.Battery1"))))

@@ 20,7 20,7 @@
   :license  "ISC"
   :version "0.0.1"
   :serial t
-  :depends-on (#:j-utils #:alexandria #:dbus #:cxml #:xpath)
+  :depends-on (#:alexandria #:dbus #:cxml #:xpath)
   :components ((:file "package")
                (:file "dbus-tools")
                (:file "bluez"))

@@ 143,13 143,15 @@ For example (list-paths-at :system \:org.bluez\" \"/\") -> (\"/org\")"
                         :interface interface
                         :destination service)))
 
+(defparameter *inspect-function* #'inspect)
 (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))
     (let ((obj (dbus:make-object-from-introspection (dbus:bus-connection bus) object service)))
-      (swank:inspect-in-emacs obj))))
+
+      (funcall *inspect-function* obj))))
 
 (defun list-interfaces (which-bus service object)
   "List all interfaces that object satisfies."