1 ;;; code-files.el --- File I/O functions for XEmacs.
3 ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Amdahl Corporation.
5 ;; Copyright (C) 1995 Sun Microsystems.
7 ;; This file is part of XEmacs.
9 ;; This file is very similar to mule-files.el
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; 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.
28 ;;; Derived from mule.el in the original Mule but heavily modified
31 ;; 1997/3/11 modified by MORIOKA Tomohiko to sync with Emacs 20 API.
35 (setq-default buffer-file-coding-system 'no-conversion)
36 (put 'buffer-file-coding-system 'permanent-local t)
38 (define-obsolete-variable-alias
40 'buffer-file-coding-system)
42 (define-obsolete-variable-alias
43 'overriding-file-coding-system
44 'coding-system-for-read)
46 (defvar buffer-file-coding-system-for-read 'undecided
47 "Coding system used when reading a file.
48 This provides coarse-grained control; for finer-grained control, use
49 `file-coding-system-alist'. From a Lisp program, if you wish to
50 unilaterally specify the coding system used for one particular
51 operation, you should bind the variable `coding-system-for-read'
52 rather than setting this variable, which is intended to be used for
53 global environment specification.")
55 (define-obsolete-variable-alias
56 'file-coding-system-for-read
57 'buffer-file-coding-system-for-read)
59 (defvar file-coding-system-alist
60 '(("\\.elc$" . (binary . binary))
61 ;; This must not be neccessary, slb suggests -kkm
62 ;; ("loaddefs.el$" . (binary . binary))
63 ("\\.tar$" . (binary . binary))
64 ("\\.\\(tif\\|tiff\\)$" . (binary . binary))
65 ("\\.png$" . (binary . binary))
66 ("\\.gif$" . (binary . binary))
67 ("\\.\\(jpeg\\|jpg\\)$" . (binary . binary))
68 ("TUTORIAL\\.hr$" . iso-8859-2)
69 ("TUTORIAL\\.pl$" . iso-8859-2)
70 ("TUTORIAL\\.ro$" . iso-8859-2)
71 ;; ("\\.\\(el\\|emacs\\|info\\(-[0-9]+\\)?\\|texi\\)$" . iso-2022-8)
72 ;; ("\\(ChangeLog\\|CHANGES-beta\\)$" . iso-2022-8)
73 ("\\.\\(gz\\|Z\\)$" . binary)
74 ("/spool/mail/.*$" . convert-mbox-coding-system))
75 "Alist to decide a coding system to use for a file I/O operation.
76 The format is ((PATTERN . VAL) ...),
77 where PATTERN is a regular expression matching a file name,
78 VAL is a coding system, a cons of coding systems, or a function symbol.
79 If VAL is a coding system, it is used for both decoding and encoding
81 If VAL is a cons of coding systems, the car part is used for decoding,
82 and the cdr part is used for encoding.
83 If VAL is a function symbol, the function must return a coding system
84 or a cons of coding systems which are used as above.
86 This overrides the more general specification in
87 `buffer-file-coding-system-for-read', but is overridden by
88 `coding-system-for-read'.")
90 (defun set-buffer-file-coding-system (coding-system &optional force)
91 "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM.
92 If optional argument FORCE (interactively, the prefix argument) is not
93 given, attempt to match the EOL type of the new coding system to
94 the current value of `buffer-file-coding-system'."
95 (interactive "zFile coding system: \nP")
96 (get-coding-system coding-system) ;; correctness check
99 (subsidiary-coding-system
101 (coding-system-eol-type buffer-file-coding-system))))
102 (setq buffer-file-coding-system coding-system)
105 (defun toggle-buffer-file-coding-system ()
106 "Set EOL type of buffer-file-coding-system of the current buffer to
107 something other than what it is at the moment."
110 (coding-system-eol-type buffer-file-coding-system)))
111 (setq buffer-file-coding-system
112 (subsidiary-coding-system
113 (coding-system-base buffer-file-coding-system)
114 (cond ((eq eol-type 'lf) 'crlf)
115 ((eq eol-type 'crlf) 'lf)
116 ((eq eol-type 'cr) 'lf))))))
118 (define-obsolete-function-alias
119 'set-file-coding-system
120 'set-buffer-file-coding-system)
122 (defun set-buffer-file-coding-system-for-read (coding-system)
123 "Set the coding system used when reading in a file.
124 This is equivalent to setting the variable
125 `buffer-file-coding-system-for-read'. You can also use
126 `file-coding-system-alist' to specify the coding system for
128 (interactive "zFile coding system for read: ")
129 (get-coding-system coding-system) ;; correctness check
130 (setq buffer-file-coding-system-for-read coding-system))
132 (define-obsolete-function-alias
133 'set-file-coding-system-for-read
134 'set-buffer-file-coding-system-for-read)
136 (defun set-default-buffer-file-coding-system (coding-system)
137 "Set the default value of `buffer-file-coding-system' to CODING-SYSTEM.
138 The default value is used both for buffers without associated files
139 and for files with no apparent coding system (i.e. primarily ASCII).
140 See `buffer-file-coding-system' for more information."
141 (interactive "zDefault file coding system: ")
142 (setq-default buffer-file-coding-system coding-system)
145 (define-obsolete-function-alias
146 'set-default-file-coding-system
147 'set-default-buffer-file-coding-system)
149 (defun find-file-coding-system-for-read-from-filename (filename)
150 "Look up coding system to read a file in `file-coding-system-alist'.
151 The return value will be nil (no applicable entry) or a coding system
152 object (the entry specified a coding system)."
153 (let ((alist file-coding-system-alist)
156 (let ((case-fold-search (eq system-type 'vax-vms)))
157 (setq filename (file-name-sans-versions filename))
158 (while (and (not found) alist)
159 (if (string-match (car (car alist)) filename)
160 (setq codesys (cdr (car alist))
162 (setq alist (cdr alist))))
164 (if (functionp codesys)
165 (setq codesys (funcall codesys 'insert-file-contents filename))
167 (cond ((consp codesys) (find-coding-system (car codesys)))
168 ((find-coding-system codesys))
171 (define-obsolete-function-alias
172 'find-file-coding-system-from-filename
173 'find-file-coding-system-for-read-from-filename)
175 (defun find-file-coding-system-for-write-from-filename (filename)
176 "Look up coding system to write a file in `file-coding-system-alist'.
177 The return value will be nil (no applicable entry) or a coding system
178 object (the entry specified a coding system)."
179 (let ((alist file-coding-system-alist)
182 (let ((case-fold-search (eq system-type 'vax-vms)))
183 (setq filename (file-name-sans-versions filename))
184 (while (and (not found) alist)
185 (if (string-match (car (car alist)) filename)
186 (setq codesys (cdr (car alist))
188 (setq alist (cdr alist))))
190 (if (functionp codesys)
191 (setq codesys (funcall codesys 'write-region filename))
193 (cond ((consp codesys) (find-coding-system (cdr codesys)))
194 ((find-coding-system codesys))
197 (defun convert-mbox-coding-system (filename visit start end)
198 "Decoding function for Unix mailboxes.
199 Does separate detection and decoding on each message, since each
200 message might be in a different encoding."
201 (let ((buffer-read-only nil))
203 (narrow-to-region start end)
204 (goto-char (point-min))
206 (let ((start (point))
209 (if (re-search-forward "^From" nil 'move)
212 (decode-coding-region start end 'undecided))))))
214 (defun find-coding-system-magic-cookie ()
215 "Look for the coding-system magic cookie in the current buffer.\n"
216 "The coding-system magic cookie is the exact string\n"
217 "\";;;###coding system: \" followed by a valid coding system symbol,\n"
218 "somewhere within the first 3000 characters of the file. If found,\n"
219 "the coding system symbol is returned; otherwise nil is returned.\n"
220 "Note that it is extremely unlikely that such a string would occur\n"
221 "coincidentally as the result of encoding some characters in a non-ASCII\n"
222 "charset, and that the spaces make it even less likely since the space\n"
223 "character is not a valid octet in any ISO 2022 encoding of most non-ASCII\n"
226 (goto-char (point-min))
228 "^[^\n]*-\\*-[^\n]*coding: \\([^ \t\n;]+\\)[^\n]*-\\*-")
229 (let ((codesys (intern (buffer-substring
230 (match-beginning 1)(match-end 1)))))
231 (if (find-coding-system codesys) codesys)))
234 ;; (and (re-search-forward "^;+[ \t]*Local Variables:" nil t)
235 ;; (setq start (match-end 0))
236 ;; (re-search-forward "\n;+[ \t]*End:")
237 ;; (setq end (match-beginning 0))
239 ;; (narrow-to-region start end)
241 ;; (re-search-forward "^;;; coding: \\([^\n]+\\)$" nil t)
244 ;; (intern (buffer-substring
245 ;; (match-beginning 1)(match-end 1)))))
246 ;; (if (find-coding-system codesys) codesys))
248 (let ((case-fold-search nil))
250 ";;;###coding system: " (+ (point-min) 3000) t)
251 (let ((start (point))
253 (skip-chars-forward "^ \t\n\r")
256 (let ((codesys (intern (buffer-substring start end))))
257 (if (find-coding-system codesys) codesys)))
261 (defun load (file &optional noerror nomessage nosuffix)
262 "Execute a file of Lisp code named FILE.
263 First tries FILE with .elc appended, then tries with .el,
264 then tries FILE unmodified. Searches directories in load-path.
265 If optional second arg NOERROR is non-nil,
266 report no error if FILE doesn't exist.
267 Print messages at start and end of loading unless
268 optional third arg NOMESSAGE is non-nil.
269 If optional fourth arg NOSUFFIX is non-nil, don't try adding
270 suffixes .elc or .el to the specified name FILE.
271 Return t if file exists."
272 (let* ((filename (substitute-in-file-name file))
273 (handler (find-file-name-handler filename 'load))
276 (funcall handler 'load filename noerror nomessage nosuffix)
277 (if (or (<= (length filename) 0)
279 (locate-file filename load-path
280 (and (not nosuffix) ".elc:.el:")))))
282 (signal 'file-error (list "Cannot open load file" filename)))
283 ;; now use the internal load to actually load the file.
285 file noerror nomessage nosuffix
286 (let ((elc ; use string= instead of string-match to keep match-data.
287 (string= ".elc" (downcase (substring path -4)))))
288 (or (and (not elc) coding-system-for-read) ; prefer for source file
291 (set-buffer (get-buffer-create " *load*"))
293 (let ((coding-system-for-read 'no-conversion))
294 (insert-file-contents path nil 1 3001))
295 (find-coding-system-magic-cookie))
297 ;; if reading a byte-compiled file and we didn't find
298 ;; a coding-system magic cookie, then use `binary'.
299 ;; We need to guarantee that we never do autodetection
300 ;; on byte-compiled files because confusion here would
301 ;; be a very bad thing. Pre-existing byte-compiled
302 ;; files are always in the `binary' coding system.
303 ;; Also, byte-compiled files always use `lf' to terminate
304 ;; a line; don't risk confusion here either.
306 (or (find-file-coding-system-for-read-from-filename path)
307 ;; looking up in `file-coding-system-alist'.
308 ;; otherwise use `buffer-file-coding-system-for-read',
310 buffer-file-coding-system-for-read)
314 (defvar insert-file-contents-access-hook nil
315 "A hook to make a file accessible before reading it.
316 `insert-file-contents' calls this hook before doing anything else.
317 Called with two arguments: FILENAME and VISIT, the same as the
318 corresponding arguments in the call to `insert-file-contents'.")
320 (defvar insert-file-contents-pre-hook nil
321 "A special hook to decide the coding system used for reading in a file.
323 Before reading a file, `insert-file-contents' calls the functions on
324 this hook with arguments FILENAME and VISIT, the same as the
325 corresponding arguments in the call to `insert-file-contents'. In
326 these functions, you may refer to the global variable
327 `buffer-file-coding-system-for-read'.
329 The return value of the functions should be either
332 -- A coding system or a symbol denoting it, indicating the coding system
333 to be used for reading the file
334 -- A list of two elements (absolute pathname and length of data inserted),
335 which is used as the return value to `insert-file-contents'. In this
336 case, `insert-file-contents' assumes that the function has inserted
337 the file for itself and suppresses further reading.
339 If any function returns non-nil, the remaining functions are not called.")
341 (defvar insert-file-contents-error-hook nil
342 "A hook to set `buffer-file-coding-system' when a read error has occurred.
344 When a file error (e.g. nonexistent file) occurs while read a file,
345 `insert-file-contents' calls the functions on this hook with three
346 arguments: FILENAME and VISIT (the same as the corresponding arguments
347 in the call to `insert-file-contents') and a cons (SIGNALED-CONDITIONS
350 After calling this hook, the error is signalled for real and
351 propagates to the caller of `insert-file-contents'.")
353 (defvar insert-file-contents-post-hook nil
354 "A hook to set `buffer-file-coding-system' for the current buffer.
356 After successful reading, `insert-file-contents' calls the functions
357 on this hook with four arguments: FILENAME and VISIT (the same as the
358 corresponding arguments in the call to `insert-file-contents'),
359 CODING-SYSTEM (the actual coding system used to decode the file), and
360 a cons of absolute pathname and length of data inserted (the same
361 thing as will be returned from `insert-file-contents').")
363 (defun insert-file-contents (filename &optional visit beg end replace)
364 "Insert contents of file FILENAME after point.
365 Returns list of absolute file name and length of data inserted.
366 If second argument VISIT is non-nil, the buffer's visited filename
367 and last save file modtime are set, and it is marked unmodified.
368 If visiting and the file does not exist, visiting is completed
369 before the error is signaled.
371 The optional third and fourth arguments BEG and END
372 specify what portion of the file to insert.
373 If VISIT is non-nil, BEG and END must be nil.
374 If optional fifth argument REPLACE is non-nil,
375 it means replace the current buffer contents (in the accessible portion)
376 with the file contents. This is better than simply deleting and inserting
377 the whole thing because (1) it preserves some marker positions
378 and (2) it puts less data in the undo list.
380 NOTE: When Mule support is enabled, the REPLACE argument is
383 The coding system used for decoding the file is determined as follows:
385 1. `coding-system-for-read', if non-nil.
386 2. The result of `insert-file-contents-pre-hook', if non-nil.
387 3. The matching value for this filename from
388 `file-coding-system-alist', if any.
389 4. `buffer-file-coding-system-for-read', if non-nil.
390 5. The coding system 'no-conversion.
392 If a local value for `buffer-file-coding-system' in the current buffer
393 does not exist, it is set to the coding system which was actually used
396 See also `insert-file-contents-access-hook',
397 `insert-file-contents-pre-hook', `insert-file-contents-error-hook',
398 and `insert-file-contents-post-hook'."
399 (let (return-val coding-system used-codesys conversion-func)
400 ;; OK, first load the file.
403 (run-hook-with-args 'insert-file-contents-access-hook
405 ;; determine the coding system to use, as described above.
409 coding-system-for-read
411 (run-hook-with-args-until-success
412 'insert-file-contents-pre-hook
415 (find-file-coding-system-for-read-from-filename filename)
417 buffer-file-coding-system-for-read
420 (if (consp coding-system)
421 (setq return-val coding-system)
422 (if (null (find-coding-system coding-system))
425 "Invalid coding-system (%s), using 'undecided"
427 (setq coding-system 'undecided)))
429 (insert-file-contents-internal filename visit beg end
430 replace coding-system
435 (run-hook-with-args 'insert-file-contents-error-hook
437 (signal (car err) (cdr err))))
438 (setq coding-system used-codesys)
439 ;; call any `post-read-conversion' for the coding system that
442 (coding-system-property coding-system 'post-read-conversion))
443 (endmark (make-marker)))
444 (set-marker endmark (+ (point) (nth 1 return-val)))
448 (let (buffer-read-only)
449 (funcall func (point) (marker-position endmark))))
452 (set-buffer-auto-saved)
453 (set-buffer-modified-p nil)))))
454 (setcar (cdr return-val) (- (marker-position endmark) (point))))
455 ;; now finally set the buffer's `buffer-file-coding-system'.
456 (if (run-hook-with-args-until-success 'insert-file-contents-post-hook
457 filename visit return-val)
459 (if (local-variable-p 'buffer-file-coding-system (current-buffer))
460 ;; if buffer-file-coding-system is already local, just
461 ;; set its eol type to what was found, if it wasn't
463 (set-buffer-file-coding-system
464 (subsidiary-coding-system buffer-file-coding-system
465 (coding-system-eol-type coding-system)))
466 ;; otherwise actually set buffer-file-coding-system.
467 (set-buffer-file-coding-system coding-system)))
470 (defvar write-region-pre-hook nil
471 "A special hook to decide the coding system used for writing out a file.
473 Before writing a file, `write-region' calls the functions on this hook
474 with arguments START, END, FILENAME, APPEND, VISIT, and CODING-SYSTEM,
475 the same as the corresponding arguments in the call to
478 The return value of the functions should be either
481 -- A coding system or a symbol denoting it, indicating the coding system
482 to be used for reading the file
483 -- A list of two elements (absolute pathname and length of data written),
484 which is used as the return value to `write-region'. In this
485 case, `write-region' assumes that the function has written
486 the file for itself and suppresses further writing.
488 If any function returns non-nil, the remaining functions are not called.")
490 (defvar write-region-post-hook nil
491 "A hook called by `write-region' after a file has been written out.
493 The functions on this hook are called with arguments START, END,
494 FILENAME, APPEND, VISIT, and CODING-SYSTEM, the same as the
495 corresponding arguments in the call to `write-region'.")
497 (defun write-region (start end filename &optional append visit lockname coding-system)
498 "Write current region into specified file.
499 By default the file's existing contents are replaced by the specified region.
500 When called from a program, takes three arguments:
501 START, END and FILENAME. START and END are buffer positions.
502 Optional fourth argument APPEND if non-nil means
503 append to existing file contents (if any).
504 Optional fifth argument VISIT if t means
505 set last-save-file-modtime of buffer to this file's modtime
506 and mark buffer not modified.
507 If VISIT is a string, it is a second file name;
508 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
509 VISIT is also the file name to lock and unlock for clash detection.
510 If VISIT is neither t nor nil nor a string,
511 that means do not print the \"Wrote file\" message.
512 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
513 use for locking and unlocking, overriding FILENAME and VISIT.
514 Kludgy feature: if START is a string, then that string is written
515 to the file, instead of any buffer contents, and END is ignored.
516 Optional seventh argument CODING-SYSTEM specifies the coding system
517 used to encode the text when it is written out, and defaults to
518 the value of `buffer-file-coding-system' in the current buffer.
519 Interactively, with a prefix arg, you will be prompted for the
521 See also `write-region-pre-hook' and `write-region-post-hook'."
522 (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ")
524 (or coding-system-for-write
525 (run-hook-with-args-until-success
526 'write-region-pre-hook start end filename append visit lockname)
528 buffer-file-coding-system
529 (find-file-coding-system-for-write-from-filename filename)
531 (if (consp coding-system)
534 (coding-system-property coding-system 'pre-write-conversion)))
536 (let ((curbuf (current-buffer))
537 (tempbuf (generate-new-buffer " *temp-write-buffer*"))
538 (modif (buffer-modified-p)))
543 (insert-buffer-substring curbuf start end)
544 (funcall func (point-min) (point-max))
545 (write-region-internal (point-min) (point-max) filename
547 (if (eq visit t) nil visit)
550 ;; leaving a buffer associated with file will cause problems
551 ;; when next visiting.
552 (kill-buffer tempbuf)
553 (if (or visit (null modif))
555 (set-buffer-auto-saved)
556 (set-buffer-modified-p nil)
557 (if (buffer-file-name) (set-visited-file-modtime))))))
558 (write-region-internal start end filename append visit lockname
560 (run-hook-with-args 'write-region-post-hook
561 start end filename append visit lockname
564 ;;; mule-files.el ends here