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