Add support for device profiles

This is especially useful with Bluetooth devices.
Fix pw-cli--parse-properties
2022-06-15 21:31:24 +02:00 · 2022-06-15 21:30:27 +02:00 · 2022-06-15 19:50:24 +02:00
3 changed files with 107 additions and 17 deletions
--- a/pw-access.el
+++ b/pw-access.el
@ -73,6 +73,30 @@ PROPERTIES is an association list in the same format as in
 `pw-access-properties'.  It needn't contain all the properties, just
 the properties to be changed.")

+(cl-defgeneric pw-access-current-profile (class device-id)
+  "Return current profile of the given device.
+DEVICE-ID is a numeric PipeWire Device id (other kinds of PipeWire
+objects are not supported in this method).
+
+The profile is an association list with elements of the form
+(PROPERTY . VALUE), in the same format as properties in
+`pw-access-properties'.")
+
+(cl-defgeneric pw-access-profiles (class device-id)
+  "Return available profiles of the given device.
+DEVICE-ID is a numeric PipeWire Device id (other kinds of PipeWire
+objects are not supported in this method).
+
+Return a list of profiles, which are in the same format as in
+`pw-access-current-profile'.")
+
+(cl-defgeneric pw-access-set-profile (class device-id profile-index)
+  "Set the profile of the given device.
+DEVICE-ID is a numeric PipeWire Device id (other kinds of PipeWire
+objects are not supported in this method).
+PROFILE-INDEX is a numeric index of the profile to set, as returned
+from PipeWire.")
+
 (cl-defgeneric pw-access-defaults (class)
  "Return default sinks and sources.
 An association lists is returned.  Each list element is of the form
@ -123,7 +147,7 @@ Note this interface may not work with all PipeWire versions.")
        (push (cons id properties) objects)))
    (nreverse objects)))

-(cl-defmethod pw-access-objects ((class pw-cli-accessor))
+(cl-defmethod pw-access-objects ((_class pw-cli-accessor))
  (with-temp-buffer
    (pw-cli--command pw-cli-command '("list-objects"))
    (pw-cli--parse-list)))
@ -153,20 +177,20 @@ Note this interface may not work with all PipeWire versions.")
  
 (defun pw-cli--parse-properties ()
  (pw-cli--next-line)
-  (let ((end (save-excursion
-               (or (and (re-search-forward "^  Object:" nil t)
-                        (point))
-                   (point-max))))
+  (let ((end (or (save-excursion (re-search-forward "^  Object:" nil t))
+                 (point-max)))
        (properties '()))
-    (while (re-search-forward "^    Prop: key \\([A-Za-z:]+\\)" end t)
+    (while (and (< (point) end)
+                (re-search-forward "^    Prop: key \\([A-Za-z:]+\\)" end t))
      (pw-cli--next-line)
      (let ((property (car (last (split-string (match-string 1) ":"))))
            (value (pw-cli--read-property)))
        (when value
          (push (cons property value) properties))))
+    (goto-char end)
    properties))

-(cl-defmethod pw-access-properties ((class pw-cli-accessor) node-id)
+(cl-defmethod pw-access-properties ((_class pw-cli-accessor) node-id)
  (with-temp-buffer
    (pw-cli--command pw-cli-command `("enum-params" ,(number-to-string node-id) "Props"))
    (pw-cli--parse-properties)))
@ -183,11 +207,29 @@ Note this interface may not work with all PipeWire versions.")
 (defun pw-cli--format-property (property)
  (format "%s: %s" (car property) (pw-cli--format-property-value (cdr property))))

