Function: mpc-cmd-list

mpc-cmd-list is a byte-compiled function defined in mpc.el.gz.

Signature

(mpc-cmd-list TAG &optional OTHER-TAG VALUE)

Source Code

;; Defined in /usr/src/emacs/lisp/mpc.el.gz
(defun mpc-cmd-list (tag &optional other-tag value)
  ;; FIXME: we could also provide a `mpc-cmd-list' alternative which
  ;; doesn't take an "other-tag value" constraint but a "song-list" instead.
  ;; That might be more efficient in some cases.
  (cond
   ((eq tag 'Playlist)
    (let ((pls (mpc-assq-all 'playlist (mpc-proc-cmd-to-alist "lsinfo"))))
      (when other-tag
        (dolist (pl (prog1 pls (setq pls nil)))
          (let ((plsongs (mpc-cmd-find 'Playlist pl)))
            (if (not (mpc-cmd-special-tag-p other-tag))
                (when (member (cons other-tag value)
                              (apply #'append plsongs))
                  (push pl pls))
              ;; Problem N°2: we compute the intersection whereas all
              ;; we care about is whether it's empty.  So we could
              ;; speed this up significantly.
              ;; We only compare file names, because the full song-entries
              ;; are slightly different (the ones in plsongs include
              ;; position and id info specific to the playlist), and it's
              ;; good enough because this is only used with "search", which
              ;; doesn't pay attention to playlists and URLs anyway.
              (let* ((osongs (mpc-cmd-find other-tag value))
                     (ofiles (mpc-assq-all 'file (apply #'append osongs)))
                     (plfiles (mpc-assq-all 'file (apply #'append plsongs))))
                (when (seq-intersection plfiles ofiles)
                  (push pl pls)))))))
      pls))

   ((eq tag 'Directory)
    (if (null other-tag)
        (apply #'nconc
               (mpc-assq-all 'directory
                             (mpc-proc-buf-to-alist
                              (mpc-proc-cmd "lsinfo")))
               (mapcar (lambda (dir)
                         (let ((shortdir
                                (if (get-text-property 0 'display dir)
                                    (concat "   "
                                            (get-text-property 0 'display dir))
                                  " ↪ "))
                               (subdirs
                                (mpc-assq-all 'directory
                                              (mpc-proc-buf-to-alist
                                               (mpc-proc-cmd (list "lsinfo" dir))))))
                           (dolist (subdir subdirs)
                             (put-text-property 0 (1+ (length dir))
                                                'display shortdir
                                                subdir))
                           subdirs))
                       (process-get (mpc-proc) 'Directory)))
      ;; If there's an other-tag, then just extract the dir info from the
      ;; list of other-tag's songs.
      (let* ((other-songs (mpc-cmd-find other-tag value))
             (files (mpc-assq-all 'file (apply #'append other-songs)))
             (dirs '()))
        (dolist (file files)
          (let ((dir (file-name-directory file)))
            (if (and dir (setq dir (directory-file-name dir))
                     (not (equal dir (car dirs))))
                (push dir dirs))))
        ;; Dirs might have duplicates still.
        (setq dirs (delete-dups dirs))
        (let ((newdirs dirs))
          (while newdirs
            (let ((dir (file-name-directory (pop newdirs))))
              (when (and dir (setq dir (directory-file-name dir))
                         (not (member dir dirs)))
                (push dir newdirs)
                (push dir dirs)))))
        dirs)))

   ;; The UI should not provide access to such a thing anyway currently.
   ;; But I could imagine adding in the future a browser for the "search"
   ;; tag, which would provide things like previous searches.  Not sure how
   ;; useful that would be tho.
   ((eq tag 'Search) (error "Not supported"))

   ((string-match "|" (symbol-name tag))
    (let ((tag1 (intern (substring (symbol-name tag)
                                   0 (match-beginning 0))))
          (tag2 (intern (substring (symbol-name tag)
                                   (match-end 0)))))
      (mpc-union (mpc-cmd-list tag1 other-tag value)
                 (mpc-cmd-list tag2 other-tag value))))

   ((null other-tag)
    (condition-case nil
        (mapcar #'cdr (mpc-proc-cmd-to-alist (list "list" (symbol-name tag))))
      (mpc-proc-error
       ;; If `tag' is not one of the expected tags, MPD burps about not
       ;; having the relevant table.
       ;; FIXME: check the kind of error.
       (error "MPD does not know this tag %s" tag)
       (mpc-assq-all tag (mpc-proc-cmd-to-alist "listallinfo")))))
   (t
    (condition-case nil
        (if (mpc-cmd-special-tag-p other-tag)
            (signal 'mpc-proc-error "Not implemented")
          (mapcar #'cdr
                  (mpc-proc-cmd-to-alist
                   (list "list" (symbol-name tag)
                         (symbol-name other-tag) value))))
      (mpc-proc-error
       ;; DAMN!! the 3-arg form of `list' is new in 0.12 !!
       ;; FIXME: check the kind of error.
       (let ((other-songs (mpc-cmd-find other-tag value)))
         (mpc-assq-all tag
                       ;; Don't use `nconc' now that mpc-cmd-find may
                       ;; return a memoized result.
                       (apply #'append other-songs))))))))