13337
|
1 ;;; jka-compr.el --- reading/writing/loading compressed files
|
|
2
|
74442
|
3 ;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
|
75347
|
4 ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
|
6002
|
5
|
|
6 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
|
17976
|
7 ;; Maintainer: FSF
|
6002
|
8 ;; Keywords: data
|
|
9
|
13514
|
10 ;; This file is part of GNU Emacs.
|
|
11
|
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
13 ;; it under the terms of the GNU General Public License as published by
|
78236
|
14 ;; the Free Software Foundation; either version 3, or (at your option)
|
13514
|
15 ;; any later version.
|
|
16
|
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
20 ;; GNU General Public License for more details.
|
|
21
|
|
22 ;; You should have received a copy of the GNU General Public License
|
14169
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64091
|
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
25 ;; Boston, MA 02110-1301, USA.
|
13514
|
26
|
38412
|
27 ;;; Commentary:
|
6002
|
28
|
14169
|
29 ;; This package implements low-level support for reading, writing,
|
|
30 ;; and loading compressed files. It hooks into the low-level file
|
|
31 ;; I/O functions (including write-region and insert-file-contents) so
|
|
32 ;; that they automatically compress or uncompress a file if the file
|
|
33 ;; appears to need it (based on the extension of the file name).
|
|
34 ;; Packages like Rmail, VM, GNUS, and Info should be able to work
|
|
35 ;; with compressed files without modification.
|
6002
|
36
|
|
37
|
14169
|
38 ;; INSTRUCTIONS:
|
|
39 ;;
|
32497
|
40 ;; To use jka-compr, invoke the command `auto-compression-mode' (which
|
|
41 ;; see), or customize the variable of the same name. Its operation
|
|
42 ;; should be transparent to the user (except for messages appearing when
|
|
43 ;; a file is being compressed or uncompressed).
|
14169
|
44 ;;
|
|
45 ;; The variable, jka-compr-compression-info-list can be used to
|
|
46 ;; customize jka-compr to work with other compression programs.
|
|
47 ;; The default value of this variable allows jka-compr to work with
|
|
48 ;; Unix compress and gzip.
|
|
49 ;;
|
|
50 ;; If you don't want messages about compressing and decompressing
|
75423
|
51 ;; to show up in the echo area, you can set the compress-msg and
|
|
52 ;; decompress-msg fields of the jka-compr-compression-info-list to
|
14169
|
53 ;; nil.
|
6002
|
54
|
|
55
|
14169
|
56 ;; APPLICATION NOTES:
|
|
57 ;;
|
|
58 ;; crypt++
|
45720
|
59 ;; jka-compr can coexist with crypt++ if you take all the decompression
|
14169
|
60 ;; entries out of the crypt-encoding-list. Clearly problems will arise if
|
|
61 ;; you have two programs trying to compress/decompress files. jka-compr
|
|
62 ;; will not "work with" crypt++ in the following sense: you won't be able to
|
|
63 ;; decode encrypted compressed files--that is, files that have been
|
|
64 ;; compressed then encrypted (in that order). Theoretically, crypt++ and
|
|
65 ;; jka-compr could properly handle a file that has been encrypted then
|
|
66 ;; compressed, but there is little point in trying to compress an encrypted
|
|
67 ;; file.
|
|
68 ;;
|
6002
|
69
|
|
70
|
14169
|
71 ;; ACKNOWLEDGMENTS
|
49597
|
72 ;;
|
14169
|
73 ;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people
|
49597
|
74 ;; have made helpful suggestions, reported bugs, and even fixed bugs in
|
14169
|
75 ;; jka-compr. I recall the following people as being particularly helpful.
|
|
76 ;;
|
|
77 ;; Jean-loup Gailly
|
|
78 ;; David Hughes
|
|
79 ;; Richard Pieri
|
|
80 ;; Daniel Quinlan
|
|
81 ;; Chris P. Ross
|
|
82 ;; Rick Sladkey
|
|
83 ;;
|
|
84 ;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for
|
|
85 ;; Version 18 of Emacs.
|
|
86 ;;
|
|
87 ;; After I had made progress on the original jka-compr for V18, I learned of a
|
|
88 ;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly
|
|
89 ;; what I was trying to do. I looked over the jam-zcat source code and
|
|
90 ;; probably got some ideas from it.
|
|
91 ;;
|
6002
|
92
|
|
93 ;;; Code:
|
|
94
|
66805
|
95 (require 'jka-cmpr-hook)
|
|
96
|
17411
|
97 (defcustom jka-compr-shell "sh"
|
6002
|
98 "*Shell to be used for calling compression programs.
|
75423
|
99 NOTE: Not used in MS-DOS and Windows systems."
|
17411
|
100 :type 'string
|
|
101 :group 'jka-compr)
|
6002
|
102
|
49597
|
103 (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
|
104 (not (memq system-type '(ms-dos windows-nt))))
|
6002
|
105
|
26987
|
106 (defvar jka-compr-really-do-compress nil
|
60781
|
107 "Non-nil in a buffer whose visited file was uncompressed on visiting it.
|
|
108 This means compress the data on writing the file, even if the
|
|
109 data appears to be compressed already.")
|
|
110 (make-variable-buffer-local 'jka-compr-really-do-compress)
|
26987
|
111 (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
|
112
|
6002
|
113
|
|
114 (put 'compression-error 'error-conditions '(compression-error file-error error))
|
|
115
|
|
116
|
11635
|
117 (defvar jka-compr-acceptable-retval-list '(0 2 141))
|
6002
|
118
|
|
119
|
|
120 (defun jka-compr-error (prog args infile message &optional errfile)
|
|
121
|
66805
|
122 (let ((errbuf (get-buffer-create " *jka-compr-error*")))
|
16940
|
123 (with-current-buffer errbuf
|
|
124 (widen) (erase-buffer)
|
|
125 (insert (format "Error while executing \"%s %s < %s\"\n\n"
|
|
126 prog
|
|
127 (mapconcat 'identity args " ")
|
|
128 infile))
|
6002
|
129
|
16940
|
130 (and errfile
|
|
131 (insert-file-contents errfile)))
|
6002
|
132 (display-buffer errbuf))
|
|
133
|
16940
|
134 (signal 'compression-error
|
|
135 (list "Opening input file" (format "error %s" message) infile)))
|
49597
|
136
|
|
137
|
40782
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
138 (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
|
139 "How to invoke `dd'."
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
140 :type 'string
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
141 :group 'jka-compr)
|
6002
|
142
|
|
143
|
6041
|
144 (defvar jka-compr-dd-blocksize 256)
|
6002
|
145
|
|
146
|
|
147 (defun jka-compr-partial-uncompress (prog message args infile beg len)
|
|
148 "Call program PROG with ARGS args taking input from INFILE.
|
|
149 Fourth and fifth args, BEG and LEN, specify which part of the output
|
8065
|
150 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
|
151 (let ((start (point))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
152 (prefix beg))
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
153 (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
|
154 ;; 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
|
155 ;; 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
|
156 (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
|
157 (err-file (jka-compr-make-temp-name))
|
75494
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
158 ;; call-process barfs if default-directory is inaccessible.
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
159 (default-directory
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
160 (if (and default-directory
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
161 (file-accessible-directory-p default-directory))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
162 default-directory
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
163 (file-name-directory infile)))
|
40782
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
164 count)
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
165 ;; 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
|
166 (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
|
167 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
|
168 (unwind-protect
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
169 (or (memq (call-process
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
170 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
|
171 (format
|
42231
054cf5ce349b
(jka-compr-partial-uncompress): Use null-device instead of a literal
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
172 "%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
|
173 prog
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
174 (mapconcat 'identity args " ")
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
175 err-file
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
176 jka-compr-dd-program
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
177 jka-compr-dd-blocksize
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
178 skip
|
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
179 ;; 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
|
180 ;; 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
|
181 ;; 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
|
182 (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
|
183 null-device))
|
40782
3a4d800ced48
(jka-compr-partial-uncompress): Support an alternative of not using dd.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
184 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
|
185 (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
|
186 (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
|
187 ;; 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
|
188 ;; 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
|
189 (jka-compr-call-process prog message infile t nil args))
|
6002
|
190
|
8065
|
191 ;; Delete the stuff after what we want, if there is any.
|
6002
|
192 (and
|
6041
|
193 len
|
8065
|
194 (< (+ start prefix len) (point))
|
6041
|
195 (delete-region (+ start prefix len) (point)))
|
6002
|
196
|
8065
|
197 ;; Delete the stuff before what we want.
|
6002
|
198 (delete-region start (+ start prefix))))
|
|
199
|
|
200
|
|
201 (defun jka-compr-call-process (prog message infile output temp args)
|
75494
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
202 ;; call-process barfs if default-directory is inaccessible.
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
203 (let ((default-directory
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
204 (if (and default-directory
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
205 (file-accessible-directory-p default-directory))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
206 default-directory
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
207 (file-name-directory infile))))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
208 (if jka-compr-use-shell
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
209 (let ((err-file (jka-compr-make-temp-name))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
210 (coding-system-for-read (or coding-system-for-read 'undecided))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
211 (coding-system-for-write 'no-conversion))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
212 (unwind-protect
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
213 (or (memq
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
214 (call-process jka-compr-shell infile
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
215 (if (stringp output) nil output)
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
216 nil
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
217 "-c"
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
218 (format "%s %s 2> %s %s"
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
219 prog
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
220 (mapconcat 'identity args " ")
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
221 err-file
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
222 (if (stringp output)
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
223 (concat "> " output)
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
224 "")))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
225 jka-compr-acceptable-retval-list)
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
226 (jka-compr-error prog args infile message err-file))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
227 (jka-compr-delete-temp-file err-file)))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
228 (or (eq 0
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
229 (apply 'call-process
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
230 prog infile (if (stringp output) temp output)
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
231 nil args))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
232 (jka-compr-error prog args infile message))
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
233 (and (stringp output)
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
234 (with-current-buffer temp
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
235 (write-region (point-min) (point-max) output)
|
04d75deb3a31
(jka-compr-partial-uncompress, jka-compr-call-process): Rebind
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
236 (erase-buffer))))))
|
6002
|
237
|
|
238
|
66805
|
239 ;; Support for temp files. Much of this was inspired if not lifted
|
|
240 ;; from ange-ftp.
|
6002
|
241
|
17411
|
242 (defcustom jka-compr-temp-name-template
|
22100
|
243 (expand-file-name "jka-com" temporary-file-directory)
|
17441
|
244 "Prefix added to all temp files created by jka-compr.
|
17411
|
245 There should be no more than seven characters after the final `/'."
|
|
246 :type 'string
|
|
247 :group 'jka-compr)
|
6002
|
248
|
|
249 (defun jka-compr-make-temp-name (&optional local-copy)
|
|
250 "This routine will return the name of a new file."
|
26039
|
251 (make-temp-file jka-compr-temp-name-template))
|
6002
|
252
|
26039
|
253 (defalias 'jka-compr-delete-temp-file 'delete-file)
|
6002
|
254
|
|
255
|
|
256 (defun jka-compr-write-region (start end file &optional append visit)
|
|
257 (let* ((filename (expand-file-name file))
|
|
258 (visit-file (if (stringp visit) (expand-file-name visit) filename))
|
26987
|
259 (info (jka-compr-get-compression-info visit-file))
|
|
260 (magic (and info (jka-compr-info-file-magic-bytes info))))
|
6002
|
261
|
42461
|
262 ;; If START is nil, use the whole buffer.
|
|
263 (if (null start)
|
|
264 (setq start 1 end (1+ (buffer-size))))
|
|
265
|
26987
|
266 ;; If we uncompressed this file when visiting it,
|
|
267 ;; then recompress it when writing it
|
|
268 ;; even if the contents look compressed already.
|
|
269 (if (and jka-compr-really-do-compress
|
|
270 (eq start 1)
|
|
271 (eq end (1+ (buffer-size))))
|
|
272 (setq magic nil))
|
6002
|
273
|
26987
|
274 (if (and info
|
|
275 ;; If the contents to be written out
|
|
276 ;; are properly compressed already,
|
|
277 ;; don't try to compress them over again.
|
|
278 (not (and magic
|
|
279 (equal (if (stringp start)
|
|
280 (substring start 0 (min (length start)
|
|
281 (length magic)))
|
|
282 (buffer-substring start
|
|
283 (min end
|
|
284 (+ start (length magic)))))
|
|
285 magic))))
|
|
286 (let ((can-append (jka-compr-info-can-append info))
|
|
287 (compress-program (jka-compr-info-compress-program info))
|
|
288 (compress-message (jka-compr-info-compress-message info))
|
|
289 (compress-args (jka-compr-info-compress-args info))
|
|
290 (base-name (file-name-nondirectory visit-file))
|
|
291 temp-file temp-buffer
|
|
292 ;; we need to leave `last-coding-system-used' set to its
|
|
293 ;; value after calling write-region the first time, so
|
|
294 ;; that `basic-save-buffer' sees the right value.
|
|
295 (coding-system-used last-coding-system-used))
|
6002
|
296
|
54521
|
297 (or compress-program
|
|
298 (error "No compression program defined"))
|
|
299
|
26987
|
300 (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
|
|
301 (with-current-buffer temp-buffer
|
|
302 (widen) (erase-buffer))
|
6002
|
303
|
26987
|
304 (if (and append
|
|
305 (not can-append)
|
|
306 (file-exists-p filename))
|
6002
|
307
|
26987
|
308 (let* ((local-copy (file-local-copy filename))
|
|
309 (local-file (or local-copy filename)))
|
|
310
|
|
311 (setq temp-file local-file))
|
|
312
|
|
313 (setq temp-file (jka-compr-make-temp-name)))
|
6002
|
314
|
49597
|
315 (and
|
26987
|
316 compress-message
|
|
317 (message "%s %s..." compress-message base-name))
|
|
318
|
|
319 (jka-compr-run-real-handler 'write-region
|
|
320 (list start end temp-file t 'dont))
|
|
321 ;; save value used by the real write-region
|
|
322 (setq coding-system-used last-coding-system-used)
|
6002
|
323
|
26987
|
324 ;; Here we must read the output of compress program as is
|
|
325 ;; without any code conversion.
|
|
326 (let ((coding-system-for-read 'no-conversion))
|
|
327 (jka-compr-call-process compress-program
|
|
328 (concat compress-message
|
|
329 " " base-name)
|
|
330 temp-file
|
|
331 temp-buffer
|
|
332 nil
|
|
333 compress-args))
|
6002
|
334
|
26987
|
335 (with-current-buffer temp-buffer
|
|
336 (let ((coding-system-for-write 'no-conversion))
|
|
337 (if (memq system-type '(ms-dos windows-nt))
|
|
338 (setq buffer-file-type t) )
|
|
339 (jka-compr-run-real-handler 'write-region
|
|
340 (list (point-min) (point-max)
|
|
341 filename
|
|
342 (and append can-append) 'dont))
|
|
343 (erase-buffer)) )
|
6002
|
344
|
26987
|
345 (jka-compr-delete-temp-file temp-file)
|
|
346
|
|
347 (and
|
|
348 compress-message
|
|
349 (message "%s %s...done" compress-message base-name))
|
6002
|
350
|
26987
|
351 (cond
|
|
352 ((eq visit t)
|
|
353 (setq buffer-file-name filename)
|
|
354 (setq jka-compr-really-do-compress t)
|
|
355 (set-visited-file-modtime))
|
|
356 ((stringp visit)
|
|
357 (setq buffer-file-name visit)
|
|
358 (let ((buffer-file-name filename))
|
|
359 (set-visited-file-modtime))))
|
6002
|
360
|
26987
|
361 (and (or (eq visit t)
|
|
362 (eq visit nil)
|
|
363 (stringp visit))
|
|
364 (message "Wrote %s" visit-file))
|
22360
|
365
|
26987
|
366 ;; ensure `last-coding-system-used' has an appropriate value
|
|
367 (setq last-coding-system-used coding-system-used)
|
|
368
|
|
369 nil)
|
49597
|
370
|
26987
|
371 (jka-compr-run-real-handler 'write-region
|
|
372 (list start end filename append visit)))))
|
6002
|
373
|
|
374
|
6218
|
375 (defun jka-compr-insert-file-contents (file &optional visit beg end replace)
|
6002
|
376 (barf-if-buffer-read-only)
|
|
377
|
|
378 (and (or beg end)
|
|
379 visit
|
|
380 (error "Attempt to visit less than an entire file"))
|
|
381
|
|
382 (let* ((filename (expand-file-name file))
|
|
383 (info (jka-compr-get-compression-info filename)))
|
|
384
|
|
385 (if info
|
|
386
|
|
387 (let ((uncompress-message (jka-compr-info-uncompress-message info))
|
|
388 (uncompress-program (jka-compr-info-uncompress-program info))
|
|
389 (uncompress-args (jka-compr-info-uncompress-args info))
|
|
390 (base-name (file-name-nondirectory filename))
|
|
391 (notfound nil)
|
7976
|
392 (local-copy
|
|
393 (jka-compr-run-real-handler 'file-local-copy (list filename)))
|
6002
|
394 local-file
|
49377
|
395 size start)
|
6002
|
396
|
|
397 (setq local-file (or local-copy filename))
|
|
398
|
|
399 (and
|
|
400 visit
|
|
401 (setq buffer-file-name filename))
|
|
402
|
|
403 (unwind-protect ; to make sure local-copy gets deleted
|
|
404
|
|
405 (progn
|
49597
|
406
|
6002
|
407 (and
|
|
408 uncompress-message
|
|
409 (message "%s %s..." uncompress-message base-name))
|
|
410
|
|
411 (condition-case error-code
|
|
412
|
49377
|
413 (let ((coding-system-for-read 'no-conversion))
|
8774
|
414 (if replace
|
|
415 (goto-char (point-min)))
|
6002
|
416 (setq start (point))
|
|
417 (if (or beg end)
|
|
418 (jka-compr-partial-uncompress uncompress-program
|
|
419 (concat uncompress-message
|
|
420 " " base-name)
|
|
421 uncompress-args
|
|
422 local-file
|
|
423 (or beg 0)
|
|
424 (if (and beg end)
|
|
425 (- end beg)
|
|
426 end))
|
11621
|
427 ;; If visiting, bind off buffer-file-name so that
|
|
428 ;; file-locking will not ask whether we should
|
|
429 ;; really edit the buffer.
|
|
430 (let ((buffer-file-name
|
|
431 (if visit nil buffer-file-name)))
|
|
432 (jka-compr-call-process uncompress-program
|
|
433 (concat uncompress-message
|
|
434 " " base-name)
|
|
435 local-file
|
|
436 t
|
|
437 nil
|
|
438 uncompress-args)))
|
6002
|
439 (setq size (- (point) start))
|
8774
|
440 (if replace
|
51284
|
441 (delete-region (point) (point-max)))
|
8774
|
442 (goto-char start))
|
6002
|
443 (error
|
63766
|
444 ;; If the file we wanted to uncompress does not exist,
|
|
445 ;; handle that according to VISIT as `insert-file-contents'
|
|
446 ;; would, maybe signaling the same error it normally would.
|
6002
|
447 (if (and (eq (car error-code) 'file-error)
|
|
448 (eq (nth 3 error-code) local-file))
|
|
449 (if visit
|
|
450 (setq notfound error-code)
|
49597
|
451 (signal 'file-error
|
6002
|
452 (cons "Opening input file"
|
|
453 (nthcdr 2 error-code))))
|
63766
|
454 ;; If the uncompression program can't be found,
|
|
455 ;; signal that as a non-file error
|
|
456 ;; so that find-file-noselect-1 won't handle it.
|
|
457 (if (and (eq (car error-code) 'file-error)
|
|
458 (equal (cadr error-code) "Searching for program"))
|
|
459 (error "Uncompression program `%s' not found"
|
|
460 (nth 3 error-code)))
|
6002
|
461 (signal (car error-code) (cdr error-code))))))
|
|
462
|
|
463 (and
|
|
464 local-copy
|
|
465 (file-exists-p local-copy)
|
|
466 (delete-file local-copy)))
|
|
467
|
53304
|
468 (unless notfound
|
|
469 (decode-coding-inserted-region
|
|
470 (point) (+ (point) size)
|
|
471 (jka-compr-byte-compiler-base-file-name file)
|
|
472 visit beg end replace))
|
49377
|
473
|
6002
|
474 (and
|
|
475 visit
|
|
476 (progn
|
7976
|
477 (unlock-buffer)
|
6002
|
478 (setq buffer-file-name filename)
|
26987
|
479 (setq jka-compr-really-do-compress t)
|
6002
|
480 (set-visited-file-modtime)))
|
49597
|
481
|
6002
|
482 (and
|
|
483 uncompress-message
|
|
484 (message "%s %s...done" uncompress-message base-name))
|
|
485
|
|
486 (and
|
|
487 visit
|
|
488 notfound
|
|
489 (signal 'file-error
|
|
490 (cons "Opening input file" (nth 2 notfound))))
|
|
491
|
22484
|
492 ;; This is done in insert-file-contents after we return.
|
|
493 ;; That is a little weird, but better to go along with it now
|
|
494 ;; than to change it now.
|
|
495
|
|
496 ;;; ;; Run the functions that insert-file-contents would.
|
|
497 ;;; (let ((p after-insert-file-functions)
|
|
498 ;;; (insval size))
|
|
499 ;;; (while p
|
|
500 ;;; (setq insval (funcall (car p) size))
|
|
501 ;;; (if insval
|
|
502 ;;; (progn
|
|
503 ;;; (or (integerp insval)
|
|
504 ;;; (signal 'wrong-type-argument
|
|
505 ;;; (list 'integerp insval)))
|
|
506 ;;; (setq size insval)))
|
|
507 ;;; (setq p (cdr p))))
|
8774
|
508
|
54521
|
509 (or (jka-compr-info-compress-program info)
|
|
510 (message "You can't save this buffer because compression program is not defined"))
|
|
511
|
6002
|
512 (list filename size))
|
|
513
|
7976
|
514 (jka-compr-run-real-handler 'insert-file-contents
|
|
515 (list file visit beg end replace)))))
|
6002
|
516
|
|
517
|
|
518 (defun jka-compr-file-local-copy (file)
|
|
519 (let* ((filename (expand-file-name file))
|
|
520 (info (jka-compr-get-compression-info filename)))
|
|
521
|
|
522 (if info
|
|
523
|
|
524 (let ((uncompress-message (jka-compr-info-uncompress-message info))
|
|
525 (uncompress-program (jka-compr-info-uncompress-program info))
|
|
526 (uncompress-args (jka-compr-info-uncompress-args info))
|
|
527 (base-name (file-name-nondirectory filename))
|
7976
|
528 (local-copy
|
|
529 (jka-compr-run-real-handler 'file-local-copy (list filename)))
|
6002
|
530 (temp-file (jka-compr-make-temp-name t))
|
11635
|
531 (temp-buffer (get-buffer-create " *jka-compr-flc-temp*"))
|
6002
|
532 local-file)
|
|
533
|
|
534 (setq local-file (or local-copy filename))
|
|
535
|
|
536 (unwind-protect
|
|
537
|
16940
|
538 (with-current-buffer temp-buffer
|
49597
|
539
|
6002
|
540 (and
|
|
541 uncompress-message
|
|
542 (message "%s %s..." uncompress-message base-name))
|
49597
|
543
|
18906
|
544 ;; Here we must read the output of uncompress program
|
|
545 ;; and write it to TEMP-FILE without any code
|
|
546 ;; conversion. An appropriate code conversion (if
|
|
547 ;; necessary) is done by the later I/O operation
|
|
548 ;; (e.g. load).
|
|
549 (let ((coding-system-for-read 'no-conversion)
|
|
550 (coding-system-for-write 'no-conversion))
|
6002
|
551
|
18906
|
552 (jka-compr-call-process uncompress-program
|
|
553 (concat uncompress-message
|
|
554 " " base-name)
|
|
555 local-file
|
|
556 t
|
|
557 nil
|
|
558 uncompress-args)
|
6002
|
559
|
18906
|
560 (and
|
|
561 uncompress-message
|
|
562 (message "%s %s...done" uncompress-message base-name))
|
|
563
|
|
564 (write-region
|
|
565 (point-min) (point-max) temp-file nil 'dont)))
|
6002
|
566
|
|
567 (and
|
|
568 local-copy
|
|
569 (file-exists-p local-copy)
|
|
570 (delete-file local-copy))
|
|
571
|
|
572 (kill-buffer temp-buffer))
|
|
573
|
|
574 temp-file)
|
49597
|
575
|
7976
|
576 (jka-compr-run-real-handler 'file-local-copy (list filename)))))
|
6002
|
577
|
|
578
|
66805
|
579 ;; Support for loading compressed files.
|
6002
|
580 (defun jka-compr-load (file &optional noerror nomessage nosuffix)
|
|
581 "Documented as original."
|
|
582
|
|
583 (let* ((local-copy (jka-compr-file-local-copy file))
|
|
584 (load-file (or local-copy file)))
|
|
585
|
|
586 (unwind-protect
|
|
587
|
7976
|
588 (let (inhibit-file-name-operation
|
|
589 inhibit-file-name-handlers)
|
6002
|
590 (or nomessage
|
|
591 (message "Loading %s..." file))
|
|
592
|
12758
|
593 (let ((load-force-doc-strings t))
|
|
594 (load load-file noerror t t))
|
6002
|
595 (or nomessage
|
27512
|
596 (message "Loading %s...done." file))
|
|
597 ;; Fix up the load history to point at the right library.
|
|
598 (let ((l (assoc load-file load-history)))
|
|
599 ;; Remove .gz and .elc?.
|
|
600 (while (file-name-extension file)
|
|
601 (setq file (file-name-sans-extension file)))
|
|
602 (setcar l file)))
|
6002
|
603
|
|
604 (jka-compr-delete-temp-file local-copy))
|
|
605
|
|
606 t))
|
12922
|
607
|
|
608 (defun jka-compr-byte-compiler-base-file-name (file)
|
|
609 (let ((info (jka-compr-get-compression-info file)))
|
|
610 (if (and info (jka-compr-info-strip-extension info))
|
|
611 (save-match-data
|
|
612 (substring file 0 (string-match (jka-compr-info-regexp info) file)))
|
|
613 file)))
|
7976
|
614
|
|
615 (put 'write-region 'jka-compr 'jka-compr-write-region)
|
|
616 (put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
|
|
617 (put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
|
|
618 (put 'load 'jka-compr 'jka-compr-load)
|
12922
|
619 (put 'byte-compiler-base-file-name 'jka-compr
|
|
620 'jka-compr-byte-compiler-base-file-name)
|
6002
|
621
|
61946
|
622 ;;;###autoload
|
20132
|
623 (defvar jka-compr-inhibit nil
|
|
624 "Non-nil means inhibit automatic uncompression temporarily.
|
|
625 Lisp programs can bind this to t to do that.
|
|
626 It is not recommended to set this variable permanently to anything but nil.")
|
|
627
|
61946
|
628 ;;;###autoload
|
6002
|
629 (defun jka-compr-handler (operation &rest args)
|
7976
|
630 (save-match-data
|
|
631 (let ((jka-op (get operation 'jka-compr)))
|
20132
|
632 (if (and jka-op (not jka-compr-inhibit))
|
7976
|
633 (apply jka-op args)
|
|
634 (jka-compr-run-real-handler operation args)))))
|
6002
|
635
|
7066
|
636 ;; If we are given an operation that we don't handle,
|
|
637 ;; call the Emacs primitive for that operation,
|
|
638 ;; and manipulate the inhibit variables
|
|
639 ;; to prevent the primitive from calling our handler again.
|
|
640 (defun jka-compr-run-real-handler (operation args)
|
|
641 (let ((inhibit-file-name-handlers
|
|
642 (cons 'jka-compr-handler
|
|
643 (and (eq inhibit-file-name-operation operation)
|
|
644 inhibit-file-name-handlers)))
|
|
645 (inhibit-file-name-operation operation))
|
|
646 (apply operation args)))
|
|
647
|
62108
|
648 ;;;###autoload
|
6002
|
649 (defun jka-compr-uninstall ()
|
|
650 "Uninstall jka-compr.
|
7066
|
651 This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
|
11296
|
652 and `inhibit-first-line-modes-suffixes' that were added
|
|
653 by `jka-compr-installed'."
|
|
654 ;; Delete from inhibit-first-line-modes-suffixes
|
|
655 ;; what jka-compr-install added.
|
69163
|
656 (mapc
|
11296
|
657 (function (lambda (x)
|
|
658 (and (jka-compr-info-strip-extension x)
|
|
659 (setq inhibit-first-line-modes-suffixes
|
|
660 (delete (jka-compr-info-regexp x)
|
|
661 inhibit-first-line-modes-suffixes)))))
|
69163
|
662 jka-compr-compression-info-list--internal)
|
6002
|
663
|
|
664 (let* ((fnha (cons nil file-name-handler-alist))
|
|
665 (last fnha))
|
|
666
|
|
667 (while (cdr last)
|
|
668 (if (eq (cdr (car (cdr last))) 'jka-compr-handler)
|
|
669 (setcdr last (cdr (cdr last)))
|
|
670 (setq last (cdr last))))
|
|
671
|
|
672 (setq file-name-handler-alist (cdr fnha)))
|
|
673
|
|
674 (let* ((ama (cons nil auto-mode-alist))
|
|
675 (last ama)
|
|
676 entry)
|
|
677
|
|
678 (while (cdr last)
|
|
679 (setq entry (car (cdr last)))
|
69163
|
680 (if (or (member entry jka-compr-mode-alist-additions--internal)
|
9493
|
681 (and (consp (cdr entry))
|
|
682 (eq (nth 2 entry) 'jka-compr)))
|
6002
|
683 (setcdr last (cdr (cdr last)))
|
|
684 (setq last (cdr last))))
|
49597
|
685
|
19004
|
686 (setq auto-mode-alist (cdr ama)))
|
|
687
|
66805
|
688 (while jka-compr-added-to-file-coding-system-alist
|
|
689 (setq file-coding-system-alist
|
|
690 (delq (car (member (pop jka-compr-added-to-file-coding-system-alist)
|
|
691 file-coding-system-alist))
|
|
692 file-coding-system-alist)))
|
39829
|
693
|
|
694 ;; Remove the suffixes that were added by jka-compr.
|
69163
|
695 (dolist (suff jka-compr-load-suffixes--internal)
|
|
696 (setq load-file-rep-suffixes (delete suff load-file-rep-suffixes)))
|
|
697
|
|
698 (setq jka-compr-compression-info-list--internal nil
|
|
699 jka-compr-mode-alist-additions--internal nil
|
|
700 jka-compr-load-suffixes--internal nil))
|
6002
|
701
|
|
702 (provide 'jka-compr)
|
|
703
|
66805
|
704 ;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc
|
38412
|
705 ;;; jka-compr.el ends here
|