* server.el (server-edit): No-op if no server buffers exist.

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

diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 99b8ffd377bd8536feb64c70136185c156d00c29..82c0461a3f84eeec42085e436541b1aead408724 100644 (file)
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -1,6 +1,7 @@
 ;;; jka-compr.el --- reading/writing/loading compressed files
 
 ;;; jka-compr.el --- reading/writing/loading compressed files
 

-;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000  Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2002, 2003,
+;;   2004, 2005, 2006 Free Software Foundation, Inc.

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


@@ -20,10 +21,10 @@
 
 ;; 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
 
 ;; 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: 
+;;; 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


@@ -64,7 +65,7 @@
 ;; APPLICATION NOTES:
 ;;
 ;; crypt++
 ;; APPLICATION NOTES:
 ;;
 ;; crypt++

-;;   jka-compr can coexist with crpyt++ if you take all the decompression
+;;   jka-compr can coexist with crypt++ if you take all the decompression

 ;;   entries out of the crypt-encoding-list.  Clearly problems will arise if
 ;;   you have two programs trying to compress/decompress files.  jka-compr
 ;;   will not "work with" crypt++ in the following sense: you won't be able to
 ;;   entries out of the crypt-encoding-list.  Clearly problems will arise if
 ;;   you have two programs trying to compress/decompress files.  jka-compr
 ;;   will not "work with" crypt++ in the following sense: you won't be able to


@@ -77,9 +78,9 @@
 
 
 ;; ACKNOWLEDGMENTS
 
 
 ;; ACKNOWLEDGMENTS

-;; 
+;;

 ;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs.  Many people
 ;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs.  Many people

-;; have made helpful suggestions, reported bugs, and even fixed bugs in 
+;; have made helpful suggestions, reported bugs, and even fixed bugs in

 ;; jka-compr.  I recall the following people as being particularly helpful.
 ;;
 ;;   Jean-loup Gailly
 ;; jka-compr.  I recall the following people as being particularly helpful.
 ;;
 ;;   Jean-loup Gailly


@@ -100,14 +101,7 @@
 
 ;;; Code:
 
 
 ;;; 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.
 
 (defcustom jka-compr-shell "sh"
   "*Shell to be used for calling compression programs.


@@ -117,127 +111,16 @@ for `jka-compr-compression-info-list')."
   :type 'string
   :group 'jka-compr)
 
   :type 'string
   :group 'jka-compr)
 

-(defvar jka-compr-use-shell 
+(defvar jka-compr-use-shell

   (not (memq system-type '(ms-dos windows-nt))))
 
   (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 "Auto Mode")))
-  :group 'jka-compr)
-
-(defvar 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.")
-
-;; 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
 (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)
 \f
 (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))
-(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))
 
 
 (put 'compression-error 'error-conditions '(compression-error file-error error))
 


@@ -247,8 +130,7 @@ based on the filename itself and `jka-compr-compression-info-list'."
 
 (defun jka-compr-error (prog args infile message &optional errfile)
 
 
 (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"
     (with-current-buffer errbuf
       (widen) (erase-buffer)
       (insert (format "Error while executing \"%s %s < %s\"\n\n"


@@ -262,10 +144,12 @@ based on the filename itself and `jka-compr-compression-info-list'."
 
   (signal 'compression-error
          (list "Opening input file" (format "error %s" message) infile)))
 
   (signal 'compression-error
          (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)


@@ -275,32 +159,39 @@ 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> %s"
+                         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)) "")
+                         null-device))
+                       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


@@ -339,7 +230,7 @@ to keep: LEN chars starting BEG chars from the beginning."
 
          (jka-compr-delete-temp-file err-file)))
 
 
          (jka-compr-delete-temp-file err-file)))
 

-    (or (zerop
+    (or (eq 0

         (apply 'call-process
                prog
                infile
         (apply 'call-process
                prog
                infile


@@ -354,8 +245,8 @@ to keep: LEN chars starting BEG chars from the beginning."
           (erase-buffer)))))
 
 
           (erase-buffer)))))
 
 

-;;; Support for temp files.  Much of this was inspired if not lifted
-;;; from ange-ftp.
+;; 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)
 
 (defcustom jka-compr-temp-name-template
   (expand-file-name "jka-com" temporary-file-directory)


@@ -377,6 +268,10 @@ There should be no more than seven characters after the final `/'."
         (info (jka-compr-get-compression-info visit-file))
         (magic (and info (jka-compr-info-file-magic-bytes info))))
 
         (info (jka-compr-get-compression-info visit-file))
         (magic (and info (jka-compr-info-file-magic-bytes info))))
 

+    ;; If START is nil, use the whole buffer.
+    (if (null start)
+       (setq start 1 end (1+ (buffer-size))))
+

     ;; If we uncompressed this file when visiting it,
     ;; then recompress it when writing it
     ;; even if the contents look compressed already.
     ;; If we uncompressed this file when visiting it,
     ;; then recompress it when writing it
     ;; even if the contents look compressed already.


@@ -400,10 +295,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))
        (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))
              (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
              (base-name (file-name-nondirectory visit-file))
              temp-file temp-buffer
              ;; we need to leave `last-coding-system-used' set to its


@@ -411,6 +303,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))
 
              ;; 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))
          (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
          (with-current-buffer temp-buffer
            (widen) (erase-buffer))


@@ -426,7 +321,7 @@ There should be no more than seven characters after the final `/'."
 
            (setq temp-file (jka-compr-make-temp-name)))
 
 
            (setq temp-file (jka-compr-make-temp-name)))
 

