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