Mercurial > hg > xemacs-beta
comparison lisp/files.el @ 1333:1b0339b048ce
[xemacs-hg @ 2003-03-02 09:38:37 by ben]
To: xemacs-patches@xemacs.org
PROBLEMS: Include nt/PROBLEMS and update. Add note about incremental
linking badness.
cmdloop.el, custom.el, dumped-lisp.el, files.el, keydefs.el, keymap.el, lisp-mode.el, make-docfile.el, replace.el, simple.el, subr.el, view-less.el, wid-edit.el: Lots of syncing with FSF 21.2.
Use if-fboundp in wid-edit.el.
New file newcomment.el from FSF.
internals/internals.texi: Fix typo.
(Build-Time Dependencies): New node.
PROBLEMS: Delete.
config.inc.samp, xemacs.mak: Eliminate HAVE_VC6, use SUPPORT_EDIT_AND_CONTINUE in its place.
No incremental linking unless SUPPORT_EDIT_AND_CONTINUE, since it
can cause nasty crashes in pdump. Put warnings about this in
config.inc.samp. Report the full compile flags used for src
and lib-src in the Installation output.
alloc.c, lisp.h, ralloc.c, regex.c: Use ALLOCA() in regex.c to avoid excessive stack allocation.
Also fix subtle problem with REL_ALLOC() -- any call to malloc()
(direct or indirect) may relocate rel-alloced data, causing
buffer text to shift. After any such call, regex must update
all its pointers to such data. Add a system, when
ERROR_CHECK_MALLOC, whereby regex.c indicates all the places
it is prepared to handle malloc()/realloc()/free(), and any
calls anywhere in XEmacs outside of this will trigger an abort.
alloc.c, dialog-msw.c, eval.c, event-stream.c, general-slots.h, insdel.c, lisp.h, menubar-msw.c, menubar-x.c: Change *run_hook*_trapping_problems to take a warning class, not
a string. Factor out code to issue warnings, add flag to
call_trapping_problems() to postpone warning issue, and make
*run_hook*_trapping_problems issue their own warnings tailored
to the hook, postponed in the case of safe_run_hook_trapping_problems()
so that the appropriate message can be issued about resetting to
nil only when not `quit'. Make record_unwind_protect_restoring_int()
non-static.
dumper.c: Issue notes about incremental linking problems under Windows.
fileio.c: Mule-ize encrypt/decrypt-string code.
text.h: Spacing changes.
author | ben |
---|---|
date | Sun, 02 Mar 2003 09:38:54 +0000 |
parents | ccaf90c5a53a |
children | 5f6cef39d81f |
comparison
equal
deleted
inserted
replaced
1332:6aa23bb3da6b | 1333:1b0339b048ce |
---|---|
1 ;;; files.el --- file input and output commands for XEmacs. | 1 ;;; files.el --- file input and output commands for XEmacs. |
2 | 2 |
3 ;; Copyright (C) 1985-1987, 1992-1995, 1997 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1985-1987, 1992-1995, 1997 Free Software Foundation, Inc. |
4 ;; Copyright (C) 1995 Sun Microsystems. | 4 ;; Copyright (C) 1995 Sun Microsystems. |
5 ;; Copyright (C) 2001, 2002 Ben Wing. | 5 ;; Copyright (C) 2001, 2002, 2003 Ben Wing. |
6 | 6 |
7 ;; Maintainer: XEmacs Development Team | 7 ;; Maintainer: XEmacs Development Team |
8 ;; Keywords: extensions, dumped | 8 ;; Keywords: extensions, dumped |
9 | 9 |
10 ;; This file is part of XEmacs. | 10 ;; This file is part of XEmacs. |
22 ;; You should have received a copy of the GNU General Public License | 22 ;; You should have received a copy of the GNU General Public License |
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free | 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free |
24 ;; Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA | 24 ;; Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA |
25 ;; 02111-1307, USA. | 25 ;; 02111-1307, USA. |
26 | 26 |
27 ;;; Synched up with: FSF 20.3 (but diverging) | 27 ;;; [[ Synched up with: FSF 20.3 (but diverging) |
28 ;;; Warning: Merging this file is tough. Beware. | 28 ;;; Warning: Merging this file is tough. Beware.]] |
29 | |
30 ;;; Beware of sync messages with 20.x or 21.x! (Unless I did them, of | |
31 ;;; course ... :-) Those who did these synchronizations did not do proper | |
32 ;;; jobs and often left out lots of changes. In practice you need to do a | |
33 ;;; line-by-line comparison, and whenever encountering differences, see | |
34 ;;; what FSF 19.34 looks like to see if the changes are intentional or just | |
35 ;;; regressions. In at least one case below, our code was unchanged from | |
36 ;;; FSF 19.30! --ben | |
37 | |
38 ;;; Mostly synched to FSF 21.2 by Ben Wing using a line-by-line comparison, | |
39 ;;; except some really hard parts that have changed almost completely. | |
29 | 40 |
30 ;;; Commentary: | 41 ;;; Commentary: |
31 | 42 |
32 ;; This file is dumped with XEmacs. | 43 ;; This file is dumped with XEmacs. |
44 | |
45 ;; BEGIN SYNC WITH FSF 21.2. | |
33 | 46 |
34 ;; Defines most of XEmacs's file- and directory-handling functions, | 47 ;; Defines most of XEmacs's file- and directory-handling functions, |
35 ;; including basic file visiting, backup generation, link handling, | 48 ;; including basic file visiting, backup generation, link handling, |
36 ;; ITS-id version control, load- and write-hook handling, and the like. | 49 ;; ITS-id version control, load- and write-hook handling, and the like. |
37 | 50 |
51 | 64 |
52 (defgroup find-file nil | 65 (defgroup find-file nil |
53 "Finding and editing files." | 66 "Finding and editing files." |
54 :group 'files) | 67 :group 'files) |
55 | 68 |
56 | 69 ;; XEmacs: In buffer.c (also) |
57 ;; XEmacs: In buffer.c | 70 (defcustom delete-auto-save-files t |
58 ;(defconst delete-auto-save-files t | 71 "*Non-nil means delete auto-save file when a buffer is saved or killed. |
59 ; "*Non-nil means delete auto-save file when a buffer is saved or killed.") | 72 |
73 Note that auto-save file will not be deleted if the buffer is killed | |
74 when it has unsaved changes." | |
75 :type 'boolean | |
76 :group 'auto-save) | |
60 | 77 |
61 ;; FSF has automount-dir-prefix. Our directory-abbrev-alist is more general. | 78 ;; FSF has automount-dir-prefix. Our directory-abbrev-alist is more general. |
62 ;; note: tmp_mnt bogosity conversion is established in paths.el. | 79 ;; note: tmp_mnt bogosity conversion is established in paths.el. |
63 (defcustom directory-abbrev-alist nil | 80 (defcustom directory-abbrev-alist nil |
64 "*Alist of abbreviations for file directories. | 81 "*Alist of abbreviations for file directories. |
65 A list of elements of the form (FROM . TO), each meaning to replace | 82 A list of elements of the form (FROM . TO), each meaning to replace |
66 FROM with TO when it appears in a directory name. | 83 FROM with TO when it appears in a directory name. |
67 This replacement is done when setting up the default directory of a | 84 This replacement is done when setting up the default directory of a |
68 newly visited file. *Every* FROM string should start with \\\\` or ^. | 85 newly visited file. *Every* FROM string should start with \\\\` or ^. |
86 | |
87 Do not use `~' in the TO strings. | |
88 They should be ordinary absolute directory names. | |
69 | 89 |
70 Use this feature when you have directories which you normally refer to | 90 Use this feature when you have directories which you normally refer to |
71 via absolute symbolic links or to eliminate automounter mount points | 91 via absolute symbolic links or to eliminate automounter mount points |
72 from the beginning of your filenames. Make TO the name of the link, | 92 from the beginning of your filenames. Make TO the name of the link, |
73 and FROM the name it is linked to." | 93 and FROM the name it is linked to." |
91 names that the old file had will now refer to the new (edited) file. | 111 names that the old file had will now refer to the new (edited) file. |
92 The file's owner and group are unchanged. | 112 The file's owner and group are unchanged. |
93 | 113 |
94 The choice of renaming or copying is controlled by the variables | 114 The choice of renaming or copying is controlled by the variables |
95 `backup-by-copying', `backup-by-copying-when-linked' and | 115 `backup-by-copying', `backup-by-copying-when-linked' and |
96 `backup-by-copying-when-mismatch'. See also `backup-inhibited'." | 116 `backup-by-copying-when-mismatch' and |
117 `backup-by-copying-when-privileged-mismatch'. See also `backup-inhibited'." | |
97 :type 'boolean | 118 :type 'boolean |
98 :group 'backup) | 119 :group 'backup) |
99 | 120 |
100 ;; Do this so that local variables based on the file name | 121 ;; Do this so that local variables based on the file name |
101 ;; are not overridden by the major mode. | 122 ;; are not overridden by the major mode. |
126 the default for a new file created there by you. | 147 the default for a new file created there by you. |
127 This variable is relevant only if `backup-by-copying' is nil." | 148 This variable is relevant only if `backup-by-copying' is nil." |
128 :type 'boolean | 149 :type 'boolean |
129 :group 'backup) | 150 :group 'backup) |
130 | 151 |
131 (defvar backup-enable-predicate | 152 (defcustom backup-by-copying-when-privileged-mismatch 200 |
132 #'(lambda (name) | 153 "*Non-nil means create backups by copying to preserve a privileged owner. |
133 (not (or (null name) | 154 Renaming may still be used (subject to control of other variables) |
134 (string-match "^/tmp/" name) | 155 when it would not result in changing the owner of the file or if the owner |
135 (let ((tmpdir (temp-directory))) | 156 has a user id greater than the value of this variable. This is useful |
136 (and tmpdir | 157 when low-numbered uid's are used for special system users (such as root) |
137 (string-match (concat "\\`" (regexp-quote tmpdir) "/") | 158 that must maintain ownership of certain files. |
138 tmpdir)))))) | 159 This variable is relevant only if `backup-by-copying' and |
160 `backup-by-copying-when-mismatch' are nil." | |
161 :type '(choice (const nil) integer) | |
162 :group 'backup) | |
163 | |
164 (defun normal-backup-enable-predicate (name) | |
165 "Default `backup-enable-predicate' function. | |
166 Checks for files in `temporary-file-directory' or | |
167 `small-temporary-file-directory'." | |
168 (let ((temporary-file-directory (temp-directory))) | |
169 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil | |
170 name 0 nil))) | |
171 ;; Directory is under temporary-file-directory. | |
172 (and (not (eq comp t)) | |
173 (< comp (- (length temporary-file-directory))))) | |
174 (if small-temporary-file-directory | |
175 (let ((comp (compare-strings small-temporary-file-directory | |
176 0 nil | |
177 name 0 nil))) | |
178 ;; Directory is under small-temporary-file-directory. | |
179 (and (not (eq comp t)) | |
180 (< comp (- (length small-temporary-file-directory)))))))))) | |
181 | |
182 (defvar backup-enable-predicate 'normal-backup-enable-predicate | |
139 "Predicate that looks at a file name and decides whether to make backups. | 183 "Predicate that looks at a file name and decides whether to make backups. |
140 Called with an absolute file name as argument, it returns t to enable backup.") | 184 Called with an absolute file name as argument, it returns t to enable backup.") |
141 | 185 |
142 (defcustom buffer-offer-save nil | 186 (defcustom buffer-offer-save nil |
143 "*Non-nil in a buffer means offer to save the buffer on exit | 187 "*Non-nil in a buffer means always offer to save buffer on exit. |
144 even if the buffer is not visiting a file. | 188 Do so even if the buffer is not visiting a file. |
145 Automatically local in all buffers." | 189 Automatically local in all buffers." |
146 :type 'boolean | 190 :type 'boolean |
147 :group 'find-file) | 191 :group 'find-file) |
148 (make-variable-buffer-local 'buffer-offer-save) | 192 (make-variable-buffer-local 'buffer-offer-save) |
149 | 193 |
169 (put 'buffer-file-number 'permanent-local t) | 213 (put 'buffer-file-number 'permanent-local t) |
170 | 214 |
171 (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt))) | 215 (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt))) |
172 "Non-nil means that buffer-file-number uniquely identifies files.") | 216 "Non-nil means that buffer-file-number uniquely identifies files.") |
173 | 217 |
218 ;; FSF 21.2. We use (temp-directory). | |
219 ; (defvar temporary-file-directory | |
220 ; (file-name-as-directory | |
221 ; (cond ((memq system-type '(ms-dos windows-nt)) | |
222 ; (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp")) | |
223 ; ((memq system-type '(vax-vms axp-vms)) | |
224 ; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:")) | |
225 ; (t | |
226 ; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) | |
227 ; "The directory for writing temporary files.") | |
228 | |
229 (defvar small-temporary-file-directory | |
230 (if (eq system-type 'ms-dos) (getenv "TMPDIR")) | |
231 "The directory for writing small temporary files. | |
232 If non-nil, this directory is used instead of `temporary-file-directory' | |
233 by programs that create small temporary files. This is for systems that | |
234 have fast storage with limited space, such as a RAM disk.") | |
235 | |
236 ;; The system null device. (Should reference NULL_DEVICE from C.) | |
237 (defvar null-device "/dev/null" "The system null device.") | |
238 | |
239 ; (defvar file-name-invalid-regexp | |
240 ; (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names))) | |
241 ; (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive | |
242 ; "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters | |
243 ; "[\000-\031]\\|" ; control characters | |
244 ; "\\(/\\.\\.?[^/]\\)\\|" ; leading dots | |
245 ; "\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot | |
246 ; ((memq system-type '(ms-dos windows-nt)) | |
247 ; (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive | |
248 ; "[|<>\"?*\000-\031]")) ; invalid characters | |
249 ; (t "[\000]")) | |
250 ; "Regexp recognizing file names which aren't allowed by the filesystem.") | |
251 | |
174 (defcustom file-precious-flag nil | 252 (defcustom file-precious-flag nil |
175 "*Non-nil means protect against I/O errors while saving files. | 253 "*Non-nil means protect against I/O errors while saving files. |
176 Some modes set this non-nil in particular buffers. | 254 Some modes set this non-nil in particular buffers. |
177 | 255 |
178 This feature works by writing the new contents into a temporary file | 256 This feature works by writing the new contents into a temporary file |
189 (defcustom version-control nil | 267 (defcustom version-control nil |
190 "*Control use of version numbers for backup files. | 268 "*Control use of version numbers for backup files. |
191 t means make numeric backup versions unconditionally. | 269 t means make numeric backup versions unconditionally. |
192 nil means make them for files that have some already. | 270 nil means make them for files that have some already. |
193 `never' means do not make them." | 271 `never' means do not make them." |
194 :type 'boolean | 272 :type '(choice (const :tag "Never" never) |
273 (const :tag "If existing" nil) | |
274 (other :tag "Always" t)) | |
195 :group 'backup | 275 :group 'backup |
196 :group 'vc) | 276 :group 'vc) |
197 | 277 |
198 ;; This is now defined in efs. | 278 ;; This is now defined in efs. |
199 ;(defvar dired-kept-versions 2 | 279 ; (defcustom dired-kept-versions 2 |
200 ; "*When cleaning directory, number of versions to keep.") | 280 ; "*When cleaning directory, number of versions to keep." |
281 ; :type 'integer | |
282 ; :group 'backup | |
283 ; :group 'dired) | |
201 | 284 |
202 (defcustom delete-old-versions nil | 285 (defcustom delete-old-versions nil |
203 "*If t, delete excess backup versions silently. | 286 "*If t, delete excess backup versions silently. |
204 If nil, ask confirmation. Any other value prevents any trimming." | 287 If nil, ask confirmation. Any other value prevents any trimming." |
205 :type '(choice (const :tag "Delete" t) | 288 :type '(choice (const :tag "Delete" t) |
236 "*Non-nil says auto-save a buffer in the file it is visiting, when practical. | 319 "*Non-nil says auto-save a buffer in the file it is visiting, when practical. |
237 Normally auto-save files are written under other names." | 320 Normally auto-save files are written under other names." |
238 :type 'boolean | 321 :type 'boolean |
239 :group 'auto-save) | 322 :group 'auto-save) |
240 | 323 |
324 (defcustom auto-save-file-name-transforms | |
325 `(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)" | |
326 ,(expand-file-name "\\2" (temp-directory)))) | |
327 "*Transforms to apply to buffer file name before making auto-save file name. | |
328 Each transform is a list (REGEXP REPLACEMENT): | |
329 REGEXP is a regular expression to match against the file name. | |
330 If it matches, `replace-match' is used to replace the | |
331 matching part with REPLACEMENT. | |
332 All the transforms in the list are tried, in the order they are listed. | |
333 When one transform applies, its result is final; | |
334 no further transforms are tried. | |
335 | |
336 The default value is set up to put the auto-save file into the | |
337 temporary directory (see the variable `temporary-file-directory') for | |
338 editing a remote file." | |
339 :group 'auto-save | |
340 :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement"))) | |
341 ;:version "21.1" | |
342 ) | |
343 | |
241 (defcustom save-abbrevs nil | 344 (defcustom save-abbrevs nil |
242 "*Non-nil means save word abbrevs too when files are saved. | 345 "*Non-nil means save word abbrevs too when files are saved. |
243 Loading an abbrev file sets this to t." | 346 If `silently', don't ask the user before saving. |
244 :type 'boolean | 347 Loading an abbrev file sets this to t." |
245 :group 'abbrev) | 348 :type '(choice (const t) (const nil) (const silently)) |
246 | 349 :group 'abbrev) |
350 | |
247 (defcustom find-file-run-dired t | 351 (defcustom find-file-run-dired t |
248 "*Non-nil says run dired if `find-file' is given the name of a directory." | 352 "*Non-nil means allow `find-file' to visit directories. |
249 :type 'boolean | 353 To visit the directory, `find-file' runs `find-directory-functions'." |
354 :type 'boolean | |
355 :group 'find-file) | |
356 | |
357 (defcustom find-directory-functions '(cvs-dired-noselect dired-noselect) | |
358 "*List of functions to try in sequence to visit a directory. | |
359 Each function is called with the directory name as the sole argument | |
360 and should return either a buffer or nil." | |
361 :type '(hook :options (cvs-dired-noselect dired-noselect)) | |
250 :group 'find-file) | 362 :group 'find-file) |
251 | 363 |
252 ;;;It is not useful to make this a local variable. | 364 ;;;It is not useful to make this a local variable. |
253 ;;;(put 'find-file-not-found-hooks 'permanent-local t) | 365 ;;;(put 'find-file-not-found-hooks 'permanent-local t) |
254 (defvar find-file-not-found-hooks nil | 366 (defvar find-file-not-found-hooks nil |
255 "List of functions to be called for `find-file' on nonexistent file. | 367 "List of functions to be called for `find-file' on nonexistent file. |
256 These functions are called as soon as the error is detected. | 368 These functions are called as soon as the error is detected. |
257 `buffer-file-name' is already set up. | 369 Variable `buffer-file-name' is already set up. |
258 The functions are called in the order given until one of them returns non-nil.") | 370 The functions are called in the order given until one of them returns non-nil.") |
259 | 371 |
260 ;;;It is not useful to make this a local variable. | 372 ;;;It is not useful to make this a local variable. |
261 ;;;(put 'find-file-hooks 'permanent-local t) | 373 ;;;(put 'find-file-hooks 'permanent-local t) |
262 (defvar find-file-hooks nil | 374 (defvar find-file-hooks nil |
267 (defvar write-file-hooks nil | 379 (defvar write-file-hooks nil |
268 "List of functions to be called before writing out a buffer to a file. | 380 "List of functions to be called before writing out a buffer to a file. |
269 If one of them returns non-nil, the file is considered already written | 381 If one of them returns non-nil, the file is considered already written |
270 and the rest are not called. | 382 and the rest are not called. |
271 These hooks are considered to pertain to the visited file. | 383 These hooks are considered to pertain to the visited file. |
272 So this list is cleared if you change the visited file name. | 384 So any buffer-local binding of `write-file-hooks' is |
385 discarded if you change the visited file name with \\[set-visited-file-name]. | |
386 | |
387 Don't make this variable buffer-local; instead, use `local-write-file-hooks'. | |
273 See also `write-contents-hooks' and `continue-save-buffer'.") | 388 See also `write-contents-hooks' and `continue-save-buffer'.") |
274 ;;; However, in case someone does make it local... | 389 ;;; However, in case someone does make it local... |
275 (put 'write-file-hooks 'permanent-local t) | 390 (put 'write-file-hooks 'permanent-local t) |
276 | 391 |
277 (defvar local-write-file-hooks nil | 392 (defvar local-write-file-hooks nil |
300 | 415 |
301 (defvar write-contents-hooks nil | 416 (defvar write-contents-hooks nil |
302 "List of functions to be called before writing out a buffer to a file. | 417 "List of functions to be called before writing out a buffer to a file. |
303 If one of them returns non-nil, the file is considered already written | 418 If one of them returns non-nil, the file is considered already written |
304 and the rest are not called. | 419 and the rest are not called. |
305 These hooks are considered to pertain to the buffer's contents, | 420 |
306 not to the particular visited file; thus, `set-visited-file-name' does | 421 This variable is meant to be used for hooks that pertain to the |
307 not clear this variable, but changing the major mode does clear it. | 422 buffer's contents, not to the particular visited file; thus, |
423 `set-visited-file-name' does not clear this variable; but changing the | |
424 major mode does clear it. | |
425 | |
426 This variable automatically becomes buffer-local whenever it is set. | |
427 If you use `add-hook' to add elements to the list, use nil for the | |
428 LOCAL argument. | |
429 | |
308 See also `write-file-hooks' and `continue-save-buffer'.") | 430 See also `write-file-hooks' and `continue-save-buffer'.") |
431 (make-variable-buffer-local 'write-contents-hooks) | |
309 | 432 |
310 ;; XEmacs addition | 433 ;; XEmacs addition |
311 ;; Energize needed this to hook into save-buffer at a lower level; we need | 434 ;; Energize needed this to hook into save-buffer at a lower level; we need |
312 ;; to provide a new output method, but don't want to have to duplicate all | 435 ;; to provide a new output method, but don't want to have to duplicate all |
313 ;; of the backup file and file modes logic.that does not occur if one uses | 436 ;; of the backup file and file modes logic.that does not occur if one uses |
319 The default behavior is to call | 442 The default behavior is to call |
320 (write-region (point-min) (point-max) filename nil t) | 443 (write-region (point-min) (point-max) filename nil t) |
321 If one of them returns non-nil, the file is considered already written | 444 If one of them returns non-nil, the file is considered already written |
322 and the rest are not called. | 445 and the rest are not called. |
323 These hooks are considered to pertain to the visited file. | 446 These hooks are considered to pertain to the visited file. |
324 So this list is cleared if you change the visited file name. | 447 So any buffer-local binding of `write-file-data-hooks' is |
448 discarded if you change the visited file name with \\[set-visited-file-name]. | |
325 See also `write-file-hooks'.") | 449 See also `write-file-hooks'.") |
326 | 450 |
327 (defcustom enable-local-variables t | 451 (defcustom enable-local-variables t |
328 "*Control use of local-variables lists in files you visit. | 452 "*Control use of local variables in files you visit. |
329 The value can be t, nil or something else. | 453 The value can be t, nil or something else. |
330 A value of t means local-variables lists are obeyed; | 454 A value of t means file local variables specifications are obeyed; |
331 nil means they are ignored; anything else means query. | 455 nil means they are ignored; anything else means query. |
456 This variable also controls use of major modes specified in | |
457 a -*- line. | |
458 | |
459 The command \\[normal-mode], when used interactively, | |
460 always obeys file local variable specifications and the -*- line, | |
461 and ignores this variable." | |
462 :type '(choice (const :tag "Obey" t) | |
463 (const :tag "Ignore" nil) | |
464 (sexp :tag "Query" :format "%t\n" other)) | |
465 :group 'find-file) | |
466 | |
467 ; (defvar local-enable-local-variables t | |
468 ; "Like `enable-local-variables' but meant for buffer-local bindings. | |
469 ; The meaningful values are nil and non-nil. The default is non-nil. | |
470 ; If a major mode sets this to nil, buffer-locally, then any local | |
471 ; variables list in the file will be ignored. | |
472 | |
473 ; This variable does not affect the use of major modes | |
474 ; specified in a -*- line.") | |
475 | |
476 (defcustom enable-local-eval 'maybe | |
477 "*Control processing of the \"variable\" `eval' in a file's local variables. | |
478 The value can be t, nil or something else. | |
479 A value of t means obey `eval' variables; | |
480 nil means ignore them; anything else means query. | |
332 | 481 |
333 The command \\[normal-mode] always obeys local-variables lists | 482 The command \\[normal-mode] always obeys local-variables lists |
334 and ignores this variable." | 483 and ignores this variable." |
335 :type '(choice (const :tag "Obey" t) | 484 :type '(choice (const :tag "Obey" t) |
336 (const :tag "Ignore" nil) | 485 (const :tag "Ignore" nil) |
337 (sexp :tag "Query" :format "%t\n" other)) | 486 (sexp :tag "Query" :format "%t\n" other)) |
338 :group 'find-file) | 487 :group 'find-file) |
339 | 488 |
340 (defcustom enable-local-eval 'maybe | |
341 "*Control processing of the \"variable\" `eval' in a file's local variables. | |
342 The value can be t, nil or something else. | |
343 A value of t means obey `eval' variables; | |
344 nil means ignore them; anything else means query. | |
345 | |
346 The command \\[normal-mode] always obeys local-variables lists | |
347 and ignores this variable." | |
348 :type '(choice (const :tag "Obey" t) | |
349 (const :tag "Ignore" nil) | |
350 (sexp :tag "Query" :format "%t\n" other)) | |
351 :group 'find-file) | |
352 | |
353 ;; Avoid losing in versions where CLASH_DETECTION is disabled. | 489 ;; Avoid losing in versions where CLASH_DETECTION is disabled. |
354 (or (fboundp 'lock-buffer) | 490 (or (fboundp 'lock-buffer) |
355 (defalias 'lock-buffer 'ignore)) | 491 (defalias 'lock-buffer 'ignore)) |
356 (or (fboundp 'unlock-buffer) | 492 (or (fboundp 'unlock-buffer) |
357 (defalias 'unlock-buffer 'ignore)) | 493 (defalias 'unlock-buffer 'ignore)) |
494 (or (fboundp 'file-locked-p) | |
495 (defalias 'file-locked-p 'ignore)) | |
496 | |
497 (defvar view-read-only nil | |
498 "*Non-nil means buffers visiting files read-only, do it in view mode.") | |
358 | 499 |
359 ;;FSFmacs bastardized ange-ftp cruft | 500 ;;FSFmacs bastardized ange-ftp cruft |
360 ;; This hook function provides support for ange-ftp host name | |
361 ;; completion. It runs the usual ange-ftp hook, but only for | |
362 ;; completion operations. Having this here avoids the need | |
363 ;; to load ange-ftp when it's not really in use. | |
364 ;(defun ange-ftp-completion-hook-function (op &rest args) | 501 ;(defun ange-ftp-completion-hook-function (op &rest args) |
502 ; "Provides support for ange-ftp host name completion. | |
503 ;Runs the usual ange-ftp hook, but only for completion operations." | |
504 ; ;; Having this here avoids the need to load ange-ftp when it's not | |
505 ; ;; really in use. | |
365 ; (if (memq op '(file-name-completion file-name-all-completions)) | 506 ; (if (memq op '(file-name-completion file-name-all-completions)) |
366 ; (apply 'ange-ftp-hook-function op args) | 507 ; (apply 'ange-ftp-hook-function op args) |
367 ; (let ((inhibit-file-name-handlers | 508 ; (let ((inhibit-file-name-handlers |
368 ; (cons 'ange-ftp-completion-hook-function | 509 ; (cons 'ange-ftp-completion-hook-function |
369 ; (and (eq inhibit-file-name-operation op) | 510 ; (and (eq inhibit-file-name-operation op) |
370 ; inhibit-file-name-handlers))) | 511 ; inhibit-file-name-handlers))) |
371 ; (inhibit-file-name-operation op)) | 512 ; (inhibit-file-name-operation op)) |
372 ; (apply op args)) | 513 ; (apply op args)) |
373 | 514 |
515 ;; FSF 21.2: | |
516 ;This function's standard definition is trivial; it just returns the argument. | |
517 ;However, on some systems, the function is redefined with a definition | |
518 ;that really does change some file names to canonicalize certain | |
519 ;patterns and to guarantee valid names." | |
374 (defun convert-standard-filename (filename) | 520 (defun convert-standard-filename (filename) |
375 "Convert a standard file's name to something suitable for the current OS." | 521 "Convert a standard file's name to something suitable for the current OS." |
376 (if (eq system-type 'windows-nt) | 522 (if (eq system-type 'windows-nt) |
377 (let ((name (copy-sequence filename)) | 523 (let ((name (copy-sequence filename)) |
378 (start 0)) | 524 (start 0)) |
430 ;; XEmacs change: stig@hackvan.com | 576 ;; XEmacs change: stig@hackvan.com |
431 (if find-file-use-truenames | 577 (if find-file-use-truenames |
432 (setq dir (file-truename dir))) | 578 (setq dir (file-truename dir))) |
433 (setq dir (abbreviate-file-name (expand-file-name dir))) | 579 (setq dir (abbreviate-file-name (expand-file-name dir))) |
434 (cond ((not (file-directory-p dir)) | 580 (cond ((not (file-directory-p dir)) |
435 (error "%s is not a directory" dir)) | 581 (if (file-exists-p dir) |
582 (error "%s is not a directory" dir) | |
583 (error "%s: no such directory" dir))) | |
436 ;; this breaks ange-ftp, which doesn't (can't?) overload `file-executable-p'. | 584 ;; this breaks ange-ftp, which doesn't (can't?) overload `file-executable-p'. |
437 ;;((not (file-executable-p dir)) | 585 ;;((not (file-executable-p dir)) |
438 ;; (error "Cannot cd to %s: Permission denied" dir)) | 586 ;; (error "Cannot cd to %s: Permission denied" dir)) |
439 (t | 587 (t |
440 (setq default-directory dir)))) | 588 (setq default-directory dir)))) |
472 (error "No such directory: %s" (expand-file-name dir)) | 620 (error "No such directory: %s" (expand-file-name dir)) |
473 (error "Directory not found in $CDPATH: %s" dir))))) | 621 (error "Directory not found in $CDPATH: %s" dir))))) |
474 | 622 |
475 (defun load-file (file) | 623 (defun load-file (file) |
476 "Load the Lisp file named FILE." | 624 "Load the Lisp file named FILE." |
477 (interactive "fLoad file: ") | 625 ;; This is a case where .elc makes a lot of sense. |
626 (interactive (list (let ((completion-ignored-extensions | |
627 (remove ".elc" completion-ignored-extensions))) | |
628 (read-file-name "Load file: ")))) | |
478 (load (expand-file-name file) nil nil t)) | 629 (load (expand-file-name file) nil nil t)) |
479 | 630 |
480 ; We now dump utils/lib-complete.el which has improved versions of this. | 631 ; We now dump utils/lib-complete.el which has improved versions of this. |
481 ;(defun load-library (library) | 632 ;(defun load-library (library) |
482 ; "Load the library named LIBRARY. | 633 ; "Load the library named LIBRARY. |
491 ; (let ((f (locate-file library load-path ":.el:"))) | 642 ; (let ((f (locate-file library load-path ":.el:"))) |
492 ; (if f | 643 ; (if f |
493 ; (find-file f) | 644 ; (find-file f) |
494 ; (error "Couldn't locate library %s" library)))) | 645 ; (error "Couldn't locate library %s" library)))) |
495 | 646 |
496 (defun file-local-copy (file &optional buffer) | 647 (defun file-local-copy (file) |
497 "Copy the file FILE into a temporary file on this machine. | 648 "Copy the file FILE into a temporary file on this machine. |
498 Returns the name of the local copy, or nil, if FILE is directly | 649 Returns the name of the local copy, or nil, if FILE is directly |
499 accessible." | 650 accessible." |
651 ;; This formerly had an optional BUFFER argument that wasn't used by | |
652 ;; anything. | |
500 (let ((handler (find-file-name-handler file 'file-local-copy))) | 653 (let ((handler (find-file-name-handler file 'file-local-copy))) |
501 (if handler | 654 (if handler |
502 (funcall handler 'file-local-copy file) | 655 (funcall handler 'file-local-copy file) |
503 nil))) | 656 nil))) |
504 | 657 |
545 (save-match-data | 698 (save-match-data |
546 (if (= count 0) | 699 (if (= count 0) |
547 (error "Apparent cycle of symbolic links for %s" filename)) | 700 (error "Apparent cycle of symbolic links for %s" filename)) |
548 ;; In the context of a link, `//' doesn't mean what XEmacs thinks. | 701 ;; In the context of a link, `//' doesn't mean what XEmacs thinks. |
549 (while (string-match "//+" tem) | 702 (while (string-match "//+" tem) |
550 (setq tem (concat (substring tem 0 (1+ (match-beginning 0))) | 703 (setq tem (replace-match "/" nil nil tem))) |
551 (substring tem (match-end 0))))) | |
552 ;; Handle `..' by hand, since it needs to work in the | 704 ;; Handle `..' by hand, since it needs to work in the |
553 ;; target of any directory symlink. | 705 ;; target of any directory symlink. |
554 ;; This code is not quite complete; it does not handle | 706 ;; This code is not quite complete; it does not handle |
555 ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose. | 707 ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose. |
556 (while (string-match "\\`\\.\\./" tem) ;#### Unix specific | 708 (while (string-match "\\`\\.\\./" tem) ;#### Unix specific |
576 (bury-buffer (current-buffer))) | 728 (bury-buffer (current-buffer))) |
577 (switch-to-buffer | 729 (switch-to-buffer |
578 (if (<= arg 1) (other-buffer (current-buffer)) | 730 (if (<= arg 1) (other-buffer (current-buffer)) |
579 (nth (1+ arg) (buffer-list))))) | 731 (nth (1+ arg) (buffer-list))))) |
580 | 732 |
581 (defun switch-to-buffer-other-window (buffer) | 733 ;;FSF 21.2 |
582 "Select buffer BUFFER in another window." | 734 ;Optional second arg NORECORD non-nil means |
583 (interactive "BSwitch to buffer in other window: ") | 735 ;do not put this buffer at the front of the list of recently selected ones. |
736 (defun switch-to-buffer-other-window (buffer) ;;FSF 21.2: &optional norecord | |
737 "Select buffer BUFFER in another window. | |
738 | |
739 This uses the function `display-buffer' as a subroutine; see its | |
740 documentation for additional customization information." | |
741 (interactive "BSwitch to buffer in other window: ") | |
584 (let ((pop-up-windows t)) | 742 (let ((pop-up-windows t)) |
585 ;; XEmacs: this used to have (selected-frame) as the third argument, | 743 ;; XEmacs: this used to have (selected-frame) as the third argument, |
586 ;; but this is obnoxious. If the user wants the buffer in a | 744 ;; but this is obnoxious. If the user wants the buffer in a |
587 ;; different frame, then it should be this way. | 745 ;; different frame, then it should be this way. |
588 | 746 |
589 ;; Change documented above undone --mrb | 747 ;; Change documented above undone --mrb |
590 (pop-to-buffer buffer t (selected-frame)))) | 748 (pop-to-buffer buffer t (selected-frame)))) |
749 ;(pop-to-buffer buffer t norecord))) | |
750 | |
751 ;; FSF 21.2: | |
752 ; (defun switch-to-buffer-other-frame (buffer &optional norecord) | |
753 ; "Switch to buffer BUFFER in another frame. | |
754 ; Optional second arg NORECORD non-nil means | |
755 ; do not put this buffer at the front of the list of recently selected ones. | |
756 | |
757 ; This uses the function `display-buffer' as a subroutine; see its | |
758 ; documentation for additional customization information." | |
759 ; (interactive "BSwitch to buffer in other frame: ") | |
760 ; (let ((pop-up-frames t)) | |
761 ; (pop-to-buffer buffer t norecord) | |
762 ; (raise-frame (window-frame (selected-window))))) | |
591 | 763 |
592 (defun switch-to-buffer-other-frame (buffer) | 764 (defun switch-to-buffer-other-frame (buffer) |
593 "Switch to buffer BUFFER in a newly-created frame." | 765 "Switch to buffer BUFFER in a newly-created frame. |
766 | |
767 This uses the function `display-buffer' as a subroutine; see its | |
768 documentation for additional customization information." | |
594 (interactive "BSwitch to buffer in other frame: ") | 769 (interactive "BSwitch to buffer in other frame: ") |
595 (let* ((name (get-frame-name-for-buffer buffer)) | 770 (let* ((name (get-frame-name-for-buffer buffer)) |
596 (frame (make-frame (if name | 771 (frame (make-frame (if name |
597 (list (cons 'name (symbol-name name))))))) | 772 (list (cons 'name (symbol-name name))))))) |
598 (pop-to-buffer buffer t frame) | 773 (pop-to-buffer buffer t frame) |
656 do (switch-to-buffer (car (last (buffer-list)))) | 831 do (switch-to-buffer (car (last (buffer-list)))) |
657 while (or (funcall buffers-tab-omit-function (car (buffer-list))) | 832 while (or (funcall buffers-tab-omit-function (car (buffer-list))) |
658 (not (funcall buffers-tab-selection-function | 833 (not (funcall buffers-tab-selection-function |
659 curbuf (car (buffer-list))))))))) | 834 curbuf (car (buffer-list))))))))) |
660 | 835 |
661 (defun find-file (filename &optional codesys) | 836 (defun find-file (filename &optional codesys wildcards) |
662 "Edit file FILENAME. | 837 "Edit file FILENAME. |
663 Switch to a buffer visiting file FILENAME, creating one if none already | 838 Switch to a buffer visiting file FILENAME, creating one if none already |
664 exists. Optional second argument specifies the coding system to use when | 839 exists. Optional second argument specifies the coding system to use when |
665 decoding the file. Interactively, with a prefix argument, you will be | 840 decoding the file. Interactively, with a prefix argument, you will be |
666 prompted for the coding system. | 841 prompted for the coding system. |
680 default -- normally `undecided', so the built-in auto-detection | 855 default -- normally `undecided', so the built-in auto-detection |
681 mechanism can do its thing.) | 856 mechanism can do its thing.) |
682 5. The coding system 'raw-text. | 857 5. The coding system 'raw-text. |
683 | 858 |
684 See `insert-file-contents' for more details about how the process of | 859 See `insert-file-contents' for more details about how the process of |
685 determining the coding system works." | 860 determining the coding system works. |
686 (interactive "FFind file: \nZCoding system: ") | 861 |
862 Interactively, or if WILDCARDS is non-nil in a call from Lisp, | |
863 expand wildcards (if any) and visit multiple files. Wildcard expansion | |
864 can be suppressed by setting `find-file-wildcards'." | |
865 (interactive (list (read-file-name "Find file: ") | |
866 (and current-prefix-arg | |
867 (read-coding-system "Coding system: ")) | |
868 t)) | |
687 (if codesys | 869 (if codesys |
688 (let ((coding-system-for-read | 870 (let ((coding-system-for-read |
689 (get-coding-system codesys))) | 871 (get-coding-system codesys))) |
690 (switch-to-buffer (find-file-noselect filename))) | 872 (let ((value (find-file-noselect filename nil nil wildcards))) |
691 (switch-to-buffer (find-file-noselect filename)))) | 873 (if (listp value) |
692 | 874 (mapcar 'switch-to-buffer (nreverse value)) |
693 (defun find-file-other-window (filename &optional codesys) | 875 (switch-to-buffer value)))) |
876 (let ((value (find-file-noselect filename nil nil wildcards))) | |
877 (if (listp value) | |
878 (mapcar 'switch-to-buffer (nreverse value)) | |
879 (switch-to-buffer value))))) | |
880 | |
881 (defun find-file-other-window (filename &optional codesys wildcards) | |
694 "Edit file FILENAME, in another window. | 882 "Edit file FILENAME, in another window. |
695 May create a new window, or reuse an existing one. See the function | 883 May create a new window, or reuse an existing one. See the function |
696 `display-buffer'. Optional second argument specifies the coding system to | 884 `display-buffer'. Optional second argument specifies the coding system to |
697 use when decoding the file. Interactively, with a prefix argument, you | 885 use when decoding the file. Interactively, with a prefix argument, you |
698 will be prompted for the coding system." | 886 will be prompted for the coding system." |
699 (interactive "FFind file in other window: \nZCoding system: ") | 887 (interactive (list (read-file-name "Find file in other window: ") |
888 (and current-prefix-arg | |
889 (read-coding-system "Coding system: ")) | |
890 t)) | |
700 (if codesys | 891 (if codesys |
701 (let ((coding-system-for-read | 892 (let ((coding-system-for-read |
702 (get-coding-system codesys))) | 893 (get-coding-system codesys))) |
703 (switch-to-buffer-other-window (find-file-noselect filename))) | 894 (let ((value (find-file-noselect filename nil nil wildcards))) |
704 (switch-to-buffer-other-window (find-file-noselect filename)))) | 895 (if (listp value) |
705 | 896 (progn |
706 (defun find-file-other-frame (filename &optional codesys) | 897 (setq value (nreverse value)) |
898 (switch-to-buffer-other-window (car value)) | |
899 (mapcar 'switch-to-buffer (cdr value))) | |
900 (switch-to-buffer-other-window value)))) | |
901 (let ((value (find-file-noselect filename nil nil wildcards))) | |
902 (if (listp value) | |
903 (progn | |
904 (setq value (nreverse value)) | |
905 (switch-to-buffer-other-window (car value)) | |
906 (mapcar 'switch-to-buffer (cdr value))) | |
907 (switch-to-buffer-other-window value))))) | |
908 | |
909 (defun find-file-other-frame (filename &optional codesys wildcards) | |
707 "Edit file FILENAME, in a newly-created frame. | 910 "Edit file FILENAME, in a newly-created frame. |
708 Optional second argument specifies the coding system to use when decoding | 911 Optional second argument specifies the coding system to use when decoding |
709 the file. Interactively, with a prefix argument, you will be prompted for | 912 the file. Interactively, with a prefix argument, you will be prompted for |
710 the coding system." | 913 the coding system." |
711 (interactive "FFind file in other frame: \nZCoding system: ") | 914 (interactive (list (read-file-name "Find file in other frame: ") |
915 (and current-prefix-arg | |
916 (read-coding-system "Coding system: ")) | |
917 t)) | |
712 (if codesys | 918 (if codesys |
713 (let ((coding-system-for-read | 919 (let ((coding-system-for-read |
714 (get-coding-system codesys))) | 920 (get-coding-system codesys))) |
715 (switch-to-buffer-other-frame (find-file-noselect filename))) | 921 (let ((value (find-file-noselect filename nil nil wildcards))) |
716 (switch-to-buffer-other-frame (find-file-noselect filename)))) | 922 (if (listp value) |
717 | 923 (progn |
718 (defun find-file-read-only (filename &optional codesys) | 924 (setq value (nreverse value)) |
925 (switch-to-buffer-other-frame (car value)) | |
926 (mapcar 'switch-to-buffer (cdr value))) | |
927 (switch-to-buffer-other-frame value)))) | |
928 (let ((value (find-file-noselect filename nil nil wildcards))) | |
929 (if (listp value) | |
930 (progn | |
931 (setq value (nreverse value)) | |
932 (switch-to-buffer-other-frame (car value)) | |
933 (mapcar 'switch-to-buffer (cdr value))) | |
934 (switch-to-buffer-other-frame value))))) | |
935 | |
936 (defun find-file-read-only (filename &optional codesys wildcards) | |
719 "Edit file FILENAME but don't allow changes. | 937 "Edit file FILENAME but don't allow changes. |
720 Like \\[find-file] but marks buffer as read-only. | 938 Like \\[find-file] but marks buffer as read-only. |
721 Use \\[toggle-read-only] to permit editing. | 939 Use \\[toggle-read-only] to permit editing. |
722 Optional second argument specifies the coding system to use when decoding | 940 Optional second argument specifies the coding system to use when decoding |
723 the file. Interactively, with a prefix argument, you will be prompted for | 941 the file. Interactively, with a prefix argument, you will be prompted for |
724 the coding system." | 942 the coding system." |
725 (interactive "fFind file read-only: \nZCoding system: ") | 943 (interactive (list (read-file-name "Find file read-only: ") |
944 (and current-prefix-arg | |
945 (read-coding-system "Coding system: ")) | |
946 t)) | |
726 (if codesys | 947 (if codesys |
727 (let ((coding-system-for-read | 948 (let ((coding-system-for-read |
728 (get-coding-system codesys))) | 949 (get-coding-system codesys))) |
729 (find-file filename)) | 950 (find-file filename nil wildcards)) |
730 (find-file filename)) | 951 (find-file filename nil wildcards)) |
731 (setq buffer-read-only t) | 952 (setq buffer-read-only t) |
732 (current-buffer)) | 953 (current-buffer)) |
733 | 954 |
734 (defun find-file-read-only-other-window (filename &optional codesys) | 955 (defun find-file-read-only-other-window (filename &optional codesys wildcards) |
735 "Edit file FILENAME in another window but don't allow changes. | 956 "Edit file FILENAME in another window but don't allow changes. |
736 Like \\[find-file-other-window] but marks buffer as read-only. | 957 Like \\[find-file-other-window] but marks buffer as read-only. |
737 Use \\[toggle-read-only] to permit editing. | 958 Use \\[toggle-read-only] to permit editing. |
738 Optional second argument specifies the coding system to use when decoding | 959 Optional second argument specifies the coding system to use when decoding |
739 the file. Interactively, with a prefix argument, you will be prompted for | 960 the file. Interactively, with a prefix argument, you will be prompted for |
740 the coding system." | 961 the coding system." |
741 (interactive "fFind file read-only other window: \nZCoding system: ") | 962 (interactive (list (read-file-name "Find file read-only other window: ") |
963 (and current-prefix-arg | |
964 (read-coding-system "Coding system: ")) | |
965 t)) | |
742 (if codesys | 966 (if codesys |
743 (let ((coding-system-for-read | 967 (let ((coding-system-for-read |
744 (get-coding-system codesys))) | 968 (get-coding-system codesys))) |
745 (find-file-other-window filename)) | 969 (find-file-other-window filename)) |
746 (find-file-other-window filename)) | 970 (find-file-other-window filename)) |
747 (setq buffer-read-only t) | 971 (setq buffer-read-only t) |
748 (current-buffer)) | 972 (current-buffer)) |
749 | 973 |
750 (defun find-file-read-only-other-frame (filename &optional codesys) | 974 (defun find-file-read-only-other-frame (filename &optional codesys wildcards) |
751 "Edit file FILENAME in another frame but don't allow changes. | 975 "Edit file FILENAME in another frame but don't allow changes. |
752 Like \\[find-file-other-frame] but marks buffer as read-only. | 976 Like \\[find-file-other-frame] but marks buffer as read-only. |
753 Use \\[toggle-read-only] to permit editing. | 977 Use \\[toggle-read-only] to permit editing. |
754 Optional second argument specifies the coding system to use when decoding | 978 Optional second argument specifies the coding system to use when decoding |
755 the file. Interactively, with a prefix argument, you will be prompted for | 979 the file. Interactively, with a prefix argument, you will be prompted for |
756 the coding system." | 980 the coding system." |
757 (interactive "fFind file read-only other frame: \nZCoding system: ") | 981 (interactive (list (read-file-name "Find file read-only other frame: ") |
982 (and current-prefix-arg | |
983 (read-coding-system "Coding system: ")) | |
984 t)) | |
758 (if codesys | 985 (if codesys |
759 (let ((coding-system-for-read | 986 (let ((coding-system-for-read |
760 (get-coding-system codesys))) | 987 (get-coding-system codesys))) |
761 (find-file-other-frame filename)) | 988 (find-file-other-frame filename)) |
762 (find-file-other-frame filename)) | 989 (find-file-other-frame filename)) |
834 (setq buffer-file-truename otrue) | 1061 (setq buffer-file-truename otrue) |
835 (lock-buffer) | 1062 (lock-buffer) |
836 (rename-buffer oname)))) | 1063 (rename-buffer oname)))) |
837 (or (eq (current-buffer) obuf) | 1064 (or (eq (current-buffer) obuf) |
838 (kill-buffer obuf)))) | 1065 (kill-buffer obuf)))) |
839 | 1066 |
840 (defun create-file-buffer (filename) | 1067 (defun create-file-buffer (filename) |
841 "Create a suitably named buffer for visiting FILENAME, and return it. | 1068 "Create a suitably named buffer for visiting FILENAME, and return it. |
842 FILENAME (sans directory) is used unchanged if that name is free; | 1069 FILENAME (sans directory) is used unchanged if that name is free; |
843 otherwise a string <2> or <3> or ... is appended to get an unused name." | 1070 otherwise a string <2> or <3> or ... is appended to get an unused name." |
844 (let ((handler (find-file-name-handler filename 'create-file-buffer))) | 1071 (let ((handler (find-file-name-handler filename 'create-file-buffer))) |
857 (defvar abbreviated-home-dir nil | 1084 (defvar abbreviated-home-dir nil |
858 "The user's homedir abbreviated according to `directory-abbrev-alist'.") | 1085 "The user's homedir abbreviated according to `directory-abbrev-alist'.") |
859 | 1086 |
860 (defun abbreviate-file-name (filename &optional hack-homedir) | 1087 (defun abbreviate-file-name (filename &optional hack-homedir) |
861 "Return a version of FILENAME shortened using `directory-abbrev-alist'. | 1088 "Return a version of FILENAME shortened using `directory-abbrev-alist'. |
862 See documentation of variable `directory-abbrev-alist' for more information. | 1089 Type \\[describe-variable] directory-abbrev-alist RET for more information. |
863 If optional argument HACK-HOMEDIR is non-nil, then this also substitutes | 1090 If optional argument HACK-HOMEDIR is non-nil, then this also substitutes |
864 \"~\" for the user's home directory." | 1091 \"~\" for the user's home directory." |
865 (let ((handler (find-file-name-handler filename 'abbreviate-file-name))) | 1092 (let ((handler (find-file-name-handler filename 'abbreviate-file-name))) |
866 (if handler | 1093 (if handler |
867 (funcall handler 'abbreviate-file-name filename hack-homedir) | 1094 (funcall handler 'abbreviate-file-name filename hack-homedir) |
936 (if (and buffer-file-name | 1163 (if (and buffer-file-name |
937 (string= buffer-file-truename truename)) | 1164 (string= buffer-file-truename truename)) |
938 (setq found (car list)))) | 1165 (setq found (car list)))) |
939 (setq list (cdr list))) | 1166 (setq list (cdr list))) |
940 found) | 1167 found) |
941 (let ((number (nthcdr 10 (file-attributes truename))) | 1168 (let* ((attributes (file-attributes truename)) |
942 (list (buffer-list)) found) | 1169 (number (nthcdr 10 attributes)) |
1170 (list (buffer-list)) found) | |
943 (and buffer-file-numbers-unique | 1171 (and buffer-file-numbers-unique |
944 number | 1172 number |
945 (while (and (not found) list) | 1173 (while (and (not found) list) |
946 (save-excursion | 1174 (with-current-buffer (car list) |
947 (set-buffer (car list)) | 1175 (if (and buffer-file-name |
948 (if (and buffer-file-number | 1176 (equal buffer-file-number number) |
949 (equal buffer-file-number number) | |
950 ;; Verify this buffer's file number | 1177 ;; Verify this buffer's file number |
951 ;; still belongs to its file. | 1178 ;; still belongs to its file. |
952 (file-exists-p buffer-file-name) | 1179 (file-exists-p buffer-file-name) |
953 (equal (nthcdr 10 (file-attributes buffer-file-name)) | 1180 (equal (file-attributes buffer-file-name) |
954 number)) | 1181 attributes)) |
955 (setq found (car list)))) | 1182 (setq found (car list)))) |
956 (setq list (cdr list)))) | 1183 (setq list (cdr list)))) |
957 found)))) | 1184 found)))) |
958 | 1185 |
1186 (defcustom find-file-wildcards t | |
1187 "*Non-nil means file-visiting commands should handle wildcards. | |
1188 For example, if you specify `*.c', that would visit all the files | |
1189 whose names match the pattern." | |
1190 :group 'files | |
1191 ; :version "20.4" | |
1192 :type 'boolean) | |
1193 | |
1194 (defcustom find-file-suppress-same-file-warnings nil | |
1195 "*Non-nil means suppress warning messages for symlinked files. | |
1196 When nil, Emacs prints a warning when visiting a file that is already | |
1197 visited, but with a different name. Setting this option to t | |
1198 suppresses this warning." | |
1199 :group 'files | |
1200 ; :version "21.1" | |
1201 :type 'boolean) | |
1202 | |
1203 (defun find-file-noselect (filename &optional nowarn rawfile wildcards) | |
1204 "Read file FILENAME into a buffer and return the buffer. | |
1205 If a buffer exists visiting FILENAME, return that one, but | |
1206 verify that the file has not changed since visited or saved. | |
1207 The buffer is not selected, just returned to the caller. | |
1208 If NOWARN is non-nil, warning messages will be suppressed. | |
1209 If RAWFILE is non-nil, the file is read literally." | |
1210 (setq filename | |
1211 (abbreviate-file-name | |
1212 (expand-file-name filename))) | |
1213 (if (file-directory-p filename) | |
1214 (or (and find-file-run-dired | |
1215 (loop for fn in find-directory-functions | |
1216 for x = (and (fboundp fn) | |
1217 (funcall fn | |
1218 (if find-file-use-truenames | |
1219 (abbreviate-file-name | |
1220 (file-truename filename)) | |
1221 filename))) | |
1222 if x | |
1223 return x)) | |
1224 (error "%s is a directory" filename)) | |
1225 (if (and wildcards | |
1226 find-file-wildcards | |
1227 (not (string-match "\\`/:" filename)) | |
1228 (string-match "[[*?]" filename)) | |
1229 (let ((files (condition-case nil | |
1230 (file-expand-wildcards filename t) | |
1231 (error (list filename)))) | |
1232 (find-file-wildcards nil)) | |
1233 (if (null files) | |
1234 (find-file-noselect filename) | |
1235 (mapcar #'find-file-noselect files))) | |
1236 (let* ((buf (get-file-buffer filename)) | |
1237 (truename (abbreviate-file-name (file-truename filename))) | |
1238 (number (nthcdr 10 (file-attributes truename))) | |
1239 ; ;; Find any buffer for a file which has same truename. | |
1240 ; (other (and (not buf) (find-buffer-visiting filename))) | |
1241 (error nil)) | |
1242 | |
1243 ; ;; Let user know if there is a buffer with the same truename. | |
1244 ; (if other | |
1245 ; (progn | |
1246 ; (or nowarn | |
1247 ; find-file-suppress-same-file-warnings | |
1248 ; (string-equal filename (buffer-file-name other)) | |
1249 ; (message "%s and %s are the same file" | |
1250 ; filename (buffer-file-name other))) | |
1251 ; ;; Optionally also find that buffer. | |
1252 ; (if (or find-file-existing-other-name find-file-visit-truename) | |
1253 ; (setq buf other)))) | |
1254 | |
1255 (when (and buf | |
1256 (or find-file-compare-truenames find-file-use-truenames) | |
1257 (not find-file-suppress-same-file-warnings) | |
1258 (not nowarn)) | |
1259 (save-excursion | |
1260 (set-buffer buf) | |
1261 (if (not (string-equal buffer-file-name filename)) | |
1262 (message "%s and %s are the same file (%s)" | |
1263 filename buffer-file-name | |
1264 buffer-file-truename)))) | |
1265 | |
1266 (if buf | |
1267 (progn | |
1268 (or nowarn | |
1269 (verify-visited-file-modtime buf) | |
1270 (cond ((not (file-exists-p filename)) | |
1271 (error "File %s no longer exists!" filename)) | |
1272 ;; Certain files should be reverted automatically | |
1273 ;; if they have changed on disk and not in the buffer. | |
1274 ((and (not (buffer-modified-p buf)) | |
1275 (dolist (rx revert-without-query nil) | |
1276 (when (string-match rx filename) | |
1277 (return t)))) | |
1278 (with-current-buffer buf | |
1279 (message "Reverting file %s..." filename) | |
1280 (revert-buffer t t) | |
1281 (message "Reverting file %s... done" filename))) | |
1282 ((yes-or-no-p | |
1283 (if (string= (file-name-nondirectory filename) | |
1284 (buffer-name buf)) | |
1285 (format | |
1286 (if (buffer-modified-p buf) | |
1287 (gettext "File %s changed on disk. Discard your edits? ") | |
1288 (gettext "File %s changed on disk. Reread from disk? ")) | |
1289 (file-name-nondirectory filename)) | |
1290 (format | |
1291 (if (buffer-modified-p buf) | |
1292 (gettext "File %s changed on disk. Discard your edits in %s? ") | |
1293 (gettext "File %s changed on disk. Reread from disk into %s? ")) | |
1294 (file-name-nondirectory filename) | |
1295 (buffer-name buf)))) | |
1296 (with-current-buffer buf | |
1297 (revert-buffer t t))))) | |
1298 (when (not (eq rawfile (not (null find-file-literally)))) | |
1299 (with-current-buffer buf | |
1300 (if (buffer-modified-p) | |
1301 (if (y-or-n-p (if rawfile | |
1302 "Save file and revisit literally? " | |
1303 "Save file and revisit non-literally? ")) | |
1304 (progn | |
1305 (save-buffer) | |
1306 (find-file-noselect-1 buf filename nowarn | |
1307 rawfile truename number)) | |
1308 (if (y-or-n-p (if rawfile | |
1309 "Discard your edits and revisit file literally? " | |
1310 "Discard your edits and revisit file non-literally? ")) | |
1311 (find-file-noselect-1 buf filename nowarn | |
1312 rawfile truename number) | |
1313 (error (if rawfile "File already visited non-literally" | |
1314 "File already visited literally")))) | |
1315 (if (y-or-n-p (if rawfile | |
1316 "Revisit file literally? " | |
1317 "Revisit file non-literally? ")) | |
1318 (find-file-noselect-1 buf filename nowarn | |
1319 rawfile truename number) | |
1320 (error (if rawfile "File already visited non-literally" | |
1321 "File already visited literally")))))) | |
1322 ;; Return the buffer we are using. | |
1323 buf) | |
1324 ;; Create a new buffer. | |
1325 (setq buf (create-file-buffer filename)) | |
1326 ;; Catch various signals, such as QUIT, and kill the buffer | |
1327 ;; in that case. | |
1328 (condition-case data | |
1329 (progn | |
1330 (set-buffer-major-mode buf) | |
1331 ;; find-file-noselect-1 may use a different buffer. | |
1332 (find-file-noselect-1 buf filename nowarn | |
1333 rawfile truename number)) | |
1334 (t | |
1335 (kill-buffer buf) | |
1336 (signal (car data) (cdr data))))))))) | |
1337 | |
1338 (defun find-file-noselect-1 (buf filename nowarn rawfile truename number) | |
1339 (let ((inhibit-read-only t) | |
1340 error) | |
1341 (with-current-buffer buf | |
1342 (kill-local-variable 'find-file-literally) | |
1343 ;; Needed in case we are re-visiting the file with a different | |
1344 ;; text representation. | |
1345 (kill-local-variable 'buffer-file-coding-system) | |
1346 (erase-buffer) | |
1347 ; (and (default-value 'enable-multibyte-characters) | |
1348 ; (not rawfile) | |
1349 ; (set-buffer-multibyte t)) | |
1350 (condition-case () | |
1351 (if rawfile | |
1352 (insert-file-contents-literally filename t) | |
1353 (insert-file-contents filename t)) | |
1354 (file-error | |
1355 (when (and (file-exists-p filename) | |
1356 (not (file-readable-p filename))) | |
1357 (signal 'file-error (list "File is not readable" filename))) | |
1358 (if rawfile | |
1359 ;; Unconditionally set error | |
1360 (setq error t) | |
1361 (or | |
1362 ;; Run find-file-not-found-hooks until one returns non-nil. | |
1363 (run-hook-with-args-until-success 'find-file-not-found-hooks) | |
1364 ;; If they fail too, set error. | |
1365 (setq error t))))) | |
1366 ;; Find the file's truename, and maybe use that as visited name. | |
1367 ;; automatically computed in XEmacs, unless jka-compr was used! | |
1368 (unless buffer-file-truename | |
1369 (setq buffer-file-truename truename)) | |
1370 (setq buffer-file-number number) | |
1371 (and find-file-use-truenames | |
1372 ;; This should be in C. Put pathname | |
1373 ;; abbreviations that have been explicitly | |
1374 ;; requested back into the pathname. Most | |
1375 ;; importantly, strip out automounter /tmp_mnt | |
1376 ;; directories so that auto-save will work | |
1377 (setq buffer-file-name (abbreviate-file-name buffer-file-name))) | |
1378 ;; Set buffer's default directory to that of the file. | |
1379 (setq default-directory (file-name-directory buffer-file-name)) | |
1380 ;; Turn off backup files for certain file names. Since | |
1381 ;; this is a permanent local, the major mode won't eliminate it. | |
1382 (and (not (funcall backup-enable-predicate buffer-file-name)) | |
1383 (progn | |
1384 (make-local-variable 'backup-inhibited) | |
1385 (setq backup-inhibited t))) | |
1386 (if rawfile | |
1387 (progn | |
1388 (setq buffer-file-coding-system 'no-conversion) | |
1389 (make-local-variable 'find-file-literally) | |
1390 (setq find-file-literally t)) | |
1391 (after-find-file error (not nowarn)) | |
1392 (setq buf (current-buffer))) | |
1393 (current-buffer)))) | |
1394 | |
959 (defun insert-file-contents-literally (filename &optional visit start end replace) | 1395 (defun insert-file-contents-literally (filename &optional visit start end replace) |
960 "Like `insert-file-contents', q.v., but only reads in the file. | 1396 "Like `insert-file-contents', but only reads in the file literally. |
961 A buffer may be modified in several ways after reading into the buffer due | 1397 A buffer may be modified in several ways after reading into the buffer, |
962 to advanced Emacs features, such as format decoding, character code | 1398 due to Emacs features such as format decoding, character code |
963 conversion, find-file-hooks, automatic uncompression, etc. | 1399 conversion, `find-file-hooks', automatic uncompression, etc. |
964 | 1400 |
965 This function ensures that none of these modifications will take place." | 1401 This function ensures that none of these modifications will take place." |
966 (let ((wrap-func (find-file-name-handler filename | 1402 (let ((wrap-func (find-file-name-handler filename |
967 'insert-file-contents-literally))) | 1403 'insert-file-contents-literally))) |
968 (if wrap-func | 1404 (if wrap-func |
969 (funcall wrap-func 'insert-file-contents-literally filename | 1405 (funcall wrap-func 'insert-file-contents-literally filename |
970 visit start end replace) | 1406 visit start end replace) |
974 (coding-system-for-read 'binary) | 1410 (coding-system-for-read 'binary) |
975 (coding-system-for-write 'binary) | 1411 (coding-system-for-write 'binary) |
976 (find-buffer-file-type-function | 1412 (find-buffer-file-type-function |
977 (if (fboundp 'find-buffer-file-type) | 1413 (if (fboundp 'find-buffer-file-type) |
978 (symbol-function 'find-buffer-file-type) | 1414 (symbol-function 'find-buffer-file-type) |
979 nil))) | 1415 nil)) |
1416 (inhibit-file-name-handlers '(jka-compr-handler image-file-handler)) | |
1417 (inhibit-file-name-operation 'insert-file-contents)) | |
980 (unwind-protect | 1418 (unwind-protect |
981 (progn | 1419 (progn |
982 (fset 'find-buffer-file-type (lambda (filename) t)) | 1420 (fset 'find-buffer-file-type (lambda (filename) t)) |
983 (insert-file-contents filename visit start end replace)) | 1421 (insert-file-contents filename visit start end replace)) |
984 (if find-buffer-file-type-function | 1422 (if find-buffer-file-type-function |
985 (fset 'find-buffer-file-type find-buffer-file-type-function) | 1423 (fset 'find-buffer-file-type find-buffer-file-type-function) |
986 (fmakunbound 'find-buffer-file-type))))))) | 1424 (fmakunbound 'find-buffer-file-type))))))) |
987 | 1425 |
988 (defun find-file-noselect (filename &optional nowarn rawfile) | 1426 (defun insert-file-literally (filename) |
989 "Read file FILENAME into a buffer and return the buffer. | 1427 "Insert contents of file FILENAME into buffer after point with no conversion. |
990 If a buffer exists visiting FILENAME, return that one, but | 1428 |
991 verify that the file has not changed since visited or saved. | 1429 This function is meant for the user to run interactively. |
992 The buffer is not selected, just returned to the caller. | 1430 Don't call it from programs! Use `insert-file-contents-literally' instead. |
993 If NOWARN is non-nil, warning messages will be suppressed. | 1431 \(Its calling sequence is different; see its documentation)." |
994 If RAWFILE is non-nil, the file is read literally." | 1432 (interactive "*fInsert file literally: ") |
995 (setq filename (abbreviate-file-name (expand-file-name filename))) | |
996 (if (file-directory-p filename) | 1433 (if (file-directory-p filename) |
997 (if (and (fboundp 'dired-noselect) find-file-run-dired) | 1434 (signal 'file-error (list "Opening input file" "file is a directory" |
998 (declare-fboundp | 1435 filename))) |
999 (dired-noselect (if find-file-use-truenames | 1436 (let ((tem (insert-file-contents-literally filename))) |
1000 (abbreviate-file-name (file-truename filename)) | 1437 (push-mark (+ (point) (car (cdr tem)))))) |
1001 filename))) | 1438 |
1002 (error "%s is a directory" filename)) | 1439 (defvar find-file-literally nil |
1003 (let* ((buf (get-file-buffer filename)) | 1440 "Non-nil if this buffer was made by `find-file-literally' or equivalent. |
1004 (truename (abbreviate-file-name (file-truename filename))) | 1441 This is a permanent local.") |
1005 (number (nthcdr 10 (file-attributes truename))) | 1442 (put 'find-file-literally 'permanent-local t) |
1006 ; ;; Find any buffer for a file which has same truename. | 1443 |
1007 ; (other (and (not buf) (find-buffer-visiting filename))) | 1444 (defun find-file-literally (filename) |
1008 (error nil)) | 1445 "Visit file FILENAME with no conversion of any kind. |
1009 | 1446 Format conversion and character code conversion are both disabled, |
1010 ; ;; Let user know if there is a buffer with the same truename. | 1447 and multibyte characters are disabled in the resulting buffer. |
1011 ; (if (and (not buf) same-truename (not nowarn)) | 1448 The major mode used is Fundamental mode regardless of the file name, |
1012 ; (message "%s and %s are the same file (%s)" | 1449 and local variable specifications in the file are ignored. |
1013 ; filename (buffer-file-name same-truename) | 1450 Automatic uncompression and adding a newline at the end of the |
1014 ; truename) | 1451 file due to `require-final-newline' is also disabled. |
1015 ; (if (and (not buf) same-number (not nowarn)) | 1452 |
1016 ; (message "%s and %s are the same file" | 1453 You cannot absolutely rely on this function to result in |
1017 ; filename (buffer-file-name same-number)))) | 1454 visiting the file literally. If Emacs already has a buffer |
1018 ; ;; Optionally also find that buffer. | 1455 which is visiting the file, you get the existing buffer, |
1019 ; (if (or find-file-existing-other-name find-file-visit-truename) | 1456 regardless of whether it was created literally or not. |
1020 ; (setq buf (or same-truename same-number))) | 1457 |
1021 | 1458 In a Lisp program, if you want to be sure of accessing a file's |
1022 (when (and buf | 1459 contents literally, you should create a temporary buffer and then read |
1023 (or find-file-compare-truenames find-file-use-truenames) | 1460 the file contents into it using `insert-file-contents-literally'." |
1024 (not nowarn)) | 1461 (interactive "FFind file literally: ") |
1025 (save-excursion | 1462 (switch-to-buffer (find-file-noselect filename nil t))) |
1026 (set-buffer buf) | |
1027 (if (not (string-equal buffer-file-name filename)) | |
1028 (message "%s and %s are the same file (%s)" | |
1029 filename buffer-file-name | |
1030 buffer-file-truename)))) | |
1031 | |
1032 (if buf | |
1033 (or nowarn | |
1034 (verify-visited-file-modtime buf) | |
1035 (cond ((not (file-exists-p filename)) | |
1036 (error "File %s no longer exists!" filename)) | |
1037 ;; Certain files should be reverted automatically | |
1038 ;; if they have changed on disk and not in the buffer. | |
1039 ((and (not (buffer-modified-p buf)) | |
1040 (dolist (rx revert-without-query nil) | |
1041 (when (string-match rx filename) | |
1042 (return t)))) | |
1043 (with-current-buffer buf | |
1044 (message "Reverting file %s..." filename) | |
1045 (revert-buffer t t) | |
1046 (message "Reverting file %s... done" filename))) | |
1047 ((yes-or-no-p | |
1048 (if (string= (file-name-nondirectory filename) | |
1049 (buffer-name buf)) | |
1050 (format | |
1051 (if (buffer-modified-p buf) | |
1052 (gettext "File %s changed on disk. Discard your edits? ") | |
1053 (gettext "File %s changed on disk. Reread from disk? ")) | |
1054 (file-name-nondirectory filename)) | |
1055 (format | |
1056 (if (buffer-modified-p buf) | |
1057 (gettext "File %s changed on disk. Discard your edits in %s? ") | |
1058 (gettext "File %s changed on disk. Reread from disk into %s? ")) | |
1059 (file-name-nondirectory filename) | |
1060 (buffer-name buf)))) | |
1061 (with-current-buffer buf | |
1062 (revert-buffer t t))))) | |
1063 ;; Else: we must create a new buffer for filename | |
1064 (save-excursion | |
1065 ;;; The truename stuff makes this obsolete. | |
1066 ;;; (let* ((link-name (car (file-attributes filename))) | |
1067 ;;; (linked-buf (and (stringp link-name) | |
1068 ;;; (get-file-buffer link-name)))) | |
1069 ;;; (if (bufferp linked-buf) | |
1070 ;;; (message "Symbolic link to file in buffer %s" | |
1071 ;;; (buffer-name linked-buf)))) | |
1072 (setq buf (create-file-buffer filename)) | |
1073 ;; Catch various signals, such as QUIT, and kill the buffer | |
1074 ;; in that case. | |
1075 (condition-case data | |
1076 (progn | |
1077 (set-buffer-major-mode buf) | |
1078 (set-buffer buf) | |
1079 (erase-buffer) | |
1080 (condition-case () | |
1081 (if rawfile | |
1082 (insert-file-contents-literally filename t) | |
1083 (insert-file-contents filename t)) | |
1084 (file-error | |
1085 (when (and (file-exists-p filename) | |
1086 (not (file-readable-p filename))) | |
1087 (signal 'file-error (list "File is not readable" filename))) | |
1088 (if rawfile | |
1089 ;; Unconditionally set error | |
1090 (setq error t) | |
1091 (or | |
1092 ;; Run find-file-not-found-hooks until one returns non-nil. | |
1093 (run-hook-with-args-until-success 'find-file-not-found-hooks) | |
1094 ;; If they fail too, set error. | |
1095 (setq error t))))) | |
1096 ;; Find the file's truename, and maybe use that as visited name. | |
1097 ;; automatically computed in XEmacs, unless jka-compr was used! | |
1098 (unless buffer-file-truename | |
1099 (setq buffer-file-truename truename)) | |
1100 (setq buffer-file-number number) | |
1101 (and find-file-use-truenames | |
1102 ;; This should be in C. Put pathname | |
1103 ;; abbreviations that have been explicitly | |
1104 ;; requested back into the pathname. Most | |
1105 ;; importantly, strip out automounter /tmp_mnt | |
1106 ;; directories so that auto-save will work | |
1107 (setq buffer-file-name (abbreviate-file-name buffer-file-name))) | |
1108 ;; Set buffer's default directory to that of the file. | |
1109 (setq default-directory (file-name-directory buffer-file-name)) | |
1110 ;; Turn off backup files for certain file names. Since | |
1111 ;; this is a permanent local, the major mode won't eliminate it. | |
1112 (and (not (funcall backup-enable-predicate buffer-file-name)) | |
1113 (progn | |
1114 (make-local-variable 'backup-inhibited) | |
1115 (setq backup-inhibited t))) | |
1116 (if rawfile | |
1117 ;; #### FSF 20.3 sets buffer-file-coding-system to | |
1118 ;; `no-conversion' here. Should we copy? It also | |
1119 ;; makes `find-file-literally' a local variable | |
1120 ;; and sets it to t. | |
1121 nil | |
1122 (after-find-file error (not nowarn)) | |
1123 (setq buf (current-buffer)))) | |
1124 (t | |
1125 (kill-buffer buf) | |
1126 (signal (car data) (cdr data)))) | |
1127 )) | |
1128 buf))) | |
1129 | 1463 |
1130 ;; FSF has `insert-file-literally' and `find-file-literally' here. | |
1131 | |
1132 (defvar after-find-file-from-revert-buffer nil) | 1464 (defvar after-find-file-from-revert-buffer nil) |
1133 | 1465 |
1134 (defun after-find-file (&optional error warn noauto | 1466 (defun after-find-file (&optional error warn noauto |
1135 after-find-file-from-revert-buffer | 1467 after-find-file-from-revert-buffer |
1136 nomodes) | 1468 nomodes) |
1141 exists an auto-save file more recent than the visited file. | 1473 exists an auto-save file more recent than the visited file. |
1142 NOAUTO means don't mess with auto-save mode. | 1474 NOAUTO means don't mess with auto-save mode. |
1143 Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil | 1475 Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil |
1144 means this call was from `revert-buffer'. | 1476 means this call was from `revert-buffer'. |
1145 Fifth arg NOMODES non-nil means don't alter the file's modes. | 1477 Fifth arg NOMODES non-nil means don't alter the file's modes. |
1146 Finishes by calling the functions in `find-file-hooks'." | 1478 Finishes by calling the functions in `find-file-hooks' |
1479 unless NOMODES is non-nil." | |
1147 (setq buffer-read-only (not (file-writable-p buffer-file-name))) | 1480 (setq buffer-read-only (not (file-writable-p buffer-file-name))) |
1148 (if noninteractive | 1481 (if noninteractive |
1149 nil | 1482 nil |
1150 (let* (not-serious | 1483 (let* (not-serious |
1151 (msg | 1484 (msg |
1152 (cond ((and error (file-attributes buffer-file-name)) | 1485 (cond |
1153 (setq buffer-read-only t) | 1486 ((not warn) nil) |
1154 (gettext "File exists, but cannot be read.")) | 1487 ((and error (file-attributes buffer-file-name)) |
1155 ((not buffer-read-only) | 1488 (setq buffer-read-only t) |
1156 (if (and warn | 1489 (gettext "File exists, but cannot be read.")) |
1157 (file-newer-than-file-p (make-auto-save-file-name) | 1490 ((not buffer-read-only) |
1158 buffer-file-name)) | 1491 (if (and warn |
1159 (format "%s has auto save data; consider M-x recover-file" | 1492 (file-newer-than-file-p (make-auto-save-file-name) |
1160 (file-name-nondirectory buffer-file-name)) | 1493 buffer-file-name)) |
1161 (setq not-serious t) | 1494 (format "%s has auto save data; consider M-x recover-file" |
1162 (if error (gettext "(New file)") nil))) | 1495 (file-name-nondirectory buffer-file-name)) |
1163 ((not error) | 1496 (setq not-serious t) |
1164 (setq not-serious t) | 1497 (if error (gettext "(New file)") nil))) |
1165 (gettext "Note: file is write protected")) | 1498 ((not error) |
1166 ((file-attributes (directory-file-name default-directory)) | 1499 (setq not-serious t) |
1167 (gettext "File not found and directory write-protected")) | 1500 (gettext "Note: file is write protected")) |
1168 ((file-exists-p (file-name-directory buffer-file-name)) | 1501 ((file-attributes (directory-file-name default-directory)) |
1169 (setq buffer-read-only nil)) | 1502 (gettext "File not found and directory write-protected")) |
1170 (t | 1503 ((file-exists-p (file-name-directory buffer-file-name)) |
1171 ;; If the directory the buffer is in doesn't exist, | 1504 (setq buffer-read-only nil)) |
1172 ;; offer to create it. It's better to do this now | 1505 (t |
1173 ;; than when we save the buffer, because we want | 1506 ;; If the directory the buffer is in doesn't exist, |
1174 ;; autosaving to work. | 1507 ;; offer to create it. It's better to do this now |
1175 (setq buffer-read-only nil) | 1508 ;; than when we save the buffer, because we want |
1176 ;; XEmacs | 1509 ;; autosaving to work. |
1177 (or (file-exists-p (file-name-directory buffer-file-name)) | 1510 (setq buffer-read-only nil) |
1178 (condition-case nil | 1511 ;; XEmacs |
1179 (if (yes-or-no-p | 1512 (or (file-exists-p (file-name-directory buffer-file-name)) |
1180 (format | 1513 (condition-case nil |
1181 "\ | 1514 (if (yes-or-no-p |
1515 (format | |
1516 "\ | |
1182 The directory containing %s does not exist. Create? " | 1517 The directory containing %s does not exist. Create? " |
1183 (abbreviate-file-name buffer-file-name))) | 1518 (abbreviate-file-name buffer-file-name))) |
1184 (make-directory (file-name-directory | 1519 (make-directory (file-name-directory |
1185 buffer-file-name) | 1520 buffer-file-name) |
1186 t)) | 1521 t)) |
1187 (quit | 1522 (quit |
1188 (kill-buffer (current-buffer)) | 1523 (kill-buffer (current-buffer)) |
1189 (signal 'quit nil)))) | 1524 (signal 'quit nil)))) |
1190 nil)))) | 1525 nil)))) |
1191 (if msg | 1526 (if msg |
1192 (progn | 1527 (progn |
1193 (message "%s" msg) | 1528 (message "%s" msg) |
1194 (or not-serious (sit-for 1 t))))) | 1529 (or not-serious (sit-for 1 t))))) |
1195 (if (and auto-save-default (not noauto)) | 1530 (when (and auto-save-default (not noauto)) |
1196 (auto-save-mode t))) | 1531 (auto-save-mode t))) |
1532 ;; Make people do a little extra work (C-x C-q) | |
1533 ;; before altering a backup file. | |
1534 (when (backup-file-name-p buffer-file-name) | |
1535 (setq buffer-read-only t)) | |
1197 (unless nomodes | 1536 (unless nomodes |
1537 ;; #### No view-mode-disable. | |
1538 ; (when view-read-only | |
1539 ; (and-boundp 'view-mode (view-mode-disable))) | |
1198 (normal-mode t) | 1540 (normal-mode t) |
1541 (when (and buffer-read-only | |
1542 view-read-only | |
1543 (not (eq (get major-mode 'mode-class) 'special))) | |
1544 (view-mode)) | |
1199 (run-hooks 'find-file-hooks))) | 1545 (run-hooks 'find-file-hooks))) |
1200 | 1546 |
1201 (defun normal-mode (&optional find-file) | 1547 (defun normal-mode (&optional find-file) |
1202 "Choose the major mode for this buffer automatically. | 1548 "Choose the major mode for this buffer automatically. |
1203 Also sets up any specified local variables of the file. | 1549 Also sets up any specified local variables of the file. |
1204 Uses the visited file name, the -*- line, and the local variables spec. | 1550 Uses the visited file name, the -*- line, and the local variables spec. |
1205 | 1551 |
1206 This function is called automatically from `find-file'. In that case, | 1552 This function is called automatically from `find-file'. In that case, |
1207 we may set up specified local variables depending on the value of | 1553 we may set up the file-specified mode and local variables, |
1208 `enable-local-variables': if it is t, we do; if it is nil, we don't; | 1554 depending on the value of `enable-local-variables': if it is t, we do; |
1209 otherwise, we query. `enable-local-variables' is ignored if you | 1555 if it is nil, we don't; otherwise, we query. |
1210 run `normal-mode' explicitly." | 1556 In addition, if `local-enable-local-variables' is nil, we do |
1557 not set local variables (though we do notice a mode specified with -*-.) | |
1558 | |
1559 `enable-local-variables' is ignored if you run `normal-mode' interactively, | |
1560 or from Lisp without specifying the optional argument FIND-FILE; | |
1561 in that case, this function acts as if `enable-local-variables' were t." | |
1211 (interactive) | 1562 (interactive) |
1212 (or find-file (funcall (or default-major-mode 'fundamental-mode))) | 1563 (or find-file (funcall (or default-major-mode 'fundamental-mode))) |
1213 (and (with-trapping-errors | 1564 (and (with-trapping-errors |
1214 :operation "File mode specification" | 1565 :operation "File mode specification" |
1215 :class 'file-mode-spec | 1566 :class 'file-mode-spec |
1218 t) | 1569 t) |
1219 (with-trapping-errors | 1570 (with-trapping-errors |
1220 :operation "File local-variables" | 1571 :operation "File local-variables" |
1221 :class 'local-variables | 1572 :class 'local-variables |
1222 :error-form nil | 1573 :error-form nil |
1574 ;; FSF 21.2: | |
1575 ; (let ((enable-local-variables (or (not find-file) | |
1576 ; enable-local-variables))) | |
1577 ; (hack-local-variables)) | |
1223 (hack-local-variables (not find-file))))) | 1578 (hack-local-variables (not find-file))))) |
1579 | |
1580 ;; END SYNC WITH FSF 21.2. | |
1224 | 1581 |
1225 ;; `auto-mode-alist' used to contain entries for modes in core and in packages. | 1582 ;; `auto-mode-alist' used to contain entries for modes in core and in packages. |
1226 ;; The applicable entries are now located in the corresponding modes in | 1583 ;; The applicable entries are now located in the corresponding modes in |
1227 ;; packages, the ones here are for core modes. Ditto for | 1584 ;; packages, the ones here are for core modes. Ditto for |
1228 ;; `interpreter-mode-alist' below. | 1585 ;; `interpreter-mode-alist' below. |
1304 | 1661 |
1305 (defvar inhibit-first-line-modes-suffixes nil | 1662 (defvar inhibit-first-line-modes-suffixes nil |
1306 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'. | 1663 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'. |
1307 When checking `inhibit-first-line-modes-regexps', we first discard | 1664 When checking `inhibit-first-line-modes-regexps', we first discard |
1308 from the end of the file name anything that matches one of these regexps.") | 1665 from the end of the file name anything that matches one of these regexps.") |
1666 | |
1667 ;; Junk from FSF 21.2. Unnecessary in XEmacs, since `interpreter-mode-alist' | |
1668 ;; can have regexps. | |
1669 ; (defvar auto-mode-interpreter-regexp | |
1670 ; "#![ \t]?\\([^ \t\n]*\ | |
1671 ; /bin/env[ \t]\\)?\\([^ \t\n]+\\)" | |
1672 ; "Regular expression matching interpreters, for file mode determination. | |
1673 ; This regular expression is matched against the first line of a file | |
1674 ; to determine the file's mode in `set-auto-mode' when Emacs can't deduce | |
1675 ; a mode from the file's name. If it matches, the file is assumed to | |
1676 ; be interpreted by the interpreter matched by the second group of the | |
1677 ; regular expression. The mode is then determined as the mode associated | |
1678 ; with that interpreter in `interpreter-mode-alist'.") | |
1309 | 1679 |
1310 (defvar user-init-file | 1680 (defvar user-init-file |
1311 nil ; set by command-line | 1681 nil ; set by command-line |
1312 "File name including directory of user's initialization file.") | 1682 "File name including directory of user's initialization file.") |
1313 | 1683 |
1637 (t | 2007 (t |
1638 nil))) | 2008 nil))) |
1639 (setq result (cdr result))) | 2009 (setq result (cdr result))) |
1640 mode-p))) | 2010 mode-p))) |
1641 | 2011 |
2012 ;; BEGIN SYNC WITH FSF 21.2. | |
2013 | |
1642 (defconst ignored-local-variables | 2014 (defconst ignored-local-variables |
1643 (list 'enable-local-eval) | 2015 (list 'enable-local-eval) |
1644 "Variables to be ignored in a file's local variable spec.") | 2016 "Variables to be ignored in a file's local variable spec.") |
1645 | 2017 |
1646 ;; Get confirmation before setting these variables as locals in a file. | 2018 ;; Get confirmation before setting these variables as locals in a file. |
1656 (put 'buffer-file-truename 'risky-local-variable t) | 2028 (put 'buffer-file-truename 'risky-local-variable t) |
1657 (put 'exec-path 'risky-local-variable t) | 2029 (put 'exec-path 'risky-local-variable t) |
1658 (put 'load-path 'risky-local-variable t) | 2030 (put 'load-path 'risky-local-variable t) |
1659 (put 'exec-directory 'risky-local-variable t) | 2031 (put 'exec-directory 'risky-local-variable t) |
1660 (put 'process-environment 'risky-local-variable t) | 2032 (put 'process-environment 'risky-local-variable t) |
2033 (put 'dabbrev-case-fold-search 'risky-local-variable t) | |
2034 (put 'dabbrev-case-replace 'risky-local-variable t) | |
1661 ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode. | 2035 ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode. |
1662 (put 'outline-level 'risky-local-variable t) | 2036 (put 'outline-level 'risky-local-variable t) |
1663 (put 'rmail-output-file-alist 'risky-local-variable t) | 2037 (put 'rmail-output-file-alist 'risky-local-variable t) |
1664 | 2038 |
1665 ;; This one is safe because the user gets to check it before it is used. | 2039 ;; This one is safe because the user gets to check it before it is used. |
1666 (put 'compile-command 'safe-local-variable t) | 2040 (put 'compile-command 'safe-local-variable t) |
1667 | 2041 |
1668 ;(defun hack-one-local-variable-quotep (exp) | 2042 (defun hack-one-local-variable-quotep (exp) |
1669 ; (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) | 2043 (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) |
1670 | 2044 |
1671 ;; "Set" one variable in a local variables spec. | |
1672 ;; A few variable names are treated specially. | |
1673 (defun hack-one-local-variable (var val) | 2045 (defun hack-one-local-variable (var val) |
2046 "\"Set\" one variable in a local variables spec. | |
2047 A few variable names are treated specially." | |
1674 (cond ((eq var 'mode) | 2048 (cond ((eq var 'mode) |
1675 (funcall (intern (concat (downcase (symbol-name val)) | 2049 (funcall (intern (concat (downcase (symbol-name val)) |
1676 "-mode")))) | 2050 "-mode")))) |
2051 ((eq var 'coding) | |
2052 ;; We have already handled coding: tag in set-auto-coding. | |
2053 nil) | |
1677 ((memq var ignored-local-variables) | 2054 ((memq var ignored-local-variables) |
1678 nil) | 2055 nil) |
1679 ;; "Setting" eval means either eval it or do nothing. | 2056 ;; "Setting" eval means either eval it or do nothing. |
1680 ;; Likewise for setting hook variables. | 2057 ;; Likewise for setting hook variables. |
1681 ((or (get var 'risky-local-variable) | 2058 ((or (get var 'risky-local-variable) |
1682 (and | 2059 (and |
1683 (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$" | 2060 (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$" |
1684 (symbol-name var)) | 2061 (symbol-name var)) |
1685 (not (get var 'safe-local-variable)))) | 2062 (not (get var 'safe-local-variable)))) |
1686 ; ;; Permit evaling a put of a harmless property | 2063 ;; Permit evalling a put of a harmless property. |
1687 ; ;; if the args do nothing tricky. | 2064 ;; if the args do nothing tricky. |
1688 ; (if (or (and (eq var 'eval) | 2065 (if (or (and (eq var 'eval) |
1689 ; (consp val) | 2066 (consp val) |
1690 ; (eq (car val) 'put) | 2067 (eq (car val) 'put) |
1691 ; (hack-one-local-variable-quotep (nth 1 val)) | 2068 (hack-one-local-variable-quotep (nth 1 val)) |
1692 ; (hack-one-local-variable-quotep (nth 2 val)) | 2069 (hack-one-local-variable-quotep (nth 2 val)) |
1693 ; ;; Only allow safe values of lisp-indent-hook; | 2070 ;; Only allow safe values of lisp-indent-hook; |
1694 ; ;; not functions. | 2071 ;; not functions. |
1695 ; (or (numberp (nth 3 val)) | 2072 (or (numberp (nth 3 val)) |
1696 ; (equal (nth 3 val) ''defun)) | 2073 (equal (nth 3 val) ''defun)) |
1697 ; (memq (nth 1 (nth 2 val)) | 2074 (memq (nth 1 (nth 2 val)) |
1698 ; '(lisp-indent-hook))) | 2075 '(lisp-indent-hook))) |
1699 (if (and (not (zerop (user-uid))) | 2076 ;; Permit eval if not root and user says ok. |
1700 (or (eq enable-local-eval t) | 2077 (and (not (zerop (user-uid))) |
1701 (and enable-local-eval | 2078 (or (eq enable-local-eval t) |
1702 (save-window-excursion | 2079 (and enable-local-eval |
1703 (switch-to-buffer (current-buffer)) | 2080 (save-window-excursion |
1704 (save-excursion | 2081 (switch-to-buffer (current-buffer)) |
1705 (beginning-of-line) | 2082 (save-excursion |
1706 (set-window-start (selected-window) (point))) | 2083 (beginning-of-line) |
1707 (setq enable-local-eval | 2084 (set-window-start (selected-window) (point))) |
1708 (y-or-n-p (format "Process `eval' or hook local variables in file %s? " | 2085 (setq enable-local-eval |
1709 (file-name-nondirectory buffer-file-name)))))))) | 2086 (y-or-n-p (format "Process `eval' or hook local variables in %s? " |
2087 (if buffer-file-name | |
2088 (concat "file " (file-name-nondirectory buffer-file-name)) | |
2089 (concat "buffer " (buffer-name))))))))))) | |
1710 (if (eq var 'eval) | 2090 (if (eq var 'eval) |
1711 (save-excursion (eval val)) | 2091 (save-excursion (eval val)) |
1712 (make-local-variable var) | 2092 (make-local-variable var) |
1713 (set var val)) | 2093 (set var val)) |
1714 (message "Ignoring `eval:' in file's local variables"))) | 2094 (message "Ignoring `eval:' in the local variables list"))) |
1715 ;; Ordinary variable, really set it. | 2095 ;; Ordinary variable, really set it. |
1716 (t (make-local-variable var) | 2096 (t (make-local-variable var) |
1717 (set var val)))) | 2097 (set var val)))) |
1718 | 2098 |
1719 (defun find-coding-system-magic-cookie-in-file (file) | 2099 (defun find-coding-system-magic-cookie-in-file (file) |
1760 (point)))) | 2140 (point)))) |
1761 (if (> end start) (buffer-substring start end)) | 2141 (if (> end start) (buffer-substring start end)) |
1762 ))) | 2142 ))) |
1763 )))) | 2143 )))) |
1764 | 2144 |
2145 | |
1765 (defcustom change-major-mode-with-file-name t | 2146 (defcustom change-major-mode-with-file-name t |
1766 "*Non-nil means \\[write-file] should set the major mode from the file name. | 2147 "*Non-nil means \\[write-file] should set the major mode from the file name. |
1767 However, the mode will not be changed if | 2148 However, the mode will not be changed if |
1768 \(1) a local variables list or the `-*-' line specifies a major mode, or | 2149 \(1) a local variables list or the `-*-' line specifies a major mode, or |
1769 \(2) the current major mode is a \"special\" mode, | 2150 \(2) the current major mode is a \"special\" mode, |
1880 (get major-mode 'mode-class) | 2261 (get major-mode 'mode-class) |
1881 ;; Don't change the mode if the local variable list specifies it. | 2262 ;; Don't change the mode if the local variable list specifies it. |
1882 (hack-local-variables t) | 2263 (hack-local-variables t) |
1883 (set-auto-mode t)) | 2264 (set-auto-mode t)) |
1884 (error nil)) | 2265 (error nil)) |
1885 ;; #### ?? | 2266 ;; #### ?? not in FSF. |
1886 (run-hooks 'after-set-visited-file-name-hooks)) | 2267 (run-hooks 'after-set-visited-file-name-hooks)) |
1887 | 2268 |
1888 (defun write-file (filename &optional confirm codesys) | 2269 (defun write-file (filename &optional confirm codesys) |
1889 "Write current buffer into file FILENAME. | 2270 "Write current buffer into file FILENAME. |
1890 Makes buffer visit that file, and marks it not modified. If the buffer is | 2271 This makes the buffer visit that file, and marks it as not modified. |
1891 already visiting a file, you can specify a directory name as FILENAME, to | 2272 |
1892 write a file of the same old name in that directory. | 2273 If you specify just a directory name as FILENAME, that means to use |
1893 | 2274 the default file name but in that directory. You can also yank |
1894 If optional second arg CONFIRM is non-nil, ask for confirmation for | 2275 the default file name into the minibuffer to edit it, using M-n. |
1895 overwriting an existing file. | 2276 |
2277 If the buffer is not already visiting a file, the default file name | |
2278 for the output file is the buffer name. | |
2279 | |
2280 If optional second arg CONFIRM is non-nil, this function | |
2281 asks for confirmation before overwriting an existing file. | |
2282 Interactively, this is always the case. | |
1896 | 2283 |
1897 Optional third argument specifies the coding system to use when encoding | 2284 Optional third argument specifies the coding system to use when encoding |
1898 the file. Interactively, with a prefix argument, you will be prompted for | 2285 the file. Interactively, with a prefix argument, you will be prompted for |
1899 the coding system." | 2286 the coding system." |
1900 ;; (interactive "FWrite file: ") | 2287 ;; (interactive "FWrite file: ") |
1901 (interactive | 2288 (interactive |
1902 (list (if buffer-file-name | 2289 (list (if buffer-file-name |
1903 (read-file-name "Write file: " | 2290 (read-file-name "Write file: " |
1904 nil nil nil nil) | 2291 nil nil nil nil) |
1905 (read-file-name "Write file: " | 2292 (read-file-name "Write file: " default-directory |
1906 (cdr (assq 'default-directory | 2293 (expand-file-name |
1907 (buffer-local-variables))) | 2294 (file-name-nondirectory (buffer-name)) |
1908 nil nil (buffer-name))) | 2295 default-directory) |
2296 nil nil)) | |
1909 t | 2297 t |
1910 (if current-prefix-arg (read-coding-system "Coding system: ")))) | 2298 (if current-prefix-arg (read-coding-system "Coding system: ")))) |
1911 (and (eq (current-buffer) mouse-grabbed-buffer) | 2299 (and (eq (current-buffer) mouse-grabbed-buffer) |
1912 (error "Can't write minibuffer window")) | 2300 (error "Can't write minibuffer window")) |
1913 (or (null filename) (string-equal filename "") | 2301 (or (null filename) (string-equal filename "") |
1914 (progn | 2302 (progn |
1915 ;; If arg is just a directory, | 2303 ;; If arg is just a directory, |
1916 ;; use same file name, but in that directory. | 2304 ;; use the default file name, but in that directory. |
1917 (if (and (file-directory-p filename) buffer-file-name) | 2305 (if (file-directory-p filename) |
1918 (setq filename (concat (file-name-as-directory filename) | 2306 (setq filename (concat (file-name-as-directory filename) |
1919 (file-name-nondirectory buffer-file-name)))) | 2307 (file-name-nondirectory |
2308 (or buffer-file-name (buffer-name)))))) | |
1920 (and confirm | 2309 (and confirm |
1921 (file-exists-p filename) | 2310 (file-exists-p filename) |
1922 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename)) | 2311 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename)) |
1923 (error "Canceled"))) | 2312 (error "Canceled"))) |
1924 (set-visited-file-name filename))) | 2313 (set-visited-file-name filename (not confirm)))) |
1925 (set-buffer-modified-p t) | 2314 (set-buffer-modified-p t) |
1926 (setq buffer-read-only nil) | 2315 ;; Make buffer writable if file is writable. |
2316 (and buffer-file-name | |
2317 (file-writable-p buffer-file-name) | |
2318 (setq buffer-read-only nil)) | |
1927 (if codesys | 2319 (if codesys |
1928 (let ((buffer-file-coding-system (get-coding-system codesys))) | 2320 (let ((buffer-file-coding-system (get-coding-system codesys))) |
1929 (save-buffer)) | 2321 (save-buffer)) |
1930 (save-buffer))) | 2322 (save-buffer))) |
1931 | 2323 |
2324 | |
1932 (defun backup-buffer () | 2325 (defun backup-buffer () |
1933 "Make a backup of the disk file visited by the current buffer, if appropriate. | 2326 "Make a backup of the disk file visited by the current buffer, if appropriate. |
1934 This is normally done before saving the buffer the first time. | 2327 This is normally done before saving the buffer the first time. |
1935 If the value is non-nil, it is the result of `file-modes' on the original file; | 2328 If the value is non-nil, it is the result of `file-modes' on the original |
1936 this means that the caller, after saving the buffer, should change the modes | 2329 file; this means that the caller, after saving the buffer, should change |
1937 of the new file to agree with the old modes." | 2330 the modes of the new file to agree with the old modes. |
2331 | |
2332 A backup may be done by renaming or by copying; see documentation of | |
2333 variable `make-backup-files'. If it's done by renaming, then the file is | |
2334 no longer accessible under its old name." | |
1938 (if buffer-file-name | 2335 (if buffer-file-name |
1939 (let ((handler (find-file-name-handler buffer-file-name 'backup-buffer))) | 2336 (let ((handler (find-file-name-handler buffer-file-name 'backup-buffer))) |
1940 (if handler | 2337 (if handler |
1941 (funcall handler 'backup-buffer) | 2338 (funcall handler 'backup-buffer) |
1942 (if (and make-backup-files | 2339 (if (and make-backup-files |
1972 (if (or file-precious-flag | 2369 (if (or file-precious-flag |
1973 ; (file-symlink-p buffer-file-name) | 2370 ; (file-symlink-p buffer-file-name) |
1974 backup-by-copying | 2371 backup-by-copying |
1975 (and backup-by-copying-when-linked | 2372 (and backup-by-copying-when-linked |
1976 (> (file-nlinks real-file-name) 1)) | 2373 (> (file-nlinks real-file-name) 1)) |
1977 (and backup-by-copying-when-mismatch | 2374 (and (or backup-by-copying-when-mismatch |
2375 (integerp backup-by-copying-when-privileged-mismatch)) | |
1978 (let ((attr (file-attributes real-file-name))) | 2376 (let ((attr (file-attributes real-file-name))) |
1979 (or (nth 9 attr) | 2377 (and (or backup-by-copying-when-mismatch |
1980 (not (file-ownership-preserved-p real-file-name)))))) | 2378 (and (integerp (nth 2 attr)) |
2379 (integerp backup-by-copying-when-privileged-mismatch) | |
2380 (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch))) | |
2381 (or (nth 9 attr) | |
2382 (not (file-ownership-preserved-p real-file-name))))))) | |
1981 (condition-case () | 2383 (condition-case () |
1982 (copy-file real-file-name backupname t t) | 2384 (copy-file real-file-name backupname t t) |
1983 (file-error | 2385 (file-error |
1984 ;; If copying fails because file BACKUPNAME | 2386 ;; If copying fails because file BACKUPNAME |
1985 ;; is not writable, delete that file and try again. | 2387 ;; is not writable, delete that file and try again. |
1993 (file-error | 2395 (file-error |
1994 ;; If trouble writing the backup, write it in ~. | 2396 ;; If trouble writing the backup, write it in ~. |
1995 (setq backupname | 2397 (setq backupname |
1996 (expand-file-name | 2398 (expand-file-name |
1997 (convert-standard-filename "~/%backup%~"))) | 2399 (convert-standard-filename "~/%backup%~"))) |
1998 (lwarn 'file 'alert "Cannot write backup file; backing up in ~/%%backup%%~") | 2400 (lwarn 'file 'alert "Cannot write backup file; backing up in %s" |
2401 (file-name-nondirectory backupname)) | |
1999 (sleep-for 1) | 2402 (sleep-for 1) |
2000 (condition-case () | 2403 (condition-case () |
2001 (copy-file real-file-name backupname t t) | 2404 (copy-file real-file-name backupname t t) |
2002 (file-error | 2405 (file-error |
2003 ;; If copying fails because file BACKUPNAME | 2406 ;; If copying fails because file BACKUPNAME |
2075 (if (string-match "\\.[^.]*\\'" file) | 2478 (if (string-match "\\.[^.]*\\'" file) |
2076 (substring file (+ (match-beginning 0) (if period 0 1))) | 2479 (substring file (+ (match-beginning 0) (if period 0 1))) |
2077 (if period | 2480 (if period |
2078 ""))))) | 2481 ""))))) |
2079 | 2482 |
2483 (defcustom make-backup-file-name-function nil | |
2484 "A function to use instead of the default `make-backup-file-name'. | |
2485 A value of nil gives the default `make-backup-file-name' behaviour. | |
2486 | |
2487 This could be buffer-local to do something special for specific | |
2488 files. If you define it, you may need to change `backup-file-name-p' | |
2489 and `file-name-sans-versions' too. | |
2490 | |
2491 See also `backup-directory-alist'." | |
2492 :group 'backup | |
2493 :type '(choice (const :tag "Default" nil) | |
2494 (function :tag "Your function"))) | |
2495 | |
2496 (defcustom backup-directory-alist nil | |
2497 "Alist of filename patterns and backup directory names. | |
2498 Each element looks like (REGEXP . DIRECTORY). Backups of files with | |
2499 names matching REGEXP will be made in DIRECTORY. DIRECTORY may be | |
2500 relative or absolute. If it is absolute, so that all matching files | |
2501 are backed up into the same directory, the file names in this | |
2502 directory will be the full name of the file backed up with all | |
2503 directory separators changed to `!' to prevent clashes. This will not | |
2504 work correctly if your filesystem truncates the resulting name. | |
2505 | |
2506 For the common case of all backups going into one directory, the alist | |
2507 should contain a single element pairing \".\" with the appropriate | |
2508 directory name. | |
2509 | |
2510 If this variable is nil, or it fails to match a filename, the backup | |
2511 is made in the original file's directory. | |
2512 | |
2513 On MS-DOS filesystems without long names this variable is always | |
2514 ignored." | |
2515 :group 'backup | |
2516 :type '(repeat (cons (regexp :tag "Regexp matching filename") | |
2517 (directory :tag "Backup directory name")))) | |
2518 | |
2080 (defun make-backup-file-name (file) | 2519 (defun make-backup-file-name (file) |
2081 "Create the non-numeric backup file name for FILE. | 2520 "Create the non-numeric backup file name for FILE. |
2082 This is a separate function so you can redefine it for customization." | 2521 Normally this will just be the file's name with `~' appended. |
2083 ;; FSF has code here for MS-DOS short filenames, not supported in XEmacs. | 2522 Customization hooks are provided as follows. |
2084 (concat file "~")) | 2523 |
2524 If the variable `make-backup-file-name-function' is non-nil, its value | |
2525 should be a function which will be called with FILE as its argument; | |
2526 the resulting name is used. | |
2527 | |
2528 Otherwise a match for FILE is sought in `backup-directory-alist'; see | |
2529 the documentation of that variable. If the directory for the backup | |
2530 doesn't exist, it is created." | |
2531 (if make-backup-file-name-function | |
2532 (funcall make-backup-file-name-function file) | |
2533 ; (if (and (eq system-type 'ms-dos) | |
2534 ; (not (msdos-long-file-names))) | |
2535 ; (let ((fn (file-name-nondirectory file))) | |
2536 ; (concat (file-name-directory file) | |
2537 ; (or (and (string-match "\\`[^.]+\\'" fn) | |
2538 ; (concat (match-string 0 fn) ".~")) | |
2539 ; (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn) | |
2540 ; (concat (match-string 0 fn) "~"))))) | |
2541 (concat (make-backup-file-name-1 file) "~"))) | |
2542 | |
2543 (defun make-backup-file-name-1 (file) | |
2544 "Subroutine of `make-backup-file-name' and `find-backup-file-name'." | |
2545 (let ((alist backup-directory-alist) | |
2546 elt backup-directory dir-sep-string) | |
2547 (while alist | |
2548 (setq elt (pop alist)) | |
2549 (if (string-match (car elt) file) | |
2550 (setq backup-directory (cdr elt) | |
2551 alist nil))) | |
2552 (if (null backup-directory) | |
2553 file | |
2554 (unless (file-exists-p backup-directory) | |
2555 (condition-case nil | |
2556 (make-directory backup-directory 'parents) | |
2557 (file-error file))) | |
2558 (if (file-name-absolute-p backup-directory) | |
2559 (progn | |
2560 (when (memq system-type '(windows-nt ms-dos)) | |
2561 ;; Normalize DOSish file names: convert all slashes to | |
2562 ;; directory-sep-char, downcase the drive letter, if any, | |
2563 ;; and replace the leading "x:" with "/drive_x". | |
2564 (or (file-name-absolute-p file) | |
2565 (setq file (expand-file-name file))) ; make defaults explicit | |
2566 ;; Replace any invalid file-name characters (for the | |
2567 ;; case of backing up remote files). | |
2568 (setq file (expand-file-name (convert-standard-filename file))) | |
2569 (setq dir-sep-string (char-to-string directory-sep-char)) | |
2570 (if (eq (aref file 1) ?:) | |
2571 (setq file (concat dir-sep-string | |
2572 "drive_" | |
2573 (char-to-string (downcase (aref file 0))) | |
2574 (if (eq (aref file 2) directory-sep-char) | |
2575 "" | |
2576 dir-sep-string) | |
2577 (substring file 2))))) | |
2578 ;; Make the name unique by substituting directory | |
2579 ;; separators. It may not really be worth bothering about | |
2580 ;; doubling `!'s in the original name... | |
2581 (expand-file-name | |
2582 (subst-char-in-string | |
2583 directory-sep-char ?! | |
2584 (replace-regexp-in-string "!" "!!" file)) | |
2585 backup-directory)) | |
2586 (expand-file-name (file-name-nondirectory file) | |
2587 (file-name-as-directory | |
2588 (expand-file-name backup-directory | |
2589 (file-name-directory file)))))))) | |
2085 | 2590 |
2086 (defun backup-file-name-p (file) | 2591 (defun backup-file-name-p (file) |
2087 "Return non-nil if FILE is a backup file name (numeric or not). | 2592 "Return non-nil if FILE is a backup file name (numeric or not). |
2088 This is a separate function so you can redefine it for customization. | 2593 This is a separate function so you can redefine it for customization. |
2089 You may need to redefine `file-name-sans-versions' as well." | 2594 You may need to redefine `file-name-sans-versions' as well." |
2090 (string-match "~\\'" file)) | 2595 (string-match "~\\'" file)) |
2091 | 2596 |
2597 (defvar backup-extract-version-start) | |
2598 | |
2092 ;; This is used in various files. | 2599 ;; This is used in various files. |
2093 ;; The usage of bv-length is not very clean, | 2600 ;; The usage of backup-extract-version-start is not very clean, |
2094 ;; but I can't see a good alternative, | 2601 ;; but I can't see a good alternative, so as of now I am leaving it alone. |
2095 ;; so as of now I am leaving it alone. | |
2096 (defun backup-extract-version (fn) | 2602 (defun backup-extract-version (fn) |
2097 "Given the name of a numeric backup file, return the backup number. | 2603 "Given the name of a numeric backup file, FN, return the backup number. |
2098 Uses the free variable `bv-length', whose value should be | 2604 Uses the free variable `backup-extract-version-start', whose value should be |
2099 the index in the name where the version number begins." | 2605 the index in the name where the version number begins." |
2100 (declare (special bv-length)) | 2606 (if (and (string-match "[0-9]+~$" fn backup-extract-version-start) |
2101 (if (and (string-match "[0-9]+~\\'" fn bv-length) | 2607 (= (match-beginning 0) backup-extract-version-start)) |
2102 (= (match-beginning 0) bv-length)) | 2608 (string-to-int (substring fn backup-extract-version-start -1)) |
2103 (string-to-int (substring fn bv-length -1)) | |
2104 0)) | 2609 0)) |
2105 | 2610 |
2611 ;; [[ FSF 21.2 says: | |
2612 ;; I believe there is no need to alter this behavior for VMS; | |
2613 ;; since backup files are not made on VMS, it should not get called. ]] | |
2106 (defun find-backup-file-name (fn) | 2614 (defun find-backup-file-name (fn) |
2107 "Find a file name for a backup file, and suggestions for deletions. | 2615 "Find a file name for a backup file FN, and suggestions for deletions. |
2108 Value is a list whose car is the name for the backup file | 2616 Value is a list whose car is the name for the backup file |
2109 and whose cdr is a list of old versions to consider deleting now. | 2617 and whose cdr is a list of old versions to consider deleting now. |
2110 If the value is nil, don't make a backup." | 2618 If the value is nil, don't make a backup. |
2111 (declare (special bv-length)) | 2619 Uses `backup-directory-alist' in the same way as does |
2620 `make-backup-file-name'." | |
2112 (let ((handler (find-file-name-handler fn 'find-backup-file-name))) | 2621 (let ((handler (find-file-name-handler fn 'find-backup-file-name))) |
2113 ;; Run a handler for this function so that ange-ftp can refuse to do it. | 2622 ;; Run a handler for this function so that ange-ftp can refuse to do it. |
2114 (if handler | 2623 (if handler |
2115 (funcall handler 'find-backup-file-name fn) | 2624 (funcall handler 'find-backup-file-name fn) |
2116 (if (eq version-control 'never) | 2625 (if (or (eq version-control 'never) |
2626 ;; We don't support numbered backups on plain MS-DOS | |
2627 ;; when long file names are unavailable. | |
2628 ; (and (eq system-type 'ms-dos) | |
2629 ; (not (msdos-long-file-names))) | |
2630 ) | |
2117 (list (make-backup-file-name fn)) | 2631 (list (make-backup-file-name fn)) |
2118 (let* ((base-versions (concat (file-name-nondirectory fn) ".~")) | 2632 (let* ((basic-name (make-backup-file-name-1 fn)) |
2119 ;; used by backup-extract-version: | 2633 (base-versions (concat (file-name-nondirectory basic-name) |
2120 (bv-length (length base-versions)) | 2634 ".~")) |
2121 possibilities | 2635 (backup-extract-version-start (length base-versions)) |
2122 (versions nil) | |
2123 (high-water-mark 0) | 2636 (high-water-mark 0) |
2124 (deserve-versions-p nil) | 2637 (number-to-delete 0) |
2125 (number-to-delete 0)) | 2638 possibilities deserve-versions-p versions) |
2126 (condition-case () | 2639 (condition-case () |
2127 (setq possibilities (file-name-all-completions | 2640 (setq possibilities (file-name-all-completions |
2128 base-versions | 2641 base-versions |
2129 (file-name-directory fn)) | 2642 (file-name-directory basic-name)) |
2130 versions (sort (mapcar | 2643 versions (sort (mapcar #'backup-extract-version |
2131 #'backup-extract-version | 2644 possibilities) |
2132 possibilities) | 2645 #'<) |
2133 '<) | 2646 high-water-mark (apply 'max 0 versions) |
2134 high-water-mark (apply #'max 0 versions) | |
2135 deserve-versions-p (or version-control | 2647 deserve-versions-p (or version-control |
2136 (> high-water-mark 0)) | 2648 (> high-water-mark 0)) |
2137 number-to-delete (- (length versions) | 2649 number-to-delete (- (length versions) |
2138 kept-old-versions kept-new-versions -1)) | 2650 kept-old-versions |
2139 (file-error | 2651 kept-new-versions |
2140 (setq possibilities nil))) | 2652 -1)) |
2653 (file-error (setq possibilities nil))) | |
2141 (if (not deserve-versions-p) | 2654 (if (not deserve-versions-p) |
2142 (list (make-backup-file-name fn)) | 2655 (list (make-backup-file-name fn)) |
2143 (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~") | 2656 (cons (format "%s.~%d~" basic-name (1+ high-water-mark)) |
2144 (if (and (> number-to-delete 0) | 2657 (if (and (> number-to-delete 0) |
2145 ;; Delete nothing if there is overflow | 2658 ;; Delete nothing if there is overflow |
2146 ;; in the number of versions to keep. | 2659 ;; in the number of versions to keep. |
2147 (>= (+ kept-new-versions kept-old-versions -1) 0)) | 2660 (>= (+ kept-new-versions kept-old-versions -1) 0)) |
2148 (mapcar #'(lambda (n) | 2661 (mapcar (lambda (n) |
2149 (concat fn ".~" (int-to-string n) "~")) | 2662 (format "%s.~%d~" basic-name n)) |
2150 (let ((v (nthcdr kept-old-versions versions))) | 2663 (let ((v (nthcdr kept-old-versions versions))) |
2151 (rplacd (nthcdr (1- number-to-delete) v) ()) | 2664 (rplacd (nthcdr (1- number-to-delete) v) ()) |
2152 v)))))))))) | 2665 v)))))))))) |
2153 | 2666 |
2154 (defun file-nlinks (filename) | 2667 (defun file-nlinks (filename) |
2155 "Return number of names file FILENAME has." | 2668 "Return number of names file FILENAME has." |
2156 (car (cdr (file-attributes filename)))) | 2669 (car (cdr (file-attributes filename)))) |
2157 | 2670 |
2158 (defun file-relative-name (filename &optional directory) | 2671 (defun file-relative-name (filename &optional directory) |
2159 "Convert FILENAME to be relative to DIRECTORY (default: default-directory). | 2672 "Convert FILENAME to be relative to DIRECTORY (default: `default-directory'). |
2160 This function returns a relative file name which is equivalent to FILENAME | 2673 This function returns a relative file name which is equivalent to FILENAME |
2161 when used with that default directory as the default. | 2674 when used with that default directory as the default. |
2162 If this is impossible (which can happen on MS Windows when the file name | 2675 If this is impossible (which can happen on MS Windows when the file name |
2163 and directory use different drive names) then it returns FILENAME." | 2676 and directory use different drive names) then it returns FILENAME." |
2164 (save-match-data | 2677 (save-match-data |
2193 ;; We matched FNAME's directory equivalent. | 2706 ;; We matched FNAME's directory equivalent. |
2194 ancestor)))))) | 2707 ancestor)))))) |
2195 | 2708 |
2196 (defun save-buffer (&optional args) | 2709 (defun save-buffer (&optional args) |
2197 "Save current buffer in visited file if modified. Versions described below. | 2710 "Save current buffer in visited file if modified. Versions described below. |
2198 | |
2199 By default, makes the previous version into a backup file | 2711 By default, makes the previous version into a backup file |
2200 if previously requested or if this is the first save. | 2712 if previously requested or if this is the first save. |
2201 With 1 or 3 \\[universal-argument]'s, marks this version | 2713 With 1 \\[universal-argument], marks this version |
2202 to become a backup when the next save is done. | 2714 to become a backup when the next save is done. |
2203 With 2 or 3 \\[universal-argument]'s, | 2715 With 2 \\[universal-argument]'s, |
2204 unconditionally makes the previous version into a backup file. | 2716 unconditionally makes the previous version into a backup file. |
2205 With argument of 0, never makes the previous version into a backup file. | 2717 With 3 \\[universal-argument]'s, marks this version |
2718 to become a backup when the next save is done, | |
2719 and unconditionally makes the previous version into a backup file. | |
2720 | |
2721 With argument of 0, never make the previous version into a backup file. | |
2206 | 2722 |
2207 If a file's name is FOO, the names of its numbered backup versions are | 2723 If a file's name is FOO, the names of its numbered backup versions are |
2208 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. | 2724 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. |
2209 Numeric backups (rather than FOO~) will be made if value of | 2725 Numeric backups (rather than FOO~) will be made if value of |
2210 `version-control' is not the atom `never' and either there are already | 2726 `version-control' is not the atom `never' and either there are already |
2211 numeric versions of the file being backed up, or `version-control' is | 2727 numeric versions of the file being backed up, or `version-control' is |
2212 non-nil. | 2728 non-nil. |
2213 We don't want excessive versions piling up, so there are variables | 2729 We don't want excessive versions piling up, so there are variables |
2214 `kept-old-versions', which tells XEmacs how many oldest versions to keep, | 2730 `kept-old-versions', which tells Emacs how many oldest versions to keep, |
2215 and `kept-new-versions', which tells how many newest versions to keep. | 2731 and `kept-new-versions', which tells how many newest versions to keep. |
2216 Defaults are 2 old versions and 2 new. | 2732 Defaults are 2 old versions and 2 new. |
2217 `dired-kept-versions' controls dired's clean-directory (.) command. | 2733 `dired-kept-versions' controls dired's clean-directory (.) command. |
2218 If `delete-old-versions' is nil, system will query user | 2734 If `delete-old-versions' is nil, system will query user |
2219 before trimming versions. Otherwise it does it silently." | 2735 before trimming versions. Otherwise it does it silently. |
2736 | |
2737 If `vc-make-backup-files' is nil, which is the default, | |
2738 no backup files are made for files managed by version control. | |
2739 (This is because the version control system itself records previous versions.) | |
2740 | |
2741 See the subroutine `basic-save-buffer' for more information." | |
2220 (interactive "_p") | 2742 (interactive "_p") |
2221 (let ((modp (buffer-modified-p)) | 2743 (let ((modp (buffer-modified-p)) |
2222 (large (> (buffer-size) 50000)) | 2744 (large (> (buffer-size) 50000)) |
2223 (make-backup-files (or (and make-backup-files (not (eq args 0))) | 2745 (make-backup-files (or (and make-backup-files (not (eq args 0))) |
2224 (memq args '(16 64))))) | 2746 (memq args '(16 64))))) |
2225 (and modp (memq args '(16 64)) (setq buffer-backed-up nil)) | 2747 (and modp (memq args '(16 64)) (setq buffer-backed-up nil)) |
2226 (if (and modp large) (display-message | 2748 (if (and modp large (buffer-file-name)) |
2227 'progress (format "Saving file %s..." | 2749 (display-message 'progress (format "Saving file %s..." |
2228 (buffer-file-name)))) | 2750 (buffer-file-name)))) |
2229 (basic-save-buffer) | 2751 (basic-save-buffer) |
2230 (and modp (memq args '(4 64)) (setq buffer-backed-up nil)))) | 2752 (and modp (memq args '(4 64)) (setq buffer-backed-up nil)))) |
2231 | 2753 |
2232 (defun delete-auto-save-file-if-necessary (&optional force) | 2754 (defun delete-auto-save-file-if-necessary (&optional force) |
2233 "Delete auto-save file for current buffer if `delete-auto-save-files' is t. | 2755 "Delete auto-save file for current buffer if `delete-auto-save-files' is t. |
2234 Normally delete only if the file was written by this XEmacs | 2756 Normally delete only if the file was written by this XEmacs since |
2235 since the last real save, but optional arg FORCE non-nil means delete anyway." | 2757 the last real save, but optional arg FORCE non-nil means delete anyway." |
2236 (and buffer-auto-save-file-name delete-auto-save-files | 2758 (and buffer-auto-save-file-name delete-auto-save-files |
2237 (not (string= buffer-file-name buffer-auto-save-file-name)) | 2759 (not (string= buffer-file-name buffer-auto-save-file-name)) |
2238 (or force (recent-auto-save-p)) | 2760 (or force (recent-auto-save-p)) |
2239 (progn | 2761 (progn |
2240 (ignore-file-errors (delete-file buffer-auto-save-file-name)) | 2762 (ignore-file-errors (delete-file buffer-auto-save-file-name)) |
2254 (setq region-written (funcall (car hooks) realname) | 2776 (setq region-written (funcall (car hooks) realname) |
2255 hooks (cdr hooks))) | 2777 hooks (cdr hooks))) |
2256 (if (not region-written) | 2778 (if (not region-written) |
2257 (write-region (point-min) (point-max) realname nil t truename)))) | 2779 (write-region (point-min) (point-max) realname nil t truename)))) |
2258 | 2780 |
2781 ; (defvar auto-save-hook nil | |
2782 ; "Normal hook run just before auto-saving.") | |
2783 | |
2259 (put 'after-save-hook 'permanent-local t) | 2784 (put 'after-save-hook 'permanent-local t) |
2260 (defvar after-save-hook nil | 2785 (defvar after-save-hook nil |
2261 "Normal hook that is run after a buffer is saved to its file. | 2786 "Normal hook that is run after a buffer is saved to its file. |
2262 These hooks are considered to pertain to the visited file. | 2787 These hooks are considered to pertain to the visited file. |
2263 So this list is cleared if you change the visited file name.") | 2788 So this list is cleared if you change the visited file name.") |
2789 | |
2790 (defvar save-buffer-coding-system nil | |
2791 "If non-nil, use this coding system for saving the buffer. | |
2792 More precisely, use this coding system in place of the | |
2793 value of `buffer-file-coding-system', when saving the buffer. | |
2794 Calling `write-region' for any purpose other than saving the buffer | |
2795 will still use `buffer-file-coding-system'; this variable has no effect | |
2796 in such cases.") | |
2797 | |
2798 (make-variable-buffer-local 'save-buffer-coding-system) | |
2799 (put 'save-buffer-coding-system 'permanent-local t) | |
2264 | 2800 |
2265 (defun files-fetch-hook-value (hook) | 2801 (defun files-fetch-hook-value (hook) |
2266 (let ((localval (symbol-value hook)) | 2802 (let ((localval (symbol-value hook)) |
2267 (globalval (default-value hook))) | 2803 (globalval (default-value hook))) |
2268 (if (memq t localval) | 2804 (if (memq t localval) |
2269 (setq localval (append (delq t localval) (delq t globalval)))) | 2805 (setq localval (append (delq t localval) (delq t globalval)))) |
2270 localval)) | 2806 localval)) |
2271 | 2807 |
2272 (defun basic-save-buffer () | 2808 (defun basic-save-buffer () |
2273 "Save the current buffer in its visited file, if it has been modified. | 2809 "Save the current buffer in its visited file, if it has been modified. |
2274 After saving the buffer, run `after-save-hook'." | 2810 The hooks `write-contents-hooks', `local-write-file-hooks' and |
2811 `write-file-hooks' get a chance to do the job of saving; if they do not, | |
2812 then the buffer is saved in the visited file file in the usual way. | |
2813 After saving the buffer, this function runs `after-save-hook'." | |
2275 (interactive) | 2814 (interactive) |
2276 (save-excursion | 2815 (save-current-buffer |
2277 ;; In an indirect buffer, save its base buffer instead. | 2816 ;; In an indirect buffer, save its base buffer instead. |
2278 (if (buffer-base-buffer) | 2817 (if (buffer-base-buffer) |
2279 (set-buffer (buffer-base-buffer))) | 2818 (set-buffer (buffer-base-buffer))) |
2280 (if (buffer-modified-p) | 2819 (if (buffer-modified-p) |
2281 (let ((recent-save (recent-auto-save-p))) | 2820 (let ((recent-save (recent-auto-save-p))) |
2295 (format "%s has changed since visited or saved. Save anyway? " | 2834 (format "%s has changed since visited or saved. Save anyway? " |
2296 (file-name-nondirectory buffer-file-name))) | 2835 (file-name-nondirectory buffer-file-name))) |
2297 (error "Save not confirmed")) | 2836 (error "Save not confirmed")) |
2298 (save-restriction | 2837 (save-restriction |
2299 (widen) | 2838 (widen) |
2300 | 2839 (save-excursion |
2301 ;; Add final newline if required. See `require-final-newline'. | 2840 (and (> (point-max) 1) |
2302 (when (and (not (eq (char-before (point-max)) ?\n)) ; common case | 2841 (not find-file-literally) |
2303 (char-before (point-max)) ; empty buffer? | 2842 (not (eq (char-after (1- (point-max))) ?\n)) |
2304 (not (and (eq selective-display t) | 2843 (not (and (eq selective-display t) |
2305 (eq (char-before (point-max)) ?\r))) | 2844 (eq (char-after (1- (point-max))) ?\r))) |
2306 (or (eq require-final-newline t) | 2845 (or (eq require-final-newline t) |
2307 (and require-final-newline | 2846 (and require-final-newline |
2308 (y-or-n-p | 2847 (y-or-n-p |
2309 (format "Buffer %s does not end in newline. Add one? " | 2848 (format "Buffer %s does not end in newline. Add one? " |
2310 (buffer-name)))))) | 2849 (buffer-name))))) |
2311 (save-excursion | 2850 (save-excursion |
2312 (goto-char (point-max)) | 2851 (goto-char (point-max)) |
2313 (insert ?\n))) | 2852 (insert ?\n)))) |
2853 | |
2854 ;; Support VC version backups. | |
2855 (if-fboundp 'vc-before-save | |
2856 (vc-before-save)) | |
2314 | 2857 |
2315 ;; Run the write-file-hooks until one returns non-nil. | 2858 ;; Run the write-file-hooks until one returns non-nil. |
2316 ;; Bind after-save-hook to nil while running the | 2859 ;; Bind after-save-hook to nil while running the |
2317 ;; write-file-hooks so that if this function is called | 2860 ;; write-file-hooks so that if this function is called |
2318 ;; recursively (from inside a write-file-hook) the | 2861 ;; recursively (from inside a write-file-hook) the |
2336 ;; If a hook returned t, file is already "written". | 2879 ;; If a hook returned t, file is already "written". |
2337 ;; Otherwise, write it the usual way now. | 2880 ;; Otherwise, write it the usual way now. |
2338 (if (not done) | 2881 (if (not done) |
2339 (basic-save-buffer-1))) | 2882 (basic-save-buffer-1))) |
2340 ;; XEmacs: next two clauses (buffer-file-number setting and | 2883 ;; XEmacs: next two clauses (buffer-file-number setting and |
2341 ;; set-file-modes) moved into basic-save-buffer-1. | 2884 ;; set-file-modes) moved into basic-save-buffer-1 for use by |
2885 ;; continue-save-buffer. | |
2342 ) | 2886 ) |
2343 ;; If the auto-save file was recent before this command, | 2887 ;; If the auto-save file was recent before this command, |
2344 ;; delete it now. | 2888 ;; delete it now. |
2345 (delete-auto-save-file-if-necessary recent-save) | 2889 (delete-auto-save-file-if-necessary recent-save) |
2346 ;; Support VC `implicit' locking. | 2890 ;; Support VC `implicit' locking. |
2352 ;; This does the "real job" of writing a buffer into its visited file | 2896 ;; This does the "real job" of writing a buffer into its visited file |
2353 ;; and making a backup file. This is what is normally done | 2897 ;; and making a backup file. This is what is normally done |
2354 ;; but inhibited if one of write-file-hooks returns non-nil. | 2898 ;; but inhibited if one of write-file-hooks returns non-nil. |
2355 ;; It returns a value to store in setmodes. | 2899 ;; It returns a value to store in setmodes. |
2356 (defun basic-save-buffer-1 () | 2900 (defun basic-save-buffer-1 () |
2901 (if save-buffer-coding-system | |
2902 (let ((coding-system-for-write save-buffer-coding-system)) | |
2903 (basic-save-buffer-2)) | |
2904 (basic-save-buffer-2))) | |
2905 | |
2906 (defun basic-save-buffer-2 () | |
2357 (let (setmodes tempsetmodes) | 2907 (let (setmodes tempsetmodes) |
2358 (if (not (file-writable-p buffer-file-name)) | 2908 (if (not (file-writable-p buffer-file-name)) |
2359 (let ((dir (file-name-directory buffer-file-name))) | 2909 (let ((dir (file-name-directory buffer-file-name))) |
2360 (if (not (file-directory-p dir)) | 2910 (if (not (file-directory-p dir)) |
2361 (error "%s is not a directory" dir) | 2911 (if (file-exists-p dir) |
2912 (error "%s is not a directory" dir) | |
2913 (error "%s: no such directory" buffer-file-name)) | |
2362 (if (not (file-exists-p buffer-file-name)) | 2914 (if (not (file-exists-p buffer-file-name)) |
2363 (error "Directory %s write-protected" dir) | 2915 (error "Directory %s write-protected" dir) |
2364 (if (yes-or-no-p | 2916 (if (yes-or-no-p |
2365 (format "File %s is write-protected; try to save anyway? " | 2917 (format "File %s is write-protected; try to save anyway? " |
2366 (file-name-nondirectory | 2918 (file-name-nondirectory |
2394 (setq succeed t)) | 2946 (setq succeed t)) |
2395 ;; If writing the temp file fails, | 2947 ;; If writing the temp file fails, |
2396 ;; delete the temp file. | 2948 ;; delete the temp file. |
2397 (or succeed | 2949 (or succeed |
2398 (progn | 2950 (progn |
2399 (delete-file tempname) | 2951 (ignore-file-errors |
2952 (delete-file tempname)) | |
2400 (set-visited-file-modtime old-modtime)))) | 2953 (set-visited-file-modtime old-modtime)))) |
2401 ;; Since we have created an entirely new file | 2954 ;; Since we have created an entirely new file |
2402 ;; and renamed it, make sure it gets the | 2955 ;; and renamed it, make sure it gets the |
2403 ;; right permission bits set. | 2956 ;; right permission bits set. |
2404 (setq setmodes (file-modes buffer-file-name)) | 2957 (setq setmodes (file-modes buffer-file-name)) |
2410 ;; But no need to do so if we have just backed it up | 2963 ;; But no need to do so if we have just backed it up |
2411 ;; (setmodes is set) because that says we're superseding. | 2964 ;; (setmodes is set) because that says we're superseding. |
2412 (cond ((and tempsetmodes (not setmodes)) | 2965 (cond ((and tempsetmodes (not setmodes)) |
2413 ;; Change the mode back, after writing. | 2966 ;; Change the mode back, after writing. |
2414 (setq setmodes (file-modes buffer-file-name)) | 2967 (setq setmodes (file-modes buffer-file-name)) |
2415 (set-file-modes buffer-file-name 511))) | 2968 (set-file-modes buffer-file-name (logior setmodes 128)))) |
2416 (basic-write-file-data buffer-file-name buffer-file-truename))) | 2969 (basic-write-file-data buffer-file-name buffer-file-truename))) |
2970 ;; #### FSF 21.2. We don't have last-coding-system-used. | |
2971 ; ;; Now we have saved the current buffer. Let's make sure | |
2972 ; ;; that buffer-file-coding-system is fixed to what | |
2973 ; ;; actually used for saving by binding it locally. | |
2974 ; (if save-buffer-coding-system | |
2975 ; (setq save-buffer-coding-system last-coding-system-used) | |
2976 ; (setq buffer-file-coding-system last-coding-system-used)) | |
2417 (setq buffer-file-number | 2977 (setq buffer-file-number |
2418 (if buffer-file-name | 2978 (if buffer-file-name |
2419 (nth 10 (file-attributes buffer-file-name)) | 2979 (nth 10 (file-attributes buffer-file-name)) |
2420 nil)) | 2980 nil)) |
2421 (if setmodes | 2981 (if setmodes |
2452 (defcustom save-some-buffers-query-display-buffer t | 3012 (defcustom save-some-buffers-query-display-buffer t |
2453 "*Non-nil makes `\\[save-some-buffers]' switch to the buffer offered for saving." | 3013 "*Non-nil makes `\\[save-some-buffers]' switch to the buffer offered for saving." |
2454 :type 'boolean | 3014 :type 'boolean |
2455 :group 'editing-basics) | 3015 :group 'editing-basics) |
2456 | 3016 |
2457 (defun save-some-buffers (&optional arg exiting) | 3017 (defun save-some-buffers (&optional arg pred) |
2458 "Save some modified file-visiting buffers. Asks user about each one. | 3018 "Save some modified file-visiting buffers. Asks user about each one. |
2459 Optional argument (the prefix) non-nil means save all with no questions. | 3019 Optional argument (the prefix) non-nil means save all with no questions. |
2460 Optional second argument EXITING means ask about certain non-file buffers | 3020 Optional second argument PRED determines which buffers are considered: |
2461 as well as about file buffers." | 3021 If PRED is nil, all the file-visiting buffers are considered. |
3022 If PRED is t, then certain non-file buffers will also be considered. | |
3023 If PRED is a zero-argument function, it indicates for each buffer whether | |
3024 to consider it or not when called with that buffer current." | |
2462 (interactive "P") | 3025 (interactive "P") |
2463 (save-excursion | 3026 (save-excursion |
2464 ;; `delete-other-windows' can bomb during autoloads generation, so | 3027 ;; `delete-other-windows' can bomb during autoloads generation, so |
2465 ;; guard it well. | 3028 ;; guard it well. |
2466 (if (or noninteractive | 3029 (if (or noninteractive |
2467 (eq (selected-window) (minibuffer-window)) | 3030 (eq (selected-window) (minibuffer-window)) |
2468 (not save-some-buffers-query-display-buffer)) | 3031 (not save-some-buffers-query-display-buffer)) |
2469 ;; If playing with windows is unsafe or undesired, just do the | 3032 ;; If playing with windows is unsafe or undesired, just do the |
2470 ;; usual drill. | 3033 ;; usual drill. |
2471 (save-some-buffers-1 arg exiting nil) | 3034 (save-some-buffers-1 arg pred nil) |
2472 ;; Else, protect the windows. | 3035 ;; Else, protect the windows. |
2473 (when (save-window-excursion | 3036 (when (save-window-excursion |
2474 (save-some-buffers-1 arg exiting t)) | 3037 (save-some-buffers-1 arg pred t)) |
2475 ;; Force redisplay. | 3038 ;; Force redisplay. |
2476 (sit-for 0))))) | 3039 (sit-for 0))))) |
2477 | 3040 |
2478 ;; XEmacs - do not use queried flag | 3041 ;; XEmacs - do not use queried flag |
2479 (defun save-some-buffers-1 (arg exiting switch-buffer) | 3042 (defun save-some-buffers-1 (arg pred switch-buffer) |
2480 (let* ((switched nil) | 3043 (let* ((switched nil) |
2481 (last-buffer nil) | 3044 (last-buffer nil) |
2482 (files-done | 3045 (files-done |
2483 (map-y-or-n-p | 3046 (map-y-or-n-p |
2484 (lambda (buffer) | 3047 (lambda (buffer) |
2487 (not (buffer-base-buffer buffer)) | 3050 (not (buffer-base-buffer buffer)) |
2488 ;; XEmacs addition: | 3051 ;; XEmacs addition: |
2489 (not (symbol-value-in-buffer 'save-buffers-skip buffer)) | 3052 (not (symbol-value-in-buffer 'save-buffers-skip buffer)) |
2490 (or | 3053 (or |
2491 (buffer-file-name buffer) | 3054 (buffer-file-name buffer) |
2492 (and exiting | 3055 (and pred |
2493 (progn | 3056 (progn |
2494 (set-buffer buffer) | 3057 (set-buffer buffer) |
2495 (and buffer-offer-save (> (buffer-size) 0))))) | 3058 (and buffer-offer-save (> (buffer-size) 0))))) |
3059 (or (not (functionp pred)) | |
3060 (with-current-buffer buffer (funcall pred))) | |
2496 (if arg | 3061 (if arg |
2497 t | 3062 t |
2498 ;; #### We should provide a per-buffer means to | 3063 ;; #### We should provide a per-buffer means to |
2499 ;; disable the switching. For instance, you might | 3064 ;; disable the switching. For instance, you might |
2500 ;; want to turn it off for buffers the contents of | 3065 ;; want to turn it off for buffers the contents of |
2533 ;; We should fix the dialog box rather than disabling | 3098 ;; We should fix the dialog box rather than disabling |
2534 ;; this! --hniksic | 3099 ;; this! --hniksic |
2535 (list (list ?\C-r (lambda (buf) | 3100 (list (list ?\C-r (lambda (buf) |
2536 ;; #### FSF has an EXIT-ACTION argument | 3101 ;; #### FSF has an EXIT-ACTION argument |
2537 ;; to `view-buffer'. | 3102 ;; to `view-buffer'. |
2538 (view-buffer buf) | 3103 (view-buffer buf |
3104 ; (function | |
3105 ; (lambda (ignore) | |
3106 ; (exit-recursive-edit)))) | |
3107 ) | |
2539 (with-boundp 'view-exit-action | 3108 (with-boundp 'view-exit-action |
2540 (setq view-exit-action | 3109 (setq view-exit-action |
2541 (lambda (ignore) | 3110 (lambda (ignore) |
2542 (exit-recursive-edit)))) | 3111 (exit-recursive-edit)))) |
2543 (recursive-edit) | 3112 (recursive-edit) |
2546 "%_Display Buffer")))) | 3115 "%_Display Buffer")))) |
2547 (abbrevs-done | 3116 (abbrevs-done |
2548 (and save-abbrevs abbrevs-changed | 3117 (and save-abbrevs abbrevs-changed |
2549 (progn | 3118 (progn |
2550 (if (or arg | 3119 (if (or arg |
3120 (eq save-abbrevs 'silently) | |
2551 (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name))) | 3121 (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name))) |
2552 (write-abbrev-file nil)) | 3122 (write-abbrev-file nil)) |
2553 ;; Don't keep bothering user if he says no. | 3123 ;; Don't keep bothering user if he says no. |
2554 (setq abbrevs-changed nil) | 3124 (setq abbrevs-changed nil) |
2555 t)))) | 3125 t)))) |
2556 (or (> files-done 0) abbrevs-done | 3126 (or (> files-done 0) abbrevs-done |
2557 (display-message 'no-log "(No files need saving)")) | 3127 (display-message 'no-log "(No files need saving)")) |
2558 switched)) | 3128 switched)) |
2559 | 3129 |
2560 | 3130 |
3131 | |
2561 (defun not-modified (&optional arg) | 3132 (defun not-modified (&optional arg) |
2562 "Mark current buffer as unmodified, not needing to be saved. | 3133 "Mark current buffer as unmodified, not needing to be saved. |
2563 With prefix arg, mark buffer as modified, so \\[save-buffer] will save. | 3134 With prefix arg, mark buffer as modified, so \\[save-buffer] will save. |
2564 | 3135 |
2565 It is not a good idea to use this function in Lisp programs, because it | 3136 It is not a good idea to use this function in Lisp programs, because it |
2569 (display-message 'command "Modification-flag set") | 3140 (display-message 'command "Modification-flag set") |
2570 (display-message 'command "Modification-flag cleared")) | 3141 (display-message 'command "Modification-flag cleared")) |
2571 (set-buffer-modified-p arg)) | 3142 (set-buffer-modified-p arg)) |
2572 | 3143 |
2573 (defun toggle-read-only (&optional arg) | 3144 (defun toggle-read-only (&optional arg) |
2574 "Toggle the current buffer's read-only status. | 3145 "Change whether this buffer is visiting its file read-only. |
2575 With arg, set read-only iff arg is positive." | 3146 With arg, set read-only iff arg is positive. |
2576 (interactive "_P") | 3147 If visiting file read-only and `view-read-only' is non-nil, enter view mode." |
2577 (setq buffer-read-only | 3148 (interactive "P") |
2578 (if (null arg) | 3149 (cond |
2579 (not buffer-read-only) | 3150 ((and arg (if (> (prefix-numeric-value arg) 0) buffer-read-only |
2580 (> (prefix-numeric-value arg) 0))) | 3151 (not buffer-read-only))) ; If buffer-read-only is set correctly, |
2581 ;; Force modeline redisplay | 3152 nil) ; do nothing. |
2582 (redraw-modeline)) | 3153 ;; Toggle. |
3154 ((and buffer-read-only view-minor-mode) | |
3155 ;(View-exit-and-edit) | |
3156 (view-mode) | |
3157 (make-local-variable 'view-read-only) | |
3158 (setq view-read-only t)) ; Must leave view mode. | |
3159 ((and (not buffer-read-only) view-read-only | |
3160 (not (eq (get major-mode 'mode-class) 'special))) | |
3161 ;(view-mode-enter) | |
3162 (view-mode)) | |
3163 (t (setq buffer-read-only (not buffer-read-only)) | |
3164 (force-mode-line-update)))) | |
2583 | 3165 |
2584 (defun insert-file (filename &optional codesys) | 3166 (defun insert-file (filename &optional codesys) |
2585 "Insert contents of file FILENAME into buffer after point. | 3167 "Insert contents of file FILENAME into buffer after point. |
2586 Set mark after the inserted text. | 3168 Set mark after the inserted text. |
2587 | 3169 |
2617 (write-region start end filename t)) | 3199 (write-region start end filename t)) |
2618 (write-region start end filename t))) | 3200 (write-region start end filename t))) |
2619 | 3201 |
2620 (defun file-newest-backup (filename) | 3202 (defun file-newest-backup (filename) |
2621 "Return most recent backup file for FILENAME or nil if no backups exist." | 3203 "Return most recent backup file for FILENAME or nil if no backups exist." |
2622 (let* ((filename (expand-file-name filename)) | 3204 ;; `make-backup-file-name' will get us the right directory for |
3205 ;; ordinary or numeric backups. It might create a directory for | |
3206 ;; backups as a side-effect, according to `backup-directory-alist'. | |
3207 (let* ((filename (file-name-sans-versions | |
3208 (make-backup-file-name filename))) | |
2623 (file (file-name-nondirectory filename)) | 3209 (file (file-name-nondirectory filename)) |
2624 (dir (file-name-directory filename)) | 3210 (dir (file-name-directory filename)) |
2625 (comp (file-name-all-completions file dir)) | 3211 (comp (file-name-all-completions file dir)) |
2626 newest) | 3212 (newest nil) |
3213 tem) | |
2627 (while comp | 3214 (while comp |
2628 (setq file (concat dir (car comp)) | 3215 (setq tem (pop comp)) |
2629 comp (cdr comp)) | 3216 (cond ((and (backup-file-name-p tem) |
2630 (if (and (backup-file-name-p file) | 3217 (string= (file-name-sans-versions tem) file)) |
2631 (or (null newest) (file-newer-than-file-p file newest))) | 3218 (setq tem (concat dir tem)) |
2632 (setq newest file))) | 3219 (if (or (null newest) |
3220 (file-newer-than-file-p tem newest)) | |
3221 (setq newest tem))))) | |
2633 newest)) | 3222 newest)) |
2634 | 3223 |
2635 (defun rename-uniquely () | 3224 (defun rename-uniquely () |
2636 "Rename current buffer to a similar name not already taken. | 3225 "Rename current buffer to a similar name not already taken. |
2637 This function is useful for creating multiple shell process buffers | 3226 This function is useful for creating multiple shell process buffers |
2638 or multiple mail buffers, etc." | 3227 or multiple mail buffers, etc." |
2639 (interactive) | 3228 (interactive) |
2640 (save-match-data | 3229 (save-match-data |
2641 (let* ((base-name (if (and (string-match "<[0-9]+>\\'" (buffer-name)) | 3230 (let ((base-name (buffer-name))) |
2642 (not (and buffer-file-name | 3231 (and (string-match "<[0-9]+>\\'" base-name) |
2643 (string= (buffer-name) | 3232 (not (and buffer-file-name |
2644 (file-name-nondirectory | 3233 (string= base-name |
2645 buffer-file-name))))) | 3234 (file-name-nondirectory buffer-file-name)))) |
2646 ;; If the existing buffer name has a <NNN>, | 3235 ;; If the existing buffer name has a <NNN>, |
2647 ;; which isn't part of the file name (if any), | 3236 ;; which isn't part of the file name (if any), |
2648 ;; then get rid of that. | 3237 ;; then get rid of that. |
2649 (substring (buffer-name) 0 (match-beginning 0)) | 3238 (setq base-name (substring base-name 0 (match-beginning 0)))) |
2650 (buffer-name))) | 3239 (rename-buffer (generate-new-buffer-name base-name)) |
2651 (new-buf (generate-new-buffer base-name)) | 3240 (force-mode-line-update)))) |
2652 (name (buffer-name new-buf))) | |
2653 (kill-buffer new-buf) | |
2654 (rename-buffer name) | |
2655 (redraw-modeline)))) | |
2656 | 3241 |
2657 (defun make-directory-path (path) | 3242 (defun make-directory-path (path) |
2658 "Create all the directories along path that don't exist yet." | 3243 "Create all the directories along path that don't exist yet." |
2659 (interactive "Fdirectory path to create: ") | 3244 (interactive "Fdirectory path to create: ") |
2660 (make-directory path t)) | 3245 (make-directory path t)) |
2694 (defvar revert-buffer-insert-file-contents-function nil | 3279 (defvar revert-buffer-insert-file-contents-function nil |
2695 "Function to use to insert contents when reverting this buffer. | 3280 "Function to use to insert contents when reverting this buffer. |
2696 Gets two args, first the nominal file name to use, | 3281 Gets two args, first the nominal file name to use, |
2697 and second, t if reading the auto-save file. | 3282 and second, t if reading the auto-save file. |
2698 If the current buffer contents are to be discarded, the function must do | 3283 If the current buffer contents are to be discarded, the function must do |
2699 so itself.") | 3284 so itself. |
3285 | |
3286 The function you specify is responsible for updating (or preserving) point.") | |
2700 | 3287 |
2701 (defvar before-revert-hook nil | 3288 (defvar before-revert-hook nil |
2702 "Normal hook for `revert-buffer' to run before reverting. | 3289 "Normal hook for `revert-buffer' to run before reverting. |
2703 If `revert-buffer-function' is used to override the normal revert | 3290 If `revert-buffer-function' is used to override the normal revert |
2704 mechanism, this hook is not used.") | 3291 mechanism, this hook is not used.") |
2712 If `revert-buffer-function' is used to override the normal revert | 3299 If `revert-buffer-function' is used to override the normal revert |
2713 mechanism, this hook is not used.") | 3300 mechanism, this hook is not used.") |
2714 | 3301 |
2715 (defvar revert-buffer-internal-hook nil | 3302 (defvar revert-buffer-internal-hook nil |
2716 "Don't use this.") | 3303 "Don't use this.") |
3304 | |
3305 ;; END SYNC WITH FSF 21.2. | |
2717 | 3306 |
2718 (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes) | 3307 (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes) |
2719 "Replace the buffer text with the text of the visited file on disk. | 3308 "Replace the buffer text with the text of the visited file on disk. |
2720 This undoes all changes since the file was visited or saved. | 3309 This undoes all changes since the file was visited or saved. |
2721 With a prefix argument, offer to revert from latest auto-save file, if | 3310 With a prefix argument, offer to revert from latest auto-save file, if |
2927 (eq (compare-buffer-substrings | 3516 (eq (compare-buffer-substrings |
2928 newbuf bmin bmax (current-buffer) bmin bmax) 0))) | 3517 newbuf bmin bmax (current-buffer) bmin bmax) 0))) |
2929 newbuf | 3518 newbuf |
2930 (and (kill-buffer newbuf) nil)))) | 3519 (and (kill-buffer newbuf) nil)))) |
2931 | 3520 |
3521 ;; BEGIN SYNC WITH FSF 21.2. | |
3522 | |
2932 (defvar recover-file-diff-program "diff" | 3523 (defvar recover-file-diff-program "diff" |
2933 "Absolute or relative name of the `diff' program used by `recover-file'.") | 3524 "Absolute or relative name of the `diff' program used by `recover-file'.") |
2934 (defvar recover-file-diff-arguments '("-c") | 3525 (defvar recover-file-diff-arguments '("-c") |
2935 "List of arguments (switches) to pass to `diff' by `recover-file'.") | 3526 "List of arguments (switches) to pass to `diff' by `recover-file'.") |
2936 | 3527 |
2961 ;; XEmacs change: use insert-directory instead of | 3552 ;; XEmacs change: use insert-directory instead of |
2962 ;; calling ls directly. Add option for diff. | 3553 ;; calling ls directly. Add option for diff. |
2963 (with-output-to-temp-buffer "*Directory*" | 3554 (with-output-to-temp-buffer "*Directory*" |
2964 (buffer-disable-undo standard-output) | 3555 (buffer-disable-undo standard-output) |
2965 (save-excursion | 3556 (save-excursion |
2966 (set-buffer "*Directory*") | 3557 (let ((switches dired-listing-switches)) |
2967 (setq default-directory (file-name-directory file)) | 3558 (if (file-symlink-p file) |
2968 (insert-directory file | 3559 (setq switches (concat switches "L"))) |
2969 (if (file-symlink-p file) "-lL" "-l")) | 3560 (set-buffer standard-output) |
2970 (setq default-directory (file-name-directory file-name)) | 3561 ;; XEmacs had the following line, not in FSF. |
2971 (insert-directory file-name "-l"))) | 3562 (setq default-directory (file-name-directory file)) |
3563 ;; Use insert-directory-safely, not insert-directory, | |
3564 ;; because these files might not exist. In particular, | |
3565 ;; FILE might not exist if the auto-save file was for | |
3566 ;; a buffer that didn't visit a file, such as "*mail*". | |
3567 ;; The code in v20.x called `ls' directly, so we need | |
3568 ;; to emulate what `ls' did in that case. | |
3569 (insert-directory-safely file switches) | |
3570 (insert-directory-safely file-name switches)))) | |
2972 (block nil | 3571 (block nil |
2973 (while t | 3572 (while t |
2974 (case (get-user-response | 3573 (case (get-user-response |
2975 nil | 3574 nil |
2976 ;; Formerly included file name. Useless now that | 3575 ;; Formerly included file name. Useless now that |
2982 ("no" "%_No" no) | 3581 ("no" "%_No" no) |
2983 ("diff" "%_Diff" diff))) | 3582 ("diff" "%_Diff" diff))) |
2984 (no (error "Recover-file cancelled.")) | 3583 (no (error "Recover-file cancelled.")) |
2985 (yes | 3584 (yes |
2986 (switch-to-buffer (find-file-noselect file t)) | 3585 (switch-to-buffer (find-file-noselect file t)) |
2987 (let ((buffer-read-only nil)) | 3586 (let ((buffer-read-only nil) |
3587 ;; Keep the current buffer-file-coding-system. | |
3588 (coding-system buffer-file-coding-system) | |
3589 ;; Auto-saved file shoule be read without any code conversion. | |
3590 (coding-system-for-read 'escape-quoted)) | |
2988 (erase-buffer) | 3591 (erase-buffer) |
2989 (let ((coding-system-for-read 'escape-quoted)) | 3592 (insert-file-contents file-name nil) |
2990 (insert-file-contents file-name nil))) | 3593 (set-buffer-file-coding-system coding-system)) |
2991 (after-find-file nil nil t) | 3594 (after-find-file nil nil t) |
2992 (return nil)) | 3595 (return nil)) |
2993 (diff | 3596 (diff |
2994 ;; rather than just diff the two files (which would | 3597 ;; rather than just diff the two files (which would |
2995 ;; be easy), we have to deal with the fact that | 3598 ;; be easy), we have to deal with the fact that |
3029 (append | 3632 (append |
3030 recover-file-diff-arguments | 3633 recover-file-diff-arguments |
3031 (list temp file-name))) | 3634 (list temp file-name))) |
3032 (io-error | 3635 (io-error |
3033 (save-excursion | 3636 (save-excursion |
3034 (set-buffer standard-output) | 3637 (let ((switches dired-listing-switches)) |
3035 (setq default-directory | 3638 (if (file-symlink-p file) |
3036 (file-name-directory file)) | 3639 (setq switches (concat switches "L"))) |
3037 (insert-directory | 3640 (set-buffer standard-output) |
3038 file | 3641 ;; XEmacs had the following line, not in FSF. |
3039 (if (file-symlink-p file) "-lL" | 3642 (setq default-directory (file-name-directory file)) |
3040 "-l")) | 3643 ;; Use insert-directory-safely, not insert-directory, |
3041 (setq default-directory | 3644 ;; because these files might not exist. In particular, |
3042 (file-name-directory file-name)) | 3645 ;; FILE might not exist if the auto-save file was for |
3043 (insert-directory file-name "-l") | 3646 ;; a buffer that didn't visit a file, such as "*mail*". |
3647 ;; The code in v20.x called `ls' directly, so we need | |
3648 ;; to emulate what `ls' did in that case. | |
3649 (insert-directory-safely file switches) | |
3650 (insert-directory-safely file-name switches)) | |
3044 (terpri) | 3651 (terpri) |
3045 (princ "Error during diff: ") | 3652 (princ "Error during diff: ") |
3046 (display-error ferr | 3653 (display-error ferr |
3047 standard-output))))))) | 3654 standard-output))))))) |
3048 (ignore-errors (kill-buffer buffer)) | 3655 (ignore-errors (kill-buffer buffer)) |
3059 (unless (fboundp 'dired) | 3666 (unless (fboundp 'dired) |
3060 (error "recover-session requires dired")) | 3667 (error "recover-session requires dired")) |
3061 (if (null auto-save-list-file-prefix) | 3668 (if (null auto-save-list-file-prefix) |
3062 (error | 3669 (error |
3063 "You set `auto-save-list-file-prefix' to disable making session files")) | 3670 "You set `auto-save-list-file-prefix' to disable making session files")) |
3671 (let ((dir (file-name-directory auto-save-list-file-prefix))) | |
3672 (unless (file-directory-p dir) | |
3673 (make-directory dir t))) | |
3064 (let* ((auto-save-list-dir | 3674 (let* ((auto-save-list-dir |
3065 (file-name-directory auto-save-list-file-prefix)) | 3675 (file-name-directory auto-save-list-file-prefix)) |
3066 (files (directory-files | 3676 (files (directory-files |
3067 auto-save-list-dir | 3677 auto-save-list-dir |
3068 t | 3678 t |
3071 (files (sort (delete-if-not #'Recover-session-files-from-auto-save-list-file | 3681 (files (sort (delete-if-not #'Recover-session-files-from-auto-save-list-file |
3072 files) #'file-newer-than-file-p))) | 3682 files) #'file-newer-than-file-p))) |
3073 (unless files | 3683 (unless files |
3074 (error "No sessions can be recovered now")) | 3684 (error "No sessions can be recovered now")) |
3075 (declare-fboundp (dired (cons auto-save-list-dir files))) | 3685 (declare-fboundp (dired (cons auto-save-list-dir files))) |
3076 (goto-char (point-min)) | 3686 (save-excursion |
3077 (or (looking-at "Move to the session you want to recover,") | 3687 (goto-char (point-min)) |
3078 (let ((inhibit-read-only t)) | 3688 (or (looking-at "Move to the session you want to recover,") |
3079 (delete-matching-lines "^[ \t]*total.*$") | 3689 (let ((inhibit-read-only t)) |
3080 (insert "Move to the session you want to recover,\n" | 3690 (delete-matching-lines "^[ \t]*total.*$") |
3081 "then type C-c C-c to select it.\n\n" | 3691 (insert "Move to the session you want to recover,\n" |
3082 "You can also delete some of these files;\n" | 3692 "then type C-c C-c to select it.\n\n" |
3083 "type d on a line to mark that file for deletion.\n\n"))) | 3693 "You can also delete some of these files;\n" |
3694 "type d on a line to mark that file for deletion.\n\n")))) | |
3084 (use-local-map (let ((map (make-sparse-keymap))) | 3695 (use-local-map (let ((map (make-sparse-keymap))) |
3085 (set-keymap-parents map (list (current-local-map))) | 3696 (set-keymap-parents map (list (current-local-map))) |
3086 map)) | 3697 map)) |
3087 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))) | 3698 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))) |
3088 | 3699 |
3142 This command is used in the special Dired buffer created by | 3753 This command is used in the special Dired buffer created by |
3143 \\[recover-session]." | 3754 \\[recover-session]." |
3144 (interactive) | 3755 (interactive) |
3145 ;; Get the name of the session file to recover from. | 3756 ;; Get the name of the session file to recover from. |
3146 (let ((file (declare-fboundp (dired-get-filename)))) | 3757 (let ((file (declare-fboundp (dired-get-filename)))) |
3758 (dired-unmark 1) | |
3147 ;; #### dired-do-flagged-delete in FSF. | 3759 ;; #### dired-do-flagged-delete in FSF. |
3148 ;; This version is for ange-ftp | 3760 ;; This version is for ange-ftp |
3149 ;;(dired-do-deletions t) | 3761 ;;(dired-do-deletions t) |
3150 ;; This version is for efs | 3762 ;; This version is for efs |
3151 (declare-fboundp (dired-expunge-deletions)) | 3763 (declare-fboundp (dired-expunge-deletions)) |
3174 (setq list (buffer-list))) | 3786 (setq list (buffer-list))) |
3175 (while list | 3787 (while list |
3176 (let* ((buffer (car list)) | 3788 (let* ((buffer (car list)) |
3177 (name (buffer-name buffer))) | 3789 (name (buffer-name buffer))) |
3178 (and (not (string-equal name "")) | 3790 (and (not (string-equal name "")) |
3179 (/= (aref name 0) ?\ ) | 3791 (not (eq (aref name 0) ?\ )) |
3180 (yes-or-no-p | 3792 (yes-or-no-p |
3181 (format | 3793 (format |
3182 (if (buffer-modified-p buffer) | 3794 (if (buffer-modified-p buffer) |
3183 (gettext "Buffer %s HAS BEEN EDITED. Kill? ") | 3795 (gettext "Buffer %s HAS BEEN EDITED. Kill? ") |
3184 (gettext "Buffer %s is unmodified. Kill? ")) | 3796 (gettext "Buffer %s is unmodified. Kill? ")) |
3222 (not (string= buffer-auto-save-file-name osave)) | 3834 (not (string= buffer-auto-save-file-name osave)) |
3223 (file-exists-p osave) | 3835 (file-exists-p osave) |
3224 (recent-auto-save-p)) | 3836 (recent-auto-save-p)) |
3225 (rename-file osave buffer-auto-save-file-name t)))) | 3837 (rename-file osave buffer-auto-save-file-name t)))) |
3226 | 3838 |
3839 ;; END SYNC WITH FSF 21.2. | |
3840 | |
3227 ;; make-auto-save-file-name and auto-save-file-name-p are now only in | 3841 ;; make-auto-save-file-name and auto-save-file-name-p are now only in |
3228 ;; auto-save.el. | 3842 ;; auto-save.el. |
3229 | 3843 |
3230 | 3844 |
3845 ;; BEGIN SYNC WITH FSF 21.2. | |
3846 | |
3231 (defun wildcard-to-regexp (wildcard) | 3847 (defun wildcard-to-regexp (wildcard) |
3232 "Given a shell file name pattern WILDCARD, return an equivalent regexp. | 3848 "Given a shell file name pattern WILDCARD, return an equivalent regexp. |
3233 The generated regexp will match a filename iff the filename | 3849 The generated regexp will match a filename iff the filename |
3234 matches that wildcard according to shell rules. Only wildcards known | 3850 matches that wildcard according to shell rules. Only wildcards known |
3235 by `sh' are supported." | 3851 by `sh' are supported." |
3244 j) | 3860 j) |
3245 (setq | 3861 (setq |
3246 result | 3862 result |
3247 (concat result | 3863 (concat result |
3248 (cond | 3864 (cond |
3865 ((and (eq ch ?\[) | |
3866 (< (1+ i) len) | |
3867 (eq (aref wildcard (1+ i)) ?\])) | |
3868 "\\[") | |
3249 ((eq ch ?\[) ; [...] maps to regexp char class | 3869 ((eq ch ?\[) ; [...] maps to regexp char class |
3250 (progn | 3870 (progn |
3251 (setq i (1+ i)) | 3871 (setq i (1+ i)) |
3252 (concat | 3872 (concat |
3253 (cond | 3873 (cond |
3303 (defcustom list-directory-verbose-switches "-l" | 3923 (defcustom list-directory-verbose-switches "-l" |
3304 "*Switches for list-directory to pass to `ls' for verbose listing," | 3924 "*Switches for list-directory to pass to `ls' for verbose listing," |
3305 :type 'string | 3925 :type 'string |
3306 :group 'dired) | 3926 :group 'dired) |
3307 | 3927 |
3928 (defun file-expand-wildcards (pattern &optional full) | |
3929 "Expand wildcard pattern PATTERN. | |
3930 This returns a list of file names which match the pattern. | |
3931 | |
3932 If PATTERN is written as an absolute relative file name, | |
3933 the values are absolute also. | |
3934 | |
3935 If PATTERN is written as a relative file name, it is interpreted | |
3936 relative to the current default directory, `default-directory'. | |
3937 The file names returned are normally also relative to the current | |
3938 default directory. However, if FULL is non-nil, they are absolute." | |
3939 (let* ((nondir (file-name-nondirectory pattern)) | |
3940 (dirpart (file-name-directory pattern)) | |
3941 ;; A list of all dirs that DIRPART specifies. | |
3942 ;; This can be more than one dir | |
3943 ;; if DIRPART contains wildcards. | |
3944 (dirs (if (and dirpart (string-match "[[*?]" dirpart)) | |
3945 (mapcar 'file-name-as-directory | |
3946 (file-expand-wildcards (directory-file-name dirpart))) | |
3947 (list dirpart))) | |
3948 contents) | |
3949 (while dirs | |
3950 (when (or (null (car dirs)) ; Possible if DIRPART is not wild. | |
3951 (file-directory-p (directory-file-name (car dirs)))) | |
3952 (let ((this-dir-contents | |
3953 ;; Filter out "." and ".." | |
3954 (delq nil | |
3955 (mapcar #'(lambda (name) | |
3956 (unless (string-match "\\`\\.\\.?\\'" | |
3957 (file-name-nondirectory name)) | |
3958 name)) | |
3959 (directory-files (or (car dirs) ".") full | |
3960 (wildcard-to-regexp nondir)))))) | |
3961 (setq contents | |
3962 (nconc | |
3963 (if (and (car dirs) (not full)) | |
3964 (mapcar (function (lambda (name) (concat (car dirs) name))) | |
3965 this-dir-contents) | |
3966 this-dir-contents) | |
3967 contents)))) | |
3968 (setq dirs (cdr dirs))) | |
3969 contents)) | |
3970 | |
3308 (defun list-directory (dirname &optional verbose) | 3971 (defun list-directory (dirname &optional verbose) |
3309 "Display a list of files in or matching DIRNAME, a la `ls'. | 3972 "Display a list of files in or matching DIRNAME, a la `ls'. |
3310 DIRNAME is globbed by the shell if necessary. | 3973 DIRNAME is globbed by the shell if necessary. |
3311 Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. | 3974 Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. |
3312 Actions controlled by variables `list-directory-brief-switches' | 3975 Actions controlled by variables `list-directory-brief-switches' |
3325 (princ "Directory ") | 3988 (princ "Directory ") |
3326 (princ dirname) | 3989 (princ dirname) |
3327 (terpri) | 3990 (terpri) |
3328 (save-excursion | 3991 (save-excursion |
3329 (set-buffer "*Directory*") | 3992 (set-buffer "*Directory*") |
3330 (setq default-directory (file-name-directory dirname)) | 3993 (setq default-directory |
3994 (if (file-directory-p dirname) | |
3995 (file-name-as-directory dirname) | |
3996 (file-name-directory dirname))) | |
3331 (let ((wildcard (not (file-directory-p dirname)))) | 3997 (let ((wildcard (not (file-directory-p dirname)))) |
3332 (insert-directory dirname switches wildcard (not wildcard))))))) | 3998 (insert-directory dirname switches wildcard (not wildcard))))))) |
3999 | |
4000 (defun shell-quote-wildcard-pattern (pattern) | |
4001 "Quote characters special to the shell in PATTERN, leave wildcards alone. | |
4002 | |
4003 PATTERN is assumed to represent a file-name wildcard suitable for the | |
4004 underlying filesystem. For Unix and GNU/Linux, the characters from the | |
4005 set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all | |
4006 the parts of the pattern which don't include wildcard characters are | |
4007 quoted with double quotes. | |
4008 Existing quote characters in PATTERN are left alone, so you can pass | |
4009 PATTERN that already quotes some of the special characters." | |
4010 (save-match-data | |
4011 (cond | |
4012 ((memq system-type '(ms-dos windows-nt)) | |
4013 ;; DOS/Windows don't allow `"' in file names. So if the | |
4014 ;; argument has quotes, we can safely assume it is already | |
4015 ;; quoted by the caller. | |
4016 (if (or (string-match "[\"]" pattern) | |
4017 ;; We quote [&()#$'] in case their shell is a port of a | |
4018 ;; Unixy shell. We quote [,=+] because stock DOS and | |
4019 ;; Windows shells require that in some cases, such as | |
4020 ;; passing arguments to batch files that use positional | |
4021 ;; arguments like %1. | |
4022 (not (string-match "[ \t;&()#$',=+]" pattern))) | |
4023 pattern | |
4024 (let ((result "\"") | |
4025 (beg 0) | |
4026 end) | |
4027 (while (string-match "[*?]+" pattern beg) | |
4028 (setq end (match-beginning 0) | |
4029 result (concat result (substring pattern beg end) | |
4030 "\"" | |
4031 (substring pattern end (match-end 0)) | |
4032 "\"") | |
4033 beg (match-end 0))) | |
4034 (concat result (substring pattern beg) "\"")))) | |
4035 (t | |
4036 (let ((beg 0)) | |
4037 (while (string-match "[ \t\n;<>&|()#$]" pattern beg) | |
4038 (setq pattern | |
4039 (concat (substring pattern 0 (match-beginning 0)) | |
4040 "\\" | |
4041 (substring pattern (match-beginning 0))) | |
4042 beg (1+ (match-end 0))))) | |
4043 pattern)))) | |
4044 | |
3333 | 4045 |
3334 (defvar insert-directory-program "ls" | 4046 (defvar insert-directory-program "ls" |
3335 "Absolute or relative name of the `ls' program used by `insert-directory'.") | 4047 "Absolute or relative name of the `ls' program used by `insert-directory'.") |
3336 | 4048 |
3337 ;; insert-directory | 4049 ;; insert-directory |
3350 ;; dired-move-to-end-of-filename, | 4062 ;; dired-move-to-end-of-filename, |
3351 ;; dired-between-files, (shortcut for (not (dired-move-to-filename))) | 4063 ;; dired-between-files, (shortcut for (not (dired-move-to-filename))) |
3352 ;; dired-insert-headerline | 4064 ;; dired-insert-headerline |
3353 ;; dired-after-subdir-garbage (defines what a "total" line is) | 4065 ;; dired-after-subdir-garbage (defines what a "total" line is) |
3354 ;; - variable dired-subdir-regexp | 4066 ;; - variable dired-subdir-regexp |
4067 | |
4068 ;; END SYNC WITH FSF 21.2. | |
4069 | |
3355 (defun insert-directory (file switches &optional wildcard full-directory-p) | 4070 (defun insert-directory (file switches &optional wildcard full-directory-p) |
3356 "Insert directory listing for FILE, formatted according to SWITCHES. | 4071 "Insert directory listing for FILE, formatted according to SWITCHES. |
3357 Leaves point after the inserted text. | 4072 Leaves point after the inserted text. |
3358 SWITCHES may be a string of options, or a list of strings. | 4073 SWITCHES may be a string of options, or a list of strings. |
3359 Optional third arg WILDCARD means treat FILE as shell wildcard. | 4074 Optional third arg WILDCARD means treat FILE as shell wildcard. |
3429 (concat (file-name-as-directory file) | 4144 (concat (file-name-as-directory file) |
3430 ;;#### Unix-specific | 4145 ;;#### Unix-specific |
3431 ".") | 4146 ".") |
3432 file))))))))))) | 4147 file))))))))))) |
3433 | 4148 |
4149 ;; BEGIN SYNC WITH FSF 21.2. | |
4150 | |
4151 (defun insert-directory-safely (file switches | |
4152 &optional wildcard full-directory-p) | |
4153 "Insert directory listing for FILE, formatted according to SWITCHES. | |
4154 | |
4155 Like `insert-directory', but if FILE does not exist, it inserts a | |
4156 message to that effect instead of signaling an error." | |
4157 (if (file-exists-p file) | |
4158 (insert-directory file switches wildcard full-directory-p) | |
4159 ;; Simulate the message printed by `ls'. | |
4160 (insert (format "%s: No such file or directory\n" file)))) | |
4161 | |
3434 (defvar kill-emacs-query-functions nil | 4162 (defvar kill-emacs-query-functions nil |
3435 "Functions to call with no arguments to query about killing XEmacs. | 4163 "Functions to call with no arguments to query about killing XEmacs. |
3436 If any of these functions returns nil, killing Emacs is cancelled. | 4164 If any of these functions returns nil, killing Emacs is cancelled. |
3437 `save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions, | 4165 `save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions, |
3438 but `kill-emacs', the low level primitive, does not. | 4166 but `kill-emacs', the low level primitive, does not. |
3439 See also `kill-emacs-hook'.") | 4167 See also `kill-emacs-hook'.") |
4168 | |
4169 (defcustom confirm-kill-emacs nil | |
4170 "How to ask for confirmation when leaving Emacs. | |
4171 If nil, the default, don't ask at all. If the value is non-nil, it should | |
4172 be a predicate function such as `yes-or-no-p'." | |
4173 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p) | |
4174 (const :tag "Ask with y-or-n-p" y-or-n-p) | |
4175 (const :tag "Don't confirm" nil)) | |
4176 :group 'emacs | |
4177 ;:version "21.1" | |
4178 ) | |
3440 | 4179 |
3441 (defun save-buffers-kill-emacs (&optional arg) | 4180 (defun save-buffers-kill-emacs (&optional arg) |
3442 "Offer to save each buffer, then kill this XEmacs process. | 4181 "Offer to save each buffer, then kill this XEmacs process. |
3443 With prefix arg, silently save all file-visiting buffers, then kill." | 4182 With prefix arg, silently save all file-visiting buffers, then kill." |
3444 (interactive "P") | 4183 (interactive "P") |
3466 (list-processes) | 4205 (list-processes) |
3467 (yes-or-no-p | 4206 (yes-or-no-p |
3468 "Active processes exist; kill them and exit anyway? ")))))) | 4207 "Active processes exist; kill them and exit anyway? ")))))) |
3469 ;; Query the user for other things, perhaps. | 4208 ;; Query the user for other things, perhaps. |
3470 (run-hook-with-args-until-failure 'kill-emacs-query-functions) | 4209 (run-hook-with-args-until-failure 'kill-emacs-query-functions) |
4210 (or (null confirm-kill-emacs) | |
4211 (funcall confirm-kill-emacs "Really exit Emacs? ")) | |
3471 (kill-emacs))) | 4212 (kill-emacs))) |
3472 | 4213 |
3473 (defun symlink-expand-file-name (filename) | 4214 (defun symlink-expand-file-name (filename) |
3474 "If FILENAME is a symlink, return its non-symlink equivalent. | 4215 "If FILENAME is a symlink, return its non-symlink equivalent. |
3475 Unlike `file-truename', this doesn't chase symlinks in directory | 4216 Unlike `file-truename', this doesn't chase symlinks in directory |
3491 (declare-fboundp (ange-ftp-ftp-path file-name))) | 4232 (declare-fboundp (ange-ftp-ftp-path file-name))) |
3492 ((fboundp 'efs-ftp-path) | 4233 ((fboundp 'efs-ftp-path) |
3493 (declare-fboundp (efs-ftp-path file-name))) | 4234 (declare-fboundp (efs-ftp-path file-name))) |
3494 (t nil))) | 4235 (t nil))) |
3495 | 4236 |
3496 ;; #### FSF has file-name-non-special here. | 4237 |
4238 ;; We use /: as a prefix to "quote" a file name | |
4239 ;; so that magic file name handlers will not apply to it. | |
4240 | |
4241 (setq file-name-handler-alist | |
4242 (cons '("\\`/:" . file-name-non-special) | |
4243 file-name-handler-alist)) | |
4244 | |
4245 ;; We depend on being the last handler on the list, | |
4246 ;; so that anything else which does need handling | |
4247 ;; has been handled already. | |
4248 ;; So it is safe for us to inhibit *all* magic file name handlers. | |
4249 | |
4250 (defun file-name-non-special (operation &rest arguments) | |
4251 (let ((file-name-handler-alist nil) | |
4252 (default-directory | |
4253 (if (eq operation 'insert-directory) | |
4254 (directory-file-name | |
4255 (expand-file-name | |
4256 (unhandled-file-name-directory default-directory))) | |
4257 default-directory)) | |
4258 ;; Get a list of the indices of the args which are file names. | |
4259 (file-arg-indices | |
4260 (cdr (or (assq operation | |
4261 ;; The first four are special because they | |
4262 ;; return a file name. We want to include the /: | |
4263 ;; in the return value. | |
4264 ;; So just avoid stripping it in the first place. | |
4265 '((expand-file-name . nil) | |
4266 ;; `identity' means just return the first arg | |
4267 ;; as stripped of its quoting. | |
4268 (substitute-in-file-name . identity) | |
4269 (file-name-directory . nil) | |
4270 (file-name-as-directory . nil) | |
4271 (directory-file-name . nil) | |
4272 (file-name-completion 0 1) | |
4273 (file-name-all-completions 0 1) | |
4274 (rename-file 0 1) | |
4275 (copy-file 0 1) | |
4276 (make-symbolic-link 0 1) | |
4277 (add-name-to-file 0 1))) | |
4278 ;; For all other operations, treat the first argument only | |
4279 ;; as the file name. | |
4280 '(nil 0)))) | |
4281 ;; Copy ARGUMENTS so we can replace elements in it. | |
4282 (arguments (copy-sequence arguments))) | |
4283 ;; Strip off the /: from the file names that have this handler. | |
4284 (save-match-data | |
4285 (while (consp file-arg-indices) | |
4286 (let ((pair (nthcdr (car file-arg-indices) arguments))) | |
4287 (and (car pair) | |
4288 (string-match "\\`/:" (car pair)) | |
4289 (setcar pair | |
4290 (if (= (length (car pair)) 2) | |
4291 "/" | |
4292 (substring (car pair) 2))))) | |
4293 (setq file-arg-indices (cdr file-arg-indices)))) | |
4294 (if (eq file-arg-indices 'identity) | |
4295 (car arguments) | |
4296 (apply operation arguments)))) | |
4297 | |
4298 ;; END SYNC WITH FSF 21.2. | |
3497 | 4299 |
3498 ;;; files.el ends here | 4300 ;;; files.el ends here |