-         (and 
+         (and

           compress-message
           (message "%s %s..." compress-message base-name))
 
           compress-message
           (message "%s %s..." compress-message base-name))
 


@@ -481,7 +376,7 @@ There should be no more than seven characters after the final `/'."
          (setq last-coding-system-used coding-system-used)
 
          nil)
          (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)))))
 


@@ -506,20 +401,7 @@ There should be no more than seven characters after the final `/'."
              (local-copy
               (jka-compr-run-real-handler 'file-local-copy (list filename)))
              local-file
              (local-copy
               (jka-compr-run-real-handler 'file-local-copy (list filename)))
              local-file

-             size start
-              (coding-system-for-read
-              (or coding-system-for-read
-                  ;; If multibyte characters are disabled,
-                  ;; don't do that conversion.
-                  (and (null enable-multibyte-characters)
-                       (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))))
-                    (and (consp coding) (car coding)))
-                  'undecided)) )
+             size start)

 
          (setq local-file (or local-copy filename))
 
 
          (setq local-file (or local-copy filename))
 


@@ -530,14 +412,14 @@ There should be no more than seven characters after the final `/'."
          (unwind-protect               ; to make sure local-copy gets deleted
 
              (progn
          (unwind-protect               ; to make sure local-copy gets deleted
 
              (progn

-                 
+

                (and
                 uncompress-message
                 (message "%s %s..." uncompress-message base-name))
 
                (condition-case error-code
 
                (and
                 uncompress-message
                 (message "%s %s..." uncompress-message base-name))
 
                (condition-case error-code
 

-                   (progn
+                   (let ((coding-system-for-read 'no-conversion))

                      (if replace
                          (goto-char (point-min)))
                      (setq start (point))
                      (if replace
                          (goto-char (point-min)))
                      (setq start (point))


@@ -565,19 +447,26 @@ There should be no more than seven characters after the final `/'."
                                                  uncompress-args)))
                      (setq size (- (point) start))
                      (if replace
                                                  uncompress-args)))
                      (setq size (- (point) start))
                      (if replace

-                         (let* ((del-beg (point))
-                                (del-end (+ del-beg size)))
-                           (delete-region del-beg
-                                          (min del-end (point-max)))))
+                         (delete-region (point) (point-max)))

                      (goto-char start))
                  (error
                      (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)
                   (if (and (eq (car error-code) 'file-error)
                            (eq (nth 3 error-code) local-file))
                       (if visit
                           (setq notfound error-code)

-                        (signal 'file-error 
+                        (signal 'file-error

                                 (cons "Opening input file"
                                       (nthcdr 2 error-code))))
                                 (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
                     (signal (car error-code) (cdr error-code))))))
 
            (and


@@ -585,6 +474,12 @@ There should be no more than seven characters after the final `/'."
             (file-exists-p local-copy)
             (delete-file 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
          (and
           visit
           (progn


@@ -592,7 +487,7 @@ There should be no more than seven characters after the final `/'."
             (setq buffer-file-name filename)
             (setq jka-compr-really-do-compress t)
             (set-visited-file-modtime)))
             (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
           uncompress-message
           (message "%s %s...done" uncompress-message base-name))


