(jka-compr-info-file-magic-bytes): New function.

(jka-compr-compression-info-list): Add new elt to each vector.
(jka-compr-write-region): Don't compress the data if it is already compressed.

(jka-compr-really-do-compress): New variable.
(jka-compr-insert-file-contents): Set jka-compr-really-do-compress if visiting.
(jka-compr-write-region): Set jka-compr-really-do-compress
if visiting.  Test it when deciding to compress.

1 files changed, 124 insertions, 95 deletions

diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 234fb8375d8..a3fae5b05bc 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -126,32 +126,32 @@ for `jka-compr-compression-info-list')."
   ;;[regexp
   ;; compr-message  compr-prog  compr-args
   ;; uncomp-message uncomp-prog uncomp-args
-  ;; can-append auto-mode-flag]
+  ;; can-append auto-mode-flag strip-extension-flag file-magic-bytes]
   '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
      "compressing"    "compress"     ("-c")
      "uncompressing"  "uncompress"   ("-c")
-     nil t]
+     nil t "\037\235"]
      ;; Formerly, these had an additional arg "-c", but that fails with
      ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
      ;; "Version 0.9.0b, 9-Sept-98".
     ["\\.bz2\\'"
      "bzip2ing"        "bzip2"         nil
      "bunzip2ing"      "bzip2"         ("-d")
-     nil t]
+     nil t "BZh"]
     ["\\.tgz\\'"
      "zipping"        "gzip"         ("-c" "-q")
      "unzipping"      "gzip"         ("-c" "-q" "-d")
-     t nil]
+     t nil "\037\213"]
     ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'"
      "zipping"        "gzip"         ("-c" "-q")
      "unzipping"      "gzip"         ("-c" "-q" "-d")
-     t t])
+     t t "\037\213"])
 
   "List of vectors that describe available compression techniques.
 Each element, which describes a compression technique, is a vector of
 the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
 UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
-APPEND-FLAG EXTENSION], where:
+APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
 
    regexp                is a regexp that matches filenames that are
                          compressed with this format
@@ -173,9 +173,12 @@ APPEND-FLAG EXTENSION], where:
    append-flag           is non-nil if this compression technique can be
                          appended
 
-   auto-mode flag        non-nil means strip the regexp from file names
+   strip-extension-flag  non-nil means strip the regexp from file names
                          before attempting to set the mode.
 
+   file-magic-chars      is a string of characters that you would find
+			 at the beginning of a file compressed in this way.
+
 Because of the way `call-process' is defined, discarding the stderr output of
 a program adds the overhead of starting a shell each time the program is
 invoked."
@@ -204,6 +207,10 @@ invoked."
 (defvar jka-compr-file-name-handler-entry
   nil
   "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.")
+
+(defvar jka-compr-really-do-compress nil
+  "Non-nil in a buffer whose visited file was uncompressed on visiting it.")
+(put 'jka-compr-really-do-compress 'permanent-local t)
 
 ;;; Functions for accessing the return value of jka-compr-get-compression-info
 (defun jka-compr-info-regexp               (info)  (aref info 0))
@@ -215,6 +222,7 @@ invoked."
 (defun jka-compr-info-uncompress-args      (info)  (aref info 6))
 (defun jka-compr-info-can-append           (info)  (aref info 7))
 (defun jka-compr-info-strip-extension      (info)  (aref info 8))
