13337
|
1 ;;; jka-compr.el --- reading/writing/loading compressed files
|
|
2
|
54521
|
3 ;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2003, 2004 Free Software Foundation, Inc.
|
6002
|
4
|
|
5 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
|
17976
|
6 ;; Maintainer: FSF
|
6002
|
7 ;; Keywords: data
|
|
8
|
13514
|
9 ;; This file is part of GNU Emacs.
|
|
10
|
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
14 ;; any later version.
|
|
15
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
19 ;; GNU General Public License for more details.
|
|
20
|
|
21 ;; You should have received a copy of the GNU General Public License
|
14169
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
24 ;; Boston, MA 02111-1307, USA.
|
13514
|
25
|
38412
|
26 ;;; Commentary:
|
6002
|
27
|
14169
|
28 ;; This package implements low-level support for reading, writing,
|
|
29 ;; and loading compressed files. It hooks into the low-level file
|
|
30 ;; I/O functions (including write-region and insert-file-contents) so
|
|
31 ;; that they automatically compress or uncompress a file if the file
|
|
32 ;; appears to need it (based on the extension of the file name).
|
|
33 ;; Packages like Rmail, VM, GNUS, and Info should be able to work
|
|
34 ;; with compressed files without modification.
|
6002
|
35
|
|
36
|
14169
|
37 ;; INSTRUCTIONS:
|
|
38 ;;
|
32497
|
39 ;; To use jka-compr, invoke the command `auto-compression-mode' (which
|
|
40 ;; see), or customize the variable of the same name. Its operation
|
|
41 ;; should be transparent to the user (except for messages appearing when
|
|
42 ;; a file is being compressed or uncompressed).
|
14169
|
43 ;;
|
|
44 ;; The variable, jka-compr-compression-info-list can be used to
|
|
45 ;; customize jka-compr to work with other compression programs.
|
|
46 ;; The default value of this variable allows jka-compr to work with
|
|
47 ;; Unix compress and gzip.
|
|
48 ;;
|
|
49 ;; If you are concerned about the stderr output of gzip and other
|
|
50 ;; compression/decompression programs showing up in your buffers, you
|
|
51 ;; should set the discard-error flag in the compression-info-list.
|
|
52 ;; This will cause the stderr of all programs to be discarded.
|
|
53 ;; However, it also causes emacs to call compression/uncompression
|
|
54 ;; programs through a shell (which is specified by jka-compr-shell).
|
|
55 ;; This may be a drag if, on your system, starting up a shell is
|
|
56 ;; slow.
|
|
57 ;;
|
|
58 ;; If you don't want messages about compressing and decompressing
|
|
59 ;; to show up in the echo area, you can set the compress-name and
|
|
60 ;; decompress-name fields of the jka-compr-compression-info-list to
|
|
61 ;; nil.
|
6002
|
62
|
|
63
|
14169
|
64 ;; APPLICATION NOTES:
|
|
65 ;;
|
|
66 ;; crypt++
|
45720
|
67 ;; jka-compr can coexist with crypt++ if you take all the decompression
|
14169
|
68 ;; entries out of the crypt-encoding-list. Clearly problems will arise if
|
|
69 ;; you have two programs trying to compress/decompress files. jka-compr
|
|
70 ;; will not "work with" crypt++ in the following sense: you won't be able to
|
|
71 ;; decode encrypted compressed files--that is, files that have been
|
|
72 ;; compressed then encrypted (in that order). Theoretically, crypt++ and
|
|
73 ;; jka-compr could properly handle a file that has been encrypted then
|
|
74 ;; compressed, but there is little point in trying to compress an encrypted
|
|
75 ;; file.
|
|
76 ;;
|
6002
|
77
|
|
78
|
14169
|
79 ;; ACKNOWLEDGMENTS
|
49597
|
80 ;;
|
14169
|
81 ;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people
|
49597
|
82 ;; have made helpful suggestions, reported bugs, and even fixed bugs in
|
14169
|
83 ;; jka-compr. I recall the following people as being particularly helpful.
|
|
84 ;;
|
|
85 ;; Jean-loup Gailly
|
|
86 ;; David Hughes
|
|
87 ;; Richard Pieri
|
|
88 ;; Daniel Quinlan
|
|
89 ;; Chris P. Ross
|
|
90 ;; Rick Sladkey
|
|
91 ;;
|
|
92 ;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for
|
|
93 ;; Version 18 of Emacs.
|
|
94 ;;
|
|
95 ;; After I had made progress on the original jka-compr for V18, I learned of a
|
|
96 ;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly
|
|
97 ;; what I was trying to do. I looked over the jam-zcat source code and
|
|
98 ;; probably got some ideas from it.
|
|
99 ;;
|
6002
|
100
|
|
101 ;;; Code:
|
|
102
|
17411
|
103 (defgroup compression nil
|
|
104 "Data compression utilities"
|
|
105 :group 'data)
|
|
106
|
|
107 (defgroup jka-compr nil
|
|
108 "jka-compr customization"
|
|
109 :group 'compression)
|
|
110
|
|
111
|
|
112 (defcustom jka-compr-shell "sh"
|
6002
|
113 "*Shell to be used for calling compression programs.
|
|
114 The value of this variable only matters if you want to discard the
|
|
115 stderr of a compression/decompression program (see the documentation
|
17411
|
116 for `jka-compr-compression-info-list')."
|
|
117 :type 'string
|
|
118 :group 'jka-compr)
|
6002
|
119
|
49597
|
120 (defvar jka-compr-use-shell
|
21633
185e8e424ee9
(jka-compr-use-shell) [ms-dos, windows-nt]: Do not use a shell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
121 (not (memq system-type '(ms-dos windows-nt))))
|
6002
|
122
|
|
123 ;;; I have this defined so that .Z files are assumed to be in unix
|
20873
|
124 ;;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
|
17411
|
125 (defcustom jka-compr-compression-info-list
|
6002
|
126 ;;[regexp
|
7616
|
127 ;; compr-message compr-prog compr-args
|
|
128 ;; uncomp-message uncomp-prog uncomp-args
|
26987
|
129 ;; can-append auto-mode-flag strip-extension-flag file-magic-bytes]
|
8774
|
130 '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
|
6002
|
131 "compressing" "compress" ("-c")
|
|
132 "uncompressing" "uncompress" ("-c")
|
26987
|
133 nil t "\037\235"]
|
23348
|
134 ;; Formerly, these had an additional arg "-c", but that fails with
|
|
135 ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
|
|
136 ;; "Version 0.9.0b, 9-Sept-98".
|
20873
|
137 ["\\.bz2\\'"
|
23348
|
138 "bzip2ing" "bzip2" nil
|
|
139 "bunzip2ing" "bzip2" ("-d")
|
26987
|
140 nil t "BZh"]
|
54521
|
141 ["\\.tbz\\'"
|
|
142 "bzip2ing" "bzip2" nil
|
|
143 "bunzip2ing" "bzip2" ("-d")
|
|
144 nil nil "BZh"]
|
9493
|
145 ["\\.tgz\\'"
|
|
146 "zipping" "gzip" ("-c" "-q")
|
|
147 "unzipping" "gzip" ("-c" "-q" "-d")
|
26987
|
148 t nil "\037\213"]
|
28484
|
149 ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'"
|
6002
|
150 "zipping" "gzip" ("-c" "-q")
|
|
151 "unzipping" "gzip" ("-c" "-q" "-d")
|
54521
|
152 t t "\037\213"]
|
|
153 ;; dzip is gzip with random access. Its compression program can't
|
|
154 ;; read/write stdin/out, so .dz files can only be viewed without
|
|
155 ;; saving, having their contents decompressed with gzip.
|
|
156 ["\\.dz\\'"
|
|
157 nil nil nil
|
|
158 "unzipping" "gzip" ("-c" "-q" "-d")
|
|
159 nil t "\037\213"])
|
6002
|
160
|
|
161 "List of vectors that describe available compression techniques.
|
|
162 Each element, which describes a compression technique, is a vector of
|
7616
|
163 the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
|
|
164 UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
|
26987
|
165 APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
|
6002
|
166
|
|
167 regexp is a regexp that matches filenames that are
|
|
168 compressed with this format
|
|
169
|
7616
|
170 compress-msg is the message to issue to the user when doing this
|
|
171 type of compression (nil means no message)
|
|
172
|
6002
|
173 compress-program is a program that performs this compression
|
54521
|
174 (nil means visit file in read-only mode)
|
6002
|
175
|
|
176 compress-args is a list of args to pass to the compress program
|
|
177
|
7616
|
178 uncompress-msg is the message to issue to the user when doing this
|
|
179 type of uncompression (nil means no message)
|
6002
|
180
|
|
181 uncompress-program is a program that performs this compression
|
|
182
|
|
183 uncompress-args is a list of args to pass to the uncompress program
|
|
184
|
|
185 append-flag is non-nil if this compression technique can be
|
|
186 appended
|
|
187
|
26987
|
188 strip-extension-flag non-nil means strip the regexp from file names
|
6002
|
189 before attempting to set the mode.
|
|
190
|
26987
|
191 file-magic-chars is a string of characters that you would find
|
|
192 at the beginning of a file compressed in this way.
|
|
193
|
7976
|
194 Because of the way `call-process' is defined, discarding the stderr output of
|
6002
|
195 a program adds the overhead of starting a shell each time the program is
|
17411
|
196 invoked."
|
|
197 :type '(repeat (vector regexp
|
|
198 (choice :tag "Compress Message"
|
|
199 (string :format "%v")
|
|
200 (const :tag "No Message" nil))
|
|
201 (string :tag "Compress Program")
|
|
202 (repeat :tag "Compress Arguments" string)
|
|
203 (choice :tag "Uncompress Message"
|
|
204 (string :format "%v")
|
|
205 (const :tag "No Message" nil))
|
|
206 (string :tag "Uncompress Program")
|
|
207 (repeat :tag "Uncompress Arguments" string)
|
|
208 (boolean :tag "Append")
|
34332
|
209 (boolean :tag "Strip Extension")
|
|
210 (string :tag "Magic Bytes")))
|
17411
|
211 :group 'jka-compr)
|
6002
|
212
|
40782
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
213 (defcustom jka-compr-mode-alist-additions
|
54521
|
214 (list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode))
|
40782
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
215 "A list of pairs to add to `auto-mode-alist' when jka-compr is installed."
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
216 :type '(repeat (cons string symbol))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
217 :group 'jka-compr)
|
19004
|
218
|
40782
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
219 (defcustom jka-compr-load-suffixes '(".gz")
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
220 "List of suffixes to try when loading files."
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
221 :type '(repeat string)
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
222 :group 'jka-compr)
|
39829
|
223
|
19004
|
224 ;; List of all the elements we actually added to file-coding-system-alist.
|
|
225 (defvar jka-compr-added-to-file-coding-system-alist nil)
|
6002
|
226
|
7617
edc853e14f7b
(jka-compr-op-table, jka-compr-file-name-handler-entry): Move defvars.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
227 (defvar jka-compr-file-name-handler-entry
|
edc853e14f7b
(jka-compr-op-table, jka-compr-file-name-handler-entry): Move defvars.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
228 nil
|
edc853e14f7b
(jka-compr-op-table, jka-compr-file-name-handler-entry): Move defvars.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
229 "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.")
|
26987
|
230
|
|
231 (defvar jka-compr-really-do-compress nil
|
|
232 "Non-nil in a buffer whose visited file was uncompressed on visiting it.")
|
|
233 (put 'jka-compr-really-do-compress 'permanent-local t)
|
7617
edc853e14f7b
(jka-compr-op-table, jka-compr-file-name-handler-entry): Move defvars.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
234
|
15083
|
235 ;;; Functions for accessing the return value of jka-compr-get-compression-info
|
6002
|
236 (defun jka-compr-info-regexp (info) (aref info 0))
|
|
237 (defun jka-compr-info-compress-message (info) (aref info 1))
|
|
238 (defun jka-compr-info-compress-program (info) (aref info 2))
|
|
239 (defun jka-compr-info-compress-args (info) (aref info 3))
|
|
240 (defun jka-compr-info-uncompress-message (info) (aref info 4))
|
|
241 (defun jka-compr-info-uncompress-program (info) (aref info 5))
|
|
242 (defun jka-compr-info-uncompress-args (info) (aref info 6))
|
|
243 (defun jka-compr-info-can-append (info) (aref info 7))
|
|
244 (defun jka-compr-info-strip-extension (info) (aref info 8))
|
26987
|
245 (defun jka-compr-info-file-magic-bytes (info) (aref info 9))
|
6002
|
246
|
|
247
|
|
248 (defun jka-compr-get-compression-info (filename)
|
|
249 "Return information about the compression scheme of FILENAME.
|
|
250 The determination as to which compression scheme, if any, to use is
|
7066
|
251 based on the filename itself and `jka-compr-compression-info-list'."
|
6002
|
252 (catch 'compression-info
|
|
253 (let ((case-fold-search nil))
|
|
254 (mapcar
|
|
255 (function (lambda (x)
|
|
256 (and (string-match (jka-compr-info-regexp x) filename)
|
|
257 (throw 'compression-info x))))
|
|
258 jka-compr-compression-info-list)
|
|
259 nil)))
|
|
260
|
|
261
|
|
262 (put 'compression-error 'error-conditions '(compression-error file-error error))
|
|
263
|
|
264
|
11635
|
265 (defvar jka-compr-acceptable-retval-list '(0 2 141))
|
6002
|
266
|
|
267
|
|
268 (defun jka-compr-error (prog args infile message &optional errfile)
|
|
269
|
|
270 (let ((errbuf (get-buffer-create " *jka-compr-error*"))
|
|
271 (curbuf (current-buffer)))
|
16940
|
272 (with-current-buffer errbuf
|
|
273 (widen) (erase-buffer)
|
|
274 (insert (format "Error while executing \"%s %s < %s\"\n\n"
|
|
275 prog
|
|
276 (mapconcat 'identity args " ")
|
|
277 infile))
|
6002
|
278
|
16940
|
279 (and errfile
|
|
280 (insert-file-contents errfile)))
|
6002
|
281 (display-buffer errbuf))
|
|
282
|
16940
|
283 (signal 'compression-error
|
|
284 (list "Opening input file" (format "error %s" message) infile)))
|
49597
|
285
|
|
286
|
40782
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
287 (defcustom jka-compr-dd-program "/bin/dd"
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
288 "How to invoke `dd'."
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
289 :type 'string
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
290 :group 'jka-compr)
|
6002
|
291
|
|
292
|
6041
|
293 (defvar jka-compr-dd-blocksize 256)
|
6002
|
294
|
|
295
|
|
296 (defun jka-compr-partial-uncompress (prog message args infile beg len)
|
|
297 "Call program PROG with ARGS args taking input from INFILE.
|
|
298 Fourth and fifth args, BEG and LEN, specify which part of the output
|
8065
|
299 to keep: LEN chars starting BEG chars from the beginning."
|
40782
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
300 (let ((start (point))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
301 (prefix beg))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
302 (if (and jka-compr-use-shell jka-compr-dd-program)
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
303 ;; Put the uncompression output through dd
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
304 ;; to discard the part we don't want.
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
305 (let ((skip (/ beg jka-compr-dd-blocksize))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
306 (err-file (jka-compr-make-temp-name))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
307 count)
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
308 ;; Update PREFIX based on the text that we won't read in.
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
309 (setq prefix (- beg (* skip jka-compr-dd-blocksize))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
310 count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
311 (unwind-protect
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
312 (or (memq (call-process
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
313 jka-compr-shell infile t nil "-c"
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
314 (format
|
42231
054cf5ce349b
(jka-compr-partial-uncompress): Use null-device instead of a literal
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
315 "%s %s 2> %s | %s bs=%d skip=%d %s 2> %s"
|
40782
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
316 prog
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
317 (mapconcat 'identity args " ")
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
318 err-file
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
319 jka-compr-dd-program
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
320 jka-compr-dd-blocksize
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
321 skip
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
322 ;; dd seems to be unreliable about
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
323 ;; providing the last block. So, always
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
324 ;; read one more than you think you need.
|
42231
054cf5ce349b
(jka-compr-partial-uncompress): Use null-device instead of a literal
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
325 (if count (format "count=%d" (1+ count)) "")
|
054cf5ce349b
(jka-compr-partial-uncompress): Use null-device instead of a literal
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
326 null-device))
|
40782
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
327 jka-compr-acceptable-retval-list)
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
328 (jka-compr-error prog args infile message err-file))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
329 (jka-compr-delete-temp-file err-file)))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
330 ;; Run the uncompression program directly.
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
331 ;; We get the whole file and must delete what we don't want.
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
332 (jka-compr-call-process prog message infile t nil args))
|
6002
|
333
|
8065
|
334 ;; Delete the stuff after what we want, if there is any.
|
6002
|
335 (and
|
6041
|
336 len
|
8065
|
337 (< (+ start prefix len) (point))
|
6041
|
338 (delete-region (+ start prefix len) (point)))
|
6002
|
339
|
8065
|
340 ;; Delete the stuff before what we want.
|
6002
|
341 (delete-region start (+ start prefix))))
|
|
342
|
|
343
|
|
344 (defun jka-compr-call-process (prog message infile output temp args)
|
|
345 (if jka-compr-use-shell
|
|
346
|
18879
|
347 (let ((err-file (jka-compr-make-temp-name))
|
18906
|
348 (coding-system-for-read (or coding-system-for-read 'undecided))
|
22360
|
349 (coding-system-for-write 'no-conversion))
|
18879
|
350
|
6002
|
351 (unwind-protect
|
|
352
|
|
353 (or (memq
|
|
354 (call-process jka-compr-shell infile
|
|
355 (if (stringp output) nil output)
|
|
356 nil
|
|
357 "-c"
|
|
358 (format "%s %s 2> %s %s"
|
|
359 prog
|
|
360 (mapconcat 'identity args " ")
|
|
361 err-file
|
|
362 (if (stringp output)
|
|
363 (concat "> " output)
|
|
364 "")))
|
|
365 jka-compr-acceptable-retval-list)
|
|
366
|
|
367 (jka-compr-error prog args infile message err-file))
|
|
368
|
|
369 (jka-compr-delete-temp-file err-file)))
|
|
370
|
53477
|
371 (or (eq 0
|
6002
|
372 (apply 'call-process
|
|
373 prog
|
|
374 infile
|
|
375 (if (stringp output) temp output)
|
|
376 nil
|
|
377 args))
|
|
378 (jka-compr-error prog args infile message))
|
|
379
|
|
380 (and (stringp output)
|
16940
|
381 (with-current-buffer temp
|
6002
|
382 (write-region (point-min) (point-max) output)
|
16940
|
383 (erase-buffer)))))
|
6002
|
384
|
|
385
|
|
386 ;;; Support for temp files. Much of this was inspired if not lifted
|
|
387 ;;; from ange-ftp.
|
|
388
|
17411
|
389 (defcustom jka-compr-temp-name-template
|
22100
|
390 (expand-file-name "jka-com" temporary-file-directory)
|
17441
|
391 "Prefix added to all temp files created by jka-compr.
|
17411
|
392 There should be no more than seven characters after the final `/'."
|
|
393 :type 'string
|
|
394 :group 'jka-compr)
|
6002
|
395
|
|
396 (defun jka-compr-make-temp-name (&optional local-copy)
|
|
397 "This routine will return the name of a new file."
|
26039
|
398 (make-temp-file jka-compr-temp-name-template))
|
6002
|
399
|
26039
|
400 (defalias 'jka-compr-delete-temp-file 'delete-file)
|
6002
|
401
|
|
402
|
|
403 (defun jka-compr-write-region (start end file &optional append visit)
|
|
404 (let* ((filename (expand-file-name file))
|
|
405 (visit-file (if (stringp visit) (expand-file-name visit) filename))
|
26987
|
406 (info (jka-compr-get-compression-info visit-file))
|
|
407 (magic (and info (jka-compr-info-file-magic-bytes info))))
|
6002
|
408
|
42461
|
409 ;; If START is nil, use the whole buffer.
|
|
410 (if (null start)
|
|
411 (setq start 1 end (1+ (buffer-size))))
|
|
412
|
26987
|
413 ;; If we uncompressed this file when visiting it,
|
|
414 ;; then recompress it when writing it
|
|
415 ;; even if the contents look compressed already.
|
|
416 (if (and jka-compr-really-do-compress
|
|
417 (eq start 1)
|
|
418 (eq end (1+ (buffer-size))))
|
|
419 (setq magic nil))
|
6002
|
420
|
26987
|
421 (if (and info
|
|
422 ;; If the contents to be written out
|
|
423 ;; are properly compressed already,
|
|
424 ;; don't try to compress them over again.
|
|
425 (not (and magic
|
|
426 (equal (if (stringp start)
|
|
427 (substring start 0 (min (length start)
|
|
428 (length magic)))
|
|
429 (buffer-substring start
|
|
430 (min end
|
|
431 (+ start (length magic)))))
|
|
432 magic))))
|
|
433 (let ((can-append (jka-compr-info-can-append info))
|
|
434 (compress-program (jka-compr-info-compress-program info))
|
|
435 (compress-message (jka-compr-info-compress-message info))
|
|
436 (compress-args (jka-compr-info-compress-args info))
|
|
437 (base-name (file-name-nondirectory visit-file))
|
|
438 temp-file temp-buffer
|
|
439 ;; we need to leave `last-coding-system-used' set to its
|
|
440 ;; value after calling write-region the first time, so
|
|
441 ;; that `basic-save-buffer' sees the right value.
|
|
442 (coding-system-used last-coding-system-used))
|
6002
|
443
|
54521
|
444 (or compress-program
|
|
445 (error "No compression program defined"))
|
|
446
|
26987
|
447 (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
|
|
448 (with-current-buffer temp-buffer
|
|
449 (widen) (erase-buffer))
|
6002
|
450
|
26987
|
451 (if (and append
|
|
452 (not can-append)
|
|
453 (file-exists-p filename))
|
6002
|
454
|
26987
|
455 (let* ((local-copy (file-local-copy filename))
|
|
456 (local-file (or local-copy filename)))
|
|
457
|
|
458 (setq temp-file local-file))
|
|
459
|
|
460 (setq temp-file (jka-compr-make-temp-name)))
|
6002
|
461
|
49597
|
462 (and
|
26987
|
463 compress-message
|
|
464 (message "%s %s..." compress-message base-name))
|
|
465
|
|
466 (jka-compr-run-real-handler 'write-region
|
|
467 (list start end temp-file t 'dont))
|
|
468 ;; save value used by the real write-region
|
|
469 (setq coding-system-used last-coding-system-used)
|
6002
|
470
|
26987
|
471 ;; Here we must read the output of compress program as is
|
|
472 ;; without any code conversion.
|
|
473 (let ((coding-system-for-read 'no-conversion))
|
|
474 (jka-compr-call-process compress-program
|
|
475 (concat compress-message
|
|
476 " " base-name)
|
|
477 temp-file
|
|
478 temp-buffer
|
|
479 nil
|
|
480 compress-args))
|
6002
|
481
|
26987
|
482 (with-current-buffer temp-buffer
|
|
483 (let ((coding-system-for-write 'no-conversion))
|
|
484 (if (memq system-type '(ms-dos windows-nt))
|
|
485 (setq buffer-file-type t) )
|
|
486 (jka-compr-run-real-handler 'write-region
|
|
487 (list (point-min) (point-max)
|
|
488 filename
|
|
489 (and append can-append) 'dont))
|
|
490 (erase-buffer)) )
|
6002
|
491
|
26987
|
492 (jka-compr-delete-temp-file temp-file)
|
|
493
|
|
494 (and
|
|
495 compress-message
|
|
496 (message "%s %s...done" compress-message base-name))
|
6002
|
497
|
26987
|
498 (cond
|
|
499 ((eq visit t)
|
|
500 (setq buffer-file-name filename)
|
|
501 (setq jka-compr-really-do-compress t)
|
|
502 (set-visited-file-modtime))
|
|
503 ((stringp visit)
|
|
504 (setq buffer-file-name visit)
|
|
505 (let ((buffer-file-name filename))
|
|
506 (set-visited-file-modtime))))
|
6002
|
507
|
26987
|
508 (and (or (eq visit t)
|
|
509 (eq visit nil)
|
|
510 (stringp visit))
|
|
511 (message "Wrote %s" visit-file))
|
22360
|
512
|
26987
|
513 ;; ensure `last-coding-system-used' has an appropriate value
|
|
514 (setq last-coding-system-used coding-system-used)
|
|
515
|
|
516 nil)
|
49597
|
517
|
26987
|
518 (jka-compr-run-real-handler 'write-region
|
|
519 (list start end filename append visit)))))
|
6002
|
520
|
|
521
|
6218
|
522 (defun jka-compr-insert-file-contents (file &optional visit beg end replace)
|
6002
|
523 (barf-if-buffer-read-only)
|
|
524
|
|
525 (and (or beg end)
|
|
526 visit
|
|
527 (error "Attempt to visit less than an entire file"))
|
|
528
|
|
529 (let* ((filename (expand-file-name file))
|
|
530 (info (jka-compr-get-compression-info filename)))
|
|
531
|
|
532 (if info
|
|
533
|
|
534 (let ((uncompress-message (jka-compr-info-uncompress-message info))
|
|
535 (uncompress-program (jka-compr-info-uncompress-program info))
|
|
536 (uncompress-args (jka-compr-info-uncompress-args info))
|
|
537 (base-name (file-name-nondirectory filename))
|
|
538 (notfound nil)
|
7976
|
539 (local-copy
|
|
540 (jka-compr-run-real-handler 'file-local-copy (list filename)))
|
6002
|
541 local-file
|
49377
|
542 size start)
|
6002
|
543
|
|
544 (setq local-file (or local-copy filename))
|
|
545
|
|
546 (and
|
|
547 visit
|
|
548 (setq buffer-file-name filename))
|
|
549
|
|
550 (unwind-protect ; to make sure local-copy gets deleted
|
|
551
|
|
552 (progn
|
49597
|
553
|
6002
|
554 (and
|
|
555 uncompress-message
|
|
556 (message "%s %s..." uncompress-message base-name))
|
|
557
|
|
558 (condition-case error-code
|
|
559
|
49377
|
560 (let ((coding-system-for-read 'no-conversion))
|
8774
|
561 (if replace
|
|
562 (goto-char (point-min)))
|
6002
|
563 (setq start (point))
|
|
564 (if (or beg end)
|
|
565 (jka-compr-partial-uncompress uncompress-program
|
|
566 (concat uncompress-message
|
|
567 " " base-name)
|
|
568 uncompress-args
|
|
569 local-file
|
|
570 (or beg 0)
|
|
571 (if (and beg end)
|
|
572 (- end beg)
|
|
573 end))
|
11621
|
574 ;; If visiting, bind off buffer-file-name so that
|
|
575 ;; file-locking will not ask whether we should
|
|
576 ;; really edit the buffer.
|
|
577 (let ((buffer-file-name
|
|
578 (if visit nil buffer-file-name)))
|
|
579 (jka-compr-call-process uncompress-program
|
|
580 (concat uncompress-message
|
|
581 " " base-name)
|
|
582 local-file
|
|
583 t
|
|
584 nil
|
|
585 uncompress-args)))
|
6002
|
586 (setq size (- (point) start))
|
8774
|
587 (if replace
|
51284
|
588 (delete-region (point) (point-max)))
|
8774
|
589 (goto-char start))
|
6002
|
590 (error
|
|
591 (if (and (eq (car error-code) 'file-error)
|
|
592 (eq (nth 3 error-code) local-file))
|
|
593 (if visit
|
|
594 (setq notfound error-code)
|
49597
|
595 (signal 'file-error
|
6002
|
596 (cons "Opening input file"
|
|
597 (nthcdr 2 error-code))))
|
|
598 (signal (car error-code) (cdr error-code))))))
|
|
599
|
|
600 (and
|
|
601 local-copy
|
|
602 (file-exists-p local-copy)
|
|
603 (delete-file local-copy)))
|
|
604
|
53304
|
605 (unless notfound
|
|
606 (decode-coding-inserted-region
|
|
607 (point) (+ (point) size)
|
|
608 (jka-compr-byte-compiler-base-file-name file)
|
|
609 visit beg end replace))
|
49377
|
610
|
6002
|
611 (and
|
|
612 visit
|
|
613 (progn
|
7976
|
614 (unlock-buffer)
|
6002
|
615 (setq buffer-file-name filename)
|
26987
|
616 (setq jka-compr-really-do-compress t)
|
6002
|
617 (set-visited-file-modtime)))
|
49597
|
618
|
6002
|
619 (and
|
|
620 uncompress-message
|
|
621 (message "%s %s...done" uncompress-message base-name))
|
|
622
|
|
623 (and
|
|
624 visit
|
|
625 notfound
|
|
626 (signal 'file-error
|
|
627 (cons "Opening input file" (nth 2 notfound))))
|
|
628
|
22484
|
629 ;; This is done in insert-file-contents after we return.
|
|
630 ;; That is a little weird, but better to go along with it now
|
|
631 ;; than to change it now.
|
|
632
|
|
633 ;;; ;; Run the functions that insert-file-contents would.
|
|
634 ;;; (let ((p after-insert-file-functions)
|
|
635 ;;; (insval size))
|
|
636 ;;; (while p
|
|
637 ;;; (setq insval (funcall (car p) size))
|
|
638 ;;; (if insval
|
|
639 ;;; (progn
|
|
640 ;;; (or (integerp insval)
|
|
641 ;;; (signal 'wrong-type-argument
|
|
642 ;;; (list 'integerp insval)))
|
|
643 ;;; (setq size insval)))
|
|
644 ;;; (setq p (cdr p))))
|
8774
|
645
|
54521
|
646 (or (jka-compr-info-compress-program info)
|
|
647 (message "You can't save this buffer because compression program is not defined"))
|
|
648
|
6002
|
649 (list filename size))
|
|
650
|
7976
|
651 (jka-compr-run-real-handler 'insert-file-contents
|
|
652 (list file visit beg end replace)))))
|
6002
|
653
|
|
654
|
|
655 (defun jka-compr-file-local-copy (file)
|
|
656 (let* ((filename (expand-file-name file))
|
|
657 (info (jka-compr-get-compression-info filename)))
|
|
658
|
|
659 (if info
|
|
660
|
|
661 (let ((uncompress-message (jka-compr-info-uncompress-message info))
|
|
662 (uncompress-program (jka-compr-info-uncompress-program info))
|
|
663 (uncompress-args (jka-compr-info-uncompress-args info))
|
|
664 (base-name (file-name-nondirectory filename))
|
7976
|
665 (local-copy
|
|
666 (jka-compr-run-real-handler 'file-local-copy (list filename)))
|
6002
|
667 (temp-file (jka-compr-make-temp-name t))
|
11635
|
668 (temp-buffer (get-buffer-create " *jka-compr-flc-temp*"))
|
6002
|
669 (notfound nil)
|
|
670 local-file)
|
|
671
|
|
672 (setq local-file (or local-copy filename))
|
|
673
|
|
674 (unwind-protect
|
|
675
|
16940
|
676 (with-current-buffer temp-buffer
|
49597
|
677
|
6002
|
678 (and
|
|
679 uncompress-message
|
|
680 (message "%s %s..." uncompress-message base-name))
|
49597
|
681
|
18906
|
682 ;; Here we must read the output of uncompress program
|
|
683 ;; and write it to TEMP-FILE without any code
|
|
684 ;; conversion. An appropriate code conversion (if
|
|
685 ;; necessary) is done by the later I/O operation
|
|
686 ;; (e.g. load).
|
|
687 (let ((coding-system-for-read 'no-conversion)
|
|
688 (coding-system-for-write 'no-conversion))
|
6002
|
689
|
18906
|
690 (jka-compr-call-process uncompress-program
|
|
691 (concat uncompress-message
|
|
692 " " base-name)
|
|
693 local-file
|
|
694 t
|
|
695 nil
|
|
696 uncompress-args)
|
6002
|
697
|
18906
|
698 (and
|
|
699 uncompress-message
|
|
700 (message "%s %s...done" uncompress-message base-name))
|
|
701
|
|
702 (write-region
|
|
703 (point-min) (point-max) temp-file nil 'dont)))
|
6002
|
704
|
|
705 (and
|
|
706 local-copy
|
|
707 (file-exists-p local-copy)
|
|
708 (delete-file local-copy))
|
|
709
|
|
710 (kill-buffer temp-buffer))
|
|
711
|
|
712 temp-file)
|
49597
|
713
|
7976
|
714 (jka-compr-run-real-handler 'file-local-copy (list filename)))))
|
6002
|
715
|
|
716
|
|
717 ;;; Support for loading compressed files.
|
|
718 (defun jka-compr-load (file &optional noerror nomessage nosuffix)
|
|
719 "Documented as original."
|
|
720
|
|
721 (let* ((local-copy (jka-compr-file-local-copy file))
|
|
722 (load-file (or local-copy file)))
|
|
723
|
|
724 (unwind-protect
|
|
725
|
7976
|
726 (let (inhibit-file-name-operation
|
|
727 inhibit-file-name-handlers)
|
6002
|
728 (or nomessage
|
|
729 (message "Loading %s..." file))
|
|
730
|
12758
|
731 (let ((load-force-doc-strings t))
|
|
732 (load load-file noerror t t))
|
6002
|
733 (or nomessage
|
27512
|
734 (message "Loading %s...done." file))
|
|
735 ;; Fix up the load history to point at the right library.
|
|
736 (let ((l (assoc load-file load-history)))
|
|
737 ;; Remove .gz and .elc?.
|
|
738 (while (file-name-extension file)
|
|
739 (setq file (file-name-sans-extension file)))
|
|
740 (setcar l file)))
|
6002
|
741
|
|
742 (jka-compr-delete-temp-file local-copy))
|
|
743
|
|
744 t))
|
12922
|
745
|
|
746 (defun jka-compr-byte-compiler-base-file-name (file)
|
|
747 (let ((info (jka-compr-get-compression-info file)))
|
|
748 (if (and info (jka-compr-info-strip-extension info))
|
|
749 (save-match-data
|
|
750 (substring file 0 (string-match (jka-compr-info-regexp info) file)))
|
|
751 file)))
|
7976
|
752
|
|
753 (put 'write-region 'jka-compr 'jka-compr-write-region)
|
|
754 (put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
|
|
755 (put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
|
|
756 (put 'load 'jka-compr 'jka-compr-load)
|
12922
|
757 (put 'byte-compiler-base-file-name 'jka-compr
|
|
758 'jka-compr-byte-compiler-base-file-name)
|
6002
|
759
|
20132
|
760 (defvar jka-compr-inhibit nil
|
|
761 "Non-nil means inhibit automatic uncompression temporarily.
|
|
762 Lisp programs can bind this to t to do that.
|
|
763 It is not recommended to set this variable permanently to anything but nil.")
|
|
764
|
47180
|
765 (put 'jka-compr-handler 'safe-magic t)
|
6002
|
766 (defun jka-compr-handler (operation &rest args)
|
7976
|
767 (save-match-data
|
|
768 (let ((jka-op (get operation 'jka-compr)))
|
20132
|
769 (if (and jka-op (not jka-compr-inhibit))
|
7976
|
770 (apply jka-op args)
|
|
771 (jka-compr-run-real-handler operation args)))))
|
6002
|
772
|
7066
|
773 ;; If we are given an operation that we don't handle,
|
|
774 ;; call the Emacs primitive for that operation,
|
|
775 ;; and manipulate the inhibit variables
|
|
776 ;; to prevent the primitive from calling our handler again.
|
|
777 (defun jka-compr-run-real-handler (operation args)
|
|
778 (let ((inhibit-file-name-handlers
|
|
779 (cons 'jka-compr-handler
|
|
780 (and (eq inhibit-file-name-operation operation)
|
|
781 inhibit-file-name-handlers)))
|
|
782 (inhibit-file-name-operation operation))
|
|
783 (apply operation args)))
|
|
784
|
31747
|
785
|
6002
|
786 (defun jka-compr-build-file-regexp ()
|
31975
|
787 (mapconcat
|
|
788 'jka-compr-info-regexp
|
|
789 jka-compr-compression-info-list
|
|
790 "\\|"))
|
6002
|
791
|
|
792
|
|
793 (defun jka-compr-install ()
|
|
794 "Install jka-compr.
|
11296
|
795 This adds entries to `file-name-handler-alist' and `auto-mode-alist'
|
|
796 and `inhibit-first-line-modes-suffixes'."
|
6002
|
797
|
|
798 (setq jka-compr-file-name-handler-entry
|
|
799 (cons (jka-compr-build-file-regexp) 'jka-compr-handler))
|
|
800
|
|
801 (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry
|
|
802 file-name-handler-alist))
|
|
803
|
19004
|
804 (setq jka-compr-added-to-file-coding-system-alist nil)
|
|
805
|
6002
|
806 (mapcar
|
|
807 (function (lambda (x)
|
19004
|
808 ;; Don't do multibyte encoding on the compressed files.
|
|
809 (let ((elt (cons (jka-compr-info-regexp x)
|
|
810 '(no-conversion . no-conversion))))
|
|
811 (setq file-coding-system-alist
|
|
812 (cons elt file-coding-system-alist))
|
|
813 (setq jka-compr-added-to-file-coding-system-alist
|
|
814 (cons elt jka-compr-added-to-file-coding-system-alist)))
|
|
815
|
11179
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
816 (and (jka-compr-info-strip-extension x)
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
817 ;; Make entries in auto-mode-alist so that modes
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
818 ;; are chosen right according to the file names
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
819 ;; sans `.gz'.
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
820 (setq auto-mode-alist
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
821 (cons (list (jka-compr-info-regexp x)
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
822 nil 'jka-compr)
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
823 auto-mode-alist))
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
824 ;; Also add these regexps to
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
825 ;; inhibit-first-line-modes-suffixes, so that a
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
826 ;; -*- line in the first file of a compressed tar
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
827 ;; file doesn't override tar-mode.
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
828 (setq inhibit-first-line-modes-suffixes
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
829 (cons (jka-compr-info-regexp x)
|
9ff0cfb97106
(jka-compr-install): Add items to inhibit-first-line-modes-suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
830 inhibit-first-line-modes-suffixes)))))
|
9493
|
831 jka-compr-compression-info-list)
|
|
832 (setq auto-mode-alist
|
39829
|
833 (append auto-mode-alist jka-compr-mode-alist-additions))
|
|
834
|
|
835 ;; Make sure that (load "foo") will find /bla/foo.el.gz.
|
|
836 (setq load-suffixes
|
|
837 (apply 'append
|
|
838 (mapcar (lambda (suffix)
|
|
839 (cons suffix
|
|
840 (mapcar (lambda (ext) (concat suffix ext))
|
|
841 jka-compr-load-suffixes)))
|
|
842 load-suffixes))))
|
6002
|
843
|
|
844
|
|
845 (defun jka-compr-uninstall ()
|
|
846 "Uninstall jka-compr.
|
7066
|
847 This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
|
11296
|
848 and `inhibit-first-line-modes-suffixes' that were added
|
|
849 by `jka-compr-installed'."
|
|
850 ;; Delete from inhibit-first-line-modes-suffixes
|
|
851 ;; what jka-compr-install added.
|
|
852 (mapcar
|
|
853 (function (lambda (x)
|
|
854 (and (jka-compr-info-strip-extension x)
|
|
855 (setq inhibit-first-line-modes-suffixes
|
|
856 (delete (jka-compr-info-regexp x)
|
|
857 inhibit-first-line-modes-suffixes)))))
|
|
858 jka-compr-compression-info-list)
|
6002
|
859
|
|
860 (let* ((fnha (cons nil file-name-handler-alist))
|
|
861 (last fnha))
|
|
862
|
|
863 (while (cdr last)
|
|
864 (if (eq (cdr (car (cdr last))) 'jka-compr-handler)
|
|
865 (setcdr last (cdr (cdr last)))
|
|
866 (setq last (cdr last))))
|
|
867
|
|
868 (setq file-name-handler-alist (cdr fnha)))
|
|
869
|
|
870 (let* ((ama (cons nil auto-mode-alist))
|
|
871 (last ama)
|
|
872 entry)
|
|
873
|
|
874 (while (cdr last)
|
|
875 (setq entry (car (cdr last)))
|
9493
|
876 (if (or (member entry jka-compr-mode-alist-additions)
|
|
877 (and (consp (cdr entry))
|
|
878 (eq (nth 2 entry) 'jka-compr)))
|
6002
|
879 (setcdr last (cdr (cdr last)))
|
|
880 (setq last (cdr last))))
|
49597
|
881
|
19004
|
882 (setq auto-mode-alist (cdr ama)))
|
|
883
|
|
884 (let* ((ama (cons nil file-coding-system-alist))
|
|
885 (last ama)
|
|
886 entry)
|
|
887
|
|
888 (while (cdr last)
|
|
889 (setq entry (car (cdr last)))
|
|
890 (if (member entry jka-compr-added-to-file-coding-system-alist)
|
|
891 (setcdr last (cdr (cdr last)))
|
|
892 (setq last (cdr last))))
|
49597
|
893
|
39829
|
894 (setq file-coding-system-alist (cdr ama)))
|
|
895
|
|
896 ;; Remove the suffixes that were added by jka-compr.
|
|
897 (let ((suffixes nil)
|
|
898 (re (jka-compr-build-file-regexp)))
|
|
899 (dolist (suffix load-suffixes)
|
|
900 (unless (string-match re suffix)
|
|
901 (push suffix suffixes)))
|
|
902 (setq load-suffixes (nreverse suffixes))))
|
6002
|
903
|
49597
|
904
|
6002
|
905 (defun jka-compr-installed-p ()
|
|
906 "Return non-nil if jka-compr is installed.
|
7066
|
907 The return value is the entry in `file-name-handler-alist' for jka-compr."
|
6002
|
908
|
|
909 (let ((fnha file-name-handler-alist)
|
|
910 (installed nil))
|
|
911
|
|
912 (while (and fnha (not installed))
|
|
913 (and (eq (cdr (car fnha)) 'jka-compr-handler)
|
|
914 (setq installed (car fnha)))
|
|
915 (setq fnha (cdr fnha)))
|
|
916
|
|
917 installed))
|
|
918
|
|
919
|
32317
|
920 ;;; Add the file I/O hook if it does not already exist.
|
|
921 ;;; Make sure that jka-compr-file-name-handler-entry is eq to the
|
|
922 ;;; entry for jka-compr in file-name-handler-alist.
|
|
923 (and (jka-compr-installed-p)
|
|
924 (jka-compr-uninstall))
|
|
925
|
|
926
|
32262
|
927 ;;;###autoload
|
|
928 (define-minor-mode auto-compression-mode
|
|
929 "Toggle automatic file compression and uncompression.
|
|
930 With prefix argument ARG, turn auto compression on if positive, else off.
|
|
931 Returns the new status of auto compression (non-nil means on)."
|
33190
c33775f5049b
(auto-compression-mode): Drop unneeded positional args.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
932 :global t :group 'jka-compr
|
32262
|
933 (let* ((installed (jka-compr-installed-p))
|
|
934 (flag auto-compression-mode))
|
|
935 (cond
|
|
936 ((and flag installed) t) ; already installed
|
|
937 ((and (not flag) (not installed)) nil) ; already not installed
|
|
938 (flag (jka-compr-install))
|
|
939 (t (jka-compr-uninstall)))))
|
|
940
|
|
941
|
|
942 ;;;###autoload
|
|
943 (defmacro with-auto-compression-mode (&rest body)
|
32317
|
944 "Evalute BODY with automatic file compression and uncompression enabled."
|
32262
|
945 (let ((already-installed (make-symbol "already-installed")))
|
|
946 `(let ((,already-installed (jka-compr-installed-p)))
|
|
947 (unwind-protect
|
|
948 (progn
|
|
949 (unless ,already-installed
|
|
950 (jka-compr-install))
|
|
951 ,@body)
|
|
952 (unless ,already-installed
|
|
953 (jka-compr-uninstall))))))
|
|
954 (put 'with-auto-compression-mode 'lisp-indent-function 0)
|
|
955
|
|
956
|
6002
|
957 (provide 'jka-compr)
|
|
958
|
52401
|
959 ;;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc
|
38412
|
960 ;;; jka-compr.el ends here
|