path: root/emms-tag-editor.el

;;; emms-tag-editor.el --- Edit track tags.

;; Copyright 2006 Ye Wenbin
;;
;; Author: wenbinye@163.com
;; Keywords:
;; X-URL: not distributed yet

;; 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 2, or (at your option)
;; any later version.
;;
;; 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 this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'emms-tag-editor)

;;; Code:

(provide 'emms-tag-editor)
(eval-when-compile
  (require 'cl))
(require 'emms)
(require 'emms-info-mp3info)
(require 'emms-playlist-mode)
(require 'emms-mark)
(require 'format-spec)

(defvar emms-tag-editor-tags
  '((info-artist      . "a")
    (info-title       . "t")
    (info-album       . "l")
    (info-tracknumber . "n")
    (info-year        . "y")
    (info-genre       . "g")
    (info-date        . "d")
    (info-note        . "c"))
"A list to setup format.")

(defvar emms-tag-editor-edit-buffer "*EMMS-TAGS*"
  "Buffer name to edit tags")
(defvar emms-tag-editor-log-buffer "*EMMS-LOG*"
  "Buffer name of tag edit log")

(defun emms-tag-editor-make-format (tags)
  (format "%%m\n%-16s = %%f\n%s\n\n" "name"
          (mapconcat
           (lambda (tag)
             (concat (propertize (format "%-16s = " (symbol-name tag))
                                 'read-only t 'rear-nonsticky t 'face 'bold)
                     "%" (cdr (assoc tag emms-tag-editor-tags))))
           tags "\n")))

(defvar emms-tag-editor-formats
  (let* ((tags (mapcar 'car emms-tag-editor-tags))
         (default (emms-tag-editor-make-format (remove 'info-date tags))))
    `(("mp3" . ,default)
      ("ogg" . ,(emms-tag-editor-make-format (remove 'info-year tags)))
      ("default" . ,default)))
  "Format to insert the track. The CAR part is the extension of the
track name, and the CDR part is the format template. The format
specification is like:
 m     --     Track description
 f     --     Track name
 a     --     Track info-artist
 t     --     Track info-title
 l     --     Track info-album
 n     --     Track info-tracknumber
 y     --     Track info-year
 g     --     Track info-genre
 c     --     Track info-note

You can add new specification in `emms-tag-editor-tags' and use
`emms-tag-editor-make-format' to help create a new format.

The CDR part also can be a function, which accept one parameter, the
track, and should return a string to insert to `emms-tag-editor-edit-buffer'.
")

(defvar emms-tag-editor-get-format-function 'emms-tag-editor-get-format
  "Function to decide which format to use for format the track.")

(defvar emms-tag-editor-parse-function 'emms-tag-editor-default-parser
  "Function to parse tags in `emms-tag-editor-edit-buffer'. It should find
all modified tags, and return all the tracks. The tracks which tag has
been modified should set a property 'tag-modified to t, and if the
track name have been change, the function should set a new property
'newname instead set the 'name directly.

See also `emms-tag-editor-default-parser'.")

(defvar emms-tag-editor-tagfile-functions
  '(("mp3" "mp3info"
     ((info-artist      . "a")
      (info-title       . "t")
      (info-album       . "l")
      (info-tracknumber . "n")
      (info-year        . "y")
      (info-genre       . "g")
      (info-note        . "c")))
    ("ogg" . emms-tag-editor-tag-ogg))
  "A List for change tag in files. If the extern program set tag by
command line options one by one such as mp3info, the list should like:
 (EXTENSION PROGRAM COMMAND_LINE_OPTIONS)

Otherwise, a function that accept a parameter, the track, should be
given.

See also `emms-tag-editor-tag-file' and `emms-tag-editor-tag-ogg'.
")

(defun emms-tag-editor-tag-ogg (track)
  (call-process "vorbiscomment" nil nil nil
                "-w" "-t"
                (mapconcat
                 (lambda (tag)
                   (concat tag "="
                           (emms-track-get track (intern (concat "info-" tag)))))
                 '("artist" "title" "album" "tracknumber" "date" "genre" "note")
                 "\n\t")
                (emms-track-name track)))

(defun emms-tag-editor-tag-file (track program tags)
  "Change tag in FILE use PROGRAM. The TAGS is given in `emms-tag-editor-tagfile-functions'."
  (let (args val)
    (mapc (lambda (tag)
            (when (> (length (setq val (emms-track-get track (car tag)))) 0)
              (setq args (append args (list (concat "-" (cdr tag)) val)))))
          tags)
    (apply 'call-process program
           nil nil nil
           filename args)))

(defun emms-tag-editor-get-format (track)
  (let ((format
         (assoc (file-name-extension (emms-track-name track))
                emms-tag-editor-formats)))
    (if format
        (cdr format)
      (cdr (assoc "default" emms-tag-editor-formats)))))

(defun emms-tag-editor-format-track (track)
  (let ((format (funcall emms-tag-editor-get-format-function track)))
    (if (functionp format)
        (funcall format track)
      (format-spec
       format
       (apply 'format-spec-make
              ?m (emms-propertize (emms-track-force-description track)
                                  'face 'emms-playlist-track-face
                                  'emms-track (copy-sequence track))
              ?f (emms-track-name track)
              (apply 'append
                     (mapcar (lambda (tag)
                               (list (string-to-char (cdr tag))
                                     (or (emms-track-get track (car tag)) "")))
                             emms-tag-editor-tags)))))))

(defun emms-tag-editor-track-at (&optional pos)
  (let ((track (emms-playlist-track-at pos))
        newtrack)
    (when track
      (setq newtrack (copy-sequence track))
      (emms-track-set newtrack 'position (point-marker))
      (emms-track-set newtrack 'orig-track track)
      newtrack)))

(defsubst emms-tag-editor-erase-buffer (&optional buf)
  (let ((inhibit-read-only t))
    (save-excursion
      (set-buffer (get-buffer-create buf))
      (erase-buffer))))

(defsubst emms-tag-editor-insert-track (track)
  (and track
       (insert (emms-tag-editor-format-track track))))

(defsubst emms-tag-editor-display-log-buffer-maybe ()
  (if (> (buffer-size (get-buffer emms-tag-editor-log-buffer)) 0)
      (display-buffer emms-tag-editor-log-buffer)))

(defun emms-tag-editor-insert-tracks (tracks)
  (save-excursion
    (emms-tag-editor-erase-buffer emms-tag-editor-log-buffer)
    (emms-tag-editor-erase-buffer emms-tag-editor-edit-buffer)
    (set-buffer (get-buffer emms-tag-editor-edit-buffer))
    (mapc 'emms-tag-editor-insert-track tracks)
    (emms-tag-editor-mode)
    (pop-to-buffer (current-buffer))
    (goto-char (point-min))
    (emms-tag-editor-display-log-buffer-maybe)))

(defun emms-tag-editor-edit-track (track)
  (interactive (list (emms-tag-editor-track-at)))
  (if (null track)
      (message "No track at point!")
    (emms-tag-editor-insert-tracks (list track))))

(defun emms-tag-editor-edit-marked-tracks ()
  (interactive)
  (let ((tracks (emms-mark-mapcar-marked-track 'emms-tag-editor-track-at t)))
    (if (null tracks)
        (message "No track marked!")
      (emms-tag-editor-insert-tracks tracks))))

(defun emms-tag-editor-edit ()
  "Edit tags of track at point or marked tracks"
  (interactive)
  (if (emms-mark-has-markedp)
      (emms-tag-editor-edit-marked-tracks)
    (emms-tag-editor-edit-track (emms-tag-editor-track-at))))

(defvar emms-tag-editor-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [tab] 'emms-tag-editor-next-field)
    (define-key map [backtab] 'emms-tag-editor-prev-field)
    (define-key map "\C-c\C-n" 'emms-tag-editor-next-track)
    (define-key map "\C-c\C-p" 'emms-tag-editor-prev-track)
    (define-key map "\C-c\C-c" 'emms-tag-editor-submit-and-exit)
    (define-key map "\C-c\C-s" 'emms-tag-editor-submit)
    (define-key map "\C-c\C-r" 'emms-tag-editor-replace-all)
    map))
(define-key emms-playlist-mode-map "E" 'emms-tag-editor-edit)

(define-derived-mode emms-tag-editor-mode text-mode "Tag-Edit"
  "Major mode to edit track tags.
\\{emms-tag-editor-mode-map}")

(defun emms-tag-editor-replace-all (name value)
  "Replace all track's NAME to VALUE. If turn transient-mark-mode on,
you can apply the command to a selected region."
  (interactive
   (list (completing-read "Replace tag: "
                          emms-tag-editor-tags nil t)
         (read-from-minibuffer "Set tag to: ")))
  (save-excursion
    (save-restriction
      (if (and mark-active transient-mark-mode)
          (narrow-to-region (region-beginning) (region-end)))
      (goto-char (point-min))
      (while (re-search-forward (concat "^" (regexp-quote name)) nil t)
        (skip-chars-forward " \t=")
        (delete-region (point) (line-end-position))
        (insert value)))))

(defun emms-tag-editor-next-field (arg)
  (interactive "p")
  (if (> arg 0)
      (re-search-forward "\\s-*=[ \t]*" nil nil arg)
    (emms-tag-editor-prev-field (- arg))))

(defun emms-tag-editor-prev-field (arg)
  (interactive "p")
  (if (< arg 0)
      (emms-tag-editor-next-field (- arg))
    (skip-chars-backward " \t=")
    (re-search-backward "\\s-*=[ \t]*" nil nil arg)
    (skip-chars-forward " \t=")))

(defun emms-tag-editor-prev-track ()
  (interactive)
  (let ((prev (previous-single-property-change (point)
                                               'emms-track)))
    (when (not prev)
      (error "No previous track"))
    (when (not (get-text-property prev 'emms-track))
      (setq prev (or (previous-single-property-change prev 'emms-track)
                     (point-min))))
    (when (or (not prev)
              (not (get-text-property prev 'emms-track)))
      (error "No previous track"))
    (goto-char prev)))

(defun emms-tag-editor-next-track ()
  (interactive)
  (let ((next (next-single-property-change (point)
                                           'emms-track)))
    (when (not next)
      (error "No next track"))
    (when (not (get-text-property next 'emms-track))
      (setq next (next-single-property-change next 'emms-track)))
    (when (or (not next)
              (= next (point-max)))
      (error "No next track"))
    (goto-char next)))

(defun emms-tag-editor-submit (arg)
  "Make modified tags take affect. With prefiex argument, bury tag
edit buffer."
  (interactive "P")
  (let ((tracks (funcall emms-tag-editor-parse-function))
        filename func exit old pos val need-sync)
    (if (not (and tracks (y-or-n-p "Submit changes? ")))
        (message "Nothing have to do!")
      (emms-tag-editor-erase-buffer emms-tag-editor-log-buffer)
      (message "Wait while set tags...")
      (save-excursion
        (dolist (track tracks)
          (when (emms-track-get track 'tag-modified)
            (setq filename (emms-track-name track)
                  old (emms-track-get track 'orig-track))
            ;; rename local file
            (when (and (emms-track-get track 'newname)
                       (eq (emms-track-get track 'type) 'file)
                       (file-writable-p (emms-track-name track)))
              (setq filename (emms-track-get track 'newname))
              (rename-file (emms-track-name track) filename)
              (emms-track-set old 'name filename)
              ;; for re-enter this function
              (emms-track-set track 'newname nil)
              (emms-track-set track 'name filename)
              (setq need-sync t)
              ;; register to emms-cache-db
              (funcall emms-cache-modified-function)
              (funcall emms-cache-set-function filename 'file old))
            ;; set tags to original track
            (dolist (tag emms-tag-editor-tags)
              (when (setq val (emms-track-get track (car tag)))
                (emms-track-set old (car tag) val)))
            ;; use mp3info to change tag in mp3 file
            (when (and (eq (emms-track-get track 'type) 'file)
                       (file-writable-p (emms-track-name track))
                       (setq func (assoc (file-name-extension filename) emms-tag-editor-tagfile-functions)))
              (setq exit
                    (if (functionp (cdr func))
                        (funcall (cdr func) track)
                      (emms-tag-editor-tag-file track (cadr func) (nth 2 func))))
              (if (zerop exit)
                  (emms-track-get track 'info-mtime (butlast (current-time)))
                (emms-tag-editor-log "Change tags of %s failed with exit value %d" filename exit)))
            ;; update track in playlist
            (when (and (setq pos (emms-track-get track 'position))
                       (marker-position pos))
              (set-buffer (marker-buffer pos))
              (goto-char pos)
              (funcall emms-playlist-update-track-function))
            ;; clear modified tag
            (emms-track-set track 'tag-modified nil))))
      (if (and (featurep 'emms-cache)
               need-sync
               (y-or-n-p "You have change some track names, sync the cache? "))
          (and (fboundp 'emms-cache-sync) ; silence byte-compiler
               (emms-cache-sync)))
      (emms-tag-editor-display-log-buffer-maybe)
      (message "Set all mp3 tag done!")))
  (if arg (bury-buffer)))

(defun emms-tag-editor-submit-and-exit ()
  (interactive)
  (emms-tag-editor-submit t))

(defun emms-tag-editor-default-parser ()
  (let (next tracks track key val)
    (goto-char (point-min))
    (if (get-text-property (point) 'emms-track)
        (setq next (point))
      (setq next (next-single-property-change (point)
                                              'emms-track)))
    (when next
      (while
          (progn
            (goto-char next)
            (setq track (get-text-property (point) 'emms-track))
            (forward-line 1)
            (mapc (lambda (pair)
                    (when (string-match "\\s-*=\\s-*" pair)
                      (setq key (intern-soft (substring pair 0 (match-beginning 0)))
                            val (substring pair (match-end 0)))
                      (when (and key
                                 (> (length val) 0)
                                 (not (string= val (emms-track-get track key))))
                        (if (eq key 'name)
                            (emms-track-set track 'newname val)
                          (emms-track-set track key val))
                        (emms-track-set track 'tag-modified t))))
                  (split-string (buffer-substring (point)
                                                  (or
                                                   (setq next (next-single-property-change (point) 'emms-track))
                                                   (point-max)))
                                "\n"))
            (if (emms-track-get track 'tag-modified)
                (push track tracks))
            next))
      tracks)))

(defun emms-tag-editor-log (&rest args)
  (with-current-buffer (get-buffer-create emms-tag-editor-log-buffer)
    (goto-char (point-max))
    (insert (apply 'format args) "\n")))

;;; emms-tag-editor.el ends here