Mercurial > emacs
comparison lisp/jka-cmpr-hook.el @ 62107:4f5570943f21
Renamed jka-comp-hook.el to jka-cmpr-hook.el.
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Fri, 06 May 2005 11:19:51 +0000 |
parents | |
children | 29c6e26ca9a1 |
comparison
equal
deleted
inserted
replaced
62106:d731348f032d | 62107:4f5570943f21 |
---|---|
1 ;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el | |
2 | |
3 ;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2003, 2004, 2005 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: jka@ece.cmu.edu (Jay K. Adams) | |
6 ;; Maintainer: FSF | |
7 ;; Keywords: data | |
8 | |
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 | |
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. | |
25 | |
26 ;;; Commentary: | |
27 | |
28 ;; This file contains the code to enable and disable Auto-Compression mode. | |
29 ;; It is preloaded. The guts of this mode are in jka-compr.el, which | |
30 ;; is loaded only when you really try to uncompress something. | |
31 | |
32 ;;; Code: | |
33 | |
34 (defgroup compression nil | |
35 "Data compression utilities" | |
36 :group 'data) | |
37 | |
38 (defgroup jka-compr nil | |
39 "jka-compr customization" | |
40 :group 'compression) | |
41 | |
42 ;;; I have this defined so that .Z files are assumed to be in unix | |
43 ;;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt. | |
44 (defcustom jka-compr-compression-info-list | |
45 ;;[regexp | |
46 ;; compr-message compr-prog compr-args | |
47 ;; uncomp-message uncomp-prog uncomp-args | |
48 ;; can-append auto-mode-flag strip-extension-flag file-magic-bytes] | |
49 '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'" | |
50 "compressing" "compress" ("-c") | |
51 "uncompressing" "uncompress" ("-c") | |
52 nil t "\037\235"] | |
53 ;; Formerly, these had an additional arg "-c", but that fails with | |
54 ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and | |
55 ;; "Version 0.9.0b, 9-Sept-98". | |
56 ["\\.bz2\\'" | |
57 "bzip2ing" "bzip2" nil | |
58 "bunzip2ing" "bzip2" ("-d") | |
59 nil t "BZh"] | |
60 ["\\.tbz\\'" | |
61 "bzip2ing" "bzip2" nil | |
62 "bunzip2ing" "bzip2" ("-d") | |
63 nil nil "BZh"] | |
64 ["\\.tgz\\'" | |
65 "compressing" "gzip" ("-c" "-q") | |
66 "uncompressing" "gzip" ("-c" "-q" "-d") | |
67 t nil "\037\213"] | |
68 ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'" | |
69 "compressing" "gzip" ("-c" "-q") | |
70 "uncompressing" "gzip" ("-c" "-q" "-d") | |
71 t t "\037\213"] | |
72 ;; dzip is gzip with random access. Its compression program can't | |
73 ;; read/write stdin/out, so .dz files can only be viewed without | |
74 ;; saving, having their contents decompressed with gzip. | |
75 ["\\.dz\\'" | |
76 nil nil nil | |
77 "uncompressing" "gzip" ("-c" "-q" "-d") | |
78 nil t "\037\213"]) | |
79 | |
80 "List of vectors that describe available compression techniques. | |
81 Each element, which describes a compression technique, is a vector of | |
82 the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS | |
83 UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS | |
84 APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where: | |
85 | |
86 regexp is a regexp that matches filenames that are | |
87 compressed with this format | |
88 | |
89 compress-msg is the message to issue to the user when doing this | |
90 type of compression (nil means no message) | |
91 | |
92 compress-program is a program that performs this compression | |
93 (nil means visit file in read-only mode) | |
94 | |
95 compress-args is a list of args to pass to the compress program | |
96 | |
97 uncompress-msg is the message to issue to the user when doing this | |
98 type of uncompression (nil means no message) | |
99 | |
100 uncompress-program is a program that performs this compression | |
101 | |
102 uncompress-args is a list of args to pass to the uncompress program | |
103 | |
104 append-flag is non-nil if this compression technique can be | |
105 appended | |
106 | |
107 strip-extension-flag non-nil means strip the regexp from file names | |
108 before attempting to set the mode. | |
109 | |
110 file-magic-chars is a string of characters that you would find | |
111 at the beginning of a file compressed in this way. | |
112 | |
113 Because of the way `call-process' is defined, discarding the stderr output of | |
114 a program adds the overhead of starting a shell each time the program is | |
115 invoked." | |
116 :type '(repeat (vector regexp | |
117 (choice :tag "Compress Message" | |
118 (string :format "%v") | |
119 (const :tag "No Message" nil)) | |
120 (choice :tag "Compress Program" | |
121 (string) | |
122 (const :tag "None" nil)) | |
123 (repeat :tag "Compress Arguments" string) | |
124 (choice :tag "Uncompress Message" | |
125 (string :format "%v") | |
126 (const :tag "No Message" nil)) | |
127 (choice :tag "Uncompress Program" | |
128 (string) | |
129 (const :tag "None" nil)) | |
130 (repeat :tag "Uncompress Arguments" string) | |
131 (boolean :tag "Append") | |
132 (boolean :tag "Strip Extension") | |
133 (string :tag "Magic Bytes"))) | |
134 :group 'jka-compr) | |
135 | |
136 (defcustom jka-compr-mode-alist-additions | |
137 (list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode)) | |
138 "A list of pairs to add to `auto-mode-alist' when jka-compr is installed." | |
139 :type '(repeat (cons string symbol)) | |
140 :group 'jka-compr) | |
141 | |
142 (defcustom jka-compr-load-suffixes '(".gz") | |
143 "List of suffixes to try when loading files." | |
144 :type '(repeat string) | |
145 :group 'jka-compr) | |
146 | |
147 ;; List of all the elements we actually added to file-coding-system-alist. | |
148 (defvar jka-compr-added-to-file-coding-system-alist nil) | |
149 | |
150 (defvar jka-compr-file-name-handler-entry | |
151 nil | |
152 "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.") | |
153 | |
154 (defun jka-compr-build-file-regexp () | |
155 (mapconcat | |
156 'jka-compr-info-regexp | |
157 jka-compr-compression-info-list | |
158 "\\|")) | |
159 | |
160 ;;; Functions for accessing the return value of jka-compr-get-compression-info | |
161 (defun jka-compr-info-regexp (info) (aref info 0)) | |
162 (defun jka-compr-info-compress-message (info) (aref info 1)) | |
163 (defun jka-compr-info-compress-program (info) (aref info 2)) | |
164 (defun jka-compr-info-compress-args (info) (aref info 3)) | |
165 (defun jka-compr-info-uncompress-message (info) (aref info 4)) | |
166 (defun jka-compr-info-uncompress-program (info) (aref info 5)) | |
167 (defun jka-compr-info-uncompress-args (info) (aref info 6)) | |
168 (defun jka-compr-info-can-append (info) (aref info 7)) | |
169 (defun jka-compr-info-strip-extension (info) (aref info 8)) | |
170 (defun jka-compr-info-file-magic-bytes (info) (aref info 9)) | |
171 | |
172 | |
173 (defun jka-compr-get-compression-info (filename) | |
174 "Return information about the compression scheme of FILENAME. | |
175 The determination as to which compression scheme, if any, to use is | |
176 based on the filename itself and `jka-compr-compression-info-list'." | |
177 (catch 'compression-info | |
178 (let ((case-fold-search nil)) | |
179 (mapcar | |
180 (function (lambda (x) | |
181 (and (string-match (jka-compr-info-regexp x) filename) | |
182 (throw 'compression-info x)))) | |
183 jka-compr-compression-info-list) | |
184 nil))) | |
185 | |
186 (defun jka-compr-install () | |
187 "Install jka-compr. | |
188 This adds entries to `file-name-handler-alist' and `auto-mode-alist' | |
189 and `inhibit-first-line-modes-suffixes'." | |
190 | |
191 (setq jka-compr-file-name-handler-entry | |
192 (cons (jka-compr-build-file-regexp) 'jka-compr-handler)) | |
193 | |
194 (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry | |
195 file-name-handler-alist)) | |
196 | |
197 (setq jka-compr-added-to-file-coding-system-alist nil) | |
198 | |
199 (mapcar | |
200 (function (lambda (x) | |
201 ;; Don't do multibyte encoding on the compressed files. | |
202 (let ((elt (cons (jka-compr-info-regexp x) | |
203 '(no-conversion . no-conversion)))) | |
204 (setq file-coding-system-alist | |
205 (cons elt file-coding-system-alist)) | |
206 (setq jka-compr-added-to-file-coding-system-alist | |
207 (cons elt jka-compr-added-to-file-coding-system-alist))) | |
208 | |
209 (and (jka-compr-info-strip-extension x) | |
210 ;; Make entries in auto-mode-alist so that modes | |
211 ;; are chosen right according to the file names | |
212 ;; sans `.gz'. | |
213 (setq auto-mode-alist | |
214 (cons (list (jka-compr-info-regexp x) | |
215 nil 'jka-compr) | |
216 auto-mode-alist)) | |
217 ;; Also add these regexps to | |
218 ;; inhibit-first-line-modes-suffixes, so that a | |
219 ;; -*- line in the first file of a compressed tar | |
220 ;; file doesn't override tar-mode. | |
221 (setq inhibit-first-line-modes-suffixes | |
222 (cons (jka-compr-info-regexp x) | |
223 inhibit-first-line-modes-suffixes))))) | |
224 jka-compr-compression-info-list) | |
225 (setq auto-mode-alist | |
226 (append auto-mode-alist jka-compr-mode-alist-additions)) | |
227 | |
228 ;; Make sure that (load "foo") will find /bla/foo.el.gz. | |
229 (setq load-suffixes | |
230 (apply 'append | |
231 (mapcar (lambda (suffix) | |
232 (cons suffix | |
233 (mapcar (lambda (ext) (concat suffix ext)) | |
234 jka-compr-load-suffixes))) | |
235 load-suffixes)))) | |
236 | |
237 | |
238 (defun jka-compr-installed-p () | |
239 "Return non-nil if jka-compr is installed. | |
240 The return value is the entry in `file-name-handler-alist' for jka-compr." | |
241 | |
242 (let ((fnha file-name-handler-alist) | |
243 (installed nil)) | |
244 | |
245 (while (and fnha (not installed)) | |
246 (and (eq (cdr (car fnha)) 'jka-compr-handler) | |
247 (setq installed (car fnha))) | |
248 (setq fnha (cdr fnha))) | |
249 | |
250 installed)) | |
251 | |
252 (define-minor-mode auto-compression-mode | |
253 "Toggle automatic file compression and uncompression. | |
254 With prefix argument ARG, turn auto compression on if positive, else off. | |
255 Returns the new status of auto compression (non-nil means on)." | |
256 :global t :group 'jka-compr | |
257 (let* ((installed (jka-compr-installed-p)) | |
258 (flag auto-compression-mode)) | |
259 (cond | |
260 ((and flag installed) t) ; already installed | |
261 ((and (not flag) (not installed)) nil) ; already not installed | |
262 (flag (jka-compr-install)) | |
263 (t (jka-compr-uninstall))))) | |
264 | |
265 (defmacro with-auto-compression-mode (&rest body) | |
266 "Evalute BODY with automatic file compression and uncompression enabled." | |
267 (let ((already-installed (make-symbol "already-installed"))) | |
268 `(let ((,already-installed (jka-compr-installed-p))) | |
269 (unwind-protect | |
270 (progn | |
271 (unless ,already-installed | |
272 (jka-compr-install)) | |
273 ,@body) | |
274 (unless ,already-installed | |
275 (jka-compr-uninstall)))))) | |
276 (put 'with-auto-compression-mode 'lisp-indent-function 0) | |
277 | |
278 | |
279 ;;; This is what we need to know about jka-compr-handler | |
280 ;;; in order to decide when to call it. | |
281 | |
282 (put 'jka-compr-handler 'safe-magic t) | |
283 (put 'jka-compr-handler 'operations '(jka-compr-byte-compiler-base-file-name | |
284 write-region insert-file-contents | |
285 file-local-copy load)) | |
286 | |
287 ;;; Turn on the mode. | |
288 (auto-compression-mode 1) | |
289 | |
290 (provide 'jka-cmpr-hook) | |
291 | |
292 ;; arch-tag: 4bd73429-f400-45fe-a065-270a113e31a8 | |
293 ;;; jka-cmpr-hook.el ends here |