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