(help-mode): Set view-exit-action to delete window.
[bpt/emacs.git] / lisp / files.el
CommitLineData
c0274f38
ER
1;;; files.el --- file input and output commands for Emacs
2
aaef169d
TTN
3;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996,
4;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5;; 2006 Free Software Foundation, Inc.
b4da00e9 6
3a801d0c
ER
7;; Maintainer: FSF
8
b4da00e9
RM
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
e5167999 13;; the Free Software Foundation; either version 2, or (at your option)
b4da00e9
RM
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
693f800d 22;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
b4da00e9 25
e41b2db1
ER
26;;; Commentary:
27
28;; Defines most of Emacs's file- and directory-handling functions,
29;; including basic file visiting, backup generation, link handling,
30;; ITS-id version control, load- and write-hook handling, and the like.
31
e5167999
ER
32;;; Code:
33
26138670
JB
34(defvar font-lock-keywords)
35
36
21540597
RS
37(defgroup backup nil
38 "Backups of edited data files."
2a9fe1e2 39 :group 'files)
b4da00e9 40
21540597 41(defgroup find-file nil
2a9fe1e2
RS
42 "Finding files."
43 :group 'files)
21540597
RS
44
45
46(defcustom delete-auto-save-files t
92631216
EZ
47 "*Non-nil means delete auto-save file when a buffer is saved or killed.
48
564af258 49Note that the auto-save file will not be deleted if the buffer is killed
92631216 50when it has unsaved changes."
21540597
RS
51 :type 'boolean
52 :group 'auto-save)
53
54(defcustom directory-abbrev-alist
b4da00e9
RM
55 nil
56 "*Alist of abbreviations for file directories.
57A list of elements of the form (FROM . TO), each meaning to replace
58FROM with TO when it appears in a directory name. This replacement is
59done when setting up the default directory of a newly visited file.
60*Every* FROM string should start with `^'.
61
65151a1b
RS
62Do not use `~' in the TO strings.
63They should be ordinary absolute directory names.
64
b4da00e9
RM
65Use this feature when you have directories which you normally refer to
66via absolute symbolic links. Make TO the name of the link, and FROM
21540597
RS
67the name it is linked to."
68 :type '(repeat (cons :format "%v"
69 :value ("" . "")
70 (regexp :tag "From")
71 (regexp :tag "To")))
72 :group 'abbrev
73 :group 'find-file)
b4da00e9 74
5c6d31a4 75;; Turn off backup files on VMS since it has version numbers.
21540597 76(defcustom make-backup-files (not (eq system-type 'vax-vms))
4ea836c1 77 "*Non-nil means make a backup of a file the first time it is saved.
b4da00e9
RM
78This can be done by renaming the file or by copying.
79
80Renaming means that Emacs renames the existing file so that it is a
81backup file, then writes the buffer into a new file. Any other names
82that the old file had will now refer to the backup file. The new file
83is owned by you and its group is defaulted.
84
85Copying means that Emacs copies the existing file into the backup
86file, then writes the buffer on top of the existing file. Any other
87names that the old file had will now refer to the new (edited) file.
88The file's owner and group are unchanged.
89
90The choice of renaming or copying is controlled by the variables
ffc0e1ca
AS
91`backup-by-copying', `backup-by-copying-when-linked',
92`backup-by-copying-when-mismatch' and
93`backup-by-copying-when-privileged-mismatch'. See also `backup-inhibited'."
21540597
RS
94 :type 'boolean
95 :group 'backup)
b4da00e9
RM
96
97;; Do this so that local variables based on the file name
98;; are not overridden by the major mode.
99(defvar backup-inhibited nil
f862241d
RS
100 "Non-nil means don't make a backup, regardless of the other parameters.
101This variable is intended for use by making it local to a buffer.
102But it is local only if you make it local.")
b4da00e9
RM
103(put 'backup-inhibited 'permanent-local t)
104
21540597 105(defcustom backup-by-copying nil
b4da00e9 106 "*Non-nil means always use copying to create backup files.
21540597
RS
107See documentation of variable `make-backup-files'."
108 :type 'boolean
109 :group 'backup)
b4da00e9 110
21540597 111(defcustom backup-by-copying-when-linked nil
b4da00e9
RM
112 "*Non-nil means use copying to create backups for files with multiple names.
113This causes the alternate names to refer to the latest version as edited.
21540597
RS
114This variable is relevant only if `backup-by-copying' is nil."
115 :type 'boolean
116 :group 'backup)
b4da00e9 117
21540597 118(defcustom backup-by-copying-when-mismatch nil
b4da00e9
RM
119 "*Non-nil means create backups by copying if this preserves owner or group.
120Renaming may still be used (subject to control of other variables)
121when it would not result in changing the owner or group of the file;
122that is, for files which are owned by you and whose group matches
123the default for a new file created there by you.
21540597
RS
124This variable is relevant only if `backup-by-copying' is nil."
125 :type 'boolean
126 :group 'backup)
b4da00e9 127
ffc0e1ca
AS
128(defcustom backup-by-copying-when-privileged-mismatch 200
129 "*Non-nil means create backups by copying to preserve a privileged owner.
130Renaming may still be used (subject to control of other variables)
131when it would not result in changing the owner of the file or if the owner
132has a user id greater than the value of this variable. This is useful
133when low-numbered uid's are used for special system users (such as root)
134that must maintain ownership of certain files.
135This variable is relevant only if `backup-by-copying' and
136`backup-by-copying-when-mismatch' are nil."
137 :type '(choice (const nil) integer)
138 :group 'backup)
139
ffc0e1ca 140(defvar backup-enable-predicate 'normal-backup-enable-predicate
b4da00e9 141 "Predicate that looks at a file name and decides whether to make backups.
37193ee6 142Called with an absolute file name as argument, it returns t to enable backup.")
b4da00e9 143
21540597 144(defcustom buffer-offer-save nil
ffc0e1ca
AS
145 "*Non-nil in a buffer means always offer to save buffer on exit.
146Do so even if the buffer is not visiting a file.
21540597
RS
147Automatically local in all buffers."
148 :type 'boolean
149 :group 'backup)
b4da00e9
RM
150(make-variable-buffer-local 'buffer-offer-save)
151
21540597 152(defcustom find-file-existing-other-name t
f3e23606
RS
153 "*Non-nil means find a file under alternative names, in existing buffers.
154This means if any existing buffer is visiting the file you want
21540597
RS
155under another name, you get the existing buffer instead of a new buffer."
156 :type 'boolean
157 :group 'find-file)
f3e23606 158
21540597 159(defcustom find-file-visit-truename nil
f3e23606
RS
160 "*Non-nil means visit a file under its truename.
161The truename of a file is found by chasing all links
21540597
RS
162both at the file level and at the levels of the containing directories."
163 :type 'boolean
164 :group 'find-file)
f3e23606 165
26b9ecbc 166(defcustom revert-without-query nil
ebeb898f
RS
167 "*Specify which files should be reverted without query.
168The value is a list of regular expressions.
169If the file name matches one of these regular expressions,
db8c4866 170then `revert-buffer' reverts the file without querying
21540597 171if the file has changed on disk and you have not edited the buffer."
a0d809f2 172 :type '(repeat regexp)
21540597 173 :group 'find-file)
ebeb898f 174
f3e23606
RS
175(defvar buffer-file-number nil
176 "The device number and file number of the file visited in the current buffer.
177The value is a list of the form (FILENUM DEVNUM).
178This pair of numbers uniquely identifies the file.
179If the buffer is visiting a new file, the value is nil.")
180(make-variable-buffer-local 'buffer-file-number)
181(put 'buffer-file-number 'permanent-local t)
182
de88363f 183(defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
26b9ecbc 184 "Non-nil means that `buffer-file-number' uniquely identifies files.")
de88363f 185
e554eeb7
RS
186(defvar buffer-file-read-only nil
187 "Non-nil if visited file was read-only when visited.")
188(make-variable-buffer-local 'buffer-file-read-only)
189
388d6ab5 190(defcustom temporary-file-directory
eb61b61b
RS
191 (file-name-as-directory
192 (cond ((memq system-type '(ms-dos windows-nt))
193 (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
194 ((memq system-type '(vax-vms axp-vms))
195 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
196 (t
197 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
388d6ab5
RS
198 "The directory for writing temporary files."
199 :group 'files
200 :type 'directory)
eb61b61b 201
388d6ab5 202(defcustom small-temporary-file-directory
eb61b61b
RS
203 (if (eq system-type 'ms-dos) (getenv "TMPDIR"))
204 "The directory for writing small temporary files.
205If non-nil, this directory is used instead of `temporary-file-directory'
206by programs that create small temporary files. This is for systems that
388d6ab5
RS
207have fast storage with limited space, such as a RAM disk."
208 :group 'files
bab6eadb 209 :type '(choice (const nil) directory))
eb61b61b
RS
210
211;; The system null device. (Should reference NULL_DEVICE from C.)
212(defvar null-device "/dev/null" "The system null device.")
213
30966847
EZ
214(defvar file-name-invalid-regexp
215 (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
9959c16e 216 (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
30966847 217 "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters
edfc7f25 218 "[\000-\031]\\|" ; control characters
30966847
EZ
219 "\\(/\\.\\.?[^/]\\)\\|" ; leading dots
220 "\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot
c60ee5e7 221 ((memq system-type '(ms-dos windows-nt cygwin))
9959c16e 222 (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
106a57a4 223 "[|<>\"?*\000-\031]")) ; invalid characters
30966847
EZ
224 (t "[\000]"))
225 "Regexp recognizing file names which aren't allowed by the filesystem.")
226
21540597 227(defcustom file-precious-flag nil
b4da00e9 228 "*Non-nil means protect against I/O errors while saving files.
560f4415 229Some modes set this non-nil in particular buffers.
4b7271c1
KH
230
231This feature works by writing the new contents into a temporary file
232and then renaming the temporary file to replace the original.
233In this way, any I/O error in writing leaves the original untouched,
234and there is never any instant where the file is nonexistent.
235
236Note that this feature forces backups to be made by copying.
560f4415 237Yet, at the same time, saving a precious file
21540597
RS
238breaks any hard links between it and other files."
239 :type 'boolean
240 :group 'backup)
b4da00e9 241
21540597 242(defcustom version-control nil
b4da00e9
RM
243 "*Control use of version numbers for backup files.
244t means make numeric backup versions unconditionally.
245nil means make them for files that have some already.
21540597 246`never' means do not make them."
e48807d1
AS
247 :type '(choice (const :tag "Never" never)
248 (const :tag "If existing" nil)
249 (other :tag "Always" t))
21540597
RS
250 :group 'backup
251 :group 'vc)
252
253(defcustom dired-kept-versions 2
254 "*When cleaning directory, number of versions to keep."
255 :type 'integer
256 :group 'backup
257 :group 'dired)
258
259(defcustom delete-old-versions nil
de7d5e1b 260 "*If t, delete excess backup versions silently.
21540597
RS
261If nil, ask confirmation. Any other value prevents any trimming."
262 :type '(choice (const :tag "Delete" t)
263 (const :tag "Ask" nil)
e48807d1 264 (other :tag "Leave" other))
21540597
RS
265 :group 'backup)
266
267(defcustom kept-old-versions 2
268 "*Number of oldest versions to keep when a new numbered backup is made."
269 :type 'integer
270 :group 'backup)
271
272(defcustom kept-new-versions 2
b4da00e9 273 "*Number of newest versions to keep when a new numbered backup is made.
21540597
RS
274Includes the new backup. Must be > 0"
275 :type 'integer
276 :group 'backup)
b4da00e9 277
21540597 278(defcustom require-final-newline nil
f4206092
RS
279 "*Whether to add a newline automatically at the end of the file.
280
281A value of t means do this only when the file is about to be saved.
282A value of `visit' means do this right after the file is visited.
283A value of `visit-save' means do it at both of those times.
284Any other non-nil value means ask user whether to add a newline, when saving.
285nil means don't add newlines.
286
287Certain major modes set this locally to the value obtained
288from `mode-require-final-newline'."
289 :type '(choice (const :tag "When visiting" visit)
290 (const :tag "When saving" t)
291 (const :tag "When visiting or saving" visit-save)
93d1963d 292 (const :tag "Don't add newlines" nil)
0776da52 293 (other :tag "Ask each time" ask))
21540597 294 :group 'editing-basics)
b4da00e9 295
f4206092 296(defcustom mode-require-final-newline t
5e9961be 297 "*Whether to add a newline at end of file, in certain major modes.
f4206092 298Those modes set `require-final-newline' to this value when you enable them.
0776da52 299They do so because they are often used for files that are supposed
f4206092
RS
300to end in newlines, and the question is how to arrange that.
301
302A value of t means do this only when the file is about to be saved.
303A value of `visit' means do this right after the file is visited.
304A value of `visit-save' means do it at both of those times.
5e9961be 305Any other non-nil value means ask user whether to add a newline, when saving.
5e9961be 306
93d1963d
RS
307nil means do not add newlines. That is a risky choice in this variable
308since this value is used for modes for files that ought to have final newlines.
309So if you set this to nil, you must explicitly check and add
310a final newline, whenever you save a file that really needs one."
f4206092
RS
311 :type '(choice (const :tag "When visiting" visit)
312 (const :tag "When saving" t)
313 (const :tag "When visiting or saving" visit-save)
93d1963d
RS
314 (const :tag "Don't add newlines" nil)
315 (other :tag "Ask each time" ask))
f4206092 316 :group 'editing-basics
bf247b6e 317 :version "22.1")
f4206092 318
21540597
RS
319(defcustom auto-save-default t
320 "*Non-nil says by default do auto-saving of every file-visiting buffer."
321 :type 'boolean
322 :group 'auto-save)
b4da00e9 323
21540597 324(defcustom auto-save-visited-file-name nil
b4da00e9 325 "*Non-nil says auto-save a buffer in the file it is visiting, when practical.
21540597
RS
326Normally auto-save files are written under other names."
327 :type 'boolean
328 :group 'auto-save)
b4da00e9 329
ffc0e1ca 330(defcustom auto-save-file-name-transforms
b1e5937c 331 `(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'"
747981b0
EZ
332 ;; Don't put "\\2" inside expand-file-name, since it will be
333 ;; transformed to "/2" on DOS/Windows.
a0b60c33 334 ,(concat temporary-file-directory "\\2") t))
ffc0e1ca 335 "*Transforms to apply to buffer file name before making auto-save file name.
a0b60c33 336Each transform is a list (REGEXP REPLACEMENT UNIQUIFY):
ffc0e1ca
AS
337REGEXP is a regular expression to match against the file name.
338If it matches, `replace-match' is used to replace the
339matching part with REPLACEMENT.
a0b60c33 340If the optional element UNIQUIFY is non-nil, the auto-save file name is
36236b72 341constructed by taking the directory part of the replaced file-name,
a0b60c33
GM
342concatenated with the buffer file name with all directory separators
343changed to `!' to prevent clashes. This will not work
344correctly if your filesystem truncates the resulting name.
345
ffc0e1ca
AS
346All the transforms in the list are tried, in the order they are listed.
347When one transform applies, its result is final;
348no further transforms are tried.
349
a2899d6c
KG
350The default value is set up to put the auto-save file into the
351temporary directory (see the variable `temporary-file-directory') for
a0b60c33
GM
352editing a remote file.
353
354On MS-DOS filesystems without long names this variable is always
355ignored."
ffc0e1ca 356 :group 'auto-save
a0b60c33
GM
357 :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")
358 (boolean :tag "Uniquify")))
ffc0e1ca
AS
359 :version "21.1")
360
88b36776 361(defcustom save-abbrevs t
02c6a1cc
EZ
362 "*Non-nil means save word abbrevs too when files are saved.
363If `silently', don't ask the user before saving."
364 :type '(choice (const t) (const nil) (const silently))
21540597 365 :group 'abbrev)
b4da00e9 366
21540597 367(defcustom find-file-run-dired t
ffc0e1ca
AS
368 "*Non-nil means allow `find-file' to visit directories.
369To visit the directory, `find-file' runs `find-directory-functions'."
21540597
RS
370 :type 'boolean
371 :group 'find-file)
b4da00e9 372
ffc0e1ca
AS
373(defcustom find-directory-functions '(cvs-dired-noselect dired-noselect)
374 "*List of functions to try in sequence to visit a directory.
375Each function is called with the directory name as the sole argument
376and should return either a buffer or nil."
377 :type '(hook :options (cvs-dired-noselect dired-noselect))
378 :group 'find-file)
379
92966e6f
RS
380;;;It is not useful to make this a local variable.
381;;;(put 'find-file-not-found-hooks 'permanent-local t)
0370fe77 382(defvar find-file-not-found-functions nil
b4da00e9
RM
383 "List of functions to be called for `find-file' on nonexistent file.
384These functions are called as soon as the error is detected.
ffc0e1ca 385Variable `buffer-file-name' is already set up.
b4da00e9 386The functions are called in the order given until one of them returns non-nil.")
26b9ecbc
JB
387(define-obsolete-variable-alias 'find-file-not-found-hooks
388 'find-file-not-found-functions "22.1")
b4da00e9 389
92966e6f
RS
390;;;It is not useful to make this a local variable.
391;;;(put 'find-file-hooks 'permanent-local t)
564af258 392(defcustom find-file-hook nil
b4da00e9
RM
393 "List of functions to be called after a buffer is loaded from a file.
394The buffer's local variables (if any) will have been processed before the
564af258
DL
395functions are called."
396 :group 'find-file
397 :type 'hook
398 :options '(auto-insert)
bf247b6e 399 :version "22.1")
26b9ecbc 400(define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1")
b4da00e9 401
0370fe77 402(defvar write-file-functions nil
b4da00e9
RM
403 "List of functions to be called before writing out a buffer to a file.
404If one of them returns non-nil, the file is considered already written
8c0e7b73
JB
405and the rest are not called.
406These hooks are considered to pertain to the visited file.
0370fe77
SM
407So any buffer-local binding of this variable is discarded if you change
408the visited file name with \\[set-visited-file-name], but not when you
409change the major mode.
410
0eb0202f
LT
411This hook is not run if any of the functions in
412`write-contents-functions' returns non-nil. Both hooks pertain
413to how to save a buffer to file, for instance, choosing a suitable
414coding system and setting mode bits. (See Info
415node `(elisp)Saving Buffers'.) To perform various checks or
26b9ecbc 416updates before the buffer is saved, use `before-save-hook'.")
0370fe77 417(put 'write-file-functions 'permanent-local t)
26b9ecbc 418(define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
0370fe77
SM
419
420(defvar local-write-file-hooks nil)
b19f1da4
BF
421(make-variable-buffer-local 'local-write-file-hooks)
422(put 'local-write-file-hooks 'permanent-local t)
bf247b6e 423(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1")
8c0e7b73 424
0370fe77 425(defvar write-contents-functions nil
8c0e7b73
JB
426 "List of functions to be called before writing out a buffer to a file.
427If one of them returns non-nil, the file is considered already written
7dd11b37
LH
428and the rest are not called and neither are the functions in
429`write-file-functions'.
f82966e4
KH
430
431This variable is meant to be used for hooks that pertain to the
432buffer's contents, not to the particular visited file; thus,
433`set-visited-file-name' does not clear this variable; but changing the
693f800d
RS
434major mode does clear it.
435
0eb0202f
LT
436For hooks that _do_ pertain to the particular visited file, use
437`write-file-functions'. Both this variable and
438`write-file-functions' relate to how a buffer is saved to file.
439To perform various checks or updates before the buffer is saved,
440use `before-save-hook'.")
0370fe77 441(make-variable-buffer-local 'write-contents-functions)
26b9ecbc
JB
442(define-obsolete-variable-alias 'write-contents-hooks
443 'write-contents-functions "22.1")
b4da00e9 444
21540597 445(defcustom enable-local-variables t
93a2702d 446 "*Control use of local variables in files you visit.
a5ce12c3 447The value can be t, nil, :safe, or something else.
5a6c1d87
CY
448
449A value of t means file local variables specifications are obeyed
a251756e
RS
450if all the specified variable values are safe; if any values are
451not safe, Emacs queries you, once, whether to set them all.
a5ce12c3
RS
452\(When you say yes to certain values, they are remembered as safe.)
453
454:safe means set the safe variables, and ignore the rest.
455nil means always ignore the file local variables.
a251756e 456
a251756e 457Any other value means always query you once whether to set them all.
a5ce12c3
RS
458\(When you say yes to certain values, they are remembered as safe, but
459this has no effect when `enable-local-variables' is \"something else\".)
5a6c1d87 460
aa5fcebf
KH
461This variable also controls use of major modes specified in
462a -*- line.
b4da00e9 463
aa5fcebf
KH
464The command \\[normal-mode], when used interactively,
465always obeys file local variable specifications and the -*- line,
466and ignores this variable."
21540597 467 :type '(choice (const :tag "Obey" t)
a5ce12c3 468 (const :tag "Safe Only" :safe)
21540597 469 (const :tag "Ignore" nil)
e48807d1 470 (other :tag "Query" other))
21540597 471 :group 'find-file)
b4da00e9 472
da09b92b
RS
473(defvar local-enable-local-variables t
474 "Like `enable-local-variables' but meant for buffer-local bindings.
aa5fcebf 475The meaningful values are nil and non-nil. The default is non-nil.
da09b92b 476If a major mode sets this to nil, buffer-locally, then any local
aa5fcebf
KH
477variables list in the file will be ignored.
478
479This variable does not affect the use of major modes
480specified in a -*- line.")
da09b92b 481
21540597 482(defcustom enable-local-eval 'maybe
d207b766
RS
483 "*Control processing of the \"variable\" `eval' in a file's local variables.
484The value can be t, nil or something else.
485A value of t means obey `eval' variables;
e0b2a2d9 486nil means ignore them; anything else means query."
21540597
RS
487 :type '(choice (const :tag "Obey" t)
488 (const :tag "Ignore" nil)
e48807d1 489 (other :tag "Query" other))
21540597 490 :group 'find-file)
b4da00e9
RM
491
492;; Avoid losing in versions where CLASH_DETECTION is disabled.
493(or (fboundp 'lock-buffer)
231c4e10 494 (defalias 'lock-buffer 'ignore))
b4da00e9 495(or (fboundp 'unlock-buffer)
231c4e10 496 (defalias 'unlock-buffer 'ignore))
a7305f6e
RS
497(or (fboundp 'file-locked-p)
498 (defalias 'file-locked-p 'ignore))
93fe0a35 499
cb211eb2 500(defcustom view-read-only nil
4c91443d
RS
501 "*Non-nil means buffers visiting files read-only do so in view mode.
502In fact, this means that all read-only buffers normally have
503View mode enabled, including buffers that are read-only because
504you visit a file you cannot alter, and buffers you make read-only
505using \\[toggle-read-only]."
cb211eb2
SM
506 :type 'boolean
507 :group 'view)
2a9fe1e2 508
1aa8fe46 509(put 'ange-ftp-completion-hook-function 'safe-magic t)
93fe0a35 510(defun ange-ftp-completion-hook-function (op &rest args)
ffc0e1ca
AS
511 "Provides support for ange-ftp host name completion.
512Runs the usual ange-ftp hook, but only for completion operations."
513 ;; Having this here avoids the need to load ange-ftp when it's not
514 ;; really in use.
93fe0a35
RS
515 (if (memq op '(file-name-completion file-name-all-completions))
516 (apply 'ange-ftp-hook-function op args)
57e81f57
RS
517 (let ((inhibit-file-name-handlers
518 (cons 'ange-ftp-completion-hook-function
519 (and (eq inhibit-file-name-operation op)
520 inhibit-file-name-handlers)))
521 (inhibit-file-name-operation op))
93fe0a35 522 (apply op args))))
567c1ca9
RS
523
524(defun convert-standard-filename (filename)
a576d8e2 525 "Convert a standard file's name to something suitable for the OS.
915b0bf0
JB
526This means to guarantee valid names and perhaps to canonicalize
527certain patterns.
528
f2430a0d
SM
529FILENAME should be an absolute file name since the conversion rules
530sometimes vary depending on the position in the file name. E.g. c:/foo
531is a valid DOS file name, but c:/bar/c:/foo is not.
532
915b0bf0
JB
533This function's standard definition is trivial; it just returns
534the argument. However, on Windows and DOS, replace invalid
535characters. On DOS, make sure to obey the 8.3 limitations. On
536Windows, turn Cygwin names into native names, and also turn
537slashes into backslashes if the shell requires it (see
a576d8e2
LT
538`w32-shell-dos-semantics').
539
540See Info node `(elisp)Standard File Names' for more details."
567c1ca9 541 filename)
5d4d17b8
KS
542
543(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
544 "Read directory name, prompting with PROMPT and completing in directory DIR.
545Value is not expanded---you must call `expand-file-name' yourself.
25802eac
LT
546Default name to DEFAULT-DIRNAME if user exits with the same
547non-empty string that was inserted by this function.
44dce0fb
RS
548 (If DEFAULT-DIRNAME is omitted, DIR combined with INITIAL is used,
549 or just DIR if INITIAL is nil.)
25802eac
LT
550If the user exits with an empty minibuffer, this function returns
551an empty string. (This can only happen if the user erased the
552pre-inserted contents or if `insert-default-directory' is nil.)
5d4d17b8
KS
553Fourth arg MUSTMATCH non-nil means require existing directory's name.
554 Non-nil and non-t means also require confirmation after completion.
555Fifth arg INITIAL specifies text to start with.
25802eac
LT
556DIR should be an absolute directory name. It defaults to
557the value of `default-directory'."
5d4d17b8
KS
558 (unless dir
559 (setq dir default-directory))
54005870 560 (read-file-name prompt dir (or default-dirname
44dce0fb
RS
561 (if initial (expand-file-name initial dir)
562 dir))
563 mustmatch initial
5d4d17b8
KS
564 'file-directory-p))
565
b4da00e9
RM
566\f
567(defun pwd ()
568 "Show the current default directory."
569 (interactive nil)
570 (message "Directory %s" default-directory))
571
231c4e10
ER
572(defvar cd-path nil
573 "Value of the CDPATH environment variable, as a list.
9ee45b2c 574Not actually set up until the first time you use it.")
231c4e10
ER
575
576(defun parse-colon-path (cd-path)
ae135939 577 "Explode a search path into a list of directory names.
c5994cfa
JB
578Directories are separated by occurrences of `path-separator'
579\(which is colon in GNU and GNU-like systems)."
ffc0e1ca 580 ;; We could use split-string here.
231c4e10 581 (and cd-path
818286f4 582 (let (cd-list (cd-start 0) cd-colon)
306faa42
RS
583 (setq cd-path (concat cd-path path-separator))
584 (while (setq cd-colon (string-match path-separator cd-path cd-start))
231c4e10 585 (setq cd-list
9daefb36 586 (nconc cd-list
c52e4104
RS
587 (list (if (= cd-start cd-colon)
588 nil
589 (substitute-in-file-name
e33e80e4
RS
590 (file-name-as-directory
591 (substring cd-path cd-start cd-colon)))))))
231c4e10
ER
592 (setq cd-start (+ cd-colon 1)))
593 cd-list)))
594
595(defun cd-absolute (dir)
30c5ce9c 596 "Change current directory to given absolute file name DIR."
f4a0f59b
RS
597 ;; Put the name into directory syntax now,
598 ;; because otherwise expand-file-name may give some bad results.
b4da00e9
RM
599 (if (not (eq system-type 'vax-vms))
600 (setq dir (file-name-as-directory dir)))
f4a0f59b 601 (setq dir (abbreviate-file-name (expand-file-name dir)))
b4da00e9 602 (if (not (file-directory-p dir))
83c6f446
RS
603 (if (file-exists-p dir)
604 (error "%s is not a directory" dir)
31c691c1 605 (error "%s: no such directory" dir))
b4da00e9
RM
606 (if (file-executable-p dir)
607 (setq default-directory dir)
9daefb36 608 (error "Cannot cd to %s: Permission denied" dir))))
b4da00e9 609
231c4e10
ER
610(defun cd (dir)
611 "Make DIR become the current buffer's default directory.
ae135939
JB
612If your environment includes a `CDPATH' variable, try each one of
613that list of directories (separated by occurrences of
c5994cfa
JB
614`path-separator') when resolving a relative directory name.
615The path separator is colon in GNU and GNU-like systems."
dac4ea74 616 (interactive
5d4d17b8 617 (list (read-directory-name "Change default directory: "
2121cd9c
RM
618 default-directory default-directory
619 (and (member cd-path '(nil ("./")))
620 (null (getenv "CDPATH"))))))
30c5ce9c
RS
621 (if (file-name-absolute-p dir)
622 (cd-absolute (expand-file-name dir))
623 (if (null cd-path)
624 (let ((trypath (parse-colon-path (getenv "CDPATH"))))
625 (setq cd-path (or trypath (list "./")))))
626 (if (not (catch 'found
627 (mapcar
628 (function (lambda (x)
629 (let ((f (expand-file-name (concat x dir))))
630 (if (file-directory-p f)
631 (progn
632 (cd-absolute f)
633 (throw 'found t))))))
634 cd-path)
635 nil))
636 (error "No such directory found via CDPATH environment variable"))))
231c4e10 637
b4da00e9
RM
638(defun load-file (file)
639 "Load the Lisp file named FILE."
58195faa
DL
640 ;; This is a case where .elc makes a lot of sense.
641 (interactive (list (let ((completion-ignored-extensions
9ab80679 642 (remove ".elc" completion-ignored-extensions)))
58195faa
DL
643 (read-file-name "Load file: "))))
644 (load (expand-file-name file) nil nil t))
b4da00e9 645
38eea7c7
SM
646(defun locate-file (filename path &optional suffixes predicate)
647 "Search for FILENAME through PATH.
c7c4bc11
EZ
648If found, return the absolute file name of FILENAME, with its suffixes;
649otherwise return nil.
650PATH should be a list of directories to look in, like the lists in
651`exec-path' or `load-path'.
38eea7c7
SM
652If SUFFIXES is non-nil, it should be a list of suffixes to append to
653file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\").
c7c4bc11 654Use '(\"/\") to disable PATH search, but still try the suffixes in SUFFIXES.
38eea7c7 655If non-nil, PREDICATE is used instead of `file-readable-p'.
e6f0ff92
RS
656PREDICATE can also be an integer to pass to the `access' system call,
657in which case file-name handlers are ignored. This usage is deprecated.
658
659For compatibility, PREDICATE can also be one of the symbols
660`executable', `readable', `writable', or `exists', or a list of
661one or more of those symbols."
38eea7c7
SM
662 (if (and predicate (symbolp predicate) (not (functionp predicate)))
663 (setq predicate (list predicate)))
664 (when (and (consp predicate) (not (functionp predicate)))
665 (setq predicate
666 (logior (if (memq 'executable predicate) 1 0)
667 (if (memq 'writable predicate) 2 0)
668 (if (memq 'readable predicate) 4 0))))
669 (locate-file-internal filename path suffixes predicate))
670
671(defun locate-file-completion (string path-and-suffixes action)
672 "Do completion for file names passed to `locate-file'.
e6ca43c8 673PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
2c3d8820 674 (if (file-name-absolute-p string)
38eea7c7 675 (read-file-name-internal string nil action)
2c3d8820 676 (let ((names nil)
38eea7c7 677 (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'"))
2c3d8820 678 (string-dir (file-name-directory string)))
38eea7c7 679 (dolist (dir (car path-and-suffixes))
f2440e42
RS
680 (unless dir
681 (setq dir default-directory))
2c3d8820
SM
682 (if string-dir (setq dir (expand-file-name string-dir dir)))
683 (when (file-directory-p dir)
684 (dolist (file (file-name-all-completions
685 (file-name-nondirectory string) dir))
686 (push (if string-dir (concat string-dir file) file) names)
687 (when (string-match suffix file)
688 (setq file (substring file 0 (match-beginning 0)))
689 (push (if string-dir (concat string-dir file) file) names)))))
0370fe77
SM
690 (cond
691 ((eq action t) (all-completions string names))
692 ((null action) (try-completion string names))
693 (t (test-completion string names))))))
2c3d8820 694
c3f6aa20
SM
695(defun executable-find (command)
696 "Search for COMMAND in `exec-path' and return the absolute file name.
697Return nil if COMMAND is not found anywhere in `exec-path'."
698 ;; Use 1 rather than file-executable-p to better match the behavior of
699 ;; call-process.
700 (locate-file command exec-path exec-suffixes 1))
701
b4da00e9
RM
702(defun load-library (library)
703 "Load the library named LIBRARY.
704This is an interface to the function `load'."
38eea7c7
SM
705 (interactive
706 (list (completing-read "Load library: "
707 'locate-file-completion
9f6fdbf0 708 (cons load-path (get-load-suffixes)))))
b4da00e9 709 (load library))
5d68c2c2 710
ff7affeb 711(defun file-remote-p (file)
3f788773
KG
712 "Test whether FILE specifies a location on a remote system.
713Return an identification of the system if the location is indeed
714remote. The identification of the system may comprise a method
715to access the system and its hostname, amongst other things.
716
717For example, the filename \"/user@host:/foo\" specifies a location
718on the system \"/user@host:\"."
04621aaa 719 (let ((handler (find-file-name-handler file 'file-remote-p)))
ff7affeb 720 (if handler
04621aaa
MA
721 (funcall handler 'file-remote-p file)
722 nil)))
ff7affeb 723
ffc0e1ca 724(defun file-local-copy (file)
5d68c2c2
RS
725 "Copy the file FILE into a temporary file on this machine.
726Returns the name of the local copy, or nil, if FILE is directly
727accessible."
ffc0e1ca
AS
728 ;; This formerly had an optional BUFFER argument that wasn't used by
729 ;; anything.
6eaebaa2 730 (let ((handler (find-file-name-handler file 'file-local-copy)))
5d68c2c2
RS
731 (if handler
732 (funcall handler 'file-local-copy file)
733 nil)))
f3e23606 734
05ef1cda 735(defun file-truename (filename &optional counter prev-dirs)
f3e23606
RS
736 "Return the truename of FILENAME, which should be absolute.
737The truename of a file name is found by chasing symbolic links
738both at the level of the file and at the level of the directories
05ef1cda
RS
739containing it, until no links are left at any level.
740
89bf74f8 741\(fn FILENAME)" ;; Don't document the optional arguments.
b9963e32
JB
742 ;; COUNTER and PREV-DIRS are only used in recursive calls.
743 ;; COUNTER can be a cons cell whose car is the count of how many
744 ;; more links to chase before getting an error.
05ef1cda
RS
745 ;; PREV-DIRS can be a cons cell whose car is an alist
746 ;; of truenames we've just recently computed.
f2440e42
RS
747 (cond ((or (string= filename "") (string= filename "~"))
748 (setq filename (expand-file-name filename))
749 (if (string= filename "")
750 (setq filename "/")))
751 ((and (string= (substring filename 0 1) "~")
752 (string-match "~[^/]*/?" filename))
753 (let ((first-part
754 (substring filename 0 (match-end 0)))
755 (rest (substring filename (match-end 0))))
756 (setq filename (concat (expand-file-name first-part) rest)))))
757
05ef1cda 758 (or counter (setq counter (list 100)))
b505828b
RS
759 (let (done
760 ;; For speed, remove the ange-ftp completion handler from the list.
761 ;; We know it's not needed here.
762 ;; For even more speed, do this only on the outermost call.
763 (file-name-handler-alist
764 (if prev-dirs file-name-handler-alist
765 (let ((tem (copy-sequence file-name-handler-alist)))
766 (delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
767 (or prev-dirs (setq prev-dirs (list nil)))
b1667e6c
GV
768
769 ;; andrewi@harlequin.co.uk - none of the following code (except for
770 ;; invoking the file-name handler) currently applies on Windows
771 ;; (ie. there are no native symlinks), but there is an issue with
772 ;; case differences being ignored by the OS, and short "8.3 DOS"
773 ;; name aliases existing for all files. (The short names are not
774 ;; reported by directory-files, but can be used to refer to files.)
775 ;; It seems appropriate for file-truename to resolve these issues in
776 ;; the most natural way, which on Windows is to call the function
777 ;; `w32-long-file-name' - this returns the exact name of a file as
778 ;; it is stored on disk (expanding short name aliases with the full
779 ;; name in the process).
780 (if (eq system-type 'windows-nt)
06dd5ef7 781 (let ((handler (find-file-name-handler filename 'file-truename)))
b1667e6c
GV
782 ;; For file name that has a special handler, call handler.
783 ;; This is so that ange-ftp can save time by doing a no-op.
784 (if handler
785 (setq filename (funcall handler 'file-truename filename))
786 ;; If filename contains a wildcard, newname will be the old name.
06dd5ef7 787 (unless (string-match "[[*?]" filename)
5b373bd3
JB
788 ;; If filename exists, use the long name
789 (setq filename (or (w32-long-file-name filename) filename))))
b1667e6c
GV
790 (setq done t)))
791
05ef1cda
RS
792 ;; If this file directly leads to a link, process that iteratively
793 ;; so that we don't use lots of stack.
794 (while (not done)
795 (setcar counter (1- (car counter)))
796 (if (< (car counter) 0)
797 (error "Apparent cycle of symbolic links for %s" filename))
798 (let ((handler (find-file-name-handler filename 'file-truename)))
799 ;; For file name that has a special handler, call handler.
800 ;; This is so that ange-ftp can save time by doing a no-op.
801 (if handler
802 (setq filename (funcall handler 'file-truename filename)
803 done t)
fb145562 804 (let ((dir (or (file-name-directory filename) default-directory))
05ef1cda
RS
805 target dirfile)
806 ;; Get the truename of the directory.
807 (setq dirfile (directory-file-name dir))
808 ;; If these are equal, we have the (or a) root directory.
809 (or (string= dir dirfile)
810 ;; If this is the same dir we last got the truename for,
811 ;; save time--don't recalculate.
812 (if (assoc dir (car prev-dirs))
813 (setq dir (cdr (assoc dir (car prev-dirs))))
814 (let ((old dir)
815 (new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
816 (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
817 (setq dir new))))
818 (if (equal ".." (file-name-nondirectory filename))
819 (setq filename
820 (directory-file-name (file-name-directory (directory-file-name dir)))
821 done t)
822 (if (equal "." (file-name-nondirectory filename))
823 (setq filename (directory-file-name dir)
824 done t)
825 ;; Put it back on the file name.
826 (setq filename (concat dir (file-name-nondirectory filename)))
827 ;; Is the file name the name of a link?
828 (setq target (file-symlink-p filename))
829 (if target
830 ;; Yes => chase that link, then start all over
831 ;; since the link may point to a directory name that uses links.
832 ;; We can't safely use expand-file-name here
833 ;; since target might look like foo/../bar where foo
834 ;; is itself a link. Instead, we handle . and .. above.
835 (setq filename
836 (if (file-name-absolute-p target)
837 target
838 (concat dir target))
839 done nil)
840 ;; No, we are done!
841 (setq done t))))))))
842 filename))
5dbfdacd 843
302fcc98 844(defun file-chase-links (filename &optional limit)
5dadeb29 845 "Chase links in FILENAME until a name that is not a link.
302fcc98
RS
846Unlike `file-truename', this does not check whether a parent
847directory name is a symbolic link.
848If the optional argument LIMIT is a number,
849it means chase no more than that many links and then stop."
850 (let (tem (newname filename)
92464ae6 851 (count 0))
302fcc98
RS
852 (while (and (or (null limit) (< count limit))
853 (setq tem (file-symlink-p newname)))
9695aac6 854 (save-match-data
92464ae6 855 (if (and (null limit) (= count 100))
9695aac6
RS
856 (error "Apparent cycle of symbolic links for %s" filename))
857 ;; In the context of a link, `//' doesn't mean what Emacs thinks.
858 (while (string-match "//+" tem)
859 (setq tem (replace-match "/" nil nil tem)))
860 ;; Handle `..' by hand, since it needs to work in the
861 ;; target of any directory symlink.
862 ;; This code is not quite complete; it does not handle
863 ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
864 (while (string-match "\\`\\.\\./" tem)
865 (setq tem (substring tem 3))
866 (setq newname (expand-file-name newname))
867 ;; Chase links in the default dir of the symlink.
868 (setq newname
869 (file-chase-links
870 (directory-file-name (file-name-directory newname))))
871 ;; Now find the parent of that dir.
872 (setq newname (file-name-directory newname)))
873 (setq newname (expand-file-name tem (file-name-directory newname)))
92464ae6 874 (setq count (1+ count))))
5dadeb29 875 newname))
9bdbd98e 876
9e8bb7f7
RS
877(defun make-temp-file (prefix &optional dir-flag suffix)
878 "Create a temporary file.
879The returned file name (created by appending some random characters at the end
880of PREFIX, and expanding against `temporary-file-directory' if necessary),
881is guaranteed to point to a newly created empty file.
882You can then use `write-region' to write new data into the file.
883
884If DIR-FLAG is non-nil, create a new empty directory instead of a file.
885
886If SUFFIX is non-nil, add that at the end of the file name."
887 (let ((umask (default-file-modes))
888 file)
889 (unwind-protect
890 (progn
891 ;; Create temp files with strict access rights. It's easy to
892 ;; loosen them later, whereas it's impossible to close the
893 ;; time-window of loose permissions otherwise.
894 (set-default-file-modes ?\700)
895 (while (condition-case ()
896 (progn
897 (setq file
898 (make-temp-name
899 (expand-file-name prefix temporary-file-directory)))
900 (if suffix
901 (setq file (concat file suffix)))
902 (if dir-flag
903 (make-directory file)
904 (write-region "" nil file nil 'silent nil 'excl))
905 nil)
906 (file-already-exists t))
907 ;; the file was somehow created by someone else between
908 ;; `make-temp-name' and `write-region', let's try again.
909 nil)
910 file)
911 ;; Reset the umask.
912 (set-default-file-modes umask))))
913
9bdbd98e
KH
914(defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
915 "Change the encoding of FILE's name from CODING to NEW-CODING.
916The value is a new name of FILE.
917Signals a `file-already-exists' error if a file of the new name
26b9ecbc
JB
918already exists unless optional fourth argument OK-IF-ALREADY-EXISTS
919is non-nil. A number as fourth arg means request confirmation if
9bdbd98e
KH
920the new name already exists. This is what happens in interactive
921use with M-x."
922 (interactive
923 (let ((default-coding (or file-name-coding-system
924 default-file-name-coding-system))
925 (filename (read-file-name "Recode filename: " nil nil t))
926 from-coding to-coding)
927 (if (and default-coding
928 ;; We provide the default coding only when it seems that
929 ;; the filename is correctly decoded by the default
930 ;; coding.
931 (let ((charsets (find-charset-string filename)))
932 (and (not (memq 'eight-bit-control charsets))
933 (not (memq 'eight-bit-graphic charsets)))))
934 (setq from-coding (read-coding-system
935 (format "Recode filename %s from (default %s): "
936 filename default-coding)
937 default-coding))
938 (setq from-coding (read-coding-system
939 (format "Recode filename %s from: " filename))))
cdec2ad7 940
9bdbd98e
KH
941 ;; We provide the default coding only when a user is going to
942 ;; change the encoding not from the default coding.
943 (if (eq from-coding default-coding)
944 (setq to-coding (read-coding-system
945 (format "Recode filename %s from %s to: "
946 filename from-coding)))
947 (setq to-coding (read-coding-system
948 (format "Recode filename %s from %s to (default %s): "
949 filename from-coding default-coding)
950 default-coding)))
951 (list filename from-coding to-coding)))
952
953 (let* ((default-coding (or file-name-coding-system
954 default-file-name-coding-system))
955 ;; FILE should have been decoded by DEFAULT-CODING.
956 (encoded (encode-coding-string file default-coding))
957 (newname (decode-coding-string encoded coding))
958 (new-encoded (encode-coding-string newname new-coding))
959 ;; Suppress further encoding.
960 (file-name-coding-system nil)
961 (default-file-name-coding-system nil)
962 (locale-coding-system nil))
963 (rename-file encoded new-encoded ok-if-already-exists)
964 newname))
b4da00e9 965\f
467ff692
RS
966(defun switch-to-buffer-other-window (buffer &optional norecord)
967 "Select buffer BUFFER in another window.
839857c7
LT
968If BUFFER does not identify an existing buffer, then this function
969creates a buffer with that name.
970
971When called from Lisp, BUFFER can be a buffer, a string \(a buffer name),
972or nil. If BUFFER is nil, then this function chooses a buffer
973using `other-buffer'.
467ff692 974Optional second arg NORECORD non-nil means
4c6a4739 975do not put this buffer at the front of the list of recently selected ones.
839857c7 976This function returns the buffer it switched to.
4c6a4739
EZ
977
978This uses the function `display-buffer' as a subroutine; see its
979documentation for additional customization information."
b4da00e9 980 (interactive "BSwitch to buffer in other window: ")
cf44b9b7
RS
981 (let ((pop-up-windows t)
982 ;; Don't let these interfere.
983 same-window-buffer-names same-window-regexps)
467ff692 984 (pop-to-buffer buffer t norecord)))
b4da00e9 985
467ff692
RS
986(defun switch-to-buffer-other-frame (buffer &optional norecord)
987 "Switch to buffer BUFFER in another frame.
988Optional second arg NORECORD non-nil means
4c6a4739
EZ
989do not put this buffer at the front of the list of recently selected ones.
990
991This uses the function `display-buffer' as a subroutine; see its
992documentation for additional customization information."
f98955ea 993 (interactive "BSwitch to buffer in other frame: ")
cf44b9b7
RS
994 (let ((pop-up-frames t)
995 same-window-buffer-names same-window-regexps)
467ff692 996 (pop-to-buffer buffer t norecord)
336b7f41 997 (raise-frame (window-frame (selected-window)))))
5bbbceb1 998
ab9b3866
RS
999(defun display-buffer-other-frame (buffer)
1000 "Switch to buffer BUFFER in another frame.
1001This uses the function `display-buffer' as a subroutine; see its
1002documentation for additional customization information."
1003 (interactive "BDisplay buffer in other frame: ")
1004 (let ((pop-up-frames t)
1005 same-window-buffer-names same-window-regexps
1006 (old-window (selected-window))
1007 new-window)
1008 (setq new-window (display-buffer buffer t))
1009 (lower-frame (window-frame new-window))
1010 (make-frame-invisible (window-frame old-window))
1011 (make-frame-visible (window-frame old-window))))
1012
a49a58f9
RS
1013(defvar find-file-default nil
1014 "Used within `find-file-read-args'.")
1015
a42e7db0
SM
1016(defmacro minibuffer-with-setup-hook (fun &rest body)
1017 "Add FUN to `minibuffer-setup-hook' while executing BODY.
1018BODY should use the minibuffer at most once.
1019Recursive uses of the minibuffer will not be affected."
1020 (declare (indent 1) (debug t))
1021 (let ((hook (make-symbol "setup-hook")))
44dce0fb
RS
1022 `(let (,hook)
1023 (setq ,hook
1024 (lambda ()
1025 ;; Clear out this hook so it does not interfere
1026 ;; with any recursive minibuffer usage.
1027 (remove-hook 'minibuffer-setup-hook ,hook)
1028 (,fun)))
a42e7db0
SM
1029 (unwind-protect
1030 (progn
1031 (add-hook 'minibuffer-setup-hook ,hook)
1032 ,@body)
1033 (remove-hook 'minibuffer-setup-hook ,hook)))))
1034
05a7cb3d 1035(defun find-file-read-args (prompt mustmatch)
e6f0ff92
RS
1036 (list (let ((find-file-default
1037 (and buffer-file-name
a42e7db0
SM
1038 (abbreviate-file-name buffer-file-name))))
1039 (minibuffer-with-setup-hook
1040 (lambda () (setq minibuffer-default find-file-default))
1041 (read-file-name prompt nil default-directory mustmatch)))
b2a26f4e 1042 t))
e6f0ff92 1043
243ce842 1044(defun find-file (filename &optional wildcards)
b4da00e9
RM
1045 "Edit file FILENAME.
1046Switch to a buffer visiting file FILENAME,
243ce842 1047creating one if none already exists.
e6f0ff92
RS
1048Interactively, the default if you just type RET is the current directory,
1049but the visited file name is available through the minibuffer history:
1050type M-n to pull it into the minibuffer.
1051
243ce842 1052Interactively, or if WILDCARDS is non-nil in a call from Lisp,
91174d63 1053expand wildcards (if any) and visit multiple files. You can
518dc5be 1054suppress wildcard expansion by setting `find-file-wildcards' to nil.
91174d63
RS
1055
1056To visit a file without any kind of conversion and without
1057automatically choosing a major mode, use \\[find-file-literally]."
a9d6a617 1058 (interactive (find-file-read-args "Find file: " nil))
5b8ed07b
RS
1059 (let ((value (find-file-noselect filename nil nil wildcards)))
1060 (if (listp value)
1061 (mapcar 'switch-to-buffer (nreverse value))
1062 (switch-to-buffer value))))
82d0954a 1063
243ce842 1064(defun find-file-other-window (filename &optional wildcards)
b4da00e9
RM
1065 "Edit file FILENAME, in another window.
1066May create a new window, or reuse an existing one.
243ce842 1067See the function `display-buffer'.
e6f0ff92
RS
1068
1069Interactively, the default if you just type RET is the current directory,
1070but the visited file name is available through the minibuffer history:
1071type M-n to pull it into the minibuffer.
1072
243ce842
RS
1073Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1074expand wildcards (if any) and visit multiple files."
05a7cb3d 1075 (interactive (find-file-read-args "Find file in other window: " nil))
5b8ed07b
RS
1076 (let ((value (find-file-noselect filename nil nil wildcards)))
1077 (if (listp value)
1078 (progn
1079 (setq value (nreverse value))
a9d6a617
JL
1080 (cons (switch-to-buffer-other-window (car value))
1081 (mapcar 'switch-to-buffer (cdr value))))
5b8ed07b 1082 (switch-to-buffer-other-window value))))
243ce842
RS
1083
1084(defun find-file-other-frame (filename &optional wildcards)
f98955ea
JB
1085 "Edit file FILENAME, in another frame.
1086May create a new frame, or reuse an existing one.
243ce842 1087See the function `display-buffer'.
e6f0ff92
RS
1088
1089Interactively, the default if you just type RET is the current directory,
1090but the visited file name is available through the minibuffer history:
1091type M-n to pull it into the minibuffer.
1092
243ce842
RS
1093Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1094expand wildcards (if any) and visit multiple files."
05a7cb3d 1095 (interactive (find-file-read-args "Find file in other frame: " nil))
5b8ed07b
RS
1096 (let ((value (find-file-noselect filename nil nil wildcards)))
1097 (if (listp value)
1098 (progn
1099 (setq value (nreverse value))
a9d6a617
JL
1100 (cons (switch-to-buffer-other-frame (car value))
1101 (mapcar 'switch-to-buffer (cdr value))))
5b8ed07b 1102 (switch-to-buffer-other-frame value))))
243ce842 1103
46bfc73b
JD
1104(defun find-file-existing (filename &optional wildcards)
1105 "Edit the existing file FILENAME.
518dc5be 1106Like \\[find-file] but only allow a file that exists."
46bfc73b
JD
1107 (interactive (find-file-read-args "Find existing file: " t))
1108 (unless (file-exists-p filename) (error "%s does not exist" filename))
1109 (find-file filename wildcards)
1110 (current-buffer))
1111
243ce842 1112(defun find-file-read-only (filename &optional wildcards)
b4da00e9 1113 "Edit file FILENAME but don't allow changes.
e6f0ff92 1114Like \\[find-file] but marks buffer as read-only.
b4da00e9 1115Use \\[toggle-read-only] to permit editing."
a9d6a617
JL
1116 (interactive (find-file-read-args "Find file read-only: " nil))
1117 (unless (or (and wildcards find-file-wildcards
1118 (not (string-match "\\`/:" filename))
1119 (string-match "[[*?]" filename))
1120 (file-exists-p filename))
1121 (error "%s does not exist" filename))
1122 (let ((value (find-file filename wildcards)))
1123 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1124 (if (listp value) value (list value)))
1125 value))
b4da00e9 1126
243ce842 1127(defun find-file-read-only-other-window (filename &optional wildcards)
b4da00e9
RM
1128 "Edit file FILENAME in another window but don't allow changes.
1129Like \\[find-file-other-window] but marks buffer as read-only.
1130Use \\[toggle-read-only] to permit editing."
a9d6a617
JL
1131 (interactive (find-file-read-args "Find file read-only other window: " nil))
1132 (unless (or (and wildcards find-file-wildcards
1133 (not (string-match "\\`/:" filename))
1134 (string-match "[[*?]" filename))
1135 (file-exists-p filename))
1136 (error "%s does not exist" filename))
1137 (let ((value (find-file-other-window filename wildcards)))
1138 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1139 (if (listp value) value (list value)))
1140 value))
b4da00e9 1141
243ce842 1142(defun find-file-read-only-other-frame (filename &optional wildcards)
f98955ea
JB
1143 "Edit file FILENAME in another frame but don't allow changes.
1144Like \\[find-file-other-frame] but marks buffer as read-only.
5bbbceb1 1145Use \\[toggle-read-only] to permit editing."
a9d6a617
JL
1146 (interactive (find-file-read-args "Find file read-only other frame: " nil))
1147 (unless (or (and wildcards find-file-wildcards
1148 (not (string-match "\\`/:" filename))
1149 (string-match "[[*?]" filename))
1150 (file-exists-p filename))
1151 (error "%s does not exist" filename))
1152 (let ((value (find-file-other-frame filename wildcards)))
1153 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1154 (if (listp value) value (list value)))
1155 value))
1156
1157(defun find-alternate-file-other-window (filename &optional wildcards)
60eaf370 1158 "Find file FILENAME as a replacement for the file in the next window.
a9d6a617
JL
1159This command does not select that window.
1160
1161Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1162expand wildcards (if any) and replace the file with multiple files."
60eaf370
RS
1163 (interactive
1164 (save-selected-window
1165 (other-window 1)
1166 (let ((file buffer-file-name)
1167 (file-name nil)
1168 (file-dir nil))
1169 (and file
1170 (setq file-name (file-name-nondirectory file)
1171 file-dir (file-name-directory file)))
1172 (list (read-file-name
a9d6a617
JL
1173 "Find alternate file: " file-dir nil nil file-name)
1174 t))))
60eaf370 1175 (if (one-window-p)
a9d6a617 1176 (find-file-other-window filename wildcards)
60eaf370
RS
1177 (save-selected-window
1178 (other-window 1)
a9d6a617 1179 (find-alternate-file filename wildcards))))
60eaf370 1180
a9d6a617 1181(defun find-alternate-file (filename &optional wildcards)
b4da00e9
RM
1182 "Find file FILENAME, select its buffer, kill previous buffer.
1183If the current buffer now contains an empty file that you just visited
a9d6a617
JL
1184\(presumably by mistake), use this command to visit the file you really want.
1185
1186Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1187expand wildcards (if any) and replace the file with multiple files."
b4da00e9
RM
1188 (interactive
1189 (let ((file buffer-file-name)
1190 (file-name nil)
1191 (file-dir nil))
1192 (and file
1193 (setq file-name (file-name-nondirectory file)
1194 file-dir (file-name-directory file)))
a61f59b4 1195 (list (read-file-name
a9d6a617
JL
1196 "Find alternate file: " file-dir nil nil file-name)
1197 t)))
63fabbb4
RS
1198 (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
1199 (error "Aborted"))
1200 (when (and (buffer-modified-p) (buffer-file-name))
1201 (if (yes-or-no-p (format "Buffer %s is modified; save it first? "
1202 (buffer-name)))
1203 (save-buffer)
1204 (unless (yes-or-no-p "Kill and replace the buffer without saving it? ")
1205 (error "Aborted"))))
b4da00e9
RM
1206 (let ((obuf (current-buffer))
1207 (ofile buffer-file-name)
8bb27285 1208 (onum buffer-file-number)
37c58ca6 1209 (odir dired-directory)
8bb27285 1210 (otrue buffer-file-truename)
b4da00e9 1211 (oname (buffer-name)))
baf9b8c4
RS
1212 (if (get-buffer " **lose**")
1213 (kill-buffer " **lose**"))
b4da00e9 1214 (rename-buffer " **lose**")
b4da00e9
RM
1215 (unwind-protect
1216 (progn
1217 (unlock-buffer)
7906c044
RS
1218 ;; This prevents us from finding the same buffer
1219 ;; if we specified the same file again.
a4ad4d96
RS
1220 (setq buffer-file-name nil)
1221 (setq buffer-file-number nil)
1222 (setq buffer-file-truename nil)
7906c044
RS
1223 ;; Likewise for dired buffers.
1224 (setq dired-directory nil)
a9d6a617 1225 (find-file filename wildcards))
63fabbb4
RS
1226 (when (eq obuf (current-buffer))
1227 ;; This executes if find-file gets an error
1228 ;; and does not really find anything.
1229 ;; We put things back as they were.
1230 ;; If find-file actually finds something, we kill obuf below.
1231 (setq buffer-file-name ofile)
1232 (setq buffer-file-number onum)
1233 (setq buffer-file-truename otrue)
7906c044 1234 (setq dired-directory odir)
63fabbb4
RS
1235 (lock-buffer)
1236 (rename-buffer oname)))
1237 (unless (eq (current-buffer) obuf)
d97a9ff3
RS
1238 (with-current-buffer obuf
1239 ;; We already asked; don't ask again.
1240 (let ((kill-buffer-query-functions))
1241 (kill-buffer obuf))))))
9b8ef27d 1242\f
b4da00e9
RM
1243(defun create-file-buffer (filename)
1244 "Create a suitably named buffer for visiting FILENAME, and return it.
1245FILENAME (sans directory) is used unchanged if that name is free;
1246otherwise a string <2> or <3> or ... is appended to get an unused name."
1247 (let ((lastname (file-name-nondirectory filename)))
1248 (if (string= lastname "")
1249 (setq lastname filename))
1250 (generate-new-buffer lastname)))
1251
5bbbceb1
JB
1252(defun generate-new-buffer (name)
1253 "Create and return a buffer with a name based on NAME.
29165787 1254Choose the buffer's name using `generate-new-buffer-name'."
5bbbceb1
JB
1255 (get-buffer-create (generate-new-buffer-name name)))
1256
ffc0e1ca
AS
1257(defcustom automount-dir-prefix "^/tmp_mnt/"
1258 "Regexp to match the automounter prefix in a directory name."
1259 :group 'files
1260 :type 'regexp)
e373f201 1261
ffb3a4db 1262(defvar abbreviated-home-dir nil
ffc0e1ca 1263 "The user's homedir abbreviated according to `directory-abbrev-alist'.")
ffb3a4db 1264
5bbbceb1 1265(defun abbreviate-file-name (filename)
29165787 1266 "Return a version of FILENAME shortened using `directory-abbrev-alist'.
b69a0de9 1267This also substitutes \"~\" for the user's home directory and
5baabf7b 1268removes automounter prefixes (see the variable `automount-dir-prefix')."
e373f201 1269 ;; Get rid of the prefixes added by the automounter.
a8f34fc0
RS
1270 (if (and automount-dir-prefix
1271 (string-match automount-dir-prefix filename)
e373f201
JB
1272 (file-exists-p (file-name-directory
1273 (substring filename (1- (match-end 0))))))
1274 (setq filename (substring filename (1- (match-end 0)))))
5bbbceb1 1275 (let ((tail directory-abbrev-alist))
ffb3a4db
RS
1276 ;; If any elt of directory-abbrev-alist matches this name,
1277 ;; abbreviate accordingly.
5bbbceb1
JB
1278 (while tail
1279 (if (string-match (car (car tail)) filename)
1280 (setq filename
1281 (concat (cdr (car tail)) (substring filename (match-end 0)))))
1282 (setq tail (cdr tail)))
ffb3a4db
RS
1283 ;; Compute and save the abbreviated homedir name.
1284 ;; We defer computing this until the first time it's needed, to
1285 ;; give time for directory-abbrev-alist to be set properly.
e98dda89
RS
1286 ;; We include a slash at the end, to avoid spurious matches
1287 ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
ffb3a4db
RS
1288 (or abbreviated-home-dir
1289 (setq abbreviated-home-dir
1290 (let ((abbreviated-home-dir "$foo"))
3a8a836d
RS
1291 (concat "^" (abbreviate-file-name (expand-file-name "~"))
1292 "\\(/\\|$\\)"))))
76d5492b 1293
ffb3a4db
RS
1294 ;; If FILENAME starts with the abbreviated homedir,
1295 ;; make it start with `~' instead.
ca33ccb5
RS
1296 (if (and (string-match abbreviated-home-dir filename)
1297 ;; If the home dir is just /, don't change it.
1298 (not (and (= (match-end 0) 1)
288201bd 1299 (= (aref filename 0) ?/)))
567c1ca9
RS
1300 ;; MS-DOS root directories can come with a drive letter;
1301 ;; Novell Netware allows drive letters beyond `Z:'.
76d5492b 1302 (not (and (or (eq system-type 'ms-dos)
c60ee5e7 1303 (eq system-type 'cygwin)
c32d49e8 1304 (eq system-type 'windows-nt))
288201bd 1305 (save-match-data
567c1ca9 1306 (string-match "^[a-zA-`]:/$" filename)))))
5bbbceb1 1307 (setq filename
28dbf501 1308 (concat "~"
3a8a836d 1309 (substring filename (match-beginning 1) (match-end 1))
28dbf501 1310 (substring filename (match-end 0)))))
5bbbceb1
JB
1311 filename))
1312
21540597 1313(defcustom find-file-not-true-dirname-list nil
1770543d
RS
1314 "*List of logical names for which visiting shouldn't save the true dirname.
1315On VMS, when you visit a file using a logical name that searches a path,
1316you may or may not want the visited file name to record the specific
1317directory where the file was found. If you *do not* want that, add the logical
21540597
RS
1318name to this list as a string."
1319 :type '(repeat (string :tag "Name"))
1320 :group 'find-file)
1770543d 1321
3a64a3cf 1322(defun find-buffer-visiting (filename &optional predicate)
138c44f6
KH
1323 "Return the buffer visiting file FILENAME (a string).
1324This is like `get-file-buffer', except that it checks for any buffer
1325visiting the same file, possibly under a different name.
a1b0c2a7
RS
1326If PREDICATE is non-nil, only buffers satisfying it are eligible,
1327and others are ignored.
138c44f6 1328If there is no such live buffer, return nil."
3a64a3cf
JB
1329 (let ((predicate (or predicate #'identity))
1330 (truename (abbreviate-file-name (file-truename filename))))
1331 (or (let ((buf (get-file-buffer filename)))
1332 (when (and buf (funcall predicate buf)) buf))
1333 (let ((list (buffer-list)) found)
1334 (while (and (not found) list)
1335 (save-excursion
1336 (set-buffer (car list))
1337 (if (and buffer-file-name
1338 (string= buffer-file-truename truename)
1339 (funcall predicate (current-buffer)))
1340 (setq found (car list))))
1341 (setq list (cdr list)))
1342 found)
1343 (let* ((attributes (file-attributes truename))
1344 (number (nthcdr 10 attributes))
1345 (list (buffer-list)) found)
1346 (and buffer-file-numbers-unique
1347 number
1348 (while (and (not found) list)
1349 (with-current-buffer (car list)
1350 (if (and buffer-file-name
1351 (equal buffer-file-number number)
1352 ;; Verify this buffer's file number
1353 ;; still belongs to its file.
1354 (file-exists-p buffer-file-name)
1355 (equal (file-attributes buffer-file-truename)
1356 attributes)
1357 (funcall predicate (current-buffer)))
1358 (setq found (car list))))
1359 (setq list (cdr list))))
1360 found))))
9b8ef27d 1361\f
5de148a2
RS
1362(defcustom find-file-wildcards t
1363 "*Non-nil means file-visiting commands should handle wildcards.
1364For example, if you specify `*.c', that would visit all the files
1365whose names match the pattern."
1366 :group 'files
3957c982 1367 :version "20.4"
5de148a2
RS
1368 :type 'boolean)
1369
ffc0e1ca
AS
1370(defcustom find-file-suppress-same-file-warnings nil
1371 "*Non-nil means suppress warning messages for symlinked files.
1372When nil, Emacs prints a warning when visiting a file that is already
1373visited, but with a different name. Setting this option to t
1374suppresses this warning."
1375 :group 'files
1376 :version "21.1"
1377 :type 'boolean)
1378
818286f4 1379(defcustom large-file-warning-threshold 10000000
5d648479
JPW
1380 "Maximum size of file above which a confirmation is requested.
1381When nil, never request confirmation."
1382 :group 'files
1383 :group 'find-file
bf247b6e 1384 :version "22.1"
5d648479 1385 :type '(choice integer (const :tag "Never request confirmation" nil)))
818286f4 1386
243ce842 1387(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
b4da00e9
RM
1388 "Read file FILENAME into a buffer and return the buffer.
1389If a buffer exists visiting FILENAME, return that one, but
1390verify that the file has not changed since visited or saved.
82d0954a 1391The buffer is not selected, just returned to the caller.
26b9ecbc
JB
1392Optional second arg NOWARN non-nil means suppress any warning messages.
1393Optional third arg RAWFILE non-nil means the file is read literally.
1394Optional fourth arg WILDCARDS non-nil means do wildcard processing
5b8ed07b 1395and visit all the matching files. When wildcards are actually
a9d6a617
JL
1396used and expanded, return a list of buffers that are visiting
1397the various files."
e373f201
JB
1398 (setq filename
1399 (abbreviate-file-name
1400 (expand-file-name filename)))
b4da00e9 1401 (if (file-directory-p filename)
ffc0e1ca
AS
1402 (or (and find-file-run-dired
1403 (run-hook-with-args-until-success
1404 'find-directory-functions
1405 (if find-file-visit-truename
1406 (abbreviate-file-name (file-truename filename))
1407 filename)))
1408 (error "%s is a directory" filename))
243ce842
RS
1409 (if (and wildcards
1410 find-file-wildcards
f91fe604 1411 (not (string-match "\\`/:" filename))
5de148a2 1412 (string-match "[[*?]" filename))
ffc0e1ca
AS
1413 (let ((files (condition-case nil
1414 (file-expand-wildcards filename t)
1415 (error (list filename))))
5de148a2 1416 (find-file-wildcards nil))
f91fe604 1417 (if (null files)
ffc0e1ca 1418 (find-file-noselect filename)
648ec2ff 1419 (mapcar #'find-file-noselect files)))
5de148a2
RS
1420 (let* ((buf (get-file-buffer filename))
1421 (truename (abbreviate-file-name (file-truename filename)))
818286f4
SM
1422 (attributes (file-attributes truename))
1423 (number (nthcdr 10 attributes))
5de148a2
RS
1424 ;; Find any buffer for a file which has same truename.
1425 (other (and (not buf) (find-buffer-visiting filename))))
1426 ;; Let user know if there is a buffer with the same truename.
1427 (if other
1428 (progn
1429 (or nowarn
ffc0e1ca 1430 find-file-suppress-same-file-warnings
5de148a2
RS
1431 (string-equal filename (buffer-file-name other))
1432 (message "%s and %s are the same file"
1433 filename (buffer-file-name other)))
1434 ;; Optionally also find that buffer.
1435 (if (or find-file-existing-other-name find-file-visit-truename)
1436 (setq buf other))))
818286f4
SM
1437 ;; Check to see if the file looks uncommonly large.
1438 (when (and large-file-warning-threshold (nth 7 attributes)
1439 ;; Don't ask again if we already have the file or
1440 ;; if we're asked to be quiet.
1441 (not (or buf nowarn))
1442 (> (nth 7 attributes) large-file-warning-threshold)
1443 (not (y-or-n-p
879bae91 1444 (format "File %s is large (%dMB), really open? "
818286f4
SM
1445 (file-name-nondirectory filename)
1446 (/ (nth 7 attributes) 1048576)))))
1447 (error "Aborted"))
5de148a2
RS
1448 (if buf
1449 ;; We are using an existing buffer.
1450 (progn
1451 (or nowarn
1452 (verify-visited-file-modtime buf)
1453 (cond ((not (file-exists-p filename))
1454 (error "File %s no longer exists!" filename))
1455 ;; Certain files should be reverted automatically
1456 ;; if they have changed on disk and not in the buffer.
1457 ((and (not (buffer-modified-p buf))
1458 (let ((tail revert-without-query)
1459 (found nil))
1460 (while tail
1461 (if (string-match (car tail) filename)
1462 (setq found t))
1463 (setq tail (cdr tail)))
1464 found))
1465 (with-current-buffer buf
1466 (message "Reverting file %s..." filename)
1467 (revert-buffer t t)
1468 (message "Reverting file %s...done" filename)))
1469 ((yes-or-no-p
1470 (if (string= (file-name-nondirectory filename)
1471 (buffer-name buf))
1472 (format
1473 (if (buffer-modified-p buf)
1474 "File %s changed on disk. Discard your edits? "
1475 "File %s changed on disk. Reread from disk? ")
1476 (file-name-nondirectory filename))
ddd64da9
RS
1477 (format
1478 (if (buffer-modified-p buf)
5de148a2
RS
1479 "File %s changed on disk. Discard your edits in %s? "
1480 "File %s changed on disk. Reread from disk into %s? ")
1481 (file-name-nondirectory filename)
1482 (buffer-name buf))))
1483 (with-current-buffer buf
1484 (revert-buffer t t)))))
1485 (with-current-buffer buf
a8d002d2
GM
1486
1487 ;; Check if a formerly read-only file has become
e554eeb7
RS
1488 ;; writable and vice versa, but if the buffer agrees
1489 ;; with the new state of the file, that is ok too.
a8d002d2 1490 (let ((read-only (not (file-writable-p buffer-file-name))))
e554eeb7
RS
1491 (unless (or (eq read-only buffer-file-read-only)
1492 (eq read-only buffer-read-only))
a8d002d2 1493 (when (or nowarn
36236b72 1494 (let ((question
a8d002d2
GM
1495 (format "File %s is %s on disk. Change buffer mode? "
1496 buffer-file-name
1497 (if read-only "read-only" "writable"))))
1498 (y-or-n-p question)))
e554eeb7
RS
1499 (setq buffer-read-only read-only)))
1500 (setq buffer-file-read-only read-only))
a8d002d2 1501
ef59dd3b
EZ
1502 (when (and (not (eq (not (null rawfile))
1503 (not (null find-file-literally))))
1504 ;; It is confusing to ask whether to visit
1505 ;; non-literally if they have the file in
1506 ;; hexl-mode.
1507 (not (eq major-mode 'hexl-mode)))
5de148a2 1508 (if (buffer-modified-p)
ddd64da9 1509 (if (y-or-n-p (if rawfile
5de148a2
RS
1510 "Save file and revisit literally? "
1511 "Save file and revisit non-literally? "))
1512 (progn
1513 (save-buffer)
1514 (find-file-noselect-1 buf filename nowarn
1515 rawfile truename number))
1516 (if (y-or-n-p (if rawfile
1517 "Discard your edits and revisit file literally? "
1518 "Discard your edits and revisit file non-literally? "))
1519 (find-file-noselect-1 buf filename nowarn
1520 rawfile truename number)
1521 (error (if rawfile "File already visited non-literally"
1522 "File already visited literally"))))
1523 (if (y-or-n-p (if rawfile
1524 "Revisit file literally? "
1525 "Revisit file non-literally? "))
1526 (find-file-noselect-1 buf filename nowarn
1527 rawfile truename number)
1528 (error (if rawfile "File already visited non-literally"
1529 "File already visited literally"))))))
1530 ;; Return the buffer we are using.
1531 buf)
1532 ;; Create a new buffer.
1533 (setq buf (create-file-buffer filename))
5de148a2
RS
1534 ;; find-file-noselect-1 may use a different buffer.
1535 (find-file-noselect-1 buf filename nowarn
1536 rawfile truename number))))))
ddd64da9
RS
1537
1538(defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
4edcfd17 1539 (let (error)
ddd64da9
RS
1540 (with-current-buffer buf
1541 (kill-local-variable 'find-file-literally)
b296cbd4
RS
1542 ;; Needed in case we are re-visiting the file with a different
1543 ;; text representation.
e73ec04b 1544 (kill-local-variable 'buffer-file-coding-system)
4ad1689f 1545 (kill-local-variable 'cursor-type)
4edcfd17 1546 (let ((inhibit-read-only t))
0a11c70b
LT
1547 (erase-buffer))
1548 (and (default-value 'enable-multibyte-characters)
1549 (not rawfile)
1550 (set-buffer-multibyte t))
1551 (if rawfile
74dca654 1552 (condition-case ()
0a11c70b
LT
1553 (let ((inhibit-read-only t))
1554 (insert-file-contents-literally filename t))
74dca654
LT
1555 (file-error
1556 (when (and (file-exists-p filename)
1557 (not (file-readable-p filename)))
1558 (kill-buffer buf)
1559 (signal 'file-error (list "File is not readable"
1560 filename)))
0a11c70b
LT
1561 ;; Unconditionally set error
1562 (setq error t)))
1563 (condition-case ()
1564 (let ((inhibit-read-only t))
1565 (insert-file-contents filename t))
1566 (file-error
1567 (when (and (file-exists-p filename)
1568 (not (file-readable-p filename)))
1569 (kill-buffer buf)
1570 (signal 'file-error (list "File is not readable"
1571 filename)))
1572 ;; Run find-file-not-found-hooks until one returns non-nil.
1573 (or (run-hook-with-args-until-success 'find-file-not-found-functions)
1574 ;; If they fail too, set error.
1575 (setq error t)))))
b120e713
KH
1576 ;; Record the file's truename, and maybe use that as visited name.
1577 (if (equal filename buffer-file-name)
1578 (setq buffer-file-truename truename)
9ab19105
DL
1579 (setq buffer-file-truename
1580 (abbreviate-file-name (file-truename buffer-file-name))))
ddd64da9
RS
1581 (setq buffer-file-number number)
1582 ;; On VMS, we may want to remember which directory in a search list
1583 ;; the file was found in.
1584 (and (eq system-type 'vax-vms)
1585 (let (logical)
1586 (if (string-match ":" (file-name-directory filename))
1587 (setq logical (substring (file-name-directory filename)
1588 0 (match-beginning 0))))
1589 (not (member logical find-file-not-true-dirname-list)))
1590 (setq buffer-file-name buffer-file-truename))
1591 (if find-file-visit-truename
1592 (setq buffer-file-name
1593 (setq filename
1594 (expand-file-name buffer-file-truename))))
1595 ;; Set buffer's default directory to that of the file.
b120e713 1596 (setq default-directory (file-name-directory buffer-file-name))
ddd64da9
RS
1597 ;; Turn off backup files for certain file names. Since
1598 ;; this is a permanent local, the major mode won't eliminate it.
1599 (and (not (funcall backup-enable-predicate buffer-file-name))
1600 (progn
1601 (make-local-variable 'backup-inhibited)
1602 (setq backup-inhibited t)))
f402ba38
RS
1603 (if rawfile
1604 (progn
1605 (set-buffer-multibyte nil)
1606 (setq buffer-file-coding-system 'no-conversion)
e8f30180 1607 (set-buffer-major-mode buf)
f402ba38
RS
1608 (make-local-variable 'find-file-literally)
1609 (setq find-file-literally t))
1610 (after-find-file error (not nowarn)))
1611 (current-buffer))))
9b8ef27d
RS
1612\f
1613(defun insert-file-contents-literally (filename &optional visit beg end replace)
1614 "Like `insert-file-contents', but only reads in the file literally.
1615A buffer may be modified in several ways after reading into the buffer,
1616to Emacs features such as format decoding, character code
0370fe77 1617conversion, `find-file-hook', automatic uncompression, etc.
9b8ef27d
RS
1618
1619This function ensures that none of these modifications will take place."
1620 (let ((format-alist nil)
1621 (after-insert-file-functions nil)
1622 (coding-system-for-read 'no-conversion)
1623 (coding-system-for-write 'no-conversion)
9b8ef27d 1624 (find-buffer-file-type-function
cdec2ad7
JB
1625 (if (fboundp 'find-buffer-file-type)
1626 (symbol-function 'find-buffer-file-type)
1627 nil))
1628 (inhibit-file-name-handlers
1629 (append '(jka-compr-handler image-file-handler)
1630 inhibit-file-name-handlers))
1631 (inhibit-file-name-operation 'insert-file-contents))
9b8ef27d 1632 (unwind-protect
cdec2ad7
JB
1633 (progn
1634 (fset 'find-buffer-file-type (lambda (filename) t))
1635 (insert-file-contents filename visit beg end replace))
9b8ef27d
RS
1636 (if find-buffer-file-type-function
1637 (fset 'find-buffer-file-type find-buffer-file-type-function)
1638 (fmakunbound 'find-buffer-file-type)))))
1639
3a64a3cf
JB
1640(defun insert-file-1 (filename insert-func)
1641 (if (file-directory-p filename)
1642 (signal 'file-error (list "Opening input file" "file is a directory"
1643 filename)))
1644 (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename))
1645 #'buffer-modified-p))
1646 (tem (funcall insert-func filename)))
1647 (push-mark (+ (point) (car (cdr tem))))
1648 (when buffer
1649 (message "File %s already visited and modified in buffer %s"
1650 filename (buffer-name buffer)))))
1651
9b8ef27d
RS
1652(defun insert-file-literally (filename)
1653 "Insert contents of file FILENAME into buffer after point with no conversion.
1654
1655This function is meant for the user to run interactively.
1656Don't call it from programs! Use `insert-file-contents-literally' instead.
1657\(Its calling sequence is different; see its documentation)."
1658 (interactive "*fInsert file literally: ")
3a64a3cf 1659 (insert-file-1 filename #'insert-file-contents-literally))
9b8ef27d
RS
1660
1661(defvar find-file-literally nil
1662 "Non-nil if this buffer was made by `find-file-literally' or equivalent.
1663This is a permanent local.")
1664(put 'find-file-literally 'permanent-local t)
5fc196af 1665
ffc0e1ca 1666(defun find-file-literally (filename)
5fc196af
RS
1667 "Visit file FILENAME with no conversion of any kind.
1668Format conversion and character code conversion are both disabled,
1669and multibyte characters are disabled in the resulting buffer.
e65db7b8
RS
1670The major mode used is Fundamental mode regardless of the file name,
1671and local variable specifications in the file are ignored.
407b4328
GM
1672Automatic uncompression and adding a newline at the end of the
1673file due to `require-final-newline' is also disabled.
9b8ef27d
RS
1674
1675You cannot absolutely rely on this function to result in
b9aa9537 1676visiting the file literally. If Emacs already has a buffer
9b8ef27d
RS
1677which is visiting the file, you get the existing buffer,
1678regardless of whether it was created literally or not.
1679
1680In a Lisp program, if you want to be sure of accessing a file's
1681contents literally, you should create a temporary buffer and then read
1682the file contents into it using `insert-file-contents-literally'."
5fc196af 1683 (interactive "FFind file literally: ")
9b8ef27d 1684 (switch-to-buffer (find-file-noselect filename nil t)))
b4da00e9 1685\f
f7d786d0
RS
1686(defvar after-find-file-from-revert-buffer nil)
1687
e0ab8879 1688(defun after-find-file (&optional error warn noauto
9a30563f
RS
1689 after-find-file-from-revert-buffer
1690 nomodes)
b4da00e9
RM
1691 "Called after finding a file and by the default revert function.
1692Sets buffer mode, parses local variables.
8cfb9d46 1693Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
b4da00e9
RM
1694error in reading the file. WARN non-nil means warn if there
1695exists an auto-save file more recent than the visited file.
8cfb9d46 1696NOAUTO means don't mess with auto-save mode.
e0ab8879
RS
1697Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
1698 means this call was from `revert-buffer'.
9a30563f 1699Fifth arg NOMODES non-nil means don't alter the file's modes.
0370fe77 1700Finishes by calling the functions in `find-file-hook'
9a30563f 1701unless NOMODES is non-nil."
b4da00e9
RM
1702 (setq buffer-read-only (not (file-writable-p buffer-file-name)))
1703 (if noninteractive
1704 nil
1705 (let* (not-serious
1706 (msg
fe50b6ab
GM
1707 (cond
1708 ((not warn) nil)
1709 ((and error (file-attributes buffer-file-name))
1710 (setq buffer-read-only t)
1711 "File exists, but cannot be read")
1712 ((not buffer-read-only)
1713 (if (and warn
1714 ;; No need to warn if buffer is auto-saved
1715 ;; under the name of the visited file.
1716 (not (and buffer-file-name
1717 auto-save-visited-file-name))
1718 (file-newer-than-file-p (or buffer-auto-save-file-name
1719 (make-auto-save-file-name))
1720 buffer-file-name))
64d18e8f 1721 (format "%s has auto save data; consider M-x recover-this-file"
fe50b6ab
GM
1722 (file-name-nondirectory buffer-file-name))
1723 (setq not-serious t)
1724 (if error "(New file)" nil)))
1725 ((not error)
1726 (setq not-serious t)
1727 "Note: file is write protected")
1728 ((file-attributes (directory-file-name default-directory))
1729 "File not found and directory write-protected")
1730 ((file-exists-p (file-name-directory buffer-file-name))
1731 (setq buffer-read-only nil))
1732 (t
1733 (setq buffer-read-only nil)
07703430 1734 "Use M-x make-directory RET RET to create the directory and its parents"))))
fe50b6ab 1735 (when msg
a74357d4 1736 (message "%s" msg)
e09f3bff 1737 (or not-serious (sit-for 1 t))))
fe50b6ab
GM
1738 (when (and auto-save-default (not noauto))
1739 (auto-save-mode t)))
ffc0e1ca
AS
1740 ;; Make people do a little extra work (C-x C-q)
1741 ;; before altering a backup file.
fe50b6ab
GM
1742 (when (backup-file-name-p buffer-file-name)
1743 (setq buffer-read-only t))
8fd9c174
RS
1744 ;; When a file is marked read-only,
1745 ;; make the buffer read-only even if root is looking at it.
879365c6
KS
1746 (when (and (file-modes (buffer-file-name))
1747 (zerop (logand (file-modes (buffer-file-name)) #o222)))
8fd9c174 1748 (setq buffer-read-only t))
fe50b6ab
GM
1749 (unless nomodes
1750 (when (and view-read-only view-mode)
1751 (view-mode-disable))
9a30563f 1752 (normal-mode t)
f4206092
RS
1753 ;; If requested, add a newline at the end of the file.
1754 (and (memq require-final-newline '(visit visit-save))
1755 (> (point-max) (point-min))
1756 (/= (char-after (1- (point-max))) ?\n)
1757 (not (and (eq selective-display t)
1758 (= (char-after (1- (point-max))) ?\r)))
1759 (save-excursion
1760 (goto-char (point-max))
1761 (insert "\n")))
fe50b6ab
GM
1762 (when (and buffer-read-only
1763 view-read-only
1764 (not (eq (get major-mode 'mode-class) 'special)))
1765 (view-mode-enter))
0370fe77 1766 (run-hooks 'find-file-hook)))
b4da00e9 1767
818286f4
SM
1768(defmacro report-errors (format &rest body)
1769 "Eval BODY and turn any error into a FORMAT message.
1770FORMAT can have a %s escape which will be replaced with the actual error.
1771If `debug-on-error' is set, errors are not caught, so that you can
1772debug them.
1773Avoid using a large BODY since it is duplicated."
1774 (declare (debug t) (indent 1))
1775 `(if debug-on-error
1776 (progn . ,body)
1777 (condition-case err
1778 (progn . ,body)
1779 (error (message ,format (prin1-to-string err))))))
1780
b4da00e9
RM
1781(defun normal-mode (&optional find-file)
1782 "Choose the major mode for this buffer automatically.
1783Also sets up any specified local variables of the file.
1784Uses the visited file name, the -*- line, and the local variables spec.
1785
1786This function is called automatically from `find-file'. In that case,
aa5fcebf 1787we may set up the file-specified mode and local variables,
a5ce12c3 1788depending on the value of `enable-local-variables'.
aa5fcebf
KH
1789In addition, if `local-enable-local-variables' is nil, we do
1790not set local variables (though we do notice a mode specified with -*-.)
1791
1792`enable-local-variables' is ignored if you run `normal-mode' interactively,
1793or from Lisp without specifying the optional argument FIND-FILE;
1794in that case, this function acts as if `enable-local-variables' were t."
b4da00e9 1795 (interactive)
e8f30180 1796 (funcall (or default-major-mode 'fundamental-mode))
0fc205c6
LT
1797 (let ((enable-local-variables (or (not find-file) enable-local-variables)))
1798 (report-errors "File mode specification error: %s"
1799 (set-auto-mode))
1800 (report-errors "File local-variables error: %s"
818286f4 1801 (hack-local-variables)))
6e86be0b
RS
1802 ;; Turn font lock off and on, to make sure it takes account of
1803 ;; whatever file local variables are relevant to it.
344f1111
SM
1804 (when (and font-lock-mode
1805 ;; Font-lock-mode (now in font-core.el) can be ON when
1806 ;; font-lock.el still hasn't been loaded.
1807 (boundp 'font-lock-keywords)
1808 (eq (car font-lock-keywords) t))
6e86be0b
RS
1809 (setq font-lock-keywords (cadr font-lock-keywords))
1810 (font-lock-mode 1))
1811
24c9eeeb
DL
1812 (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
1813 (ucs-set-table-for-input)))
b4da00e9 1814
f76e0cd0 1815(defvar auto-mode-alist
f209c999
MS
1816 ;; Note: The entries for the modes defined in cc-mode.el (c-mode,
1817 ;; c++-mode, java-mode and more) are added through autoload
1818 ;; directives in that file. That way is discouraged since it
1819 ;; spreads out the definition of the initial value.
ffc0e1ca
AS
1820 (mapc
1821 (lambda (elt)
1822 (cons (purecopy (car elt)) (cdr elt)))
813731b3 1823 `(;; do this first, so that .html.pl is Polish html, not Perl
9e6f5419
DP
1824 ("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode)
1825 ("\\.te?xt\\'" . text-mode)
bbc67516 1826 ("\\.[tT]e[xX]\\'" . tex-mode)
4e163715 1827 ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
ffc0e1ca 1828 ("\\.ltx\\'" . latex-mode)
4e163715 1829 ("\\.dtx\\'" . doctex-mode)
ffc0e1ca 1830 ("\\.el\\'" . emacs-lisp-mode)
21575d92 1831 ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
ffc0e1ca 1832 ("\\.l\\'" . lisp-mode)
bbc67516
DP
1833 ("\\.li?sp\\'" . lisp-mode)
1834 ("\\.[fF]\\'" . fortran-mode)
ffc0e1ca
AS
1835 ("\\.for\\'" . fortran-mode)
1836 ("\\.p\\'" . pascal-mode)
1837 ("\\.pas\\'" . pascal-mode)
1838 ("\\.ad[abs]\\'" . ada-mode)
7defe888 1839 ("\\.ad[bs].dg\\'" . ada-mode)
bbc67516 1840 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
3968c89f 1841 ("Imakefile\\'" . makefile-imake-mode)
813731b3
DP
1842 ,@(if (memq system-type '(berkeley-unix next-mach darwin))
1843 '(("\\.mk\\'" . makefile-bsdmake-mode)
47d4e709 1844 ("GNUmakefile\\'" . makefile-gmake-mode)
813731b3
DP
1845 ("[Mm]akefile\\'" . makefile-bsdmake-mode))
1846 '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
47d4e709 1847 ("[Mm]akefile\\'" . makefile-gmake-mode)))
27a7c83f
DP
1848 ("Makeppfile\\'" . makefile-makepp-mode)
1849 ("\\.am\\'" . makefile-automake-mode)
5c6d31a4
SM
1850 ;; Less common extensions come here
1851 ;; so more common ones above are found faster.
ffc0e1ca
AS
1852 ("\\.texinfo\\'" . texinfo-mode)
1853 ("\\.te?xi\\'" . texinfo-mode)
bbc67516 1854 ("\\.[sS]\\'" . asm-mode)
ffc0e1ca 1855 ("\\.asm\\'" . asm-mode)
bbc67516
DP
1856 ("[cC]hange\\.?[lL]og?\\'" . change-log-mode)
1857 ("[cC]hange[lL]og\\.[0-9]+\\'" . change-log-mode)
ffc0e1ca
AS
1858 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
1859 ("\\.scm\\.[0-9]*\\'" . scheme-mode)
1860 ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
b921b596 1861 ("\\.bash\\'" . sh-mode)
ffc0e1ca
AS
1862 ("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode)
1863 ("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
1864 ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
d5798fa7 1865 ("\\.m?spec\\'" . sh-mode)
bbc67516 1866 ("\\.m[mes]\\'" . nroff-mode)
ffc0e1ca 1867 ("\\.man\\'" . nroff-mode)
ffc0e1ca 1868 ("\\.sty\\'" . latex-mode)
bbc67516 1869 ("\\.cl[so]\\'" . latex-mode) ;LaTeX 2e class option
ffc0e1ca
AS
1870 ("\\.bbl\\'" . latex-mode)
1871 ("\\.bib\\'" . bibtex-mode)
1872 ("\\.sql\\'" . sql-mode)
bbc67516 1873 ("\\.m[4c]\\'" . m4-mode)
9e6f5419
DP
1874 ("\\.mf\\'" . metafont-mode)
1875 ("\\.mp\\'" . metapost-mode)
ffc0e1ca
AS
1876 ("\\.vhdl?\\'" . vhdl-mode)
1877 ("\\.article\\'" . text-mode)
1878 ("\\.letter\\'" . text-mode)
bbc67516 1879 ("\\.i?tcl\\'" . tcl-mode)
ffc0e1ca 1880 ("\\.exp\\'" . tcl-mode)
ffc0e1ca
AS
1881 ("\\.itk\\'" . tcl-mode)
1882 ("\\.icn\\'" . icon-mode)
1883 ("\\.sim\\'" . simula-mode)
1884 ("\\.mss\\'" . scribe-mode)
bbc67516 1885 ("\\.f9[05]\\'" . f90-mode)
8f9495e7 1886 ("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
ffc0e1ca 1887 ("\\.pro\\'" . idlwave-mode)
ffc0e1ca
AS
1888 ("\\.prolog\\'" . prolog-mode)
1889 ("\\.tar\\'" . tar-mode)
0ee6e7b7
JL
1890 ;; The list of archive file extensions should be in sync with
1891 ;; `auto-coding-alist' with `no-conversion' coding system.
e084f8c3
EZ
1892 ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|[jew]ar\\|xpi\\)\\'" . archive-mode)
1893 ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . archive-mode)
d5040404 1894 ("\\.\\(sx[dmicw]\\|odt\\)\\'" . archive-mode) ; OpenOffice.org
ffc0e1ca
AS
1895 ;; Mailer puts message to be edited in
1896 ;; /tmp/Re.... or Message
1897 ("\\`/tmp/Re" . text-mode)
1898 ("/Message[0-9]*\\'" . text-mode)
ffc0e1ca
AS
1899 ("\\.zone\\'" . zone-mode)
1900 ;; some news reader is reported to use this
1901 ("\\`/tmp/fol/" . text-mode)
ffc0e1ca
AS
1902 ("\\.oak\\'" . scheme-mode)
1903 ("\\.sgml?\\'" . sgml-mode)
bbc67516 1904 ("\\.x[ms]l\\'" . xml-mode)
ffc0e1ca
AS
1905 ("\\.dtd\\'" . sgml-mode)
1906 ("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
bbc67516
DP
1907 ("\\.js\\'" . java-mode) ; javascript-mode would be better
1908 ("\\.x[bp]m\\'" . c-mode)
709d45e1
KG
1909 ;; .emacs or .gnus or .viper following a directory delimiter in
1910 ;; Unix, MSDOG or VMS syntax.
1911 ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
ffc0e1ca
AS
1912 ("\\`\\..*emacs\\'" . emacs-lisp-mode)
1913 ;; _emacs following a directory delimiter
1914 ;; in MsDos syntax
1915 ("[:/]_emacs\\'" . emacs-lisp-mode)
1916 ("/crontab\\.X*[0-9]+\\'" . shell-script-mode)
1917 ("\\.ml\\'" . lisp-mode)
d5798fa7
SM
1918 ("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode)
1919 ("\\.\\(as\\|mi\\|sm\\)2\\'" . snmpv2-mode)
ffc0e1ca 1920 ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
e854cc22 1921 ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG
d5798fa7 1922 ("\\.[eE]?[pP][sS]\\'" . ps-mode)
e55c4863 1923 ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
ffc0e1ca
AS
1924 ("BROWSE\\'" . ebrowse-tree-mode)
1925 ("\\.ebrowse\\'" . ebrowse-tree-mode)
9ee45b2c 1926 ("#\\*mail\\*" . mail-mode)
80174d35
DP
1927 ("\\.g\\'" . antlr-mode)
1928 ("\\.ses\\'" . ses-mode)
1929 ("\\.\\(soa\\|zone\\)\\'" . dns-mode)
1930 ("\\.docbook\\'" . sgml-mode)
00daa381 1931 ("\\.com\\'" . dcl-mode)
80174d35
DP
1932 ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode)
1933 ;; Windows candidates may be opened case sensitively on Unix
1934 ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode)
1935 ("\\.\\(?:desktop\\|la\\)\\'" . conf-unix-mode)
08adf84e 1936 ("\\.ppd\\'" . conf-ppd-mode)
80174d35
DP
1937 ("java.+\\.conf\\'" . conf-javaprop-mode)
1938 ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode)
1939 ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config
1940 ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode)
a35d9075
AS
1941 ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
1942 ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
80174d35
DP
1943 ;; either user's dot-files or under /etc or some such
1944 ("/\\.?\\(?:gnokiirc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
1945 ;; alas not all ~/.*rc files are like this
b14f1885 1946 ("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode)
80174d35
DP
1947 ("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode)
1948 ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode)
1949 ("/X11.+app-defaults/" . conf-xdefaults-mode)
1950 ("/X11.+locale/.+/Compose\\'" . conf-colon-mode)
1951 ;; this contains everything twice, with space and with colon :-(
1952 ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode)
9ee45b2c
SM
1953 ;; Get rid of any trailing .n.m and try again.
1954 ;; This is for files saved by cvs-merge that look like .#<file>.<rev>
5c6d31a4
SM
1955 ;; or .#<file>.<rev>-<rev> or VC's <file>.~<rev>~.
1956 ;; Using mode nil rather than `ignore' would let the search continue
1957 ;; through this list (with the shortened name) rather than start over.
bbc67516 1958 ("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t)
5c6d31a4
SM
1959 ;; The following should come after the ChangeLog pattern
1960 ;; for the sake of ChangeLog.1, etc.
1961 ;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
e043664a 1962 ("\\.[1-9]\\'" . nroff-mode)
80174d35 1963 ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t)))
ffc0e1ca 1964 "Alist of filename patterns vs corresponding major mode functions.
116987ba
RS
1965Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
1966\(NON-NIL stands for anything that is not nil; the value does not matter.)
1967Visiting a file whose name matches REGEXP specifies FUNCTION as the
1968mode function to use. FUNCTION will be called, unless it is nil.
1969
1970If the element has the form (REGEXP FUNCTION NON-NIL), then after
1971calling FUNCTION (if it's not nil), we delete the suffix that matched
969be033 1972REGEXP and search the list again for another match.
7b3f3dc2 1973
969be033
RS
1974If the file name matches `inhibit-first-line-modes-regexps',
1975then `auto-mode-alist' is not processed.
1976
d5040404
EZ
1977The extensions whose FUNCTION is `archive-mode' should also
1978appear in `auto-coding-alist' with `no-conversion' coding system.
1979
969be033
RS
1980See also `interpreter-mode-alist', which detects executable script modes
1981based on the interpreters they specify to run,
1982and `magic-mode-alist', which determines modes based on file contents.")
e13322a0 1983
d7fa5aa2 1984(defvar interpreter-mode-alist
f209c999
MS
1985 ;; Note: The entries for the modes defined in cc-mode.el (awk-mode
1986 ;; and pike-mode) are added through autoload directives in that
1987 ;; file. That way is discouraged since it spreads out the
1988 ;; definition of the initial value.
ffc0e1ca
AS
1989 (mapc
1990 (lambda (l)
1991 (cons (purecopy (car l)) (cdr l)))
1992 '(("perl" . perl-mode)
1993 ("perl5" . perl-mode)
1994 ("miniperl" . perl-mode)
1995 ("wish" . tcl-mode)
1996 ("wishx" . tcl-mode)
1997 ("tcl" . tcl-mode)
1998 ("tclsh" . tcl-mode)
ffc0e1ca
AS
1999 ("scm" . scheme-mode)
2000 ("ash" . sh-mode)
2001 ("bash" . sh-mode)
2002 ("bash2" . sh-mode)
2003 ("csh" . sh-mode)
2004 ("dtksh" . sh-mode)
2005 ("es" . sh-mode)
2006 ("itcsh" . sh-mode)
2007 ("jsh" . sh-mode)
2008 ("ksh" . sh-mode)
2009 ("oash" . sh-mode)
2010 ("pdksh" . sh-mode)
2011 ("rc" . sh-mode)
2012 ("rpm" . sh-mode)
2013 ("sh" . sh-mode)
2014 ("sh5" . sh-mode)
2015 ("tcsh" . sh-mode)
2016 ("wksh" . sh-mode)
2017 ("wsh" . sh-mode)
2018 ("zsh" . sh-mode)
2019 ("tail" . text-mode)
2020 ("more" . text-mode)
2021 ("less" . text-mode)
2022 ("pg" . text-mode)
27a7c83f 2023 ("make" . makefile-gmake-mode) ; Debian uses this
ffc0e1ca
AS
2024 ("guile" . scheme-mode)
2025 ("clisp" . lisp-mode)))
c907d156 2026 "Alist mapping interpreter names to major modes.
969be033 2027This is used for files whose first lines match `auto-mode-interpreter-regexp'.
c907d156 2028Each element looks like (INTERPRETER . MODE).
9f01a773
RS
2029If INTERPRETER matches the name of the interpreter specified in the first line
2030of a script, mode MODE is enabled.
969be033
RS
2031
2032See also `auto-mode-alist'.")
c907d156 2033
d7fa5aa2 2034(defvar inhibit-first-line-modes-regexps '("\\.tar\\'" "\\.tgz\\'")
45fb3bb8 2035 "List of regexps; if one matches a file name, don't look for `-*-'.")
a0c9f21b 2036
d7fa5aa2 2037(defvar inhibit-first-line-modes-suffixes nil
b20ff6d0
RS
2038 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
2039When checking `inhibit-first-line-modes-regexps', we first discard
2040from the end of the file name anything that matches one of these regexps.")
2041
ffc0e1ca
AS
2042(defvar auto-mode-interpreter-regexp
2043 "#![ \t]?\\([^ \t\n]*\
2044/bin/env[ \t]\\)?\\([^ \t\n]+\\)"
54005870 2045 "Regexp matching interpreters, for file mode determination.
ffc0e1ca 2046This regular expression is matched against the first line of a file
54005870
LT
2047to determine the file's mode in `set-auto-mode'. If it matches, the file
2048is assumed to be interpreted by the interpreter matched by the second group
2049of the regular expression. The mode is then determined as the mode
2050associated with that interpreter in `interpreter-mode-alist'.")
0720b68b 2051
4ac1d37a 2052(defvar magic-mode-alist
32a0479a 2053 `(;; The < comes before the groups (but the first) to reduce backtracking.
4ac1d37a 2054 ;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff.
a52152f8 2055 ;; We use [ \t\n] instead of `\\s ' to make regex overflow less likely.
32a0479a 2056 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
a52152f8
RS
2057 (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\n]*<\\)")))
2058 (concat "\\(?:<\\?xml[ \t\n]+[^>]*>\\)?[ \t\n]*<"
32a0479a 2059 comment-re "*"
a52152f8 2060 "\\(?:!DOCTYPE[ \t\n]+[^>]*>[ \t\n]*<[ \t\n]*" comment-re "*\\)?"
969be033
RS
2061 "[Hh][Tt][Mm][Ll]"))
2062 . html-mode)
4ac1d37a
DP
2063 ;; These two must come after html, because they are more general:
2064 ("<\\?xml " . xml-mode)
811cab86 2065 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
a52152f8
RS
2066 (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\n]*<\\)")))
2067 (concat "[ \t\n]*<" comment-re "*!DOCTYPE "))
969be033 2068 . sgml-mode)
80174d35
DP
2069 ("%![^V]" . ps-mode)
2070 ("# xmcd " . conf-unix-mode))
2071 "Alist of buffer beginnings vs. corresponding major mode functions.
44dce0fb
RS
2072Each element looks like (REGEXP . FUNCTION). After visiting a file,
2073if REGEXP matches the text at the beginning of the buffer,
2074`normal-mode' will call FUNCTION rather than allowing `auto-mode-alist'
2075to decide the buffer's major mode.
2076
2077If FUNCTION is nil, then it is not called. (That is a way of saying
26b9ecbc 2078\"allow `auto-mode-alist' to decide for these files.\")")
bbc67516 2079
5cce080e
KS
2080(defvar magic-mode-regexp-match-limit 4000
2081 "Upper limit on `magic-mode-alist' regexp matches.")
2082
9e6f5419 2083(defun set-auto-mode (&optional keep-mode-if-same)
b4da00e9 2084 "Select major mode appropriate for current buffer.
4ac1d37a 2085
bbc67516
DP
2086This checks for a -*- mode tag in the buffer's text, checks the
2087interpreter that runs this file against `interpreter-mode-alist',
811cab86
JL
2088compares the buffer beginning against `magic-mode-alist', or
2089compares the filename against the entries in `auto-mode-alist'.
e3998da1
RS
2090
2091It does not check for the `mode:' local variable in the
2092Local Variables section of the file; for that, use `hack-local-variables'.
7b3f3dc2 2093
f3e23606 2094If `enable-local-variables' is nil, this function does not check for a
9de9b6a2
RS
2095-*- mode tag.
2096
521cf174
DP
2097If the optional argument KEEP-MODE-IF-SAME is non-nil, then we
2098only set the major mode, if that would change it."
b4da00e9 2099 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
811cab86 2100 (let (end done mode modes)
9e6f5419
DP
2101 ;; Find a -*- mode tag
2102 (save-excursion
2103 (goto-char (point-min))
2104 (skip-chars-forward " \t\n")
9e6f5419
DP
2105 (and enable-local-variables
2106 (setq end (set-auto-mode-1))
2107 (if (save-excursion (search-forward ":" end t))
2108 ;; Find all specifications for the `mode:' variable
2109 ;; and execute them left to right.
2110 (while (let ((case-fold-search t))
2111 (or (and (looking-at "mode:")
2112 (goto-char (match-end 0)))
2113 (re-search-forward "[ \t;]mode:" end t)))
2114 (skip-chars-forward " \t")
2115 (let ((beg (point)))
2116 (if (search-forward ";" end t)
2117 (forward-char -1)
2118 (goto-char end))
2119 (skip-chars-backward " \t")
2120 (push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
2121 modes)))
2122 ;; Simple -*-MODE-*- case.
2123 (push (intern (concat (downcase (buffer-substring (point) end))
2124 "-mode"))
2125 modes))))
2126 ;; If we found modes to use, invoke them now, outside the save-excursion.
2127 (if modes
521cf174
DP
2128 (catch 'nop
2129 (dolist (mode (nreverse modes))
2130 (if (not (functionp mode))
2131 (message "Ignoring unknown mode `%s'" mode)
2132 (setq done t)
3467488e 2133 (or (set-auto-mode-0 mode keep-mode-if-same)
df4d0613 2134 ;; continuing would call minor modes again, toggling them off
ec6328a2
EZ
2135 (throw 'nop nil))))))
2136 (unless done
9e6f5419
DP
2137 ;; If we didn't, look for an interpreter specified in the first line.
2138 ;; As a special case, allow for things like "#!/bin/env perl", which
2139 ;; finds the interpreter anywhere in $PATH.
2140 (setq mode (save-excursion
2141 (goto-char (point-min))
2142 (if (looking-at auto-mode-interpreter-regexp)
2143 (match-string 2)
2144 ""))
2145 ;; Map interpreter name to a mode, signalling we're done at the
2146 ;; same time.
2147 done (assoc (file-name-nondirectory mode)
df4d0613 2148 interpreter-mode-alist))
811cab86 2149 ;; If we found an interpreter mode to use, invoke it now.
df4d0613
DP
2150 (if done
2151 (set-auto-mode-0 (cdr done) keep-mode-if-same)))
811cab86 2152 ;; If we didn't, match the buffer beginning against magic-mode-alist.
df4d0613 2153 (unless done
4ac1d37a
DP
2154 (if (setq done (save-excursion
2155 (goto-char (point-min))
5cce080e
KS
2156 (save-restriction
2157 (narrow-to-region (point-min)
2158 (min (point-max)
2159 (+ (point-min) magic-mode-regexp-match-limit)))
2160 (assoc-default nil magic-mode-alist
2161 (lambda (re dummy)
2162 (looking-at re))))))
4ac1d37a 2163 (set-auto-mode-0 done keep-mode-if-same)
811cab86 2164 ;; Compare the filename against the entries in auto-mode-alist.
4ac1d37a
DP
2165 (if buffer-file-name
2166 (let ((name buffer-file-name))
2167 ;; Remove backup-suffixes from file name.
2168 (setq name (file-name-sans-versions name))
2169 (while name
2170 ;; Find first matching alist entry.
2171 (let ((case-fold-search
2172 (memq system-type '(vax-vms windows-nt cygwin))))
2173 (if (and (setq mode (assoc-default name auto-mode-alist
811cab86 2174 'string-match))
4ac1d37a
DP
2175 (consp mode)
2176 (cadr mode))
2177 (setq mode (car mode)
2178 name (substring name 0 (match-beginning 0)))
2179 (setq name)))
2180 (when mode
2181 (set-auto-mode-0 mode keep-mode-if-same)))))))))
521cf174 2182
521cf174
DP
2183;; When `keep-mode-if-same' is set, we are working on behalf of
2184;; set-visited-file-name. In that case, if the major mode specified is the
2185;; same one we already have, don't actually reset it. We don't want to lose
2186;; minor modes such as Font Lock.
3467488e 2187(defun set-auto-mode-0 (mode &optional keep-mode-if-same)
521cf174 2188 "Apply MODE and return it.
3467488e
KS
2189If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
2190any aliases and compared to current major mode. If they are the
2191same, do nothing and return nil."
521cf174
DP
2192 (when keep-mode-if-same
2193 (while (symbolp (symbol-function mode))
2194 (setq mode (symbol-function mode)))
2195 (if (eq mode major-mode)
3467488e 2196 (setq mode nil)))
521cf174
DP
2197 (when mode
2198 (funcall mode)
2199 mode))
b4da00e9 2200
e3f9b9c0
RS
2201(defun set-auto-mode-1 ()
2202 "Find the -*- spec in the buffer.
2203Call with point at the place to start searching from.
2204If one is found, set point to the beginning
2205and return the position of the end.
2206Otherwise, return nil; point may be changed."
2207 (let (beg end)
2208 (and
2209 ;; Don't look for -*- if this file name matches any
2210 ;; of the regexps in inhibit-first-line-modes-regexps.
2211 (let ((temp inhibit-first-line-modes-regexps)
2212 (name (if buffer-file-name
2213 (file-name-sans-versions buffer-file-name)
2214 (buffer-name))))
2215 (while (let ((sufs inhibit-first-line-modes-suffixes))
2216 (while (and sufs (not (string-match (car sufs) name)))
2217 (setq sufs (cdr sufs)))
2218 sufs)
2219 (setq name (substring name 0 (match-beginning 0))))
2220 (while (and temp
2221 (not (string-match (car temp) name)))
2222 (setq temp (cdr temp)))
2223 (not temp))
2224
f587e30b
SM
2225 (search-forward "-*-" (line-end-position
2226 ;; If the file begins with "#!"
2227 ;; (exec interpreter magic), look
2228 ;; for mode frobs in the first two
2229 ;; lines. You cannot necessarily
2230 ;; put them in the first line of
2231 ;; such a file without screwing up
2232 ;; the interpreter invocation.
2233 (and (looking-at "^#!") 2)) t)
e3f9b9c0
RS
2234 (progn
2235 (skip-chars-forward " \t")
2236 (setq beg (point))
f587e30b 2237 (search-forward "-*-" (line-end-position) t))
e3f9b9c0
RS
2238 (progn
2239 (forward-char -3)
2240 (skip-chars-backward " \t")
2241 (setq end (point))
2242 (goto-char beg)
2243 end))))
b9e1451a
CY
2244\f
2245;;; Handling file local variables
2246
2247(defvar ignored-local-variables
2248 '(ignored-local-variables safe-local-variable-values)
2249 "Variables to be ignored in a file's local variable spec.")
2250
2251(defvar hack-local-variables-hook nil
2252 "Normal hook run after processing a file's local variables specs.
2253Major modes can use this to examine user-specified local variables
2254in order to initialize other data structure based on them.")
2255
2256(defcustom safe-local-variable-values nil
2257 "List variable-value pairs that are considered safe.
2258Each element is a cons cell (VAR . VAL), where VAR is a variable
2259symbol and VAL is a value that is considered safe."
2260 :group 'find-file
2261 :type 'alist)
2262
2263(defcustom safe-local-eval-forms nil
2264 "*Expressions that are considered safe in an `eval:' local variable.
2265Add expressions to this list if you want Emacs to evaluate them, when
2266they appear in an `eval' local variable specification, without first
2267asking you for confirmation."
2268 :group 'find-file
2269 :version "22.1"
2270 :type '(repeat sexp))
2271
2272;; Risky local variables:
2273(mapc (lambda (var) (put var 'risky-local-variable t))
2274 '(after-load-alist
2275 auto-mode-alist
2276 buffer-auto-save-file-name
2277 buffer-file-name
2278 buffer-file-truename
2279 buffer-undo-list
2280 dabbrev-case-fold-search
2281 dabbrev-case-replace
2282 debugger
2283 default-text-properties
2284 display-time-string
2285 enable-local-eval
2286 eval
2287 exec-directory
2288 exec-path
2289 file-name-handler-alist
2290 font-lock-defaults
2291 format-alist
2292 frame-title-format
2293 global-mode-string
2294 header-line-format
2295 icon-title-format
2296 ignored-local-variables
2297 imenu--index-alist
2298 imenu-generic-expression
2299 inhibit-quit
2300 input-method-alist
2301 load-path
2302 max-lisp-eval-depth
2303 max-specpdl-size
2304 minor-mode-alist
2305 minor-mode-map-alist
2306 minor-mode-overriding-map-alist
2307 mode-line-buffer-identification
2308 mode-line-format
2309 mode-line-modes
2310 mode-line-modified
2311 mode-line-mule-info
2312 mode-line-position
2313 mode-line-process
2314 mode-name
2315 outline-level
2316 overriding-local-map
2317 overriding-terminal-local-map
2318 parse-time-rules
2319 process-environment
2320 rmail-output-file-alist
2321 save-some-buffers-action-alist
2322 special-display-buffer-names
2323 standard-input
2324 standard-output
2325 unread-command-events
2326 vc-mode))
2327
2328;; Safe local variables:
2329;;
3e457225
RS
2330;; For variables defined by major modes, the safety declarations can go into
2331;; the major mode's file, since that will be loaded before file variables are
2332;; processed.
2333;;
2334;; For variables defined by minor modes, put the safety declarations in the
2335;; file defining the minor mode after the defcustom/defvar using an autoload
2336;; cookie, e.g.:
2337;;
2338;; ;;;###autoload(put 'variable 'safe-local-variable 'stringp)
2339;;
2340;; Otherwise, when Emacs visits a file specifying that local variable, the
2341;; minor mode file may not be loaded yet.
2342;;
2343;; For variables defined in the C source code the declaration should go here:
b9e1451a 2344
3e457225 2345;; FIXME: Some variables should be moved according to the rules above.
b9e1451a
CY
2346(let ((string-or-null (lambda (a) (or (stringp a) (null a)))))
2347 (eval
2348 `(mapc (lambda (pair)
2349 (put (car pair) 'safe-local-variable (cdr pair)))
2350 '((byte-compile-dynamic . t)
704d7017
AS
2351 (byte-compile-dynamic-docstrings . t)
2352 (byte-compile-warnings . t)
b9e1451a
CY
2353 (c-basic-offset . integerp)
2354 (c-file-style . stringp)
2355 (c-indent-level . integerp)
2356 (comment-column . integerp)
3e457225 2357 (compile-command . string-or-null-p)
b9e1451a 2358 (fill-column . integerp)
3e457225 2359 (fill-prefix . string-or-null-p)
b9e1451a 2360 (indent-tabs-mode . t)
b9e1451a 2361 (kept-new-versions . integerp)
704d7017 2362 (left-margin . t)
b9e1451a
CY
2363 (no-byte-compile . t)
2364 (no-update-autoloads . t)
3e457225 2365 (outline-regexp . string-or-null-p)
6c07f4d4
RS
2366 (tab-width . integerp) ;; C source code
2367 (truncate-lines . t) ;; C source code
b9e1451a
CY
2368 (version-control . t)))))
2369
2370(put 'c-set-style 'safe-local-eval-function t)
e3f9b9c0 2371
5a6c1d87
CY
2372(defun hack-local-variables-confirm (vars unsafe-vars risky-vars)
2373 (if noninteractive
2374 nil
2375 (let ((name (if buffer-file-name
2376 (file-name-nondirectory buffer-file-name)
2377 (concat "buffer " (buffer-name))))
af467e28 2378 (offer-save (and (eq enable-local-variables t) unsafe-vars))
0a158521 2379 prompt char)
5a6c1d87 2380 (save-window-excursion
0a158521 2381 (let ((buf (get-buffer-create "*Local Variables*")))
42078bb2
CY
2382 (pop-to-buffer buf)
2383 (set (make-local-variable 'cursor-type) nil)
2384 (erase-buffer)
5a6c1d87 2385 (if unsafe-vars
42078bb2
CY
2386 (insert "The local variables list in " name
2387 "\ncontains values that may not be safe (*)"
2388 (if risky-vars
2389 ", and variables that are risky (**)."
2390 "."))
5a6c1d87 2391 (if risky-vars
42078bb2
CY
2392 (insert "The local variables list in " name
2393 "\ncontains variables that are risky (**).")
2394 (insert "A local variables list is specified in " name ".")))
2395 (insert "\n\nDo you want to apply it? You can type
5a6c1d87 2396y -- to apply the local variables list.
af467e28
CY
2397n -- to ignore the local variables list.")
2398 (if offer-save
2399 (insert "
dbcd3ce0
EZ
2400! -- to apply the local variables list, and permanently mark these
2401 values (*) as safe (in the future, they will be set automatically.)\n\n")
af467e28 2402 (insert "\n\n"))
5a6c1d87
CY
2403 (dolist (elt vars)
2404 (cond ((member elt unsafe-vars)
42078bb2 2405 (insert " * "))
5a6c1d87 2406 ((member elt risky-vars)
42078bb2 2407 (insert " ** "))
5a6c1d87 2408 (t
42078bb2
CY
2409 (insert " ")))
2410 (princ (car elt) buf)
2411 (insert " : ")
2412 (princ (cdr elt) buf)
2413 (insert "\n"))
af467e28
CY
2414 (setq prompt
2415 (format "Please type %s%s: "
2416 (if offer-save "y, n, or !" "y or n")
2417 (if (< (line-number-at-pos) (window-body-height))
2418 ""
2419 ", or C-v to scroll")))
2420 (goto-char (point-min))
a5ce12c3 2421 (let ((cursor-in-echo-area t)
af467e28
CY
2422 (exit-chars
2423 (if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g)))
42078bb2
CY
2424 done)
2425 (while (not done)
2426 (message prompt)
2427 (setq char (read-event))
2428 (if (numberp char)
2429 (if (eq char ?\C-v)
2430 (condition-case nil
2431 (scroll-up)
2432 (error (goto-char (point-min))))
a5ce12c3 2433 (setq done (memq (downcase char) exit-chars))))))
42078bb2 2434 (setq char (downcase char))
af467e28 2435 (when (and offer-save (= char ?!) unsafe-vars)
42078bb2
CY
2436 (dolist (elt unsafe-vars)
2437 (add-to-list 'safe-local-variable-values elt))
4299d849
CY
2438 ;; When this is called from desktop-restore-file-buffer,
2439 ;; coding-system-for-read may be non-nil. Reset it before
2440 ;; writing to .emacs.
af467e28
CY
2441 (if (or custom-file user-init-file)
2442 (let ((coding-system-for-read nil))
2443 (customize-save-variable
2444 'safe-local-variable-values
2445 safe-local-variable-values))))
0a158521 2446 (kill-buffer buf)
42078bb2
CY
2447 (or (= char ?!)
2448 (= char ?\s)
2449 (= char ?y)))))))
cc45837e 2450
a0e74e72 2451(defun hack-local-variables-prop-line (&optional mode-only)
5a6c1d87 2452 "Return local variables specified in the -*- line.
ffc0e1ca
AS
2453Ignore any specification for `mode:' and `coding:';
2454`set-auto-mode' should already have handled `mode:',
a0e74e72 2455`set-auto-coding' should already have handled `coding:'.
5a6c1d87
CY
2456
2457If MODE-ONLY is non-nil, all we do is check whether the major
2458mode is specified, returning t if it is specified. Otherwise,
2459return an alist of elements (VAR . VAL), where VAR is a variable
2460and VAL is the specified value."
f3e23606
RS
2461 (save-excursion
2462 (goto-char (point-min))
5a6c1d87
CY
2463 (let ((end (set-auto-mode-1))
2464 result mode-specified)
a0e74e72
RS
2465 ;; Parse the -*- line into the RESULT alist.
2466 ;; Also set MODE-SPECIFIED if we see a spec or `mode'.
e3f9b9c0 2467 (cond ((not end)
f3e23606
RS
2468 nil)
2469 ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
13a66180 2470 ;; Simple form: "-*- MODENAME -*-". Already handled.
a0e74e72 2471 (setq mode-specified t)
13a66180 2472 nil)
f3e23606
RS
2473 (t
2474 ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
2475 ;; (last ";" is optional).
f3e23606
RS
2476 (while (< (point) end)
2477 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
ffc0e1ca 2478 (error "Malformed -*- line"))
f3e23606 2479 (goto-char (match-end 0))
1c26a6f3
KH
2480 ;; There used to be a downcase here,
2481 ;; but the manual didn't say so,
2482 ;; and people want to set var names that aren't all lc.
2483 (let ((key (intern (buffer-substring
2484 (match-beginning 1)
2485 (match-end 1))))
f3e23606
RS
2486 (val (save-restriction
2487 (narrow-to-region (point) end)
2488 (read (current-buffer)))))
93a2702d
RS
2489 ;; It is traditional to ignore
2490 ;; case when checking for `mode' in set-auto-mode,
2491 ;; so we must do that here as well.
2492 ;; That is inconsistent, but we're stuck with it.
3fa0a9aa 2493 ;; The same can be said for `coding' in set-auto-coding.
5a6c1d87
CY
2494 (or (and (equal (downcase (symbol-name key)) "mode")
2495 (setq mode-specified t))
3fa0a9aa 2496 (equal (downcase (symbol-name key)) "coding")
5a6c1d87
CY
2497 (condition-case nil
2498 (push (cons (if (eq key 'eval)
2499 'eval
2500 (indirect-variable key))
2501 val) result)
2502 (error nil)))
2503 (skip-chars-forward " \t;")))))
2504
2505 (if mode-only
2506 mode-specified
2507 result))))
f3e23606 2508
9de9b6a2
RS
2509(defun hack-local-variables (&optional mode-only)
2510 "Parse and put into effect this buffer's local variables spec.
2511If MODE-ONLY is non-nil, all we do is check whether the major mode
2512is specified, returning t if it is specified."
5a6c1d87
CY
2513 (let ((enable-local-variables
2514 (and local-enable-local-variables enable-local-variables))
2515 result)
2516 (when (or mode-only enable-local-variables)
2517 (setq result (hack-local-variables-prop-line mode-only))
2518 ;; Look for "Local variables:" line in last page.
2519 (save-excursion
2520 (goto-char (point-max))
2521 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
2522 'move)
2523 (when (let ((case-fold-search t))
2524 (search-forward "Local Variables:" nil t))
2525 (skip-chars-forward " \t")
2526 ;; suffix is what comes after "local variables:" in its line.
2527 ;; prefix is what comes before "local variables:" in its line.
2528 (let ((suffix
2529 (concat
2530 (regexp-quote (buffer-substring (point)
2531 (line-end-position)))
2532 "$"))
2533 (prefix
2534 (concat "^" (regexp-quote
2535 (buffer-substring (line-beginning-position)
2536 (match-beginning 0)))))
2537 beg)
2538
2539 (forward-line 1)
2540 (let ((startpos (point))
2541 endpos
2542 (thisbuf (current-buffer)))
2543 (save-excursion
2544 (unless (let ((case-fold-search t))
2545 (re-search-forward
2546 (concat prefix "[ \t]*End:[ \t]*" suffix)
2547 nil t))
2548 (error "Local variables list is not properly terminated"))
2549 (beginning-of-line)
2550 (setq endpos (point)))
2551
2552 (with-temp-buffer
2553 (insert-buffer-substring thisbuf startpos endpos)
2554 (goto-char (point-min))
2555 (subst-char-in-region (point) (point-max) ?\^m ?\n)
2556 (while (not (eobp))
2557 ;; Discard the prefix.
2558 (if (looking-at prefix)
2559 (delete-region (point) (match-end 0))
2560 (error "Local variables entry is missing the prefix"))
2561 (end-of-line)
2562 ;; Discard the suffix.
2563 (if (looking-back suffix)
2564 (delete-region (match-beginning 0) (point))
2565 (error "Local variables entry is missing the suffix"))
2566 (forward-line 1))
2567 (goto-char (point-min))
2568
2569 (while (not (eobp))
2570 ;; Find the variable name; strip whitespace.
2571 (skip-chars-forward " \t")
2572 (setq beg (point))
2573 (skip-chars-forward "^:\n")
2574 (if (eolp) (error "Missing colon in local variables entry"))
2575 (skip-chars-backward " \t")
2576 (let* ((str (buffer-substring beg (point)))
2577 (var (read str))
2578 val)
2579 ;; Read the variable value.
2580 (skip-chars-forward "^:")
2581 (forward-char 1)
2582 (setq val (read (current-buffer)))
2583 (if mode-only
2584 (if (eq var 'mode)
2585 (setq result t))
2586 (unless (eq var 'coding)
2587 (condition-case nil
2588 (push (cons (if (eq var 'eval)
2589 'eval
2590 (indirect-variable var))
2591 val) result)
2592 (error nil)))))
2593 (forward-line 1)))))))
2594
2595 ;; We've read all the local variables. Now, return whether the
2596 ;; mode is specified (if MODE-ONLY is non-nil), or set the
2597 ;; variables (if MODE-ONLY is nil.)
2598 (if mode-only
2599 result
d450f2a2
CY
2600 (dolist (ignored ignored-local-variables)
2601 (setq result (assq-delete-all ignored result)))
2602 (if (null enable-local-eval)
2603 (setq result (assq-delete-all 'eval result)))
dd60bebe
CY
2604 (when result
2605 (setq result (nreverse result))
dd60bebe
CY
2606 ;; Find those variables that we may want to save to
2607 ;; `safe-local-variable-values'.
2608 (let (risky-vars unsafe-vars)
2609 (dolist (elt result)
2610 (let ((var (car elt))
2611 (val (cdr elt)))
2612 (or (eq var 'mode)
2613 (and (eq var 'eval)
2614 (or (eq enable-local-eval t)
2615 (hack-one-local-variable-eval-safep
2616 (eval (quote val)))))
2617 (safe-local-variable-p var val)
2618 (and (risky-local-variable-p var val)
2619 (push elt risky-vars))
2620 (push elt unsafe-vars))))
a5ce12c3
RS
2621 (if (eq enable-local-variables :safe)
2622 ;; If caller wants only the safe variables,
2623 ;; install only them.
dd60bebe 2624 (dolist (elt result)
a5ce12c3
RS
2625 (unless (or (memq (car elt) unsafe-vars)
2626 (memq (car elt) risky-vars))
2627 (hack-one-local-variable (car elt) (cdr elt))))
2628 ;; Query, except in the case where all are known safe
2629 ;; if the user wants no quuery in that case.
2630 (if (or (and (eq enable-local-variables t)
2631 (null unsafe-vars)
2632 (null risky-vars))
2633 (hack-local-variables-confirm
2634 result unsafe-vars risky-vars))
2635 (dolist (elt result)
2636 (hack-one-local-variable (car elt) (cdr elt))))))
dd60bebe 2637 (run-hooks 'hack-local-variables-hook))))))
5a6c1d87 2638
5a6c1d87
CY
2639(defun safe-local-variable-p (sym val)
2640 "Non-nil if SYM is safe as a file-local variable with value VAL.
2641It is safe if any of these conditions are met:
2642
2643 * There is a matching entry (SYM . VAL) in the
2644 `safe-local-variable-values' user option.
2645
2646 * The `safe-local-variable' property of SYM is t.
2647
2648 * The `safe-local-variable' property of SYM is a function that
2649 evaluates to a non-nil value with VAL as an argument."
2650 (or (member (cons sym val) safe-local-variable-values)
2651 (let ((safep (get sym 'safe-local-variable)))
2652 (or (eq safep t)
2653 (and (functionp safep)
2654 (funcall safep val))))))
2655
2656(defun risky-local-variable-p (sym &optional ignored)
2657 "Non-nil if SYM could be dangerous as a file-local variable.
2658It is dangerous if either of these conditions are met:
2659
2660 * Its `risky-local-variable' property is non-nil.
2661
2662 * Its name ends with \"hook(s)\", \"function(s)\", \"form(s)\", \"map\",
2663 \"program\", \"command(s)\", \"predicate(s)\", \"frame-alist\",
2664 \"mode-alist\", \"font-lock-(syntactic-)keyword*\", or
2665 \"map-alist\"."
f36d46ca
RS
2666 ;; If this is an alias, check the base name.
2667 (condition-case nil
2668 (setq sym (indirect-variable sym))
2669 (error nil))
5a6c1d87
CY
2670 (or (get sym 'risky-local-variable)
2671 (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|\
2672-commands?$\\|-predicates?$\\|font-lock-keywords$\\|font-lock-keywords\
2673-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|\
2674-map$\\|-map-alist$" (symbol-name sym))))
7ed9159a 2675
d0bd3513
RS
2676(defun hack-one-local-variable-quotep (exp)
2677 (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
2678
ff7affeb
RS
2679(defun hack-one-local-variable-constantp (exp)
2680 (or (and (not (symbolp exp)) (not (consp exp)))
2681 (memq exp '(t nil))
2682 (keywordp exp)
2683 (hack-one-local-variable-quotep exp)))
2684
2685(defun hack-one-local-variable-eval-safep (exp)
2686 "Return t if it is safe to eval EXP when it is found in a file."
8fd9c174
RS
2687 (or (not (consp exp))
2688 ;; Detect certain `put' expressions.
2689 (and (eq (car exp) 'put)
2690 (hack-one-local-variable-quotep (nth 1 exp))
2691 (hack-one-local-variable-quotep (nth 2 exp))
bc5d1dfb
EZ
2692 (let ((prop (nth 1 (nth 2 exp))) (val (nth 3 exp)))
2693 (cond ((eq prop 'lisp-indent-hook)
2694 ;; Only allow safe values of lisp-indent-hook;
2695 ;; not functions.
2696 (or (numberp val) (equal val ''defun)))
2697 ((eq prop 'edebug-form-spec)
2698 ;; Only allow indirect form specs.
2699 (edebug-basic-spec val)))))
8fd9c174
RS
2700 ;; Allow expressions that the user requested.
2701 (member exp safe-local-eval-forms)
2702 ;; Certain functions can be allowed with safe arguments
2703 ;; or can specify verification functions to try.
2704 (and (symbolp (car exp))
2705 (let ((prop (get (car exp) 'safe-local-eval-function)))
2706 (cond ((eq prop t)
2707 (let ((ok t))
2708 (dolist (arg (cdr exp))
2709 (unless (hack-one-local-variable-constantp arg)
2710 (setq ok nil)))
2711 ok))
2712 ((functionp prop)
2713 (funcall prop exp))
2714 ((listp prop)
2715 (let ((ok nil))
2716 (dolist (function prop)
2717 (if (funcall function exp)
2718 (setq ok t)))
2719 ok)))))))
ff7affeb 2720
f3e23606 2721(defun hack-one-local-variable (var val)
5a6c1d87 2722 "Set local variable VAR with value VAL."
f3e23606
RS
2723 (cond ((eq var 'mode)
2724 (funcall (intern (concat (downcase (symbol-name val))
2725 "-mode"))))
5a6c1d87
CY
2726 ((eq var 'eval)
2727 (save-excursion (eval val)))
f3e23606 2728 (t (make-local-variable var)
87a6a5d8
RS
2729 ;; Make sure the string has no text properties.
2730 ;; Some text properties can get evaluated in various ways,
2731 ;; so it is risky to put them on with a local variable list.
2732 (if (stringp val)
2733 (set-text-properties 0 (length val) nil val))
f3e23606
RS
2734 (set var val))))
2735
b4da00e9 2736\f
21540597 2737(defcustom change-major-mode-with-file-name t
9de9b6a2
RS
2738 "*Non-nil means \\[write-file] should set the major mode from the file name.
2739However, the mode will not be changed if
2740\(1) a local variables list or the `-*-' line specifies a major mode, or
2741\(2) the current major mode is a \"special\" mode,
8609911b 2742\ not suitable for ordinary files, or
21540597
RS
2743\(3) the new file name does not particularly specify any mode."
2744 :type 'boolean
2745 :group 'editing-basics)
9de9b6a2 2746
f36012a6 2747(defun set-visited-file-name (filename &optional no-query along-with-file)
b4da00e9 2748 "Change name of file visited in current buffer to FILENAME.
1af57101 2749This also renames the buffer to correspond to the new file.
b4da00e9 2750The next time the buffer is saved it will go in the newly specified file.
1af57101 2751FILENAME nil or an empty string means mark buffer as not visiting any file.
b4da00e9 2752Remember to delete the initial contents of the minibuffer
6a6b62f8
RS
2753if you wish to pass an empty string as the argument.
2754
2755The optional second argument NO-QUERY, if non-nil, inhibits asking for
f36012a6
RS
2756confirmation in the case where another buffer is already visiting FILENAME.
2757
2758The optional third argument ALONG-WITH-FILE, if non-nil, means that
2759the old visited file has been renamed to the new name FILENAME."
b4da00e9 2760 (interactive "FSet visited file name: ")
c11a94fe
RS
2761 (if (buffer-base-buffer)
2762 (error "An indirect buffer cannot visit a file"))
a522e5bf
RS
2763 (let (truename)
2764 (if filename
2765 (setq filename
2766 (if (string-equal filename "")
2767 nil
2768 (expand-file-name filename))))
2769 (if filename
2770 (progn
2771 (setq truename (file-truename filename))
2772 (if find-file-visit-truename
a522e5bf 2773 (setq filename truename))))
cbca0a4b 2774 (if filename
e6d0b67a 2775 (let ((new-name (file-name-nondirectory filename)))
cbca0a4b
RS
2776 (if (string= new-name "")
2777 (error "Empty file name"))))
11e314fa 2778 (let ((buffer (and filename (find-buffer-visiting filename))))
7b89d38e 2779 (and buffer (not (eq buffer (current-buffer)))
6a6b62f8 2780 (not no-query)
7b89d38e
RS
2781 (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
2782 filename)))
2783 (error "Aborted")))
a522e5bf
RS
2784 (or (equal filename buffer-file-name)
2785 (progn
2786 (and filename (lock-buffer filename))
2787 (unlock-buffer)))
2788 (setq buffer-file-name filename)
2789 (if filename ; make buffer name reflect filename.
2790 (let ((new-name (file-name-nondirectory buffer-file-name)))
a522e5bf
RS
2791 (if (eq system-type 'vax-vms)
2792 (setq new-name (downcase new-name)))
2793 (setq default-directory (file-name-directory buffer-file-name))
67b6fd1c
SM
2794 ;; If new-name == old-name, renaming would add a spurious <2>
2795 ;; and it's considered as a feature in rename-buffer.
a522e5bf
RS
2796 (or (string= new-name (buffer-name))
2797 (rename-buffer new-name t))))
2798 (setq buffer-backed-up nil)
f36012a6
RS
2799 (or along-with-file
2800 (clear-visited-file-modtime))
8ccdc29e 2801 ;; Abbreviate the file names of the buffer.
4826e97f 2802 (if truename
8ccdc29e
RS
2803 (progn
2804 (setq buffer-file-truename (abbreviate-file-name truename))
2805 (if find-file-visit-truename
b1f1ceb8 2806 (setq buffer-file-name truename))))
a522e5bf
RS
2807 (setq buffer-file-number
2808 (if filename
2a47b4f5 2809 (nthcdr 10 (file-attributes buffer-file-name))
a522e5bf 2810 nil)))
0370fe77 2811 ;; write-file-functions is normally used for things like ftp-find-file
b4da00e9
RM
2812 ;; that visit things that are not local files as if they were files.
2813 ;; Changing to visit an ordinary local file instead should flush the hook.
0370fe77 2814 (kill-local-variable 'write-file-functions)
c9dca4e0 2815 (kill-local-variable 'local-write-file-hooks)
b4da00e9
RM
2816 (kill-local-variable 'revert-buffer-function)
2817 (kill-local-variable 'backup-inhibited)
ee81c959
RS
2818 ;; If buffer was read-only because of version control,
2819 ;; that reason is gone now, so make it writable.
2820 (if vc-mode
2821 (setq buffer-read-only nil))
2822 (kill-local-variable 'vc-mode)
b4da00e9
RM
2823 ;; Turn off backup files for certain file names.
2824 ;; Since this is a permanent local, the major mode won't eliminate it.
4d49551a
KH
2825 (and buffer-file-name
2826 (not (funcall backup-enable-predicate buffer-file-name))
b4da00e9
RM
2827 (progn
2828 (make-local-variable 'backup-inhibited)
2829 (setq backup-inhibited t)))
c77a81cf
RS
2830 (let ((oauto buffer-auto-save-file-name))
2831 ;; If auto-save was not already on, turn it on if appropriate.
2832 (if (not buffer-auto-save-file-name)
2833 (and buffer-file-name auto-save-default
2834 (auto-save-mode t))
2835 ;; If auto save is on, start using a new name.
2836 ;; We deliberately don't rename or delete the old auto save
2837 ;; for the old visited file name. This is because perhaps
2838 ;; the user wants to save the new state and then compare with the
2839 ;; previous state from the auto save file.
2840 (setq buffer-auto-save-file-name
2841 (make-auto-save-file-name)))
2842 ;; Rename the old auto save file if any.
2843 (and oauto buffer-auto-save-file-name
e6f0e76c 2844 (file-exists-p oauto)
c77a81cf 2845 (rename-file oauto buffer-auto-save-file-name t)))
f36012a6
RS
2846 (and buffer-file-name
2847 (not along-with-file)
9de9b6a2
RS
2848 (set-buffer-modified-p t))
2849 ;; Update the major mode, if the file name determines it.
2850 (condition-case nil
2851 ;; Don't change the mode if it is special.
2852 (or (not change-major-mode-with-file-name)
2853 (get major-mode 'mode-class)
2854 ;; Don't change the mode if the local variable list specifies it.
2855 (hack-local-variables t)
2856 (set-auto-mode t))
2857 (error nil)))
b4da00e9 2858
912192d1 2859(defun write-file (filename &optional confirm)
b4da00e9 2860 "Write current buffer into file FILENAME.
7f99999a 2861This makes the buffer visit that file, and marks it as not modified.
7458cc35 2862
7f99999a
KH
2863If you specify just a directory name as FILENAME, that means to use
2864the default file name but in that directory. You can also yank
074eb6ac 2865the default file name into the minibuffer to edit it, using \\<minibuffer-local-map>\\[next-history-element].
7f99999a
KH
2866
2867If the buffer is not already visiting a file, the default file name
2868for the output file is the buffer name.
2869
2870If optional second arg CONFIRM is non-nil, this function
2871asks for confirmation before overwriting an existing file.
912192d1 2872Interactively, confirmation is required unless you supply a prefix argument."
b4da00e9
RM
2873;; (interactive "FWrite file: ")
2874 (interactive
2875 (list (if buffer-file-name
2876 (read-file-name "Write file: "
2877 nil nil nil nil)
7f99999a
KH
2878 (read-file-name "Write file: " default-directory
2879 (expand-file-name
2880 (file-name-nondirectory (buffer-name))
2881 default-directory)
2882 nil nil))
912192d1 2883 (not current-prefix-arg)))
b4da00e9 2884 (or (null filename) (string-equal filename "")
41f48cb1
RS
2885 (progn
2886 ;; If arg is just a directory,
7f99999a
KH
2887 ;; use the default file name, but in that directory.
2888 (if (file-directory-p filename)
41f48cb1 2889 (setq filename (concat (file-name-as-directory filename)
7f99999a
KH
2890 (file-name-nondirectory
2891 (or buffer-file-name (buffer-name))))))
c2fb8488
RS
2892 (and confirm
2893 (file-exists-p filename)
2894 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
2895 (error "Canceled")))
5f65549e 2896 (set-visited-file-name filename (not confirm))))
b4da00e9 2897 (set-buffer-modified-p t)
6492b55d
KH
2898 ;; Make buffer writable if file is writable.
2899 (and buffer-file-name
2900 (file-writable-p buffer-file-name)
2901 (setq buffer-read-only nil))
8e5c7b90
SM
2902 (save-buffer)
2903 ;; It's likely that the VC status at the new location is different from
2904 ;; the one at the old location.
2905 (vc-find-file-hook))
b4da00e9
RM
2906\f
2907(defun backup-buffer ()
2908 "Make a backup of the disk file visited by the current buffer, if appropriate.
2909This is normally done before saving the buffer the first time.
27ab6944
KH
2910
2911A backup may be done by renaming or by copying; see documentation of
2912variable `make-backup-files'. If it's done by renaming, then the file is
f3f9e207
RS
2913no longer accessible under its old name.
2914
2915The value is non-nil after a backup was made by renaming.
2916It has the form (MODES . BACKUPNAME).
2917MODES is the result of `file-modes' on the original
2918file; this means that the caller, after saving the buffer, should change
2919the modes of the new file to agree with the old modes.
2920BACKUPNAME is the backup file name, which is the old file renamed."
b4da00e9
RM
2921 (if (and make-backup-files (not backup-inhibited)
2922 (not buffer-backed-up)
2923 (file-exists-p buffer-file-name)
2924 (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
2925 '(?- ?l)))
2926 (let ((real-file-name buffer-file-name)
2927 backup-info backupname targets setmodes)
2928 ;; If specified name is a symbolic link, chase it to the target.
2929 ;; Thus we make the backups in the directory where the real file is.
5dadeb29 2930 (setq real-file-name (file-chase-links real-file-name))
b4da00e9
RM
2931 (setq backup-info (find-backup-file-name real-file-name)
2932 backupname (car backup-info)
2933 targets (cdr backup-info))
5c6d31a4
SM
2934 ;; (if (file-directory-p buffer-file-name)
2935 ;; (error "Cannot save buffer in directory %s" buffer-file-name))
eb650569
RS
2936 (if backup-info
2937 (condition-case ()
2938 (let ((delete-old-versions
2939 ;; If have old versions to maybe delete,
2940 ;; ask the user to confirm now, before doing anything.
2941 ;; But don't actually delete til later.
2942 (and targets
2943 (or (eq delete-old-versions t) (eq delete-old-versions nil))
2944 (or delete-old-versions
2945 (y-or-n-p (format "Delete excess backup versions of %s? "
446c63b0
RS
2946 real-file-name)))))
2947 (modes (file-modes buffer-file-name)))
eb650569
RS
2948 ;; Actually write the back up file.
2949 (condition-case ()
2950 (if (or file-precious-flag
ffc0e1ca 2951 ; (file-symlink-p buffer-file-name)
eb650569 2952 backup-by-copying
446c63b0 2953 ;; Don't rename a suid or sgid file.
7da6bf00 2954 (and modes (< 0 (logand modes #o6000)))
79d2d279 2955 (not (file-writable-p (file-name-directory real-file-name)))
eb650569
RS
2956 (and backup-by-copying-when-linked
2957 (> (file-nlinks real-file-name) 1))
ffc0e1ca
AS
2958 (and (or backup-by-copying-when-mismatch
2959 (integerp backup-by-copying-when-privileged-mismatch))
eb650569 2960 (let ((attr (file-attributes real-file-name)))
ffc0e1ca
AS
2961 (and (or backup-by-copying-when-mismatch
2962 (and (integerp (nth 2 attr))
2963 (integerp backup-by-copying-when-privileged-mismatch)
2964 (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
2965 (or (nth 9 attr)
2966 (not (file-ownership-preserved-p real-file-name)))))))
446c63b0 2967 (backup-buffer-copy real-file-name backupname modes)
eb650569
RS
2968 ;; rename-file should delete old backup.
2969 (rename-file real-file-name backupname t)
446c63b0 2970 (setq setmodes (cons modes backupname)))
eb650569
RS
2971 (file-error
2972 ;; If trouble writing the backup, write it in ~.
567c1ca9
RS
2973 (setq backupname (expand-file-name
2974 (convert-standard-filename
2975 "~/%backup%~")))
2976 (message "Cannot write backup file; backing up in %s"
2977 (file-name-nondirectory backupname))
eb650569 2978 (sleep-for 1)
446c63b0 2979 (backup-buffer-copy real-file-name backupname modes)))
eb650569
RS
2980 (setq buffer-backed-up t)
2981 ;; Now delete the old versions, if desired.
2982 (if delete-old-versions
2983 (while targets
2984 (condition-case ()
2985 (delete-file (car targets))
2986 (file-error nil))
2987 (setq targets (cdr targets))))
2988 setmodes)
2989 (file-error nil))))))
b4da00e9 2990
446c63b0 2991(defun backup-buffer-copy (from-name to-name modes)
44dce0fb
RS
2992 (let ((umask (default-file-modes)))
2993 (unwind-protect
2994 (progn
2995 ;; Create temp files with strict access rights. It's easy to
2996 ;; loosen them later, whereas it's impossible to close the
2997 ;; time-window of loose permissions otherwise.
2998 (set-default-file-modes ?\700)
2999 (while (condition-case ()
3000 (progn
3001 (condition-case nil
3002 (delete-file to-name)
3003 (file-error nil))
689accb8 3004 (copy-file from-name to-name t t 'excl)
44dce0fb
RS
3005 nil)
3006 (file-already-exists t))
689accb8
RS
3007 ;; The file was somehow created by someone else between
3008 ;; `delete-file' and `copy-file', so let's try again.
3009 nil))
44dce0fb
RS
3010 ;; Reset the umask.
3011 (set-default-file-modes umask)))
147fbf70
RS
3012 (and modes
3013 (set-file-modes to-name (logand modes #o1777))))
446c63b0 3014
c3554e95 3015(defun file-name-sans-versions (name &optional keep-backup-version)
ffc0e1ca 3016 "Return file NAME sans backup versions or strings.
b4da00e9 3017This is a separate procedure so your site-init or startup file can
c3554e95
RS
3018redefine it.
3019If the optional argument KEEP-BACKUP-VERSION is non-nil,
3020we do not remove backup version numbers, only true file version numbers."
6eaebaa2 3021 (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
c3554e95
RS
3022 (if handler
3023 (funcall handler 'file-name-sans-versions name keep-backup-version)
3024 (substring name 0
3025 (if (eq system-type 'vax-vms)
3026 ;; VMS version number is (a) semicolon, optional
3027 ;; sign, zero or more digits or (b) period, option
3028 ;; sign, zero or more digits, provided this is the
3029 ;; second period encountered outside of the
3030 ;; device/directory part of the file name.
26add1bf
KH
3031 (or (string-match ";[-+]?[0-9]*\\'" name)
3032 (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'"
c3554e95
RS
3033 name)
3034 (match-beginning 1))
3035 (length name))
3036 (if keep-backup-version
3037 (length name)
dbb12f2c 3038 (or (string-match "\\.~[0-9.]+~\\'" name)
c3554e95
RS
3039 (string-match "~\\'" name)
3040 (length name))))))))
b4da00e9 3041
cb0cd911 3042(defun file-ownership-preserved-p (file)
ffc0e1ca 3043 "Return t if deleting FILE and rewriting it would preserve the owner."
cb0cd911
RS
3044 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
3045 (if handler
3046 (funcall handler 'file-ownership-preserved-p file)
ec5533be 3047 (let ((attributes (file-attributes file)))
306faa42
RS
3048 ;; Return t if the file doesn't exist, since it's true that no
3049 ;; information would be lost by an (attempted) delete and create.
3050 (or (null attributes)
3051 (= (nth 2 attributes) (user-uid)))))))
cb0cd911 3052
20b5d24c
RS
3053(defun file-name-sans-extension (filename)
3054 "Return FILENAME sans final \"extension\".
2531b0c3
EZ
3055The extension, in a file name, is the part that follows the last `.',
3056except that a leading `.', if any, doesn't count."
20b5d24c
RS
3057 (save-match-data
3058 (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
3059 directory)
2531b0c3
EZ
3060 (if (and (string-match "\\.[^.]*\\'" file)
3061 (not (eq 0 (match-beginning 0))))
20b5d24c 3062 (if (setq directory (file-name-directory filename))
6ee24f1e
RS
3063 ;; Don't use expand-file-name here; if DIRECTORY is relative,
3064 ;; we don't want to expand it.
3065 (concat directory (substring file 0 (match-beginning 0)))
20b5d24c
RS
3066 (substring file 0 (match-beginning 0)))
3067 filename))))
3068
93a2702d
RS
3069(defun file-name-extension (filename &optional period)
3070 "Return FILENAME's final \"extension\".
2531b0c3
EZ
3071The extension, in a file name, is the part that follows the last `.',
3072except that a leading `.', if any, doesn't count.
93a2702d
RS
3073Return nil for extensionless file names such as `foo'.
3074Return the empty string for file names such as `foo.'.
3075
3076If PERIOD is non-nil, then the returned value includes the period
3077that delimits the extension, and if FILENAME has no extension,
3078the value is \"\"."
3079 (save-match-data
3080 (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
2531b0c3
EZ
3081 (if (and (string-match "\\.[^.]*\\'" file)
3082 (not (eq 0 (match-beginning 0))))
93a2702d
RS
3083 (substring file (+ (match-beginning 0) (if period 0 1)))
3084 (if period
3085 "")))))
3086
ffc0e1ca
AS
3087(defcustom make-backup-file-name-function nil
3088 "A function to use instead of the default `make-backup-file-name'.
643c985d 3089A value of nil gives the default `make-backup-file-name' behavior.
ffc0e1ca 3090
d5798fa7 3091This could be buffer-local to do something special for specific
ffc0e1ca
AS
3092files. If you define it, you may need to change `backup-file-name-p'
3093and `file-name-sans-versions' too.
3094
3095See also `backup-directory-alist'."
3096 :group 'backup
3097 :type '(choice (const :tag "Default" nil)
3098 (function :tag "Your function")))
3099
3100(defcustom backup-directory-alist nil
3101 "Alist of filename patterns and backup directory names.
3102Each element looks like (REGEXP . DIRECTORY). Backups of files with
3103names matching REGEXP will be made in DIRECTORY. DIRECTORY may be
3104relative or absolute. If it is absolute, so that all matching files
3105are backed up into the same directory, the file names in this
3106directory will be the full name of the file backed up with all
3107directory separators changed to `!' to prevent clashes. This will not
3108work correctly if your filesystem truncates the resulting name.
3109
3110For the common case of all backups going into one directory, the alist
3111should contain a single element pairing \".\" with the appropriate
3112directory name.
3113
3114If this variable is nil, or it fails to match a filename, the backup
3115is made in the original file's directory.
3116
3117On MS-DOS filesystems without long names this variable is always
3118ignored."
3119 :group 'backup
dca5e71d 3120 :type '(repeat (cons (regexp :tag "Regexp matching filename")
ffc0e1ca
AS
3121 (directory :tag "Backup directory name"))))
3122
388d6ab5
RS
3123(defun normal-backup-enable-predicate (name)
3124 "Default `backup-enable-predicate' function.
0c2f6dda
RS
3125Checks for files in `temporary-file-directory',
3126`small-temporary-file-directory', and /tmp."
388d6ab5
RS
3127 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
3128 name 0 nil)))
3129 ;; Directory is under temporary-file-directory.
3130 (and (not (eq comp t))
3131 (< comp (- (length temporary-file-directory)))))
0c2f6dda
RS
3132 (let ((comp (compare-strings "/tmp" 0 nil
3133 name 0 nil)))
3134 ;; Directory is under /tmp.
3135 (and (not (eq comp t))
3136 (< comp (- (length "/tmp")))))
388d6ab5
RS
3137 (if small-temporary-file-directory
3138 (let ((comp (compare-strings small-temporary-file-directory
3139 0 nil
3140 name 0 nil)))
3141 ;; Directory is under small-temporary-file-directory.
3142 (and (not (eq comp t))
3143 (< comp (- (length small-temporary-file-directory)))))))))
3144
b4da00e9
RM
3145(defun make-backup-file-name (file)
3146 "Create the non-numeric backup file name for FILE.
ffc0e1ca
AS
3147Normally this will just be the file's name with `~' appended.
3148Customization hooks are provided as follows.
3149
3150If the variable `make-backup-file-name-function' is non-nil, its value
3151should be a function which will be called with FILE as its argument;
3152the resulting name is used.
3153
3154Otherwise a match for FILE is sought in `backup-directory-alist'; see
3155the documentation of that variable. If the directory for the backup
3156doesn't exist, it is created."
3157 (if make-backup-file-name-function
3158 (funcall make-backup-file-name-function file)
3159 (if (and (eq system-type 'ms-dos)
3160 (not (msdos-long-file-names)))
3161 (let ((fn (file-name-nondirectory file)))
3162 (concat (file-name-directory file)
3163 (or (and (string-match "\\`[^.]+\\'" fn)
3164 (concat (match-string 0 fn) ".~"))
3165 (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
3166 (concat (match-string 0 fn) "~")))))
3167 (concat (make-backup-file-name-1 file) "~"))))
3168
3169(defun make-backup-file-name-1 (file)
3170 "Subroutine of `make-backup-file-name' and `find-backup-file-name'."
3171 (let ((alist backup-directory-alist)
818286f4 3172 elt backup-directory)
ffc0e1ca
AS
3173 (while alist
3174 (setq elt (pop alist))
3175 (if (string-match (car elt) file)
3176 (setq backup-directory (cdr elt)
3177 alist nil)))
ee291b46 3178 (if (and backup-directory (not (file-exists-p backup-directory)))
ffc0e1ca
AS
3179 (condition-case nil
3180 (make-directory backup-directory 'parents)
ee291b46
RS
3181 (file-error (setq backup-directory nil))))
3182 (if (null backup-directory)
3183 file
ffc0e1ca
AS
3184 (if (file-name-absolute-p backup-directory)
3185 (progn
c60ee5e7 3186 (when (memq system-type '(windows-nt ms-dos cygwin))
d7b6ca4a
RS
3187 ;; Normalize DOSish file names: downcase the drive
3188 ;; letter, if any, and replace the leading "x:" with
3189 ;; "/drive_x".
ffc0e1ca
AS
3190 (or (file-name-absolute-p file)
3191 (setq file (expand-file-name file))) ; make defaults explicit
3192 ;; Replace any invalid file-name characters (for the
3193 ;; case of backing up remote files).
446c097e 3194 (setq file (expand-file-name (convert-standard-filename file)))
ffc0e1ca 3195 (if (eq (aref file 1) ?:)
d7b6ca4a 3196 (setq file (concat "/"
ffc0e1ca
AS
3197 "drive_"
3198 (char-to-string (downcase (aref file 0)))
d7b6ca4a 3199 (if (eq (aref file 2) ?/)
ffc0e1ca 3200 ""
d7b6ca4a 3201 "/")
ffc0e1ca
AS
3202 (substring file 2)))))
3203 ;; Make the name unique by substituting directory
3204 ;; separators. It may not really be worth bothering about
3205 ;; doubling `!'s in the original name...
3206 (expand-file-name
3207 (subst-char-in-string
d7b6ca4a 3208 ?/ ?!
ffc0e1ca
AS
3209 (replace-regexp-in-string "!" "!!" file))
3210 backup-directory))
3211 (expand-file-name (file-name-nondirectory file)
3212 (file-name-as-directory
3213 (expand-file-name backup-directory
3214 (file-name-directory file))))))))
b4da00e9
RM
3215
3216(defun backup-file-name-p (file)
3217 "Return non-nil if FILE is a backup file name (numeric or not).
3218This is a separate function so you can redefine it for customization.
3219You may need to redefine `file-name-sans-versions' as well."
066327ae 3220 (string-match "~\\'" file))
b4da00e9 3221
e2b30772
RS
3222(defvar backup-extract-version-start)
3223
2d051399 3224;; This is used in various files.
a7aa942a
KH
3225;; The usage of backup-extract-version-start is not very clean,
3226;; but I can't see a good alternative, so as of now I am leaving it alone.
2d051399 3227(defun backup-extract-version (fn)
ffc0e1ca 3228 "Given the name of a numeric backup file, FN, return the backup number.
e2b30772 3229Uses the free variable `backup-extract-version-start', whose value should be
2d051399 3230the index in the name where the version number begins."
e2b30772
RS
3231 (if (and (string-match "[0-9]+~$" fn backup-extract-version-start)
3232 (= (match-beginning 0) backup-extract-version-start))
027a4b6b 3233 (string-to-number (substring fn backup-extract-version-start -1))
2d051399
RS
3234 0))
3235
b4da00e9
RM
3236;; I believe there is no need to alter this behavior for VMS;
3237;; since backup files are not made on VMS, it should not get called.
3238(defun find-backup-file-name (fn)
ffc0e1ca 3239 "Find a file name for a backup file FN, and suggestions for deletions.
b4da00e9 3240Value is a list whose car is the name for the backup file
ffc0e1ca
AS
3241and whose cdr is a list of old versions to consider deleting now.
3242If the value is nil, don't make a backup.
3243Uses `backup-directory-alist' in the same way as does
3244`make-backup-file-name'."
eb650569
RS
3245 (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
3246 ;; Run a handler for this function so that ange-ftp can refuse to do it.
3247 (if handler
3248 (funcall handler 'find-backup-file-name fn)
f26d858e
EZ
3249 (if (or (eq version-control 'never)
3250 ;; We don't support numbered backups on plain MS-DOS
3251 ;; when long file names are unavailable.
3252 (and (eq system-type 'ms-dos)
3253 (not (msdos-long-file-names))))
b4da00e9 3254 (list (make-backup-file-name fn))
ffc0e1ca
AS
3255 (let* ((basic-name (make-backup-file-name-1 fn))
3256 (base-versions (concat (file-name-nondirectory basic-name)
3257 ".~"))
e2b30772 3258 (backup-extract-version-start (length base-versions))
eb650569 3259 (high-water-mark 0)
ffc0e1ca
AS
3260 (number-to-delete 0)
3261 possibilities deserve-versions-p versions)
eb650569
RS
3262 (condition-case ()
3263 (setq possibilities (file-name-all-completions
3264 base-versions
ffc0e1ca
AS
3265 (file-name-directory basic-name))
3266 versions (sort (mapcar #'backup-extract-version
3267 possibilities)
3268 #'<)
eb650569
RS
3269 high-water-mark (apply 'max 0 versions)
3270 deserve-versions-p (or version-control
3271 (> high-water-mark 0))
3272 number-to-delete (- (length versions)
ffc0e1ca
AS
3273 kept-old-versions
3274 kept-new-versions
3275 -1))
3276 (file-error (setq possibilities nil)))
eb650569 3277 (if (not deserve-versions-p)
8767d866 3278 (list (make-backup-file-name fn))
ffc0e1ca 3279 (cons (format "%s.~%d~" basic-name (1+ high-water-mark))
eb650569
RS
3280 (if (and (> number-to-delete 0)
3281 ;; Delete nothing if there is overflow
3282 ;; in the number of versions to keep.
3283 (>= (+ kept-new-versions kept-old-versions -1) 0))
ffc0e1ca
AS
3284 (mapcar (lambda (n)
3285 (format "%s.~%d~" basic-name n))
eb650569
RS
3286 (let ((v (nthcdr kept-old-versions versions)))
3287 (rplacd (nthcdr (1- number-to-delete) v) ())
3288 v))))))))))
b4da00e9 3289
b4da00e9
RM
3290(defun file-nlinks (filename)
3291 "Return number of names file FILENAME has."
3292 (car (cdr (file-attributes filename))))
6c636af9 3293
753ad988
KG
3294;; (defun file-relative-name (filename &optional directory)
3295;; "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
3296;; This function returns a relative file name which is equivalent to FILENAME
3297;; when used with that default directory as the default.
3298;; If this is impossible (which can happen on MSDOS and Windows
3299;; when the file name and directory use different drive names)
3300;; then it returns FILENAME."
3301;; (save-match-data
3302;; (let ((fname (expand-file-name filename)))
3303;; (setq directory (file-name-as-directory
3304;; (expand-file-name (or directory default-directory))))
3305;; ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
3306;; ;; drive names, they can't be relative, so return the absolute name.
3307;; (if (and (or (eq system-type 'ms-dos)
3308;; (eq system-type 'cygwin)
3309;; (eq system-type 'windows-nt))
3310;; (not (string-equal (substring fname 0 2)
3311;; (substring directory 0 2))))
3312;; filename
3313;; (let ((ancestor ".")
3314;; (fname-dir (file-name-as-directory fname)))
3315;; (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
3316;; (not (string-match (concat "^" (regexp-quote directory)) fname)))
3317;; (setq directory (file-name-directory (substring directory 0 -1))
3318;; ancestor (if (equal ancestor ".")
3319;; ".."
3320;; (concat "../" ancestor))))
3321;; ;; Now ancestor is empty, or .., or ../.., etc.
3322;; (if (string-match (concat "^" (regexp-quote directory)) fname)
3323;; ;; We matched within FNAME's directory part.
3324;; ;; Add the rest of FNAME onto ANCESTOR.
3325;; (let ((rest (substring fname (match-end 0))))
3326;; (if (and (equal ancestor ".")
3327;; (not (equal rest "")))
3328;; ;; But don't bother with ANCESTOR if it would give us `./'.
3329;; rest
3330;; (concat (file-name-as-directory ancestor) rest)))
3331;; ;; We matched FNAME's directory equivalent.
3332;; ancestor))))))
3333
6c636af9 3334(defun file-relative-name (filename &optional directory)
ffc0e1ca 3335 "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
2d6562a5
RS
3336This function returns a relative file name which is equivalent to FILENAME
3337when used with that default directory as the default.
753ad988 3338If FILENAME and DIRECTORY lie on different machines or on different drives
1be0210d 3339on a DOS/Windows machine, it returns FILENAME in expanded form."
96c188b0 3340 (save-match-data
753ad988
KG
3341 (setq directory
3342 (file-name-as-directory (expand-file-name (or directory
3343 default-directory))))
3344 (setq filename (expand-file-name filename))
3f788773
KG
3345 (let ((fremote (file-remote-p filename))
3346 (dremote (file-remote-p directory)))
493c98af
KG
3347 (if ;; Conditions for separate trees
3348 (or
3349 ;; Test for different drives on DOS/Windows
3350 (and
7c64272b 3351 ;; Should `cygwin' really be included here? --stef
493c98af 3352 (memq system-type '(ms-dos cygwin windows-nt))
7c64272b 3353 (not (eq t (compare-strings filename 0 2 directory 0 2))))
493c98af 3354 ;; Test for different remote file system identification
3f788773 3355 (not (equal fremote dremote)))
e2b30772 3356 filename
753ad988
KG
3357 (let ((ancestor ".")
3358 (filename-dir (file-name-as-directory filename)))
7c64272b
SM
3359 (while (not
3360 (or
3361 (eq t (compare-strings filename-dir nil (length directory)
3362 directory nil nil case-fold-search))
3363 (eq t (compare-strings filename nil (length directory)
3364 directory nil nil case-fold-search))))
753ad988 3365 (setq directory (file-name-directory (substring directory 0 -1))
9695aac6
RS
3366 ancestor (if (equal ancestor ".")
3367 ".."
3368 (concat "../" ancestor))))
753ad988 3369 ;; Now ancestor is empty, or .., or ../.., etc.
7c64272b
SM
3370 (if (eq t (compare-strings filename nil (length directory)
3371 directory nil nil case-fold-search))
753ad988
KG
3372 ;; We matched within FILENAME's directory part.
3373 ;; Add the rest of FILENAME onto ANCESTOR.
3f7d6528 3374 (let ((rest (substring filename (length directory))))
753ad988 3375 (if (and (equal ancestor ".") (not (equal rest "")))
9695aac6
RS
3376 ;; But don't bother with ANCESTOR if it would give us `./'.
3377 rest
3378 (concat (file-name-as-directory ancestor) rest)))
753ad988
KG
3379 ;; We matched FILENAME's directory equivalent.
3380 ancestor))))))
b4da00e9
RM
3381\f
3382(defun save-buffer (&optional args)
e8f4db18
RS
3383 "Save current buffer in visited file if modified.
3384Variations are described below.
3385
b4da00e9
RM
3386By default, makes the previous version into a backup file
3387 if previously requested or if this is the first save.
dc2ab26e 3388Prefixed with one \\[universal-argument], marks this version
b4da00e9 3389 to become a backup when the next save is done.
dc2ab26e 3390Prefixed with two \\[universal-argument]'s,
b4da00e9 3391 unconditionally makes the previous version into a backup file.
dc2ab26e 3392Prefixed with three \\[universal-argument]'s, marks this version
ac9650be
RS
3393 to become a backup when the next save is done,
3394 and unconditionally makes the previous version into a backup file.
3395
dc2ab26e
EZ
3396With a numeric argument of 0, never make the previous version
3397into a backup file.
b4da00e9
RM
3398
3399If a file's name is FOO, the names of its numbered backup versions are
3400 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
3401Numeric backups (rather than FOO~) will be made if value of
3402 `version-control' is not the atom `never' and either there are already
3403 numeric versions of the file being backed up, or `version-control' is
3404 non-nil.
3405We don't want excessive versions piling up, so there are variables
3406 `kept-old-versions', which tells Emacs how many oldest versions to keep,
3407 and `kept-new-versions', which tells how many newest versions to keep.
3408 Defaults are 2 old versions and 2 new.
3409`dired-kept-versions' controls dired's clean-directory (.) command.
de7d5e1b 3410If `delete-old-versions' is nil, system will query user
e73ec04b
RS
3411 before trimming versions. Otherwise it does it silently.
3412
749d2ee6
RS
3413If `vc-make-backup-files' is nil, which is the default,
3414 no backup files are made for files managed by version control.
3415 (This is because the version control system itself records previous versions.)
3416
e73ec04b 3417See the subroutine `basic-save-buffer' for more information."
b4da00e9
RM
3418 (interactive "p")
3419 (let ((modp (buffer-modified-p))
3420 (large (> (buffer-size) 50000))
b5a8e0fc
RS
3421 (make-backup-files (or (and make-backup-files (not (eq args 0)))
3422 (memq args '(16 64)))))
b4da00e9 3423 (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
b4990dde
GM
3424 (if (and modp large (buffer-file-name))
3425 (message "Saving file %s..." (buffer-file-name)))
b4da00e9
RM
3426 (basic-save-buffer)
3427 (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
3428
3429(defun delete-auto-save-file-if-necessary (&optional force)
3430 "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
3431Normally delete only if the file was written by this Emacs since
3432the last real save, but optional arg FORCE non-nil means delete anyway."
3433 (and buffer-auto-save-file-name delete-auto-save-files
3434 (not (string= buffer-file-name buffer-auto-save-file-name))
3435 (or force (recent-auto-save-p))
3436 (progn
3437 (condition-case ()
3438 (delete-file buffer-auto-save-file-name)
3439 (file-error nil))
3440 (set-buffer-auto-saved))))
3441
481f215b
KH
3442(defvar auto-save-hook nil
3443 "Normal hook run just before auto-saving.")
3444
3c3b81d1
SJ
3445(defcustom before-save-hook nil
3446 "Normal hook that is run before a buffer is saved to its file."
25f6295e 3447 :options '(copyright-update time-stamp)
3c3b81d1
SJ
3448 :type 'hook
3449 :group 'files)
3450
ffc0e1ca
AS
3451(defcustom after-save-hook nil
3452 "Normal hook that is run after a buffer is saved to its file."
3453 :options '(executable-make-buffer-file-executable-if-script-p)
3454 :type 'hook
3455 :group 'files)
1cc852cc 3456
0516edee
RS
3457(defvar save-buffer-coding-system nil
3458 "If non-nil, use this coding system for saving the buffer.
3459More precisely, use this coding system in place of the
3460value of `buffer-file-coding-system', when saving the buffer.
3461Calling `write-region' for any purpose other than saving the buffer
3462will still use `buffer-file-coding-system'; this variable has no effect
3463in such cases.")
3464
d5fe94cc
RS
3465(make-variable-buffer-local 'save-buffer-coding-system)
3466(put 'save-buffer-coding-system 'permanent-local t)
3467
b4da00e9 3468(defun basic-save-buffer ()
1cc852cc 3469 "Save the current buffer in its visited file, if it has been modified.
0370fe77
SM
3470The hooks `write-contents-functions' and `write-file-functions' get a chance
3471to do the job of saving; if they do not, then the buffer is saved in
222cf381 3472the visited file in the usual way.
3c3b81d1
SJ
3473Before and after saving the buffer, this function runs
3474`before-save-hook' and `after-save-hook', respectively."
b4da00e9 3475 (interactive)
19618231 3476 (save-current-buffer
c11a94fe
RS
3477 ;; In an indirect buffer, save its base buffer instead.
3478 (if (buffer-base-buffer)
3479 (set-buffer (buffer-base-buffer)))
3480 (if (buffer-modified-p)
3481 (let ((recent-save (recent-auto-save-p))
818286f4 3482 setmodes)
c11a94fe
RS
3483 ;; On VMS, rename file and buffer to get rid of version number.
3484 (if (and (eq system-type 'vax-vms)
3485 (not (string= buffer-file-name
3486 (file-name-sans-versions buffer-file-name))))
3487 (let (buffer-new-name)
3488 ;; Strip VMS version number before save.
3489 (setq buffer-file-name
3490 (file-name-sans-versions buffer-file-name))
3491 ;; Construct a (unique) buffer name to correspond.
3492 (let ((buf (create-file-buffer (downcase buffer-file-name))))
3493 (setq buffer-new-name (buffer-name buf))
3494 (kill-buffer buf))
3495 (rename-buffer buffer-new-name)))
3496 ;; If buffer has no file name, ask user for one.
3497 (or buffer-file-name
182891ef
RS
3498 (let ((filename
3499 (expand-file-name
3500 (read-file-name "File to save in: ") nil)))
3501 (and (file-exists-p filename)
3502 (or (y-or-n-p (format "File `%s' exists; overwrite? "
3503 filename))
3504 (error "Canceled")))
3505 (set-visited-file-name filename)))
c11a94fe
RS
3506 (or (verify-visited-file-modtime (current-buffer))
3507 (not (file-exists-p buffer-file-name))
3508 (yes-or-no-p
3509 (format "%s has changed since visited or saved. Save anyway? "
3510 (file-name-nondirectory buffer-file-name)))
3511 (error "Save not confirmed"))
3512 (save-restriction
3513 (widen)
19618231 3514 (save-excursion
0370fe77 3515 (and (> (point-max) (point-min))
407b4328 3516 (not find-file-literally)
19618231
RS
3517 (/= (char-after (1- (point-max))) ?\n)
3518 (not (and (eq selective-display t)
3519 (= (char-after (1- (point-max))) ?\r)))
3520 (or (eq require-final-newline t)
f4206092 3521 (eq require-final-newline 'visit-save)
19618231
RS
3522 (and require-final-newline
3523 (y-or-n-p
3524 (format "Buffer %s does not end in newline. Add one? "
3525 (buffer-name)))))
3526 (save-excursion
3527 (goto-char (point-max))
3528 (insert ?\n))))
fa5867f6
AS
3529 ;; Support VC version backups.
3530 (vc-before-save)
3c3b81d1 3531 (run-hooks 'before-save-hook)
0370fe77 3532 (or (run-hook-with-args-until-success 'write-contents-functions)
c11a94fe 3533 (run-hook-with-args-until-success 'local-write-file-hooks)
0370fe77 3534 (run-hook-with-args-until-success 'write-file-functions)
0ba5894b
RS
3535 ;; If a hook returned t, file is already "written".
3536 ;; Otherwise, write it the usual way now.
3537 (setq setmodes (basic-save-buffer-1)))
d6e8ea6f
KH
3538 ;; Now we have saved the current buffer. Let's make sure
3539 ;; that buffer-file-coding-system is fixed to what
3540 ;; actually used for saving by binding it locally.
0516edee
RS
3541 (if save-buffer-coding-system
3542 (setq save-buffer-coding-system last-coding-system-used)
3543 (setq buffer-file-coding-system last-coding-system-used))
2a47b4f5
RS
3544 (setq buffer-file-number
3545 (nthcdr 10 (file-attributes buffer-file-name)))
c11a94fe
RS
3546 (if setmodes
3547 (condition-case ()
f3f9e207 3548 (set-file-modes buffer-file-name (car setmodes))
c11a94fe
RS
3549 (error nil))))
3550 ;; If the auto-save file was recent before this command,
3551 ;; delete it now.
3552 (delete-auto-save-file-if-necessary recent-save)
49530862
RS
3553 ;; Support VC `implicit' locking.
3554 (vc-after-save)
c11a94fe
RS
3555 (run-hooks 'after-save-hook))
3556 (message "(No changes need to be saved)"))))
b4da00e9 3557
87d26afc
RS
3558;; This does the "real job" of writing a buffer into its visited file
3559;; and making a backup file. This is what is normally done
0370fe77 3560;; but inhibited if one of write-file-functions returns non-nil.
f3f9e207 3561;; It returns a value (MODES . BACKUPNAME), like backup-buffer.
87d26afc 3562(defun basic-save-buffer-1 ()
969be033
RS
3563 (prog1
3564 (if save-buffer-coding-system
3565 (let ((coding-system-for-write save-buffer-coding-system))
3566 (basic-save-buffer-2))
d5fe94cc 3567 (basic-save-buffer-2))
969be033 3568 (setq buffer-file-coding-system-explicit last-coding-system-used)))
d5fe94cc 3569
f3f9e207 3570;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
d5fe94cc
RS
3571(defun basic-save-buffer-2 ()
3572 (let (tempsetmodes setmodes)
87d26afc
RS
3573 (if (not (file-writable-p buffer-file-name))
3574 (let ((dir (file-name-directory buffer-file-name)))
3575 (if (not (file-directory-p dir))
83c6f446
RS
3576 (if (file-exists-p dir)
3577 (error "%s is not a directory" dir)
cb2fdcfa 3578 (error "%s: no such directory" buffer-file-name))
87d26afc
RS
3579 (if (not (file-exists-p buffer-file-name))
3580 (error "Directory %s write-protected" dir)
3581 (if (yes-or-no-p
3582 (format "File %s is write-protected; try to save anyway? "
3583 (file-name-nondirectory
3584 buffer-file-name)))
3585 (setq tempsetmodes t)
3586 (error "Attempt to save to a file which you aren't allowed to write"))))))
3587 (or buffer-backed-up
3588 (setq setmodes (backup-buffer)))
76d5492b 3589 (let ((dir (file-name-directory buffer-file-name)))
f4a0f59b
RS
3590 (if (and file-precious-flag
3591 (file-writable-p dir))
3592 ;; If file is precious, write temp name, then rename it.
3593 ;; This requires write access to the containing dir,
3594 ;; which is why we don't try it if we don't have that access.
3595 (let ((realname buffer-file-name)
44dce0fb
RS
3596 tempname succeed
3597 (umask (default-file-modes))
6782610c 3598 (old-modtime (visited-file-modtime)))
44dce0fb
RS
3599 ;; Create temp files with strict access rights. It's easy to
3600 ;; loosen them later, whereas it's impossible to close the
3601 ;; time-window of loose permissions otherwise.
f4a0f59b 3602 (unwind-protect
44dce0fb
RS
3603 (progn
3604 (clear-visited-file-modtime)
3605 (set-default-file-modes ?\700)
3606 ;; Try various temporary names.
3607 ;; This code follows the example of make-temp-file,
3608 ;; but it calls write-region in the appropriate way
3609 ;; for saving the buffer.
3610 (while (condition-case ()
3611 (progn
3612 (setq tempname
3613 (make-temp-name
3614 (expand-file-name "tmp" dir)))
3615 (write-region (point-min) (point-max)
3616 tempname nil realname
3617 buffer-file-truename 'excl)
3618 nil)
3619 (file-already-exists t))
3620 ;; The file was somehow created by someone else between
3621 ;; `make-temp-name' and `write-region', let's try again.
3622 nil)
3623 (setq succeed t))
3624 ;; Reset the umask.
3625 (set-default-file-modes umask)
3626 ;; If we failed, restore the buffer's modtime.
3627 (unless succeed
3628 (set-visited-file-modtime old-modtime)))
3629 ;; Since we have created an entirely new file,
3630 ;; make sure it gets the right permission bits set.
f3f9e207
RS
3631 (setq setmodes (or setmodes (cons (file-modes buffer-file-name)
3632 buffer-file-name)))
f4a0f59b
RS
3633 ;; We succeeded in writing the temp file,
3634 ;; so rename it.
3635 (rename-file tempname buffer-file-name t))
3636 ;; If file not writable, see if we can make it writable
3637 ;; temporarily while we write it.
3638 ;; But no need to do so if we have just backed it up
3639 ;; (setmodes is set) because that says we're superseding.
3640 (cond ((and tempsetmodes (not setmodes))
3641 ;; Change the mode back, after writing.
f3f9e207
RS
3642 (setq setmodes (cons (file-modes buffer-file-name) buffer-file-name))
3643 (set-file-modes buffer-file-name (logior (car setmodes) 128))))
3644 (let (success)
3645 (unwind-protect
3646 (progn
3647 (write-region (point-min) (point-max)
3648 buffer-file-name nil t buffer-file-truename)
3649 (setq success t))
3650 ;; If we get an error writing the new file, and we made
3651 ;; the backup by renaming, undo the backing-up.
3652 (and setmodes (not success)
0133dab9
EZ
3653 (progn
3654 (rename-file (cdr setmodes) buffer-file-name t)
3655 (setq buffer-backed-up nil)))))))
87d26afc
RS
3656 setmodes))
3657
1eeae2a1
RS
3658(defun diff-buffer-with-file (&optional buffer)
3659 "View the differences between BUFFER and its associated file.
0b9e4749 3660This requires the external program `diff' to be in your `exec-path'."
1eeae2a1 3661 (interactive "bBuffer: ")
0b9e4749 3662 (with-current-buffer (get-buffer (or buffer (current-buffer)))
4e4e9519
MR
3663 (if (and buffer-file-name
3664 (file-exists-p buffer-file-name))
3665 (let ((tempfile (make-temp-file "buffer-content-")))
3666 (unwind-protect
3667 (save-restriction
3668 (widen)
3669 (write-region (point-min) (point-max) tempfile nil 'nomessage)
3670 (diff buffer-file-name tempfile nil t)
3671 (sit-for 0))
3672 (when (file-exists-p tempfile)
3673 (delete-file tempfile))))
3674 (message "Buffer %s has no associated file on disc" (buffer-name))
3675 ;; Display that message for 1 second so that user can read it
3676 ;; in the minibuffer.
3677 (sit-for 1)))
3678 ;; return always nil, so that save-buffers-kill-emacs will not move
3679 ;; over to the next unsaved buffer when calling `d'.
3680 nil)
1eeae2a1
RS
3681
3682(defvar save-some-buffers-action-alist
3683 '((?\C-r
3684 (lambda (buf)
3685 (view-buffer buf
3686 (lambda (ignore)
3687 (exit-recursive-edit)))
3688 (recursive-edit)
3689 ;; Return nil to ask about BUF again.
3690 nil)
e8f30180 3691 "view this file")
1eeae2a1 3692 (?d diff-buffer-with-file
e8f30180 3693 "view changes in file"))
1eeae2a1 3694 "ACTION-ALIST argument used in call to `map-y-or-n-p'.")
1eeae2a1 3695
a1b0c2a7
RS
3696(defvar buffer-save-without-query nil
3697 "Non-nil means `save-some-buffers' should save this buffer without asking.")
3698(make-variable-buffer-local 'buffer-save-without-query)
3699
ffc0e1ca 3700(defun save-some-buffers (&optional arg pred)
b4da00e9 3701 "Save some modified file-visiting buffers. Asks user about each one.
1eeae2a1
RS
3702You can answer `y' to save, `n' not to save, `C-r' to look at the
3703buffer in question with `view-buffer' before deciding or `d' to
126c9dda 3704view the differences using `diff-buffer-with-file'.
8fd9c174 3705
5bbbceb1 3706Optional argument (the prefix) non-nil means save all with no questions.
ffc0e1ca
AS
3707Optional second argument PRED determines which buffers are considered:
3708If PRED is nil, all the file-visiting buffers are considered.
3709If PRED is t, then certain non-file buffers will also be considered.
3710If PRED is a zero-argument function, it indicates for each buffer whether
1eeae2a1
RS
3711to consider it or not when called with that buffer current.
3712
3713See `save-some-buffers-action-alist' if you want to
3714change the additional actions you can take on files."
b4da00e9 3715 (interactive "P")
907482b9 3716 (save-window-excursion
a1b0c2a7
RS
3717 (let* (queried some-automatic
3718 files-done abbrevs-done)
3719 (dolist (buffer (buffer-list))
3720 ;; First save any buffers that we're supposed to save unconditionally.
3721 ;; That way the following code won't ask about them.
3722 (with-current-buffer buffer
3723 (when (and buffer-save-without-query (buffer-modified-p))
3724 (setq some-automatic t)
3725 (save-buffer))))
3726 ;; Ask about those buffers that merit it,
3727 ;; and record the number thus saved.
3728 (setq files-done
76d5492b
RM
3729 (map-y-or-n-p
3730 (function
3731 (lambda (buffer)
3732 (and (buffer-modified-p buffer)
3733 (not (buffer-base-buffer buffer))
3734 (or
3735 (buffer-file-name buffer)
ffc0e1ca 3736 (and pred
76d5492b
RM
3737 (progn
3738 (set-buffer buffer)
3739 (and buffer-offer-save (> (buffer-size) 0)))))
ffc0e1ca
AS
3740 (or (not (functionp pred))
3741 (with-current-buffer buffer (funcall pred)))
76d5492b
RM
3742 (if arg
3743 t
3744 (setq queried t)
3745 (if (buffer-file-name buffer)
3746 (format "Save file %s? "
3747 (buffer-file-name buffer))
3748 (format "Save buffer %s? "
3749 (buffer-name buffer)))))))
3750 (function
3751 (lambda (buffer)
3752 (set-buffer buffer)
3753 (save-buffer)))
3754 (buffer-list)
3755 '("buffer" "buffers" "save")
1eeae2a1 3756 save-some-buffers-action-alist))
bf247b6e 3757 ;; Maybe to save abbrevs, and record whether
a1b0c2a7
RS
3758 ;; we either saved them or asked to.
3759 (and save-abbrevs abbrevs-changed
3760 (progn
3761 (if (or arg
3762 (eq save-abbrevs 'silently)
3763 (y-or-n-p (format "Save abbrevs in %s? "
3764 abbrev-file-name)))
3765 (write-abbrev-file nil))
3766 ;; Don't keep bothering user if he says no.
3767 (setq abbrevs-changed nil)
3768 (setq abbrevs-done t)))
76d5492b 3769 (or queried (> files-done 0) abbrevs-done
a1b0c2a7
RS
3770 (message (if some-automatic
3771 "(Some special files were saved without asking)"
3772 "(No files need saving)"))))))
b4da00e9
RM
3773\f
3774(defun not-modified (&optional arg)
3775 "Mark current buffer as unmodified, not needing to be saved.
a641f9a1
RM
3776With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
3777
3778It is not a good idea to use this function in Lisp programs, because it
3779prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
b4da00e9
RM
3780 (interactive "P")
3781 (message (if arg "Modification-flag set"
3782 "Modification-flag cleared"))
3783 (set-buffer-modified-p arg))
3784
3785(defun toggle-read-only (&optional arg)
3786 "Change whether this buffer is visiting its file read-only.
2a9fe1e2
RS
3787With arg, set read-only iff arg is positive.
3788If visiting file read-only and `view-read-only' is non-nil, enter view mode."
b4da00e9 3789 (interactive "P")
c60ee5e7 3790 (if (and arg
d758359d
AS
3791 (if (> (prefix-numeric-value arg) 0) buffer-read-only
3792 (not buffer-read-only))) ; If buffer-read-only is set correctly,
3793 nil ; do nothing.
3794 ;; Toggle.
3795 (cond
3796 ((and buffer-read-only view-mode)
3797 (View-exit-and-edit)
3798 (make-local-variable 'view-read-only)
3799 (setq view-read-only t)) ; Must leave view mode.
3800 ((and (not buffer-read-only) view-read-only
818286f4
SM
3801 ;; If view-mode is already active, `view-mode-enter' is a nop.
3802 (not view-mode)
d758359d
AS
3803 (not (eq (get major-mode 'mode-class) 'special)))
3804 (view-mode-enter))
3805 (t (setq buffer-read-only (not buffer-read-only))
3806 (force-mode-line-update)))
3807 (if (vc-backend buffer-file-name)
8a26c165 3808 (message "%s" (substitute-command-keys
a5dd5f60
RS
3809 (concat "File is under version-control; "
3810 "use \\[vc-next-action] to check in/out"))))))
b4da00e9 3811
912192d1 3812(defun insert-file (filename)
b4da00e9
RM
3813 "Insert contents of file FILENAME into buffer after point.
3814Set mark after the inserted text.
3815
3816This function is meant for the user to run interactively.
3817Don't call it from programs! Use `insert-file-contents' instead.
3818\(Its calling sequence is different; see its documentation)."
912192d1 3819 (interactive "*fInsert file: ")
3a64a3cf 3820 (insert-file-1 filename #'insert-file-contents))
b4da00e9 3821
912192d1 3822(defun append-to-file (start end filename)
b4da00e9
RM
3823 "Append the contents of the region to the end of file FILENAME.
3824When called from a function, expects three arguments,
3825START, END and FILENAME. START and END are buffer positions
da30bf98 3826saying what text to write."
912192d1
KH
3827 (interactive "r\nFAppend to file: ")
3828 (write-region start end filename t))
b4da00e9
RM
3829
3830(defun file-newest-backup (filename)
3831 "Return most recent backup file for FILENAME or nil if no backups exist."
ffc0e1ca
AS
3832 ;; `make-backup-file-name' will get us the right directory for
3833 ;; ordinary or numeric backups. It might create a directory for
3834 ;; backups as a side-effect, according to `backup-directory-alist'.
e31cfca5 3835 (let* ((filename (file-name-sans-versions
783bf210 3836 (make-backup-file-name (expand-file-name filename))))
b4da00e9
RM
3837 (file (file-name-nondirectory filename))
3838 (dir (file-name-directory filename))
3839 (comp (file-name-all-completions file dir))
cf7e94a0
RS
3840 (newest nil)
3841 tem)
b4da00e9 3842 (while comp
ffc0e1ca 3843 (setq tem (pop comp))
cf7e94a0
RS
3844 (cond ((and (backup-file-name-p tem)
3845 (string= (file-name-sans-versions tem) file))
3846 (setq tem (concat dir tem))
3847 (if (or (null newest)
3848 (file-newer-than-file-p tem newest))
3849 (setq newest tem)))))
b4da00e9
RM
3850 newest))
3851
3852(defun rename-uniquely ()
3853 "Rename current buffer to a similar name not already taken.
3854This function is useful for creating multiple shell process buffers
3855or multiple mail buffers, etc."
3856 (interactive)
40eb8038 3857 (save-match-data
e0df3aef
KH
3858 (let ((base-name (buffer-name)))
3859 (and (string-match "<[0-9]+>\\'" base-name)
3860 (not (and buffer-file-name
3861 (string= base-name
3862 (file-name-nondirectory buffer-file-name))))
3863 ;; If the existing buffer name has a <NNN>,
3864 ;; which isn't part of the file name (if any),
3865 ;; then get rid of that.
3866 (setq base-name (substring base-name 0 (match-beginning 0))))
3867 (rename-buffer (generate-new-buffer-name base-name))
3941fe2c 3868 (force-mode-line-update))))
5bbbceb1 3869
4e43240a 3870(defun make-directory (dir &optional parents)
5ce8bb89
RS
3871 "Create the directory DIR and any nonexistent parent dirs.
3872Interactively, the default choice of directory to create
3873is the current default directory for file names.
0225ae5e 3874That is useful when you have visited a file in a nonexistent directory.
5ce8bb89
RS
3875
3876Noninteractively, the second (optional) argument PARENTS says whether
07703430
RS
3877to create parent directories if they don't exist. Interactively,
3878this happens by default."
5ce8bb89
RS
3879 (interactive
3880 (list (read-file-name "Make directory: " default-directory default-directory
3881 nil nil)
3882 t))
ee291b46
RS
3883 ;; If default-directory is a remote directory,
3884 ;; make sure we find its make-directory handler.
3885 (setq dir (expand-file-name dir))
6eaebaa2 3886 (let ((handler (find-file-name-handler dir 'make-directory)))
4e43240a
RS
3887 (if handler
3888 (funcall handler 'make-directory dir parents)
3889 (if (not parents)
3890 (make-directory-internal dir)
3891 (let ((dir (directory-file-name (expand-file-name dir)))
3892 create-list)
3893 (while (not (file-exists-p dir))
76d5492b 3894 (setq create-list (cons dir create-list)
4e43240a
RS
3895 dir (directory-file-name (file-name-directory dir))))
3896 (while create-list
3897 (make-directory-internal (car create-list))
3898 (setq create-list (cdr create-list))))))))
b4da00e9
RM
3899\f
3900(put 'revert-buffer-function 'permanent-local t)
3901(defvar revert-buffer-function nil
0973d78b
RS
3902 "Function to use to revert this buffer, or nil to do the default.
3903The function receives two arguments IGNORE-AUTO and NOCONFIRM,
3904which are the arguments that `revert-buffer' received.")
b4da00e9
RM
3905
3906(put 'revert-buffer-insert-file-contents-function 'permanent-local t)
3907(defvar revert-buffer-insert-file-contents-function nil
3908 "Function to use to insert contents when reverting this buffer.
3909Gets two args, first the nominal file name to use,
2df32500
RS
3910and second, t if reading the auto-save file.
3911
3912The function you specify is responsible for updating (or preserving) point.")
b4da00e9 3913
b0dc9757
LT
3914(defvar buffer-stale-function nil
3915 "Function to check whether a non-file buffer needs reverting.
3916This should be a function with one optional argument NOCONFIRM.
44dce0fb 3917Auto Revert Mode passes t for NOCONFIRM. The function should return
8b0b6932
LT
3918non-nil if the buffer should be reverted. A return value of
3919`fast' means that the need for reverting was not checked, but
3920that reverting the buffer is fast. The buffer is current when
3921this function is called.
b0dc9757 3922
4f8453ae
LT
3923The idea behind the NOCONFIRM argument is that it should be
3924non-nil if the buffer is going to be reverted without asking the
3925user. In such situations, one has to be careful with potentially
c90dcdd5
LT
3926time consuming operations.
3927
3928For more information on how this variable is used by Auto Revert mode,
3929see Info node `(emacs-xtra)Supporting additional buffers'.")
b0dc9757 3930
5f76e7d4
KH
3931(defvar before-revert-hook nil
3932 "Normal hook for `revert-buffer' to run before reverting.
3933If `revert-buffer-function' is used to override the normal revert
3934mechanism, this hook is not used.")
3935
3936(defvar after-revert-hook nil
3937 "Normal hook for `revert-buffer' to run after reverting.
3938Note that the hook value that it runs is the value that was in effect
3939before reverting; that makes a difference if you have buffer-local
3940hook functions.
3941
3942If `revert-buffer-function' is used to override the normal revert
3943mechanism, this hook is not used.")
3944
1554c03b
RS
3945(defvar revert-buffer-internal-hook)
3946
9a30563f 3947(defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
7e7c9c4e 3948 "Replace current buffer text with the text of the visited file on disk.
b4da00e9 3949This undoes all changes since the file was visited or saved.
8c0e7b73
JB
3950With a prefix argument, offer to revert from latest auto-save file, if
3951that is more recent than the visited file.
1ab31687 3952
7e7c9c4e
RS
3953This command also works for special buffers that contain text which
3954doesn't come from a file, but reflects some other data base instead:
4e163715 3955for example, Dired buffers and `buffer-list' buffers. In these cases,
7e7c9c4e
RS
3956it reconstructs the buffer contents from the appropriate data base.
3957
65ee6096 3958When called from Lisp, the first argument is IGNORE-AUTO; only offer
1ab31687
JB
3959to revert from the auto-save file when this is nil. Note that the
3960sense of this argument is the reverse of the prefix argument, for the
3961sake of backward compatibility. IGNORE-AUTO is optional, defaulting
3962to nil.
3963
3964Optional second argument NOCONFIRM means don't ask for confirmation at
518dc5be
EZ
3965all. \(The variable `revert-without-query' offers another way to
3966revert buffers without querying for confirmation.)
b4da00e9 3967
5b2b26d5
RS
3968Optional third argument PRESERVE-MODES non-nil means don't alter
3969the files modes. Normally we reinitialize them using `normal-mode'.
3970
8c0e7b73 3971If the value of `revert-buffer-function' is non-nil, it is called to
7e7c9c4e
RS
3972do all the work for this command. Otherwise, the hooks
3973`before-revert-hook' and `after-revert-hook' are run at the beginning
3974and the end, and if `revert-buffer-insert-file-contents-function' is
3975non-nil, it is called instead of rereading visited file contents."
fb6208a6 3976
1ab31687
JB
3977 ;; I admit it's odd to reverse the sense of the prefix argument, but
3978 ;; there is a lot of code out there which assumes that the first
3979 ;; argument should be t to avoid consulting the auto-save file, and
3980 ;; there's no straightforward way to encourage authors to notice a
3981 ;; reversal of the argument sense. So I'm just changing the user
3982 ;; interface, but leaving the programmatic interface the same.
e0867e99 3983 (interactive (list (not current-prefix-arg)))
b4da00e9 3984 (if revert-buffer-function
1ab31687 3985 (funcall revert-buffer-function ignore-auto noconfirm)
44dce0fb
RS
3986 (with-current-buffer (or (buffer-base-buffer (current-buffer))
3987 (current-buffer))
3988 (let* ((auto-save-p (and (not ignore-auto)
3989 (recent-auto-save-p)
3990 buffer-auto-save-file-name
3991 (file-readable-p buffer-auto-save-file-name)
3992 (y-or-n-p
3993 "Buffer has been auto-saved recently. Revert from auto-save file? ")))
3994 (file-name (if auto-save-p
3995 buffer-auto-save-file-name
3996 buffer-file-name)))
3997 (cond ((null file-name)
3998 (error "Buffer does not seem to be associated with any file"))
3999 ((or noconfirm
4000 (and (not (buffer-modified-p))
518dc5be
EZ
4001 (catch 'found
4002 (dolist (regexp revert-without-query)
4003 (when (string-match regexp file-name)
4004 (throw 'found t)))))
44dce0fb
RS
4005 (yes-or-no-p (format "Revert buffer from file %s? "
4006 file-name)))
4007 (run-hooks 'before-revert-hook)
4008 ;; If file was backed up but has changed since,
4009 ;; we shd make another backup.
4010 (and (not auto-save-p)
4011 (not (verify-visited-file-modtime (current-buffer)))
4012 (setq buffer-backed-up nil))
44dce0fb
RS
4013 ;; Effectively copy the after-revert-hook status,
4014 ;; since after-find-file will clobber it.
4015 (let ((global-hook (default-value 'after-revert-hook))
518dc5be
EZ
4016 (local-hook (when (local-variable-p 'after-revert-hook)
4017 after-revert-hook))
4018 (inhibit-read-only t))
4019 (cond
4020 (revert-buffer-insert-file-contents-function
4021 (unless (eq buffer-undo-list t)
4022 ;; Get rid of all undo records for this buffer.
4023 (setq buffer-undo-list nil))
4024 ;; Don't make undo records for the reversion.
4025 (let ((buffer-undo-list t))
4026 (funcall revert-buffer-insert-file-contents-function
4027 file-name auto-save-p)))
4028 ((not (file-exists-p file-name))
4029 (error (if buffer-file-number
4030 "File %s no longer exists!"
4031 "Cannot revert nonexistent file %s")
4032 file-name))
4033 (t
4034 ;; Bind buffer-file-name to nil
4035 ;; so that we don't try to lock the file.
4036 (let ((buffer-file-name nil))
4037 (or auto-save-p
4038 (unlock-buffer)))
4039 (widen)
4040 (let ((coding-system-for-read
4041 ;; Auto-saved file should be read by Emacs'
4042 ;; internal coding.
4043 (if auto-save-p 'auto-save-coding
4044 (or coding-system-for-read
4045 buffer-file-coding-system-explicit))))
4046 ;; This force after-insert-file-set-coding
4047 ;; (called from insert-file-contents) to set
4048 ;; buffer-file-coding-system to a proper value.
4049 (kill-local-variable 'buffer-file-coding-system)
4050
4051 ;; Note that this preserves point in an intelligent way.
4052 (if preserve-modes
4053 (let ((buffer-file-format buffer-file-format))
4054 (insert-file-contents file-name (not auto-save-p)
4055 nil nil t))
4056 (insert-file-contents file-name (not auto-save-p)
4057 nil nil t)))))
44dce0fb
RS
4058 ;; Recompute the truename in case changes in symlinks
4059 ;; have changed the truename.
4060 (setq buffer-file-truename
4061 (abbreviate-file-name (file-truename buffer-file-name)))
4062 (after-find-file nil nil t t preserve-modes)
4063 ;; Run after-revert-hook as it was before we reverted.
4064 (setq-default revert-buffer-internal-hook global-hook)
518dc5be 4065 (if local-hook
44dce0fb
RS
4066 (set (make-local-variable 'revert-buffer-internal-hook)
4067 local-hook)
4068 (kill-local-variable 'revert-buffer-internal-hook))
4069 (run-hooks 'revert-buffer-internal-hook))
4070 t))))))
b4da00e9 4071
64d18e8f
RS
4072(defun recover-this-file ()
4073 "Recover the visited file--get contents from its last auto-save file."
4074 (interactive)
4075 (recover-file buffer-file-name))
4076
b4da00e9
RM
4077(defun recover-file (file)
4078 "Visit file FILE, but get contents from its last auto-save file."
10f7c7fc
RS
4079 ;; Actually putting the file name in the minibuffer should be used
4080 ;; only rarely.
4081 ;; Not just because users often use the default.
e1dadc17 4082 (interactive "FRecover file: ")
b4da00e9 4083 (setq file (expand-file-name file))
f7da6740 4084 (if (auto-save-file-name-p (file-name-nondirectory file))
4e163715 4085 (error "%s is an auto-save file" (abbreviate-file-name file)))
b4da00e9
RM
4086 (let ((file-name (let ((buffer-file-name file))
4087 (make-auto-save-file-name))))
945e1965
RS
4088 (cond ((if (file-exists-p file)
4089 (not (file-newer-than-file-p file-name file))
4090 (not (file-exists-p file-name)))
4e163715
SM
4091 (error "Auto-save file %s not current"
4092 (abbreviate-file-name file-name)))
b4da00e9 4093 ((save-window-excursion
ffc0e1ca
AS
4094 (with-output-to-temp-buffer "*Directory*"
4095 (buffer-disable-undo standard-output)
4096 (save-excursion
4097 (let ((switches dired-listing-switches))
4098 (if (file-symlink-p file)
4099 (setq switches (concat switches "L")))
4100 (set-buffer standard-output)
bc22fd18
EZ
4101 ;; Use insert-directory-safely, not insert-directory,
4102 ;; because these files might not exist. In particular,
4103 ;; FILE might not exist if the auto-save file was for
4104 ;; a buffer that didn't visit a file, such as "*mail*".
4105 ;; The code in v20.x called `ls' directly, so we need
4106 ;; to emulate what `ls' did in that case.
4107 (insert-directory-safely file switches)
4108 (insert-directory-safely file-name switches))))
b4da00e9
RM
4109 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
4110 (switch-to-buffer (find-file-noselect file t))
518dc5be 4111 (let ((inhibit-read-only t)
1e87edf5
KH
4112 ;; Keep the current buffer-file-coding-system.
4113 (coding-system buffer-file-coding-system)
77619f8e
KH
4114 ;; Auto-saved file shoule be read with special coding.
4115 (coding-system-for-read 'auto-save-coding))
b4da00e9 4116 (erase-buffer)
1e87edf5
KH
4117 (insert-file-contents file-name nil)
4118 (set-buffer-file-coding-system coding-system))
8cfb9d46 4119 (after-find-file nil nil t))
ffa7ab70 4120 (t (error "Recover-file cancelled")))))
b4da00e9 4121
6598027d 4122(defun recover-session ()
9aee5392
RS
4123 "Recover auto save files from a previous Emacs session.
4124This command first displays a Dired buffer showing you the
4125previous sessions that you could recover from.
4126To choose one, move point to the proper line and then type C-c C-c.
4127Then you'll be asked about a number of files to recover."
4128 (interactive)
363a5030
RS
4129 (if (null auto-save-list-file-prefix)
4130 (error "You set `auto-save-list-file-prefix' to disable making session files"))
ffc0e1ca
AS
4131 (let ((dir (file-name-directory auto-save-list-file-prefix)))
4132 (unless (file-directory-p dir)
194600a8
JPW
4133 (make-directory dir t))
4134 (unless (directory-files dir nil
4135 (concat "\\`" (regexp-quote
4136 (file-name-nondirectory
4137 auto-save-list-file-prefix)))
4138 t)
4139 (error "No previous sessions to recover")))
6f4983e6 4140 (let ((ls-lisp-support-shell-wildcards t))
7b3478a5
RS
4141 (dired (concat auto-save-list-file-prefix "*")
4142 (concat dired-listing-switches "t")))
05e076c7
AS
4143 (save-excursion
4144 (goto-char (point-min))
4145 (or (looking-at " Move to the session you want to recover,")
4146 (let ((inhibit-read-only t))
4147 ;; Each line starts with a space
4148 ;; so that Font Lock mode won't highlight the first character.
4149 (insert " Move to the session you want to recover,\n"
4150 " then type C-c C-c to select it.\n\n"
4151 " You can also delete some of these files;\n"
4152 " type d on a line to mark that file for deletion.\n\n"))))
9aee5392 4153 (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
80280bb7 4154 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))
9aee5392 4155
80280bb7 4156(defun recover-session-finish ()
9aee5392
RS
4157 "Choose one saved session to recover auto-save files from.
4158This command is used in the special Dired buffer created by
80280bb7 4159\\[recover-session]."
9aee5392
RS
4160 (interactive)
4161 ;; Get the name of the session file to recover from.
4162 (let ((file (dired-get-filename))
953a03b2 4163 files
9aee5392 4164 (buffer (get-buffer-create " *recover*")))
c11032b9 4165 (dired-unmark 1)
033ef863 4166 (dired-do-flagged-delete t)
9aee5392
RS
4167 (unwind-protect
4168 (save-excursion
4169 ;; Read in the auto-save-list file.
4170 (set-buffer buffer)
4171 (erase-buffer)
4172 (insert-file-contents file)
953a03b2
RS
4173 ;; Loop thru the text of that file
4174 ;; and get out the names of the files to recover.
4175 (while (not (eobp))
4176 (let (thisfile autofile)
4177 (if (eolp)
4178 ;; This is a pair of lines for a non-file-visiting buffer.
4179 ;; Get the auto-save file name and manufacture
4180 ;; a "visited file name" from that.
4181 (progn
4182 (forward-line 1)
259be4e6
JB
4183 ;; If there is no auto-save file name, the
4184 ;; auto-save-list file is probably corrupted.
4185 (unless (eolp)
4186 (setq autofile
4187 (buffer-substring-no-properties
4188 (point)
4189 (save-excursion
4190 (end-of-line)
4191 (point))))
4192 (setq thisfile
4193 (expand-file-name
4194 (substring
4195 (file-name-nondirectory autofile)
4196 1 -1)
4197 (file-name-directory autofile))))
953a03b2
RS
4198 (forward-line 1))
4199 ;; This pair of lines is a file-visiting
4200 ;; buffer. Use the visited file name.
4201 (progn
4202 (setq thisfile
4203 (buffer-substring-no-properties
4204 (point) (progn (end-of-line) (point))))
4205 (forward-line 1)
4206 (setq autofile
4207 (buffer-substring-no-properties
4208 (point) (progn (end-of-line) (point))))
4209 (forward-line 1)))
4210 ;; Ignore a file if its auto-save file does not exist now.
259be4e6 4211 (if (and autofile (file-exists-p autofile))
953a03b2
RS
4212 (setq files (cons thisfile files)))))
4213 (setq files (nreverse files))
945e1965
RS
4214 ;; The file contains a pair of line for each auto-saved buffer.
4215 ;; The first line of the pair contains the visited file name
4216 ;; or is empty if the buffer was not visiting a file.
4217 ;; The second line is the auto-save file name.
953a03b2
RS
4218 (if files
4219 (map-y-or-n-p "Recover %s? "
4220 (lambda (file)
4221 (condition-case nil
4222 (save-excursion (recover-file file))
76d5492b 4223 (error
953a03b2
RS
4224 "Failed to recover `%s'" file)))
4225 files
4226 '("file" "files" "recover"))
4227 (message "No files can be recovered from this session now")))
9aee5392
RS
4228 (kill-buffer buffer))))
4229
73ba610a 4230(defun kill-some-buffers (&optional list)
243a3ae0 4231 "Kill some buffers. Asks the user whether to kill each one of them.
bb8eaf67 4232Non-interactively, if optional argument LIST is non-nil, it
243a3ae0 4233specifies the list of buffers to kill, asking for approval for each one."
b4da00e9 4234 (interactive)
73ba610a
RS
4235 (if (null list)
4236 (setq list (buffer-list)))
4237 (while list
4238 (let* ((buffer (car list))
4239 (name (buffer-name buffer)))
cbca0a4b
RS
4240 (and name ; Can be nil for an indirect buffer
4241 ; if we killed the base buffer.
4242 (not (string-equal name ""))
26b9ecbc 4243 (/= (aref name 0) ?\s)
73ba610a
RS
4244 (yes-or-no-p
4245 (format "Buffer %s %s. Kill? "
4246 name
4247 (if (buffer-modified-p buffer)
4248 "HAS BEEN EDITED" "is unmodified")))
4249 (kill-buffer buffer)))
4250 (setq list (cdr list))))
b4da00e9
RM
4251\f
4252(defun auto-save-mode (arg)
4253 "Toggle auto-saving of contents of current buffer.
f3e23606 4254With prefix argument ARG, turn auto-saving on if positive, else off."
b4da00e9
RM
4255 (interactive "P")
4256 (setq buffer-auto-save-file-name
4257 (and (if (null arg)
74b9c2af 4258 (or (not buffer-auto-save-file-name)
4e0c8650 4259 ;; If auto-save is off because buffer has shrunk,
74b9c2af
RS
4260 ;; then toggling should turn it on.
4261 (< buffer-saved-size 0))
b4da00e9
RM
4262 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
4263 (if (and buffer-file-name auto-save-visited-file-name
4264 (not buffer-read-only))
4265 buffer-file-name
4266 (make-auto-save-file-name))))
0b7f1ef2
RS
4267 ;; If -1 was stored here, to temporarily turn off saving,
4268 ;; turn it back on.
4269 (and (< buffer-saved-size 0)
4270 (setq buffer-saved-size 0))
b4da00e9
RM
4271 (if (interactive-p)
4272 (message "Auto-save %s (in this buffer)"
4273 (if buffer-auto-save-file-name "on" "off")))
4274 buffer-auto-save-file-name)
4275
4276(defun rename-auto-save-file ()
4277 "Adjust current buffer's auto save file name for current conditions.
4278Also rename any existing auto save file, if it was made in this session."
4279 (let ((osave buffer-auto-save-file-name))
4280 (setq buffer-auto-save-file-name
4281 (make-auto-save-file-name))
4282 (if (and osave buffer-auto-save-file-name
4283 (not (string= buffer-auto-save-file-name buffer-file-name))
4284 (not (string= buffer-auto-save-file-name osave))
4285 (file-exists-p osave)
4286 (recent-auto-save-p))
4287 (rename-file osave buffer-auto-save-file-name t))))
4288
4289(defun make-auto-save-file-name ()
4290 "Return file name to use for auto-saves of current buffer.
4291Does not consider `auto-save-visited-file-name' as that variable is checked
4292before calling this function. You can redefine this for customization.
4293See also `auto-save-file-name-p'."
4294 (if buffer-file-name
c1105d05
MA
4295 (let ((handler (find-file-name-handler buffer-file-name
4296 'make-auto-save-file-name)))
4297 (if handler
4298 (funcall handler 'make-auto-save-file-name)
4299 (let ((list auto-save-file-name-transforms)
4300 (filename buffer-file-name)
4301 result uniq)
4302 ;; Apply user-specified translations
4303 ;; to the file name.
4304 (while (and list (not result))
4305 (if (string-match (car (car list)) filename)
4306 (setq result (replace-match (cadr (car list)) t nil
4307 filename)
4308 uniq (car (cddr (car list)))))
4309 (setq list (cdr list)))
4310 (if result
4311 (if uniq
4312 (setq filename (concat
4313 (file-name-directory result)
4314 (subst-char-in-string
4315 ?/ ?!
4316 (replace-regexp-in-string "!" "!!"
4317 filename))))
4318 (setq filename result)))
4319 (setq result
4320 (if (and (eq system-type 'ms-dos)
4321 (not (msdos-long-file-names)))
4322 ;; We truncate the file name to DOS 8+3 limits
4323 ;; before doing anything else, because the regexp
4324 ;; passed to string-match below cannot handle
4325 ;; extensions longer than 3 characters, multiple
4326 ;; dots, and other atrocities.
4327 (let ((fn (dos-8+3-filename
4328 (file-name-nondirectory buffer-file-name))))
4329 (string-match
4330 "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
4331 fn)
4332 (concat (file-name-directory buffer-file-name)
4333 "#" (match-string 1 fn)
4334 "." (match-string 3 fn) "#"))
4335 (concat (file-name-directory filename)
4336 "#"
4337 (file-name-nondirectory filename)
4338 "#")))
4339 ;; Make sure auto-save file names don't contain characters
4340 ;; invalid for the underlying filesystem.
4341 (if (and (memq system-type '(ms-dos windows-nt))
4342 ;; Don't modify remote (ange-ftp) filenames
4343 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result)))
4344 (convert-standard-filename result)
4345 result))))
0a1763b4
RS
4346
4347 ;; Deal with buffers that don't have any associated files. (Mail
4348 ;; mode tends to create a good number of these.)
4349
7d483e8c 4350 (let ((buffer-name (buffer-name))
ff5c7181 4351 (limit 0)
77d18896 4352 file-name)
c3348e10
RS
4353 ;; Eliminate all slashes and backslashes by
4354 ;; replacing them with sequences that start with %.
4355 ;; Quote % also, to keep distinct names distinct.
4356 (while (string-match "[/\\%]" buffer-name limit)
4357 (let* ((character (aref buffer-name (match-beginning 0)))
4358 (replacement
4359 (cond ((eq character ?%) "%%")
4360 ((eq character ?/) "%+")
4361 ((eq character ?\\) "%-"))))
4362 (setq buffer-name (replace-match replacement t t buffer-name))
4363 (setq limit (1+ (match-end 0)))))
a8abaf83 4364 ;; Generate the file name.
ff5c7181
RS
4365 (setq file-name
4366 (make-temp-file
4367 (let ((fname
4368 (expand-file-name
4369 (format "#%s#" buffer-name)
4370 ;; Try a few alternative directories, to get one we can
4371 ;; write it.
4372 (cond
4373 ((file-writable-p default-directory) default-directory)
4374 ((file-writable-p "/var/tmp/") "/var/tmp/")
4375 ("~/")))))
4376 (if (and (memq system-type '(ms-dos windows-nt))
4377 ;; Don't modify remote (ange-ftp) filenames
4378 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" fname)))
4379 ;; The call to convert-standard-filename is in case
4380 ;; buffer-name includes characters not allowed by the
4381 ;; DOS/Windows filesystems. make-temp-file writes to the
4382 ;; file it creates, so we must fix the file name _before_
4383 ;; make-temp-file is called.
4384 (convert-standard-filename fname)
4385 fname))
4386 nil "#"))
4387 ;; make-temp-file creates the file,
4388 ;; but we don't want it to exist until we do an auto-save.
4389 (condition-case ()
4390 (delete-file file-name)
4391 (file-error nil))
4392 file-name)))
b4da00e9
RM
4393
4394(defun auto-save-file-name-p (filename)
4395 "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
4396FILENAME should lack slashes. You can redefine this for customization."
4397 (string-match "^#.*#$" filename))
4398\f
6f4983e6
RS
4399(defun wildcard-to-regexp (wildcard)
4400 "Given a shell file name pattern WILDCARD, return an equivalent regexp.
4401The generated regexp will match a filename iff the filename
4402matches that wildcard according to shell rules. Only wildcards known
4403by `sh' are supported."
4404 (let* ((i (string-match "[[.*+\\^$?]" wildcard))
4405 ;; Copy the initial run of non-special characters.
4406 (result (substring wildcard 0 i))
4407 (len (length wildcard)))
4408 ;; If no special characters, we're almost done.
4409 (if i
4410 (while (< i len)
4411 (let ((ch (aref wildcard i))
4412 j)
4413 (setq
4414 result
4415 (concat result
4416 (cond
7e7c9c4e
RS
4417 ((and (eq ch ?\[)
4418 (< (1+ i) len)
4419 (eq (aref wildcard (1+ i)) ?\]))
4420 "\\[")
6f4983e6
RS
4421 ((eq ch ?\[) ; [...] maps to regexp char class
4422 (progn
4423 (setq i (1+ i))
4424 (concat
4425 (cond
4426 ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
4427 (progn
4428 (setq i (1+ i))
4429 (if (eq (aref wildcard i) ?\])
4430 (progn
4431 (setq i (1+ i))
4432 "[^]")
4433 "[^")))
4434 ((eq (aref wildcard i) ?^)
4435 ;; Found "[^". Insert a `\0' character
4436 ;; (which cannot happen in a filename)
4437 ;; into the character class, so that `^'
4438 ;; is not the first character after `[',
4439 ;; and thus non-special in a regexp.
4440 (progn
4441 (setq i (1+ i))
4442 "[\000^"))
4443 ((eq (aref wildcard i) ?\])
4444 ;; I don't think `]' can appear in a
4445 ;; character class in a wildcard, but
4446 ;; let's be general here.
4447 (progn
4448 (setq i (1+ i))
4449 "[]"))
4450 (t "["))
4451 (prog1 ; copy everything upto next `]'.
4452 (substring wildcard
4453 i
4454 (setq j (string-match
4455 "]" wildcard i)))
4456 (setq i (if j (1- j) (1- len)))))))
4457 ((eq ch ?.) "\\.")
4458 ((eq ch ?*) "[^\000]*")
4459 ((eq ch ?+) "\\+")
4460 ((eq ch ?^) "\\^")
4461 ((eq ch ?$) "\\$")
4462 ((eq ch ?\\) "\\\\") ; probably cannot happen...
4463 ((eq ch ??) "[^\000]")
4464 (t (char-to-string ch)))))
4465 (setq i (1+ i)))))
4466 ;; Shell wildcards should match the entire filename,
4467 ;; not its part. Make the regexp say so.
4468 (concat "\\`" result "\\'")))
4469\f
21540597 4470(defcustom list-directory-brief-switches
b4da00e9 4471 (if (eq system-type 'vax-vms) "" "-CF")
ffc0e1ca 4472 "*Switches for `list-directory' to pass to `ls' for brief listing."
21540597
RS
4473 :type 'string
4474 :group 'dired)
b4da00e9 4475
21540597 4476(defcustom list-directory-verbose-switches
b4da00e9
RM
4477 (if (eq system-type 'vax-vms)
4478 "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)"
4479 "-l")
ffc0e1ca 4480 "*Switches for `list-directory' to pass to `ls' for verbose listing."
21540597
RS
4481 :type 'string
4482 :group 'dired)
b4da00e9 4483
5de148a2
RS
4484(defun file-expand-wildcards (pattern &optional full)
4485 "Expand wildcard pattern PATTERN.
4db2a7de
RS
4486This returns a list of file names which match the pattern.
4487
814af837 4488If PATTERN is written as an absolute file name,
4db2a7de
RS
4489the values are absolute also.
4490
4491If PATTERN is written as a relative file name, it is interpreted
4492relative to the current default directory, `default-directory'.
4493The file names returned are normally also relative to the current
4494default directory. However, if FULL is non-nil, they are absolute."
032388f3
RS
4495 (save-match-data
4496 (let* ((nondir (file-name-nondirectory pattern))
4497 (dirpart (file-name-directory pattern))
4498 ;; A list of all dirs that DIRPART specifies.
4499 ;; This can be more than one dir
4500 ;; if DIRPART contains wildcards.
4501 (dirs (if (and dirpart (string-match "[[*?]" dirpart))
4502 (mapcar 'file-name-as-directory
4503 (file-expand-wildcards (directory-file-name dirpart)))
4504 (list dirpart)))
4505 contents)
4506 (while dirs
4507 (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
4508 (file-directory-p (directory-file-name (car dirs))))
4509 (let ((this-dir-contents
4510 ;; Filter out "." and ".."
4511 (delq nil
4512 (mapcar #'(lambda (name)
4513 (unless (string-match "\\`\\.\\.?\\'"
4514 (file-name-nondirectory name))
4515 name))
4516 (directory-files (or (car dirs) ".") full
4517 (wildcard-to-regexp nondir))))))
4518 (setq contents
4519 (nconc
4520 (if (and (car dirs) (not full))
4521 (mapcar (function (lambda (name) (concat (car dirs) name)))
4522 this-dir-contents)
4523 this-dir-contents)
4524 contents))))
4525 (setq dirs (cdr dirs)))
4526 contents)))
5de148a2 4527
b4da00e9
RM
4528(defun list-directory (dirname &optional verbose)
4529 "Display a list of files in or matching DIRNAME, a la `ls'.
4530DIRNAME is globbed by the shell if necessary.
4531Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
4532Actions controlled by variables `list-directory-brief-switches'
4533and `list-directory-verbose-switches'."
4534 (interactive (let ((pfx current-prefix-arg))
4535 (list (read-file-name (if pfx "List directory (verbose): "
4536 "List directory (brief): ")
4537 nil default-directory nil)
4538 pfx)))
4539 (let ((switches (if verbose list-directory-verbose-switches
84905190
RS
4540 list-directory-brief-switches))
4541 buffer)
b4da00e9
RM
4542 (or dirname (setq dirname default-directory))
4543 (setq dirname (expand-file-name dirname))
4544 (with-output-to-temp-buffer "*Directory*"
84905190 4545 (setq buffer standard-output)
b4da00e9
RM
4546 (buffer-disable-undo standard-output)
4547 (princ "Directory ")
4548 (princ dirname)
4549 (terpri)
c3554e95
RS
4550 (save-excursion
4551 (set-buffer "*Directory*")
4552 (let ((wildcard (not (file-directory-p dirname))))
84905190
RS
4553 (insert-directory dirname switches wildcard (not wildcard)))))
4554 ;; Finishing with-output-to-temp-buffer seems to clobber default-directory.
4555 (with-current-buffer buffer
4556 (setq default-directory
4557 (if (file-directory-p dirname)
4558 (file-name-as-directory dirname)
4559 (file-name-directory dirname))))))
c3554e95 4560
ffc0e1ca
AS
4561(defun shell-quote-wildcard-pattern (pattern)
4562 "Quote characters special to the shell in PATTERN, leave wildcards alone.
4563
4564PATTERN is assumed to represent a file-name wildcard suitable for the
4565underlying filesystem. For Unix and GNU/Linux, the characters from the
4566set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all
4567the parts of the pattern which don't include wildcard characters are
4568quoted with double quotes.
4569Existing quote characters in PATTERN are left alone, so you can pass
4570PATTERN that already quotes some of the special characters."
4571 (save-match-data
4572 (cond
c60ee5e7 4573 ((memq system-type '(ms-dos windows-nt cygwin))
ffc0e1ca
AS
4574 ;; DOS/Windows don't allow `"' in file names. So if the
4575 ;; argument has quotes, we can safely assume it is already
4576 ;; quoted by the caller.
4577 (if (or (string-match "[\"]" pattern)
4578 ;; We quote [&()#$'] in case their shell is a port of a
4579 ;; Unixy shell. We quote [,=+] because stock DOS and
4580 ;; Windows shells require that in some cases, such as
4581 ;; passing arguments to batch files that use positional
4582 ;; arguments like %1.
4583 (not (string-match "[ \t;&()#$',=+]" pattern)))
4584 pattern
4585 (let ((result "\"")
4586 (beg 0)
4587 end)
4588 (while (string-match "[*?]+" pattern beg)
4589 (setq end (match-beginning 0)
4590 result (concat result (substring pattern beg end)
4591 "\""
4592 (substring pattern end (match-end 0))
4593 "\"")
4594 beg (match-end 0)))
4595 (concat result (substring pattern beg) "\""))))
4596 (t
4597 (let ((beg 0))
4598 (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
4599 (setq pattern
4600 (concat (substring pattern 0 (match-beginning 0))
4601 "\\"
4602 (substring pattern (match-beginning 0)))
4603 beg (1+ (match-end 0)))))
4604 pattern))))
4605
4606
c3554e95
RS
4607(defvar insert-directory-program "ls"
4608 "Absolute or relative name of the `ls' program used by `insert-directory'.")
4609
f4d04672
RS
4610(defcustom directory-free-space-program "df"
4611 "*Program to get the amount of free space on a file system.
4612We assume the output has the format of `df'.
4613The value of this variable must be just a command name or file name;
4614if you want to specify options, use `directory-free-space-args'.
4615
01b26b90
EZ
4616A value of nil disables this feature.
4617
4618If the function `file-system-info' is defined, it is always used in
4619preference to the program given by this variable."
f4d04672
RS
4620 :type '(choice (string :tag "Program") (const :tag "None" nil))
4621 :group 'dired)
4622
525fdbc9
AS
4623(defcustom directory-free-space-args
4624 (if (eq system-type 'darwin) "-k" "-Pk")
f4d04672
RS
4625 "*Options to use when running `directory-free-space-program'."
4626 :type 'string
4627 :group 'dired)
4628
01b26b90 4629(defun get-free-disk-space (dir)
26b9ecbc 4630 "Return the amount of free space on directory DIR's file system.
01b26b90 4631The result is a string that gives the number of free 1KB blocks,
26b9ecbc 4632or nil if the system call or the program which retrieve the information
01b26b90
EZ
4633fail.
4634
4635This function calls `file-system-info' if it is available, or invokes the
4636program specified by `directory-free-space-program' if that is non-nil."
4637 ;; Try to find the number of free blocks. Non-Posix systems don't
4638 ;; always have df, but might have an equivalent system call.
4639 (if (fboundp 'file-system-info)
4640 (let ((fsinfo (file-system-info dir)))
4641 (if fsinfo
4642 (format "%.0f" (/ (nth 2 fsinfo) 1024))))
4643 (save-match-data
4644 (with-temp-buffer
4645 (when (and directory-free-space-program
15502042
EZ
4646 (eq 0 (call-process directory-free-space-program
4647 nil t nil
4648 directory-free-space-args
4649 dir)))
01b26b90
EZ
4650 ;; Usual format is a header line followed by a line of
4651 ;; numbers.
4652 (goto-char (point-min))
4653 (forward-line 1)
4654 (if (not (eobp))
4655 (progn
4656 ;; Move to the end of the "available blocks" number.
4657 (skip-chars-forward "^ \t")
4658 (forward-word 3)
4659 ;; Copy it into AVAILABLE.
4660 (let ((end (point)))
4661 (forward-word -1)
4662 (buffer-substring (point) end)))))))))
4663
9bc260cf
MA
4664;; The following expression replaces `dired-move-to-filename-regexp'.
4665(defvar directory-listing-before-filename-regexp
4666 (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
4667 (l-or-quote "\\([A-Za-z']\\|[^\0-\177]\\)")
4668 ;; In some locales, month abbreviations are as short as 2 letters,
4669 ;; and they can be followed by ".".
4670 ;; In Breton, a month name can include a quote character.
4671 (month (concat l-or-quote l-or-quote "+\\.?"))
4672 (s " ")
4673 (yyyy "[0-9][0-9][0-9][0-9]")
4674 (dd "[ 0-3][0-9]")
4675 (HH:MM "[ 0-2][0-9][:.][0-5][0-9]")
4676 (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
4677 (zone "[-+][0-2][0-9][0-5][0-9]")
4678 (iso-mm-dd "[01][0-9]-[0-3][0-9]")
4679 (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
4680 (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
4681 "\\|" yyyy "-" iso-mm-dd "\\)"))
4682 (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
4683 s "+"
4684 "\\(" HH:MM "\\|" yyyy "\\)"))
4685 (western-comma (concat month s "+" dd "," s "+" yyyy))
4686 ;; Japanese MS-Windows ls-lisp has one-digit months, and
4687 ;; omits the Kanji characters after month and day-of-month.
4688 ;; On Mac OS X 10.3, the date format in East Asian locales is
4689 ;; day-of-month digits followed by month digits.
4690 (mm "[ 0-1]?[0-9]")
4691 (east-asian
4692 (concat "\\(" mm l "?" s dd l "?" s "+"
4693 "\\|" dd s mm s "+" "\\)"
4694 "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
4695 ;; The "[0-9]" below requires the previous column to end in a digit.
4696 ;; This avoids recognizing `1 may 1997' as a date in the line:
4697 ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README
4698
4699 ;; The "[BkKMGTPEZY]?" below supports "ls -alh" output.
4700 ;; The ".*" below finds the last match if there are multiple matches.
4701 ;; This avoids recognizing `jservice 10 1024' as a date in the line:
4702 ;; drwxr-xr-x 3 jservice 10 1024 Jul 2 1997 esg-host
4703
4704 ;; vc dired listings provide the state or blanks between file
4705 ;; permissions and date. The state is always surrounded by
4706 ;; parantheses:
4707 ;; -rw-r--r-- (modified) 2005-10-22 21:25 files.el
4708 ;; This is not supported yet.
4709 (concat ".*[0-9][BkKMGTPEZY]?" s
4710 "\\(" western "\\|" western-comma "\\|" east-asian "\\|" iso "\\)"
4711 s "+"))
4712 "Regular expression to match up to the file name in a directory listing.
4713The default value is designed to recognize dates and times
4714regardless of the language.")
01b26b90 4715
a1b0c2a7
RS
4716(defvar insert-directory-ls-version 'unknown)
4717
c3554e95
RS
4718;; insert-directory
4719;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
4720;; FULL-DIRECTORY-P is nil.
4721;; The single line of output must display FILE's name as it was
4722;; given, namely, an absolute path name.
4723;; - must insert exactly one line for each file if WILDCARD or
4724;; FULL-DIRECTORY-P is t, plus one optional "total" line
4725;; before the file lines, plus optional text after the file lines.
4726;; Lines are delimited by "\n", so filenames containing "\n" are not
4727;; allowed.
4728;; File lines should display the basename.
4729;; - must be consistent with
4730;; - functions dired-move-to-filename, (these two define what a file line is)
4731;; dired-move-to-end-of-filename,
4732;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
4733;; dired-insert-headerline
4734;; dired-after-subdir-garbage (defines what a "total" line is)
4735;; - variable dired-subdir-regexp
1fc85dae
KG
4736;; - may be passed "--dired" as the first argument in SWITCHES.
4737;; Filename handlers might have to remove this switch if their
4738;; "ls" command does not support it.
c3554e95 4739(defun insert-directory (file switches &optional wildcard full-directory-p)
a18b7c81 4740 "Insert directory listing for FILE, formatted according to SWITCHES.
c3554e95 4741Leaves point after the inserted text.
8f8607be
LT
4742SWITCHES may be a string of options, or a list of strings
4743representing individual options.
c3554e95
RS
4744Optional third arg WILDCARD means treat FILE as shell wildcard.
4745Optional fourth arg FULL-DIRECTORY-P means file is a directory and
4746switches do not contain `d', so that a full listing is expected.
4747
4748This works by running a directory listing program
406e12d9 4749whose name is in the variable `insert-directory-program'.
8f8607be
LT
4750If WILDCARD, it also runs the shell specified by `shell-file-name'.
4751
60ce7e3e 4752When SWITCHES contains the long `--dired' option, this function
8f8607be
LT
4753treats it specially, for the sake of dired. However, the
4754normally equivalent short `-D' option is just passed on to
4755`insert-directory-program', as any other option."
c870ab8e 4756 ;; We need the directory in order to find the right handler.
d2473540
AS
4757 (let ((handler (find-file-name-handler (expand-file-name file)
4758 'insert-directory)))
ebad92dc 4759 (if handler
c3554e95
RS
4760 (funcall handler 'insert-directory file switches
4761 wildcard full-directory-p)
b4da00e9 4762 (if (eq system-type 'vax-vms)
c3554e95 4763 (vms-read-directory file switches (current-buffer))
818286f4 4764 (let (result (beg (point)))
ebad92dc
RS
4765
4766 ;; Read the actual directory using `insert-directory-program'.
4767 ;; RESULT gets the status code.
99f01c91
KH
4768 (let* (;; We at first read by no-conversion, then after
4769 ;; putting text property `dired-filename, decode one
4770 ;; bunch by one to preserve that property.
4771 (coding-system-for-read 'no-conversion)
4772 ;; This is to control encoding the arguments in call-process.
c60ee5e7 4773 (coding-system-for-write
82e22b57
KH
4774 (and enable-multibyte-characters
4775 (or file-name-coding-system
99f01c91 4776 default-file-name-coding-system))))
ebad92dc
RS
4777 (setq result
4778 (if wildcard
4779 ;; Run ls in the directory part of the file pattern
4780 ;; using the last component as argument.
4781 (let ((default-directory
4782 (if (file-name-absolute-p file)
4783 (file-name-directory file)
4784 (file-name-directory (expand-file-name file))))
4785 (pattern (file-name-nondirectory file)))
4786 (call-process
4787 shell-file-name nil t nil
4788 "-c"
4789 (concat (if (memq system-type '(ms-dos windows-nt))
4790 ""
4791 "\\") ; Disregard Unix shell aliases!
4792 insert-directory-program
4793 " -d "
4794 (if (stringp switches)
4795 switches
4796 (mapconcat 'identity switches " "))
4797 " -- "
4798 ;; Quote some characters that have
4799 ;; special meanings in shells; but
4800 ;; don't quote the wildcards--we want
4801 ;; them to be special. We also
4802 ;; currently don't quote the quoting
4803 ;; characters in case people want to
4804 ;; use them explicitly to quote
4805 ;; wildcard characters.
4806 (shell-quote-wildcard-pattern pattern))))
4807 ;; SunOS 4.1.3, SVr4 and others need the "." to list the
4808 ;; directory if FILE is a symbolic link.
4809 (apply 'call-process
4810 insert-directory-program nil t nil
4811 (append
4812 (if (listp switches) switches
4813 (unless (equal switches "")
4814 ;; Split the switches at any spaces so we can
4815 ;; pass separate options as separate args.
4816 (split-string switches)))
4817 ;; Avoid lossage if FILE starts with `-'.
4818 '("--")
4819 (progn
4820 (if (string-match "\\`~" file)
4821 (setq file (expand-file-name file)))
4822 (list
4823 (if full-directory-p
4824 (concat (file-name-as-directory file) ".")
4825 file))))))))
4826
a1b0c2a7
RS
4827 ;; If we got "//DIRED//" in the output, it means we got a real
4828 ;; directory listing, even if `ls' returned nonzero.
4829 ;; So ignore any errors.
4830 (when (if (stringp switches)
4831 (string-match "--dired\\>" switches)
4832 (member "--dired" switches))
4833 (save-excursion
4834 (forward-line -2)
4835 (when (looking-at "//SUBDIRED//")
4836 (forward-line -1))
4837 (if (looking-at "//DIRED//")
4838 (setq result 0))))
4839
4840 (when (and (not (eq 0 result))
4841 (eq insert-directory-ls-version 'unknown))
4842 ;; The first time ls returns an error,
4843 ;; find the version numbers of ls,
4844 ;; and set insert-directory-ls-version
4845 ;; to > if it is more than 5.2.1, < if it is less, nil if it
4846 ;; is equal or if the info cannot be obtained.
4847 ;; (That can mean it isn't GNU ls.)
4848 (let ((version-out
4849 (with-temp-buffer
4850 (call-process "ls" nil t nil "--version")
4851 (buffer-string))))
4852 (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out)
4853 (let* ((version (match-string 1 version-out))
4854 (split (split-string version "[.]"))
027a4b6b 4855 (numbers (mapcar 'string-to-number split))
a1b0c2a7
RS
4856 (min '(5 2 1))
4857 comparison)
4858 (while (and (not comparison) (or numbers min))
4859 (cond ((null min)
4860 (setq comparison '>))
4861 ((null numbers)
4862 (setq comparison '<))
4863 ((> (car numbers) (car min))
4864 (setq comparison '>))
4865 ((< (car numbers) (car min))
4866 (setq comparison '<))
4867 (t
4868 (setq numbers (cdr numbers)
4869 min (cdr min)))))
4870 (setq insert-directory-ls-version (or comparison '=)))
4871 (setq insert-directory-ls-version nil))))
4872
4873 ;; For GNU ls versions 5.2.2 and up, ignore minor errors.
4874 (when (and (eq 1 result) (eq insert-directory-ls-version '>))
4875 (setq result 0))
4876
ebad92dc 4877 ;; If `insert-directory-program' failed, signal an error.
15502042 4878 (unless (eq 0 result)
f2440e42
RS
4879 ;; Delete the error message it may have output.
4880 (delete-region beg (point))
15502042
EZ
4881 ;; On non-Posix systems, we cannot open a directory, so
4882 ;; don't even try, because that will always result in
4883 ;; the ubiquitous "Access denied". Instead, show the
4884 ;; command line so the user can try to guess what went wrong.
4885 (if (and (file-directory-p file)
4886 (memq system-type '(ms-dos windows-nt)))
4887 (error
4888 "Reading directory: \"%s %s -- %s\" exited with status %s"
4889 insert-directory-program
4890 (if (listp switches) (concat switches) switches)
4891 file result)
4892 ;; Unix. Access the file to get a suitable error.
4893 (access-file file "Reading directory")
4894 (error "Listing directory failed but `access-file' worked")))
ebad92dc 4895
8f8607be
LT
4896 (when (if (stringp switches)
4897 (string-match "--dired\\>" switches)
4898 (member "--dired" switches))
9bb99df6
LT
4899 ;; The following overshoots by one line for an empty
4900 ;; directory listed with "--dired", but without "-a"
4901 ;; switch, where the ls output contains a
4902 ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
4903 ;; We take care of that case later.
ff7affeb 4904 (forward-line -2)
9423860f
AS
4905 (when (looking-at "//SUBDIRED//")
4906 (delete-region (point) (progn (forward-line 1) (point)))
4907 (forward-line -1))
9bb99df6
LT
4908 (if (looking-at "//DIRED//")
4909 (let ((end (line-end-position))
4910 (linebeg (point))
4911 error-lines)
4912 ;; Find all the lines that are error messages,
4913 ;; and record the bounds of each one.
4914 (goto-char beg)
4915 (while (< (point) linebeg)
4916 (or (eql (following-char) ?\s)
4917 (push (list (point) (line-end-position)) error-lines))
4918 (forward-line 1))
4919 (setq error-lines (nreverse error-lines))
4920 ;; Now read the numeric positions of file names.
4921 (goto-char linebeg)
4922 (forward-word 1)
4923 (forward-char 3)
4924 (while (< (point) end)
4925 (let ((start (insert-directory-adj-pos
4926 (+ beg (read (current-buffer)))
4927 error-lines))
4928 (end (insert-directory-adj-pos
a1b0c2a7 4929 (+ beg (read (current-buffer)))
9bb99df6 4930 error-lines)))
26b9ecbc 4931 (if (memq (char-after end) '(?\n ?\s))
9bb99df6
LT
4932 ;; End is followed by \n or by " -> ".
4933 (put-text-property start end 'dired-filename t)
4934 ;; It seems that we can't trust ls's output as to
4935 ;; byte positions of filenames.
4936 (put-text-property beg (point) 'dired-filename nil)
4937 (end-of-line))))
4938 (goto-char end)
4939 (beginning-of-line)
4940 (delete-region (point) (progn (forward-line 1) (point))))
4941 ;; Take care of the case where the ls output contains a
4942 ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
4943 ;; and we went one line too far back (see above).
4944 (forward-line 1))
4945 (if (looking-at "//DIRED-OPTIONS//")
4946 (delete-region (point) (progn (forward-line 1) (point)))))
ff7affeb 4947
99f01c91 4948 ;; Now decode what read if necessary.
b6647390
KH
4949 (let ((coding (or coding-system-for-read
4950 file-name-coding-system
4951 default-file-name-coding-system
4952 'undecided))
0bded065 4953 coding-no-eol
99f01c91 4954 val pos)
b6647390
KH
4955 (when (and enable-multibyte-characters
4956 (not (memq (coding-system-base coding)
4957 '(raw-text no-conversion))))
4958 ;; If no coding system is specified or detection is
4959 ;; requested, detect the coding.
4960 (if (eq (coding-system-base coding) 'undecided)
4961 (setq coding (detect-coding-region beg (point) t)))
4962 (if (not (eq (coding-system-base coding) 'undecided))
4963 (save-restriction
0bded065
AS
4964 (setq coding-no-eol
4965 (coding-system-change-eol-conversion coding 'unix))
b6647390
KH
4966 (narrow-to-region beg (point))
4967 (goto-char (point-min))
4968 (while (not (eobp))
4969 (setq pos (point)
4970 val (get-text-property (point) 'dired-filename))
4971 (goto-char (next-single-property-change
4972 (point) 'dired-filename nil (point-max)))
0bded065
AS
4973 ;; Force no eol conversion on a file name, so
4974 ;; that CR is preserved.
4975 (decode-coding-region pos (point)
4976 (if val coding-no-eol coding))
b6647390
KH
4977 (if val
4978 (put-text-property pos (point)
4979 'dired-filename t)))))))
99f01c91 4980
75bb5ca4
AS
4981 (if full-directory-p
4982 ;; Try to insert the amount of free space.
4983 (save-excursion
4984 (goto-char beg)
4985 ;; First find the line to put it on.
4986 (when (re-search-forward "^ *\\(total\\)" nil t)
4987 (let ((available (get-free-disk-space ".")))
4988 (when available
4989 ;; Replace "total" with "used", to avoid confusion.
4990 (replace-match "total used in directory" nil nil nil 1)
4991 (end-of-line)
4992 (insert " available " available)))))))))))
34342a07 4993
a1b0c2a7 4994(defun insert-directory-adj-pos (pos error-lines)
fead94d6 4995 "Convert `ls --dired' file name position value POS to a buffer position.
a1b0c2a7
RS
4996File name position values returned in ls --dired output
4997count only stdout; they don't count the error messages sent to stderr.
4998So this function converts to them to real buffer positions.
4999ERROR-LINES is a list of buffer positions of error message lines,
5000of the form (START END)."
5001 (while (and error-lines (< (caar error-lines) pos))
5002 (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines)))))
5003 (pop error-lines))
5004 pos)
5005
bc22fd18
EZ
5006(defun insert-directory-safely (file switches
5007 &optional wildcard full-directory-p)
5008 "Insert directory listing for FILE, formatted according to SWITCHES.
5009
5010Like `insert-directory', but if FILE does not exist, it inserts a
5011message to that effect instead of signaling an error."
5012 (if (file-exists-p file)
5013 (insert-directory file switches wildcard full-directory-p)
5014 ;; Simulate the message printed by `ls'.
5015 (insert (format "%s: No such file or directory\n" file))))
5016
88902b35 5017(defvar kill-emacs-query-functions nil
65d5c6de 5018 "Functions to call with no arguments to query about killing Emacs.
78c793d1
RS
5019If any of these functions returns nil, killing Emacs is cancelled.
5020`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
5021but `kill-emacs', the low level primitive, does not.
5022See also `kill-emacs-hook'.")
88902b35 5023
11f15305 5024(defcustom confirm-kill-emacs nil
9c2ba08f
EZ
5025 "How to ask for confirmation when leaving Emacs.
5026If nil, the default, don't ask at all. If the value is non-nil, it should
5027be a predicate function such as `yes-or-no-p'."
11f15305
GM
5028 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
5029 (const :tag "Ask with y-or-n-p" y-or-n-p)
5030 (const :tag "Don't confirm" nil))
bdd9ab6e 5031 :group 'convenience
11f15305
GM
5032 :version "21.1")
5033
b4da00e9
RM
5034(defun save-buffers-kill-emacs (&optional arg)
5035 "Offer to save each buffer, then kill this Emacs process.
5036With prefix arg, silently save all file-visiting buffers, then kill."
5037 (interactive "P")
5038 (save-some-buffers arg t)
5039 (and (or (not (memq t (mapcar (function
5040 (lambda (buf) (and (buffer-file-name buf)
5041 (buffer-modified-p buf))))
5042 (buffer-list))))
5043 (yes-or-no-p "Modified buffers exist; exit anyway? "))
5044 (or (not (fboundp 'process-list))
5045 ;; process-list is not defined on VMS.
5046 (let ((processes (process-list))
5047 active)
5048 (while processes
48a4a1fb
KS
5049 (and (memq (process-status (car processes)) '(run stop open listen))
5050 (process-query-on-exit-flag (car processes))
b4da00e9
RM
5051 (setq active t))
5052 (setq processes (cdr processes)))
5053 (or (not active)
48a4a1fb 5054 (list-processes t)
b4da00e9 5055 (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
88902b35 5056 ;; Query the user for other things, perhaps.
fb15c113 5057 (run-hook-with-args-until-failure 'kill-emacs-query-functions)
11f15305
GM
5058 (or (null confirm-kill-emacs)
5059 (funcall confirm-kill-emacs "Really exit Emacs? "))
b4da00e9
RM
5060 (kill-emacs)))
5061\f
ffc0e1ca 5062;; We use /: as a prefix to "quote" a file name
47afc068
RS
5063;; so that magic file name handlers will not apply to it.
5064
5065(setq file-name-handler-alist
5066 (cons '("\\`/:" . file-name-non-special)
5067 file-name-handler-alist))
5068
5069;; We depend on being the last handler on the list,
5070;; so that anything else which does need handling
5071;; has been handled already.
5072;; So it is safe for us to inhibit *all* magic file name handlers.
5073
5074(defun file-name-non-special (operation &rest arguments)
5075 (let ((file-name-handler-alist nil)
5cb1f728
KH
5076 (default-directory
5077 (if (eq operation 'insert-directory)
5078 (directory-file-name
ffc0e1ca 5079 (expand-file-name
5cb1f728
KH
5080 (unhandled-file-name-directory default-directory)))
5081 default-directory))
47afc068
RS
5082 ;; Get a list of the indices of the args which are file names.
5083 (file-arg-indices
5084 (cdr (or (assq operation
ae3b2983 5085 ;; The first six are special because they
47afc068
RS
5086 ;; return a file name. We want to include the /:
5087 ;; in the return value.
5088 ;; So just avoid stripping it in the first place.
5089 '((expand-file-name . nil)
5090 (file-name-directory . nil)
5091 (file-name-as-directory . nil)
5092 (directory-file-name . nil)
c736f678 5093 (file-name-sans-versions . nil)
ae3b2983 5094 (find-backup-file-name . nil)
c736f678 5095 ;; `identity' means just return the first arg
6750c852
RS
5096 ;; not stripped of its quoting.
5097 (substitute-in-file-name identity)
ae3b2983
MA
5098 ;; `add' means add "/:" to the result.
5099 (file-truename add 0)
5100 ;; `quote' means add "/:" to buffer-file-name.
5101 (insert-file-contents quote 0)
5102 ;; `unquote-then-quote' means set buffer-file-name
5103 ;; temporarily to unquoted filename.
5104 (verify-visited-file-modtime unquote-then-quote)
5105 ;; List the arguments which are filenames.
c37adaa5
SM
5106 (file-name-completion 1)
5107 (file-name-all-completions 1)
ae3b2983 5108 (write-region 2 5)
47afc068
RS
5109 (rename-file 0 1)
5110 (copy-file 0 1)
5111 (make-symbolic-link 0 1)
5112 (add-name-to-file 0 1)))
5113 ;; For all other operations, treat the first argument only
5114 ;; as the file name.
5115 '(nil 0))))
6750c852 5116 method
47afc068
RS
5117 ;; Copy ARGUMENTS so we can replace elements in it.
5118 (arguments (copy-sequence arguments)))
6750c852
RS
5119 (if (symbolp (car file-arg-indices))
5120 (setq method (pop file-arg-indices)))
5121 ;; Strip off the /: from the file names that have it.
47afc068 5122 (save-match-data
18b9dced 5123 (while (consp file-arg-indices)
fe4d9852
KH
5124 (let ((pair (nthcdr (car file-arg-indices) arguments)))
5125 (and (car pair)
5126 (string-match "\\`/:" (car pair))
5127 (setcar pair
5128 (if (= (length (car pair)) 2)
5129 "/"
5130 (substring (car pair) 2)))))
47afc068 5131 (setq file-arg-indices (cdr file-arg-indices))))
6750c852
RS
5132 (cond ((eq method 'identity)
5133 (car arguments))
ae3b2983 5134 ((eq method 'add)
6750c852 5135 (concat "/:" (apply operation arguments)))
ae3b2983 5136 ((eq method 'quote)
e8f30180
RS
5137 (unwind-protect
5138 (apply operation arguments)
ae3b2983
MA
5139 (setq buffer-file-name (concat "/:" buffer-file-name))))
5140 ((eq method 'unquote-then-quote)
5141 (let (res)
5142 (setq buffer-file-name (substring buffer-file-name 2))
5143 (setq res (apply operation arguments))
5144 (setq buffer-file-name (concat "/:" buffer-file-name))
5145 res))
6750c852
RS
5146 (t
5147 (apply operation arguments)))))
47afc068 5148\f
b4da00e9 5149(define-key ctl-x-map "\C-f" 'find-file)
b4da00e9
RM
5150(define-key ctl-x-map "\C-r" 'find-file-read-only)
5151(define-key ctl-x-map "\C-v" 'find-alternate-file)
5152(define-key ctl-x-map "\C-s" 'save-buffer)
5153(define-key ctl-x-map "s" 'save-some-buffers)
5154(define-key ctl-x-map "\C-w" 'write-file)
5155(define-key ctl-x-map "i" 'insert-file)
5156(define-key esc-map "~" 'not-modified)
5157(define-key ctl-x-map "\C-d" 'list-directory)
5158(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)
d758359d 5159(define-key ctl-x-map "\C-q" 'toggle-read-only)
b4da00e9
RM
5160
5161(define-key ctl-x-4-map "f" 'find-file-other-window)
5162(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
5163(define-key ctl-x-4-map "\C-f" 'find-file-other-window)
5164(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
924f0a24 5165(define-key ctl-x-4-map "\C-o" 'display-buffer)
5bbbceb1 5166
f98955ea
JB
5167(define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame)
5168(define-key ctl-x-5-map "f" 'find-file-other-frame)
5169(define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
5170(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
3095ccf5 5171(define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame)
c0274f38 5172
c3f6aa20 5173;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f
c0274f38 5174;;; files.el ends here