From: Oleh Krehel <ohwoeowho@gmail.com>
Date: Tue, 13 Oct 2015 12:07:10 +0000 (+0200)
Subject: Make dired-do-compress work for directories
X-Git-Tag: emacs-25.0.90~1141
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=787028839bd2a5887f8dcb53da801b6075d2e67e;p=emacs.git

Make dired-do-compress work for directories

* lisp/dired-aux.el (dired-compress-file): When FILE is a directory,
  instead of emitting an error, call "tar -czf FILE.tar.gz FILE".
Also convert the top comment into a docstring.
---

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index a67b11fb6a6..8e714c7d8a3 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -888,56 +888,63 @@ 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.
+  "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))
-	suffix newname
-	(suffixes dired-compress-file-suffixes))
+        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 (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))))
+        (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)
-	  ((and suffix (nth 2 suffix))
-	   ;; We found an uncompression rule.
-	   (if (not (dired-check-process (concat "Uncompressing " file)
-					 (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
-	       (let ((out-name (concat file ".gz")))
-		 (and (or (not (file-exists-p out-name))
-			  (y-or-n-p
-			   (format "File %s already exists.  Really compress? "
-				   out-name)))
-		      (not (dired-check-process (concat "Compressing " file)
-						"gzip" "-f" file))
-		      (or (file-exists-p out-name)
-			  (setq out-name (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"))))))))
+           (funcall handler 'dired-compress-file file))
+          ((file-symlink-p file)
+           nil)
+          ((and suffix (nth 2 suffix))
+           ;; We found an uncompression rule.
+           (if (not (dired-check-process (concat "Uncompressing " file)
+                                         (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
+               (let ((out-name (concat file (if (file-directory-p file)
+                                                ".tar.gz"
+                                              ".gz"))))
+                 (and (or (not (file-exists-p out-name))
+                          (y-or-n-p
+                           (format "File %s already exists.  Really compress? "
+                                   out-name)))
+                      (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)
+                                              "gzip" "-f" file)))
+                      (or (file-exists-p out-name)
+                          (setq out-name (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)
   ;; Request confirmation from the user that the operation described