ネット購入した曲ファイルの曲名を一覧表示する Emacs LISP です.

音楽をネット購入するとファイル名が "284553877.m4a" のような、中身の判らない名前である場合が殆どなので、それが何の曲のファイルなのかをまとめて知るためのものです.

下手にオリジナル・ファイル名を変えてしまうと、あとで却って探しにくくなるとか、そもそも気分がよろしくないとかするので、DL したファイル名は rename などはしないのですが、曲ファイルの場合「名は体をまるで現していない」ため、探すときひとつひとつ中身を検証して探していました。
これを楽にするために作った lisp です。

DL Directory で実行すると .m4a と .flac のファイルの曲名を集めてバッファに一覧表示し、同時に dired でも別ウインドウで開き双方のカーソルを追従させます.

SPC n p で上下移動します.
ソートしたいときは TAB と S-TAB でフィールド移動するので
そこで s でそのフィールドを基準にソートします.
m でマークすると dired 側のファイルもマークされます.
u のマーク解除も同様に動作します.
q で m4a-browse-name ウィンドウが閉じ
マークが残ったまま dired だけになるのでそこでコピーなりなんなりをします.
使い方の流れはそんな感じです.

P で再生もします.

CODE

m4a-browse-name.el

;;; m4a-browse-name.el -- m4a file name browse title. -*- coding: utf-8 -*-
;; Copyright (C) 2023 fubuki

