Integrate 7z and Tar With Emacs

| 分类 Emacs  | 标签 emacs  7z  dired 

In dired-mode of emacs, we can compress/decompress files quickly by pressing one key: Z. This key will trigger function dired-do-compress which in turn will call dired-compress to do real works.

I don't like the default implementation of dired-compress because:

  1. it can't process zip/rar/7z files.
  2. For files such as "tar.gz", "tar.bz2" it simply decompresses them into "tar" files

I made a advice to dired-compress to make it works as I expected. You can copy it to your dot emacs if you want.

  1: ;; Use 7z and tar to compress/decompress file if possible.
  2: (defvar yc/dired-compress-file-suffixes
  3:   (list
  4:    ;; Regexforsuffix-Programm-Args.
  5:    (list (rx "." (or "gz" "Z" "z" "dz" "bz2" "xz" "zip" "rar" "7z")) "7z" "x")
  6:    (list (rx "." (or "tar.gz" "tgz")) "tar" "xzvf")
  7:    (list (rx "." (or "tar.bz2" "tbz")) "tar" "xjvf")
  8:    (list (rx ".tar.xz") "tar" "xJvf"))
  9:   "nil")
 10: 
 11: (defun yc/dired-check-process (msg program &rest arguments)
 12:   (let (err-buffer err (dir default-directory))
 13:     (message "%s..." msg )
 14:     (save-excursion
 15:       ;; Get a clean buffer for error output:
 16:       (setq err-buffer (get-buffer-create " *dired-check-process output*"))
 17:       (set-buffer err-buffer)
 18:       (erase-buffer)
 19:       (setq default-directory dir   ; caller's default-directory
 20:             err (not (eq 0 (apply 'process-file program nil t nil
 21:                                   (if (string= "7z" program) "-y" " ") arguments))))
 22:       (if err
 23:           (progn
 24:             (if (listp arguments)
 25:                 (let ((args "") )
 26:                   (mapc (lambda (X)
 27:                             (setq args (concat args X " ")))
 28:                           arguments)
 29:                   (setq arguments args)))
 30:             (dired-log (concat program " " (prin1-to-string arguments) "\n"))
 31:             (dired-log err-buffer)
 32:             (or arguments program t))
 33:         (kill-buffer err-buffer)
 34:         (message "%s...done" msg)
 35:         nil))))
 36: 
 37: 
 38: (defun yc/dired-compress-file (file)
 39:   ;; Compress or uncompress FILE.
 40:   ;; Return the name of the compressed or uncompressed file.
 41:   ;; Return nil if no change in files.
 42:   (let ((handler (find-file-name-handler file 'dired-compress-file))
 43:         suffix newname
 44:         (suffixes yc/dired-compress-file-suffixes))
 45: 
 46:     ;; See if any suffix rule matches this file name.
 47:     (while suffixes
 48:       (let (case-fold-search)
 49:         (if (string-match (car (car suffixes)) file)
 50:             (setq suffix (car suffixes) suffixes nil))
 51:         (setq suffixes (cdr suffixes))))
 52:     ;; If so, compute desired new name.
 53:     (if suffix
 54:         (setq newname (substring file 0 (match-beginning 0))))
 55:     (cond (handler
 56:            (funcall handler 'dired-compress-file file))
 57:           ((file-symlink-p file)
 58:            nil)
 59:           ((and suffix (nth 1 suffix))
 60:            ;; We found an uncompression rule.
 61:            (if
 62:                (and (or (not (file-exists-p newname))
 63:                         (y-or-n-p
 64:                          (format "File %s already exists.  Replace it? "
 65:                                  newname)))
 66:                     (not (yc/dired-check-process (concat "Uncompressing " file)
 67:                                                  (nth 1 suffix) (nth 2 suffix) file)))
 68:                newname))
 69:           (t
 70:            ;;; We don't recognize the file as compressed, so compress it.
 71:            ;;; Try gzip; if we don't have that, use compress.
 72:            (condition-case nil
 73:                (let ((out-name (concat file ".7z")))
 74:                  (and (or (not (file-exists-p out-name))
 75:                           (y-or-n-p
 76:                            (format "File %s already exists.  Really compress? "
 77:                                    out-name)))
 78:                       (not (yc/dired-check-process (concat "Compressing " file)
 79:                                                    "7z" "a" out-name file))
 80:                       ;; Rename the compressed file to NEWNAME
 81:                       ;; if it hasn't got that name already.
 82:                       (if (and newname (not (equal newname out-name)))
 83:                           (progn
 84:                             (rename-file out-name newname t)
 85:                             newname)
 86:                         out-name))))))))
 87: 
 88: (defadvice dired-compress (around yc/dired-compress )
 89:   "If last action was not a yank, run `browse-kill-ring' instead."
 90:   (let* (buffer-read-only
 91:          (from-file (dired-get-filename))
 92:          (new-file (yc/dired-compress-file from-file)))
 93:     (if new-file
 94:         (let ((start (point)))
 95:           ;; Remove any preexisting entry for the name NEW-FILE.
 96:           (ignore-errors (dired-remove-entry new-file))
 97:           (goto-char start)
 98:           ;; Now replace the current line with an entry for NEW-FILE.
 99:           (dired-update-file-line new-file) nil)
100:       (dired-log (concat "Failed to compress" from-file))
101:       from-file))
102:   )
103: (ad-activate 'dired-compress)

You can find it at https://github.com/yangyingchao/tubo-env/blob/master/.emacs.d/rc/05-rc-misc.el line:129.


上一篇     下一篇