1 ;;; jka-compr.el --- reading/writing/loading compressed files
3 ;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
5 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
9 ;; This file is part of GNU Emacs.
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 2, or (at your option)
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; This package implements low-level support for reading, writing,
29 ;; and loading compressed files. It hooks into the low-level file
30 ;; I/O functions (including write-region and insert-file-contents) so
31 ;; that they automatically compress or uncompress a file if the file
32 ;; appears to need it (based on the extension of the file name).
33 ;; Packages like Rmail, VM, GNUS, and Info should be able to work
34 ;; with compressed files without modification.
39 ;; To use jka-compr, simply load this package, and edit as usual.
40 ;; Its operation should be transparent to the user (except for
41 ;; messages appearing when a file is being compressed or
44 ;; The variable, jka-compr-compression-info-list can be used to
45 ;; customize jka-compr to work with other compression programs.
46 ;; The default value of this variable allows jka-compr to work with
47 ;; Unix compress and gzip.
49 ;; If you are concerned about the stderr output of gzip and other
50 ;; compression/decompression programs showing up in your buffers, you
51 ;; should set the discard-error flag in the compression-info-list.
52 ;; This will cause the stderr of all programs to be discarded.
53 ;; However, it also causes emacs to call compression/uncompression
54 ;; programs through a shell (which is specified by jka-compr-shell).
55 ;; This may be a drag if, on your system, starting up a shell is
58 ;; If you don't want messages about compressing and decompressing
59 ;; to show up in the echo area, you can set the compress-name and
60 ;; decompress-name fields of the jka-compr-compression-info-list to
67 ;; jka-compr can coexist with crpyt++ if you take all the decompression
68 ;; entries out of the crypt-encoding-list. Clearly problems will arise if
69 ;; you have two programs trying to compress/decompress files. jka-compr
70 ;; will not "work with" crypt++ in the following sense: you won't be able to
71 ;; decode encrypted compressed files--that is, files that have been
72 ;; compressed then encrypted (in that order). Theoretically, crypt++ and
73 ;; jka-compr could properly handle a file that has been encrypted then
74 ;; compressed, but there is little point in trying to compress an encrypted
81 ;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people
82 ;; have made helpful suggestions, reported bugs, and even fixed bugs in
83 ;; jka-compr. I recall the following people as being particularly helpful.
92 ;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for
93 ;; Version 18 of Emacs.
95 ;; After I had made progress on the original jka-compr for V18, I learned of a
96 ;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly
97 ;; what I was trying to do. I looked over the jam-zcat source code and
98 ;; probably got some ideas from it.
103 (defgroup compression nil
104 "Data compression utilities"
107 (defgroup jka-compr nil
108 "jka-compr customization"
112 (defcustom jka-compr-shell
"sh"
113 "*Shell to be used for calling compression programs.
114 The value of this variable only matters if you want to discard the
115 stderr of a compression/decompression program (see the documentation
116 for `jka-compr-compression-info-list')."
120 (defvar jka-compr-use-shell t
)
123 ;;; I have this defined so that .Z files are assumed to be in unix
124 ;;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
125 (defcustom jka-compr-compression-info-list
127 ;; compr-message compr-prog compr-args
128 ;; uncomp-message uncomp-prog uncomp-args
129 ;; can-append auto-mode-flag]
130 '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
131 "compressing" "compress" ("-c")
132 "uncompressing" "uncompress" ("-c")
135 "bzip2ing" "bzip2" ("")
136 "bunzip2ing" "bzip2" ("-d")
139 "zipping" "gzip" ("-c" "-q")
140 "unzipping" "gzip" ("-c" "-q" "-d")
142 ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'"
143 "zipping" "gzip" ("-c" "-q")
144 "unzipping" "gzip" ("-c" "-q" "-d")
147 "List of vectors that describe available compression techniques.
148 Each element, which describes a compression technique, is a vector of
149 the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
150 UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
151 APPEND-FLAG EXTENSION], where:
153 regexp is a regexp that matches filenames that are
154 compressed with this format
156 compress-msg is the message to issue to the user when doing this
157 type of compression (nil means no message)
159 compress-program is a program that performs this compression
161 compress-args is a list of args to pass to the compress program
163 uncompress-msg is the message to issue to the user when doing this
164 type of uncompression (nil means no message)
166 uncompress-program is a program that performs this compression
168 uncompress-args is a list of args to pass to the uncompress program
170 append-flag is non-nil if this compression technique can be
173 auto-mode flag non-nil means strip the regexp from file names
174 before attempting to set the mode.
176 Because of the way `call-process' is defined, discarding the stderr output of
177 a program adds the overhead of starting a shell each time the program is
179 :type
'(repeat (vector regexp
180 (choice :tag
"Compress Message"
181 (string :format
"%v")
182 (const :tag
"No Message" nil
))
183 (string :tag
"Compress Program")
184 (repeat :tag
"Compress Arguments" string
)
185 (choice :tag
"Uncompress Message"
186 (string :format
"%v")
187 (const :tag
"No Message" nil
))
188 (string :tag
"Uncompress Program")
189 (repeat :tag
"Uncompress Arguments" string
)
190 (boolean :tag
"Append")
191 (boolean :tag
"Auto Mode")))
194 (defvar jka-compr-mode-alist-additions
195 (list (cons "\\.tgz\\'" 'tar-mode
))
196 "A list of pairs to add to `auto-mode-alist' when jka-compr is installed.")
198 ;; List of all the elements we actually added to file-coding-system-alist.
199 (defvar jka-compr-added-to-file-coding-system-alist nil
)
201 (defvar jka-compr-file-name-handler-entry
203 "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.")
205 ;;; Functions for accessing the return value of jka-compr-get-compression-info
206 (defun jka-compr-info-regexp (info) (aref info
0))
207 (defun jka-compr-info-compress-message (info) (aref info
1))
208 (defun jka-compr-info-compress-program (info) (aref info
2))
209 (defun jka-compr-info-compress-args (info) (aref info
3))
210 (defun jka-compr-info-uncompress-message (info) (aref info
4))
211 (defun jka-compr-info-uncompress-program (info) (aref info
5))
212 (defun jka-compr-info-uncompress-args (info) (aref info
6))
213 (defun jka-compr-info-can-append (info) (aref info
7))
214 (defun jka-compr-info-strip-extension (info) (aref info
8))
217 (defun jka-compr-get-compression-info (filename)
218 "Return information about the compression scheme of FILENAME.
219 The determination as to which compression scheme, if any, to use is
220 based on the filename itself and `jka-compr-compression-info-list'."
221 (catch 'compression-info
222 (let ((case-fold-search nil
))
224 (function (lambda (x)
225 (and (string-match (jka-compr-info-regexp x
) filename
)
226 (throw 'compression-info x
))))
227 jka-compr-compression-info-list
)
231 (put 'compression-error
'error-conditions
'(compression-error file-error error
))
234 (defvar jka-compr-acceptable-retval-list
'(0 2 141))
237 (defun jka-compr-error (prog args infile message
&optional errfile
)
239 (let ((errbuf (get-buffer-create " *jka-compr-error*"))
240 (curbuf (current-buffer)))
241 (with-current-buffer errbuf
242 (widen) (erase-buffer)
243 (insert (format "Error while executing \"%s %s < %s\"\n\n"
245 (mapconcat 'identity args
" ")
249 (insert-file-contents errfile
)))
250 (display-buffer errbuf
))
252 (signal 'compression-error
253 (list "Opening input file" (format "error %s" message
) infile
)))
256 (defvar jka-compr-dd-program
260 (defvar jka-compr-dd-blocksize
256)
263 (defun jka-compr-partial-uncompress (prog message args infile beg len
)
264 "Call program PROG with ARGS args taking input from INFILE.
265 Fourth and fifth args, BEG and LEN, specify which part of the output
266 to keep: LEN chars starting BEG chars from the beginning."
267 (let* ((skip (/ beg jka-compr-dd-blocksize
))
268 (prefix (- beg
(* skip jka-compr-dd-blocksize
)))
269 (count (and len
(1+ (/ (+ len prefix
) jka-compr-dd-blocksize
))))
271 (err-file (jka-compr-make-temp-name))
272 (run-string (format "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null"
274 (mapconcat 'identity args
" ")
277 jka-compr-dd-blocksize
279 ;; dd seems to be unreliable about
280 ;; providing the last block. So, always
281 ;; read one more than you think you need.
282 (if count
(concat "count=" (1+ count
)) ""))))
285 (or (memq (call-process jka-compr-shell
288 jka-compr-acceptable-retval-list
)
290 (jka-compr-error prog args infile message err-file
))
292 (jka-compr-delete-temp-file err-file
))
294 ;; Delete the stuff after what we want, if there is any.
297 (< (+ start prefix len
) (point))
298 (delete-region (+ start prefix len
) (point)))
300 ;; Delete the stuff before what we want.
301 (delete-region start
(+ start prefix
))))
304 (defun jka-compr-call-process (prog message infile output temp args
)
305 (if jka-compr-use-shell
307 (let ((err-file (jka-compr-make-temp-name))
308 (coding-system-for-read (or coding-system-for-read
'undecided
))
309 (coding-system-for-write 'no-conversion
) )
314 (call-process jka-compr-shell infile
315 (if (stringp output
) nil output
)
318 (format "%s %s 2> %s %s"
320 (mapconcat 'identity args
" ")
325 jka-compr-acceptable-retval-list
)
327 (jka-compr-error prog args infile message err-file
))
329 (jka-compr-delete-temp-file err-file
)))
335 (if (stringp output
) temp output
)
338 (jka-compr-error prog args infile message
))
340 (and (stringp output
)
341 (with-current-buffer temp
342 (write-region (point-min) (point-max) output
)
346 ;;; Support for temp files. Much of this was inspired if not lifted
349 (defcustom jka-compr-temp-name-template
350 (expand-file-name "jka-com"
351 (or (getenv "TMPDIR") "/tmp/"))
352 "Prefix added to all temp files created by jka-compr.
353 There should be no more than seven characters after the final `/'."
357 (defvar jka-compr-temp-name-table
(make-vector 31 nil
))
359 (defun jka-compr-make-temp-name (&optional local-copy
)
360 "This routine will return the name of a new file."
363 (template (concat jka-compr-temp-name-template
"aa"))
364 (lastpos (1- (length template
)))
370 (aset template lastpos lastchar
)
371 (setq file
(concat (make-temp-name template
) "#"))
372 (setq entry
(intern file jka-compr-temp-name-table
))
373 (if (or (get entry
'active
)
374 (file-exists-p file
))
377 (setq lastchar
(1+ lastchar
))
380 (setq prevchar
(1+ prevchar
))
383 (error "Can't allocate temp file.")
384 (aset template
(1- lastpos
) prevchar
)))))
386 (put entry
'active
(not local-copy
))
387 (setq not-done nil
)))
392 (defun jka-compr-delete-temp-file (temp)
394 (put (intern temp jka-compr-temp-name-table
)
402 (defun jka-compr-write-region (start end file
&optional append visit
)
403 (let* ((filename (expand-file-name file
))
404 (visit-file (if (stringp visit
) (expand-file-name visit
) filename
))
405 (info (jka-compr-get-compression-info visit-file
)))
409 (let ((can-append (jka-compr-info-can-append info
))
410 (compress-program (jka-compr-info-compress-program info
))
411 (compress-message (jka-compr-info-compress-message info
))
412 (uncompress-program (jka-compr-info-uncompress-program info
))
413 (uncompress-message (jka-compr-info-uncompress-message info
))
414 (compress-args (jka-compr-info-compress-args info
))
415 (uncompress-args (jka-compr-info-uncompress-args info
))
416 (base-name (file-name-nondirectory visit-file
))
417 temp-file temp-buffer
)
419 (setq temp-buffer
(get-buffer-create " *jka-compr-wr-temp*"))
420 (with-current-buffer temp-buffer
421 (widen) (erase-buffer))
425 (file-exists-p filename
))
427 (let* ((local-copy (file-local-copy filename
))
428 (local-file (or local-copy filename
)))
430 (setq temp-file local-file
))
432 (setq temp-file
(jka-compr-make-temp-name)))
436 (message "%s %s..." compress-message base-name
))
438 (jka-compr-run-real-handler 'write-region
439 (list start end temp-file t
'dont
))
441 ;; Here we must read the output of compress program as is
442 ;; without any code conversion.
443 (let ((coding-system-for-read 'no-conversion
))
444 (jka-compr-call-process compress-program
445 (concat compress-message
452 (with-current-buffer temp-buffer
453 (let ((coding-system-for-write 'no-conversion
))
454 (if (memq system-type
'(ms-dos windows-nt
))
455 (setq buffer-file-type t
) )
456 (jka-compr-run-real-handler 'write-region
457 (list (point-min) (point-max)
459 (and append can-append
) 'dont
))
462 (jka-compr-delete-temp-file temp-file
)
466 (message "%s %s...done" compress-message base-name
))
470 (setq buffer-file-name filename
)
471 (set-visited-file-modtime))
473 (setq buffer-file-name visit
)
474 (let ((buffer-file-name filename
))
475 (set-visited-file-modtime))))
477 (and (or (eq visit t
)
480 (message "Wrote %s" visit-file
))
484 (jka-compr-run-real-handler 'write-region
485 (list start end filename append visit
)))))
488 (defun jka-compr-insert-file-contents (file &optional visit beg end replace
)
489 (barf-if-buffer-read-only)
493 (error "Attempt to visit less than an entire file"))
495 (let* ((filename (expand-file-name file
))
496 (info (jka-compr-get-compression-info filename
)))
500 (let ((uncompress-message (jka-compr-info-uncompress-message info
))
501 (uncompress-program (jka-compr-info-uncompress-program info
))
502 (uncompress-args (jka-compr-info-uncompress-args info
))
503 (base-name (file-name-nondirectory filename
))
506 (jka-compr-run-real-handler 'file-local-copy
(list filename
)))
509 (coding-system-for-read
510 (or coding-system-for-read
511 ;; If multibyte characters are disabled,
512 ;; don't do that conversion.
513 (and (null enable-multibyte-characters
)
515 (let ((tail file-coding-system-alist
)
517 (jka-compr-byte-compiler-base-file-name file
))
520 (if (string-match (car (car tail
)) newfile
)
521 (setq result
(car (cdr (car tail
)))
523 (setq tail
(cdr tail
)))
527 (setq local-file
(or local-copy filename
))
531 (setq buffer-file-name filename
))
533 (unwind-protect ; to make sure local-copy gets deleted
539 (message "%s %s..." uncompress-message base-name
))
541 (condition-case error-code
545 (goto-char (point-min)))
548 (jka-compr-partial-uncompress uncompress-program
549 (concat uncompress-message
557 ;; If visiting, bind off buffer-file-name so that
558 ;; file-locking will not ask whether we should
559 ;; really edit the buffer.
560 (let ((buffer-file-name
561 (if visit nil buffer-file-name
)))
562 (jka-compr-call-process uncompress-program
563 (concat uncompress-message
569 (setq size
(- (point) start
))
571 (let* ((del-beg (point))
572 (del-end (+ del-beg size
)))
573 (delete-region del-beg
574 (min del-end
(point-max)))))
577 (if (and (eq (car error-code
) 'file-error
)
578 (eq (nth 3 error-code
) local-file
))
580 (setq notfound error-code
)
582 (cons "Opening input file"
583 (nthcdr 2 error-code
))))
584 (signal (car error-code
) (cdr error-code
))))))
588 (file-exists-p local-copy
)
589 (delete-file local-copy
)))
595 (setq buffer-file-name filename
)
596 (set-visited-file-modtime)))
600 (message "%s %s...done" uncompress-message base-name
))
606 (cons "Opening input file" (nth 2 notfound
))))
608 ;; Run the functions that insert-file-contents would.
609 (let ((p after-insert-file-functions
)
612 (setq insval
(funcall (car p
) size
))
615 (or (integerp insval
)
616 (signal 'wrong-type-argument
617 (list 'integerp insval
)))
621 (list filename size
))
623 (jka-compr-run-real-handler 'insert-file-contents
624 (list file visit beg end replace
)))))
627 (defun jka-compr-file-local-copy (file)
628 (let* ((filename (expand-file-name file
))
629 (info (jka-compr-get-compression-info filename
)))
633 (let ((uncompress-message (jka-compr-info-uncompress-message info
))
634 (uncompress-program (jka-compr-info-uncompress-program info
))
635 (uncompress-args (jka-compr-info-uncompress-args info
))
636 (base-name (file-name-nondirectory filename
))
638 (jka-compr-run-real-handler 'file-local-copy
(list filename
)))
639 (temp-file (jka-compr-make-temp-name t
))
640 (temp-buffer (get-buffer-create " *jka-compr-flc-temp*"))
644 (setq local-file
(or local-copy filename
))
648 (with-current-buffer temp-buffer
652 (message "%s %s..." uncompress-message base-name
))
654 ;; Here we must read the output of uncompress program
655 ;; and write it to TEMP-FILE without any code
656 ;; conversion. An appropriate code conversion (if
657 ;; necessary) is done by the later I/O operation
659 (let ((coding-system-for-read 'no-conversion
)
660 (coding-system-for-write 'no-conversion
))
662 (jka-compr-call-process uncompress-program
663 (concat uncompress-message
672 (message "%s %s...done" uncompress-message base-name
))
675 (point-min) (point-max) temp-file nil
'dont
)))
679 (file-exists-p local-copy
)
680 (delete-file local-copy
))
682 (kill-buffer temp-buffer
))
686 (jka-compr-run-real-handler 'file-local-copy
(list filename
)))))
689 ;;; Support for loading compressed files.
690 (defun jka-compr-load (file &optional noerror nomessage nosuffix
)
691 "Documented as original."
693 (let* ((local-copy (jka-compr-file-local-copy file
))
694 (load-file (or local-copy file
)))
698 (let (inhibit-file-name-operation
699 inhibit-file-name-handlers
)
701 (message "Loading %s..." file
))
703 (let ((load-force-doc-strings t
))
704 (load load-file noerror t t
))
707 (message "Loading %s...done." file
)))
709 (jka-compr-delete-temp-file local-copy
))
713 (defun jka-compr-byte-compiler-base-file-name (file)
714 (let ((info (jka-compr-get-compression-info file
)))
715 (if (and info
(jka-compr-info-strip-extension info
))
717 (substring file
0 (string-match (jka-compr-info-regexp info
) file
)))
720 (put 'write-region
'jka-compr
'jka-compr-write-region
)
721 (put 'insert-file-contents
'jka-compr
'jka-compr-insert-file-contents
)
722 (put 'file-local-copy
'jka-compr
'jka-compr-file-local-copy
)
723 (put 'load
'jka-compr
'jka-compr-load
)
724 (put 'byte-compiler-base-file-name
'jka-compr
725 'jka-compr-byte-compiler-base-file-name
)
727 (defvar jka-compr-inhibit nil
728 "Non-nil means inhibit automatic uncompression temporarily.
729 Lisp programs can bind this to t to do that.
730 It is not recommended to set this variable permanently to anything but nil.")
732 (defun jka-compr-handler (operation &rest args
)
734 (let ((jka-op (get operation
'jka-compr
)))
735 (if (and jka-op
(not jka-compr-inhibit
))
737 (jka-compr-run-real-handler operation args
)))))
739 ;; If we are given an operation that we don't handle,
740 ;; call the Emacs primitive for that operation,
741 ;; and manipulate the inhibit variables
742 ;; to prevent the primitive from calling our handler again.
743 (defun jka-compr-run-real-handler (operation args
)
744 (let ((inhibit-file-name-handlers
745 (cons 'jka-compr-handler
746 (and (eq inhibit-file-name-operation operation
)
747 inhibit-file-name-handlers
)))
748 (inhibit-file-name-operation operation
))
749 (apply operation args
)))
751 ;;;###autoload(defun auto-compression-mode (&optional arg)
753 ;;;###autoloadToggle automatic file compression and uncompression.
754 ;;;###autoloadWith prefix argument ARG, turn auto compression on if positive, else off.
755 ;;;###autoloadReturns the new status of auto compression (non-nil means on)."
756 ;;;###autoload (interactive "P")
757 ;;;###autoload (if (not (fboundp 'jka-compr-installed-p))
758 ;;;###autoload (progn
759 ;;;###autoload (require 'jka-compr)
760 ;;;###autoload ;; That turned the mode on, so make it initially off.
761 ;;;###autoload (toggle-auto-compression)))
762 ;;;###autoload (toggle-auto-compression arg t))
764 (defun toggle-auto-compression (&optional arg message
)
765 "Toggle automatic file compression and uncompression.
766 With prefix argument ARG, turn auto compression on if positive, else off.
767 Returns the new status of auto compression (non-nil means on).
768 If the argument MESSAGE is non-nil, it means to print a message
769 saying whether the mode is now on or off."
771 (let* ((installed (jka-compr-installed-p))
774 (or (eq arg t
) (listp arg
) (and (integerp arg
) (> arg
0))))))
777 ((and flag installed
) t
) ; already installed
779 ((and (not flag
) (not installed
)) nil
) ; already not installed
785 (jka-compr-uninstall)))
790 (message "Automatic file (de)compression is now ON.")
791 (message "Automatic file (de)compression is now OFF.")))
795 (defun jka-compr-build-file-regexp ()
799 'jka-compr-info-regexp
800 jka-compr-compression-info-list
805 (defun jka-compr-install ()
807 This adds entries to `file-name-handler-alist' and `auto-mode-alist'
808 and `inhibit-first-line-modes-suffixes'."
810 (setq jka-compr-file-name-handler-entry
811 (cons (jka-compr-build-file-regexp) 'jka-compr-handler
))
813 (setq file-name-handler-alist
(cons jka-compr-file-name-handler-entry
814 file-name-handler-alist
))
816 (setq jka-compr-added-to-file-coding-system-alist nil
)
819 (function (lambda (x)
820 ;; Don't do multibyte encoding on the compressed files.
821 (let ((elt (cons (jka-compr-info-regexp x
)
822 '(no-conversion . no-conversion
))))
823 (setq file-coding-system-alist
824 (cons elt file-coding-system-alist
))
825 (setq jka-compr-added-to-file-coding-system-alist
826 (cons elt jka-compr-added-to-file-coding-system-alist
)))
828 (and (jka-compr-info-strip-extension x
)
829 ;; Make entries in auto-mode-alist so that modes
830 ;; are chosen right according to the file names
832 (setq auto-mode-alist
833 (cons (list (jka-compr-info-regexp x
)
836 ;; Also add these regexps to
837 ;; inhibit-first-line-modes-suffixes, so that a
838 ;; -*- line in the first file of a compressed tar
839 ;; file doesn't override tar-mode.
840 (setq inhibit-first-line-modes-suffixes
841 (cons (jka-compr-info-regexp x
)
842 inhibit-first-line-modes-suffixes
)))))
843 jka-compr-compression-info-list
)
844 (setq auto-mode-alist
845 (append auto-mode-alist jka-compr-mode-alist-additions
)))
848 (defun jka-compr-uninstall ()
849 "Uninstall jka-compr.
850 This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
851 and `inhibit-first-line-modes-suffixes' that were added
852 by `jka-compr-installed'."
853 ;; Delete from inhibit-first-line-modes-suffixes
854 ;; what jka-compr-install added.
856 (function (lambda (x)
857 (and (jka-compr-info-strip-extension x
)
858 (setq inhibit-first-line-modes-suffixes
859 (delete (jka-compr-info-regexp x
)
860 inhibit-first-line-modes-suffixes
)))))
861 jka-compr-compression-info-list
)
863 (let* ((fnha (cons nil file-name-handler-alist
))
867 (if (eq (cdr (car (cdr last
))) 'jka-compr-handler
)
868 (setcdr last
(cdr (cdr last
)))
869 (setq last
(cdr last
))))
871 (setq file-name-handler-alist
(cdr fnha
)))
873 (let* ((ama (cons nil auto-mode-alist
))
878 (setq entry
(car (cdr last
)))
879 (if (or (member entry jka-compr-mode-alist-additions
)
880 (and (consp (cdr entry
))
881 (eq (nth 2 entry
) 'jka-compr
)))
882 (setcdr last
(cdr (cdr last
)))
883 (setq last
(cdr last
))))
885 (setq auto-mode-alist
(cdr ama
)))
887 (let* ((ama (cons nil file-coding-system-alist
))
892 (setq entry
(car (cdr last
)))
893 (if (member entry jka-compr-added-to-file-coding-system-alist
)
894 (setcdr last
(cdr (cdr last
)))
895 (setq last
(cdr last
))))
897 (setq file-coding-system-alist
(cdr ama
))))
900 (defun jka-compr-installed-p ()
901 "Return non-nil if jka-compr is installed.
902 The return value is the entry in `file-name-handler-alist' for jka-compr."
904 (let ((fnha file-name-handler-alist
)
907 (while (and fnha
(not installed
))
908 (and (eq (cdr (car fnha
)) 'jka-compr-handler
)
909 (setq installed
(car fnha
)))
910 (setq fnha
(cdr fnha
)))
915 ;;; Add the file I/O hook if it does not already exist.
916 ;;; Make sure that jka-compr-file-name-handler-entry is eq to the
917 ;;; entry for jka-compr in file-name-handler-alist.
918 (and (jka-compr-installed-p)
919 (jka-compr-uninstall))
926 ;; jka-compr.el ends here.