(undigestify-rmail-message): Better error messages.
[bpt/emacs.git] / lisp / files.el
CommitLineData
c0274f38
ER
1;;; files.el --- file input and output commands for Emacs
2
a641f9a1 3;; Copyright (C) 1985, 86, 87, 92, 93, 94, 1995 Free Software Foundation, Inc.
b4da00e9 4
3a801d0c
ER
5;; Maintainer: FSF
6
b4da00e9
RM
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
e5167999 11;; the Free Software Foundation; either version 2, or (at your option)
b4da00e9
RM
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to
21;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
e41b2db1
ER
23;;; Commentary:
24
25;; Defines most of Emacs's file- and directory-handling functions,
26;; including basic file visiting, backup generation, link handling,
27;; ITS-id version control, load- and write-hook handling, and the like.
28
e5167999
ER
29;;; Code:
30
b4da00e9 31(defconst delete-auto-save-files t
d1739e52 32 "*Non-nil means delete auto-save file when a buffer is saved or killed.")
b4da00e9
RM
33
34(defconst directory-abbrev-alist
35 nil
36 "*Alist of abbreviations for file directories.
37A list of elements of the form (FROM . TO), each meaning to replace
38FROM with TO when it appears in a directory name. This replacement is
39done when setting up the default directory of a newly visited file.
40*Every* FROM string should start with `^'.
41
65151a1b
RS
42Do not use `~' in the TO strings.
43They should be ordinary absolute directory names.
44
b4da00e9
RM
45Use this feature when you have directories which you normally refer to
46via absolute symbolic links. Make TO the name of the link, and FROM
47the name it is linked to.")
48
49;;; Turn off backup files on VMS since it has version numbers.
50(defconst make-backup-files (not (eq system-type 'vax-vms))
4ea836c1 51 "*Non-nil means make a backup of a file the first time it is saved.
b4da00e9
RM
52This can be done by renaming the file or by copying.
53
54Renaming means that Emacs renames the existing file so that it is a
55backup file, then writes the buffer into a new file. Any other names
56that the old file had will now refer to the backup file. The new file
57is owned by you and its group is defaulted.
58
59Copying means that Emacs copies the existing file into the backup
60file, then writes the buffer on top of the existing file. Any other
61names that the old file had will now refer to the new (edited) file.
62The file's owner and group are unchanged.
63
64The choice of renaming or copying is controlled by the variables
65`backup-by-copying', `backup-by-copying-when-linked' and
f862241d 66`backup-by-copying-when-mismatch'. See also `backup-inhibited'.")
b4da00e9
RM
67
68;; Do this so that local variables based on the file name
69;; are not overridden by the major mode.
70(defvar backup-inhibited nil
f862241d
RS
71 "Non-nil means don't make a backup, regardless of the other parameters.
72This variable is intended for use by making it local to a buffer.
73But it is local only if you make it local.")
b4da00e9
RM
74(put 'backup-inhibited 'permanent-local t)
75
76(defconst backup-by-copying nil
77 "*Non-nil means always use copying to create backup files.
78See documentation of variable `make-backup-files'.")
79
80(defconst backup-by-copying-when-linked nil
81 "*Non-nil means use copying to create backups for files with multiple names.
82This causes the alternate names to refer to the latest version as edited.
83This variable is relevant only if `backup-by-copying' is nil.")
84
85(defconst backup-by-copying-when-mismatch nil
86 "*Non-nil means create backups by copying if this preserves owner or group.
87Renaming may still be used (subject to control of other variables)
88when it would not result in changing the owner or group of the file;
89that is, for files which are owned by you and whose group matches
90the default for a new file created there by you.
91This variable is relevant only if `backup-by-copying' is nil.")
92
93(defvar backup-enable-predicate
94 '(lambda (name)
95 (or (< (length name) 5)
96 (not (string-equal "/tmp/" (substring name 0 5)))))
97 "Predicate that looks at a file name and decides whether to make backups.
98Called with an absolute file name as argument, it returns t to enable backup.")
99
100(defconst buffer-offer-save nil
101 "*Non-nil in a buffer means offer to save the buffer on exit
102even if the buffer is not visiting a file.
103Automatically local in all buffers.")
104(make-variable-buffer-local 'buffer-offer-save)
105
f3e23606
RS
106(defconst find-file-existing-other-name nil
107 "*Non-nil means find a file under alternative names, in existing buffers.
108This means if any existing buffer is visiting the file you want
109under another name, you get the existing buffer instead of a new buffer.")
110
111(defconst find-file-visit-truename nil
112 "*Non-nil means visit a file under its truename.
113The truename of a file is found by chasing all links
114both at the file level and at the levels of the containing directories.")
115
f3e23606
RS
116(defvar buffer-file-number nil
117 "The device number and file number of the file visited in the current buffer.
118The value is a list of the form (FILENUM DEVNUM).
119This pair of numbers uniquely identifies the file.
120If the buffer is visiting a new file, the value is nil.")
121(make-variable-buffer-local 'buffer-file-number)
122(put 'buffer-file-number 'permanent-local t)
123
b4da00e9
RM
124(defconst file-precious-flag nil
125 "*Non-nil means protect against I/O errors while saving files.
560f4415 126Some modes set this non-nil in particular buffers.
4b7271c1
KH
127
128This feature works by writing the new contents into a temporary file
129and then renaming the temporary file to replace the original.
130In this way, any I/O error in writing leaves the original untouched,
131and there is never any instant where the file is nonexistent.
132
133Note that this feature forces backups to be made by copying.
560f4415
KH
134Yet, at the same time, saving a precious file
135breaks any hard links between it and other files.")
b4da00e9
RM
136
137(defvar version-control nil
138 "*Control use of version numbers for backup files.
139t means make numeric backup versions unconditionally.
140nil means make them for files that have some already.
399f8dd6 141`never' means do not make them.")
b4da00e9
RM
142
143(defvar dired-kept-versions 2
144 "*When cleaning directory, number of versions to keep.")
145
de7d5e1b
RS
146(defvar delete-old-versions nil
147 "*If t, delete excess backup versions silently.
148If nil, ask confirmation. Any other value prevents any trimming.")
b4da00e9
RM
149
150(defvar kept-old-versions 2
151 "*Number of oldest versions to keep when a new numbered backup is made.")
152
153(defvar kept-new-versions 2
154 "*Number of newest versions to keep when a new numbered backup is made.
155Includes the new backup. Must be > 0")
156
157(defconst require-final-newline nil
158 "*Value of t says silently ensure a file ends in a newline when it is saved.
159Non-nil but not t says ask user whether to add a newline when there isn't one.
160nil means don't add newlines.")
161
162(defconst auto-save-default t
163 "*Non-nil says by default do auto-saving of every file-visiting buffer.")
164
165(defconst auto-save-visited-file-name nil
166 "*Non-nil says auto-save a buffer in the file it is visiting, when practical.
167Normally auto-save files are written under other names.")
168
169(defconst save-abbrevs nil
170 "*Non-nil means save word abbrevs too when files are saved.
171Loading an abbrev file sets this to t.")
172
173(defconst find-file-run-dired t
320b4233 174 "*Non-nil says run dired if `find-file' is given the name of a directory.")
b4da00e9 175
92966e6f
RS
176;;;It is not useful to make this a local variable.
177;;;(put 'find-file-not-found-hooks 'permanent-local t)
b4da00e9
RM
178(defvar find-file-not-found-hooks nil
179 "List of functions to be called for `find-file' on nonexistent file.
180These functions are called as soon as the error is detected.
181`buffer-file-name' is already set up.
182The functions are called in the order given until one of them returns non-nil.")
183
92966e6f
RS
184;;;It is not useful to make this a local variable.
185;;;(put 'find-file-hooks 'permanent-local t)
b4da00e9
RM
186(defvar find-file-hooks nil
187 "List of functions to be called after a buffer is loaded from a file.
188The buffer's local variables (if any) will have been processed before the
189functions are called.")
190
b4da00e9
RM
191(defvar write-file-hooks nil
192 "List of functions to be called before writing out a buffer to a file.
193If one of them returns non-nil, the file is considered already written
8c0e7b73
JB
194and the rest are not called.
195These hooks are considered to pertain to the visited file.
196So this list is cleared if you change the visited file name.
c9dca4e0
RS
197See also `write-contents-hooks'.
198Don't make this variable buffer-local; instead, use `local-write-file-hooks'.")
b19f1da4
BF
199;;; However, in case someone does make it local...
200(put 'write-file-hooks 'permanent-local t)
c9dca4e0 201
c9dca4e0
RS
202(defvar local-write-file-hooks nil
203 "Just like `write-file-hooks', except intended for per-buffer use.
204The functions in this list are called before the ones in
205`write-file-hooks'.")
b19f1da4
BF
206(make-variable-buffer-local 'local-write-file-hooks)
207(put 'local-write-file-hooks 'permanent-local t)
8c0e7b73
JB
208
209(defvar write-contents-hooks nil
210 "List of functions to be called before writing out a buffer to a file.
211If one of them returns non-nil, the file is considered already written
212and the rest are not called.
213These hooks are considered to pertain to the buffer's contents,
214not to the particular visited file; thus, `set-visited-file-name' does
215not clear this variable, but changing the major mode does clear it.
216See also `write-file-hooks'.")
b4da00e9
RM
217
218(defconst enable-local-variables t
219 "*Control use of local-variables lists in files you visit.
220The value can be t, nil or something else.
221A value of t means local-variables lists are obeyed;
222nil means they are ignored; anything else means query.
223
224The command \\[normal-mode] always obeys local-variables lists
225and ignores this variable.")
226
2bba782c 227(defconst enable-local-eval 'maybe
d207b766
RS
228 "*Control processing of the \"variable\" `eval' in a file's local variables.
229The value can be t, nil or something else.
230A value of t means obey `eval' variables;
231nil means ignore them; anything else means query.
232
233The command \\[normal-mode] always obeys local-variables lists
234and ignores this variable.")
b4da00e9
RM
235
236;; Avoid losing in versions where CLASH_DETECTION is disabled.
237(or (fboundp 'lock-buffer)
231c4e10 238 (defalias 'lock-buffer 'ignore))
b4da00e9 239(or (fboundp 'unlock-buffer)
231c4e10 240 (defalias 'unlock-buffer 'ignore))
93fe0a35
RS
241
242;; This hook function provides support for ange-ftp host name
243;; completion. It runs the usual ange-ftp hook, but only for
244;; completion operations. Having this here avoids the need
245;; to load ange-ftp when it's not really in use.
246(defun ange-ftp-completion-hook-function (op &rest args)
247 (if (memq op '(file-name-completion file-name-all-completions))
248 (apply 'ange-ftp-hook-function op args)
57e81f57
RS
249 (let ((inhibit-file-name-handlers
250 (cons 'ange-ftp-completion-hook-function
251 (and (eq inhibit-file-name-operation op)
252 inhibit-file-name-handlers)))
253 (inhibit-file-name-operation op))
93fe0a35 254 (apply op args))))
b4da00e9
RM
255\f
256(defun pwd ()
257 "Show the current default directory."
258 (interactive nil)
259 (message "Directory %s" default-directory))
260
231c4e10
ER
261(defvar cd-path nil
262 "Value of the CDPATH environment variable, as a list.
263Not actually set up until the first time you you use it.")
264
306faa42
RS
265(defvar path-separator ":"
266 "Character used to separate concatenated paths.")
267
231c4e10
ER
268(defun parse-colon-path (cd-path)
269 "Explode a colon-separated list of paths into a string list."
270 (and cd-path
271 (let (cd-prefix cd-list (cd-start 0) cd-colon)
306faa42
RS
272 (setq cd-path (concat cd-path path-separator))
273 (while (setq cd-colon (string-match path-separator cd-path cd-start))
231c4e10 274 (setq cd-list
9daefb36 275 (nconc cd-list
c52e4104
RS
276 (list (if (= cd-start cd-colon)
277 nil
278 (substitute-in-file-name
e33e80e4
RS
279 (file-name-as-directory
280 (substring cd-path cd-start cd-colon)))))))
231c4e10
ER
281 (setq cd-start (+ cd-colon 1)))
282 cd-list)))
283
284(defun cd-absolute (dir)
30c5ce9c 285 "Change current directory to given absolute file name DIR."
f4a0f59b
RS
286 ;; Put the name into directory syntax now,
287 ;; because otherwise expand-file-name may give some bad results.
b4da00e9
RM
288 (if (not (eq system-type 'vax-vms))
289 (setq dir (file-name-as-directory dir)))
f4a0f59b 290 (setq dir (abbreviate-file-name (expand-file-name dir)))
b4da00e9
RM
291 (if (not (file-directory-p dir))
292 (error "%s is not a directory" dir)
293 (if (file-executable-p dir)
294 (setq default-directory dir)
9daefb36 295 (error "Cannot cd to %s: Permission denied" dir))))
b4da00e9 296
231c4e10
ER
297(defun cd (dir)
298 "Make DIR become the current buffer's default directory.
30c5ce9c
RS
299If your environment includes a `CDPATH' variable, try each one of that
300colon-separated list of directories when resolving a relative directory name."
dac4ea74
RS
301 (interactive
302 (list (read-file-name "Change default directory: "
303 default-directory default-directory)))
30c5ce9c
RS
304 (if (file-name-absolute-p dir)
305 (cd-absolute (expand-file-name dir))
306 (if (null cd-path)
307 (let ((trypath (parse-colon-path (getenv "CDPATH"))))
308 (setq cd-path (or trypath (list "./")))))
309 (if (not (catch 'found
310 (mapcar
311 (function (lambda (x)
312 (let ((f (expand-file-name (concat x dir))))
313 (if (file-directory-p f)
314 (progn
315 (cd-absolute f)
316 (throw 'found t))))))
317 cd-path)
318 nil))
319 (error "No such directory found via CDPATH environment variable"))))
231c4e10 320
b4da00e9
RM
321(defun load-file (file)
322 "Load the Lisp file named FILE."
323 (interactive "fLoad file: ")
324 (load (expand-file-name file) nil nil t))
325
326(defun load-library (library)
327 "Load the library named LIBRARY.
328This is an interface to the function `load'."
329 (interactive "sLoad library: ")
330 (load library))
5d68c2c2 331
7c4b8f8c 332(defun file-local-copy (file &optional buffer)
5d68c2c2
RS
333 "Copy the file FILE into a temporary file on this machine.
334Returns the name of the local copy, or nil, if FILE is directly
335accessible."
6eaebaa2 336 (let ((handler (find-file-name-handler file 'file-local-copy)))
5d68c2c2
RS
337 (if handler
338 (funcall handler 'file-local-copy file)
339 nil)))
f3e23606 340
05ef1cda 341(defun file-truename (filename &optional counter prev-dirs)
f3e23606
RS
342 "Return the truename of FILENAME, which should be absolute.
343The truename of a file name is found by chasing symbolic links
344both at the level of the file and at the level of the directories
05ef1cda
RS
345containing it, until no links are left at any level.
346
347The arguments COUNTER and PREV-DIRS are used only in recursive calls.
348Do not specify them in other calls."
349 ;; COUNTER can be a cons cell whose car is the count of how many more links
350 ;; to chase before getting an error.
351 ;; PREV-DIRS can be a cons cell whose car is an alist
352 ;; of truenames we've just recently computed.
cc37a58c 353
cc37a58c
SM
354 ;; The last test looks dubious, maybe `+' is meant here? --simon.
355 (if (or (string= filename "") (string= filename "~")
7a5a26a6
RS
356 (and (string= (substring filename 0 1) "~")
357 (string-match "~[^/]*" filename)))
1cc2fbeb
RS
358 (progn
359 (setq filename (expand-file-name filename))
360 (if (string= filename "")
361 (setq filename "/"))))
05ef1cda 362 (or counter (setq counter (list 100)))
b505828b
RS
363 (let (done
364 ;; For speed, remove the ange-ftp completion handler from the list.
365 ;; We know it's not needed here.
366 ;; For even more speed, do this only on the outermost call.
367 (file-name-handler-alist
368 (if prev-dirs file-name-handler-alist
369 (let ((tem (copy-sequence file-name-handler-alist)))
370 (delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
371 (or prev-dirs (setq prev-dirs (list nil)))
05ef1cda
RS
372 ;; If this file directly leads to a link, process that iteratively
373 ;; so that we don't use lots of stack.
374 (while (not done)
375 (setcar counter (1- (car counter)))
376 (if (< (car counter) 0)
377 (error "Apparent cycle of symbolic links for %s" filename))
378 (let ((handler (find-file-name-handler filename 'file-truename)))
379 ;; For file name that has a special handler, call handler.
380 ;; This is so that ange-ftp can save time by doing a no-op.
381 (if handler
382 (setq filename (funcall handler 'file-truename filename)
383 done t)
fb145562 384 (let ((dir (or (file-name-directory filename) default-directory))
05ef1cda
RS
385 target dirfile)
386 ;; Get the truename of the directory.
387 (setq dirfile (directory-file-name dir))
388 ;; If these are equal, we have the (or a) root directory.
389 (or (string= dir dirfile)
390 ;; If this is the same dir we last got the truename for,
391 ;; save time--don't recalculate.
392 (if (assoc dir (car prev-dirs))
393 (setq dir (cdr (assoc dir (car prev-dirs))))
394 (let ((old dir)
395 (new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
396 (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
397 (setq dir new))))
398 (if (equal ".." (file-name-nondirectory filename))
399 (setq filename
400 (directory-file-name (file-name-directory (directory-file-name dir)))
401 done t)
402 (if (equal "." (file-name-nondirectory filename))
403 (setq filename (directory-file-name dir)
404 done t)
405 ;; Put it back on the file name.
406 (setq filename (concat dir (file-name-nondirectory filename)))
407 ;; Is the file name the name of a link?
408 (setq target (file-symlink-p filename))
409 (if target
410 ;; Yes => chase that link, then start all over
411 ;; since the link may point to a directory name that uses links.
412 ;; We can't safely use expand-file-name here
413 ;; since target might look like foo/../bar where foo
414 ;; is itself a link. Instead, we handle . and .. above.
415 (setq filename
416 (if (file-name-absolute-p target)
417 target
418 (concat dir target))
419 done nil)
420 ;; No, we are done!
421 (setq done t))))))))
422 filename))
5dbfdacd 423
5dadeb29
RS
424(defun file-chase-links (filename)
425 "Chase links in FILENAME until a name that is not a link.
426Does not examine containing directories for links,
427unlike `file-truename'."
428 (let (tem (count 100) (newname filename))
429 (while (setq tem (file-symlink-p newname))
430 (if (= count 0)
431 (error "Apparent cycle of symbolic links for %s" filename))
f01de0db
KH
432 ;; In the context of a link, `//' doesn't mean what Emacs thinks.
433 (while (string-match "//+" tem)
434 (setq tem (concat (substring tem 0 (1+ (match-beginning 0)))
435 (substring tem (match-end 0)))))
cf65b429
RS
436 ;; Handle `..' by hand, since it needs to work in the
437 ;; target of any directory symlink.
438 ;; This code is not quite complete; it does not handle
439 ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
f01de0db 440 (while (string-match "\\`\\.\\./" tem)
cf65b429
RS
441 (setq tem (substring tem 3))
442 (setq newname (file-name-as-directory
443 ;; Do the .. by hand.
444 (directory-file-name
445 (file-name-directory
446 ;; Chase links in the default dir of the symlink.
447 (file-chase-links
448 (directory-file-name
449 (file-name-directory newname))))))))
5dadeb29
RS
450 (setq newname (expand-file-name tem (file-name-directory newname)))
451 (setq count (1- count)))
452 newname))
b4da00e9
RM
453\f
454(defun switch-to-buffer-other-window (buffer)
455 "Select buffer BUFFER in another window."
456 (interactive "BSwitch to buffer in other window: ")
457 (let ((pop-up-windows t))
458 (pop-to-buffer buffer t)))
459
f98955ea
JB
460(defun switch-to-buffer-other-frame (buffer)
461 "Switch to buffer BUFFER in another frame."
462 (interactive "BSwitch to buffer in other frame: ")
463 (let ((pop-up-frames t))
336b7f41
RS
464 (pop-to-buffer buffer t)
465 (raise-frame (window-frame (selected-window)))))
5bbbceb1 466
b4da00e9
RM
467(defun find-file (filename)
468 "Edit file FILENAME.
469Switch to a buffer visiting file FILENAME,
470creating one if none already exists."
471 (interactive "FFind file: ")
472 (switch-to-buffer (find-file-noselect filename)))
473
474(defun find-file-other-window (filename)
475 "Edit file FILENAME, in another window.
476May create a new window, or reuse an existing one.
477See the function `display-buffer'."
478 (interactive "FFind file in other window: ")
479 (switch-to-buffer-other-window (find-file-noselect filename)))
480
f98955ea
JB
481(defun find-file-other-frame (filename)
482 "Edit file FILENAME, in another frame.
483May create a new frame, or reuse an existing one.
5bbbceb1 484See the function `display-buffer'."
f98955ea
JB
485 (interactive "FFind file in other frame: ")
486 (switch-to-buffer-other-frame (find-file-noselect filename)))
5bbbceb1 487
b4da00e9
RM
488(defun find-file-read-only (filename)
489 "Edit file FILENAME but don't allow changes.
490Like \\[find-file] but marks buffer as read-only.
491Use \\[toggle-read-only] to permit editing."
492 (interactive "fFind file read-only: ")
493 (find-file filename)
320b4233
RS
494 (setq buffer-read-only t)
495 (current-buffer))
b4da00e9
RM
496
497(defun find-file-read-only-other-window (filename)
498 "Edit file FILENAME in another window but don't allow changes.
499Like \\[find-file-other-window] but marks buffer as read-only.
500Use \\[toggle-read-only] to permit editing."
501 (interactive "fFind file read-only other window: ")
9466a1f6 502 (find-file-other-window filename)
320b4233
RS
503 (setq buffer-read-only t)
504 (current-buffer))
b4da00e9 505
f98955ea
JB
506(defun find-file-read-only-other-frame (filename)
507 "Edit file FILENAME in another frame but don't allow changes.
508Like \\[find-file-other-frame] but marks buffer as read-only.
5bbbceb1 509Use \\[toggle-read-only] to permit editing."
f98955ea
JB
510 (interactive "fFind file read-only other frame: ")
511 (find-file-other-frame filename)
320b4233
RS
512 (setq buffer-read-only t)
513 (current-buffer))
5bbbceb1 514
b4da00e9
RM
515(defun find-alternate-file (filename)
516 "Find file FILENAME, select its buffer, kill previous buffer.
517If the current buffer now contains an empty file that you just visited
518\(presumably by mistake), use this command to visit the file you really want."
519 (interactive
520 (let ((file buffer-file-name)
521 (file-name nil)
522 (file-dir nil))
523 (and file
524 (setq file-name (file-name-nondirectory file)
525 file-dir (file-name-directory file)))
a61f59b4
JA
526 (list (read-file-name
527 "Find alternate file: " file-dir nil nil file-name))))
2aa8cc2d 528 (and (buffer-modified-p) (buffer-file-name)
b4da00e9
RM
529 ;; (not buffer-read-only)
530 (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
531 (buffer-name))))
532 (error "Aborted"))
533 (let ((obuf (current-buffer))
534 (ofile buffer-file-name)
8bb27285
RS
535 (onum buffer-file-number)
536 (otrue buffer-file-truename)
b4da00e9 537 (oname (buffer-name)))
baf9b8c4
RS
538 (if (get-buffer " **lose**")
539 (kill-buffer " **lose**"))
b4da00e9
RM
540 (rename-buffer " **lose**")
541 (setq buffer-file-name nil)
8bb27285
RS
542 (setq buffer-file-number nil)
543 (setq buffer-file-truename nil)
b4da00e9
RM
544 (unwind-protect
545 (progn
546 (unlock-buffer)
547 (find-file filename))
548 (cond ((eq obuf (current-buffer))
549 (setq buffer-file-name ofile)
8bb27285
RS
550 (setq buffer-file-number onum)
551 (setq buffer-file-truename otrue)
b4da00e9
RM
552 (lock-buffer)
553 (rename-buffer oname))))
554 (or (eq (current-buffer) obuf)
555 (kill-buffer obuf))))
556
557(defun create-file-buffer (filename)
558 "Create a suitably named buffer for visiting FILENAME, and return it.
559FILENAME (sans directory) is used unchanged if that name is free;
560otherwise a string <2> or <3> or ... is appended to get an unused name."
561 (let ((lastname (file-name-nondirectory filename)))
562 (if (string= lastname "")
563 (setq lastname filename))
564 (generate-new-buffer lastname)))
565
5bbbceb1
JB
566(defun generate-new-buffer (name)
567 "Create and return a buffer with a name based on NAME.
29165787 568Choose the buffer's name using `generate-new-buffer-name'."
5bbbceb1
JB
569 (get-buffer-create (generate-new-buffer-name name)))
570
e373f201
JB
571(defconst automount-dir-prefix "^/tmp_mnt/"
572 "Regexp to match the automounter prefix in a directory name.")
573
ffb3a4db 574(defvar abbreviated-home-dir nil
292297c6 575 "The user's homedir abbreviated according to `directory-abbrev-list'.")
ffb3a4db 576
5bbbceb1 577(defun abbreviate-file-name (filename)
29165787 578 "Return a version of FILENAME shortened using `directory-abbrev-alist'.
5bbbceb1 579This also substitutes \"~\" for the user's home directory.
29165787 580Type \\[describe-variable] directory-abbrev-alist RET for more information."
e373f201
JB
581 ;; Get rid of the prefixes added by the automounter.
582 (if (and (string-match automount-dir-prefix filename)
583 (file-exists-p (file-name-directory
584 (substring filename (1- (match-end 0))))))
585 (setq filename (substring filename (1- (match-end 0)))))
5bbbceb1 586 (let ((tail directory-abbrev-alist))
ffb3a4db
RS
587 ;; If any elt of directory-abbrev-alist matches this name,
588 ;; abbreviate accordingly.
5bbbceb1
JB
589 (while tail
590 (if (string-match (car (car tail)) filename)
591 (setq filename
592 (concat (cdr (car tail)) (substring filename (match-end 0)))))
593 (setq tail (cdr tail)))
ffb3a4db
RS
594 ;; Compute and save the abbreviated homedir name.
595 ;; We defer computing this until the first time it's needed, to
596 ;; give time for directory-abbrev-alist to be set properly.
e98dda89
RS
597 ;; We include a slash at the end, to avoid spurious matches
598 ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
ffb3a4db
RS
599 (or abbreviated-home-dir
600 (setq abbreviated-home-dir
601 (let ((abbreviated-home-dir "$foo"))
3a8a836d
RS
602 (concat "^" (abbreviate-file-name (expand-file-name "~"))
603 "\\(/\\|$\\)"))))
604
ffb3a4db
RS
605 ;; If FILENAME starts with the abbreviated homedir,
606 ;; make it start with `~' instead.
ca33ccb5
RS
607 (if (and (string-match abbreviated-home-dir filename)
608 ;; If the home dir is just /, don't change it.
609 (not (and (= (match-end 0) 1)
288201bd 610 (= (aref filename 0) ?/)))
c32d49e8
RS
611 (not (and (or (eq system-type 'ms-dos)
612 (eq system-type 'windows-nt))
288201bd
RS
613 (save-match-data
614 (string-match "^[a-zA-Z]:/$" filename)))))
5bbbceb1 615 (setq filename
28dbf501 616 (concat "~"
3a8a836d 617 (substring filename (match-beginning 1) (match-end 1))
28dbf501 618 (substring filename (match-end 0)))))
5bbbceb1
JB
619 filename))
620
1770543d
RS
621(defvar find-file-not-true-dirname-list nil
622 "*List of logical names for which visiting shouldn't save the true dirname.
623On VMS, when you visit a file using a logical name that searches a path,
624you may or may not want the visited file name to record the specific
625directory where the file was found. If you *do not* want that, add the logical
626name to this list as a string.")
627
138c44f6
KH
628(defun find-buffer-visiting (filename)
629 "Return the buffer visiting file FILENAME (a string).
630This is like `get-file-buffer', except that it checks for any buffer
631visiting the same file, possibly under a different name.
632If there is no such live buffer, return nil."
633 (let ((buf (get-file-buffer filename))
634 (truename (abbreviate-file-name (file-truename filename))))
635 (or buf
636 (let ((list (buffer-list)) found)
637 (while (and (not found) list)
638 (save-excursion
639 (set-buffer (car list))
640 (if (and buffer-file-name
641 (string= buffer-file-truename truename))
642 (setq found (car list))))
643 (setq list (cdr list)))
644 found)
0f933cf6 645 (let ((number (nthcdr 10 (file-attributes truename)))
138c44f6 646 (list (buffer-list)) found)
181c830f
RS
647 (and number
648 (while (and (not found) list)
649 (save-excursion
650 (set-buffer (car list))
d49ab5a0
RS
651 (if (and buffer-file-name
652 (equal buffer-file-number number)
181c830f
RS
653 ;; Verify this buffer's file number
654 ;; still belongs to its file.
655 (file-exists-p buffer-file-name)
656 (equal (nthcdr 10 (file-attributes buffer-file-name))
657 number))
658 (setq found (car list))))
659 (setq list (cdr list))))
138c44f6
KH
660 found))))
661
40dfe94d
RS
662(defun insert-file-contents-literally (filename &optional visit beg end replace)
663 "Like `insert-file-contents', q.v., but only reads in the file.
664A buffer may be modified in several ways after reading into the buffer due
665to advanced Emacs features, such as file-name-handlers, format decoding,
666find-file-hooks, etc.
667 This function ensures that none of these modifications will take place."
668 (let ((file-name-handler-alist nil)
669 (format-alist nil)
670 (after-insert-file-functions nil)
671 (find-buffer-file-type-function
672 (if (fboundp 'find-buffer-file-type)
673 (symbol-function 'find-buffer-file-type)
674 nil)))
675 (unwind-protect
676 (progn
677 (fset 'find-buffer-file-type (lambda (filename) t))
678 (insert-file-contents filename visit beg end replace))
679 (if find-buffer-file-type-function
680 (fset 'find-buffer-file-type find-buffer-file-type-function)
681 (fmakunbound 'find-buffer-file-type)))))
682
683(defun find-file-noselect (filename &optional nowarn rawfile)
b4da00e9
RM
684 "Read file FILENAME into a buffer and return the buffer.
685If a buffer exists visiting FILENAME, return that one, but
686verify that the file has not changed since visited or saved.
687The buffer is not selected, just returned to the caller."
e373f201
JB
688 (setq filename
689 (abbreviate-file-name
690 (expand-file-name filename)))
b4da00e9
RM
691 (if (file-directory-p filename)
692 (if find-file-run-dired
693 (dired-noselect filename)
694 (error "%s is a directory." filename))
f3e23606
RS
695 (let* ((buf (get-file-buffer filename))
696 (truename (abbreviate-file-name (file-truename filename)))
697 (number (nthcdr 10 (file-attributes truename)))
698 ;; Find any buffer for a file which has same truename.
138c44f6 699 (other (and (not buf) (find-buffer-visiting filename)))
f3e23606
RS
700 error)
701 ;; Let user know if there is a buffer with the same truename.
138c44f6
KH
702 (if other
703 (progn
327bebe8
RS
704 (or nowarn
705 (string-equal filename (buffer-file-name other))
706 (message "%s and %s are the same file"
707 filename (buffer-file-name other)))
138c44f6
KH
708 ;; Optionally also find that buffer.
709 (if (or find-file-existing-other-name find-file-visit-truename)
710 (setq buf other))))
b4da00e9
RM
711 (if buf
712 (or nowarn
713 (verify-visited-file-modtime buf)
714 (cond ((not (file-exists-p filename))
715 (error "File %s no longer exists!" filename))
716 ((yes-or-no-p
b7d19f4a
KH
717 (if (string= (file-name-nondirectory filename)
718 (buffer-name buf))
719 (format
720 (if (buffer-modified-p buf)
721 "File %s changed on disk. Discard your edits? "
722 "File %s changed on disk. Reread from disk? ")
723 (file-name-nondirectory filename))
724 (format
725 (if (buffer-modified-p buf)
726 "File %s changed on disk. Discard your edits in %s? "
727 "File %s changed on disk. Reread from disk into %s? ")
728 (file-name-nondirectory filename)
729 (buffer-name buf))))
b4da00e9
RM
730 (save-excursion
731 (set-buffer buf)
732 (revert-buffer t t)))))
733 (save-excursion
f3e23606
RS
734;;; The truename stuff makes this obsolete.
735;;; (let* ((link-name (car (file-attributes filename)))
736;;; (linked-buf (and (stringp link-name)
737;;; (get-file-buffer link-name))))
738;;; (if (bufferp linked-buf)
739;;; (message "Symbolic link to file in buffer %s"
740;;; (buffer-name linked-buf))))
b4da00e9 741 (setq buf (create-file-buffer filename))
a2e12c0c 742 (set-buffer-major-mode buf)
b4da00e9
RM
743 (set-buffer buf)
744 (erase-buffer)
40dfe94d
RS
745 (if rawfile
746 (condition-case ()
747 (insert-file-contents-literally filename t)
748 (file-error
749 ;; Unconditionally set error
750 (setq error t)))
751 (condition-case ()
752 (insert-file-contents filename t)
753 (file-error
754 ;; Run find-file-not-found-hooks until one returns non-nil.
755 (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
756 ;; If they fail too, set error.
757 (setq error t)))))
f3e23606 758 ;; Find the file's truename, and maybe use that as visited name.
138c44f6 759 (setq buffer-file-truename truename)
1770543d
RS
760 (setq buffer-file-number number)
761 ;; On VMS, we may want to remember which directory in a search list
762 ;; the file was found in.
763 (and (eq system-type 'vax-vms)
764 (let (logical)
765 (if (string-match ":" (file-name-directory filename))
766 (setq logical (substring (file-name-directory filename)
767 0 (match-beginning 0))))
768 (not (member logical find-file-not-true-dirname-list)))
769 (setq buffer-file-name buffer-file-truename))
1cc2fbeb 770 (if find-file-visit-truename
27d0420c
RS
771 (setq buffer-file-name
772 (setq filename
773 (expand-file-name buffer-file-truename))))
b4da00e9
RM
774 ;; Set buffer's default directory to that of the file.
775 (setq default-directory (file-name-directory filename))
776 ;; Turn off backup files for certain file names. Since
777 ;; this is a permanent local, the major mode won't eliminate it.
778 (and (not (funcall backup-enable-predicate buffer-file-name))
779 (progn
780 (make-local-variable 'backup-inhibited)
781 (setq backup-inhibited t)))
40dfe94d
RS
782 (if rawfile
783 nil
784 (after-find-file error (not nowarn)))))
b4da00e9
RM
785 buf)))
786\f
f7d786d0
RS
787(defvar after-find-file-from-revert-buffer nil)
788
e0ab8879
RS
789(defun after-find-file (&optional error warn noauto
790 after-find-file-from-revert-buffer)
b4da00e9
RM
791 "Called after finding a file and by the default revert function.
792Sets buffer mode, parses local variables.
8cfb9d46 793Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
b4da00e9
RM
794error in reading the file. WARN non-nil means warn if there
795exists an auto-save file more recent than the visited file.
8cfb9d46 796NOAUTO means don't mess with auto-save mode.
e0ab8879
RS
797Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
798 means this call was from `revert-buffer'.
b4da00e9
RM
799Finishes by calling the functions in `find-file-hooks'."
800 (setq buffer-read-only (not (file-writable-p buffer-file-name)))
801 (if noninteractive
802 nil
803 (let* (not-serious
804 (msg
805 (cond ((and error (file-attributes buffer-file-name))
806 (setq buffer-read-only t)
ff78d520 807 "File exists, but cannot be read.")
b4da00e9
RM
808 ((not buffer-read-only)
809 (if (and warn
810 (file-newer-than-file-p (make-auto-save-file-name)
811 buffer-file-name))
812 "Auto save file is newer; consider M-x recover-file"
813 (setq not-serious t)
814 (if error "(New file)" nil)))
815 ((not error)
816 (setq not-serious t)
817 "Note: file is write protected")
818 ((file-attributes (directory-file-name default-directory))
819 "File not found and directory write-protected")
4e43240a
RS
820 ((file-exists-p (file-name-directory buffer-file-name))
821 (setq buffer-read-only nil))
b4da00e9 822 (t
5bbbceb1 823 (setq buffer-read-only nil)
4e43240a
RS
824 (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name))))
825 "Use M-x make-dir RET RET to create the directory"
826 "Use C-u M-x make-dir RET RET to create directory and its parents")))))
b4da00e9
RM
827 (if msg
828 (progn
829 (message msg)
830 (or not-serious (sit-for 1 nil t)))))
8cfb9d46 831 (if (and auto-save-default (not noauto))
b4da00e9
RM
832 (auto-save-mode t)))
833 (normal-mode t)
a4f5efdc 834 (run-hooks 'find-file-hooks))
b4da00e9
RM
835
836(defun normal-mode (&optional find-file)
837 "Choose the major mode for this buffer automatically.
838Also sets up any specified local variables of the file.
839Uses the visited file name, the -*- line, and the local variables spec.
840
841This function is called automatically from `find-file'. In that case,
842we may set up specified local variables depending on the value of
843`enable-local-variables': if it is t, we do; if it is nil, we don't;
844otherwise, we query. `enable-local-variables' is ignored if you
845run `normal-mode' explicitly."
846 (interactive)
847 (or find-file (funcall (or default-major-mode 'fundamental-mode)))
848 (condition-case err
849 (set-auto-mode)
850 (error (message "File mode specification error: %s"
851 (prin1-to-string err))))
852 (condition-case err
7b3f3dc2
JB
853 (let ((enable-local-variables (or (not find-file)
854 enable-local-variables)))
855 (hack-local-variables))
b4da00e9
RM
856 (error (message "File local-variables error: %s"
857 (prin1-to-string err)))))
858
7b3f3dc2
JB
859(defvar auto-mode-alist (mapcar 'purecopy
860 '(("\\.text\\'" . text-mode)
861 ("\\.c\\'" . c-mode)
862 ("\\.h\\'" . c-mode)
c11a94fe
RS
863 ("\\.tex\\'" . tex-mode)
864 ("\\.ltx\\'" . latex-mode)
7b3f3dc2
JB
865 ("\\.el\\'" . emacs-lisp-mode)
866 ("\\.mm\\'" . nroff-mode)
867 ("\\.me\\'" . nroff-mode)
c80d2575
ER
868 ("\\.ms\\'" . nroff-mode)
869 ("\\.man\\'" . nroff-mode)
7b3f3dc2
JB
870 ("\\.scm\\'" . scheme-mode)
871 ("\\.l\\'" . lisp-mode)
872 ("\\.lisp\\'" . lisp-mode)
873 ("\\.f\\'" . fortran-mode)
874 ("\\.for\\'" . fortran-mode)
e70991d4
RS
875 ("\\.p\\'" . pascal-mode)
876 ("\\.pas\\'" . pascal-mode)
7b3f3dc2 877 ("\\.mss\\'" . scribe-mode)
f804f4e4 878 ("\\.ad[abs]\\'" . ada-mode)
b9952c29 879 ("\\.icn\\'" . icon-mode)
d23e6f97 880 ("\\.pl\\'" . perl-mode)
7b3f3dc2 881 ("\\.cc\\'" . c++-mode)
2b845a8c 882 ("\\.hh\\'" . c++-mode)
7b3f3dc2 883 ("\\.C\\'" . c++-mode)
2b845a8c 884 ("\\.H\\'" . c++-mode)
c76a164a
RS
885 ("\\.cpp\\'" . c++-mode)
886 ("\\.cxx\\'" . c++-mode)
887 ("\\.hxx\\'" . c++-mode)
71679121
RS
888 ("\\.c\\+\\+\\'" . c++-mode)
889 ("\\.h\\+\\+\\'" . c++-mode)
6cf85938
RS
890 ("\\.mk\\'" . makefile-mode)
891 ("[Mm]akefile\\(.in\\)?\\'" . makefile-mode)
7b3f3dc2
JB
892;;; Less common extensions come here
893;;; so more common ones above are found faster.
7ca1d903
RS
894 ("\\.texinfo\\'" . texinfo-mode)
895 ("\\.texi\\'" . texinfo-mode)
7b3f3dc2
JB
896 ("\\.s\\'" . asm-mode)
897 ("ChangeLog\\'" . change-log-mode)
bb157910 898 ("change.log\\'" . change-log-mode)
9bb004f6 899 ("changelo\\'" . change-log-mode)
7adc58e5 900 ("ChangeLog.[0-9]+\\'" . change-log-mode)
7b3f3dc2 901 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
c1fe251a
KH
902 ("\\.scm\\.[0-9]*\\'" . scheme-mode)
903;;; The following should come after the ChangeLog pattern
904;;; for the sake of ChangeLog.1, etc.
905;;; and after the .scm.[0-9] pattern too.
7adc58e5 906 ("\\.[12345678]\\'" . nroff-mode)
c11a94fe
RS
907 ("\\.TeX\\'" . tex-mode)
908 ("\\.sty\\'" . latex-mode)
04eae667 909 ("\\.cls\\'" . latex-mode) ;LaTeX 2e class
c11a94fe 910 ("\\.bbl\\'" . latex-mode)
7b3f3dc2
JB
911 ("\\.bib\\'" . bibtex-mode)
912 ("\\.article\\'" . text-mode)
913 ("\\.letter\\'" . text-mode)
7ca1d903 914 ("\\.tcl\\'" . tcl-mode)
bccfd936 915 ("\\.f90\\'" . f90-mode)
7b3f3dc2
JB
916 ("\\.lsp\\'" . lisp-mode)
917 ("\\.awk\\'" . awk-mode)
918 ("\\.prolog\\'" . prolog-mode)
c80d2575 919 ("\\.tar\\'" . tar-mode)
1d354180 920 ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode)
7b3f3dc2
JB
921 ;; Mailer puts message to be edited in
922 ;; /tmp/Re.... or Message
923 ("^/tmp/Re" . text-mode)
924 ("/Message[0-9]*\\'" . text-mode)
04eae667 925 ("/drafts/[0-9]+\\'" . mh-letter-mode)
7b3f3dc2
JB
926 ;; some news reader is reported to use this
927 ("^/tmp/fol/" . text-mode)
928 ("\\.y\\'" . c-mode)
c80d2575 929 ("\\.lex\\'" . c-mode)
7b3f3dc2 930 ("\\.oak\\'" . scheme-mode)
278584fb
RS
931 ("\\.sgm\\'" . sgml-mode)
932 ("\\.sgml\\'" . sgml-mode)
933 ("\\.dtd\\'" . sgml-mode)
7b3f3dc2
JB
934 ;; .emacs following a directory delimiter
935 ;; in either Unix or VMS syntax.
936 ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode)
bb157910
RS
937 ;; _emacs following a directory delimiter
938 ;; in MsDos syntax
939 ("[:/]_emacs\\'" . emacs-lisp-mode)
7b3f3dc2
JB
940 ("\\.ml\\'" . lisp-mode)))
941 "\
942Alist of filename patterns vs corresponding major mode functions.
116987ba
RS
943Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
944\(NON-NIL stands for anything that is not nil; the value does not matter.)
945Visiting a file whose name matches REGEXP specifies FUNCTION as the
946mode function to use. FUNCTION will be called, unless it is nil.
947
948If the element has the form (REGEXP FUNCTION NON-NIL), then after
949calling FUNCTION (if it's not nil), we delete the suffix that matched
950REGEXP and search the list again for another match.")
7b3f3dc2 951
c907d156
RS
952(defconst interpreter-mode-alist
953 '(("perl" . perl-mode)
c907d156 954 ("wish" . tcl-mode)
e3998da1 955 ("wishx" . tcl-mode)
8db739de 956 ("tcl" . tcl-mode)
e3998da1 957 ("tclsh" . tcl-mode)
8db739de
NF
958 ("awk" . awk-mode)
959 ("gawk" . awk-mode)
960 ("scm" . scheme-mode))
c907d156
RS
961 "Alist mapping interpreter names to major modes.
962This alist applies to files whose first line starts with `#!'.
963Each element looks like (INTERPRETER . MODE).
964The car of each element is compared with
965the name of the interpreter specified in the first line.
966If it matches, mode MODE is selected.")
967
b20ff6d0 968(defconst inhibit-first-line-modes-regexps '("\\.tar\\'")
45fb3bb8 969 "List of regexps; if one matches a file name, don't look for `-*-'.")
a0c9f21b 970
b20ff6d0
RS
971(defconst inhibit-first-line-modes-suffixes nil
972 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
973When checking `inhibit-first-line-modes-regexps', we first discard
974from the end of the file name anything that matches one of these regexps.")
975
bb157910
RS
976(defvar user-init-file
977 "" ; set by command-line
978 "File name including directory of user's initialization file.")
979
b4da00e9
RM
980(defun set-auto-mode ()
981 "Select major mode appropriate for current buffer.
e3998da1
RS
982This checks for a -*- mode tag in the buffer's text,
983compares the filename against the entries in `auto-mode-alist',
984or checks the interpreter that runs this file against
985`interpreter-mode-alist'.
986
987It does not check for the `mode:' local variable in the
988Local Variables section of the file; for that, use `hack-local-variables'.
7b3f3dc2 989
f3e23606 990If `enable-local-variables' is nil, this function does not check for a
7b3f3dc2 991-*- mode tag."
b4da00e9 992 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
9fa7bfe5 993 (let (beg end done)
b4da00e9
RM
994 (save-excursion
995 (goto-char (point-min))
996 (skip-chars-forward " \t\n")
9fa7bfe5
RS
997 (and enable-local-variables
998 ;; Don't look for -*- if this file name matches any
45fb3bb8 999 ;; of the regexps in inhibit-first-line-modes-regexps.
cae111fa 1000 (let ((temp inhibit-first-line-modes-regexps)
4bc3d240
RS
1001 (name (if buffer-file-name
1002 (file-name-sans-versions buffer-file-name)
1003 (buffer-name))))
38832b4c
KH
1004 (while (let ((sufs inhibit-first-line-modes-suffixes))
1005 (while (and sufs (not (string-match (car sufs) name)))
1006 (setq sufs (cdr sufs)))
1007 sufs)
1008 (setq name (substring name 0 (match-beginning 0))))
9fa7bfe5 1009 (while (and temp
b20ff6d0 1010 (not (string-match (car temp) name)))
9fa7bfe5
RS
1011 (setq temp (cdr temp)))
1012 (not temp))
1013 (search-forward "-*-" (save-excursion
1014 ;; If the file begins with "#!"
1015 ;; (exec interpreter magic), look
1016 ;; for mode frobs in the first two
1017 ;; lines. You cannot necessarily
1018 ;; put them in the first line of
1019 ;; such a file without screwing up
1020 ;; the interpreter invocation.
1021 (end-of-line (and (looking-at "^#!") 2))
1022 (point)) t)
1023 (progn
1024 (skip-chars-forward " \t")
1025 (setq beg (point))
1026 (search-forward "-*-"
1027 (save-excursion (end-of-line) (point))
1028 t))
1029 (progn
1030 (forward-char -3)
1031 (skip-chars-backward " \t")
1032 (setq end (point))
1033 (goto-char beg)
1034 (if (save-excursion (search-forward ":" end t))
1035 ;; Find all specifications for the `mode:' variable
57a0155c 1036 ;; and execute them left to right.
9fa7bfe5 1037 (while (let ((case-fold-search t))
6054fcc6
KH
1038 (or (and (looking-at "mode:")
1039 (goto-char (match-end 0)))
1040 (re-search-forward "[ \t;]mode:" end t)))
9fa7bfe5
RS
1041 (skip-chars-forward " \t")
1042 (setq beg (point))
1043 (if (search-forward ";" end t)
1044 (forward-char -1)
1045 (goto-char end))
1046 (skip-chars-backward " \t")
fb69dfa5
RS
1047 (funcall (intern (concat (downcase (buffer-substring beg (point))) "-mode")))
1048 (setq done t))
9fa7bfe5 1049 ;; Simple -*-MODE-*- case.
fb69dfa5
RS
1050 (funcall (intern (concat (downcase (buffer-substring beg end)) "-mode")))
1051 (setq done t))))
9fa7bfe5
RS
1052 ;; If we didn't find a mode from a -*- line, try using the file name.
1053 (if (and (not done) buffer-file-name)
81860e46 1054 (let ((name buffer-file-name)
81860e46
RS
1055 (keep-going t))
1056 ;; Remove backup-suffixes from file name.
1057 (setq name (file-name-sans-versions name))
1058 (while keep-going
1059 (setq keep-going nil)
1060 (let ((alist auto-mode-alist)
1061 (mode nil))
1062 ;; Find first matching alist entry.
64ce1458
KH
1063 (let ((case-fold-search
1064 (memq system-type '(vax-vms windows-nt))))
f4a0f59b
RS
1065 (while (and (not mode) alist)
1066 (if (string-match (car (car alist)) name)
1067 (if (and (consp (cdr (car alist)))
1068 (nth 2 (car alist)))
1069 (progn
1070 (setq mode (car (cdr (car alist)))
1071 name (substring name 0 (match-beginning 0))
1072 keep-going t))
1073 (setq mode (cdr (car alist))
1074 keep-going nil)))
1075 (setq alist (cdr alist))))
c907d156
RS
1076 (if mode
1077 (funcall mode)
1078 ;; If we can't deduce a mode from the file name,
1079 ;; look for an interpreter specified in the first line.
1080 (let ((interpreter
1081 (save-excursion
1082 (goto-char (point-min))
e3998da1
RS
1083 (if (looking-at "#! *\\([^ \t\n]+\\)")
1084 (buffer-substring (match-beginning 1)
1085 (match-end 1))
c907d156
RS
1086 "")))
1087 elt)
1088 ;; Map interpreter name to a mode.
1089 (setq elt (assoc (file-name-nondirectory interpreter)
1090 interpreter-mode-alist))
1091 (if elt
1092 (funcall (cdr elt))))))))))))
b4da00e9 1093
f3e23606
RS
1094(defun hack-local-variables-prop-line ()
1095 ;; Set local variables specified in the -*- line.
9fa7bfe5
RS
1096 ;; Ignore any specification for `mode:';
1097 ;; set-auto-mode should already have handled that.
f3e23606
RS
1098 (save-excursion
1099 (goto-char (point-min))
13a66180
KH
1100 (let ((result nil)
1101 (end (save-excursion (end-of-line (and (looking-at "^#!") 2)) (point))))
f3e23606
RS
1102 ;; Parse the -*- line into the `result' alist.
1103 (cond ((not (search-forward "-*-" end t))
1104 ;; doesn't have one.
1105 nil)
1106 ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
13a66180
KH
1107 ;; Simple form: "-*- MODENAME -*-". Already handled.
1108 nil)
f3e23606
RS
1109 (t
1110 ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
1111 ;; (last ";" is optional).
1112 (save-excursion
1113 (if (search-forward "-*-" end t)
1114 (setq end (- (point) 3))
1115 (error "-*- not terminated before end of line")))
1116 (while (< (point) end)
1117 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
1118 (error "malformed -*- line"))
1119 (goto-char (match-end 0))
1c26a6f3
KH
1120 ;; There used to be a downcase here,
1121 ;; but the manual didn't say so,
1122 ;; and people want to set var names that aren't all lc.
1123 (let ((key (intern (buffer-substring
1124 (match-beginning 1)
1125 (match-end 1))))
f3e23606
RS
1126 (val (save-restriction
1127 (narrow-to-region (point) end)
1128 (read (current-buffer)))))
13a66180
KH
1129 (or (eq key 'mode)
1130 (setq result (cons (cons key val) result)))
f3e23606
RS
1131 (skip-chars-forward " \t;")))
1132 (setq result (nreverse result))))
f3e23606
RS
1133
1134 (if (and result
1135 (or (eq enable-local-variables t)
1136 (and enable-local-variables
1137 (save-window-excursion
6f931919
RS
1138 (condition-case nil
1139 (switch-to-buffer (current-buffer))
1140 (error
1141 ;; If we fail to switch in the selected window,
1142 ;; it is probably a minibuffer.
1143 ;; So try another window.
1144 (condition-case nil
1145 (switch-to-buffer-other-window (current-buffer))
1146 (error
1147 (switch-to-buffer-other-frame (current-buffer))))))
f3e23606
RS
1148 (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
1149 (file-name-nondirectory buffer-file-name)))))))
1150 (while result
13a66180 1151 (hack-one-local-variable (car (car result)) (cdr (car result)))
9fa7bfe5 1152 (setq result (cdr result)))))))
f3e23606 1153
1d517019
RS
1154(defvar hack-local-variables-hook nil
1155 "Normal hook run after processing a file's local variables specs.
1156Major modes can use this to examine user-specified local variables
1157in order to initialize other data structure based on them.")
1158
7b3f3dc2 1159(defun hack-local-variables ()
5792c834 1160 "Parse and put into effect this buffer's local variables spec."
f3e23606 1161 (hack-local-variables-prop-line)
b4da00e9
RM
1162 ;; Look for "Local variables:" line in last page.
1163 (save-excursion
1164 (goto-char (point-max))
1165 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
1166 (if (let ((case-fold-search t))
1167 (and (search-forward "Local Variables:" nil t)
7b3f3dc2 1168 (or (eq enable-local-variables t)
b4da00e9
RM
1169 (and enable-local-variables
1170 (save-window-excursion
1171 (switch-to-buffer (current-buffer))
1172 (save-excursion
1173 (beginning-of-line)
1174 (set-window-start (selected-window) (point)))
1175 (y-or-n-p (format "Set local variables as specified at end of %s? "
51de78c1
RS
1176 (if buffer-file-name
1177 (file-name-nondirectory
1178 buffer-file-name)
1179 (concat "buffer "
1180 (buffer-name))))))))))
b4da00e9 1181 (let ((continue t)
2bba782c
RS
1182 prefix prefixlen suffix beg
1183 (enable-local-eval enable-local-eval))
b4da00e9
RM
1184 ;; The prefix is what comes before "local variables:" in its line.
1185 ;; The suffix is what comes after "local variables:" in its line.
1186 (skip-chars-forward " \t")
1187 (or (eolp)
1188 (setq suffix (buffer-substring (point)
1189 (progn (end-of-line) (point)))))
1190 (goto-char (match-beginning 0))
1191 (or (bolp)
1192 (setq prefix
1193 (buffer-substring (point)
1194 (progn (beginning-of-line) (point)))))
7b3f3dc2 1195
b4da00e9
RM
1196 (if prefix (setq prefixlen (length prefix)
1197 prefix (regexp-quote prefix)))
1198 (if suffix (setq suffix (concat (regexp-quote suffix) "$")))
1199 (while continue
1200 ;; Look at next local variable spec.
1201 (if selective-display (re-search-forward "[\n\C-m]")
1202 (forward-line 1))
1203 ;; Skip the prefix, if any.
1204 (if prefix
1205 (if (looking-at prefix)
1206 (forward-char prefixlen)
1207 (error "Local variables entry is missing the prefix")))
1208 ;; Find the variable name; strip whitespace.
1209 (skip-chars-forward " \t")
1210 (setq beg (point))
1211 (skip-chars-forward "^:\n")
1212 (if (eolp) (error "Missing colon in local variables entry"))
1213 (skip-chars-backward " \t")
1214 (let* ((str (buffer-substring beg (point)))
1215 (var (read str))
1216 val)
1217 ;; Setting variable named "end" means end of list.
1218 (if (string-equal (downcase str) "end")
1219 (setq continue nil)
1220 ;; Otherwise read the variable value.
1221 (skip-chars-forward "^:")
1222 (forward-char 1)
1223 (setq val (read (current-buffer)))
1224 (skip-chars-backward "\n")
1225 (skip-chars-forward " \t")
1226 (or (if suffix (looking-at suffix) (eolp))
1227 (error "Local variables entry is terminated incorrectly"))
1228 ;; Set the variable. "Variables" mode and eval are funny.
1d517019
RS
1229 (hack-one-local-variable var val)))))))
1230 (run-hooks 'hack-local-variables-hook))
f3e23606
RS
1231
1232(defconst ignored-local-variables
1233 '(enable-local-eval)
1234 "Variables to be ignored in a file's local variable spec.")
1235
be0218a8 1236;; Get confirmation before setting these variables as locals in a file.
05ef1cda 1237(put 'debugger 'risky-local-variable t)
f6fa3ee3 1238(put 'enable-local-eval 'risky-local-variable t)
fce47eea 1239(put 'ignored-local-variables 'risky-local-variable t)
be0218a8
RS
1240(put 'eval 'risky-local-variable t)
1241(put 'file-name-handler-alist 'risky-local-variable t)
1242(put 'minor-mode-map-alist 'risky-local-variable t)
1243(put 'after-load-alist 'risky-local-variable t)
f6fa3ee3
RS
1244(put 'buffer-file-name 'risky-local-variable t)
1245(put 'buffer-auto-save-file-name 'risky-local-variable t)
1246(put 'buffer-file-truename 'risky-local-variable t)
b0ffcc0d
RS
1247(put 'exec-path 'risky-local-variable t)
1248(put 'load-path 'risky-local-variable t)
1249(put 'exec-directory 'risky-local-variable t)
1250(put 'process-environment 'risky-local-variable t)
9afa8bf7
RS
1251;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode.
1252(put 'outline-level 'risky-local-variable t)
d98b741d 1253(put 'rmail-output-file-alist 'risky-local-variable t)
f6fa3ee3 1254
6672c42b
RS
1255;; This one is safe because the user gets to check it before it is used.
1256(put 'compile-command 'safe-local-variable t)
1257
d0bd3513
RS
1258(defun hack-one-local-variable-quotep (exp)
1259 (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
1260
f3e23606
RS
1261;; "Set" one variable in a local variables spec.
1262;; A few variable names are treated specially.
1263(defun hack-one-local-variable (var val)
1264 (cond ((eq var 'mode)
1265 (funcall (intern (concat (downcase (symbol-name val))
1266 "-mode"))))
1267 ((memq var ignored-local-variables)
1268 nil)
1269 ;; "Setting" eval means either eval it or do nothing.
7d3221d7 1270 ;; Likewise for setting hook variables.
be0218a8 1271 ((or (get var 'risky-local-variable)
6672c42b
RS
1272 (and
1273 (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$"
1274 (symbol-name var))
1275 (not (get var 'safe-local-variable))))
d0bd3513
RS
1276 ;; Permit evaling a put of a harmless property
1277 ;; if the args do nothing tricky.
1278 (if (or (and (eq var 'eval)
1279 (consp val)
1280 (eq (car val) 'put)
1281 (hack-one-local-variable-quotep (nth 1 val))
1282 (hack-one-local-variable-quotep (nth 2 val))
1283 ;; Only allow safe values of lisp-indent-hook;
1284 ;; not functions.
1285 (or (numberp (nth 3 val))
dc417415 1286 (equal (nth 3 val) ''defun))
d0bd3513
RS
1287 (memq (nth 1 (nth 2 val))
1288 '(lisp-indent-hook)))
1289 ;; Permit eval if not root and user says ok.
c7e62660 1290 (and (not (zerop (user-uid)))
d0bd3513
RS
1291 (or (eq enable-local-eval t)
1292 (and enable-local-eval
1293 (save-window-excursion
1294 (switch-to-buffer (current-buffer))
1295 (save-excursion
1296 (beginning-of-line)
1297 (set-window-start (selected-window) (point)))
1298 (setq enable-local-eval
1299 (y-or-n-p (format "Process `eval' or hook local variables in file %s? "
1300 (file-name-nondirectory buffer-file-name)))))))))
7d3221d7
RS
1301 (if (eq var 'eval)
1302 (save-excursion (eval val))
1303 (make-local-variable var)
1304 (set var val))
f3e23606
RS
1305 (message "Ignoring `eval:' in file's local variables")))
1306 ;; Ordinary variable, really set it.
1307 (t (make-local-variable var)
1308 (set var val))))
1309
b4da00e9
RM
1310\f
1311(defun set-visited-file-name (filename)
1312 "Change name of file visited in current buffer to FILENAME.
1313The next time the buffer is saved it will go in the newly specified file.
1314nil or empty string as argument means make buffer not be visiting any file.
1315Remember to delete the initial contents of the minibuffer
1316if you wish to pass an empty string as the argument."
1317 (interactive "FSet visited file name: ")
c11a94fe
RS
1318 (if (buffer-base-buffer)
1319 (error "An indirect buffer cannot visit a file"))
a522e5bf
RS
1320 (let (truename)
1321 (if filename
1322 (setq filename
1323 (if (string-equal filename "")
1324 nil
1325 (expand-file-name filename))))
1326 (if filename
1327 (progn
1328 (setq truename (file-truename filename))
1329 (if find-file-visit-truename
1330 ;; Do not use the abbreviated filename, because
1331 ;; write-region will reset it to the expanded filename
1332 (setq filename truename))))
1333 (or (equal filename buffer-file-name)
1334 (progn
1335 (and filename (lock-buffer filename))
1336 (unlock-buffer)))
1337 (setq buffer-file-name filename)
1338 (if filename ; make buffer name reflect filename.
1339 (let ((new-name (file-name-nondirectory buffer-file-name)))
1340 (if (string= new-name "")
1341 (error "Empty file name"))
1342 (if (eq system-type 'vax-vms)
1343 (setq new-name (downcase new-name)))
1344 (setq default-directory (file-name-directory buffer-file-name))
1345 (or (string= new-name (buffer-name))
1346 (rename-buffer new-name t))))
1347 (setq buffer-backed-up nil)
1348 (clear-visited-file-modtime)
4826e97f
RS
1349 (if truename
1350 (setq buffer-file-truename (abbreviate-file-name truename)))
a522e5bf
RS
1351 (setq buffer-file-number
1352 (if filename
1353 (nth 10 (file-attributes buffer-file-name))
1354 nil)))
b4da00e9
RM
1355 ;; write-file-hooks is normally used for things like ftp-find-file
1356 ;; that visit things that are not local files as if they were files.
1357 ;; Changing to visit an ordinary local file instead should flush the hook.
1358 (kill-local-variable 'write-file-hooks)
c9dca4e0 1359 (kill-local-variable 'local-write-file-hooks)
b4da00e9
RM
1360 (kill-local-variable 'revert-buffer-function)
1361 (kill-local-variable 'backup-inhibited)
ee81c959
RS
1362 ;; If buffer was read-only because of version control,
1363 ;; that reason is gone now, so make it writable.
1364 (if vc-mode
1365 (setq buffer-read-only nil))
1366 (kill-local-variable 'vc-mode)
b4da00e9
RM
1367 ;; Turn off backup files for certain file names.
1368 ;; Since this is a permanent local, the major mode won't eliminate it.
1369 (and (not (funcall backup-enable-predicate buffer-file-name))
1370 (progn
1371 (make-local-variable 'backup-inhibited)
1372 (setq backup-inhibited t)))
c77a81cf
RS
1373 (let ((oauto buffer-auto-save-file-name))
1374 ;; If auto-save was not already on, turn it on if appropriate.
1375 (if (not buffer-auto-save-file-name)
1376 (and buffer-file-name auto-save-default
1377 (auto-save-mode t))
1378 ;; If auto save is on, start using a new name.
1379 ;; We deliberately don't rename or delete the old auto save
1380 ;; for the old visited file name. This is because perhaps
1381 ;; the user wants to save the new state and then compare with the
1382 ;; previous state from the auto save file.
1383 (setq buffer-auto-save-file-name
1384 (make-auto-save-file-name)))
1385 ;; Rename the old auto save file if any.
1386 (and oauto buffer-auto-save-file-name
e6f0e76c 1387 (file-exists-p oauto)
c77a81cf 1388 (rename-file oauto buffer-auto-save-file-name t)))
b4da00e9
RM
1389 (if buffer-file-name
1390 (set-buffer-modified-p t)))
1391
c2fb8488 1392(defun write-file (filename &optional confirm)
b4da00e9 1393 "Write current buffer into file FILENAME.
41f48cb1
RS
1394Makes buffer visit that file, and marks it not modified.
1395If the buffer is already visiting a file, you can specify
1396a directory name as FILENAME, to write a file of the same
c2fb8488
RS
1397old name in that directory.
1398If optional second arg CONFIRM is non-nil,
1399ask for confirmation for overwriting an existing file."
b4da00e9
RM
1400;; (interactive "FWrite file: ")
1401 (interactive
1402 (list (if buffer-file-name
1403 (read-file-name "Write file: "
1404 nil nil nil nil)
1405 (read-file-name "Write file: "
1406 (cdr (assq 'default-directory
1407 (buffer-local-variables)))
c2fb8488
RS
1408 nil nil (buffer-name)))
1409 t))
b4da00e9 1410 (or (null filename) (string-equal filename "")
41f48cb1
RS
1411 (progn
1412 ;; If arg is just a directory,
1413 ;; use same file name, but in that directory.
1414 (if (and (file-directory-p filename) buffer-file-name)
1415 (setq filename (concat (file-name-as-directory filename)
1416 (file-name-nondirectory buffer-file-name))))
c2fb8488
RS
1417 (and confirm
1418 (file-exists-p filename)
1419 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
1420 (error "Canceled")))
41f48cb1 1421 (set-visited-file-name filename)))
b4da00e9
RM
1422 (set-buffer-modified-p t)
1423 (save-buffer))
1424\f
1425(defun backup-buffer ()
1426 "Make a backup of the disk file visited by the current buffer, if appropriate.
1427This is normally done before saving the buffer the first time.
1428If the value is non-nil, it is the result of `file-modes' on the original
1429file; this means that the caller, after saving the buffer, should change
1430the modes of the new file to agree with the old modes."
1431 (if (and make-backup-files (not backup-inhibited)
1432 (not buffer-backed-up)
1433 (file-exists-p buffer-file-name)
1434 (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
1435 '(?- ?l)))
1436 (let ((real-file-name buffer-file-name)
1437 backup-info backupname targets setmodes)
1438 ;; If specified name is a symbolic link, chase it to the target.
1439 ;; Thus we make the backups in the directory where the real file is.
5dadeb29 1440 (setq real-file-name (file-chase-links real-file-name))
b4da00e9
RM
1441 (setq backup-info (find-backup-file-name real-file-name)
1442 backupname (car backup-info)
1443 targets (cdr backup-info))
1444;;; (if (file-directory-p buffer-file-name)
1445;;; (error "Cannot save buffer in directory %s" buffer-file-name))
eb650569
RS
1446 (if backup-info
1447 (condition-case ()
1448 (let ((delete-old-versions
1449 ;; If have old versions to maybe delete,
1450 ;; ask the user to confirm now, before doing anything.
1451 ;; But don't actually delete til later.
1452 (and targets
1453 (or (eq delete-old-versions t) (eq delete-old-versions nil))
1454 (or delete-old-versions
1455 (y-or-n-p (format "Delete excess backup versions of %s? "
1456 real-file-name))))))
1457 ;; Actually write the back up file.
1458 (condition-case ()
1459 (if (or file-precious-flag
1460 ; (file-symlink-p buffer-file-name)
1461 backup-by-copying
1462 (and backup-by-copying-when-linked
1463 (> (file-nlinks real-file-name) 1))
1464 (and backup-by-copying-when-mismatch
1465 (let ((attr (file-attributes real-file-name)))
1466 (or (nth 9 attr)
1467 (not (file-ownership-preserved-p real-file-name))))))
1468 (condition-case ()
1469 (copy-file real-file-name backupname t t)
1470 (file-error
1471 ;; If copying fails because file BACKUPNAME
1472 ;; is not writable, delete that file and try again.
1473 (if (and (file-exists-p backupname)
1474 (not (file-writable-p backupname)))
1475 (delete-file backupname))
1476 (copy-file real-file-name backupname t t)))
1477 ;; rename-file should delete old backup.
1478 (rename-file real-file-name backupname t)
1479 (setq setmodes (file-modes backupname)))
1480 (file-error
1481 ;; If trouble writing the backup, write it in ~.
1482 (setq backupname (expand-file-name "~/%backup%~"))
1483 (message "Cannot write backup file; backing up in ~/%%backup%%~")
1484 (sleep-for 1)
1485 (condition-case ()
1486 (copy-file real-file-name backupname t t)
1487 (file-error
1488 ;; If copying fails because file BACKUPNAME
1489 ;; is not writable, delete that file and try again.
1490 (if (and (file-exists-p backupname)
1491 (not (file-writable-p backupname)))
1492 (delete-file backupname))
1493 (copy-file real-file-name backupname t t)))))
1494 (setq buffer-backed-up t)
1495 ;; Now delete the old versions, if desired.
1496 (if delete-old-versions
1497 (while targets
1498 (condition-case ()
1499 (delete-file (car targets))
1500 (file-error nil))
1501 (setq targets (cdr targets))))
1502 setmodes)
1503 (file-error nil))))))
b4da00e9 1504
c3554e95 1505(defun file-name-sans-versions (name &optional keep-backup-version)
b4da00e9
RM
1506 "Return FILENAME sans backup versions or strings.
1507This is a separate procedure so your site-init or startup file can
c3554e95
RS
1508redefine it.
1509If the optional argument KEEP-BACKUP-VERSION is non-nil,
1510we do not remove backup version numbers, only true file version numbers."
6eaebaa2 1511 (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
c3554e95
RS
1512 (if handler
1513 (funcall handler 'file-name-sans-versions name keep-backup-version)
1514 (substring name 0
1515 (if (eq system-type 'vax-vms)
1516 ;; VMS version number is (a) semicolon, optional
1517 ;; sign, zero or more digits or (b) period, option
1518 ;; sign, zero or more digits, provided this is the
1519 ;; second period encountered outside of the
1520 ;; device/directory part of the file name.
26add1bf
KH
1521 (or (string-match ";[-+]?[0-9]*\\'" name)
1522 (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'"
c3554e95
RS
1523 name)
1524 (match-beginning 1))
1525 (length name))
1526 (if keep-backup-version
1527 (length name)
dbb12f2c 1528 (or (string-match "\\.~[0-9.]+~\\'" name)
c3554e95
RS
1529 (string-match "~\\'" name)
1530 (length name))))))))
b4da00e9 1531
cb0cd911
RS
1532(defun file-ownership-preserved-p (file)
1533 "Returns t if deleting FILE and rewriting it would preserve the owner."
1534 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
1535 (if handler
1536 (funcall handler 'file-ownership-preserved-p file)
ec5533be 1537 (let ((attributes (file-attributes file)))
306faa42
RS
1538 ;; Return t if the file doesn't exist, since it's true that no
1539 ;; information would be lost by an (attempted) delete and create.
1540 (or (null attributes)
1541 (= (nth 2 attributes) (user-uid)))))))
cb0cd911 1542
20b5d24c
RS
1543(defun file-name-sans-extension (filename)
1544 "Return FILENAME sans final \"extension\".
1545The extension, in a file name, is the part that follows the last `.'."
1546 (save-match-data
1547 (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
1548 directory)
1549 (if (string-match "\\.[^.]*\\'" file)
1550 (if (setq directory (file-name-directory filename))
1551 (expand-file-name (substring file 0 (match-beginning 0))
1552 directory)
1553 (substring file 0 (match-beginning 0)))
1554 filename))))
1555
b4da00e9
RM
1556(defun make-backup-file-name (file)
1557 "Create the non-numeric backup file name for FILE.
1558This is a separate function so you can redefine it for customization."
bb157910
RS
1559 (if (eq system-type 'ms-dos)
1560 (let ((fn (file-name-nondirectory file)))
1561 (concat (file-name-directory file)
1562 (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
1563 (substring fn 0 (match-end 1)))
1564 ".bak"))
1565 (concat file "~")))
b4da00e9
RM
1566
1567(defun backup-file-name-p (file)
1568 "Return non-nil if FILE is a backup file name (numeric or not).
1569This is a separate function so you can redefine it for customization.
1570You may need to redefine `file-name-sans-versions' as well."
bb157910
RS
1571 (if (eq system-type 'ms-dos)
1572 (string-match "\\.bak$" file)
1573 (string-match "~$" file)))
b4da00e9 1574
2d051399
RS
1575;; This is used in various files.
1576;; The usage of bv-length is not very clean,
1577;; but I can't see a good alternative,
1578;; so as of now I am leaving it alone.
1579(defun backup-extract-version (fn)
1580 "Given the name of a numeric backup file, return the backup number.
1581Uses the free variable `bv-length', whose value should be
1582the index in the name where the version number begins."
1583 (if (and (string-match "[0-9]+~$" fn bv-length)
1584 (= (match-beginning 0) bv-length))
1585 (string-to-int (substring fn bv-length -1))
1586 0))
1587
b4da00e9
RM
1588;; I believe there is no need to alter this behavior for VMS;
1589;; since backup files are not made on VMS, it should not get called.
1590(defun find-backup-file-name (fn)
1591 "Find a file name for a backup file, and suggestions for deletions.
1592Value is a list whose car is the name for the backup file
eb650569
RS
1593 and whose cdr is a list of old versions to consider deleting now.
1594If the value is nil, don't make a backup."
1595 (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
1596 ;; Run a handler for this function so that ange-ftp can refuse to do it.
1597 (if handler
1598 (funcall handler 'find-backup-file-name fn)
1599 (if (eq version-control 'never)
b4da00e9 1600 (list (make-backup-file-name fn))
eb650569
RS
1601 (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
1602 (bv-length (length base-versions))
1603 possibilities
1604 (versions nil)
1605 (high-water-mark 0)
1606 (deserve-versions-p nil)
1607 (number-to-delete 0))
1608 (condition-case ()
1609 (setq possibilities (file-name-all-completions
1610 base-versions
1611 (file-name-directory fn))
1612 versions (sort (mapcar
1613 (function backup-extract-version)
1614 possibilities)
1615 '<)
1616 high-water-mark (apply 'max 0 versions)
1617 deserve-versions-p (or version-control
1618 (> high-water-mark 0))
1619 number-to-delete (- (length versions)
1620 kept-old-versions kept-new-versions -1))
1621 (file-error
1622 (setq possibilities nil)))
1623 (if (not deserve-versions-p)
1624 (list (make-backup-file-name fn))
1625 (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
1626 (if (and (> number-to-delete 0)
1627 ;; Delete nothing if there is overflow
1628 ;; in the number of versions to keep.
1629 (>= (+ kept-new-versions kept-old-versions -1) 0))
1630 (mapcar (function (lambda (n)
1631 (concat fn ".~" (int-to-string n) "~")))
1632 (let ((v (nthcdr kept-old-versions versions)))
1633 (rplacd (nthcdr (1- number-to-delete) v) ())
1634 v))))))))))
b4da00e9 1635
b4da00e9
RM
1636(defun file-nlinks (filename)
1637 "Return number of names file FILENAME has."
1638 (car (cdr (file-attributes filename))))
6c636af9
RM
1639
1640(defun file-relative-name (filename &optional directory)
1641 "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
1642 (setq filename (expand-file-name filename)
77fb6aed
RS
1643 directory (file-name-as-directory (expand-file-name
1644 (or directory default-directory))))
b1fa544f
KH
1645 (let ((ancestor ""))
1646 (while (not (string-match (concat "^" (regexp-quote directory)) filename))
1647 (setq directory (file-name-directory (substring directory 0 -1))
1648 ancestor (concat "../" ancestor)))
1649 (concat ancestor (substring filename (match-end 0)))))
b4da00e9
RM
1650\f
1651(defun save-buffer (&optional args)
1652 "Save current buffer in visited file if modified. Versions described below.
1653By default, makes the previous version into a backup file
1654 if previously requested or if this is the first save.
1655With 1 or 3 \\[universal-argument]'s, marks this version
1656 to become a backup when the next save is done.
1657With 2 or 3 \\[universal-argument]'s,
1658 unconditionally makes the previous version into a backup file.
1659With argument of 0, never makes the previous version into a backup file.
1660
1661If a file's name is FOO, the names of its numbered backup versions are
1662 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
1663Numeric backups (rather than FOO~) will be made if value of
1664 `version-control' is not the atom `never' and either there are already
1665 numeric versions of the file being backed up, or `version-control' is
1666 non-nil.
1667We don't want excessive versions piling up, so there are variables
1668 `kept-old-versions', which tells Emacs how many oldest versions to keep,
1669 and `kept-new-versions', which tells how many newest versions to keep.
1670 Defaults are 2 old versions and 2 new.
1671`dired-kept-versions' controls dired's clean-directory (.) command.
de7d5e1b 1672If `delete-old-versions' is nil, system will query user
b4da00e9
RM
1673 before trimming versions. Otherwise it does it silently."
1674 (interactive "p")
1675 (let ((modp (buffer-modified-p))
1676 (large (> (buffer-size) 50000))
b5a8e0fc
RS
1677 (make-backup-files (or (and make-backup-files (not (eq args 0)))
1678 (memq args '(16 64)))))
b4da00e9
RM
1679 (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
1680 (if (and modp large) (message "Saving file %s..." (buffer-file-name)))
1681 (basic-save-buffer)
1682 (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
1683
1684(defun delete-auto-save-file-if-necessary (&optional force)
1685 "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
1686Normally delete only if the file was written by this Emacs since
1687the last real save, but optional arg FORCE non-nil means delete anyway."
1688 (and buffer-auto-save-file-name delete-auto-save-files
1689 (not (string= buffer-file-name buffer-auto-save-file-name))
1690 (or force (recent-auto-save-p))
1691 (progn
1692 (condition-case ()
1693 (delete-file buffer-auto-save-file-name)
1694 (file-error nil))
1695 (set-buffer-auto-saved))))
1696
1cc852cc
RS
1697(defvar after-save-hook nil
1698 "Normal hook that is run after a buffer is saved to its file.")
1699
b4da00e9 1700(defun basic-save-buffer ()
1cc852cc
RS
1701 "Save the current buffer in its visited file, if it has been modified.
1702After saving the buffer, run `after-save-hook'."
b4da00e9 1703 (interactive)
c11a94fe
RS
1704 (save-excursion
1705 ;; In an indirect buffer, save its base buffer instead.
1706 (if (buffer-base-buffer)
1707 (set-buffer (buffer-base-buffer)))
1708 (if (buffer-modified-p)
1709 (let ((recent-save (recent-auto-save-p))
1710 setmodes tempsetmodes)
1711 ;; On VMS, rename file and buffer to get rid of version number.
1712 (if (and (eq system-type 'vax-vms)
1713 (not (string= buffer-file-name
1714 (file-name-sans-versions buffer-file-name))))
1715 (let (buffer-new-name)
1716 ;; Strip VMS version number before save.
1717 (setq buffer-file-name
1718 (file-name-sans-versions buffer-file-name))
1719 ;; Construct a (unique) buffer name to correspond.
1720 (let ((buf (create-file-buffer (downcase buffer-file-name))))
1721 (setq buffer-new-name (buffer-name buf))
1722 (kill-buffer buf))
1723 (rename-buffer buffer-new-name)))
1724 ;; If buffer has no file name, ask user for one.
1725 (or buffer-file-name
182891ef
RS
1726 (let ((filename
1727 (expand-file-name
1728 (read-file-name "File to save in: ") nil)))
1729 (and (file-exists-p filename)
1730 (or (y-or-n-p (format "File `%s' exists; overwrite? "
1731 filename))
1732 (error "Canceled")))
1733 (set-visited-file-name filename)))
c11a94fe
RS
1734 (or (verify-visited-file-modtime (current-buffer))
1735 (not (file-exists-p buffer-file-name))
1736 (yes-or-no-p
1737 (format "%s has changed since visited or saved. Save anyway? "
1738 (file-name-nondirectory buffer-file-name)))
1739 (error "Save not confirmed"))
1740 (save-restriction
1741 (widen)
1742 (and (> (point-max) 1)
1743 (/= (char-after (1- (point-max))) ?\n)
1744 (not (and (eq selective-display t)
1745 (= (char-after (1- (point-max))) ?\r)))
1746 (or (eq require-final-newline t)
1747 (and require-final-newline
1748 (y-or-n-p
1749 (format "Buffer %s does not end in newline. Add one? "
1750 (buffer-name)))))
1751 (save-excursion
1752 (goto-char (point-max))
1753 (insert ?\n)))
1754 (or (run-hook-with-args-until-success 'write-contents-hooks)
1755 (run-hook-with-args-until-success 'local-write-file-hooks)
1756 (run-hook-with-args-until-success 'write-file-hooks)
1757 ;; If a hook returned t, file is already "written".
1758 ;; Otherwise, write it the usual way now.
1759 (setq setmodes (basic-save-buffer-1)))
1760 (setq buffer-file-number (nth 10 (file-attributes buffer-file-name)))
1761 (if setmodes
1762 (condition-case ()
1763 (set-file-modes buffer-file-name setmodes)
1764 (error nil))))
1765 ;; If the auto-save file was recent before this command,
1766 ;; delete it now.
1767 (delete-auto-save-file-if-necessary recent-save)
49530862
RS
1768 ;; Support VC `implicit' locking.
1769 (vc-after-save)
c11a94fe
RS
1770 (run-hooks 'after-save-hook))
1771 (message "(No changes need to be saved)"))))
b4da00e9 1772
87d26afc
RS
1773;; This does the "real job" of writing a buffer into its visited file
1774;; and making a backup file. This is what is normally done
1775;; but inhibited if one of write-file-hooks returns non-nil.
1776;; It returns a value to store in setmodes.
1777(defun basic-save-buffer-1 ()
1778 (let (tempsetmodes setmodes)
1779 (if (not (file-writable-p buffer-file-name))
1780 (let ((dir (file-name-directory buffer-file-name)))
1781 (if (not (file-directory-p dir))
1782 (error "%s is not a directory" dir)
1783 (if (not (file-exists-p buffer-file-name))
1784 (error "Directory %s write-protected" dir)
1785 (if (yes-or-no-p
1786 (format "File %s is write-protected; try to save anyway? "
1787 (file-name-nondirectory
1788 buffer-file-name)))
1789 (setq tempsetmodes t)
1790 (error "Attempt to save to a file which you aren't allowed to write"))))))
1791 (or buffer-backed-up
1792 (setq setmodes (backup-buffer)))
f4a0f59b
RS
1793 (let ((dir (file-name-directory buffer-file-name)))
1794 (if (and file-precious-flag
1795 (file-writable-p dir))
1796 ;; If file is precious, write temp name, then rename it.
1797 ;; This requires write access to the containing dir,
1798 ;; which is why we don't try it if we don't have that access.
1799 (let ((realname buffer-file-name)
6782610c
RS
1800 tempname temp nogood i succeed
1801 (old-modtime (visited-file-modtime)))
f4a0f59b
RS
1802 (setq i 0)
1803 (setq nogood t)
1804 ;; Find the temporary name to write under.
1805 (while nogood
1806 (setq tempname (format "%s#tmp#%d" dir i))
1807 (setq nogood (file-exists-p tempname))
1808 (setq i (1+ i)))
1809 (unwind-protect
1810 (progn (clear-visited-file-modtime)
1811 (write-region (point-min) (point-max)
89095962
RS
1812 tempname nil realname
1813 buffer-file-truename)
f4a0f59b
RS
1814 (setq succeed t))
1815 ;; If writing the temp file fails,
1816 ;; delete the temp file.
6782610c
RS
1817 (or succeed
1818 (progn
1819 (delete-file tempname)
1820 (set-visited-file-modtime old-modtime))))
f4a0f59b
RS
1821 ;; Since we have created an entirely new file
1822 ;; and renamed it, make sure it gets the
1823 ;; right permission bits set.
1824 (setq setmodes (file-modes buffer-file-name))
1825 ;; We succeeded in writing the temp file,
1826 ;; so rename it.
1827 (rename-file tempname buffer-file-name t))
1828 ;; If file not writable, see if we can make it writable
1829 ;; temporarily while we write it.
1830 ;; But no need to do so if we have just backed it up
1831 ;; (setmodes is set) because that says we're superseding.
1832 (cond ((and tempsetmodes (not setmodes))
1833 ;; Change the mode back, after writing.
1834 (setq setmodes (file-modes buffer-file-name))
1835 (set-file-modes buffer-file-name 511)))
1836 (write-region (point-min) (point-max)
89095962 1837 buffer-file-name nil t buffer-file-truename)))
87d26afc
RS
1838 setmodes))
1839
b4da00e9
RM
1840(defun save-some-buffers (&optional arg exiting)
1841 "Save some modified file-visiting buffers. Asks user about each one.
5bbbceb1
JB
1842Optional argument (the prefix) non-nil means save all with no questions.
1843Optional second argument EXITING means ask about certain non-file buffers
1844 as well as about file buffers."
b4da00e9 1845 (interactive "P")
907482b9 1846 (save-window-excursion
5625c2fc
RS
1847 (let ((files-done
1848 (map-y-or-n-p
1849 (function
1850 (lambda (buffer)
1851 (and (buffer-modified-p buffer)
c11a94fe 1852 (not (buffer-base-buffer buffer))
5625c2fc
RS
1853 (or
1854 (buffer-file-name buffer)
1855 (and exiting
1856 (progn
1857 (set-buffer buffer)
1858 (and buffer-offer-save (> (buffer-size) 0)))))
1859 (if arg
1860 t
1861 (if (buffer-file-name buffer)
1862 (format "Save file %s? "
1863 (buffer-file-name buffer))
1864 (format "Save buffer %s? "
1865 (buffer-name buffer)))))))
1866 (function
1867 (lambda (buffer)
1868 (set-buffer buffer)
1869 (save-buffer)))
1870 (buffer-list)
1871 '("buffer" "buffers" "save")
1872 (list (list ?\C-r (lambda (buf)
1873 (view-buffer buf)
1874 (setq view-exit-action
1875 '(lambda (ignore)
1876 (exit-recursive-edit)))
1877 (recursive-edit)
1878 ;; Return nil to ask about BUF again.
1879 nil)
1880 "display the current buffer"))))
1881 (abbrevs-done
1882 (and save-abbrevs abbrevs-changed
1883 (progn
1884 (if (or arg
1885 (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
1886 (write-abbrev-file nil))
1887 ;; Don't keep bothering user if he says no.
1888 (setq abbrevs-changed nil)
1889 t))))
1890 (or (> files-done 0) abbrevs-done
1891 (message "(No files need saving)")))))
b4da00e9
RM
1892\f
1893(defun not-modified (&optional arg)
1894 "Mark current buffer as unmodified, not needing to be saved.
a641f9a1
RM
1895With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
1896
1897It is not a good idea to use this function in Lisp programs, because it
1898prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
b4da00e9
RM
1899 (interactive "P")
1900 (message (if arg "Modification-flag set"
1901 "Modification-flag cleared"))
1902 (set-buffer-modified-p arg))
1903
1904(defun toggle-read-only (&optional arg)
1905 "Change whether this buffer is visiting its file read-only.
1906With arg, set read-only iff arg is positive."
1907 (interactive "P")
1908 (setq buffer-read-only
1909 (if (null arg)
1910 (not buffer-read-only)
1911 (> (prefix-numeric-value arg) 0)))
3941fe2c 1912 (force-mode-line-update))
b4da00e9
RM
1913
1914(defun insert-file (filename)
1915 "Insert contents of file FILENAME into buffer after point.
1916Set mark after the inserted text.
1917
1918This function is meant for the user to run interactively.
1919Don't call it from programs! Use `insert-file-contents' instead.
1920\(Its calling sequence is different; see its documentation)."
6f931919 1921 (interactive "*fInsert file: ")
3be6243a
RS
1922 (if (file-directory-p filename)
1923 (signal 'file-error (list "Opening input file" "file is a directory"
1924 filename)))
b4da00e9
RM
1925 (let ((tem (insert-file-contents filename)))
1926 (push-mark (+ (point) (car (cdr tem))))))
1927
1928(defun append-to-file (start end filename)
1929 "Append the contents of the region to the end of file FILENAME.
1930When called from a function, expects three arguments,
1931START, END and FILENAME. START and END are buffer positions
1932saying what text to write."
1933 (interactive "r\nFAppend to file: ")
1934 (write-region start end filename t))
1935
1936(defun file-newest-backup (filename)
1937 "Return most recent backup file for FILENAME or nil if no backups exist."
1938 (let* ((filename (expand-file-name filename))
1939 (file (file-name-nondirectory filename))
1940 (dir (file-name-directory filename))
1941 (comp (file-name-all-completions file dir))
1942 newest)
1943 (while comp
1944 (setq file (concat dir (car comp))
1945 comp (cdr comp))
1946 (if (and (backup-file-name-p file)
1947 (or (null newest) (file-newer-than-file-p file newest)))
1948 (setq newest file)))
1949 newest))
1950
1951(defun rename-uniquely ()
1952 "Rename current buffer to a similar name not already taken.
1953This function is useful for creating multiple shell process buffers
1954or multiple mail buffers, etc."
1955 (interactive)
40eb8038 1956 (save-match-data
ed34f320
RS
1957 (let* ((base-name (if (and (string-match "<[0-9]+>\\'" (buffer-name))
1958 (not (and buffer-file-name
1959 (string= (buffer-name)
1960 (file-name-nondirectory
1961 buffer-file-name)))))
1962 ;; If the existing buffer name has a <NNN>,
1963 ;; which isn't part of the file name (if any),
1964 ;; then get rid of that.
40eb8038
RS
1965 (substring (buffer-name) 0 (match-beginning 0))
1966 (buffer-name)))
1967 (new-buf (generate-new-buffer base-name))
1968 (name (buffer-name new-buf)))
1969 (kill-buffer new-buf)
1970 (rename-buffer name)
3941fe2c 1971 (force-mode-line-update))))
5bbbceb1 1972
4e43240a 1973(defun make-directory (dir &optional parents)
5ce8bb89
RS
1974 "Create the directory DIR and any nonexistent parent dirs.
1975Interactively, the default choice of directory to create
1976is the current default directory for file names.
1977That is useful when you have visited a file in a nonexistint directory.
1978
1979Noninteractively, the second (optional) argument PARENTS says whether
1980to create parent directories if they don't exist."
1981 (interactive
1982 (list (read-file-name "Make directory: " default-directory default-directory
1983 nil nil)
1984 t))
6eaebaa2 1985 (let ((handler (find-file-name-handler dir 'make-directory)))
4e43240a
RS
1986 (if handler
1987 (funcall handler 'make-directory dir parents)
1988 (if (not parents)
1989 (make-directory-internal dir)
1990 (let ((dir (directory-file-name (expand-file-name dir)))
1991 create-list)
1992 (while (not (file-exists-p dir))
1993 (setq create-list (cons dir create-list)
1994 dir (directory-file-name (file-name-directory dir))))
1995 (while create-list
1996 (make-directory-internal (car create-list))
1997 (setq create-list (cdr create-list))))))))
b4da00e9
RM
1998\f
1999(put 'revert-buffer-function 'permanent-local t)
2000(defvar revert-buffer-function nil
0973d78b
RS
2001 "Function to use to revert this buffer, or nil to do the default.
2002The function receives two arguments IGNORE-AUTO and NOCONFIRM,
2003which are the arguments that `revert-buffer' received.")
b4da00e9
RM
2004
2005(put 'revert-buffer-insert-file-contents-function 'permanent-local t)
2006(defvar revert-buffer-insert-file-contents-function nil
2007 "Function to use to insert contents when reverting this buffer.
2008Gets two args, first the nominal file name to use,
2009and second, t if reading the auto-save file.")
2010
5f76e7d4
KH
2011(defvar before-revert-hook nil
2012 "Normal hook for `revert-buffer' to run before reverting.
2013If `revert-buffer-function' is used to override the normal revert
2014mechanism, this hook is not used.")
2015
2016(defvar after-revert-hook nil
2017 "Normal hook for `revert-buffer' to run after reverting.
2018Note that the hook value that it runs is the value that was in effect
2019before reverting; that makes a difference if you have buffer-local
2020hook functions.
2021
2022If `revert-buffer-function' is used to override the normal revert
2023mechanism, this hook is not used.")
2024
1ab31687 2025(defun revert-buffer (&optional ignore-auto noconfirm)
b4da00e9
RM
2026 "Replace the buffer text with the text of the visited file on disk.
2027This undoes all changes since the file was visited or saved.
8c0e7b73
JB
2028With a prefix argument, offer to revert from latest auto-save file, if
2029that is more recent than the visited file.
1ab31687 2030
65ee6096 2031When called from Lisp, the first argument is IGNORE-AUTO; only offer
1ab31687
JB
2032to revert from the auto-save file when this is nil. Note that the
2033sense of this argument is the reverse of the prefix argument, for the
2034sake of backward compatibility. IGNORE-AUTO is optional, defaulting
2035to nil.
2036
2037Optional second argument NOCONFIRM means don't ask for confirmation at
2038all.
b4da00e9 2039
8c0e7b73 2040If the value of `revert-buffer-function' is non-nil, it is called to
fb6208a6
RS
2041do the work.
2042
4fbf62ee
KH
2043The default revert function runs the hook `before-revert-hook' at the
2044beginning and `after-revert-hook' at the end."
1ab31687
JB
2045 ;; I admit it's odd to reverse the sense of the prefix argument, but
2046 ;; there is a lot of code out there which assumes that the first
2047 ;; argument should be t to avoid consulting the auto-save file, and
2048 ;; there's no straightforward way to encourage authors to notice a
2049 ;; reversal of the argument sense. So I'm just changing the user
2050 ;; interface, but leaving the programmatic interface the same.
e0867e99 2051 (interactive (list (not current-prefix-arg)))
b4da00e9 2052 (if revert-buffer-function
1ab31687 2053 (funcall revert-buffer-function ignore-auto noconfirm)
b4da00e9 2054 (let* ((opoint (point))
1ab31687
JB
2055 (auto-save-p (and (not ignore-auto)
2056 (recent-auto-save-p)
b4da00e9
RM
2057 buffer-auto-save-file-name
2058 (file-readable-p buffer-auto-save-file-name)
2059 (y-or-n-p
2060 "Buffer has been auto-saved recently. Revert from auto-save file? ")))
2061 (file-name (if auto-save-p
2062 buffer-auto-save-file-name
2063 buffer-file-name)))
2064 (cond ((null file-name)
2065 (error "Buffer does not seem to be associated with any file"))
2066 ((or noconfirm
2067 (yes-or-no-p (format "Revert buffer from file %s? "
2068 file-name)))
4fbf62ee 2069 (run-hooks 'before-revert-hook)
b4da00e9
RM
2070 ;; If file was backed up but has changed since,
2071 ;; we shd make another backup.
2072 (and (not auto-save-p)
5bbbceb1 2073 (not (verify-visited-file-modtime (current-buffer)))
b4da00e9
RM
2074 (setq buffer-backed-up nil))
2075 ;; Get rid of all undo records for this buffer.
2076 (or (eq buffer-undo-list t)
2077 (setq buffer-undo-list nil))
ba5c8c93
KH
2078 ;; Effectively copy the after-revert-hook status,
2079 ;; since after-find-file will clobber it.
2080 (let ((global-hook (default-value 'after-revert-hook))
2081 (local-hook-p (local-variable-p 'after-revert-hook))
2082 (local-hook (and (local-variable-p 'after-revert-hook)
2083 after-revert-hook)))
2084 (let (buffer-read-only
2085 ;; Don't make undo records for the reversion.
2086 (buffer-undo-list t))
2087 (if revert-buffer-insert-file-contents-function
2088 (funcall revert-buffer-insert-file-contents-function
2089 file-name auto-save-p)
2090 (if (not (file-exists-p file-name))
2091 (error "File %s no longer exists!" file-name))
2092 ;; Bind buffer-file-name to nil
2093 ;; so that we don't try to lock the file.
2094 (let ((buffer-file-name nil))
2095 (or auto-save-p
2096 (unlock-buffer)))
2097 (widen)
2098 (insert-file-contents file-name (not auto-save-p)
2099 nil nil t)))
2100 (goto-char (min opoint (point-max)))
2101 ;; Recompute the truename in case changes in symlinks
2102 ;; have changed the truename.
2103 (setq buffer-file-truename
2104 (abbreviate-file-name (file-truename buffer-file-name)))
2105 (after-find-file nil nil t t)
2106 ;; Run after-revert-hook as it was before we reverted.
2107 (setq-default revert-buffer-internal-hook global-hook)
2108 (if local-hook-p
2109 (progn
2110 (make-local-variable 'revert-buffer-internal-hook)
2111 (setq revert-buffer-internal-hook local-hook))
2112 (kill-local-variable 'revert-buffer-internal-hook))
2113 (run-hooks 'revert-buffer-internal-hook))
4fbf62ee 2114 t)))))
b4da00e9
RM
2115
2116(defun recover-file (file)
2117 "Visit file FILE, but get contents from its last auto-save file."
10f7c7fc
RS
2118 ;; Actually putting the file name in the minibuffer should be used
2119 ;; only rarely.
2120 ;; Not just because users often use the default.
2121 (interactive "fRecover file: ")
b4da00e9 2122 (setq file (expand-file-name file))
f7da6740
RS
2123 (if (auto-save-file-name-p (file-name-nondirectory file))
2124 (error "%s is an auto-save file" file))
b4da00e9
RM
2125 (let ((file-name (let ((buffer-file-name file))
2126 (make-auto-save-file-name))))
945e1965
RS
2127 (cond ((if (file-exists-p file)
2128 (not (file-newer-than-file-p file-name file))
2129 (not (file-exists-p file-name)))
b4da00e9
RM
2130 (error "Auto-save file %s not current" file-name))
2131 ((save-window-excursion
2132 (if (not (eq system-type 'vax-vms))
2133 (with-output-to-temp-buffer "*Directory*"
2134 (buffer-disable-undo standard-output)
2135 (call-process "ls" nil standard-output nil
2dc2b736
RS
2136 (if (file-symlink-p file) "-lL" "-l")
2137 file file-name)))
b4da00e9
RM
2138 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
2139 (switch-to-buffer (find-file-noselect file t))
2140 (let ((buffer-read-only nil))
2141 (erase-buffer)
2142 (insert-file-contents file-name nil))
8cfb9d46 2143 (after-find-file nil nil t))
b4da00e9
RM
2144 (t (error "Recover-file cancelled.")))))
2145
6598027d 2146(defun recover-session ()
9aee5392
RS
2147 "Recover auto save files from a previous Emacs session.
2148This command first displays a Dired buffer showing you the
2149previous sessions that you could recover from.
2150To choose one, move point to the proper line and then type C-c C-c.
2151Then you'll be asked about a number of files to recover."
2152 (interactive)
2153 (dired "~/.save*")
2154 (goto-char (point-min))
2155 (or (looking-at "Move to the session you want to recover,")
2156 (let ((inhibit-read-only t))
033ef863
RS
2157 (insert "Move to the session you want to recover,\n"
2158 "then type C-c C-c to select it.\n\n"
2159 "You can also delete some of these files;\n"
2160 "type d on a line to mark that file for deletion.\n\n")))
9aee5392 2161 (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
80280bb7 2162 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))
9aee5392 2163
80280bb7 2164(defun recover-session-finish ()
9aee5392
RS
2165 "Choose one saved session to recover auto-save files from.
2166This command is used in the special Dired buffer created by
80280bb7 2167\\[recover-session]."
9aee5392
RS
2168 (interactive)
2169 ;; Get the name of the session file to recover from.
2170 (let ((file (dired-get-filename))
2171 (buffer (get-buffer-create " *recover*")))
033ef863 2172 (dired-do-flagged-delete t)
9aee5392
RS
2173 (unwind-protect
2174 (save-excursion
2175 ;; Read in the auto-save-list file.
2176 (set-buffer buffer)
2177 (erase-buffer)
2178 (insert-file-contents file)
945e1965
RS
2179 ;; The file contains a pair of line for each auto-saved buffer.
2180 ;; The first line of the pair contains the visited file name
2181 ;; or is empty if the buffer was not visiting a file.
2182 ;; The second line is the auto-save file name.
80280bb7 2183 (map-y-or-n-p "Recover %s? "
aaf17501
RS
2184 (lambda (file)
2185 (condition-case nil
2186 (save-excursion (recover-file file))
2187 (error
2188 "Failed to recover `%s'" file)))
80280bb7
RM
2189 (lambda ()
2190 (if (eobp)
2191 nil
2192 (prog1
945e1965
RS
2193 (if (eolp)
2194 ;; If the first line of the pair is empty,
2195 ;; it means this was a non-file buffer
2196 ;; that was autosaved.
2197 ;; Make a file name from
2198 ;; the auto-save file name.
2199 (let ((autofile
2200 (buffer-substring-no-properties
2201 (save-excursion
2202 (forward-line 1)
2203 (point))
2204 (save-excursion
2205 (forward-line 1)
2206 (end-of-line)
2207 (point)))))
2208 (expand-file-name
2209 (concat "temp"
2210 (substring
2211 (file-name-nondirectory autofile)
2212 1 -1))
2213 (file-name-directory autofile)))
2214 ;; This pair of lines is a file-visiting
2215 ;; buffer. Use the visited file name.
2216 (buffer-substring-no-properties
2217 (point) (progn (end-of-line) (point))))
80280bb7
RM
2218 (while (and (eolp) (not (eobp)))
2219 (forward-line 2)))))
2220 '("file" "files" "recover")))
9aee5392
RS
2221 (kill-buffer buffer))))
2222
b4da00e9
RM
2223(defun kill-some-buffers ()
2224 "For each buffer, ask whether to kill it."
2225 (interactive)
2226 (let ((list (buffer-list)))
2227 (while list
2228 (let* ((buffer (car list))
2229 (name (buffer-name buffer)))
2230 (and (not (string-equal name ""))
2231 (/= (aref name 0) ? )
2232 (yes-or-no-p
2233 (format "Buffer %s %s. Kill? "
2234 name
2235 (if (buffer-modified-p buffer)
2236 "HAS BEEN EDITED" "is unmodified")))
2237 (kill-buffer buffer)))
2238 (setq list (cdr list)))))
2239\f
2240(defun auto-save-mode (arg)
2241 "Toggle auto-saving of contents of current buffer.
f3e23606 2242With prefix argument ARG, turn auto-saving on if positive, else off."
b4da00e9
RM
2243 (interactive "P")
2244 (setq buffer-auto-save-file-name
2245 (and (if (null arg)
74b9c2af
RS
2246 (or (not buffer-auto-save-file-name)
2247 ;; If autosave is off because buffer has shrunk,
2248 ;; then toggling should turn it on.
2249 (< buffer-saved-size 0))
b4da00e9
RM
2250 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
2251 (if (and buffer-file-name auto-save-visited-file-name
2252 (not buffer-read-only))
2253 buffer-file-name
2254 (make-auto-save-file-name))))
0b7f1ef2
RS
2255 ;; If -1 was stored here, to temporarily turn off saving,
2256 ;; turn it back on.
2257 (and (< buffer-saved-size 0)
2258 (setq buffer-saved-size 0))
b4da00e9
RM
2259 (if (interactive-p)
2260 (message "Auto-save %s (in this buffer)"
2261 (if buffer-auto-save-file-name "on" "off")))
2262 buffer-auto-save-file-name)
2263
2264(defun rename-auto-save-file ()
2265 "Adjust current buffer's auto save file name for current conditions.
2266Also rename any existing auto save file, if it was made in this session."
2267 (let ((osave buffer-auto-save-file-name))
2268 (setq buffer-auto-save-file-name
2269 (make-auto-save-file-name))
2270 (if (and osave buffer-auto-save-file-name
2271 (not (string= buffer-auto-save-file-name buffer-file-name))
2272 (not (string= buffer-auto-save-file-name osave))
2273 (file-exists-p osave)
2274 (recent-auto-save-p))
2275 (rename-file osave buffer-auto-save-file-name t))))
2276
2277(defun make-auto-save-file-name ()
2278 "Return file name to use for auto-saves of current buffer.
2279Does not consider `auto-save-visited-file-name' as that variable is checked
2280before calling this function. You can redefine this for customization.
2281See also `auto-save-file-name-p'."
2282 (if buffer-file-name
2283 (concat (file-name-directory buffer-file-name)
2284 "#"
2285 (file-name-nondirectory buffer-file-name)
2286 "#")
0a1763b4
RS
2287
2288 ;; Deal with buffers that don't have any associated files. (Mail
2289 ;; mode tends to create a good number of these.)
2290
7d483e8c 2291 (let ((buffer-name (buffer-name))
0a1763b4
RS
2292 (limit 0))
2293 ;; Use technique from Sebastian Kremer's auto-save
2294 ;; package to turn slashes into \\!. This ensures that
2295 ;; the auto-save buffer name is unique.
2296
2297 (while (string-match "[/\\]" buffer-name limit)
2298 (setq buffer-name (concat (substring buffer-name 0 (match-beginning 0))
2299 (if (string= (substring buffer-name
2300 (match-beginning 0)
2301 (match-end 0))
2302 "/")
2303 "\\!"
2304 "\\\\")
2305 (substring buffer-name (match-end 0))))
2306 (setq limit (1+ (match-end 0))))
2307
7d483e8c 2308 (expand-file-name (format "#%s#%s#" buffer-name (make-temp-name ""))))))
b4da00e9
RM
2309
2310(defun auto-save-file-name-p (filename)
2311 "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
2312FILENAME should lack slashes. You can redefine this for customization."
2313 (string-match "^#.*#$" filename))
2314\f
2315(defconst list-directory-brief-switches
2316 (if (eq system-type 'vax-vms) "" "-CF")
2317 "*Switches for list-directory to pass to `ls' for brief listing,")
2318
2319(defconst list-directory-verbose-switches
2320 (if (eq system-type 'vax-vms)
2321 "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)"
2322 "-l")
2323 "*Switches for list-directory to pass to `ls' for verbose listing,")
2324
2325(defun list-directory (dirname &optional verbose)
2326 "Display a list of files in or matching DIRNAME, a la `ls'.
2327DIRNAME is globbed by the shell if necessary.
2328Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
2329Actions controlled by variables `list-directory-brief-switches'
2330and `list-directory-verbose-switches'."
2331 (interactive (let ((pfx current-prefix-arg))
2332 (list (read-file-name (if pfx "List directory (verbose): "
2333 "List directory (brief): ")
2334 nil default-directory nil)
2335 pfx)))
2336 (let ((switches (if verbose list-directory-verbose-switches
2337 list-directory-brief-switches)))
2338 (or dirname (setq dirname default-directory))
2339 (setq dirname (expand-file-name dirname))
2340 (with-output-to-temp-buffer "*Directory*"
2341 (buffer-disable-undo standard-output)
2342 (princ "Directory ")
2343 (princ dirname)
2344 (terpri)
c3554e95
RS
2345 (save-excursion
2346 (set-buffer "*Directory*")
a513a2f8 2347 (setq default-directory (file-name-directory dirname))
c3554e95
RS
2348 (let ((wildcard (not (file-directory-p dirname))))
2349 (insert-directory dirname switches wildcard (not wildcard)))))))
2350
2351(defvar insert-directory-program "ls"
2352 "Absolute or relative name of the `ls' program used by `insert-directory'.")
2353
2354;; insert-directory
2355;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
2356;; FULL-DIRECTORY-P is nil.
2357;; The single line of output must display FILE's name as it was
2358;; given, namely, an absolute path name.
2359;; - must insert exactly one line for each file if WILDCARD or
2360;; FULL-DIRECTORY-P is t, plus one optional "total" line
2361;; before the file lines, plus optional text after the file lines.
2362;; Lines are delimited by "\n", so filenames containing "\n" are not
2363;; allowed.
2364;; File lines should display the basename.
2365;; - must be consistent with
2366;; - functions dired-move-to-filename, (these two define what a file line is)
2367;; dired-move-to-end-of-filename,
2368;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
2369;; dired-insert-headerline
2370;; dired-after-subdir-garbage (defines what a "total" line is)
2371;; - variable dired-subdir-regexp
2372(defun insert-directory (file switches &optional wildcard full-directory-p)
a18b7c81 2373 "Insert directory listing for FILE, formatted according to SWITCHES.
c3554e95 2374Leaves point after the inserted text.
727d277d 2375SWITCHES may be a string of options, or a list of strings.
c3554e95
RS
2376Optional third arg WILDCARD means treat FILE as shell wildcard.
2377Optional fourth arg FULL-DIRECTORY-P means file is a directory and
2378switches do not contain `d', so that a full listing is expected.
2379
2380This works by running a directory listing program
406e12d9 2381whose name is in the variable `insert-directory-program'.
c3554e95 2382If WILDCARD, it also runs the shell specified by `shell-file-name'."
c870ab8e
RS
2383 ;; We need the directory in order to find the right handler.
2384 (let ((handler (find-file-name-handler (expand-file-name file)
2385 'insert-directory)))
c3554e95
RS
2386 (if handler
2387 (funcall handler 'insert-directory file switches
2388 wildcard full-directory-p)
b4da00e9 2389 (if (eq system-type 'vax-vms)
c3554e95
RS
2390 (vms-read-directory file switches (current-buffer))
2391 (if wildcard
a9fa0bd5
RS
2392 ;; Run ls in the directory of the file pattern we asked for.
2393 (let ((default-directory
2394 (if (file-name-absolute-p file)
2395 (file-name-directory file)
6e2dc7cb
RS
2396 (file-name-directory (expand-file-name file))))
2397 (pattern (file-name-nondirectory file))
2398 (beg 0))
2399 ;; Quote some characters that have special meanings in shells;
2400 ;; but don't quote the wildcards--we want them to be special.
2401 ;; We also currently don't quote the quoting characters
2402 ;; in case people want to use them explicitly to quote
2403 ;; wildcard characters.
d1739e52 2404 (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
6e2dc7cb
RS
2405 (setq pattern
2406 (concat (substring pattern 0 (match-beginning 0))
2407 "\\"
2408 (substring pattern (match-beginning 0)))
2409 beg (1+ (match-end 0))))
c3554e95 2410 (call-process shell-file-name nil t nil
108aa1b5
RS
2411 "-c" (concat "\\" ;; Disregard shell aliases!
2412 insert-directory-program
727d277d
RS
2413 " -d "
2414 (if (stringp switches)
2415 switches
eb51e665 2416 (mapconcat 'identity switches " "))
727d277d 2417 " "
eb51e665 2418 pattern)))
a18b7c81
JB
2419 ;; SunOS 4.1.3, SVr4 and others need the "." to list the
2420 ;; directory if FILE is a symbolic link.
727d277d
RS
2421 (apply 'call-process
2422 insert-directory-program nil t nil
2423 (let (list)
9700caaf 2424 (if (listp switches)
727d277d 2425 (setq list switches)
9700caaf
RS
2426 (if (not (equal switches ""))
2427 (progn
2428 ;; Split the switches at any spaces
2429 ;; so we can pass separate options as separate args.
2430 (while (string-match " " switches)
2431 (setq list (cons (substring switches 0 (match-beginning 0))
2432 list)
2433 switches (substring switches (match-end 0))))
2434 (setq list (cons switches list)))))
727d277d
RS
2435 (append list
2436 (list
2437 (if full-directory-p
2438 (concat (file-name-as-directory file) ".")
2439 file))))))))))
b4da00e9 2440
88902b35 2441(defvar kill-emacs-query-functions nil
65d5c6de 2442 "Functions to call with no arguments to query about killing Emacs.
78c793d1
RS
2443If any of these functions returns nil, killing Emacs is cancelled.
2444`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
2445but `kill-emacs', the low level primitive, does not.
2446See also `kill-emacs-hook'.")
88902b35 2447
b4da00e9
RM
2448(defun save-buffers-kill-emacs (&optional arg)
2449 "Offer to save each buffer, then kill this Emacs process.
2450With prefix arg, silently save all file-visiting buffers, then kill."
2451 (interactive "P")
2452 (save-some-buffers arg t)
2453 (and (or (not (memq t (mapcar (function
2454 (lambda (buf) (and (buffer-file-name buf)
2455 (buffer-modified-p buf))))
2456 (buffer-list))))
2457 (yes-or-no-p "Modified buffers exist; exit anyway? "))
2458 (or (not (fboundp 'process-list))
2459 ;; process-list is not defined on VMS.
2460 (let ((processes (process-list))
2461 active)
2462 (while processes
528415e7 2463 (and (memq (process-status (car processes)) '(run stop open))
b4da00e9
RM
2464 (let ((val (process-kill-without-query (car processes))))
2465 (process-kill-without-query (car processes) val)
2466 val)
2467 (setq active t))
2468 (setq processes (cdr processes)))
2469 (or (not active)
2470 (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
88902b35 2471 ;; Query the user for other things, perhaps.
fb15c113 2472 (run-hook-with-args-until-failure 'kill-emacs-query-functions)
b4da00e9
RM
2473 (kill-emacs)))
2474\f
2475(define-key ctl-x-map "\C-f" 'find-file)
2476(define-key ctl-x-map "\C-q" 'toggle-read-only)
2477(define-key ctl-x-map "\C-r" 'find-file-read-only)
2478(define-key ctl-x-map "\C-v" 'find-alternate-file)
2479(define-key ctl-x-map "\C-s" 'save-buffer)
2480(define-key ctl-x-map "s" 'save-some-buffers)
2481(define-key ctl-x-map "\C-w" 'write-file)
2482(define-key ctl-x-map "i" 'insert-file)
2483(define-key esc-map "~" 'not-modified)
2484(define-key ctl-x-map "\C-d" 'list-directory)
2485(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)
2486
2487(define-key ctl-x-4-map "f" 'find-file-other-window)
2488(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
2489(define-key ctl-x-4-map "\C-f" 'find-file-other-window)
2490(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
924f0a24 2491(define-key ctl-x-4-map "\C-o" 'display-buffer)
5bbbceb1 2492
f98955ea
JB
2493(define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame)
2494(define-key ctl-x-5-map "f" 'find-file-other-frame)
2495(define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
2496(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
c0274f38
ER
2497
2498;;; files.el ends here