ネット購入した曲ファイルの曲名を一覧表示する 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.el1 のパッケージと fm-mode が要ります.
-
wtag は 2023 May 版以降のもの ↩