+(defun jka-compr-info-file-magic-bytes     (info)  (aref info 9))
 
 
 (defun jka-compr-get-compression-info (filename)
@@ -366,96 +374,116 @@ There should be no more than seven characters after the final `/'."
 (defun jka-compr-write-region (start end file &optional append visit)
   (let* ((filename (expand-file-name file))
 	 (visit-file (if (stringp visit) (expand-file-name visit) filename))
-	 (info (jka-compr-get-compression-info visit-file)))
-      
-      (if info
-
-	  (let ((can-append (jka-compr-info-can-append info))
-		(compress-program (jka-compr-info-compress-program info))
-		(compress-message (jka-compr-info-compress-message info))
-		(uncompress-program (jka-compr-info-uncompress-program info))
-		(uncompress-message (jka-compr-info-uncompress-message info))
-		(compress-args (jka-compr-info-compress-args info))
-		(uncompress-args (jka-compr-info-uncompress-args info))
-		(base-name (file-name-nondirectory visit-file))
-		temp-file temp-buffer
-		;; we need to leave `last-coding-system-used' set to its
-		;; value after calling write-region the first time, so
-		;; that `basic-save-buffer' sees the right value.
-		(coding-system-used last-coding-system-used))
-
-	    (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
-	    (with-current-buffer temp-buffer
-	      (widen) (erase-buffer))
-
-	    (if (and append
-		     (not can-append)
-		     (file-exists-p filename))
-		
-		(let* ((local-copy (file-local-copy filename))
-		       (local-file (or local-copy filename)))
-		  
-		  (setq temp-file local-file))
-
-	      (setq temp-file (jka-compr-make-temp-name)))
-
-	    (and 
-	     compress-message
-	     (message "%s %s..." compress-message base-name))
-	    
-	    (jka-compr-run-real-handler 'write-region
-					(list start end temp-file t 'dont))
-	    ;; save value used by the real write-region
-	    (setq coding-system-used last-coding-system-used)
-
-	    ;; Here we must read the output of compress program as is
-	    ;; without any code conversion.
-	    (let ((coding-system-for-read 'no-conversion))
-	      (jka-compr-call-process compress-program
-				      (concat compress-message
-					      " " base-name)
-				      temp-file
-				      temp-buffer
-				      nil
-				      compress-args))
-
-	    (with-current-buffer temp-buffer
-              (let ((coding-system-for-write 'no-conversion))
-                (if (memq system-type '(ms-dos windows-nt))
-                    (setq buffer-file-type t) )
-                (jka-compr-run-real-handler 'write-region
-                                            (list (point-min) (point-max)
-                                                  filename
-                                                  (and append can-append) 'dont))
-                (erase-buffer)) )
-
-	    (jka-compr-delete-temp-file temp-file)
+	 (info (jka-compr-get-compression-info visit-file))
+	 (magic (and info (jka-compr-info-file-magic-bytes info))))
+
+    ;; If we uncompressed this file when visiting it,
+    ;; then recompress it when writing it
+    ;; even if the contents look compressed already.
+    (if (and jka-compr-really-do-compress
+	     (eq start 1)
+	     (eq end (1+ (buffer-size))))
+	(setq magic nil))
+
+    (if (and info
+	     ;; If the contents to be written out
+	     ;; are properly compressed already,
+	     ;; don't try to compress them over again.
+	     (not (and magic
+		       (equal (if (stringp start)
+				  (substring start 0 (min (length start)
+							  (length magic)))
+				(buffer-substring start
+						  (min end
+						       (+ start (length magic)))))
+			      magic))))
+	(let ((can-append (jka-compr-info-can-append info))
+	      (compress-program (jka-compr-info-compress-program info))
+	      (compress-message (jka-compr-info-compress-message info))
+	      (uncompress-program (jka-compr-info-uncompress-program info))
+	      (uncompress-message (jka-compr-info-uncompress-message info))
+	      (compress-args (jka-compr-info-compress-args info))
+	      (uncompress-args (jka-compr-info-uncompress-args info))
+	      (base-name (file-name-nondirectory visit-file))
+	      temp-file temp-buffer
+	      ;; we need to leave `last-coding-system-used' set to its
+	      ;; value after calling write-region the first time, so
+	      ;; that `basic-save-buffer' sees the right value.
+	      (coding-system-used last-coding-system-used))
+
+	  (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
+	  (with-current-buffer temp-buffer
+	    (widen) (erase-buffer))
+
+	  (if (and append
+		   (not can-append)
+		   (file-exists-p filename))
+
+	      (let* ((local-copy (file-local-copy filename))
+		     (local-file (or local-copy filename)))
+
+		(setq temp-file local-file))
+
+	    (setq temp-file (jka-compr-make-temp-name)))
+
+	  (and 
+	   compress-message
+	   (message "%s %s..." compress-message base-name))
+
+	  (jka-compr-run-real-handler 'write-region
+				      (list start end temp-file t 'dont))
+	  ;; save value used by the real write-region
+	  (setq coding-system-used last-coding-system-used)
+
+	  ;; Here we must read the output of compress program as is
+	  ;; without any code conversion.
+	  (let ((coding-system-for-read 'no-conversion))
+	    (jka-compr-call-process compress-program
+				    (concat compress-message
+					    " " base-name)
+				    temp-file
+				    temp-buffer
+				    nil
+				    compress-args))
+
+	  (with-current-buffer temp-buffer
+	    (let ((coding-system-for-write 'no-conversion))
+	      (if (memq system-type '(ms-dos windows-nt))
+		  (setq buffer-file-type t) )
+	      (jka-compr-run-real-handler 'write-region
+					  (list (point-min) (point-max)
+						filename
+						(and append can-append) 'dont))
+	      (erase-buffer)) )
+
+	  (jka-compr-delete-temp-file temp-file)
 
-	    (and
-	     compress-message
-	     (message "%s %s...done" compress-message base-name))
-
-	    (cond
-	     ((eq visit t)
-	      (setq buffer-file-name filename)
-	      (set-visited-file-modtime))
-	     ((stringp visit)
-	      (setq buffer-file-name visit)
-	      (let ((buffer-file-name filename))
-		(set-visited-file-modtime))))
-
-	    (and (or (eq visit t)
-		     (eq visit nil)
-		     (stringp visit))
-		 (message "Wrote %s" visit-file))
-
-	    ;; ensure `last-coding-system-used' has an appropriate value
-	    (setq last-coding-system-used coding-system-used)
-
-	    nil)
+	  (and
+	   compress-message
+	   (message "%s %s...done" compress-message base-name))
+
+	  (cond
+	   ((eq visit t)
+	    (setq buffer-file-name filename)
+	    (setq jka-compr-really-do-compress t)
+	    (set-visited-file-modtime))
+	   ((stringp visit)
+	    (setq buffer-file-name visit)
+	    (let ((buffer-file-name filename))
+	      (set-visited-file-modtime))))
+
+	  (and (or (eq visit t)
+		   (eq visit nil)
+		   (stringp visit))
+	       (message "Wrote %s" visit-file))
+
+	  ;; ensure `last-coding-system-used' has an appropriate value
+	  (setq last-coding-system-used coding-system-used)
+
+	  nil)
 	      
-	(jka-compr-run-real-handler 'write-region
-				    (list start end filename append visit)))))
+      (jka-compr-run-real-handler 'write-region
+				  (list start end filename append visit)))))
 
 
 (defun jka-compr-insert-file-contents (file &optional visit beg end replace)
@@ -562,6 +590,7 @@ There should be no more than seven characters after the final `/'."
 	   (progn
 	     (unlock-buffer)
 	     (setq buffer-file-name filename)
+	     (setq jka-compr-really-do-compress t)
 	     (set-visited-file-modtime)))
 	    
 	  (and