Add MPD stats viewer to 'mpc' (Bug#76350)

* lisp/mpc.el (mpc-server-stats): New command.
(mpc-mode-menu): Add menu item.
(mpc--server-stats-date, mpc--server-stats-duration):
New variable.
(mpc--server-stats-date, mpc--server-stats-duration):
(mpc--server-stats-format): New function.
(mpc-song-viewer-value, mpc-song-viewer-tag):
(mpc-song-viewer-empty): Remove face.
(mpc-table-value, mpc-table-key, mpc-table-empty): New face.
(mpc-describe-song): Use new table face names.

(cherry picked from commit df93e53a1c648654d8b128a5955bb4ff0229b041)

diff --git a/lisp/mpc.el b/lisp/mpc.el
index e50ed142d8e1302c3e60f544294046b181f1f9a1..22d7ae7a432aaa64c54ef401931133f02a197a3a 100644 (file)
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -1201,6 +1201,7 @@ string POST."
      :selected (alist-get 'xfade mpc-status)]
     "--"
     ["Add new browser" mpc-tagbrowser]
+    ["Server Stats" mpc-server-stats]
     ["Update DB" mpc-update]
     ["Quit" mpc-quit]))
 
@@ -2863,17 +2864,17 @@ will be used.  See `mpc-format' for the definition of FORMAT-SPEC."
 
 ;;; Song Viewer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defface mpc-song-viewer-value
+(defface mpc-table-value
   '((t (:inherit vtable)))
-  "Face for tag values in the MPC song viewer.")
+  "Face for values in MPC tables.")
 
-(defface mpc-song-viewer-tag
-  '((t (:inherit (mpc-song-viewer-value bold))))
-  "Face for tag types in the MPC song viewer.")
+(defface mpc-table-key
+  '((t (:inherit (mpc-table-value bold))))
+  "Face for keys in MPC tables.")
 
-(defface mpc-song-viewer-empty
-  '((t (:inherit (mpc-song-viewer-value italic shadow))))
-  "Face for empty tag values in the MPC song viewer.")
+(defface mpc-table-empty
+  '((t (:inherit (mpc-table-value italic shadow))))
+  "Face for empty values in MPC tables.")
 
 (defcustom mpc-song-viewer-tags
   '("Title" "Artist" "Album" "Performer" "Composer"
@@ -2918,15 +2919,15 @@ playing song is displayed."
                         :min-width 3
                         :displayer
                         (lambda (tag &rest _)
-                          (propertize tag 'face 'mpc-song-viewer-tag)))
+                          (propertize tag 'face 'mpc-table-key)))
                       ( :name "Value"
                         :align left
                         :min-width 5
                         :displayer
                         (lambda (value &rest _)
                           (if (and value (not (string-blank-p value)))
-                              (propertize value 'face 'mpc-song-viewer-value)
-                            (propertize "empty" 'face 'mpc-song-viewer-empty)))))
+                              (propertize value 'face 'mpc-table-value)
+                            (propertize "empty" 'face 'mpc-table-empty)))))
            :objects (mapcar
                      (lambda (tag)
                        (pcase tag
@@ -2953,6 +2954,56 @@ playing song is displayed."
                                display-buffer-same-window)
                               (reusable-frames . t))))))
 
+;;; Stats viewer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar mpc--server-stats-date "%c"
+  "Format used for dates in `mpc-server-stats'.
+See `format-time-string' for formatting details.")
+
+(defvar mpc--server-stats-duration "%Y, %D, %z%h:%.2m:%.2s"
+  "Format used for durations in `mpc-server-stats'.
+See `format-seconds' for formatting details.")
+
+(defun mpc--server-stats-date (seconds)
+  "Format SECONDS as a date for display by `mpc-server-stats'."
+  (format-time-string mpc--server-stats-date (string-to-number seconds)))
+
+(defun mpc--server-stats-duration (seconds)
+  "Format SECONDS as a duration for display by `mpc-server-stats'."
+  (format-seconds mpc--server-stats-duration (string-to-number seconds)))
+
+(defun mpc--server-stats-format (stat)
+  "Format STAT data for display by `mpc-server-stats'."
+  (let ((key (seq-reduce (lambda (string from-to)
+                           (string-replace (car from-to) (cdr from-to) string))
+                         '(("Db_" . "DB_") ("_" . " "))
+                         (capitalize (symbol-name (car stat)))))
+        (val (cdr stat)))
+    (list key (cond
+               ((string-match-p "time\\'" key) (mpc--server-stats-duration val))
+               ((string-match-p "date\\'" key) (mpc--server-stats-date val))
+               (t val)))))
+
+(defun mpc-server-stats ()
+  "Display stats about the connected MPD server."
+  (interactive)
+  (let ((buffer "*MPC Stats Viewer*"))
+    (with-current-buffer (get-buffer-create buffer)
+      (special-mode)
+      (let ((inhibit-read-only t))
+        (erase-buffer)
+        (make-vtable
+         :columns '((:name "Server Stats" :align right :min-width 10) "")
+         :formatter (lambda (value column &rest _)
+                      (propertize value 'face (if (= column 0)
+                                                  'mpc-table-key
+                                                'mpc-table-value)))
+         :objects (mapcar #'mpc--server-stats-format
+                          (mpc-proc-cmd-to-alist (list "stats")))))
+      (pop-to-buffer buffer '((display-buffer-reuse-window)
+                              (reusable-frames . t)
+                              (window-height . 10))))))
+
 ;;; Toplevel ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defcustom mpc-frame-alist '((name . "MPC") (tool-bar-lines . 1)