[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master f6ece24: Add dired-do-compress-to command bound to
From: |
Oleh Krehel |
Subject: |
[Emacs-diffs] master f6ece24: Add dired-do-compress-to command bound to "c" |
Date: |
Wed, 21 Oct 2015 14:54:50 +0000 |
branch: master
commit f6ece2420c3dc6f3dde06c7f8722f5b0b7e1ef4a
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>
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.
---
etc/NEWS | 6 ++++
lisp/dired-aux.el | 76 +++++++++++++++++++++++++++++++++++++++++++++-------
lisp/dired.el | 11 +++++++-
3 files changed, 81 insertions(+), 12 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index ef90268..0cb814b 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 98a974a..5cece27 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 e8791f8..bc0139f 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.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master f6ece24: Add dired-do-compress-to command bound to "c",
Oleh Krehel <=