annotate lisp/jka-compr.el @ 6041:649926e9c1a8

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