]> code.delx.au - gnu-emacs/blobdiff - lisp/jka-compr.el
*** empty log message ***
[gnu-emacs] / lisp / jka-compr.el
index 7419d086b613f62ce5621ec68849e4a74c24580b..33d3fe379d8cf975752e27f617cfcce33cf1395f 100644 (file)
-;;; jka-compr.el - reading/writing/loading compressed files.
-;;; Copyright (C) 1993, 1994  Free Software Foundation, Inc.
+;;; jka-compr.el --- reading/writing/loading compressed files
+
+;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
 
 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
-;; Version: 0.11
+;; Maintainer: FSF
 ;; Keywords: data
 
 ;; Keywords: data
 
-;;; Commentary: 
-
-;;; This package implements low-level support for reading, writing,
-;;; and loading compressed files.  It hooks into the low-level file
-;;; I/O functions (including write-region and insert-file-contents) so
-;;; that they automatically compress or uncompress a file if the file
-;;; appears to need it (based on the extension of the file name).
-;;; Packages like Rmail, VM, GNUS, and Info should be able to work
-;;; with compressed files without modification.
-
-
-;;; 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).
-;;;
-;;; The variable, jka-compr-compression-info-list can be used to
-;;; customize jka-compr to work with other compression programs.
-;;; 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
-;;; nil.
-
-
-;;; APPLICATION NOTES:
-;;; 
-;;; rmail, vm, gnus, etc.
-;;;   To use compressed mail folders, .newsrc files, etc., you need
-;;;   only compress the file.  Since jka-compr searches for .gz
-;;;   versions of the files it's finding, you need not change
-;;;   variables within rmail, gnus, etc.  
-;;;
-;;;
-;;; crypt++
-;;;   jka-compr can coexist with crpyt++ 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
-;;;   decode encrypted compressed files--that is, files that have been
-;;;   compressed then encrypted (in that order).  Theoretically, crypt++ and
-;;;   jka-compr could properly handle a file that has been encrypted then
-;;;   compressed, but there is little point in trying to compress an encrypted
-;;;   file.
-;;;
-;;;
-;;; tar-mode
-;;;   Some people like to use extensions like .trz for compressed tar files.
-;;;   To handle these sorts of files, you have to add an entry to
-;;;   jka-compr-compression-info-list that looks something like this: 
-;;;
-;;;      ["\\.trz\\'" "\037\213"
-;;;       "zip"   "gzip"  nil  ("-q")
-;;;       "unzip" "gzip"  nil  ("-q" "-d")
-;;;       t
-;;;       nil]
-;;;
-;;;   The last nil in the vector (the "extension" field) prevents jka-compr
-;;;   from attempting to add .trz to an ordinary file name when it is looking
-;;;   for a compressed version of that file (i.e. don't look for things like
-;;;   foobar.c.trz).
-;;;
-;;;   Finally, to make tar-mode start up automatically, you have to add an
-;;;   entry to auto-mode-alist that looks like this
-;;;
-;;;       ("\\.trz\\'" . tar-mode)
-;;;
-
-
-;;; ACKNOWLEDGMENTS
-;;; 
-;;; 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 
-;;; jka-compr.  I recall the following people as being particularly helpful.
-;;;
-;;;   Jean-loup Gailly
-;;;   David Hughes
-;;;   Richard Pieri
-;;;   Daniel Quinlan
-;;;   Chris P. Ross
-;;;   Rick Sladkey
-;;;
-;;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for
-;;; Version 18 of Emacs.
-;;;
-;;; After I had made progress on the original jka-compr for V18, I learned of a
-;;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly
-;;; what I was trying to do.  I looked over the jam-zcat source code and
-;;; probably got some ideas from it.
-;;;
+;; This file is part of GNU Emacs.
+
+;; 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 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; 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., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This package implements low-level support for reading, writing,
+;; and loading compressed files.  It hooks into the low-level file
+;; I/O functions (including write-region and insert-file-contents) so
+;; that they automatically compress or uncompress a file if the file
+;; appears to need it (based on the extension of the file name).
+;; Packages like Rmail, VM, GNUS, and Info should be able to work
+;; with compressed files without modification.
+
+
+;; INSTRUCTIONS:
+;;
+;; 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 default value of this variable allows jka-compr to work with
+;; Unix compress and gzip.
+;;
+;; If you don't want messages about compressing and decompressing
+;; 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.
+
+
+;; APPLICATION NOTES:
+;;
+;; crypt++
+;;   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
+;;   decode encrypted compressed files--that is, files that have been
+;;   compressed then encrypted (in that order).  Theoretically, crypt++ and
+;;   jka-compr could properly handle a file that has been encrypted then
+;;   compressed, but there is little point in trying to compress an encrypted
+;;   file.
+;;
+
+
+;; ACKNOWLEDGMENTS
+;;
+;; 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
+;; jka-compr.  I recall the following people as being particularly helpful.
+;;
+;;   Jean-loup Gailly
+;;   David Hughes
+;;   Richard Pieri
+;;   Daniel Quinlan
+;;   Chris P. Ross
+;;   Rick Sladkey
+;;
+;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for
+;; Version 18 of Emacs.
+;;
+;; After I had made progress on the original jka-compr for V18, I learned of a
+;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly
+;; what I was trying to do.  I looked over the jam-zcat source code and
+;; probably got some ideas from it.
+;;
 
 ;;; Code:
 
 
 ;;; Code:
 
