Mercurial > hg > xemacs-beta
annotate lisp/code-files.el @ 5561:9a93bc90b3bd
Add a defsetf for get-char-table, necessary for the tests in the last commit.
lisp/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (get-char-table): Add a defsetf for this.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 04 Sep 2011 20:35:31 +0100 |
| parents | 308d34e9f07d |
| children | 1152e0091f8c |
| 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)) |
|
4385
7a8c613ee283
Don't call substitute-in-file-name haphazardly.
Mike Sperber <sperber@deinprogramm.de>
parents:
4308
diff
changeset
|
251 (let ((handler (find-file-name-handler filename 'load)) |
|
7a8c613ee283
Don't call substitute-in-file-name haphazardly.
Mike Sperber <sperber@deinprogramm.de>
parents:
4308
diff
changeset
|
252 (path nil)) |
| 428 | 253 (if handler |
| 254 (funcall handler 'load filename noerror nomessage nosuffix) | |
| 883 | 255 ;; First try to load a Lisp file |
| 256 (if (and (> (length filename) 0) | |
| 257 (setq path (locate-file filename load-path | |
| 502 | 258 (and (not nosuffix) |
| 883 | 259 '(".elc" ".el" ""))))) |
| 260 ;; now use the internal load to actually load the file. | |
| 261 (load-internal | |
|
4385
7a8c613ee283
Don't call substitute-in-file-name haphazardly.
Mike Sperber <sperber@deinprogramm.de>
parents:
4308
diff
changeset
|
262 filename noerror nomessage nosuffix |
| 883 | 263 (let ((elc ; use string= instead of string-match to keep match-data. |
|
4385
7a8c613ee283
Don't call substitute-in-file-name haphazardly.
Mike Sperber <sperber@deinprogramm.de>
parents:
4308
diff
changeset
|
264 (equalp ".elc" (substring path -4)))) |
|
7a8c613ee283
Don't call substitute-in-file-name haphazardly.
Mike Sperber <sperber@deinprogramm.de>
parents:
4308
diff
changeset
|
265 (or (and (not elc) coding-system-for-read) ;prefer for source file |
| 883 | 266 ;; find magic-cookie |
| 267 (let ((codesys | |
| 268 (find-coding-system-magic-cookie-in-file path))) | |
| 269 (when codesys | |
| 270 (setq codesys (intern codesys)) | |
| 271 (if (find-coding-system codesys) codesys))) | |
| 272 (if elc | |
| 273 ;; if reading a byte-compiled file and we didn't find | |
| 274 ;; a coding-system magic cookie, then use `binary'. | |
| 275 ;; We need to guarantee that we never do autodetection | |
| 276 ;; on byte-compiled files because confusion here would | |
| 277 ;; be a very bad thing. Pre-existing byte-compiled | |
| 278 ;; files are always in the `binary' coding system. | |
| 279 ;; Also, byte-compiled files always use `lf' to terminate | |
| 280 ;; a line; don't risk confusion here either. | |
| 281 'binary | |
| 282 (or (find-file-coding-system-for-read-from-filename path) | |
| 283 ;; looking up in `file-coding-system-alist'. | |
| 284 ;; otherwise use `buffer-file-coding-system-for-read', | |
| 285 ;; as normal | |
| 286 buffer-file-coding-system-for-read) | |
| 287 )))) | |
| 288 ;; The file name is invalid, or we want to load a binary module | |
| 289 (if (and (> (length filename) 0) | |
| 996 | 290 (locate-file filename module-load-path |
| 1733 | 291 (and (not nosuffix) module-extensions))) |
| 883 | 292 (if (featurep 'modules) |
| 293 (let ((load-modules-quietly nomessage)) | |
| 1111 | 294 (declare-fboundp (load-module filename))) |
| 883 | 295 (signal 'file-error '("This XEmacs does not support modules"))) |
| 296 (and (null noerror) | |
| 297 (signal 'file-error (list "Cannot open load file" filename)))) | |
| 298 )))) | |
| 428 | 299 |
| 300 (defvar insert-file-contents-access-hook nil | |
| 301 "A hook to make a file accessible before reading it. | |
| 302 `insert-file-contents' calls this hook before doing anything else. | |
| 303 Called with two arguments: FILENAME and VISIT, the same as the | |
| 304 corresponding arguments in the call to `insert-file-contents'.") | |
| 305 | |
| 306 (defvar insert-file-contents-pre-hook nil | |
| 307 "A special hook to decide the coding system used for reading in a file. | |
| 308 | |
| 309 Before reading a file, `insert-file-contents' calls the functions on | |
| 310 this hook with arguments FILENAME and VISIT, the same as the | |
| 311 corresponding arguments in the call to `insert-file-contents'. In | |
| 312 these functions, you may refer to the global variable | |
| 313 `buffer-file-coding-system-for-read'. | |
| 314 | |
| 315 The return value of the functions should be either | |
| 316 | |
| 317 -- nil | |
| 318 -- A coding system or a symbol denoting it, indicating the coding system | |
| 319 to be used for reading the file | |
| 320 -- A list of two elements (absolute pathname and length of data inserted), | |
| 321 which is used as the return value to `insert-file-contents'. In this | |
| 322 case, `insert-file-contents' assumes that the function has inserted | |
| 323 the file for itself and suppresses further reading. | |
| 324 | |
| 325 If any function returns non-nil, the remaining functions are not called.") | |
| 326 | |
| 327 (defvar insert-file-contents-error-hook nil | |
| 328 "A hook to set `buffer-file-coding-system' when a read error has occurred. | |
| 329 | |
| 330 When a file error (e.g. nonexistent file) occurs while read a file, | |
| 331 `insert-file-contents' calls the functions on this hook with three | |
| 332 arguments: FILENAME and VISIT (the same as the corresponding arguments | |
| 333 in the call to `insert-file-contents') and a cons (SIGNALED-CONDITIONS | |
| 334 . SIGNAL-DATA). | |
| 335 | |
| 336 After calling this hook, the error is signalled for real and | |
| 337 propagates to the caller of `insert-file-contents'.") | |
| 338 | |
| 339 (defvar insert-file-contents-post-hook nil | |
| 340 "A hook to set `buffer-file-coding-system' for the current buffer. | |
| 341 | |
| 342 After successful reading, `insert-file-contents' calls the functions | |
| 343 on this hook with four arguments: FILENAME and VISIT (the same as the | |
| 344 corresponding arguments in the call to `insert-file-contents'), | |
| 345 CODING-SYSTEM (the actual coding system used to decode the file), and | |
| 346 a cons of absolute pathname and length of data inserted (the same | |
| 347 thing as will be returned from `insert-file-contents').") | |
| 348 | |
| 444 | 349 (defun insert-file-contents (filename &optional visit start end replace) |
| 428 | 350 "Insert contents of file FILENAME after point. |
| 351 Returns list of absolute file name and length of data inserted. | |
| 352 If second argument VISIT is non-nil, the buffer's visited filename | |
| 353 and last save file modtime are set, and it is marked unmodified. | |
| 354 If visiting and the file does not exist, visiting is completed | |
| 355 before the error is signaled. | |
| 356 | |
| 4205 | 357 The optional third and fourth arguments START and END specify what portion |
| 358 of the file to insert, and start at zero, in direct and needless contrast to | |
| 359 buffer offsets. That is, values of 0 and 10 for START and END respectively | |
| 360 will give the first ten octets of a file. | |
| 361 | |
| 444 | 362 If VISIT is non-nil, START and END must be nil. |
| 428 | 363 If optional fifth argument REPLACE is non-nil, |
| 364 it means replace the current buffer contents (in the accessible portion) | |
| 365 with the file contents. This is better than simply deleting and inserting | |
| 366 the whole thing because (1) it preserves some marker positions | |
| 367 and (2) it puts less data in the undo list. | |
| 368 | |
| 369 The coding system used for decoding the file is determined as follows: | |
| 370 | |
| 771 | 371 1. `coding-system-for-read', if non-nil. (Intended as a temporary overriding |
| 372 mechanism for use by Lisp code.) | |
| 373 2. The result of `insert-file-contents-pre-hook', if non-nil. (Intended for | |
| 374 handling tricky cases where the coding system of the file cannot be | |
| 375 determined just by looking at the filename's extension and the standard | |
| 376 auto-detection mechanism isn't suitable, so more clever code is required. | |
| 377 In general, this hook should rarely be used.) | |
| 378 3. The matching value for this filename from `file-coding-system-alist', | |
| 379 if any. (Intended as the standard way of determining encoding from | |
| 380 the name, or esp. the extension, of the file. Akin to the way | |
| 381 file-name extensions are used under MS Windows to determine how to | |
| 382 handle the file, but more flexible.) | |
| 383 4. `buffer-file-coding-system-for-read', if non-nil. (Intended to be where | |
| 384 the global default coding system is set. Usually, you want to use | |
| 385 the value `undecided', to let the system auto-detect according to the | |
| 386 priorities set up by `set-coding-priority-list'. This is usually | |
| 387 initialized from the `coding-system' property of the current language | |
| 388 environment.) | |
| 428 | 389 5. The coding system 'raw-text. |
| 390 | |
| 391 If a local value for `buffer-file-coding-system' in the current buffer | |
| 392 does not exist, it is set to the coding system which was actually used | |
| 393 for reading. | |
| 394 | |
| 771 | 395 #### This should explain in more detail the exact workings of the |
| 396 coding-system determination procedure. | |
| 397 | |
| 428 | 398 See also `insert-file-contents-access-hook', |
| 399 `insert-file-contents-pre-hook', `insert-file-contents-error-hook', | |
| 400 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
|
401 (let ((handler (find-file-name-handler filename 'insert-file-contents))) |
| 3722 | 402 (if handler |
| 403 (funcall handler 'insert-file-contents filename visit start end replace) | |
| 404 (let (return-val coding-system used-codesys) | |
| 405 ;; OK, first load the file. | |
| 406 (condition-case err | |
| 407 (progn | |
| 408 (run-hook-with-args 'insert-file-contents-access-hook | |
| 409 filename visit) | |
| 410 ;; determine the coding system to use, as described above. | |
| 411 (setq coding-system | |
| 412 (or | |
| 413 ;; #1. | |
| 414 coding-system-for-read | |
| 415 ;; #2. | |
| 416 (run-hook-with-args-until-success | |
| 417 'insert-file-contents-pre-hook | |
| 418 filename visit) | |
| 419 ;; #3. | |
| 420 (find-file-coding-system-for-read-from-filename filename) | |
| 421 ;; #4. | |
| 422 buffer-file-coding-system-for-read | |
| 423 ;; #5. | |
| 424 'raw-text)) | |
| 425 (if (consp coding-system) | |
| 426 (setq return-val coding-system) | |
| 427 (if (null (find-coding-system coding-system)) | |
| 428 (progn | |
| 429 (lwarn 'coding-system 'notice | |
| 430 "Invalid coding-system (%s), using 'undecided" | |
| 431 coding-system) | |
| 432 (setq coding-system 'undecided))) | |
| 433 (setq return-val | |
| 434 (insert-file-contents-internal filename visit start end | |
| 435 replace coding-system | |
| 436 ;; store here! | |
| 437 'used-codesys)) | |
| 438 )) | |
| 439 (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
|
440 ;; 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
|
441 ;; 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
|
442 ;; 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
|
443 (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
|
444 (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
|
445 '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
|
446 (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
|
447 (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
|
448 ;; 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
|
449 ;; 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
|
450 ;; 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
|
451 ;; 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
|
452 ;; 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
|
453 (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
|
454 ;; 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
|
455 ;; 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
|
456 (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
|
457 '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
|
458 (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
|
459 (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
|
460 (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
|
461 (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
|
462 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
|
463 (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
|
464 (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
|
465 (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
|
466 coding-system) |
| 3722 | 467 (run-hook-with-args 'insert-file-contents-error-hook |
| 468 filename visit err) | |
| 469 (signal (car err) (cdr err)))) | |
| 470 (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
|
471 ;; 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
|
472 ;; 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
|
473 (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
|
474 (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
|
475 (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
|
476 (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
|
477 (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
|
478 '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 (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
|
480 (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
|
481 ;; 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
|
482 ;; 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
|
483 ;; 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
|
484 ;; 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
|
485 ;; 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
|
486 (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
|
487 ;; 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
|
488 ;; 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
|
489 (setq coding-system (default-value 'buffer-file-coding-system)))) |
| 3722 | 490 ;; call any `post-read-conversion' for the coding system that |
| 491 ;; was used ... | |
| 492 (let ((func | |
| 493 (coding-system-property coding-system 'post-read-conversion)) | |
| 494 (endmark (make-marker))) | |
| 495 (set-marker endmark (+ (point) (nth 1 return-val))) | |
| 496 (if func | |
| 497 (unwind-protect | |
| 498 (save-excursion | |
| 499 (let (buffer-read-only) | |
| 500 (if (>= (function-max-args func) 2) | |
| 501 ;; #### fuckme! Someone at FSF changed the calling | |
| 502 ;; convention of post-read-conversion. We try to | |
| 503 ;; support the old way. #### Should we kill this? | |
| 504 (funcall func (point) (marker-position endmark)) | |
| 505 (funcall func (- (marker-position endmark) (point)))))) | |
| 506 (if visit | |
| 507 (progn | |
| 508 (set-buffer-auto-saved) | |
| 509 (set-buffer-modified-p nil))))) | |
| 510 (setcar (cdr return-val) (- (marker-position endmark) (point)))) | |
| 511 ;; now finally set the buffer's `buffer-file-coding-system' ... | |
| 512 (if (run-hook-with-args-until-success 'insert-file-contents-post-hook | |
| 513 filename visit return-val) | |
| 514 nil | |
| 515 (if (local-variable-p 'buffer-file-coding-system (current-buffer)) | |
| 516 ;; if buffer-file-coding-system is already local, just | |
| 517 ;; set its eol type to what was found, if it wasn't | |
| 518 ;; set already. | |
| 519 (set-buffer-file-coding-system | |
| 3950 | 520 (subsidiary-coding-system |
| 521 buffer-file-coding-system | |
| 522 (coding-system-eol-type coding-system)) t t) | |
| 3722 | 523 ;; otherwise actually set buffer-file-coding-system. |
| 3950 | 524 (set-buffer-file-coding-system coding-system t t))) |
| 3722 | 525 ;; ... and `buffer-file-coding-system-when-loaded'. the machinations |
| 526 ;; of set-buffer-file-coding-system cause the actual coding system | |
| 527 ;; object to be stored, so do that here, too. | |
| 528 (setq buffer-file-coding-system-when-loaded | |
| 529 (get-coding-system coding-system)) | |
| 530 return-val)))) | |
| 428 | 531 |
| 532 (defvar write-region-pre-hook nil | |
| 533 "A special hook to decide the coding system used for writing out a file. | |
| 534 | |
| 748 | 535 Before writing a file, `write-region' calls the functions on this hook with |
| 863 | 536 arguments START, END, FILENAME, APPEND, VISIT, LOCKNAME and CODING-SYSTEM, |
| 748 | 537 the same as the corresponding arguments in the call to `write-region'. |
| 428 | 538 |
| 748 | 539 The return value of each function should be one of |
| 428 | 540 |
| 541 -- nil | |
| 542 -- A coding system or a symbol denoting it, indicating the coding system | |
| 863 | 543 to be used for writing the file |
| 428 | 544 -- A list of two elements (absolute pathname and length of data written), |
| 863 | 545 which is used as the return value to `write-region'. In this case, |
| 546 `write-region' assumes that the function has written the file and | |
| 547 returns. | |
| 428 | 548 |
| 549 If any function returns non-nil, the remaining functions are not called.") | |
| 550 | |
| 551 (defvar write-region-post-hook nil | |
| 552 "A hook called by `write-region' after a file has been written out. | |
| 553 | |
| 554 The functions on this hook are called with arguments START, END, | |
| 748 | 555 FILENAME, APPEND, VISIT, LOCKNAME, and CODING-SYSTEM, the same as the |
| 428 | 556 corresponding arguments in the call to `write-region'.") |
| 557 | |
| 4308 | 558 (defun write-region (start end filename &optional append visit lockname |
| 4266 | 559 coding-system-or-mustbenew) |
| 428 | 560 "Write current region into specified file. |
| 4308 | 561 Called interactively, prompts for a file name. |
| 562 With a prefix arg, prompts for a coding system as well. | |
| 748 | 563 |
| 564 When called from a program, takes three required arguments: | |
| 428 | 565 START, END and FILENAME. START and END are buffer positions. |
| 4308 | 566 APPEND, if non-nil, means append to existing file contents (if any), else |
| 567 the file's existing contents are replaced by the specified region. | |
| 568 VISIT, if non-nil, should be a string naming a file. The buffer is marked | |
| 569 as visiting VISIT. VISIT is also the file name to lock | |
| 570 and unlock for clash detection. | |
| 571 LOCKNAME, if non-nil, specifies the name to use for locking and unlocking, | |
| 572 overriding FILENAME and VISIT. | |
| 573 CODING-SYSTEM-OR-MUSTBENEW specifies the coding system used to encode the | |
| 574 text written. It defaults to the value of `buffer-file-coding-system' | |
| 575 in the current buffer. | |
| 4266 | 576 |
| 4308 | 577 For compatibility with GNU Emacs, several arguments are overloaded: |
| 578 START may be a string, which is written to the file. END is ignored. | |
| 579 VISIT may take the value t, meaning to set last-save-file-modtime of buffer | |
| 580 to this file's modtime and mark buffer not modified. With any other | |
| 581 non-nil value of VISIT, suppress printing of the \"Wrote file\" message. | |
| 582 CODING-SYSTEM-OR-MUSTBENEW may be a non-nil, non-coding-system value. | |
| 583 If it is `excl' and FILENAME already exists, signal `file-already-exists'. | |
| 584 Otherwise, if FILENAME already exists, ask for confirmation before | |
| 585 writing, and signal `file-already-exists' if not confirmed. | |
| 4266 | 586 |
| 428 | 587 See also `write-region-pre-hook' and `write-region-post-hook'." |
| 588 (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ") | |
| 4266 | 589 (let (mustbenew coding-system func hook-result) |
| 590 (setq hook-result | |
| 591 (or coding-system-for-write | |
| 592 (run-hook-with-args-until-success | |
| 593 'write-region-pre-hook | |
| 594 start end filename append visit lockname | |
| 595 coding-system-or-mustbenew) | |
| 4271 | 596 (if (and coding-system-or-mustbenew |
| 597 (coding-system-p | |
| 598 (find-coding-system coding-system-or-mustbenew))) | |
| 599 coding-system-or-mustbenew) | |
| 4266 | 600 buffer-file-coding-system |
| 601 (find-file-coding-system-for-write-from-filename filename))) | |
| 602 (if (consp hook-result) | |
| 603 ;; One of the `write-region-pre-hook' functions wrote the file. | |
| 604 hook-result | |
| 605 ;; The hooks didn't do the work; do it ourselves. | |
| 4271 | 606 (setq hook-result (find-coding-system hook-result) |
| 607 mustbenew (unless (coding-system-p | |
| 608 (find-coding-system coding-system-or-mustbenew)) | |
| 4266 | 609 coding-system-or-mustbenew) |
| 610 coding-system (cond ((coding-system-p hook-result) hook-result) | |
| 611 ((null mustbenew) coding-system-or-mustbenew)) | |
| 612 func (coding-system-property coding-system 'pre-write-conversion)) | |
| 428 | 613 (if func |
| 614 (let ((curbuf (current-buffer)) | |
| 615 (tempbuf (generate-new-buffer " *temp-write-buffer*")) | |
| 616 (modif (buffer-modified-p))) | |
| 617 (unwind-protect | |
| 618 (save-excursion | |
| 619 (set-buffer tempbuf) | |
| 620 (erase-buffer) | |
| 621 (insert-buffer-substring curbuf start end) | |
| 622 (funcall func (point-min) (point-max)) | |
| 623 (write-region-internal (point-min) (point-max) filename | |
| 624 append | |
| 625 (if (eq visit t) nil visit) | |
| 626 lockname | |
| 4266 | 627 coding-system |
| 628 mustbenew)) | |
| 428 | 629 ;; leaving a buffer associated with file will cause problems |
| 630 ;; when next visiting. | |
| 631 (kill-buffer tempbuf) | |
| 632 (if (or visit (null modif)) | |
| 633 (progn | |
| 634 (set-buffer-auto-saved) | |
| 635 (set-buffer-modified-p nil) | |
| 636 (if (buffer-file-name) (set-visited-file-modtime)))))) | |
| 637 (write-region-internal start end filename append visit lockname | |
| 4266 | 638 coding-system mustbenew))) |
| 428 | 639 (run-hook-with-args 'write-region-post-hook |
| 640 start end filename append visit lockname | |
| 641 coding-system))) | |
| 642 | |
| 643 ;;; code-files.el ends here |