Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-files.el @ 110:fe104dbd9147 r20-1b7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b7
author cvs
date Mon, 13 Aug 2007 09:19:45 +0200
parents 360340f9fd5f
children 48d667d6f17f
comparison
equal deleted inserted replaced
109:e183fc049578 110:fe104dbd9147
24 ;;; Commentary: 24 ;;; Commentary:
25 25
26 ;;; Derived from mule.el in the original Mule but heavily modified 26 ;;; Derived from mule.el in the original Mule but heavily modified
27 ;;; by Ben Wing. 27 ;;; by Ben Wing.
28 28
29 ;; 1997/3/11 modified by MORIOKA Tomohiko to sync with Emacs/mule API.
30
29 ;;; Code: 31 ;;; Code:
30 32
31 ;;;; #### also think more about `binary' vs. `no-conversion' 33 ;;;; #### also think more about `binary' vs. `no-conversion'
32 34
33 (setq-default file-coding-system 'iso-2022-8) 35 ;; Use `no-conversion' instead of `binary', because Emacs/mule does
34 (put 'file-coding-system 'permanent-local t) 36 ;; not have `binary' coding-system.
37
38 ;; also think more about `internal'.
39
40
41 (setq-default buffer-file-coding-system 'iso-2022-8)
42 (put 'buffer-file-coding-system 'permanent-local t)
35 43
36 (defvar coding-system-for-write nil 44 (defvar coding-system-for-write nil
37 "Overriding coding system used when writing a file. 45 "Overriding coding system used when writing a file.
38 You should *bind* this, not set it. If this is non-nil, it specifies 46 You should *bind* this, not set it. If this is non-nil, it specifies
39 the coding system that will be used when a file is wrote in, and 47 the coding system that will be used when a file is wrote in, and
40 overrides `file-coding-system', `insert-file-contents-pre-hook', 48 overrides `buffer-file-coding-system',
41 etc. Use those variables instead of this one for permanent changes 49 `insert-file-contents-pre-hook', etc. Use those variables instead of
42 to the environment.") 50 this one for permanent changes to the environment.")
43 51
44 (defvar coding-system-for-read nil 52 (defvar coding-system-for-read nil
45 "Overriding coding system used when reading a file. 53 "Overriding coding system used when reading a file.
46 You should *bind* this, not set it. If this is non-nil, it specifies 54 You should *bind* this, not set it. If this is non-nil, it specifies
47 the coding system that will be used when a file is read in, and 55 the coding system that will be used when a file is read in, and
48 overrides `file-coding-system-for-read', `file-coding-system-alist', 56 overrides `buffer-file-coding-system-for-read',
49 etc. Use those variables instead of this one for permanent changes 57 `buffer-file-coding-system-alist', etc. Use those variables instead
50 to the environment.") 58 of this one for permanent changes to the environment.")
51 59
52 (defvar file-coding-system-for-read 'autodetect 60 (defvar buffer-file-coding-system-for-read 'autodetect
53 "Coding system used when reading a file. 61 "Coding system used when reading a file.
54 This provides coarse-grained control; for finer-grained control, 62 This provides coarse-grained control; for finer-grained control,
55 use `file-coding-system-alist'. From a Lisp program, if you wish 63 use `buffer-file-coding-system-alist'. From a Lisp program, if you wish
56 to unilaterally specify the coding system used for one 64 to unilaterally specify the coding system used for one
57 particular operation, you should bind the variable 65 particular operation, you should bind the variable
58 `coding-system-for-read' rather than setting this variable, 66 `coding-system-for-read' rather than setting this variable,
59 which is intended to be used for global environment specification.") 67 which is intended to be used for global environment specification.")
60 68
61 (defvar file-coding-system-alist 69 (defvar buffer-file-coding-system-alist
62 ;; '(; ("\\.el$" . euc-japan)
63 '(("\\.el$" . iso-2022-8) 70 '(("\\.el$" . iso-2022-8)
64 ("\\.info$" . iso-2022-8) 71 ("\\.info$" . iso-2022-8)
65 ("ChangeLog$" . iso-2022-8) 72 ("ChangeLog$" . iso-2022-8)
66 ("\\.texi$" . iso-2022-8) 73 ("\\.texi$" . iso-2022-8)
67 ("\\.\\(gz\\|Z\\)$" . binary) 74 ("\\.\\(gz\\|Z\\)$" . no-conversion)
68 ("/spool/mail/.*$" . convert-mbox-coding-system)) 75 ("/spool/mail/.*$" . convert-mbox-coding-system))
69 "Alist specifying the coding system used for particular files. 76 "Alist specifying the coding system used for particular files.
70 Each element of the alist is a cons of a regexp, specifying the files 77 Each element of the alist is a cons of a regexp, specifying the files
71 to be affected, and a coding system. This overrides the more 78 to be affected, and a coding system. This overrides the more general
72 general specification in `file-coding-system-for-read', but is 79 specification in `buffer-file-coding-system-for-read', but is
73 overridden by `coding-system-for-read'. 80 overridden by `coding-system-for-read'.
74 81
75 Instead of a coding system you may specify a function, and it will be 82 Instead of a coding system you may specify a function, and it will be
76 called after the file has been read in to decode the file. It is 83 called after the file has been read in to decode the file. It is
77 called with four arguments: FILENAME, VISIT, START, and END, the same 84 called with four arguments: FILENAME, VISIT, START, and END, the same
78 as the first four arguments to `insert-file-contents'.") 85 as the first four arguments to `insert-file-contents'.")
79 86
80 (defun set-file-coding-system (coding-system &optional force) 87 (defun set-buffer-file-coding-system (coding-system &optional force)
81 "Set the current `file-coding-system' to CODING-SYSTEM. 88 "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM.
82 If optional argument FORCE (interactively, the prefix argument) is not 89 If optional argument FORCE (interactively, the prefix argument) is not
83 given, attempt to match the EOL type of the new coding system to 90 given, attempt to match the EOL type of the new coding system to
84 the current value of `file-coding-system'." 91 the current value of `buffer-file-coding-system'."
85 (interactive "zFile coding system: \nP") 92 (interactive "zFile coding system: \nP")
86 (get-coding-system coding-system) ;; correctness check 93 (get-coding-system coding-system) ;; correctness check
87 (if (not force) 94 (if (not force)
88 (setq coding-system 95 (setq coding-system
89 (subsidiary-coding-system coding-system (coding-system-eol-type 96 (subsidiary-coding-system
90 file-coding-system)))) 97 coding-system
91 (setq file-coding-system coding-system) 98 (coding-system-eol-type buffer-file-coding-system))))
99 (setq buffer-file-coding-system coding-system)
92 (redraw-modeline t)) 100 (redraw-modeline t))
93 101
94 (defun set-file-coding-system-for-read (coding-system) 102 (defun set-buffer-file-coding-system-for-read (coding-system)
95 "Set the coding system used when reading in a file. 103 "Set the coding system used when reading in a file.
96 This is equivalent to setting the variable `file-coding-system-for-read'. 104 This is equivalent to setting the variable
97 You can also use `file-coding-system-alist' to specify the coding system 105 `buffer-file-coding-system-for-read'. You can also use
98 for particular files." 106 `buffer-file-coding-system-alist' to specify the coding system for
107 particular files."
99 (interactive "zFile coding system for read: ") 108 (interactive "zFile coding system for read: ")
100 (get-coding-system coding-system) ;; correctness check 109 (get-coding-system coding-system) ;; correctness check
101 (setq file-coding-system-for-read coding-system)) 110 (setq buffer-file-coding-system-for-read coding-system))
102 111
103 (defun set-default-file-coding-system (coding-system) 112 (defun set-default-buffer-file-coding-system (coding-system)
104 "Set the default value of `file-coding-system' to CODING-SYSTEM. 113 "Set the default value of `buffer-file-coding-system' to CODING-SYSTEM.
105 The default value is used both for buffers without associated files 114 The default value is used both for buffers without associated files
106 and for files with no apparent coding system (i.e. primarily ASCII). 115 and for files with no apparent coding system (i.e. primarily ASCII).
107 See `file-coding-system' for more information." 116 See `buffer-file-coding-system' for more information."
108 (interactive "zDefault file coding system: ") 117 (interactive "zDefault file coding system: ")
109 (setq-default file-coding-system coding-system) 118 (setq-default buffer-file-coding-system coding-system)
110 (redraw-modeline t)) 119 (redraw-modeline t))
111 120
112 (defun find-file-coding-system-from-filename (filename) 121 (defun find-buffer-file-coding-system-from-filename (filename)
113 "Look up a file in `file-coding-system-alist'. 122 "Look up a file in `buffer-file-coding-system-alist'.
114 The return value will be nil (no applicable entry), a coding system object 123 The return value will be nil (no applicable entry), a coding system
115 \(the entry specified a coding system), or something else (the entry 124 object (the entry specified a coding system), or something else (the
116 specified a function to be called)." 125 entry specified a function to be called)."
117 (let ((alist file-coding-system-alist) 126 (let ((alist buffer-file-coding-system-alist)
118 (found nil) 127 (found nil)
119 (codesys nil)) 128 (codesys nil))
120 (let ((case-fold-search (eq system-type 'vax-vms))) 129 (let ((case-fold-search (eq system-type 'vax-vms)))
121 (setq filename (file-name-sans-versions filename)) 130 (setq filename (file-name-sans-versions filename))
122 (while (and (not found) alist) 131 (while (and (not found) alist)
192 (signal 'file-error (list "Cannot open load file" filename))) 201 (signal 'file-error (list "Cannot open load file" filename)))
193 (let (__codesys__) 202 (let (__codesys__)
194 (save-excursion 203 (save-excursion
195 (set-buffer (get-buffer-create " *load*")) 204 (set-buffer (get-buffer-create " *load*"))
196 (erase-buffer) 205 (erase-buffer)
197 (let ((file-coding-system-for-read 'no-conversion)) 206 (let ((buffer-file-coding-system-for-read 'no-conversion))
198 (insert-file-contents path nil 1 3001)) 207 (insert-file-contents path nil 1 3001))
199 (setq __codesys__ (find-coding-system-magic-cookie))) 208 (setq __codesys__ (find-coding-system-magic-cookie)))
200 ;; use string= instead of string-match to keep match-data. 209 ;; use string= instead of string-match to keep match-data.
201 (if (string= ".elc" (downcase (substring path -4))) 210 (if (string= ".elc" (downcase (substring path -4)))
202 ;; if reading a byte-compiled file and we didn't find 211 ;; if reading a byte-compiled file and we didn't find
203 ;; a coding-system magic cookie, then use `binary'. 212 ;; a coding-system magic cookie, then use `no-conversion'.
204 ;; We need to guarantee that we never do autodetection 213 ;; We need to guarantee that we never do autodetection
205 ;; on byte-compiled files because confusion here would 214 ;; on byte-compiled files because confusion here would
206 ;; be a very bad thing. Pre-existing byte-compiled 215 ;; be a very bad thing. Pre-existing byte-compiled
207 ;; files are always in the `no-conversion' system. 216 ;; files are always in the `no-conversion' system.
208 ;; Also, byte-compiled files always use `lf' to terminate 217 ;; Also, byte-compiled files always use `lf' to terminate
209 ;; a line; don't risk confusion here either. 218 ;; a line; don't risk confusion here either.
210 (if (not __codesys__) 219 (if (not __codesys__)
211 (setq __codesys__ 'binary)) 220 (setq __codesys__ 'no-conversion))
212 ;; otherwise use `file-coding-system-for-read', as normal 221 ;; otherwise use `buffer-file-coding-system-for-read', as normal
213 ;; #### need to do some looking up in file-coding-system-alist! 222 ;; #### need to do some looking up in
223 ;; #### buffer-file-coding-system-alist!
214 (if (not __codesys__) 224 (if (not __codesys__)
215 (setq __codesys__ file-coding-system-for-read))) 225 (setq __codesys__ buffer-file-coding-system-for-read)))
216 ;; now use the internal load to actually load the file. 226 ;; now use the internal load to actually load the file.
217 (load-internal file noerror nomessage nosuffix __codesys__)))))) 227 (load-internal file noerror nomessage nosuffix __codesys__))))))
218 228
219 (defvar insert-file-contents-access-hook nil 229 (defvar insert-file-contents-access-hook nil
220 "A hook to make a file accessible before reading it. 230 "A hook to make a file accessible before reading it.
223 corresponding arguments in the call to `insert-file-contents'.") 233 corresponding arguments in the call to `insert-file-contents'.")
224 234
225 (defvar insert-file-contents-pre-hook nil 235 (defvar insert-file-contents-pre-hook nil
226 "A special hook to decide the coding system used for reading in a file. 236 "A special hook to decide the coding system used for reading in a file.
227 237
228 Before reading a file, `insert-file-contents' calls the functions 238 Before reading a file, `insert-file-contents' calls the functions on
229 on this hook with arguments FILENAME and VISIT, the same as the 239 this hook with arguments FILENAME and VISIT, the same as the
230 corresponding arguments in the call to `insert-file-contents'. In 240 corresponding arguments in the call to `insert-file-contents'. In
231 these functions, you may refer to the global variable 241 these functions, you may refer to the global variable
232 `file-coding-system-for-read'. 242 `buffer-file-coding-system-for-read'.
233 243
234 The return value of the functions should be either 244 The return value of the functions should be either
235 245
236 -- nil 246 -- nil
237 -- A coding system or a symbol denoting it, indicating the coding system 247 -- A coding system or a symbol denoting it, indicating the coding system
242 the file for itself and suppresses further reading. 252 the file for itself and suppresses further reading.
243 253
244 If any function returns non-nil, the remaining functions are not called.") 254 If any function returns non-nil, the remaining functions are not called.")
245 255
246 (defvar insert-file-contents-error-hook nil 256 (defvar insert-file-contents-error-hook nil
247 "A hook to set `file-coding-system' when a read error has occurred. 257 "A hook to set `buffer-file-coding-system' when a read error has occurred.
248 258
249 When a file error (e.g. nonexistent file) occurs while read a file, 259 When a file error (e.g. nonexistent file) occurs while read a file,
250 `insert-file-contents' calls the functions on this hook with three 260 `insert-file-contents' calls the functions on this hook with three
251 arguments: FILENAME and VISIT (the same as the corresponding arguments 261 arguments: FILENAME and VISIT (the same as the corresponding arguments
252 in the call to `insert-file-contents') and a cons (SIGNALED-CONDITIONS 262 in the call to `insert-file-contents') and a cons (SIGNALED-CONDITIONS
254 264
255 After calling this hook, the error is signalled for real and 265 After calling this hook, the error is signalled for real and
256 propagates to the caller of `insert-file-contents'.") 266 propagates to the caller of `insert-file-contents'.")
257 267
258 (defvar insert-file-contents-post-hook nil 268 (defvar insert-file-contents-post-hook nil
259 "A hook to set `file-coding-system' for the current buffer. 269 "A hook to set `buffer-file-coding-system' for the current buffer.
260 270
261 After successful reading, `insert-file-contents' calls the functions 271 After successful reading, `insert-file-contents' calls the functions
262 on this hook with four arguments: FILENAME and VISIT (the same as the 272 on this hook with four arguments: FILENAME and VISIT (the same as the
263 corresponding arguments in the call to `insert-file-contents'), 273 corresponding arguments in the call to `insert-file-contents'),
264 CODING-SYSTEM (the actual coding system used to decode the file), and 274 CODING-SYSTEM (the actual coding system used to decode the file), and
287 297
288 The coding system used for decoding the file is determined as follows: 298 The coding system used for decoding the file is determined as follows:
289 299
290 1. `coding-system-for-read', if non-nil. 300 1. `coding-system-for-read', if non-nil.
291 2. The result of `insert-file-contents-pre-hook', if non-nil. 301 2. The result of `insert-file-contents-pre-hook', if non-nil.
292 3. The matching value for this filename from `file-coding-system-alist', 302 3. The matching value for this filename from
293 if any. 303 `buffer-file-coding-system-alist', if any.
294 4. `file-coding-system-for-read', if non-nil. 304 4. `buffer-file-coding-system-for-read', if non-nil.
295 5. The coding system 'no-conversion. 305 5. The coding system 'no-conversion.
296 306
297 If a local value for `file-coding-system' in the current buffer does 307 If a local value for `buffer-file-coding-system' in the current buffer
298 not exist, it is set to the coding system which was actually used for 308 does not exist, it is set to the coding system which was actually used
299 reading. 309 for reading.
300 310
301 See also `insert-file-contents-access-hook', `insert-file-contents-pre-hook', 311 See also `insert-file-contents-access-hook',
302 `insert-file-contents-error-hook', and `insert-file-contents-post-hook'." 312 `insert-file-contents-pre-hook', `insert-file-contents-error-hook',
313 and `insert-file-contents-post-hook'."
303 (let (return-val coding-system used-codesys conversion-func) 314 (let (return-val coding-system used-codesys conversion-func)
304 ;; OK, first load the file. 315 ;; OK, first load the file.
305 (condition-case err 316 (condition-case err
306 (progn 317 (progn
307 (run-hook-with-args 'insert-file-contents-access-hook 318 (run-hook-with-args 'insert-file-contents-access-hook
313 coding-system-for-read 324 coding-system-for-read
314 ;; #2. 325 ;; #2.
315 (run-special-hook-with-args 'insert-file-contents-pre-hook 326 (run-special-hook-with-args 'insert-file-contents-pre-hook
316 filename visit) 327 filename visit)
317 ;; #3. 328 ;; #3.
318 (let ((retval (find-file-coding-system-from-filename 329 (let ((retval (find-buffer-file-coding-system-from-filename
319 filename))) 330 filename)))
320 (if (or (null retval) (coding-system-p retval)) 331 (if (or (null retval) (coding-system-p retval))
321 retval 332 retval
322 (setq conversion-func retval) 333 (setq conversion-func retval)
323 'no-conversion)) 334 'no-conversion))
324 ;; #4. 335 ;; #4.
325 file-coding-system-for-read 336 buffer-file-coding-system-for-read
326 ;; #5. 337 ;; #5.
327 'no-conversion)) 338 'no-conversion))
328 (if (consp coding-system) 339 (if (consp coding-system)
329 (setq return-val coding-system) 340 (setq return-val coding-system)
330 (if (null (find-coding-system coding-system)) 341 (if (null (find-coding-system coding-system))
358 (progn 369 (progn
359 (set-buffer-auto-saved) 370 (set-buffer-auto-saved)
360 (set-buffer-modified-p nil))))) 371 (set-buffer-modified-p nil)))))
361 (setcar (cdr return-val) (- (marker-position endmark) (point))) 372 (setcar (cdr return-val) (- (marker-position endmark) (point)))
362 ;; also call any post-conversion function called for by 373 ;; also call any post-conversion function called for by
363 ;; `file-coding-system-alist' 374 ;; `buffer-file-coding-system-alist'
364 (if conversion-func 375 (if conversion-func
365 (unwind-protect 376 (unwind-protect
366 (save-excursion 377 (save-excursion
367 (let (buffer-read-only) 378 (let (buffer-read-only)
368 (funcall conversion-func (point) (marker-position endmark)))) 379 (funcall conversion-func (point) (marker-position endmark))))
369 (if visit 380 (if visit
370 (progn 381 (progn
371 (set-buffer-auto-saved) 382 (set-buffer-auto-saved)
372 (set-buffer-modified-p nil))))) 383 (set-buffer-modified-p nil)))))
373 (setcar (cdr return-val) (- (marker-position endmark) (point)))) 384 (setcar (cdr return-val) (- (marker-position endmark) (point))))
374 ;; now finally set the buffer's `file-coding-system'. 385 ;; now finally set the buffer's `buffer-file-coding-system'.
375 (if (run-special-hook-with-args 'insert-file-contents-post-hook 386 (if (run-special-hook-with-args 'insert-file-contents-post-hook
376 filename visit return-val) 387 filename visit return-val)
377 nil 388 nil
378 (if (local-variable-p 'file-coding-system (current-buffer)) 389 (if (local-variable-p 'buffer-file-coding-system (current-buffer))
379 ;; if file-coding-system is already local, just 390 ;; if buffer-file-coding-system is already local, just
380 ;; set its eol type to what was found, if it wasn't 391 ;; set its eol type to what was found, if it wasn't
381 ;; set already. 392 ;; set already.
382 (set-file-coding-system 393 (set-buffer-file-coding-system
383 (subsidiary-coding-system file-coding-system 394 (subsidiary-coding-system buffer-file-coding-system
384 (coding-system-eol-type coding-system))) 395 (coding-system-eol-type coding-system)))
385 ;; otherwise actually set file-coding-system. 396 ;; otherwise actually set buffer-file-coding-system.
386 (set-file-coding-system coding-system))) 397 (set-buffer-file-coding-system coding-system)))
387 return-val)) 398 return-val))
388 399
389 (defvar write-region-pre-hook nil 400 (defvar write-region-pre-hook nil
390 "A special hook to decide the coding system used for writing out a file. 401 "A special hook to decide the coding system used for writing out a file.
391 402
431 use for locking and unlocking, overriding FILENAME and VISIT. 442 use for locking and unlocking, overriding FILENAME and VISIT.
432 Kludgy feature: if START is a string, then that string is written 443 Kludgy feature: if START is a string, then that string is written
433 to the file, instead of any buffer contents, and END is ignored. 444 to the file, instead of any buffer contents, and END is ignored.
434 Optional seventh argument CODING-SYSTEM specifies the coding system 445 Optional seventh argument CODING-SYSTEM specifies the coding system
435 used to encode the text when it is written out, and defaults to 446 used to encode the text when it is written out, and defaults to
436 the value of `file-coding-system' in the current buffer. 447 the value of `buffer-file-coding-system' in the current buffer.
437 Interactively, with a prefix arg, you will be prompted for the 448 Interactively, with a prefix arg, you will be prompted for the
438 coding system. 449 coding system.
439 See also `write-region-pre-hook' and `write-region-post-hook'." 450 See also `write-region-pre-hook' and `write-region-post-hook'."
440 (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ") 451 (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ")
441 (setq coding-system 452 (setq coding-system
442 (or coding-system-for-write 453 (or coding-system-for-write
443 (run-special-hook-with-args 454 (run-special-hook-with-args
444 'write-region-pre-hook start end filename append visit lockname) 455 'write-region-pre-hook start end filename append visit lockname)
445 coding-system 456 coding-system
446 file-coding-system)) 457 buffer-file-coding-system))
447 (if (consp coding-system) 458 (if (consp coding-system)
448 coding-system 459 coding-system
449 (let ((func 460 (let ((func
450 (coding-system-property coding-system 'pre-write-conversion))) 461 (coding-system-property coding-system 'pre-write-conversion)))
451 (if func 462 (if func