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