Mercurial > hg > xemacs-beta

comparison lisp/packages/jka-compr.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children e04119814345
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
1 ;;; jka-compr.el - reading/writing/loading compressed files. 1 ;;; jka-compr.el --- reading/writing/loading compressed files
2 ;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. 2
3 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 4
4 ;; Author: jka@ece.cmu.edu (Jay K. Adams) 5 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
5 ;; Keywords: data 6 ;; Keywords: data
6 7
7 ;;; Synched up with: Very close to the version supplied with 8 ;; This file is part of XEmacs.
8 ;;; FSF 19.29 but not quite synched. 9
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
23 ;; 02111-1307, USA.
24
25 ;; Synched up with: FSF 19.34
9 26
10 ;;; Commentary: 27 ;;; Commentary:
11 28
12 ;;; This package implements low-level support for reading, writing, 29 ;; This package implements low-level support for reading, writing,
13 ;;; and loading compressed files. It hooks into the low-level file 30 ;; and loading compressed files. It hooks into the low-level file
14 ;;; I/O functions (including write-region and insert-file-contents) so 31 ;; I/O functions (including write-region and insert-file-contents) so
15 ;;; that they automatically compress or uncompress a file if the file 32 ;; that they automatically compress or uncompress a file if the file
16 ;;; appears to need it (based on the extension of the file name). 33 ;; appears to need it (based on the extension of the file name).
17 ;;; Packages like Rmail, VM, GNUS, and Info should be able to work 34 ;; Packages like Rmail, VM, GNUS, and Info should be able to work
18 ;;; with compressed files without modification. 35 ;; with compressed files without modification.
19 36
20 37
21 ;;; INSTRUCTIONS: 38 ;; INSTRUCTIONS:
22 ;;; 39 ;;
23 ;;; To use jka-compr, simply load this package, and edit as usual. 40 ;; To use jka-compr, simply load this package, and edit as usual.
24 ;;; Its operation should be transparent to the user (except for 41 ;; Its operation should be transparent to the user (except for
25 ;;; messages appearing when a file is being compressed or 42 ;; messages appearing when a file is being compressed or
26 ;;; uncompressed). 43 ;; uncompressed).
27 ;;; 44 ;;
28 ;;; The variable, jka-compr-compression-info-list can be used to 45 ;; The variable, jka-compr-compression-info-list can be used to
29 ;;; customize jka-compr to work with other compression programs. 46 ;; customize jka-compr to work with other compression programs.
30 ;;; The default value of this variable allows jka-compr to work with 47 ;; The default value of this variable allows jka-compr to work with
31 ;;; Unix compress and gzip. 48 ;; Unix compress and gzip.
32 ;;; 49 ;;
33 ;;; If you are concerned about the stderr output of gzip and other 50 ;; If you are concerned about the stderr output of gzip and other
34 ;;; compression/decompression programs showing up in your buffers, you 51 ;; compression/decompression programs showing up in your buffers, you
35 ;;; should set the discard-error flag in the compression-info-list. 52 ;; should set the discard-error flag in the compression-info-list.
36 ;;; This will cause the stderr of all programs to be discarded. 53 ;; This will cause the stderr of all programs to be discarded.
37 ;;; However, it also causes emacs to call compression/uncompression 54 ;; However, it also causes emacs to call compression/uncompression
38 ;;; programs through a shell (which is specified by jka-compr-shell). 55 ;; programs through a shell (which is specified by jka-compr-shell).
39 ;;; This may be a drag if, on your system, starting up a shell is 56 ;; This may be a drag if, on your system, starting up a shell is
40 ;;; slow. 57 ;; slow.
41 ;;; 58 ;;
42 ;;; If you don't want messages about compressing and decompressing 59 ;; If you don't want messages about compressing and decompressing
43 ;;; to show up in the echo area, you can set the compress-name and 60 ;; to show up in the echo area, you can set the compress-name and
44 ;;; decompress-name fields of the jka-compr-compression-info-list to 61 ;; decompress-name fields of the jka-compr-compression-info-list to
45 ;;; nil. 62 ;; nil.
46 63
47 64
48 ;;; APPLICATION NOTES: 65 ;; APPLICATION NOTES:
49 ;;; 66 ;;
50 ;;; crypt++ 67 ;; crypt++
51 ;;; jka-compr can coexist with crpyt++ if you take all the decompression 68 ;; jka-compr can coexist with crpyt++ if you take all the decompression
52 ;;; entries out of the crypt-encoding-list. Clearly problems will arise if 69 ;; entries out of the crypt-encoding-list. Clearly problems will arise if
53 ;;; you have two programs trying to compress/decompress files. jka-compr 70 ;; you have two programs trying to compress/decompress files. jka-compr
54 ;;; will not "work with" crypt++ in the following sense: you won't be able to 71 ;; will not "work with" crypt++ in the following sense: you won't be able to
55 ;;; decode encrypted compressed files--that is, files that have been 72 ;; decode encrypted compressed files--that is, files that have been
56 ;;; compressed then encrypted (in that order). Theoretically, crypt++ and 73 ;; compressed then encrypted (in that order). Theoretically, crypt++ and
57 ;;; jka-compr could properly handle a file that has been encrypted then 74 ;; jka-compr could properly handle a file that has been encrypted then
58 ;;; compressed, but there is little point in trying to compress an encrypted 75 ;; compressed, but there is little point in trying to compress an encrypted
59 ;;; file. 76 ;; file.
60 ;;; 77 ;;
61 78
62 79
63 ;;; ACKNOWLEDGMENTS 80 ;; ACKNOWLEDGMENTS
64 ;;; 81 ;;
65 ;;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people 82 ;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people
66 ;;; have made helpful suggestions, reported bugs, and even fixed bugs in 83 ;; have made helpful suggestions, reported bugs, and even fixed bugs in
67 ;;; jka-compr. I recall the following people as being particularly helpful. 84 ;; jka-compr. I recall the following people as being particularly helpful.
68 ;;; 85 ;;
69 ;;; Jean-loup Gailly 86 ;; Jean-loup Gailly
70 ;;; David Hughes 87 ;; David Hughes
71 ;;; Richard Pieri 88 ;; Richard Pieri
72 ;;; Daniel Quinlan 89 ;; Daniel Quinlan
73 ;;; Chris P. Ross 90 ;; Chris P. Ross
74 ;;; Rick Sladkey 91 ;; Rick Sladkey
75 ;;; 92 ;;
76 ;;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for 93 ;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for
77 ;;; Version 18 of Emacs. 94 ;; Version 18 of Emacs.
78 ;;; 95 ;;
79 ;;; After I had made progress on the original jka-compr for V18, I learned of a 96 ;; After I had made progress on the original jka-compr for V18, I learned of a
80 ;;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly 97 ;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly
81 ;;; what I was trying to do. I looked over the jam-zcat source code and 98 ;; what I was trying to do. I looked over the jam-zcat source code and
82 ;;; probably got some ideas from it. 99 ;; probably got some ideas from it.
83 ;;; 100 ;;
84 101
85 ;;; Code: 102 ;;; Code:
86 103
87 (defvar jka-compr-shell "sh" 104 (defvar jka-compr-shell "sh"
88 "*Shell to be used for calling compression programs. 105 "*Shell to be used for calling compression programs.
153 170
154 (defvar jka-compr-file-name-handler-entry 171 (defvar jka-compr-file-name-handler-entry
155 nil 172 nil
156 "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.") 173 "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.")
157 174
158 ;;; Functions for accessing the return value of jka-get-compression-info 175 ;;; Functions for accessing the return value of jka-compr-get-compression-info
159 (defun jka-compr-info-regexp (info) (aref info 0)) 176 (defun jka-compr-info-regexp (info) (aref info 0))
160 (defun jka-compr-info-compress-message (info) (aref info 1)) 177 (defun jka-compr-info-compress-message (info) (aref info 1))
161 (defun jka-compr-info-compress-program (info) (aref info 2)) 178 (defun jka-compr-info-compress-program (info) (aref info 2))
162 (defun jka-compr-info-compress-args (info) (aref info 3)) 179 (defun jka-compr-info-compress-args (info) (aref info 3))
163 (defun jka-compr-info-uncompress-message (info) (aref info 4)) 180 (defun jka-compr-info-uncompress-message (info) (aref info 4))
483 local-file 500 local-file
484 (or beg 0) 501 (or beg 0)
485 (if (and beg end) 502 (if (and beg end)
486 (- end beg) 503 (- end beg)
487 end)) 504 end))
488 (jka-compr-call-process uncompress-program 505 ;; If visiting, bind off buffer-file-name so that
489 (concat uncompress-message 506 ;; file-locking will not ask whether we should
490 " " base-name) 507 ;; really edit the buffer.
491 local-file 508 (let ((buffer-file-name
492 t 509 (if visit nil buffer-file-name)))
493 nil 510 (jka-compr-call-process uncompress-program
494 uncompress-args)) 511 (concat uncompress-message
512 " " base-name)
513 local-file
514 t
515 nil
516 uncompress-args)))
495 (setq size (- (point) start)) 517 (setq size (- (point) start))
496 (if replace 518 (if replace
497 (let* ((del-beg (point)) 519 (let* ((del-beg (point))
498 (del-end (+ del-beg size))) 520 (del-end (+ del-beg size)))
499 (delete-region del-beg 521 (delete-region del-beg
607 629
608 (jka-compr-run-real-handler 'file-local-copy (list filename))))) 630 (jka-compr-run-real-handler 'file-local-copy (list filename)))))
609 631
610 632
611 ;;; Support for loading compressed files. 633 ;;; Support for loading compressed files.
634 ;;; XEmacs: autoload this function
612 ;;;###autoload 635 ;;;###autoload
613 (defun jka-compr-load (file &optional noerror nomessage nosuffix) 636 (defun jka-compr-load (file &optional noerror nomessage nosuffix)
614 "Documented as original." 637 "Documented as original."
615 638
616 (let* ((local-copy (jka-compr-file-local-copy file)) 639 (let* ((local-copy (jka-compr-file-local-copy file))
621 (let (inhibit-file-name-operation 644 (let (inhibit-file-name-operation
622 inhibit-file-name-handlers) 645 inhibit-file-name-handlers)
623 (or nomessage 646 (or nomessage
624 (message "Loading %s..." file)) 647 (message "Loading %s..." file))
625 648
626 (load load-file noerror t t) 649 (let ((load-force-doc-strings t))
650 (load load-file noerror t t))
627 651
628 (or nomessage 652 (or nomessage
629 (message "Loading %s...done." file))) 653 (message "Loading %s...done." file)))
630 654
631 (jka-compr-delete-temp-file local-copy)) 655 (jka-compr-delete-temp-file local-copy))
632 656
633 t)) 657 t))
658
659 (defun jka-compr-byte-compiler-base-file-name (file)
660 (let ((info (jka-compr-get-compression-info file)))
661 (if (and info (jka-compr-info-strip-extension info))
662 (save-match-data
663 (substring file 0 (string-match (jka-compr-info-regexp info) file)))
664 file)))
634 665
635 (put 'write-region 'jka-compr 'jka-compr-write-region) 666 (put 'write-region 'jka-compr 'jka-compr-write-region)
636 (put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents) 667 (put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
637 (put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy) 668 (put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
638 (put 'load 'jka-compr 'jka-compr-load) 669 (put 'load 'jka-compr 'jka-compr-load)
670 (put 'byte-compiler-base-file-name 'jka-compr
671 'jka-compr-byte-compiler-base-file-name)
639 672
640 (defun jka-compr-handler (operation &rest args) 673 (defun jka-compr-handler (operation &rest args)
641 (save-match-data 674 (save-match-data
642 (let ((jka-op (get operation 'jka-compr))) 675 (let ((jka-op (get operation 'jka-compr)))
643 (if jka-op 676 (if jka-op
654 (and (eq inhibit-file-name-operation operation) 687 (and (eq inhibit-file-name-operation operation)
655 inhibit-file-name-handlers))) 688 inhibit-file-name-handlers)))
656 (inhibit-file-name-operation operation)) 689 (inhibit-file-name-operation operation))
657 (apply operation args))) 690 (apply operation args)))
658 691
692 ;; XEmacs change: I don't have a clue what this is trying do. -sb
693 ;; ;;;###autoload(defun auto-compression-mode (&optional arg)
694 ;; ;;;###autoload "\
695 ;; ;;;###autoloadToggle automatic file compression and uncompression.
696 ;; ;;;###autoloadWith prefix argument ARG, turn auto compression on if positive, else off.
697 ;; ;;;###autoloadReturns the new status of auto compression (non-nil means on)."
698 ;; ;;;###autoload (interactive "P")
699 ;; ;;;###autoload (if (not (fboundp 'jka-compr-installed-p))
700 ;; ;;;###autoload (progn
701 ;; ;;;###autoload (require 'jka-compr)
702 ;; ;;;###autoload ;; That turned the mode on, so make it initially off.
703 ;; ;;;###autoload (toggle-auto-compression)))
704 ;; ;;;###autoload (toggle-auto-compression arg t))
705
706 ;; XEmacs: autoload this function
659 ;;;###autoload 707 ;;;###autoload
660 (defun toggle-auto-compression (arg) 708 (defun toggle-auto-compression (&optional arg message)
661 "Toggle automatic file compression and decompression. 709 "Toggle automatic file compression and uncompression.
662 With prefix argument ARG, turn auto compression on if positive, else off. 710 With prefix argument ARG, turn auto compression on if positive, else off.
663 Returns the new status of auto compression (non-nil means on)." 711 Returns the new status of auto compression (non-nil means on).
664 (interactive "P") 712 If the argument MESSAGE is non-nil, it means to print a message
713 saying whether the mode is now on or off."
714 (interactive "P\np")
665 (let* ((installed (jka-compr-installed-p)) 715 (let* ((installed (jka-compr-installed-p))
666 (flag (if (null arg) 716 (flag (if (null arg)
667 (not installed) 717 (not installed)
668 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0)))))) 718 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))))
669 719
677 727
678 (t 728 (t
679 (jka-compr-uninstall))) 729 (jka-compr-uninstall)))
680 730
681 731
682 (and (interactive-p) 732 (and message
683 (if flag 733 (if flag
684 (message "Automatic file (de)compression is now ON.") 734 (message "Automatic file (de)compression is now ON.")
685 (message "Automatic file (de)compression is now OFF."))) 735 (message "Automatic file (de)compression is now OFF.")))
686 736
687 flag)) 737 flag))
720 auto-mode-alist)) 770 auto-mode-alist))
721 ;; Also add these regexps to 771 ;; Also add these regexps to
722 ;; inhibit-first-line-modes-suffixes, so that a 772 ;; inhibit-first-line-modes-suffixes, so that a
723 ;; -*- line in the first file of a compressed tar 773 ;; -*- line in the first file of a compressed tar
724 ;; file doesn't override tar-mode. 774 ;; file doesn't override tar-mode.
775 ;; XEmacs: the (now)superfluous conditional doesn't hurt
725 (and (boundp 'inhibit-first-line-modes-suffixes) 776 (and (boundp 'inhibit-first-line-modes-suffixes)
726 (setq inhibit-first-line-modes-suffixes 777 (setq inhibit-first-line-modes-suffixes
727 (cons (jka-compr-info-regexp x) 778 (cons (jka-compr-info-regexp x)
728 inhibit-first-line-modes-suffixes)))))) 779 inhibit-first-line-modes-suffixes))))))
729 jka-compr-compression-info-list) 780 jka-compr-compression-info-list)
739 ;; Delete from inhibit-first-line-modes-suffixes 790 ;; Delete from inhibit-first-line-modes-suffixes
740 ;; what jka-compr-install added. 791 ;; what jka-compr-install added.
741 (mapcar 792 (mapcar
742 (function (lambda (x) 793 (function (lambda (x)
743 (and (jka-compr-info-strip-extension x) 794 (and (jka-compr-info-strip-extension x)
795 ;; XEmacs: the (now)superfluous conditional doesn't hurt
744 (and (boundp 'inhibit-first-line-modes-suffixes) 796 (and (boundp 'inhibit-first-line-modes-suffixes)
745 (setq inhibit-first-line-modes-suffixes 797 (setq inhibit-first-line-modes-suffixes
746 (delete (jka-compr-info-regexp x) 798 (delete (jka-compr-info-regexp x)
747 inhibit-first-line-modes-suffixes))))) 799 inhibit-first-line-modes-suffixes)))))
748 ) 800 )