Compare commits

...

8 Commits

4 changed files with 61 additions and 48 deletions

2
pipewire-0-pkg.el Normal file
View File

@ -0,0 +1,2 @@
(define-package pipewire-0 "1"
"Interface to PipeWire.")

View File

@ -17,6 +17,8 @@
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; A generic interface for communication with PipeWire (https://pipewire.org). ;; A generic interface for communication with PipeWire (https://pipewire.org).
;; It abstracts communication with PipeWire to be backend independent. ;; It abstracts communication with PipeWire to be backend independent.
;; Only functions from this module may communicate with PipeWire. ;; Only functions from this module may communicate with PipeWire.
@ -40,9 +42,9 @@ All PipeWire interfaces should derive from this class.")
(cl-defgeneric pw-access-objects (class) (cl-defgeneric pw-access-objects (class)
"Return all the objects currently reported by PipeWire. "Return all the objects currently reported by PipeWire.
It is a list of object data. Each of the elements has a form It is a list of object data. Each of the elements has a form
(OBJECT-ID . INFO) where OBJECT-ID is a numeric OBJECT-ID as \(OBJECT-ID . INFO) where OBJECT-ID is a numeric OBJECT-ID as
reported by PipeWire and INFO is an association list of items reported by PipeWire and INFO is an association list of items
(NAME . VALUE) where NAME is a string item name as reported by \(NAME . VALUE) where NAME is a string item name as reported by
PipeWire and VALUE is the corresponding value. VALUE is a number for PipeWire and VALUE is the corresponding value. VALUE is a number for
object ids, a string otherwise. object ids, a string otherwise.
A special entry with `type' symbol as its name contains the PipeWire A special entry with `type' symbol as its name contains the PipeWire
@ -56,7 +58,7 @@ are not supported in this method).
Object properties may be, unlike object info items, settable. Object properties may be, unlike object info items, settable.
An assocation list is returned. Each list element is of the form An assocation list is returned. Each list element is of the form
(PROPERTY . VALUE) where PROPERTY is a string name of the given \(PROPERTY . VALUE) where PROPERTY is a string name of the given
property. VALUE can be: property. VALUE can be:
- \"true\" or \"false\" for boolean values (t and nil are not used to - \"true\" or \"false\" for boolean values (t and nil are not used to
@ -79,7 +81,7 @@ DEVICE-ID is a numeric PipeWire Device id (other kinds of PipeWire
objects are not supported in this method). objects are not supported in this method).
The profile is an association list with elements of the form The profile is an association list with elements of the form
(PROPERTY . VALUE), in the same format as properties in \(PROPERTY . VALUE), in the same format as properties in
`pw-access-properties'.") `pw-access-properties'.")
(cl-defgeneric pw-access-profiles (class device-id) (cl-defgeneric pw-access-profiles (class device-id)
@ -100,7 +102,7 @@ from PipeWire.")
(cl-defgeneric pw-access-defaults (class) (cl-defgeneric pw-access-defaults (class)
"Return default sinks and sources. "Return default sinks and sources.
An association lists is returned. Each list element is of the form An association lists is returned. Each list element is of the form
(KEY . NAME) where KEY is a string identifying the given kind of \(KEY . NAME) where KEY is a string identifying the given kind of
default sink or source as reported by PipeWire and NAME is a string default sink or source as reported by PipeWire and NAME is a string
name of the node assigned to the default.") name of the node assigned to the default.")

View File

@ -17,6 +17,8 @@
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Backend-independent library to access PipeWire functionality. ;; Backend-independent library to access PipeWire functionality.
;; It abstracts data returned from `pw-access' methods and provides ;; It abstracts data returned from `pw-access' methods and provides
;; functions to work with them. ;; functions to work with them.
@ -53,7 +55,7 @@ version, call `pw-lib-refresh' first."
(let ((objects pw-lib--objects)) (let ((objects pw-lib--objects))
(when type (when type
(setq objects (cl-remove-if-not (setq objects (cl-remove-if-not
#'(lambda (o) (string= (cdr (assq 'type (cdr o))) type)) (lambda (o) (string= (cdr (assq 'type (cdr o))) type))
objects))) objects)))
objects)) objects))
@ -146,13 +148,13 @@ Note that PipeWire data is cached, if you need its up-to-date
version, call `pw-lib-refresh' first." version, call `pw-lib-refresh' first."
(unless pw-lib--defaults (unless pw-lib--defaults
(let ((defaults (pw-access-defaults pw-lib--accessor)) (let ((defaults (pw-access-defaults pw-lib--accessor))
(nodes (mapcar #'(lambda (o) (nodes (mapcar (lambda (o)
(cons (pw-lib-object-value o "node.name") (pw-lib-object-id o))) (cons (pw-lib-object-value o "node.name") (pw-lib-object-id o)))
(pw-lib-objects "Node")))) (pw-lib-objects "Node"))))
(setq pw-lib--defaults (setq pw-lib--defaults
(cl-remove-if-not #'cdr (cl-remove-if-not #'cdr
(mapcar #'(lambda (d) (mapcar (lambda (d)
(cons (car d) (cdr (assoc (cdr d) nodes)))) (cons (car d) (cdr (assoc (cdr d) nodes))))
defaults))))) defaults)))))
pw-lib--defaults) pw-lib--defaults)
@ -168,12 +170,12 @@ version, call `pw-lib-refresh' first."
(or pw-lib--bindings (or pw-lib--bindings
(setq pw-lib--bindings (setq pw-lib--bindings
(apply #'nconc (apply #'nconc
(mapcar #'(lambda (o) (mapcar (lambda (o)
(let ((o-id (pw-lib-object-id o))) (let ((o-id (pw-lib-object-id o)))
(mapcar #'(lambda (p) (mapcar (lambda (p)
(cons o-id (cdr p))) (cons o-id (cdr p)))
(cl-remove-if-not #'numberp (pw-lib--object-info o) (cl-remove-if-not #'numberp (pw-lib--object-info o)
:key #'cdr)))) :key #'cdr))))
(pw-lib-objects)))))) (pw-lib-objects))))))
(defun pw-lib-children (id &optional type) (defun pw-lib-children (id &optional type)
@ -183,10 +185,10 @@ type are returned.
Note that PipeWire data is cached, if you need its up-to-date Note that PipeWire data is cached, if you need its up-to-date
version, call `pw-lib-refresh' first." version, call `pw-lib-refresh' first."
(let ((children (mapcar #'pw-lib-get-object (let ((children (mapcar #'pw-lib-get-object
(mapcar #'car (cl-remove-if #'(lambda (b) (/= (cdr b) id)) (mapcar #'car (cl-remove-if (lambda (b) (/= (cdr b) id))
(pw-lib-bindings)))))) (pw-lib-bindings))))))
(when type (when type
(setq children (cl-remove-if-not #'(lambda (o) (equal (pw-lib-object-type o) type)) (setq children (cl-remove-if-not (lambda (o) (equal (pw-lib-object-type o) type))
children))) children)))
children)) children))
@ -194,9 +196,9 @@ version, call `pw-lib-refresh' first."
(when node (when node
(let ((ports (pw-lib-children (pw-lib-object-id node) "Port"))) (let ((ports (pw-lib-children (pw-lib-object-id node) "Port")))
(if regexp (if regexp
(cl-delete-if-not #'(lambda (o) (cl-delete-if-not (lambda (o)
(if-let ((name (pw-lib-object-value o "port.name"))) (if-let ((name (pw-lib-object-value o "port.name")))
(string-match regexp name))) (string-match regexp name)))
ports) ports)
ports)))) ports))))

View File

@ -17,6 +17,8 @@
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; PipeWire user interface based on pw-lib. ;; PipeWire user interface based on pw-lib.
;; An interactive buffer can be displayed using `M-x pipewire'. ;; An interactive buffer can be displayed using `M-x pipewire'.
;; `pipewire-increase-volume', `pipewire-decrease-volume' and ;; `pipewire-increase-volume', `pipewire-decrease-volume' and
@ -26,7 +28,8 @@
(require 'pw-lib) (require 'pw-lib)
(defgroup pipewire () (defgroup pipewire ()
"PipeWire user interface.") "PipeWire user interface."
:group 'multimedia)
(defcustom pipewire-volume-step 5 (defcustom pipewire-volume-step 5
"How many percent points to add or subtract when changing volumes." "How many percent points to add or subtract when changing volumes."
@ -66,22 +69,22 @@ The indicator is displayed only on graphical terminals."
:type '(alist :key-type symbol :value-type sexp) :type '(alist :key-type symbol :value-type sexp)
:group 'pip-frame) :group 'pip-frame)
(defface pipewire-label-face (defface pipewire-label
'((t (:weight bold :overline t))) '((t (:weight bold :overline t)))
"Face to use for PipeWire node group labels." "Face to use for PipeWire node group labels."
:group 'pipewire) :group 'pipewire)
(defface pipewire-default-object-face (defface pipewire-default-object
'((t (:weight bold))) '((t (:weight bold)))
"Face to use for PipeWire default sinks and sources." "Face to use for PipeWire default sinks and sources."
:group 'pipewire) :group 'pipewire)
(defface pipewire-muted-face (defface pipewire-muted
'((t (:strike-through t))) '((t (:strike-through t)))
"Face to use for muted PipeWire sinks and sources." "Face to use for muted PipeWire sinks and sources."
:group 'pipewire) :group 'pipewire)
(defface pipewire-volume-face (defface pipewire-volume
'((t (:inverse-video t))) '((t (:inverse-video t)))
"Face to use for displaying volumes of PipeWire objects." "Face to use for displaying volumes of PipeWire objects."
:group 'pipewire) :group 'pipewire)
@ -89,20 +92,20 @@ The indicator is displayed only on graphical terminals."
(defvar pipewire-buffer "*PipeWire*") (defvar pipewire-buffer "*PipeWire*")
(defun pw-ui--label (label) (defun pw-ui--label (label)
(propertize (concat label ":") 'face 'pipewire-label-face)) (propertize (concat label ":") 'face 'pipewire-label))
(defun pw-ui--object-volume (object) (defun pw-ui--object-volume (object)
(propertize (pw-lib-volume object) 'face 'pipewire-volume-face)) (propertize (pw-lib-volume object) 'face 'pipewire-volume))
(defun pw-ui--object-name (object) (defun pw-ui--object-name (object)
(let* ((type (pw-lib-object-type object)) (let* ((type (pw-lib-object-type object))
(description-properties (if (equal type "Client") (description-properties (if (equal type "Client")
'("application.name") '("application.name")
(let ((prefix (concat (downcase type) "."))) (let ((prefix (concat (downcase type) ".")))
(mapcar #'(lambda (suffix) (concat prefix suffix)) (mapcar (lambda (suffix) (concat prefix suffix))
'("description" "name")))))) '("description" "name"))))))
(or (cl-find-if #'identity (or (cl-find-if #'identity
(mapcar #'(lambda (p) (pw-lib-object-value object p)) (mapcar (lambda (p) (pw-lib-object-value object p))
description-properties)) description-properties))
""))) "")))
@ -112,7 +115,7 @@ The indicator is displayed only on graphical terminals."
(text (format "%4s: %s" id (pw-ui--object-name object))) (text (format "%4s: %s" id (pw-ui--object-name object)))
(profile (when (equal type "Device") (profile (when (equal type "Device")
(pw-lib-current-profile (pw-lib-object-id object)))) (pw-lib-current-profile (pw-lib-object-id object))))
(face (if (member id default-ids) 'pipewire-default-object-face 'default)) (face (if (member id default-ids) 'pipewire-default-object 'default))
(media-class (pw-lib-object-value object "media.class"))) (media-class (pw-lib-object-value object "media.class")))
(when media-class (when media-class
(setq text (format "%s (%s)" text media-class))) (setq text (format "%s (%s)" text media-class)))
@ -120,14 +123,14 @@ The indicator is displayed only on graphical terminals."
(setq text (format "%s: %s" text profile))) (setq text (format "%s: %s" text profile)))
(let ((volume-p (member type '("Node" "Port")))) (let ((volume-p (member type '("Node" "Port"))))
(when (and volume-p (pw-lib-muted-p object)) (when (and volume-p (pw-lib-muted-p object))
(setq face `(:inherit (pipewire-muted-face ,face)))) (setq face `(:inherit (pipewire-muted ,face))))
(let ((label (propertize text 'face face))) (let ((label (propertize text 'face face)))
(when volume-p (when volume-p
(let ((volume (pw-lib-volume object))) (let ((volume (pw-lib-volume object)))
(when volume (when volume
(setq label (concat label " " (setq label (concat label " "
(propertize (number-to-string volume) (propertize (number-to-string volume)
'face 'pipewire-volume-face)))))) 'face 'pipewire-volume))))))
label)))) label))))
(defun pw-ui--insert-line (line object) (defun pw-ui--insert-line (line object)
@ -211,17 +214,18 @@ The indicator is displayed only on graphical terminals."
(setq pw-ui--osd-timer (setq pw-ui--osd-timer
(run-with-timer (run-with-timer
pipewire-osd-timeout nil pipewire-osd-timeout nil
#'(lambda () (lambda ()
(when pw-ui--osd-frame (when pw-ui--osd-frame
(ignore-errors (delete-frame pw-ui--osd-frame))) (ignore-errors (delete-frame pw-ui--osd-frame)))
(when pw-ui--osd-buffer (when pw-ui--osd-buffer
(ignore-errors (kill-buffer pw-ui--osd-buffer))) (ignore-errors (kill-buffer pw-ui--osd-buffer)))
(setq pw-ui--osd-frame nil (setq pw-ui--osd-frame nil
pw-ui--osd-timer nil pw-ui--osd-timer nil
pw-ui--osd-buffer nil))))) pw-ui--osd-buffer nil)))))
(defmacro pw-ui--osd (&rest body) (defmacro pw-ui--osd (&rest body)
(declare (indent defun)) (declare (debug (body))
(indent defun))
(let (($string (gensym))) (let (($string (gensym)))
`(when (and window-system pipewire-osd-enable) `(when (and window-system pipewire-osd-enable)
(if-let ((,$string (progn ,@body))) (if-let ((,$string (progn ,@body)))
@ -252,9 +256,12 @@ The indicator is displayed only on graphical terminals."
'face `(:background ,pipewire-osd-volume-off-color))))))) 'face `(:background ,pipewire-osd-volume-off-color)))))))
(defun pw-ui--update-muted (object muted-p) (defun pw-ui--update-muted (object muted-p)
(let ((object-name (pw-ui--object-name object)) (let* ((object-name (pw-ui--object-name object))
(node-name (pw-ui--object-name (pw-lib-parent-node object)))) (parent-node (pw-lib-parent-node object))
(pw-ui--update (format "%s in %s %s" object-name node-name (if muted-p "muted" "unmuted"))))) (node-info (if parent-node
(format " in %s" (pw-ui--object-name parent-node))
"")))
(pw-ui--update (format "%s%s %s" object-name node-info (if muted-p "muted" "unmuted")))))
;;;###autoload ;;;###autoload
(defun pipewire-toggle-muted () (defun pipewire-toggle-muted ()
@ -344,10 +351,10 @@ Otherwise ask for the Node to set as the default Node."
(let ((object (or (pw-ui--current-object nil '("Device" "Node")) (let ((object (or (pw-ui--current-object nil '("Device" "Node"))
(let* ((default-node-ids (mapcar #'cdr (pw-lib-default-nodes))) (let* ((default-node-ids (mapcar #'cdr (pw-lib-default-nodes)))
(nodes (cl-remove-if (nodes (cl-remove-if
#'(lambda (n) (member (pw-lib-object-id n) default-node-ids)) (lambda (n) (member (pw-lib-object-id n) default-node-ids))
(pw-lib-objects "Node"))) (pw-lib-objects "Node")))
(node-mapping (mapcar #'(lambda (n) (cons (pw-ui--object-name n) (node-mapping (mapcar (lambda (n) (cons (pw-ui--object-name n)
(pw-lib-object-id n))) (pw-lib-object-id n)))
nodes)) nodes))
(node-name (completing-read "Default node: " node-mapping nil t))) (node-name (completing-read "Default node: " node-mapping nil t)))
(pw-lib-get-object (cdr (assoc node-name node-mapping))))))) (pw-lib-get-object (cdr (assoc node-name node-mapping)))))))