emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/listen 8ad00dbc10 6/6: Change: Use tracks more


From: ELPA Syncer
Subject: [elpa] externals/listen 8ad00dbc10 6/6: Change: Use tracks more
Date: Fri, 8 Mar 2024 18:58:24 -0500 (EST)

branch: externals/listen
commit 8ad00dbc10ea3f550302da9e1ad7f76ec453d7fb
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Change: Use tracks more
    
    Rather than recreating track objects from filenames everywhere, pass
    tracks where possible.  (Will probably need some more fixes...)
---
 listen-library.el | 67 ++++++++++++++++++++++-------------------
 listen-mpd.el     | 89 +++++++++++++++++++++++++++++--------------------------
 listen-queue.el   | 29 ++++++++++--------
 3 files changed, 99 insertions(+), 86 deletions(-)

diff --git a/listen-library.el b/listen-library.el
index c7a8979ac4..a204a38574 100644
--- a/listen-library.el
+++ b/listen-library.el
@@ -40,7 +40,7 @@
 (defvar listen-directory)
 
 (defvar-local listen-library-name nil)
-(defvar-local listen-library-paths nil)
+(defvar-local listen-library-tracks nil)
 
 (defvar listen-library-taxy
   (cl-labels ((with-face (face string)
@@ -106,7 +106,7 @@
   :parent magit-section-mode-map
   "?" #'listen-menu
   "!" #'listen-library-shell-command
-  "a" #'listen-library-add-tracks
+  "a" #'listen-library-to-queue
   "g" #'listen-library-revert
   "j" #'listen-library-jump
   "m" #'listen-library-view-track
@@ -116,23 +116,19 @@
   (setq-local bookmark-make-record-function 
#'listen-library--bookmark-make-record))
 
 ;;;###autoload
-(cl-defun listen-library (paths &key name buffer)
-  "Show a library view of PATHS.
-PATHS is a list of paths to files and/or directories, or a
-function which returns them.  Interactively, with prefix, NAME
-may be specified to show in the mode line and bookmark name.
-BUFFER may be specified in which to show the view."
+(cl-defun listen-library (tracks &key name buffer)
+  "Show a library view of TRACKS.
+PATHS is a list of `listen-track' objects, or a function which
+returns them.  Interactively, with prefix, NAME may be specified
+to show in the mode line and bookmark name.  BUFFER may be
+specified in which to show the view."
   (interactive
    (list (list (read-file-name "View library for: "))
          :name (when current-prefix-arg
                  (read-string "Library name: "))))
-  (let* ((filenames (cl-loop for path in (cl-etypecase paths
-                                           (function (funcall paths))
-                                           (list paths))
-                             if (file-directory-p path)
-                             append (directory-files-recursively path "." t)
-                             else collect path))
-         (tracks (listen-queue-tracks-for filenames))
+  (let* ((tracks (cl-etypecase tracks
+                   (function (funcall tracks))
+                   (list tracks)))
          (buffer-name (if name
                           (format "*Listen library: %s*" name)
                         (generate-new-buffer-name (format "*Listen 
library*"))))
@@ -140,7 +136,7 @@ BUFFER may be specified in which to show the view."
          (inhibit-read-only t))
     (with-current-buffer buffer
       (listen-library-mode)
-      (setf listen-library-paths paths
+      (setf listen-library-tracks tracks
             listen-library-name name)
       (erase-buffer)
       (thread-last listen-library-taxy
@@ -153,16 +149,21 @@ BUFFER may be specified in which to show the view."
 
 ;;;; Commands
 
-(defun listen-library-add-tracks (queue tracks)
-  "Add TRACKS to QUEUE.
-Interactively, play tracks in sections at point and select QUEUE
-with completion."
+(defun listen-library-to-queue (tracks queue)
+  "Add current library buffer's TRACKS to QUEUE.
+Interactively, add TRACKS in sections at point and select QUEUE
+with completion.  Duplicate tracks (by filename) are removed from
+the queue."
   (interactive
-   (list (listen-queue-complete :prompt "Add to queue" :allow-new-p t)
-         (listen-library--selected-tracks)))
-  (listen-queue-add-files (mapcar #'listen-track-filename tracks) queue))
+   (list (listen-library--selected-tracks)
+         (listen-queue-complete :prompt "Add to queue" :allow-new-p t)))
+  (cl-callf2 append (listen-queue-tracks queue) tracks)
+  (setf (listen-queue-tracks queue)
+        (cl-delete-duplicates (listen-queue-tracks queue)
+                              :key #'listen-track-filename :test #'equal)))
 
 (declare-function listen-play "listen")
+(declare-function listen-queue-add-tracks "listen-queue")
 (defun listen-library-play (tracks &optional queue)
   "Play or add TRACKS.
 If TRACKS is a list of one track, play it; otherwise, prompt for
@@ -172,8 +173,9 @@ a QUEUE to add them to and play it."
      (list tracks (when (length> tracks 1)
                     (listen-queue-complete :prompt "Add tracks to queue" 
:allow-new-p t)))))
   (if queue
-      (listen-queue-play
-       (listen-queue-add-files (mapcar #'listen-track-filename tracks) queue))
+      (progn
+        (listen-queue-add-tracks tracks queue)
+        (listen-queue-play queue))
     (listen-play (listen-current-player) (listen-track-filename (car 
tracks)))))
 
 (defun listen-library-jump (track)
@@ -202,8 +204,8 @@ Interactively, read COMMAND and use tracks at point in
 (defun listen-library-revert ()
   "Revert current listen library buffer."
   (interactive)
-  (cl-assert listen-library-paths)
-  (listen-library listen-library-paths :name listen-library-name :buffer 
(current-buffer)))
+  (cl-assert listen-library-tracks)
+  (listen-library listen-library-tracks :name listen-library-name :buffer 
(current-buffer)))
 
 (cl-defun listen-library-from-playlist-file (filename)
   "Show library view tracks in playlist at FILENAME."
@@ -212,7 +214,9 @@ Interactively, read COMMAND and use tracks at point in
                          (lambda (filename)
                            (pcase (file-name-extension filename)
                              ("m3u" t))))))
-  (listen-library (listen-queue--m3u-filenames filename)))
+  (listen-library (lambda ()
+                    (listen-queue-tracks-for
+                     (listen-queue--m3u-filenames filename)))))
 
 ;;;; Functions
 
@@ -239,11 +243,12 @@ Interactively, read COMMAND and use tracks at point in
 
 (defun listen-library--bookmark-make-record ()
   "Return a bookmark record for the current library buffer."
-  (cl-assert listen-library-paths)
-  `(,(format "Listen library: %s" (or listen-library-name 
listen-library-paths))
+  (cl-assert listen-library-tracks)
+  `(,(format "Listen library: %s" (or listen-library-name 
listen-library-tracks))
     (handler . listen-library--bookmark-handler)
     (name . ,listen-library-name)
-    (paths . ,listen-library-paths)))
+    ;; NOTE: Leaving key as `paths' for backward compatibility.
+    (paths . ,listen-library-tracks)))
 
 ;;;###autoload
 (defun listen-library--bookmark-handler (bookmark)
diff --git a/listen-mpd.el b/listen-mpd.el
index 27bd6a0373..d5fdf515cc 100644
--- a/listen-mpd.el
+++ b/listen-mpd.el
@@ -27,29 +27,34 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'map)
 (require 'mpc)
 
+(require 'listen-lib)
+
 (defvar listen-directory)
 (defvar crm-separator)
 
 (declare-function listen-library "listen-library")
 ;;;###autoload
-(cl-defun listen-library-from-mpd (filenames &key query)
-  "Show library view of FILENAMES selected from MPD library.
-With prefix, select individual results with
-`completing-read-multiple'; otherwise show all results and show
-QUERY in result buffer."
+(cl-defun listen-library-from-mpd (tracks &key name)
+  "Show library view of TRACKS selected from MPD library.
+With prefix, select individual tracks with
+`completing-read-multiple'; otherwise show all results.  NAME is
+applied to the buffer."
   ;; FIXME: This isn't the ideal way to split functionality between the 
interactive form and the
   ;; function body.
   (interactive
    (if current-prefix-arg
        (list (listen-mpd-completing-read))
-     (let ((query (listen-mpd-read-query :select-tag-p t)))
-       (list (lambda ()
-               (listen-mpd-tracks-matching query))
-             :query query))))
-  (listen-library filenames :name (when query
-                                    (format "(MPD: %s)" query))))
+     (pcase-let ((`(,tag ,query) (listen-mpd-read-query :select-tag-p t)))
+       (list `(lambda ()
+                (listen-mpd-tracks-matching ,query :tag ',tag))
+             :name (when query
+                     (format "(MPD: %s%s)"
+                             (if tag (format "%s:" tag) "")
+                             query))))))
+  (listen-library tracks :name name))
 
 (declare-function listen-queue-add-files "listen-queue")
 (declare-function listen-queue-complete "listen-queue-complete")
@@ -65,46 +70,46 @@ QUERY in result buffer."
   (listen-queue-add-files filenames queue))
 
 (cl-defun listen-mpd-read-query (&key (tag 'file) select-tag-p)
+  "Return MPD (TAG QUERY) read from the user.
+If SELECT-TAG-P, read TAG with completion."
   (when select-tag-p
-    (let ((tags '( Artist Album Title Track Name Genre Date Composer Performer 
Comment
-                   Disc file any)))
-      (setf tag (intern (completing-read "Search by tag: " tags nil t)))))
-  (read-string (pcase-exhaustive tag
-                 ('file "MPC Search (track): ")
-                 (_ (format "MPC Search (%s): " tag)))))
-
-(cl-defun listen-mpd-tracks-matching (query &key (tag 'file) select-tag-p)
+    (let ((tags '( artist album title track name genre date composer performer 
comment
+                   disc file any)))
+      (setf tag (completing-read "Search by tag: " tags nil t))))
+  (cl-values tag (read-string (pcase-exhaustive tag
+                                ('file "MPC Search (track): ")
+                                (_ (format "MPC Search (%s): " tag))))))
+
+(cl-defun listen-mpd-tracks-matching (query &key (tag "file") select-tag-p)
   "Return tracks matching QUERY on TAG.
 If SELECT-TAG-P, prompt for TAG with completion.  If QUERY is
 nil, read it."
   (when select-tag-p
-    (let ((tags '( Artist Album Title Track Name Genre Date Composer Performer 
Comment
-                   Disc file any)))
-      (setf tag (intern (completing-read "Search by tag: " tags nil t)))))
+    (let ((tags '( artist album title track name genre date composer performer 
comment
+                   disc file any)))
+      (setf tag (completing-read "Search by tag: " tags nil t))))
   (unless query
     (setf query (read-string (pcase-exhaustive tag
                                ('file "MPC Search (track): ")
                                (_ (format "MPC Search (%s): " tag))))))
-  (cl-labels ((search-any (queries)
-                (mpc-proc-buf-to-alists
-                 (mpc-proc-cmd (cl-loop for query in queries
-                                        append (list "any" query)
-                                        into list
-                                        finally return (cons "search" 
list))))))
-    (let ((result (unless (string-empty-p query)
-                    (let ((tag (pcase tag
-                                 ('any 'file)
-                                 (_ tag))))
-                      (delete-dups
-                       (delq nil
-                             (mapcar (lambda (row)
-                                       (when-let ((value (alist-get tag row)))
-                                         (propertize value
-                                                     :mpc-alist row)))
-                                     (search-any (split-string query)))))))))
-      (mapcar (lambda (filename)
-                (expand-file-name filename (or mpc-mpd-music-directory 
listen-directory)))
-              result))))
+  (let* ((command (cons "search" (list tag query)))
+         (results (mpc-proc-buf-to-alists (mpc-proc-cmd command))))
+    (when results
+      (mapcar #'listen-mpd-track-for results))))
+
+(defun listen-mpd-track-for (alist)
+  "Return `listen-track' for MPD track ALIST."
+  (pcase-let (((map file Artist Title Album Genre Date duration ('Track 
number)) alist))
+    (make-listen-track
+     :filename (expand-file-name file (or mpc-mpd-music-directory 
listen-directory))
+     :artist Artist :title Title :album Album :genre Genre :date Date :number 
number
+     :duration (when duration
+                 (string-to-number duration))
+     :metadata (map-apply (lambda (key value)
+                            ;; TODO: Consider using symbols for keys 
everywhere to reduce consing.
+                            (cons (downcase (symbol-name key))
+                                  value))
+                          alist))))
 
 ;;;###autoload
 (cl-defun listen-mpd-completing-read (&key (tag 'file) select-tag-p)
diff --git a/listen-queue.el b/listen-queue.el
index 0920c517b1..653a72ac88 100644
--- a/listen-queue.el
+++ b/listen-queue.el
@@ -377,6 +377,10 @@ which see."
   (listen-queue queue)
   queue)
 
+(defun listen-queue-add-tracks (tracks queue)
+  "Add TRACKS to QUEUE."
+  (cl-callf append (listen-queue-tracks queue) tracks))
+
 (cl-defun listen-queue-add-from-playlist-file (filename queue)
   "Add tracks to QUEUE selected from playlist at FILENAME.
 M3U playlists are supported."
@@ -413,19 +417,18 @@ buffer, if any)."
      (list :tracks tracks :queue queue)))
   (listen-library (or tracks
                       (lambda ()
-                        (mapcar #'listen-track-filename
-                                ;; In case the queue gets renamed, or gets 
replaced by a
-                                ;; different one with the same name:
-                                (listen-queue-tracks
-                                 (or (when (member queue listen-queues)
-                                       ;; Ensure the queue is in the queue 
list (one from a bookmark
-                                       ;; record wouldn't be the same object 
anymore).  This allows
-                                       ;; a queue to be renamed during a 
session and still match
-                                       ;; here.
-                                       queue)
-                                     (cl-find (listen-queue-name queue) 
listen-queues
-                                              :key #'listen-queue-name :test 
#'equal)
-                                     (error "Queue not found: %S" queue)))))) 
))
+                        (listen-queue-tracks
+                         ;; In case the queue gets renamed, or gets replaced 
by a
+                         ;; different one with the same name:
+                         (or (when (member queue listen-queues)
+                               ;; Ensure the queue is in the queue list (one 
from a bookmark
+                               ;; record wouldn't be the same object anymore). 
 This allows
+                               ;; a queue to be renamed during a session and 
still match
+                               ;; here.
+                               queue)
+                             (cl-find (listen-queue-name queue) listen-queues
+                                      :key #'listen-queue-name :test #'equal)
+                             (error "Queue not found: %S" queue))))) ))
 
 (defun listen-queue-track (filename)
   "Return track for FILENAME."



reply via email to

[Prev in Thread] Current Thread [Next in Thread]