Line data Source code
1 : ;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
2 :
3 : ;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2017 Free Software
4 : ;; Foundation, Inc.
5 :
6 : ;; Author: Jay K. Adams <jka@ece.cmu.edu>
7 : ;; Maintainer: emacs-devel@gnu.org
8 : ;; Keywords: data
9 : ;; Package: emacs
10 :
11 : ;; This file is part of GNU Emacs.
12 :
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.
17 :
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.
22 :
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/>.
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 : (defcustom jka-compr-verbose t
43 : "If non-nil, output messages whenever compressing or uncompressing files."
44 : :version "24.1"
45 : :type 'boolean
46 : :group 'jka-compr)
47 :
48 : ;; List of all the elements we actually added to file-coding-system-alist.
49 : (defvar jka-compr-added-to-file-coding-system-alist nil)
50 :
51 : (defvar jka-compr-file-name-handler-entry
52 : nil
53 : "`file-name-handler-alist' entry used by jka-compr I/O functions.")
54 :
55 : ;; Compiler defvars. These three variables will be defined later with
56 : ;; `defcustom' when everything used in the :set functions is defined.
57 : (defvar jka-compr-compression-info-list)
58 : (defvar jka-compr-mode-alist-additions)
59 : (defvar jka-compr-load-suffixes)
60 :
61 : (defvar jka-compr-compression-info-list--internal nil
62 : "Stored value of `jka-compr-compression-info-list'.
63 : If Auto Compression mode is enabled, this is the value of
64 : `jka-compr-compression-info-list' when `jka-compr-install' was last called.
65 : Otherwise, it is nil.")
66 :
67 : (defvar jka-compr-mode-alist-additions--internal nil
68 : "Stored value of `jka-compr-mode-alist-additions'.
69 : If Auto Compression mode is enabled, this is the value of
70 : `jka-compr-mode-alist-additions' when `jka-compr-install' was last called.
71 : Otherwise, it is nil.")
72 :
73 : (defvar jka-compr-load-suffixes--internal nil
74 : "Stored value of `jka-compr-load-suffixes'.
75 : If Auto Compression mode is enabled, this is the value of
76 : `jka-compr-load-suffixes' when `jka-compr-install' was last called.
77 : Otherwise, it is nil.")
78 :
79 :
80 : (defun jka-compr-build-file-regexp ()
81 3 : (purecopy
82 3 : (let ((re-anchored '())
83 : (re-free '()))
84 3 : (dolist (e jka-compr-compression-info-list)
85 36 : (let ((re (jka-compr-info-regexp e)))
86 36 : (if (string-match "\\\\'\\'" re)
87 72 : (push (substring re 0 (match-beginning 0)) re-anchored)
88 36 : (push re re-free))))
89 3 : (concat
90 3 : (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|"))
91 : "\\(?:"
92 3 : (mapconcat 'identity re-anchored "\\|")
93 3 : "\\)" file-name-version-regexp "?\\'"))))
94 :
95 : ;; Functions for accessing the return value of jka-compr-get-compression-info
96 144 : (defun jka-compr-info-regexp (info) (aref info 0))
97 0 : (defun jka-compr-info-compress-message (info) (aref info 1))
98 0 : (defun jka-compr-info-compress-program (info) (aref info 2))
99 0 : (defun jka-compr-info-compress-args (info) (aref info 3))
100 0 : (defun jka-compr-info-uncompress-message (info) (aref info 4))
101 0 : (defun jka-compr-info-uncompress-program (info) (aref info 5))
102 0 : (defun jka-compr-info-uncompress-args (info) (aref info 6))
103 0 : (defun jka-compr-info-can-append (info) (aref info 7))
104 72 : (defun jka-compr-info-strip-extension (info) (aref info 8))
105 0 : (defun jka-compr-info-file-magic-bytes (info) (aref info 9))
106 :
107 :
108 : (defun jka-compr-get-compression-info (filename)
109 : "Return information about the compression scheme of FILENAME.
110 : The determination as to which compression scheme, if any, to use is
111 : based on the filename itself and `jka-compr-compression-info-list'."
112 0 : (setq filename (file-name-sans-versions filename))
113 0 : (catch 'compression-info
114 0 : (let ((case-fold-search nil))
115 0 : (dolist (x jka-compr-compression-info-list)
116 0 : (and (string-match (jka-compr-info-regexp x) filename)
117 0 : (throw 'compression-info x)))
118 0 : nil)))
119 :
120 : (defun jka-compr-install ()
121 : "Install jka-compr.
122 : This adds entries to `file-name-handler-alist' and `auto-mode-alist'
123 : and `inhibit-local-variables-suffixes'."
124 :
125 3 : (setq jka-compr-file-name-handler-entry
126 3 : (cons (jka-compr-build-file-regexp) 'jka-compr-handler))
127 :
128 6 : (push jka-compr-file-name-handler-entry file-name-handler-alist)
129 :
130 3 : (setq jka-compr-compression-info-list--internal
131 3 : jka-compr-compression-info-list
132 : jka-compr-mode-alist-additions--internal
133 3 : jka-compr-mode-alist-additions
134 : jka-compr-load-suffixes--internal
135 3 : jka-compr-load-suffixes)
136 :
137 3 : (dolist (x jka-compr-compression-info-list)
138 : ;; Don't do multibyte encoding on the compressed files.
139 36 : (let ((elt (cons (jka-compr-info-regexp x)
140 36 : '(no-conversion . no-conversion))))
141 72 : (push elt file-coding-system-alist)
142 72 : (push elt jka-compr-added-to-file-coding-system-alist))
143 :
144 36 : (and (jka-compr-info-strip-extension x)
145 : ;; Make entries in auto-mode-alist so that modes
146 : ;; are chosen right according to the file names
147 : ;; sans `.gz'.
148 48 : (push (list (jka-compr-info-regexp x) nil 'jka-compr) auto-mode-alist)
149 : ;; Also add these regexps to inhibit-local-variables-suffixes,
150 : ;; so that a -*- line in the first file of a compressed tar file,
151 : ;; or a Local Variables section in a member file at the end of
152 : ;; the tar file don't override tar-mode.
153 24 : (push (jka-compr-info-regexp x)
154 48 : inhibit-local-variables-suffixes)))
155 3 : (setq auto-mode-alist
156 3 : (append auto-mode-alist jka-compr-mode-alist-additions))
157 :
158 : ;; Make sure that (load "foo") will find /bla/foo.el.gz.
159 3 : (setq load-file-rep-suffixes
160 3 : (append load-file-rep-suffixes jka-compr-load-suffixes nil)))
161 :
162 : (defun jka-compr-installed-p ()
163 : "Return non-nil if jka-compr is installed.
164 : The return value is the entry in `file-name-handler-alist' for jka-compr."
165 :
166 4 : (let ((fnha file-name-handler-alist)
167 : (installed nil))
168 :
169 10 : (while (and fnha (not installed))
170 6 : (and (eq (cdr (car fnha)) 'jka-compr-handler)
171 6 : (setq installed (car fnha)))
172 6 : (setq fnha (cdr fnha)))
173 :
174 4 : installed))
175 :
176 : (defun jka-compr-update ()
177 : "Update Auto Compression mode for changes in option values.
178 : If you change the options `jka-compr-compression-info-list',
179 : `jka-compr-mode-alist-additions' or `jka-compr-load-suffixes'
180 : outside Custom, while Auto Compression mode is already enabled
181 : \(as it is by default), then you have to call this function
182 : afterward to properly update other variables. Setting these
183 : options through Custom does this automatically."
184 3 : (when (jka-compr-installed-p)
185 3 : (jka-compr-uninstall)
186 3 : (jka-compr-install)))
187 :
188 : (defun jka-compr-set (variable value)
189 : "Internal Custom :set function."
190 3 : (set-default variable value)
191 3 : (jka-compr-update))
192 :
193 : ;; I have this defined so that .Z files are assumed to be in unix
194 : ;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
195 : (defcustom jka-compr-compression-info-list
196 : ;;[regexp
197 : ;; compr-message compr-prog compr-args
198 : ;; uncomp-message uncomp-prog uncomp-args
199 : ;; can-append strip-extension-flag file-magic-bytes]
200 : (mapcar 'purecopy
201 : '(["\\.Z\\'"
202 : "compressing" "compress" ("-c")
203 : ;; gzip is more common than uncompress. It can only read, not write.
204 : "uncompressing" "gzip" ("-c" "-q" "-d")
205 : nil t "\037\235"]
206 : ;; Formerly, these had an additional arg "-c", but that fails with
207 : ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
208 : ;; "Version 0.9.0b, 9-Sept-98".
209 : ["\\.bz2\\'"
210 : "bzip2ing" "bzip2" nil
211 : "bunzip2ing" "bzip2" ("-d")
212 : nil t "BZh"]
213 : ["\\.tbz2?\\'"
214 : "bzip2ing" "bzip2" nil
215 : "bunzip2ing" "bzip2" ("-d")
216 : nil nil "BZh"]
217 : ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'"
218 : "compressing" "gzip" ("-c" "-q")
219 : "uncompressing" "gzip" ("-c" "-q" "-d")
220 : t nil "\037\213"]
221 : ["\\.g?z\\'"
222 : "compressing" "gzip" ("-c" "-q")
223 : "uncompressing" "gzip" ("-c" "-q" "-d")
224 : t t "\037\213"]
225 : ["\\.lz\\'"
226 : "Lzip compressing" "lzip" ("-c" "-q")
227 : "Lzip uncompressing" "lzip" ("-c" "-q" "-d")
228 : t t "LZIP"]
229 : ["\\.lzma\\'"
230 : "LZMA compressing" "lzma" ("-c" "-q" "-z")
231 : "LZMA uncompressing" "lzma" ("-c" "-q" "-d")
232 : t t ""]
233 : ["\\.xz\\'"
234 : "XZ compressing" "xz" ("-c" "-q")
235 : "XZ uncompressing" "xz" ("-c" "-q" "-d")
236 : t t "\3757zXZ\0"]
237 : ["\\.txz\\'"
238 : "XZ compressing" "xz" ("-c" "-q")
239 : "XZ uncompressing" "xz" ("-c" "-q" "-d")
240 : t nil "\3757zXZ\0"]
241 : ;; dzip is gzip with random access. Its compression program can't
242 : ;; read/write stdin/out, so .dz files can only be viewed without
243 : ;; saving, having their contents decompressed with gzip.
244 : ["\\.dz\\'"
245 : nil nil nil
246 : "uncompressing" "gzip" ("-c" "-q" "-d")
247 : nil t "\037\213"]
248 : ["\\.zst\\'"
249 : "zstd compressing" "zstd" ("-c" "-q")
250 : "zstd uncompressing" "zstd" ("-c" "-q" "-d")
251 : t t "\050\265\057\375"]
252 : ["\\.tzst\\'"
253 : "zstd compressing" "zstd" ("-c" "-q")
254 : "zstd uncompressing" "zstd" ("-c" "-q" "-d")
255 : t nil "\050\265\057\375"]))
256 :
257 : "List of vectors that describe available compression techniques.
258 : Each element, which describes a compression technique, is a vector of
259 : the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
260 : UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
261 : APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
262 :
263 : regexp is a regexp that matches filenames that are
264 : compressed with this format
265 :
266 : compress-msg is the message to issue to the user when doing this
267 : type of compression (nil means no message)
268 :
269 : compress-program is a program that performs this compression
270 : (nil means visit file in read-only mode)
271 :
272 : compress-args is a list of args to pass to the compress program
273 :
274 : uncompress-msg is the message to issue to the user when doing this
275 : type of uncompression (nil means no message)
276 :
277 : uncompress-program is a program that performs this compression
278 :
279 : uncompress-args is a list of args to pass to the uncompress program
280 :
281 : append-flag is non-nil if this compression technique can be
282 : appended
283 :
284 : strip-extension-flag non-nil means strip the regexp from file names
285 : before attempting to set the mode.
286 :
287 : file-magic-chars is a string of characters that you would find
288 : at the beginning of a file compressed in this way.
289 :
290 : If you set this outside Custom while Auto Compression mode is
291 : already enabled \(as it is by default), you have to call
292 : `jka-compr-update' after setting it to properly update other
293 : variables. Setting this through Custom does that automatically."
294 : :type '(repeat (vector regexp
295 : (choice :tag "Compress Message"
296 : (string :format "%v")
297 : (const :tag "No Message" nil))
298 : (choice :tag "Compress Program"
299 : (string)
300 : (const :tag "None" nil))
301 : (repeat :tag "Compress Arguments" string)
302 : (choice :tag "Uncompress Message"
303 : (string :format "%v")
304 : (const :tag "No Message" nil))
305 : (choice :tag "Uncompress Program"
306 : (string)
307 : (const :tag "None" nil))
308 : (repeat :tag "Uncompress Arguments" string)
309 : (boolean :tag "Append")
310 : (boolean :tag "Strip Extension")
311 : (string :tag "Magic Bytes")))
312 : :set 'jka-compr-set
313 : :version "24.1" ; removed version extension piece
314 : :group 'jka-compr)
315 :
316 : (defcustom jka-compr-mode-alist-additions
317 : (purecopy '(("\\.tgz\\'" . tar-mode)
318 : ("\\.tbz2?\\'" . tar-mode)
319 : ("\\.txz\\'" . tar-mode)
320 : ("\\.tzst\\'" . tar-mode)))
321 : "List of pairs added to `auto-mode-alist' when installing jka-compr.
322 : Uninstalling jka-compr removes all pairs from `auto-mode-alist' that
323 : installing added.
324 :
325 : If you set this outside Custom while Auto Compression mode is
326 : already enabled \(as it is by default), you have to call
327 : `jka-compr-update' after setting it to properly update other
328 : variables. Setting this through Custom does that automatically."
329 : :type '(repeat (cons string symbol))
330 : :version "24.4" ; add txz
331 : :set 'jka-compr-set
332 : :group 'jka-compr)
333 :
334 : (defcustom jka-compr-load-suffixes (purecopy '(".gz"))
335 : "List of compression related suffixes to try when loading files.
336 : Enabling Auto Compression mode appends this list to `load-file-rep-suffixes',
337 : which see. Disabling Auto Compression mode removes all suffixes
338 : from `load-file-rep-suffixes' that enabling added.
339 :
340 : If you set this outside Custom while Auto Compression mode is
341 : already enabled \(as it is by default), you have to call
342 : `jka-compr-update' after setting it to properly update other
343 : variables. Setting this through Custom does that automatically."
344 : :type '(repeat string)
345 : :set 'jka-compr-set
346 : :group 'jka-compr)
347 :
348 : (define-minor-mode auto-compression-mode
349 : "Toggle Auto Compression mode.
350 : With a prefix argument ARG, enable Auto Compression mode if ARG
351 : is positive, and disable it otherwise. If called from Lisp,
352 : enable the mode if ARG is omitted or nil.
353 :
354 : Auto Compression mode is a global minor mode. When enabled,
355 : compressed files are automatically uncompressed for reading, and
356 : compressed when writing."
357 : :global t :init-value t :group 'jka-compr :version "22.1"
358 1 : (let* ((installed (jka-compr-installed-p))
359 1 : (flag auto-compression-mode))
360 1 : (cond
361 1 : ((and flag installed) t) ; already installed
362 0 : ((and (not flag) (not installed)) nil) ; already not installed
363 0 : (flag (jka-compr-install))
364 1 : (t (jka-compr-uninstall)))))
365 :
366 : (defmacro with-auto-compression-mode (&rest body)
367 : "Evaluate BODY with automatic file compression and uncompression enabled."
368 : (declare (indent 0))
369 0 : (let ((already-installed (make-symbol "already-installed")))
370 0 : `(let ((,already-installed (jka-compr-installed-p)))
371 : (unwind-protect
372 : (progn
373 0 : (unless ,already-installed
374 : (jka-compr-install))
375 0 : ,@body)
376 0 : (unless ,already-installed
377 0 : (jka-compr-uninstall))))))
378 :
379 : ;; This is what we need to know about jka-compr-handler
380 : ;; in order to decide when to call it.
381 :
382 : (put 'jka-compr-handler 'safe-magic t)
383 : (put 'jka-compr-handler 'operations '(byte-compiler-base-file-name
384 : write-region insert-file-contents
385 : file-local-copy load))
386 :
387 : ;; Turn on the mode.
388 : (when auto-compression-mode (auto-compression-mode 1))
389 :
390 : (provide 'jka-cmpr-hook)
391 :
392 : ;;; jka-cmpr-hook.el ends here
|