(dired-compress-file-suffixes): New variable.

(dired-compress-file): Use that to control file naming.

1 files changed, 49 insertions, 21 deletions

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 0e3b0f26f12..dca2ca488ed 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -514,45 +514,73 @@ and use this command with a prefix argument (the value does not matter)."
       (dired-log (concat "Failed to compress" from-file))
       from-file)))
 
+(defvar dired-compress-file-suffixes
+  '(("\\.gz\\'" "" "gunzip")
+    ("\\.tgz\\'" ".tar" "gunzip")
+    ("\\.Z\\'" "" "uncompress")
+    ;; For .z, try gunzip.  It might be an old gzip file,
+    ;; or it might be from compact? pack? (which?) but gunzip handles both.
+    ("\\.z\\'" "" "gunzip")
+    ;; 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)
+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.
+Otherwise, the rule is a compression rule, and compression is done with gzip.")
+
 ;;;###autoload
 (defun dired-compress-file (file)
   ;; Compress or uncompress FILE.
   ;; 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)))
+  (let ((handler (find-file-name-handler file 'dired-compress-file))
+        suffix newname
+        (suffixes dired-compress-file-suffixes))
+    ;; See if any suffix rule matches this file name.
+    (while suffixes
+      (let (case-fold-search)
+        (if (string-match (car (car suffixes)) file)
+            (setq suffix (car suffixes) suffixes nil))
+        (setq suffixes (cdr suffixes))))
+    ;; If so, compute desired new name.
+    (if suffix  
+        (setq newname (concat (substring file 0 (match-beginning 0))
+                              (nth 1 suffix))))
     (cond (handler
            (funcall handler 'dired-compress-file file))
           ((file-symlink-p file)
            nil)
-          ((let (case-fold-search)
-             (string-match "\\.Z$" file))
-           (if (not (dired-check-process (concat "Uncompressing " file)
-                                         "uncompress" file))
-               (substring file 0 -2)))
-          ((let (case-fold-search)
-             (string-match "\\.gz$" file))
-           (if (not (dired-check-process (concat "Uncompressing " file)
-                                         "gunzip" file))
-               (substring file 0 -3)))
-          ;; For .z, try gunzip.  It might be an old gzip file,
-          ;; or it might be from compact? pack? (which?) but gunzip handles
-          ;; both.
-          ((let (case-fold-search)
-             (string-match "\\.z$" file))
+          ((and suffix (nth 2 suffix))
+           ;; We found an uncompression rule.
            (if (not (dired-check-process (concat "Uncompressing " file)
-                                         "gunzip" file))
-               (substring file 0 -2)))
+                                         (nth 2 suffix) file))
+               newname))
           (t
+           ;;; We don't recognize the file as compressed, so compress it.
            ;;; Try gzip; if we don't have that, use compress.
            (condition-case nil
                (if (not (dired-check-process (concat "Compressing " file)
                                              "gzip" "-f" file))
-                   (cond ((file-exists-p (concat file ".gz"))
-                          (concat file ".gz"))
-                         (t (concat file ".z"))))
+                   (let ((out-name
+                          (if (file-exists-p (concat file ".gz"))
+                              (concat file ".gz")
+                            (concat file ".z"))))
+                     ;; Rename the compressed file to NEWNAME
+                     ;; if it hasn't got that name already.
+                     (if (and newname (not (equal newname out-name)))
+                         (progn
+                           (rename-file out-name newname t)
+                           newname)
+                       out-name)))
              (file-error
               (if (not (dired-check-process (concat "Compressing " file)
                                             "compress" "-f" file))
+                  ;; Don't use NEWNAME with `compress'.
                   (concat file ".Z"))))))))
 
 (defun dired-mark-confirm (op-symbol arg)