Emacs lisp music player.

shuffle-all.el

;;; shuffle-all.el --- Play the Music file -*- lexical-binding:t -*-
;; Copyright (C) 2023-2025 fubuki

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

;; Play the music file on wtag-view-mode.
;; Or for music file play in Directory recursively.
;; Need the `mf-tag-write.el', `wtag.el' library.

;;; Installation:

;; (autoload 'shuffle-all "shuffle-all" nil t)

;; or for wtag

;; (require 'shuffle-all)

;;; Change Log:

;;; Code:
(require 'mf-tag-write)
(require 'wtag)
(require 'tab-bar)
(require 'repeat)
(require 'hl-line)
(require 'seq)

(define-key wtag-view-mode-map [remap wtag-music-play] #'shuffle-wtag-play)
(define-key wtag-view-mode-map [remap wtag-kill-process] #'shuffle-kill)
(define-key wtag-view-mode-map "\C-c\C-s" #'shuffle-stop)
(define-key wtag-view-mode-map "\M-n" #'shuffle-next)
(define-key wtag-view-mode-map "/" #'shuffle-single-play)
(define-key wtag-view-mode-map [mouse-1] #'shuffle-play-mouse)

(add-hook 'wtag-view-mode-hook
          #'(lambda ()
              (define-key-after
                (lookup-key wtag-view-mode-map [menu-bar wtag])
                [shuffle-next]
                '(menu-item "Next Play" shuffle-next :key-sequence "\M-n")
                'wtag-music-play)
              (define-key-after
                (lookup-key wtag-view-mode-map [menu-bar wtag])
                [shuffle-single-play]
                (list 'menu-item "Single Play" #'shuffle-single-play
                      :button '(:toggle . shuffle-single-play))
                'wtag-kill-process)))

(add-hook 'wtag-writable-mode-hook #'shuffle-kill-silent)

(defgroup shuffle-all nil
  "Group Shuffle all."
  :group 'music-file)

(defcustom shuffle-directory nil
  "Default shuffle directory name."
  :type  '(choice directory (const nil))
  :group 'shuffle-all)

(defcustom shuffle-music-file "\\.\\(mp3\\)\\'"
  "Shuffle file name regexp."
  :type  'regexp
  :group 'shuffle-all)

(defcustom shuffle-music-file-wtag nil
  "Shuffle file name regexp for `shuffle-wtag-play'.
If nil, `shuffle-music-file' will be used."
  :type  '(choice regexp (const nil))
  :group 'shuffle-all)

(defcustom shuffle-ignore-regexp nil
  "Directory name for exclude."
  :type  '(choice regexp (const nil))
  :group 'shuffle-all)

(defcustom shuffle-players (or wtag-music-players '(("\\.mp3\\'" "mpg123")))
  "Shuffle music player."
  :type '(repeat
          (list regexp
                (file :tag "Player" :must-match t)
                (repeat :inline t :tag "Option" string)))
  :group 'shuffle-all)

(defcustom shuffle-sleep-timer-time nil
  "オフタイマー時間を秒数か \"2 hour 10 min\" 等の文字列で指定."
  :type  '(choice string integer (const nil))
  :group 'shuffle-all)

(defcustom shuffle-format " `%a - %t (%T)'"
  "Shuffle mode line format.
Special characters:
 %f File Name
 %T Play Time (variable `shuffle-time-format')
 %C Codec
 %B Bit rate
 %A Album Title
 %a Artist Name
 %t Track Title
 %n Track Number
 %g Genre
 %y Release Year
 %% %"
  :type  'string
  :group 'shuffle-all)

(defcustom shuffle-time-format "%m'%02s\""
  "See function `format-seconds'."
  :type  'string
  :group 'shuffle-all)

(defcustom shuffle-follow-cursor t
   "Follow the cursor."
   :type  'boolean
   :group 'shuffle-all)

(defcustom shuffle-single-play nil
  "non-nil if single play."
  :local t
  :initialize 'custom-initialize-default
  :type  'boolean
  :group 'shuffle-all)

(defcustom shuffle-move-shade-over nil
  "Shuffle move shade over."
    :type  '(choice (const nil) (const t) number)
    :group 'shuffle-all)

(defcustom shuffle-gap '(("mpg123" . 0.25))
  "Seconds of track margin.
Number, Cons list \((Player . Number) ...) or nil."
  :type  '(choice (const :tag "Disable" nil)
                  (number :tag "Gap")
                  (repeat :tag "Individual"
                          (cons (regexp :tag "Player") (number :tag "Gap   "))))
  :group 'shuffle-all)

(defcustom shuffle-all-startup-hook nil
  "Shuffle all startup hook."
  :type  'hook
  :group 'shuffle-all)

(defgroup shuffle-all-faces nil
  "Group Shuffle all face."
  :group 'shuffle-all
  :group 'faces)

(defface shuffle-mode-line nil
  "Shuffle all mode line face."
  :group 'shuffle-all-faces)

(defface shuffle-shade
  '((t :inherit shadow :foreground "dim gray" :extend t))
  "Wtag shuffle shade face."
  :group 'shuffle-all-faces)

(defvar shuffle-stat nil)
(defvar shuffle-title nil)
(put 'shuffle-title 'risky-local-variable t)

(defcustom shuffle-global-mode-string nil
  "`shuffle-title' Add `global-mode-string'."
  :type 'boolean
  :group 'shuffle-all)
  
(unless (featurep 'wtag)
  (defvar wtag-process-name "*wtag process*")
  (defvar wtag-process nil))

(defvar shuffle-fringe-bitmap-alist
  '((shuffle-all     . [128 192 224 240 248 252 254 255])
    (shuffle-single  . [96 112 124 127 127 124 112 96])
    (shuffle-shuffle . [255 254 252 248 240 224 192 128]))
  "\(symbol name/face name . bitmap data)")

(dolist (a shuffle-fringe-bitmap-alist)
  (define-fringe-bitmap (car a) (cdr a))
  (set-fringe-bitmap-face (car a) (car a)))

(defvar-local shuffle-fringe nil)
(defvar-local shuffle-position nil)

(defface shuffle-all
  '((t :inherit font-lock-constant-face))
  "All mode face."
  :group 'shuffle-all-faces)

(defface shuffle-single
  '((t :inherit font-lock-property-name-face))
  "Single mode face."
  :group 'shuffle-all-faces)

(defface shuffle-shuffle
  '((t :inherit font-lock-function-name-face))
  "Shuffle mode face."
  :group 'shuffle-all-faces)

(defvar shuffle-prefix nil)

(defcustom shuffle-progress-interval 5
  "Progress time interval.
INTEGER is Progress interval Seconds. if NIL is disable. "
  :type  '(choice integer (const :tag "Disable" nil))
  :group 'shuffle-all)

(defcustom shuffle-progress-timer-mode-line-update nil
  "non-nil なら残り計算時に mode-line 表示を常に更新する."
  :type 'boolean
  :group 'shuffle-all)

(defcustom shuffle-all-minor-mode-lighter-label "▶"
  "`shuffle-all-minor-mode-lighter' Play label."
  :type '(choice string (const nil))
  :group 'shuffle-all)

(defsubst shuffle-get (prop)
  (plist-get shuffle-stat prop))

(defsubst shuffle-put (prop val)
  (setq shuffle-stat (plist-put shuffle-stat prop val)))

(defsubst shuffle-member (prop)
  (plist-member shuffle-stat prop))

(defvar shuffle-all-progress-exp
  `(shuffle-progress-interval
    (:propertize
     (:eval (format " %s%d%%%%"
                    (or shuffle-all-minor-mode-lighter-label "")
                    (- 100 (/ (shuffle-get :progress)
                              (/ (shuffle-get :total-time) 100.0)))))
     mouse-face mode-line-highlight
     local-map ,(make-mode-line-mouse-map 'mouse-1 'shuffle-all-minor-mode-menu-map)
     help-echo (shuffle-get :now))))

(put 'shuffle-all-progress-exp 'risky-local-variable t)

(defcustom shuffle-all-minor-mode-lighter 'shuffle-all-progress-exp
  "shuffle all minor mode lighter."
  :type '(choice symbol string sexp)
  :group 'shuffle-all)

(put 'shuffle-all-minor-mode-lighter 'risky-local-variable t)

(defun shuffle-progress-time-timer ()
  (run-with-timer shuffle-progress-interval shuffle-progress-interval
                  #'(lambda ()
                      (shuffle-put
                       :progress (- (or (shuffle-get :progress) 0) shuffle-progress-interval))
                      (and shuffle-progress-timer-mode-line-update
                           (force-mode-line-update))
                      (unless (and (shuffle-get :progress) (natnump (shuffle-get :progress)))
                        (cancel-timer (shuffle-get :progress-timer))
                        (shuffle-put :progress-timer nil)
                        (shuffle-put :now nil)))))

(defun shuffle-set-gap (app)
  (cond
   ((consp shuffle-gap)
    (or (assoc-default app shuffle-gap #'string-match) 0))
   (t
    (or shuffle-gap 0))))

(defun shuffle-wc-point-move (buff marker)
  "移動したポイントを tab-bar が元の位置に戻してしまうので書換えている."
  (let ((tabs (funcall tab-bar-tabs-function)) tmp)
    (dolist (a tabs)
      (when (eq 'tab (car a))
        (setq tmp (assq 'wc-point (cdr a)))
        (if (eq buff (marker-buffer (cdr tmp)))
            (setcdr tmp marker))))))

(defun shuffle-put-fringe (pos)
  (let ((fringe (cond
                 (shuffle-single-play 'shuffle-single)
                 ((not (natnump (shuffle-get :mode))) 'shuffle-shuffle)
                 (t 'shuffle-all))))
    (setq shuffle-fringe (set-marker (make-marker) pos))
    (put 'shuffle-fringe 'overlay-arrow-bitmap fringe)
    (add-to-list 'overlay-arrow-variable-list 'shuffle-fringe)))

(defun shuffle-shade (pos buff)
  "ポイントを POS, カレントバッファを BUFF に移し日除けをおろす.
`shuffle-follow-cursor' が non-nil ならポイント POS に移動する."
  (let ((prev (point))
        (inhibit-field-text-motion t)
        beg end end2 ov)
    (with-current-buffer buff
      (goto-char pos)
      (and shuffle-follow-cursor (shuffle-wc-point-move buff (point-marker)))
      (setq beg (line-beginning-position)
            end (line-end-position)
            end2 (line-beginning-position 2)) ; for hl-line
      (shuffle-put-fringe beg)
      (setq ov (make-overlay beg end buff))
      (overlay-put ov 'category 'shuffle-alls)
      (overlay-put ov 'shuffle-shade t)
      (setq ov (make-overlay beg end2 buff))
      (overlay-put ov 'category 'shuffle-alls)
      (overlay-put ov 'priority 1024)
      (overlay-put ov 'face 'shuffle-shade)
      (or shuffle-follow-cursor (goto-char prev))
      (and hl-line-mode (hl-line-highlight)))))

(defun shuffle-open-shade (&optional buff)
  (with-current-buffer (or buff (current-buffer))
    (remove-overlays (point-min) (point-max) 'category 'shuffle-alls)
    (setq overlay-arrow-variable-list
          (delq 'shuffle-fringe overlay-arrow-variable-list))))

(defun shuffle-move-shade (times func limit)
  (let ((pos (point)))
    (dotimes (_ times)
      (while (and
              (not (eq limit (setq pos (funcall func pos 'shuffle-shade))))
              (not (get-char-property pos 'shuffle-shade)))))
    (if (null (eq pos limit))
        (goto-char pos)
      (ding)
      (message "No Match")
      (when shuffle-move-shade-over
        (and (numberp shuffle-move-shade-over)
             (sit-for shuffle-move-shade-over))
        (goto-char (if (= limit (point-min)) (point-max) (point-min)))
        (shuffle-move-shade times func limit)))))

(defun shuffle-next-shade (times)
  (interactive "p")
  (shuffle-move-shade times #'next-single-char-property-change (point-max)))

(defun shuffle-previous-shade (times)
  (interactive "p")
  (shuffle-move-shade times #'previous-single-char-property-change (point-min)))

(defun shuffle-current-shade ()
  (interactive)
  (goto-char shuffle-position))

(defun shuffle-goto-char (pos)
  (with-current-buffer (shuffle-get :init)
    (goto-char pos)
    (wtag-move-to-property 'title)))

(defun shuffle-process-buffer ()
  "Process log buffer を開く."
  (interactive)
  (pop-to-buffer wtag-process-name)
  (shuffle-log-mode))

(defvar shuffle-tags nil)

(defun shuffle-spec ()
  "`shuffle-format' にで使うスペシャルキャラのテーブル."
  (let* ((tags shuffle-tags))
    `((?f . ,(plist-get tags :file))
      (?T . ,(wtag-format shuffle-time-format (car (plist-get tags '*time))))
      (?C . ,(shuffle-id2codec (plist-get tags '*type)))
      (?B . ,(mf-indirect-car (cadr (plist-get tags '*time))))
      (?A . ,(shuffle-plist-get tags 'album))
      (?a . ,(shuffle-plist-get tags 'artist))
      (?t . ,(shuffle-plist-get tags 'title))
      (?n . ,(shuffle-plist-get tags 'track))
      (?g . ,(shuffle-plist-get tags 'genre))
      (?y . ,(shuffle-plist-get tags 'year))
      (?% . "%"))))

(defun shuffle-now (tags)
  "TAGS を元に `shuffle-format' を展開して文字列にして戻す."
  (setq shuffle-tags tags)
  (format-spec shuffle-format (shuffle-spec)))

(defvar shuffle-id2codec-table
  '(("ID3\1" . "mp3") ("ID3\2" . "mp3") ("ID3\3" . "mp3") ("ea3\3" . "oma")))

(defun shuffle-id2codec (id)
  "コーデック ID の変名を戻す."
  (or (assoc-default id shuffle-id2codec-table) id))

(defun shuffle-directory-files-directories (dir)
  "DIR 以下から `shuffle-music-file' の在る Directory だけを集め list で戻す.
各要素には :index Property に位置番号リストで埋め込まれている."
  (let* ((files (directory-files dir t directory-files-no-dot-files-regexp))
         (index (shuffle-make-index files))
         (result (when index
                   (progn
                     (put-text-property 0 1 :index index dir)
                     (list dir))))
         message-log-max)
    (dolist (f files result)
      (cond
       ((and (not (and shuffle-ignore-regexp
                       (string-match shuffle-ignore-regexp f)))
             (car (file-attributes f)))
        (message "Scan `%s'..." f)
        (setq result (append result (shuffle-directory-files-directories f))))))))

(defun shuffle-make-index (files)
  (let ((count 0) result)
    (dolist (f files (reverse result))
      (when (string-match shuffle-music-file f)
        (setq result (cons count result)
              count (1+ count))))))

(defun shuffle-shuffle (lst)
  "LST をシャッフルした新たなリストを戻す."
  (let (result)
    (random t)
    (while lst
      (push (nth (random (length lst)) lst) result)
      (setq lst (remove (car result) lst)))
    result))

(defun shuffle-sleep-timer (sec)
  "STR see `timer-duration-words'."
  (interactive "s: ")
  (let ((sec (if (stringp sec) (timer-duration sec) sec)))
    (and (shuffle-get :sleep) (cancel-timer (shuffle-get :sleep)))
    (shuffle-put :sleep (run-with-timer sec nil #'shuffle-kill))))

;;;###autoload
(defun shuffle-init (dir)
  (message "Initializ shuffle...")
  (random t)
  (and (shuffle-get :timer) (shuffle-cancel-timer))
  (and shuffle-sleep-timer-time (shuffle-sleep-timer shuffle-sleep-timer-time))
  (shuffle-reset-stat)
  (shuffle-put :next (or (shuffle-directory-files-directories dir)
                         (error "Not found `shuffle-music-file'")))
  (shuffle-put :init (file-name-as-directory dir))
  (and shuffle-title (shuffle-title-clear))
  (message "Initializ shuffle...done."))

(defun shuffle-point-music-tags (mark)
  "ポイント *pos を追加した stat プロパティを戻す.
但し MARK が non-nil 且つ、
stat の filename が `shuffle-music-file' にマッチしなければ nil になる."
  (let ((stat (get-text-property (line-end-position) 'stat)))
    (and mark stat (string-match
                    (or shuffle-music-file-wtag
                        shuffle-music-file)
                    (cddr (assq 'filename stat)))
         (cons `(*pos nil . ,(point)) stat))))

(defun shuffle-alist-to-plist (lst)
  (let (result)
    (dolist (a lst result)
      (setq result (append result (list (car a) (cddr a)))))))

(defun shuffle-single-play ()
  (interactive)
  (when (bufferp (shuffle-get :init))
    (with-current-buffer (shuffle-get :init)
      (setq shuffle-single-play (not shuffle-single-play))
      (shuffle-put-fringe shuffle-position)
      (recenter nil t)
      (message "%s single play." (if shuffle-single-play "Enable" "Disable")))))

(defun shuffle-buffer-properties (mode)
  (let ((mark-buff (wtag-buffer-mark-p ?*))
        (abs (wtag-absolutely-track-number))
        stat props)
    (when (and (natnump mode) (null (assq mode abs)))
      (shuffle-reset-stat)
      (error "Illegal number"))
    (when (wtag-common-area-p)
      (goto-char (point-min))
      (forward-line 2))
    (cond
     ((or mark-buff (not (natnump mode)))
      (goto-char (point-min)))
     ((natnump mode)
      (goto-char (point-min))
      (forward-line (1+ (cdr (assq mode abs)))))
     (t
      (beginning-of-line)))
    (save-excursion
      (while (not (eobp))
        (when (or (null mark-buff) (wtag-mark-p ?*))
          (setq stat (shuffle-point-music-tags ?*))
          (and stat (push (shuffle-alist-to-plist stat) props)))
        (forward-line)))
    (if (not (natnump mode))
        (shuffle-shuffle props)
      (reverse props))))

(defun shuffle-init-buff (mode)
  "MODE (prefix) で shuffle に関するステータスの初期化をする."
  (shuffle-open-shade)
  (and (shuffle-get :timer) (shuffle-cancel-timer))
  (and shuffle-sleep-timer-time (shuffle-sleep-timer shuffle-sleep-timer-time))
  (shuffle-reset-stat)
  (shuffle-put :mode mode)
  (shuffle-put :init (current-buffer))
  ;; (shuffle-put :window (selected-window))
  (shuffle-put :next (shuffle-buffer-properties mode))
  (and shuffle-title (shuffle-title-clear))
  (shuffle-get :next))

(defvar shuffle-unknown "Unknown")

(defun shuffle-plist-get (lst tag)
  (or (plist-get lst tag) shuffle-unknown))

(defun shuffle-rondom (lst)
  (and lst (nth (random (length lst)) lst)))

(defun shuffle-cancel-timer ()
  (interactive)
  (and (shuffle-get :timer) (cancel-timer (shuffle-get :timer)))
  (shuffle-put :timer nil)
  (when (shuffle-get :progress-timer)
    (cancel-timer (shuffle-get :progress-timer))
    (shuffle-put :progress-timer nil)
    (shuffle-put :now nil)
    (shuffle-put :progress (shuffle-get :total-time))))

(defun shuffle-cancel-sleep-timer ()
  (interactive)
  (and (shuffle-get :sleep) (cancel-timer (shuffle-get :sleep)))
  (shuffle-put :sleep nil))

(defun shuffle-title-clear ()
  (and (memq 'shuffle-title global-mode-string)
       (setq global-mode-string
             (delq 'shuffle-title global-mode-string)))
  (and (buffer-live-p (shuffle-get :init))
       (with-current-buffer (shuffle-get :init)
         (setq wtag-music-title nil)))
  (setq shuffle-title nil))

(defun shuffle-reset-stat ()
  (let ((tmp (cons (shuffle-get :timer)
                   (shuffle-get :sleep))))
    (setq shuffle-stat nil)
    (shuffle-put :timer (car tmp))
    (shuffle-put :sleep (cdr tmp))))

(defun shuffle-kill-silent (&optional prefix)
  (interactive "P")
  (shuffle-kill prefix 'silent))

;; 2.18 曲間クリック防止で再生前に delete-process しなくしたため
;; 連続再生時に前のトラックと被ると process_name<1> などと番号が付き
;; うまく get-process できなくなるので(nil になる)
;; process-list から調べて削除するようにした.
(defun shuffle-get-process ()
  (or (get-process wtag-process-name)
      (seq-find
       (lambda (p)
         (string-match
          (concat "\\`"
                  (regexp-quote  wtag-process-name)
                  "\\(<[[:digit:]]+>\\)?\\'")
          (process-name p)))
       (process-list))))

(defun shuffle-process-delete ()
  (let ((ps (shuffle-get-process)))
    (and ps (delete-process ps))))

;;;###autoload
(defun shuffle-kill (&optional prefix silent)
  "PREFIX が non-nil なら初期化フラグを保持、つまり再開ができる."
  (interactive "P")
  (shuffle-process-delete)
  (setq wtag-process nil)
  (shuffle-cancel-timer)
  ;; (or prefix (shuffle-cancel-sleep-timer))
  (shuffle-cancel-sleep-timer)
  (shuffle-title-clear)
  (shuffle-all-minor-mode -1)
  (unless prefix
    (and (buffer-live-p (shuffle-get :init))
         (shuffle-open-shade (shuffle-get :init)))
    (shuffle-reset-stat)
    (shuffle-put :init nil))
  (or silent
      (message "%s shuffle play process." (if prefix "Stop" "Kill"))))

(defun shuffle-stop ()
  (interactive)
  (shuffle-kill 'keep))

(defun shuffle-filter (prc str)
  "エラーハンドラフィルタ. PRC 番号と STR."
  (if (string-match "error: .+valid MPEG header" str)
      (progn
        (shuffle-kill)
        (message "%s had the event '%s'" prc str))
    (when (buffer-live-p (process-buffer prc))
      (with-current-buffer (process-buffer prc)
        (let ((pos (= (point) (process-mark prc)))
              buffer-read-only)
          (save-excursion
            (goto-char (process-mark prc))
            (insert str)
            (set-marker (process-mark prc) (point)))
          (if pos (goto-char (process-mark prc))))))))

;;;###autoload
(defun shuffle-next ()
  (interactive)
  (let ((interactive (called-interactively-p 'interactive)))
    (if (shuffle-get :next)
        (progn
          (or shuffle-all-minor-mode (shuffle-all-minor-mode 1))
          (if (or (eq major-mode 'wtag-view-mode) (bufferp (shuffle-get :init)))
              (let ((next (shuffle-get :next)))
                (shuffle-put :next (cdr next))
                (shuffle-play (car next) (not (cdr next)) interactive))
            (shuffle-all nil interactive)))
      (error "Ther is Nothing"))))

(defun shuffle-music-play (prefix)
  (interactive "p")
  (if (eq major-mode 'wtag-view-mode)
      (shuffle-wtag-play prefix)
    (shuffle-all)))

;;;###autoload
(defun shuffle-all (&optional dirs interactive)
  (interactive
   (list (if (or current-prefix-arg (null shuffle-directory))
             (read-directory-name "Dir: ")
           shuffle-directory)
         (called-interactively-p 'interactive)))
  (let (dir files index target)
    (unless (and (shuffle-get :next) (shuffle-get :init)) (shuffle-init dirs))
    (run-hooks 'shuffle-all-startup-hook)
    (shuffle-all-minor-mode 1)
    (setq dir (shuffle-rondom (shuffle-get :next))
          index (get-text-property 0 :index dir))
    (setq files (directory-files dir t shuffle-music-file)
          target (shuffle-rondom index)
          index (remq target index))
    (if index
        (put-text-property 0 1 :index index dir)
      (shuffle-put :next (remove dir (shuffle-get :next))))
    (shuffle-play (nth target files) (not (shuffle-get :next)) interactive)))

(defun shuffle-make-prefix-number ()
  (car (rassq 
        (if (wtag-common-area-p)
            1
          (- (line-number-at-pos) 2))
        (wtag-absolutely-track-number))))

(defun shuffle-auto-forward (prefix)
  (when (and (natnump prefix) wtag-music-play-next)
    (and (numberp wtag-music-play-next)
         (sleep-for wtag-music-play-next))
    (forward-line)))

(defun shuffle-play-mouse (event)
  (interactive "e")
  (let* ((ev (if (eq (car event) 'mouse-1) (cadr event)))
         (num (- (line-number-at-pos (nth 1 ev)) 2))
         (file (wtag-get-point-filename))
         (ps (shuffle-get-process))
         (abs (wtag-absolutely-track-number)))
    (if (and ps (member file (process-command ps)))
        (shuffle-kill)
      (shuffle-wtag-play (car (rassq num abs))))))

(defsubst shuffle-single-play-p ()
  (and (shuffle-get :init)
       (with-current-buffer (shuffle-get :init) shuffle-single-play)))

(defun shuffle-next-function (mode last)
  (funcall
   (cond
    ((or (shuffle-single-play-p) last)
     #'shuffle-kill)
    ((eq mode 'wtag)
     #'shuffle-next)
    (t
     #'shuffle-all))))

;;;###autoload
(defun shuffle-wtag-play (prefix)
  (interactive
   (list (if current-prefix-arg
             (prefix-numeric-value current-prefix-arg)
           (shuffle-make-prefix-number))))
  (let (props)
    (run-hooks 'shuffle-all-startup-hook)
    (with-current-buffer (or (shuffle-get :init) (current-buffer))
      (unless (eq major-mode 'wtag-view-mode) (error "Only wtag view mode"))
      (when (or wtag-process (null (shuffle-get :init)))
        (shuffle-kill-silent)
        (shuffle-init-buff prefix))
      ;; (shuffle-auto-forward prefix)
      (shuffle-all-minor-mode 1)
      (setq props (shuffle-get :next))
      (shuffle-put :next (cdr props))
      (unless (car props) (shuffle-kill-silent) (error "No match file"))
      (shuffle-play (car props) (not (cdr props))
                    (called-interactively-p 'interactive)))))

(defun shuffle-play (file-or-prop &optional last interactive)
  (let* ((mode   (if (consp file-or-prop) 'wtag))
         (tags   (if (eq mode 'wtag)
                     file-or-prop
                   (mf-tag-read-plist file-or-prop nil t)))
         (file   (if (eq mode 'wtag) (plist-get tags 'filename) file-or-prop))
         (time   (car (plist-get tags '*time)))
         (pos    (plist-get tags '*pos))
         (app    (assoc-default file shuffle-players #'string-match))
         (gap    (shuffle-set-gap (car app)))
         (prog   (car app))
         (opt    (cdr app))
         (name   wtag-process-name)
         (now    (shuffle-now tags)))
    (unless app (shuffle-kill nil t) (error "Invalid file `%s'" file))
    (plist-put tags :file file)
    (shuffle-cancel-timer)
    (setq shuffle-title
          (propertize
           now
           'face 'shuffle-mode-line
           'help-echo now
           'local-map
           (make-mode-line-mouse-map 'mouse-1 'shuffle-all-minor-mode-menu-map)
           'mouse-face 'mode-line-highlight))
    (when (and shuffle-global-mode-string global-mode-string)
      (or (memq 'shuffle-title global-mode-string)
          (setq global-mode-string
                (append global-mode-string (list 'shuffle-title)))))
    (and pos
         (with-current-buffer (shuffle-get :init)
           (setq wtag-music-title shuffle-title)
           (setq-local shuffle-position pos)))
    (and interactive (shuffle-process-delete))
    (setq wtag-process
          (progn
            (message "%s" shuffle-title)
            (and pos (shuffle-shade pos (shuffle-get :init)))
            (apply #'start-process name name prog (append opt (list file)))))
    (set-process-filter wtag-process #'shuffle-filter)
    (shuffle-put :timer (run-with-timer
                         (+ time gap) nil #'shuffle-next-function mode last))
    (shuffle-put :total-time time)
    (shuffle-put :now now)
    (shuffle-put :progress time)
    (shuffle-put :progress-timer
                 (and shuffle-progress-interval
                      (not (stringp shuffle-all-minor-mode-lighter))
                      (shuffle-progress-time-timer)))
    nil))

(defun shuffle-wtag-view-buffer-p ()
  (eq major-mode 'wtag-view-mode))

(defvar shuffle-all-minor-mode-menu-map
  (let ((menu (make-sparse-keymap "Shuffle all Minor Mode")))
    (define-key menu [shuffle-process-buffer] '("Log" . shuffle-process-buffer))
    (define-key menu [dasshes1] '("--"))
    (define-key menu [shuffle-current-shade]
                '(menu-item "Current Shade" shuffle-current-shade
                            :enable (shuffle-wtag-view-buffer-p)))
    (define-key menu [shuffle-previous-shade]
                '(menu-item "Previous Shade" shuffle-previous-shade
                            :enable (shuffle-wtag-view-buffer-p)))
    (define-key menu [shuffle-next-shade]
                '(menu-item "Next Shade" shuffle-next-shade
                            :enable (shuffle-wtag-view-buffer-p)))
    (define-key menu [dasshes2] '("--"))
    (define-key menu [shuffle-stop] '("Stop" . shuffle-stop))
    (define-key menu [shuffle-kill] '("Kill" . shuffle-kill))
    (define-key menu [shuffle-next] '("Next" . shuffle-next))
    (define-key menu [shuffle-all] '("Play" . shuffle-all))
    menu))

(fset 'shuffle-all-minor-mode-menu-map shuffle-all-minor-mode-menu-map)

(defvar shuffle-all-minor-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c[k" #'shuffle-kill)
    (define-key map "\C-c[s" #'shuffle-stop)
    (define-key map "\C-c[l" #'shuffle-process-buffer)
    (define-key map "\C-c[n" #'shuffle-next)
    (define-key map "\C-c[p" #'shuffle-all)
    (define-key map "\C-c[\C-n" #'shuffle-next-shade)
    (define-key map "\C-c[\C-p" #'shuffle-previous-shade)
    (define-key map [?\C-c ?\[ ?\C-.]  #'shuffle-current-shade)
    (define-key map [menu-bar shuffle] (cons "Shuffle" shuffle-all-minor-mode-menu-map))
    map))

(defvar-keymap shuffle-all-minor-mode-repeat-map
  :repeat t
  "C-n" #'shuffle-next-shade
  "C-p" #'shuffle-previous-shade
  "C-." #'shuffle-current-shade)

(define-minor-mode shuffle-all-minor-mode
  "Shuffle All Minor Mode."
  :global t
  :group 'music-file
  :lighter shuffle-all-minor-mode-lighter
  (let ((inhibit-message t) message-log-max) (repeat-mode 1)))

(defvar shuffle-log-mode-font-lock
  '(("^\\(Comment:\\)\\( .+\\)$" (1 'link) (2 'shuffle-shade))
    ("\\([A-Z][a-z]+:\\)[ ]" 1 'link)
    ("^Process .+$" . font-lock-warning-face)))

(define-derived-mode shuffle-log-mode fundamental-mode "Shuffle-log"
  "Shuffle log mode."
  (setq-local font-lock-defaults (list shuffle-log-mode-font-lock))
  (define-key shuffle-log-mode-map "q" #'quit-window))

(provide 'shuffle-all)
;;

shuffle-all.org

shuffle-all.el

インストール

`wtag’ と `mf-tag-write’ がインストールされていれば `load-path’ の通ったディレクトリに置き `init.el’ 等で `require’ します.

(require 'shuffle-all)

つかいかた

wtag 上で曲再生(`P’)の機能を置き換えします.

`数値 P’ でそのトラックの再生. 数値が `0’ ならポイント以降のすべてのトラック. 数値が `負’ ならすべてのトラックをシャッフル再生します.

`C-c C-c’ 再生停止, `M-n’ 次の曲へ 等です.

通常ディレクトリでのつかいかた

引数なしで起動するとカレントディレクトリに含まれるサブディレクトリをすべてスキャンし 対象ファイルをシャッフル再生します.

M-x shuffle-all

前置き引数付だと対象ディレクトリをきいてきます

C-u M-x shuffle-all

Command: `shuffle-all-minor-mode’

`shuffle-all-minor-mode’ になるので menu が現われ、 以下のコマンドが使えるようになります. また再生中の wtag バッファにいる場合なら、 再生済みの曲の行へ移動するコマンドもいくつか使えるようになります.

スペース節約のためモードインジケータにはモード名を出しませんが、 その代りモードラインに出る曲タイトルをクリックするとメニューが使えるようになっています.

C-c [ k	プロセスをキル
C-c [ n	次の曲を再生
C-c [ s	停止
C-c [ p	s で停止した場合次から, k でなら最初から再生
C-c [ l	ログ表示

カスタマイズ変数

User Option: `shuffle-directory’ デフォルト対象ディレクトリ

ここで指定したディレクトリから `shuffle-music-file’ を `shuffle-players’ で再生します. デフォルトは `nil’ で カレントディレクトリになります.

User Option: `shuffle-music-file’ 集めるファイル名のパターン

デフォルトでは `.mp3’ が設定されています.

User Option: `shuffle-ignore-regexp’ 除外したいディレクトリ名を正規表現で指定.

デフォルトは `nil’ で何も対象になっていません.

User Option: `shuffle-players’ 再生アプリ

デフォルトは “.mp3 なら mpg123(PATH が通っている前提) を使う” というセットアップになっています.

設定の書式はファイルパターンとアプリのリストを集めたリストで以下のようになります.

(("ファイル名正規表現" "再生アプリ" "オプション" ...) ...)
    

`.flac’ や `.m4a’ なら `wmp’ で再生などと追加するには以下のようになります. 正規表現の大文字小文字の区別はされません[fn::区別したい場合 `case-fold-search’ を `nil’ にしてください].

(setq shuffle-playersshuffle-players
      '(("\\.mp3\\'" "mpg123")
        ("\\.\\(flac\\|m4a\\)\\'" "wmplayer" "/play" "/close"))
    

User Option: `shuffle-gap’ 再生時間のマージン

(元の音源の)トラックギャップの無い箇所の次の再生タイミングの調整に使います. デフォルトでは mpg123 のとき演奏時間に 0.25 秒追加し 次のトラックの再生開始が 0.25秒うしろにずれこみます.

(("mpg123" . 0.25)) ; デフォルト
    

;; 例1. 効果なし.
(setq shuffle-gap nil)

;; 例2. 一様に 0.3秒のマージン.
(setq shuffle-gap 0.3)

;; 例3. mpg123 なら 0.3秒、wmplayer なら 0.1秒 その他なら効果なし.
(setq shuffle-gap '(("mpg123" . 0.3) ("wmplayer" . 0.1)))
    

User Option: `shuffle-sleep-timer-time’ オフタイマーの秒指定

ここで指定した時間が来るとまだ再生リストがあっても再生プロセスを kill、 つまり再生を停止します.

(setq shuffle-sleep-timer-time "120min") 
    

数値で秒数を指定するか上記のような時間を現す文字列で指定します.

z.CHANGES

shuffle-all.el 3.1

lexical-binding 対応.

shuffle-all.el 2.30

new: 演奏経過時間の割合をモードラインにパーセント表示.

此の上にマウスを置くと再生中のトラックのタイトルがバルーン表示され 右クリックすると shuffle-all-minor-mode-menu が現れる.

カスタム変数 `shuffle-progress-interval’ で進捗割合の更新間隔秒数を指定(デフォルト 5). 負荷軽減目的でデフォルトでは同時にモードラインの更新はしないのですぐには反映されないが カスタム変数 `shuffle-progress-timer-mode-line-update’ が non-nil なら モードラインも一緒に更新する.

カスタム変数 `shuffle-all-minor-mode-lighter-label’ 進捗表示のプレフィクス文字列でデフォルトは “▶”.

カスタム変数 `shuffle-global-mode-string’ non-nil なら mode-line 右端グローバルエリアに `shuffle-title’ を表示する(従来互換).

fix: カレントバッファ(wtag-view-mode buffer)にいないと Single play mode が効かないバグを修正.

fix: `shuffle-shade’ face のエラーが出てしまうのを回避.

change: `shuffle-all-minor-mode’

repeat-mode のメッセをメッセージログにも残さないようにする.

change: ソースヘッダ部分の Installation: の説明変更.

`wtag-view-mode-hook’ でセットすると Progress が出ないケースが在るので 単純に `require’ するよう設定例を変更.

shuffle-all.el 2.21

change: 次の曲が自動再生されるときプロセスを削除しないようにした.

トラック終了で故意に停止しないでも フィニッシュすればプロセスは自動消滅するのに任せるようにした. これにより mpg123 などで mp3 を再生するとき トラックを跨いでいるような曲と曲の間にノイズが乗らなくなった.

併わせて再生時間にマージンを設定するカスタム変数 `shuffle-gap’ を追加. プロセス削除を無くした事と併わせこの変数を適宜セットすることで 擬似的なギャップレス再生になる.

デフォルトでは mpg123 のとき演奏時間に 0.25 秒追加する. 次のトラックの再生開始が 0.25秒後にずれこみ ものにもよるが、曲間の無い箇所のトラックがいい感じにつながって再生される. 其々の環境により適宜値を調整してください.

;; 例1. 効果なし. (setq shuffle-gap nil)

;; 例2. 0.3秒のマージン. (setq shuffle-gap 0.3)

;; 例3. mpg123 なら 0.3秒のマージン、その他なら効果なし. CAR には正規表現を指定します. (setq shuffle-gap ‘((“mpg123” . 0.3)))

;; 例4. mpg123 なら 0.3秒 wmplayer なら 0.1秒 その他なら効果なし. (setq shuffle-gap ‘((“mpg123” . 0.3) (“wmplayer” . 0.1)))

add: `shuffle-log-mode-font-lock’ プロセスメッセージも着色.

new: `hl-line-mode’ に対応.

shuffle 再生等で移動するポイントが追従.