|
662
|
1 ;;; files.el --- file input and output commands for Emacs
|
|
|
2
|
|
14734
|
3 ;; Copyright (C) 1985, 86, 87, 92, 93,
|
|
21146
|
4 ;; 94, 95, 96, 97, 1998 Free Software Foundation, Inc.
|
|
846
|
5
|
|
807
|
6 ;; Maintainer: FSF
|
|
337
|
7
|
|
|
8 ;; This file is part of GNU Emacs.
|
|
|
9
|
|
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
807
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
337
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
18 ;; GNU General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
14176
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
337
|
24
|
|
2307
|
25 ;;; Commentary:
|
|
|
26
|
|
|
27 ;; Defines most of Emacs's file- and directory-handling functions,
|
|
|
28 ;; including basic file visiting, backup generation, link handling,
|
|
|
29 ;; ITS-id version control, load- and write-hook handling, and the like.
|
|
|
30
|
|
807
|
31 ;;; Code:
|
|
|
32
|
|
17673
|
33 (defgroup backup nil
|
|
|
34 "Backups of edited data files."
|
|
18316
|
35 :group 'files)
|
|
17673
|
36
|
|
|
37 (defgroup find-file nil
|
|
18316
|
38 "Finding files."
|
|
|
39 :group 'files)
|
|
337
|
40
|
|
17673
|
41
|
|
|
42 (defcustom delete-auto-save-files t
|
|
20596
|
43 "*Non-nil means delete auto-save file when a buffer is saved or killed.
|
|
|
44
|
|
|
45 Note that auto-save file will not be deleted if the buffer is killed
|
|
|
46 when it has unsaved changes."
|
|
17673
|
47 :type 'boolean
|
|
|
48 :group 'auto-save)
|
|
|
49
|
|
|
50 (defcustom directory-abbrev-alist
|
|
337
|
51 nil
|
|
|
52 "*Alist of abbreviations for file directories.
|
|
|
53 A list of elements of the form (FROM . TO), each meaning to replace
|
|
|
54 FROM with TO when it appears in a directory name. This replacement is
|
|
|
55 done when setting up the default directory of a newly visited file.
|
|
|
56 *Every* FROM string should start with `^'.
|
|
|
57
|
|
4735
|
58 Do not use `~' in the TO strings.
|
|
|
59 They should be ordinary absolute directory names.
|
|
|
60
|
|
337
|
61 Use this feature when you have directories which you normally refer to
|
|
|
62 via absolute symbolic links. Make TO the name of the link, and FROM
|
|
17673
|
63 the name it is linked to."
|
|
|
64 :type '(repeat (cons :format "%v"
|
|
|
65 :value ("" . "")
|
|
|
66 (regexp :tag "From")
|
|
|
67 (regexp :tag "To")))
|
|
|
68 :group 'abbrev
|
|
|
69 :group 'find-file)
|
|
337
|
70
|
|
|
71 ;;; Turn off backup files on VMS since it has version numbers.
|
|
17673
|
72 (defcustom make-backup-files (not (eq system-type 'vax-vms))
|
|
3634
|
73 "*Non-nil means make a backup of a file the first time it is saved.
|
|
337
|
74 This can be done by renaming the file or by copying.
|
|
|
75
|
|
|
76 Renaming means that Emacs renames the existing file so that it is a
|
|
|
77 backup file, then writes the buffer into a new file. Any other names
|
|
|
78 that the old file had will now refer to the backup file. The new file
|
|
|
79 is owned by you and its group is defaulted.
|
|
|
80
|
|
|
81 Copying means that Emacs copies the existing file into the backup
|
|
|
82 file, then writes the buffer on top of the existing file. Any other
|
|
|
83 names that the old file had will now refer to the new (edited) file.
|
|
|
84 The file's owner and group are unchanged.
|
|
|
85
|
|
|
86 The choice of renaming or copying is controlled by the variables
|
|
|
87 `backup-by-copying', `backup-by-copying-when-linked' and
|
|
17673
|
88 `backup-by-copying-when-mismatch'. See also `backup-inhibited'."
|
|
|
89 :type 'boolean
|
|
|
90 :group 'backup)
|
|
337
|
91
|
|
|
92 ;; Do this so that local variables based on the file name
|
|
|
93 ;; are not overridden by the major mode.
|
|
|
94 (defvar backup-inhibited nil
|
|
4597
|
95 "Non-nil means don't make a backup, regardless of the other parameters.
|
|
|
96 This variable is intended for use by making it local to a buffer.
|
|
|
97 But it is local only if you make it local.")
|
|
337
|
98 (put 'backup-inhibited 'permanent-local t)
|
|
|
99
|
|
17673
|
100 (defcustom backup-by-copying nil
|
|
337
|
101 "*Non-nil means always use copying to create backup files.
|
|
17673
|
102 See documentation of variable `make-backup-files'."
|
|
|
103 :type 'boolean
|
|
|
104 :group 'backup)
|
|
337
|
105
|
|
17673
|
106 (defcustom backup-by-copying-when-linked nil
|
|
337
|
107 "*Non-nil means use copying to create backups for files with multiple names.
|
|
|
108 This causes the alternate names to refer to the latest version as edited.
|
|
17673
|
109 This variable is relevant only if `backup-by-copying' is nil."
|
|
|
110 :type 'boolean
|
|
|
111 :group 'backup)
|
|
337
|
112
|
|
17673
|
113 (defcustom backup-by-copying-when-mismatch nil
|
|
337
|
114 "*Non-nil means create backups by copying if this preserves owner or group.
|
|
|
115 Renaming may still be used (subject to control of other variables)
|
|
|
116 when it would not result in changing the owner or group of the file;
|
|
|
117 that is, for files which are owned by you and whose group matches
|
|
|
118 the default for a new file created there by you.
|
|
17673
|
119 This variable is relevant only if `backup-by-copying' is nil."
|
|
|
120 :type 'boolean
|
|
|
121 :group 'backup)
|
|
337
|
122
|
|
|
123 (defvar backup-enable-predicate
|
|
|
124 '(lambda (name)
|
|
|
125 (or (< (length name) 5)
|
|
|
126 (not (string-equal "/tmp/" (substring name 0 5)))))
|
|
|
127 "Predicate that looks at a file name and decides whether to make backups.
|
|
|
128 Called with an absolute file name as argument, it returns t to enable backup.")
|
|
|
129
|
|
17673
|
130 (defcustom buffer-offer-save nil
|
|
337
|
131 "*Non-nil in a buffer means offer to save the buffer on exit
|
|
|
132 even if the buffer is not visiting a file.
|
|
17673
|
133 Automatically local in all buffers."
|
|
|
134 :type 'boolean
|
|
|
135 :group 'backup)
|
|
337
|
136 (make-variable-buffer-local 'buffer-offer-save)
|
|
|
137
|
|
17673
|
138 (defcustom find-file-existing-other-name t
|
|
1395
|
139 "*Non-nil means find a file under alternative names, in existing buffers.
|
|
|
140 This means if any existing buffer is visiting the file you want
|
|
17673
|
141 under another name, you get the existing buffer instead of a new buffer."
|
|
|
142 :type 'boolean
|
|
|
143 :group 'find-file)
|
|
1395
|
144
|
|
17673
|
145 (defcustom find-file-visit-truename nil
|
|
1395
|
146 "*Non-nil means visit a file under its truename.
|
|
|
147 The truename of a file is found by chasing all links
|
|
17673
|
148 both at the file level and at the levels of the containing directories."
|
|
|
149 :type 'boolean
|
|
|
150 :group 'find-file)
|
|
1395
|
151
|
|
17894
|
152 (defcustom revert-without-query
|
|
16687
|
153 nil
|
|
16684
|
154 "*Specify which files should be reverted without query.
|
|
|
155 The value is a list of regular expressions.
|
|
|
156 If the file name matches one of these regular expressions,
|
|
17894
|
157 then `revert-buffer' reverts the file without querying
|
|
17673
|
158 if the file has changed on disk and you have not edited the buffer."
|
|
20018
|
159 :type '(repeat regexp)
|
|
17673
|
160 :group 'find-file)
|
|
16684
|
161
|
|
1395
|
162 (defvar buffer-file-number nil
|
|
|
163 "The device number and file number of the file visited in the current buffer.
|
|
|
164 The value is a list of the form (FILENUM DEVNUM).
|
|
|
165 This pair of numbers uniquely identifies the file.
|
|
|
166 If the buffer is visiting a new file, the value is nil.")
|
|
|
167 (make-variable-buffer-local 'buffer-file-number)
|
|
|
168 (put 'buffer-file-number 'permanent-local t)
|
|
|
169
|
|
15329
|
170 (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
|
|
|
171 "Non-nil means that buffer-file-number uniquely identifies files.")
|
|
|
172
|
22175
0a2e8ec2a766
(file-name-invalid-regexp): New variable, moved here from arc-mode.el
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
173 (defvar file-name-invalid-regexp
|
0a2e8ec2a766
(file-name-invalid-regexp): New variable, moved here from arc-mode.el
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
174 (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
|
22762
1de4d5771a8f
(file-name-invalid-regexp): Fix the part which handles colons in file names.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
175 (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
|
22175
0a2e8ec2a766
(file-name-invalid-regexp): New variable, moved here from arc-mode.el
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
176 "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters
|
|
22480
|
177 "[\000-\031]|" ; control characters
|
22175
0a2e8ec2a766
(file-name-invalid-regexp): New variable, moved here from arc-mode.el
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
178 "\\(/\\.\\.?[^/]\\)\\|" ; leading dots
|
0a2e8ec2a766
(file-name-invalid-regexp): New variable, moved here from arc-mode.el
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
179 "\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot
|
0a2e8ec2a766
(file-name-invalid-regexp): New variable, moved here from arc-mode.el
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
180 ((memq system-type '(ms-dos windows-nt))
|
22762
1de4d5771a8f
(file-name-invalid-regexp): Fix the part which handles colons in file names.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
181 (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
|
|
22480
|
182 "[|<>\"?*\000-\031]")) ; invalid characters
|
22175
0a2e8ec2a766
(file-name-invalid-regexp): New variable, moved here from arc-mode.el
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
183 (t "[\000]"))
|
0a2e8ec2a766
(file-name-invalid-regexp): New variable, moved here from arc-mode.el
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
184 "Regexp recognizing file names which aren't allowed by the filesystem.")
|
0a2e8ec2a766
(file-name-invalid-regexp): New variable, moved here from arc-mode.el
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
185
|
|
17673
|
186 (defcustom file-precious-flag nil
|
|
337
|
187 "*Non-nil means protect against I/O errors while saving files.
|
|
12105
|
188 Some modes set this non-nil in particular buffers.
|
|
12145
|
189
|
|
|
190 This feature works by writing the new contents into a temporary file
|
|
|
191 and then renaming the temporary file to replace the original.
|
|
|
192 In this way, any I/O error in writing leaves the original untouched,
|
|
|
193 and there is never any instant where the file is nonexistent.
|
|
|
194
|
|
|
195 Note that this feature forces backups to be made by copying.
|
|
12105
|
196 Yet, at the same time, saving a precious file
|
|
17673
|
197 breaks any hard links between it and other files."
|
|
|
198 :type 'boolean
|
|
|
199 :group 'backup)
|
|
337
|
200
|
|
17673
|
201 (defcustom version-control nil
|
|
337
|
202 "*Control use of version numbers for backup files.
|
|
|
203 t means make numeric backup versions unconditionally.
|
|
|
204 nil means make them for files that have some already.
|
|
17673
|
205 `never' means do not make them."
|
|
22582
|
206 :type '(choice (const :tag "Never" never)
|
|
|
207 (const :tag "If existing" nil)
|
|
|
208 (other :tag "Always" t))
|
|
17673
|
209 :group 'backup
|
|
|
210 :group 'vc)
|
|
337
|
211
|
|
17673
|
212 (defcustom dired-kept-versions 2
|
|
|
213 "*When cleaning directory, number of versions to keep."
|
|
|
214 :type 'integer
|
|
|
215 :group 'backup
|
|
|
216 :group 'dired)
|
|
337
|
217
|
|
17673
|
218 (defcustom delete-old-versions nil
|
|
|
219 "*If t, delete excess backup versions silently.
|
|
|
220 If nil, ask confirmation. Any other value prevents any trimming."
|
|
|
221 :type '(choice (const :tag "Delete" t)
|
|
|
222 (const :tag "Ask" nil)
|
|
22582
|
223 (other :tag "Leave" other))
|
|
17673
|
224 :group 'backup)
|
|
337
|
225
|
|
17673
|
226 (defcustom kept-old-versions 2
|
|
|
227 "*Number of oldest versions to keep when a new numbered backup is made."
|
|
|
228 :type 'integer
|
|
|
229 :group 'backup)
|
|
|
230
|
|
|
231 (defcustom kept-new-versions 2
|
|
337
|
232 "*Number of newest versions to keep when a new numbered backup is made.
|
|
17673
|
233 Includes the new backup. Must be > 0"
|
|
|
234 :type 'integer
|
|
|
235 :group 'backup)
|
|
337
|
236
|
|
17673
|
237 (defcustom require-final-newline nil
|
|
337
|
238 "*Value of t says silently ensure a file ends in a newline when it is saved.
|
|
|
239 Non-nil but not t says ask user whether to add a newline when there isn't one.
|
|
17673
|
240 nil means don't add newlines."
|
|
18340
|
241 :type '(choice (const :tag "Off" nil)
|
|
|
242 (const :tag "Add" t)
|
|
22582
|
243 (other :tag "Ask" ask))
|
|
17673
|
244 :group 'editing-basics)
|
|
337
|
245
|
|
17673
|
246 (defcustom auto-save-default t
|
|
|
247 "*Non-nil says by default do auto-saving of every file-visiting buffer."
|
|
|
248 :type 'boolean
|
|
|
249 :group 'auto-save)
|
|
337
|
250
|
|
17673
|
251 (defcustom auto-save-visited-file-name nil
|
|
337
|
252 "*Non-nil says auto-save a buffer in the file it is visiting, when practical.
|
|
17673
|
253 Normally auto-save files are written under other names."
|
|
|
254 :type 'boolean
|
|
|
255 :group 'auto-save)
|
|
337
|
256
|
|
17673
|
257 (defcustom save-abbrevs nil
|
|
337
|
258 "*Non-nil means save word abbrevs too when files are saved.
|
|
17673
|
259 Loading an abbrev file sets this to t."
|
|
|
260 :type 'boolean
|
|
|
261 :group 'abbrev)
|
|
337
|
262
|
|
17673
|
263 (defcustom find-file-run-dired t
|
|
|
264 "*Non-nil says run dired if `find-file' is given the name of a directory."
|
|
|
265 :type 'boolean
|
|
|
266 :group 'find-file)
|
|
337
|
267
|
|
1879
|
268 ;;;It is not useful to make this a local variable.
|
|
|
269 ;;;(put 'find-file-not-found-hooks 'permanent-local t)
|
|
337
|
270 (defvar find-file-not-found-hooks nil
|
|
|
271 "List of functions to be called for `find-file' on nonexistent file.
|
|
|
272 These functions are called as soon as the error is detected.
|
|
|
273 `buffer-file-name' is already set up.
|
|
|
274 The functions are called in the order given until one of them returns non-nil.")
|
|
|
275
|
|
1879
|
276 ;;;It is not useful to make this a local variable.
|
|
|
277 ;;;(put 'find-file-hooks 'permanent-local t)
|
|
337
|
278 (defvar find-file-hooks nil
|
|
|
279 "List of functions to be called after a buffer is loaded from a file.
|
|
|
280 The buffer's local variables (if any) will have been processed before the
|
|
|
281 functions are called.")
|
|
|
282
|
|
|
283 (defvar write-file-hooks nil
|
|
|
284 "List of functions to be called before writing out a buffer to a file.
|
|
|
285 If one of them returns non-nil, the file is considered already written
|
|
605
|
286 and the rest are not called.
|
|
|
287 These hooks are considered to pertain to the visited file.
|
|
|
288 So this list is cleared if you change the visited file name.
|
|
14112
|
289
|
|
|
290 Don't make this variable buffer-local; instead, use `local-write-file-hooks'.
|
|
|
291 See also `write-contents-hooks'.")
|
|
4762
|
292 ;;; However, in case someone does make it local...
|
|
|
293 (put 'write-file-hooks 'permanent-local t)
|
|
2375
|
294
|
|
|
295 (defvar local-write-file-hooks nil
|
|
|
296 "Just like `write-file-hooks', except intended for per-buffer use.
|
|
|
297 The functions in this list are called before the ones in
|
|
14112
|
298 `write-file-hooks'.
|
|
|
299
|
|
|
300 This variable is meant to be used for hooks that have to do with a
|
|
|
301 particular visited file. Therefore, it is a permanent local, so that
|
|
|
302 changing the major mode does not clear it. However, calling
|
|
|
303 `set-visited-file-name' does clear it.")
|
|
4762
|
304 (make-variable-buffer-local 'local-write-file-hooks)
|
|
|
305 (put 'local-write-file-hooks 'permanent-local t)
|
|
605
|
306
|
|
|
307 (defvar write-contents-hooks nil
|
|
|
308 "List of functions to be called before writing out a buffer to a file.
|
|
|
309 If one of them returns non-nil, the file is considered already written
|
|
|
310 and the rest are not called.
|
|
14112
|
311
|
|
|
312 This variable is meant to be used for hooks that pertain to the
|
|
|
313 buffer's contents, not to the particular visited file; thus,
|
|
|
314 `set-visited-file-name' does not clear this variable; but changing the
|
|
14176
|
315 major mode does clear it.
|
|
|
316
|
|
|
317 This variable automatically becomes buffer-local whenever it is set.
|
|
16586
|
318 If you use `add-hook' to add elements to the list, use nil for the
|
|
14176
|
319 LOCAL argument.
|
|
14112
|
320
|
|
605
|
321 See also `write-file-hooks'.")
|
|
14112
|
322 (make-variable-buffer-local 'write-contents-hooks)
|
|
337
|
323
|
|
17673
|
324 (defcustom enable-local-variables t
|
|
16440
|
325 "*Control use of local variables in files you visit.
|
|
337
|
326 The value can be t, nil or something else.
|
|
16440
|
327 A value of t means file local variables specifications are obeyed;
|
|
337
|
328 nil means they are ignored; anything else means query.
|
|
|
329
|
|
16440
|
330 The command \\[normal-mode] always obeys file local variable
|
|
17673
|
331 specifications and ignores this variable."
|
|
|
332 :type '(choice (const :tag "Obey" t)
|
|
|
333 (const :tag "Ignore" nil)
|
|
22582
|
334 (other :tag "Query" other))
|
|
17673
|
335 :group 'find-file)
|
|
337
|
336
|
|
22476
|
337 (defvar local-enable-local-variables t
|
|
|
338 "Like `enable-local-variables' but meant for buffer-local bindings.
|
|
|
339 If a major mode sets this to nil, buffer-locally, then any local
|
|
|
340 variables list in the file will be ignored.")
|
|
|
341
|
|
17673
|
342 (defcustom enable-local-eval 'maybe
|
|
722
|
343 "*Control processing of the \"variable\" `eval' in a file's local variables.
|
|
|
344 The value can be t, nil or something else.
|
|
|
345 A value of t means obey `eval' variables;
|
|
|
346 nil means ignore them; anything else means query.
|
|
|
347
|
|
|
348 The command \\[normal-mode] always obeys local-variables lists
|
|
17673
|
349 and ignores this variable."
|
|
|
350 :type '(choice (const :tag "Obey" t)
|
|
|
351 (const :tag "Ignore" nil)
|
|
22582
|
352 (other :tag "Query" other))
|
|
17673
|
353 :group 'find-file)
|
|
337
|
354
|
|
|
355 ;; Avoid losing in versions where CLASH_DETECTION is disabled.
|
|
|
356 (or (fboundp 'lock-buffer)
|
|
2575
|
357 (defalias 'lock-buffer 'ignore))
|
|
337
|
358 (or (fboundp 'unlock-buffer)
|
|
2575
|
359 (defalias 'unlock-buffer 'ignore))
|
|
16214
|
360 (or (fboundp 'file-locked-p)
|
|
|
361 (defalias 'file-locked-p 'ignore))
|
|
4186
|
362
|
|
18316
|
363 (defvar view-read-only nil
|
|
|
364 "*Non-nil means buffers visiting files read-only, do it in view mode.")
|
|
|
365
|
|
22143
|
366 (defvar temporary-file-directory
|
|
|
367 (file-name-as-directory
|
|
22084
|
368 (cond ((memq system-type '(ms-dos windows-nt))
|
|
|
369 (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
|
|
|
370 ((memq system-type '(vax-vms axp-vms))
|
|
|
371 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
|
|
|
372 (t
|
|
|
373 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
|
|
22143
|
374 "The directory for writing temporary files.")
|
|
22084
|
375
|
|
22405
|
376 ;; The system null device. (Should reference NULL_DEVICE from C.)
|
|
|
377 (defvar null-device "/dev/null" "The system null device.")
|
|
|
378
|
|
4186
|
379 ;; This hook function provides support for ange-ftp host name
|
|
|
380 ;; completion. It runs the usual ange-ftp hook, but only for
|
|
|
381 ;; completion operations. Having this here avoids the need
|
|
|
382 ;; to load ange-ftp when it's not really in use.
|
|
|
383 (defun ange-ftp-completion-hook-function (op &rest args)
|
|
|
384 (if (memq op '(file-name-completion file-name-all-completions))
|
|
|
385 (apply 'ange-ftp-hook-function op args)
|
|
7142
|
386 (let ((inhibit-file-name-handlers
|
|
|
387 (cons 'ange-ftp-completion-hook-function
|
|
|
388 (and (eq inhibit-file-name-operation op)
|
|
|
389 inhibit-file-name-handlers)))
|
|
|
390 (inhibit-file-name-operation op))
|
|
4186
|
391 (apply op args))))
|
13903
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
392
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
393 (defun convert-standard-filename (filename)
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
394 "Convert a standard file's name to something suitable for the current OS.
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
395 This function's standard definition is trivial; it just returns the argument.
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
396 However, on some systems, the function is redefined
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
397 with a definition that really does change some file names."
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
398 filename)
|
|
337
|
399
|
|
|
400 (defun pwd ()
|
|
|
401 "Show the current default directory."
|
|
|
402 (interactive nil)
|
|
|
403 (message "Directory %s" default-directory))
|
|
|
404
|
|
2575
|
405 (defvar cd-path nil
|
|
|
406 "Value of the CDPATH environment variable, as a list.
|
|
|
407 Not actually set up until the first time you you use it.")
|
|
|
408
|
|
|
409 (defun parse-colon-path (cd-path)
|
|
17894
|
410 "Explode a colon-separated search path into a list of directory names."
|
|
2575
|
411 (and cd-path
|
|
|
412 (let (cd-prefix cd-list (cd-start 0) cd-colon)
|
|
11817
|
413 (setq cd-path (concat cd-path path-separator))
|
|
|
414 (while (setq cd-colon (string-match path-separator cd-path cd-start))
|
|
2575
|
415 (setq cd-list
|
|
3038
|
416 (nconc cd-list
|
4216
6f940dcec978
(parse-colon-path): Really make nil, not ".", for empty path element.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
417 (list (if (= cd-start cd-colon)
|
6f940dcec978
(parse-colon-path): Really make nil, not ".", for empty path element.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
418 nil
|
6f940dcec978
(parse-colon-path): Really make nil, not ".", for empty path element.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
419 (substitute-in-file-name
|
|
4196
|
420 (file-name-as-directory
|
|
|
421 (substring cd-path cd-start cd-colon)))))))
|
|
2575
|
422 (setq cd-start (+ cd-colon 1)))
|
|
|
423 cd-list)))
|
|
|
424
|
|
|
425 (defun cd-absolute (dir)
|
|
3652
|
426 "Change current directory to given absolute file name DIR."
|
|
8362
|
427 ;; Put the name into directory syntax now,
|
|
|
428 ;; because otherwise expand-file-name may give some bad results.
|
|
337
|
429 (if (not (eq system-type 'vax-vms))
|
|
|
430 (setq dir (file-name-as-directory dir)))
|
|
8362
|
431 (setq dir (abbreviate-file-name (expand-file-name dir)))
|
|
337
|
432 (if (not (file-directory-p dir))
|
|
18819
|
433 (if (file-exists-p dir)
|
|
|
434 (error "%s is not a directory" dir)
|
|
19159
|
435 (error "%s: no such directory" dir))
|
|
337
|
436 (if (file-executable-p dir)
|
|
|
437 (setq default-directory dir)
|
|
3038
|
438 (error "Cannot cd to %s: Permission denied" dir))))
|
|
337
|
439
|
|
2575
|
440 (defun cd (dir)
|
|
|
441 "Make DIR become the current buffer's default directory.
|
|
3652
|
442 If your environment includes a `CDPATH' variable, try each one of that
|
|
|
443 colon-separated list of directories when resolving a relative directory name."
|
|
12719
|
444 (interactive
|
|
|
445 (list (read-file-name "Change default directory: "
|
13095
8477c2dca6b0
(cd): Fix interactive spec to require match if there is no CDPATH.
Roland McGrath <roland@gnu.org>
diff
changeset
|
446 default-directory default-directory
|
8477c2dca6b0
(cd): Fix interactive spec to require match if there is no CDPATH.
Roland McGrath <roland@gnu.org>
diff
changeset
|
447 (and (member cd-path '(nil ("./")))
|
8477c2dca6b0
(cd): Fix interactive spec to require match if there is no CDPATH.
Roland McGrath <roland@gnu.org>
diff
changeset
|
448 (null (getenv "CDPATH"))))))
|
|
3652
|
449 (if (file-name-absolute-p dir)
|
|
|
450 (cd-absolute (expand-file-name dir))
|
|
|
451 (if (null cd-path)
|
|
|
452 (let ((trypath (parse-colon-path (getenv "CDPATH"))))
|
|
|
453 (setq cd-path (or trypath (list "./")))))
|
|
|
454 (if (not (catch 'found
|
|
|
455 (mapcar
|
|
|
456 (function (lambda (x)
|
|
|
457 (let ((f (expand-file-name (concat x dir))))
|
|
|
458 (if (file-directory-p f)
|
|
|
459 (progn
|
|
|
460 (cd-absolute f)
|
|
|
461 (throw 'found t))))))
|
|
|
462 cd-path)
|
|
|
463 nil))
|
|
|
464 (error "No such directory found via CDPATH environment variable"))))
|
|
2575
|
465
|
|
337
|
466 (defun load-file (file)
|
|
|
467 "Load the Lisp file named FILE."
|
|
|
468 (interactive "fLoad file: ")
|
|
|
469 (load (expand-file-name file) nil nil t))
|
|
|
470
|
|
|
471 (defun load-library (library)
|
|
|
472 "Load the library named LIBRARY.
|
|
|
473 This is an interface to the function `load'."
|
|
|
474 (interactive "sLoad library: ")
|
|
|
475 (load library))
|
|
1134
|
476
|
|
7036
|
477 (defun file-local-copy (file &optional buffer)
|
|
1134
|
478 "Copy the file FILE into a temporary file on this machine.
|
|
|
479 Returns the name of the local copy, or nil, if FILE is directly
|
|
|
480 accessible."
|
|
7030
|
481 (let ((handler (find-file-name-handler file 'file-local-copy)))
|
|
1134
|
482 (if handler
|
|
|
483 (funcall handler 'file-local-copy file)
|
|
|
484 nil)))
|
|
1395
|
485
|
|
8148
|
486 (defun file-truename (filename &optional counter prev-dirs)
|
|
1395
|
487 "Return the truename of FILENAME, which should be absolute.
|
|
|
488 The truename of a file name is found by chasing symbolic links
|
|
|
489 both at the level of the file and at the level of the directories
|
|
8148
|
490 containing it, until no links are left at any level.
|
|
|
491
|
|
|
492 The arguments COUNTER and PREV-DIRS are used only in recursive calls.
|
|
|
493 Do not specify them in other calls."
|
|
|
494 ;; COUNTER can be a cons cell whose car is the count of how many more links
|
|
|
495 ;; to chase before getting an error.
|
|
|
496 ;; PREV-DIRS can be a cons cell whose car is an alist
|
|
|
497 ;; of truenames we've just recently computed.
|
|
12202
|
498
|
|
|
499 ;; The last test looks dubious, maybe `+' is meant here? --simon.
|
|
|
500 (if (or (string= filename "") (string= filename "~")
|
|
4965
|
501 (and (string= (substring filename 0 1) "~")
|
|
|
502 (string-match "~[^/]*" filename)))
|
|
2613
|
503 (progn
|
|
|
504 (setq filename (expand-file-name filename))
|
|
|
505 (if (string= filename "")
|
|
|
506 (setq filename "/"))))
|
|
8148
|
507 (or counter (setq counter (list 100)))
|
|
8374
|
508 (let (done
|
|
|
509 ;; For speed, remove the ange-ftp completion handler from the list.
|
|
|
510 ;; We know it's not needed here.
|
|
|
511 ;; For even more speed, do this only on the outermost call.
|
|
|
512 (file-name-handler-alist
|
|
|
513 (if prev-dirs file-name-handler-alist
|
|
|
514 (let ((tem (copy-sequence file-name-handler-alist)))
|
|
|
515 (delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
|
|
|
516 (or prev-dirs (setq prev-dirs (list nil)))
|
|
19680
|
517
|
|
|
518 ;; andrewi@harlequin.co.uk - none of the following code (except for
|
|
|
519 ;; invoking the file-name handler) currently applies on Windows
|
|
|
520 ;; (ie. there are no native symlinks), but there is an issue with
|
|
|
521 ;; case differences being ignored by the OS, and short "8.3 DOS"
|
|
|
522 ;; name aliases existing for all files. (The short names are not
|
|
|
523 ;; reported by directory-files, but can be used to refer to files.)
|
|
|
524 ;; It seems appropriate for file-truename to resolve these issues in
|
|
|
525 ;; the most natural way, which on Windows is to call the function
|
|
|
526 ;; `w32-long-file-name' - this returns the exact name of a file as
|
|
|
527 ;; it is stored on disk (expanding short name aliases with the full
|
|
|
528 ;; name in the process).
|
|
|
529 (if (eq system-type 'windows-nt)
|
|
|
530 (let ((handler (find-file-name-handler filename 'file-truename))
|
|
|
531 newname)
|
|
|
532 ;; For file name that has a special handler, call handler.
|
|
|
533 ;; This is so that ange-ftp can save time by doing a no-op.
|
|
|
534 (if handler
|
|
|
535 (setq filename (funcall handler 'file-truename filename))
|
|
|
536 ;; If filename contains a wildcard, newname will be the old name.
|
|
|
537 (if (string-match "[*?]" filename)
|
|
|
538 (setq newname filename)
|
|
|
539 ;; If filename doesn't exist, newname will be nil.
|
|
|
540 (setq newname (w32-long-file-name filename)))
|
|
|
541 (setq filename (or newname filename)))
|
|
|
542 (setq done t)))
|
|
|
543
|
|
8148
|
544 ;; If this file directly leads to a link, process that iteratively
|
|
|
545 ;; so that we don't use lots of stack.
|
|
|
546 (while (not done)
|
|
|
547 (setcar counter (1- (car counter)))
|
|
|
548 (if (< (car counter) 0)
|
|
|
549 (error "Apparent cycle of symbolic links for %s" filename))
|
|
|
550 (let ((handler (find-file-name-handler filename 'file-truename)))
|
|
|
551 ;; For file name that has a special handler, call handler.
|
|
|
552 ;; This is so that ange-ftp can save time by doing a no-op.
|
|
|
553 (if handler
|
|
|
554 (setq filename (funcall handler 'file-truename filename)
|
|
|
555 done t)
|
|
9234
|
556 (let ((dir (or (file-name-directory filename) default-directory))
|
|
8148
|
557 target dirfile)
|
|
|
558 ;; Get the truename of the directory.
|
|
|
559 (setq dirfile (directory-file-name dir))
|
|
|
560 ;; If these are equal, we have the (or a) root directory.
|
|
|
561 (or (string= dir dirfile)
|
|
|
562 ;; If this is the same dir we last got the truename for,
|
|
|
563 ;; save time--don't recalculate.
|
|
|
564 (if (assoc dir (car prev-dirs))
|
|
|
565 (setq dir (cdr (assoc dir (car prev-dirs))))
|
|
|
566 (let ((old dir)
|
|
|
567 (new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
|
|
|
568 (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
|
|
|
569 (setq dir new))))
|
|
|
570 (if (equal ".." (file-name-nondirectory filename))
|
|
|
571 (setq filename
|
|
|
572 (directory-file-name (file-name-directory (directory-file-name dir)))
|
|
|
573 done t)
|
|
|
574 (if (equal "." (file-name-nondirectory filename))
|
|
|
575 (setq filename (directory-file-name dir)
|
|
|
576 done t)
|
|
|
577 ;; Put it back on the file name.
|
|
|
578 (setq filename (concat dir (file-name-nondirectory filename)))
|
|
|
579 ;; Is the file name the name of a link?
|
|
|
580 (setq target (file-symlink-p filename))
|
|
|
581 (if target
|
|
|
582 ;; Yes => chase that link, then start all over
|
|
|
583 ;; since the link may point to a directory name that uses links.
|
|
|
584 ;; We can't safely use expand-file-name here
|
|
|
585 ;; since target might look like foo/../bar where foo
|
|
|
586 ;; is itself a link. Instead, we handle . and .. above.
|
|
|
587 (setq filename
|
|
|
588 (if (file-name-absolute-p target)
|
|
|
589 target
|
|
|
590 (concat dir target))
|
|
|
591 done nil)
|
|
|
592 ;; No, we are done!
|
|
|
593 (setq done t))))))))
|
|
|
594 filename))
|
|
1672
|
595
|
|
3260
|
596 (defun file-chase-links (filename)
|
|
|
597 "Chase links in FILENAME until a name that is not a link.
|
|
|
598 Does not examine containing directories for links,
|
|
|
599 unlike `file-truename'."
|
|
|
600 (let (tem (count 100) (newname filename))
|
|
|
601 (while (setq tem (file-symlink-p newname))
|
|
18466
|
602 (save-match-data
|
|
|
603 (if (= count 0)
|
|
|
604 (error "Apparent cycle of symbolic links for %s" filename))
|
|
|
605 ;; In the context of a link, `//' doesn't mean what Emacs thinks.
|
|
|
606 (while (string-match "//+" tem)
|
|
|
607 (setq tem (replace-match "/" nil nil tem)))
|
|
|
608 ;; Handle `..' by hand, since it needs to work in the
|
|
|
609 ;; target of any directory symlink.
|
|
|
610 ;; This code is not quite complete; it does not handle
|
|
|
611 ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
|
|
|
612 (while (string-match "\\`\\.\\./" tem)
|
|
|
613 (setq tem (substring tem 3))
|
|
|
614 (setq newname (expand-file-name newname))
|
|
|
615 ;; Chase links in the default dir of the symlink.
|
|
|
616 (setq newname
|
|
|
617 (file-chase-links
|
|
|
618 (directory-file-name (file-name-directory newname))))
|
|
|
619 ;; Now find the parent of that dir.
|
|
|
620 (setq newname (file-name-directory newname)))
|
|
|
621 (setq newname (expand-file-name tem (file-name-directory newname)))
|
|
|
622 (setq count (1- count))))
|
|
3260
|
623 newname))
|
|
337
|
624
|
|
16831
|
625 (defun switch-to-buffer-other-window (buffer &optional norecord)
|
|
|
626 "Select buffer BUFFER in another window.
|
|
|
627 Optional second arg NORECORD non-nil means
|
|
|
628 do not put this buffer at the front of the list of recently selected ones."
|
|
337
|
629 (interactive "BSwitch to buffer in other window: ")
|
|
|
630 (let ((pop-up-windows t))
|
|
16831
|
631 (pop-to-buffer buffer t norecord)))
|
|
337
|
632
|
|
16831
|
633 (defun switch-to-buffer-other-frame (buffer &optional norecord)
|
|
|
634 "Switch to buffer BUFFER in another frame.
|
|
|
635 Optional second arg NORECORD non-nil means
|
|
|
636 do not put this buffer at the front of the list of recently selected ones."
|
|
778
|
637 (interactive "BSwitch to buffer in other frame: ")
|
|
|
638 (let ((pop-up-frames t))
|
|
16831
|
639 (pop-to-buffer buffer t norecord)
|
|
8165
|
640 (raise-frame (window-frame (selected-window)))))
|
|
423
|
641
|
|
17987
|
642 (defun find-file (filename)
|
|
337
|
643 "Edit file FILENAME.
|
|
|
644 Switch to a buffer visiting file FILENAME,
|
|
17987
|
645 creating one if none already exists."
|
|
|
646 (interactive "FFind file: ")
|
|
|
647 (switch-to-buffer (find-file-noselect filename)))
|
|
337
|
648
|
|
17987
|
649 (defun find-file-other-window (filename)
|
|
337
|
650 "Edit file FILENAME, in another window.
|
|
|
651 May create a new window, or reuse an existing one.
|
|
|
652 See the function `display-buffer'."
|
|
17987
|
653 (interactive "FFind file in other window: ")
|
|
|
654 (switch-to-buffer-other-window (find-file-noselect filename)))
|
|
337
|
655
|
|
17987
|
656 (defun find-file-other-frame (filename)
|
|
778
|
657 "Edit file FILENAME, in another frame.
|
|
|
658 May create a new frame, or reuse an existing one.
|
|
423
|
659 See the function `display-buffer'."
|
|
17987
|
660 (interactive "FFind file in other frame: ")
|
|
|
661 (switch-to-buffer-other-frame (find-file-noselect filename)))
|
|
423
|
662
|
|
17987
|
663 (defun find-file-read-only (filename)
|
|
337
|
664 "Edit file FILENAME but don't allow changes.
|
|
|
665 Like \\[find-file] but marks buffer as read-only.
|
|
|
666 Use \\[toggle-read-only] to permit editing."
|
|
17987
|
667 (interactive "fFind file read-only: ")
|
|
|
668 (find-file filename)
|
|
18316
|
669 (toggle-read-only 1)
|
|
3280
|
670 (current-buffer))
|
|
337
|
671
|
|
17987
|
672 (defun find-file-read-only-other-window (filename)
|
|
337
|
673 "Edit file FILENAME in another window but don't allow changes.
|
|
|
674 Like \\[find-file-other-window] but marks buffer as read-only.
|
|
|
675 Use \\[toggle-read-only] to permit editing."
|
|
17987
|
676 (interactive "fFind file read-only other window: ")
|
|
|
677 (find-file-other-window filename)
|
|
18316
|
678 (toggle-read-only 1)
|
|
3280
|
679 (current-buffer))
|
|
337
|
680
|
|
17987
|
681 (defun find-file-read-only-other-frame (filename)
|
|
778
|
682 "Edit file FILENAME in another frame but don't allow changes.
|
|
|
683 Like \\[find-file-other-frame] but marks buffer as read-only.
|
|
423
|
684 Use \\[toggle-read-only] to permit editing."
|
|
17987
|
685 (interactive "fFind file read-only other frame: ")
|
|
|
686 (find-file-other-frame filename)
|
|
18316
|
687 (toggle-read-only 1)
|
|
3280
|
688 (current-buffer))
|
|
423
|
689
|
|
17987
|
690 (defun find-alternate-file-other-window (filename)
|
|
13182
|
691 "Find file FILENAME as a replacement for the file in the next window.
|
|
17987
|
692 This command does not select that window."
|
|
13182
|
693 (interactive
|
|
|
694 (save-selected-window
|
|
|
695 (other-window 1)
|
|
|
696 (let ((file buffer-file-name)
|
|
|
697 (file-name nil)
|
|
|
698 (file-dir nil))
|
|
|
699 (and file
|
|
|
700 (setq file-name (file-name-nondirectory file)
|
|
|
701 file-dir (file-name-directory file)))
|
|
|
702 (list (read-file-name
|
|
17987
|
703 "Find alternate file: " file-dir nil nil file-name)))))
|
|
13182
|
704 (if (one-window-p)
|
|
17987
|
705 (find-file-other-window filename)
|
|
13182
|
706 (save-selected-window
|
|
|
707 (other-window 1)
|
|
17987
|
708 (find-alternate-file filename))))
|
|
13182
|
709
|
|
17987
|
710 (defun find-alternate-file (filename)
|
|
337
|
711 "Find file FILENAME, select its buffer, kill previous buffer.
|
|
|
712 If the current buffer now contains an empty file that you just visited
|
|
17987
|
713 \(presumably by mistake), use this command to visit the file you really want."
|
|
337
|
714 (interactive
|
|
|
715 (let ((file buffer-file-name)
|
|
|
716 (file-name nil)
|
|
|
717 (file-dir nil))
|
|
|
718 (and file
|
|
|
719 (setq file-name (file-name-nondirectory file)
|
|
|
720 file-dir (file-name-directory file)))
|
|
941
|
721 (list (read-file-name
|
|
17987
|
722 "Find alternate file: " file-dir nil nil file-name))))
|
9048
dc5a9c83dc35
(find-alternate-file): Confirm killing buffer only if it is visiting a file.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
723 (and (buffer-modified-p) (buffer-file-name)
|
|
337
|
724 ;; (not buffer-read-only)
|
|
|
725 (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
|
|
|
726 (buffer-name))))
|
|
|
727 (error "Aborted"))
|
|
|
728 (let ((obuf (current-buffer))
|
|
|
729 (ofile buffer-file-name)
|
|
3191
|
730 (onum buffer-file-number)
|
|
|
731 (otrue buffer-file-truename)
|
|
337
|
732 (oname (buffer-name)))
|
|
13037
|
733 (if (get-buffer " **lose**")
|
|
|
734 (kill-buffer " **lose**"))
|
|
337
|
735 (rename-buffer " **lose**")
|
|
|
736 (unwind-protect
|
|
|
737 (progn
|
|
|
738 (unlock-buffer)
|
|
15410
|
739 (setq buffer-file-name nil)
|
|
|
740 (setq buffer-file-number nil)
|
|
|
741 (setq buffer-file-truename nil)
|
|
17987
|
742 (find-file filename))
|
|
337
|
743 (cond ((eq obuf (current-buffer))
|
|
|
744 (setq buffer-file-name ofile)
|
|
3191
|
745 (setq buffer-file-number onum)
|
|
|
746 (setq buffer-file-truename otrue)
|
|
337
|
747 (lock-buffer)
|
|
|
748 (rename-buffer oname))))
|
|
|
749 (or (eq (current-buffer) obuf)
|
|
|
750 (kill-buffer obuf))))
|
|
19305
|
751
|
|
337
|
752 (defun create-file-buffer (filename)
|
|
|
753 "Create a suitably named buffer for visiting FILENAME, and return it.
|
|
|
754 FILENAME (sans directory) is used unchanged if that name is free;
|
|
|
755 otherwise a string <2> or <3> or ... is appended to get an unused name."
|
|
|
756 (let ((lastname (file-name-nondirectory filename)))
|
|
|
757 (if (string= lastname "")
|
|
|
758 (setq lastname filename))
|
|
|
759 (generate-new-buffer lastname)))
|
|
|
760
|
|
423
|
761 (defun generate-new-buffer (name)
|
|
|
762 "Create and return a buffer with a name based on NAME.
|
|
1461
|
763 Choose the buffer's name using `generate-new-buffer-name'."
|
|
423
|
764 (get-buffer-create (generate-new-buffer-name name)))
|
|
|
765
|
|
16687
|
766 (defvar automount-dir-prefix "^/tmp_mnt/"
|
|
817
|
767 "Regexp to match the automounter prefix in a directory name.")
|
|
|
768
|
|
1725
|
769 (defvar abbreviated-home-dir nil
|
|
4847
|
770 "The user's homedir abbreviated according to `directory-abbrev-list'.")
|
|
1725
|
771
|
|
423
|
772 (defun abbreviate-file-name (filename)
|
|
1461
|
773 "Return a version of FILENAME shortened using `directory-abbrev-alist'.
|
|
423
|
774 This also substitutes \"~\" for the user's home directory.
|
|
1461
|
775 Type \\[describe-variable] directory-abbrev-alist RET for more information."
|
|
817
|
776 ;; Get rid of the prefixes added by the automounter.
|
|
15548
|
777 (if (and automount-dir-prefix
|
|
|
778 (string-match automount-dir-prefix filename)
|
|
817
|
779 (file-exists-p (file-name-directory
|
|
|
780 (substring filename (1- (match-end 0))))))
|
|
|
781 (setq filename (substring filename (1- (match-end 0)))))
|
|
423
|
782 (let ((tail directory-abbrev-alist))
|
|
1725
|
783 ;; If any elt of directory-abbrev-alist matches this name,
|
|
|
784 ;; abbreviate accordingly.
|
|
423
|
785 (while tail
|
|
|
786 (if (string-match (car (car tail)) filename)
|
|
|
787 (setq filename
|
|
|
788 (concat (cdr (car tail)) (substring filename (match-end 0)))))
|
|
|
789 (setq tail (cdr tail)))
|
|
1725
|
790 ;; Compute and save the abbreviated homedir name.
|
|
|
791 ;; We defer computing this until the first time it's needed, to
|
|
|
792 ;; give time for directory-abbrev-alist to be set properly.
|
|
3624
|
793 ;; We include a slash at the end, to avoid spurious matches
|
|
|
794 ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
|
|
1725
|
795 (or abbreviated-home-dir
|
|
|
796 (setq abbreviated-home-dir
|
|
|
797 (let ((abbreviated-home-dir "$foo"))
|
3709
09e961c82be8
(abbreviate-file-name): Match home dir with no / if nothing else follows.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
798 (concat "^" (abbreviate-file-name (expand-file-name "~"))
|
09e961c82be8
(abbreviate-file-name): Match home dir with no / if nothing else follows.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
799 "\\(/\\|$\\)"))))
|
|
13832
|
800
|
|
1725
|
801 ;; If FILENAME starts with the abbreviated homedir,
|
|
|
802 ;; make it start with `~' instead.
|
5582
cc4892ee6807
(abbreviate-file-name): Don't convert / to ~/ when the home dir is /.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
803 (if (and (string-match abbreviated-home-dir filename)
|
cc4892ee6807
(abbreviate-file-name): Don't convert / to ~/ when the home dir is /.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
804 ;; If the home dir is just /, don't change it.
|
cc4892ee6807
(abbreviate-file-name): Don't convert / to ~/ when the home dir is /.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
805 (not (and (= (match-end 0) 1)
|
|
7440
|
806 (= (aref filename 0) ?/)))
|
13903
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
807 ;; MS-DOS root directories can come with a drive letter;
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
808 ;; Novell Netware allows drive letters beyond `Z:'.
|
|
13832
|
809 (not (and (or (eq system-type 'ms-dos)
|
9777
178a3bf170f3
(abbreviate-file-name): Handle drive letters on windows-nt as on ms-dos.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
810 (eq system-type 'windows-nt))
|
|
7440
|
811 (save-match-data
|
13903
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
812 (string-match "^[a-zA-`]:/$" filename)))))
|
|
423
|
813 (setq filename
|
|
2630
|
814 (concat "~"
|
3709
09e961c82be8
(abbreviate-file-name): Match home dir with no / if nothing else follows.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
815 (substring filename (match-beginning 1) (match-end 1))
|
|
2630
|
816 (substring filename (match-end 0)))))
|
|
423
|
817 filename))
|
|
|
818
|
|
17673
|
819 (defcustom find-file-not-true-dirname-list nil
|
|
2622
|
820 "*List of logical names for which visiting shouldn't save the true dirname.
|
|
|
821 On VMS, when you visit a file using a logical name that searches a path,
|
|
|
822 you may or may not want the visited file name to record the specific
|
|
|
823 directory where the file was found. If you *do not* want that, add the logical
|
|
17673
|
824 name to this list as a string."
|
|
|
825 :type '(repeat (string :tag "Name"))
|
|
|
826 :group 'find-file)
|
|
2622
|
827
|
6265
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
828 (defun find-buffer-visiting (filename)
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
829 "Return the buffer visiting file FILENAME (a string).
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
830 This is like `get-file-buffer', except that it checks for any buffer
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
831 visiting the same file, possibly under a different name.
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
832 If there is no such live buffer, return nil."
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
833 (let ((buf (get-file-buffer filename))
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
834 (truename (abbreviate-file-name (file-truename filename))))
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
835 (or buf
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
836 (let ((list (buffer-list)) found)
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
837 (while (and (not found) list)
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
838 (save-excursion
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
839 (set-buffer (car list))
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
840 (if (and buffer-file-name
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
841 (string= buffer-file-truename truename))
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
842 (setq found (car list))))
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
843 (setq list (cdr list)))
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
844 found)
|
|
6272
|
845 (let ((number (nthcdr 10 (file-attributes truename)))
|
6265
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
846 (list (buffer-list)) found)
|
|
15329
|
847 (and buffer-file-numbers-unique
|
|
|
848 number
|
|
6294
|
849 (while (and (not found) list)
|
|
|
850 (save-excursion
|
|
|
851 (set-buffer (car list))
|
|
6866
|
852 (if (and buffer-file-name
|
|
|
853 (equal buffer-file-number number)
|
|
6294
|
854 ;; Verify this buffer's file number
|
|
|
855 ;; still belongs to its file.
|
|
|
856 (file-exists-p buffer-file-name)
|
|
|
857 (equal (nthcdr 10 (file-attributes buffer-file-name))
|
|
|
858 number))
|
|
|
859 (setq found (car list))))
|
|
|
860 (setq list (cdr list))))
|
6265
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
861 found))))
|
|
19305
|
862
|
|
12850
|
863 (defun find-file-noselect (filename &optional nowarn rawfile)
|
|
337
|
864 "Read file FILENAME into a buffer and return the buffer.
|
|
|
865 If a buffer exists visiting FILENAME, return that one, but
|
|
|
866 verify that the file has not changed since visited or saved.
|
|
17004
|
867 The buffer is not selected, just returned to the caller.
|
|
|
868 Optional first arg NOWARN non-nil means suppress any warning messages.
|
|
19122
|
869 Optional second arg RAWFILE non-nil means the file is read literally."
|
|
817
|
870 (setq filename
|
|
|
871 (abbreviate-file-name
|
|
|
872 (expand-file-name filename)))
|
|
337
|
873 (if (file-directory-p filename)
|
|
|
874 (if find-file-run-dired
|
|
13497
|
875 (dired-noselect (if find-file-visit-truename
|
|
|
876 (abbreviate-file-name (file-truename filename))
|
|
|
877 filename))
|
|
14287
|
878 (error "%s is a directory" filename))
|
|
1395
|
879 (let* ((buf (get-file-buffer filename))
|
|
|
880 (truename (abbreviate-file-name (file-truename filename)))
|
|
|
881 (number (nthcdr 10 (file-attributes truename)))
|
|
|
882 ;; Find any buffer for a file which has same truename.
|
|
22466
|
883 (other (and (not buf) (find-buffer-visiting filename))))
|
|
1395
|
884 ;; Let user know if there is a buffer with the same truename.
|
6265
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
885 (if other
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
886 (progn
|
|
7422
|
887 (or nowarn
|
|
|
888 (string-equal filename (buffer-file-name other))
|
|
|
889 (message "%s and %s are the same file"
|
|
|
890 filename (buffer-file-name other)))
|
6265
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
891 ;; Optionally also find that buffer.
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
892 (if (or find-file-existing-other-name find-file-visit-truename)
|
f901b6091821
(find-buffer-visiting): New function to look for another buffer visiting the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
893 (setq buf other))))
|
|
337
|
894 (if buf
|
|
22555
|
895 ;; We are using an existing buffer.
|
|
22403
|
896 (progn
|
|
|
897 (or nowarn
|
|
|
898 (verify-visited-file-modtime buf)
|
|
|
899 (cond ((not (file-exists-p filename))
|
|
|
900 (error "File %s no longer exists!" filename))
|
|
|
901 ;; Certain files should be reverted automatically
|
|
|
902 ;; if they have changed on disk and not in the buffer.
|
|
|
903 ((and (not (buffer-modified-p buf))
|
|
|
904 (let ((tail revert-without-query)
|
|
|
905 (found nil))
|
|
|
906 (while tail
|
|
|
907 (if (string-match (car tail) filename)
|
|
|
908 (setq found t))
|
|
|
909 (setq tail (cdr tail)))
|
|
|
910 found))
|
|
|
911 (with-current-buffer buf
|
|
|
912 (message "Reverting file %s..." filename)
|
|
|
913 (revert-buffer t t)
|
|
|
914 (message "Reverting file %s...done" filename)))
|
|
|
915 ((yes-or-no-p
|
|
|
916 (if (string= (file-name-nondirectory filename)
|
|
|
917 (buffer-name buf))
|
|
|
918 (format
|
|
|
919 (if (buffer-modified-p buf)
|
|
|
920 "File %s changed on disk. Discard your edits? "
|
|
|
921 "File %s changed on disk. Reread from disk? ")
|
|
|
922 (file-name-nondirectory filename))
|
|
11981
|
923 (format
|
|
|
924 (if (buffer-modified-p buf)
|
|
22403
|
925 "File %s changed on disk. Discard your edits in %s? "
|
|
|
926 "File %s changed on disk. Reread from disk into %s? ")
|
|
|
927 (file-name-nondirectory filename)
|
|
|
928 (buffer-name buf))))
|
|
|
929 (with-current-buffer buf
|
|
|
930 (revert-buffer t t)))))
|
|
|
931 (when (not (eq rawfile (not (null find-file-literally))))
|
|
|
932 (with-current-buffer buf
|
|
|
933 (if (buffer-modified-p)
|
|
|
934 (if (y-or-n-p (if rawfile
|
|
|
935 "Save file and revisit literally? "
|
|
|
936 "Save file and revisit non-literally? "))
|
|
|
937 (progn
|
|
|
938 (save-buffer)
|
|
22465
|
939 (find-file-noselect-1 buf filename nowarn
|
|
|
940 rawfile truename number))
|
|
22403
|
941 (if (y-or-n-p (if rawfile
|
|
|
942 "Discard your edits and revisit file literally? "
|
|
|
943 "Discard your edits and revisit file non-literally? "))
|
|
|
944 (find-file-noselect-1 buf filename nowarn
|
|
|
945 rawfile truename number)
|
|
|
946 (error (if rawfile "File already visited non-literally"
|
|
|
947 "File already visited literally"))))
|
|
|
948 (if (y-or-n-p (if rawfile
|
|
|
949 "Revisit file literally? "
|
|
|
950 "Revisit file non-literally? "))
|
|
|
951 (find-file-noselect-1 buf filename nowarn
|
|
|
952 rawfile truename number)
|
|
|
953 (error (if rawfile "File already visited non-literally"
|
|
22555
|
954 "File already visited literally"))))))
|
|
|
955 ;; Return the buffer we are using.
|
|
|
956 buf)
|
|
|
957 ;; Create a new buffer.
|
|
|
958 (setq buf (create-file-buffer filename))
|
|
|
959 (set-buffer-major-mode buf)
|
|
|
960 ;; find-file-noselect-1 may use a different buffer.
|
|
|
961 (find-file-noselect-1 buf filename nowarn
|
|
|
962 rawfile truename number)))))
|
|
22403
|
963
|
|
|
964 (defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
|
|
22466
|
965 (let ((inhibit-read-only t)
|
|
|
966 error)
|
|
22403
|
967 (with-current-buffer buf
|
|
|
968 (kill-local-variable 'find-file-literally)
|
|
22555
|
969 ;; Needed in case we are re-visiting the file with a different
|
|
|
970 ;; text representation.
|
|
22738
|
971 (kill-local-variable 'buffer-file-coding-system)
|
|
22403
|
972 (erase-buffer)
|
|
|
973 (and (default-value 'enable-multibyte-characters)
|
|
|
974 (not rawfile)
|
|
|
975 (set-buffer-multibyte t))
|
|
|
976 (if rawfile
|
|
|
977 (condition-case ()
|
|
|
978 (insert-file-contents-literally filename t)
|
|
|
979 (file-error
|
|
|
980 (when (and (file-exists-p filename)
|
|
|
981 (not (file-readable-p filename)))
|
|
|
982 (kill-buffer buf)
|
|
|
983 (signal 'file-error (list "File is not readable"
|
|
|
984 filename)))
|
|
|
985 ;; Unconditionally set error
|
|
|
986 (setq error t)))
|
|
|
987 (condition-case ()
|
|
|
988 (insert-file-contents filename t)
|
|
|
989 (file-error
|
|
|
990 (when (and (file-exists-p filename)
|
|
|
991 (not (file-readable-p filename)))
|
|
|
992 (kill-buffer buf)
|
|
|
993 (signal 'file-error (list "File is not readable"
|
|
|
994 filename)))
|
|
|
995 ;; Run find-file-not-found-hooks until one returns non-nil.
|
|
|
996 (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
|
|
|
997 ;; If they fail too, set error.
|
|
|
998 (setq error t)))))
|
|
|
999 ;; Find the file's truename, and maybe use that as visited name.
|
|
|
1000 (setq buffer-file-truename truename)
|
|
|
1001 (setq buffer-file-number number)
|
|
|
1002 ;; On VMS, we may want to remember which directory in a search list
|
|
|
1003 ;; the file was found in.
|
|
|
1004 (and (eq system-type 'vax-vms)
|
|
|
1005 (let (logical)
|
|
|
1006 (if (string-match ":" (file-name-directory filename))
|
|
|
1007 (setq logical (substring (file-name-directory filename)
|
|
|
1008 0 (match-beginning 0))))
|
|
|
1009 (not (member logical find-file-not-true-dirname-list)))
|
|
|
1010 (setq buffer-file-name buffer-file-truename))
|
|
|
1011 (if find-file-visit-truename
|
|
|
1012 (setq buffer-file-name
|
|
|
1013 (setq filename
|
|
|
1014 (expand-file-name buffer-file-truename))))
|
|
|
1015 ;; Set buffer's default directory to that of the file.
|
|
|
1016 (setq default-directory (file-name-directory filename))
|
|
|
1017 ;; Turn off backup files for certain file names. Since
|
|
|
1018 ;; this is a permanent local, the major mode won't eliminate it.
|
|
|
1019 (and (not (funcall backup-enable-predicate buffer-file-name))
|
|
|
1020 (progn
|
|
|
1021 (make-local-variable 'backup-inhibited)
|
|
|
1022 (setq backup-inhibited t)))
|
|
|
1023 (if rawfile
|
|
|
1024 (progn
|
|
|
1025 (set-buffer-multibyte nil)
|
|
|
1026 (setq buffer-file-coding-system 'no-conversion)
|
|
|
1027 (make-local-variable 'find-file-literally)
|
|
|
1028 (setq find-file-literally t))
|
|
22555
|
1029 (after-find-file error (not nowarn)))
|
|
|
1030 (current-buffer))))
|
|
19305
|
1031
|
|
|
1032 (defun insert-file-contents-literally (filename &optional visit beg end replace)
|
|
|
1033 "Like `insert-file-contents', but only reads in the file literally.
|
|
|
1034 A buffer may be modified in several ways after reading into the buffer,
|
|
|
1035 to Emacs features such as format decoding, character code
|
|
|
1036 conversion, find-file-hooks, automatic uncompression, etc.
|
|
|
1037
|
|
|
1038 This function ensures that none of these modifications will take place."
|
|
|
1039 (let ((format-alist nil)
|
|
|
1040 (after-insert-file-functions nil)
|
|
|
1041 (coding-system-for-read 'no-conversion)
|
|
|
1042 (coding-system-for-write 'no-conversion)
|
|
|
1043 (jka-compr-compression-info-list nil)
|
|
|
1044 (find-buffer-file-type-function
|
|
|
1045 (if (fboundp 'find-buffer-file-type)
|
|
|
1046 (symbol-function 'find-buffer-file-type)
|
|
|
1047 nil)))
|
|
|
1048 (unwind-protect
|
|
|
1049 (progn
|
|
|
1050 (fset 'find-buffer-file-type (lambda (filename) t))
|
|
|
1051 (insert-file-contents filename visit beg end replace))
|
|
|
1052 (if find-buffer-file-type-function
|
|
|
1053 (fset 'find-buffer-file-type find-buffer-file-type-function)
|
|
|
1054 (fmakunbound 'find-buffer-file-type)))))
|
|
|
1055
|
|
|
1056 (defun insert-file-literally (filename)
|
|
|
1057 "Insert contents of file FILENAME into buffer after point with no conversion.
|
|
|
1058
|
|
|
1059 This function is meant for the user to run interactively.
|
|
|
1060 Don't call it from programs! Use `insert-file-contents-literally' instead.
|
|
|
1061 \(Its calling sequence is different; see its documentation)."
|
|
|
1062 (interactive "*fInsert file literally: ")
|
|
|
1063 (if (file-directory-p filename)
|
|
|
1064 (signal 'file-error (list "Opening input file" "file is a directory"
|
|
|
1065 filename)))
|
|
|
1066 (let ((tem (insert-file-contents-literally filename)))
|
|
|
1067 (push-mark (+ (point) (car (cdr tem))))))
|
|
|
1068
|
|
|
1069 (defvar find-file-literally nil
|
|
|
1070 "Non-nil if this buffer was made by `find-file-literally' or equivalent.
|
|
|
1071 This is a permanent local.")
|
|
|
1072 (put 'find-file-literally 'permanent-local t)
|
|
18676
|
1073
|
|
|
1074 (defun find-file-literally (filename)
|
|
|
1075 "Visit file FILENAME with no conversion of any kind.
|
|
|
1076 Format conversion and character code conversion are both disabled,
|
|
|
1077 and multibyte characters are disabled in the resulting buffer.
|
|
19122
|
1078 The major mode used is Fundamental mode regardless of the file name,
|
|
|
1079 and local variable specifications in the file are ignored.
|
|
19305
|
1080 Automatic uncompression is also disabled.
|
|
|
1081
|
|
|
1082 You cannot absolutely rely on this function to result in
|
|
19575
|
1083 visiting the file literally. If Emacs already has a buffer
|
|
19305
|
1084 which is visiting the file, you get the existing buffer,
|
|
|
1085 regardless of whether it was created literally or not.
|
|
|
1086
|
|
|
1087 In a Lisp program, if you want to be sure of accessing a file's
|
|
|
1088 contents literally, you should create a temporary buffer and then read
|
|
|
1089 the file contents into it using `insert-file-contents-literally'."
|
|
18676
|
1090 (interactive "FFind file literally: ")
|
|
19305
|
1091 (switch-to-buffer (find-file-noselect filename nil t)))
|
|
337
|
1092
|
|
8650
|
1093 (defvar after-find-file-from-revert-buffer nil)
|
|
|
1094
|
8556
04a87d0e4a62
(after-find-file): New arg renamed to after-find-file-from-revert-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1095 (defun after-find-file (&optional error warn noauto
|
|
13857
|
1096 after-find-file-from-revert-buffer
|
|
|
1097 nomodes)
|
|
337
|
1098 "Called after finding a file and by the default revert function.
|
|
|
1099 Sets buffer mode, parses local variables.
|
|
1212
|
1100 Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
|
|
337
|
1101 error in reading the file. WARN non-nil means warn if there
|
|
|
1102 exists an auto-save file more recent than the visited file.
|
|
1212
|
1103 NOAUTO means don't mess with auto-save mode.
|
8556
04a87d0e4a62
(after-find-file): New arg renamed to after-find-file-from-revert-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1104 Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
|
04a87d0e4a62
(after-find-file): New arg renamed to after-find-file-from-revert-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1105 means this call was from `revert-buffer'.
|
|
13857
|
1106 Fifth arg NOMODES non-nil means don't alter the file's modes.
|
|
|
1107 Finishes by calling the functions in `find-file-hooks'
|
|
|
1108 unless NOMODES is non-nil."
|
|
337
|
1109 (setq buffer-read-only (not (file-writable-p buffer-file-name)))
|
|
|
1110 (if noninteractive
|
|
|
1111 nil
|
|
|
1112 (let* (not-serious
|
|
|
1113 (msg
|
|
|
1114 (cond ((and error (file-attributes buffer-file-name))
|
|
|
1115 (setq buffer-read-only t)
|
|
4466
|
1116 "File exists, but cannot be read.")
|
|
337
|
1117 ((not buffer-read-only)
|
|
|
1118 (if (and warn
|
|
|
1119 (file-newer-than-file-p (make-auto-save-file-name)
|
|
|
1120 buffer-file-name))
|
15050
7cc3bad1b93e
(after-find-file): Mention file name in "auto save is newer" message.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1121 (format "%s has auto save data; consider M-x recover-file"
|
7cc3bad1b93e
(after-find-file): Mention file name in "auto save is newer" message.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1122 (file-name-nondirectory buffer-file-name))
|
|
337
|
1123 (setq not-serious t)
|
|
|
1124 (if error "(New file)" nil)))
|
|
|
1125 ((not error)
|
|
|
1126 (setq not-serious t)
|
|
|
1127 "Note: file is write protected")
|
|
|
1128 ((file-attributes (directory-file-name default-directory))
|
|
|
1129 "File not found and directory write-protected")
|
|
1537
|
1130 ((file-exists-p (file-name-directory buffer-file-name))
|
|
|
1131 (setq buffer-read-only nil))
|
|
337
|
1132 (t
|
|
423
|
1133 (setq buffer-read-only nil)
|
|
1537
|
1134 (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name))))
|
|
|
1135 "Use M-x make-dir RET RET to create the directory"
|
|
|
1136 "Use C-u M-x make-dir RET RET to create directory and its parents")))))
|
|
337
|
1137 (if msg
|
|
|
1138 (progn
|
|
|
1139 (message msg)
|
|
|
1140 (or not-serious (sit-for 1 nil t)))))
|
|
1212
|
1141 (if (and auto-save-default (not noauto))
|
|
337
|
1142 (auto-save-mode t)))
|
|
13857
|
1143 (if nomodes
|
|
|
1144 nil
|
|
|
1145 (normal-mode t)
|
|
18316
|
1146 (if (and buffer-read-only view-read-only
|
|
|
1147 (not (eq (get major-mode 'mode-class) 'special)))
|
|
|
1148 (view-mode-enter))
|
|
13857
|
1149 (run-hooks 'find-file-hooks)))
|
|
337
|
1150
|
|
|
1151 (defun normal-mode (&optional find-file)
|
|
|
1152 "Choose the major mode for this buffer automatically.
|
|
|
1153 Also sets up any specified local variables of the file.
|
|
|
1154 Uses the visited file name, the -*- line, and the local variables spec.
|
|
|
1155
|
|
|
1156 This function is called automatically from `find-file'. In that case,
|
|
|
1157 we may set up specified local variables depending on the value of
|
|
|
1158 `enable-local-variables': if it is t, we do; if it is nil, we don't;
|
|
|
1159 otherwise, we query. `enable-local-variables' is ignored if you
|
|
|
1160 run `normal-mode' explicitly."
|
|
|
1161 (interactive)
|
|
|
1162 (or find-file (funcall (or default-major-mode 'fundamental-mode)))
|
|
|
1163 (condition-case err
|
|
|
1164 (set-auto-mode)
|
|
|
1165 (error (message "File mode specification error: %s"
|
|
|
1166 (prin1-to-string err))))
|
|
|
1167 (condition-case err
|
|
566
|
1168 (let ((enable-local-variables (or (not find-file)
|
|
|
1169 enable-local-variables)))
|
|
|
1170 (hack-local-variables))
|
|
337
|
1171 (error (message "File local-variables error: %s"
|
|
|
1172 (prin1-to-string err)))))
|
|
|
1173
|
|
13662
|
1174 (defvar auto-mode-alist
|
13903
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1175 '(("\\.te?xt\\'" . text-mode)
|
|
13662
|
1176 ("\\.c\\'" . c-mode)
|
|
|
1177 ("\\.h\\'" . c-mode)
|
|
|
1178 ("\\.tex\\'" . tex-mode)
|
|
|
1179 ("\\.ltx\\'" . latex-mode)
|
|
|
1180 ("\\.el\\'" . emacs-lisp-mode)
|
|
|
1181 ("\\.mm\\'" . nroff-mode)
|
|
|
1182 ("\\.me\\'" . nroff-mode)
|
|
|
1183 ("\\.ms\\'" . nroff-mode)
|
|
|
1184 ("\\.man\\'" . nroff-mode)
|
|
|
1185 ("\\.scm\\'" . scheme-mode)
|
|
|
1186 ("\\.l\\'" . lisp-mode)
|
|
|
1187 ("\\.lisp\\'" . lisp-mode)
|
|
|
1188 ("\\.f\\'" . fortran-mode)
|
|
15056
|
1189 ("\\.F\\'" . fortran-mode)
|
|
13662
|
1190 ("\\.for\\'" . fortran-mode)
|
|
|
1191 ("\\.p\\'" . pascal-mode)
|
|
|
1192 ("\\.pas\\'" . pascal-mode)
|
|
|
1193 ("\\.ad[abs]\\'" . ada-mode)
|
|
20325
|
1194 ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode)
|
|
17731
|
1195 ("\\.s?html?\\'" . html-mode)
|
|
13662
|
1196 ("\\.cc\\'" . c++-mode)
|
|
|
1197 ("\\.hh\\'" . c++-mode)
|
|
16414
|
1198 ("\\.hpp\\'" . c++-mode)
|
|
13662
|
1199 ("\\.C\\'" . c++-mode)
|
|
|
1200 ("\\.H\\'" . c++-mode)
|
|
|
1201 ("\\.cpp\\'" . c++-mode)
|
|
|
1202 ("\\.cxx\\'" . c++-mode)
|
|
|
1203 ("\\.hxx\\'" . c++-mode)
|
|
|
1204 ("\\.c\\+\\+\\'" . c++-mode)
|
|
|
1205 ("\\.h\\+\\+\\'" . c++-mode)
|
|
16477
|
1206 ("\\.m\\'" . objc-mode)
|
|
14987
|
1207 ("\\.java\\'" . java-mode)
|
|
13662
|
1208 ("\\.mk\\'" . makefile-mode)
|
|
14576
|
1209 ("\\(M\\|m\\|GNUm\\)akefile\\(.in\\)?\\'" . makefile-mode)
|
|
20454
|
1210 ("\\.am\\'" . makefile-mode) ;For Automake.
|
|
566
|
1211 ;;; Less common extensions come here
|
|
|
1212 ;;; so more common ones above are found faster.
|
|
13662
|
1213 ("\\.texinfo\\'" . texinfo-mode)
|
13903
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1214 ("\\.te?xi\\'" . texinfo-mode)
|
|
13662
|
1215 ("\\.s\\'" . asm-mode)
|
|
13743
|
1216 ("\\.S\\'" . asm-mode)
|
|
|
1217 ("\\.asm\\'" . asm-mode)
|
|
13662
|
1218 ("ChangeLog\\'" . change-log-mode)
|
|
|
1219 ("change.log\\'" . change-log-mode)
|
|
|
1220 ("changelo\\'" . change-log-mode)
|
|
|
1221 ("ChangeLog.[0-9]+\\'" . change-log-mode)
|
|
16334
|
1222 ;; for MSDOS and MS-Windows (which are case-insensitive)
|
|
|
1223 ("changelog\\'" . change-log-mode)
|
|
|
1224 ("changelog.[0-9]+\\'" . change-log-mode)
|
|
13662
|
1225 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
|
|
|
1226 ("\\.scm\\.[0-9]*\\'" . scheme-mode)
|
|
14469
|
1227 ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
|
|
14025
|
1228 ("/\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode)
|
|
|
1229 ("/\\.\\(bash_logout\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
|
|
|
1230 ("/\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
|
|
12554
|
1231 ;;; The following should come after the ChangeLog pattern
|
|
|
1232 ;;; for the sake of ChangeLog.1, etc.
|
|
|
1233 ;;; and after the .scm.[0-9] pattern too.
|
|
13662
|
1234 ("\\.[12345678]\\'" . nroff-mode)
|
|
|
1235 ("\\.TeX\\'" . tex-mode)
|
|
|
1236 ("\\.sty\\'" . latex-mode)
|
|
|
1237 ("\\.cls\\'" . latex-mode) ;LaTeX 2e class
|
|
18923
|
1238 ("\\.clo\\'" . latex-mode) ;LaTeX 2e class option
|
|
13662
|
1239 ("\\.bbl\\'" . latex-mode)
|
|
|
1240 ("\\.bib\\'" . bibtex-mode)
|
|
19778
|
1241 ("\\.m4\\'" . m4-mode)
|
|
|
1242 ("\\.mc\\'" . m4-mode)
|
|
18923
|
1243 ("\\.mf\\'" . metafont-mode)
|
|
|
1244 ("\\.mp\\'" . metapost-mode)
|
|
20660
|
1245 ("\\.vhdl?\\'" . vhdl-mode)
|
|
13662
|
1246 ("\\.article\\'" . text-mode)
|
|
|
1247 ("\\.letter\\'" . text-mode)
|
|
|
1248 ("\\.tcl\\'" . tcl-mode)
|
|
14229
|
1249 ("\\.exp\\'" . tcl-mode)
|
|
14574
|
1250 ("\\.itcl\\'" . tcl-mode)
|
|
|
1251 ("\\.itk\\'" . tcl-mode)
|
|
17731
|
1252 ("\\.icn\\'" . icon-mode)
|
|
|
1253 ("\\.sim\\'" . simula-mode)
|
|
|
1254 ("\\.mss\\'" . scribe-mode)
|
|
13662
|
1255 ("\\.f90\\'" . f90-mode)
|
|
|
1256 ("\\.lsp\\'" . lisp-mode)
|
|
|
1257 ("\\.awk\\'" . awk-mode)
|
|
|
1258 ("\\.prolog\\'" . prolog-mode)
|
|
|
1259 ("\\.tar\\'" . tar-mode)
|
|
19680
|
1260 ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\)\\'" . archive-mode)
|
|
|
1261 ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\)\\'" . archive-mode)
|
|
13662
|
1262 ;; Mailer puts message to be edited in
|
|
|
1263 ;; /tmp/Re.... or Message
|
|
14205
|
1264 ("\\`/tmp/Re" . text-mode)
|
|
13662
|
1265 ("/Message[0-9]*\\'" . text-mode)
|
|
|
1266 ("/drafts/[0-9]+\\'" . mh-letter-mode)
|
|
21069
|
1267 ("\\.zone\\'" . zone-mode)
|
|
13662
|
1268 ;; some news reader is reported to use this
|
|
14205
|
1269 ("\\`/tmp/fol/" . text-mode)
|
|
13662
|
1270 ("\\.y\\'" . c-mode)
|
|
|
1271 ("\\.lex\\'" . c-mode)
|
|
|
1272 ("\\.oak\\'" . scheme-mode)
|
|
14176
|
1273 ("\\.sgml?\\'" . sgml-mode)
|
|
22558
|
1274 ("\\.xml\\'" . sgml-mode)
|
|
13662
|
1275 ("\\.dtd\\'" . sgml-mode)
|
|
17421
|
1276 ("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
|
|
13662
|
1277 ;; .emacs following a directory delimiter
|
|
18868
|
1278 ;; in Unix, MSDOG or VMS syntax.
|
|
|
1279 ("[]>:/\\]\\..*emacs\\'" . emacs-lisp-mode)
|
|
13662
|
1280 ;; _emacs following a directory delimiter
|
|
|
1281 ;; in MsDos syntax
|
|
|
1282 ("[:/]_emacs\\'" . emacs-lisp-mode)
|
|
|
1283 ("\\.ml\\'" . lisp-mode))
|
|
566
|
1284 "\
|
|
|
1285 Alist of filename patterns vs corresponding major mode functions.
|
|
9602
|
1286 Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
|
|
|
1287 \(NON-NIL stands for anything that is not nil; the value does not matter.)
|
|
|
1288 Visiting a file whose name matches REGEXP specifies FUNCTION as the
|
|
|
1289 mode function to use. FUNCTION will be called, unless it is nil.
|
|
|
1290
|
|
|
1291 If the element has the form (REGEXP FUNCTION NON-NIL), then after
|
|
|
1292 calling FUNCTION (if it's not nil), we delete the suffix that matched
|
|
|
1293 REGEXP and search the list again for another match.")
|
|
566
|
1294
|
|
21069
|
1295
|
|
16687
|
1296 (defvar interpreter-mode-alist
|
|
5956
|
1297 '(("perl" . perl-mode)
|
|
15010
|
1298 ("perl5" . perl-mode)
|
|
20325
|
1299 ("miniperl" . perl-mode)
|
|
5956
|
1300 ("wish" . tcl-mode)
|
|
7662
|
1301 ("wishx" . tcl-mode)
|
5973
628188ceb43b
interpreter-mode-alist: Add modes for awk, gawk, and scm scripts.
Noah Friedman <friedman@splode.com>
diff
changeset
|
1302 ("tcl" . tcl-mode)
|
|
7662
|
1303 ("tclsh" . tcl-mode)
|
5973
628188ceb43b
interpreter-mode-alist: Add modes for awk, gawk, and scm scripts.
Noah Friedman <friedman@splode.com>
diff
changeset
|
1304 ("awk" . awk-mode)
|
|
14598
|
1305 ("mawk" . awk-mode)
|
|
13091
|
1306 ("nawk" . awk-mode)
|
5973
628188ceb43b
interpreter-mode-alist: Add modes for awk, gawk, and scm scripts.
Noah Friedman <friedman@splode.com>
diff
changeset
|
1307 ("gawk" . awk-mode)
|
|
14025
|
1308 ("scm" . scheme-mode)
|
|
|
1309 ("ash" . sh-mode)
|
|
|
1310 ("bash" . sh-mode)
|
|
|
1311 ("csh" . sh-mode)
|
|
|
1312 ("dtksh" . sh-mode)
|
|
|
1313 ("es" . sh-mode)
|
|
|
1314 ("itcsh" . sh-mode)
|
|
|
1315 ("jsh" . sh-mode)
|
|
|
1316 ("ksh" . sh-mode)
|
|
|
1317 ("oash" . sh-mode)
|
|
|
1318 ("pdksh" . sh-mode)
|
|
|
1319 ("rc" . sh-mode)
|
|
|
1320 ("sh" . sh-mode)
|
|
|
1321 ("sh5" . sh-mode)
|
|
|
1322 ("tcsh" . sh-mode)
|
|
|
1323 ("wksh" . sh-mode)
|
|
|
1324 ("wsh" . sh-mode)
|
|
|
1325 ("zsh" . sh-mode)
|
|
|
1326 ("tail" . text-mode)
|
|
|
1327 ("more" . text-mode)
|
|
|
1328 ("less" . text-mode)
|
|
|
1329 ("pg" . text-mode))
|
|
5956
|
1330 "Alist mapping interpreter names to major modes.
|
|
|
1331 This alist applies to files whose first line starts with `#!'.
|
|
|
1332 Each element looks like (INTERPRETER . MODE).
|
|
|
1333 The car of each element is compared with
|
|
|
1334 the name of the interpreter specified in the first line.
|
|
|
1335 If it matches, mode MODE is selected.")
|
|
|
1336
|
|
16687
|
1337 (defvar inhibit-first-line-modes-regexps '("\\.tar\\'" "\\.tgz\\'")
|
|
6780
|
1338 "List of regexps; if one matches a file name, don't look for `-*-'.")
|
|
3364
|
1339
|
|
16687
|
1340 (defvar inhibit-first-line-modes-suffixes nil
|
|
11180
|
1341 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
|
|
|
1342 When checking `inhibit-first-line-modes-regexps', we first discard
|
|
|
1343 from the end of the file name anything that matches one of these regexps.")
|
|
|
1344
|
|
22476
|
1345 (defvar user-init-file nil
|
|
|
1346 "File name, including directory, of user's initialization file.")
|
|
5453
|
1347
|
|
17660
|
1348 (defun set-auto-mode (&optional just-from-file-name)
|
|
337
|
1349 "Select major mode appropriate for current buffer.
|
|
7662
|
1350 This checks for a -*- mode tag in the buffer's text,
|
|
|
1351 compares the filename against the entries in `auto-mode-alist',
|
|
|
1352 or checks the interpreter that runs this file against
|
|
|
1353 `interpreter-mode-alist'.
|
|
|
1354
|
|
|
1355 It does not check for the `mode:' local variable in the
|
|
|
1356 Local Variables section of the file; for that, use `hack-local-variables'.
|
|
566
|
1357
|
|
1395
|
1358 If `enable-local-variables' is nil, this function does not check for a
|
|
17660
|
1359 -*- mode tag.
|
|
|
1360
|
|
|
1361 If the optional argument JUST-FROM-FILE-NAME is non-nil,
|
|
|
1362 then we do not set anything but the major mode,
|
|
|
1363 and we don't even do that unless it would come from the file name."
|
|
337
|
1364 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
|
|
13496
|
1365 (let (beg end done modes)
|
|
337
|
1366 (save-excursion
|
|
|
1367 (goto-char (point-min))
|
|
|
1368 (skip-chars-forward " \t\n")
|
|
4699
|
1369 (and enable-local-variables
|
|
22476
|
1370 local-enable-local-variables
|
|
4699
|
1371 ;; Don't look for -*- if this file name matches any
|
|
6780
|
1372 ;; of the regexps in inhibit-first-line-modes-regexps.
|
|
9251
|
1373 (let ((temp inhibit-first-line-modes-regexps)
|
|
11636
|
1374 (name (if buffer-file-name
|
|
|
1375 (file-name-sans-versions buffer-file-name)
|
|
|
1376 (buffer-name))))
|
|
11189
|
1377 (while (let ((sufs inhibit-first-line-modes-suffixes))
|
|
|
1378 (while (and sufs (not (string-match (car sufs) name)))
|
|
|
1379 (setq sufs (cdr sufs)))
|
|
|
1380 sufs)
|
|
|
1381 (setq name (substring name 0 (match-beginning 0))))
|
|
4699
|
1382 (while (and temp
|
|
11180
|
1383 (not (string-match (car temp) name)))
|
|
4699
|
1384 (setq temp (cdr temp)))
|
|
|
1385 (not temp))
|
|
|
1386 (search-forward "-*-" (save-excursion
|
|
|
1387 ;; If the file begins with "#!"
|
|
|
1388 ;; (exec interpreter magic), look
|
|
|
1389 ;; for mode frobs in the first two
|
|
|
1390 ;; lines. You cannot necessarily
|
|
|
1391 ;; put them in the first line of
|
|
|
1392 ;; such a file without screwing up
|
|
|
1393 ;; the interpreter invocation.
|
|
|
1394 (end-of-line (and (looking-at "^#!") 2))
|
|
|
1395 (point)) t)
|
|
|
1396 (progn
|
|
|
1397 (skip-chars-forward " \t")
|
|
|
1398 (setq beg (point))
|
|
|
1399 (search-forward "-*-"
|
|
|
1400 (save-excursion (end-of-line) (point))
|
|
|
1401 t))
|
|
|
1402 (progn
|
|
|
1403 (forward-char -3)
|
|
|
1404 (skip-chars-backward " \t")
|
|
|
1405 (setq end (point))
|
|
|
1406 (goto-char beg)
|
|
|
1407 (if (save-excursion (search-forward ":" end t))
|
|
|
1408 ;; Find all specifications for the `mode:' variable
|
|
6322
|
1409 ;; and execute them left to right.
|
|
4699
|
1410 (while (let ((case-fold-search t))
|
10132
d6ab8efcd2ff
(set-auto-mode): Don't get confused by anything ending in "mode:" which isn't
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1411 (or (and (looking-at "mode:")
|
d6ab8efcd2ff
(set-auto-mode): Don't get confused by anything ending in "mode:" which isn't
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1412 (goto-char (match-end 0)))
|
d6ab8efcd2ff
(set-auto-mode): Don't get confused by anything ending in "mode:" which isn't
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1413 (re-search-forward "[ \t;]mode:" end t)))
|
|
4699
|
1414 (skip-chars-forward " \t")
|
|
|
1415 (setq beg (point))
|
|
|
1416 (if (search-forward ";" end t)
|
|
|
1417 (forward-char -1)
|
|
|
1418 (goto-char end))
|
|
|
1419 (skip-chars-backward " \t")
|
|
13496
|
1420 (setq modes (cons (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
|
|
|
1421 modes)))
|
|
4699
|
1422 ;; Simple -*-MODE-*- case.
|
|
13496
|
1423 (setq modes (cons (intern (concat (downcase (buffer-substring beg end))
|
|
|
1424 "-mode"))
|
|
|
1425 modes))))))
|
|
|
1426 ;; If we found modes to use, invoke them now,
|
|
|
1427 ;; outside the save-excursion.
|
|
18819
|
1428 (when modes
|
|
|
1429 (unless just-from-file-name
|
|
|
1430 (mapcar 'funcall (nreverse modes)))
|
|
|
1431 (setq done t))
|
|
13496
|
1432 ;; If we didn't find a mode from a -*- line, try using the file name.
|
|
|
1433 (if (and (not done) buffer-file-name)
|
|
|
1434 (let ((name buffer-file-name)
|
|
|
1435 (keep-going t))
|
|
|
1436 ;; Remove backup-suffixes from file name.
|
|
|
1437 (setq name (file-name-sans-versions name))
|
|
|
1438 (while keep-going
|
|
|
1439 (setq keep-going nil)
|
|
|
1440 (let ((alist auto-mode-alist)
|
|
|
1441 (mode nil))
|
|
|
1442 ;; Find first matching alist entry.
|
|
13832
|
1443 (let ((case-fold-search
|
|
13496
|
1444 (memq system-type '(vax-vms windows-nt))))
|
|
|
1445 (while (and (not mode) alist)
|
|
|
1446 (if (string-match (car (car alist)) name)
|
|
|
1447 (if (and (consp (cdr (car alist)))
|
|
|
1448 (nth 2 (car alist)))
|
|
|
1449 (progn
|
|
|
1450 (setq mode (car (cdr (car alist)))
|
|
|
1451 name (substring name 0 (match-beginning 0))
|
|
|
1452 keep-going t))
|
|
|
1453 (setq mode (cdr (car alist))
|
|
|
1454 keep-going nil)))
|
|
|
1455 (setq alist (cdr alist))))
|
|
|
1456 (if mode
|
|
21773
|
1457 ;; When JUST-FROM-FILE-NAME is set,
|
|
|
1458 ;; we are working on behalf of set-visited-file-name.
|
|
|
1459 ;; In that case, if the major mode specified is the
|
|
|
1460 ;; same one we already have, don't actually reset it.
|
|
|
1461 ;; We don't want to lose minor modes such as Font Lock.
|
|
|
1462 (unless (and just-from-file-name (eq mode major-mode))
|
|
|
1463 (funcall mode))
|
|
13496
|
1464 ;; If we can't deduce a mode from the file name,
|
|
|
1465 ;; look for an interpreter specified in the first line.
|
|
13737
|
1466 ;; As a special case, allow for things like "#!/bin/env perl",
|
|
|
1467 ;; which finds the interpreter anywhere in $PATH.
|
|
13496
|
1468 (let ((interpreter
|
|
|
1469 (save-excursion
|
|
|
1470 (goto-char (point-min))
|
|
14598
|
1471 (if (looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
|
|
13737
|
1472 (buffer-substring (match-beginning 2)
|
|
|
1473 (match-end 2))
|
|
13496
|
1474 "")))
|
|
|
1475 elt)
|
|
|
1476 ;; Map interpreter name to a mode.
|
|
|
1477 (setq elt (assoc (file-name-nondirectory interpreter)
|
|
|
1478 interpreter-mode-alist))
|
|
17660
|
1479 (unless just-from-file-name
|
|
|
1480 (if elt
|
|
|
1481 (funcall (cdr elt))))))))))))
|
|
337
|
1482
|
|
1395
|
1483 (defun hack-local-variables-prop-line ()
|
|
|
1484 ;; Set local variables specified in the -*- line.
|
|
19645
|
1485 ;; Ignore any specification for `mode:' and `coding:';
|
|
|
1486 ;; set-auto-mode should already have handled `mode:',
|
|
|
1487 ;; set-auto-coding should already have handled `coding:'.
|
|
1395
|
1488 (save-excursion
|
|
|
1489 (goto-char (point-min))
|
|
6575
|
1490 (let ((result nil)
|
|
|
1491 (end (save-excursion (end-of-line (and (looking-at "^#!") 2)) (point))))
|
|
1395
|
1492 ;; Parse the -*- line into the `result' alist.
|
|
|
1493 (cond ((not (search-forward "-*-" end t))
|
|
|
1494 ;; doesn't have one.
|
|
|
1495 nil)
|
|
|
1496 ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
|
|
6575
|
1497 ;; Simple form: "-*- MODENAME -*-". Already handled.
|
|
|
1498 nil)
|
|
1395
|
1499 (t
|
|
|
1500 ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
|
|
|
1501 ;; (last ";" is optional).
|
|
|
1502 (save-excursion
|
|
|
1503 (if (search-forward "-*-" end t)
|
|
|
1504 (setq end (- (point) 3))
|
|
|
1505 (error "-*- not terminated before end of line")))
|
|
|
1506 (while (< (point) end)
|
|
|
1507 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
|
|
|
1508 (error "malformed -*- line"))
|
|
|
1509 (goto-char (match-end 0))
|
|
12068
|
1510 ;; There used to be a downcase here,
|
|
|
1511 ;; but the manual didn't say so,
|
|
|
1512 ;; and people want to set var names that aren't all lc.
|
|
|
1513 (let ((key (intern (buffer-substring
|
|
|
1514 (match-beginning 1)
|
|
|
1515 (match-end 1))))
|
|
1395
|
1516 (val (save-restriction
|
|
|
1517 (narrow-to-region (point) end)
|
|
|
1518 (read (current-buffer)))))
|
|
16440
|
1519 ;; It is traditional to ignore
|
|
|
1520 ;; case when checking for `mode' in set-auto-mode,
|
|
|
1521 ;; so we must do that here as well.
|
|
|
1522 ;; That is inconsistent, but we're stuck with it.
|
|
19645
|
1523 ;; The same can be said for `coding' in set-auto-coding.
|
|
16440
|
1524 (or (equal (downcase (symbol-name key)) "mode")
|
|
19645
|
1525 (equal (downcase (symbol-name key)) "coding")
|
|
6575
|
1526 (setq result (cons (cons key val) result)))
|
|
1395
|
1527 (skip-chars-forward " \t;")))
|
|
|
1528 (setq result (nreverse result))))
|
|
13832
|
1529
|
|
1395
|
1530 (if (and result
|
|
|
1531 (or (eq enable-local-variables t)
|
|
|
1532 (and enable-local-variables
|
|
|
1533 (save-window-excursion
|
|
5292
|
1534 (condition-case nil
|
|
|
1535 (switch-to-buffer (current-buffer))
|
|
|
1536 (error
|
|
|
1537 ;; If we fail to switch in the selected window,
|
|
|
1538 ;; it is probably a minibuffer.
|
|
|
1539 ;; So try another window.
|
|
|
1540 (condition-case nil
|
|
|
1541 (switch-to-buffer-other-window (current-buffer))
|
|
|
1542 (error
|
|
|
1543 (switch-to-buffer-other-frame (current-buffer))))))
|
|
1395
|
1544 (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
|
|
|
1545 (file-name-nondirectory buffer-file-name)))))))
|
|
15365
|
1546 (let ((enable-local-eval enable-local-eval))
|
|
|
1547 (while result
|
|
|
1548 (hack-one-local-variable (car (car result)) (cdr (car result)))
|
|
|
1549 (setq result (cdr result))))))))
|
|
1395
|
1550
|
|
10169
|
1551 (defvar hack-local-variables-hook nil
|
|
|
1552 "Normal hook run after processing a file's local variables specs.
|
|
|
1553 Major modes can use this to examine user-specified local variables
|
|
|
1554 in order to initialize other data structure based on them.")
|
|
|
1555
|
|
17660
|
1556 (defun hack-local-variables (&optional mode-only)
|
|
|
1557 "Parse and put into effect this buffer's local variables spec.
|
|
|
1558 If MODE-ONLY is non-nil, all we do is check whether the major mode
|
|
|
1559 is specified, returning t if it is specified."
|
|
|
1560 (unless mode-only
|
|
|
1561 (hack-local-variables-prop-line))
|
|
337
|
1562 ;; Look for "Local variables:" line in last page.
|
|
17660
|
1563 (let (mode-specified)
|
|
|
1564 (save-excursion
|
|
|
1565 (goto-char (point-max))
|
|
|
1566 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
|
|
|
1567 (if (let ((case-fold-search t))
|
|
|
1568 (and (search-forward "Local Variables:" nil t)
|
|
|
1569 (or (eq enable-local-variables t)
|
|
|
1570 mode-only
|
|
|
1571 (and enable-local-variables
|
|
|
1572 (save-window-excursion
|
|
|
1573 (switch-to-buffer (current-buffer))
|
|
|
1574 (save-excursion
|
|
|
1575 (beginning-of-line)
|
|
|
1576 (set-window-start (selected-window) (point)))
|
|
|
1577 (y-or-n-p (format "Set local variables as specified at end of %s? "
|
|
|
1578 (if buffer-file-name
|
|
|
1579 (file-name-nondirectory
|
|
|
1580 buffer-file-name)
|
|
|
1581 (concat "buffer "
|
|
|
1582 (buffer-name))))))))))
|
|
|
1583 (let ((continue t)
|
|
|
1584 prefix prefixlen suffix beg
|
|
|
1585 mode-specified
|
|
|
1586 (enable-local-eval enable-local-eval))
|
|
|
1587 ;; The prefix is what comes before "local variables:" in its line.
|
|
|
1588 ;; The suffix is what comes after "local variables:" in its line.
|
|
|
1589 (skip-chars-forward " \t")
|
|
|
1590 (or (eolp)
|
|
|
1591 (setq suffix (buffer-substring (point)
|
|
|
1592 (progn (end-of-line) (point)))))
|
|
|
1593 (goto-char (match-beginning 0))
|
|
|
1594 (or (bolp)
|
|
|
1595 (setq prefix
|
|
|
1596 (buffer-substring (point)
|
|
|
1597 (progn (beginning-of-line) (point)))))
|
|
566
|
1598
|
|
17660
|
1599 (if prefix (setq prefixlen (length prefix)
|
|
|
1600 prefix (regexp-quote prefix)))
|
|
|
1601 (if suffix (setq suffix (concat (regexp-quote suffix) "$")))
|
|
|
1602 (while continue
|
|
|
1603 ;; Look at next local variable spec.
|
|
|
1604 (if selective-display (re-search-forward "[\n\C-m]")
|
|
|
1605 (forward-line 1))
|
|
|
1606 ;; Skip the prefix, if any.
|
|
|
1607 (if prefix
|
|
|
1608 (if (looking-at prefix)
|
|
|
1609 (forward-char prefixlen)
|
|
|
1610 (error "Local variables entry is missing the prefix")))
|
|
|
1611 ;; Find the variable name; strip whitespace.
|
|
|
1612 (skip-chars-forward " \t")
|
|
|
1613 (setq beg (point))
|
|
|
1614 (skip-chars-forward "^:\n")
|
|
|
1615 (if (eolp) (error "Missing colon in local variables entry"))
|
|
|
1616 (skip-chars-backward " \t")
|
|
|
1617 (let* ((str (buffer-substring beg (point)))
|
|
|
1618 (var (read str))
|
|
|
1619 val)
|
|
|
1620 ;; Setting variable named "end" means end of list.
|
|
|
1621 (if (string-equal (downcase str) "end")
|
|
|
1622 (setq continue nil)
|
|
|
1623 ;; Otherwise read the variable value.
|
|
|
1624 (skip-chars-forward "^:")
|
|
|
1625 (forward-char 1)
|
|
|
1626 (setq val (read (current-buffer)))
|
|
|
1627 (skip-chars-backward "\n")
|
|
|
1628 (skip-chars-forward " \t")
|
|
|
1629 (or (if suffix (looking-at suffix) (eolp))
|
|
|
1630 (error "Local variables entry is terminated incorrectly"))
|
|
|
1631 (if mode-only
|
|
|
1632 (if (eq var 'mode)
|
|
|
1633 (setq mode-specified t))
|
|
|
1634 ;; Set the variable. "Variables" mode and eval are funny.
|
|
|
1635 (hack-one-local-variable var val))))))))
|
|
|
1636 (unless mode-only
|
|
|
1637 (run-hooks 'hack-local-variables-hook))
|
|
|
1638 mode-specified))
|
|
1395
|
1639
|
|
16687
|
1640 (defvar ignored-local-variables
|
|
1395
|
1641 '(enable-local-eval)
|
|
|
1642 "Variables to be ignored in a file's local variable spec.")
|
|
|
1643
|
6734
6e61dbbfce80
(hack-one-local-variable): Test for risky-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1644 ;; Get confirmation before setting these variables as locals in a file.
|
|
8148
|
1645 (put 'debugger 'risky-local-variable t)
|
|
7682
|
1646 (put 'enable-local-eval 'risky-local-variable t)
|
|
10149
|
1647 (put 'ignored-local-variables 'risky-local-variable t)
|
6734
6e61dbbfce80
(hack-one-local-variable): Test for risky-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1648 (put 'eval 'risky-local-variable t)
|
6e61dbbfce80
(hack-one-local-variable): Test for risky-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1649 (put 'file-name-handler-alist 'risky-local-variable t)
|
6e61dbbfce80
(hack-one-local-variable): Test for risky-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1650 (put 'minor-mode-map-alist 'risky-local-variable t)
|
6e61dbbfce80
(hack-one-local-variable): Test for risky-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1651 (put 'after-load-alist 'risky-local-variable t)
|
|
7682
|
1652 (put 'buffer-file-name 'risky-local-variable t)
|
|
|
1653 (put 'buffer-auto-save-file-name 'risky-local-variable t)
|
|
|
1654 (put 'buffer-file-truename 'risky-local-variable t)
|
|
8171
|
1655 (put 'exec-path 'risky-local-variable t)
|
|
|
1656 (put 'load-path 'risky-local-variable t)
|
|
|
1657 (put 'exec-directory 'risky-local-variable t)
|
|
|
1658 (put 'process-environment 'risky-local-variable t)
|
|
15753
|
1659 (put 'dabbrev-case-fold-search 'risky-local-variable t)
|
|
|
1660 (put 'dabbrev-case-replace 'risky-local-variable t)
|
|
8177
|
1661 ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode.
|
|
|
1662 (put 'outline-level 'risky-local-variable t)
|
|
8251
|
1663 (put 'rmail-output-file-alist 'risky-local-variable t)
|
|
7682
|
1664
|
9162
53d02761f5b7
(hack-one-local-variable): Support safe-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1665 ;; This one is safe because the user gets to check it before it is used.
|
53d02761f5b7
(hack-one-local-variable): Support safe-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1666 (put 'compile-command 'safe-local-variable t)
|
53d02761f5b7
(hack-one-local-variable): Support safe-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1667
|
|
7217
|
1668 (defun hack-one-local-variable-quotep (exp)
|
|
|
1669 (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
|
|
|
1670
|
|
1395
|
1671 ;; "Set" one variable in a local variables spec.
|
|
|
1672 ;; A few variable names are treated specially.
|
|
|
1673 (defun hack-one-local-variable (var val)
|
|
|
1674 (cond ((eq var 'mode)
|
|
|
1675 (funcall (intern (concat (downcase (symbol-name val))
|
|
|
1676 "-mode"))))
|
|
19645
|
1677 ((eq var 'coding)
|
|
|
1678 ;; We have already handled coding: tag in set-auto-coding.
|
|
|
1679 nil)
|
|
1395
|
1680 ((memq var ignored-local-variables)
|
|
|
1681 nil)
|
|
|
1682 ;; "Setting" eval means either eval it or do nothing.
|
3626
ae0389767674
(hack-one-local-variable): Treat ...-hook(s) and ..-function(s)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1683 ;; Likewise for setting hook variables.
|
6734
6e61dbbfce80
(hack-one-local-variable): Test for risky-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1684 ((or (get var 'risky-local-variable)
|
9162
53d02761f5b7
(hack-one-local-variable): Support safe-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1685 (and
|
21327
01870b9b4f2a
(hack-one-local-variable): Variables named ...-predicate are treated as risky.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1686 (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$"
|
9162
53d02761f5b7
(hack-one-local-variable): Support safe-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1687 (symbol-name var))
|
53d02761f5b7
(hack-one-local-variable): Support safe-local-variable property.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1688 (not (get var 'safe-local-variable))))
|
|
13980
|
1689 ;; Permit evalling a put of a harmless property.
|
|
7217
|
1690 ;; if the args do nothing tricky.
|
|
|
1691 (if (or (and (eq var 'eval)
|
|
|
1692 (consp val)
|
|
|
1693 (eq (car val) 'put)
|
|
|
1694 (hack-one-local-variable-quotep (nth 1 val))
|
|
|
1695 (hack-one-local-variable-quotep (nth 2 val))
|
|
|
1696 ;; Only allow safe values of lisp-indent-hook;
|
|
|
1697 ;; not functions.
|
|
|
1698 (or (numberp (nth 3 val))
|
|
7643
|
1699 (equal (nth 3 val) ''defun))
|
|
7217
|
1700 (memq (nth 1 (nth 2 val))
|
|
|
1701 '(lisp-indent-hook)))
|
|
|
1702 ;; Permit eval if not root and user says ok.
|
|
8181
|
1703 (and (not (zerop (user-uid)))
|
|
7217
|
1704 (or (eq enable-local-eval t)
|
|
|
1705 (and enable-local-eval
|
|
|
1706 (save-window-excursion
|
|
|
1707 (switch-to-buffer (current-buffer))
|
|
|
1708 (save-excursion
|
|
|
1709 (beginning-of-line)
|
|
|
1710 (set-window-start (selected-window) (point)))
|
|
|
1711 (setq enable-local-eval
|
|
|
1712 (y-or-n-p (format "Process `eval' or hook local variables in file %s? "
|
|
|
1713 (file-name-nondirectory buffer-file-name)))))))))
|
3626
ae0389767674
(hack-one-local-variable): Treat ...-hook(s) and ..-function(s)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1714 (if (eq var 'eval)
|
ae0389767674
(hack-one-local-variable): Treat ...-hook(s) and ..-function(s)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1715 (save-excursion (eval val))
|
ae0389767674
(hack-one-local-variable): Treat ...-hook(s) and ..-function(s)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1716 (make-local-variable var)
|
ae0389767674
(hack-one-local-variable): Treat ...-hook(s) and ..-function(s)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1717 (set var val))
|
|
1395
|
1718 (message "Ignoring `eval:' in file's local variables")))
|
|
|
1719 ;; Ordinary variable, really set it.
|
|
|
1720 (t (make-local-variable var)
|
|
|
1721 (set var val))))
|
|
|
1722
|
|
337
|
1723
|
|
17673
|
1724 (defcustom change-major-mode-with-file-name t
|
|
17660
|
1725 "*Non-nil means \\[write-file] should set the major mode from the file name.
|
|
|
1726 However, the mode will not be changed if
|
|
|
1727 \(1) a local variables list or the `-*-' line specifies a major mode, or
|
|
|
1728 \(2) the current major mode is a \"special\" mode,
|
|
17666
|
1729 \ not suitable for ordinary files, or
|
|
17673
|
1730 \(3) the new file name does not particularly specify any mode."
|
|
|
1731 :type 'boolean
|
|
|
1732 :group 'editing-basics)
|
|
17660
|
1733
|
|
16971
|
1734 (defun set-visited-file-name (filename &optional no-query along-with-file)
|
|
337
|
1735 "Change name of file visited in current buffer to FILENAME.
|
|
|
1736 The next time the buffer is saved it will go in the newly specified file.
|
|
|
1737 nil or empty string as argument means make buffer not be visiting any file.
|
|
|
1738 Remember to delete the initial contents of the minibuffer
|
|
15570
|
1739 if you wish to pass an empty string as the argument.
|
|
|
1740
|
|
|
1741 The optional second argument NO-QUERY, if non-nil, inhibits asking for
|
|
16971
|
1742 confirmation in the case where another buffer is already visiting FILENAME.
|
|
|
1743
|
|
|
1744 The optional third argument ALONG-WITH-FILE, if non-nil, means that
|
|
|
1745 the old visited file has been renamed to the new name FILENAME."
|
|
337
|
1746 (interactive "FSet visited file name: ")
|
|
10298
|
1747 (if (buffer-base-buffer)
|
|
|
1748 (error "An indirect buffer cannot visit a file"))
|
|
8140
|
1749 (let (truename)
|
|
|
1750 (if filename
|
|
|
1751 (setq filename
|
|
|
1752 (if (string-equal filename "")
|
|
|
1753 nil
|
|
|
1754 (expand-file-name filename))))
|
|
|
1755 (if filename
|
|
|
1756 (progn
|
|
|
1757 (setq truename (file-truename filename))
|
|
|
1758 (if find-file-visit-truename
|
|
|
1759 (setq filename truename))))
|
14883
f8a7a08fb9dd
(set-visited-file-name): Don't call find-buffer-visiting if filename is nil.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1760 (let ((buffer (and filename (find-buffer-visiting filename))))
|
|
14731
|
1761 (and buffer (not (eq buffer (current-buffer)))
|
|
15570
|
1762 (not no-query)
|
|
14731
|
1763 (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
|
|
|
1764 filename)))
|
|
|
1765 (error "Aborted")))
|
|
8140
|
1766 (or (equal filename buffer-file-name)
|
|
|
1767 (progn
|
|
|
1768 (and filename (lock-buffer filename))
|
|
|
1769 (unlock-buffer)))
|
|
|
1770 (setq buffer-file-name filename)
|
|
|
1771 (if filename ; make buffer name reflect filename.
|
|
|
1772 (let ((new-name (file-name-nondirectory buffer-file-name)))
|
|
|
1773 (if (string= new-name "")
|
|
|
1774 (error "Empty file name"))
|
|
|
1775 (if (eq system-type 'vax-vms)
|
|
|
1776 (setq new-name (downcase new-name)))
|
|
|
1777 (setq default-directory (file-name-directory buffer-file-name))
|
|
|
1778 (or (string= new-name (buffer-name))
|
|
|
1779 (rename-buffer new-name t))))
|
|
|
1780 (setq buffer-backed-up nil)
|
|
16971
|
1781 (or along-with-file
|
|
|
1782 (clear-visited-file-modtime))
|
|
13289
|
1783 ;; Abbreviate the file names of the buffer.
|
|
8151
|
1784 (if truename
|
|
13289
|
1785 (progn
|
|
|
1786 (setq buffer-file-truename (abbreviate-file-name truename))
|
|
|
1787 (if find-file-visit-truename
|
|
|
1788 (setq buffer-file-name buffer-file-truename))))
|
|
8140
|
1789 (setq buffer-file-number
|
|
|
1790 (if filename
|
|
13326
|
1791 (nthcdr 10 (file-attributes buffer-file-name))
|
|
8140
|
1792 nil)))
|
|
337
|
1793 ;; write-file-hooks is normally used for things like ftp-find-file
|
|
|
1794 ;; that visit things that are not local files as if they were files.
|
|
|
1795 ;; Changing to visit an ordinary local file instead should flush the hook.
|
|
|
1796 (kill-local-variable 'write-file-hooks)
|
|
2375
|
1797 (kill-local-variable 'local-write-file-hooks)
|
|
337
|
1798 (kill-local-variable 'revert-buffer-function)
|
|
|
1799 (kill-local-variable 'backup-inhibited)
|
|
6546
|
1800 ;; If buffer was read-only because of version control,
|
|
|
1801 ;; that reason is gone now, so make it writable.
|
|
|
1802 (if vc-mode
|
|
|
1803 (setq buffer-read-only nil))
|
|
|
1804 (kill-local-variable 'vc-mode)
|
|
337
|
1805 ;; Turn off backup files for certain file names.
|
|
|
1806 ;; Since this is a permanent local, the major mode won't eliminate it.
|
|
21001
|
1807 (and buffer-file-name
|
|
|
1808 (not (funcall backup-enable-predicate buffer-file-name))
|
|
337
|
1809 (progn
|
|
|
1810 (make-local-variable 'backup-inhibited)
|
|
|
1811 (setq backup-inhibited t)))
|
|
3944
|
1812 (let ((oauto buffer-auto-save-file-name))
|
|
|
1813 ;; If auto-save was not already on, turn it on if appropriate.
|
|
|
1814 (if (not buffer-auto-save-file-name)
|
|
|
1815 (and buffer-file-name auto-save-default
|
|
|
1816 (auto-save-mode t))
|
|
|
1817 ;; If auto save is on, start using a new name.
|
|
|
1818 ;; We deliberately don't rename or delete the old auto save
|
|
|
1819 ;; for the old visited file name. This is because perhaps
|
|
|
1820 ;; the user wants to save the new state and then compare with the
|
|
|
1821 ;; previous state from the auto save file.
|
|
|
1822 (setq buffer-auto-save-file-name
|
|
|
1823 (make-auto-save-file-name)))
|
|
|
1824 ;; Rename the old auto save file if any.
|
|
|
1825 (and oauto buffer-auto-save-file-name
|
3946
535f1f575d04
(set-visited-file-name): Rename auto-save file only if it exists.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1826 (file-exists-p oauto)
|
|
3944
|
1827 (rename-file oauto buffer-auto-save-file-name t)))
|
|
16971
|
1828 (and buffer-file-name
|
|
|
1829 (not along-with-file)
|
|
17660
|
1830 (set-buffer-modified-p t))
|
|
|
1831 ;; Update the major mode, if the file name determines it.
|
|
|
1832 (condition-case nil
|
|
|
1833 ;; Don't change the mode if it is special.
|
|
|
1834 (or (not change-major-mode-with-file-name)
|
|
|
1835 (get major-mode 'mode-class)
|
|
|
1836 ;; Don't change the mode if the local variable list specifies it.
|
|
|
1837 (hack-local-variables t)
|
|
|
1838 (set-auto-mode t))
|
|
|
1839 (error nil)))
|
|
337
|
1840
|
|
17987
|
1841 (defun write-file (filename &optional confirm)
|
|
337
|
1842 "Write current buffer into file FILENAME.
|
|
2003
|
1843 Makes buffer visit that file, and marks it not modified.
|
|
|
1844 If the buffer is already visiting a file, you can specify
|
|
|
1845 a directory name as FILENAME, to write a file of the same
|
11340
5c97fabe0ab9
(write-file): Default is ask for confirmation only interactively.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1846 old name in that directory.
|
|
14469
|
1847
|
11340
5c97fabe0ab9
(write-file): Default is ask for confirmation only interactively.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1848 If optional second arg CONFIRM is non-nil,
|
|
14469
|
1849 ask for confirmation for overwriting an existing file.
|
|
17987
|
1850 Interactively, confirmation is required unless you supply a prefix argument."
|
|
337
|
1851 ;; (interactive "FWrite file: ")
|
|
|
1852 (interactive
|
|
|
1853 (list (if buffer-file-name
|
|
|
1854 (read-file-name "Write file: "
|
|
|
1855 nil nil nil nil)
|
|
|
1856 (read-file-name "Write file: "
|
|
|
1857 (cdr (assq 'default-directory
|
|
|
1858 (buffer-local-variables)))
|
21327
01870b9b4f2a
(hack-one-local-variable): Variables named ...-predicate are treated as risky.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1859 nil nil (file-name-nondirectory (buffer-name))))
|
|
17987
|
1860 (not current-prefix-arg)))
|
|
337
|
1861 (or (null filename) (string-equal filename "")
|
|
2003
|
1862 (progn
|
|
|
1863 ;; If arg is just a directory,
|
|
|
1864 ;; use same file name, but in that directory.
|
|
|
1865 (if (and (file-directory-p filename) buffer-file-name)
|
|
|
1866 (setq filename (concat (file-name-as-directory filename)
|
|
|
1867 (file-name-nondirectory buffer-file-name))))
|
11340
5c97fabe0ab9
(write-file): Default is ask for confirmation only interactively.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1868 (and confirm
|
5c97fabe0ab9
(write-file): Default is ask for confirmation only interactively.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1869 (file-exists-p filename)
|
5c97fabe0ab9
(write-file): Default is ask for confirmation only interactively.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1870 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
|
5c97fabe0ab9
(write-file): Default is ask for confirmation only interactively.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1871 (error "Canceled")))
|
|
16470
|
1872 (set-visited-file-name filename (not confirm))))
|
|
337
|
1873 (set-buffer-modified-p t)
|
|
20291
|
1874 ;; Make buffer writable if file is writable.
|
|
|
1875 (and buffer-file-name
|
|
|
1876 (file-writable-p buffer-file-name)
|
|
|
1877 (setq buffer-read-only nil))
|
|
17987
|
1878 (save-buffer))
|
|
337
|
1879
|
|
|
1880 (defun backup-buffer ()
|
|
|
1881 "Make a backup of the disk file visited by the current buffer, if appropriate.
|
|
|
1882 This is normally done before saving the buffer the first time.
|
|
|
1883 If the value is non-nil, it is the result of `file-modes' on the original
|
|
|
1884 file; this means that the caller, after saving the buffer, should change
|
|
16614
|
1885 the modes of the new file to agree with the old modes.
|
|
|
1886
|
|
|
1887 A backup may be done by renaming or by copying; see documentation of
|
|
|
1888 variable `make-backup-files'. If it's done by renaming, then the file is
|
|
|
1889 no longer accessible under its old name."
|
|
337
|
1890 (if (and make-backup-files (not backup-inhibited)
|
|
|
1891 (not buffer-backed-up)
|
|
|
1892 (file-exists-p buffer-file-name)
|
|
|
1893 (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
|
|
|
1894 '(?- ?l)))
|
|
|
1895 (let ((real-file-name buffer-file-name)
|
|
|
1896 backup-info backupname targets setmodes)
|
|
|
1897 ;; If specified name is a symbolic link, chase it to the target.
|
|
|
1898 ;; Thus we make the backups in the directory where the real file is.
|
|
3260
|
1899 (setq real-file-name (file-chase-links real-file-name))
|
|
337
|
1900 (setq backup-info (find-backup-file-name real-file-name)
|
|
|
1901 backupname (car backup-info)
|
|
|
1902 targets (cdr backup-info))
|
|
|
1903 ;;; (if (file-directory-p buffer-file-name)
|
|
|
1904 ;;; (error "Cannot save buffer in directory %s" buffer-file-name))
|
|
10408
|
1905 (if backup-info
|
|
|
1906 (condition-case ()
|
|
|
1907 (let ((delete-old-versions
|
|
|
1908 ;; If have old versions to maybe delete,
|
|
|
1909 ;; ask the user to confirm now, before doing anything.
|
|
|
1910 ;; But don't actually delete til later.
|
|
|
1911 (and targets
|
|
|
1912 (or (eq delete-old-versions t) (eq delete-old-versions nil))
|
|
|
1913 (or delete-old-versions
|
|
|
1914 (y-or-n-p (format "Delete excess backup versions of %s? "
|
|
|
1915 real-file-name))))))
|
|
|
1916 ;; Actually write the back up file.
|
|
|
1917 (condition-case ()
|
|
|
1918 (if (or file-precious-flag
|
|
|
1919 ; (file-symlink-p buffer-file-name)
|
|
|
1920 backup-by-copying
|
|
|
1921 (and backup-by-copying-when-linked
|
|
|
1922 (> (file-nlinks real-file-name) 1))
|
|
|
1923 (and backup-by-copying-when-mismatch
|
|
|
1924 (let ((attr (file-attributes real-file-name)))
|
|
|
1925 (or (nth 9 attr)
|
|
|
1926 (not (file-ownership-preserved-p real-file-name))))))
|
|
|
1927 (condition-case ()
|
|
|
1928 (copy-file real-file-name backupname t t)
|
|
|
1929 (file-error
|
|
|
1930 ;; If copying fails because file BACKUPNAME
|
|
|
1931 ;; is not writable, delete that file and try again.
|
|
|
1932 (if (and (file-exists-p backupname)
|
|
|
1933 (not (file-writable-p backupname)))
|
|
|
1934 (delete-file backupname))
|
|
|
1935 (copy-file real-file-name backupname t t)))
|
|
|
1936 ;; rename-file should delete old backup.
|
|
|
1937 (rename-file real-file-name backupname t)
|
|
|
1938 (setq setmodes (file-modes backupname)))
|
|
|
1939 (file-error
|
|
|
1940 ;; If trouble writing the backup, write it in ~.
|
13903
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1941 (setq backupname (expand-file-name
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1942 (convert-standard-filename
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1943 "~/%backup%~")))
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1944 (message "Cannot write backup file; backing up in %s"
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1945 (file-name-nondirectory backupname))
|
|
10408
|
1946 (sleep-for 1)
|
|
|
1947 (condition-case ()
|
|
|
1948 (copy-file real-file-name backupname t t)
|
|
|
1949 (file-error
|
|
|
1950 ;; If copying fails because file BACKUPNAME
|
|
|
1951 ;; is not writable, delete that file and try again.
|
|
|
1952 (if (and (file-exists-p backupname)
|
|
|
1953 (not (file-writable-p backupname)))
|
|
|
1954 (delete-file backupname))
|
|
|
1955 (copy-file real-file-name backupname t t)))))
|
|
|
1956 (setq buffer-backed-up t)
|
|
|
1957 ;; Now delete the old versions, if desired.
|
|
|
1958 (if delete-old-versions
|
|
|
1959 (while targets
|
|
|
1960 (condition-case ()
|
|
|
1961 (delete-file (car targets))
|
|
|
1962 (file-error nil))
|
|
|
1963 (setq targets (cdr targets))))
|
|
|
1964 setmodes)
|
|
|
1965 (file-error nil))))))
|
|
337
|
1966
|
|
1109
|
1967 (defun file-name-sans-versions (name &optional keep-backup-version)
|
|
337
|
1968 "Return FILENAME sans backup versions or strings.
|
|
|
1969 This is a separate procedure so your site-init or startup file can
|
|
1109
|
1970 redefine it.
|
|
|
1971 If the optional argument KEEP-BACKUP-VERSION is non-nil,
|
|
|
1972 we do not remove backup version numbers, only true file version numbers."
|
|
7030
|
1973 (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
|
|
1109
|
1974 (if handler
|
|
|
1975 (funcall handler 'file-name-sans-versions name keep-backup-version)
|
|
|
1976 (substring name 0
|
|
|
1977 (if (eq system-type 'vax-vms)
|
|
|
1978 ;; VMS version number is (a) semicolon, optional
|
|
|
1979 ;; sign, zero or more digits or (b) period, option
|
|
|
1980 ;; sign, zero or more digits, provided this is the
|
|
|
1981 ;; second period encountered outside of the
|
|
|
1982 ;; device/directory part of the file name.
|
|
6309
|
1983 (or (string-match ";[-+]?[0-9]*\\'" name)
|
|
|
1984 (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'"
|
|
1109
|
1985 name)
|
|
|
1986 (match-beginning 1))
|
|
|
1987 (length name))
|
|
|
1988 (if keep-backup-version
|
|
|
1989 (length name)
|
12591
7caa97ba6a7b
(file-name-sans-versions): Recognize version control version numbers.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1990 (or (string-match "\\.~[0-9.]+~\\'" name)
|
|
1109
|
1991 (string-match "~\\'" name)
|
|
|
1992 (length name))))))))
|
|
337
|
1993
|
|
8987
|
1994 (defun file-ownership-preserved-p (file)
|
|
|
1995 "Returns t if deleting FILE and rewriting it would preserve the owner."
|
|
|
1996 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
|
|
|
1997 (if handler
|
|
|
1998 (funcall handler 'file-ownership-preserved-p file)
|
|
11867
|
1999 (let ((attributes (file-attributes file)))
|
|
11817
|
2000 ;; Return t if the file doesn't exist, since it's true that no
|
|
|
2001 ;; information would be lost by an (attempted) delete and create.
|
|
|
2002 (or (null attributes)
|
|
|
2003 (= (nth 2 attributes) (user-uid)))))))
|
|
8987
|
2004
|
|
8908
|
2005 (defun file-name-sans-extension (filename)
|
|
|
2006 "Return FILENAME sans final \"extension\".
|
|
|
2007 The extension, in a file name, is the part that follows the last `.'."
|
|
|
2008 (save-match-data
|
|
|
2009 (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
|
|
|
2010 directory)
|
|
|
2011 (if (string-match "\\.[^.]*\\'" file)
|
|
|
2012 (if (setq directory (file-name-directory filename))
|
|
|
2013 (expand-file-name (substring file 0 (match-beginning 0))
|
|
|
2014 directory)
|
|
|
2015 (substring file 0 (match-beginning 0)))
|
|
|
2016 filename))))
|
|
|
2017
|
|
16440
|
2018 (defun file-name-extension (filename &optional period)
|
|
|
2019 "Return FILENAME's final \"extension\".
|
|
|
2020 The extension, in a file name, is the part that follows the last `.'.
|
|
|
2021 Return nil for extensionless file names such as `foo'.
|
|
|
2022 Return the empty string for file names such as `foo.'.
|
|
|
2023
|
|
|
2024 If PERIOD is non-nil, then the returned value includes the period
|
|
|
2025 that delimits the extension, and if FILENAME has no extension,
|
|
|
2026 the value is \"\"."
|
|
|
2027 (save-match-data
|
|
|
2028 (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
|
|
|
2029 (if (string-match "\\.[^.]*\\'" file)
|
|
|
2030 (substring file (+ (match-beginning 0) (if period 0 1)))
|
|
|
2031 (if period
|
|
|
2032 "")))))
|
|
|
2033
|
|
337
|
2034 (defun make-backup-file-name (file)
|
|
|
2035 "Create the non-numeric backup file name for FILE.
|
|
|
2036 This is a separate function so you can redefine it for customization."
|
|
15269
|
2037 (if (and (eq system-type 'ms-dos)
|
|
|
2038 (not (msdos-long-file-names)))
|
|
5453
|
2039 (let ((fn (file-name-nondirectory file)))
|
|
|
2040 (concat (file-name-directory file)
|
|
13749
|
2041 (or
|
|
|
2042 (and (string-match "\\`[^.]+\\'" fn)
|
|
|
2043 (concat (match-string 0 fn) ".~"))
|
|
|
2044 (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
|
|
|
2045 (concat (match-string 0 fn) "~")))))
|
|
5453
|
2046 (concat file "~")))
|
|
337
|
2047
|
|
|
2048 (defun backup-file-name-p (file)
|
|
|
2049 "Return non-nil if FILE is a backup file name (numeric or not).
|
|
|
2050 This is a separate function so you can redefine it for customization.
|
|
|
2051 You may need to redefine `file-name-sans-versions' as well."
|
|
13749
|
2052 (string-match "~\\'" file))
|
|
337
|
2053
|
|
17734
|
2054 (defvar backup-extract-version-start)
|
|
|
2055
|
|
890
|
2056 ;; This is used in various files.
|
|
|
2057 ;; The usage of bv-length is not very clean,
|
|
|
2058 ;; but I can't see a good alternative,
|
|
|
2059 ;; so as of now I am leaving it alone.
|
|
|
2060 (defun backup-extract-version (fn)
|
|
|
2061 "Given the name of a numeric backup file, return the backup number.
|
|
17734
|
2062 Uses the free variable `backup-extract-version-start', whose value should be
|
|
890
|
2063 the index in the name where the version number begins."
|
|
17734
|
2064 (if (and (string-match "[0-9]+~$" fn backup-extract-version-start)
|
|
|
2065 (= (match-beginning 0) backup-extract-version-start))
|
|
|
2066 (string-to-int (substring fn backup-extract-version-start -1))
|
|
890
|
2067 0))
|
|
|
2068
|
|
337
|
2069 ;; I believe there is no need to alter this behavior for VMS;
|
|
|
2070 ;; since backup files are not made on VMS, it should not get called.
|
|
|
2071 (defun find-backup-file-name (fn)
|
|
|
2072 "Find a file name for a backup file, and suggestions for deletions.
|
|
|
2073 Value is a list whose car is the name for the backup file
|
|
10408
|
2074 and whose cdr is a list of old versions to consider deleting now.
|
|
|
2075 If the value is nil, don't make a backup."
|
|
|
2076 (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
|
|
|
2077 ;; Run a handler for this function so that ange-ftp can refuse to do it.
|
|
|
2078 (if handler
|
|
|
2079 (funcall handler 'find-backup-file-name fn)
|
|
|
2080 (if (eq version-control 'never)
|
|
337
|
2081 (list (make-backup-file-name fn))
|
|
10408
|
2082 (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
|
|
17734
|
2083 (backup-extract-version-start (length base-versions))
|
|
10408
|
2084 possibilities
|
|
|
2085 (versions nil)
|
|
|
2086 (high-water-mark 0)
|
|
|
2087 (deserve-versions-p nil)
|
|
|
2088 (number-to-delete 0))
|
|
|
2089 (condition-case ()
|
|
|
2090 (setq possibilities (file-name-all-completions
|
|
|
2091 base-versions
|
|
|
2092 (file-name-directory fn))
|
|
|
2093 versions (sort (mapcar
|
|
|
2094 (function backup-extract-version)
|
|
|
2095 possibilities)
|
|
|
2096 '<)
|
|
|
2097 high-water-mark (apply 'max 0 versions)
|
|
|
2098 deserve-versions-p (or version-control
|
|
|
2099 (> high-water-mark 0))
|
|
|
2100 number-to-delete (- (length versions)
|
|
|
2101 kept-old-versions kept-new-versions -1))
|
|
|
2102 (file-error
|
|
|
2103 (setq possibilities nil)))
|
|
|
2104 (if (not deserve-versions-p)
|
|
|
2105 (list (make-backup-file-name fn))
|
|
|
2106 (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
|
|
|
2107 (if (and (> number-to-delete 0)
|
|
|
2108 ;; Delete nothing if there is overflow
|
|
|
2109 ;; in the number of versions to keep.
|
|
|
2110 (>= (+ kept-new-versions kept-old-versions -1) 0))
|
|
|
2111 (mapcar (function (lambda (n)
|
|
|
2112 (concat fn ".~" (int-to-string n) "~")))
|
|
|
2113 (let ((v (nthcdr kept-old-versions versions)))
|
|
|
2114 (rplacd (nthcdr (1- number-to-delete) v) ())
|
|
|
2115 v))))))))))
|
|
337
|
2116
|
|
|
2117 (defun file-nlinks (filename)
|
|
|
2118 "Return number of names file FILENAME has."
|
|
|
2119 (car (cdr (file-attributes filename))))
|
|
1229
|
2120
|
|
|
2121 (defun file-relative-name (filename &optional directory)
|
|
17379
|
2122 "Convert FILENAME to be relative to DIRECTORY (default: default-directory).
|
|
|
2123 This function returns a relative file name which is equivalent to FILENAME
|
|
|
2124 when used with that default directory as the default.
|
|
|
2125 If this is impossible (which can happen on MSDOS and Windows
|
|
|
2126 when the file name and directory use different drive names)
|
|
|
2127 then it returns FILENAME."
|
|
16976
|
2128 (save-match-data
|
|
17734
|
2129 (let ((fname (expand-file-name filename)))
|
|
|
2130 (setq directory (file-name-as-directory
|
|
|
2131 (expand-file-name (or directory default-directory))))
|
|
|
2132 ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
|
|
|
2133 ;; drive names, they can't be relative, so return the absolute name.
|
|
|
2134 (if (and (or (eq system-type 'ms-dos)
|
|
|
2135 (eq system-type 'windows-nt))
|
|
|
2136 (not (string-equal (substring fname 0 2)
|
|
|
2137 (substring directory 0 2))))
|
|
|
2138 filename
|
|
18466
|
2139 (let ((ancestor ".")
|
|
|
2140 (fname-dir (file-name-as-directory fname)))
|
|
|
2141 (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
|
|
|
2142 (not (string-match (concat "^" (regexp-quote directory)) fname)))
|
|
17734
|
2143 (setq directory (file-name-directory (substring directory 0 -1))
|
|
18466
|
2144 ancestor (if (equal ancestor ".")
|
|
|
2145 ".."
|
|
|
2146 (concat "../" ancestor))))
|
|
|
2147 ;; Now ancestor is empty, or .., or ../.., etc.
|
|
|
2148 (if (string-match (concat "^" (regexp-quote directory)) fname)
|
|
|
2149 ;; We matched within FNAME's directory part.
|
|
|
2150 ;; Add the rest of FNAME onto ANCESTOR.
|
|
|
2151 (let ((rest (substring fname (match-end 0))))
|
|
|
2152 (if (and (equal ancestor ".")
|
|
|
2153 (not (equal rest "")))
|
|
|
2154 ;; But don't bother with ANCESTOR if it would give us `./'.
|
|
|
2155 rest
|
|
|
2156 (concat (file-name-as-directory ancestor) rest)))
|
|
|
2157 ;; We matched FNAME's directory equivalent.
|
|
|
2158 ancestor))))))
|
|
337
|
2159
|
|
|
2160 (defun save-buffer (&optional args)
|
|
|
2161 "Save current buffer in visited file if modified. Versions described below.
|
|
|
2162 By default, makes the previous version into a backup file
|
|
|
2163 if previously requested or if this is the first save.
|
|
13823
|
2164 With 1 \\[universal-argument], marks this version
|
|
337
|
2165 to become a backup when the next save is done.
|
|
13823
|
2166 With 2 \\[universal-argument]'s,
|
|
337
|
2167 unconditionally makes the previous version into a backup file.
|
|
13823
|
2168 With 3 \\[universal-argument]'s, marks this version
|
|
|
2169 to become a backup when the next save is done,
|
|
|
2170 and unconditionally makes the previous version into a backup file.
|
|
|
2171
|
|
337
|
2172 With argument of 0, never makes the previous version into a backup file.
|
|
|
2173
|
|
|
2174 If a file's name is FOO, the names of its numbered backup versions are
|
|
|
2175 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
|
|
|
2176 Numeric backups (rather than FOO~) will be made if value of
|
|
|
2177 `version-control' is not the atom `never' and either there are already
|
|
|
2178 numeric versions of the file being backed up, or `version-control' is
|
|
|
2179 non-nil.
|
|
|
2180 We don't want excessive versions piling up, so there are variables
|
|
|
2181 `kept-old-versions', which tells Emacs how many oldest versions to keep,
|
|
|
2182 and `kept-new-versions', which tells how many newest versions to keep.
|
|
|
2183 Defaults are 2 old versions and 2 new.
|
|
|
2184 `dired-kept-versions' controls dired's clean-directory (.) command.
|
8157
14766204c0fe
(delete-old-versions): Var renamed from trim-versions-without-asking.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2185 If `delete-old-versions' is nil, system will query user
|
|
22738
|
2186 before trimming versions. Otherwise it does it silently.
|
|
|
2187
|
|
|
2188 See the subroutine `basic-save-buffer' for more information."
|
|
337
|
2189 (interactive "p")
|
|
|
2190 (let ((modp (buffer-modified-p))
|
|
|
2191 (large (> (buffer-size) 50000))
|
|
8462
|
2192 (make-backup-files (or (and make-backup-files (not (eq args 0)))
|
|
|
2193 (memq args '(16 64)))))
|
|
337
|
2194 (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
|
|
|
2195 (if (and modp large) (message "Saving file %s..." (buffer-file-name)))
|
|
|
2196 (basic-save-buffer)
|
|
|
2197 (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
|
|
|
2198
|
|
|
2199 (defun delete-auto-save-file-if-necessary (&optional force)
|
|
|
2200 "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
|
|
|
2201 Normally delete only if the file was written by this Emacs since
|
|
|
2202 the last real save, but optional arg FORCE non-nil means delete anyway."
|
|
|
2203 (and buffer-auto-save-file-name delete-auto-save-files
|
|
|
2204 (not (string= buffer-file-name buffer-auto-save-file-name))
|
|
|
2205 (or force (recent-auto-save-p))
|
|
|
2206 (progn
|
|
|
2207 (condition-case ()
|
|
|
2208 (delete-file buffer-auto-save-file-name)
|
|
|
2209 (file-error nil))
|
|
|
2210 (set-buffer-auto-saved))))
|
|
|
2211
|
|
12963
|
2212 (defvar after-save-hook nil
|
|
|
2213 "Normal hook that is run after a buffer is saved to its file.")
|
|
|
2214
|
|
22026
|
2215 (defvar save-buffer-coding-system nil
|
|
|
2216 "If non-nil, use this coding system for saving the buffer.
|
|
|
2217 More precisely, use this coding system in place of the
|
|
|
2218 value of `buffer-file-coding-system', when saving the buffer.
|
|
|
2219 Calling `write-region' for any purpose other than saving the buffer
|
|
|
2220 will still use `buffer-file-coding-system'; this variable has no effect
|
|
|
2221 in such cases.")
|
|
|
2222
|
|
337
|
2223 (defun basic-save-buffer ()
|
|
12963
|
2224 "Save the current buffer in its visited file, if it has been modified.
|
|
22738
|
2225 The hooks `write-contents-hooks', `local-write-file-hooks' and
|
|
|
2226 `write-file-hooks' get a chance to do the job of saving; if they do not,
|
|
|
2227 then the buffer is saved in the visited file file in the usual way.
|
|
|
2228 After saving the buffer, this function runs `after-save-hook'."
|
|
337
|
2229 (interactive)
|
21071
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2230 (save-current-buffer
|
|
10298
|
2231 ;; In an indirect buffer, save its base buffer instead.
|
|
|
2232 (if (buffer-base-buffer)
|
|
|
2233 (set-buffer (buffer-base-buffer)))
|
|
|
2234 (if (buffer-modified-p)
|
|
|
2235 (let ((recent-save (recent-auto-save-p))
|
|
|
2236 setmodes tempsetmodes)
|
|
|
2237 ;; On VMS, rename file and buffer to get rid of version number.
|
|
|
2238 (if (and (eq system-type 'vax-vms)
|
|
|
2239 (not (string= buffer-file-name
|
|
|
2240 (file-name-sans-versions buffer-file-name))))
|
|
|
2241 (let (buffer-new-name)
|
|
|
2242 ;; Strip VMS version number before save.
|
|
|
2243 (setq buffer-file-name
|
|
|
2244 (file-name-sans-versions buffer-file-name))
|
|
|
2245 ;; Construct a (unique) buffer name to correspond.
|
|
|
2246 (let ((buf (create-file-buffer (downcase buffer-file-name))))
|
|
|
2247 (setq buffer-new-name (buffer-name buf))
|
|
|
2248 (kill-buffer buf))
|
|
|
2249 (rename-buffer buffer-new-name)))
|
|
|
2250 ;; If buffer has no file name, ask user for one.
|
|
|
2251 (or buffer-file-name
|
|
12895
|
2252 (let ((filename
|
|
|
2253 (expand-file-name
|
|
|
2254 (read-file-name "File to save in: ") nil)))
|
|
|
2255 (and (file-exists-p filename)
|
|
|
2256 (or (y-or-n-p (format "File `%s' exists; overwrite? "
|
|
|
2257 filename))
|
|
|
2258 (error "Canceled")))
|
|
|
2259 (set-visited-file-name filename)))
|
|
10298
|
2260 (or (verify-visited-file-modtime (current-buffer))
|
|
|
2261 (not (file-exists-p buffer-file-name))
|
|
|
2262 (yes-or-no-p
|
|
|
2263 (format "%s has changed since visited or saved. Save anyway? "
|
|
|
2264 (file-name-nondirectory buffer-file-name)))
|
|
|
2265 (error "Save not confirmed"))
|
|
|
2266 (save-restriction
|
|
|
2267 (widen)
|
21071
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2268 (save-excursion
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2269 (and (> (point-max) 1)
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2270 (/= (char-after (1- (point-max))) ?\n)
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2271 (not (and (eq selective-display t)
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2272 (= (char-after (1- (point-max))) ?\r)))
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2273 (or (eq require-final-newline t)
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2274 (and require-final-newline
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2275 (y-or-n-p
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2276 (format "Buffer %s does not end in newline. Add one? "
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2277 (buffer-name)))))
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2278 (save-excursion
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2279 (goto-char (point-max))
|
39d081df3643
(basic-save-buffer): Use save-current-buffer not save-excursion.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2280 (insert ?\n))))
|
|
10298
|
2281 (or (run-hook-with-args-until-success 'write-contents-hooks)
|
|
|
2282 (run-hook-with-args-until-success 'local-write-file-hooks)
|
|
|
2283 (run-hook-with-args-until-success 'write-file-hooks)
|
|
|
2284 ;; If a hook returned t, file is already "written".
|
|
|
2285 ;; Otherwise, write it the usual way now.
|
|
|
2286 (setq setmodes (basic-save-buffer-1)))
|
|
20093
|
2287 ;; Now we have saved the current buffer. Let's make sure
|
|
|
2288 ;; that buffer-file-coding-system is fixed to what
|
|
|
2289 ;; actually used for saving by binding it locally.
|
|
22026
|
2290 (if save-buffer-coding-system
|
|
|
2291 (setq save-buffer-coding-system last-coding-system-used)
|
|
|
2292 (setq buffer-file-coding-system last-coding-system-used))
|
|
13326
|
2293 (setq buffer-file-number
|
|
|
2294 (nthcdr 10 (file-attributes buffer-file-name)))
|
|
10298
|
2295 (if setmodes
|
|
|
2296 (condition-case ()
|
|
|
2297 (set-file-modes buffer-file-name setmodes)
|
|
|
2298 (error nil))))
|
|
|
2299 ;; If the auto-save file was recent before this command,
|
|
|
2300 ;; delete it now.
|
|
|
2301 (delete-auto-save-file-if-necessary recent-save)
|
|
12930
|
2302 ;; Support VC `implicit' locking.
|
|
|
2303 (vc-after-save)
|
|
10298
|
2304 (run-hooks 'after-save-hook))
|
|
|
2305 (message "(No changes need to be saved)"))))
|
|
337
|
2306
|
6574
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2307 ;; This does the "real job" of writing a buffer into its visited file
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2308 ;; and making a backup file. This is what is normally done
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2309 ;; but inhibited if one of write-file-hooks returns non-nil.
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2310 ;; It returns a value to store in setmodes.
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2311 (defun basic-save-buffer-1 ()
|
|
22026
|
2312 (let ((buffer-file-coding-system
|
|
|
2313 (or save-buffer-coding-system
|
|
|
2314 buffer-file-coding-system))
|
|
|
2315 tempsetmodes setmodes)
|
6574
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2316 (if (not (file-writable-p buffer-file-name))
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2317 (let ((dir (file-name-directory buffer-file-name)))
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2318 (if (not (file-directory-p dir))
|
|
18819
|
2319 (if (file-exists-p dir)
|
|
|
2320 (error "%s is not a directory" dir)
|
|
19145
|
2321 (error "%s: no such directory" buffer-file-name))
|
6574
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2322 (if (not (file-exists-p buffer-file-name))
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2323 (error "Directory %s write-protected" dir)
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2324 (if (yes-or-no-p
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2325 (format "File %s is write-protected; try to save anyway? "
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2326 (file-name-nondirectory
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2327 buffer-file-name)))
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2328 (setq tempsetmodes t)
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2329 (error "Attempt to save to a file which you aren't allowed to write"))))))
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2330 (or buffer-backed-up
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2331 (setq setmodes (backup-buffer)))
|
|
13832
|
2332 (let ((dir (file-name-directory buffer-file-name)))
|
|
8362
|
2333 (if (and file-precious-flag
|
|
|
2334 (file-writable-p dir))
|
|
|
2335 ;; If file is precious, write temp name, then rename it.
|
|
|
2336 ;; This requires write access to the containing dir,
|
|
|
2337 ;; which is why we don't try it if we don't have that access.
|
|
|
2338 (let ((realname buffer-file-name)
|
|
8937
|
2339 tempname temp nogood i succeed
|
|
|
2340 (old-modtime (visited-file-modtime)))
|
|
8362
|
2341 (setq i 0)
|
|
|
2342 (setq nogood t)
|
|
|
2343 ;; Find the temporary name to write under.
|
|
|
2344 (while nogood
|
13903
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2345 (setq tempname (format
|
|
15269
|
2346 (if (and (eq system-type 'ms-dos)
|
|
|
2347 (not (msdos-long-file-names)))
|
13903
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2348 "%s#%d.tm#" ; MSDOS limits files to 8+3
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2349 "%s#tmp#%d")
|
936c8364e15a
(abbrev-file-name): Drive letter can go beyond `Z' under MS-DOS/Novell.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2350 dir i))
|
|
8362
|
2351 (setq nogood (file-exists-p tempname))
|
|
|
2352 (setq i (1+ i)))
|
|
|
2353 (unwind-protect
|
|
|
2354 (progn (clear-visited-file-modtime)
|
|
|
2355 (write-region (point-min) (point-max)
|
|
12852
|
2356 tempname nil realname
|
|
|
2357 buffer-file-truename)
|
|
8362
|
2358 (setq succeed t))
|
|
|
2359 ;; If writing the temp file fails,
|
|
|
2360 ;; delete the temp file.
|
|
13832
|
2361 (or succeed
|
|
8937
|
2362 (progn
|
|
|
2363 (delete-file tempname)
|
|
|
2364 (set-visited-file-modtime old-modtime))))
|
|
8362
|
2365 ;; Since we have created an entirely new file
|
|
|
2366 ;; and renamed it, make sure it gets the
|
|
|
2367 ;; right permission bits set.
|
|
|
2368 (setq setmodes (file-modes buffer-file-name))
|
|
|
2369 ;; We succeeded in writing the temp file,
|
|
|
2370 ;; so rename it.
|
|
|
2371 (rename-file tempname buffer-file-name t))
|
|
|
2372 ;; If file not writable, see if we can make it writable
|
|
|
2373 ;; temporarily while we write it.
|
|
|
2374 ;; But no need to do so if we have just backed it up
|
|
|
2375 ;; (setmodes is set) because that says we're superseding.
|
|
|
2376 (cond ((and tempsetmodes (not setmodes))
|
|
|
2377 ;; Change the mode back, after writing.
|
|
|
2378 (setq setmodes (file-modes buffer-file-name))
|
|
|
2379 (set-file-modes buffer-file-name 511)))
|
|
|
2380 (write-region (point-min) (point-max)
|
|
12852
|
2381 buffer-file-name nil t buffer-file-truename)))
|
6574
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2382 setmodes))
|
f0e1ed0e82a7
(basic-save-buffer-1): New subroutine, broken out of basic-save-buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2383
|
|
337
|
2384 (defun save-some-buffers (&optional arg exiting)
|
|
|
2385 "Save some modified file-visiting buffers. Asks user about each one.
|
|
423
|
2386 Optional argument (the prefix) non-nil means save all with no questions.
|
|
|
2387 Optional second argument EXITING means ask about certain non-file buffers
|
|
|
2388 as well as about file buffers."
|
|
337
|
2389 (interactive "P")
|
|
891
|
2390 (save-window-excursion
|
|
13832
|
2391 (let* ((queried nil)
|
|
|
2392 (files-done
|
|
|
2393 (map-y-or-n-p
|
|
|
2394 (function
|
|
|
2395 (lambda (buffer)
|
|
|
2396 (and (buffer-modified-p buffer)
|
|
|
2397 (not (buffer-base-buffer buffer))
|
|
|
2398 (or
|
|
|
2399 (buffer-file-name buffer)
|
|
|
2400 (and exiting
|
|
|
2401 (progn
|
|
|
2402 (set-buffer buffer)
|
|
|
2403 (and buffer-offer-save (> (buffer-size) 0)))))
|
|
|
2404 (if arg
|
|
|
2405 t
|
|
|
2406 (setq queried t)
|
|
|
2407 (if (buffer-file-name buffer)
|
|
|
2408 (format "Save file %s? "
|
|
|
2409 (buffer-file-name buffer))
|
|
|
2410 (format "Save buffer %s? "
|
|
|
2411 (buffer-name buffer)))))))
|
|
|
2412 (function
|
|
|
2413 (lambda (buffer)
|
|
|
2414 (set-buffer buffer)
|
|
|
2415 (save-buffer)))
|
|
|
2416 (buffer-list)
|
|
|
2417 '("buffer" "buffers" "save")
|
|
|
2418 (list (list ?\C-r (lambda (buf)
|
|
18316
|
2419 (view-buffer buf
|
|
|
2420 (function
|
|
|
2421 (lambda (ignore)
|
|
|
2422 (exit-recursive-edit))))
|
|
13832
|
2423 (recursive-edit)
|
|
|
2424 ;; Return nil to ask about BUF again.
|
|
|
2425 nil)
|
|
|
2426 "display the current buffer"))))
|
|
|
2427 (abbrevs-done
|
|
|
2428 (and save-abbrevs abbrevs-changed
|
|
|
2429 (progn
|
|
|
2430 (if (or arg
|
|
|
2431 (y-or-n-p (format "Save abbrevs in %s? "
|
|
|
2432 abbrev-file-name)))
|
|
|
2433 (write-abbrev-file nil))
|
|
|
2434 ;; Don't keep bothering user if he says no.
|
|
|
2435 (setq abbrevs-changed nil)
|
|
|
2436 t))))
|
|
|
2437 (or queried (> files-done 0) abbrevs-done
|
|
5398
|
2438 (message "(No files need saving)")))))
|
|
337
|
2439
|
|
|
2440 (defun not-modified (&optional arg)
|
|
|
2441 "Mark current buffer as unmodified, not needing to be saved.
|
|
10430
|
2442 With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
|
|
|
2443
|
|
|
2444 It is not a good idea to use this function in Lisp programs, because it
|
|
|
2445 prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
|
|
337
|
2446 (interactive "P")
|
|
|
2447 (message (if arg "Modification-flag set"
|
|
|
2448 "Modification-flag cleared"))
|
|
|
2449 (set-buffer-modified-p arg))
|
|
|
2450
|
|
|
2451 (defun toggle-read-only (&optional arg)
|
|
|
2452 "Change whether this buffer is visiting its file read-only.
|
|
18316
|
2453 With arg, set read-only iff arg is positive.
|
|
|
2454 If visiting file read-only and `view-read-only' is non-nil, enter view mode."
|
|
337
|
2455 (interactive "P")
|
|
18316
|
2456 (cond
|
|
|
2457 ((and arg (if (> (prefix-numeric-value arg) 0) buffer-read-only
|
|
|
2458 (not buffer-read-only))) ; If buffer-read-only is set correctly,
|
|
|
2459 nil) ; do nothing.
|
|
|
2460 ;; Toggle.
|
|
|
2461 ((and buffer-read-only view-mode)
|
|
22338
|
2462 (View-exit-and-edit)
|
|
|
2463 (make-local-variable 'view-read-only)
|
|
|
2464 (setq view-read-only t)) ; Must leave view mode.
|
|
18316
|
2465 ((and (not buffer-read-only) view-read-only
|
|
|
2466 (not (eq (get major-mode 'mode-class) 'special)))
|
|
|
2467 (view-mode-enter))
|
|
|
2468 (t (setq buffer-read-only (not buffer-read-only))
|
|
|
2469 (force-mode-line-update))))
|
|
337
|
2470
|
|
17987
|
2471 (defun insert-file (filename)
|
|
337
|
2472 "Insert contents of file FILENAME into buffer after point.
|
|
|
2473 Set mark after the inserted text.
|
|
|
2474
|
|
|
2475 This function is meant for the user to run interactively.
|
|
|
2476 Don't call it from programs! Use `insert-file-contents' instead.
|
|
|
2477 \(Its calling sequence is different; see its documentation)."
|
|
17987
|
2478 (interactive "*fInsert file: ")
|
|
3835
|
2479 (if (file-directory-p filename)
|
|
|
2480 (signal 'file-error (list "Opening input file" "file is a directory"
|
|
|
2481 filename)))
|
|
17987
|
2482 (let ((tem (insert-file-contents filename)))
|
|
337
|
2483 (push-mark (+ (point) (car (cdr tem))))))
|
|
|
2484
|
|
17987
|
2485 (defun append-to-file (start end filename)
|
|
337
|
2486 "Append the contents of the region to the end of file FILENAME.
|
|
|
2487 When called from a function, expects three arguments,
|
|
|
2488 START, END and FILENAME. START and END are buffer positions
|
|
19435
|
2489 saying what text to write."
|
|
17987
|
2490 (interactive "r\nFAppend to file: ")
|
|
|
2491 (write-region start end filename t))
|
|
337
|
2492
|
|
|
2493 (defun file-newest-backup (filename)
|
|
|
2494 "Return most recent backup file for FILENAME or nil if no backups exist."
|
|
|
2495 (let* ((filename (expand-file-name filename))
|
|
|
2496 (file (file-name-nondirectory filename))
|
|
|
2497 (dir (file-name-directory filename))
|
|
|
2498 (comp (file-name-all-completions file dir))
|
|
14927
|
2499 (newest nil)
|
|
|
2500 tem)
|
|
337
|
2501 (while comp
|
|
14927
|
2502 (setq tem (car comp)
|
|
337
|
2503 comp (cdr comp))
|
|
14927
|
2504 (cond ((and (backup-file-name-p tem)
|
|
|
2505 (string= (file-name-sans-versions tem) file))
|
|
|
2506 (setq tem (concat dir tem))
|
|
|
2507 (if (or (null newest)
|
|
|
2508 (file-newer-than-file-p tem newest))
|
|
|
2509 (setq newest tem)))))
|
|
337
|
2510 newest))
|
|
|
2511
|
|
|
2512 (defun rename-uniquely ()
|
|
|
2513 "Rename current buffer to a similar name not already taken.
|
|
|
2514 This function is useful for creating multiple shell process buffers
|
|
|
2515 or multiple mail buffers, etc."
|
|
|
2516 (interactive)
|
|
11522
|
2517 (save-match-data
|
|
20218
|
2518 (let ((base-name (buffer-name)))
|
|
|
2519 (and (string-match "<[0-9]+>\\'" base-name)
|
|
|
2520 (not (and buffer-file-name
|
|
|
2521 (string= base-name
|
|
|
2522 (file-name-nondirectory buffer-file-name))))
|
|
|
2523 ;; If the existing buffer name has a <NNN>,
|
|
|
2524 ;; which isn't part of the file name (if any),
|
|
|
2525 ;; then get rid of that.
|
|
|
2526 (setq base-name (substring base-name 0 (match-beginning 0))))
|
|
|
2527 (rename-buffer (generate-new-buffer-name base-name))
|
|
11563
|
2528 (force-mode-line-update))))
|
|
423
|
2529
|
|
1537
|
2530 (defun make-directory (dir &optional parents)
|
|
3672
|
2531 "Create the directory DIR and any nonexistent parent dirs.
|
|
|
2532 Interactively, the default choice of directory to create
|
|
|
2533 is the current default directory for file names.
|
|
13980
|
2534 That is useful when you have visited a file in a nonexistent directory.
|
|
3672
|
2535
|
|
|
2536 Noninteractively, the second (optional) argument PARENTS says whether
|
|
|
2537 to create parent directories if they don't exist."
|
|
|
2538 (interactive
|
|
|
2539 (list (read-file-name "Make directory: " default-directory default-directory
|
|
|
2540 nil nil)
|
|
|
2541 t))
|
|
7030
|
2542 (let ((handler (find-file-name-handler dir 'make-directory)))
|
|
1537
|
2543 (if handler
|
|
|
2544 (funcall handler 'make-directory dir parents)
|
|
|
2545 (if (not parents)
|
|
|
2546 (make-directory-internal dir)
|
|
|
2547 (let ((dir (directory-file-name (expand-file-name dir)))
|
|
|
2548 create-list)
|
|
|
2549 (while (not (file-exists-p dir))
|
|
13832
|
2550 (setq create-list (cons dir create-list)
|
|
1537
|
2551 dir (directory-file-name (file-name-directory dir))))
|
|
|
2552 (while create-list
|
|
|
2553 (make-directory-internal (car create-list))
|
|
|
2554 (setq create-list (cdr create-list))))))))
|
|
337
|
2555
|
|
|
2556 (put 'revert-buffer-function 'permanent-local t)
|
|
|
2557 (defvar revert-buffer-function nil
|
|
8160
|
2558 "Function to use to revert this buffer, or nil to do the default.
|
|
|
2559 The function receives two arguments IGNORE-AUTO and NOCONFIRM,
|
|
|
2560 which are the arguments that `revert-buffer' received.")
|
|
337
|
2561
|
|
|
2562 (put 'revert-buffer-insert-file-contents-function 'permanent-local t)
|
|
|
2563 (defvar revert-buffer-insert-file-contents-function nil
|
|
|
2564 "Function to use to insert contents when reverting this buffer.
|
|
|
2565 Gets two args, first the nominal file name to use,
|
|
|
2566 and second, t if reading the auto-save file.")
|
|
|
2567
|
|
11995
|
2568 (defvar before-revert-hook nil
|
|
|
2569 "Normal hook for `revert-buffer' to run before reverting.
|
|
|
2570 If `revert-buffer-function' is used to override the normal revert
|
|
|
2571 mechanism, this hook is not used.")
|
|
|
2572
|
|
|
2573 (defvar after-revert-hook nil
|
|
|
2574 "Normal hook for `revert-buffer' to run after reverting.
|
|
|
2575 Note that the hook value that it runs is the value that was in effect
|
|
|
2576 before reverting; that makes a difference if you have buffer-local
|
|
|
2577 hook functions.
|
|
|
2578
|
|
|
2579 If `revert-buffer-function' is used to override the normal revert
|
|
|
2580 mechanism, this hook is not used.")
|
|
|
2581
|
|
13857
|
2582 (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
|
|
16544
|
2583 "Replace current buffer text with the text of the visited file on disk.
|
|
337
|
2584 This undoes all changes since the file was visited or saved.
|
|
605
|
2585 With a prefix argument, offer to revert from latest auto-save file, if
|
|
|
2586 that is more recent than the visited file.
|
|
1905
|
2587
|
|
16544
|
2588 This command also works for special buffers that contain text which
|
|
|
2589 doesn't come from a file, but reflects some other data base instead:
|
|
|
2590 for example, Dired buffers and buffer-list buffers. In these cases,
|
|
|
2591 it reconstructs the buffer contents from the appropriate data base.
|
|
|
2592
|
|
10942
|
2593 When called from Lisp, the first argument is IGNORE-AUTO; only offer
|
|
1905
|
2594 to revert from the auto-save file when this is nil. Note that the
|
|
|
2595 sense of this argument is the reverse of the prefix argument, for the
|
|
|
2596 sake of backward compatibility. IGNORE-AUTO is optional, defaulting
|
|
|
2597 to nil.
|
|
|
2598
|
|
|
2599 Optional second argument NOCONFIRM means don't ask for confirmation at
|
|
|
2600 all.
|
|
337
|
2601
|
|
15890
|
2602 Optional third argument PRESERVE-MODES non-nil means don't alter
|
|
|
2603 the files modes. Normally we reinitialize them using `normal-mode'.
|
|
|
2604
|
|
605
|
2605 If the value of `revert-buffer-function' is non-nil, it is called to
|
|
16544
|
2606 do all the work for this command. Otherwise, the hooks
|
|
|
2607 `before-revert-hook' and `after-revert-hook' are run at the beginning
|
|
|
2608 and the end, and if `revert-buffer-insert-file-contents-function' is
|
|
|
2609 non-nil, it is called instead of rereading visited file contents."
|
|
5624
|
2610
|
|
1905
|
2611 ;; I admit it's odd to reverse the sense of the prefix argument, but
|
|
|
2612 ;; there is a lot of code out there which assumes that the first
|
|
|
2613 ;; argument should be t to avoid consulting the auto-save file, and
|
|
|
2614 ;; there's no straightforward way to encourage authors to notice a
|
|
|
2615 ;; reversal of the argument sense. So I'm just changing the user
|
|
|
2616 ;; interface, but leaving the programmatic interface the same.
|
|
10847
|
2617 (interactive (list (not current-prefix-arg)))
|
|
337
|
2618 (if revert-buffer-function
|
|
1905
|
2619 (funcall revert-buffer-function ignore-auto noconfirm)
|
|
337
|
2620 (let* ((opoint (point))
|
|
1905
|
2621 (auto-save-p (and (not ignore-auto)
|
|
|
2622 (recent-auto-save-p)
|
|
337
|
2623 buffer-auto-save-file-name
|
|
|
2624 (file-readable-p buffer-auto-save-file-name)
|
|
|
2625 (y-or-n-p
|
|
|
2626 "Buffer has been auto-saved recently. Revert from auto-save file? ")))
|
|
|
2627 (file-name (if auto-save-p
|
|
|
2628 buffer-auto-save-file-name
|
|
|
2629 buffer-file-name)))
|
|
|
2630 (cond ((null file-name)
|
|
|
2631 (error "Buffer does not seem to be associated with any file"))
|
|
|
2632 ((or noconfirm
|
|
17894
|
2633 (and (not (buffer-modified-p))
|
|
|
2634 (let ((tail revert-without-query)
|
|
|
2635 (found nil))
|
|
|
2636 (while tail
|
|
|
2637 (if (string-match (car tail) file-name)
|
|
|
2638 (setq found t))
|
|
|
2639 (setq tail (cdr tail)))
|
|
|
2640 found))
|
|
337
|
2641 (yes-or-no-p (format "Revert buffer from file %s? "
|
|
|
2642 file-name)))
|
5716
82588f97d478
(revert-buffer): reposition after-revert-hook, and add before-revert-hook.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2643 (run-hooks 'before-revert-hook)
|
|
337
|
2644 ;; If file was backed up but has changed since,
|
|
|
2645 ;; we shd make another backup.
|
|
|
2646 (and (not auto-save-p)
|
|
423
|
2647 (not (verify-visited-file-modtime (current-buffer)))
|
|
337
|
2648 (setq buffer-backed-up nil))
|
|
|
2649 ;; Get rid of all undo records for this buffer.
|
|
|
2650 (or (eq buffer-undo-list t)
|
|
|
2651 (setq buffer-undo-list nil))
|
|
11982
|
2652 ;; Effectively copy the after-revert-hook status,
|
|
|
2653 ;; since after-find-file will clobber it.
|
|
|
2654 (let ((global-hook (default-value 'after-revert-hook))
|
|
|
2655 (local-hook-p (local-variable-p 'after-revert-hook))
|
|
|
2656 (local-hook (and (local-variable-p 'after-revert-hook)
|
|
|
2657 after-revert-hook)))
|
|
|
2658 (let (buffer-read-only
|
|
|
2659 ;; Don't make undo records for the reversion.
|
|
|
2660 (buffer-undo-list t))
|
|
|
2661 (if revert-buffer-insert-file-contents-function
|
|
|
2662 (funcall revert-buffer-insert-file-contents-function
|
|
|
2663 file-name auto-save-p)
|
|
|
2664 (if (not (file-exists-p file-name))
|
|
|
2665 (error "File %s no longer exists!" file-name))
|
|
|
2666 ;; Bind buffer-file-name to nil
|
|
|
2667 ;; so that we don't try to lock the file.
|
|
|
2668 (let ((buffer-file-name nil))
|
|
|
2669 (or auto-save-p
|
|
|
2670 (unlock-buffer)))
|
|
|
2671 (widen)
|
|
19552
|
2672 (let ((coding-system-for-read
|
|
|
2673 ;; Auto-saved file shoule be read without
|
|
|
2674 ;; any code conversion.
|
|
|
2675 (if auto-save-p 'no-conversion
|
|
|
2676 coding-system-for-read)))
|
|
|
2677 (insert-file-contents file-name (not auto-save-p)
|
|
|
2678 nil nil t))))
|
|
11982
|
2679 (goto-char (min opoint (point-max)))
|
|
|
2680 ;; Recompute the truename in case changes in symlinks
|
|
|
2681 ;; have changed the truename.
|
|
|
2682 (setq buffer-file-truename
|
|
|
2683 (abbreviate-file-name (file-truename buffer-file-name)))
|
|
13857
|
2684 (after-find-file nil nil t t preserve-modes)
|
|
11982
|
2685 ;; Run after-revert-hook as it was before we reverted.
|
|
|
2686 (setq-default revert-buffer-internal-hook global-hook)
|
|
|
2687 (if local-hook-p
|
|
|
2688 (progn
|
|
|
2689 (make-local-variable 'revert-buffer-internal-hook)
|
|
|
2690 (setq revert-buffer-internal-hook local-hook))
|
|
|
2691 (kill-local-variable 'revert-buffer-internal-hook))
|
|
|
2692 (run-hooks 'revert-buffer-internal-hook))
|
5716
82588f97d478
(revert-buffer): reposition after-revert-hook, and add before-revert-hook.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2693 t)))))
|
|
337
|
2694
|
|
|
2695 (defun recover-file (file)
|
|
|
2696 "Visit file FILE, but get contents from its last auto-save file."
|
|
10712
|
2697 ;; Actually putting the file name in the minibuffer should be used
|
|
|
2698 ;; only rarely.
|
|
|
2699 ;; Not just because users often use the default.
|
|
13693
|
2700 (interactive "FRecover file: ")
|
|
337
|
2701 (setq file (expand-file-name file))
|
|
5958
|
2702 (if (auto-save-file-name-p (file-name-nondirectory file))
|
|
|
2703 (error "%s is an auto-save file" file))
|
|
337
|
2704 (let ((file-name (let ((buffer-file-name file))
|
|
|
2705 (make-auto-save-file-name))))
|
|
12846
|
2706 (cond ((if (file-exists-p file)
|
|
|
2707 (not (file-newer-than-file-p file-name file))
|
|
|
2708 (not (file-exists-p file-name)))
|
|
337
|
2709 (error "Auto-save file %s not current" file-name))
|
|
|
2710 ((save-window-excursion
|
|
19680
|
2711 (if (not (memq system-type '(vax-vms windows-nt)))
|
|
337
|
2712 (with-output-to-temp-buffer "*Directory*"
|
|
|
2713 (buffer-disable-undo standard-output)
|
|
|
2714 (call-process "ls" nil standard-output nil
|
|
736
|
2715 (if (file-symlink-p file) "-lL" "-l")
|
|
|
2716 file file-name)))
|
|
337
|
2717 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
|
|
|
2718 (switch-to-buffer (find-file-noselect file t))
|
|
17004
|
2719 (let ((buffer-read-only nil)
|
|
|
2720 ;; Auto-saved file shoule be read without any code conversion.
|
|
|
2721 (coding-system-for-read 'no-conversion))
|
|
337
|
2722 (erase-buffer)
|
|
|
2723 (insert-file-contents file-name nil))
|
|
1212
|
2724 (after-find-file nil nil t))
|
|
17525
|
2725 (t (error "Recover-file cancelled")))))
|
|
337
|
2726
|
|
11739
|
2727 (defun recover-session ()
|
|
11630
|
2728 "Recover auto save files from a previous Emacs session.
|
|
|
2729 This command first displays a Dired buffer showing you the
|
|
|
2730 previous sessions that you could recover from.
|
|
|
2731 To choose one, move point to the proper line and then type C-c C-c.
|
|
|
2732 Then you'll be asked about a number of files to recover."
|
|
|
2733 (interactive)
|
|
16372
|
2734 (if (null auto-save-list-file-prefix)
|
|
|
2735 (error "You set `auto-save-list-file-prefix' to disable making session files"))
|
|
13879
|
2736 (let ((ls-lisp-support-shell-wildcards t))
|
|
17208
|
2737 (dired (concat auto-save-list-file-prefix "*")
|
|
|
2738 (concat dired-listing-switches "t")))
|
|
11630
|
2739 (goto-char (point-min))
|
|
|
2740 (or (looking-at "Move to the session you want to recover,")
|
|
|
2741 (let ((inhibit-read-only t))
|
|
12740
|
2742 (insert "Move to the session you want to recover,\n"
|
|
|
2743 "then type C-c C-c to select it.\n\n"
|
|
|
2744 "You can also delete some of these files;\n"
|
|
|
2745 "type d on a line to mark that file for deletion.\n\n")))
|
|
11630
|
2746 (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
|
|
12050
|
2747 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))
|
|
11630
|
2748
|
|
12050
|
2749 (defun recover-session-finish ()
|
|
11630
|
2750 "Choose one saved session to recover auto-save files from.
|
|
|
2751 This command is used in the special Dired buffer created by
|
|
12050
|
2752 \\[recover-session]."
|
|
11630
|
2753 (interactive)
|
|
|
2754 ;; Get the name of the session file to recover from.
|
|
|
2755 (let ((file (dired-get-filename))
|
|
13115
|
2756 files
|
|
11630
|
2757 (buffer (get-buffer-create " *recover*")))
|
|
22084
|
2758 (dired-unmark 1)
|
|
12740
|
2759 (dired-do-flagged-delete t)
|
|
11630
|
2760 (unwind-protect
|
|
|
2761 (save-excursion
|
|
|
2762 ;; Read in the auto-save-list file.
|
|
|
2763 (set-buffer buffer)
|
|
|
2764 (erase-buffer)
|
|
|
2765 (insert-file-contents file)
|
|
13115
|
2766 ;; Loop thru the text of that file
|
|
|
2767 ;; and get out the names of the files to recover.
|
|
|
2768 (while (not (eobp))
|
|
|
2769 (let (thisfile autofile)
|
|
|
2770 (if (eolp)
|
|
|
2771 ;; This is a pair of lines for a non-file-visiting buffer.
|
|
|
2772 ;; Get the auto-save file name and manufacture
|
|
|
2773 ;; a "visited file name" from that.
|
|
|
2774 (progn
|
|
|
2775 (forward-line 1)
|
|
|
2776 (setq autofile
|
|
|
2777 (buffer-substring-no-properties
|
|
|
2778 (point)
|
|
|
2779 (save-excursion
|
|
|
2780 (end-of-line)
|
|
|
2781 (point))))
|
|
|
2782 (setq thisfile
|
|
|
2783 (expand-file-name
|
|
|
2784 (substring
|
|
|
2785 (file-name-nondirectory autofile)
|
|
|
2786 1 -1)
|
|
|
2787 (file-name-directory autofile)))
|
|
|
2788 (forward-line 1))
|
|
|
2789 ;; This pair of lines is a file-visiting
|
|
|
2790 ;; buffer. Use the visited file name.
|
|
|
2791 (progn
|
|
|
2792 (setq thisfile
|
|
|
2793 (buffer-substring-no-properties
|
|
|
2794 (point) (progn (end-of-line) (point))))
|
|
|
2795 (forward-line 1)
|
|
|
2796 (setq autofile
|
|
|
2797 (buffer-substring-no-properties
|
|
|
2798 (point) (progn (end-of-line) (point))))
|
|
|
2799 (forward-line 1)))
|
|
|
2800 ;; Ignore a file if its auto-save file does not exist now.
|
|
|
2801 (if (file-exists-p autofile)
|
|
|
2802 (setq files (cons thisfile files)))))
|
|
|
2803 (setq files (nreverse files))
|
|
12846
|
2804 ;; The file contains a pair of line for each auto-saved buffer.
|
|
|
2805 ;; The first line of the pair contains the visited file name
|
|
|
2806 ;; or is empty if the buffer was not visiting a file.
|
|
|
2807 ;; The second line is the auto-save file name.
|
|
13115
|
2808 (if files
|
|
|
2809 (map-y-or-n-p "Recover %s? "
|
|
|
2810 (lambda (file)
|
|
|
2811 (condition-case nil
|
|
|
2812 (save-excursion (recover-file file))
|
|
13832
|
2813 (error
|
|
13115
|
2814 "Failed to recover `%s'" file)))
|
|
|
2815 files
|
|
|
2816 '("file" "files" "recover"))
|
|
|
2817 (message "No files can be recovered from this session now")))
|
|
11630
|
2818 (kill-buffer buffer))))
|
|
|
2819
|
|
15963
|
2820 (defun kill-some-buffers (&optional list)
|
|
|
2821 "For each buffer in LIST, ask whether to kill it.
|
|
|
2822 LIST defaults to all existing live buffers."
|
|
337
|
2823 (interactive)
|
|
15963
|
2824 (if (null list)
|
|
|
2825 (setq list (buffer-list)))
|
|
|
2826 (while list
|
|
|
2827 (let* ((buffer (car list))
|
|
|
2828 (name (buffer-name buffer)))
|
|
|
2829 (and (not (string-equal name ""))
|
|
|
2830 (/= (aref name 0) ? )
|
|
|
2831 (yes-or-no-p
|
|
|
2832 (format "Buffer %s %s. Kill? "
|
|
|
2833 name
|
|
|
2834 (if (buffer-modified-p buffer)
|
|
|
2835 "HAS BEEN EDITED" "is unmodified")))
|
|
|
2836 (kill-buffer buffer)))
|
|
|
2837 (setq list (cdr list))))
|
|
337
|
2838
|
|
|
2839 (defun auto-save-mode (arg)
|
|
|
2840 "Toggle auto-saving of contents of current buffer.
|
|
1395
|
2841 With prefix argument ARG, turn auto-saving on if positive, else off."
|
|
337
|
2842 (interactive "P")
|
|
|
2843 (setq buffer-auto-save-file-name
|
|
|
2844 (and (if (null arg)
|
|
8158
|
2845 (or (not buffer-auto-save-file-name)
|
|
|
2846 ;; If autosave is off because buffer has shrunk,
|
|
|
2847 ;; then toggling should turn it on.
|
|
|
2848 (< buffer-saved-size 0))
|
|
337
|
2849 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
|
|
|
2850 (if (and buffer-file-name auto-save-visited-file-name
|
|
|
2851 (not buffer-read-only))
|
|
|
2852 buffer-file-name
|
|
|
2853 (make-auto-save-file-name))))
|
|
6677
|
2854 ;; If -1 was stored here, to temporarily turn off saving,
|
|
|
2855 ;; turn it back on.
|
|
|
2856 (and (< buffer-saved-size 0)
|
|
|
2857 (setq buffer-saved-size 0))
|
|
337
|
2858 (if (interactive-p)
|
|
|
2859 (message "Auto-save %s (in this buffer)"
|
|
|
2860 (if buffer-auto-save-file-name "on" "off")))
|
|
|
2861 buffer-auto-save-file-name)
|
|
|
2862
|
|
|
2863 (defun rename-auto-save-file ()
|
|
|
2864 "Adjust current buffer's auto save file name for current conditions.
|
|
|
2865 Also rename any existing auto save file, if it was made in this session."
|
|
|
2866 (let ((osave buffer-auto-save-file-name))
|
|
|
2867 (setq buffer-auto-save-file-name
|
|
|
2868 (make-auto-save-file-name))
|
|
|
2869 (if (and osave buffer-auto-save-file-name
|
|
|
2870 (not (string= buffer-auto-save-file-name buffer-file-name))
|
|
|
2871 (not (string= buffer-auto-save-file-name osave))
|
|
|
2872 (file-exists-p osave)
|
|
|
2873 (recent-auto-save-p))
|
|
|
2874 (rename-file osave buffer-auto-save-file-name t))))
|
|
|
2875
|
|
|
2876 (defun make-auto-save-file-name ()
|
|
|
2877 "Return file name to use for auto-saves of current buffer.
|
|
|
2878 Does not consider `auto-save-visited-file-name' as that variable is checked
|
|
|
2879 before calling this function. You can redefine this for customization.
|
|
|
2880 See also `auto-save-file-name-p'."
|
|
|
2881 (if buffer-file-name
|
|
15269
|
2882 (if (and (eq system-type 'ms-dos)
|
|
|
2883 (not (msdos-long-file-names)))
|
|
13885
|
2884 (let ((fn (file-name-nondirectory buffer-file-name)))
|
|
19663
|
2885 (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
|
|
13885
|
2886 (concat (file-name-directory buffer-file-name)
|
|
|
2887 "#" (match-string 1 fn)
|
|
|
2888 "." (match-string 3 fn) "#"))
|
|
|
2889 (concat (file-name-directory buffer-file-name)
|
|
|
2890 "#"
|
|
|
2891 (file-name-nondirectory buffer-file-name)
|
|
|
2892 "#"))
|
7944
a114bbe9a63c
(make-auto-save-file-name): Convert slashes to \! and double the backslashes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2893
|
a114bbe9a63c
(make-auto-save-file-name): Convert slashes to \! and double the backslashes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2894 ;; Deal with buffers that don't have any associated files. (Mail
|
a114bbe9a63c
(make-auto-save-file-name): Convert slashes to \! and double the backslashes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2895 ;; mode tends to create a good number of these.)
|
a114bbe9a63c
(make-auto-save-file-name): Convert slashes to \! and double the backslashes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2896
|
7895
fac7ff0a7aeb
(make-auto-save-file-name): Don't use slashes in autosave name for a non-file
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2897 (let ((buffer-name (buffer-name))
|
7944
a114bbe9a63c
(make-auto-save-file-name): Convert slashes to \! and double the backslashes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2898 (limit 0))
|
|
17256
|
2899 ;; Eliminate all slashes and backslashes by
|
|
|
2900 ;; replacing them with sequences that start with %.
|
|
|
2901 ;; Quote % also, to keep distinct names distinct.
|
|
|
2902 (while (string-match "[/\\%]" buffer-name limit)
|
|
|
2903 (let* ((character (aref buffer-name (match-beginning 0)))
|
|
|
2904 (replacement
|
|
|
2905 (cond ((eq character ?%) "%%")
|
|
|
2906 ((eq character ?/) "%+")
|
|
|
2907 ((eq character ?\\) "%-"))))
|
|
|
2908 (setq buffer-name (replace-match replacement t t buffer-name))
|
|
|
2909 (setq limit (1+ (match-end 0)))))
|
|
16015
|
2910 ;; Generate the file name.
|
|
|
2911 (expand-file-name
|
|
|
2912 (format "#%s#%s#" buffer-name (make-temp-name ""))
|
|
|
2913 ;; Try a few alternative directories, to get one we can write it.
|
|
|
2914 (cond
|
|
|
2915 ((file-writable-p default-directory) default-directory)
|
|
|
2916 ((file-writable-p "/var/tmp/") "/var/tmp/")
|
|
|
2917 ("~/"))))))
|
|
337
|
2918
|
|
|
2919 (defun auto-save-file-name-p (filename)
|
|
|
2920 "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
|
|
|
2921 FILENAME should lack slashes. You can redefine this for customization."
|
|
|
2922 (string-match "^#.*#$" filename))
|
|
|
2923
|
|
13879
|
2924 (defun wildcard-to-regexp (wildcard)
|
|
|
2925 "Given a shell file name pattern WILDCARD, return an equivalent regexp.
|
|
|
2926 The generated regexp will match a filename iff the filename
|
|
|
2927 matches that wildcard according to shell rules. Only wildcards known
|
|
|
2928 by `sh' are supported."
|
|
|
2929 (let* ((i (string-match "[[.*+\\^$?]" wildcard))
|
|
|
2930 ;; Copy the initial run of non-special characters.
|
|
|
2931 (result (substring wildcard 0 i))
|
|
|
2932 (len (length wildcard)))
|
|
|
2933 ;; If no special characters, we're almost done.
|
|
|
2934 (if i
|
|
|
2935 (while (< i len)
|
|
|
2936 (let ((ch (aref wildcard i))
|
|
|
2937 j)
|
|
|
2938 (setq
|
|
|
2939 result
|
|
|
2940 (concat result
|
|
|
2941 (cond
|
|
16544
|
2942 ((and (eq ch ?\[)
|
|
|
2943 (< (1+ i) len)
|
|
|
2944 (eq (aref wildcard (1+ i)) ?\]))
|
|
|
2945 "\\[")
|
|
13879
|
2946 ((eq ch ?\[) ; [...] maps to regexp char class
|
|
|
2947 (progn
|
|
|
2948 (setq i (1+ i))
|
|
|
2949 (concat
|
|
|
2950 (cond
|
|
|
2951 ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
|
|
|
2952 (progn
|
|
|
2953 (setq i (1+ i))
|
|
|
2954 (if (eq (aref wildcard i) ?\])
|
|
|
2955 (progn
|
|
|
2956 (setq i (1+ i))
|
|
|
2957 "[^]")
|
|
|
2958 "[^")))
|
|
|
2959 ((eq (aref wildcard i) ?^)
|
|
|
2960 ;; Found "[^". Insert a `\0' character
|
|
|
2961 ;; (which cannot happen in a filename)
|
|
|
2962 ;; into the character class, so that `^'
|
|
|
2963 ;; is not the first character after `[',
|
|
|
2964 ;; and thus non-special in a regexp.
|
|
|
2965 (progn
|
|
|
2966 (setq i (1+ i))
|
|
|
2967 "[\000^"))
|
|
|
2968 ((eq (aref wildcard i) ?\])
|
|
|
2969 ;; I don't think `]' can appear in a
|
|
|
2970 ;; character class in a wildcard, but
|
|
|
2971 ;; let's be general here.
|
|
|
2972 (progn
|
|
|
2973 (setq i (1+ i))
|
|
|
2974 "[]"))
|
|
|
2975 (t "["))
|
|
|
2976 (prog1 ; copy everything upto next `]'.
|
|
|
2977 (substring wildcard
|
|
|
2978 i
|
|
|
2979 (setq j (string-match
|
|
|
2980 "]" wildcard i)))
|
|
|
2981 (setq i (if j (1- j) (1- len)))))))
|
|
|
2982 ((eq ch ?.) "\\.")
|
|
|
2983 ((eq ch ?*) "[^\000]*")
|
|
|
2984 ((eq ch ?+) "\\+")
|
|
|
2985 ((eq ch ?^) "\\^")
|
|
|
2986 ((eq ch ?$) "\\$")
|
|
|
2987 ((eq ch ?\\) "\\\\") ; probably cannot happen...
|
|
|
2988 ((eq ch ??) "[^\000]")
|
|
|
2989 (t (char-to-string ch)))))
|
|
|
2990 (setq i (1+ i)))))
|
|
|
2991 ;; Shell wildcards should match the entire filename,
|
|
|
2992 ;; not its part. Make the regexp say so.
|
|
|
2993 (concat "\\`" result "\\'")))
|
|
|
2994
|
|
17673
|
2995 (defcustom list-directory-brief-switches
|
|
337
|
2996 (if (eq system-type 'vax-vms) "" "-CF")
|
|
17673
|
2997 "*Switches for list-directory to pass to `ls' for brief listing,"
|
|
|
2998 :type 'string
|
|
|
2999 :group 'dired)
|
|
337
|
3000
|
|
17673
|
3001 (defcustom list-directory-verbose-switches
|
|
337
|
3002 (if (eq system-type 'vax-vms)
|
|
|
3003 "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)"
|
|
|
3004 "-l")
|
|
17673
|
3005 "*Switches for list-directory to pass to `ls' for verbose listing,"
|
|
|
3006 :type 'string
|
|
|
3007 :group 'dired)
|
|
337
|
3008
|
|
|
3009 (defun list-directory (dirname &optional verbose)
|
|
|
3010 "Display a list of files in or matching DIRNAME, a la `ls'.
|
|
|
3011 DIRNAME is globbed by the shell if necessary.
|
|
|
3012 Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
|
|
|
3013 Actions controlled by variables `list-directory-brief-switches'
|
|
|
3014 and `list-directory-verbose-switches'."
|
|
|
3015 (interactive (let ((pfx current-prefix-arg))
|
|
|
3016 (list (read-file-name (if pfx "List directory (verbose): "
|
|
|
3017 "List directory (brief): ")
|
|
|
3018 nil default-directory nil)
|
|
|
3019 pfx)))
|
|
|
3020 (let ((switches (if verbose list-directory-verbose-switches
|
|
|
3021 list-directory-brief-switches)))
|
|
|
3022 (or dirname (setq dirname default-directory))
|
|
|
3023 (setq dirname (expand-file-name dirname))
|
|
|
3024 (with-output-to-temp-buffer "*Directory*"
|
|
|
3025 (buffer-disable-undo standard-output)
|
|
|
3026 (princ "Directory ")
|
|
|
3027 (princ dirname)
|
|
|
3028 (terpri)
|
|
1109
|
3029 (save-excursion
|
|
|
3030 (set-buffer "*Directory*")
|
|
14401
|
3031 (setq default-directory
|
|
|
3032 (if (file-directory-p dirname)
|
|
|
3033 (file-name-as-directory dirname)
|
|
|
3034 (file-name-directory dirname)))
|
|
1109
|
3035 (let ((wildcard (not (file-directory-p dirname))))
|
|
|
3036 (insert-directory dirname switches wildcard (not wildcard)))))))
|
|
|
3037
|
|
|
3038 (defvar insert-directory-program "ls"
|
|
|
3039 "Absolute or relative name of the `ls' program used by `insert-directory'.")
|
|
|
3040
|
|
|
3041 ;; insert-directory
|
|
|
3042 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
|
|
|
3043 ;; FULL-DIRECTORY-P is nil.
|
|
|
3044 ;; The single line of output must display FILE's name as it was
|
|
|
3045 ;; given, namely, an absolute path name.
|
|
|
3046 ;; - must insert exactly one line for each file if WILDCARD or
|
|
|
3047 ;; FULL-DIRECTORY-P is t, plus one optional "total" line
|
|
|
3048 ;; before the file lines, plus optional text after the file lines.
|
|
|
3049 ;; Lines are delimited by "\n", so filenames containing "\n" are not
|
|
|
3050 ;; allowed.
|
|
|
3051 ;; File lines should display the basename.
|
|
|
3052 ;; - must be consistent with
|
|
|
3053 ;; - functions dired-move-to-filename, (these two define what a file line is)
|
|
|
3054 ;; dired-move-to-end-of-filename,
|
|
|
3055 ;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
|
|
|
3056 ;; dired-insert-headerline
|
|
|
3057 ;; dired-after-subdir-garbage (defines what a "total" line is)
|
|
|
3058 ;; - variable dired-subdir-regexp
|
|
|
3059 (defun insert-directory (file switches &optional wildcard full-directory-p)
|
|
4148
|
3060 "Insert directory listing for FILE, formatted according to SWITCHES.
|
|
1109
|
3061 Leaves point after the inserted text.
|
|
8207
|
3062 SWITCHES may be a string of options, or a list of strings.
|
|
1109
|
3063 Optional third arg WILDCARD means treat FILE as shell wildcard.
|
|
|
3064 Optional fourth arg FULL-DIRECTORY-P means file is a directory and
|
|
|
3065 switches do not contain `d', so that a full listing is expected.
|
|
|
3066
|
|
|
3067 This works by running a directory listing program
|
|
1892
|
3068 whose name is in the variable `insert-directory-program'.
|
|
1109
|
3069 If WILDCARD, it also runs the shell specified by `shell-file-name'."
|
|
7730
|
3070 ;; We need the directory in order to find the right handler.
|
|
|
3071 (let ((handler (find-file-name-handler (expand-file-name file)
|
|
|
3072 'insert-directory)))
|
|
1109
|
3073 (if handler
|
|
|
3074 (funcall handler 'insert-directory file switches
|
|
|
3075 wildcard full-directory-p)
|
|
337
|
3076 (if (eq system-type 'vax-vms)
|
|
1109
|
3077 (vms-read-directory file switches (current-buffer))
|
|
21041
|
3078 (let* ((coding-system-for-read
|
|
|
3079 (and enable-multibyte-characters
|
|
|
3080 (or file-name-coding-system
|
|
|
3081 default-file-name-coding-system)))
|
22179
edc72bb3a3ff
(insert-directory): When WILDCARD is nil, expand ~ if necessary.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3082 ;; This is to control encoding the arguments in call-process.
|
|
21046
|
3083 (coding-system-for-write coding-system-for-read)
|
|
21041
|
3084 (result
|
|
|
3085 (if wildcard
|
|
|
3086 ;; Run ls in the directory of the file pattern we asked for.
|
|
|
3087 (let ((default-directory
|
|
|
3088 (if (file-name-absolute-p file)
|
|
|
3089 (file-name-directory file)
|
|
|
3090 (file-name-directory (expand-file-name file))))
|
|
|
3091 (pattern (file-name-nondirectory file))
|
|
|
3092 (beg 0))
|
|
|
3093 ;; Quote some characters that have special meanings in shells;
|
|
|
3094 ;; but don't quote the wildcards--we want them to be special.
|
|
|
3095 ;; We also currently don't quote the quoting characters
|
|
|
3096 ;; in case people want to use them explicitly to quote
|
|
|
3097 ;; wildcard characters.
|
|
|
3098 (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
|
|
|
3099 (setq pattern
|
|
|
3100 (concat (substring pattern 0 (match-beginning 0))
|
|
|
3101 "\\"
|
|
|
3102 (substring pattern (match-beginning 0)))
|
|
|
3103 beg (1+ (match-end 0))))
|
|
|
3104 (call-process shell-file-name nil t nil
|
|
|
3105 "-c" (concat "\\";; Disregard shell aliases!
|
|
|
3106 insert-directory-program
|
|
|
3107 " -d "
|
|
|
3108 (if (stringp switches)
|
|
|
3109 switches
|
|
|
3110 (mapconcat 'identity switches " "))
|
|
|
3111 " -- "
|
|
21046
|
3112 pattern)))
|
|
21041
|
3113 ;; SunOS 4.1.3, SVr4 and others need the "." to list the
|
|
|
3114 ;; directory if FILE is a symbolic link.
|
|
|
3115 (apply 'call-process
|
|
|
3116 insert-directory-program nil t nil
|
|
|
3117 (let (list)
|
|
|
3118 (if (listp switches)
|
|
|
3119 (setq list switches)
|
|
|
3120 (if (not (equal switches ""))
|
|
|
3121 (progn
|
|
|
3122 ;; Split the switches at any spaces
|
|
|
3123 ;; so we can pass separate options as separate args.
|
|
|
3124 (while (string-match " " switches)
|
|
|
3125 (setq list (cons (substring switches 0 (match-beginning 0))
|
|
|
3126 list)
|
|
|
3127 switches (substring switches (match-end 0))))
|
|
|
3128 (setq list (nreverse (cons switches list))))))
|
|
|
3129 (append list
|
|
|
3130 ;; Avoid lossage if FILE starts with `-'.
|
|
|
3131 '("--")
|
22179
edc72bb3a3ff
(insert-directory): When WILDCARD is nil, expand ~ if necessary.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3132 (progn
|
edc72bb3a3ff
(insert-directory): When WILDCARD is nil, expand ~ if necessary.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3133 (if (string-match "\\`~" file)
|
edc72bb3a3ff
(insert-directory): When WILDCARD is nil, expand ~ if necessary.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3134 (setq file (expand-file-name file)))
|
edc72bb3a3ff
(insert-directory): When WILDCARD is nil, expand ~ if necessary.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3135 (list
|
edc72bb3a3ff
(insert-directory): When WILDCARD is nil, expand ~ if necessary.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3136 (if full-directory-p
|
edc72bb3a3ff
(insert-directory): When WILDCARD is nil, expand ~ if necessary.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3137 (concat (file-name-as-directory file) ".")
|
edc72bb3a3ff
(insert-directory): When WILDCARD is nil, expand ~ if necessary.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3138 file)))))))))
|
|
21041
|
3139 (if (/= result 0)
|
|
|
3140 ;; We get here if ls failed.
|
|
|
3141 ;; Access the file to get a suitable error.
|
|
|
3142 (access-file file "Reading directory")))))))
|
|
337
|
3143
|
|
6050
|
3144 (defvar kill-emacs-query-functions nil
|
|
7686
|
3145 "Functions to call with no arguments to query about killing Emacs.
|
|
10901
|
3146 If any of these functions returns nil, killing Emacs is cancelled.
|
|
|
3147 `save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
|
|
|
3148 but `kill-emacs', the low level primitive, does not.
|
|
|
3149 See also `kill-emacs-hook'.")
|
|
6050
|
3150
|
|
337
|
3151 (defun save-buffers-kill-emacs (&optional arg)
|
|
|
3152 "Offer to save each buffer, then kill this Emacs process.
|
|
|
3153 With prefix arg, silently save all file-visiting buffers, then kill."
|
|
|
3154 (interactive "P")
|
|
|
3155 (save-some-buffers arg t)
|
|
|
3156 (and (or (not (memq t (mapcar (function
|
|
|
3157 (lambda (buf) (and (buffer-file-name buf)
|
|
|
3158 (buffer-modified-p buf))))
|
|
|
3159 (buffer-list))))
|
|
|
3160 (yes-or-no-p "Modified buffers exist; exit anyway? "))
|
|
|
3161 (or (not (fboundp 'process-list))
|
|
|
3162 ;; process-list is not defined on VMS.
|
|
|
3163 (let ((processes (process-list))
|
|
|
3164 active)
|
|
|
3165 (while processes
|
|
739
|
3166 (and (memq (process-status (car processes)) '(run stop open))
|
|
337
|
3167 (let ((val (process-kill-without-query (car processes))))
|
|
|
3168 (process-kill-without-query (car processes) val)
|
|
|
3169 val)
|
|
|
3170 (setq active t))
|
|
|
3171 (setq processes (cdr processes)))
|
|
|
3172 (or (not active)
|
|
|
3173 (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
|
|
6050
|
3174 ;; Query the user for other things, perhaps.
|
|
10236
|
3175 (run-hook-with-args-until-failure 'kill-emacs-query-functions)
|
|
337
|
3176 (kill-emacs)))
|
|
|
3177
|
|
16387
|
3178 ;; We use /: as a prefix to "quote" a file name
|
|
|
3179 ;; so that magic file name handlers will not apply to it.
|
|
|
3180
|
|
|
3181 (setq file-name-handler-alist
|
|
|
3182 (cons '("\\`/:" . file-name-non-special)
|
|
|
3183 file-name-handler-alist))
|
|
|
3184
|
|
|
3185 ;; We depend on being the last handler on the list,
|
|
|
3186 ;; so that anything else which does need handling
|
|
|
3187 ;; has been handled already.
|
|
|
3188 ;; So it is safe for us to inhibit *all* magic file name handlers.
|
|
|
3189
|
|
|
3190 (defun file-name-non-special (operation &rest arguments)
|
|
|
3191 (let ((file-name-handler-alist nil)
|
|
20095
|
3192 (default-directory
|
|
|
3193 (if (eq operation 'insert-directory)
|
|
|
3194 (directory-file-name
|
|
|
3195 (expand-file-name
|
|
|
3196 (unhandled-file-name-directory default-directory)))
|
|
|
3197 default-directory))
|
|
16387
|
3198 ;; Get a list of the indices of the args which are file names.
|
|
|
3199 (file-arg-indices
|
|
|
3200 (cdr (or (assq operation
|
|
|
3201 ;; The first four are special because they
|
|
|
3202 ;; return a file name. We want to include the /:
|
|
|
3203 ;; in the return value.
|
|
|
3204 ;; So just avoid stripping it in the first place.
|
|
|
3205 '((expand-file-name . nil)
|
|
18040
|
3206 ;; `identity' means just return the first arg
|
|
|
3207 ;; as stripped of its quoting.
|
|
|
3208 (substitute-in-file-name . identity)
|
|
16387
|
3209 (file-name-directory . nil)
|
|
|
3210 (file-name-as-directory . nil)
|
|
|
3211 (directory-file-name . nil)
|
|
18164
|
3212 (file-name-completion 0 1)
|
|
|
3213 (file-name-all-completions 0 1)
|
|
16387
|
3214 (rename-file 0 1)
|
|
|
3215 (copy-file 0 1)
|
|
|
3216 (make-symbolic-link 0 1)
|
|
|
3217 (add-name-to-file 0 1)))
|
|
|
3218 ;; For all other operations, treat the first argument only
|
|
|
3219 ;; as the file name.
|
|
|
3220 '(nil 0))))
|
|
|
3221 ;; Copy ARGUMENTS so we can replace elements in it.
|
|
|
3222 (arguments (copy-sequence arguments)))
|
|
|
3223 ;; Strip off the /: from the file names that have this handler.
|
|
|
3224 (save-match-data
|
|
18040
|
3225 (while (consp file-arg-indices)
|
|
20094
|
3226 (let ((pair (nthcdr (car file-arg-indices) arguments)))
|
|
|
3227 (and (car pair)
|
|
|
3228 (string-match "\\`/:" (car pair))
|
|
|
3229 (setcar pair
|
|
|
3230 (if (= (length (car pair)) 2)
|
|
|
3231 "/"
|
|
|
3232 (substring (car pair) 2)))))
|
|
16387
|
3233 (setq file-arg-indices (cdr file-arg-indices))))
|
|
18040
|
3234 (if (eq file-arg-indices 'identity)
|
|
|
3235 (car arguments)
|
|
|
3236 (apply operation arguments))))
|
|
16387
|
3237
|
|
337
|
3238 (define-key ctl-x-map "\C-f" 'find-file)
|
|
|
3239 (define-key ctl-x-map "\C-r" 'find-file-read-only)
|
|
|
3240 (define-key ctl-x-map "\C-v" 'find-alternate-file)
|
|
|
3241 (define-key ctl-x-map "\C-s" 'save-buffer)
|
|
|
3242 (define-key ctl-x-map "s" 'save-some-buffers)
|
|
|
3243 (define-key ctl-x-map "\C-w" 'write-file)
|
|
|
3244 (define-key ctl-x-map "i" 'insert-file)
|
|
|
3245 (define-key esc-map "~" 'not-modified)
|
|
|
3246 (define-key ctl-x-map "\C-d" 'list-directory)
|
|
|
3247 (define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)
|
|
|
3248
|
|
|
3249 (define-key ctl-x-4-map "f" 'find-file-other-window)
|
|
|
3250 (define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
|
|
|
3251 (define-key ctl-x-4-map "\C-f" 'find-file-other-window)
|
|
|
3252 (define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
|
|
854
|
3253 (define-key ctl-x-4-map "\C-o" 'display-buffer)
|
|
423
|
3254
|
|
778
|
3255 (define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame)
|
|
|
3256 (define-key ctl-x-5-map "f" 'find-file-other-frame)
|
|
|
3257 (define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
|
|
|
3258 (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
|
|
662
|
3259
|
|
|
3260 ;;; files.el ends here
|
