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