-(cl-defmethod pw-access-set-properties ((class pw-cli-accessor) node-id properties)
-  (let* ((formatted (mapconcat #'pw-cli--format-property properties ", "))
-         (props (concat "{ " formatted " }")))
+(defun pw-cli--set-parameter (object-id parameter value)
+  (let* ((formatted (mapconcat #'pw-cli--format-property value ", "))
+         (param-value (concat "{ " formatted " }")))
    (call-process pw-cli-command nil pw-cli-command nil
-                  "set-param" (number-to-string node-id) "Props" props)))
+                  "set-param" (number-to-string object-id) parameter param-value)))
+
+(cl-defmethod pw-access-set-properties ((_class pw-cli-accessor) node-id properties)
+  (pw-cli--set-parameter node-id "Props" properties))
+
+(cl-defmethod pw-access-current-profile ((_class pw-cli-accessor) device-id)
+  (with-temp-buffer
+    (pw-cli--command pw-cli-command `("enum-params" ,(number-to-string device-id) "Profile"))
+    (pw-cli--parse-properties)))
+
+(cl-defmethod pw-access-profiles ((_class pw-cli-accessor) device-id)
+  (with-temp-buffer
+    (pw-cli--command pw-cli-command `("enum-params" ,(number-to-string device-id) "EnumProfile"))
+    (cl-loop for profile = (pw-cli--parse-properties) then (pw-cli--parse-properties)
+             while profile
+             collect profile)))
+
+(cl-defmethod pw-access-set-profile ((_class pw-cli-accessor) device-id profile-index)
+  (pw-cli--set-parameter device-id "Profile" `(("index" . ,profile-index) ("save" . "true"))))

 (defun pw-cli--parse-metadata ()
  (let ((metadata '()))
@ -197,12 +239,12 @@ Note this interface may not work with all PipeWire versions.")
      (push (cons (match-string 1) (match-string 3)) metadata))
    metadata))

-(cl-defmethod pw-access-defaults ((class pw-cli-accessor))
+(cl-defmethod pw-access-defaults ((_class pw-cli-accessor))
  (with-temp-buffer
    (pw-cli--command pw-cli-metadata-command '("0"))
    (pw-cli--parse-metadata)))

-(cl-defmethod pw-access-set-default ((class pw-cli-accessor) property node-name)
+(cl-defmethod pw-access-set-default ((_class pw-cli-accessor) property node-name)
  (call-process pw-cli-metadata-command nil pw-cli-metadata-command nil
                "0" property (format "{ \"name\": \"%s\" }" node-name)))

--- a/pw-lib.el
+++ b/pw-lib.el
@ -81,6 +81,36 @@ If the given KEY doesn't exist in OBJECT, return DEFAULT."
 E.g. \"Device\", \"Node\", \"Port\", \"Client\", ..."
  (pw-lib-object-value object 'type))

+(defun pw-lib--profile-name (profile)
+  (cdr (or (assoc "description" profile)
+           (assoc "name" profile))))
+
+(defun pw-lib-current-profile (device-id)
+  "Return the current profile name of the given device.
+DEVICE-ID is the numeric id of the device.
+The returned profile name is a string, or nil if it cannot be found."
+  (pw-lib--profile-name (pw-access-current-profile pw-lib--accessor device-id)))
+
+(defun pw-lib-profiles (device-id)
+  "Return list of available profiles of the given device.
+DEVICE-ID is the numeric id of the device.
+A list of strings (possibly empty) is returned."
+  (mapcar #'pw-lib--profile-name (pw-access-profiles pw-lib--accessor device-id)))
+
+(defun pw-lib-set-profile (device-id profile)
+  "Set the profile of the given device.
+DEVICE-ID is the numeric id of the device.
+PROFILE is a string name of the profile, it must be one of the values
+returned from `pw-lib-profiles'. "
+  (let* ((all-profiles (pw-access-profiles pw-lib--accessor device-id))
+         (properties (cl-find profile all-profiles :key #'pw-lib--profile-name :test #'equal)))
+    (unless properties
+      (error "Profile %s of device %s not found" profile device-id))
+    (let ((index (cdr (assoc "index" properties))))
+      (unless index
+        (error "Index of %s profile of device %s not found" profile device-id))
+      (pw-access-set-profile pw-lib--accessor device-id index))))
+
 (defun pw-lib--node (object)
  (if (equal (pw-lib-object-type object) "Node")
      object
@ -197,7 +227,7 @@ version, call `pw-lib-refresh' first."
 Applicable only to Nodes and Ports.
 If REFRESH is non-nil then retrive fresh information from PipeWire
 rather than using cached data to obtain the result."
-  (cl-destructuring-bind (node-p parameters monitor-p node-id port-id)
+  (cl-destructuring-bind (_node-p parameters monitor-p _node-id _port-id)
      (pw-lib--object-parameters object refresh)
    (eq (cdr (assoc (if monitor-p "monitorMute" "mute") parameters)) 'true)))

@ -207,7 +237,7 @@ Return the new boolean mute status of OBJECT.
 Applicable only to Nodes and Ports.
 If REFRESH is non-nil then retrive fresh information from PipeWire
 rather than using cached data to obtain the result."
-  (cl-destructuring-bind (node-p parameters monitor-p node-id port-id)
+  (cl-destructuring-bind (_node-p _parameters monitor-p node-id _port-id)
      (pw-lib--object-parameters object refresh)
    (let* ((mute (not (pw-lib-muted-p object)))
           (property (if monitor-p "monitorMute" "mute"))
@ -221,7 +251,7 @@ The returned value is an integer in the range 0-100.
 Applicable only to Nodes and Ports.
 If REFRESH is non-nil then retrive fresh information from PipeWire
 rather than using cached data to obtain the result."
-  (cl-destructuring-bind (node-p parameters monitor-p node-id port-id)
+  (cl-destructuring-bind (node-p parameters monitor-p _node-id port-id)
      (pw-lib--object-parameters object refresh)
    (pw-lib--volume-%
     (if node-p
--- a/pw-ui.el
+++ b/pw-ui.el
@ -110,10 +110,14 @@ The indicator is displayed only on graphical terminals."
  (let* ((id (pw-lib-object-id object))
         (type (pw-lib-object-type object))
         (text (format "%4s: %s" id (pw-ui--object-name object)))
+         (profile (when (equal type "Device")
+                    (pw-lib-current-profile (pw-lib-object-id object))))
         (face (if (member id default-ids) 'pipewire-default-object-face 'default))
         (media-class (pw-lib-object-value object "media.class")))
    (when media-class
      (setq text (format "%s (%s)" text media-class)))
+    (when profile
+      (setq text (format "%s: %s" text profile)))
    (let ((volume-p (member type '("Node" "Port"))))
      (when (and volume-p (pw-lib-muted-p object))
        (setq face `(:inherit (pipewire-muted-face ,face))))
@ -129,7 +133,7 @@ The indicator is displayed only on graphical terminals."
 (defun pw-ui--insert-line (line object)
  (insert (propertize line 'pw-object-id (pw-lib-object-id object)) "\n"))

-(defun pipewire-refresh (&optional ignore-auto noconfirm)
+(defun pipewire-refresh (&optional _ignore-auto _noconfirm)
  "Refresh PipeWire buffer."
  (interactive)
  (when (and (not (eq major-mode 'pipewire-mode))
@ -337,10 +341,24 @@ Otherwise ask for the Node to set as the default Node."
    (pw-lib-set-default object t)
    (pw-ui--update)))

+(defun pipewire-set-profile ()
+  "Set profile of the device at the current point."
+  (interactive)
+  (if-let ((device (pw-ui--current-object nil '("Device")))
+           (device-id (pw-lib-object-id device))
+           (profiles (pw-lib-profiles device-id)))
+      (progn
+        (pw-lib-set-profile device-id (completing-read "Select profile: " profiles nil t))
+        ;; Without this, ports of the device may not be displayed on the update:
+        (sit-for 0)
+        (pw-ui--update))
+    (error "Nothing to set a profile for here")))
+
 (defvar pipewire-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "d" 'pipewire-set-default)
    (define-key map "m" 'pipewire-toggle-muted)
+    (define-key map "p" 'pipewire-set-profile)
    (define-key map "v" 'pipewire-set-volume)
    (define-key map "=" 'pipewire-increase-volume)
    (define-key map "-" 'pipewire-decrease-volume)
Author	SHA1	Message	Date
Milan Zamazal	2c421bb990	Add support for device profiles This is especially useful with Bluetooth devices.	2022-06-15 21:31:24 +02:00
Milan Zamazal	1065d9d389	Fix pw-cli--parse-properties - Remove some redundancy. - Make sure we don’t search after the end point. - Move to the end point (this is necessary for parsing the following object).	2022-06-15 21:30:27 +02:00
Milan Zamazal	08c9d50a1c	Silence compilation warnings about unused variables	2022-06-15 19:50:24 +02:00