[bpt/emacs.git] / lisp / jka-comp-hook.el

;;; jka-comp-hook.el --- preloaded code to enable jka-compr.el

;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2003, 2004, 2005  Free Software Foundation, Inc.

;; Author: jka@ece.cmu.edu (Jay K. Adams)
;; Maintainer: FSF
;; Keywords: data

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This file contains the  code to enable and disable Auto-Compression mode.
;; It is preloaded.  The guts of this mode are in jka-compr.el, which
;; is loaded only when you really try to uncompress something.

;;; Code:

(defgroup compression nil
  "Data compression utilities"
  :group 'data)

(defgroup jka-compr nil
  "jka-compr customization"
  :group 'compression)

;;; I have this defined so that .Z files are assumed to be in unix
;;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
(defcustom jka-compr-compression-info-list
  ;;[regexp
  ;; compr-message  compr-prog  compr-args
  ;; uncomp-message uncomp-prog uncomp-args
  ;; can-append auto-mode-flag strip-extension-flag file-magic-bytes]
  '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
     "compressing"    "compress"     ("-c")
     "uncompressing"  "uncompress"   ("-c")
     nil t "\037\235"]
     ;; Formerly, these had an additional arg "-c", but that fails with
     ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
     ;; "Version 0.9.0b, 9-Sept-98".
    ["\\.bz2\\'"
     "bzip2ing"        "bzip2"         nil
     "bunzip2ing"      "bzip2"         ("-d")
     nil t "BZh"]
    ["\\.tbz\\'"
     "bzip2ing"        "bzip2"         nil
     "bunzip2ing"      "bzip2"         ("-d")
     nil nil "BZh"]
    ["\\.tgz\\'"
     "compressing"        "gzip"         ("-c" "-q")
     "uncompressing"      "gzip"         ("-c" "-q" "-d")
     t nil "\037\213"]
    ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'"
     "compressing"        "gzip"         ("-c" "-q")
     "uncompressing"      "gzip"         ("-c" "-q" "-d")
     t t "\037\213"]
    ;; dzip is gzip with random access.  Its compression program can't
    ;; read/write stdin/out, so .dz files can only be viewed without
    ;; saving, having their contents decompressed with gzip.
    ["\\.dz\\'"
     nil              nil            nil
     "uncompressing"      "gzip"         ("-c" "-q" "-d")
     nil t "\037\213"])

  "List of vectors that describe available compression techniques.
Each element, which describes a compression technique, is a vector of
the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:

   regexp                is a regexp that matches filenames that are
                         compressed with this format

   compress-msg          is the message to issue to the user when doing this
                         type of compression (nil means no message)

   compress-program      is a program that performs this compression
                         (nil means visit file in read-only mode)

   compress-args         is a list of args to pass to the compress program

   uncompress-msg        is the message to issue to the user when doing this
                         type of uncompression (nil means no message)

   uncompress-program    is a program that performs this compression

   uncompress-args       is a list of args to pass to the uncompress program

   append-flag           is non-nil if this compression technique can be
                         appended

   strip-extension-flag  non-nil means strip the regexp from file names
                         before attempting to set the mode.

   file-magic-chars      is a string of characters that you would find
			 at the beginning of a file compressed in this way.

Because of the way `call-process' is defined, discarding the stderr output of
a program adds the overhead of starting a shell each time the program is
invoked."
  :type '(repeat (vector regexp
			 (choice :tag "Compress Message"
				 (string :format "%v")
				 (const :tag "No Message" nil))
			 (choice :tag "Compress Program"
				 (string)
				 (const :tag "None" nil))
			 (repeat :tag "Compress Arguments" string)
			 (choice :tag "Uncompress Message"
				 (string :format "%v")
				 (const :tag "No Message" nil))
			 (choice :tag "Uncompress Program"
				 (string)
				 (const :tag "None" nil))
			 (repeat :tag "Uncompress Arguments" string)
			 (boolean :tag "Append")
			 (boolean :tag "Strip Extension")
			 (string :tag "Magic Bytes")))
  :group 'jka-compr)

(defcustom jka-compr-mode-alist-additions
  (list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode))
  "A list of pairs to add to `auto-mode-alist' when jka-compr is installed."
  :type '(repeat (cons string symbol))
  :group 'jka-compr)

