Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-files.el @ 197:acd284d43ca1 r20-3b25

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b25
author cvs
date Mon, 13 Aug 2007 10:00:02 +0200
parents 538048ae2ab8
children e45d5e7c476e
comparison
equal deleted inserted replaced
196:58e0786448ca 197:acd284d43ca1
49 'overriding-file-coding-system 49 'overriding-file-coding-system
50 'coding-system-for-read) 50 'coding-system-for-read)
51 51
52 (defvar buffer-file-coding-system-for-read 'automatic-conversion 52 (defvar buffer-file-coding-system-for-read 'automatic-conversion
53 "Coding system used when reading a file. 53 "Coding system used when reading a file.
54 This provides coarse-grained control; for finer-grained control, 54 This provides coarse-grained control; for finer-grained control, use
55 use `buffer-file-coding-system-alist'. From a Lisp program, if you wish 55 `file-coding-system-alist'. From a Lisp program, if you wish to
56 to unilaterally specify the coding system used for one 56 unilaterally specify the coding system used for one particular
57 particular operation, you should bind the variable 57 operation, you should bind the variable `coding-system-for-read'
58 `coding-system-for-read' rather than setting this variable, 58 rather than setting this variable, which is intended to be used for
59 which is intended to be used for global environment specification.") 59 global environment specification.")
60 60
61 (define-obsolete-variable-alias 61 (define-obsolete-variable-alias
62 'file-coding-system-for-read 62 'file-coding-system-for-read
63 'buffer-file-coding-system-for-read) 63 'buffer-file-coding-system-for-read)
64 64
65 (defvar buffer-file-coding-system-alist 65 (defvar file-coding-system-alist
66 '(("\\.\\(el\\|emacs\\|info\\(-[0-9]+\\)?\\|texi\\)$" . iso-2022-8) 66 '(("\\.elc$" . (binary . binary))
67 ("\\(ChangeLog\\|CHANGES-beta\\)$" . iso-2022-8) 67 ("loaddefs.el$" . (binary . binary))
68 ("\\.tar$" . (binary . binary))
69 ;; ("\\.\\(el\\|emacs\\|info\\(-[0-9]+\\)?\\|texi\\)$" . iso-2022-8)
70 ;; ("\\(ChangeLog\\|CHANGES-beta\\)$" . iso-2022-8)
68 ("\\.\\(gz\\|Z\\)$" . binary) 71 ("\\.\\(gz\\|Z\\)$" . binary)
69 ("/spool/mail/.*$" . convert-mbox-coding-system)) 72 ("/spool/mail/.*$" . convert-mbox-coding-system))
70 "Alist specifying the coding system used for particular files. 73 "Alist to decide a coding system to use for a file I/O operation.
71 Each element of the alist is a cons of a regexp, specifying the files 74 The format is ((PATTERN . VAL) ...),
72 to be affected, and a coding system. This overrides the more general 75 where PATTERN is a regular expression matching a file name,
73 specification in `buffer-file-coding-system-for-read', but is 76 VAL is a coding system, a cons of coding systems, or a function symbol.
74 overridden by `coding-system-for-read'. 77 If VAL is a coding system, it is used for both decoding and encoding
75 78 the file contents.
76 Instead of a coding system you may specify a function, and it will be 79 If VAL is a cons of coding systems, the car part is used for decoding,
77 called after the file has been read in to decode the file. It is 80 and the cdr part is used for encoding.
78 called with four arguments: FILENAME, VISIT, START, and END, the same 81 If VAL is a function symbol, the function must return a coding system
79 as the first four arguments to `insert-file-contents'.") 82 or a cons of coding systems which are used as above.
80 83
81 (define-obsolete-variable-alias 84 This overrides the more general specification in
82 'file-coding-system-alist 85 `buffer-file-coding-system-for-read', but is overridden by
83 'buffer-file-coding-system-alist) 86 `coding-system-for-read'.")
84 87
85 (defun set-buffer-file-coding-system (coding-system &optional force) 88 (defun set-buffer-file-coding-system (coding-system &optional force)
86 "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM. 89 "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM.
87 If optional argument FORCE (interactively, the prefix argument) is not 90 If optional argument FORCE (interactively, the prefix argument) is not
88 given, attempt to match the EOL type of the new coding system to 91 given, attempt to match the EOL type of the new coding system to
103 106
104 (defun set-buffer-file-coding-system-for-read (coding-system) 107 (defun set-buffer-file-coding-system-for-read (coding-system)
105 "Set the coding system used when reading in a file. 108 "Set the coding system used when reading in a file.
106 This is equivalent to setting the variable 109 This is equivalent to setting the variable
107 `buffer-file-coding-system-for-read'. You can also use 110 `buffer-file-coding-system-for-read'. You can also use
108 `buffer-file-coding-system-alist' to specify the coding system for 111 `file-coding-system-alist' to specify the coding system for
109 particular files." 112 particular files."
110 (interactive "zFile coding system for read: ") 113 (interactive "zFile coding system for read: ")
111 (get-coding-system coding-system) ;; correctness check 114 (get-coding-system coding-system) ;; correctness check
112 (setq buffer-file-coding-system-for-read coding-system)) 115 (setq buffer-file-coding-system-for-read coding-system))
113 116
126 129
127 (define-obsolete-function-alias 130 (define-obsolete-function-alias
128 'set-default-file-coding-system 131 'set-default-file-coding-system
129 'set-default-buffer-file-coding-system) 132 'set-default-buffer-file-coding-system)
130 133
131 (defun find-buffer-file-coding-system-from-filename (filename) 134 (defun find-file-coding-system-for-read-from-filename (filename)
132 "Look up a file in `buffer-file-coding-system-alist'. 135 "Look up coding system to read a file in `file-coding-system-alist'.
133 The return value will be nil (no applicable entry), a coding system 136 The return value will be nil (no applicable entry) or a coding system
134 object (the entry specified a coding system), or something else (the 137 object (the entry specified a coding system)."
135 entry specified a function to be called)." 138 (let ((alist file-coding-system-alist)
136 (let ((alist buffer-file-coding-system-alist)
137 (found nil) 139 (found nil)
138 (codesys nil)) 140 (codesys nil))
139 (let ((case-fold-search (eq system-type 'vax-vms))) 141 (let ((case-fold-search (eq system-type 'vax-vms)))
140 (setq filename (file-name-sans-versions filename)) 142 (setq filename (file-name-sans-versions filename))
141 (while (and (not found) alist) 143 (while (and (not found) alist)
142 (if (string-match (car (car alist)) filename) 144 (if (string-match (car (car alist)) filename)
143 (setq codesys (cdr (car alist)) 145 (setq codesys (cdr (car alist))
144 found t)) 146 found t))
145 (setq alist (cdr alist)))) 147 (setq alist (cdr alist))))
146 (if codesys 148 (when codesys
147 (cond ((find-coding-system codesys)) 149 (if (functionp codesys)
148 (t codesys))))) 150 (setq codesys (funcall codesys 'insert-file-contents filename))
151 )
152 (cond ((consp codesys) (find-coding-system (car codesys)))
153 ((find-coding-system codesys))
154 ))))
149 155
150 (define-obsolete-function-alias 156 (define-obsolete-function-alias
151 'find-file-coding-system-from-filename 157 'find-file-coding-system-from-filename
152 'find-buffer-file-coding-system-from-filename) 158 'find-file-coding-system-for-read-from-filename)
159
160 (defun find-file-coding-system-for-write-from-filename (filename)
161 "Look up coding system to write a file in `file-coding-system-alist'.
162 The return value will be nil (no applicable entry) or a coding system
163 object (the entry specified a coding system)."
164 (let ((alist file-coding-system-alist)
165 (found nil)
166 (codesys nil))
167 (let ((case-fold-search (eq system-type 'vax-vms)))
168 (setq filename (file-name-sans-versions filename))
169 (while (and (not found) alist)
170 (if (string-match (car (car alist)) filename)
171 (setq codesys (cdr (car alist))
172 found t))
173 (setq alist (cdr alist))))
174 (when codesys
175 (if (functionp codesys)
176 (setq codesys (funcall codesys 'write-region filename))
177 )
178 (cond ((consp codesys) (find-coding-system (cdr codesys)))
179 ((find-coding-system codesys))
180 ))))
153 181
154 (defun convert-mbox-coding-system (filename visit start end) 182 (defun convert-mbox-coding-system (filename visit start end)
155 "Decoding function for Unix mailboxes. 183 "Decoding function for Unix mailboxes.
156 Does separate detection and decoding on each message, since each 184 Does separate detection and decoding on each message, since each
157 message might be in a different encoding." 185 message might be in a different encoding."
232 ;; a line; don't risk confusion here either. 260 ;; a line; don't risk confusion here either.
233 (if (not __codesys__) 261 (if (not __codesys__)
234 (setq __codesys__ 'no-conversion)) 262 (setq __codesys__ 'no-conversion))
235 ;; otherwise use `buffer-file-coding-system-for-read', as normal 263 ;; otherwise use `buffer-file-coding-system-for-read', as normal
236 ;; #### need to do some looking up in 264 ;; #### need to do some looking up in
237 ;; #### buffer-file-coding-system-alist! 265 ;; #### file-coding-system-alist!
238 (if (not __codesys__) 266 (if (not __codesys__)
239 (setq __codesys__ buffer-file-coding-system-for-read))) 267 (setq __codesys__ buffer-file-coding-system-for-read)))
240 ;; now use the internal load to actually load the file. 268 ;; now use the internal load to actually load the file.
241 (load-internal file noerror nomessage nosuffix __codesys__)))))) 269 (load-internal file noerror nomessage nosuffix __codesys__))))))
242 270
312 The coding system used for decoding the file is determined as follows: 340 The coding system used for decoding the file is determined as follows:
313 341
314 1. `coding-system-for-read', if non-nil. 342 1. `coding-system-for-read', if non-nil.
315 2. The result of `insert-file-contents-pre-hook', if non-nil. 343 2. The result of `insert-file-contents-pre-hook', if non-nil.
316 3. The matching value for this filename from 344 3. The matching value for this filename from
317 `buffer-file-coding-system-alist', if any. 345 `file-coding-system-alist', if any.
318 4. `buffer-file-coding-system-for-read', if non-nil. 346 4. `buffer-file-coding-system-for-read', if non-nil.
319 5. The coding system 'no-conversion. 347 5. The coding system 'no-conversion.
320 348
321 If a local value for `buffer-file-coding-system' in the current buffer 349 If a local value for `buffer-file-coding-system' in the current buffer
322 does not exist, it is set to the coding system which was actually used 350 does not exist, it is set to the coding system which was actually used
338 coding-system-for-read 366 coding-system-for-read
339 ;; #2. 367 ;; #2.
340 (run-special-hook-with-args 'insert-file-contents-pre-hook 368 (run-special-hook-with-args 'insert-file-contents-pre-hook
341 filename visit) 369 filename visit)
342 ;; #3. 370 ;; #3.
343 (let ((retval (find-buffer-file-coding-system-from-filename 371 (find-file-coding-system-for-read-from-filename filename)
344 filename)))
345 (if (or (null retval) (coding-system-p retval))
346 retval
347 (setq conversion-func retval)
348 'no-conversion))
349 ;; #4. 372 ;; #4.
350 buffer-file-coding-system-for-read 373 buffer-file-coding-system-for-read
351 ;; #5. 374 ;; #5.
352 'no-conversion)) 375 'no-conversion))
353 (if (consp coding-system) 376 (if (consp coding-system)
382 (funcall func (point) (marker-position endmark)))) 405 (funcall func (point) (marker-position endmark))))
383 (if visit 406 (if visit
384 (progn 407 (progn
385 (set-buffer-auto-saved) 408 (set-buffer-auto-saved)
386 (set-buffer-modified-p nil))))) 409 (set-buffer-modified-p nil)))))
387 (setcar (cdr return-val) (- (marker-position endmark) (point)))
388 ;; also call any post-conversion function called for by
389 ;; `buffer-file-coding-system-alist'
390 (if conversion-func
391 (unwind-protect
392 (save-excursion
393 (let (buffer-read-only)
394 (funcall conversion-func (point) (marker-position endmark))))
395 (if visit
396 (progn
397 (set-buffer-auto-saved)
398 (set-buffer-modified-p nil)))))
399 (setcar (cdr return-val) (- (marker-position endmark) (point)))) 410 (setcar (cdr return-val) (- (marker-position endmark) (point))))
400 ;; now finally set the buffer's `buffer-file-coding-system'. 411 ;; now finally set the buffer's `buffer-file-coding-system'.
401 (if (run-special-hook-with-args 'insert-file-contents-post-hook 412 (if (run-special-hook-with-args 'insert-file-contents-post-hook
402 filename visit return-val) 413 filename visit return-val)
403 nil 414 nil
468 (setq coding-system 479 (setq coding-system
469 (or coding-system-for-write 480 (or coding-system-for-write
470 (run-special-hook-with-args 481 (run-special-hook-with-args
471 'write-region-pre-hook start end filename append visit lockname) 482 'write-region-pre-hook start end filename append visit lockname)
472 coding-system 483 coding-system
473 buffer-file-coding-system)) 484 buffer-file-coding-system
485 (find-file-coding-system-for-write-from-filename filename)
486 ))
474 (if (consp coding-system) 487 (if (consp coding-system)
475 coding-system 488 coding-system
476 (let ((func 489 (let ((func
477 (coding-system-property coding-system 'pre-write-conversion))) 490 (coding-system-property coding-system 'pre-write-conversion)))
478 (if func 491 (if func