;; Author: fubuki at frill.org
;; Version: @(#)$Revision: 1.12 $$Name:  $
;; 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.

;; 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Synchronize m4a or flac file with dired to list in buffer.

;;; Installation:

;; Need the fm.el(github.com/vapniks/fm) and wtag.el(github.com/s-fubuki/wtag) packages.

;; (require 'm4a-browse-name)

;;; Code:

(require 'dired)
(require 'wtag)
(require 'fm)

(defgroup m4a-browse-name nil
  "m4a browse name."
  :group   'music-file
  :version "30.0.50"
  :prefix  "m4a-")

(defcustom m4a-width [1 13 16 16 32 7 4]
  "[M File TimeStamp Artist Title Time BR]"
  :type '(vector (integer :tag "Mark Width       ")
                 (integer :tag "File Name Width  ")
                 (integer :tag "Time Stamp Width ")
                 (integer :tag "Artist Name Width")
                 (integer :tag "Title Width      ")
                 (integer :tag "Time Width       ")
                 (integer :tag "Bitrate Width    "))
  :group 'm4a-browse-name)

(defcustom m4a-sort '("TimeStamp" . flip)
  "Default sort field."
  :type  '(choice (const :tag "File" ("File"))
                  (const :tag "File /Flip" ("File" . flip))
                  (const :tag "Time Stamp" ("TimeStamp"))
                  (const :tag "Time Stamp /Flip" ("TimeStamp" . flip))
                  (const :tag "Artist" ("Artist"))
                  (const :tag "Artist /Flip"  ("Artist" . flip))
                  (const :tag "Title"  ("Title"))
                  (const :tag "Title /Flip" ("Title" . flip))
                  (const :tag "Time" ("Time"))
                  (const :tag "Time /Flip" ("Time" . flip))
                  (const :tag "Bitrate" ("BR"))
                  (const :tag "Bitrate /Flip" ("BR" . flip))
                  (const :tag "No Sort" nil))
  :group 'm4a-browse-name)

(defcustom m4a-browse-name-regexp (rx (and "." (or "m4a" "flac") eos))
  "Target file name."
  :type 'regexp
  :group 'm4a-browse-name)

(defcustom m4a-buff-name "*m4a browse name*"
  "Buffer name."
  :type  'string
  :group 'm4a-browse-name)

(defvar m4a-dired-buffer nil)

(unless (featurep 'wtag)
  (defvar wtag-process-name "*wtag process*")
  (defvar wtag-process nil))

(defcustom m4a-music-players
  (or wtag-music-players
      `((,(rx "." (or "mp4" "m4a" "flac" "wav") eos)
         ,(executable-find "wmplayer.exe") . ("/play" "/close"))
        (,(rx "." (or "mp3") eos)
         ,(executable-find "mpg123"))))
  "Music Player and Opt."
  :type '(repeat
          (cons regexp
                (cons
                 (file :tag "Player" :must-match t)
                 (list :inline t :tag "Option" (repeat string)))))
  :group 'm4a-browse-name)

(defgroup m4a-faces nil
  "Faces for m4a browse name."
  :group 'm4a-browse-name
  :group 'faces)

(defface m4a-file
  '((t :inherit bold))
  "m4a mode file name face."
  :group 'm4a-browse-name
  :group 'm4a-faces)

(defface m4a-time
  '((t :inherit nil))
  "m4a mode time stamp face."
  :group 'm4a-browse-name
  :group 'm4a-faces)

(defface m4a-artist
  '((t :inherit font-lock-keyword-face))
  "m4a mode artist name face."
  :group 'm4a-browse-name
  :group 'm4a-faces)

(defface m4a-title
  '((t :inherit font-lock-constant-face))
  "m4a mode title name face."
  :group 'm4a-browse-name
  :group 'm4a-faces)

(defface m4a-bitrate
  '((t :inherit font-lock-variable-name-face))
  "m4a mode bitrate and time face."
  :group 'm4a-browse-name
  :group 'm4a-faces)

(defface m4a-marked
  '((t :inherit dired-marked))
  "m4a mode marked face."
  :group 'm4a-browse-name
  :group 'm4a-faces)

(defun m4a-browse-name-mode-goto ()
  "next-next / previous-line のバインドでシンクロして動く."
  (interactive)
  (let* ((atr (get-text-property (line-beginning-position) 'tabulated-list-id))
         (pos (plist-get atr '*pos)))
    (pop-to-buffer m4a-dired-buffer)
    (goto-char pos)))

(defun m4a-file-pos (buff name)
  (with-current-buffer buff
    (dired-goto-file name)))

(defun m4a-music-play ()
  (interactive)
  (let* ((atr (get-text-property (line-beginning-position) 'tabulated-list-id))
         (file (plist-get atr '*file))
         (buff wtag-process-name)
         cmd)
    (m4a-music-kill)
    (when (setq cmd (assoc-default file m4a-music-players #'string-match))
      (setq wtag-process
            (apply #'start-process (append (list buff buff) cmd (list file)))))))

(defun m4a-music-kill ()
  (interactive)
  (and wtag-process (delete-process wtag-process))
  (setq wtag-process nil))

(defun m4a-dired-mark ()
  (interactive)
  (let* ((beg (line-beginning-position))
         (atr (get-text-property beg 'tabulated-list-id))
         (file (plist-get atr '*file)))
    (tabulated-list-set-col 0 (propertize "*" 'face 'm4a-marked) t)
    (forward-line)
    (with-current-buffer m4a-dired-buffer
      (dired-goto-file file)
      (dired-mark 1))))

(defun m4a-dired-unmark ()
  (interactive)
  (let* ((beg (line-beginning-position))
         (atr (get-text-property beg 'tabulated-list-id))
         (file (plist-get atr '*file)))
    (tabulated-list-set-col 0 " " t)
    (forward-line)
    (with-current-buffer m4a-dired-buffer
      (dired-goto-file file)
      (dired-unmark 1))))

(defun m4a-dired-unmark-all ()
  (interactive)
  (let* (beg vec atr mark file)
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
        (setq beg (line-beginning-position)
              vec (get-text-property beg 'tabulated-list-entry)
              atr (get-text-property beg 'tabulated-list-id)
              mark (aref vec 0)
              file (plist-get atr '*file))
        (unless (equal mark " ")
          (tabulated-list-set-col 0 " " t)
          (with-current-buffer m4a-dired-buffer
            (dired-goto-file file)
            (dired-unmark 1)))
        (forward-line)))))

(defun m4a-next-marked-file ()
  (interactive)
  (let ((pos (point)))
    (forward-line)
    (unless (re-search-forward "^\\*" nil t)
      (goto-char pos))))

(defun m4a-previous-marked-file ()
  (interactive)
  (let ((pos (point)))
    (beginning-of-line)
    (unless (re-search-backward "^\\*" nil t)
      (goto-char pos))))

(defun m4a-dired-mode-directories ()
  (let (result)
    (dolist (buff (buffer-list) (reverse result))
      (with-current-buffer buff
        (if (eq major-mode 'dired-mode)
            (push default-directory result))))))

;;;###autoload
(defun m4a-browse-name (dir)
  "DIR 下にある \".m4a\" (or \".flac\")のタイトルを知る.
変数 `m4a-buff-name' にセットされた名前のバッファに一覧表示される"
  (interactive "DDir: ")
  (and (get-buffer m4a-buff-name) (kill-buffer m4a-buff-name))
  (dired dir)
  (setq m4a-dired-buffer (current-buffer))
  (with-current-buffer (get-buffer-create m4a-buff-name)
    (m4a-browse-name-mode)
    (m4a-browse-name-refresh dir)
    (tabulated-list-print t)
    (pop-to-buffer (current-buffer))))

(defun m4a-bitrate (lst)
  (let ((tmp (nth 1 (plist-get lst '*time))))
    (if (consp tmp) (car tmp) tmp)))

(defun tabulated-list-entry-bitrate-> (ent1 ent2)
  (> (m4a-bitrate (car ent1)) (m4a-bitrate (car ent2))))

(defun tabulated-list-entry-time-> (ent1 ent2)
  (>  (car (plist-get (car ent1) '*time))
      (car (plist-get (car ent2) '*time))))

(defun m4a-browse-name-refresh (&optional dir)
  (let* ((buff m4a-dired-buffer)
         (dir (or dir (with-current-buffer buff default-directory)))
         (files (directory-files-and-attributes dir t m4a-browse-name-regexp))
         result entries)
    ;; Get tag data.
    (dolist (f files (message "done"))
      (let ((name (car f))
            (size (round (* (/ (file-attribute-size (cdr f)) 100.0) 20)))
            (time (file-attribute-modification-time (cdr f)))
            message-log-max)
        (message "%s..." name)
        (setq result
              (cons
               (append (list '*pos (m4a-file-pos buff name) '*file name '*mt time)
                       (mf-tag-read-plist name size t))
               result))))
    ;; Set tabulated list.
    (dolist (rec result)
      (setq entries
            (cons
             (list rec
                   (vector
                    " "
                    (propertize
                     (file-name-nondirectory (plist-get rec '*file)) 'face 'm4a-file)
                    (propertize
                     (format-time-string "%F %R" (plist-get rec '*mt)) 'face 'm4a-time)
                    (propertize (plist-get rec 'artist) 'face 'm4a-artist)
                    (propertize (plist-get rec 'title) 'face 'm4a-title)
                    (propertize
                     (format-seconds "%3m'%02s\"" (nth 0 (plist-get rec '*time)))
                     'face 'm4a-bitrate)
                    (propertize (number-to-string (m4a-bitrate rec)) 'face 'm4a-bitrate)))
             entries)))
    (setq tabulated-list-format 
          (vector `("M"         ,(aref m4a-width 0) t) ; :pad-right 0
                  `("File"      ,(aref m4a-width 1) t)
                  `("TimeStamp" ,(aref m4a-width 2) t)
                  `("Artist"    ,(aref m4a-width 3) t)
                  `("Title"     ,(aref m4a-width 4) t)
                  `("Time"      ,(aref m4a-width 5) tabulated-list-entry-time->)
                  `("BR"        ,(aref m4a-width 6) tabulated-list-entry-bitrate->)))
    (setq tabulated-list-use-header-line t)
    (and m4a-sort (setq tabulated-list-sort-key m4a-sort))
    (setq tabulated-list-entries entries)
    (tabulated-list-init-header)))

;; TextProperty: (tabulated-list-entry [194160527.m4a 2021-04-15 14:08 リーガルリリー 東京 4'17" 320] tabulated-list-id (*pos 895 *file c:/Users/foo/Desktop/tmp/music/194160527.m4a *mt (24695 51783 0 0) *time (257 320 44100.0 2 16) *type mp4 title 東京 artist リーガルリリー a-artist リーガルリリー album the World track 1 disk 1 writer たかはしほのか cover nil s-title トウキョウ s-artist リーガルリリー s-a-artist リーガルリリー copy (P) 2021 Sony Music Labels Inc.) tabulated-list-column-name File help-echo File: 194160527.m4a face m4a-file) Overlay: nil

(defvar-keymap m4a-browse-name-mode-map
  :doc "m4a browse name mode map.
\"f\" is not available as it is follow mode(fm.el) toggle."
  "P"           #'m4a-music-play
  "C-c C-c"     #'m4a-music-kill
  "n"           #'next-line
  "SPC"         #'next-line
  "p"           #'previous-line
  "S-SPC"       #'previous-line
  "<backspace>" #'previous-line
  "<tab>"       #'tabulated-list-next-column
  "S-<tab>"     #'tabulated-list-previous-column
  "s"           #'tabulated-list-sort
  "m"           #'m4a-dired-mark
  "u"           #'m4a-dired-unmark
  "U"           #'m4a-dired-unmark-all
  "M-{"         #'m4a-previous-marked-file
  "M-}"         #'m4a-next-marked-file)

(define-derived-mode m4a-browse-name-mode tabulated-list-mode "m4a" "m4a browse name mode"
  (setq-local truncate-lines t)
  (add-to-list 'fm-modes '(m4a-browse-name-mode m4a-browse-name-mode-goto))
  (fm-start)
  (add-hook 'tabulated-list-revert-hook #'m4a-browse-name-refresh))

(provide 'm4a-browse-name)

必要ライブラリ

他に wtag.el¹ のパッケージと fm-mode が要ります.

wtag: https://github.com/s-fubuki/wtag
fm: https://github.com/vapniks/fm

wtag は 2023 May 版以降のもの ↩