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 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; XEmacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
24 ;;; Synched up with: Not synched.
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.
33 ;; This file was derived from the former mule-files.el which has been removed
34 ;; as of XEmacs 21.2.15.
38 (setq-default buffer-file-coding-system 'raw-text)
39 (put 'buffer-file-coding-system 'permanent-local t)
41 (define-obsolete-variable-alias
43 'buffer-file-coding-system)
45 (define-obsolete-variable-alias
46 'overriding-file-coding-system
47 'coding-system-for-read)
49 (defvar buffer-file-coding-system-for-read 'undecided
50 "Coding system used when reading a file.
51 This provides coarse-grained control; for finer-grained control, use
52 `file-coding-system-alist'. From a Lisp program, if you wish to
53 unilaterally specify the coding system used for one particular
54 operation, you should bind the variable `coding-system-for-read'
55 rather than setting this variable, which is intended to be used for
56 global environment specification.")
58 (define-obsolete-variable-alias
59 'file-coding-system-for-read
60 'buffer-file-coding-system-for-read)
62 (defvar file-coding-system-alist
64 ;; This must not be necessary, slb suggests -kkm
65 ;; ("loaddefs.el$" . (binary . binary))
67 #'(lambda (regexp) (cons regexp 'binary)) binary-file-regexps)
68 ("TUTORIAL\\.\\(?:hr\\|pl\\|ro\\)\\'" . iso-8859-2)
69 ;; ("\\.\\(el\\|emacs\\|info\\(-[0-9]+\\)?\\|texi\\)$" . iso-2022-8)
70 ;; ("\\(ChangeLog\\|CHANGES-beta\\)$" . iso-2022-8)
72 ;; This idea is totally broken, and the code didn't work anyway.
73 ;; Mailboxes should be decoded by mail clients, who actually know
74 ;; how to deal with them. Otherwise, their contents should be
75 ;; treated as `binary'.
76 ;("/spool/mail/.*$" . convert-mbox-coding-system)
78 "Alist to decide a coding system to use for a file I/O operation.
79 The format is ((PATTERN . VAL) ...),
80 where PATTERN is a regular expression matching a file name,
81 VAL is a coding system, a cons of coding systems, or a function symbol.
82 If VAL is a coding system, it is used for both decoding and encoding
84 If VAL is a cons of coding systems, the car part is used for decoding,
85 and the cdr part is used for encoding.
86 If VAL is a function symbol, the function must return a coding system
87 or a cons of coding systems which are used as above.
89 This overrides the more general specification in
90 `buffer-file-coding-system-for-read', but is overridden by
91 `coding-system-for-read'.")
93 (defun set-buffer-file-coding-system (coding-system &optional force)
94 "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM.
95 If optional argument FORCE (interactively, the prefix argument) is not
96 given, attempt to match the EOL type of the new coding system to
97 the current value of `buffer-file-coding-system'."
98 (interactive "zFile coding system: \nP")
99 (get-coding-system coding-system) ;; correctness check
102 (subsidiary-coding-system
104 (coding-system-eol-type buffer-file-coding-system))))
105 (setq buffer-file-coding-system coding-system)
108 (defun toggle-buffer-file-coding-system ()
109 "Set EOL type of buffer-file-coding-system of the current buffer to
110 something other than what it is at the moment."
113 (coding-system-eol-type buffer-file-coding-system)))
114 (setq buffer-file-coding-system
115 (subsidiary-coding-system
116 (coding-system-base buffer-file-coding-system)
117 (cond ((eq eol-type 'lf) 'crlf)
118 ((eq eol-type 'crlf) 'lf)
119 ((eq eol-type 'cr) 'lf))))
120 (set-buffer-modified-p t)))
122 (define-obsolete-function-alias
123 'set-file-coding-system
124 'set-buffer-file-coding-system)
126 (defun set-buffer-file-coding-system-for-read (coding-system)
127 "Set the coding system used when reading in a file.
128 This is equivalent to setting the variable
129 `buffer-file-coding-system-for-read'. You can also use
130 `file-coding-system-alist' to specify the coding system for
132 (interactive "zFile coding system for read: ")
133 (get-coding-system coding-system) ;; correctness check
134 (setq buffer-file-coding-system-for-read coding-system))
136 (define-obsolete-function-alias
137 'set-file-coding-system-for-read
138 'set-buffer-file-coding-system-for-read)
140 (defun set-default-buffer-file-coding-system (coding-system)
141 "Set the default value of `buffer-file-coding-system' to CODING-SYSTEM.
142 The default value is used both for buffers without associated files
143 and for files with no apparent coding system (i.e. primarily ASCII).
144 See `buffer-file-coding-system' for more information."
145 (interactive "zDefault file coding system: ")
146 (setq-default buffer-file-coding-system coding-system)
149 (define-obsolete-function-alias
150 'set-default-file-coding-system
151 'set-default-buffer-file-coding-system)
153 (defun find-file-coding-system-for-read-from-filename (filename)
154 "Look up coding system to read a file in `file-coding-system-alist'.
155 The return value will be nil (no applicable entry) or a coding system
156 object (the entry specified a coding system)."
157 (let ((alist file-coding-system-alist)
160 (let ((case-fold-search nil))
161 (setq filename (file-name-sans-versions filename))
162 (while (and (not found) alist)
163 (if (string-match (car (car alist)) filename)
164 (setq codesys (cdr (car alist))
166 (setq alist (cdr alist))))
168 (if (functionp codesys)
169 (setq codesys (funcall codesys 'insert-file-contents filename))
171 (cond ((consp codesys) (find-coding-system (car codesys)))
172 ((find-coding-system codesys))
175 (define-obsolete-function-alias
176 'find-file-coding-system-from-filename
177 'find-file-coding-system-for-read-from-filename)
179 (defun find-file-coding-system-for-write-from-filename (filename)
180 "Look up coding system to write a file in `file-coding-system-alist'.
181 The return value will be nil (no applicable entry) or a coding system
182 object (the entry specified a coding system)."
183 (let ((alist file-coding-system-alist)
186 (let ((case-fold-search nil))
187 (setq filename (file-name-sans-versions filename))
188 (while (and (not found) alist)
189 (if (string-match (car (car alist)) filename)
190 (setq codesys (cdr (car alist))
192 (setq alist (cdr alist))))
194 (if (functionp codesys)
195 (setq codesys (funcall codesys 'write-region filename))
197 (cond ((consp codesys) (find-coding-system (cdr codesys)))
198 ((find-coding-system codesys))
201 ;; This is completely broken, not only in implementation (does not
202 ;; understand MIME), but in concept -- such high-level decoding should
203 ;; be done by mail readers, not by IO code!
205 ;(defun convert-mbox-coding-system (filename visit start end)
208 (defun find-coding-system-magic-cookie ()
209 "Look for the coding-system magic cookie in the current buffer.
210 The coding-system magic cookie is the exact string
211 \";;;###coding system: \" followed by a valid coding system symbol,
212 somewhere within the first 3000 characters of the file. If found,
213 the coding system symbol is returned; otherwise nil is returned.
214 Note that it is extremely unlikely that such a string would occur
215 coincidentally as the result of encoding some characters in a non-ASCII
216 charset, and that the spaces make it even less likely since the space
217 character is not a valid octet in any ISO 2022 encoding of most non-ASCII
220 (goto-char (point-min))
222 "^[^\n]*-\\*-[^\n]*coding: \\([^ \t\n;]+\\)[^\n]*-\\*-")
223 (let ((codesys (intern (buffer-substring
224 (match-beginning 1)(match-end 1)))))
225 (if (find-coding-system codesys) codesys)))
228 ;; (and (re-search-forward "^;+[ \t]*Local Variables:" nil t)
229 ;; (setq start (match-end 0))
230 ;; (re-search-forward "\n;+[ \t]*End:")
231 ;; (setq end (match-beginning 0))
233 ;; (narrow-to-region start end)
235 ;; (re-search-forward "^;;; coding: \\([^\n]+\\)$" nil t)
238 ;; (intern (buffer-substring
239 ;; (match-beginning 1)(match-end 1)))))
240 ;; (if (find-coding-system codesys) codesys))
242 (let ((case-fold-search nil))
244 ";;;###coding system: " (+ (point-min) 3000) t)
245 (let ((start (point))
247 (skip-chars-forward "^ \t\n\r")
250 (let ((codesys (intern (buffer-substring start end))))
251 (if (find-coding-system codesys) codesys)))
255 (defun load (file &optional noerror nomessage nosuffix)
256 "Execute a file of Lisp code named FILE.
257 First tries FILE with .elc appended, then tries with .el,
258 then tries FILE unmodified. Searches directories in load-path.
259 If optional second arg NOERROR is non-nil,
260 report no error if FILE doesn't exist.
261 Print messages at start and end of loading unless
262 optional third arg NOMESSAGE is non-nil.
263 If optional fourth arg NOSUFFIX is non-nil, don't try adding
264 suffixes .elc or .el to the specified name FILE.
265 Return t if file exists."
266 (let* ((filename (substitute-in-file-name file))
267 (handler (find-file-name-handler filename 'load))
270 (funcall handler 'load filename noerror nomessage nosuffix)
271 (if (or (<= (length filename) 0)
273 (locate-file filename load-path
274 (and (not nosuffix) '(".elc" ".el" ""))))))
276 (signal 'file-error (list "Cannot open load file" filename)))
277 ;; now use the internal load to actually load the file.
279 file noerror nomessage nosuffix
280 (let ((elc ; use string= instead of string-match to keep match-data.
281 (string= ".elc" (downcase (substring path -4)))))
282 (or (and (not elc) coding-system-for-read) ; prefer for source file
285 (set-buffer (get-buffer-create " *load*"))
287 (let ((coding-system-for-read 'raw-text))
288 (insert-file-contents path nil 1 3001))
289 (find-coding-system-magic-cookie))
291 ;; if reading a byte-compiled file and we didn't find
292 ;; a coding-system magic cookie, then use `binary'.
293 ;; We need to guarantee that we never do autodetection
294 ;; on byte-compiled files because confusion here would
295 ;; be a very bad thing. Pre-existing byte-compiled
296 ;; files are always in the `binary' coding system.
297 ;; Also, byte-compiled files always use `lf' to terminate
298 ;; a line; don't risk confusion here either.
300 (or (find-file-coding-system-for-read-from-filename path)
301 ;; looking up in `file-coding-system-alist'.
302 ;; otherwise use `buffer-file-coding-system-for-read',
304 buffer-file-coding-system-for-read)
308 (defvar insert-file-contents-access-hook nil
309 "A hook to make a file accessible before reading it.
310 `insert-file-contents' calls this hook before doing anything else.
311 Called with two arguments: FILENAME and VISIT, the same as the
312 corresponding arguments in the call to `insert-file-contents'.")
314 (defvar insert-file-contents-pre-hook nil
315 "A special hook to decide the coding system used for reading in a file.
317 Before reading a file, `insert-file-contents' calls the functions on
318 this hook with arguments FILENAME and VISIT, the same as the
319 corresponding arguments in the call to `insert-file-contents'. In
320 these functions, you may refer to the global variable
321 `buffer-file-coding-system-for-read'.
323 The return value of the functions should be either
326 -- A coding system or a symbol denoting it, indicating the coding system
327 to be used for reading the file
328 -- A list of two elements (absolute pathname and length of data inserted),
329 which is used as the return value to `insert-file-contents'. In this
330 case, `insert-file-contents' assumes that the function has inserted
331 the file for itself and suppresses further reading.
333 If any function returns non-nil, the remaining functions are not called.")
335 (defvar insert-file-contents-error-hook nil
336 "A hook to set `buffer-file-coding-system' when a read error has occurred.
338 When a file error (e.g. nonexistent file) occurs while read a file,
339 `insert-file-contents' calls the functions on this hook with three
340 arguments: FILENAME and VISIT (the same as the corresponding arguments
341 in the call to `insert-file-contents') and a cons (SIGNALED-CONDITIONS
344 After calling this hook, the error is signalled for real and
345 propagates to the caller of `insert-file-contents'.")
347 (defvar insert-file-contents-post-hook nil
348 "A hook to set `buffer-file-coding-system' for the current buffer.
350 After successful reading, `insert-file-contents' calls the functions
351 on this hook with four arguments: FILENAME and VISIT (the same as the
352 corresponding arguments in the call to `insert-file-contents'),
353 CODING-SYSTEM (the actual coding system used to decode the file), and
354 a cons of absolute pathname and length of data inserted (the same
355 thing as will be returned from `insert-file-contents').")
357 (defun insert-file-contents (filename &optional visit start end replace)
358 "Insert contents of file FILENAME after point.
359 Returns list of absolute file name and length of data inserted.
360 If second argument VISIT is non-nil, the buffer's visited filename
361 and last save file modtime are set, and it is marked unmodified.
362 If visiting and the file does not exist, visiting is completed
363 before the error is signaled.
365 The optional third and fourth arguments START and END
366 specify what portion of the file to insert.
367 If VISIT is non-nil, START and END must be nil.
368 If optional fifth argument REPLACE is non-nil,
369 it means replace the current buffer contents (in the accessible portion)
370 with the file contents. This is better than simply deleting and inserting
371 the whole thing because (1) it preserves some marker positions
372 and (2) it puts less data in the undo list.
374 The coding system used for decoding the file is determined as follows:
376 1. `coding-system-for-read', if non-nil.
377 2. The result of `insert-file-contents-pre-hook', if non-nil.
378 3. The matching value for this filename from
379 `file-coding-system-alist', if any.
380 4. `buffer-file-coding-system-for-read', if non-nil.
381 5. The coding system 'raw-text.
383 If a local value for `buffer-file-coding-system' in the current buffer
384 does not exist, it is set to the coding system which was actually used
387 See also `insert-file-contents-access-hook',
388 `insert-file-contents-pre-hook', `insert-file-contents-error-hook',
389 and `insert-file-contents-post-hook'."
390 (let (return-val coding-system used-codesys)
391 ;; OK, first load the file.
394 (run-hook-with-args 'insert-file-contents-access-hook
396 ;; determine the coding system to use, as described above.
400 coding-system-for-read
402 (run-hook-with-args-until-success
403 'insert-file-contents-pre-hook
406 (find-file-coding-system-for-read-from-filename filename)
408 buffer-file-coding-system-for-read
411 (if (consp coding-system)
412 (setq return-val coding-system)
413 (if (null (find-coding-system coding-system))
416 "Invalid coding-system (%s), using 'undecided"
418 (setq coding-system 'undecided)))
420 (insert-file-contents-internal filename visit start end
421 replace coding-system
426 (run-hook-with-args 'insert-file-contents-error-hook
428 (signal (car err) (cdr err))))
429 (setq coding-system used-codesys)
430 ;; call any `post-read-conversion' for the coding system that
433 (coding-system-property coding-system 'post-read-conversion))
434 (endmark (make-marker)))
435 (set-marker endmark (+ (point) (nth 1 return-val)))
439 (let (buffer-read-only)
440 (funcall func (point) (marker-position endmark))))
443 (set-buffer-auto-saved)
444 (set-buffer-modified-p nil)))))
445 (setcar (cdr return-val) (- (marker-position endmark) (point))))
446 ;; now finally set the buffer's `buffer-file-coding-system'.
447 (if (run-hook-with-args-until-success 'insert-file-contents-post-hook
448 filename visit return-val)
450 (if (local-variable-p 'buffer-file-coding-system (current-buffer))
451 ;; if buffer-file-coding-system is already local, just
452 ;; set its eol type to what was found, if it wasn't
454 (set-buffer-file-coding-system
455 (subsidiary-coding-system buffer-file-coding-system
456 (coding-system-eol-type coding-system)))
457 ;; otherwise actually set buffer-file-coding-system.
458 (set-buffer-file-coding-system coding-system)))
461 (defvar write-region-pre-hook nil
462 "A special hook to decide the coding system used for writing out a file.
464 Before writing a file, `write-region' calls the functions on this hook
465 with arguments START, END, FILENAME, APPEND, VISIT, and CODING-SYSTEM,
466 the same as the corresponding arguments in the call to
469 The return value of the functions should be either
472 -- A coding system or a symbol denoting it, indicating the coding system
473 to be used for reading the file
474 -- A list of two elements (absolute pathname and length of data written),
475 which is used as the return value to `write-region'. In this
476 case, `write-region' assumes that the function has written
477 the file for itself and suppresses further writing.
479 If any function returns non-nil, the remaining functions are not called.")
481 (defvar write-region-post-hook nil
482 "A hook called by `write-region' after a file has been written out.
484 The functions on this hook are called with arguments START, END,
485 FILENAME, APPEND, VISIT, and CODING-SYSTEM, the same as the
486 corresponding arguments in the call to `write-region'.")
488 (defun write-region (start end filename &optional append visit lockname coding-system)
489 "Write current region into specified file.
490 By default the file's existing contents are replaced by the specified region.
491 When called from a program, takes three arguments:
492 START, END and FILENAME. START and END are buffer positions.
493 Optional fourth argument APPEND if non-nil means
494 append to existing file contents (if any).
495 Optional fifth argument VISIT if t means
496 set last-save-file-modtime of buffer to this file's modtime
497 and mark buffer not modified.
498 If VISIT is a string, it is a second file name;
499 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
500 VISIT is also the file name to lock and unlock for clash detection.
501 If VISIT is neither t nor nil nor a string,
502 that means do not print the \"Wrote file\" message.
503 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
504 use for locking and unlocking, overriding FILENAME and VISIT.
505 Kludgy feature: if START is a string, then that string is written
506 to the file, instead of any buffer contents, and END is ignored.
507 Optional seventh argument CODING-SYSTEM specifies the coding system
508 used to encode the text when it is written out, and defaults to
509 the value of `buffer-file-coding-system' in the current buffer.
510 Interactively, with a prefix arg, you will be prompted for the
512 See also `write-region-pre-hook' and `write-region-post-hook'."
513 (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ")
515 (or coding-system-for-write
516 (run-hook-with-args-until-success
517 'write-region-pre-hook start end filename append visit lockname)
519 buffer-file-coding-system
520 (find-file-coding-system-for-write-from-filename filename)
522 (if (consp coding-system)
525 (coding-system-property coding-system 'pre-write-conversion)))
527 (let ((curbuf (current-buffer))
528 (tempbuf (generate-new-buffer " *temp-write-buffer*"))
529 (modif (buffer-modified-p)))
534 (insert-buffer-substring curbuf start end)
535 (funcall func (point-min) (point-max))
536 (write-region-internal (point-min) (point-max) filename
538 (if (eq visit t) nil visit)
541 ;; leaving a buffer associated with file will cause problems
542 ;; when next visiting.
543 (kill-buffer tempbuf)
544 (if (or visit (null modif))
546 (set-buffer-auto-saved)
547 (set-buffer-modified-p nil)
548 (if (buffer-file-name) (set-visited-file-modtime))))))
549 (write-region-internal start end filename append visit lockname
551 (run-hook-with-args 'write-region-post-hook
552 start end filename append visit lockname
555 ;;; code-files.el ends here