[elpa] externals/listen 614b9a0b67 2/8: Release: v0.4

[ELPA Syncer]

branch: externals/listen
commit 614b9a0b67b365bdd5dc36563c71ca272c6b287f
Merge: ae04167ef2 95eb3eeb7e
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Release: v0.4
---
 README.org        |  13 +++++-
 listen-lib.el     |   6 ++-
 listen-library.el |  22 ++++++----
 listen-queue.el   | 119 +++++++++++++++++++++++++++++++++++++++++++++++++-----
 listen.el         |  28 ++++++++-----
 5 files changed, 159 insertions(+), 29 deletions(-)

diff --git a/README.org b/README.org
index 87cab4441e..65cac65c19 100644
--- a/README.org
+++ b/README.org
@@ -29,7 +29,7 @@ Note a silly limitation: a track may be present in a queue 
only once (but who wo
 
 * Installation
 
-Note that Listen.el uses [[https://www.videolan.org/vlc/][VLC]] to play audio, 
so it must be installed.
+Note that Listen.el uses [[https://www.videolan.org/vlc/][VLC]] to play audio, 
so it must be installed.  Also, ~ffprobe~ (part of 
[[https://ffmpeg.org/ffprobe.html][FFmpeg]]) is used to read track durations 
when available, but it is not required.
 
 ** GNU ELPA
 
@@ -65,6 +65,17 @@ Use the command ~listen~ to show the Transient menu.  From 
there, it is--hopeful
 
 * Changelog
 
+** v0.4
+
+*Additions*
++ Command ~listen-queue-deduplicate~ removes duplicate tracks from a queue (by 
comparing artist, album, and title metadata case-insensitively).
++ Read track durations with ~ffprobe~ and show in library and queue views.
++ Bound key ~?~ to open the ~listen~ Transient menu in library and queue views.
+
+*Fixes*
++ Transposing a track in a queue keeps point on the track.
++ Autoloading of ~listen~ command.
+
 ** v0.3
 
 *Additions*
diff --git a/listen-lib.el b/listen-lib.el
index 2afd109a1a..5da08872e4 100644
--- a/listen-lib.el
+++ b/listen-lib.el
@@ -35,7 +35,7 @@
   name tracks current etc)
 
 (cl-defstruct listen-track
-  filename artist title album number genre length date rating etc)
+  filename artist title album number genre duration date rating etc)
 
 (cl-defmethod cl-print-object ((track listen-track) stream)
   (prin1 (listen-track-filename track) stream))
@@ -77,6 +77,10 @@
   (or listen-player
       (setf listen-player (make-listen-player-vlc))))
 
+(defun listen-format-seconds (seconds)
+  "Return SECONDS formatted as an hour:minute:second-style duration."
+  (format-seconds "%h:%z%.2m:%.2s" seconds))
+
 ;;;; Methods
 
 (cl-defmethod listen--running-p ((player listen-player))
diff --git a/listen-library.el b/listen-library.el
index 577a93fc24..bd4e3dd3f2 100644
--- a/listen-library.el
+++ b/listen-library.el
@@ -60,31 +60,37 @@
                                 (`nil nil)
                                 (date (format " (%s)" date)))))
                     "[unknown album]"))
-              (title (track)
-                (or (with-face 'listen-title (listen-track-title track))
-                    "[unknown title]"))
               (number (track)
                 (or (listen-track-number track) ""))
-              (track-string (track)
+              (title (track)
                 (concat (pcase (number track)
                           ("" "")
                           (else (format "%s: " else)))
-                        (title track)))
+                        (or (with-face 'listen-title (listen-track-title 
track))
+                            "[unknown title]")))
+              (format-track (track)
+                (let* ((duration (listen-track-duration track)))
+                  (when duration
+                    (setf duration (concat "(" (listen-format-seconds 
duration) ")" " ")))
+                  (concat duration (listen-track-filename track))))
               (make-fn (&rest args)
                 (apply #'make-taxy-magit-section
                        :make #'make-fn
-                       :format-fn #'cl-prin1-to-string
+                       :format-fn #'format-track
                        args)))
     (make-fn
      :name "Genres"
      :take (apply-partially #'taxy-take-keyed
                             (list #'genre #'artist ;; #'date
-                                  #'album #'track-string)))))
+                                  #'album #'title)))))
 
 ;;;; Mode
 
+(declare-function listen-menu "listen")
+
 (defvar-keymap listen-library-mode-map
   :parent magit-section-mode-map
+  "?" #'listen-menu
   "!" #'listen-library-shell-command
   "a" #'listen-library-add-tracks
   "g" #'listen-library-revert
@@ -108,7 +114,7 @@ show the view."
                              if (file-directory-p path)
                              append (directory-files-recursively path "." t)
                              else collect path))
-         (tracks (remq nil (mapcar #'listen-queue-track filenames)))
+         (tracks (listen-queue-tracks-for filenames))
          (buffer-name (if name
                           (format "*Listen library: %s" name)
                         (generate-new-buffer-name (format "*Listen 
library*"))))
diff --git a/listen-queue.el b/listen-queue.el
index bfcf20fc53..bd37d11a24 100644
--- a/listen-queue.el
+++ b/listen-queue.el
@@ -51,10 +51,20 @@
 
 (defvar listen-mode)
 
+(defvar listen-queue-ffprobe-p (not (not (executable-find "ffprobe")))
+  "Whether \"ffprobe\" is available.")
+
+(defvar listen-queue-nice-p (not (not (executable-find "nice")))
+  "Whether \"nice\" is available.")
+
 (defgroup listen-queue nil
   "Queues."
   :group 'listen)
 
+(defcustom listen-queue-max-probe-processes 16
+  "Maximum number of processes to run while probing track durations."
+  :type 'natnum)
+
 ;;;; Commands
 
 ;; (defmacro listen-queue-command (command)
@@ -65,6 +75,7 @@
 ;;        (with-current-buffer list-buffer
 ;;          (vtable-revert)))))
 
+(declare-function listen-menu "listen")
 (declare-function listen-pause "listen")
 ;;;###autoload
 (defun listen-queue (queue)
@@ -95,6 +106,10 @@
                    (list :name "#" :primary 'descend
                          :getter (lambda (track _table)
                                    (cl-position track (listen-queue-tracks 
queue))))
+                   (list :name "Duration"
+                         :getter (lambda (track _table)
+                                   (when-let ((duration (listen-track-duration 
track)))
+                                     (listen-format-seconds duration))))
                    (list :name "Artist" :max-width 20 :align 'right
                          :getter (lambda (track _table)
                                    (propertize (or (listen-track-artist track) 
"")
@@ -127,6 +142,7 @@
              :sort-by '((1 . ascend))
              ;; TODO: Add a transient to show these bindings when pressing "?".
              :actions (list "q" (lambda (_) (bury-buffer))
+                            "?" (lambda (_) (call-interactively #'listen-menu))
                             "g" (lambda (_) (call-interactively 
#'listen-queue-revert))
                             "j" (lambda (_) (listen-queue-jump))
                             "n" (lambda (_) (forward-line 1))
@@ -155,11 +171,12 @@ If BACKWARDP, move it backward."
          (position (seq-position (listen-queue-tracks queue) track))
          (_ (when (= (funcall fn position) (length (listen-queue-tracks 
queue)))
               (user-error "Track at end of queue")))
-         (next-position (funcall fn position))
-         (next-track (seq-elt (listen-queue-tracks queue) next-position)))
-    (setf (seq-elt (listen-queue-tracks queue) next-position) track
-          (seq-elt (listen-queue-tracks queue) position) next-track)
-    (listen-queue--update-buffer queue)))
+         (next-position (funcall fn position)))
+    ;; Hey, a chance to use `rotatef'!
+    (cl-rotatef (seq-elt (listen-queue-tracks queue) next-position)
+                (seq-elt (listen-queue-tracks queue) position))
+    (listen-queue--update-buffer queue)
+    (vtable-goto-object track)))
 
 (cl-defun listen-queue-transpose-backward (track queue)
   "Transpose TRACK backward in QUEUE."
@@ -303,7 +320,7 @@ which see."
                (directory-files-recursively path ".")
              (list path))
            queue)))
-  (cl-callf append (listen-queue-tracks queue) (delq nil (mapcar 
#'listen-queue-track files)))
+  (cl-callf append (listen-queue-tracks queue) (listen-queue-tracks-for files))
   (listen-queue queue)
   (listen-queue-play queue)
   queue)
@@ -372,6 +389,16 @@ buffer, if any)."
      :date (map-elt metadata "date")
      :genre (map-elt metadata "genre"))))
 
