annotate lisp/code-files.el @ 756:00793f182d30

[xemacs-hg @ 2002-02-22 17:12:26 by michaels] 2002-02-11 Mike Sperber <mike@xemacs.org> * device-x.c: (x_IO_error_handler): (x_init_device): Temporarily keep device in static variable `device_being_initialized' so we can recover gracefully from internal XOpenDevice failure. (XOpenDevice is documented to return NULL on failure, but sometimes calls the IO error handler instead.)
author michaels
date Fri, 22 Feb 2002 17:12:27 +0000
parents ca2d04c5710a
children 943eaba38521
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; code-files.el --- File I/O functions for XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995 Amdahl Corporation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Copyright (C) 1995 Sun Microsystems.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
20 ;; along with XEmacs; see the file COPYING. If not, write to the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;;; Synched up with: Not synched.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;; Derived from mule.el in the original Mule but heavily modified
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;; by Ben Wing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; 1997/3/11 modified by MORIOKA Tomohiko to sync with Emacs 20 API.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; This file was derived from the former mule-files.el which has been removed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; as of XEmacs 21.2.15.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 (setq-default buffer-file-coding-system 'raw-text)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 (put 'buffer-file-coding-system 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 (define-obsolete-variable-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 'file-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 'buffer-file-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 (define-obsolete-variable-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 'overriding-file-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 'coding-system-for-read)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 (defvar buffer-file-coding-system-for-read 'undecided
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 "Coding system used when reading a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 This provides coarse-grained control; for finer-grained control, use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 `file-coding-system-alist'. From a Lisp program, if you wish to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 unilaterally specify the coding system used for one particular
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 operation, you should bind the variable `coding-system-for-read'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 rather than setting this variable, which is intended to be used for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 global environment specification.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 (define-obsolete-variable-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 'file-coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 'buffer-file-coding-system-for-read)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (defvar file-coding-system-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 `(
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 ;; This must not be necessary, slb suggests -kkm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;; ("loaddefs.el$" . (binary . binary))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 ,@(mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 #'(lambda (regexp) (cons regexp 'binary)) binary-file-regexps)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ("TUTORIAL\\.\\(?:hr\\|pl\\|ro\\)\\'" . iso-8859-2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;; ("\\.\\(el\\|emacs\\|info\\(-[0-9]+\\)?\\|texi\\)$" . iso-2022-8)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;; ("\\(ChangeLog\\|CHANGES-beta\\)$" . iso-2022-8)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
71
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
72 ;; This idea is totally broken, and the code didn't work anyway.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
73 ;; Mailboxes should be decoded by mail clients, who actually know
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
74 ;; how to deal with them. Otherwise, their contents should be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
75 ;; treated as `binary'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
76 ;("/spool/mail/.*$" . convert-mbox-coding-system)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
77 )
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 "Alist to decide a coding system to use for a file I/O operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 The format is ((PATTERN . VAL) ...),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 where PATTERN is a regular expression matching a file name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 VAL is a coding system, a cons of coding systems, or a function symbol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 If VAL is a coding system, it is used for both decoding and encoding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 the file contents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 If VAL is a cons of coding systems, the car part is used for decoding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 and the cdr part is used for encoding.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 If VAL is a function symbol, the function must return a coding system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 or a cons of coding systems which are used as above.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 This overrides the more general specification in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 `buffer-file-coding-system-for-read', but is overridden by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 `coding-system-for-read'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (defun set-buffer-file-coding-system (coding-system &optional force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 If optional argument FORCE (interactively, the prefix argument) is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 given, attempt to match the EOL type of the new coding system to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 the current value of `buffer-file-coding-system'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (interactive "zFile coding system: \nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (get-coding-system coding-system) ;; correctness check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (if (not force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (setq coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (subsidiary-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (coding-system-eol-type buffer-file-coding-system))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (setq buffer-file-coding-system coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (redraw-modeline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (defun toggle-buffer-file-coding-system ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 "Set EOL type of buffer-file-coding-system of the current buffer to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 something other than what it is at the moment."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (let ((eol-type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (coding-system-eol-type buffer-file-coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 (setq buffer-file-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 (subsidiary-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (coding-system-base buffer-file-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (cond ((eq eol-type 'lf) 'crlf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 ((eq eol-type 'crlf) 'lf)
673
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 502
diff changeset
119 ((eq eol-type 'cr) 'lf))))
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 502
diff changeset
120 (set-buffer-modified-p t)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 'set-file-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 'set-buffer-file-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (defun set-buffer-file-coding-system-for-read (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 "Set the coding system used when reading in a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 This is equivalent to setting the variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 `buffer-file-coding-system-for-read'. You can also use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 `file-coding-system-alist' to specify the coding system for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 particular files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (interactive "zFile coding system for read: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (get-coding-system coding-system) ;; correctness check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (setq buffer-file-coding-system-for-read coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 'set-file-coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 'set-buffer-file-coding-system-for-read)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (defun set-default-buffer-file-coding-system (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 "Set the default value of `buffer-file-coding-system' to CODING-SYSTEM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 The default value is used both for buffers without associated files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 and for files with no apparent coding system (i.e. primarily ASCII).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 See `buffer-file-coding-system' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (interactive "zDefault file coding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (setq-default buffer-file-coding-system coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (redraw-modeline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 'set-default-file-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 'set-default-buffer-file-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (defun find-file-coding-system-for-read-from-filename (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 "Look up coding system to read a file in `file-coding-system-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 The return value will be nil (no applicable entry) or a coding system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 object (the entry specified a coding system)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (let ((alist file-coding-system-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (found nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (codesys nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (let ((case-fold-search nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (setq filename (file-name-sans-versions filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (while (and (not found) alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (if (string-match (car (car alist)) filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (setq codesys (cdr (car alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 found t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (setq alist (cdr alist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (when codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (if (functionp codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 (setq codesys (funcall codesys 'insert-file-contents filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (cond ((consp codesys) (find-coding-system (car codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 ((find-coding-system codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 'find-file-coding-system-from-filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 'find-file-coding-system-for-read-from-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (defun find-file-coding-system-for-write-from-filename (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 "Look up coding system to write a file in `file-coding-system-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 The return value will be nil (no applicable entry) or a coding system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 object (the entry specified a coding system)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (let ((alist file-coding-system-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 (found nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 (codesys nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (let ((case-fold-search nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 (setq filename (file-name-sans-versions filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 (while (and (not found) alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (if (string-match (car (car alist)) filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 (setq codesys (cdr (car alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 found t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (setq alist (cdr alist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (when codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (if (functionp codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (setq codesys (funcall codesys 'write-region filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 (cond ((consp codesys) (find-coding-system (cdr codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 ((find-coding-system codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200
748
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
201 ;; This was completely broken, not only in implementation (does not
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
202 ;; understand MIME), but in concept -- such high-level decoding should
748
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
203 ;; be done by mail readers, not by IO code! Removed 2000-04-18.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
204
748
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
205 ;(defun convert-mbox-coding-system (filename visit start end) ...)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 (defun load (file &optional noerror nomessage nosuffix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 "Execute a file of Lisp code named FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 First tries FILE with .elc appended, then tries with .el,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 then tries FILE unmodified. Searches directories in load-path.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 If optional second arg NOERROR is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 report no error if FILE doesn't exist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 Print messages at start and end of loading unless
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 optional third arg NOMESSAGE is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 If optional fourth arg NOSUFFIX is non-nil, don't try adding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 suffixes .elc or .el to the specified name FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Return t if file exists."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (let* ((filename (substitute-in-file-name file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (handler (find-file-name-handler filename 'load))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (path nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 (funcall handler 'load filename noerror nomessage nosuffix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 (if (or (<= (length filename) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 (null (setq path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 (locate-file filename load-path
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
226 (and (not nosuffix)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
227 '(".elc" ".el" ""))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (and (null noerror)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (signal 'file-error (list "Cannot open load file" filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 ;; now use the internal load to actually load the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (load-internal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 file noerror nomessage nosuffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (let ((elc ; use string= instead of string-match to keep match-data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (string= ".elc" (downcase (substring path -4)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (or (and (not elc) coding-system-for-read) ; prefer for source file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 ;; find magic-cookie
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
237 (let ((codesys (find-coding-system-magic-cookie-in-file path)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
238 (when codesys
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
239 (setq codesys (intern codesys))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
240 (if (find-coding-system codesys) codesys)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (if elc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 ;; if reading a byte-compiled file and we didn't find
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 ;; a coding-system magic cookie, then use `binary'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 ;; We need to guarantee that we never do autodetection
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 ;; on byte-compiled files because confusion here would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 ;; be a very bad thing. Pre-existing byte-compiled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 ;; files are always in the `binary' coding system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 ;; Also, byte-compiled files always use `lf' to terminate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 ;; a line; don't risk confusion here either.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 'binary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (or (find-file-coding-system-for-read-from-filename path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 ;; looking up in `file-coding-system-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 ;; otherwise use `buffer-file-coding-system-for-read',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 ;; as normal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 buffer-file-coding-system-for-read)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 )))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 )))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (defvar insert-file-contents-access-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 "A hook to make a file accessible before reading it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 `insert-file-contents' calls this hook before doing anything else.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 Called with two arguments: FILENAME and VISIT, the same as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 corresponding arguments in the call to `insert-file-contents'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (defvar insert-file-contents-pre-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 "A special hook to decide the coding system used for reading in a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 Before reading a file, `insert-file-contents' calls the functions on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 this hook with arguments FILENAME and VISIT, the same as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 corresponding arguments in the call to `insert-file-contents'. In
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 these functions, you may refer to the global variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 `buffer-file-coding-system-for-read'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 The return value of the functions should be either
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 -- nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 -- A coding system or a symbol denoting it, indicating the coding system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 to be used for reading the file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 -- A list of two elements (absolute pathname and length of data inserted),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 which is used as the return value to `insert-file-contents'. In this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 case, `insert-file-contents' assumes that the function has inserted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 the file for itself and suppresses further reading.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 If any function returns non-nil, the remaining functions are not called.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (defvar insert-file-contents-error-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 "A hook to set `buffer-file-coding-system' when a read error has occurred.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 When a file error (e.g. nonexistent file) occurs while read a file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 `insert-file-contents' calls the functions on this hook with three
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 arguments: FILENAME and VISIT (the same as the corresponding arguments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 in the call to `insert-file-contents') and a cons (SIGNALED-CONDITIONS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 . SIGNAL-DATA).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 After calling this hook, the error is signalled for real and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 propagates to the caller of `insert-file-contents'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (defvar insert-file-contents-post-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 "A hook to set `buffer-file-coding-system' for the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 After successful reading, `insert-file-contents' calls the functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 on this hook with four arguments: FILENAME and VISIT (the same as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 corresponding arguments in the call to `insert-file-contents'),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 CODING-SYSTEM (the actual coding system used to decode the file), and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 a cons of absolute pathname and length of data inserted (the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 thing as will be returned from `insert-file-contents').")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
308 (defun insert-file-contents (filename &optional visit start end replace)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 "Insert contents of file FILENAME after point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 Returns list of absolute file name and length of data inserted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 If second argument VISIT is non-nil, the buffer's visited filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 and last save file modtime are set, and it is marked unmodified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 If visiting and the file does not exist, visiting is completed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 before the error is signaled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
316 The optional third and fourth arguments START and END
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 specify what portion of the file to insert.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
318 If VISIT is non-nil, START and END must be nil.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 If optional fifth argument REPLACE is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 it means replace the current buffer contents (in the accessible portion)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 with the file contents. This is better than simply deleting and inserting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 the whole thing because (1) it preserves some marker positions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 and (2) it puts less data in the undo list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 The coding system used for decoding the file is determined as follows:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 1. `coding-system-for-read', if non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 2. The result of `insert-file-contents-pre-hook', if non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 3. The matching value for this filename from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 `file-coding-system-alist', if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 4. `buffer-file-coding-system-for-read', if non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 5. The coding system 'raw-text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 If a local value for `buffer-file-coding-system' in the current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 does not exist, it is set to the coding system which was actually used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 for reading.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 See also `insert-file-contents-access-hook',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 `insert-file-contents-pre-hook', `insert-file-contents-error-hook',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 and `insert-file-contents-post-hook'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (let (return-val coding-system used-codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 ;; OK, first load the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (condition-case err
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 (run-hook-with-args 'insert-file-contents-access-hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 filename visit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 ;; determine the coding system to use, as described above.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (setq coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 ;; #1.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 ;; #2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (run-hook-with-args-until-success
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 'insert-file-contents-pre-hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 filename visit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 ;; #3.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (find-file-coding-system-for-read-from-filename filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 ;; #4.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 buffer-file-coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 ;; #5.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 'raw-text))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (if (consp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (setq return-val coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (if (null (find-coding-system coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 (message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 "Invalid coding-system (%s), using 'undecided"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (setq coding-system 'undecided)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (setq return-val
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
371 (insert-file-contents-internal filename visit start end
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 replace coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 ;; store here!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 'used-codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (run-hook-with-args 'insert-file-contents-error-hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 filename visit err)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 (signal (car err) (cdr err))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (setq coding-system used-codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 ;; call any `post-read-conversion' for the coding system that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 ;; was used ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (let ((func
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (coding-system-property coding-system 'post-read-conversion))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (endmark (make-marker)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (set-marker endmark (+ (point) (nth 1 return-val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (if func
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (let (buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (funcall func (point) (marker-position endmark))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (if visit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (set-buffer-auto-saved)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (set-buffer-modified-p nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (setcar (cdr return-val) (- (marker-position endmark) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 ;; now finally set the buffer's `buffer-file-coding-system'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (if (run-hook-with-args-until-success 'insert-file-contents-post-hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 filename visit return-val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (if (local-variable-p 'buffer-file-coding-system (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 ;; if buffer-file-coding-system is already local, just
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 ;; set its eol type to what was found, if it wasn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 ;; set already.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (set-buffer-file-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (subsidiary-coding-system buffer-file-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (coding-system-eol-type coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 ;; otherwise actually set buffer-file-coding-system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 (set-buffer-file-coding-system coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 return-val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (defvar write-region-pre-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 "A special hook to decide the coding system used for writing out a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
748
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
415 Before writing a file, `write-region' calls the functions on this hook with
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
416 arguments START, END, FILENAME, APPEND, VISIT, LOCKNAME, and CODING-SYSTEM,
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
417 the same as the corresponding arguments in the call to `write-region'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
748
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
419 The return value of each function should be one of
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 -- nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 -- A coding system or a symbol denoting it, indicating the coding system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 to be used for reading the file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 -- A list of two elements (absolute pathname and length of data written),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 which is used as the return value to `write-region'. In this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 case, `write-region' assumes that the function has written
748
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
427 the file, and returns.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 If any function returns non-nil, the remaining functions are not called.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (defvar write-region-post-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 "A hook called by `write-region' after a file has been written out.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 The functions on this hook are called with arguments START, END,
748
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
435 FILENAME, APPEND, VISIT, LOCKNAME, and CODING-SYSTEM, the same as the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 corresponding arguments in the call to `write-region'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (defun write-region (start end filename &optional append visit lockname coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 "Write current region into specified file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 By default the file's existing contents are replaced by the specified region.
748
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
441 Call interactively, prompts for the filename. With a prefix arg, also prompts
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
442 for a coding system.
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
443
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
444 When called from a program, takes three required arguments:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 START, END and FILENAME. START and END are buffer positions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 Optional fourth argument APPEND if non-nil means
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 append to existing file contents (if any).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 Optional fifth argument VISIT if t means
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 set last-save-file-modtime of buffer to this file's modtime
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 and mark buffer not modified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 If VISIT is a string, it is a second file name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 VISIT is also the file name to lock and unlock for clash detection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 If VISIT is neither t nor nil nor a string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 that means do not print the \"Wrote file\" message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 use for locking and unlocking, overriding FILENAME and VISIT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 Kludgy feature: if START is a string, then that string is written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 to the file, instead of any buffer contents, and END is ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 Optional seventh argument CODING-SYSTEM specifies the coding system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 used to encode the text when it is written out, and defaults to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 the value of `buffer-file-coding-system' in the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 See also `write-region-pre-hook' and `write-region-post-hook'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (setq coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (or coding-system-for-write
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (run-hook-with-args-until-success
748
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
468 'write-region-pre-hook
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
469 start end filename append visit lockname coding-system)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 buffer-file-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 (find-file-coding-system-for-write-from-filename filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 (if (consp coding-system)
748
ca2d04c5710a [xemacs-hg @ 2002-02-12 14:24:39 by stephent]
stephent
parents: 673
diff changeset
475 ;; One of the `write-region-pre-hook' functions wrote the file
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (let ((func
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (coding-system-property coding-system 'pre-write-conversion)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (if func
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (let ((curbuf (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (tempbuf (generate-new-buffer " *temp-write-buffer*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 (modif (buffer-modified-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 (set-buffer tempbuf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 (insert-buffer-substring curbuf start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 (funcall func (point-min) (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (write-region-internal (point-min) (point-max) filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 append
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (if (eq visit t) nil visit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 lockname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 ;; leaving a buffer associated with file will cause problems
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 ;; when next visiting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 (kill-buffer tempbuf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 (if (or visit (null modif))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (set-buffer-auto-saved)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (set-buffer-modified-p nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (if (buffer-file-name) (set-visited-file-modtime))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 (write-region-internal start end filename append visit lockname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 (run-hook-with-args 'write-region-post-hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 start end filename append visit lockname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 ;;; code-files.el ends here