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