-(defvar 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').")
-
-
-(defvar jka-compr-use-shell t)
-
-
-;;; I have this defined so that .Z files are assumed to be in unix
-;;; compress format; and .gz files, in gzip format.
-(defvar jka-compr-compression-info-list
-  ;;[regexp
-  ;; compr-message  compr-prog  compr-discard  compr-args
-  ;; uncomp-message uncomp-prog uncomp-discard uncomp-args
-  ;; can-append auto-mode-flag]
-  '(["\\.Z~?\\'"
-     "compressing"    "compress"     ("-c")
-     "uncompressing"  "uncompress"   ("-c")
-     nil t]
-    ["\\.gz~?\\'"
-     "zipping"        "gzip"         ("-c" "-q")
-     "unzipping"      "gzip"         ("-c" "-q" "-d")
-     t t])
-
-  "List of vectors that describe available compression techniques.
-Each element, which describes a compression technique, is a vector of
-the form [regexp magic compress-name compress-program compress-discard-err
-compress-args uncompress-name uncompress-program uncompress-discard-err
-uncompress-args append-flag extension] where:
-
-   regexp                is a regexp that matches filenames that are
-                         compressed with this format
-
-   compress-program      is a program that performs this compression
-
-   compress-args         is a list of args to pass to the compress program
-
-   uncompress-message    is the message to issue to the user when this
-                         type of uncompression is taking place (nil
-                         means don't issue any 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
-
-   auto-mode flag        non-nil means strip the regexp from file names
-                         before attempting to set the mode.
-
-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.")
-
-
-;;; Functions for accessing the return value of jka-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))
+(require 'jka-cmpr-hook)
 
 
+(defcustom jka-compr-shell "sh"
+  "*Shell to be used for calling compression programs.
+NOTE: Not used in MS-DOS and Windows systems."
+  :type 'string
+  :group 'jka-compr)
 
 
-(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)))
+(defvar jka-compr-use-shell
+  (not (memq system-type '(ms-dos windows-nt))))
 
 
+(defvar jka-compr-really-do-compress nil
+  "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 'compression-error 'error-conditions '(compression-error file-error error))
 
 
 
 (put 'compression-error 'error-conditions '(compression-error file-error error))
 
 
-(defvar jka-compr-acceptable-retval-list '(0 141))
+(defvar jka-compr-acceptable-retval-list '(0 141))
 
 
 (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)))
-    (set-buffer errbuf)
-    (widen) (erase-buffer)
-    (insert (format "Error while executing \"%s %s < %s\"\n\n"
-                    prog
-                    (mapconcat 'identity args " ")
-                    infile))
-
-     (and errfile
-         (insert-file-contents errfile))
+  (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"
+                     prog
+                     (mapconcat 'identity args " ")
+                     infile))
 
 
-     (set-buffer curbuf)
+      (and errfile
+          (insert-file-contents errfile)))
      (display-buffer errbuf))
 
      (display-buffer errbuf))
 
-  (signal 'compression-error (list "Opening input file" (format "error %s" message) infile)))
-                       
-   
-(defvar jka-compr-dd-program
-  "/bin/dd")
+  (signal 'compression-error
+         (list "Opening input file" (format "error %s" message) infile)))
+
+
+(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)
@@ -231,243 +147,232 @@ based on the filename itself and `jka-compr-compression-info-list'."
 (defun jka-compr-partial-uncompress (prog message args infile beg len)
   "Call program PROG with ARGS args taking input from INFILE.
 Fourth and fifth args, BEG and LEN, specify which part of the output
 (defun jka-compr-partial-uncompress (prog message args infile beg len)
   "Call program PROG with ARGS args taking input from INFILE.
 Fourth and fifth args, BEG and LEN, specify which part of the output
-to discard.  All output is discarded unless it comes within LEN chars after
-the BEGth char."
-
-  (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))
-
+to keep: LEN chars starting BEG chars from the beginning."
+  (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))
+             ;; 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))
+               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
      len
     (and
      len
+     (< (+ start prefix len) (point))
      (delete-region (+ start prefix len) (point)))
 
      (delete-region (+ start prefix len) (point)))
 
+    ;; Delete the stuff before what we want.
     (delete-region start (+ start prefix))))
 
 
 (defun jka-compr-call-process (prog message infile output temp args)
     (delete-region start (+ start prefix))))
 
 
 (defun jka-compr-call-process (prog message infile output temp args)
-  (if jka-compr-use-shell
-
-      (let ((err-file (jka-compr-make-temp-name)))
-           
-       (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)
-        (let ((cbuf (current-buffer)))
-          (set-buffer temp)
-          (write-region (point-min) (point-max) output)
-          (erase-buffer)
-          (set-buffer cbuf)))))
-
-
-;;; Support for temp files.  Much of this was inspired if not lifted
-;;; from ange-ftp.
-
-(defvar jka-compr-temp-name-template
-  "/tmp/jka-com"
+  ;; 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)
   "Prefix added to all temp files created by jka-compr.
   "Prefix added to all temp files created by jka-compr.
-There should be no more than seven characters after the final `/'")
-
-(defvar jka-compr-temp-name-table (make-vector 31 nil))
+There should be no more than seven characters after the final `/'."
+  :type 'string
+  :group 'jka-compr)
 
 (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)
-
-    (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)))
+  (make-temp-file jka-compr-temp-name-template))
 
 
-    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)
 
 
 (defun jka-compr-write-region (start end file &optional append visit)
-  "Documented as original."
-  (interactive "r\nFWrite region to file: ")
-
   (let* ((filename (expand-file-name file))
         (visit-file (if (stringp visit) (expand-file-name visit) filename))
   (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))
-               (temp-file (jka-compr-make-temp-name))
-               (base-name (file-name-nondirectory visit-file))
-               cbuf temp-buffer)
-
-           (setq cbuf (current-buffer)
-                 temp-buffer (get-buffer-create " *jka-compr-temp*"))
-           (set-buffer temp-buffer)
-           (widen) (erase-buffer)
-           (set-buffer cbuf)
-
-           (and append
-                (not can-append)
-                (file-exists-p filename)
-                (let* ((local-copy (file-local-copy filename))
-                       (local-file (or local-copy filename)))
-
-                  (unwind-protect
-
-                      (progn
-                     
-                        (and
-                         uncompress-message
-                         (message "%s %s..." uncompress-message base-name))
-
-                        (jka-compr-call-process uncompress-program
-                                                (concat uncompress-message
-                                                        " " base-name)
-                                                local-file
-                                                temp-file
-                                                temp-buffer
-                                                uncompress-args)
-                        (and
-                         uncompress-message
-                         (message "%s %s...done" uncompress-message base-name)))
-                    
-                    (and
-                     local-copy
-                     (file-exists-p local-copy)
-                     (delete-file local-copy)))))
-
-           (and 
-            compress-message
-            (message "%s %s..." compress-message base-name))
-
-           (write-region start end temp-file t 'dont)
+        (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 (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))
+             (compress-args (jka-compr-info-compress-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))
+
+          (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))
+
+         (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
            (jka-compr-call-process compress-program
                                    (concat compress-message
                                            " " base-name)
                                    temp-file
                                    temp-buffer
                                    nil
-                                   compress-args)
+                                   compress-args))
 
 
-           (set-buffer temp-buffer)
-           (write-region (point-min) (point-max)
-                         filename (and append can-append) 'dont)
-           (erase-buffer)
-           (set-buffer cbuf)
+         (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)
+         (jka-compr-delete-temp-file temp-file)
 
 
-           (and
-            compress-message
-            (message "%s %s...done" compress-message base-name))
+         (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))))
+         (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))
+         (and (or (eq visit t)
+                  (eq visit nil)
+                  (stringp visit))
+              (message "Wrote %s" visit-file))
 
 
-           nil)
-             
-       (write-region start end filename append visit))))
+         ;; ensure `last-coding-system-used' has an appropriate value
+         (setq last-coding-system-used coding-system-used)
 
 
+         nil)
 
 
-(defun jka-compr-insert-file-contents (file &optional visit beg end replace)
-  "Documented as original."
+      (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)
   (barf-if-buffer-read-only)
 
   (and (or beg end)
   (barf-if-buffer-read-only)
 
   (and (or beg end)
@@ -484,7 +389,8 @@ There should be no more than seven characters after the final `/'")
              (uncompress-args (jka-compr-info-uncompress-args info))
              (base-name (file-name-nondirectory filename))
              (notfound nil)
              (uncompress-args (jka-compr-info-uncompress-args info))
              (base-name (file-name-nondirectory filename))
              (notfound nil)
-             (local-copy (file-local-copy filename))
+             (local-copy
+              (jka-compr-run-real-handler 'file-local-copy (list filename)))
              local-file
              size start)
 
              local-file
              size start)
 
@@ -497,14 +403,16 @@ 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 (or beg end)
                          (jka-compr-partial-uncompress uncompress-program
                      (setq start (point))
                      (if (or beg end)
                          (jka-compr-partial-uncompress uncompress-program
@@ -516,25 +424,40 @@ There should be no more than seven characters after the final `/'")
                                                        (if (and beg end)
                                                            (- end beg)
                                                          end))
                                                        (if (and beg end)
                                                            (- end beg)
                                                          end))
-                       (jka-compr-call-process uncompress-program
-                                               (concat uncompress-message
-                                                       " " base-name)
-                                               local-file
-                                               t
-                                               nil
-                                               uncompress-args))
+                       ;; 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))
                      (setq size (- (point) start))
