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

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

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 0e3b0f26f12e256e65737e9b5beae838077884ea..dca2ca488ed84ef7ab3fc20759363b9835242fed 100644 (file)
--- 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"))))))))
 \f
 (defun dired-mark-confirm (op-symbol arg)