X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/31b55e801d203be3366ba84627048c3ae664ad27..cb625535b532afa1017ed5b6ff7ca0b25f1e3b0a:/lisp/jka-compr.el

diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 3d14089349..c528e05623 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -1,6 +1,7 @@
 ;;; jka-compr.el --- reading/writing/loading compressed files
 
-;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2003  Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
 ;; Maintainer: FSF
@@ -10,7 +11,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -20,8 +21,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -46,18 +47,9 @@
 ;; The default value of this variable allows jka-compr to work with
 ;; Unix compress and gzip.
 ;;
-;; If you are concerned about the stderr output of gzip and other
-;; compression/decompression programs showing up in your buffers, you
-;; should set the discard-error flag in the compression-info-list.
-;; This will cause the stderr of all programs to be discarded.
-;; However, it also causes emacs to call compression/uncompression
-;; programs through a shell (which is specified by jka-compr-shell).
-;; This may be a drag if, on your system, starting up a shell is
-;; slow.
-;;
 ;; If you don't want messages about compressing and decompressing
-;; to show up in the echo area, you can set the compress-name and
-;; decompress-name fields of the jka-compr-compression-info-list to
+;; to show up in the echo area, you can set the compress-msg and
+;; decompress-msg fields of the jka-compr-compression-info-list to
 ;; nil.
 
 
@@ -100,152 +92,24 @@
 
 ;;; Code:
 