@@ -620,6 +515,9 @@ There should be no more than seven characters after the final `/'."
 ;;;                (setq size insval)))
 ;;;          (setq p (cdr p))))
 
 ;;;                (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))
 
       (jka-compr-run-real-handler 'insert-file-contents
          (list filename size))
 
       (jka-compr-run-real-handler 'insert-file-contents


@@ -640,7 +538,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*"))
               (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))
              local-file)
 
          (setq local-file (or local-copy filename))


@@ -648,11 +545,11 @@ There should be no more than seven characters after the final `/'."
          (unwind-protect
 
              (with-current-buffer temp-buffer
          (unwind-protect
 
              (with-current-buffer temp-buffer

-                 
+

                (and
                 uncompress-message
                 (message "%s %s..." uncompress-message base-name))
                (and
                 uncompress-message
                 (message "%s %s..." uncompress-message base-name))

-                 
+

                ;; Here we must read the output of uncompress program
                ;; and write it to TEMP-FILE without any code
                ;; conversion.  An appropriate code conversion (if
                ;; Here we must read the output of uncompress program
                ;; and write it to TEMP-FILE without any code
                ;; conversion.  An appropriate code conversion (if


@@ -684,11 +581,11 @@ There should be no more than seven characters after the final `/'."
            (kill-buffer temp-buffer))
 
          temp-file)
            (kill-buffer temp-buffer))
 
          temp-file)

-           
+

       (jka-compr-run-real-handler 'file-local-copy (list filename)))))
 
 
       (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."
 
 (defun jka-compr-load (file &optional noerror nomessage nosuffix)
   "Documented as original."
 


@@ -731,11 +628,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)
 
 (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.")
 
 (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.")
 

+;;;###autoload

 (defun jka-compr-handler (operation &rest args)
   (save-match-data
     (let ((jka-op (get operation 'jka-compr)))
 (defun jka-compr-handler (operation &rest args)
   (save-match-data
     (let ((jka-op (get operation 'jka-compr)))


@@ -755,57 +654,7 @@ 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)))
 

-
-(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)))
-
-
+;;;###autoload

 (defun jka-compr-uninstall ()
   "Uninstall jka-compr.
 This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
 (defun jka-compr-uninstall ()
   "Uninstall jka-compr.
 This removes the entries in `file-name-handler-alist' and `auto-mode-alist'


@@ -813,13 +662,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.
 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)))))
      (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))
 
   (let* ((fnha (cons nil file-name-handler-alist))
         (last fnha))


@@ -837,83 +686,29 @@ by `jka-compr-installed'."
 
     (while (cdr last)
       (setq entry (car (cdr last)))
 
     (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)))
        (setq last (cdr last))))
              (and (consp (cdr entry))
                   (eq (nth 2 entry) 'jka-compr)))
          (setcdr last (cdr (cdr last)))
        (setq last (cdr last))))

-    
-    (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))))
-
-      
-(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))

 
 

+    (setq auto-mode-alist (cdr ama)))

 
 

-;;; 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))
-
-
-;;; Note this definition must be at the end of the file, because
-;;; `define-minor-mode' actually calls the mode-function if the
-;;; associated variable is non-nil, which requires that all needed
-;;; functions be already defined.  [This is arguably a bug in d-m-m]
-;;;###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)))))
-
+  (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)))

 
 

-;;;###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)
+  ;; Remove the suffixes that were added by jka-compr.
+  (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)
 
 
 (provide 'jka-compr)
 

-;; jka-compr.el ends here.
+;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc
+;;; jka-compr.el ends here