Make dired-do-compress work for *.zip files

* lisp/dired-aux.el (dired-check-process): Transform the top-level
  comment into a docstring.
(dired-shell-command): New command. This mirrors
`dired-check-process', but is more user-friendly for passing
arguments.
(dired-compress-file-suffixes): Allow to specify the command switches
along with input (%i) and output (%o) inside the PROGRAM part.
Add an entry for *.zip files, and update the entry for *.tar.gz files
to the new style. Update the docstring.
(dired-compress-file): When PROGRAM matches %i or %o, use the new
logic.
(dired-update-file-line): Avoid an error when at end of buffer.

Fixes Bug#21637

1 files changed, 60 insertions, 25 deletions

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index f1f9436e8fb..7469eb96364 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -762,12 +762,12 @@ can be produced by `dired-get-marked-files', for example."
 
 
 (defun dired-check-process (msg program &rest arguments)
-;  "Display MSG while running PROGRAM, and check for output.
-;Remaining arguments are strings passed as command arguments to PROGRAM.
-; On error, insert output
-; in a log buffer and return the offending ARGUMENTS or PROGRAM.
-; Caller can cons up a list of failed args.
-;Else returns nil for success."
+  "Display MSG while running PROGRAM, and check for output.
+Remaining arguments are strings passed as command arguments to PROGRAM.
+On error, insert output
+in a log buffer and return the offending ARGUMENTS or PROGRAM.
+Caller can cons up a list of failed args.
+Else returns nil for success."
   (let (err-buffer err (dir default-directory))
     (message "%s..." msg)
     (save-excursion
@@ -785,6 +785,23 @@ can be produced by `dired-get-marked-files', for example."
         (kill-buffer err-buffer)
         (message "%s...done" msg)
         nil))))
+
+(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*"))
+    (with-current-buffer (get-buffer-create out-buffer)
+      (erase-buffer)
+      (setq res
+            (process-file
+             shell-file-name
+             nil
+             t
+             nil
+             shell-command-switch
+             cmd)))
+    (unless (zerop res)
+      (pop-to-buffer out-buffer))))
 
 ;; Commands that delete or redisplay part of the dired buffer.
 
@@ -864,7 +881,7 @@ command with a prefix argument (the value does not matter)."
       from-file)))
 
 (defvar dired-compress-file-suffixes
-  '(("\\.tar\\.gz" "" "tar" "-zxvf")
+  '(("\\.tar\\.gz\\'" "" "tar -zxvf %i")
     ("\\.gz\\'" "" "gunzip")
     ("\\.tgz\\'" ".tar" "gunzip")
     ("\\.Z\\'" "" "uncompress")
@@ -875,16 +892,21 @@ command with a prefix argument (the value does not matter)."
     ("\\.tbz\\'" ".tar" "bunzip2")
     ("\\.bz2\\'" "" "bunzip2")
     ("\\.xz\\'" "" "unxz")
+    ("\\.zip\\'" "" "unzip -o -d %o %i")
     ;; This item controls naming for compression.
     ("\\.tar\\'" ".tgz" nil))
   "Control changes in file name suffixes for compression and uncompression.
 Each element specifies one transformation rule, and has the form:
-  (REGEXP NEW-SUFFIX PROGRAM &rest ARGS)
+  (REGEXP NEW-SUFFIX PROGRAM)
 The rule applies when the old file name matches REGEXP.
 The new file name is computed by deleting the part that matches REGEXP
  (as well as anything after that), then adding NEW-SUFFIX in its place.
 If PROGRAM is non-nil, the rule is an uncompression rule,
 and uncompression is done by running PROGRAM.
+
+Within PROGRAM, %i denotes the input file, and %o denotes the
+output file.
+
 Otherwise, the rule is a compression rule, and compression is done with gzip.
 ARGS are command switches passed to PROGRAM.")
 
@@ -895,7 +917,8 @@ Return the name of the compressed or uncompressed file.
 Return nil if no change in files."
   (let ((handler (find-file-name-handler file 'dired-compress-file))
         suffix newname
-        (suffixes dired-compress-file-suffixes))
+        (suffixes dired-compress-file-suffixes)
+        command)
     ;; See if any suffix rule matches this file name.
     (while suffixes
       (let (case-fold-search)
@@ -910,13 +933,22 @@ Return nil if no change in files."
            (funcall handler 'dired-compress-file file))
           ((file-symlink-p file)
            nil)
-          ((and suffix (nth 2 suffix))
-           ;; We found an uncompression rule.
-           (when (not (apply 'dired-check-process
-                             `(,(concat "Uncompressing " file)
-                               ,@(cddr suffix)
-                               ,file)))
-             newname))
+          ((and suffix (setq command (nth 2 suffix)))
+           (if (string-match "%[io]" command)
+               (prog1 (setq newname (file-name-as-directory newname))
+                 (dired-shell-command
+                  (replace-regexp-in-string
+                   "%o" newname
+                   (replace-regexp-in-string
+                    "%i" file
+                    command))))
+             ;; We found an uncompression rule.
+             (when (not
+                    (dired-check-process
+                     (concat "Uncompressing " file)
+                     command
+                     file))
+               newname)))
           (t
            ;; We don't recognize the file as compressed, so compress it.
            ;; Try gzip; if we don't have that, use compress.
@@ -931,8 +963,10 @@ Return nil if no change in files."
                       (not
                        (if (file-directory-p file)
                            (let ((default-directory (file-name-directory file)))
-                             (dired-check-process (concat "Compressing " file)
-                                                  "tar" "-czf" out-name (file-name-nondirectory file)))
+                             (dired-check-process
+                              (concat "Compressing " file)
+                              "tar" "-czf"
+                              out-name (file-name-nondirectory file)))
                          (dired-check-process (concat "Compressing " file)
                                               "gzip" "-f" file)))
                       (or (file-exists-p out-name)
@@ -1132,15 +1166,16 @@ See Info node `(emacs)Subdir switches' for more details."
   ;; here is faster than with dired-add-entry's optional arg).
   ;; Does not update other dired buffers.  Use dired-relist-entry for that.
   (let* ((opoint (line-beginning-position))
-         (char (char-after opoint))
-         (buffer-read-only))
+         (char (char-after opoint))
+         (buffer-read-only))
     (delete-region opoint (progn (forward-line 1) (point)))
     (if file
-        (progn
-          (dired-add-entry file nil t)
-          ;; Replace space by old marker without moving point.
-          ;; Faster than goto+insdel inside a save-excursion?
-          (subst-char-in-region opoint (1+ opoint) ?\040 char))))
+        (progn
+          (dired-add-entry file nil t)
+          ;; Replace space by old marker without moving point.
+          ;; Faster than goto+insdel inside a save-excursion?
+          (when char
+            (subst-char-in-region opoint (1+ opoint) ?\040 char)))))
   (dired-move-to-filename))
 
 ;;;###autoload