diff options
Diffstat (limited to 'elisp/emms-mpris.el')
| -rw-r--r-- | elisp/emms-mpris.el | 575 |
1 files changed, 575 insertions, 0 deletions
diff --git a/elisp/emms-mpris.el b/elisp/emms-mpris.el new file mode 100644 index 0000000..b65ed18 --- /dev/null +++ b/elisp/emms-mpris.el @@ -0,0 +1,575 @@ +;;; emms-mpris.el --- Mpris interface for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2022, 2023 Free Software Foundation, Inc. + +;; Author: Fran Burstall <[email protected]> +;; Keywords: multimedia + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; This package provides a dbus interface to EMMS. + +;; Usage: +;; (require 'emms-mpris) +;; (emms-mpris-enable) + +;; Switch off with +;; (emms-mpris-disable) + +;; Caveats: this is not quite a complete implementation of the +;; org.mpris.MediaPlayer2 and org.mpris.MediaPlayer2.Player interfaces +;; (see +;; https://specifications.freedesktop.org/mpris-spec/latest/index.html). +;; What is missing: +;; - Volume: this should be easy but there seems to be no way to get a +;; simple percentage to report the volume---every emms-volume +;; controller returns a string in a different format, sigh. + + + +;;; Code: + +;;* What we need +(require 'dbus) +(require 'url-parse) +(require 'emms) +(require 'emms-browser) +(require 'emms-playing-time) +(require 'cl-lib) +(require 'pcase) +(require 'subr-x) +(require 'seq) + +;;* Dbus components +(defconst emms-mpris-service "org.mpris.MediaPlayer2.emms" + "The service we expose.") + +(defconst emms-mpris-path "/org/mpris/MediaPlayer2" + "Our object path.") + +;;* Register and update +(defun emms-mpris-register-method (iface method handler) + "Register METHOD with HANDLER on interface IFACE." + (dbus-register-method :session + emms-mpris-service + emms-mpris-path + iface + method + handler + t)) + +(defun emms-mpris-register-property (iface property access value) + "Register PROPERTY on interface IFACE. + +VALUE is the initial value, ACCESS the access mode." + (let ((val (cond ((functionp value) (funcall value)) + ((and (symbolp value) (boundp value)) (symbol-value value)) + (t value)))) + (dbus-register-property :session + emms-mpris-service + emms-mpris-path + iface + property + access + val + ;; emit signal when readwrite properties change + (equal access :readwrite) + t))) + +(defun emms-mpris-register-iface (spec) + "Register an interface with spec SPEC on the EMMS service. + +The spec is a list of the form (IFACE METHODS PROPS). + +IFACE is a string naming the interface being registered. + +METHODS is a list of methods to register on the interface. +Each method is a list (NAME FN) with NAME a string and FN the +function the method calls. + +PROPS is a list of properties to register on the interface. +Each property is a list of the form (NAME ACCESS VAL) with +NAME a string, ACCESS a keyword and VAL either a function +that returns the default value of the property, a variable +which evaluates to that value or the value itself." + (cl-destructuring-bind (iface methods props) spec + (dolist (method methods) + (apply #'emms-mpris-register-method iface method)) + (dolist (prop props) + (apply #'emms-mpris-register-property iface prop)))) + + +;;* Interfaces + +;;** MediaPlayer2 interface + +(defvar emms-mpris-mediaplayer-iface-spec + '("org.mpris.MediaPlayer2" + (("Raise" ignore) + ("Quit" ignore)) + (("CanQuit" :read nil) + ("CanRaise" :read nil) + ("HasTrackList" :read nil) + ("Identity" :read "EMMS media player") + ("SupportedUriSchemes" :read (:array "file")) + ("SupportedMimeTypes" :read (:array "audio/mpeg" "application/ogg")))) + "Interface spec for MediaPlayer2.") + +;;** MediaPlayer2.Player interface + +(defvar emms-mpris-player-iface-spec + '("org.mpris.MediaPlayer2.Player" + ;; Methods: + (("OpenUri" emms-mpris-open-uri) + ("Next" (lambda () (ignore-errors (emms-next)) :ignore)) + ("Previous" (lambda () (ignore-errors (emms-previous)) :ignore)) + ("Pause" (lambda () (emms-pause) :ignore)) + ("PlayPause" (lambda () (emms-pause) :ignore)) + ("Stop" (lambda () (emms-stop) :ignore)) + ("Play" (lambda () (emms-pause) :ignore)) + ("Seek" emms-mpris-seek) + ("SetPosition" emms-mpris-set-position)) + ;; Properties: Shuffle, LoopStatus, Volume not supported (yet) + (("LoopStatus" :readwrite emms-mpris-loop-status) + ("Shuffle" :readwrite emms-random-playlist) + ("PlaybackStatus" :read emms-mpris-status) + ("Rate" :readwrite 1.0) + ("MinimumRate" :read 1.0) + ("MaximumRate" :read 1.0) + ("Position" :read (:int64 0)) ;think more about this + ("CanGoNext" :read t) + ("CanGoPrevious" :read t) + ("CanPlay" :read t) + ("CanPause" :read t) + ("CanPause" :read t) + ("CanControl" :read t) + ("CanSeek" :read t) + ("Metadata" :read emms-mpris-current-metadata))) + "Interface spec for MediaPlayer2.Player.") +;;** Introspection interface + +(defvar emms-mpris-xml + "<!DOCTYPE node PUBLIC \"-//freedesktop//DTD D-BUS Object Introspection 1.0//EN\" + \"http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd\"> +<!-- GDBus 2.66.8 --> +<node> + <interface name=\"org.freedesktop.DBus.Properties\"> + <method name=\"Get\"> + <arg type=\"s\" name=\"interface_name\" direction=\"in\"/> + <arg type=\"s\" name=\"property_name\" direction=\"in\"/> + <arg type=\"v\" name=\"value\" direction=\"out\"/> + </method> + <method name=\"GetAll\"> + <arg type=\"s\" name=\"interface_name\" direction=\"in\"/> + <arg type=\"a{sv}\" name=\"properties\" direction=\"out\"/> + </method> + <method name=\"Set\"> + <arg type=\"s\" name=\"interface_name\" direction=\"in\"/> + <arg type=\"s\" name=\"property_name\" direction=\"in\"/> + <arg type=\"v\" name=\"value\" direction=\"in\"/> + </method> + <signal name=\"PropertiesChanged\"> + <arg type=\"s\" name=\"interface_name\"/> + <arg type=\"a{sv}\" name=\"changed_properties\"/> + <arg type=\"as\" name=\"invalidated_properties\"/> + </signal> + </interface> + <interface name=\"org.freedesktop.DBus.Introspectable\"> + <method name=\"Introspect\"> + <arg type=\"s\" name=\"xml_data\" direction=\"out\"/> + </method> + </interface> + <interface name=\"org.freedesktop.DBus.Peer\"> + <method name=\"Ping\"/> + <method name=\"GetMachineId\"> + <arg type=\"s\" name=\"machine_uuid\" direction=\"out\"/> + </method> + </interface> + <interface name=\"org.mpris.MediaPlayer2\"> + <method name=\"Raise\"/> + <method name=\"Quit\"/> + <property type=\"b\" name=\"CanQuit\" access=\"read\"/> + <property type=\"b\" name=\"CanRaise\" access=\"read\"/> + <property type=\"b\" name=\"HasTrackList\" access=\"read\"/> + <property type=\"s\" name=\"Identity\" access=\"read\"/> + <property type=\"s\" name=\"DesktopEntry\" access=\"read\"/> + <property type=\"as\" name=\"SupportedUriSchemes\" access=\"read\"/> + <property type=\"as\" name=\"SupportedMimeTypes\" access=\"read\"/> + </interface> + <interface name=\"org.mpris.MediaPlayer2.Player\"> + <method name=\"Next\"/> + <method name=\"Previous\"/> + <method name=\"Pause\"/> + <method name=\"PlayPause\"/> + <method name=\"Stop\"/> + <method name=\"Play\"/> + <method name=\"Seek\"> + <arg type=\"x\" name=\"Offset\" direction=\"in\"/> + </method> + <method name=\"SetPosition\"> + <arg type=\"o\" name=\"TrackId\" direction=\"in\"/> + <arg type=\"x\" name=\"Position\" direction=\"in\"/> + </method> + <method name=\"OpenUri\"> + <arg type=\"s\" name=\"Uri\" direction=\"in\"/> + </method> + <signal name=\"Seeked\"> + <arg type=\"x\" name=\"Position\"/> + </signal> + <property type=\"s\" name=\"PlaybackStatus\" access=\"read\"/> + <property type=\"s\" name=\"LoopStatus\" access=\"readwrite\"/> + <property type=\"d\" name=\"Rate\" access=\"readwrite\"/> + <property type=\"b\" name=\"Shuffle\" access=\"readwrite\"/> + <property type=\"a{sv}\" name=\"Metadata\" access=\"read\"/> + <property type=\"d\" name=\"Volume\" access=\"readwrite\"/> + <property type=\"x\" name=\"Position\" access=\"read\"/> + <property type=\"d\" name=\"MinimumRate\" access=\"read\"/> + <property type=\"d\" name=\"MaximumRate\" access=\"read\"/> + <property type=\"b\" name=\"CanGoNext\" access=\"read\"/> + <property type=\"b\" name=\"CanGoPrevious\" access=\"read\"/> + <property type=\"b\" name=\"CanPlay\" access=\"read\"/> + <property type=\"b\" name=\"CanPause\" access=\"read\"/> + <property type=\"b\" name=\"CanSeek\" access=\"read\"/> + <property type=\"b\" name=\"CanControl\" access=\"read\"/> + </interface> +</node> +" + "Mpris introspection data for emms.") + +(defun emms-mpris-introspect () + "Return dbus introspection data." + emms-mpris-xml) + +(defvar emms-mpris-introspectable-iface-spec + '("org.freedesktop.DBus.Introspectable" + (("Introspect" emms-mpris-introspect)) + nil) + "Introspectable interface spec for dbus.") + +;;** Properties interface + +;; We re-implement the "Get" and "GetAll" methods of the +;; dbus.properties interface. For why? Well, the default handler +;; looks up the value of a property in a hash table which works fine +;; unless we want the "Position" property of the Player interface +;; which changes all the time (and we don't want to update the table +;; every second!). So we wrap the default handler to update the +;; Position entry in the table before delegating to the default +;; handler. This is a bit of a hack in that we go rather beyond the +;; API of dbus.el and hope that the internals do not change. + +(defun emms-mpris-update-position-hash-value () + "Update the D-Bus hash-table. + +Refresh the value in the hash-table corresponding to the Position +property of the org.mpris.MediaPlayer2.Player interface." + (puthash (list :property :session "org.mpris.MediaPlayer2.Player" "Position") + (list (list nil + emms-mpris-service + emms-mpris-path + (list :read nil (list :variant :int64 (emms-mpris-sec-to-musec emms-playing-time))))) + dbus-registered-objects-table)) + +(defun emms-mpris-get-property-handler (&rest args) + "Handle Get and GetAll event for property in ARGS. + +The Position property gets refreshed before delegating +to `dbus-property-handler'." + (let* ((last-input-event last-input-event)) + (emms-mpris-update-position-hash-value) + (apply #'dbus-property-handler args))) + +(defvar emms-mpris-properties-iface-spec + '("org.freedesktop.DBus.Properties" + (("Get" emms-mpris-get-property-handler) + ("GetAll" emms-mpris-get-property-handler)) + nil) + "Partial Properties interface spec for dbus.") + + +;;* Implementation + +;;** Utilities +;; Emms thinks in seconds but mpris in microseconds +(defun emms-mpris-musec-to-sec (ms) + "Convert MS microseconds to seconds." + (* ms .000001)) + +(defun emms-mpris-sec-to-musec (s) + "Convert S seconds to microseconds." + (truncate (* s 1000000))) + +;; Track-id is a d-bus object id and these have rules... +(defun emms-mpris-track-id (track) + "Return track-id of TRACK as D-Bus object id." + ;; FIX ME: this won't work if we implement the tracklist interface + ;; and the tracklist has repeated tracks. + (concat "/" (mapconcat #'dbus-escape-as-identifier + (split-string (emms-track-get track 'name) "/" t) + "/"))) + +;;** Update properties +(defun emms-mpris-update-property (iface property access value) + "Update PROPERTY on interface IFACE to VALUE." + (dbus-register-property :session + emms-mpris-service + emms-mpris-path + iface + property + access + value + t nil)) + +(defvar emms-mpris-ignore-signal-p nil + "Non-nil if we should ignore a PropertiesChanged signal. + +We do this when we have already taken action via the EMMS UI.") + +(defun emms-mpris-property-change-handler (_service changes _invalidated) + "Respond to PropertiesChanged signal by updating emms state to reflect CHANGES." + (if emms-mpris-ignore-signal-p + (setq emms-mpris-ignore-signal-p nil) + (when-let ((payload (assoc "LoopStatus" changes))) + (pcase (caadr payload) + ("Track" (setq emms-repeat-playlist nil + emms-repeat-track t)) + ("Playlist" (setq emms-repeat-playlist t + emms-repeat-track nil)) + (_ (setq emms-repeat-playlist nil + emms-repeat-track nil)))) + (when-let ((payload (assoc "Shuffle" changes))) + (setq emms-random-playlist (caadr payload)) + (if emms-random-playlist + (setq emms-player-next-function #'emms-random) + (setq emms-player-next-function #'emms-next-noerror))))) + +;;*** Playback status +(defun emms-mpris-status () + "Return the playback status of EMMS as string: Playing, Paused or Stopped." + (if emms-player-playing-p + (if emms-player-paused-p + "Paused" "Playing") + "Stopped")) + +;;*** Loop status +(defun emms-mpris-loop-status () + "Return the loop status of EMMS as a string: Track, Playlist or None." + (cond (emms-repeat-track "Track") + (emms-repeat-playlist "Playlist") + (t "None"))) + +(defun emms-mpris-advise-loop-status () + "Update dbus value of LoopStatus. + +Intended to advise emms-toggle-repeat-*." + (setq emms-mpris-ignore-signal-p t) + (dbus-set-property :session + emms-mpris-service + emms-mpris-path + "org.mpris.MediaPlayer2.Player" + "LoopStatus" + (emms-mpris-loop-status))) + +;;*** Shuffle +(defun emms-mpris-advise-shuffle () + "Update dbus value of Shuffle. + +Intended to advise `emms-toggle-random-playlist'." + (setq emms-mpris-ignore-signal-p t) + (dbus-set-property :session + emms-mpris-service + emms-mpris-path + "org.mpris.MediaPlayer2.Player" + "Shuffle" + emms-random-playlist)) + +;;*** Metadata + +(defvar emms-mpris-metadata-dict + '((info-album "xesam:album" :s) + (info-albumartist "xesam:albumArtist" :as) + (info-artist "xesam:artist" :as) + (info-composer "xesam:composer" :as) + (info-discnumber "xesam:discNumber" :int) + (info-tracknumber "xesam:trackNumber" :int) + (info-title "xesam:title" :s) + (play-count "xesam:useCount" :int)) + "Dictionary between emms metadata and mpris metadata. + +Each entry of the form (info-field mpris-field dbus-type).") + +(defun emms-mpris-dict (k v &optional type) + "Return a dbus dict-entry with key K and value V, optionally of type TYPE." + (if type + (list :dict-entry k (list :variant type v)) + (list :dict-entry k (list :variant v)))) + +(defun emms-mpris-convert-field (track info key type) + "Convert field INFO of TRACK into dbus dict-entry with key KEY and type TYPE." + (let ((data (emms-track-get track info)) + value) + (when data + (setq value (pcase type + (:as (list :array data)) + (:int (if (stringp data) (string-to-number data) data)) + (:s data))) + (emms-mpris-dict key value)))) + +(defun emms-mpris-metadata (track) + "Return mpris metadata for TRACK." + (let ((track-name (emms-track-get track 'name)) + metadata) + ;; standard fields + (dolist (field emms-mpris-metadata-dict) + (when-let ((entry (apply #'emms-mpris-convert-field track field))) + (push entry metadata))) + ;; url + (push (emms-mpris-dict "xesam:url" (url-encode-url (concat "file:" track-name))) metadata) + ;; artUrl + ;; Shockingly, emms-browser-get-cover-from-path needs a graphical display to + ;; function (it eventually calls image-size) so we check there is one... + (when (seq-some #'display-graphic-p (frame-list)) + (when-let ((art-file (emms-browser-get-cover-from-path track-name 'medium))) + (push (emms-mpris-dict "mpris:artUrl" (url-encode-url (concat "file://" art-file))) metadata))) + ;; length + (push + (emms-mpris-dict "mpris:length" + (emms-mpris-sec-to-musec (emms-track-get track 'info-playing-time 0)) + :int64) + metadata) + ;; trackid + (push + (emms-mpris-dict "mpris:trackid" + (emms-mpris-track-id track) + :object-path) + metadata) + (cons :array metadata))) + +(defun emms-mpris-current-metadata () + "Return metadata of current track if it exists, else return a placeholder." + (if-let ((track (emms-playlist-current-selected-track))) + (emms-mpris-metadata track) + '(:array (:dict-entry "mpris:trackid" (:variant :object-path "/no/track/here"))))) + +;;*** update them! +(defun emms-mpris-change-status () + "Notify emms status to dbus." + (let ((iface "org.mpris.MediaPlayer2.Player")) + (emms-mpris-update-property iface + "PlaybackStatus" + :read + (emms-mpris-status)) + (emms-mpris-update-property iface + "Metadata" + :read + (emms-mpris-current-metadata)))) + + +;;** Seek and SetPosition + +;;*** Signal position change (after Seek or SetPosition) +(defun emms-mpris-signal-position (pos) + "Send \"Seeked\" signal with new position POS (in seconds)." + (dbus-send-signal :session + nil + emms-mpris-path + "org.mpris.MediaPlayer2.Player" + "Seeked" + :int64 + (emms-mpris-sec-to-musec pos))) + +;;*** Seek method +(defun emms-mpris-seek (ms) + "Method to seek by MS microseconds." + (emms-seek (number-to-string (emms-mpris-musec-to-sec ms))) + (emms-mpris-signal-position emms-playing-time) + :ignore) + +;;*** SetPosition method +(defun emms-mpris-set-position (track-id pos) + "Method to seek to POS (in microseconds) if current track has id TRACK-ID." + (let* ((track (emms-playlist-current-selected-track)) + (duration (emms-track-get track 'info-playing-time 0)) + (current-track-id (emms-mpris-track-id track)) + (pos-in-secs (emms-mpris-musec-to-sec pos))) + (when (and (string-equal track-id current-track-id) + (<= 0.0 pos-in-secs duration)) + (emms-seek-to (number-to-string pos-in-secs)) + (emms-mpris-signal-position emms-playing-time)) + :ignore)) + +;;** OpenURI + +(defun emms-mpris-open-uri (uri) + "Method for opening file URI and playing it." + (let* ((parsed-uri (url-generic-parse-url uri)) + (file (url-unhex-string (url-filename parsed-uri))) + (type (url-type parsed-uri))) + (when (and (string-equal type "file") (file-exists-p file)) + (cond ((file-regular-p file) (emms-play-file file)) + ((file-directory-p file) (emms-play-directory file))))) + :ignore) + + +;;* Entry point + +(defvar emms-mpris-enabled-p nil + "Non-nil if the EMMS mpris service is enabled.") + +(defun emms-mpris-enable () + "Activate EMMS dbus service." + (interactive) + (unless emms-mpris-enabled-p + (emms-mpris-register-iface emms-mpris-mediaplayer-iface-spec) + (emms-mpris-register-iface emms-mpris-player-iface-spec) + (emms-mpris-register-iface emms-mpris-introspectable-iface-spec) + (emms-mpris-register-iface emms-mpris-properties-iface-spec) + (dbus-register-service :session emms-mpris-service :allow-replacement) + (dbus-register-signal :session + emms-mpris-service + emms-mpris-path + dbus-interface-properties + "PropertiesChanged" + #'emms-mpris-property-change-handler + :eavesdrop) + (advice-add 'emms-toggle-repeat-track :after #'emms-mpris-advise-loop-status) + (advice-add 'emms-toggle-repeat-playlist :after #'emms-mpris-advise-loop-status) + (advice-add 'emms-toggle-random-playlist :after #'emms-mpris-advise-shuffle) + (add-hook 'emms-player-started-hook #'emms-mpris-change-status) + (add-hook 'emms-player-paused-hook #'emms-mpris-change-status) + (add-hook 'emms-player-stopped-hook #'emms-mpris-change-status) + (add-hook 'emms-player-finished-hook #'emms-mpris-change-status) + (setq emms-mpris-enabled-p t))) + +(defun emms-mpris-disable () + "Turn off EMMS dbus service." + (interactive) + (when emms-mpris-enabled-p + (remove-hook 'emms-player-started-hook #'emms-mpris-change-status) + (remove-hook 'emms-player-paused-hook #'emms-mpris-change-status) + (remove-hook 'emms-player-stopped-hook #'emms-mpris-change-status) + (remove-hook 'emms-player-finished-hook #'emms-mpris-change-status) + (advice-remove 'emms-toggle-repeat-track #'emms-mpris-advise-loop-status) + (advice-remove 'emms-toggle-repeat-playlist #'emms-mpris-advise-loop-status) + (advice-remove 'emms-toggle-random-playlist #'emms-mpris-advise-shuffle) + ;; Call this twice: we have two methods for "Get" on the Properties + ;; interface (there /must/ be a better way to do this!): + (dbus-unregister-service :session emms-mpris-service) + (dbus-unregister-service :session emms-mpris-service) + (setq emms-mpris-enabled-p nil))) + + +(provide 'emms-mpris) +;;; emms-mpris.el ends here |