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