(defcustom jka-compr-load-suffixes '(".gz")
  "List of suffixes to try when loading files."
  :type '(repeat string)
  :group 'jka-compr)

;; List of all the elements we actually added to file-coding-system-alist.
(defvar jka-compr-added-to-file-coding-system-alist nil)

(defvar jka-compr-file-name-handler-entry
  nil
  "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.")
\f
(defun jka-compr-build-file-regexp ()
  (mapconcat
   'jka-compr-info-regexp
   jka-compr-compression-info-list
   "\\|"))

;;; Functions for accessing the return value of jka-compr-get-compression-info
(defun jka-compr-info-regexp               (info)  (aref info 0))
(defun jka-compr-info-compress-message     (info)  (aref info 1))
(defun jka-compr-info-compress-program     (info)  (aref info 2))
(defun jka-compr-info-compress-args        (info)  (aref info 3))
(defun jka-compr-info-uncompress-message   (info)  (aref info 4))
(defun jka-compr-info-uncompress-program   (info)  (aref info 5))
(defun jka-compr-info-uncompress-args      (info)  (aref info 6))
(defun jka-compr-info-can-append           (info)  (aref info 7))
(defun jka-compr-info-strip-extension      (info)  (aref info 8))
(defun jka-compr-info-file-magic-bytes     (info)  (aref info 9))


(defun jka-compr-get-compression-info (filename)
  "Return information about the compression scheme of FILENAME.
The determination as to which compression scheme, if any, to use is
based on the filename itself and `jka-compr-compression-info-list'."
  (catch 'compression-info
    (let ((case-fold-search nil))
      (mapcar
       (function (lambda (x)
		   (and (string-match (jka-compr-info-regexp x) filename)
			(throw 'compression-info x))))
       jka-compr-compression-info-list)
      nil)))

(defun jka-compr-install ()
  "Install jka-compr.
This adds entries to `file-name-handler-alist' and `auto-mode-alist'
and `inhibit-first-line-modes-suffixes'."

  (setq jka-compr-file-name-handler-entry
	(cons (jka-compr-build-file-regexp) 'jka-compr-handler))

  (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry
				      file-name-handler-alist))

  (setq jka-compr-added-to-file-coding-system-alist nil)

  (mapcar
   (function (lambda (x)
	       ;; Don't do multibyte encoding on the compressed files.
	       (let ((elt (cons (jka-compr-info-regexp x)
				 '(no-conversion . no-conversion))))
		 (setq file-coding-system-alist
		       (cons elt file-coding-system-alist))
		 (setq jka-compr-added-to-file-coding-system-alist
		       (cons elt jka-compr-added-to-file-coding-system-alist)))

	       (and (jka-compr-info-strip-extension x)
		    ;; Make entries in auto-mode-alist so that modes
		    ;; are chosen right according to the file names
		    ;; sans `.gz'.
		    (setq auto-mode-alist
			  (cons (list (jka-compr-info-regexp x)
				      nil 'jka-compr)
				auto-mode-alist))
		    ;; Also add these regexps to
		    ;; inhibit-first-line-modes-suffixes, so that a
		    ;; -*- line in the first file of a compressed tar
		    ;; file doesn't override tar-mode.
		    (setq inhibit-first-line-modes-suffixes
			  (cons (jka-compr-info-regexp x)
				inhibit-first-line-modes-suffixes)))))
   jka-compr-compression-info-list)
  (setq auto-mode-alist
	(append auto-mode-alist jka-compr-mode-alist-additions))

  ;; Make sure that (load "foo") will find /bla/foo.el.gz.
  (setq load-suffixes
	(apply 'append
	       (mapcar (lambda (suffix)
			 (cons suffix
			       (mapcar (lambda (ext) (concat suffix ext))
				       jka-compr-load-suffixes)))
		       load-suffixes))))


(defun jka-compr-installed-p ()
  "Return non-nil if jka-compr is installed.
The return value is the entry in `file-name-handler-alist' for jka-compr."

  (let ((fnha file-name-handler-alist)
	(installed nil))

    (while (and fnha (not installed))
     (and (eq (cdr (car fnha)) 'jka-compr-handler)
	   (setq installed (car fnha)))
      (setq fnha (cdr fnha)))

    installed))

(define-minor-mode auto-compression-mode
  "Toggle automatic file compression and uncompression.
With prefix argument ARG, turn auto compression on if positive, else off.
Returns the new status of auto compression (non-nil means on)."
  :global t :group 'jka-compr
  (let* ((installed (jka-compr-installed-p))
	 (flag auto-compression-mode))
    (cond
     ((and flag installed) t)		; already installed
     ((and (not flag) (not installed)) nil) ; already not installed
     (flag (jka-compr-install))
     (t (jka-compr-uninstall)))))

(defmacro with-auto-compression-mode (&rest body)
  "Evalute BODY with automatic file compression and uncompression enabled."
  (let ((already-installed (make-symbol "already-installed")))
    `(let ((,already-installed (jka-compr-installed-p)))
       (unwind-protect
	   (progn
	     (unless ,already-installed
	       (jka-compr-install))
	     ,@body)
	 (unless ,already-installed
	   (jka-compr-uninstall))))))
(put 'with-auto-compression-mode 'lisp-indent-function 0)


;;; This is what we need to know about jka-compr-handler
;;; in order to decide when to call it.

(put 'jka-compr-handler 'safe-magic t)
(put 'jka-compr-handler 'operations '(jka-compr-byte-compiler-base-file-name
				      write-region insert-file-contents
				      file-local-copy load))

;;; Turn on the mode.
(auto-compression-mode 1)

(provide 'jka-comp-hook)

;;; jka-comp-hook.el ends here
Commit	Line	Data
216b5993 RS	1	;;; jka-comp-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	\f
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-comp-hook)
291
292	;;; jka-comp-hook.el ends here