(iswitchb-visit-buffer): Use `select-frame-set-input-focus'.

[gnu-emacs] / lisp / jka-compr.el

diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index caa07110818a7b29ffd4a1d97dc09348f5423c88..5c42a0af8be35cc5c7e39d0737009f05167c8a79 100644 (file)
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -1,6 +1,6 @@
 ;;; jka-compr.el --- reading/writing/loading compressed files
 
 ;;; jka-compr.el --- reading/writing/loading compressed files
 

-;; Copyright (C) 1993, 1994, 1995, 1997  Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000  Free Software Foundation, Inc.

 
 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
 ;; Maintainer: FSF
 
 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
 ;; Maintainer: FSF


@@ -23,7 +23,7 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 

-;;; Commentary: 
+;;; Commentary:

 
 ;; This package implements low-level support for reading, writing,
 ;; and loading compressed files.  It hooks into the low-level file
 
 ;; This package implements low-level support for reading, writing,
 ;; and loading compressed files.  It hooks into the low-level file


@@ -36,10 +36,10 @@
 
 ;; INSTRUCTIONS:
 ;;
 
 ;; INSTRUCTIONS:
 ;;

-;; To use jka-compr, simply load this package, and edit as usual.
-;; Its operation should be transparent to the user (except for
-;; messages appearing when a file is being compressed or
-;; uncompressed).
+;; To use jka-compr, invoke the command `auto-compression-mode' (which
+;; see), or customize the variable of the same name.  Its operation
+;; should be transparent to the user (except for messages appearing when
+;; a file is being compressed or uncompressed).

 ;;
 ;; The variable, jka-compr-compression-info-list can be used to
 ;; customize jka-compr to work with other compression programs.
 ;;
 ;; The variable, jka-compr-compression-info-list can be used to
 ;; customize jka-compr to work with other compression programs.


@@ -126,32 +126,32 @@ for `jka-compr-compression-info-list')."
   ;;[regexp
   ;; compr-message  compr-prog  compr-args
   ;; uncomp-message uncomp-prog uncomp-args
   ;;[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")
   '(["\\.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")
      ;; 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")
     ["\\.tgz\\'"
      "zipping"        "gzip"         ("-c" "-q")
      "unzipping"      "gzip"         ("-c" "-q" "-d")

-     t nil]
-    ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'"
+     t nil "\037\213"]
+    ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'"

      "zipping"        "gzip"         ("-c" "-q")
      "unzipping"      "gzip"         ("-c" "-q" "-d")
      "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
 
   "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
 
    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
 
    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.
 
                          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."
 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."


@@ -191,12 +194,20 @@ invoked."
                         (string :tag "Uncompress Program")
                         (repeat :tag "Uncompress Arguments" string)
                         (boolean :tag "Append")
                         (string :tag "Uncompress Program")
                         (repeat :tag "Uncompress Arguments" string)
                         (boolean :tag "Append")

-                        (boolean :tag "Auto Mode")))
+                        (boolean :tag "Strip Extension")
+                        (string :tag "Magic Bytes")))

   :group 'jka-compr)
 
   :group 'jka-compr)
 

-(defvar jka-compr-mode-alist-additions
+(defcustom jka-compr-mode-alist-additions

   (list (cons "\\.tgz\\'" 'tar-mode))
   (list (cons "\\.tgz\\'" 'tar-mode))

-  "A list of pairs to add to `auto-mode-alist' when jka-compr is installed.")
+  "A list of pairs to add to `auto-mode-alist' when jka-compr is installed."
+  :type '(repeat (cons string symbol))
+  :group 'jka-compr)
+
+(defcustom jka-compr-load-suffixes '(".gz")
+  "List of suffixes to try when loading files."
+  :type '(repeat string)
+  :group 'jka-compr)

 
 ;; List of all the elements we actually added to file-coding-system-alist.
 (defvar jka-compr-added-to-file-coding-system-alist nil)
 
 ;; List of all the elements we actually added to file-coding-system-alist.
 (defvar jka-compr-added-to-file-coding-system-alist nil)


@@ -204,6 +215,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-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)

 \f
 ;;; Functions for accessing the return value of jka-compr-get-compression-info
 (defun jka-compr-info-regexp               (info)  (aref info 0))
 \f
 ;;; Functions for accessing the return value of jka-compr-get-compression-info
 (defun jka-compr-info-regexp               (info)  (aref info 0))