+                     (if replace
+                         (delete-region (point) (point-max)))
                      (goto-char start))
                      (goto-char start))
-
-
                  (error
                  (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
@@ -542,12 +465,20 @@ 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
+            (unlock-buffer)
             (setq buffer-file-name filename)
             (setq buffer-file-name filename)
+            (setq jka-compr-really-do-compress t)
             (set-visited-file-modtime)))
             (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))
@@ -558,14 +489,33 @@ There should be no more than seven characters after the final `/'")
           (signal 'file-error
                   (cons "Opening input file" (nth 2 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))
 
          (list filename size))
 
-      (insert-file-contents file visit beg end replace))))
+      (jka-compr-run-real-handler 'insert-file-contents
+                                 (list file visit beg end replace)))))
 
 
 (defun jka-compr-file-local-copy (file)
 
 
 (defun jka-compr-file-local-copy (file)
-  "Documented as original."
-
   (let* ((filename (expand-file-name file))
         (info (jka-compr-get-compression-info filename)))
 
   (let* ((filename (expand-file-name file))
         (info (jka-compr-get-compression-info filename)))
 
@@ -575,54 +525,58 @@ There should be no more than seven characters after the final `/'")
              (uncompress-program (jka-compr-info-uncompress-program info))
              (uncompress-args (jka-compr-info-uncompress-args info))
              (base-name (file-name-nondirectory filename))
              (uncompress-program (jka-compr-info-uncompress-program info))
              (uncompress-args (jka-compr-info-uncompress-args info))
              (base-name (file-name-nondirectory filename))
