1;;; jka-compr.el - reading/writing/loading compressed files. 2;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. 3 4;; Author: jka@ece.cmu.edu (Jay K. Adams) 5;; Version: 0.11 6;; Keywords: data 7 8;;; Commentary: 9 10;;; This package implements low-level support for reading, writing, 11;;; and loading compressed files. It hooks into the low-level file 12;;; I/O functions (including write-region and insert-file-contents) so 13;;; that they automatically compress or uncompress a file if the file 14;;; appears to need it (based on the extension of the file name). 15;;; Packages like Rmail, VM, GNUS, and Info should be able to work 16;;; with compressed files without modification. 17 18 19;;; INSTRUCTIONS: 20;;; 21;;; To use jka-compr, simply load this package, and edit as usual. 22;;; Its operation should be transparent to the user (except for 23;;; messages appearing when a file is being compressed or 24;;; uncompressed). 25;;; 26;;; The variable, jka-compr-compression-info-list can be used to 27;;; customize jka-compr to work with other compression programs. 28;;; The default value of this variable allows jka-compr to work with 29;;; Unix compress and gzip. 30;;; 31;;; If you are concerned about the stderr output of gzip and other 32;;; compression/decompression programs showing up in your buffers, you 33;;; should set the discard-error flag in the compression-info-list. 34;;; This will cause the stderr of all programs to be discarded. 35;;; However, it also causes emacs to call compression/uncompression 36;;; programs through a shell (which is specified by jka-compr-shell). 37;;; This may be a drag if, on your system, starting up a shell is 38;;; slow. 39;;; 40;;; If you don't want messages about compressing and decompressing 41;;; to show up in the echo area, you can set the compress-name and 42;;; decompress-name fields of the jka-compr-compression-info-list to 43;;; nil. 44 45 46;;; APPLICATION NOTES: 47;;; 48;;; rmail, vm, gnus, etc. 49;;; To use compressed mail folders, .newsrc files, etc., you need 50;;; only compress the file. Since jka-compr searches for .gz 51;;; versions of the files it's finding, you need not change 52;;; variables within rmail, gnus, etc. 53;;; 54;;; 55;;; crypt++ 56;;; jka-compr can coexist with crpyt++ 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;;; tar-mode 68;;; Some people like to use extensions like .trz for compressed tar files. 69;;; To handle these sorts of files, you have to add an entry to 70;;; jka-compr-compression-info-list that looks something like this: 71;;; 72;;; ["\\.trz\\'" "\037\213" 73;;; "zip" "gzip" nil ("-q") 74;;; "unzip" "gzip" nil ("-q" "-d") 75;;; t 76;;; nil] 77;;; 78;;; The last nil in the vector (the "extension" field) prevents jka-compr 79;;; from attempting to add .trz to an ordinary file name when it is looking 80;;; for a compressed version of that file (i.e. don't look for things like 81;;; foobar.c.trz). 82;;; 83;;; Finally, to make tar-mode start up automatically, you have to add an 84;;; entry to auto-mode-alist that looks like this 85;;; 86;;; ("\\.trz\\'" . tar-mode) 87;;; 88 89 90;;; ACKNOWLEDGMENTS 91;;; 92;;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people 93;;; have made helpful suggestions, reported bugs, and even fixed bugs in 94;;; jka-compr. I recall the following people as being particularly helpful. 95;;; 96;;; Jean-loup Gailly 97;;; David Hughes 98;;; Richard Pieri 99;;; Daniel Quinlan 100;;; Chris P. Ross 101;;; Rick Sladkey 102;;; 103;;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for 104;;; Version 18 of Emacs. 105;;; 106;;; After I had made progress on the original jka-compr for V18, I learned of a 107;;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly 108;;; what I was trying to do. I looked over the jam-zcat source code and 109;;; probably got some ideas from it. 110;;; 111 112;;; Code: 113 114(defvar jka-compr-shell "sh" 115 "*Shell to be used for calling compression programs. 116The value of this variable only matters if you want to discard the 117stderr of a compression/decompression program (see the documentation 118for `jka-compr-compression-info-list').") 119 120 121(defvar jka-compr-use-shell t) 122 123 124;;; I have this defined so that .Z files are assumed to be in unix 125;;; compress format; and .gz files, in gzip format. 126(defvar jka-compr-compression-info-list 127 ;;[regexp 128 ;; compr-message compr-prog compr-args 129 ;; uncomp-message uncomp-prog uncomp-args 130 ;; can-append auto-mode-flag] 131 '(["\\.Z~?\\'" 132 "compressing" "compress" ("-c") 133 "uncompressing" "uncompress" ("-c") 134 nil t] 135 ["\\.gz~?\\'" 136 "zipping" "gzip" ("-c" "-q") 137 "unzipping" "gzip" ("-c" "-q" "-d") 138 t t]) 139 140 "List of vectors that describe available compression techniques. 141Each element, which describes a compression technique, is a vector of 142the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS 143UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS 144APPEND-FLAG EXTENSION], where: 145 146 regexp is a regexp that matches filenames that are 147 compressed with this format 148 149 compress-msg is the message to issue to the user when doing this 150 type of compression (nil means no message) 151 152 compress-program is a program that performs this compression 153 154 compress-args is a list of args to pass to the compress program 155 156 uncompress-msg is the message to issue to the user when doing this 157 type of uncompression (nil means no message) 158 159 uncompress-program is a program that performs this compression 160 161 uncompress-args is a list of args to pass to the uncompress program 162 163 append-flag is non-nil if this compression technique can be 164 appended 165 166 auto-mode flag non-nil means strip the regexp from file names 167 before attempting to set the mode. 168 169Because of the way call-process is defined, discarding the stderr output of 170a program adds the overhead of starting a shell each time the program is 171invoked.") 172 173 174(defvar jka-compr-file-name-handler-entry 175 nil 176 "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.") 177 178(defvar jka-compr-op-table 179 (make-vector 127 0) 180 "Hash table of operations supported by jka-compr.") 181 182;;; Functions for accessing the return value of jka-get-compression-info 183(defun jka-compr-info-regexp (info) (aref info 0)) 184(defun jka-compr-info-compress-message (info) (aref info 1)) 185(defun jka-compr-info-compress-program (info) (aref info 2)) 186(defun jka-compr-info-compress-args (info) (aref info 3)) 187(defun jka-compr-info-uncompress-message (info) (aref info 4)) 188(defun jka-compr-info-uncompress-program (info) (aref info 5)) 189(defun jka-compr-info-uncompress-args (info) (aref info 6)) 190(defun jka-compr-info-can-append (info) (aref info 7)) 191(defun jka-compr-info-strip-extension (info) (aref info 8)) 192 193 194(defun jka-compr-get-compression-info (filename) 195 "Return information about the compression scheme of FILENAME. 196The determination as to which compression scheme, if any, to use is 197based on the filename itself and `jka-compr-compression-info-list'." 198 (catch 'compression-info 199 (let ((case-fold-search nil)) 200 (mapcar 201 (function (lambda (x) 202 (and (string-match (jka-compr-info-regexp x) filename) 203 (throw 'compression-info x)))) 204 jka-compr-compression-info-list) 205 nil))) 206 207 208(put 'compression-error 'error-conditions '(compression-error file-error error)) 209 210 211(defvar jka-compr-acceptable-retval-list '(0 141)) 212 213 214(defun jka-compr-error (prog args infile message &optional errfile) 215 216 (let ((errbuf (get-buffer-create " *jka-compr-error*")) 217 (curbuf (current-buffer))) 218 (set-buffer errbuf) 219 (widen) (erase-buffer) 220 (insert (format "Error while executing \"%s %s < %s\"\n\n" 221 prog 222 (mapconcat 'identity args " ") 223 infile)) 224 225 (and errfile 226 (insert-file-contents errfile)) 227 228 (set-buffer curbuf) 229 (display-buffer errbuf)) 230 231 (signal 'compression-error (list "Opening input file" (format "error %s" message) infile))) 232 233 234(defvar jka-compr-dd-program 235 "/bin/dd") 236 237 238(defvar jka-compr-dd-blocksize 256) 239 240 241(defun jka-compr-partial-uncompress (prog message args infile beg len) 242 "Call program PROG with ARGS args taking input from INFILE. 243Fourth and fifth args, BEG and LEN, specify which part of the output 244to discard. All output is discarded unless it comes within LEN chars after 245the BEGth char." 246 247 (let* ((skip (/ beg jka-compr-dd-blocksize)) 248 (prefix (- beg (* skip jka-compr-dd-blocksize))) 249 (count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize)))) 250 (start (point)) 251 (err-file (jka-compr-make-temp-name)) 252 (run-string (format "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null" 253 prog 254 (mapconcat 'identity args " ") 255 err-file 256 jka-compr-dd-program 257 jka-compr-dd-blocksize 258 skip 259 ;; dd seems to be unreliable about 260 ;; providing the last block. So, always 261 ;; read one more than you think you need. 262 (if count (concat "count=" (1+ count)) "")))) 263 264 (unwind-protect 265 (or (memq (call-process jka-compr-shell 266 infile t nil "-c" 267 run-string) 268 jka-compr-acceptable-retval-list) 269 270 (jka-compr-error prog args infile message err-file)) 271 272 (jka-compr-delete-temp-file err-file)) 273 274 (and 275 len 276 (delete-region (+ start prefix len) (point))) 277 278 (delete-region start (+ start prefix)))) 279 280 281(defun jka-compr-call-process (prog message infile output temp args) 282 (if jka-compr-use-shell 283 284 (let ((err-file (jka-compr-make-temp-name))) 285 286 (unwind-protect 287 288 (or (memq 289 (call-process jka-compr-shell infile 290 (if (stringp output) nil output) 291 nil 292 "-c" 293 (format "%s %s 2> %s %s" 294 prog 295 (mapconcat 'identity args " ") 296 err-file 297 (if (stringp output) 298 (concat "> " output) 299 ""))) 300 jka-compr-acceptable-retval-list) 301 302 (jka-compr-error prog args infile message err-file)) 303 304 (jka-compr-delete-temp-file err-file))) 305 306 (or (zerop 307 (apply 'call-process 308 prog 309 infile 310 (if (stringp output) temp output) 311 nil 312 args)) 313 (jka-compr-error prog args infile message)) 314 315 (and (stringp output) 316 (let ((cbuf (current-buffer))) 317 (set-buffer temp) 318 (write-region (point-min) (point-max) output) 319 (erase-buffer) 320 (set-buffer cbuf))))) 321 322 323;;; Support for temp files. Much of this was inspired if not lifted 324;;; from ange-ftp. 325 326(defvar jka-compr-temp-name-template 327 "/tmp/jka-com" 328 "Prefix added to all temp files created by jka-compr. 329There should be no more than seven characters after the final `/'") 330 331(defvar jka-compr-temp-name-table (make-vector 31 nil)) 332 333(defun jka-compr-make-temp-name (&optional local-copy) 334 "This routine will return the name of a new file." 335 (let* ((lastchar ?a) 336 (prevchar ?a) 337 (template (concat jka-compr-temp-name-template "aa")) 338 (lastpos (1- (length template))) 339 (not-done t) 340 file 341 entry) 342 343 (while not-done 344 (aset template lastpos lastchar) 345 (setq file (concat (make-temp-name template) "#")) 346 (setq entry (intern file jka-compr-temp-name-table)) 347 (if (or (get entry 'active) 348 (file-exists-p file)) 349 350 (progn 351 (setq lastchar (1+ lastchar)) 352 (if (> lastchar ?z) 353 (progn 354 (setq prevchar (1+ prevchar)) 355 (setq lastchar ?a) 356 (if (> prevchar ?z) 357 (error "Can't allocate temp file.") 358 (aset template (1- lastpos) prevchar))))) 359 360 (put entry 'active (not local-copy)) 361 (setq not-done nil))) 362 363 file)) 364 365 366(defun jka-compr-delete-temp-file (temp) 367 368 (put (intern temp jka-compr-temp-name-table) 369 'active nil) 370 371 (condition-case () 372 (delete-file temp) 373 (error nil))) 374 375 376(defun jka-compr-write-region (start end file &optional append visit) 377 "Documented as original." 378 (interactive "r\nFWrite region to file: ") 379 380 (let* ((filename (expand-file-name file)) 381 (visit-file (if (stringp visit) (expand-file-name visit) filename)) 382 (info (jka-compr-get-compression-info visit-file))) 383 384 (if info 385 386 (let ((can-append (jka-compr-info-can-append info)) 387 (compress-program (jka-compr-info-compress-program info)) 388 (compress-message (jka-compr-info-compress-message info)) 389 (uncompress-program (jka-compr-info-uncompress-program info)) 390 (uncompress-message (jka-compr-info-uncompress-message info)) 391 (compress-args (jka-compr-info-compress-args info)) 392 (uncompress-args (jka-compr-info-uncompress-args info)) 393 (temp-file (jka-compr-make-temp-name)) 394 (base-name (file-name-nondirectory visit-file)) 395 cbuf temp-buffer) 396 397 (setq cbuf (current-buffer) 398 temp-buffer (get-buffer-create " *jka-compr-temp*")) 399 (set-buffer temp-buffer) 400 (widen) (erase-buffer) 401 (set-buffer cbuf) 402 403 (and append 404 (not can-append) 405 (file-exists-p filename) 406 (let* ((local-copy (file-local-copy filename)) 407 (local-file (or local-copy filename))) 408 409 (unwind-protect 410 411 (progn 412 413 (and 414 uncompress-message 415 (message "%s %s..." uncompress-message base-name)) 416 417 (jka-compr-call-process uncompress-program 418 (concat uncompress-message 419 " " base-name) 420 local-file 421 temp-file 422 temp-buffer 423 uncompress-args) 424 (and 425 uncompress-message 426 (message "%s %s...done" uncompress-message base-name))) 427 428 (and 429 local-copy 430 (file-exists-p local-copy) 431 (delete-file local-copy))))) 432 433 (and 434 compress-message 435 (message "%s %s..." compress-message base-name)) 436 437 (write-region start end temp-file t 'dont) 438 439 (jka-compr-call-process compress-program 440 (concat compress-message 441 " " base-name) 442 temp-file 443 temp-buffer 444 nil 445 compress-args) 446 447 (set-buffer temp-buffer) 448 (write-region (point-min) (point-max) 449 filename (and append can-append) 'dont) 450 (erase-buffer) 451 (set-buffer cbuf) 452 453 (jka-compr-delete-temp-file temp-file) 454 455 (and 456 compress-message 457 (message "%s %s...done" compress-message base-name)) 458 459 (cond 460 ((eq visit t) 461 (setq buffer-file-name filename) 462 (set-visited-file-modtime)) 463 ((stringp visit) 464 (setq buffer-file-name visit) 465 (let ((buffer-file-name filename)) 466 (set-visited-file-modtime)))) 467 468 (and (or (eq visit t) 469 (eq visit nil) 470 (stringp visit)) 471 (message "Wrote %s" visit-file)) 472 473 nil) 474 475 (write-region start end filename append visit)))) 476 477 478(defun jka-compr-insert-file-contents (file &optional visit beg end replace) 479 "Documented as original." 480 481 (barf-if-buffer-read-only) 482 483 (and (or beg end) 484 visit 485 (error "Attempt to visit less than an entire file")) 486 487 (let* ((filename (expand-file-name file)) 488 (info (jka-compr-get-compression-info filename))) 489 490 (if info 491 492 (let ((uncompress-message (jka-compr-info-uncompress-message info)) 493 (uncompress-program (jka-compr-info-uncompress-program info)) 494 (uncompress-args (jka-compr-info-uncompress-args info)) 495 (base-name (file-name-nondirectory filename)) 496 (notfound nil) 497 (local-copy (file-local-copy filename)) 498 local-file 499 size start) 500 501 (setq local-file (or local-copy filename)) 502 503 (and 504 visit 505 (setq buffer-file-name filename)) 506 507 (unwind-protect ; to make sure local-copy gets deleted 508 509 (progn 510 511 (and 512 uncompress-message 513 (message "%s %s..." uncompress-message base-name)) 514 515 (condition-case error-code 516 517 (progn 518 (setq start (point)) 519 (if (or beg end) 520 (jka-compr-partial-uncompress uncompress-program 521 (concat uncompress-message 522 " " base-name) 523 uncompress-args 524 local-file 525 (or beg 0) 526 (if (and beg end) 527 (- end beg) 528 end)) 529 (jka-compr-call-process uncompress-program 530 (concat uncompress-message 531 " " base-name) 532 local-file 533 t 534 nil 535 uncompress-args)) 536 (setq size (- (point) start)) 537 (goto-char start)) 538 539 540 (error 541 (if (and (eq (car error-code) 'file-error) 542 (eq (nth 3 error-code) local-file)) 543 (if visit 544 (setq notfound error-code) 545 (signal 'file-error 546 (cons "Opening input file" 547 (nthcdr 2 error-code)))) 548 (signal (car error-code) (cdr error-code)))))) 549 550 (and 551 local-copy 552 (file-exists-p local-copy) 553 (delete-file local-copy))) 554 555 (and 556 visit 557 (progn 558 (setq buffer-file-name filename) 559 (set-visited-file-modtime))) 560 561 (and 562 uncompress-message 563 (message "%s %s...done" uncompress-message base-name)) 564 565 (and 566 visit 567 notfound 568 (signal 'file-error 569 (cons "Opening input file" (nth 2 notfound)))) 570 571 (list filename size)) 572 573 (insert-file-contents file visit beg end replace)))) 574 575 576(defun jka-compr-file-local-copy (file) 577 "Documented as original." 578 579 (let* ((filename (expand-file-name file)) 580 (info (jka-compr-get-compression-info filename))) 581 582 (if info 583 584 (let ((uncompress-message (jka-compr-info-uncompress-message info)) 585 (uncompress-program (jka-compr-info-uncompress-program info)) 586 (uncompress-args (jka-compr-info-uncompress-args info)) 587 (base-name (file-name-nondirectory filename)) 588 (local-copy (file-local-copy filename)) 589 (temp-file (jka-compr-make-temp-name t)) 590 (temp-buffer (get-buffer-create " *jka-compr-temp*")) 591 (notfound nil) 592 (cbuf (current-buffer)) 593 local-file) 594 595 (setq local-file (or local-copy filename)) 596 597 (unwind-protect 598 599 (progn 600 601 (and 602 uncompress-message 603 (message "%s %s..." uncompress-message base-name)) 604 605 (set-buffer temp-buffer) 606 607 (jka-compr-call-process uncompress-program 608 (concat uncompress-message 609 " " base-name) 610 local-file 611 t 612 nil 613 uncompress-args) 614 615 (and 616 uncompress-message 617 (message "%s %s...done" uncompress-message base-name)) 618 619 (write-region 620 (point-min) (point-max) temp-file nil 'dont)) 621 622 (and 623 local-copy 624 (file-exists-p local-copy) 625 (delete-file local-copy)) 626 627 (set-buffer cbuf) 628 (kill-buffer temp-buffer)) 629 630 temp-file) 631 632 (file-local-copy filename)))) 633 634 635;;; Support for loading compressed files. 636(defun jka-compr-load (file &optional noerror nomessage nosuffix) 637 "Documented as original." 638 639 (let* ((local-copy (jka-compr-file-local-copy file)) 640 (load-file (or local-copy file))) 641 642 (unwind-protect 643 644 (progn 645 646 (setq file-name-handler-alist 647 (cons jka-compr-file-name-handler-entry 648 file-name-handler-alist)) 649 650 (or nomessage 651 (message "Loading %s..." file)) 652 653 (load load-file noerror t t) 654 655 (or nomessage 656 (message "Loading %s...done." file))) 657 658 (setq file-name-handler-alist 659 (delq jka-compr-file-name-handler-entry 660 file-name-handler-alist)) 661 662 (jka-compr-delete-temp-file local-copy)) 663 664 t)) 665 666 667(defun jka-compr-handler (operation &rest args) 668 669 (let ((jka-op (intern-soft (symbol-name operation) jka-compr-op-table)) 670 (match-data (match-data))) 671 672 (unwind-protect 673 (progn 674 (setq file-name-handler-alist 675 (delq jka-compr-file-name-handler-entry 676 file-name-handler-alist)) 677 (if jka-op 678 (apply jka-op args) 679 (jka-compr-run-real-handler operation args))) 680 681 (setq file-name-handler-alist 682 (cons jka-compr-file-name-handler-entry 683 file-name-handler-alist)) 684 (store-match-data match-data)))) 685 686;; If we are given an operation that we don't handle, 687;; call the Emacs primitive for that operation, 688;; and manipulate the inhibit variables 689;; to prevent the primitive from calling our handler again. 690(defun jka-compr-run-real-handler (operation args) 691 (let ((inhibit-file-name-handlers 692 (cons 'jka-compr-handler 693 (and (eq inhibit-file-name-operation operation) 694 inhibit-file-name-handlers))) 695 (inhibit-file-name-operation operation)) 696 (apply operation args))) 697 698 699(defun jka-compr-intern-operation (op) 700 (let ((opsym (intern (symbol-name op) jka-compr-op-table)) 701 (jka-fn (intern (concat "jka-compr-" (symbol-name op))))) 702 (fset opsym jka-fn))) 703 704 705(defvar jka-compr-operation-list 706 '( 707 write-region 708 insert-file-contents 709 file-local-copy 710 load 711 ) 712 "List of file operations implemented by jka-compr.") 713 714 715(mapcar 716 (function 717 (lambda (fn) 718 (jka-compr-intern-operation fn))) 719 jka-compr-operation-list) 720 721 722(defun toggle-auto-compression (arg) 723 "Toggle automatic file compression and decompression. 724With prefix argument ARG, turn auto compression on if positive, else off. 725Returns the new status of auto compression (non-nil means on)." 726 (interactive "P") 727 (let* ((installed (jka-compr-installed-p)) 728 (flag (if (null arg) 729 (not installed) 730 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0)))))) 731 732 (cond 733 ((and flag installed) t) ; already installed 734 735 ((and (not flag) (not installed)) nil) ; already not installed 736 737 (flag 738 (jka-compr-install)) 739 740 (t 741 (jka-compr-uninstall))) 742 743 744 (and (interactive-p) 745 (if flag 746 (message "Automatic file (de)compression is now ON.") 747 (message "Automatic file (de)compression is now OFF."))) 748 749 flag)) 750 751 752(defun jka-compr-build-file-regexp () 753 (concat 754 "\\(" 755 (mapconcat 756 'jka-compr-info-regexp 757 jka-compr-compression-info-list 758 "\\)\\|\\(") 759 "\\)")) 760 761 762(defun jka-compr-install () 763 "Install jka-compr. 764This adds entries to `file-name-handler-alist' and `auto-mode-alist'." 765 766 (setq jka-compr-file-name-handler-entry 767 (cons (jka-compr-build-file-regexp) 'jka-compr-handler)) 768 769 (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry 770 file-name-handler-alist)) 771 772 (mapcar 773 (function (lambda (x) 774 (and 775 (jka-compr-info-strip-extension x) 776 (setq auto-mode-alist (cons (list (jka-compr-info-regexp x) 777 nil 'jka-compr) 778 auto-mode-alist))))) 779 780 jka-compr-compression-info-list)) 781 782 783(defun jka-compr-uninstall () 784 "Uninstall jka-compr. 785This removes the entries in `file-name-handler-alist' and `auto-mode-alist' 786that were created by `jka-compr-installed'." 787 788 (let* ((fnha (cons nil file-name-handler-alist)) 789 (last fnha)) 790 791 (while (cdr last) 792 (if (eq (cdr (car (cdr last))) 'jka-compr-handler) 793 (setcdr last (cdr (cdr last))) 794 (setq last (cdr last)))) 795 796 (setq file-name-handler-alist (cdr fnha))) 797 798 (let* ((ama (cons nil auto-mode-alist)) 799 (last ama) 800 entry) 801 802 (while (cdr last) 803 (setq entry (car (cdr last))) 804 (if (and (consp (cdr entry)) 805 (eq (nth 2 entry) 'jka-compr)) 806 (setcdr last (cdr (cdr last))) 807 (setq last (cdr last)))) 808 809 (setq auto-mode-alist (cdr ama)))) 810 811 812(defun jka-compr-installed-p () 813 "Return non-nil if jka-compr is installed. 814The return value is the entry in `file-name-handler-alist' for jka-compr." 815 816 (let ((fnha file-name-handler-alist) 817 (installed nil)) 818 819 (while (and fnha (not installed)) 820 (and (eq (cdr (car fnha)) 'jka-compr-handler) 821 (setq installed (car fnha))) 822 (setq fnha (cdr fnha))) 823 824 installed)) 825 826 827;;; Add the file I/O hook if it does not already exist. 828;;; Make sure that jka-compr-file-name-handler-entry is eq to the 829;;; entry for jka-compr in file-name-handler-alist. 830(and (jka-compr-installed-p) 831 (jka-compr-uninstall)) 832 833(jka-compr-install) 834 835 836(provide 'jka-compr) 837 838;; jka-compr.el ends here. 839