Mercurial > emacs

comparison lisp/jka-cmpr-hook.el @ 90341:5754737d1e04

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-34 Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 123-134) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 40-48) - Merge from emacs--devo--0 - Update from CVS - Munge arch explicit ids in etc/images to match Emacs
author Miles Bader <miles@gnu.org>
date Fri, 03 Mar 2006 07:48:46 +0000
parents ada9af8312a6
children ddcbd2c1b70d
comparison
equal deleted inserted replaced
90340:8f2b88ad38c4 90341:5754737d1e04
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA. 25 ;; Boston, MA 02110-1301, USA.
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
29 ;; This file contains the code to enable and disable Auto-Compression mode. 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 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. 31 ;; is loaded only when you really try to uncompress something.
32 32
33 ;;; Code: 33 ;;; Code:
34 34
37 :group 'data) 37 :group 'data)
38 38
39 (defgroup jka-compr nil 39 (defgroup jka-compr nil
40 "jka-compr customization." 40 "jka-compr customization."
41 :group 'compression) 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'.
58 If Auto Compression mode is enabled, this is the value of
59 `jka-compr-compression-info-list' when `jka-compr-install' was last called.
60 Otherwise, it is nil.")
61
62 (defvar jka-compr-mode-alist-additions--internal nil
63 "Stored value of `jka-compr-mode-alist-additions'.
64 If Auto Compression mode is enabled, this is the value of
65 `jka-compr-mode-alist-additions' when `jka-compr-install' was last called.
66 Otherwise, it is nil.")
67
68 (defvar jka-compr-load-suffixes--internal nil
69 "Stored value of `jka-compr-load-suffixes'.
70 If Auto Compression mode is enabled, this is the value of
71 `jka-compr-load-suffixes' when `jka-compr-install' was last called.
72 Otherwise, 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.
96 The determination as to which compression scheme, if any, to use is
97 based 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.
109 This adds entries to `file-name-handler-alist' and `auto-mode-alist'
110 and `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.
151 The 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.
165 If you change the options `jka-compr-compression-info-list',
166 `jka-compr-mode-alist-additions' or `jka-compr-load-suffixes'
167 outside Custom, while Auto Compression mode is already enabled
168 \(as it is by default), then you have to call this function
169 afterward to properly update other variables. Setting these
170 options 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))
42 179
43 ;; I have this defined so that .Z files are assumed to be in unix 180 ;; I have this defined so that .Z files are assumed to be in unix
44 ;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt. 181 ;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
45 (defcustom jka-compr-compression-info-list 182 (defcustom jka-compr-compression-info-list
46 ;;[regexp 183 ;;[regexp
111 file-magic-chars is a string of characters that you would find 248 file-magic-chars is a string of characters that you would find
112 at the beginning of a file compressed in this way. 249 at the beginning of a file compressed in this way.
113 250
114 Because of the way `call-process' is defined, discarding the stderr output of 251 Because of the way `call-process' is defined, discarding the stderr output of
115 a program adds the overhead of starting a shell each time the program is 252 a program adds the overhead of starting a shell each time the program is
116 invoked." 253 invoked.
254
255 If you set this outside Custom while Auto Compression mode is
256 already enabled \(as it is by default), you have to call
257 `jka-compr-update' after setting it to properly update other
258 variables. Setting this through Custom does that automatically."
117 :type '(repeat (vector regexp 259 :type '(repeat (vector regexp
118 (choice :tag "Compress Message" 260 (choice :tag "Compress Message"
119 (string :format "%v") 261 (string :format "%v")
120 (const :tag "No Message" nil)) 262 (const :tag "No Message" nil))
121 (choice :tag "Compress Program" 263 (choice :tag "Compress Program"
130 (const :tag "None" nil)) 272 (const :tag "None" nil))
131 (repeat :tag "Uncompress Arguments" string) 273 (repeat :tag "Uncompress Arguments" string)
132 (boolean :tag "Append") 274 (boolean :tag "Append")
133 (boolean :tag "Strip Extension") 275 (boolean :tag "Strip Extension")
134 (string :tag "Magic Bytes"))) 276 (string :tag "Magic Bytes")))
277 :set 'jka-compr-set
135 :group 'jka-compr) 278 :group 'jka-compr)
136 279
137 (defcustom jka-compr-mode-alist-additions 280 (defcustom jka-compr-mode-alist-additions
138 (list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode)) 281 (list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode))
139 "A list of pairs to add to `auto-mode-alist' when jka-compr is installed." 282 "List of pairs added to `auto-mode-alist' when installing jka-compr.
283 Uninstalling jka-compr removes all pairs from `auto-mode-alist' that
284 installing added.
285
286 If you set this outside Custom while Auto Compression mode is
287 already enabled \(as it is by default), you have to call
288 `jka-compr-update' after setting it to properly update other
289 variables. Setting this through Custom does that automatically."
140 :type '(repeat (cons string symbol)) 290 :type '(repeat (cons string symbol))
291 :set 'jka-compr-set
141 :group 'jka-compr) 292 :group 'jka-compr)
142 293
143 (defcustom jka-compr-load-suffixes '(".gz") 294 (defcustom jka-compr-load-suffixes '(".gz")
144 "List of suffixes to try when loading files." 295 "List of compression related suffixes to try when loading files.
296 Enabling Auto Compression mode appends this list to `load-file-rep-suffixes',
297 which see. Disabling Auto Compression mode removes all suffixes
298 from `load-file-rep-suffixes' that enabling added.
299
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."
145 :type '(repeat string) 304 :type '(repeat string)
305 :set 'jka-compr-set
146 :group 'jka-compr) 306 :group 'jka-compr)
147
148 ;; List of all the elements we actually added to file-coding-system-alist.
149 (defvar jka-compr-added-to-file-coding-system-alist nil)
150
151 (defvar jka-compr-file-name-handler-entry
152 nil
153 "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.")
154
155 (defun jka-compr-build-file-regexp ()
156 (mapconcat
157 'jka-compr-info-regexp
158 jka-compr-compression-info-list
159 "\\|"))
160
161 ;; Functions for accessing the return value of jka-compr-get-compression-info
162 (defun jka-compr-info-regexp (info) (aref info 0))
163 (defun jka-compr-info-compress-message (info) (aref info 1))
164 (defun jka-compr-info-compress-program (info) (aref info 2))
165 (defun jka-compr-info-compress-args (info) (aref info 3))
166 (defun jka-compr-info-uncompress-message (info) (aref info 4))
167 (defun jka-compr-info-uncompress-program (info) (aref info 5))
168 (defun jka-compr-info-uncompress-args (info) (aref info 6))
169 (defun jka-compr-info-can-append (info) (aref info 7))
170 (defun jka-compr-info-strip-extension (info) (aref info 8))
171 (defun jka-compr-info-file-magic-bytes (info) (aref info 9))
172
173
174 (defun jka-compr-get-compression-info (filename)
175 "Return information about the compression scheme of FILENAME.
176 The determination as to which compression scheme, if any, to use is
177 based on the filename itself and `jka-compr-compression-info-list'."
178 (catch 'compression-info
179 (let ((case-fold-search nil))
180 (mapcar
181 (function (lambda (x)
182 (and (string-match (jka-compr-info-regexp x) filename)
183 (throw 'compression-info x))))
184 jka-compr-compression-info-list)
185 nil)))
186
187 (defun jka-compr-install ()
188 "Install jka-compr.
189 This adds entries to `file-name-handler-alist' and `auto-mode-alist'
190 and `inhibit-first-line-modes-suffixes'."
191
192 (setq jka-compr-file-name-handler-entry
193 (cons (jka-compr-build-file-regexp) 'jka-compr-handler))
194
195 (push jka-compr-file-name-handler-entry file-name-handler-alist)
196
197 (dolist (x jka-compr-compression-info-list)
198 ;; Don't do multibyte encoding on the compressed files.
199 (let ((elt (cons (jka-compr-info-regexp x)
200 '(no-conversion . no-conversion))))
201 (push elt file-coding-system-alist)
202 (push elt jka-compr-added-to-file-coding-system-alist))
203
204 (and (jka-compr-info-strip-extension x)
205 ;; Make entries in auto-mode-alist so that modes
206 ;; are chosen right according to the file names
207 ;; sans `.gz'.
208 (push (list (jka-compr-info-regexp x) nil 'jka-compr) auto-mode-alist)
209 ;; Also add these regexps to
210 ;; inhibit-first-line-modes-suffixes, so that a
211 ;; -*- line in the first file of a compressed tar
212 ;; file doesn't override tar-mode.
213 (push (jka-compr-info-regexp x)
214 inhibit-first-line-modes-suffixes)))
215 (setq auto-mode-alist
216 (append auto-mode-alist jka-compr-mode-alist-additions))
217
218 ;; Make sure that (load "foo") will find /bla/foo.el.gz.
219 (setq load-suffixes
220 (apply 'append
221 (append (mapcar (lambda (suffix)
222 (cons suffix
223 (mapcar (lambda (ext) (concat suffix ext))
224 jka-compr-load-suffixes)))
225 load-suffixes)
226 (list jka-compr-load-suffixes)))))
227
228
229 (defun jka-compr-installed-p ()
230 "Return non-nil if jka-compr is installed.
231 The return value is the entry in `file-name-handler-alist' for jka-compr."
232
233 (let ((fnha file-name-handler-alist)
234 (installed nil))
235
236 (while (and fnha (not installed))
237 (and (eq (cdr (car fnha)) 'jka-compr-handler)
238 (setq installed (car fnha)))
239 (setq fnha (cdr fnha)))
240
241 installed))
242 307
243 (define-minor-mode auto-compression-mode 308 (define-minor-mode auto-compression-mode
244 "Toggle automatic file compression and uncompression. 309 "Toggle automatic file compression and uncompression.
245 With prefix argument ARG, turn auto compression on if positive, else off. 310 With prefix argument ARG, turn auto compression on if positive, else off.
246 Returns the new status of auto compression (non-nil means on)." 311 Return the new status of auto compression (non-nil means on)."
247 :global t :init-value t :group 'jka-compr :version "22.1" 312 :global t :init-value t :group 'jka-compr :version "22.1"
248 (let* ((installed (jka-compr-installed-p)) 313 (let* ((installed (jka-compr-installed-p))
249 (flag auto-compression-mode)) 314 (flag auto-compression-mode))
250 (cond 315 (cond
251 ((and flag installed) t) ; already installed 316 ((and flag installed) t) ; already installed