Mercurial > hg > xemacs-beta
annotate lisp/code-files.el @ 5916:1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
lisp/ChangeLog addition:
2015-06-03 Aidan Kehoe <kehoea@parhasard.net>
* code-files.el (load):
Revise this to respect load-ignore-out-of-date-elc-files, rather
than leaving that to #'load-internal. Avoids a corner case where
the source and the compiled file have different, incompatible
encodings.
Move the call to #'substitute-in-file-name here.
No longer check for a zero-length filename, since #'load-internal
no longer chokes on same and errors correctly.
src/ChangeLog addition:
2015-06-03 Aidan Kehoe <kehoea@parhasard.net>
* lread.c (Fload_internal):
Delegate calling the handler and #'substitute-in-file-name to #'load.
Error correctly with a zero-length file name, instead of giving a
bus error on my machine.
Delegate the check for out-of-date ELC files to #'load,
avoiding a bug where the encoding of the ELC file and the source
file differed.
* lread.c (PRINT_LOADING_MESSAGE_1):
This is simplified, now we no longer have to talk about
out-of-date ELC files.
tests/ChangeLog addition:
2015-06-03 Aidan Kehoe <kehoea@parhasard.net>
* automated/file-tests.el:
Gross sanity check for #'load and #'load-internal with a
zero-length FILE, something that crashed until today.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 03 Jun 2015 20:13:07 +0100 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; code-files.el --- File I/O functions for XEmacs. |
| 2 | |
| 3 ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1995 Amdahl Corporation. | |
| 5 ;; Copyright (C) 1995 Sun Microsystems. | |
| 793 | 6 ;; Copyright (C) 2001, 2002 Ben Wing. |
| 428 | 7 |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4650
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4650
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4650
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4650
diff
changeset
|
13 ;; option) any later version. |
| 428 | 14 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4650
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4650
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4650
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4650
diff
changeset
|
18 ;; for more details. |
| 428 | 19 |
| 20 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4650
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 22 |
| 23 ;;; Synched up with: Not synched. | |
| 24 | |
| 25 ;;; Commentary: | |
| 26 | |
| 27 ;; Derived from mule.el in the original Mule but heavily modified | |
| 28 ;; by Ben Wing. | |
| 29 | |
| 30 ;; 1997/3/11 modified by MORIOKA Tomohiko to sync with Emacs 20 API. | |
| 31 | |
| 32 ;; This file was derived from the former mule-files.el which has been removed | |
| 33 ;; as of XEmacs 21.2.15. | |
| 34 | |
| 35 ;;; Code: | |
| 36 | |
| 37 (put 'buffer-file-coding-system 'permanent-local t) | |
| 38 | |
| 771 | 39 (defvar buffer-file-coding-system-when-loaded nil |
| 40 "Coding system used when current buffer's file was read in. | |
| 41 | |
| 42 Automatically buffer-local when set in any fashion. This is set | |
| 43 automatically when a file is loaded and is used when the file needs to be | |
| 44 reloaded (e.g. `revert-buffer'). Normally this will have the same value as | |
| 45 `buffer-file-coding-system', but the latter may be changed because it's | |
| 46 also used to specify the encoding when the file is written out.") | |
| 47 (make-variable-buffer-local 'buffer-file-coding-system-when-loaded) | |
| 48 (put 'buffer-file-coding-system-when-loaded 'permanent-local t) | |
| 49 | |
| 428 | 50 (define-obsolete-variable-alias |
| 51 'file-coding-system | |
| 52 'buffer-file-coding-system) | |
| 53 | |
| 54 (define-obsolete-variable-alias | |
| 55 'overriding-file-coding-system | |
| 56 'coding-system-for-read) | |
| 57 | |
| 771 | 58 ;; NOTE: The real default value is set in code-init.el. |
| 59 (defvar buffer-file-coding-system-for-read nil | |
| 60 "Default coding system used when reading a file. | |
| 428 | 61 This provides coarse-grained control; for finer-grained control, use |
| 62 `file-coding-system-alist'. From a Lisp program, if you wish to | |
| 63 unilaterally specify the coding system used for one particular | |
| 64 operation, you should bind the variable `coding-system-for-read' | |
| 65 rather than setting this variable, which is intended to be used for | |
| 771 | 66 global environment specification. |
| 67 | |
| 68 See `insert-file-contents' for a full description of how a file's | |
| 69 coding system is determined when it is read in.") | |
| 428 | 70 |
| 71 (define-obsolete-variable-alias | |
| 72 'file-coding-system-for-read | |
| 73 'buffer-file-coding-system-for-read) | |
| 74 | |
| 75 (defvar file-coding-system-alist | |
| 76 `( | |
| 77 ;; This must not be necessary, slb suggests -kkm | |
| 78 ;; ("loaddefs.el$" . (binary . binary)) | |
| 79 ,@(mapcar | |
| 80 #'(lambda (regexp) (cons regexp 'binary)) binary-file-regexps) | |
| 81 ("TUTORIAL\\.\\(?:hr\\|pl\\|ro\\)\\'" . iso-8859-2) | |
| 82 ;; ("\\.\\(el\\|emacs\\|info\\(-[0-9]+\\)?\\|texi\\)$" . iso-2022-8) | |
| 83 ;; ("\\(ChangeLog\\|CHANGES-beta\\)$" . iso-2022-8) | |
| 442 | 84 |
| 85 ;; This idea is totally broken, and the code didn't work anyway. | |
| 86 ;; Mailboxes should be decoded by mail clients, who actually know | |
| 87 ;; how to deal with them. Otherwise, their contents should be | |
| 88 ;; treated as `binary'. | |
| 89 ;("/spool/mail/.*$" . convert-mbox-coding-system) | |
| 90 ) | |
| 428 | 91 "Alist to decide a coding system to use for a file I/O operation. |
| 92 The format is ((PATTERN . VAL) ...), | |
| 93 where PATTERN is a regular expression matching a file name, | |
| 94 VAL is a coding system, a cons of coding systems, or a function symbol. | |
| 95 If VAL is a coding system, it is used for both decoding and encoding | |
| 96 the file contents. | |
| 97 If VAL is a cons of coding systems, the car part is used for decoding, | |
| 98 and the cdr part is used for encoding. | |
| 99 If VAL is a function symbol, the function must return a coding system | |
| 100 or a cons of coding systems which are used as above. | |
| 101 | |
| 102 This overrides the more general specification in | |
| 103 `buffer-file-coding-system-for-read', but is overridden by | |
| 104 `coding-system-for-read'.") | |
| 105 | |
| 3950 | 106 (defun set-buffer-file-coding-system (coding-system &optional force nomodify) |
| 107 "Set the file coding-system of the current buffer to CODING-SYSTEM. | |
| 108 This means that when you save the buffer, it will be converted | |
| 109 according to CODING-SYSTEM. For a list of possible values of CODING-SYSTEM, | |
| 110 use \\[list-coding-systems]. | |
| 111 | |
| 112 If CODING-SYSTEM leaves the text conversion unspecified, or if it | |
| 113 leaves the end-of-line conversion unspecified, FORCE controls what to | |
| 114 do. If FORCE is nil, get the unspecified aspect (or aspects) from the | |
| 115 buffer's previous `buffer-file-coding-system' value (if it is | |
| 116 specified there). Otherwise, leave it unspecified. | |
| 117 | |
| 118 This marks the buffer modified so that the succeeding \\[save-buffer] | |
| 119 surely saves the buffer with CODING-SYSTEM. From a program, if you | |
| 120 don't want to mark the buffer modified, specify t for NOMODIFY. | |
| 121 If you know exactly what coding system you want to use, | |
| 122 just set the variable `buffer-file-coding-system' directly." | |
| 123 (interactive "zCoding system for saving file (default nil): \nP") | |
| 124 (check-coding-system coding-system) | |
| 125 (if (and coding-system buffer-file-coding-system (null force)) | |
| 126 (setq coding-system | |
| 428 | 127 (subsidiary-coding-system |
| 128 coding-system | |
| 129 (coding-system-eol-type buffer-file-coding-system)))) | |
| 3950 | 130 (setq buffer-file-coding-system coding-system) |
| 131 ;; XEmacs change; remove a call to ucs-set-table-for-input, which we don't | |
| 132 ;; have. | |
| 133 (unless nomodify | |
| 134 (set-buffer-modified-p t)) | |
| 135 (force-mode-line-update)) | |
| 428 | 136 |
| 137 (defun toggle-buffer-file-coding-system () | |
| 138 "Set EOL type of buffer-file-coding-system of the current buffer to | |
| 139 something other than what it is at the moment." | |
| 140 (interactive) | |
| 141 (let ((eol-type | |
| 142 (coding-system-eol-type buffer-file-coding-system))) | |
| 143 (setq buffer-file-coding-system | |
| 144 (subsidiary-coding-system | |
| 145 (coding-system-base buffer-file-coding-system) | |
| 146 (cond ((eq eol-type 'lf) 'crlf) | |
| 147 ((eq eol-type 'crlf) 'lf) | |
| 673 | 148 ((eq eol-type 'cr) 'lf)))) |
| 149 (set-buffer-modified-p t))) | |
| 428 | 150 |
| 151 (define-obsolete-function-alias | |
| 152 'set-file-coding-system | |
| 153 'set-buffer-file-coding-system) | |
| 154 | |
| 155 (defun set-buffer-file-coding-system-for-read (coding-system) | |
| 156 "Set the coding system used when reading in a file. | |
| 157 This is equivalent to setting the variable | |
| 158 `buffer-file-coding-system-for-read'. You can also use | |
| 159 `file-coding-system-alist' to specify the coding system for | |
| 160 particular files." | |
| 161 (interactive "zFile coding system for read: ") | |
| 162 (get-coding-system coding-system) ;; correctness check | |
| 163 (setq buffer-file-coding-system-for-read coding-system)) | |
| 164 | |
| 165 (define-obsolete-function-alias | |
| 166 'set-file-coding-system-for-read | |
| 167 'set-buffer-file-coding-system-for-read) | |
| 168 | |
| 169 (defun set-default-buffer-file-coding-system (coding-system) | |
| 170 "Set the default value of `buffer-file-coding-system' to CODING-SYSTEM. | |
| 171 The default value is used both for buffers without associated files | |
| 172 and for files with no apparent coding system (i.e. primarily ASCII). | |
| 173 See `buffer-file-coding-system' for more information." | |
| 174 (interactive "zDefault file coding system: ") | |
| 175 (setq-default buffer-file-coding-system coding-system) | |
| 176 (redraw-modeline t)) | |
| 177 | |
| 178 (define-obsolete-function-alias | |
| 179 'set-default-file-coding-system | |
| 180 'set-default-buffer-file-coding-system) | |
| 181 | |
| 182 (defun find-file-coding-system-for-read-from-filename (filename) | |
| 183 "Look up coding system to read a file in `file-coding-system-alist'. | |
| 184 The return value will be nil (no applicable entry) or a coding system | |
| 185 object (the entry specified a coding system)." | |
| 186 (let ((alist file-coding-system-alist) | |
| 187 (found nil) | |
| 188 (codesys nil)) | |
| 189 (let ((case-fold-search nil)) | |
| 190 (setq filename (file-name-sans-versions filename)) | |
| 191 (while (and (not found) alist) | |
| 192 (if (string-match (car (car alist)) filename) | |
| 193 (setq codesys (cdr (car alist)) | |
| 194 found t)) | |
| 195 (setq alist (cdr alist)))) | |
| 196 (when codesys | |
| 197 (if (functionp codesys) | |
| 198 (setq codesys (funcall codesys 'insert-file-contents filename)) | |
| 199 ) | |
| 200 (cond ((consp codesys) (find-coding-system (car codesys))) | |
| 201 ((find-coding-system codesys)) | |
| 202 )))) | |
| 203 | |
| 204 (define-obsolete-function-alias | |
| 205 'find-file-coding-system-from-filename | |
| 206 'find-file-coding-system-for-read-from-filename) | |
| 207 | |
| 208 (defun find-file-coding-system-for-write-from-filename (filename) | |
| 209 "Look up coding system to write a file in `file-coding-system-alist'. | |
| 210 The return value will be nil (no applicable entry) or a coding system | |
| 211 object (the entry specified a coding system)." | |
| 212 (let ((alist file-coding-system-alist) | |
| 213 (found nil) | |
| 214 (codesys nil)) | |
| 215 (let ((case-fold-search nil)) | |
| 216 (setq filename (file-name-sans-versions filename)) | |
| 217 (while (and (not found) alist) | |
| 218 (if (string-match (car (car alist)) filename) | |
| 219 (setq codesys (cdr (car alist)) | |
| 220 found t)) | |
| 221 (setq alist (cdr alist)))) | |
| 222 (when codesys | |
| 223 (if (functionp codesys) | |
| 224 (setq codesys (funcall codesys 'write-region filename)) | |
| 225 ) | |
| 226 (cond ((consp codesys) (find-coding-system (cdr codesys))) | |
| 227 ((find-coding-system codesys)) | |
| 228 )))) | |
| 229 | |
| 748 | 230 ;; This was completely broken, not only in implementation (does not |
| 442 | 231 ;; understand MIME), but in concept -- such high-level decoding should |
| 748 | 232 ;; be done by mail readers, not by IO code! Removed 2000-04-18. |
| 442 | 233 |
| 748 | 234 ;(defun convert-mbox-coding-system (filename visit start end) ...) |
| 428 | 235 |
|
4385
7a8c613ee283
Don't call substitute-in-file-name haphazardly.
Mike Sperber <sperber@deinprogramm.de>
parents:
4308
diff
changeset
|
236 (defun load (filename &optional noerror nomessage nosuffix) |
|
7a8c613ee283
Don't call substitute-in-file-name haphazardly.
Mike Sperber <sperber@deinprogramm.de>
parents:
4308
diff
changeset
|
237 "Execute a file of Lisp code named FILENAME, or load a binary module. |
|
7a8c613ee283
Don't call substitute-in-file-name haphazardly.
Mike Sperber <sperber@deinprogramm.de>
parents:
4308
diff
changeset
|
238 First tries to find a Lisp file FILENAME with .elc appended, then with .el, then with |
|
7a8c613ee283
Don't call substitute-in-file-name haphazardly.
Mike Sperber <sperber@deinprogramm.de>
parents:
4308
diff
changeset
|
239 FILENAME unmodified. If unsuccessful, tries to find a binary module FILE with |
| 1733 | 240 the elements of `module-extensions' appended, one at a time. |
| 241 Searches directories in load-path for Lisp files, and in `module-load-path' | |
| 883 | 242 for binary modules. |
| 428 | 243 If optional second arg NOERROR is non-nil, |
| 244 report no error if FILE doesn't exist. | |
| 245 Print messages at start and end of loading unless | |
| 246 optional third arg NOMESSAGE is non-nil. | |
| 1733 | 247 If optional fourth arg NOSUFFIX is non-nil, don't try adding suffixes |
| 248 .elc, .el, or elements of `module-extensions' to the specified name FILE. | |
| 428 | 249 Return t if file exists." |
| 1111 | 250 (declare (special load-modules-quietly)) |
|
5916
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
251 (let (handler path elc old (spaces "")) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
252 (cond |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
253 ;; Maybe there's a handler. |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
254 ((setq handler (find-file-name-handler filename 'load)) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
255 (funcall handler 'load filename noerror nomessage nosuffix)) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
256 ;; Nope, no handler. Try to load a Lisp file. |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
257 ((setq path |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
258 (locate-file (setq filename (substitute-in-file-name filename)) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
259 load-path (and (not nosuffix) '(".elc" ".el" "")))) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
260 (setq elc |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
261 (not (mismatch |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
262 ".elc" path :test (and (file-system-ignore-case-p path) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
263 #'equalp) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
264 :start2 (max 0 (- (length path) (length ".elc")))))) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
265 ;; Maybe the .elc is out of date with regard to the .el file. If so we |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
266 ;; may need to prefer the .el file, or just to warn. |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
267 (when (and elc (or load-ignore-out-of-date-elc-files |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
268 load-warn-when-source-newer) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
269 (file-newer-than-file-p (subseq path 0 -1) path)) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
270 (setq old (if load-show-full-path-in-messages |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
271 path |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
272 (file-name-nondirectory path)) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
273 nomessage (or nomessage t)) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
274 ;; Considered binding this within this function, but decided |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
275 ;; against it, since it's most used for debugging, and |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
276 ;; encountering an out-of-date-ELC file should happen rarely |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
277 ;; enough that the infelicity of the double-loading message is |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
278 ;; outweighed by the improvement in debugging: |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
279 ;load-always-display-messages nil) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
280 (if (and noninteractive load-in-progress) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
281 (setq spaces " ")) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
282 (when load-ignore-out-of-date-elc-files |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
283 (setq filename |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
284 (if (not (mismatch ".elc" filename |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
285 :start2 (max 0 (- (length filename) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
286 (length ".elc"))))) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
287 (subseq filename 0 -1) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
288 (concat filename ".elc")) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
289 path (locate-file filename load-path))) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
290 (message "%s%s %s... (file %s is out-of-date)" spaces |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
291 (if (eq nomessage 'require) "Requiring" "Loading") |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
292 (if load-show-full-path-in-messages path filename) old)) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
293 ;; Now use #'load-internal to actually load the file. |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
294 (prog1 |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
295 (load-internal |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
296 filename noerror nomessage nosuffix |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
297 (or (and (not elc) coding-system-for-read) ;; Prefer for source |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
298 ;; find magic-cookie |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
299 (let ((codesys |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
300 (find-coding-system-magic-cookie-in-file path))) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
301 (when codesys |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
302 (setq codesys (intern codesys)) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
303 (if (find-coding-system codesys) codesys))) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
304 (if elc |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
305 ;; If reading a byte-compiled file and we didn't find a |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
306 ;; coding-system magic cookie, then use `binary'. We need |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
307 ;; to guarantee that we never do autodetection on |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
308 ;; byte-compiled files because confusion here would be a |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
309 ;; very bad thing. Pre-existing byte-compiled files are |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
310 ;; always in the `binary' coding system. Also, |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
311 ;; byte-compiled files always use `lf' to terminate a |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
312 ;; line; don't risk confusion here either. |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
313 'binary |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
314 (or (find-file-coding-system-for-read-from-filename path) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
315 ;; looking up in `file-coding-system-alist'. otherwise |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
316 ;; use `buffer-file-coding-system-for-read', as normal |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
317 buffer-file-coding-system-for-read)))) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
318 (and old |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
319 (message "%s%s %s... done (file %s is out-of-date)" spaces |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
320 (if (eq nomessage 'require) "Requiring" "Loading") |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
321 (if load-show-full-path-in-messages path filename) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
322 old)))) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
323 ;; Maybe there's a module. |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
324 ((locate-file filename module-load-path |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
325 (and (not nosuffix) module-extensions)) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
326 (let ((load-modules-quietly nomessage)) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
327 ;; This will just error if we don't have module support, no need to |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
328 ;; error specially ourselves. |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
329 (declare-fboundp (load-module filename)))) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
330 ;; Maybe we can't find the file. |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
331 (t (and (not noerror) |
|
1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
332 (signal 'file-error (list "Cannot open load file" filename))))))) |
| 428 | 333 |
| 334 (defvar insert-file-contents-access-hook nil | |
| 335 "A hook to make a file accessible before reading it. | |
| 336 `insert-file-contents' calls this hook before doing anything else. | |
| 337 Called with two arguments: FILENAME and VISIT, the same as the | |
| 338 corresponding arguments in the call to `insert-file-contents'.") | |
| 339 | |
| 340 (defvar insert-file-contents-pre-hook nil | |
| 341 "A special hook to decide the coding system used for reading in a file. | |
| 342 | |
| 343 Before reading a file, `insert-file-contents' calls the functions on | |
| 344 this hook with arguments FILENAME and VISIT, the same as the | |
| 345 corresponding arguments in the call to `insert-file-contents'. In | |
| 346 these functions, you may refer to the global variable | |
| 347 `buffer-file-coding-system-for-read'. | |
| 348 | |
| 349 The return value of the functions should be either | |
| 350 | |
| 351 -- nil | |
| 352 -- A coding system or a symbol denoting it, indicating the coding system | |
| 353 to be used for reading the file | |
| 354 -- A list of two elements (absolute pathname and length of data inserted), | |
| 355 which is used as the return value to `insert-file-contents'. In this | |
| 356 case, `insert-file-contents' assumes that the function has inserted | |
| 357 the file for itself and suppresses further reading. | |
| 358 | |
| 359 If any function returns non-nil, the remaining functions are not called.") | |
| 360 | |
| 361 (defvar insert-file-contents-error-hook nil | |
| 362 "A hook to set `buffer-file-coding-system' when a read error has occurred. | |
| 363 | |
| 364 When a file error (e.g. nonexistent file) occurs while read a file, | |
| 365 `insert-file-contents' calls the functions on this hook with three | |
| 366 arguments: FILENAME and VISIT (the same as the corresponding arguments | |
| 367 in the call to `insert-file-contents') and a cons (SIGNALED-CONDITIONS | |
| 368 . SIGNAL-DATA). | |
| 369 | |
| 370 After calling this hook, the error is signalled for real and | |
| 371 propagates to the caller of `insert-file-contents'.") | |
| 372 | |
| 373 (defvar insert-file-contents-post-hook nil | |
| 374 "A hook to set `buffer-file-coding-system' for the current buffer. | |
| 375 | |
| 376 After successful reading, `insert-file-contents' calls the functions | |
| 377 on this hook with four arguments: FILENAME and VISIT (the same as the | |
| 378 corresponding arguments in the call to `insert-file-contents'), | |
| 379 CODING-SYSTEM (the actual coding system used to decode the file), and | |
| 380 a cons of absolute pathname and length of data inserted (the same | |
| 381 thing as will be returned from `insert-file-contents').") | |
| 382 | |
| 444 | 383 (defun insert-file-contents (filename &optional visit start end replace) |
| 428 | 384 "Insert contents of file FILENAME after point. |
| 385 Returns list of absolute file name and length of data inserted. | |
| 386 If second argument VISIT is non-nil, the buffer's visited filename | |
| 387 and last save file modtime are set, and it is marked unmodified. | |
| 388 If visiting and the file does not exist, visiting is completed | |
| 389 before the error is signaled. | |
| 390 | |
| 4205 | 391 The optional third and fourth arguments START and END specify what portion |
| 392 of the file to insert, and start at zero, in direct and needless contrast to | |
| 393 buffer offsets. That is, values of 0 and 10 for START and END respectively | |
| 394 will give the first ten octets of a file. | |
| 395 | |
| 444 | 396 If VISIT is non-nil, START and END must be nil. |
| 428 | 397 If optional fifth argument REPLACE is non-nil, |
| 398 it means replace the current buffer contents (in the accessible portion) | |
| 399 with the file contents. This is better than simply deleting and inserting | |
| 400 the whole thing because (1) it preserves some marker positions | |
| 401 and (2) it puts less data in the undo list. | |
| 402 | |
| 403 The coding system used for decoding the file is determined as follows: | |
| 404 | |
| 771 | 405 1. `coding-system-for-read', if non-nil. (Intended as a temporary overriding |
| 406 mechanism for use by Lisp code.) | |
| 407 2. The result of `insert-file-contents-pre-hook', if non-nil. (Intended for | |
| 408 handling tricky cases where the coding system of the file cannot be | |
| 409 determined just by looking at the filename's extension and the standard | |
| 410 auto-detection mechanism isn't suitable, so more clever code is required. | |
| 411 In general, this hook should rarely be used.) | |
| 412 3. The matching value for this filename from `file-coding-system-alist', | |
| 413 if any. (Intended as the standard way of determining encoding from | |
| 414 the name, or esp. the extension, of the file. Akin to the way | |
| 415 file-name extensions are used under MS Windows to determine how to | |
| 416 handle the file, but more flexible.) | |
| 417 4. `buffer-file-coding-system-for-read', if non-nil. (Intended to be where | |
| 418 the global default coding system is set. Usually, you want to use | |
| 419 the value `undecided', to let the system auto-detect according to the | |
| 420 priorities set up by `set-coding-priority-list'. This is usually | |
| 421 initialized from the `coding-system' property of the current language | |
| 422 environment.) | |
| 428 | 423 5. The coding system 'raw-text. |
| 424 | |
| 425 If a local value for `buffer-file-coding-system' in the current buffer | |
| 426 does not exist, it is set to the coding system which was actually used | |
| 427 for reading. | |
| 428 | |
| 771 | 429 #### This should explain in more detail the exact workings of the |
| 430 coding-system determination procedure. | |
| 431 | |
| 428 | 432 See also `insert-file-contents-access-hook', |
| 433 `insert-file-contents-pre-hook', `insert-file-contents-error-hook', | |
| 434 and `insert-file-contents-post-hook'." | |
|
4385
7a8c613ee283
Don't call substitute-in-file-name haphazardly.
Mike Sperber <sperber@deinprogramm.de>
parents:
4308
diff
changeset
|
435 (let ((handler (find-file-name-handler filename 'insert-file-contents))) |
| 3722 | 436 (if handler |
| 437 (funcall handler 'insert-file-contents filename visit start end replace) | |
| 438 (let (return-val coding-system used-codesys) | |
| 439 ;; OK, first load the file. | |
| 440 (condition-case err | |
| 441 (progn | |
| 442 (run-hook-with-args 'insert-file-contents-access-hook | |
| 443 filename visit) | |
| 444 ;; determine the coding system to use, as described above. | |
| 445 (setq coding-system | |
| 446 (or | |
| 447 ;; #1. | |
| 448 coding-system-for-read | |
| 449 ;; #2. | |
| 450 (run-hook-with-args-until-success | |
| 451 'insert-file-contents-pre-hook | |
| 452 filename visit) | |
| 453 ;; #3. | |
| 454 (find-file-coding-system-for-read-from-filename filename) | |
| 455 ;; #4. | |
| 456 buffer-file-coding-system-for-read | |
| 457 ;; #5. | |
| 458 'raw-text)) | |
| 459 (if (consp coding-system) | |
| 460 (setq return-val coding-system) | |
| 461 (if (null (find-coding-system coding-system)) | |
| 462 (progn | |
| 463 (lwarn 'coding-system 'notice | |
| 464 "Invalid coding-system (%s), using 'undecided" | |
| 465 coding-system) | |
| 466 (setq coding-system 'undecided))) | |
| 467 (setq return-val | |
| 468 (insert-file-contents-internal filename visit start end | |
| 469 replace coding-system | |
| 470 ;; store here! | |
| 471 'used-codesys)) | |
| 472 )) | |
| 473 (file-error | |
|
4650
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
474 ;; If we error, which we may if the file does not exist, we still |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
475 ;; want to set the buffer-file-coding-system if that is |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
476 ;; appropriate: |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
477 (when (eq 'undecided (coding-system-type coding-system)) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
478 (setq used-codesys (coding-system-property coding-system |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
479 'coding-system)) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
480 (if (and used-codesys |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
481 (not (eq 'undecided (coding-system-type used-codesys)))) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
482 ;; If this property is available, and not undecided, it should |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
483 ;; be a coding system that we can use to write a file (as |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
484 ;; opposed to the true undecided coding system, which trashes |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
485 ;; non-Latin-1 on writing). It might just be the value of |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
486 ;; coding-system passed to #'insert-file-contents-internal. |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
487 (setq coding-system used-codesys) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
488 ;; Otherwise, take the value normally specified by the |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
489 ;; language environment: |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
490 (setq coding-system (default-value |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
491 'buffer-file-coding-system)))) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
492 (if (local-variable-p 'buffer-file-coding-system |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
493 (current-buffer)) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
494 (set-buffer-file-coding-system |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
495 (subsidiary-coding-system |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
496 buffer-file-coding-system |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
497 (coding-system-eol-type coding-system)) t t) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
498 (set-buffer-file-coding-system coding-system t t)) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
499 (setq buffer-file-coding-system-when-loaded |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
500 coding-system) |
| 3722 | 501 (run-hook-with-args 'insert-file-contents-error-hook |
| 502 filename visit err) | |
| 503 (signal (car err) (cdr err)))) | |
| 504 (setq coding-system used-codesys) | |
|
4641
a90b63846dc4
Set buffer-file-coding-system more sensibly with zero-length files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4385
diff
changeset
|
505 ;; If the file was zero-length, used-codesys is undecided. Set it to |
|
a90b63846dc4
Set buffer-file-coding-system more sensibly with zero-length files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4385
diff
changeset
|
506 ;; a more sane value. |
|
a90b63846dc4
Set buffer-file-coding-system more sensibly with zero-length files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4385
diff
changeset
|
507 (when (eq 'undecided (coding-system-type coding-system)) |
|
a90b63846dc4
Set buffer-file-coding-system more sensibly with zero-length files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4385
diff
changeset
|
508 (unless (zerop (buffer-size)) |
|
a90b63846dc4
Set buffer-file-coding-system more sensibly with zero-length files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4385
diff
changeset
|
509 (warn "%s: autodetection failed: setting to default." |
|
a90b63846dc4
Set buffer-file-coding-system more sensibly with zero-length files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4385
diff
changeset
|
510 (file-name-nondirectory (buffer-file-name)))) |
|
4650
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
511 (setq used-codesys (coding-system-property coding-system |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
512 'coding-system)) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
513 (if (and used-codesys |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
514 (not (eq 'undecided (coding-system-type used-codesys)))) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
515 ;; If this property is available, and not undecided, it should |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
516 ;; be a coding system that we can use to write a file (as |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
517 ;; opposed to the true undecided coding system, which trashes |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
518 ;; non-Latin-1 on writing). It might just be the value of |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
519 ;; coding-system passed to #'insert-file-contents-internal. |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
520 (setq coding-system used-codesys) |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
521 ;; Otherwise, take the value normally specified by the |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
522 ;; language environment: |
|
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
523 (setq coding-system (default-value 'buffer-file-coding-system)))) |
| 3722 | 524 ;; call any `post-read-conversion' for the coding system that |
| 525 ;; was used ... | |
| 526 (let ((func | |
| 527 (coding-system-property coding-system 'post-read-conversion)) | |
| 528 (endmark (make-marker))) | |
| 529 (set-marker endmark (+ (point) (nth 1 return-val))) | |
| 530 (if func | |
| 531 (unwind-protect | |
| 532 (save-excursion | |
| 533 (let (buffer-read-only) | |
| 534 (if (>= (function-max-args func) 2) | |
| 535 ;; #### fuckme! Someone at FSF changed the calling | |
| 536 ;; convention of post-read-conversion. We try to | |
| 537 ;; support the old way. #### Should we kill this? | |
| 538 (funcall func (point) (marker-position endmark)) | |
| 539 (funcall func (- (marker-position endmark) (point)))))) | |
| 540 (if visit | |
| 541 (progn | |
| 542 (set-buffer-auto-saved) | |
| 543 (set-buffer-modified-p nil))))) | |
| 544 (setcar (cdr return-val) (- (marker-position endmark) (point)))) | |
| 545 ;; now finally set the buffer's `buffer-file-coding-system' ... | |
| 546 (if (run-hook-with-args-until-success 'insert-file-contents-post-hook | |
| 547 filename visit return-val) | |
| 548 nil | |
| 549 (if (local-variable-p 'buffer-file-coding-system (current-buffer)) | |
| 550 ;; if buffer-file-coding-system is already local, just | |
| 551 ;; set its eol type to what was found, if it wasn't | |
| 552 ;; set already. | |
| 553 (set-buffer-file-coding-system | |
| 3950 | 554 (subsidiary-coding-system |
| 555 buffer-file-coding-system | |
| 556 (coding-system-eol-type coding-system)) t t) | |
| 3722 | 557 ;; otherwise actually set buffer-file-coding-system. |
| 3950 | 558 (set-buffer-file-coding-system coding-system t t))) |
| 3722 | 559 ;; ... and `buffer-file-coding-system-when-loaded'. the machinations |
| 560 ;; of set-buffer-file-coding-system cause the actual coding system | |
| 561 ;; object to be stored, so do that here, too. | |
| 562 (setq buffer-file-coding-system-when-loaded | |
| 563 (get-coding-system coding-system)) | |
| 564 return-val)))) | |
| 428 | 565 |
| 566 (defvar write-region-pre-hook nil | |
| 567 "A special hook to decide the coding system used for writing out a file. | |
| 568 | |
| 748 | 569 Before writing a file, `write-region' calls the functions on this hook with |
| 863 | 570 arguments START, END, FILENAME, APPEND, VISIT, LOCKNAME and CODING-SYSTEM, |
| 748 | 571 the same as the corresponding arguments in the call to `write-region'. |
| 428 | 572 |
| 748 | 573 The return value of each function should be one of |
| 428 | 574 |
| 575 -- nil | |
| 576 -- A coding system or a symbol denoting it, indicating the coding system | |
| 863 | 577 to be used for writing the file |
| 428 | 578 -- A list of two elements (absolute pathname and length of data written), |
| 863 | 579 which is used as the return value to `write-region'. In this case, |
| 580 `write-region' assumes that the function has written the file and | |
| 581 returns. | |
| 428 | 582 |
| 583 If any function returns non-nil, the remaining functions are not called.") | |
| 584 | |
| 585 (defvar write-region-post-hook nil | |
| 586 "A hook called by `write-region' after a file has been written out. | |
| 587 | |
| 588 The functions on this hook are called with arguments START, END, | |
| 748 | 589 FILENAME, APPEND, VISIT, LOCKNAME, and CODING-SYSTEM, the same as the |
| 428 | 590 corresponding arguments in the call to `write-region'.") |
| 591 | |
| 4308 | 592 (defun write-region (start end filename &optional append visit lockname |
| 4266 | 593 coding-system-or-mustbenew) |
| 428 | 594 "Write current region into specified file. |
| 4308 | 595 Called interactively, prompts for a file name. |
| 596 With a prefix arg, prompts for a coding system as well. | |
| 748 | 597 |
| 598 When called from a program, takes three required arguments: | |
| 428 | 599 START, END and FILENAME. START and END are buffer positions. |
| 4308 | 600 APPEND, if non-nil, means append to existing file contents (if any), else |
| 601 the file's existing contents are replaced by the specified region. | |
| 602 VISIT, if non-nil, should be a string naming a file. The buffer is marked | |
| 603 as visiting VISIT. VISIT is also the file name to lock | |
| 604 and unlock for clash detection. | |
| 605 LOCKNAME, if non-nil, specifies the name to use for locking and unlocking, | |
| 606 overriding FILENAME and VISIT. | |
| 607 CODING-SYSTEM-OR-MUSTBENEW specifies the coding system used to encode the | |
| 608 text written. It defaults to the value of `buffer-file-coding-system' | |
| 609 in the current buffer. | |
| 4266 | 610 |
| 4308 | 611 For compatibility with GNU Emacs, several arguments are overloaded: |
| 612 START may be a string, which is written to the file. END is ignored. | |
| 613 VISIT may take the value t, meaning to set last-save-file-modtime of buffer | |
| 614 to this file's modtime and mark buffer not modified. With any other | |
| 615 non-nil value of VISIT, suppress printing of the \"Wrote file\" message. | |
| 616 CODING-SYSTEM-OR-MUSTBENEW may be a non-nil, non-coding-system value. | |
| 617 If it is `excl' and FILENAME already exists, signal `file-already-exists'. | |
| 618 Otherwise, if FILENAME already exists, ask for confirmation before | |
| 619 writing, and signal `file-already-exists' if not confirmed. | |
| 4266 | 620 |
| 428 | 621 See also `write-region-pre-hook' and `write-region-post-hook'." |
| 622 (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ") | |
| 4266 | 623 (let (mustbenew coding-system func hook-result) |
| 624 (setq hook-result | |
| 625 (or coding-system-for-write | |
| 626 (run-hook-with-args-until-success | |
| 627 'write-region-pre-hook | |
| 628 start end filename append visit lockname | |
| 629 coding-system-or-mustbenew) | |
| 4271 | 630 (if (and coding-system-or-mustbenew |
| 631 (coding-system-p | |
| 632 (find-coding-system coding-system-or-mustbenew))) | |
| 633 coding-system-or-mustbenew) | |
| 4266 | 634 buffer-file-coding-system |
| 635 (find-file-coding-system-for-write-from-filename filename))) | |
| 636 (if (consp hook-result) | |
| 637 ;; One of the `write-region-pre-hook' functions wrote the file. | |
| 638 hook-result | |
| 639 ;; The hooks didn't do the work; do it ourselves. | |
| 4271 | 640 (setq hook-result (find-coding-system hook-result) |
| 641 mustbenew (unless (coding-system-p | |
| 642 (find-coding-system coding-system-or-mustbenew)) | |
| 4266 | 643 coding-system-or-mustbenew) |
| 644 coding-system (cond ((coding-system-p hook-result) hook-result) | |
| 645 ((null mustbenew) coding-system-or-mustbenew)) | |
| 646 func (coding-system-property coding-system 'pre-write-conversion)) | |
| 428 | 647 (if func |
| 648 (let ((curbuf (current-buffer)) | |
| 649 (tempbuf (generate-new-buffer " *temp-write-buffer*")) | |
| 650 (modif (buffer-modified-p))) | |
| 651 (unwind-protect | |
| 652 (save-excursion | |
| 653 (set-buffer tempbuf) | |
| 654 (erase-buffer) | |
| 655 (insert-buffer-substring curbuf start end) | |
| 656 (funcall func (point-min) (point-max)) | |
| 657 (write-region-internal (point-min) (point-max) filename | |
| 658 append | |
| 659 (if (eq visit t) nil visit) | |
| 660 lockname | |
| 4266 | 661 coding-system |
| 662 mustbenew)) | |
| 428 | 663 ;; leaving a buffer associated with file will cause problems |
| 664 ;; when next visiting. | |
| 665 (kill-buffer tempbuf) | |
| 666 (if (or visit (null modif)) | |
| 667 (progn | |
| 668 (set-buffer-auto-saved) | |
| 669 (set-buffer-modified-p nil) | |
| 670 (if (buffer-file-name) (set-visited-file-modtime)))))) | |
| 671 (write-region-internal start end filename append visit lockname | |
| 4266 | 672 coding-system mustbenew))) |
| 428 | 673 (run-hook-with-args 'write-region-post-hook |
| 674 start end filename append visit lockname | |
| 675 coding-system))) | |
| 676 | |
| 677 ;;; code-files.el ends here |