lisp/jka-compr.el

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