+(defun listen-queue-tracks-for (filenames)
+  "Return tracks for FILENAMES.
+When `listen-queue-ffprobe-p' is non-nil, adds durations read
+with \"ffprobe\"."
+  (with-demoted-errors "listen-queue-tracks-for: %S"
+    (let ((tracks (remq nil (mapcar #'listen-queue-track filenames))))
+      (when listen-queue-ffprobe-p
+        (listen-queue--add-track-durations tracks))
+      tracks)))
+
 (defun listen-queue-shuffle (queue)
   "Shuffle QUEUE."
   (interactive (list (listen-queue-complete)))
@@ -390,6 +417,34 @@ buffer, if any)."
     (setf (listen-queue-tracks queue) tracks))
   (listen-queue--update-buffer queue))
 
+(cl-defun listen-queue-deduplicate (queue)
+  "Remove duplicate tracks from QUEUE.
+Tracks that appear to have the same metadata (artist, album, and
+title, compared case-insensitively) are deduplicated."
+  (interactive (list (listen-queue-complete)))
+  (setf (listen-queue-tracks queue)
+        (cl-remove-duplicates
+         (listen-queue-tracks queue)
+         :test (lambda (a b)
+                 (pcase-let ((( cl-struct listen-track
+                                (artist a-artist) (album a-album) (title 
a-title)) a)
+                             (( cl-struct listen-track
+                                (artist b-artist) (album b-album) (title 
b-title)) b))
+                   (and (or (and a-artist b-artist)
+                            (and a-album b-album)
+                            (and a-title b-title))
+                        ;; Tracks have at least one common metadata field: 
compare them.
+                        (if (and a-artist b-artist)
+                            (string-equal-ignore-case a-artist b-artist)
+                          t)
+                        (if (and a-album b-album)
+                            (string-equal-ignore-case a-album b-album)
+                          t)
+                        (if (and a-title b-title)
+                            (string-equal-ignore-case a-title b-title)
+                          t))))))
+  (listen-queue--update-buffer queue))
+
 (defun listen-queue-next (queue)
   "Play next track in QUEUE."
   (interactive (list (listen-queue-complete)))
@@ -448,9 +503,7 @@ disk."
 (defun listen-queue-refresh (queue)
   "Refresh QUEUE's tracks from disk."
   (setf (listen-queue-tracks queue)
-        (delq nil (mapcar (lambda (track)
-                            (listen-queue-track (listen-track-filename track)))
-                          (listen-queue-tracks queue)))))
+        (listen-queue-tracks-for (mapcar #'listen-track-filename 
(listen-queue-tracks queue)))))
 
 (defun listen-queue-order-by ()
   "Order the queue by the column at point.
@@ -514,6 +567,54 @@ Expands filenames relative to playlist's directory."
       (cl-loop while (re-search-forward (rx bol (group (not (any "#")) (1+ 
nonl)) eol) nil t)
                collect (expand-file-name (match-string 1))))))
 
+;;;;; ffprobe queue
+
+(cl-defun listen-queue--add-track-durations (tracks &key (max-processes 
listen-queue-max-probe-processes))
+  "Add durations to TRACKS by probing with \"ffprobe\".
+MAX-PROCESSES limits the number of parallel probing processes."
+  ;; Because running "ffprobe" sequentially can be quite slow, we do
+  ;; it asynchronously in a queue.
+  ;; TODO: Generalize this.
+  (let (processes)
+    (cl-labels
+        ((probe-duration (track)
+           (with-demoted-errors "Unable to get duration for %S"
+             (with-current-buffer (get-buffer-create (generate-new-buffer " 
*listen: ffprobe*"))
+               (let* ((sentinel (lambda (process status)
+                                  (unwind-protect
+                                      (pcase status
+                                        ((or "killed\n" "interrupt\n"
+                                             (pred numberp)
+                                             (rx "exited abnormally with code 
" (1+ digit))))
+                                        ("finished\n"
+                                         (with-current-buffer (process-buffer 
process)
+                                           (goto-char (point-min))
+                                           (let ((duration (read 
(current-buffer))))
+                                             (cl-check-type duration number )
+                                             (setf (listen-track-duration 
track) duration)))))
+                                    (kill-buffer (process-buffer process))
+                                    (cl-callf2 remove process processes)
+                                    (probe-more))))
+                      (command (list "ffprobe" "-v" "quiet" "-print_format"
+                                     
"compact=print_section=0:nokey=1:escape=csv"
+                                     "-show_entries" "format=duration"
+                                     (expand-file-name (listen-track-filename 
track))))
+                      (process (make-process
+                                :name "listen:ffprobe" :noquery t :type 'pipe 
:buffer (current-buffer)
+                                :sentinel sentinel :command (if 
listen-queue-nice-p
+                                                                (cons "nice" 
command)
+                                                              command))))
+                 process))))
+         (probe-more ()
+           (while (and tracks (length< processes max-processes))
+             (let ((track (pop tracks)))
+               (push (probe-duration track) processes)))))
+      (with-timeout ((* 0.05 (length tracks)) (error "Probing for track 
duration timed out"))
+        (while (or tracks processes)
+          (probe-more)
+          (while (accept-process-output nil 0.01))
+          (sleep-for 0.01))))))
+
 ;;;; Footer
 
 (provide 'listen-queue)
diff --git a/listen.el b/listen.el
index 58d6d47555..83cf229f56 100755
--- a/listen.el
+++ b/listen.el
@@ -6,7 +6,7 @@
 ;; Maintainer: Adam Porter <adam@alphapapa.net>
 ;; Keywords: multimedia
 ;; Package-Requires: ((emacs "29.1") (persist "0.6") (taxy "0.10") 
(taxy-magit-section "0.13"))
-;; Version: 0.3
+;; Version: 0.4
 ;; URL: https://github.com/alphapapa/listen.el
 
 ;; This program is free software; you can redistribute it and/or modify
@@ -99,7 +99,8 @@ Interactively, uses the default player."
    (list (listen--player)))
   (delete-process (listen-player-process player))
   (when (eq player listen-player)
-    (setf listen-player nil)))
+    (setf listen-player nil))
+  (listen-mode--update))
 
 (declare-function listen-queue-next "listen-queue")
 (defun listen-next (player)
@@ -194,9 +195,7 @@ command with completion."
 
 (defun listen-mode-lighter ()
   "Return lighter for `listen-mode'."
-  (cl-labels ((format-time (seconds)
-                (format-seconds "%h:%z%.2m:%.2s" seconds))
-              (format-track ()
+  (cl-labels ((format-track ()
                 (when-let ((info (listen--info listen-player))
                            ;; Sometimes when paused/stopped, the artist and/or
                            ;; title are nil even if info isn't, so we must
@@ -217,11 +216,11 @@ command with completion."
                (list (format-status) " " (format-track)
                      " ("
                      (pcase listen-lighter-format
-                       ('remaining (concat "-" (format-time (- (listen--length 
listen-player)
-                                                               
(listen--elapsed listen-player)))))
-                       (_ (concat (format-time (listen--elapsed listen-player))
+                       ('remaining (concat "-" (listen-format-seconds (- 
(listen--length listen-player)
+                                                                         
(listen--elapsed listen-player)))))
+                       (_ (concat (listen-format-seconds (listen--elapsed 
listen-player))
                                   "/"
-                                  (format-time (listen--length 
listen-player)))))
+                                  (listen-format-seconds (listen--length 
listen-player)))))
                      ") ")
              '("■ ")))))
 
@@ -270,8 +269,15 @@ TIME is a string like \"SS\", \"MM:SS\", or \"HH:MM:SS\"."
 
 (require 'transient)
 
+(declare-function listen-queue "listen-queue")
+(declare-function listen-queue-shuffle "listen-queue")
+
+;; It seems that autoloading the transient prefix command doesn't work
+;; as expected, so we'll try this workaround.
 ;;;###autoload
-(transient-define-prefix listen ()
+(defalias 'listen #'listen-menu)
+
+(transient-define-prefix listen-menu ()
   "Show Listen menu."
   :refresh-suffixes t
   [["Listen"
@@ -348,6 +354,8 @@ TIME is a string like \"SS\", \"MM:SS\", or \"HH:MM:SS\"."
                          (let ((current-prefix-arg '(4)))
                            (call-interactively #'listen-queue-play)))
      :transient t)
+    ("qd" "Deduplicate" listen-queue-deduplicate
+     :transient t)
     ("qs" "Shuffle" (lambda ()
                       "Shuffle queue."
                       (interactive)