@@ -215,6 +230,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-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)
 
 
 (defun jka-compr-get-compression-info (filename)


@@ -256,8 +272,10 @@ based on the filename itself and `jka-compr-compression-info-list'."
          (list "Opening input file" (format "error %s" message) infile)))
                        
    
          (list "Opening input file" (format "error %s" message) infile)))
                        
    

-(defvar jka-compr-dd-program
-  "/bin/dd")
+(defcustom jka-compr-dd-program "/bin/dd"
+  "How to invoke `dd'."
+  :type 'string
+  :group 'jka-compr)

 
 
 (defvar jka-compr-dd-blocksize 256)
 
 
 (defvar jka-compr-dd-blocksize 256)


@@ -267,32 +285,38 @@ based on the filename itself and `jka-compr-compression-info-list'."
   "Call program PROG with ARGS args taking input from INFILE.
 Fourth and fifth args, BEG and LEN, specify which part of the output
 to keep: LEN chars starting BEG chars from the beginning."
   "Call program PROG with ARGS args taking input from INFILE.
 Fourth and fifth args, BEG and LEN, specify which part of the output
 to keep: LEN chars starting BEG chars from the beginning."

-  (let* ((skip (/ beg jka-compr-dd-blocksize))
-        (prefix (- beg (* skip jka-compr-dd-blocksize)))
-        (count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
-        (start (point))
-        (err-file (jka-compr-make-temp-name))
-        (run-string (format "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null"
-                            prog
-                            (mapconcat 'identity args " ")
-                            err-file
-                            jka-compr-dd-program
-                            jka-compr-dd-blocksize
-                            skip
-                            ;; dd seems to be unreliable about
-                            ;; providing the last block.  So, always
-                            ;; read one more than you think you need.
-                            (if count (concat "count=" (1+ count)) ""))))
-
-    (unwind-protect
-       (or (memq (call-process jka-compr-shell
-                               infile t nil "-c"
-                               run-string)
-                 jka-compr-acceptable-retval-list)
-           
-           (jka-compr-error prog args infile message err-file))
-
-      (jka-compr-delete-temp-file err-file))
+  (let ((start (point))
+       (prefix beg))
+    (if (and jka-compr-use-shell jka-compr-dd-program)
+       ;; Put the uncompression output through dd
+       ;; to discard the part we don't want.
+       (let ((skip (/ beg jka-compr-dd-blocksize))
+             (err-file (jka-compr-make-temp-name))
+             count)
+         ;; Update PREFIX based on the text that we won't read in.
+         (setq prefix (- beg (* skip jka-compr-dd-blocksize))
+               count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
+         (unwind-protect
+             (or (memq (call-process
+                        jka-compr-shell infile t nil "-c"
+                        (format
+                         "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null"
+                         prog
+                         (mapconcat 'identity args " ")
+                         err-file
+                         jka-compr-dd-program
+                         jka-compr-dd-blocksize
+                         skip
+                         ;; dd seems to be unreliable about
+                         ;; providing the last block.  So, always
+                         ;; read one more than you think you need.
+                         (if count (format "count=%d" (1+ count)) "")))
+                       jka-compr-acceptable-retval-list)
+                 (jka-compr-error prog args infile message err-file))
+           (jka-compr-delete-temp-file err-file)))
+      ;; Run the uncompression program directly.
+      ;; We get the whole file and must delete what we don't want.
+      (jka-compr-call-process prog message infile t nil args))

 
     ;; Delete the stuff after what we want, if there is any.
     (and
 
     ;; Delete the stuff after what we want, if there is any.
     (and


@@ -356,144 +380,126 @@ There should be no more than seven characters after the final `/'."
   :type 'string
   :group 'jka-compr)
 
   :type 'string
   :group 'jka-compr)
 

-(defvar jka-compr-temp-name-table (make-vector 31 nil))
-

 (defun jka-compr-make-temp-name (&optional local-copy)
   "This routine will return the name of a new file."
 (defun jka-compr-make-temp-name (&optional local-copy)
   "This routine will return the name of a new file."

-  (let* ((lastchar ?a)
-        (prevchar ?a)
-        (template (concat jka-compr-temp-name-template "aa"))
-        (lastpos (1- (length template)))
-        (not-done t)
-        file
-        entry)
+  (make-temp-file jka-compr-temp-name-template))

 
 

-    (while not-done
-      (aset template lastpos lastchar)
-      (setq file (concat (make-temp-name template) "#"))
-      (setq entry (intern file jka-compr-temp-name-table))
-      (if (or (get entry 'active)
-             (file-exists-p file))
-
-         (progn
-           (setq lastchar (1+ lastchar))
-           (if (> lastchar ?z)
-               (progn
-                 (setq prevchar (1+ prevchar))
-                 (setq lastchar ?a)
-                 (if (> prevchar ?z)
-                     (error "Can't allocate temp file.")
-                   (aset template (1- lastpos) prevchar)))))
-
-       (put entry 'active (not local-copy))
-       (setq not-done nil)))
-
-    file))
-
-
-(defun jka-compr-delete-temp-file (temp)
-
-  (put (intern temp jka-compr-temp-name-table)
-       'active nil)
-
-  (condition-case ()
-      (delete-file temp)
-    (error nil)))
+(defalias 'jka-compr-delete-temp-file 'delete-file)

 
 
 (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))
 
 
 (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)
 
 
 (defun jka-compr-insert-file-contents (file &optional visit beg end replace)


@@ -522,7 +528,9 @@ There should be no more than seven characters after the final `/'."
                   ;; If multibyte characters are disabled,
                   ;; don't do that conversion.
                   (and (null enable-multibyte-characters)
                   ;; If multibyte characters are disabled,
                   ;; don't do that conversion.
                   (and (null enable-multibyte-characters)

-                       'raw-text)
+                       (or (auto-coding-alist-lookup
+                            (jka-compr-byte-compiler-base-file-name file))
+                           'raw-text))

                   (let ((coding (find-operation-coding-system
                                  'insert-file-contents
                                  (jka-compr-byte-compiler-base-file-name file))))
                   (let ((coding (find-operation-coding-system
                                  'insert-file-contents
                                  (jka-compr-byte-compiler-base-file-name file))))


@@ -598,6 +606,7 @@ There should be no more than seven characters after the final `/'."
           (progn
             (unlock-buffer)
             (setq buffer-file-name filename)
           (progn
             (unlock-buffer)
             (setq buffer-file-name filename)

+            (setq jka-compr-really-do-compress t)

             (set-visited-file-modtime)))
            
          (and
             (set-visited-file-modtime)))
            
          (and


@@ -711,9 +720,14 @@ There should be no more than seven characters after the final `/'."
 
          (let ((load-force-doc-strings t))
            (load load-file noerror t t))
 
          (let ((load-force-doc-strings t))
            (load load-file noerror t t))

-

          (or nomessage
          (or nomessage

-             (message "Loading %s...done." file)))
+             (message "Loading %s...done." file))
+         ;; Fix up the load history to point at the right library.
+         (let ((l (assoc load-file load-history)))
+           ;; Remove .gz and .elc?.
+           (while (file-name-extension file)
+             (setq file (file-name-sans-extension file)))
+           (setcar l file)))

 
       (jka-compr-delete-temp-file local-copy))
 
 
       (jka-compr-delete-temp-file local-copy))
 


@@ -757,58 +771,12 @@ It is not recommended to set this variable permanently to anything but nil.")
        (inhibit-file-name-operation operation))
     (apply operation args)))
 
        (inhibit-file-name-operation operation))
     (apply operation args)))
 

-;;;###autoload(defun auto-compression-mode (&optional arg)
-;;;###autoload  "\
-;;;###autoloadToggle automatic file compression and uncompression.
-;;;###autoloadWith prefix argument ARG, turn auto compression on if positive, else off.
-;;;###autoloadReturns the new status of auto compression (non-nil means on)."
-;;;###autoload  (interactive "P")
-;;;###autoload  (if (not (fboundp 'jka-compr-installed-p))
-;;;###autoload      (progn
-;;;###autoload        (require 'jka-compr)
-;;;###autoload        ;; That turned the mode on, so make it initially off.
-;;;###autoload        (toggle-auto-compression)))
-;;;###autoload  (toggle-auto-compression arg t))
-
-(defun toggle-auto-compression (&optional arg message)
-  "Toggle automatic file compression and uncompression.
-With prefix argument ARG, turn auto compression on if positive, else off.
-Returns the new status of auto compression (non-nil means on).
-If the argument MESSAGE is non-nil, it means to print a message
-saying whether the mode is now on or off."
-  (interactive "P\np")
-  (let* ((installed (jka-compr-installed-p))
-        (flag (if (null arg)
-                  (not installed)
-                (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))))
-
-    (cond
-     ((and flag installed) t)          ; already installed
-
-     ((and (not flag) (not installed)) nil) ; already not installed
-
-     (flag
-      (jka-compr-install))
-
-     (t
-      (jka-compr-uninstall)))
-
-
-    (and message
-        (if flag
-            (message "Automatic file (de)compression is now ON.")
-          (message "Automatic file (de)compression is now OFF.")))
-
-    flag))

 
 (defun jka-compr-build-file-regexp ()
 
 (defun jka-compr-build-file-regexp ()

-  (concat
-   "\\("
-   (mapconcat
-    'jka-compr-info-regexp
-    jka-compr-compression-info-list
-    "\\)\\|\\(")
-   "\\)"))
+  (mapconcat
+   'jka-compr-info-regexp
+   jka-compr-compression-info-list
+   "\\|"))

 
 
 (defun jka-compr-install ()
 
 
 (defun jka-compr-install ()


@@ -851,7 +819,16 @@ and `inhibit-first-line-modes-suffixes'."
                                inhibit-first-line-modes-suffixes)))))
    jka-compr-compression-info-list)
   (setq auto-mode-alist
                                inhibit-first-line-modes-suffixes)))))
    jka-compr-compression-info-list)
   (setq auto-mode-alist

-       (append auto-mode-alist jka-compr-mode-alist-additions)))
+       (append auto-mode-alist jka-compr-mode-alist-additions))
+
+  ;; Make sure that (load "foo") will find /bla/foo.el.gz.
+  (setq load-suffixes
+       (apply 'append
+              (mapcar (lambda (suffix)
+                        (cons suffix
+                              (mapcar (lambda (ext) (concat suffix ext))
+                                      jka-compr-load-suffixes)))
+                      load-suffixes))))

 
 
 (defun jka-compr-uninstall ()
 
 
 (defun jka-compr-uninstall ()


@@ -903,7 +880,15 @@ by `jka-compr-installed'."
          (setcdr last (cdr (cdr last)))
        (setq last (cdr last))))
     
          (setcdr last (cdr (cdr last)))
        (setq last (cdr last))))
     

-    (setq file-coding-system-alist (cdr ama))))
+    (setq file-coding-system-alist (cdr ama)))
+
+  ;; Remove the suffixes that were added by jka-compr.
+  (let ((suffixes nil)
+       (re (jka-compr-build-file-regexp)))
+    (dolist (suffix load-suffixes)
+      (unless (string-match re suffix)
+       (push suffix suffixes)))
+    (setq load-suffixes (nreverse suffixes))))

 
       
 (defun jka-compr-installed-p ()
 
       
 (defun jka-compr-installed-p ()


@@ -927,9 +912,37 @@ The return value is the entry in `file-name-handler-alist' for jka-compr."
 (and (jka-compr-installed-p)
      (jka-compr-uninstall))
 
 (and (jka-compr-installed-p)
      (jka-compr-uninstall))
 

-(jka-compr-install)
+
+;;;###autoload
+(define-minor-mode auto-compression-mode
+  "Toggle automatic file compression and uncompression.
+With prefix argument ARG, turn auto compression on if positive, else off.
+Returns the new status of auto compression (non-nil means on)."
+  :global t :group 'jka-compr
+  (let* ((installed (jka-compr-installed-p))
+        (flag auto-compression-mode))
+    (cond
+     ((and flag installed) t)          ; already installed
+     ((and (not flag) (not installed)) nil) ; already not installed
+     (flag (jka-compr-install))
+     (t (jka-compr-uninstall)))))
+
+
+;;;###autoload
+(defmacro with-auto-compression-mode (&rest body)
+  "Evalute BODY with automatic file compression and uncompression enabled."
+  (let ((already-installed (make-symbol "already-installed")))
+    `(let ((,already-installed (jka-compr-installed-p)))
+       (unwind-protect
+          (progn
+            (unless ,already-installed
+              (jka-compr-install))
+            ,@body)
+        (unless ,already-installed
+          (jka-compr-uninstall))))))
+(put 'with-auto-compression-mode 'lisp-indent-function 0)

 
 
 (provide 'jka-compr)
 
 
 
 (provide 'jka-compr)
 

-;; jka-compr.el ends here.
+;;; jka-compr.el ends here