-(defgroup compression nil
-  "Data compression utilities"
-  :group 'data)
-
-(defgroup jka-compr nil
-  "jka-compr customization"
-  :group 'compression)
-
+(require 'jka-cmpr-hook)
 
 (defcustom jka-compr-shell "sh"
   "*Shell to be used for calling compression programs.
-The value of this variable only matters if you want to discard the
-stderr of a compression/decompression program (see the documentation
-for `jka-compr-compression-info-list')."
+NOTE: Not used in MS-DOS and Windows systems."
   :type 'string
   :group 'jka-compr)
 
 (defvar jka-compr-use-shell
   (not (memq system-type '(ms-dos windows-nt))))
 
-;;; I have this defined so that .Z files are assumed to be in unix
-;;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
-(defcustom jka-compr-compression-info-list
-  ;;[regexp
-  ;; compr-message  compr-prog  compr-args
-  ;; uncomp-message uncomp-prog uncomp-args
-  ;; can-append auto-mode-flag strip-extension-flag file-magic-bytes]
-  '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
-     "compressing"    "compress"     ("-c")
-     "uncompressing"  "uncompress"   ("-c")
-     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 "BZh"]
-    ["\\.tgz\\'"
-     "zipping"        "gzip"         ("-c" "-q")
-     "unzipping"      "gzip"         ("-c" "-q" "-d")
-     t nil "\037\213"]
-    ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'"
-     "zipping"        "gzip"         ("-c" "-q")
-     "unzipping"      "gzip"         ("-c" "-q" "-d")
-     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 STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
-
-   regexp                is a regexp that matches filenames that are
-                         compressed with this format
-
-   compress-msg          is the message to issue to the user when doing this
-                         type of compression (nil means no message)
-
-   compress-program      is a program that performs this compression
-
-   compress-args         is a list of args to pass to the compress program
-
-   uncompress-msg        is the message to issue to the user when doing this
-                         type of uncompression (nil means no message)
-
-   uncompress-program    is a program that performs this compression
-
-   uncompress-args       is a list of args to pass to the uncompress program
-
-   append-flag           is non-nil if this compression technique can be
-                         appended
-
-   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."
-  :type '(repeat (vector regexp
-			 (choice :tag "Compress Message"
-				 (string :format "%v")
-				 (const :tag "No Message" nil))
-			 (string :tag "Compress Program")
-			 (repeat :tag "Compress Arguments" string)
-			 (choice :tag "Uncompress Message"
-				 (string :format "%v")
-				 (const :tag "No Message" nil))
-			 (string :tag "Uncompress Program")
-			 (repeat :tag "Uncompress Arguments" string)
-			 (boolean :tag "Append")
-			 (boolean :tag "Strip Extension")
-			 (string :tag "Magic Bytes")))
-  :group 'jka-compr)
-
-(defcustom jka-compr-mode-alist-additions
-  (list (cons "\\.tgz\\'" 'tar-mode))
-  "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)
-
-(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.")
+  "Non-nil in a buffer whose visited file was uncompressed on visiting it.
+This means compress the data on writing the file, even if the
+data appears to be compressed already.")
+(make-variable-buffer-local 'jka-compr-really-do-compress)
 (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))
-(defun jka-compr-info-compress-message     (info)  (aref info 1))
-(defun jka-compr-info-compress-program     (info)  (aref info 2))
-(defun jka-compr-info-compress-args        (info)  (aref info 3))
-(defun jka-compr-info-uncompress-message   (info)  (aref info 4))
-(defun jka-compr-info-uncompress-program   (info)  (aref info 5))
-(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)
-  "Return information about the compression scheme of FILENAME.
-The determination as to which compression scheme, if any, to use is
-based on the filename itself and `jka-compr-compression-info-list'."
-  (catch 'compression-info
-    (let ((case-fold-search nil))
-      (mapcar
-       (function (lambda (x)
-		   (and (string-match (jka-compr-info-regexp x) filename)
-			(throw 'compression-info x))))
-       jka-compr-compression-info-list)
-      nil)))
-
 
 (put 'compression-error 'error-conditions '(compression-error file-error error))
 
@@ -255,8 +119,7 @@ based on the filename itself and `jka-compr-compression-info-list'."
 
 (defun jka-compr-error (prog args infile message &optional errfile)
 
-  (let ((errbuf (get-buffer-create " *jka-compr-error*"))
-	(curbuf (current-buffer)))
+  (let ((errbuf (get-buffer-create " *jka-compr-error*")))
     (with-current-buffer errbuf
       (widen) (erase-buffer)
       (insert (format "Error while executing \"%s %s < %s\"\n\n"
@@ -292,6 +155,12 @@ to keep: LEN chars starting BEG chars from the beginning."
 	;; to discard the part we don't want.
 	(let ((skip (/ beg jka-compr-dd-blocksize))
 	      (err-file (jka-compr-make-temp-name))
+	      ;; call-process barfs if default-directory is inaccessible.
+	      (default-directory
+		(if (and default-directory
+			 (file-accessible-directory-p default-directory))
+		    default-directory
+		  (file-name-directory infile)))
 	      count)
 	  ;; Update PREFIX based on the text that we won't read in.
 	  (setq prefix (- beg (* skip jka-compr-dd-blocksize))
@@ -330,49 +199,45 @@ to keep: LEN chars starting BEG chars from the beginning."
 
 
 (defun jka-compr-call-process (prog message infile output temp args)
-  (if jka-compr-use-shell
-
-      (let ((err-file (jka-compr-make-temp-name))
-	    (coding-system-for-read (or coding-system-for-read 'undecided))
-            (coding-system-for-write 'no-conversion))
-
-	(unwind-protect
-
-	    (or (memq
-		 (call-process jka-compr-shell infile
-			       (if (stringp output) nil output)
-			       nil
-			       "-c"
-			       (format "%s %s 2> %s %s"
-				       prog
-				       (mapconcat 'identity args " ")
-				       err-file
-				       (if (stringp output)
-					   (concat "> " output)
-					 "")))
-		 jka-compr-acceptable-retval-list)
-
-		(jka-compr-error prog args infile message err-file))
-
-	  (jka-compr-delete-temp-file err-file)))
-
-    (or (zerop
-	 (apply 'call-process
-		prog
-		infile
-		(if (stringp output) temp output)
-		nil
-		args))
-	(jka-compr-error prog args infile message))
-
-    (and (stringp output)
-	 (with-current-buffer temp
-	   (write-region (point-min) (point-max) output)
-	   (erase-buffer)))))
-
-
-;;; Support for temp files.  Much of this was inspired if not lifted
-;;; from ange-ftp.
+  ;; call-process barfs if default-directory is inaccessible.
+  (let ((default-directory
+	  (if (and default-directory
+		   (file-accessible-directory-p default-directory))
+	      default-directory
+	    (file-name-directory infile))))
+    (if jka-compr-use-shell
+	(let ((err-file (jka-compr-make-temp-name))
+	      (coding-system-for-read (or coding-system-for-read 'undecided))
+	      (coding-system-for-write 'no-conversion))
+	  (unwind-protect
+	      (or (memq
+		   (call-process jka-compr-shell infile
+				 (if (stringp output) nil output)
+				 nil
+				 "-c"
+				 (format "%s %s 2> %s %s"
+					 prog
+					 (mapconcat 'identity args " ")
+					 err-file
+					 (if (stringp output)
+					     (concat "> " output)
+					   "")))
+		   jka-compr-acceptable-retval-list)
+		  (jka-compr-error prog args infile message err-file))
+	    (jka-compr-delete-temp-file err-file)))
+      (or (eq 0
+	      (apply 'call-process
+		     prog infile (if (stringp output) temp output)
+		     nil args))
+	  (jka-compr-error prog args infile message))
+      (and (stringp output)
+	   (with-current-buffer temp
+	     (write-region (point-min) (point-max) output)
+	     (erase-buffer))))))
+
+
+;; Support for temp files.  Much of this was inspired if not lifted
+;; from ange-ftp.
 
 (defcustom jka-compr-temp-name-template
   (expand-file-name "jka-com" temporary-file-directory)
@@ -421,10 +286,7 @@ There should be no more than seven characters after the final `/'."
 	(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
@@ -432,6 +294,9 @@ There should be no more than seven characters after the final `/'."
 	      ;; that `basic-save-buffer' sees the right value.
 	      (coding-system-used last-coding-system-used))
 
+          (or compress-program
+              (error "No compression program defined"))
+
 	  (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
 	  (with-current-buffer temp-buffer
 	    (widen) (erase-buffer))
@@ -517,123 +382,137 @@ There should be no more than seven characters after the final `/'."
   (let* ((filename (expand-file-name file))
 	 (info (jka-compr-get-compression-info filename)))
 
-    (if info
-
-	(let ((uncompress-message (jka-compr-info-uncompress-message info))
-	      (uncompress-program (jka-compr-info-uncompress-program info))
-	      (uncompress-args (jka-compr-info-uncompress-args info))
-	      (base-name (file-name-nondirectory filename))
-	      (notfound nil)
-	      (local-copy
-	       (jka-compr-run-real-handler 'file-local-copy (list filename)))
-	      local-file
-	      size start)
-
-	  (setq local-file (or local-copy filename))
-
-	  (and
-	   visit
-	   (setq buffer-file-name filename))
-
-	  (unwind-protect		; to make sure local-copy gets deleted
-
-	      (progn
-
-		(and
-		 uncompress-message
-		 (message "%s %s..." uncompress-message base-name))
-
-		(condition-case error-code
-
-		    (let ((coding-system-for-read 'no-conversion))
-		      (if replace
-			  (goto-char (point-min)))
-		      (setq start (point))
-		      (if (or beg end)
-			  (jka-compr-partial-uncompress uncompress-program
-							(concat uncompress-message
-								" " base-name)
-							uncompress-args
-							local-file
-							(or beg 0)
-							(if (and beg end)
-							    (- end beg)
-							  end))
-			;; If visiting, bind off buffer-file-name so that
-			;; file-locking will not ask whether we should
-			;; really edit the buffer.
-			(let ((buffer-file-name
-			       (if visit nil buffer-file-name)))
-			  (jka-compr-call-process uncompress-program
-						  (concat uncompress-message
-							  " " base-name)
-						  local-file
-						  t
-						  nil
-						  uncompress-args)))
-		      (setq size (- (point) start))
-		      (if replace
-			  (delete-region (point) (point-max)))
-		      (goto-char start))
-		  (error
-		   (if (and (eq (car error-code) 'file-error)
-			    (eq (nth 3 error-code) local-file))
-		       (if visit
-			   (setq notfound error-code)
-			 (signal 'file-error
-				 (cons "Opening input file"
-				       (nthcdr 2 error-code))))
-		     (signal (car error-code) (cdr error-code))))))
-
-	    (and
-	     local-copy
-	     (file-exists-p local-copy)
-	     (delete-file local-copy)))
-
-	  (decode-coding-inserted-region
-	   (point) (+ (point) size)
-	   (jka-compr-byte-compiler-base-file-name file)
-	   visit beg end replace)
-
-	  (and
-	   visit
-	   (progn
-	     (unlock-buffer)
-	     (setq buffer-file-name filename)
-	     (setq jka-compr-really-do-compress t)
-	     (set-visited-file-modtime)))
-
-	  (and
-	   uncompress-message
-	   (message "%s %s...done" uncompress-message base-name))
-
-	  (and
-	   visit
-	   notfound
-	   (signal 'file-error
-		   (cons "Opening input file" (nth 2 notfound))))
-
-	  ;; This is done in insert-file-contents after we return.
-	  ;; That is a little weird, but better to go along with it now
-	  ;; than to change it now.
-
-;;;	  ;; Run the functions that insert-file-contents would.
-;;; 	  (let ((p after-insert-file-functions)
-;;; 		(insval size))
-;;; 	    (while p
-;;; 	      (setq insval (funcall (car p) size))
-;;; 	      (if insval
-;;; 		  (progn
-;;; 		    (or (integerp insval)
-;;; 			(signal 'wrong-type-argument
-;;; 				(list 'integerp insval)))
-;;; 		    (setq size insval)))
-;;; 	      (setq p (cdr p))))
-
-	  (list filename size))
-
-      (jka-compr-run-real-handler 'insert-file-contents
-				  (list file visit beg end replace)))))
+    (if (not info)
+
+	(jka-compr-run-real-handler 'insert-file-contents
+                                    (list file visit beg end replace))
+
+      (let ((uncompress-message (jka-compr-info-uncompress-message info))
+            (uncompress-program (jka-compr-info-uncompress-program info))
+            (uncompress-args (jka-compr-info-uncompress-args info))
+            (base-name (file-name-nondirectory filename))
+            (notfound nil)
+            (local-copy
+             (jka-compr-run-real-handler 'file-local-copy (list filename)))
+            local-file
+            size start)
+
+        (setq local-file (or local-copy filename))
+
+        (and
+         visit
+         (setq buffer-file-name filename))
+
+        (unwind-protect               ; to make sure local-copy gets deleted
+
+            (progn
+
+              (and
+               uncompress-message
+               (message "%s %s..." uncompress-message base-name))
+
+              (condition-case error-code
+
+                  (let ((coding-system-for-read 'no-conversion))
+                    (if replace
+                        (goto-char (point-min)))
+                    (setq start (point))
+                    (if (or beg end)
+                        (jka-compr-partial-uncompress uncompress-program
+                                                      (concat uncompress-message
+                                                              " " base-name)
+                                                      uncompress-args
+                                                      local-file
+                                                      (or beg 0)
+                                                      (if (and beg end)
+                                                          (- end beg)
+                                                        end))
+                      ;; If visiting, bind off buffer-file-name so that
+                      ;; file-locking will not ask whether we should
+                      ;; really edit the buffer.
+                      (let ((buffer-file-name
+                             (if visit nil buffer-file-name)))
+                        (jka-compr-call-process uncompress-program
+                                                (concat uncompress-message
+                                                        " " base-name)
+                                                local-file
+                                                t
+                                                nil
+                                                uncompress-args)))
+                    (setq size (- (point) start))
+                    (if replace
+                        (delete-region (point) (point-max)))
+                    (goto-char start))
+                (error
+                 ;; If the file we wanted to uncompress does not exist,
+                 ;; handle that according to VISIT as `insert-file-contents'
+                 ;; would, maybe signaling the same error it normally would.
+                 (if (and (eq (car error-code) 'file-error)
+                          (eq (nth 3 error-code) local-file))
+                     (if visit
+                         (setq notfound error-code)
+                       (signal 'file-error
+                               (cons "Opening input file"
+                                     (nthcdr 2 error-code))))
+                   ;; If the uncompression program can't be found,
+                   ;; signal that as a non-file error
+                   ;; so that find-file-noselect-1 won't handle it.
+                   (if (and (eq (car error-code) 'file-error)
+                            (equal (cadr error-code) "Searching for program"))
+                       (error "Uncompression program `%s' not found"
+                              (nth 3 error-code)))
+                   (signal (car error-code) (cdr error-code))))))
+
+          (and
+           local-copy
+           (file-exists-p local-copy)
+           (delete-file local-copy)))
+
+        (unless notfound
+          (decode-coding-inserted-region
+           (point) (+ (point) size)
+           (jka-compr-byte-compiler-base-file-name file)
+           visit beg end replace))
+
+        (and
+         visit
+         (progn
+           (unlock-buffer)
+           (setq buffer-file-name filename)
+           (setq jka-compr-really-do-compress t)
+           (set-visited-file-modtime)))
+
+        (and
+         uncompress-message
+         (message "%s %s...done" uncompress-message base-name))
+
+        (and
+         visit
+         notfound
+         (signal 'file-error
+                 (cons "Opening input file" (nth 2 notfound))))
+
+        ;; This is done in insert-file-contents after we return.
+        ;; That is a little weird, but better to go along with it now
+        ;; than to change it now.
+
+        ;; ;; Run the functions that insert-file-contents would.
+        ;; (let ((p after-insert-file-functions)
+        ;;       (insval size))
+        ;;   (while p
+        ;;     (setq insval (funcall (car p) size))
+        ;;     (if insval
+        ;;         (progn
+        ;;           (or (integerp insval)
+        ;;       	(signal 'wrong-type-argument
+        ;;       		(list 'integerp insval)))
+        ;;           (setq size insval)))
+        ;;     (setq p (cdr p))))
+
+        (or (jka-compr-info-compress-program info)
+            (message "You can't save this buffer because compression program is not defined"))
+
+        (list filename size)))))
 
 
 (defun jka-compr-file-local-copy (file)
@@ -650,7 +529,6 @@ There should be no more than seven characters after the final `/'."
 	       (jka-compr-run-real-handler 'file-local-copy (list filename)))
 	      (temp-file (jka-compr-make-temp-name t))
 	      (temp-buffer (get-buffer-create " *jka-compr-flc-temp*"))
-	      (notfound nil)
 	      local-file)
 
 	  (setq local-file (or local-copy filename))
@@ -698,7 +576,7 @@ There should be no more than seven characters after the final `/'."
       (jka-compr-run-real-handler 'file-local-copy (list filename)))))
 
 
-;;; Support for loading compressed files.
+;; Support for loading compressed files.
 (defun jka-compr-load (file &optional noerror nomessage nosuffix)
   "Documented as original."
 
@@ -741,12 +619,13 @@ There should be no more than seven characters after the final `/'."
 (put 'byte-compiler-base-file-name 'jka-compr
      'jka-compr-byte-compiler-base-file-name)
 
+;;;###autoload
 (defvar jka-compr-inhibit nil
   "Non-nil means inhibit automatic uncompression temporarily.
 Lisp programs can bind this to t to do that.
 It is not recommended to set this variable permanently to anything but nil.")
 
-(put 'jka-compr-handler 'safe-magic t)
+;;;###autoload
 (defun jka-compr-handler (operation &rest args)
   (save-match-data
     (let ((jka-op (get operation 'jka-compr)))
@@ -766,66 +645,7 @@ It is not recommended to set this variable permanently to anything but nil.")
 	(inhibit-file-name-operation operation))
     (apply operation args)))
 
-
-(defun jka-compr-build-file-regexp ()
-  (mapconcat
-   'jka-compr-info-regexp
-   jka-compr-compression-info-list
-   "\\|"))
-
-
-(defun jka-compr-install ()
-  "Install jka-compr.
-This adds entries to `file-name-handler-alist' and `auto-mode-alist'
-and `inhibit-first-line-modes-suffixes'."
-
-  (setq jka-compr-file-name-handler-entry
-	(cons (jka-compr-build-file-regexp) 'jka-compr-handler))
-
-  (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry
-				      file-name-handler-alist))
-
-  (setq jka-compr-added-to-file-coding-system-alist nil)
-
-  (mapcar
-   (function (lambda (x)
-	       ;; Don't do multibyte encoding on the compressed files.
-	       (let ((elt (cons (jka-compr-info-regexp x)
-				 '(no-conversion . no-conversion))))
-		 (setq file-coding-system-alist
-		       (cons elt file-coding-system-alist))
-		 (setq jka-compr-added-to-file-coding-system-alist
-		       (cons elt jka-compr-added-to-file-coding-system-alist)))
-
-	       (and (jka-compr-info-strip-extension x)
-		    ;; Make entries in auto-mode-alist so that modes
-		    ;; are chosen right according to the file names
-		    ;; sans `.gz'.
-		    (setq auto-mode-alist
-			  (cons (list (jka-compr-info-regexp x)
-				      nil 'jka-compr)
-				auto-mode-alist))
-		    ;; Also add these regexps to
-		    ;; inhibit-first-line-modes-suffixes, so that a
-		    ;; -*- line in the first file of a compressed tar
-		    ;; file doesn't override tar-mode.
-		    (setq inhibit-first-line-modes-suffixes
-			  (cons (jka-compr-info-regexp x)
-				inhibit-first-line-modes-suffixes)))))
-   jka-compr-compression-info-list)
-  (setq auto-mode-alist
-	(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))))
-
-
+;;;###autoload
 (defun jka-compr-uninstall ()
   "Uninstall jka-compr.
 This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
@@ -833,13 +653,13 @@ and `inhibit-first-line-modes-suffixes' that were added
 by `jka-compr-installed'."
   ;; Delete from inhibit-first-line-modes-suffixes
   ;; what jka-compr-install added.
-  (mapcar
+  (mapc
      (function (lambda (x)
 		 (and (jka-compr-info-strip-extension x)
 		      (setq inhibit-first-line-modes-suffixes
 			    (delete (jka-compr-info-regexp x)
 				    inhibit-first-line-modes-suffixes)))))
-     jka-compr-compression-info-list)
+     jka-compr-compression-info-list--internal)
 
   (let* ((fnha (cons nil file-name-handler-alist))
 	 (last fnha))
@@ -857,7 +677,7 @@ by `jka-compr-installed'."
 
     (while (cdr last)
       (setq entry (car (cdr last)))
-      (if (or (member entry jka-compr-mode-alist-additions)
+      (if (or (member entry jka-compr-mode-alist-additions--internal)
 	      (and (consp (cdr entry))
 		   (eq (nth 2 entry) 'jka-compr)))
 	  (setcdr last (cdr (cdr last)))
@@ -865,79 +685,21 @@ by `jka-compr-installed'."
 
     (setq auto-mode-alist (cdr ama)))
 
-  (let* ((ama (cons nil file-coding-system-alist))
-	 (last ama)
-	 entry)
-
-    (while (cdr last)
-      (setq entry (car (cdr last)))
-      (if (member entry jka-compr-added-to-file-coding-system-alist)
-	  (setcdr last (cdr (cdr last)))
-	(setq last (cdr last))))
-
-    (setq file-coding-system-alist (cdr ama)))
+  (while jka-compr-added-to-file-coding-system-alist
+    (setq file-coding-system-alist
+          (delq (car (member (pop jka-compr-added-to-file-coding-system-alist)
+                             file-coding-system-alist))
+                file-coding-system-alist)))
 
   ;; 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 ()
-  "Return non-nil if jka-compr is installed.
-The return value is the entry in `file-name-handler-alist' for jka-compr."
-
-  (let ((fnha file-name-handler-alist)
-	(installed nil))
-
-    (while (and fnha (not installed))
-     (and (eq (cdr (car fnha)) 'jka-compr-handler)
-	   (setq installed (car fnha)))
-      (setq fnha (cdr fnha)))
-
-    installed))
-
-
-;;; Add the file I/O hook if it does not already exist.
-;;; Make sure that jka-compr-file-name-handler-entry is eq to the
-;;; entry for jka-compr in file-name-handler-alist.
-(and (jka-compr-installed-p)
-     (jka-compr-uninstall))
-
-
-;;;###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)
+  (dolist (suff jka-compr-load-suffixes--internal)
+    (setq load-file-rep-suffixes (delete suff load-file-rep-suffixes)))
 
+  (setq jka-compr-compression-info-list--internal nil
+	jka-compr-mode-alist-additions--internal nil
+	jka-compr-load-suffixes--internal nil))
 
 (provide 'jka-compr)
 
+;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc
 ;;; jka-compr.el ends here