dired で tar.gz 圧縮をする その4

Emacs

完成版と書いちゃったけど, まだまだ更新できる限りつづきます.



plus さんからメールをもらいました.
1つの関数で4つの状態を扱えるようになっています.

(defun dired-do-tar-create (output-filename arg)
 "マークしたファイルを tar + gzip(or bzip2) でまとめて圧縮する.
M-x dired-do-tar-create       : tar + gzip
C-u M-x dired-do-tar-create   : tar + gzip(ファイル追加あり)
- M-x dired-do-tar-create     : tar + bzip2
- C-u M-x dired-do-tar-create : tar + bzip2(ファイル追加あり)"
 (interactive "FOUTPUT FILENAME: \nP")
 (let ((opt (if (>= (prefix-numeric-value arg) 0)
                '("\\.t\\(ar\\.\\)?gz$" ".tar.gz" "z")
              '("\\.t\\(ar\\.bz2\\|bz\\)$" ".tar.bz2" "j"))))
   (or (when (string= "" (file-name-nondirectory output-filename))
         ;; 出力ファイル名が入力されていなかったらエラーとする.
         (message "ERROR: Output filename is empty."))
       (when (file-exists-p
              (setq output-filename
                    (concat output-filename (unless (string-match (car opt) output-filename) (nth 1 opt)))))
         ;; 出力ファイル名と同じ名前のファイルが, 既にあった場合, 上書きするか問い合わせる.
         (not (y-or-n-p (concat "file " output-filename " exists. overwrite the file ?"))))
       ;; 実際に圧縮をする.
       (let (add-file)
         (when (and current-prefix-arg (listp current-prefix-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 (format "tar cv%sf %s *" (nth 2 opt) output-filename) nil
                                 (append (dired-get-marked-files t) add-file))))))

21行目のこの処理が強引かもとのことで,
公開は任せるとのことでしたが, 公開してしまいました.

         (when (and current-prefix-arg (listp current-prefix-arg))

確かにこういう, マイナスの前置引数でも分岐をする場合, どういう風にやるのが上手いのでしょうね？


ついでに, この関数を受けて, 私も改造してみました.
はっきり言って微妙です.

(defun dired-do-compression-file-create (output-filename arg &optional regex-ext-cmd-list)
  "マークしたファイルを tar + gzip(or bzip2) でまとめて圧縮する.
M-x dired-do-tar-create       : tar + gzip
C-u M-x dired-do-tar-create   : tar + gzip(ファイル追加あり)"
  (interactive "FOUTPUT FILENAME: \nP")
  (let ((opt (if regex-ext-cmd-list
                 regex-ext-cmd-list
               '("\\.t\\(ar\\.\\)?gz$" ".tar.gz" "tar cvzf"))))
    (or (when (string= "" (file-name-nondirectory output-filename))
          ;; 出力ファイル名が入力されていなかったらエラーとする.
          (message "ERROR: Output filename is empty."))
        (when (file-exists-p
               (setq output-filename
                     (concat output-filename (unless (string-match (car opt) output-filename) (nth 1 opt)))))
          ;; 出力ファイル名と同じ名前のファイルが, 既にあった場合, 上書きするか問い合わせる.
          (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 (format "%s %s *" (nth 2 opt) output-filename) nil
                                  (append (dired-get-marked-files t) add-file))))))

(define-key dired-mode-map "\C-cz" (lambda (output-filename arg)
                                      (interactive "FOUTPUT FILENAME: \nP")
                                      (dired-do-compression-file-create output-filename arg '("\\.zip$" ".zip" "zip -r"))))
(define-key dired-mode-map "\C-cj" (lambda (output-filename arg)
                                      (interactive "FOUTPUT FILENAME: \nP")
                                      (dired-do-compression-file-create output-filename arg  '("\\.t\\(ar\\.bz2\\|bz\\)$" ".tar.bz2" "tar cjvf"))))

この関数では, &optional 引数と lambda を使うことにより, 他の圧縮形式も使えるようにしています.
ただ, 1つの関数で4つの状態を表すことはできなくなっています. 今まで通り2つです.
それに lambda 以下が長すぎるし, 任意の圧縮方式を M-x とやって呼出せるわけでもないですからねえ.

以前の記事