;;; emms-tag-editor.el --- Edit track tags. ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. ;; ;; Author: Ye Wenbin ;; Keywords: ;; 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")) "An alist to determine the format of various info tags.") (defvar emms-tag-editor-edit-buffer "*EMMS-TAGS*" "Name of the buffer used for editing tags.") (defvar emms-tag-editor-log-buffer "*EMMS-LOG*" "Name of emms-tag-editor's log buffer.") (defun emms-tag-editor-make-format (tags) "Make a format string based on TAGS." (concat "%m\n" (emms-propertize (format "%-16s = " "name") 'read-only t 'rear-nonsticky t 'face 'bold) "%f\n" (mapconcat (lambda (tag) (concat (emms-propertize (format "%-16s = " (symbol-name tag)) 'read-only t 'rear-nonsticky t 'face 'bold) "%" (cdr (assoc tag emms-tag-editor-tags)))) tags "\n") "\n\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 use when inserting 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 specifications in `emms-tag-editor-tags', and use `emms-tag-editor-make-format' to create a new format string. The CDR part also can be a function, which accepts one parameter, the track, and returns a string to insert in `emms-tag-editor-edit-buffer'.") (defvar emms-tag-editor-get-format-function 'emms-tag-editor-get-format "Determines which function to call to get the format string, which is used for inserting 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 for which a tag has been modified should set a property 'tag-modified to t. If the track name has been changed, the function should set a new property 'newname instead of setting 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)) "An alist used when committing changes to tags in files. If the external program sets tags by command line options one-by-one such as mp3info, then the list should like: (EXTENSION PROGRAM COMMAND_LINE_OPTIONS) Otherwise, a function that accepts a single 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) "Commit changes to an OGG file according to TRACK." (let (args val) (mapc (lambda (tag) (let ((info-tag (intern (concat "info-" tag)))) (when (> (length (setq val (emms-track-get track info-tag))) 0) (setq args (append (list "-t" (concat tag "=" val)) args))))) '("artist" "title" "album" "tracknumber" "date" "genre" "note")) (when args (apply #'call-process "vorbiscomment" nil (get-buffer-create emms-tag-editor-log-buffer) nil "-w" (append args (list (emms-track-name track))))))) (defun emms-tag-editor-tag-file (track program tags) "Change TAGS in FILE, using PROGRAM. Valid tags are given by `emms-tag-editor-tagfile-functions'." (let (args val) (mapc (lambda (tag) (setq val (emms-track-get track (car tag))) (if (and val (stringp val)) (setq args (append (list (concat "-" (cdr tag)) val) args)))) tags) (apply 'call-process program nil (get-buffer-create emms-tag-editor-log-buffer) nil (nconc args (list filename))))) (defun emms-tag-editor-get-format (track) "Get the format string to use for committing changes to 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) "Return a string representing the info tags contained in TRACK. This string is suitable for inserting into the tags buffer." (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) "Return a copy of the track at POS. Defaults to point if POS is nil." (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) "Erase the buffer BUF, and ensure that it exists." (let ((inhibit-read-only t)) (save-excursion (set-buffer (get-buffer-create buf)) (erase-buffer)))) (defsubst emms-tag-editor-insert-track (track) "Insert TRACK, if it is specified." (and track (insert (emms-tag-editor-format-track track)))) (defsubst emms-tag-editor-display-log-buffer-maybe () "Display the log buffer if it has any contents." (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) "Insert TRACKS into the tag editor buffer." (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) "Edit the track at point, or 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 () "Edit all tracks marked in the current buffer." (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 either the track at point or all 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-x\C-s" 'emms-tag-editor-submit) (define-key map "\C-c\C-r" 'emms-tag-editor-set-all) (define-key map "\C-c\C-a" 'emms-tag-editor-replace-in-tag) (define-key map "\C-c\C-t" 'emms-tag-editor-transpose-tag) map) "Keymap for `emms-tag-editor-mode'.") (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-set-all (tag value) "Set TAG to VALUE in all tracks. If transient-mark-mode is turned on, you can apply the command to a selected region. If `transient-mark-mode' is on and the mark is active, the changes will only take effect on the tracks in the region." (interactive (list (completing-read "Set tag: " emms-tag-editor-tags nil t) (read-from-minibuffer "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 tag)) nil t) (skip-chars-forward " \t=") (delete-region (point) (line-end-position)) (insert value))))) (defun emms-tag-editor-replace-in-tag (tag from to) "Query and replace text in selected TAG. For example, if the info-title tag is selected, then only perform replacement in title tags. If `transient-mark-mode' is on and the mark is active, the changes will only take effect on the tracks in the region." (interactive (cons (completing-read "Replace in tag: " emms-tag-editor-tags nil t) (let ((common (query-replace-read-args (if (and transient-mark-mode mark-active) "Query replace regexp in region" "Query replace regexp") t))) (butlast common)))) (let ((overlay (make-overlay (point-min) (1+ (point-min))))) (overlay-put overlay 'face 'match) (unwind-protect (save-excursion (save-restriction (when (and mark-active transient-mark-mode) (narrow-to-region (region-beginning) (region-end)) (deactivate-mark)) (setq tag (concat (regexp-quote tag) "[ \t]+=[ \t]+")) (goto-char (point-min)) (map-y-or-n-p (lambda (match) (move-overlay overlay (match-beginning 0) (match-end 0)) (format "Replace %s to %s" match to)) (lambda (match) (delete-region (- (point) (length match)) (point)) (insert to)) (lambda () (if (and (save-excursion (re-search-backward tag (line-beginning-position) t)) (re-search-forward from (line-end-position) t)) (match-string 0) (let (found) (while (and (not found) (re-search-forward tag nil t)) (if (re-search-forward from (line-end-position) t) (setq found t))) (and found (match-string 0)))))))) (delete-overlay overlay)))) (defun emms-tag-editor-transpose-tag (tag1 tag2) "Transpose value of TAG1 and TAG2. If `transient-mark-mode' is on and the mark is active, the changes will only take effect on the tracks in the region." (interactive (let* ((tag1 (intern (completing-read "Tag 1: " emms-tag-editor-tags nil t))) (tag2 (intern (completing-read "Tag 2: " (assq-delete-all tag1 (copy-sequence emms-tag-editor-tags)) nil t)))) (list tag1 tag2))) (save-excursion (save-restriction (if (and mark-active transient-mark-mode) (narrow-to-region (region-beginning) (region-end))) (let* ((emms-playlist-buffer-p t) (tracks (emms-playlist-tracks-in-region (point-min) (point-max))) (inhibit-read-only t) temp) (erase-buffer) (dolist (track tracks) (setq temp (emms-track-get track tag1)) (emms-track-set track tag1 (emms-track-get track tag2)) (emms-track-set track tag2 temp) (emms-tag-editor-insert-track track)))))) (defun emms-tag-editor-next-field (arg) "Move to the next tag field." (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) "Move to the previous tag field." (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 () "Move to the previous 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 () "Move to the 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 prefix argument, bury the 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 "No tags were modified") (emms-tag-editor-erase-buffer emms-tag-editor-log-buffer) (message "Setting 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 (when (boundp 'emms-cache-modified-function) (funcall emms-cache-modified-function) (funcall emms-cache-set-function 'file filename 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 "Changing 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 changed some track names; sync the cache? ")) (and (fboundp 'emms-cache-sync) ; silence byte-compiler (emms-cache-sync))) (unless (emms-tag-editor-display-log-buffer-maybe) (message "Setting tags...done")))) (if arg (bury-buffer))) (defun emms-tag-editor-submit-and-exit () "Submit changes to track information and exit the tag editor." (interactive) (emms-tag-editor-submit t)) (defun emms-tag-editor-default-parser () "Default function used to parse tags in `emms-tag-editor-edit-buffer'." (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 (let ((old (emms-track-get track key))) (if old (not (string= val old)) (string< "" val)))) (if (eq key 'name) (emms-track-set track 'newname val) (emms-track-set track key val)) (emms-track-set track 'tag-modified t)))) (let ((end-point (next-single-property-change (point) 'emms-track))) (if (and end-point (save-excursion (goto-char end-point) (bolp))) (setq next end-point) (progn (setq next nil end-point (point-max)))) (split-string (buffer-substring (point) end-point) "\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