From: Oleh Krehel Date: Wed, 21 Oct 2015 14:39:36 +0000 (+0200) Subject: Add dired-do-compress-to command bound to "c" X-Git-Tag: emacs-25.0.90~1072 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f6ece2420c3dc6f3dde06c7f8722f5b0b7e1ef4a;p=emacs.git Add dired-do-compress-to command bound to "c" * lisp/dired-aux.el (dired-shell-command): Use the caller's `default-directory', return the result of `process-file'. (dired-compress-file-suffixes): Add comment on why "tar -zxf" isn't used by default. (dired-compress-files-alist): New defvar. (dired-do-compress-to): New command. * lisp/dired.el (dired-mode-map): Bind `dired-do-compress-to' to "c". (dired-do-compress-to): Add an autoload entry. * etc/NEWS: Add two entries. --- diff --git a/etc/NEWS b/etc/NEWS index ef90268c5d2..0cb814b7eea 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -275,6 +275,12 @@ header. ** `tabulated-list-print' takes a second optional argument, update, which specifies an alternative printing method which is faster when few or no entries have changed. +** The command `dired-do-compress' bound to `Z' now can compress +directories and decompress zip files. +** New command `dired-do-compress-to' bound to `c' can be used to compress +many marked files into a single named archive. The compression +command is determined from the new `dired-compress-files-alist' +variable. * Editing Changes in Emacs 25.1 diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 98a974a8223..5cece27948f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -788,19 +788,23 @@ Else returns nil for success." (defun dired-shell-command (cmd) "Run CMD, and check for output. -On error, pop up the log buffer." - (let ((out-buffer " *dired-check-process output*")) +On error, pop up the log buffer. +Return the result of `process-file' - zero for success." + (let ((out-buffer " *dired-check-process output*") + (dir default-directory)) (with-current-buffer (get-buffer-create out-buffer) (erase-buffer) - (let ((res (process-file - shell-file-name - nil - t - nil - shell-command-switch - cmd))) + (let* ((default-directory dir) + (res (process-file + shell-file-name + nil + t + nil + shell-command-switch + cmd))) (unless (zerop res) - (pop-to-buffer out-buffer)))))) + (pop-to-buffer out-buffer)) + res)))) ;; Commands that delete or redisplay part of the dired buffer. @@ -880,7 +884,11 @@ command with a prefix argument (the value does not matter)." from-file))) (defvar dired-compress-file-suffixes - '(("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xv") + '( + ;; "tar -zxf" isn't used because it's not available the on + ;; Solaris10 version of tar. Solaris10 becomes obsolete in 2021. + ;; Same thing on AIX 7.1. + ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xv") ("\\.gz\\'" "" "gunzip") ("\\.tgz\\'" ".tar" "gunzip") ("\\.Z\\'" "" "uncompress") @@ -911,6 +919,52 @@ output file. Otherwise, the rule is a compression rule, and compression is done with gzip. ARGS are command switches passed to PROGRAM.") +(defvar dired-compress-files-alist + '(("\\.tar\\.gz\\'" . "tar -c %i | gzip -c9 > %o") + ("\\.zip\\'" . "zip %o -r --filesync %i")) + "Control the compression shell command for `dired-do-compress-to'. + +Each element is (REGEXP . CMD), where REGEXP is the name of the +archive to which you want to compress, and CMD the the +corresponding command. + +Within CMD, %i denotes the input file(s), and %o denotes the +output file. %i path(s) are relative, while %o is absolute.") + +;;;###autoload +(defun dired-do-compress-to () + "Compress selected files and directories to an archive. +You are prompted for the archive name. +The archiving command is chosen based on the archive name extension and +`dired-compress-files-alist'." + (interactive) + (let* ((in-files (dired-get-marked-files)) + (out-file (read-file-name "Compress to: ")) + (rule (cl-find-if + (lambda (x) + (string-match (car x) out-file)) + dired-compress-files-alist))) + (cond ((not rule) + (error + "No compression rule found for %s, see `dired-compress-files-alist'" + out-file)) + ((and (file-exists-p out-file) + (not (y-or-n-p + (format "%s exists, overwrite?" + (abbreviate-file-name out-file))))) + (message "Compression aborted")) + (t + (when (zerop + (dired-shell-command + (replace-regexp-in-string + "%o" out-file + (replace-regexp-in-string + "%i" (mapconcat #'file-name-nondirectory in-files " ") + (cdr rule))))) + (message "Compressed %d file(s) to %s" + (length in-files) + (file-name-nondirectory out-file))))))) + ;;;###autoload (defun dired-compress-file (file) "Compress or uncompress FILE. diff --git a/lisp/dired.el b/lisp/dired.el index e8791f8b320..bc0139f84e5 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1466,6 +1466,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "T" 'dired-do-touch) (define-key map "X" 'dired-do-shell-command) (define-key map "Z" 'dired-do-compress) + (define-key map "c" 'dired-do-compress-to) (define-key map "!" 'dired-do-shell-command) (define-key map "&" 'dired-do-async-shell-command) ;; Comparison commands @@ -3896,7 +3897,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "dired-aux" "dired-aux.el" "c4ed2cda4c70d4b38ab52ad03fa9dfda") +;;;### (autoloads nil "dired-aux" "dired-aux.el" "b946c1770b736ddc39eeef00c39425e7") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -4088,6 +4089,14 @@ command with a prefix argument (the value does not matter). \(fn &optional ARG FMT)" t nil) +(autoload 'dired-do-compress-to "dired-aux" "\ +Compress selected files and directories to an archive. +You are prompted for the archive name. +The archiving command is chosen based on the archive name extension and +`dired-compress-files-alist'. + +\(fn)" t nil) + (autoload 'dired-compress-file "dired-aux" "\ Compress or uncompress FILE. Return the name of the compressed or uncompressed file.