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