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, 2009, 2010 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             (let (delete-by-moving-to-trash)
 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                    (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             (let (delete-by-moving-to-trash)
 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            (message "%s %s..." compress-message base-name))
 313
 314           (jka-compr-run-real-handler 'write-region
 315                                       (list start end temp-file t 'dont))
 316           ;; save value used by the real write-region
 317           (setq coding-system-used last-coding-system-used)
 318
 319           ;; Here we must read the output of compress program as is
 320           ;; without any code conversion.
 321           (let ((coding-system-for-read 'no-conversion))
 322             (jka-compr-call-process compress-program
 323                                     (concat compress-message
 324                                             " " base-name)
 325                                     temp-file
 326                                     temp-buffer
 327                                     nil
 328                                     compress-args))
 329
 330           (with-current-buffer temp-buffer
 331             (let ((coding-system-for-write 'no-conversion))
 332               (if (memq system-type '(ms-dos windows-nt))
 333                   (setq buffer-file-type t) )
 334               (jka-compr-run-real-handler 'write-region
 335                                           (list (point-min) (point-max)
 336                                                 filename
 337                                                 (and append can-append) 'dont))
 338               (erase-buffer)) )
 339
 340           (let (delete-by-moving-to-trash)
 341             (delete-file temp-file))
 342
 343           (and
 344            compress-message
 345            (message "%s %s...done" compress-message base-name))
 346
 347           (cond
 348            ((eq visit t)
 349             (setq buffer-file-name filename)
 350             (setq jka-compr-really-do-compress t)
 351             (set-visited-file-modtime))
 352            ((stringp visit)
 353             (setq buffer-file-name visit)
 354             (let ((buffer-file-name filename))
 355               (set-visited-file-modtime))))
 356
 357           (and (or (eq visit t)
 358                    (eq visit nil)
 359                    (stringp visit))
 360                (message "Wrote %s" visit-file))
 361
 362           ;; ensure `last-coding-system-used' has an appropriate value
 363           (setq last-coding-system-used coding-system-used)
 364
 365           nil)
 366
 367       (jka-compr-run-real-handler 'write-region
 368                                   (list start end filename append visit)))))
 369
 370
 371 (defun jka-compr-insert-file-contents (file &optional visit beg end replace)
 372   (barf-if-buffer-read-only)
 373
 374   (and (or beg end)
 375        visit
 376        (error "Attempt to visit less than an entire file"))
 377
 378   (let* ((filename (expand-file-name file))
 379          (info (jka-compr-get-compression-info filename)))
 380
 381     (if (not info)
 382
 383         (jka-compr-run-real-handler 'insert-file-contents
 384                                     (list file visit beg end replace))
 385
 386       (let ((uncompress-message (jka-compr-info-uncompress-message info))
 387             (uncompress-program (jka-compr-info-uncompress-program info))
 388             (uncompress-args (jka-compr-info-uncompress-args info))
 389             (base-name (file-name-nondirectory filename))
 390             (notfound nil)
 391             (local-copy
 392              (jka-compr-run-real-handler 'file-local-copy (list filename)))
 393             local-file
 394             size start)
 395
 396         (setq local-file (or local-copy filename))
 397
 398         (and
 399          visit
 400          (setq buffer-file-name filename))
 401
 402         (unwind-protect               ; to make sure local-copy gets deleted
 403
 404             (progn
 405
 406               (and
 407                uncompress-message
 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          (message "%s %s...done" uncompress-message base-name))
 484
 485         (and
 486          visit
 487          notfound
 488          (signal 'file-error
 489                  (cons "Opening input file" (nth 2 notfound))))
 490
 491         ;; This is done in insert-file-contents after we return.
 492         ;; That is a little weird, but better to go along with it now
 493         ;; than to change it now.
 494
 495         ;; ;; Run the functions that insert-file-contents would.
 496         ;; (let ((p after-insert-file-functions)
 497         ;;       (insval size))
 498         ;;   (while p
 499         ;;     (setq insval (funcall (car p) size))
 500         ;;     (if insval
 501         ;;         (progn
 502         ;;           (or (integerp insval)
 503         ;;              (signal 'wrong-type-argument
 504         ;;                      (list 'integerp insval)))
 505         ;;           (setq size insval)))
 506         ;;     (setq p (cdr p))))
 507
 508         (or (jka-compr-info-compress-program info)
 509             (message "You can't save this buffer because compression program is not defined"))
 510
 511         (list filename size)))))
 512
 513
 514 (defun jka-compr-file-local-copy (file)
 515   (let* ((filename (expand-file-name file))
 516          (info (jka-compr-get-compression-info filename)))
 517
 518     (if info
 519
 520         (let ((uncompress-message (jka-compr-info-uncompress-message info))
 521               (uncompress-program (jka-compr-info-uncompress-program info))
 522               (uncompress-args (jka-compr-info-uncompress-args info))
 523               (base-name (file-name-nondirectory filename))
 524               (local-copy
 525                (jka-compr-run-real-handler 'file-local-copy (list filename)))
 526               (temp-file (jka-compr-make-temp-name t))
 527               (temp-buffer (get-buffer-create " *jka-compr-flc-temp*"))
 528               local-file)
 529
 530           (setq local-file (or local-copy filename))
 531
 532           (unwind-protect
 533
 534               (with-current-buffer temp-buffer
 535
 536                 (and
 537                  uncompress-message
 538                  (message "%s %s..." uncompress-message base-name))
 539
 540                 ;; Here we must read the output of uncompress program
 541                 ;; and write it to TEMP-FILE without any code
 542                 ;; conversion.  An appropriate code conversion (if
 543                 ;; necessary) is done by the later I/O operation
 544                 ;; (e.g. load).
 545                 (let ((coding-system-for-read 'no-conversion)
 546                       (coding-system-for-write 'no-conversion))
 547
 548                   (jka-compr-call-process uncompress-program
 549                                           (concat uncompress-message
 550                                                   " " base-name)
 551                                           local-file
 552                                           t
 553                                           nil
 554                                           uncompress-args)
 555
 556                   (and
 557                    uncompress-message
 558                    (message "%s %s...done" uncompress-message base-name))
 559
 560                   (write-region
 561                    (point-min) (point-max) temp-file nil 'dont)))
 562
 563             (and
 564              local-copy
 565              (file-exists-p local-copy)
 566              (delete-file local-copy))
 567
 568             (kill-buffer temp-buffer))
 569
 570           temp-file)
 571
 572       (jka-compr-run-real-handler 'file-local-copy (list filename)))))
 573
 574
 575 ;; Support for loading compressed files.
 576 (defun jka-compr-load (file &optional noerror nomessage nosuffix)
 577   "Documented as original."
 578
 579   (let* ((local-copy (jka-compr-file-local-copy file))
 580          (load-file (or local-copy file)))
 581
 582     (unwind-protect
 583
 584         (let (inhibit-file-name-operation
 585               inhibit-file-name-handlers)
 586           (or nomessage
 587               (message "Loading %s..." file))
 588
 589           (let ((load-force-doc-strings t))
 590             (load load-file noerror t t))
 591           (or nomessage
 592               (message "Loading %s...done." file))
 593           ;; Fix up the load history to point at the right library.
 594           (let ((l (or (assoc load-file load-history)
 595                        ;; On MS-Windows, if load-file is in
 596                        ;; temporary-file-directory, it will look like
 597                        ;; "c:/DOCUME~1/USER/LOCALS~1/foo", whereas
 598                        ;; readevalloop will record its truename in
 599                        ;; load-history.  Therefore try truename if the
 600                        ;; original name is not in load-history.
 601                        (assoc (file-truename load-file) load-history))))
 602             ;; Remove .gz and .elc?.
 603             (while (file-name-extension file)
 604               (setq file (file-name-sans-extension file)))
 605             (setcar l file)))
 606
 607       (let (delete-by-moving-to-trash)
 608         (delete-file local-copy)))
 609
 610     t))
 611
 612 (defun jka-compr-byte-compiler-base-file-name (file)
 613   (let ((info (jka-compr-get-compression-info file)))
 614     (if (and info (jka-compr-info-strip-extension info))
 615         (save-match-data
 616           (substring file 0 (string-match (jka-compr-info-regexp info) file)))
 617       file)))
 618 \f
 619 (put 'write-region 'jka-compr 'jka-compr-write-region)
 620 (put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
 621 (put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
 622 (put 'load 'jka-compr 'jka-compr-load)
 623 (put 'byte-compiler-base-file-name 'jka-compr
 624      'jka-compr-byte-compiler-base-file-name)
 625
 626 ;;;###autoload
 627 (defvar jka-compr-inhibit nil
 628   "Non-nil means inhibit automatic uncompression temporarily.
 629 Lisp programs can bind this to t to do that.
 630 It is not recommended to set this variable permanently to anything but nil.")
 631
 632 ;;;###autoload
 633 (defun jka-compr-handler (operation &rest args)
 634   (save-match-data
 635     (let ((jka-op (get operation 'jka-compr)))
 636       (if (and jka-op (not jka-compr-inhibit))
 637           (apply jka-op args)
 638         (jka-compr-run-real-handler operation args)))))
 639
 640 ;; If we are given an operation that we don't handle,
 641 ;; call the Emacs primitive for that operation,
 642 ;; and manipulate the inhibit variables
 643 ;; to prevent the primitive from calling our handler again.
 644 (defun jka-compr-run-real-handler (operation args)
 645   (let ((inhibit-file-name-handlers
 646          (cons 'jka-compr-handler
 647                (and (eq inhibit-file-name-operation operation)
 648                     inhibit-file-name-handlers)))
 649         (inhibit-file-name-operation operation))
 650     (apply operation args)))
 651
 652 ;;;###autoload
 653 (defun jka-compr-uninstall ()
 654   "Uninstall jka-compr.
 655 This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
 656 and `inhibit-first-line-modes-suffixes' that were added
 657 by `jka-compr-installed'."
 658   ;; Delete from inhibit-first-line-modes-suffixes
 659   ;; what jka-compr-install added.
 660   (mapc
 661      (function (lambda (x)
 662                  (and (jka-compr-info-strip-extension x)
 663                       (setq inhibit-first-line-modes-suffixes
 664                             (delete (jka-compr-info-regexp x)
 665                                     inhibit-first-line-modes-suffixes)))))
 666      jka-compr-compression-info-list--internal)
 667
 668   (let* ((fnha (cons nil file-name-handler-alist))
 669          (last fnha))
 670
 671     (while (cdr last)
 672       (if (eq (cdr (car (cdr last))) 'jka-compr-handler)
 673           (setcdr last (cdr (cdr last)))
 674         (setq last (cdr last))))
 675
 676     (setq file-name-handler-alist (cdr fnha)))
 677
 678   (let* ((ama (cons nil auto-mode-alist))
 679          (last ama)
 680          entry)
 681
 682     (while (cdr last)
 683       (setq entry (car (cdr last)))
 684       (if (or (member entry jka-compr-mode-alist-additions--internal)
 685               (and (consp (cdr entry))
 686                    (eq (nth 2 entry) 'jka-compr)))
 687           (setcdr last (cdr (cdr last)))
 688         (setq last (cdr last))))
 689
 690     (setq auto-mode-alist (cdr ama)))
 691
 692   (while jka-compr-added-to-file-coding-system-alist
 693     (setq file-coding-system-alist
 694           (delq (car (member (pop jka-compr-added-to-file-coding-system-alist)
 695                              file-coding-system-alist))
 696                 file-coding-system-alist)))
 697
 698   ;; Remove the suffixes that were added by jka-compr.
 699   (dolist (suff jka-compr-load-suffixes--internal)
 700     (setq load-file-rep-suffixes (delete suff load-file-rep-suffixes)))
 701
 702   (setq jka-compr-compression-info-list--internal nil
 703         jka-compr-mode-alist-additions--internal nil
 704         jka-compr-load-suffixes--internal nil))
 705
 706 (provide 'jka-compr)
 707
 708 ;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc
 709 ;;; jka-compr.el ends here