-             (local-copy (file-local-copy filename))
+             (local-copy
+              (jka-compr-run-real-handler 'file-local-copy (list filename)))
              (temp-file (jka-compr-make-temp-name t))
              (temp-file (jka-compr-make-temp-name t))
-             (temp-buffer (get-buffer-create " *jka-compr-temp*"))
-             (notfound nil)
-             (cbuf (current-buffer))
+             (temp-buffer (get-buffer-create " *jka-compr-flc-temp*"))
              local-file)
 
          (setq local-file (or local-copy filename))
 
          (unwind-protect
 
              local-file)
 
          (setq local-file (or local-copy filename))
 
          (unwind-protect
 
-             (progn
-                 
-               (and
-                uncompress-message
-                (message "%s %s..." uncompress-message base-name))
-
-               (set-buffer temp-buffer)
-                 
-               (jka-compr-call-process uncompress-program
-                                       (concat uncompress-message
-                                               " " base-name)
-                                       local-file
-                                       t
-                                       nil
-                                       uncompress-args)
+             (with-current-buffer temp-buffer
 
                (and
                 uncompress-message
 
                (and
                 uncompress-message
-                (message "%s %s...done" uncompress-message base-name))
+                (message "%s %s..." uncompress-message base-name))
 
 
-               (write-region
-                (point-min) (point-max) temp-file nil 'dont))
+               ;; Here we must read the output of uncompress program
+               ;; and write it to TEMP-FILE without any code
+               ;; conversion.  An appropriate code conversion (if
+               ;; necessary) is done by the later I/O operation
+               ;; (e.g. load).
+               (let ((coding-system-for-read 'no-conversion)
+                     (coding-system-for-write 'no-conversion))
+
+                 (jka-compr-call-process uncompress-program
+                                         (concat uncompress-message
+                                                 " " base-name)
+                                         local-file
+                                         t
+                                         nil
+                                         uncompress-args)
+
+                 (and
+                  uncompress-message
+                  (message "%s %s...done" uncompress-message base-name))
+
+                 (write-region
+                  (point-min) (point-max) temp-file nil 'dont)))
 
            (and
             local-copy
             (file-exists-p local-copy)
             (delete-file local-copy))
 
 
            (and
             local-copy
             (file-exists-p local-copy)
             (delete-file local-copy))
 
-           (set-buffer cbuf)
            (kill-buffer temp-buffer))
 
          temp-file)
            (kill-buffer temp-buffer))
 
          temp-file)
-           
-      (file-local-copy 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."
 
@@ -631,52 +585,53 @@ There should be no more than seven characters after the final `/'")
 
     (unwind-protect
 
 
     (unwind-protect
 
-       (progn
-
-         (setq file-name-handler-alist
-               (cons jka-compr-file-name-handler-entry
-                     file-name-handler-alist))
-
+       (let (inhibit-file-name-operation
+             inhibit-file-name-handlers)
          (or nomessage
              (message "Loading %s..." file))
 
          (or nomessage
              (message "Loading %s..." file))
 
-         (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)))
-
-      (setq file-name-handler-alist
-           (delq jka-compr-file-name-handler-entry
-                 file-name-handler-alist))
+             (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))
 
     t))
 
 
       (jka-compr-delete-temp-file local-copy))
 
     t))
 
-
-(defvar jka-compr-file-name-handler-entry
-  nil
-  "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.")
-
-
+(defun jka-compr-byte-compiler-base-file-name (file)
+  (let ((info (jka-compr-get-compression-info file)))
+    (if (and info (jka-compr-info-strip-extension info))
+       (save-match-data
+         (substring file 0 (string-match (jka-compr-info-regexp info) file)))
+      file)))
+\f
+(put 'write-region 'jka-compr 'jka-compr-write-region)
+(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
+(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
+(put 'load 'jka-compr 'jka-compr-load)
+(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.")
+
+;;;###autoload
 (defun jka-compr-handler (operation &rest args)
 (defun jka-compr-handler (operation &rest args)
-
-  (let ((jka-op (intern-soft (symbol-name operation) jka-compr-op-table))
-       (match-data (match-data)))
-
-    (unwind-protect
-       (progn
-         (setq file-name-handler-alist
-               (delq jka-compr-file-name-handler-entry
-                     file-name-handler-alist))
-         (if jka-op
-             (apply jka-op args)
-           (jka-compr-run-real-handler operation args)))
-
-      (setq file-name-handler-alist
-           (cons jka-compr-file-name-handler-entry
-                 file-name-handler-alist))
-      (store-match-data match-data))))
+  (save-match-data
+    (let ((jka-op (get operation 'jka-compr)))
+      (if (and jka-op (not jka-compr-inhibit))
+         (apply jka-op args)
+       (jka-compr-run-real-handler operation args)))))
 
 ;; If we are given an operation that we don't handle,
 ;; call the Emacs primitive for that operation,
 
 ;; If we are given an operation that we don't handle,
 ;; call the Emacs primitive for that operation,
@@ -690,100 +645,21 @@ There should be no more than seven characters after the final `/'")
        (inhibit-file-name-operation operation))
     (apply operation args)))
 
        (inhibit-file-name-operation operation))
     (apply operation args)))
 
-  
-(defvar jka-compr-op-table
-  (make-vector 127 0)
-  "Hash table of operations supported by jka-compr.")
-
-
-(defun jka-compr-intern-operation (op)
-  (let ((opsym (intern (symbol-name op) jka-compr-op-table))
-       (jka-fn (intern (concat "jka-compr-" (symbol-name op)))))
-    (fset opsym jka-fn)))
-
-
-(defvar jka-compr-operation-list
-  '(
-    write-region
-    insert-file-contents
-    file-local-copy
-    load
-    )
-  "List of file operations implemented by jka-compr.")
-
-
-(mapcar
- (function
-  (lambda (fn)
-    (jka-compr-intern-operation fn)))
- jka-compr-operation-list)
-
-
-(defun toggle-auto-compression (arg)
-  "Toggle automatic file compression and decompression.
-With prefix argument ARG, turn auto compression on if positive, else off.
-Returns the new status of auto compression (non-nil means on)."
-  (interactive "P")
-  (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 (interactive-p)
-        (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 ()
-  (concat
-   "\\("
-   (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'."
-
-  (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))
-
-  (mapcar
-   (function (lambda (x)
-              (and
-               (jka-compr-info-strip-extension x)
-               (setq auto-mode-alist (cons (list (jka-compr-info-regexp x)
-                                                 nil 'jka-compr)
-                                           auto-mode-alist)))))
-
-   jka-compr-compression-info-list))
-
-
+;;;###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'
-that were created by `jka-compr-installed'."
+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.
+  (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--internal)
 
   (let* ((fnha (cons nil file-name-handler-alist))
         (last fnha))
 
   (let* ((fnha (cons nil file-name-handler-alist))
         (last fnha))
@@ -801,38 +677,29 @@ that were created by `jka-compr-installed'."
 
     (while (cdr last)
       (setq entry (car (cdr last)))
 
     (while (cdr last)
       (setq entry (car (cdr last)))
-      (if (and (consp (cdr entry))
-              (eq (nth 2 entry) 'jka-compr))
+      (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))))
          (setcdr last (cdr (cdr last)))
        (setq last (cdr last))))
-    
-    (setq auto-mode-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))
+  (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)))
 
 
-(jka-compr-install)
+  ;; 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