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