lisp/font-lock.el: Remove obsolete code.
[emacs.git] / lisp / jka-cmpr-hook.el
blobfda9804bbb88e077bd5cae4f87eaa07798b67901
1 ;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
3 ;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2011
4 ;; Free Software Foundation, Inc.
6 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
7 ;; Maintainer: FSF
8 ;; Keywords: data
9 ;; Package: emacs
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;;; Commentary:
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.
32 ;;; Code:
34 (defgroup compression nil
35 "Data compression utilities."
36 :group 'data)
38 (defgroup jka-compr nil
39 "jka-compr customization."
40 :group 'compression)
42 ;; List of all the elements we actually added to file-coding-system-alist.
43 (defvar jka-compr-added-to-file-coding-system-alist nil)
45 (defvar jka-compr-file-name-handler-entry
46 nil
47 "`file-name-handler-alist' entry used by jka-compr I/O functions.")
49 ;; Compiler defvars. These three variables will be defined later with
50 ;; `defcustom' when everything used in the :set functions is defined.
51 (defvar jka-compr-compression-info-list)
52 (defvar jka-compr-mode-alist-additions)
53 (defvar jka-compr-load-suffixes)
55 (defvar jka-compr-compression-info-list--internal nil
56 "Stored value of `jka-compr-compression-info-list'.
57 If Auto Compression mode is enabled, this is the value of
58 `jka-compr-compression-info-list' when `jka-compr-install' was last called.
59 Otherwise, it is nil.")
61 (defvar jka-compr-mode-alist-additions--internal nil
62 "Stored value of `jka-compr-mode-alist-additions'.
63 If Auto Compression mode is enabled, this is the value of
64 `jka-compr-mode-alist-additions' when `jka-compr-install' was last called.
65 Otherwise, it is nil.")
67 (defvar jka-compr-load-suffixes--internal nil
68 "Stored value of `jka-compr-load-suffixes'.
69 If Auto Compression mode is enabled, this is the value of
70 `jka-compr-load-suffixes' when `jka-compr-install' was last called.
71 Otherwise, it is nil.")
74 (defun jka-compr-build-file-regexp ()
75 (purecopy
76 (let ((re-anchored '())
77 (re-free '()))
78 (dolist (e jka-compr-compression-info-list)
79 (let ((re (jka-compr-info-regexp e)))
80 (if (string-match "\\\\'\\'" re)
81 (push (substring re 0 (match-beginning 0)) re-anchored)
82 (push re re-free))))
83 (concat
84 (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|"))
85 "\\(?:"
86 (mapconcat 'identity re-anchored "\\|")
87 "\\)" file-name-version-regexp "?\\'"))))
89 ;; Functions for accessing the return value of jka-compr-get-compression-info
90 (defun jka-compr-info-regexp (info) (aref info 0))
91 (defun jka-compr-info-compress-message (info) (aref info 1))
92 (defun jka-compr-info-compress-program (info) (aref info 2))
93 (defun jka-compr-info-compress-args (info) (aref info 3))
94 (defun jka-compr-info-uncompress-message (info) (aref info 4))
95 (defun jka-compr-info-uncompress-program (info) (aref info 5))
96 (defun jka-compr-info-uncompress-args (info) (aref info 6))
97 (defun jka-compr-info-can-append (info) (aref info 7))
98 (defun jka-compr-info-strip-extension (info) (aref info 8))
99 (defun jka-compr-info-file-magic-bytes (info) (aref info 9))
102 (defun jka-compr-get-compression-info (filename)
103 "Return information about the compression scheme of FILENAME.
104 The determination as to which compression scheme, if any, to use is
105 based on the filename itself and `jka-compr-compression-info-list'."
106 (catch 'compression-info
107 (let ((case-fold-search nil))
108 (dolist (x jka-compr-compression-info-list)
109 (and (string-match (jka-compr-info-regexp x) filename)
110 (throw 'compression-info x)))
111 nil)))
113 (defun jka-compr-install ()
114 "Install jka-compr.
115 This adds entries to `file-name-handler-alist' and `auto-mode-alist'
116 and `inhibit-first-line-modes-suffixes'."
118 (setq jka-compr-file-name-handler-entry
119 (cons (jka-compr-build-file-regexp) 'jka-compr-handler))
121 (push jka-compr-file-name-handler-entry file-name-handler-alist)
123 (setq jka-compr-compression-info-list--internal
124 jka-compr-compression-info-list
125 jka-compr-mode-alist-additions--internal
126 jka-compr-mode-alist-additions
127 jka-compr-load-suffixes--internal
128 jka-compr-load-suffixes)
130 (dolist (x jka-compr-compression-info-list)
131 ;; Don't do multibyte encoding on the compressed files.
132 (let ((elt (cons (jka-compr-info-regexp x)
133 '(no-conversion . no-conversion))))
134 (push elt file-coding-system-alist)
135 (push elt jka-compr-added-to-file-coding-system-alist))
137 (and (jka-compr-info-strip-extension x)
138 ;; Make entries in auto-mode-alist so that modes
139 ;; are chosen right according to the file names
140 ;; sans `.gz'.
141 (push (list (jka-compr-info-regexp x) nil 'jka-compr) auto-mode-alist)
142 ;; Also add these regexps to
143 ;; inhibit-first-line-modes-suffixes, so that a
144 ;; -*- line in the first file of a compressed tar
145 ;; file doesn't override tar-mode.
146 (push (jka-compr-info-regexp x)
147 inhibit-first-line-modes-suffixes)))
148 (setq auto-mode-alist
149 (append auto-mode-alist jka-compr-mode-alist-additions))
151 ;; Make sure that (load "foo") will find /bla/foo.el.gz.
152 (setq load-file-rep-suffixes
153 (append load-file-rep-suffixes jka-compr-load-suffixes nil)))
155 (defun jka-compr-installed-p ()
156 "Return non-nil if jka-compr is installed.
157 The return value is the entry in `file-name-handler-alist' for jka-compr."
159 (let ((fnha file-name-handler-alist)
160 (installed nil))
162 (while (and fnha (not installed))
163 (and (eq (cdr (car fnha)) 'jka-compr-handler)
164 (setq installed (car fnha)))
165 (setq fnha (cdr fnha)))
167 installed))
169 (defun jka-compr-update ()
170 "Update Auto Compression mode for changes in option values.
171 If you change the options `jka-compr-compression-info-list',
172 `jka-compr-mode-alist-additions' or `jka-compr-load-suffixes'
173 outside Custom, while Auto Compression mode is already enabled
174 \(as it is by default), then you have to call this function
175 afterward to properly update other variables. Setting these
176 options through Custom does this automatically."
177 (when (jka-compr-installed-p)
178 (jka-compr-uninstall)
179 (jka-compr-install)))
181 (defun jka-compr-set (variable value)
182 "Internal Custom :set function."
183 (set-default variable value)
184 (jka-compr-update))
186 ;; I have this defined so that .Z files are assumed to be in unix
187 ;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
189 ;; FIXME? It seems ugly that one has to add "\\(~\\|\\.~[0-9]+~\\)?" to
190 ;; all the regexps here, in order to match backup files etc.
191 ;; It's trivial to modify jka-compr-get-compression-info to match
192 ;; regexps against file-name-sans-versions, but this regexp is also
193 ;; used to build a file-name-handler-alist entry.
194 ;; find-file-name-handler does not use file-name-sans-versions.
195 ;; Perhaps it should,
196 ;; http://lists.gnu.org/archive/html/emacs-devel/2008-02/msg00812.html,
197 ;; but it's used all over the place and there are probably other ramifications.
198 ;; One could modify jka-compr-build-file-regexp to add the backup regexp,
199 ;; but jka-compr-compression-info-list is a defcustom to which
200 ;; anything could be added, so it's easiest to leave things as they are.
201 (defcustom jka-compr-compression-info-list
202 ;;[regexp
203 ;; compr-message compr-prog compr-args
204 ;; uncomp-message uncomp-prog uncomp-args
205 ;; can-append strip-extension-flag file-magic-bytes]
206 (mapcar 'purecopy
207 '(["\\.Z\\'"
208 "compressing" "compress" ("-c")
209 ;; gzip is more common than uncompress. It can only read, not write.
210 "uncompressing" "gzip" ("-c" "-q" "-d")
211 nil t "\037\235"]
212 ;; Formerly, these had an additional arg "-c", but that fails with
213 ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
214 ;; "Version 0.9.0b, 9-Sept-98".
215 ["\\.bz2\\'"
216 "bzip2ing" "bzip2" nil
217 "bunzip2ing" "bzip2" ("-d")
218 nil t "BZh"]
219 ["\\.tbz2?\\'"
220 "bzip2ing" "bzip2" nil
221 "bunzip2ing" "bzip2" ("-d")
222 nil nil "BZh"]
223 ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'"
224 "compressing" "gzip" ("-c" "-q")
225 "uncompressing" "gzip" ("-c" "-q" "-d")
226 t nil "\037\213"]
227 ["\\.g?z\\'"
228 "compressing" "gzip" ("-c" "-q")
229 "uncompressing" "gzip" ("-c" "-q" "-d")
230 t t "\037\213"]
231 ["\\.xz\\'"
232 "XZ compressing" "xz" ("-c" "-q")
233 "XZ uncompressing" "xz" ("-c" "-q" "-d")
234 t t "\3757zXZ\0"]
235 ;; dzip is gzip with random access. Its compression program can't
236 ;; read/write stdin/out, so .dz files can only be viewed without
237 ;; saving, having their contents decompressed with gzip.
238 ["\\.dz\\'"
239 nil nil nil
240 "uncompressing" "gzip" ("-c" "-q" "-d")
241 nil t "\037\213"]))
243 "List of vectors that describe available compression techniques.
244 Each element, which describes a compression technique, is a vector of
245 the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
246 UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
247 APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
249 regexp is a regexp that matches filenames that are
250 compressed with this format
252 compress-msg is the message to issue to the user when doing this
253 type of compression (nil means no message)
255 compress-program is a program that performs this compression
256 (nil means visit file in read-only mode)
258 compress-args is a list of args to pass to the compress program
260 uncompress-msg is the message to issue to the user when doing this
261 type of uncompression (nil means no message)
263 uncompress-program is a program that performs this compression
265 uncompress-args is a list of args to pass to the uncompress program
267 append-flag is non-nil if this compression technique can be
268 appended
270 strip-extension-flag non-nil means strip the regexp from file names
271 before attempting to set the mode.
273 file-magic-chars is a string of characters that you would find
274 at the beginning of a file compressed in this way.
276 If you set this outside Custom while Auto Compression mode is
277 already enabled \(as it is by default), you have to call
278 `jka-compr-update' after setting it to properly update other
279 variables. Setting this through Custom does that automatically."
280 :type '(repeat (vector regexp
281 (choice :tag "Compress Message"
282 (string :format "%v")
283 (const :tag "No Message" nil))
284 (choice :tag "Compress Program"
285 (string)
286 (const :tag "None" nil))
287 (repeat :tag "Compress Arguments" string)
288 (choice :tag "Uncompress Message"
289 (string :format "%v")
290 (const :tag "No Message" nil))
291 (choice :tag "Uncompress Program"
292 (string)
293 (const :tag "None" nil))
294 (repeat :tag "Uncompress Arguments" string)
295 (boolean :tag "Append")
296 (boolean :tag "Strip Extension")
297 (string :tag "Magic Bytes")))
298 :set 'jka-compr-set
299 :group 'jka-compr)
301 (defcustom jka-compr-mode-alist-additions
302 (list (cons (purecopy "\\.tgz\\'") 'tar-mode) (cons (purecopy "\\.tbz2?\\'") 'tar-mode))
303 "List of pairs added to `auto-mode-alist' when installing jka-compr.
304 Uninstalling jka-compr removes all pairs from `auto-mode-alist' that
305 installing added.
307 If you set this outside Custom while Auto Compression mode is
308 already enabled \(as it is by default), you have to call
309 `jka-compr-update' after setting it to properly update other
310 variables. Setting this through Custom does that automatically."
311 :type '(repeat (cons string symbol))
312 :set 'jka-compr-set
313 :group 'jka-compr)
315 (defcustom jka-compr-load-suffixes (list (purecopy ".gz"))
316 "List of compression related suffixes to try when loading files.
317 Enabling Auto Compression mode appends this list to `load-file-rep-suffixes',
318 which see. Disabling Auto Compression mode removes all suffixes
319 from `load-file-rep-suffixes' that enabling added.
321 If you set this outside Custom while Auto Compression mode is
322 already enabled \(as it is by default), you have to call
323 `jka-compr-update' after setting it to properly update other
324 variables. Setting this through Custom does that automatically."
325 :type '(repeat string)
326 :set 'jka-compr-set
327 :group 'jka-compr)
329 (define-minor-mode auto-compression-mode
330 "Toggle automatic file compression and uncompression.
331 With prefix argument ARG, turn auto compression on if positive, else off.
332 Return the new status of auto compression (non-nil means on)."
333 :global t :init-value t :group 'jka-compr :version "22.1"
334 (let* ((installed (jka-compr-installed-p))
335 (flag auto-compression-mode))
336 (cond
337 ((and flag installed) t) ; already installed
338 ((and (not flag) (not installed)) nil) ; already not installed
339 (flag (jka-compr-install))
340 (t (jka-compr-uninstall)))))
342 (defmacro with-auto-compression-mode (&rest body)
343 "Evalute BODY with automatic file compression and uncompression enabled."
344 (declare (indent 0))
345 (let ((already-installed (make-symbol "already-installed")))
346 `(let ((,already-installed (jka-compr-installed-p)))
347 (unwind-protect
348 (progn
349 (unless ,already-installed
350 (jka-compr-install))
351 ,@body)
352 (unless ,already-installed
353 (jka-compr-uninstall))))))
355 ;; This is what we need to know about jka-compr-handler
356 ;; in order to decide when to call it.
358 (put 'jka-compr-handler 'safe-magic t)
359 (put 'jka-compr-handler 'operations '(byte-compiler-base-file-name
360 write-region insert-file-contents
361 file-local-copy load))
363 ;; Turn on the mode.
364 (when auto-compression-mode (auto-compression-mode 1))
366 (provide 'jka-cmpr-hook)
368 ;;; jka-cmpr-hook.el ends here