dired で tar.gz 圧縮 その2

Emacs

前のエントリで, plus さんに添削を頂いた.
ありがとうございます.

追記

エントリその3を作成.(20070211)
とりあえず暇だったし何となく始めたブログ - dired で tar.gz 圧縮 その3



これがそのコード.
はてなのコメント欄では, 二重引用符や \ が全角に変更されてしまうので, 直してここに転載しました.

(defun dired-do-tar-cvzf (output-filename)
  "マークしたファイルを tar cvzf でまとめて圧縮する."
  (interactive "FOUTPUT FILENAME: ")
  (or (when (string= "" output-filename)
        ;; 出力ファイル名が入力されていなかったらエラーとする.
        (message "ERROR: Output filename is empty."))
      (when (file-exists-p
             (setq output-filename
                   (replace-regexp-in-string "\\(\\.t\\(ar\\.\\)?gz\\)?$" ".tar.gz" output-filename)))
        ;; 出力ファイル名と同じ名前のファイルが, 既にあった場合, 上書きするか問い合わせる.
        (not (y-or-n-p (concat "file " output-filename " exists. overwrite the file ?"))))
      ;; 実際に圧縮をする.
      (dired-do-shell-command (concat "tar cvzf " output-filename " *") nil (dired-get-marked-files t))))

追記

ちょっとだけ改造.

  • (interactive "F")だと, ファイル名をパスごと取ってくるので, 出力ファイル名が空かどうかのチェックがされてなかったのを修正.
  • ファイル名の / をチェックするのは完全に廃止. 邪魔なだけだった.
  • 他のディレクトリにあるファイルも C-u あたりで前置引数を与えてやると指定できるようにした.
(defun dired-do-tar-cvzf (output-filename arg)
  "マークしたファイルを tar cvzf でまとめて圧縮する."
  (interactive "FOUTPUT FILENAME: \nP")
  (or (when (string= "" (file-name-nondirectory output-filename))
        ;; 出力ファイル名が入力されていなかったらエラーとする.
        (message "ERROR: Output filename is empty."))
      (when (file-exists-p
             (setq output-filename
                   (replace-regexp-in-string "\\(\\.t\\(ar\\.\\)?gz\\)?$" ".tar.gz" output-filename)))
        ;; 出力ファイル名と同じ名前のファイルが, 既にあった場合, 上書きするか問い合わせる.
        (not (y-or-n-p (concat "file " output-filename " exists. overwrite the file ?"))))
      ;; 実際に圧縮をする.
      (dired-do-shell-command (concat "tar cvzf " output-filename " *"
                                      (when arg
                                        (let ((add-file ""))
                                          (while (y-or-n-p "ADD FILE?")
                                            (setf add-file
                                                  (concat add-file " " (call-interactively
                                                                        (lambda (file)
                                                                          (interactive "f")
                                                                          file)))))
                                          add-file))) nil (dired-get-marked-files t))))

前置引数は, まあ, 無いよりはマシって程度かなあ.
指定の関係上しょうがないんだけど, /homeからのディレクトリが全部できてしまう.
例えば, 次のように圧縮したとする.

tar cvzf test.tar.gz file.txt /home/khiker/tmp/test.txt

これを解凍すると, カレントディレクトリ以下に, home/khiker/tmp/test.txt がディレクトリごと作成される.
まあ, これはしょうがない.
指定するときに, ..とか使って相対パス指定してやると多少マシになる.

さらに追記


plus さんにコメントをもらいました.
コードがすごく綺麗になってます.

(defun dired-do-tar-cvzf (output-filename arg)
 "マークしたファイルを tar cvzf でまとめて圧縮する."
 (interactive "FOUTPUT FILENAME: \nP")
 (or (when (string= "" (file-name-nondirectory output-filename))
       ;; 出力ファイル名が入力されていなかったらエラーとする.
       (message "ERROR: Output filename is empty."))
     (when (file-exists-p
            (setq output-filename
                  (replace-regexp-in-string "\\(\\.t\\(ar\\.\\)?gz\\)?$" ".tar.gz" output-filename)))
       ;; 出力ファイル名と同じ名前のファイルが, 既にあった場合, 上書きするか問い合わせる.
       (not (y-or-n-p (concat "file " output-filename " exists. overwrite the file ?"))))
     ;; 実際に圧縮をする.
     (let (add-file)
       (when arg
         (while (y-or-n-p "ADD FILE?")
           (add-to-list 'add-file (file-relative-name (read-file-name "" nil nil t)))))
       (dired-do-shell-command (concat "tar cvzf " output-filename " *") nil
                               (append (dired-get-marked-files t) add-file)))))

あとは何処がいじれるかなあ.
ちょっと難しい.
とりあえず, 現状の仕様では, カレントディレクトリに foo.tgz があって,
新たに出力ファイル名に foo を指定したときに, foo.tgz が消えて, foo.tar.gz になるっていうことがある.
でもこれはちゃんと上書きするか問い合わせてくれるし, ほとんど気にならないよねえ.
一応対処するには, コードの9行目のこの部分を,

                  (replace-regexp-in-string "\\(\\.t\\(ar\\.\\)?gz\\)?$" ".tar.gz" output-filename)))

これに変えてあげれば, foo.tgz があっても, foo.tar.gz が作られる(はず).

                   (cond
                    ((string-match "\\.t\\(ar\\.\\)?gz$" output-filename)
                     output-filename)
                    (t (concat output-filename ".tar.gz")))))

あんまりスマートな対処では, ないよなあ.
もっと上手い方法無いかなあ.