annotate lisp/code-files.el @ 5574:d4f334808463

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