.emacs.el

;;; VLC プレイリストのための XML パーサー
;; (install-elisp-from-emacswiki "xml-parse.el")
;; CSV 形式で一時バッファに出力する
(defun vlc-xml2csv-tempbuffer (tmpbuf &rest tags)
  "Output temporary buffer from xml to csv."
  (when (eval-and-compile (require 'xml-parse nil t))
    (goto-char (point-min))
    (with-output-to-temp-buffer tmpbuf
      (dolist (tracklst (read-xml))
        (when (string= (xml-tag-name tracklst) "trackList")
          (dolist (track (xml-tag-children tracklst))
            (when (string=  (xml-tag-name track) "track")
              (dolist (tag tags)
                (princ (car (xml-tag-children (xml-tag-child track tag))))
                (if (string= tag (car (last tags)))
                    (princ "\n")
                  (princ ","))))))))))

;; CSV 形式でファイルに出力する
(defun vlc-xml2csv-file ()
  "Conversion from xml to csv for vlc."
  (interactive)
  (let* ((default "vlc.csv")
         (file (read-string "Filename: " default nil default))
         (tmp " *xspf")
         tmpbuf)
    (or
     (when (file-exists-p file)
       (not (y-or-n-p (concat "Overwrite `" file "'? "))))
     (if (or (not (file-exists-p file)) (file-writable-p file))
         (progn
           (vlc-xml2csv-tempbuffer tmp "creator" "title" "annotation" "location")
           (switch-to-buffer (get-buffer-create file))
           (erase-buffer)
           (insert-buffer-substring (get-buffer tmp))
           (goto-char (point-min))
           (while (search-forward "'" nil t)
             (replace-match ""))
           (goto-char (point-min))
           (delete-other-windows)
           (set-visited-file-name file)
           (save-buffer))
       (message "Can not write: %s" file))
     (message "Write file %s...done" file))))

;; location タグのディレクトリが実際に存在するかどうか調べる
(defun vlc-check-location ()
  "Check if directory of location tag exists."
  (interactive)
  (let* ((default "check-location")
         (file (read-string "Filename: " default nil default))
         (tmp " *xspf")
         string)
    (or
     (when (file-exists-p file)
       (not (y-or-n-p (concat "Overwrite `" file "'? "))))
     (if (or (not (file-exists-p file)) (file-writable-p file))
         (progn
           (vlc-xml2csv-tempbuffer tmp "location")
           (set-buffer (get-buffer-create file))
           (erase-buffer)
           (set-buffer tmp)
           (goto-char (point-min))
           (while (not (eobp))
             (setq string (buffer-substring (point-at-bol) (point-at-eol)))
             (with-current-buffer file
               (unless (file-exists-p (substring string 7))
                 (insert string)
                 (insert "\n")))
             (forward-line 1))
           (switch-to-buffer file)
           (delete-other-windows)
           (goto-char (point-min))
           (set-visited-file-name file)
           (save-buffer))
       (message "Can not write: %s" file))
     (message "Write file %s...done" file))))

;; ディレクトリが location タグに網羅されているかどうか調べる
(defun vlc-check-directory ()
  "Check if directories exist in location tag."
  (interactive)
  (let* ((default "check-directory")
         (file (read-string "Filename name: " default nil default))
         (dirs (read-string "Directory name: " nil nil nil))
         (tmp " *xspf")
         string)
    (or
     (when (file-exists-p file)
       (not (y-or-n-p (concat "Overwrite `" file "'? "))))
     (if (or (not (file-exists-p file)) (file-writable-p file))
         (progn
           (vlc-xml2csv-tempbuffer tmp "location")
           (set-buffer (get-buffer-create file))
           (erase-buffer)
           (set-buffer tmp)
           (dolist (dir (directory-files dirs t))
             (when (and (file-directory-p dir)
                        (not (member
                              (file-name-nondirectory dir) '("." ".."))))
               (goto-char (point-min))
               (unless
                   (catch 'found
                     (while (not (eobp))
                       (setq string
                             (buffer-substring (point-at-bol) (point-at-eol)))
                       (when (string= dir (substring string 7))
                         (throw 'found t))
                       (forward-line 1)) nil)
                 (with-current-buffer file
                   (insert dir)
                   (insert "\n")))))
           (switch-to-buffer file)
           (delete-other-windows)
           (goto-char (point-min))
           (set-visited-file-name file)
           (save-buffer))
       (message "Can not write: %s" file))
     (message "Write file %s...done" file))))