lisp/jka-compr.el

   1 ;;; jka-compr.el --- reading/writing/loading compressed files
   2
   3 ;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
   4 ;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
   7 ;; Maintainer: FSF
   8 ;; Keywords: data
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; This package implements low-level support for reading, writing,
  28 ;; and loading compressed files.  It hooks into the low-level file
  29 ;; I/O functions (including write-region and insert-file-contents) so
  30 ;; that they automatically compress or uncompress a file if the file
  31 ;; appears to need it (based on the extension of the file name).
  32 ;; Packages like Rmail, VM, GNUS, and Info should be able to work
  33 ;; with compressed files without modification.
  34
  35
  36 ;; INSTRUCTIONS:
  37 ;;
  38 ;; To use jka-compr, invoke the command `auto-compression-mode' (which
  39 ;; see), or customize the variable of the same name.  Its operation
  40 ;; should be transparent to the user (except for messages appearing when
  41 ;; a file is being compressed or uncompressed).
  42 ;;
  43 ;; The variable, jka-compr-compression-info-list can be used to
  44 ;; customize jka-compr to work with other compression programs.
  45 ;; The default value of this variable allows jka-compr to work with
  46 ;; Unix compress and gzip.
  47 ;;
  48 ;; If you don't want messages about compressing and decompressing
  49 ;; to show up in the echo area, you can set the compress-msg and
  50 ;; decompress-msg fields of the jka-compr-compression-info-list to
  51 ;; nil.
  52
  53
  54 ;; APPLICATION NOTES:
  55 ;;
  56 ;; crypt++
  57 ;;   jka-compr can coexist with crypt++ if you take all the decompression
  58 ;;   entries out of the crypt-encoding-list.  Clearly problems will arise if
  59 ;;   you have two programs trying to compress/decompress files.  jka-compr
  60 ;;   will not "work with" crypt++ in the following sense: you won't be able to
  61 ;;   decode encrypted compressed files--that is, files that have been
  62 ;;   compressed then encrypted (in that order).  Theoretically, crypt++ and
  63 ;;   jka-compr could properly handle a file that has been encrypted then
  64 ;;   compressed, but there is little point in trying to compress an encrypted
  65 ;;   file.
  66 ;;
  67
  68
  69 ;; ACKNOWLEDGMENTS
  70 ;;
  71 ;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs.  Many people
  72 ;; have made helpful suggestions, reported bugs, and even fixed bugs in
  73 ;; jka-compr.  I recall the following people as being particularly helpful.
  74 ;;
  75 ;;   Jean-loup Gailly
  76 ;;   David Hughes
  77 ;;   Richard Pieri
  78 ;;   Daniel Quinlan
  79 ;;   Chris P. Ross
  80 ;;   Rick Sladkey
  81 ;;
  82 ;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for
  83 ;; Version 18 of Emacs.
  84 ;;
  85 ;; After I had made progress on the original jka-compr for V18, I learned of a
  86 ;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly
  87 ;; what I was trying to do.  I looked over the jam-zcat source code and
  88 ;; probably got some ideas from it.
  89 ;;
  90
  91 ;;; Code:
  92
  93 (require 'jka-cmpr-hook)
  94
  95 (defcustom jka-compr-shell "sh"
  96   "*Shell to be used for calling compression programs.
  97 NOTE: Not used in MS-DOS and Windows systems."
  98   :type 'string
  99   :group 'jka-compr)
 100
 101 (defvar jka-compr-use-shell
 102   (not (memq system-type '(ms-dos windows-nt))))
 103
 104 (defvar jka-compr-really-do-compress nil
 105   "Non-nil in a buffer whose visited file was uncompressed on visiting it.
 106 This means compress the data on writing the file, even if the
 107 data appears to be compressed already.")
 108 (make-variable-buffer-local 'jka-compr-really-do-compress)
 109 (put 'jka-compr-really-do-compress 'permanent-local t)
 110 \f
 111
 112 (put 'compression-error 'error-conditions '(compression-error file-error error))
 113
 114
 115 (defvar jka-compr-acceptable-retval-list '(0 2 141))
 116
 117
 118 (defun jka-compr-error (prog args infile message &optional errfile)
 119
 120   (let ((errbuf (get-buffer-create " *jka-compr-error*")))
 121     (with-current-buffer errbuf
 122       (widen) (erase-buffer)
 123       (insert (format "Error while executing \"%s %s < %s\"\n\n"
 124                       prog
 125                       (mapconcat 'identity args " ")
 126                       infile))
 127
 128       (and errfile
 129            (insert-file-contents errfile)))
 130      (display-buffer errbuf))
 131
 132   (signal 'compression-error
 133           (list "Opening input file" (format "error %s" message) infile)))
 134
 135
 136 (defcustom jka-compr-dd-program "/bin/dd"
 137   "How to invoke `dd'."
 138   :type 'string
 139   :group 'jka-compr)
 140
 141
 142 (defvar jka-compr-dd-blocksize 256)
 143
 144
 145 (defun jka-compr-partial-uncompress (prog message args infile beg len)
 146   "Call program PROG with ARGS args taking input from INFILE.
 147 Fourth and fifth args, BEG and LEN, specify which part of the output
 148 to keep: LEN chars starting BEG chars from the beginning."
 149   (let ((start (point))
 150         (prefix beg))
 151     (if (and jka-compr-use-shell jka-compr-dd-program)
 152         ;; Put the uncompression output through dd
 153         ;; to discard the part we don't want.
 154         (let ((skip (/ beg jka-compr-dd-blocksize))
 155               (err-file (jka-compr-make-temp-name))
 156               ;; call-process barfs if default-directory is inaccessible.
 157               (default-directory
 158                 (if (and default-directory
 159                          (file-accessible-directory-p default-directory))
 160                     default-directory
 161                   (file-name-directory infile)))
 162               count)
 163           ;; Update PREFIX based on the text that we won't read in.
 164           (setq prefix (- beg (* skip jka-compr-dd-blocksize))
 165                 count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
 166           (unwind-protect
 167               (or (memq (call-process
 168                          jka-compr-shell infile t nil "-c"
 169                          (format
 170                           "%s %s 2> %s | %s bs=%d skip=%d %s 2> %s"
 171                           prog
 172                           (mapconcat 'identity args " ")
 173                           err-file
 174                           jka-compr-dd-program
 175                           jka-compr-dd-blocksize
 176                           skip
 177                           ;; dd seems to be unreliable about
 178                           ;; providing the last block.  So, always
 179                           ;; read one more than you think you need.
 180                           (if count (format "count=%d" (1+ count)) "")
 181                           null-device))
 182                         jka-compr-acceptable-retval-list)
 183                   (jka-compr-error prog args infile message err-file))
 184             (jka-compr-delete-temp-file err-file)))
 185       ;; Run the uncompression program directly.
 186       ;; We get the whole file and must delete what we don't want.
 187       (jka-compr-call-process prog message infile t nil args))
 188
 189     ;; Delete the stuff after what we want, if there is any.
 190     (and
 191      len
 192      (< (+ start prefix len) (point))
 193      (delete-region (+ start prefix len) (point)))
 194
 195     ;; Delete the stuff before what we want.
 196     (delete-region start (+ start prefix))))
 197
 198
 199 (defun jka-compr-call-process (prog message infile output temp args)
 200   ;; call-process barfs if default-directory is inaccessible.
 201   (let ((default-directory
 202           (if (and default-directory
 203                    (file-accessible-directory-p default-directory))
 204               default-directory
 205             (file-name-directory infile))))
 206     (if jka-compr-use-shell
 207         (let ((err-file (jka-compr-make-temp-name))
 208               (coding-system-for-read (or coding-system-for-read 'undecided))
 209               (coding-system-for-write 'no-conversion))
 210           (unwind-protect
 211               (or (memq
 212                    (call-process jka-compr-shell infile
 213                                  (if (stringp output) nil output)
 214                                  nil
 215                                  "-c"
 216                                  (format "%s %s 2> %s %s"
 217                                          prog
 218                                          (mapconcat 'identity args " ")
 219                                          err-file
 220                                          (if (stringp output)
 221                                              (concat "> " output)
 222                                            "")))
 223                    jka-compr-acceptable-retval-list)
 224                   (jka-compr-error prog args infile message err-file))
 225             (jka-compr-delete-temp-file err-file)))
 226       (or (eq 0
 227               (apply 'call-process
 228                      prog infile (if (stringp output) temp output)
 229                      nil args))
 230           (jka-compr-error prog args infile message))
 231       (and (stringp output)
 232            (with-current-buffer temp
 233              (write-region (point-min) (point-max) output)
 234              (erase-buffer))))))
 235
 236
 237 ;; Support for temp files.  Much of this was inspired if not lifted
 238 ;; from ange-ftp.
 239
 240 (defcustom jka-compr-temp-name-template
 241   (expand-file-name "jka-com" temporary-file-directory)
 242   "Prefix added to all temp files created by jka-compr.
 243 There should be no more than seven characters after the final `/'."
 244   :type 'string
 245   :group 'jka-compr)
 246
 247 (defun jka-compr-make-temp-name (&optional local-copy)
 248   "This routine will return the name of a new file."
 249   (make-temp-file jka-compr-temp-name-template))
 250
 251 (defalias 'jka-compr-delete-temp-file 'delete-file)
 252
 253
 254 (defun jka-compr-write-region (start end file &optional append visit)
 255   (let* ((filename (expand-file-name file))
 256          (visit-file (if (stringp visit) (expand-file-name visit) filename))
 257          (info (jka-compr-get-compression-info visit-file))
 258          (magic (and info (jka-compr-info-file-magic-bytes info))))
 259
 260     ;; If START is nil, use the whole buffer.
 261     (if (null start)
 262         (setq start 1 end (1+ (buffer-size))))
 263
 264     ;; If we uncompressed this file when visiting it,
 265     ;; then recompress it when writing it
 266     ;; even if the contents look compressed already.
 267     (if (and jka-compr-really-do-compress
 268              (eq start 1)
 269              (eq end (1+ (buffer-size))))
 270         (setq magic nil))
 271
 272     (if (and info
 273              ;; If the contents to be written out
 274              ;; are properly compressed already,
 275              ;; don't try to compress them over again.
 276              (not (and magic
 277                        (equal (if (stringp start)
 278                                   (substring start 0 (min (length start)
 279                                                           (length magic)))
 280                                 (buffer-substring start
 281                                                   (min end
 282                                                        (+ start (length magic)))))
 283                               magic))))
 284         (let ((can-append (jka-compr-info-can-append info))
 285               (compress-program (jka-compr-info-compress-program info))
 286               (compress-message (jka-compr-info-compress-message info))
 287               (compress-args (jka-compr-info-compress-args info))
 288               (base-name (file-name-nondirectory visit-file))
 289               temp-file temp-buffer
 290               ;; we need to leave `last-coding-system-used' set to its
 291               ;; value after calling write-region the first time, so
 292               ;; that `basic-save-buffer' sees the right value.
 293               (coding-system-used last-coding-system-used))
 294
 295           (or compress-program
 296               (error "No compression program defined"))
 297
 298           (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
 299           (with-current-buffer temp-buffer
 300             (widen) (erase-buffer))
 301
 302           (if (and append
 303                    (not can-append)
 304                    (file-exists-p filename))
 305
 306               (let* ((local-copy (file-local-copy filename))
 307                      (local-file (or local-copy filename)))
 308
 309                 (setq temp-file local-file))
 310
 311             (setq temp-file (jka-compr-make-temp-name)))
 312
 313           (and
 314            compress-message
 315            (message "%s %s..." compress-message base-name))
 316
 317           (jka-compr-run-real-handler 'write-region
 318                                       (list start end temp-file t 'dont))
 319           ;; save value used by the real write-region
 320           (setq coding-system-used last-coding-system-used)
 321
 322           ;; Here we must read the output of compress program as is
 323           ;; without any code conversion.
 324           (let ((coding-system-for-read 'no-conversion))
 325             (jka-compr-call-process compress-program
 326                                     (concat compress-message
 327                                             " " base-name)
 328                                     temp-file
 329                                     temp-buffer
 330                                     nil
 331                                     compress-args))
 332
 333           (with-current-buffer temp-buffer
 334             (let ((coding-system-for-write 'no-conversion))
 335               (if (memq system-type '(ms-dos windows-nt))
 336                   (setq buffer-file-type t) )
 337               (jka-compr-run-real-handler 'write-region
 338                                           (list (point-min) (point-max)
 339                                                 filename
 340                                                 (and append can-append) 'dont))
 341               (erase-buffer)) )
 342
 343           (jka-compr-delete-temp-file temp-file)
 344
 345           (and
 346            compress-message
 347            (message "%s %s...done" compress-message base-name))
 348
 349           (cond
 350            ((eq visit t)
 351             (setq buffer-file-name filename)
 352             (setq jka-compr-really-do-compress t)
 353             (set-visited-file-modtime))
 354            ((stringp visit)
 355             (setq buffer-file-name visit)
 356             (let ((buffer-file-name filename))
 357               (set-visited-file-modtime))))
 358
 359           (and (or (eq visit t)
 360                    (eq visit nil)
 361                    (stringp visit))
 362                (message "Wrote %s" visit-file))
 363
 364           ;; ensure `last-coding-system-used' has an appropriate value
 365           (setq last-coding-system-used coding-system-used)
 366
 367           nil)
 368
 369       (jka-compr-run-real-handler 'write-region
 370                                   (list start end filename append visit)))))
 371
 372
 373 (defun jka-compr-insert-file-contents (file &optional visit beg end replace)
 374   (barf-if-buffer-read-only)
 375
 376   (and (or beg end)
 377        visit
 378        (error "Attempt to visit less than an entire file"))
 379
 380   (let* ((filename (expand-file-name file))
 381          (info (jka-compr-get-compression-info filename)))
 382
 383     (if (not info)
 384
 385         (jka-compr-run-real-handler 'insert-file-contents
 386                                     (list file visit beg end replace))
 387
 388       (let ((uncompress-message (jka-compr-info-uncompress-message info))
 389             (uncompress-program (jka-compr-info-uncompress-program info))
 390             (uncompress-args (jka-compr-info-uncompress-args info))
 391             (base-name (file-name-nondirectory filename))
 392             (notfound nil)
 393             (local-copy
 394              (jka-compr-run-real-handler 'file-local-copy (list filename)))
 395             local-file
 396             size start)
 397
 398         (setq local-file (or local-copy filename))
 399
 400         (and
 401          visit
 402          (setq buffer-file-name filename))
 403
 404         (unwind-protect               ; to make sure local-copy gets deleted
 405
 406             (progn
 407
 408               (and
 409                uncompress-message
 410                (message "%s %s..." uncompress-message base-name))
 411
 412               (condition-case error-code
 413
 414                   (let ((coding-system-for-read 'no-conversion))
 415                     (if replace
 416                         (goto-char (point-min)))
 417                     (setq start (point))
 418                     (if (or beg end)
 419                         (jka-compr-partial-uncompress uncompress-program
 420                                                       (concat uncompress-message
 421                                                               " " base-name)
 422                                                       uncompress-args
 423                                                       local-file
 424                                                       (or beg 0)
 425                                                       (if (and beg end)
 426                                                           (- end beg)
 427                                                         end))
 428                       ;; If visiting, bind off buffer-file-name so that
 429                       ;; file-locking will not ask whether we should
 430                       ;; really edit the buffer.
 431                       (let ((buffer-file-name
 432                              (if visit nil buffer-file-name)))
 433                         (jka-compr-call-process uncompress-program
 434                                                 (concat uncompress-message
 435                                                         " " base-name)
 436                                                 local-file
 437                                                 t
 438                                                 nil
 439                                                 uncompress-args)))
 440                     (setq size (- (point) start))
 441                     (if replace
 442                         (delete-region (point) (point-max)))
 443                     (goto-char start))
 444                 (error
 445                  ;; If the file we wanted to uncompress does not exist,
 446                  ;; handle that according to VISIT as `insert-file-contents'
 447                  ;; would, maybe signaling the same error it normally would.
 448                  (if (and (eq (car error-code) 'file-error)
 449                           (eq (nth 3 error-code) local-file))
 450                      (if visit
 451                          (setq notfound error-code)
 452                        (signal 'file-error
 453                                (cons "Opening input file"
 454                                      (nthcdr 2 error-code))))
 455                    ;; If the uncompression program can't be found,
 456                    ;; signal that as a non-file error
 457                    ;; so that find-file-noselect-1 won't handle it.
 458                    (if (and (eq (car error-code) 'file-error)
 459                             (equal (cadr error-code) "Searching for program"))
 460                        (error "Uncompression program `%s' not found"
 461                               (nth 3 error-code)))
 462                    (signal (car error-code) (cdr error-code))))))
 463
 464           (and
 465            local-copy
 466            (file-exists-p local-copy)
 467            (delete-file local-copy)))
 468
 469         (unless notfound
 470           (decode-coding-inserted-region
 471            (point) (+ (point) size)
 472            (jka-compr-byte-compiler-base-file-name file)
 473            visit beg end replace))
 474
 475         (and
 476          visit
 477          (progn
 478            (unlock-buffer)
 479            (setq buffer-file-name filename)
 480            (setq jka-compr-really-do-compress t)
 481            (set-visited-file-modtime)))
 482
 483         (and
 484          uncompress-message
 485          (message "%s %s...done" uncompress-message base-name))
 486
 487         (and
 488          visit
 489          notfound
 490          (signal 'file-error
 491                  (cons "Opening input file" (nth 2 notfound))))
 492
 493         ;; This is done in insert-file-contents after we return.
 494         ;; That is a little weird, but better to go along with it now
 495         ;; than to change it now.
 496
 497         ;; ;; Run the functions that insert-file-contents would.
 498         ;; (let ((p after-insert-file-functions)
 499         ;;       (insval size))
 500         ;;   (while p
 501         ;;     (setq insval (funcall (car p) size))
 502         ;;     (if insval
 503         ;;         (progn
 504         ;;           (or (integerp insval)
 505         ;;              (signal 'wrong-type-argument
 506         ;;                      (list 'integerp insval)))
 507         ;;           (setq size insval)))
 508         ;;     (setq p (cdr p))))
 509
 510         (or (jka-compr-info-compress-program info)
 511             (message "You can't save this buffer because compression program is not defined"))
 512
 513         (list filename size)))))
 514
 515
 516 (defun jka-compr-file-local-copy (file)
 517   (let* ((filename (expand-file-name file))
 518          (info (jka-compr-get-compression-info filename)))
 519
 520     (if info
 521
 522         (let ((uncompress-message (jka-compr-info-uncompress-message info))
 523               (uncompress-program (jka-compr-info-uncompress-program info))
 524               (uncompress-args (jka-compr-info-uncompress-args info))
 525               (base-name (file-name-nondirectory filename))
 526               (local-copy
 527                (jka-compr-run-real-handler 'file-local-copy (list filename)))
 528               (temp-file (jka-compr-make-temp-name t))
 529               (temp-buffer (get-buffer-create " *jka-compr-flc-temp*"))
 530               local-file)
 531
 532           (setq local-file (or local-copy filename))
 533
 534           (unwind-protect
 535
 536               (with-current-buffer temp-buffer
 537
 538                 (and
 539                  uncompress-message
 540                  (message "%s %s..." uncompress-message base-name))
 541
 542                 ;; Here we must read the output of uncompress program
 543                 ;; and write it to TEMP-FILE without any code
 544                 ;; conversion.  An appropriate code conversion (if
 545                 ;; necessary) is done by the later I/O operation
 546                 ;; (e.g. load).
 547                 (let ((coding-system-for-read 'no-conversion)
 548                       (coding-system-for-write 'no-conversion))
 549
 550                   (jka-compr-call-process uncompress-program
 551                                           (concat uncompress-message
 552                                                   " " base-name)
 553                                           local-file
 554                                           t
 555                                           nil
 556                                           uncompress-args)
 557
 558                   (and
 559                    uncompress-message
 560                    (message "%s %s...done" uncompress-message base-name))
 561
 562                   (write-region
 563                    (point-min) (point-max) temp-file nil 'dont)))
 564
 565             (and
 566              local-copy
 567              (file-exists-p local-copy)
 568              (delete-file local-copy))
 569
 570             (kill-buffer temp-buffer))
 571
 572           temp-file)
 573
 574       (jka-compr-run-real-handler 'file-local-copy (list filename)))))
 575
 576
 577 ;; Support for loading compressed files.
 578 (defun jka-compr-load (file &optional noerror nomessage nosuffix)
 579   "Documented as original."
 580
 581   (let* ((local-copy (jka-compr-file-local-copy file))
 582          (load-file (or local-copy file)))
 583
 584     (unwind-protect
 585
 586         (let (inhibit-file-name-operation
 587               inhibit-file-name-handlers)
 588           (or nomessage
 589               (message "Loading %s..." file))
 590
 591           (let ((load-force-doc-strings t))
 592             (load load-file noerror t t))
 593           (or nomessage
 594               (message "Loading %s...done." file))
 595           ;; Fix up the load history to point at the right library.
 596           (let ((l (assoc load-file load-history)))
 597             ;; Remove .gz and .elc?.
 598             (while (file-name-extension file)
 599               (setq file (file-name-sans-extension file)))
 600             (setcar l file)))
 601
 602       (jka-compr-delete-temp-file local-copy))
 603
 604     t))
 605
 606 (defun jka-compr-byte-compiler-base-file-name (file)
 607   (let ((info (jka-compr-get-compression-info file)))
 608     (if (and info (jka-compr-info-strip-extension info))
 609         (save-match-data
 610           (substring file 0 (string-match (jka-compr-info-regexp info) file)))
 611       file)))
 612 \f
 613 (put 'write-region 'jka-compr 'jka-compr-write-region)
 614 (put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
 615 (put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
 616 (put 'load 'jka-compr 'jka-compr-load)
 617 (put 'byte-compiler-base-file-name 'jka-compr
 618      'jka-compr-byte-compiler-base-file-name)
 619
 620 ;;;###autoload
 621 (defvar jka-compr-inhibit nil
 622   "Non-nil means inhibit automatic uncompression temporarily.
 623 Lisp programs can bind this to t to do that.
 624 It is not recommended to set this variable permanently to anything but nil.")
 625
 626 ;;;###autoload
 627 (defun jka-compr-handler (operation &rest args)
 628   (save-match-data
 629     (let ((jka-op (get operation 'jka-compr)))
 630       (if (and jka-op (not jka-compr-inhibit))
 631           (apply jka-op args)
 632         (jka-compr-run-real-handler operation args)))))
 633
 634 ;; If we are given an operation that we don't handle,
 635 ;; call the Emacs primitive for that operation,
 636 ;; and manipulate the inhibit variables
 637 ;; to prevent the primitive from calling our handler again.
 638 (defun jka-compr-run-real-handler (operation args)
 639   (let ((inhibit-file-name-handlers
 640          (cons 'jka-compr-handler
 641                (and (eq inhibit-file-name-operation operation)
 642                     inhibit-file-name-handlers)))
 643         (inhibit-file-name-operation operation))
 644     (apply operation args)))
 645
 646 ;;;###autoload
 647 (defun jka-compr-uninstall ()
 648   "Uninstall jka-compr.
 649 This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
 650 and `inhibit-first-line-modes-suffixes' that were added
 651 by `jka-compr-installed'."
 652   ;; Delete from inhibit-first-line-modes-suffixes
 653   ;; what jka-compr-install added.
 654   (mapc
 655      (function (lambda (x)
 656                  (and (jka-compr-info-strip-extension x)
 657                       (setq inhibit-first-line-modes-suffixes
 658                             (delete (jka-compr-info-regexp x)
 659                                     inhibit-first-line-modes-suffixes)))))
 660      jka-compr-compression-info-list--internal)
 661
 662   (let* ((fnha (cons nil file-name-handler-alist))
 663          (last fnha))
 664
 665     (while (cdr last)
 666       (if (eq (cdr (car (cdr last))) 'jka-compr-handler)
 667           (setcdr last (cdr (cdr last)))
 668         (setq last (cdr last))))
 669
 670     (setq file-name-handler-alist (cdr fnha)))
 671
 672   (let* ((ama (cons nil auto-mode-alist))
 673          (last ama)
 674          entry)
 675
 676     (while (cdr last)
 677       (setq entry (car (cdr last)))
 678       (if (or (member entry jka-compr-mode-alist-additions--internal)
 679               (and (consp (cdr entry))
 680                    (eq (nth 2 entry) 'jka-compr)))
 681           (setcdr last (cdr (cdr last)))
 682         (setq last (cdr last))))
 683
 684     (setq auto-mode-alist (cdr ama)))
 685
 686   (while jka-compr-added-to-file-coding-system-alist
 687     (setq file-coding-system-alist
 688           (delq (car (member (pop jka-compr-added-to-file-coding-system-alist)
 689                              file-coding-system-alist))
 690                 file-coding-system-alist)))
 691
 692   ;; Remove the suffixes that were added by jka-compr.
 693   (dolist (suff jka-compr-load-suffixes--internal)
 694     (setq load-file-rep-suffixes (delete suff load-file-rep-suffixes)))
 695
 696   (setq jka-compr-compression-info-list--internal nil
 697         jka-compr-mode-alist-additions--internal nil
 698         jka-compr-load-suffixes--internal nil))
 699
 700 (provide 'jka-compr)
 701
 702 ;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc
 703 ;;; jka-compr.el ends here