|
428
|
1 ;;; files.el --- file input and output commands for XEmacs.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1985-1987, 1992-1995, 1997 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1995 Sun Microsystems.
|
|
1333
|
5 ;; Copyright (C) 2001, 2002, 2003 Ben Wing.
|
|
428
|
6
|
|
|
7 ;; Maintainer: XEmacs Development Team
|
|
|
8 ;; Keywords: extensions, dumped
|
|
|
9
|
|
|
10 ;; This file is part of XEmacs.
|
|
|
11
|
|
|
12 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
13 ;; under the terms of the GNU General Public License as published by
|
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;; any later version.
|
|
|
16
|
|
|
17 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
20 ;; General Public License for more details.
|
|
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
|
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
24 ;; Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA
|
|
|
25 ;; 02111-1307, USA.
|
|
|
26
|
|
1333
|
27 ;;; [[ Synched up with: FSF 20.3 (but diverging)
|
|
|
28 ;;; Warning: Merging this file is tough. Beware.]]
|
|
|
29
|
|
|
30 ;;; Beware of sync messages with 20.x or 21.x! (Unless I did them, of
|
|
|
31 ;;; course ... :-) Those who did these synchronizations did not do proper
|
|
|
32 ;;; jobs and often left out lots of changes. In practice you need to do a
|
|
|
33 ;;; line-by-line comparison, and whenever encountering differences, see
|
|
|
34 ;;; what FSF 19.34 looks like to see if the changes are intentional or just
|
|
|
35 ;;; regressions. In at least one case below, our code was unchanged from
|
|
|
36 ;;; FSF 19.30! --ben
|
|
|
37
|
|
|
38 ;;; Mostly synched to FSF 21.2 by Ben Wing using a line-by-line comparison,
|
|
|
39 ;;; except some really hard parts that have changed almost completely.
|
|
428
|
40
|
|
|
41 ;;; Commentary:
|
|
|
42
|
|
|
43 ;; This file is dumped with XEmacs.
|
|
|
44
|
|
1333
|
45 ;; BEGIN SYNC WITH FSF 21.2.
|
|
|
46
|
|
428
|
47 ;; Defines most of XEmacs's file- and directory-handling functions,
|
|
|
48 ;; including basic file visiting, backup generation, link handling,
|
|
|
49 ;; ITS-id version control, load- and write-hook handling, and the like.
|
|
|
50
|
|
|
51 ;;; Code:
|
|
|
52
|
|
|
53 ;; XEmacs: Avoid compilation warnings.
|
|
|
54 (defvar coding-system-for-read)
|
|
|
55 (defvar buffer-file-coding-system)
|
|
|
56
|
|
|
57 (defgroup files nil
|
|
|
58 "Support editing files."
|
|
|
59 :group 'emacs)
|
|
|
60
|
|
|
61 (defgroup backup nil
|
|
|
62 "Backups of edited data files."
|
|
|
63 :group 'files)
|
|
|
64
|
|
|
65 (defgroup find-file nil
|
|
|
66 "Finding and editing files."
|
|
|
67 :group 'files)
|
|
|
68
|
|
1333
|
69 ;; XEmacs: In buffer.c (also)
|
|
|
70 (defcustom delete-auto-save-files t
|
|
|
71 "*Non-nil means delete auto-save file when a buffer is saved or killed.
|
|
|
72
|
|
|
73 Note that auto-save file will not be deleted if the buffer is killed
|
|
|
74 when it has unsaved changes."
|
|
|
75 :type 'boolean
|
|
|
76 :group 'auto-save)
|
|
428
|
77
|
|
|
78 ;; FSF has automount-dir-prefix. Our directory-abbrev-alist is more general.
|
|
|
79 ;; note: tmp_mnt bogosity conversion is established in paths.el.
|
|
|
80 (defcustom directory-abbrev-alist nil
|
|
|
81 "*Alist of abbreviations for file directories.
|
|
|
82 A list of elements of the form (FROM . TO), each meaning to replace
|
|
|
83 FROM with TO when it appears in a directory name.
|
|
|
84 This replacement is done when setting up the default directory of a
|
|
|
85 newly visited file. *Every* FROM string should start with \\\\` or ^.
|
|
|
86
|
|
1333
|
87 Do not use `~' in the TO strings.
|
|
|
88 They should be ordinary absolute directory names.
|
|
|
89
|
|
428
|
90 Use this feature when you have directories which you normally refer to
|
|
|
91 via absolute symbolic links or to eliminate automounter mount points
|
|
|
92 from the beginning of your filenames. Make TO the name of the link,
|
|
|
93 and FROM the name it is linked to."
|
|
|
94 :type '(repeat (cons :format "%v"
|
|
|
95 :value ("\\`" . "")
|
|
|
96 (regexp :tag "From")
|
|
|
97 (regexp :tag "To")))
|
|
|
98 :group 'find-file)
|
|
|
99
|
|
|
100 (defcustom make-backup-files t
|
|
|
101 "*Non-nil means make a backup of a file the first time it is saved.
|
|
|
102 This can be done by renaming the file or by copying.
|
|
|
103
|
|
|
104 Renaming means that XEmacs renames the existing file so that it is a
|
|
|
105 backup file, then writes the buffer into a new file. Any other names
|
|
|
106 that the old file had will now refer to the backup file. The new file
|
|
|
107 is owned by you and its group is defaulted.
|
|
|
108
|
|
|
109 Copying means that XEmacs copies the existing file into the backup
|
|
|
110 file, then writes the buffer on top of the existing file. Any other
|
|
|
111 names that the old file had will now refer to the new (edited) file.
|
|
|
112 The file's owner and group are unchanged.
|
|
|
113
|
|
|
114 The choice of renaming or copying is controlled by the variables
|
|
|
115 `backup-by-copying', `backup-by-copying-when-linked' and
|
|
1333
|
116 `backup-by-copying-when-mismatch' and
|
|
|
117 `backup-by-copying-when-privileged-mismatch'. See also `backup-inhibited'."
|
|
428
|
118 :type 'boolean
|
|
|
119 :group 'backup)
|
|
|
120
|
|
|
121 ;; Do this so that local variables based on the file name
|
|
|
122 ;; are not overridden by the major mode.
|
|
|
123 (defvar backup-inhibited nil
|
|
|
124 "Non-nil means don't make a backup, regardless of the other parameters.
|
|
|
125 This variable is intended for use by making it local to a buffer.
|
|
|
126 But it is local only if you make it local.")
|
|
|
127 (put 'backup-inhibited 'permanent-local t)
|
|
|
128
|
|
|
129 (defcustom backup-by-copying nil
|
|
|
130 "*Non-nil means always use copying to create backup files.
|
|
|
131 See documentation of variable `make-backup-files'."
|
|
|
132 :type 'boolean
|
|
|
133 :group 'backup)
|
|
|
134
|
|
|
135 (defcustom backup-by-copying-when-linked nil
|
|
|
136 "*Non-nil means use copying to create backups for files with multiple names.
|
|
|
137 This causes the alternate names to refer to the latest version as edited.
|
|
|
138 This variable is relevant only if `backup-by-copying' is nil."
|
|
|
139 :type 'boolean
|
|
|
140 :group 'backup)
|
|
|
141
|
|
|
142 (defcustom backup-by-copying-when-mismatch nil
|
|
|
143 "*Non-nil means create backups by copying if this preserves owner or group.
|
|
|
144 Renaming may still be used (subject to control of other variables)
|
|
|
145 when it would not result in changing the owner or group of the file;
|
|
|
146 that is, for files which are owned by you and whose group matches
|
|
|
147 the default for a new file created there by you.
|
|
|
148 This variable is relevant only if `backup-by-copying' is nil."
|
|
|
149 :type 'boolean
|
|
|
150 :group 'backup)
|
|
|
151
|
|
1333
|
152 (defcustom backup-by-copying-when-privileged-mismatch 200
|
|
|
153 "*Non-nil means create backups by copying to preserve a privileged owner.
|
|
|
154 Renaming may still be used (subject to control of other variables)
|
|
|
155 when it would not result in changing the owner of the file or if the owner
|
|
|
156 has a user id greater than the value of this variable. This is useful
|
|
|
157 when low-numbered uid's are used for special system users (such as root)
|
|
|
158 that must maintain ownership of certain files.
|
|
|
159 This variable is relevant only if `backup-by-copying' and
|
|
|
160 `backup-by-copying-when-mismatch' are nil."
|
|
|
161 :type '(choice (const nil) integer)
|
|
|
162 :group 'backup)
|
|
|
163
|
|
|
164 (defun normal-backup-enable-predicate (name)
|
|
|
165 "Default `backup-enable-predicate' function.
|
|
4266
|
166 Checks for files in the directory returned by `temp-directory' or specified
|
|
|
167 by `small-temporary-file-directory'."
|
|
1333
|
168 (let ((temporary-file-directory (temp-directory)))
|
|
|
169 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
|
|
|
170 name 0 nil)))
|
|
|
171 ;; Directory is under temporary-file-directory.
|
|
|
172 (and (not (eq comp t))
|
|
|
173 (< comp (- (length temporary-file-directory)))))
|
|
|
174 (if small-temporary-file-directory
|
|
|
175 (let ((comp (compare-strings small-temporary-file-directory
|
|
|
176 0 nil
|
|
|
177 name 0 nil)))
|
|
|
178 ;; Directory is under small-temporary-file-directory.
|
|
|
179 (and (not (eq comp t))
|
|
|
180 (< comp (- (length small-temporary-file-directory))))))))))
|
|
|
181
|
|
|
182 (defvar backup-enable-predicate 'normal-backup-enable-predicate
|
|
428
|
183 "Predicate that looks at a file name and decides whether to make backups.
|
|
|
184 Called with an absolute file name as argument, it returns t to enable backup.")
|
|
|
185
|
|
|
186 (defcustom buffer-offer-save nil
|
|
1333
|
187 "*Non-nil in a buffer means always offer to save buffer on exit.
|
|
|
188 Do so even if the buffer is not visiting a file.
|
|
428
|
189 Automatically local in all buffers."
|
|
|
190 :type 'boolean
|
|
|
191 :group 'find-file)
|
|
|
192 (make-variable-buffer-local 'buffer-offer-save)
|
|
|
193
|
|
|
194 ;; FSF uses normal defconst
|
|
|
195 (defvaralias 'find-file-visit-truename 'find-file-use-truenames)
|
|
|
196 (defvaralias 'find-file-existing-other-name 'find-file-compare-truenames)
|
|
|
197
|
|
|
198 (defcustom revert-without-query nil
|
|
|
199 "*Specify which files should be reverted without query.
|
|
|
200 The value is a list of regular expressions.
|
|
|
201 If the file name matches one of these regular expressions,
|
|
|
202 then `revert-buffer' reverts the file without querying
|
|
|
203 if the file has changed on disk and you have not edited the buffer."
|
|
|
204 :type '(repeat (regexp ""))
|
|
|
205 :group 'find-file)
|
|
|
206
|
|
|
207 (defvar buffer-file-number nil
|
|
|
208 "The device number and file number of the file visited in the current buffer.
|
|
|
209 The value is a list of the form (FILENUM DEVNUM).
|
|
|
210 This pair of numbers uniquely identifies the file.
|
|
|
211 If the buffer is visiting a new file, the value is nil.")
|
|
|
212 (make-variable-buffer-local 'buffer-file-number)
|
|
|
213 (put 'buffer-file-number 'permanent-local t)
|
|
|
214
|
|
|
215 (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
|
|
|
216 "Non-nil means that buffer-file-number uniquely identifies files.")
|
|
|
217
|
|
1333
|
218 ;; FSF 21.2. We use (temp-directory).
|
|
|
219 ; (defvar temporary-file-directory
|
|
|
220 ; (file-name-as-directory
|
|
|
221 ; (cond ((memq system-type '(ms-dos windows-nt))
|
|
|
222 ; (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
|
|
|
223 ; ((memq system-type '(vax-vms axp-vms))
|
|
|
224 ; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
|
|
|
225 ; (t
|
|
|
226 ; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
|
|
|
227 ; "The directory for writing temporary files.")
|
|
|
228
|
|
|
229 (defvar small-temporary-file-directory
|
|
|
230 (if (eq system-type 'ms-dos) (getenv "TMPDIR"))
|
|
|
231 "The directory for writing small temporary files.
|
|
|
232 If non-nil, this directory is used instead of `temporary-file-directory'
|
|
|
233 by programs that create small temporary files. This is for systems that
|
|
|
234 have fast storage with limited space, such as a RAM disk.")
|
|
|
235
|
|
|
236 ; (defvar file-name-invalid-regexp
|
|
|
237 ; (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
|
|
|
238 ; (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
|
|
|
239 ; "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters
|
|
|
240 ; "[\000-\031]\\|" ; control characters
|
|
|
241 ; "\\(/\\.\\.?[^/]\\)\\|" ; leading dots
|
|
|
242 ; "\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot
|
|
|
243 ; ((memq system-type '(ms-dos windows-nt))
|
|
|
244 ; (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
|
|
|
245 ; "[|<>\"?*\000-\031]")) ; invalid characters
|
|
|
246 ; (t "[\000]"))
|
|
|
247 ; "Regexp recognizing file names which aren't allowed by the filesystem.")
|
|
|
248
|
|
428
|
249 (defcustom file-precious-flag nil
|
|
|
250 "*Non-nil means protect against I/O errors while saving files.
|
|
|
251 Some modes set this non-nil in particular buffers.
|
|
|
252
|
|
|
253 This feature works by writing the new contents into a temporary file
|
|
|
254 and then renaming the temporary file to replace the original.
|
|
|
255 In this way, any I/O error in writing leaves the original untouched,
|
|
|
256 and there is never any instant where the file is nonexistent.
|
|
|
257
|
|
|
258 Note that this feature forces backups to be made by copying.
|
|
|
259 Yet, at the same time, saving a precious file
|
|
|
260 breaks any hard links between it and other files."
|
|
|
261 :type 'boolean
|
|
|
262 :group 'backup)
|
|
|
263
|
|
|
264 (defcustom version-control nil
|
|
|
265 "*Control use of version numbers for backup files.
|
|
|
266 t means make numeric backup versions unconditionally.
|
|
|
267 nil means make them for files that have some already.
|
|
|
268 `never' means do not make them."
|
|
1333
|
269 :type '(choice (const :tag "Never" never)
|
|
|
270 (const :tag "If existing" nil)
|
|
|
271 (other :tag "Always" t))
|
|
428
|
272 :group 'backup
|
|
|
273 :group 'vc)
|
|
|
274
|
|
|
275 ;; This is now defined in efs.
|
|
1333
|
276 ; (defcustom dired-kept-versions 2
|
|
|
277 ; "*When cleaning directory, number of versions to keep."
|
|
|
278 ; :type 'integer
|
|
|
279 ; :group 'backup
|
|
|
280 ; :group 'dired)
|
|
428
|
281
|
|
2103
|
282 (defcustom delete-old-versions (when noninteractive 'leave)
|
|
428
|
283 "*If t, delete excess backup versions silently.
|
|
|
284 If nil, ask confirmation. Any other value prevents any trimming."
|
|
|
285 :type '(choice (const :tag "Delete" t)
|
|
|
286 (const :tag "Ask" nil)
|
|
|
287 (sexp :tag "Leave" :format "%t\n" other))
|
|
|
288 :group 'backup)
|
|
|
289
|
|
|
290 (defcustom kept-old-versions 2
|
|
|
291 "*Number of oldest versions to keep when a new numbered backup is made."
|
|
|
292 :type 'integer
|
|
|
293 :group 'backup)
|
|
|
294
|
|
|
295 (defcustom kept-new-versions 2
|
|
|
296 "*Number of newest versions to keep when a new numbered backup is made.
|
|
|
297 Includes the new backup. Must be > 0"
|
|
|
298 :type 'integer
|
|
|
299 :group 'backup)
|
|
|
300
|
|
|
301 (defcustom require-final-newline nil
|
|
|
302 "*Value of t says silently ensure a file ends in a newline when it is saved.
|
|
|
303 Non-nil but not t says ask user whether to add a newline when there isn't one.
|
|
|
304 nil means don't add newlines."
|
|
|
305 :type '(choice (const :tag "Off" nil)
|
|
|
306 (const :tag "Add" t)
|
|
|
307 (sexp :tag "Ask" :format "%t\n" ask))
|
|
|
308 :group 'editing-basics)
|
|
|
309
|
|
|
310 (defcustom auto-save-default t
|
|
|
311 "*Non-nil says by default do auto-saving of every file-visiting buffer."
|
|
|
312 :type 'boolean
|
|
|
313 :group 'auto-save)
|
|
|
314
|
|
|
315 (defcustom auto-save-visited-file-name nil
|
|
|
316 "*Non-nil says auto-save a buffer in the file it is visiting, when practical.
|
|
|
317 Normally auto-save files are written under other names."
|
|
|
318 :type 'boolean
|
|
|
319 :group 'auto-save)
|
|
|
320
|
|
1333
|
321 (defcustom auto-save-file-name-transforms
|
|
|
322 `(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)"
|
|
|
323 ,(expand-file-name "\\2" (temp-directory))))
|
|
|
324 "*Transforms to apply to buffer file name before making auto-save file name.
|
|
|
325 Each transform is a list (REGEXP REPLACEMENT):
|
|
|
326 REGEXP is a regular expression to match against the file name.
|
|
|
327 If it matches, `replace-match' is used to replace the
|
|
|
328 matching part with REPLACEMENT.
|
|
|
329 All the transforms in the list are tried, in the order they are listed.
|
|
|
330 When one transform applies, its result is final;
|
|
|
331 no further transforms are tried.
|
|
|
332
|
|
4266
|
333 The default value is set up to put the auto-save file into the temporary
|
|
|
334 directory (see the function `temp-directory') for editing a remote file."
|
|
1333
|
335 :group 'auto-save
|
|
|
336 :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")))
|
|
|
337 ;:version "21.1"
|
|
|
338 )
|
|
|
339
|
|
428
|
340 (defcustom save-abbrevs nil
|
|
1333
|
341 "*Non-nil means save word abbrevs too when files are saved.
|
|
|
342 If `silently', don't ask the user before saving.
|
|
1337
|
343 Loading an abbrev file sets this to t."
|
|
1333
|
344 :type '(choice (const t) (const nil) (const silently))
|
|
1337
|
345 :group 'abbrev)
|
|
|
346
|
|
428
|
347 (defcustom find-file-run-dired t
|
|
1333
|
348 "*Non-nil means allow `find-file' to visit directories.
|
|
|
349 To visit the directory, `find-file' runs `find-directory-functions'."
|
|
|
350 :type 'boolean
|
|
|
351 :group 'find-file)
|
|
|
352
|
|
|
353 (defcustom find-directory-functions '(cvs-dired-noselect dired-noselect)
|
|
|
354 "*List of functions to try in sequence to visit a directory.
|
|
|
355 Each function is called with the directory name as the sole argument
|
|
|
356 and should return either a buffer or nil."
|
|
|
357 :type '(hook :options (cvs-dired-noselect dired-noselect))
|
|
428
|
358 :group 'find-file)
|
|
|
359
|
|
|
360 ;;;It is not useful to make this a local variable.
|
|
|
361 ;;;(put 'find-file-not-found-hooks 'permanent-local t)
|
|
|
362 (defvar find-file-not-found-hooks nil
|
|
|
363 "List of functions to be called for `find-file' on nonexistent file.
|
|
|
364 These functions are called as soon as the error is detected.
|
|
1333
|
365 Variable `buffer-file-name' is already set up.
|
|
428
|
366 The functions are called in the order given until one of them returns non-nil.")
|
|
|
367
|
|
|
368 ;;;It is not useful to make this a local variable.
|
|
|
369 ;;;(put 'find-file-hooks 'permanent-local t)
|
|
|
370 (defvar find-file-hooks nil
|
|
|
371 "List of functions to be called after a buffer is loaded from a file.
|
|
|
372 The buffer's local variables (if any) will have been processed before the
|
|
|
373 functions are called.")
|
|
|
374
|
|
|
375 (defvar write-file-hooks nil
|
|
|
376 "List of functions to be called before writing out a buffer to a file.
|
|
|
377 If one of them returns non-nil, the file is considered already written
|
|
|
378 and the rest are not called.
|
|
|
379 These hooks are considered to pertain to the visited file.
|
|
1333
|
380 So any buffer-local binding of `write-file-hooks' is
|
|
|
381 discarded if you change the visited file name with \\[set-visited-file-name].
|
|
|
382
|
|
|
383 Don't make this variable buffer-local; instead, use `local-write-file-hooks'.
|
|
428
|
384 See also `write-contents-hooks' and `continue-save-buffer'.")
|
|
|
385 ;;; However, in case someone does make it local...
|
|
|
386 (put 'write-file-hooks 'permanent-local t)
|
|
|
387
|
|
|
388 (defvar local-write-file-hooks nil
|
|
|
389 "Just like `write-file-hooks', except intended for per-buffer use.
|
|
|
390 The functions in this list are called before the ones in
|
|
|
391 `write-file-hooks'.
|
|
|
392
|
|
|
393 This variable is meant to be used for hooks that have to do with a
|
|
|
394 particular visited file. Therefore, it is a permanent local, so that
|
|
|
395 changing the major mode does not clear it. However, calling
|
|
|
396 `set-visited-file-name' does clear it.")
|
|
|
397 (make-variable-buffer-local 'local-write-file-hooks)
|
|
|
398 (put 'local-write-file-hooks 'permanent-local t)
|
|
|
399
|
|
|
400
|
|
|
401 ;; #### think about this (added by Sun).
|
|
|
402 (put 'after-set-visited-file-name-hooks 'permanent-local t)
|
|
|
403 (defvar after-set-visited-file-name-hooks nil
|
|
|
404 "List of functions to be called after \\[set-visited-file-name]
|
|
|
405 or during \\[write-file].
|
|
444
|
406 You can use this hook to restore local values of `write-file-hooks',
|
|
|
407 `after-save-hook', and `revert-buffer-function', which pertain
|
|
428
|
408 to a specific file and therefore are normally killed by a rename.
|
|
444
|
409 Put hooks pertaining to the buffer contents on `write-contents-hooks'
|
|
|
410 and `revert-buffer-insert-file-contents-function'.")
|
|
428
|
411
|
|
|
412 (defvar write-contents-hooks nil
|
|
|
413 "List of functions to be called before writing out a buffer to a file.
|
|
|
414 If one of them returns non-nil, the file is considered already written
|
|
|
415 and the rest are not called.
|
|
1333
|
416
|
|
|
417 This variable is meant to be used for hooks that pertain to the
|
|
|
418 buffer's contents, not to the particular visited file; thus,
|
|
|
419 `set-visited-file-name' does not clear this variable; but changing the
|
|
|
420 major mode does clear it.
|
|
|
421
|
|
|
422 This variable automatically becomes buffer-local whenever it is set.
|
|
|
423 If you use `add-hook' to add elements to the list, use nil for the
|
|
|
424 LOCAL argument.
|
|
|
425
|
|
428
|
426 See also `write-file-hooks' and `continue-save-buffer'.")
|
|
1333
|
427 (make-variable-buffer-local 'write-contents-hooks)
|
|
428
|
428
|
|
|
429 ;; XEmacs addition
|
|
|
430 ;; Energize needed this to hook into save-buffer at a lower level; we need
|
|
|
431 ;; to provide a new output method, but don't want to have to duplicate all
|
|
|
432 ;; of the backup file and file modes logic.that does not occur if one uses
|
|
|
433 ;; a write-file-hook which returns non-nil.
|
|
|
434 (put 'write-file-data-hooks 'permanent-local t)
|
|
|
435 (defvar write-file-data-hooks nil
|
|
|
436 "List of functions to be called to put the bytes on disk.
|
|
|
437 These functions receive the name of the file to write to as argument.
|
|
|
438 The default behavior is to call
|
|
|
439 (write-region (point-min) (point-max) filename nil t)
|
|
|
440 If one of them returns non-nil, the file is considered already written
|
|
|
441 and the rest are not called.
|
|
|
442 These hooks are considered to pertain to the visited file.
|
|
1333
|
443 So any buffer-local binding of `write-file-data-hooks' is
|
|
|
444 discarded if you change the visited file name with \\[set-visited-file-name].
|
|
428
|
445 See also `write-file-hooks'.")
|
|
|
446
|
|
|
447 (defcustom enable-local-variables t
|
|
1333
|
448 "*Control use of local variables in files you visit.
|
|
428
|
449 The value can be t, nil or something else.
|
|
1333
|
450 A value of t means file local variables specifications are obeyed;
|
|
428
|
451 nil means they are ignored; anything else means query.
|
|
1333
|
452 This variable also controls use of major modes specified in
|
|
|
453 a -*- line.
|
|
|
454
|
|
|
455 The command \\[normal-mode], when used interactively,
|
|
|
456 always obeys file local variable specifications and the -*- line,
|
|
428
|
457 and ignores this variable."
|
|
|
458 :type '(choice (const :tag "Obey" t)
|
|
|
459 (const :tag "Ignore" nil)
|
|
|
460 (sexp :tag "Query" :format "%t\n" other))
|
|
|
461 :group 'find-file)
|
|
|
462
|
|
1333
|
463 ; (defvar local-enable-local-variables t
|
|
|
464 ; "Like `enable-local-variables' but meant for buffer-local bindings.
|
|
|
465 ; The meaningful values are nil and non-nil. The default is non-nil.
|
|
|
466 ; If a major mode sets this to nil, buffer-locally, then any local
|
|
|
467 ; variables list in the file will be ignored.
|
|
|
468
|
|
|
469 ; This variable does not affect the use of major modes
|
|
|
470 ; specified in a -*- line.")
|
|
|
471
|
|
428
|
472 (defcustom enable-local-eval 'maybe
|
|
|
473 "*Control processing of the \"variable\" `eval' in a file's local variables.
|
|
|
474 The value can be t, nil or something else.
|
|
|
475 A value of t means obey `eval' variables;
|
|
|
476 nil means ignore them; anything else means query.
|
|
|
477
|
|
|
478 The command \\[normal-mode] always obeys local-variables lists
|
|
|
479 and ignores this variable."
|
|
|
480 :type '(choice (const :tag "Obey" t)
|
|
|
481 (const :tag "Ignore" nil)
|
|
|
482 (sexp :tag "Query" :format "%t\n" other))
|
|
|
483 :group 'find-file)
|
|
|
484
|
|
|
485 ;; Avoid losing in versions where CLASH_DETECTION is disabled.
|
|
|
486 (or (fboundp 'lock-buffer)
|
|
|
487 (defalias 'lock-buffer 'ignore))
|
|
|
488 (or (fboundp 'unlock-buffer)
|
|
|
489 (defalias 'unlock-buffer 'ignore))
|
|
1333
|
490 (or (fboundp 'file-locked-p)
|
|
|
491 (defalias 'file-locked-p 'ignore))
|
|
|
492
|
|
|
493 (defvar view-read-only nil
|
|
|
494 "*Non-nil means buffers visiting files read-only, do it in view mode.")
|
|
428
|
495
|
|
|
496 ;;FSFmacs bastardized ange-ftp cruft
|
|
|
497 ;(defun ange-ftp-completion-hook-function (op &rest args)
|
|
1333
|
498 ; "Provides support for ange-ftp host name completion.
|
|
|
499 ;Runs the usual ange-ftp hook, but only for completion operations."
|
|
|
500 ; ;; Having this here avoids the need to load ange-ftp when it's not
|
|
|
501 ; ;; really in use.
|
|
428
|
502 ; (if (memq op '(file-name-completion file-name-all-completions))
|
|
|
503 ; (apply 'ange-ftp-hook-function op args)
|
|
|
504 ; (let ((inhibit-file-name-handlers
|
|
|
505 ; (cons 'ange-ftp-completion-hook-function
|
|
|
506 ; (and (eq inhibit-file-name-operation op)
|
|
|
507 ; inhibit-file-name-handlers)))
|
|
|
508 ; (inhibit-file-name-operation op))
|
|
|
509 ; (apply op args))
|
|
|
510
|
|
1333
|
511 ;; FSF 21.2:
|
|
|
512 ;This function's standard definition is trivial; it just returns the argument.
|
|
|
513 ;However, on some systems, the function is redefined with a definition
|
|
|
514 ;that really does change some file names to canonicalize certain
|
|
|
515 ;patterns and to guarantee valid names."
|
|
428
|
516 (defun convert-standard-filename (filename)
|
|
464
|
517 "Convert a standard file's name to something suitable for the current OS."
|
|
|
518 (if (eq system-type 'windows-nt)
|
|
|
519 (let ((name (copy-sequence filename))
|
|
|
520 (start 0))
|
|
|
521 ;; leave ':' if part of drive specifier
|
|
819
|
522 (if (and (> (length name) 1)
|
|
|
523 (eq (aref name 1) ?:))
|
|
464
|
524 (setq start 2))
|
|
|
525 ;; destructively replace invalid filename characters with !
|
|
|
526 (while (string-match "[?*:<>|\"\000-\037]" name start)
|
|
|
527 (aset name (match-beginning 0) ?!)
|
|
|
528 (setq start (match-end 0)))
|
|
|
529 ;; FSF: [convert directory separators to Windows format ...]
|
|
|
530 ;; unneeded in XEmacs.
|
|
|
531 name)
|
|
|
532 filename))
|
|
|
533
|
|
428
|
534
|
|
|
535 (defun pwd ()
|
|
|
536 "Show the current default directory."
|
|
|
537 (interactive nil)
|
|
|
538 (message "Directory %s" default-directory))
|
|
|
539
|
|
|
540 (defvar cd-path nil
|
|
|
541 "Value of the CDPATH environment variable, as a list.
|
|
|
542 Not actually set up until the first time you use it.")
|
|
|
543
|
|
|
544 (defvar cdpath-previous nil
|
|
|
545 "Prior value of the CDPATH environment variable.")
|
|
|
546
|
|
|
547 (defun parse-colon-path (cd-path)
|
|
|
548 "Explode a colon-separated search path into a list of directory names.
|
|
|
549
|
|
|
550 If you think you want to use this, you probably don't. This function
|
|
|
551 is provided for backward compatibility. A more robust implementation
|
|
|
552 of the same functionality is available as `split-path', which see."
|
|
|
553 (and cd-path
|
|
|
554 (let (cd-list (cd-start 0) cd-colon)
|
|
|
555 (setq cd-path (concat cd-path path-separator))
|
|
|
556 (while (setq cd-colon (string-match path-separator cd-path cd-start))
|
|
|
557 (setq cd-list
|
|
|
558 (nconc cd-list
|
|
|
559 (list (if (= cd-start cd-colon)
|
|
|
560 nil
|
|
|
561 (substitute-in-file-name
|
|
|
562 (file-name-as-directory
|
|
|
563 (substring cd-path cd-start cd-colon)))))))
|
|
|
564 (setq cd-start (+ cd-colon 1)))
|
|
|
565 cd-list)))
|
|
|
566
|
|
|
567 (defun cd-absolute (dir)
|
|
|
568 "Change current directory to given absolute file name DIR."
|
|
|
569 ;; Put the name into directory syntax now,
|
|
|
570 ;; because otherwise expand-file-name may give some bad results.
|
|
|
571 (setq dir (file-name-as-directory dir))
|
|
|
572 ;; XEmacs change: stig@hackvan.com
|
|
|
573 (if find-file-use-truenames
|
|
|
574 (setq dir (file-truename dir)))
|
|
|
575 (setq dir (abbreviate-file-name (expand-file-name dir)))
|
|
|
576 (cond ((not (file-directory-p dir))
|
|
1333
|
577 (if (file-exists-p dir)
|
|
|
578 (error "%s is not a directory" dir)
|
|
|
579 (error "%s: no such directory" dir)))
|
|
428
|
580 ;; this breaks ange-ftp, which doesn't (can't?) overload `file-executable-p'.
|
|
|
581 ;;((not (file-executable-p dir))
|
|
|
582 ;; (error "Cannot cd to %s: Permission denied" dir))
|
|
|
583 (t
|
|
|
584 (setq default-directory dir))))
|
|
|
585
|
|
|
586 (defun cd (dir)
|
|
|
587 "Make DIR become the current buffer's default directory.
|
|
|
588 If your environment includes a `CDPATH' variable, try each one of that
|
|
|
589 colon-separated list of directories when resolving a relative directory name."
|
|
|
590 (interactive
|
|
|
591 ;; XEmacs change? (read-file-name => read-directory-name)
|
|
|
592 (list (read-directory-name "Change default directory: "
|
|
|
593 default-directory default-directory
|
|
|
594 (and (member cd-path '(nil ("./")))
|
|
|
595 (null (getenv "CDPATH"))))))
|
|
|
596 (if (file-name-absolute-p dir)
|
|
|
597 (cd-absolute (expand-file-name dir))
|
|
|
598 ;; XEmacs
|
|
|
599 (unless (and cd-path (equal (getenv "CDPATH") cdpath-previous))
|
|
|
600 ;;#### Unix-specific
|
|
|
601 (let ((trypath (parse-colon-path
|
|
|
602 (setq cdpath-previous (getenv "CDPATH")))))
|
|
|
603 (setq cd-path (or trypath (list "./")))))
|
|
|
604 (or (catch 'found
|
|
|
605 (mapcar #'(lambda (x)
|
|
|
606 (let ((f (expand-file-name (concat x dir))))
|
|
|
607 (if (file-directory-p f)
|
|
|
608 (progn
|
|
|
609 (cd-absolute f)
|
|
|
610 (throw 'found t)))))
|
|
|
611 cd-path)
|
|
|
612 nil)
|
|
|
613 ;; jwz: give a better error message to those of us with the
|
|
|
614 ;; good taste not to use a kludge like $CDPATH.
|
|
|
615 (if (equal cd-path '("./"))
|
|
|
616 (error "No such directory: %s" (expand-file-name dir))
|
|
|
617 (error "Directory not found in $CDPATH: %s" dir)))))
|
|
|
618
|
|
|
619 (defun load-file (file)
|
|
|
620 "Load the Lisp file named FILE."
|
|
1333
|
621 ;; This is a case where .elc makes a lot of sense.
|
|
|
622 (interactive (list (let ((completion-ignored-extensions
|
|
|
623 (remove ".elc" completion-ignored-extensions)))
|
|
|
624 (read-file-name "Load file: "))))
|
|
428
|
625 (load (expand-file-name file) nil nil t))
|
|
|
626
|
|
|
627 ; We now dump utils/lib-complete.el which has improved versions of this.
|
|
|
628 ;(defun load-library (library)
|
|
|
629 ; "Load the library named LIBRARY.
|
|
|
630 ;This is an interface to the function `load'."
|
|
|
631 ; (interactive "sLoad library: ")
|
|
|
632 ; (load library))
|
|
|
633 ;
|
|
|
634 ;(defun find-library (library)
|
|
|
635 ; "Find the library of Lisp code named LIBRARY.
|
|
|
636 ;This searches `load-path' for a file named either \"LIBRARY\" or \"LIBRARY.el\"."
|
|
|
637 ; (interactive "sFind library file: ")
|
|
|
638 ; (let ((f (locate-file library load-path ":.el:")))
|
|
|
639 ; (if f
|
|
|
640 ; (find-file f)
|
|
|
641 ; (error "Couldn't locate library %s" library))))
|
|
|
642
|
|
1333
|
643 (defun file-local-copy (file)
|
|
428
|
644 "Copy the file FILE into a temporary file on this machine.
|
|
|
645 Returns the name of the local copy, or nil, if FILE is directly
|
|
|
646 accessible."
|
|
1333
|
647 ;; This formerly had an optional BUFFER argument that wasn't used by
|
|
|
648 ;; anything.
|
|
428
|
649 (let ((handler (find-file-name-handler file 'file-local-copy)))
|
|
|
650 (if handler
|
|
|
651 (funcall handler 'file-local-copy file)
|
|
|
652 nil)))
|
|
|
653
|
|
|
654 ;; XEmacs change block
|
|
|
655 ; We have this in C and use the realpath() system call.
|
|
|
656
|
|
|
657 ;(defun file-truename (filename &optional counter prev-dirs)
|
|
|
658 ; [... lots of code snipped ...]
|
|
|
659 ; filename))
|
|
|
660
|
|
|
661 ;; XEmacs addition. Called from `insert-file-contents-internal'
|
|
|
662 ;; at the appropriate time.
|
|
|
663 (defun compute-buffer-file-truename (&optional buffer)
|
|
|
664 "Recompute BUFFER's value of `buffer-file-truename'
|
|
|
665 based on the current value of `buffer-file-name'.
|
|
|
666 BUFFER defaults to the current buffer if unspecified."
|
|
|
667 (save-excursion
|
|
|
668 (set-buffer (or buffer (current-buffer)))
|
|
|
669 (cond ((null buffer-file-name)
|
|
|
670 (setq buffer-file-truename nil))
|
|
|
671 ((setq buffer-file-truename (file-truename buffer-file-name))
|
|
|
672 ;; it exists, we're done.
|
|
|
673 nil)
|
|
|
674 (t
|
|
|
675 ;; the file doesn't exist, but maybe the directory does.
|
|
|
676 (let* ((dir (file-name-directory buffer-file-name))
|
|
|
677 (truedir (file-truename dir)))
|
|
|
678 (if truedir (setq dir truedir))
|
|
|
679 (setq buffer-file-truename
|
|
|
680 (expand-file-name (file-name-nondirectory buffer-file-name)
|
|
|
681 dir)))))
|
|
|
682 (if (and find-file-use-truenames buffer-file-truename)
|
|
|
683 (setq buffer-file-name (abbreviate-file-name buffer-file-truename)
|
|
|
684 default-directory (file-name-directory buffer-file-name)))
|
|
|
685 buffer-file-truename))
|
|
|
686 ;; End XEmacs change block
|
|
|
687
|
|
|
688 (defun file-chase-links (filename)
|
|
|
689 "Chase links in FILENAME until a name that is not a link.
|
|
|
690 Does not examine containing directories for links,
|
|
|
691 unlike `file-truename'."
|
|
|
692 (let (tem (count 100) (newname filename))
|
|
|
693 (while (setq tem (file-symlink-p newname))
|
|
|
694 (save-match-data
|
|
|
695 (if (= count 0)
|
|
|
696 (error "Apparent cycle of symbolic links for %s" filename))
|
|
|
697 ;; In the context of a link, `//' doesn't mean what XEmacs thinks.
|
|
|
698 (while (string-match "//+" tem)
|
|
1333
|
699 (setq tem (replace-match "/" nil nil tem)))
|
|
428
|
700 ;; Handle `..' by hand, since it needs to work in the
|
|
|
701 ;; target of any directory symlink.
|
|
|
702 ;; This code is not quite complete; it does not handle
|
|
|
703 ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
|
|
|
704 (while (string-match "\\`\\.\\./" tem) ;#### Unix specific
|
|
|
705 (setq tem (substring tem 3))
|
|
|
706 (setq newname (file-name-as-directory
|
|
|
707 ;; Do the .. by hand.
|
|
|
708 (directory-file-name
|
|
|
709 (file-name-directory
|
|
|
710 ;; Chase links in the default dir of the symlink.
|
|
|
711 (file-chase-links
|
|
|
712 (directory-file-name
|
|
|
713 (file-name-directory newname))))))))
|
|
|
714 (setq newname (expand-file-name tem (file-name-directory newname)))
|
|
|
715 (setq count (1- count))))
|
|
|
716 newname))
|
|
4266
|
717
|
|
|
718 (defun make-temp-file (prefix &optional dir-flag suffix)
|
|
|
719 "Create a temporary file.
|
|
|
720 The returned file name (created by appending some random characters at the
|
|
|
721 end of PREFIX, and expanding against the return value of `temp-directory' if
|
|
|
722 necessary), is guaranteed to point to a newly created empty file. You can
|
|
|
723 then use `write-region' to write new data into the file.
|
|
|
724
|
|
|
725 If DIR-FLAG is non-nil, create a new empty directory instead of a file.
|
|
|
726
|
|
|
727 If SUFFIX is non-nil, add that at the end of the file name.
|
|
|
728
|
|
|
729 This function is analagous to mkstemp(3) under POSIX, avoiding the race
|
|
|
730 condition between testing for the existence of the generated filename (under
|
|
|
731 POSIX with mktemp(3), under Emacs Lisp with `make-temp-name') and creating
|
|
|
732 it."
|
|
|
733 (let ((umask (default-file-modes))
|
|
|
734 (temporary-file-directory (temp-directory))
|
|
|
735 file)
|
|
|
736 (unwind-protect
|
|
|
737 (progn
|
|
|
738 ;; Create temp files with strict access rights. It's easy to
|
|
|
739 ;; loosen them later, whereas it's impossible to close the
|
|
|
740 ;; time-window of loose permissions otherwise.
|
|
|
741 (set-default-file-modes #o700)
|
|
|
742 (while (condition-case ()
|
|
|
743 (progn
|
|
|
744 (setq file
|
|
|
745 (make-temp-name
|
|
|
746 (expand-file-name prefix
|
|
|
747 temporary-file-directory)))
|
|
|
748 (if suffix
|
|
|
749 (setq file (concat file suffix)))
|
|
|
750 (if dir-flag
|
|
|
751 (make-directory file)
|
|
|
752 (write-region "" nil file nil 'silent nil 'excl))
|
|
|
753 nil)
|
|
|
754 (file-already-exists t))
|
|
|
755 ;; the file was somehow created by someone else between
|
|
|
756 ;; `make-temp-name' and `write-region', let's try again.
|
|
|
757 nil)
|
|
|
758 file)
|
|
|
759 ;; Reset the umask.
|
|
|
760 (set-default-file-modes umask))))
|
|
|
761
|
|
428
|
762
|
|
|
763 (defun switch-to-other-buffer (arg)
|
|
|
764 "Switch to the previous buffer. With a numeric arg, n, switch to the nth
|
|
|
765 most recent buffer. With an arg of 0, buries the current buffer at the
|
|
|
766 bottom of the buffer stack."
|
|
|
767 (interactive "p")
|
|
|
768 (if (eq arg 0)
|
|
|
769 (bury-buffer (current-buffer)))
|
|
|
770 (switch-to-buffer
|
|
|
771 (if (<= arg 1) (other-buffer (current-buffer))
|
|
|
772 (nth (1+ arg) (buffer-list)))))
|
|
|
773
|
|
1333
|
774 ;;FSF 21.2
|
|
|
775 ;Optional second arg NORECORD non-nil means
|
|
|
776 ;do not put this buffer at the front of the list of recently selected ones.
|
|
|
777 (defun switch-to-buffer-other-window (buffer) ;;FSF 21.2: &optional norecord
|
|
|
778 "Select buffer BUFFER in another window.
|
|
|
779
|
|
|
780 This uses the function `display-buffer' as a subroutine; see its
|
|
|
781 documentation for additional customization information."
|
|
|
782 (interactive "BSwitch to buffer in other window: ")
|
|
428
|
783 (let ((pop-up-windows t))
|
|
|
784 ;; XEmacs: this used to have (selected-frame) as the third argument,
|
|
|
785 ;; but this is obnoxious. If the user wants the buffer in a
|
|
|
786 ;; different frame, then it should be this way.
|
|
|
787
|
|
|
788 ;; Change documented above undone --mrb
|
|
|
789 (pop-to-buffer buffer t (selected-frame))))
|
|
1333
|
790 ;(pop-to-buffer buffer t norecord)))
|
|
|
791
|
|
|
792 ;; FSF 21.2:
|
|
|
793 ; (defun switch-to-buffer-other-frame (buffer &optional norecord)
|
|
|
794 ; "Switch to buffer BUFFER in another frame.
|
|
|
795 ; Optional second arg NORECORD non-nil means
|
|
|
796 ; do not put this buffer at the front of the list of recently selected ones.
|
|
|
797
|
|
|
798 ; This uses the function `display-buffer' as a subroutine; see its
|
|
|
799 ; documentation for additional customization information."
|
|
|
800 ; (interactive "BSwitch to buffer in other frame: ")
|
|
|
801 ; (let ((pop-up-frames t))
|
|
|
802 ; (pop-to-buffer buffer t norecord)
|
|
|
803 ; (raise-frame (window-frame (selected-window)))))
|
|
428
|
804
|
|
|
805 (defun switch-to-buffer-other-frame (buffer)
|
|
1333
|
806 "Switch to buffer BUFFER in a newly-created frame.
|
|
|
807
|
|
|
808 This uses the function `display-buffer' as a subroutine; see its
|
|
|
809 documentation for additional customization information."
|
|
428
|
810 (interactive "BSwitch to buffer in other frame: ")
|
|
|
811 (let* ((name (get-frame-name-for-buffer buffer))
|
|
|
812 (frame (make-frame (if name
|
|
|
813 (list (cons 'name (symbol-name name)))))))
|
|
|
814 (pop-to-buffer buffer t frame)
|
|
|
815 (make-frame-visible frame)
|
|
|
816 buffer))
|
|
|
817
|
|
771
|
818 (defun switch-to-next-buffer (&optional n)
|
|
|
819 "Switch to the next-most-recent buffer.
|
|
|
820 This essentially rotates the buffer list forward.
|
|
|
821 N (interactively, the prefix arg) specifies how many times to rotate
|
|
|
822 forward, and defaults to 1. Buffers whose name begins with a space
|
|
|
823 \(i.e. \"invisible\" buffers) are ignored."
|
|
|
824 ;; Here is a different interactive spec. Look up the function
|
|
|
825 ;; `interactive' (i.e. `C-h f interactive') to understand how this
|
|
|
826 ;; all works.
|
|
|
827 (interactive "p")
|
|
|
828 (dotimes (n (or n 1))
|
|
|
829 (loop
|
|
|
830 do (bury-buffer (car (buffer-list)))
|
|
|
831 while (funcall buffers-tab-omit-function (car (buffer-list))))
|
|
|
832 (switch-to-buffer (car (buffer-list)))))
|
|
|
833
|
|
|
834 (defun switch-to-previous-buffer (&optional n)
|
|
|
835 "Switch to the previously most-recent buffer.
|
|
|
836 This essentially rotates the buffer list backward.
|
|
|
837 N (interactively, the prefix arg) specifies how many times to rotate
|
|
|
838 backward, and defaults to 1. Buffers whose name begins with a space
|
|
|
839 \(i.e. \"invisible\" buffers) are ignored."
|
|
|
840 (interactive "p")
|
|
|
841 (dotimes (n (or n 1))
|
|
|
842 (loop
|
|
|
843 do (switch-to-buffer (car (last (buffer-list))))
|
|
|
844 while (funcall buffers-tab-omit-function (car (buffer-list))))))
|
|
|
845
|
|
|
846 (defun switch-to-next-buffer-in-group (&optional n)
|
|
|
847 "Switch to the next-most-recent buffer in the current group.
|
|
|
848 This essentially rotates the buffer list forward.
|
|
|
849 N (interactively, the prefix arg) specifies how many times to rotate
|
|
|
850 forward, and defaults to 1. Buffers whose name begins with a space
|
|
|
851 \(i.e. \"invisible\" buffers) are ignored."
|
|
|
852 (interactive "p")
|
|
|
853 (dotimes (n (or n 1))
|
|
|
854 (let ((curbuf (car (buffer-list))))
|
|
|
855 (loop
|
|
|
856 do (bury-buffer (car (buffer-list)))
|
|
|
857 while (or (funcall buffers-tab-omit-function (car (buffer-list)))
|
|
|
858 (not (funcall buffers-tab-selection-function
|
|
|
859 curbuf (car (buffer-list)))))))
|
|
|
860 (switch-to-buffer (car (buffer-list)))))
|
|
|
861
|
|
|
862 (defun switch-to-previous-buffer-in-group (&optional n)
|
|
|
863 "Switch to the previously most-recent buffer in the current group.
|
|
|
864 This essentially rotates the buffer list backward.
|
|
|
865 N (interactively, the prefix arg) specifies how many times to rotate
|
|
|
866 backward, and defaults to 1. Buffers whose name begins with a space
|
|
|
867 \(i.e. \"invisible\" buffers) are ignored."
|
|
|
868 (interactive "p")
|
|
|
869 (dotimes (n (or n 1))
|
|
|
870 (let ((curbuf (car (buffer-list))))
|
|
|
871 (loop
|
|
|
872 do (switch-to-buffer (car (last (buffer-list))))
|
|
|
873 while (or (funcall buffers-tab-omit-function (car (buffer-list)))
|
|
|
874 (not (funcall buffers-tab-selection-function
|
|
|
875 curbuf (car (buffer-list)))))))))
|
|
|
876
|
|
1333
|
877 (defun find-file (filename &optional codesys wildcards)
|
|
428
|
878 "Edit file FILENAME.
|
|
771
|
879 Switch to a buffer visiting file FILENAME, creating one if none already
|
|
|
880 exists. Optional second argument specifies the coding system to use when
|
|
|
881 decoding the file. Interactively, with a prefix argument, you will be
|
|
|
882 prompted for the coding system.
|
|
|
883
|
|
|
884 If you do not explicitly specify a coding system, the coding system
|
|
|
885 is determined as follows:
|
|
|
886
|
|
|
887 1. `coding-system-for-read', if non-nil. (This is used by Lisp programs to
|
|
|
888 temporarily set an overriding coding system and should almost never
|
|
|
889 apply here in `find-file'.)
|
|
|
890 2. The result of `insert-file-contents-pre-hook', if non-nil. (This is a
|
|
|
891 complex interface for handling special cases.)
|
|
|
892 3. The matching value for this filename from `file-coding-system-alist',
|
|
|
893 if any. (This lets you specify the coding system to be used for
|
|
|
894 files with particular extensions, names, etc.)
|
|
|
895 4. `buffer-file-coding-system-for-read', if non-nil. (This is the global
|
|
|
896 default -- normally `undecided', so the built-in auto-detection
|
|
|
897 mechanism can do its thing.)
|
|
|
898 5. The coding system 'raw-text.
|
|
|
899
|
|
|
900 See `insert-file-contents' for more details about how the process of
|
|
1333
|
901 determining the coding system works.
|
|
|
902
|
|
|
903 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
|
|
|
904 expand wildcards (if any) and visit multiple files. Wildcard expansion
|
|
1745
|
905 can be suppressed by setting `find-file-wildcards' to `nil'."
|
|
1333
|
906 (interactive (list (read-file-name "Find file: ")
|
|
|
907 (and current-prefix-arg
|
|
|
908 (read-coding-system "Coding system: "))
|
|
|
909 t))
|
|
428
|
910 (if codesys
|
|
2718
|
911 (let* ((coding-system-for-read (get-coding-system codesys))
|
|
|
912 (value (find-file-noselect filename nil nil wildcards))
|
|
|
913 (bufname (if (listp value) (car (nreverse value)) value)))
|
|
|
914 ;; If a user explicitly specified the coding system with a prefix
|
|
|
915 ;; argument when opening a nonexistent file, insert-file-contents
|
|
|
916 ;; hasn't preserved that coding system as the local
|
|
|
917 ;; buffer-file-coding-system. Do that ourselves.
|
|
|
918 (unless (and bufname
|
|
|
919 (file-exists-p (buffer-file-name bufname))
|
|
|
920 (local-variable-p 'buffer-file-coding-system bufname))
|
|
|
921 (save-excursion
|
|
|
922 (set-buffer bufname)
|
|
|
923 (setq buffer-file-coding-system coding-system-for-read)))
|
|
|
924 (switch-to-buffer bufname))
|
|
1333
|
925 (let ((value (find-file-noselect filename nil nil wildcards)))
|
|
|
926 (if (listp value)
|
|
|
927 (mapcar 'switch-to-buffer (nreverse value))
|
|
|
928 (switch-to-buffer value)))))
|
|
|
929
|
|
|
930 (defun find-file-other-window (filename &optional codesys wildcards)
|
|
428
|
931 "Edit file FILENAME, in another window.
|
|
771
|
932 May create a new window, or reuse an existing one. See the function
|
|
|
933 `display-buffer'. Optional second argument specifies the coding system to
|
|
|
934 use when decoding the file. Interactively, with a prefix argument, you
|
|
|
935 will be prompted for the coding system."
|
|
1333
|
936 (interactive (list (read-file-name "Find file in other window: ")
|
|
|
937 (and current-prefix-arg
|
|
|
938 (read-coding-system "Coding system: "))
|
|
|
939 t))
|
|
428
|
940 (if codesys
|
|
|
941 (let ((coding-system-for-read
|
|
|
942 (get-coding-system codesys)))
|
|
1333
|
943 (let ((value (find-file-noselect filename nil nil wildcards)))
|
|
|
944 (if (listp value)
|
|
|
945 (progn
|
|
|
946 (setq value (nreverse value))
|
|
|
947 (switch-to-buffer-other-window (car value))
|
|
|
948 (mapcar 'switch-to-buffer (cdr value)))
|
|
|
949 (switch-to-buffer-other-window value))))
|
|
|
950 (let ((value (find-file-noselect filename nil nil wildcards)))
|
|
|
951 (if (listp value)
|
|
|
952 (progn
|
|
|
953 (setq value (nreverse value))
|
|
|
954 (switch-to-buffer-other-window (car value))
|
|
|
955 (mapcar 'switch-to-buffer (cdr value)))
|
|
|
956 (switch-to-buffer-other-window value)))))
|
|
|
957
|
|
|
958 (defun find-file-other-frame (filename &optional codesys wildcards)
|
|
428
|
959 "Edit file FILENAME, in a newly-created frame.
|
|
771
|
960 Optional second argument specifies the coding system to use when decoding
|
|
|
961 the file. Interactively, with a prefix argument, you will be prompted for
|
|
|
962 the coding system."
|
|
1333
|
963 (interactive (list (read-file-name "Find file in other frame: ")
|
|
|
964 (and current-prefix-arg
|
|
|
965 (read-coding-system "Coding system: "))
|
|
|
966 t))
|
|
428
|
967 (if codesys
|
|
|
968 (let ((coding-system-for-read
|
|
|
969 (get-coding-system codesys)))
|
|
1333
|
970 (let ((value (find-file-noselect filename nil nil wildcards)))
|
|
|
971 (if (listp value)
|
|
|
972 (progn
|
|
|
973 (setq value (nreverse value))
|
|
|
974 (switch-to-buffer-other-frame (car value))
|
|
|
975 (mapcar 'switch-to-buffer (cdr value)))
|
|
|
976 (switch-to-buffer-other-frame value))))
|
|
|
977 (let ((value (find-file-noselect filename nil nil wildcards)))
|
|
|
978 (if (listp value)
|
|
|
979 (progn
|
|
|
980 (setq value (nreverse value))
|
|
|
981 (switch-to-buffer-other-frame (car value))
|
|
|
982 (mapcar 'switch-to-buffer (cdr value)))
|
|
|
983 (switch-to-buffer-other-frame value)))))
|
|
|
984
|
|
|
985 (defun find-file-read-only (filename &optional codesys wildcards)
|
|
428
|
986 "Edit file FILENAME but don't allow changes.
|
|
|
987 Like \\[find-file] but marks buffer as read-only.
|
|
|
988 Use \\[toggle-read-only] to permit editing.
|
|
771
|
989 Optional second argument specifies the coding system to use when decoding
|
|
|
990 the file. Interactively, with a prefix argument, you will be prompted for
|
|
|
991 the coding system."
|
|
1333
|
992 (interactive (list (read-file-name "Find file read-only: ")
|
|
|
993 (and current-prefix-arg
|
|
|
994 (read-coding-system "Coding system: "))
|
|
|
995 t))
|
|
428
|
996 (if codesys
|
|
|
997 (let ((coding-system-for-read
|
|
|
998 (get-coding-system codesys)))
|
|
1333
|
999 (find-file filename nil wildcards))
|
|
|
1000 (find-file filename nil wildcards))
|
|
428
|
1001 (setq buffer-read-only t)
|
|
|
1002 (current-buffer))
|
|
|
1003
|
|
1333
|
1004 (defun find-file-read-only-other-window (filename &optional codesys wildcards)
|
|
428
|
1005 "Edit file FILENAME in another window but don't allow changes.
|
|
|
1006 Like \\[find-file-other-window] but marks buffer as read-only.
|
|
|
1007 Use \\[toggle-read-only] to permit editing.
|
|
771
|
1008 Optional second argument specifies the coding system to use when decoding
|
|
|
1009 the file. Interactively, with a prefix argument, you will be prompted for
|
|
|
1010 the coding system."
|
|
1333
|
1011 (interactive (list (read-file-name "Find file read-only other window: ")
|
|
|
1012 (and current-prefix-arg
|
|
|
1013 (read-coding-system "Coding system: "))
|
|
|
1014 t))
|
|
428
|
1015 (if codesys
|
|
|
1016 (let ((coding-system-for-read
|
|
|
1017 (get-coding-system codesys)))
|
|
|
1018 (find-file-other-window filename))
|
|
|
1019 (find-file-other-window filename))
|
|
|
1020 (setq buffer-read-only t)
|
|
|
1021 (current-buffer))
|
|
|
1022
|
|
1333
|
1023 (defun find-file-read-only-other-frame (filename &optional codesys wildcards)
|
|
428
|
1024 "Edit file FILENAME in another frame but don't allow changes.
|
|
|
1025 Like \\[find-file-other-frame] but marks buffer as read-only.
|
|
|
1026 Use \\[toggle-read-only] to permit editing.
|
|
771
|
1027 Optional second argument specifies the coding system to use when decoding
|
|
|
1028 the file. Interactively, with a prefix argument, you will be prompted for
|
|
|
1029 the coding system."
|
|
1333
|
1030 (interactive (list (read-file-name "Find file read-only other frame: ")
|
|
|
1031 (and current-prefix-arg
|
|
|
1032 (read-coding-system "Coding system: "))
|
|
|
1033 t))
|
|
428
|
1034 (if codesys
|
|
|
1035 (let ((coding-system-for-read
|
|
|
1036 (get-coding-system codesys)))
|
|
|
1037 (find-file-other-frame filename))
|
|
|
1038 (find-file-other-frame filename))
|
|
|
1039 (setq buffer-read-only t)
|
|
|
1040 (current-buffer))
|
|
|
1041
|
|
|
1042 (defun find-alternate-file-other-window (filename &optional codesys)
|
|
|
1043 "Find file FILENAME as a replacement for the file in the next window.
|
|
771
|
1044 This command does not select that window. Optional second argument
|
|
|
1045 specifies the coding system to use when decoding the file. Interactively,
|
|
428
|
1046 with a prefix argument, you will be prompted for the coding system."
|
|
|
1047 (interactive
|
|
|
1048 (save-selected-window
|
|
|
1049 (other-window 1)
|
|
|
1050 (let ((file buffer-file-name)
|
|
|
1051 (file-name nil)
|
|
|
1052 (file-dir nil))
|
|
|
1053 (and file
|
|
|
1054 (setq file-name (file-name-nondirectory file)
|
|
|
1055 file-dir (file-name-directory file)))
|
|
|
1056 (list (read-file-name
|
|
|
1057 "Find alternate file: " file-dir nil nil file-name)
|
|
771
|
1058 (if current-prefix-arg (read-coding-system "Coding-system: "))))))
|
|
428
|
1059 (if (one-window-p)
|
|
|
1060 (find-file-other-window filename)
|
|
|
1061 (save-selected-window
|
|
|
1062 (other-window 1)
|
|
|
1063 (find-alternate-file filename codesys))))
|
|
|
1064
|
|
|
1065 (defun find-alternate-file (filename &optional codesys)
|
|
|
1066 "Find file FILENAME, select its buffer, kill previous buffer.
|
|
|
1067 If the current buffer now contains an empty file that you just visited
|
|
771
|
1068 \(presumably by mistake), use this command to visit the file you really
|
|
|
1069 want. Optional second argument specifies the coding system to use when
|
|
|
1070 decoding the file. Interactively, with a prefix argument, you will be
|
|
|
1071 prompted for the coding system."
|
|
428
|
1072 (interactive
|
|
|
1073 (let ((file buffer-file-name)
|
|
|
1074 (file-name nil)
|
|
|
1075 (file-dir nil))
|
|
|
1076 (and file
|
|
|
1077 (setq file-name (file-name-nondirectory file)
|
|
|
1078 file-dir (file-name-directory file)))
|
|
|
1079 (list (read-file-name
|
|
|
1080 "Find alternate file: " file-dir nil nil file-name)
|
|
771
|
1081 (if current-prefix-arg (read-coding-system "Coding-system: ")))))
|
|
428
|
1082 (and (buffer-modified-p) (buffer-file-name)
|
|
|
1083 ;; (not buffer-read-only)
|
|
|
1084 (not (yes-or-no-p (format
|
|
|
1085 "Buffer %s is modified; kill anyway? "
|
|
|
1086 (buffer-name))))
|
|
|
1087 (error "Aborted"))
|
|
|
1088 (let ((obuf (current-buffer))
|
|
|
1089 (ofile buffer-file-name)
|
|
|
1090 (onum buffer-file-number)
|
|
|
1091 (otrue buffer-file-truename)
|
|
|
1092 (oname (buffer-name)))
|
|
|
1093 (if (get-buffer " **lose**")
|
|
|
1094 (kill-buffer " **lose**"))
|
|
|
1095 (rename-buffer " **lose**")
|
|
|
1096 (setq buffer-file-name nil)
|
|
|
1097 (setq buffer-file-number nil)
|
|
|
1098 (setq buffer-file-truename nil)
|
|
|
1099 (unwind-protect
|
|
|
1100 (progn
|
|
|
1101 (unlock-buffer)
|
|
|
1102 (if codesys
|
|
|
1103 (let ((coding-system-for-read
|
|
|
1104 (get-coding-system codesys)))
|
|
|
1105 (find-file filename))
|
|
|
1106 (find-file filename)))
|
|
|
1107 (cond ((eq obuf (current-buffer))
|
|
|
1108 (setq buffer-file-name ofile)
|
|
|
1109 (setq buffer-file-number onum)
|
|
|
1110 (setq buffer-file-truename otrue)
|
|
|
1111 (lock-buffer)
|
|
|
1112 (rename-buffer oname))))
|
|
|
1113 (or (eq (current-buffer) obuf)
|
|
|
1114 (kill-buffer obuf))))
|
|
1333
|
1115
|
|
428
|
1116 (defun create-file-buffer (filename)
|
|
|
1117 "Create a suitably named buffer for visiting FILENAME, and return it.
|
|
|
1118 FILENAME (sans directory) is used unchanged if that name is free;
|
|
|
1119 otherwise a string <2> or <3> or ... is appended to get an unused name."
|
|
|
1120 (let ((handler (find-file-name-handler filename 'create-file-buffer)))
|
|
|
1121 (if handler
|
|
|
1122 (funcall handler 'create-file-buffer filename)
|
|
|
1123 (let ((lastname (file-name-nondirectory filename)))
|
|
|
1124 (if (string= lastname "")
|
|
|
1125 (setq lastname filename))
|
|
|
1126 (generate-new-buffer lastname)))))
|
|
|
1127
|
|
|
1128 (defun generate-new-buffer (name)
|
|
|
1129 "Create and return a buffer with a name based on NAME.
|
|
|
1130 Choose the buffer's name using `generate-new-buffer-name'."
|
|
|
1131 (get-buffer-create (generate-new-buffer-name name)))
|
|
|
1132
|
|
|
1133 (defvar abbreviated-home-dir nil
|
|
|
1134 "The user's homedir abbreviated according to `directory-abbrev-alist'.")
|
|
|
1135
|
|
|
1136 (defun abbreviate-file-name (filename &optional hack-homedir)
|
|
|
1137 "Return a version of FILENAME shortened using `directory-abbrev-alist'.
|
|
1333
|
1138 Type \\[describe-variable] directory-abbrev-alist RET for more information.
|
|
428
|
1139 If optional argument HACK-HOMEDIR is non-nil, then this also substitutes
|
|
|
1140 \"~\" for the user's home directory."
|
|
|
1141 (let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
|
|
|
1142 (if handler
|
|
|
1143 (funcall handler 'abbreviate-file-name filename hack-homedir)
|
|
|
1144 ;; Get rid of the prefixes added by the automounter.
|
|
|
1145 ;;(if (and (string-match automount-dir-prefix filename)
|
|
|
1146 ;; (file-exists-p (file-name-directory
|
|
|
1147 ;; (substring filename (1- (match-end 0))))))
|
|
|
1148 ;; (setq filename (substring filename (1- (match-end 0)))))
|
|
|
1149 (let ((tail directory-abbrev-alist))
|
|
|
1150 ;; If any elt of directory-abbrev-alist matches this name,
|
|
|
1151 ;; abbreviate accordingly.
|
|
|
1152 (while tail
|
|
|
1153 (when (string-match (car (car tail)) filename)
|
|
|
1154 (setq filename
|
|
|
1155 (concat (cdr (car tail)) (substring filename (match-end 0)))))
|
|
|
1156 (setq tail (cdr tail))))
|
|
|
1157 (when hack-homedir
|
|
|
1158 ;; Compute and save the abbreviated homedir name.
|
|
440
|
1159 ;; We defer computing this until the first time it's needed,
|
|
|
1160 ;; to give time for directory-abbrev-alist to be set properly.
|
|
|
1161 ;; We include the separator at the end, to avoid spurious
|
|
|
1162 ;; matches such as `/usr/foobar' when the home dir is
|
|
|
1163 ;; `/usr/foo'.
|
|
428
|
1164 (or abbreviated-home-dir
|
|
|
1165 (setq abbreviated-home-dir
|
|
|
1166 (let ((abbreviated-home-dir "$foo"))
|
|
440
|
1167 (concat "\\`"
|
|
|
1168 (regexp-quote
|
|
|
1169 (abbreviate-file-name (expand-file-name "~")))
|
|
|
1170 "\\("
|
|
|
1171 (regexp-quote (string directory-sep-char))
|
|
|
1172 "\\|\\'\\)"))))
|
|
428
|
1173 ;; If FILENAME starts with the abbreviated homedir,
|
|
|
1174 ;; make it start with `~' instead.
|
|
|
1175 (if (and (string-match abbreviated-home-dir filename)
|
|
|
1176 ;; If the home dir is just /, don't change it.
|
|
440
|
1177 (not (and (= (match-end 0) 1)
|
|
|
1178 (= (aref filename 0) directory-sep-char)))
|
|
|
1179 (not (and (eq system-type 'windows-nt)
|
|
428
|
1180 (save-match-data
|
|
440
|
1181 (string-match (concat "\\`[a-zA-Z]:"
|
|
|
1182 (regexp-quote
|
|
|
1183 (string directory-sep-char))
|
|
|
1184 "\\'")
|
|
|
1185 filename)))))
|
|
428
|
1186 (setq filename
|
|
|
1187 (concat "~"
|
|
440
|
1188 (match-string 1 filename)
|
|
428
|
1189 (substring filename (match-end 0))))))
|
|
|
1190 filename)))
|
|
|
1191
|
|
|
1192 (defcustom find-file-not-true-dirname-list nil
|
|
|
1193 "*List of logical names for which visiting shouldn't save the true dirname."
|
|
|
1194 :type '(repeat (string :tag "Name"))
|
|
|
1195 :group 'find-file)
|
|
|
1196
|
|
|
1197 ;; This function is needed by FSF vc.el. I hope somebody can make it
|
|
|
1198 ;; work for XEmacs. -sb.
|
|
|
1199 ;; #### In what way does it not work? --hniksic
|
|
|
1200 (defun find-buffer-visiting (filename)
|
|
|
1201 "Return the buffer visiting file FILENAME (a string).
|
|
|
1202 This is like `get-file-buffer', except that it checks for any buffer
|
|
|
1203 visiting the same file, possibly under a different name.
|
|
|
1204 If there is no such live buffer, return nil."
|
|
|
1205 (let ((buf (get-file-buffer filename))
|
|
|
1206 (truename (abbreviate-file-name (file-truename filename))))
|
|
|
1207 (or buf
|
|
|
1208 (let ((list (buffer-list)) found)
|
|
|
1209 (while (and (not found) list)
|
|
|
1210 (save-excursion
|
|
|
1211 (set-buffer (car list))
|
|
|
1212 (if (and buffer-file-name
|
|
|
1213 (string= buffer-file-truename truename))
|
|
|
1214 (setq found (car list))))
|
|
|
1215 (setq list (cdr list)))
|
|
|
1216 found)
|
|
1333
|
1217 (let* ((attributes (file-attributes truename))
|
|
|
1218 (number (nthcdr 10 attributes))
|
|
|
1219 (list (buffer-list)) found)
|
|
428
|
1220 (and buffer-file-numbers-unique
|
|
|
1221 number
|
|
|
1222 (while (and (not found) list)
|
|
1333
|
1223 (with-current-buffer (car list)
|
|
|
1224 (if (and buffer-file-name
|
|
|
1225 (equal buffer-file-number number)
|
|
428
|
1226 ;; Verify this buffer's file number
|
|
|
1227 ;; still belongs to its file.
|
|
|
1228 (file-exists-p buffer-file-name)
|
|
1333
|
1229 (equal (file-attributes buffer-file-name)
|
|
|
1230 attributes))
|
|
428
|
1231 (setq found (car list))))
|
|
|
1232 (setq list (cdr list))))
|
|
|
1233 found))))
|
|
1333
|
1234
|
|
|
1235 (defcustom find-file-wildcards t
|
|
|
1236 "*Non-nil means file-visiting commands should handle wildcards.
|
|
|
1237 For example, if you specify `*.c', that would visit all the files
|
|
|
1238 whose names match the pattern."
|
|
|
1239 :group 'files
|
|
|
1240 ; :version "20.4"
|
|
|
1241 :type 'boolean)
|
|
|
1242
|
|
|
1243 (defcustom find-file-suppress-same-file-warnings nil
|
|
|
1244 "*Non-nil means suppress warning messages for symlinked files.
|
|
|
1245 When nil, Emacs prints a warning when visiting a file that is already
|
|
|
1246 visited, but with a different name. Setting this option to t
|
|
|
1247 suppresses this warning."
|
|
|
1248 :group 'files
|
|
|
1249 ; :version "21.1"
|
|
|
1250 :type 'boolean)
|
|
|
1251
|
|
|
1252 (defun find-file-noselect (filename &optional nowarn rawfile wildcards)
|
|
|
1253 "Read file FILENAME into a buffer and return the buffer.
|
|
|
1254 If a buffer exists visiting FILENAME, return that one, but
|
|
|
1255 verify that the file has not changed since visited or saved.
|
|
|
1256 The buffer is not selected, just returned to the caller.
|
|
|
1257 If NOWARN is non-nil, warning messages will be suppressed.
|
|
|
1258 If RAWFILE is non-nil, the file is read literally."
|
|
|
1259 (setq filename
|
|
|
1260 (abbreviate-file-name
|
|
|
1261 (expand-file-name filename)))
|
|
|
1262 (if (file-directory-p filename)
|
|
|
1263 (or (and find-file-run-dired
|
|
|
1264 (loop for fn in find-directory-functions
|
|
|
1265 for x = (and (fboundp fn)
|
|
|
1266 (funcall fn
|
|
|
1267 (if find-file-use-truenames
|
|
|
1268 (abbreviate-file-name
|
|
|
1269 (file-truename filename))
|
|
|
1270 filename)))
|
|
|
1271 if x
|
|
|
1272 return x))
|
|
|
1273 (error "%s is a directory" filename))
|
|
|
1274 (if (and wildcards
|
|
|
1275 find-file-wildcards
|
|
|
1276 (not (string-match "\\`/:" filename))
|
|
|
1277 (string-match "[[*?]" filename))
|
|
|
1278 (let ((files (condition-case nil
|
|
|
1279 (file-expand-wildcards filename t)
|
|
|
1280 (error (list filename))))
|
|
|
1281 (find-file-wildcards nil))
|
|
|
1282 (if (null files)
|
|
|
1283 (find-file-noselect filename)
|
|
|
1284 (mapcar #'find-file-noselect files)))
|
|
|
1285 (let* ((buf (get-file-buffer filename))
|
|
|
1286 (truename (abbreviate-file-name (file-truename filename)))
|
|
|
1287 (number (nthcdr 10 (file-attributes truename)))
|
|
|
1288 ; ;; Find any buffer for a file which has same truename.
|
|
|
1289 ; (other (and (not buf) (find-buffer-visiting filename)))
|
|
1346
|
1290 )
|
|
1333
|
1291
|
|
|
1292 ; ;; Let user know if there is a buffer with the same truename.
|
|
|
1293 ; (if other
|
|
|
1294 ; (progn
|
|
|
1295 ; (or nowarn
|
|
|
1296 ; find-file-suppress-same-file-warnings
|
|
|
1297 ; (string-equal filename (buffer-file-name other))
|
|
|
1298 ; (message "%s and %s are the same file"
|
|
|
1299 ; filename (buffer-file-name other)))
|
|
|
1300 ; ;; Optionally also find that buffer.
|
|
|
1301 ; (if (or find-file-existing-other-name find-file-visit-truename)
|
|
|
1302 ; (setq buf other))))
|
|
|
1303
|
|
|
1304 (when (and buf
|
|
|
1305 (or find-file-compare-truenames find-file-use-truenames)
|
|
|
1306 (not find-file-suppress-same-file-warnings)
|
|
|
1307 (not nowarn))
|
|
|
1308 (save-excursion
|
|
|
1309 (set-buffer buf)
|
|
|
1310 (if (not (string-equal buffer-file-name filename))
|
|
|
1311 (message "%s and %s are the same file (%s)"
|
|
|
1312 filename buffer-file-name
|
|
|
1313 buffer-file-truename))))
|
|
|
1314
|
|
|
1315 (if buf
|
|
|
1316 (progn
|
|
|
1317 (or nowarn
|
|
|
1318 (verify-visited-file-modtime buf)
|
|
|
1319 (cond ((not (file-exists-p filename))
|
|
|
1320 (error "File %s no longer exists!" filename))
|
|
|
1321 ;; Certain files should be reverted automatically
|
|
|
1322 ;; if they have changed on disk and not in the buffer.
|
|
|
1323 ((and (not (buffer-modified-p buf))
|
|
|
1324 (dolist (rx revert-without-query nil)
|
|
|
1325 (when (string-match rx filename)
|
|
|
1326 (return t))))
|
|
|
1327 (with-current-buffer buf
|
|
|
1328 (message "Reverting file %s..." filename)
|
|
|
1329 (revert-buffer t t)
|
|
|
1330 (message "Reverting file %s... done" filename)))
|
|
|
1331 ((yes-or-no-p
|
|
|
1332 (if (string= (file-name-nondirectory filename)
|
|
|
1333 (buffer-name buf))
|
|
|
1334 (format
|
|
|
1335 (if (buffer-modified-p buf)
|
|
|
1336 (gettext "File %s changed on disk. Discard your edits? ")
|
|
|
1337 (gettext "File %s changed on disk. Reread from disk? "))
|
|
|
1338 (file-name-nondirectory filename))
|
|
|
1339 (format
|
|
|
1340 (if (buffer-modified-p buf)
|
|
|
1341 (gettext "File %s changed on disk. Discard your edits in %s? ")
|
|
|
1342 (gettext "File %s changed on disk. Reread from disk into %s? "))
|
|
|
1343 (file-name-nondirectory filename)
|
|
|
1344 (buffer-name buf))))
|
|
|
1345 (with-current-buffer buf
|
|
|
1346 (revert-buffer t t)))))
|
|
|
1347 (when (not (eq rawfile (not (null find-file-literally))))
|
|
|
1348 (with-current-buffer buf
|
|
|
1349 (if (buffer-modified-p)
|
|
|
1350 (if (y-or-n-p (if rawfile
|
|
|
1351 "Save file and revisit literally? "
|
|
|
1352 "Save file and revisit non-literally? "))
|
|
|
1353 (progn
|
|
|
1354 (save-buffer)
|
|
|
1355 (find-file-noselect-1 buf filename nowarn
|
|
|
1356 rawfile truename number))
|
|
|
1357 (if (y-or-n-p (if rawfile
|
|
|
1358 "Discard your edits and revisit file literally? "
|
|
|
1359 "Discard your edits and revisit file non-literally? "))
|
|
|
1360 (find-file-noselect-1 buf filename nowarn
|
|
|
1361 rawfile truename number)
|
|
|
1362 (error (if rawfile "File already visited non-literally"
|
|
|
1363 "File already visited literally"))))
|
|
|
1364 (if (y-or-n-p (if rawfile
|
|
|
1365 "Revisit file literally? "
|
|
|
1366 "Revisit file non-literally? "))
|
|
|
1367 (find-file-noselect-1 buf filename nowarn
|
|
|
1368 rawfile truename number)
|
|
|
1369 (error (if rawfile "File already visited non-literally"
|
|
|
1370 "File already visited literally"))))))
|
|
|
1371 ;; Return the buffer we are using.
|
|
|
1372 buf)
|
|
|
1373 ;; Create a new buffer.
|
|
|
1374 (setq buf (create-file-buffer filename))
|
|
|
1375 ;; Catch various signals, such as QUIT, and kill the buffer
|
|
|
1376 ;; in that case.
|
|
|
1377 (condition-case data
|
|
|
1378 (progn
|
|
|
1379 (set-buffer-major-mode buf)
|
|
|
1380 ;; find-file-noselect-1 may use a different buffer.
|
|
|
1381 (find-file-noselect-1 buf filename nowarn
|
|
|
1382 rawfile truename number))
|
|
|
1383 (t
|
|
|
1384 (kill-buffer buf)
|
|
|
1385 (signal (car data) (cdr data)))))))))
|
|
|
1386
|
|
|
1387 (defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
|
|
|
1388 (let ((inhibit-read-only t)
|
|
|
1389 error)
|
|
|
1390 (with-current-buffer buf
|
|
|
1391 (kill-local-variable 'find-file-literally)
|
|
|
1392 ;; Needed in case we are re-visiting the file with a different
|
|
|
1393 ;; text representation.
|
|
|
1394 (kill-local-variable 'buffer-file-coding-system)
|
|
|
1395 (erase-buffer)
|
|
|
1396 ; (and (default-value 'enable-multibyte-characters)
|
|
|
1397 ; (not rawfile)
|
|
|
1398 ; (set-buffer-multibyte t))
|
|
|
1399 (condition-case ()
|
|
|
1400 (if rawfile
|
|
|
1401 (insert-file-contents-literally filename t)
|
|
|
1402 (insert-file-contents filename t))
|
|
|
1403 (file-error
|
|
|
1404 (when (and (file-exists-p filename)
|
|
|
1405 (not (file-readable-p filename)))
|
|
|
1406 (signal 'file-error (list "File is not readable" filename)))
|
|
|
1407 (if rawfile
|
|
|
1408 ;; Unconditionally set error
|
|
|
1409 (setq error t)
|
|
|
1410 (or
|
|
|
1411 ;; Run find-file-not-found-hooks until one returns non-nil.
|
|
|
1412 (run-hook-with-args-until-success 'find-file-not-found-hooks)
|
|
|
1413 ;; If they fail too, set error.
|
|
|
1414 (setq error t)))))
|
|
|
1415 ;; Find the file's truename, and maybe use that as visited name.
|
|
|
1416 ;; automatically computed in XEmacs, unless jka-compr was used!
|
|
|
1417 (unless buffer-file-truename
|
|
|
1418 (setq buffer-file-truename truename))
|
|
|
1419 (setq buffer-file-number number)
|
|
|
1420 (and find-file-use-truenames
|
|
|
1421 ;; This should be in C. Put pathname
|
|
|
1422 ;; abbreviations that have been explicitly
|
|
|
1423 ;; requested back into the pathname. Most
|
|
|
1424 ;; importantly, strip out automounter /tmp_mnt
|
|
|
1425 ;; directories so that auto-save will work
|
|
|
1426 (setq buffer-file-name (abbreviate-file-name buffer-file-name)))
|
|
|
1427 ;; Set buffer's default directory to that of the file.
|
|
|
1428 (setq default-directory (file-name-directory buffer-file-name))
|
|
|
1429 ;; Turn off backup files for certain file names. Since
|
|
|
1430 ;; this is a permanent local, the major mode won't eliminate it.
|
|
|
1431 (and (not (funcall backup-enable-predicate buffer-file-name))
|
|
|
1432 (progn
|
|
|
1433 (make-local-variable 'backup-inhibited)
|
|
|
1434 (setq backup-inhibited t)))
|
|
|
1435 (if rawfile
|
|
|
1436 (progn
|
|
|
1437 (setq buffer-file-coding-system 'no-conversion)
|
|
|
1438 (make-local-variable 'find-file-literally)
|
|
|
1439 (setq find-file-literally t))
|
|
|
1440 (after-find-file error (not nowarn))
|
|
|
1441 (setq buf (current-buffer)))
|
|
|
1442 (current-buffer))))
|
|
|
1443
|
|
444
|
1444 (defun insert-file-contents-literally (filename &optional visit start end replace)
|
|
1333
|
1445 "Like `insert-file-contents', but only reads in the file literally.
|
|
|
1446 A buffer may be modified in several ways after reading into the buffer,
|
|
|
1447 due to Emacs features such as format decoding, character code
|
|
|
1448 conversion, `find-file-hooks', automatic uncompression, etc.
|
|
|
1449
|
|
|
1450 This function ensures that none of these modifications will take place."
|
|
442
|
1451 (let ((wrap-func (find-file-name-handler filename
|
|
|
1452 'insert-file-contents-literally)))
|
|
444
|
1453 (if wrap-func
|
|
442
|
1454 (funcall wrap-func 'insert-file-contents-literally filename
|
|
444
|
1455 visit start end replace)
|
|
442
|
1456 (let ((file-name-handler-alist nil)
|
|
|
1457 (format-alist nil)
|
|
|
1458 (after-insert-file-functions nil)
|
|
|
1459 (coding-system-for-read 'binary)
|
|
|
1460 (coding-system-for-write 'binary)
|
|
|
1461 (find-buffer-file-type-function
|
|
|
1462 (if (fboundp 'find-buffer-file-type)
|
|
|
1463 (symbol-function 'find-buffer-file-type)
|
|
1333
|
1464 nil))
|
|
|
1465 (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
|
|
|
1466 (inhibit-file-name-operation 'insert-file-contents))
|
|
442
|
1467 (unwind-protect
|
|
|
1468 (progn
|
|
|
1469 (fset 'find-buffer-file-type (lambda (filename) t))
|
|
444
|
1470 (insert-file-contents filename visit start end replace))
|
|
442
|
1471 (if find-buffer-file-type-function
|
|
|
1472 (fset 'find-buffer-file-type find-buffer-file-type-function)
|
|
|
1473 (fmakunbound 'find-buffer-file-type)))))))
|
|
428
|
1474
|
|
1333
|
1475 (defun insert-file-literally (filename)
|
|
|
1476 "Insert contents of file FILENAME into buffer after point with no conversion.
|
|
|
1477
|
|
|
1478 This function is meant for the user to run interactively.
|
|
|
1479 Don't call it from programs! Use `insert-file-contents-literally' instead.
|
|
|
1480 \(Its calling sequence is different; see its documentation)."
|
|
|
1481 (interactive "*fInsert file literally: ")
|
|
428
|
1482 (if (file-directory-p filename)
|
|
1333
|
1483 (signal 'file-error (list "Opening input file" "file is a directory"
|
|
|
1484 filename)))
|
|
|
1485 (let ((tem (insert-file-contents-literally filename)))
|
|
|
1486 (push-mark (+ (point) (car (cdr tem))))))
|
|
|
1487
|
|
|
1488 (defvar find-file-literally nil
|
|
|
1489 "Non-nil if this buffer was made by `find-file-literally' or equivalent.
|
|
|
1490 This is a permanent local.")
|
|
|
1491 (put 'find-file-literally 'permanent-local t)
|
|
|
1492
|
|
|
1493 (defun find-file-literally (filename)
|
|
|
1494 "Visit file FILENAME with no conversion of any kind.
|
|
|
1495 Format conversion and character code conversion are both disabled,
|
|
|
1496 and multibyte characters are disabled in the resulting buffer.
|
|
|
1497 The major mode used is Fundamental mode regardless of the file name,
|
|
|
1498 and local variable specifications in the file are ignored.
|
|
|
1499 Automatic uncompression and adding a newline at the end of the
|
|
|
1500 file due to `require-final-newline' is also disabled.
|
|
|
1501
|
|
|
1502 You cannot absolutely rely on this function to result in
|
|
|
1503 visiting the file literally. If Emacs already has a buffer
|
|
|
1504 which is visiting the file, you get the existing buffer,
|
|
|
1505 regardless of whether it was created literally or not.
|
|
|
1506
|
|
|
1507 In a Lisp program, if you want to be sure of accessing a file's
|
|
|
1508 contents literally, you should create a temporary buffer and then read
|
|
|
1509 the file contents into it using `insert-file-contents-literally'."
|
|
|
1510 (interactive "FFind file literally: ")
|
|
|
1511 (switch-to-buffer (find-file-noselect filename nil t)))
|
|
428
|
1512
|
|
|
1513 (defvar after-find-file-from-revert-buffer nil)
|
|
|
1514
|
|
|
1515 (defun after-find-file (&optional error warn noauto
|
|
|
1516 after-find-file-from-revert-buffer
|
|
|
1517 nomodes)
|
|
|
1518 "Called after finding a file and by the default revert function.
|
|
|
1519 Sets buffer mode, parses local variables.
|
|
|
1520 Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
|
|
|
1521 error in reading the file. WARN non-nil means warn if there
|
|
|
1522 exists an auto-save file more recent than the visited file.
|
|
|
1523 NOAUTO means don't mess with auto-save mode.
|
|
|
1524 Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
|
|
|
1525 means this call was from `revert-buffer'.
|
|
|
1526 Fifth arg NOMODES non-nil means don't alter the file's modes.
|
|
1333
|
1527 Finishes by calling the functions in `find-file-hooks'
|
|
|
1528 unless NOMODES is non-nil."
|
|
428
|
1529 (setq buffer-read-only (not (file-writable-p buffer-file-name)))
|
|
|
1530 (if noninteractive
|
|
|
1531 nil
|
|
|
1532 (let* (not-serious
|
|
|
1533 (msg
|
|
1333
|
1534 (cond
|
|
|
1535 ((not warn) nil)
|
|
|
1536 ((and error (file-attributes buffer-file-name))
|
|
|
1537 (setq buffer-read-only t)
|
|
|
1538 (gettext "File exists, but cannot be read."))
|
|
|
1539 ((not buffer-read-only)
|
|
|
1540 (if (and warn
|
|
|
1541 (file-newer-than-file-p (make-auto-save-file-name)
|
|
|
1542 buffer-file-name))
|
|
|
1543 (format "%s has auto save data; consider M-x recover-file"
|
|
|
1544 (file-name-nondirectory buffer-file-name))
|
|
|
1545 (setq not-serious t)
|
|
|
1546 (if error (gettext "(New file)") nil)))
|
|
|
1547 ((not error)
|
|
|
1548 (setq not-serious t)
|
|
|
1549 (gettext "Note: file is write protected"))
|
|
|
1550 ((file-attributes (directory-file-name default-directory))
|
|
|
1551 (gettext "File not found and directory write-protected"))
|
|
|
1552 ((file-exists-p (file-name-directory buffer-file-name))
|
|
|
1553 (setq buffer-read-only nil))
|
|
|
1554 (t
|
|
|
1555 ;; If the directory the buffer is in doesn't exist,
|
|
|
1556 ;; offer to create it. It's better to do this now
|
|
|
1557 ;; than when we save the buffer, because we want
|
|
|
1558 ;; autosaving to work.
|
|
|
1559 (setq buffer-read-only nil)
|
|
|
1560 ;; XEmacs
|
|
|
1561 (or (file-exists-p (file-name-directory buffer-file-name))
|
|
|
1562 (condition-case nil
|
|
|
1563 (if (yes-or-no-p
|
|
|
1564 (format
|
|
|
1565 "\
|
|
428
|
1566 The directory containing %s does not exist. Create? "
|
|
1333
|
1567 (abbreviate-file-name buffer-file-name)))
|
|
|
1568 (make-directory (file-name-directory
|
|
|
1569 buffer-file-name)
|
|
|
1570 t))
|
|
|
1571 (quit
|
|
|
1572 (kill-buffer (current-buffer))
|
|
|
1573 (signal 'quit nil))))
|
|
|
1574 nil))))
|
|
428
|
1575 (if msg
|
|
|
1576 (progn
|
|
|
1577 (message "%s" msg)
|
|
|
1578 (or not-serious (sit-for 1 t)))))
|
|
1333
|
1579 (when (and auto-save-default (not noauto))
|
|
428
|
1580 (auto-save-mode t)))
|
|
1333
|
1581 ;; Make people do a little extra work (C-x C-q)
|
|
|
1582 ;; before altering a backup file.
|
|
|
1583 (when (backup-file-name-p buffer-file-name)
|
|
|
1584 (setq buffer-read-only t))
|
|
428
|
1585 (unless nomodes
|
|
1333
|
1586 ;; #### No view-mode-disable.
|
|
|
1587 ; (when view-read-only
|
|
|
1588 ; (and-boundp 'view-mode (view-mode-disable)))
|
|
428
|
1589 (normal-mode t)
|
|
1333
|
1590 (when (and buffer-read-only
|
|
|
1591 view-read-only
|
|
|
1592 (not (eq (get major-mode 'mode-class) 'special)))
|
|
|
1593 (view-mode))
|
|
428
|
1594 (run-hooks 'find-file-hooks)))
|
|
|
1595
|
|
|
1596 (defun normal-mode (&optional find-file)
|
|
|
1597 "Choose the major mode for this buffer automatically.
|
|
|
1598 Also sets up any specified local variables of the file.
|
|
|
1599 Uses the visited file name, the -*- line, and the local variables spec.
|
|
|
1600
|
|
|
1601 This function is called automatically from `find-file'. In that case,
|
|
1333
|
1602 we may set up the file-specified mode and local variables,
|
|
|
1603 depending on the value of `enable-local-variables': if it is t, we do;
|
|
|
1604 if it is nil, we don't; otherwise, we query.
|
|
|
1605 In addition, if `local-enable-local-variables' is nil, we do
|
|
|
1606 not set local variables (though we do notice a mode specified with -*-.)
|
|
|
1607
|
|
|
1608 `enable-local-variables' is ignored if you run `normal-mode' interactively,
|
|
|
1609 or from Lisp without specifying the optional argument FIND-FILE;
|
|
|
1610 in that case, this function acts as if `enable-local-variables' were t."
|
|
428
|
1611 (interactive)
|
|
|
1612 (or find-file (funcall (or default-major-mode 'fundamental-mode)))
|
|
793
|
1613 (and (with-trapping-errors
|
|
|
1614 :operation "File mode specification"
|
|
|
1615 :class 'file-mode-spec
|
|
|
1616 :error-form nil
|
|
|
1617 (set-auto-mode)
|
|
|
1618 t)
|
|
|
1619 (with-trapping-errors
|
|
|
1620 :operation "File local-variables"
|
|
|
1621 :class 'local-variables
|
|
|
1622 :error-form nil
|
|
1333
|
1623 ;; FSF 21.2:
|
|
|
1624 ; (let ((enable-local-variables (or (not find-file)
|
|
|
1625 ; enable-local-variables)))
|
|
|
1626 ; (hack-local-variables))
|
|
793
|
1627 (hack-local-variables (not find-file)))))
|
|
428
|
1628
|
|
1333
|
1629 ;; END SYNC WITH FSF 21.2.
|
|
|
1630
|
|
1024
|
1631 ;; `auto-mode-alist' used to contain entries for modes in core and in packages.
|
|
|
1632 ;; The applicable entries are now located in the corresponding modes in
|
|
|
1633 ;; packages, the ones here are for core modes. Ditto for
|
|
|
1634 ;; `interpreter-mode-alist' below.
|
|
|
1635 ;; Per Abrahamsen suggested splitting auto-mode-alist to
|
|
428
|
1636 ;; several distinct variables such as, in order of precedence,
|
|
|
1637 ;; `user-auto-mode-alist' for users, `package-auto-mode-alist' for
|
|
|
1638 ;; packages and `auto-mode-alist' (which might also be called
|
|
|
1639 ;; `default-auto-mode-alist') for default stuff, such as some of the
|
|
|
1640 ;; entries below.
|
|
|
1641
|
|
|
1642 (defvar auto-mode-alist
|
|
|
1643 '(("\\.te?xt\\'" . text-mode)
|
|
|
1644 ("\\.el\\'" . emacs-lisp-mode)
|
|
|
1645 ("\\.c?l\\(?:i?sp\\)?\\'" . lisp-mode)
|
|
|
1646 ("\\.article\\'" . text-mode)
|
|
|
1647 ("\\.letter\\'" . text-mode)
|
|
|
1648 ;; Mailer puts message to be edited in /tmp/Re.... or Message
|
|
|
1649 ;; #### Unix-specific!
|
|
|
1650 ("\\`/tmp/Re" . text-mode)
|
|
|
1651 ("/Message[0-9]*\\'" . text-mode)
|
|
|
1652 ;; some news reader is reported to use this
|
|
|
1653 ("^/tmp/fol/" . text-mode)
|
|
|
1654 ;; .emacs following a directory delimiter in either Unix or
|
|
|
1655 ;; Windows syntax.
|
|
|
1656 ("[/\\][._].*emacs\\'" . emacs-lisp-mode)
|
|
|
1657 ("\\.ml\\'" . lisp-mode)
|
|
|
1658 )
|
|
|
1659 "Alist of filename patterns vs. corresponding major mode functions.
|
|
|
1660 Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
|
|
|
1661 \(NON-NIL stands for anything that is not nil; the value does not matter.)
|
|
|
1662 Visiting a file whose name matches REGEXP specifies FUNCTION as the
|
|
|
1663 mode function to use. FUNCTION will be called, unless it is nil.
|
|
|
1664
|
|
|
1665 If the element has the form (REGEXP FUNCTION NON-NIL), then after
|
|
|
1666 calling FUNCTION (if it's not nil), we delete the suffix that matched
|
|
|
1667 REGEXP and search the list again for another match.")
|
|
|
1668
|
|
|
1669 (defvar interpreter-mode-alist
|
|
1024
|
1670 '(("emacs" . emacs-lisp-mode))
|
|
428
|
1671 "Alist mapping interpreter names to major modes.
|
|
|
1672 This alist is used to guess the major mode of a file based on the
|
|
|
1673 contents of the first line. This line often contains something like:
|
|
|
1674 #!/bin/sh
|
|
|
1675 but may contain something more imaginative like
|
|
|
1676 #! /bin/env python
|
|
|
1677 or
|
|
|
1678 eval 'exec perl -w -S $0 ${1+\"$@\"}'.
|
|
|
1679
|
|
|
1680 Each alist element looks like (INTERPRETER . MODE).
|
|
|
1681 The car of each element is a regular expression which is compared
|
|
|
1682 with the name of the interpreter specified in the first line.
|
|
|
1683 If it matches, mode MODE is selected.")
|
|
|
1684
|
|
|
1685 (defvar binary-file-regexps
|
|
444
|
1686 '("\\.\\(?:bz2\\|elc\\|g\\(if\\|z\\)\\|jp\\(eg\\|g\\)\\|png\\|t\\(ar\\|gz\\|iff\\)\\|[Zo]\\)\\'")
|
|
428
|
1687 "List of regexps of filenames containing binary (non-text) data.")
|
|
|
1688
|
|
|
1689 ; (eval-when-compile
|
|
|
1690 ; (require 'regexp-opt)
|
|
|
1691 ; (list
|
|
|
1692 ; (format "\\.\\(?:%s\\)\\'"
|
|
|
1693 ; (regexp-opt
|
|
|
1694 ; '("tar"
|
|
|
1695 ; "tgz"
|
|
|
1696 ; "gz"
|
|
|
1697 ; "bz2"
|
|
|
1698 ; "Z"
|
|
|
1699 ; "o"
|
|
|
1700 ; "elc"
|
|
|
1701 ; "png"
|
|
|
1702 ; "gif"
|
|
|
1703 ; "tiff"
|
|
|
1704 ; "jpg"
|
|
|
1705 ; "jpeg"))))))
|
|
444
|
1706
|
|
428
|
1707 (defvar inhibit-first-line-modes-regexps
|
|
444
|
1708 binary-file-regexps
|
|
428
|
1709 "List of regexps; if one matches a file name, don't look for `-*-'.")
|
|
|
1710
|
|
|
1711 (defvar inhibit-first-line-modes-suffixes nil
|
|
|
1712 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
|
|
|
1713 When checking `inhibit-first-line-modes-regexps', we first discard
|
|
|
1714 from the end of the file name anything that matches one of these regexps.")
|
|
|
1715
|
|
1333
|
1716 ;; Junk from FSF 21.2. Unnecessary in XEmacs, since `interpreter-mode-alist'
|
|
|
1717 ;; can have regexps.
|
|
|
1718 ; (defvar auto-mode-interpreter-regexp
|
|
|
1719 ; "#![ \t]?\\([^ \t\n]*\
|
|
|
1720 ; /bin/env[ \t]\\)?\\([^ \t\n]+\\)"
|
|
|
1721 ; "Regular expression matching interpreters, for file mode determination.
|
|
|
1722 ; This regular expression is matched against the first line of a file
|
|
|
1723 ; to determine the file's mode in `set-auto-mode' when Emacs can't deduce
|
|
|
1724 ; a mode from the file's name. If it matches, the file is assumed to
|
|
|
1725 ; be interpreted by the interpreter matched by the second group of the
|
|
|
1726 ; regular expression. The mode is then determined as the mode associated
|
|
|
1727 ; with that interpreter in `interpreter-mode-alist'.")
|
|
|
1728
|
|
428
|
1729 (defvar user-init-file
|
|
|
1730 nil ; set by command-line
|
|
|
1731 "File name including directory of user's initialization file.")
|
|
|
1732
|
|
|
1733 (defun set-auto-mode (&optional just-from-file-name)
|
|
|
1734 "Select major mode appropriate for current buffer.
|
|
|
1735 This checks for a -*- mode tag in the buffer's text,
|
|
|
1736 compares the filename against the entries in `auto-mode-alist',
|
|
|
1737 or checks the interpreter that runs this file against
|
|
|
1738 `interpreter-mode-alist'.
|
|
|
1739
|
|
|
1740 It does not check for the `mode:' local variable in the
|
|
|
1741 Local Variables section of the file; for that, use `hack-local-variables'.
|
|
|
1742
|
|
|
1743 If `enable-local-variables' is nil, this function does not check for a
|
|
|
1744 -*- mode tag.
|
|
|
1745
|
|
|
1746 If the optional argument JUST-FROM-FILE-NAME is non-nil,
|
|
|
1747 then we do not set anything but the major mode,
|
|
|
1748 and we don't even do that unless it would come from the file name."
|
|
|
1749 (save-excursion
|
|
|
1750 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
|
|
|
1751 ;; Do this by calling the hack-local-variables helper to avoid redundancy.
|
|
|
1752 ;; We bind enable-local-variables to nil this time because we're going to
|
|
|
1753 ;; call hack-local-variables-prop-line again later, "for real." Note that
|
|
|
1754 ;; this temporary binding does not prevent hack-local-variables-prop-line
|
|
|
1755 ;; from setting the major mode.
|
|
|
1756 (or (and enable-local-variables
|
|
|
1757 (let ((enable-local-variables nil))
|
|
|
1758 (hack-local-variables-prop-line nil))
|
|
|
1759 )
|
|
|
1760 ;; It's not in the -*- line, so check the auto-mode-alist, unless
|
|
|
1761 ;; this buffer isn't associated with a file.
|
|
|
1762 (null buffer-file-name)
|
|
|
1763 (let ((name (file-name-sans-versions buffer-file-name))
|
|
|
1764 (keep-going t))
|
|
|
1765 (while keep-going
|
|
|
1766 (setq keep-going nil)
|
|
|
1767 (let ((alist auto-mode-alist)
|
|
|
1768 (mode nil))
|
|
440
|
1769
|
|
428
|
1770 ;; Find first matching alist entry.
|
|
440
|
1771
|
|
|
1772 ;; #### This is incorrect. In NT, case sensitivity is a volume
|
|
|
1773 ;; property. For instance, NFS mounts *are* case sensitive.
|
|
|
1774 ;; Need internal function (file-name-case-sensitive f), F
|
|
|
1775 ;; being file or directory name. - kkm
|
|
428
|
1776 (let ((case-fold-search
|
|
440
|
1777 (eq system-type 'windows-nt)))
|
|
428
|
1778 (while (and (not mode) alist)
|
|
|
1779 (if (string-match (car (car alist)) name)
|
|
|
1780 (if (and (consp (cdr (car alist)))
|
|
|
1781 (nth 2 (car alist)))
|
|
|
1782 (progn
|
|
|
1783 (setq mode (car (cdr (car alist)))
|
|
|
1784 name (substring name 0 (match-beginning 0))
|
|
|
1785 keep-going t))
|
|
|
1786 (setq mode (cdr (car alist))
|
|
|
1787 keep-going nil)))
|
|
|
1788 (setq alist (cdr alist))))
|
|
|
1789 (unless just-from-file-name
|
|
|
1790 ;; If we can't deduce a mode from the file name,
|
|
|
1791 ;; look for an interpreter specified in the first line.
|
|
|
1792 (if (and (null mode)
|
|
|
1793 (save-excursion ; XEmacs
|
|
|
1794 (goto-char (point-min))
|
|
|
1795 (looking-at "#!")))
|
|
|
1796 (let ((firstline
|
|
|
1797 (buffer-substring
|
|
|
1798 (point-min)
|
|
|
1799 (save-excursion
|
|
|
1800 (goto-char (point-min)) (end-of-line) (point)))))
|
|
|
1801 (setq alist interpreter-mode-alist)
|
|
|
1802 (while alist
|
|
|
1803 (if (string-match (car (car alist)) firstline)
|
|
|
1804 (progn
|
|
|
1805 (setq mode (cdr (car alist)))
|
|
|
1806 (setq alist nil))
|
|
|
1807 (setq alist (cdr alist)))))))
|
|
|
1808 (if mode
|
|
|
1809 (if (not (fboundp mode))
|
|
|
1810 (let ((name (package-get-package-provider mode)))
|
|
|
1811 (if name
|
|
|
1812 (message "Mode %s is not installed. Download package %s" mode name)
|
|
|
1813 (message "Mode %s either doesn't exist or is not a known package" mode))
|
|
|
1814 (sit-for 2)
|
|
|
1815 (error "%s" mode))
|
|
|
1816 (unless (and just-from-file-name
|
|
|
1817 (or
|
|
|
1818 ;; Don't reinvoke major mode.
|
|
|
1819 (eq mode major-mode)
|
|
|
1820 ;; Don't lose on minor modes.
|
|
|
1821 (assq mode minor-mode-alist)))
|
|
|
1822 (funcall mode))))))))))
|
|
|
1823
|
|
|
1824 (defvar hack-local-variables-hook nil
|
|
|
1825 "Normal hook run after processing a file's local variables specs.
|
|
|
1826 Major modes can use this to examine user-specified local variables
|
|
|
1827 in order to initialize other data structure based on them.
|
|
|
1828
|
|
|
1829 This hook runs even if there were no local variables or if their
|
|
|
1830 evaluation was suppressed. See also `enable-local-variables' and
|
|
|
1831 `enable-local-eval'.")
|
|
|
1832
|
|
|
1833 (defun hack-local-variables (&optional force)
|
|
|
1834 "Parse, and bind or evaluate as appropriate, any local variables
|
|
|
1835 for current buffer."
|
|
|
1836 ;; Don't look for -*- if this file name matches any
|
|
|
1837 ;; of the regexps in inhibit-first-line-modes-regexps.
|
|
|
1838 (if (or (null buffer-file-name) ; don't lose if buffer has no file!
|
|
|
1839 (not (let ((temp inhibit-first-line-modes-regexps)
|
|
|
1840 (name (if buffer-file-name
|
|
|
1841 (file-name-sans-versions buffer-file-name)
|
|
|
1842 (buffer-name))))
|
|
|
1843 (while (let ((sufs inhibit-first-line-modes-suffixes))
|
|
|
1844 (while (and sufs (not
|
|
|
1845 (string-match (car sufs) name)))
|
|
|
1846 (setq sufs (cdr sufs)))
|
|
|
1847 sufs)
|
|
|
1848 (setq name (substring name 0 (match-beginning 0))))
|
|
|
1849 (while (and temp
|
|
|
1850 (not (string-match (car temp) name)))
|
|
|
1851 (setq temp (cdr temp))
|
|
|
1852 temp))))
|
|
|
1853 (progn
|
|
|
1854 ;; Look for variables in the -*- line.
|
|
|
1855 (hack-local-variables-prop-line force)
|
|
|
1856 ;; Look for "Local variables:" block in last page.
|
|
|
1857 (hack-local-variables-last-page force)))
|
|
|
1858 (run-hooks 'hack-local-variables-hook))
|
|
|
1859
|
|
|
1860 ;;; Local variables may be specified in the last page of the file (within 3k
|
|
|
1861 ;;; from the end of the file and after the last ^L) in the form
|
|
|
1862 ;;;
|
|
|
1863 ;;; Local variables:
|
|
|
1864 ;;; variable-name: variable-value
|
|
|
1865 ;;; end:
|
|
|
1866 ;;;
|
|
|
1867 ;;; The lines may begin with a common prefix, like ";;; " in the above
|
|
|
1868 ;;; example. They may also have a common suffix (" */" for example). In
|
|
|
1869 ;;; this form, the local variable "mode" can be used to change the major
|
|
|
1870 ;;; mode, and the local variable "eval" can be used to evaluate an arbitrary
|
|
|
1871 ;;; form.
|
|
|
1872 ;;;
|
|
|
1873 ;;; Local variables may also be specified in the first line of the file.
|
|
|
1874 ;;; Embedded in this line are a pair of "-*-" sequences. What lies between
|
|
|
1875 ;;; them are variable-name/variable-value pairs, like:
|
|
|
1876 ;;;
|
|
|
1877 ;;; -*- mode: emacs-lisp -*-
|
|
|
1878 ;;; or -*- mode: postscript; version-control: never -*-
|
|
|
1879 ;;; or -*- tags-file-name: "/foo/bar/TAGS" -*-
|
|
|
1880 ;;;
|
|
|
1881 ;;; The local variable "eval" is not used with this form. For hysterical
|
|
|
1882 ;;; reasons, the syntax "-*- modename -*-" is allowed as well.
|
|
|
1883 ;;;
|
|
|
1884
|
|
|
1885 (defun hack-local-variables-p (modeline)
|
|
|
1886 (or (eq enable-local-variables t)
|
|
|
1887 (and enable-local-variables
|
|
|
1888 (save-window-excursion
|
|
|
1889 (condition-case nil
|
|
|
1890 (switch-to-buffer (current-buffer))
|
|
|
1891 (error
|
|
|
1892 ;; If we fail to switch in the selected window,
|
|
|
1893 ;; it is probably a minibuffer.
|
|
|
1894 ;; So try another window.
|
|
|
1895 (condition-case nil
|
|
|
1896 (switch-to-buffer-other-window (current-buffer))
|
|
|
1897 (error
|
|
|
1898 (switch-to-buffer-other-frame (current-buffer))))))
|
|
|
1899 (or modeline (save-excursion
|
|
|
1900 (beginning-of-line)
|
|
|
1901 (set-window-start (selected-window) (point))))
|
|
|
1902 (y-or-n-p (format
|
|
|
1903 "Set local variables as specified %s of %s? "
|
|
|
1904 (if modeline "in -*- line" "at end")
|
|
|
1905 (if buffer-file-name
|
|
|
1906 (file-name-nondirectory buffer-file-name)
|
|
|
1907 (concat "buffer " (buffer-name)))))))))
|
|
|
1908
|
|
|
1909 (defun hack-local-variables-last-page (&optional force)
|
|
|
1910 ;; Set local variables set in the "Local Variables:" block of the last page.
|
|
|
1911 (save-excursion
|
|
|
1912 (goto-char (point-max))
|
|
|
1913 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
|
|
|
1914 (if (let ((case-fold-search t))
|
|
|
1915 (and (search-forward "Local Variables:" nil t)
|
|
|
1916 (or force
|
|
|
1917 (hack-local-variables-p nil))))
|
|
|
1918 (let ((continue t)
|
|
444
|
1919 prefix prefixlen suffix start
|
|
428
|
1920 (enable-local-eval enable-local-eval))
|
|
|
1921 ;; The prefix is what comes before "local variables:" in its line.
|
|
|
1922 ;; The suffix is what comes after "local variables:" in its line.
|
|
|
1923 (skip-chars-forward " \t")
|
|
|
1924 (or (eolp)
|
|
|
1925 (setq suffix (buffer-substring (point)
|
|
|
1926 (progn (end-of-line) (point)))))
|
|
|
1927 (goto-char (match-beginning 0))
|
|
|
1928 (or (bolp)
|
|
|
1929 (setq prefix
|
|
|
1930 (buffer-substring (point)
|
|
|
1931 (progn (beginning-of-line) (point)))))
|
|
|
1932 (if prefix (setq prefixlen (length prefix)
|
|
|
1933 prefix (regexp-quote prefix)))
|
|
|
1934 (if suffix (setq suffix (concat (regexp-quote suffix) "$")))
|
|
|
1935 (while continue
|
|
|
1936 ;; Look at next local variable spec.
|
|
|
1937 (if selective-display (re-search-forward "[\n\C-m]")
|
|
|
1938 (forward-line 1))
|
|
|
1939 ;; Skip the prefix, if any.
|
|
|
1940 (if prefix
|
|
|
1941 (if (looking-at prefix)
|
|
|
1942 (forward-char prefixlen)
|
|
|
1943 (error "Local variables entry is missing the prefix")))
|
|
|
1944 ;; Find the variable name; strip whitespace.
|
|
|
1945 (skip-chars-forward " \t")
|
|
444
|
1946 (setq start (point))
|
|
428
|
1947 (skip-chars-forward "^:\n")
|
|
|
1948 (if (eolp) (error "Missing colon in local variables entry"))
|
|
|
1949 (skip-chars-backward " \t")
|
|
444
|
1950 (let* ((str (buffer-substring start (point)))
|
|
428
|
1951 (var (read str))
|
|
|
1952 val)
|
|
|
1953 ;; Setting variable named "end" means end of list.
|
|
801
|
1954 (if (equalp str "end")
|
|
428
|
1955 (setq continue nil)
|
|
|
1956 ;; Otherwise read the variable value.
|
|
|
1957 (skip-chars-forward "^:")
|
|
|
1958 (forward-char 1)
|
|
|
1959 (setq val (read (current-buffer)))
|
|
|
1960 (skip-chars-backward "\n")
|
|
|
1961 (skip-chars-forward " \t")
|
|
|
1962 (or (if suffix (looking-at suffix) (eolp))
|
|
|
1963 (error "Local variables entry is terminated incorrectly"))
|
|
|
1964 ;; Set the variable. "Variables" mode and eval are funny.
|
|
|
1965 (hack-one-local-variable var val))))))))
|
|
|
1966
|
|
|
1967 ;; jwz - New Version 20.1/19.15
|
|
|
1968 (defun hack-local-variables-prop-line (&optional force)
|
|
|
1969 ;; Set local variables specified in the -*- line.
|
|
|
1970 ;; Returns t if mode was set.
|
|
|
1971 (let ((result nil))
|
|
|
1972 (save-excursion
|
|
|
1973 (goto-char (point-min))
|
|
|
1974 (skip-chars-forward " \t\n\r")
|
|
|
1975 (let ((end (save-excursion
|
|
|
1976 ;; If the file begins with "#!"
|
|
|
1977 ;; (un*x exec interpreter magic), look
|
|
|
1978 ;; for mode frobs in the first two
|
|
|
1979 ;; lines. You cannot necessarily
|
|
|
1980 ;; put them in the first line of
|
|
|
1981 ;; such a file without screwing up
|
|
|
1982 ;; the interpreter invocation.
|
|
|
1983 (end-of-line (and (looking-at "^#!") 2))
|
|
|
1984 (point))))
|
|
|
1985 ;; Parse the -*- line into the `result' alist.
|
|
|
1986 (cond ((not (search-forward "-*-" end t))
|
|
|
1987 ;; doesn't have one.
|
|
|
1988 (setq force t))
|
|
442
|
1989 ((looking-at "[ \t]*\\([^ \t\n\r:;]+?\\)\\([ \t]*-\\*-\\)")
|
|
428
|
1990 ;; Antiquated form: "-*- ModeName -*-".
|
|
|
1991 (setq result
|
|
|
1992 (list (cons 'mode
|
|
|
1993 (intern (buffer-substring
|
|
|
1994 (match-beginning 1)
|
|
|
1995 (match-end 1)))))
|
|
|
1996 ))
|
|
|
1997 (t
|
|
|
1998 ;; Usual form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
|
|
|
1999 ;; (last ";" is optional).
|
|
|
2000 (save-excursion
|
|
|
2001 (if (search-forward "-*-" end t)
|
|
|
2002 (setq end (- (point) 3))
|
|
|
2003 (error "-*- not terminated before end of line")))
|
|
|
2004 (while (< (point) end)
|
|
|
2005 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
|
|
|
2006 (error "malformed -*- line"))
|
|
|
2007 (goto-char (match-end 0))
|
|
|
2008 ;; There used to be a downcase here,
|
|
|
2009 ;; but the manual didn't say so,
|
|
|
2010 ;; and people want to set var names that aren't all lc.
|
|
|
2011 (let ((key (intern (buffer-substring
|
|
|
2012 (match-beginning 1)
|
|
|
2013 (match-end 1))))
|
|
|
2014 (val (save-restriction
|
|
|
2015 (narrow-to-region (point) end)
|
|
|
2016 (read (current-buffer)))))
|
|
|
2017 ;; Case sensitivity! Icepicks in my forehead!
|
|
801
|
2018 (if (equalp (symbol-name key) "mode")
|
|
428
|
2019 (setq key 'mode))
|
|
|
2020 (setq result (cons (cons key val) result))
|
|
|
2021 (skip-chars-forward " \t;")))
|
|
|
2022 (setq result (nreverse result))))))
|
|
|
2023
|
|
|
2024 (let ((set-any-p (or force
|
|
|
2025 ;; It's OK to force null specifications.
|
|
|
2026 (null result)
|
|
|
2027 ;; It's OK to force mode-only specifications.
|
|
|
2028 (let ((remaining result)
|
|
|
2029 (mode-specs-only t))
|
|
|
2030 (while remaining
|
|
|
2031 (if (eq (car (car remaining)) 'mode)
|
|
|
2032 (setq remaining (cdr remaining))
|
|
|
2033 ;; Otherwise, we have a real local.
|
|
|
2034 (setq mode-specs-only nil
|
|
|
2035 remaining nil))
|
|
|
2036 )
|
|
|
2037 mode-specs-only)
|
|
|
2038 ;; Otherwise, check.
|
|
|
2039 (hack-local-variables-p t)))
|
|
|
2040 (mode-p nil))
|
|
|
2041 (while result
|
|
|
2042 (let ((key (car (car result)))
|
|
|
2043 (val (cdr (car result))))
|
|
|
2044 (cond ((eq key 'mode)
|
|
|
2045 (setq mode-p t)
|
|
|
2046 (let ((mode (intern (concat (downcase (symbol-name val))
|
|
|
2047 "-mode"))))
|
|
|
2048 ;; Without this guard, `normal-mode' would potentially run
|
|
|
2049 ;; the major mode function twice: once via `set-auto-mode'
|
|
|
2050 ;; and once via `hack-local-variables'.
|
|
|
2051 (if (not (eq mode major-mode))
|
|
|
2052 (funcall mode))
|
|
|
2053 ))
|
|
|
2054 (set-any-p
|
|
|
2055 (hack-one-local-variable key val))
|
|
|
2056 (t
|
|
|
2057 nil)))
|
|
|
2058 (setq result (cdr result)))
|
|
|
2059 mode-p)))
|
|
|
2060
|
|
1333
|
2061 ;; BEGIN SYNC WITH FSF 21.2.
|
|
|
2062
|
|
428
|
2063 (defconst ignored-local-variables
|
|
|
2064 (list 'enable-local-eval)
|
|
|
2065 "Variables to be ignored in a file's local variable spec.")
|
|
|
2066
|
|
|
2067 ;; Get confirmation before setting these variables as locals in a file.
|
|
|
2068 (put 'debugger 'risky-local-variable t)
|
|
|
2069 (put 'enable-local-eval 'risky-local-variable t)
|
|
|
2070 (put 'ignored-local-variables 'risky-local-variable t)
|
|
|
2071 (put 'eval 'risky-local-variable t)
|
|
|
2072 (put 'file-name-handler-alist 'risky-local-variable t)
|
|
|
2073 (put 'minor-mode-map-alist 'risky-local-variable t)
|
|
|
2074 (put 'after-load-alist 'risky-local-variable t)
|
|
|
2075 (put 'buffer-file-name 'risky-local-variable t)
|
|
|
2076 (put 'buffer-auto-save-file-name 'risky-local-variable t)
|
|
|
2077 (put 'buffer-file-truename 'risky-local-variable t)
|
|
|
2078 (put 'exec-path 'risky-local-variable t)
|
|
|
2079 (put 'load-path 'risky-local-variable t)
|
|
|
2080 (put 'exec-directory 'risky-local-variable t)
|
|
|
2081 (put 'process-environment 'risky-local-variable t)
|
|
1333
|
2082 (put 'dabbrev-case-fold-search 'risky-local-variable t)
|
|
|
2083 (put 'dabbrev-case-replace 'risky-local-variable t)
|
|
428
|
2084 ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode.
|
|
|
2085 (put 'outline-level 'risky-local-variable t)
|
|
|
2086 (put 'rmail-output-file-alist 'risky-local-variable t)
|
|
|
2087
|
|
|
2088 ;; This one is safe because the user gets to check it before it is used.
|
|
|
2089 (put 'compile-command 'safe-local-variable t)
|
|
|
2090
|
|
1333
|
2091 (defun hack-one-local-variable-quotep (exp)
|
|
|
2092 (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
|
|
|
2093
|
|
428
|
2094 (defun hack-one-local-variable (var val)
|
|
1333
|
2095 "\"Set\" one variable in a local variables spec.
|
|
|
2096 A few variable names are treated specially."
|
|
428
|
2097 (cond ((eq var 'mode)
|
|
|
2098 (funcall (intern (concat (downcase (symbol-name val))
|
|
|
2099 "-mode"))))
|
|
1333
|
2100 ((eq var 'coding)
|
|
|
2101 ;; We have already handled coding: tag in set-auto-coding.
|
|
|
2102 nil)
|
|
428
|
2103 ((memq var ignored-local-variables)
|
|
|
2104 nil)
|
|
|
2105 ;; "Setting" eval means either eval it or do nothing.
|
|
|
2106 ;; Likewise for setting hook variables.
|
|
|
2107 ((or (get var 'risky-local-variable)
|
|
|
2108 (and
|
|
1333
|
2109 (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$"
|
|
428
|
2110 (symbol-name var))
|
|
|
2111 (not (get var 'safe-local-variable))))
|
|
1333
|
2112 ;; Permit evalling a put of a harmless property.
|
|
|
2113 ;; if the args do nothing tricky.
|
|
|
2114 (if (or (and (eq var 'eval)
|
|
|
2115 (consp val)
|
|
|
2116 (eq (car val) 'put)
|
|
|
2117 (hack-one-local-variable-quotep (nth 1 val))
|
|
|
2118 (hack-one-local-variable-quotep (nth 2 val))
|
|
|
2119 ;; Only allow safe values of lisp-indent-hook;
|
|
|
2120 ;; not functions.
|
|
|
2121 (or (numberp (nth 3 val))
|
|
|
2122 (equal (nth 3 val) ''defun))
|
|
|
2123 (memq (nth 1 (nth 2 val))
|
|
|
2124 '(lisp-indent-hook)))
|
|
|
2125 ;; Permit eval if not root and user says ok.
|
|
|
2126 (and (not (zerop (user-uid)))
|
|
|
2127 (or (eq enable-local-eval t)
|
|
|
2128 (and enable-local-eval
|
|
|
2129 (save-window-excursion
|
|
|
2130 (switch-to-buffer (current-buffer))
|
|
|
2131 (save-excursion
|
|
|
2132 (beginning-of-line)
|
|
|
2133 (set-window-start (selected-window) (point)))
|
|
|
2134 (setq enable-local-eval
|
|
|
2135 (y-or-n-p (format "Process `eval' or hook local variables in %s? "
|
|
|
2136 (if buffer-file-name
|
|
|
2137 (concat "file " (file-name-nondirectory buffer-file-name))
|
|
|
2138 (concat "buffer " (buffer-name)))))))))))
|
|
428
|
2139 (if (eq var 'eval)
|
|
|
2140 (save-excursion (eval val))
|
|
|
2141 (make-local-variable var)
|
|
|
2142 (set var val))
|
|
1333
|
2143 (message "Ignoring `eval:' in the local variables list")))
|
|
428
|
2144 ;; Ordinary variable, really set it.
|
|
|
2145 (t (make-local-variable var)
|
|
|
2146 (set var val))))
|
|
502
|
2147
|
|
|
2148 (defun find-coding-system-magic-cookie-in-file (file)
|
|
|
2149 "Look for the coding-system magic cookie in FILE.
|
|
|
2150 The coding-system magic cookie is either the local variable specification
|
|
|
2151 -*- ... coding: ... -*- on the first line, or the exact string
|
|
|
2152 \";;;###coding system: \" somewhere within the first 3000 characters
|
|
|
2153 of the file. If found, the coding system name (as a string) is returned;
|
|
|
2154 otherwise nil is returned. Note that it is extremely unlikely that
|
|
|
2155 either such string would occur coincidentally as the result of encoding
|
|
|
2156 some characters in a non-ASCII charset, and that the spaces make it
|
|
|
2157 even less likely since the space character is not a valid octet in any
|
|
|
2158 ISO 2022 encoding of most non-ASCII charsets."
|
|
|
2159 (save-excursion
|
|
|
2160 (with-temp-buffer
|
|
|
2161 (let ((coding-system-for-read 'raw-text))
|
|
2434
|
2162 (insert-file-contents file nil 0 3000))
|
|
502
|
2163 (goto-char (point-min))
|
|
|
2164 (or (and (looking-at
|
|
|
2165 "^[^\n]*-\\*-[^\n]*coding: \\([^ \t\n;]+\\)[^\n]*-\\*-")
|
|
|
2166 (buffer-substring (match-beginning 1) (match-end 1)))
|
|
|
2167 ;; (save-excursion
|
|
|
2168 ;; (let (start end)
|
|
|
2169 ;; (and (re-search-forward "^;+[ \t]*Local Variables:" nil t)
|
|
|
2170 ;; (setq start (match-end 0))
|
|
|
2171 ;; (re-search-forward "\n;+[ \t]*End:")
|
|
|
2172 ;; (setq end (match-beginning 0))
|
|
|
2173 ;; (save-restriction
|
|
|
2174 ;; (narrow-to-region start end)
|
|
|
2175 ;; (goto-char start)
|
|
|
2176 ;; (re-search-forward "^;;; coding: \\([^\n]+\\)$" nil t)
|
|
|
2177 ;; )
|
|
|
2178 ;; (let ((codesys
|
|
|
2179 ;; (intern (buffer-substring
|
|
|
2180 ;; (match-beginning 1)(match-end 1)))))
|
|
|
2181 ;; (if (find-coding-system codesys) codesys))
|
|
|
2182 ;; )))
|
|
|
2183 (let ((case-fold-search nil))
|
|
|
2184 (if (search-forward
|
|
|
2185 ";;;###coding system: " (+ (point-min) 3000) t)
|
|
|
2186 (let ((start (point))
|
|
|
2187 (end (progn
|
|
|
2188 (skip-chars-forward "^ \t\n\r")
|
|
|
2189 (point))))
|
|
|
2190 (if (> end start) (buffer-substring start end))
|
|
|
2191 )))
|
|
|
2192 ))))
|
|
428
|
2193
|
|
1333
|
2194
|
|
428
|
2195 (defcustom change-major-mode-with-file-name t
|
|
|
2196 "*Non-nil means \\[write-file] should set the major mode from the file name.
|
|
|
2197 However, the mode will not be changed if
|
|
|
2198 \(1) a local variables list or the `-*-' line specifies a major mode, or
|
|
|
2199 \(2) the current major mode is a \"special\" mode,
|
|
|
2200 \ not suitable for ordinary files, or
|
|
|
2201 \(3) the new file name does not particularly specify any mode."
|
|
|
2202 :type 'boolean
|
|
|
2203 :group 'editing-basics)
|
|
|
2204
|
|
|
2205 (defun set-visited-file-name (filename &optional no-query along-with-file)
|
|
|
2206 "Change name of file visited in current buffer to FILENAME.
|
|
|
2207 The next time the buffer is saved it will go in the newly specified file.
|
|
|
2208 nil or empty string as argument means make buffer not be visiting any file.
|
|
|
2209 Remember to delete the initial contents of the minibuffer
|
|
|
2210 if you wish to pass an empty string as the argument.
|
|
|
2211
|
|
|
2212 The optional second argument NO-QUERY, if non-nil, inhibits asking for
|
|
|
2213 confirmation in the case where another buffer is already visiting FILENAME.
|
|
|
2214
|
|
|
2215 The optional third argument ALONG-WITH-FILE, if non-nil, means that
|
|
|
2216 the old visited file has been renamed to the new name FILENAME."
|
|
|
2217 (interactive "FSet visited file name: ")
|
|
|
2218 (if (buffer-base-buffer)
|
|
|
2219 (error "An indirect buffer cannot visit a file"))
|
|
|
2220 (let (truename)
|
|
|
2221 (if filename
|
|
|
2222 (setq filename
|
|
|
2223 (if (string-equal filename "")
|
|
|
2224 nil
|
|
|
2225 (expand-file-name filename))))
|
|
|
2226 (if filename
|
|
|
2227 (progn
|
|
|
2228 (setq truename (file-truename filename))
|
|
|
2229 ;; #### Do we need to check if truename is non-nil?
|
|
|
2230 (if find-file-use-truenames
|
|
|
2231 (setq filename truename))))
|
|
|
2232 (let ((buffer (and filename (find-buffer-visiting filename))))
|
|
|
2233 (and buffer (not (eq buffer (current-buffer)))
|
|
|
2234 (not no-query)
|
|
|
2235 (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
|
|
|
2236 filename)))
|
|
|
2237 (error "Aborted")))
|
|
|
2238 (or (equal filename buffer-file-name)
|
|
|
2239 (progn
|
|
|
2240 (and filename (lock-buffer filename))
|
|
|
2241 (unlock-buffer)))
|
|
|
2242 (setq buffer-file-name filename)
|
|
|
2243 (if filename ; make buffer name reflect filename.
|
|
|
2244 (let ((new-name (file-name-nondirectory buffer-file-name)))
|
|
|
2245 (if (string= new-name "")
|
|
|
2246 (error "Empty file name"))
|
|
|
2247 (setq default-directory (file-name-directory buffer-file-name))
|
|
|
2248 (or (string= new-name (buffer-name))
|
|
|
2249 (rename-buffer new-name t))))
|
|
|
2250 (setq buffer-backed-up nil)
|
|
|
2251 (or along-with-file
|
|
|
2252 (clear-visited-file-modtime))
|
|
|
2253 (compute-buffer-file-truename) ; insert-file-contents does this too.
|
|
|
2254 ; ;; Abbreviate the file names of the buffer.
|
|
|
2255 ; (if truename
|
|
|
2256 ; (progn
|
|
|
2257 ; (setq buffer-file-truename (abbreviate-file-name truename))
|
|
|
2258 ; (if find-file-visit-truename
|
|
|
2259 ; (setq buffer-file-name buffer-file-truename))))
|
|
|
2260 (setq buffer-file-number
|
|
|
2261 (if filename
|
|
|
2262 (nthcdr 10 (file-attributes buffer-file-name))
|
|
|
2263 nil)))
|
|
|
2264 ;; write-file-hooks is normally used for things like ftp-find-file
|
|
|
2265 ;; that visit things that are not local files as if they were files.
|
|
|
2266 ;; Changing to visit an ordinary local file instead should flush the hook.
|
|
|
2267 (kill-local-variable 'write-file-hooks)
|
|
|
2268 (kill-local-variable 'after-save-hook)
|
|
|
2269 (kill-local-variable 'local-write-file-hooks)
|
|
|
2270 (kill-local-variable 'write-file-data-hooks)
|
|
|
2271 (kill-local-variable 'revert-buffer-function)
|
|
|
2272 (kill-local-variable 'backup-inhibited)
|
|
|
2273 ;; If buffer was read-only because of version control,
|
|
|
2274 ;; that reason is gone now, so make it writable.
|
|
502
|
2275 (if-boundp 'vc-mode
|
|
|
2276 (progn
|
|
|
2277 (if vc-mode
|
|
|
2278 (setq buffer-read-only nil))
|
|
|
2279 (kill-local-variable 'vc-mode)))
|
|
428
|
2280 ;; Turn off backup files for certain file names.
|
|
|
2281 ;; Since this is a permanent local, the major mode won't eliminate it.
|
|
|
2282 (and buffer-file-name
|
|
|
2283 (not (funcall backup-enable-predicate buffer-file-name))
|
|
|
2284 (progn
|
|
|
2285 (make-local-variable 'backup-inhibited)
|
|
|
2286 (setq backup-inhibited t)))
|
|
|
2287 (let ((oauto buffer-auto-save-file-name))
|
|
|
2288 ;; If auto-save was not already on, turn it on if appropriate.
|
|
|
2289 (if (not buffer-auto-save-file-name)
|
|
|
2290 (and buffer-file-name auto-save-default
|
|
|
2291 (auto-save-mode t))
|
|
|
2292 ;; If auto save is on, start using a new name.
|
|
|
2293 ;; We deliberately don't rename or delete the old auto save
|
|
|
2294 ;; for the old visited file name. This is because perhaps
|
|
|
2295 ;; the user wants to save the new state and then compare with the
|
|
|
2296 ;; previous state from the auto save file.
|
|
|
2297 (setq buffer-auto-save-file-name
|
|
|
2298 (make-auto-save-file-name)))
|
|
|
2299 ;; Rename the old auto save file if any.
|
|
|
2300 (and oauto buffer-auto-save-file-name
|
|
|
2301 (file-exists-p oauto)
|
|
|
2302 (rename-file oauto buffer-auto-save-file-name t)))
|
|
|
2303 (if buffer-file-name
|
|
|
2304 (not along-with-file)
|
|
|
2305 (set-buffer-modified-p t))
|
|
|
2306 ;; Update the major mode, if the file name determines it.
|
|
|
2307 (condition-case nil
|
|
|
2308 ;; Don't change the mode if it is special.
|
|
|
2309 (or (not change-major-mode-with-file-name)
|
|
|
2310 (get major-mode 'mode-class)
|
|
|
2311 ;; Don't change the mode if the local variable list specifies it.
|
|
|
2312 (hack-local-variables t)
|
|
|
2313 (set-auto-mode t))
|
|
|
2314 (error nil))
|
|
1333
|
2315 ;; #### ?? not in FSF.
|
|
428
|
2316 (run-hooks 'after-set-visited-file-name-hooks))
|
|
|
2317
|
|
|
2318 (defun write-file (filename &optional confirm codesys)
|
|
|
2319 "Write current buffer into file FILENAME.
|
|
1333
|
2320 This makes the buffer visit that file, and marks it as not modified.
|
|
|
2321
|
|
|
2322 If you specify just a directory name as FILENAME, that means to use
|
|
|
2323 the default file name but in that directory. You can also yank
|
|
|
2324 the default file name into the minibuffer to edit it, using M-n.
|
|
|
2325
|
|
|
2326 If the buffer is not already visiting a file, the default file name
|
|
|
2327 for the output file is the buffer name.
|
|
|
2328
|
|
|
2329 If optional second arg CONFIRM is non-nil, this function
|
|
|
2330 asks for confirmation before overwriting an existing file.
|
|
|
2331 Interactively, this is always the case.
|
|
771
|
2332
|
|
|
2333 Optional third argument specifies the coding system to use when encoding
|
|
|
2334 the file. Interactively, with a prefix argument, you will be prompted for
|
|
|
2335 the coding system."
|
|
428
|
2336 ;; (interactive "FWrite file: ")
|
|
|
2337 (interactive
|
|
|
2338 (list (if buffer-file-name
|
|
|
2339 (read-file-name "Write file: "
|
|
|
2340 nil nil nil nil)
|
|
1333
|
2341 (read-file-name "Write file: " default-directory
|
|
|
2342 (expand-file-name
|
|
|
2343 (file-name-nondirectory (buffer-name))
|
|
|
2344 default-directory)
|
|
|
2345 nil nil))
|
|
428
|
2346 t
|
|
771
|
2347 (if current-prefix-arg (read-coding-system "Coding system: "))))
|
|
428
|
2348 (and (eq (current-buffer) mouse-grabbed-buffer)
|
|
|
2349 (error "Can't write minibuffer window"))
|
|
|
2350 (or (null filename) (string-equal filename "")
|
|
|
2351 (progn
|
|
|
2352 ;; If arg is just a directory,
|
|
1333
|
2353 ;; use the default file name, but in that directory.
|
|
|
2354 (if (file-directory-p filename)
|
|
428
|
2355 (setq filename (concat (file-name-as-directory filename)
|
|
1333
|
2356 (file-name-nondirectory
|
|
|
2357 (or buffer-file-name (buffer-name))))))
|
|
428
|
2358 (and confirm
|
|
|
2359 (file-exists-p filename)
|
|
|
2360 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
|
|
|
2361 (error "Canceled")))
|
|
1333
|
2362 (set-visited-file-name filename (not confirm))))
|
|
428
|
2363 (set-buffer-modified-p t)
|
|
1333
|
2364 ;; Make buffer writable if file is writable.
|
|
|
2365 (and buffer-file-name
|
|
|
2366 (file-writable-p buffer-file-name)
|
|
|
2367 (setq buffer-read-only nil))
|
|
428
|
2368 (if codesys
|
|
|
2369 (let ((buffer-file-coding-system (get-coding-system codesys)))
|
|
|
2370 (save-buffer))
|
|
|
2371 (save-buffer)))
|
|
|
2372
|
|
1333
|
2373
|
|
428
|
2374 (defun backup-buffer ()
|
|
|
2375 "Make a backup of the disk file visited by the current buffer, if appropriate.
|
|
|
2376 This is normally done before saving the buffer the first time.
|
|
1333
|
2377 If the value is non-nil, it is the result of `file-modes' on the original
|
|
|
2378 file; this means that the caller, after saving the buffer, should change
|
|
|
2379 the modes of the new file to agree with the old modes.
|
|
|
2380
|
|
|
2381 A backup may be done by renaming or by copying; see documentation of
|
|
|
2382 variable `make-backup-files'. If it's done by renaming, then the file is
|
|
|
2383 no longer accessible under its old name."
|
|
428
|
2384 (if buffer-file-name
|
|
|
2385 (let ((handler (find-file-name-handler buffer-file-name 'backup-buffer)))
|
|
|
2386 (if handler
|
|
|
2387 (funcall handler 'backup-buffer)
|
|
|
2388 (if (and make-backup-files
|
|
|
2389 (not backup-inhibited)
|
|
|
2390 (not buffer-backed-up)
|
|
|
2391 (file-exists-p buffer-file-name)
|
|
|
2392 (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
|
|
|
2393 '(?- ?l)))
|
|
|
2394 (let ((real-file-name buffer-file-name)
|
|
|
2395 backup-info backupname targets setmodes)
|
|
|
2396 ;; If specified name is a symbolic link, chase it to the target.
|
|
|
2397 ;; Thus we make the backups in the directory where the real file is.
|
|
|
2398 (setq real-file-name (file-chase-links real-file-name))
|
|
|
2399 (setq backup-info (find-backup-file-name real-file-name)
|
|
|
2400 backupname (car backup-info)
|
|
|
2401 targets (cdr backup-info))
|
|
|
2402 ;;; (if (file-directory-p buffer-file-name)
|
|
|
2403 ;;; (error "Cannot save buffer in directory %s" buffer-file-name))
|
|
|
2404 (if backup-info
|
|
|
2405 (condition-case ()
|
|
|
2406 (let ((delete-old-versions
|
|
|
2407 ;; If have old versions to maybe delete,
|
|
|
2408 ;; ask the user to confirm now, before doing anything.
|
|
440
|
2409 ;; But don't actually delete till later.
|
|
428
|
2410 (and targets
|
|
|
2411 (or (eq delete-old-versions t)
|
|
|
2412 (eq delete-old-versions nil))
|
|
|
2413 (or delete-old-versions
|
|
|
2414 (y-or-n-p (format "Delete excess backup versions of %s? "
|
|
|
2415 real-file-name))))))
|
|
|
2416 ;; Actually write the back up file.
|
|
|
2417 (condition-case ()
|
|
|
2418 (if (or file-precious-flag
|
|
|
2419 ; (file-symlink-p buffer-file-name)
|
|
|
2420 backup-by-copying
|
|
|
2421 (and backup-by-copying-when-linked
|
|
|
2422 (> (file-nlinks real-file-name) 1))
|
|
1333
|
2423 (and (or backup-by-copying-when-mismatch
|
|
|
2424 (integerp backup-by-copying-when-privileged-mismatch))
|
|
428
|
2425 (let ((attr (file-attributes real-file-name)))
|
|
1333
|
2426 (and (or backup-by-copying-when-mismatch
|
|
|
2427 (and (integerp (nth 2 attr))
|
|
|
2428 (integerp backup-by-copying-when-privileged-mismatch)
|
|
|
2429 (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
|
|
|
2430 (or (nth 9 attr)
|
|
|
2431 (not (file-ownership-preserved-p real-file-name)))))))
|
|
428
|
2432 (condition-case ()
|
|
|
2433 (copy-file real-file-name backupname t t)
|
|
|
2434 (file-error
|
|
|
2435 ;; If copying fails because file BACKUPNAME
|
|
|
2436 ;; is not writable, delete that file and try again.
|
|
|
2437 (if (and (file-exists-p backupname)
|
|
|
2438 (not (file-writable-p backupname)))
|
|
|
2439 (delete-file backupname))
|
|
|
2440 (copy-file real-file-name backupname t t)))
|
|
|
2441 ;; rename-file should delete old backup.
|
|
|
2442 (rename-file real-file-name backupname t)
|
|
|
2443 (setq setmodes (file-modes backupname)))
|
|
|
2444 (file-error
|
|
2710
|
2445 ;; If trouble writing the backup, write
|
|
|
2446 ;; it in `auto-save-directory'. Fall
|
|
|
2447 ;; back to $HOME if that's not possible.
|
|
464
|
2448 (setq backupname
|
|
2710
|
2449 (expand-file-name "%backup%~"
|
|
|
2450 (or (when (and auto-save-directory
|
|
|
2451 (file-writable-p auto-save-directory))
|
|
|
2452 auto-save-directory)
|
|
|
2453 (getenv "HOME"))))
|
|
1333
|
2454 (lwarn 'file 'alert "Cannot write backup file; backing up in %s"
|
|
|
2455 (file-name-nondirectory backupname))
|
|
428
|
2456 (sleep-for 1)
|
|
|
2457 (condition-case ()
|
|
|
2458 (copy-file real-file-name backupname t t)
|
|
|
2459 (file-error
|
|
|
2460 ;; If copying fails because file BACKUPNAME
|
|
|
2461 ;; is not writable, delete that file and try again.
|
|
|
2462 (if (and (file-exists-p backupname)
|
|
|
2463 (not (file-writable-p backupname)))
|
|
|
2464 (delete-file backupname))
|
|
|
2465 (copy-file real-file-name backupname t t)))))
|
|
|
2466 (setq buffer-backed-up t)
|
|
|
2467 ;; Now delete the old versions, if desired.
|
|
|
2468 (if delete-old-versions
|
|
|
2469 (while targets
|
|
|
2470 (ignore-file-errors (delete-file (car targets)))
|
|
|
2471 (setq targets (cdr targets))))
|
|
|
2472 setmodes)
|
|
|
2473 (file-error nil)))))))))
|
|
|
2474
|
|
|
2475 (defun file-name-sans-versions (name &optional keep-backup-version)
|
|
|
2476 "Return FILENAME sans backup versions or strings.
|
|
|
2477 This is a separate procedure so your site-init or startup file can
|
|
|
2478 redefine it.
|
|
|
2479 If the optional argument KEEP-BACKUP-VERSION is non-nil,
|
|
|
2480 we do not remove backup version numbers, only true file version numbers."
|
|
|
2481 (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
|
|
|
2482 (if handler
|
|
|
2483 (funcall handler 'file-name-sans-versions name keep-backup-version)
|
|
|
2484 (substring name 0
|
|
|
2485 (if keep-backup-version
|
|
|
2486 (length name)
|
|
|
2487 (or (string-match "\\.~[0-9.]+~\\'" name)
|
|
|
2488 ;; XEmacs - VC uses extensions like ".~tagname~" or ".~1.1.5.2~"
|
|
|
2489 (let ((pos (string-match "\\.~\\([^.~ \t]+\\|[0-9.]+\\)~\\'" name)))
|
|
|
2490 (and pos
|
|
|
2491 ;; #### - is this filesystem check too paranoid?
|
|
|
2492 (file-exists-p (substring name 0 pos))
|
|
|
2493 pos))
|
|
|
2494 (string-match "~\\'" name)
|
|
|
2495 (length name)))))))
|
|
|
2496
|
|
|
2497 (defun file-ownership-preserved-p (file)
|
|
|
2498 "Return t if deleting FILE and rewriting it would preserve the owner."
|
|
|
2499 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
|
|
|
2500 (if handler
|
|
|
2501 (funcall handler 'file-ownership-preserved-p file)
|
|
|
2502 (let ((attributes (file-attributes file)))
|
|
|
2503 ;; Return t if the file doesn't exist, since it's true that no
|
|
|
2504 ;; information would be lost by an (attempted) delete and create.
|
|
|
2505 (or (null attributes)
|
|
|
2506 (= (nth 2 attributes) (user-uid)))))))
|
|
|
2507
|
|
|
2508 (defun file-name-sans-extension (filename)
|
|
|
2509 "Return FILENAME sans final \"extension\".
|
|
|
2510 The extension, in a file name, is the part that follows the last `.'."
|
|
|
2511 (save-match-data
|
|
|
2512 (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
|
|
|
2513 directory)
|
|
|
2514 (if (string-match "\\.[^.]*\\'" file)
|
|
|
2515 (if (setq directory (file-name-directory filename))
|
|
|
2516 (expand-file-name (substring file 0 (match-beginning 0))
|
|
|
2517 directory)
|
|
|
2518 (substring file 0 (match-beginning 0)))
|
|
|
2519 filename))))
|
|
|
2520
|
|
|
2521 (defun file-name-extension (filename &optional period)
|
|
|
2522 "Return FILENAME's final \"extension\".
|
|
|
2523 The extension, in a file name, is the part that follows the last `.'.
|
|
|
2524 Return nil for extensionless file names such as `foo'.
|
|
3061
|
2525 Return the empty string for file names such as `foo'.
|
|
428
|
2526
|
|
|
2527 If PERIOD is non-nil, then the returned value includes the period
|
|
|
2528 that delimits the extension, and if FILENAME has no extension,
|
|
|
2529 the value is \"\"."
|
|
|
2530 (save-match-data
|
|
|
2531 (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
|
|
|
2532 (if (string-match "\\.[^.]*\\'" file)
|
|
|
2533 (substring file (+ (match-beginning 0) (if period 0 1)))
|
|
|
2534 (if period
|
|
|
2535 "")))))
|
|
|
2536
|
|
1333
|
2537 (defcustom make-backup-file-name-function nil
|
|
|
2538 "A function to use instead of the default `make-backup-file-name'.
|
|
|
2539 A value of nil gives the default `make-backup-file-name' behaviour.
|
|
|
2540
|
|
|
2541 This could be buffer-local to do something special for specific
|
|
|
2542 files. If you define it, you may need to change `backup-file-name-p'
|
|
|
2543 and `file-name-sans-versions' too.
|
|
|
2544
|
|
|
2545 See also `backup-directory-alist'."
|
|
|
2546 :group 'backup
|
|
|
2547 :type '(choice (const :tag "Default" nil)
|
|
|
2548 (function :tag "Your function")))
|
|
|
2549
|
|
|
2550 (defcustom backup-directory-alist nil
|
|
|
2551 "Alist of filename patterns and backup directory names.
|
|
|
2552 Each element looks like (REGEXP . DIRECTORY). Backups of files with
|
|
|
2553 names matching REGEXP will be made in DIRECTORY. DIRECTORY may be
|
|
|
2554 relative or absolute. If it is absolute, so that all matching files
|
|
|
2555 are backed up into the same directory, the file names in this
|
|
|
2556 directory will be the full name of the file backed up with all
|
|
|
2557 directory separators changed to `!' to prevent clashes. This will not
|
|
|
2558 work correctly if your filesystem truncates the resulting name.
|
|
|
2559
|
|
|
2560 For the common case of all backups going into one directory, the alist
|
|
|
2561 should contain a single element pairing \".\" with the appropriate
|
|
|
2562 directory name.
|
|
|
2563
|
|
|
2564 If this variable is nil, or it fails to match a filename, the backup
|
|
|
2565 is made in the original file's directory.
|
|
|
2566
|
|
|
2567 On MS-DOS filesystems without long names this variable is always
|
|
|
2568 ignored."
|
|
|
2569 :group 'backup
|
|
|
2570 :type '(repeat (cons (regexp :tag "Regexp matching filename")
|
|
|
2571 (directory :tag "Backup directory name"))))
|
|
|
2572
|
|
428
|
2573 (defun make-backup-file-name (file)
|
|
|
2574 "Create the non-numeric backup file name for FILE.
|
|
1333
|
2575 Normally this will just be the file's name with `~' appended.
|
|
|
2576 Customization hooks are provided as follows.
|
|
|
2577
|
|
|
2578 If the variable `make-backup-file-name-function' is non-nil, its value
|
|
|
2579 should be a function which will be called with FILE as its argument;
|
|
|
2580 the resulting name is used.
|
|
|
2581
|
|
|
2582 Otherwise a match for FILE is sought in `backup-directory-alist'; see
|
|
|
2583 the documentation of that variable. If the directory for the backup
|
|
|
2584 doesn't exist, it is created."
|
|
|
2585 (if make-backup-file-name-function
|
|
|
2586 (funcall make-backup-file-name-function file)
|
|
|
2587 ; (if (and (eq system-type 'ms-dos)
|
|
|
2588 ; (not (msdos-long-file-names)))
|
|
|
2589 ; (let ((fn (file-name-nondirectory file)))
|
|
|
2590 ; (concat (file-name-directory file)
|
|
|
2591 ; (or (and (string-match "\\`[^.]+\\'" fn)
|
|
|
2592 ; (concat (match-string 0 fn) ".~"))
|
|
|
2593 ; (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
|
|
|
2594 ; (concat (match-string 0 fn) "~")))))
|
|
|
2595 (concat (make-backup-file-name-1 file) "~")))
|
|
|
2596
|
|
|
2597 (defun make-backup-file-name-1 (file)
|
|
|
2598 "Subroutine of `make-backup-file-name' and `find-backup-file-name'."
|
|
|
2599 (let ((alist backup-directory-alist)
|
|
|
2600 elt backup-directory dir-sep-string)
|
|
|
2601 (while alist
|
|
|
2602 (setq elt (pop alist))
|
|
|
2603 (if (string-match (car elt) file)
|
|
|
2604 (setq backup-directory (cdr elt)
|
|
|
2605 alist nil)))
|
|
|
2606 (if (null backup-directory)
|
|
|
2607 file
|
|
|
2608 (unless (file-exists-p backup-directory)
|
|
|
2609 (condition-case nil
|
|
|
2610 (make-directory backup-directory 'parents)
|
|
|
2611 (file-error file)))
|
|
|
2612 (if (file-name-absolute-p backup-directory)
|
|
|
2613 (progn
|
|
|
2614 (when (memq system-type '(windows-nt ms-dos))
|
|
|
2615 ;; Normalize DOSish file names: convert all slashes to
|
|
|
2616 ;; directory-sep-char, downcase the drive letter, if any,
|
|
|
2617 ;; and replace the leading "x:" with "/drive_x".
|
|
|
2618 (or (file-name-absolute-p file)
|
|
|
2619 (setq file (expand-file-name file))) ; make defaults explicit
|
|
|
2620 ;; Replace any invalid file-name characters (for the
|
|
|
2621 ;; case of backing up remote files).
|
|
|
2622 (setq file (expand-file-name (convert-standard-filename file)))
|
|
|
2623 (setq dir-sep-string (char-to-string directory-sep-char))
|
|
|
2624 (if (eq (aref file 1) ?:)
|
|
|
2625 (setq file (concat dir-sep-string
|
|
|
2626 "drive_"
|
|
|
2627 (char-to-string (downcase (aref file 0)))
|
|
|
2628 (if (eq (aref file 2) directory-sep-char)
|
|
|
2629 ""
|
|
|
2630 dir-sep-string)
|
|
|
2631 (substring file 2)))))
|
|
|
2632 ;; Make the name unique by substituting directory
|
|
|
2633 ;; separators. It may not really be worth bothering about
|
|
|
2634 ;; doubling `!'s in the original name...
|
|
|
2635 (expand-file-name
|
|
|
2636 (subst-char-in-string
|
|
|
2637 directory-sep-char ?!
|
|
|
2638 (replace-regexp-in-string "!" "!!" file))
|
|
|
2639 backup-directory))
|
|
|
2640 (expand-file-name (file-name-nondirectory file)
|
|
|
2641 (file-name-as-directory
|
|
|
2642 (expand-file-name backup-directory
|
|
|
2643 (file-name-directory file))))))))
|
|
428
|
2644
|
|
|
2645 (defun backup-file-name-p (file)
|
|
|
2646 "Return non-nil if FILE is a backup file name (numeric or not).
|
|
|
2647 This is a separate function so you can redefine it for customization.
|
|
|
2648 You may need to redefine `file-name-sans-versions' as well."
|
|
440
|
2649 (string-match "~\\'" file))
|
|
428
|
2650
|
|
1333
|
2651 (defvar backup-extract-version-start)
|
|
|
2652
|
|
428
|
2653 ;; This is used in various files.
|
|
1333
|
2654 ;; The usage of backup-extract-version-start is not very clean,
|
|
|
2655 ;; but I can't see a good alternative, so as of now I am leaving it alone.
|
|
428
|
2656 (defun backup-extract-version (fn)
|
|
1333
|
2657 "Given the name of a numeric backup file, FN, return the backup number.
|
|
|
2658 Uses the free variable `backup-extract-version-start', whose value should be
|
|
428
|
2659 the index in the name where the version number begins."
|
|
1333
|
2660 (if (and (string-match "[0-9]+~$" fn backup-extract-version-start)
|
|
|
2661 (= (match-beginning 0) backup-extract-version-start))
|
|
|
2662 (string-to-int (substring fn backup-extract-version-start -1))
|
|
428
|
2663 0))
|
|
|
2664
|
|
1333
|
2665 ;; [[ FSF 21.2 says:
|
|
|
2666 ;; I believe there is no need to alter this behavior for VMS;
|
|
|
2667 ;; since backup files are not made on VMS, it should not get called. ]]
|
|
428
|
2668 (defun find-backup-file-name (fn)
|
|
1333
|
2669 "Find a file name for a backup file FN, and suggestions for deletions.
|
|
428
|
2670 Value is a list whose car is the name for the backup file
|
|
1333
|
2671 and whose cdr is a list of old versions to consider deleting now.
|
|
|
2672 If the value is nil, don't make a backup.
|
|
|
2673 Uses `backup-directory-alist' in the same way as does
|
|
|
2674 `make-backup-file-name'."
|
|
428
|
2675 (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
|
|
|
2676 ;; Run a handler for this function so that ange-ftp can refuse to do it.
|
|
|
2677 (if handler
|
|
|
2678 (funcall handler 'find-backup-file-name fn)
|
|
1333
|
2679 (if (or (eq version-control 'never)
|
|
|
2680 ;; We don't support numbered backups on plain MS-DOS
|
|
|
2681 ;; when long file names are unavailable.
|
|
|
2682 ; (and (eq system-type 'ms-dos)
|
|
|
2683 ; (not (msdos-long-file-names)))
|
|
|
2684 )
|
|
428
|
2685 (list (make-backup-file-name fn))
|
|
1333
|
2686 (let* ((basic-name (make-backup-file-name-1 fn))
|
|
|
2687 (base-versions (concat (file-name-nondirectory basic-name)
|
|
|
2688 ".~"))
|
|
|
2689 (backup-extract-version-start (length base-versions))
|
|
428
|
2690 (high-water-mark 0)
|
|
1333
|
2691 (number-to-delete 0)
|
|
|
2692 possibilities deserve-versions-p versions)
|
|
428
|
2693 (condition-case ()
|
|
|
2694 (setq possibilities (file-name-all-completions
|
|
|
2695 base-versions
|
|
1333
|
2696 (file-name-directory basic-name))
|
|
|
2697 versions (sort (mapcar #'backup-extract-version
|
|
|
2698 possibilities)
|
|
|
2699 #'<)
|
|
|
2700 high-water-mark (apply 'max 0 versions)
|
|
428
|
2701 deserve-versions-p (or version-control
|
|
|
2702 (> high-water-mark 0))
|
|
|
2703 number-to-delete (- (length versions)
|
|
1333
|
2704 kept-old-versions
|
|
|
2705 kept-new-versions
|
|
|
2706 -1))
|
|
|
2707 (file-error (setq possibilities nil)))
|
|
428
|
2708 (if (not deserve-versions-p)
|
|
|
2709 (list (make-backup-file-name fn))
|
|
1333
|
2710 (cons (format "%s.~%d~" basic-name (1+ high-water-mark))
|
|
428
|
2711 (if (and (> number-to-delete 0)
|
|
|
2712 ;; Delete nothing if there is overflow
|
|
|
2713 ;; in the number of versions to keep.
|
|
|
2714 (>= (+ kept-new-versions kept-old-versions -1) 0))
|
|
1333
|
2715 (mapcar (lambda (n)
|
|
|
2716 (format "%s.~%d~" basic-name n))
|
|
428
|
2717 (let ((v (nthcdr kept-old-versions versions)))
|
|
|
2718 (rplacd (nthcdr (1- number-to-delete) v) ())
|
|
|
2719 v))))))))))
|
|
|
2720
|
|
|
2721 (defun file-nlinks (filename)
|
|
|
2722 "Return number of names file FILENAME has."
|
|
|
2723 (car (cdr (file-attributes filename))))
|
|
|
2724
|
|
|
2725 (defun file-relative-name (filename &optional directory)
|
|
1333
|
2726 "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
|
|
428
|
2727 This function returns a relative file name which is equivalent to FILENAME
|
|
|
2728 when used with that default directory as the default.
|
|
442
|
2729 If this is impossible (which can happen on MS Windows when the file name
|
|
|
2730 and directory use different drive names) then it returns FILENAME."
|
|
428
|
2731 (save-match-data
|
|
|
2732 (let ((fname (expand-file-name filename)))
|
|
|
2733 (setq directory (file-name-as-directory
|
|
|
2734 (expand-file-name (or directory default-directory))))
|
|
|
2735 ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
|
|
|
2736 ;; drive names, they can't be relative, so return the absolute name.
|
|
440
|
2737 (if (and (eq system-type 'windows-nt)
|
|
428
|
2738 (not (string-equal (substring fname 0 2)
|
|
|
2739 (substring directory 0 2))))
|
|
|
2740 filename
|
|
|
2741 (let ((ancestor ".")
|
|
|
2742 (fname-dir (file-name-as-directory fname)))
|
|
|
2743 (while (and (not (string-match (concat "^" (regexp-quote directory))
|
|
|
2744 fname-dir))
|
|
|
2745 (not (string-match (concat "^" (regexp-quote directory)) fname)))
|
|
|
2746 (setq directory (file-name-directory (substring directory 0 -1))
|
|
|
2747 ancestor (if (equal ancestor ".")
|
|
|
2748 ".."
|
|
|
2749 (concat "../" ancestor))))
|
|
|
2750 ;; Now ancestor is empty, or .., or ../.., etc.
|
|
|
2751 (if (string-match (concat "^" (regexp-quote directory)) fname)
|
|
|
2752 ;; We matched within FNAME's directory part.
|
|
|
2753 ;; Add the rest of FNAME onto ANCESTOR.
|
|
|
2754 (let ((rest (substring fname (match-end 0))))
|
|
|
2755 (if (and (equal ancestor ".")
|
|
|
2756 (not (equal rest "")))
|
|
|
2757 ;; But don't bother with ANCESTOR if it would give us `./'.
|
|
|
2758 rest
|
|
|
2759 (concat (file-name-as-directory ancestor) rest)))
|
|
|
2760 ;; We matched FNAME's directory equivalent.
|
|
|
2761 ancestor))))))
|
|
|
2762
|
|
|
2763 (defun save-buffer (&optional args)
|
|
|
2764 "Save current buffer in visited file if modified. Versions described below.
|
|
|
2765 By default, makes the previous version into a backup file
|
|
|
2766 if previously requested or if this is the first save.
|
|
1333
|
2767 With 1 \\[universal-argument], marks this version
|
|
428
|
2768 to become a backup when the next save is done.
|
|
1333
|
2769 With 2 \\[universal-argument]'s,
|
|
428
|
2770 unconditionally makes the previous version into a backup file.
|
|
1333
|
2771 With 3 \\[universal-argument]'s, marks this version
|
|
|
2772 to become a backup when the next save is done,
|
|
|
2773 and unconditionally makes the previous version into a backup file.
|
|
|
2774
|
|
|
2775 With argument of 0, never make the previous version into a backup file.
|
|
428
|
2776
|
|
|
2777 If a file's name is FOO, the names of its numbered backup versions are
|
|
|
2778 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
|
|
|
2779 Numeric backups (rather than FOO~) will be made if value of
|
|
|
2780 `version-control' is not the atom `never' and either there are already
|
|
|
2781 numeric versions of the file being backed up, or `version-control' is
|
|
|
2782 non-nil.
|
|
|
2783 We don't want excessive versions piling up, so there are variables
|
|
1333
|
2784 `kept-old-versions', which tells Emacs how many oldest versions to keep,
|
|
428
|
2785 and `kept-new-versions', which tells how many newest versions to keep.
|
|
|
2786 Defaults are 2 old versions and 2 new.
|
|
|
2787 `dired-kept-versions' controls dired's clean-directory (.) command.
|
|
|
2788 If `delete-old-versions' is nil, system will query user
|
|
1333
|
2789 before trimming versions. Otherwise it does it silently.
|
|
|
2790
|
|
|
2791 If `vc-make-backup-files' is nil, which is the default,
|
|
|
2792 no backup files are made for files managed by version control.
|
|
|
2793 (This is because the version control system itself records previous versions.)
|
|
|
2794
|
|
|
2795 See the subroutine `basic-save-buffer' for more information."
|
|
428
|
2796 (interactive "_p")
|
|
|
2797 (let ((modp (buffer-modified-p))
|
|
|
2798 (large (> (buffer-size) 50000))
|
|
|
2799 (make-backup-files (or (and make-backup-files (not (eq args 0)))
|
|
|
2800 (memq args '(16 64)))))
|
|
|
2801 (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
|
|
1333
|
2802 (if (and modp large (buffer-file-name))
|
|
|
2803 (display-message 'progress (format "Saving file %s..."
|
|
|
2804 (buffer-file-name))))
|
|
428
|
2805 (basic-save-buffer)
|
|
|
2806 (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
|
|
|
2807
|
|
|
2808 (defun delete-auto-save-file-if-necessary (&optional force)
|
|
|
2809 "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
|
|
1333
|
2810 Normally delete only if the file was written by this XEmacs since
|
|
|
2811 the last real save, but optional arg FORCE non-nil means delete anyway."
|
|
428
|
2812 (and buffer-auto-save-file-name delete-auto-save-files
|
|
|
2813 (not (string= buffer-file-name buffer-auto-save-file-name))
|
|
|
2814 (or force (recent-auto-save-p))
|
|
|
2815 (progn
|
|
|
2816 (ignore-file-errors (delete-file buffer-auto-save-file-name))
|
|
|
2817 (set-buffer-auto-saved))))
|
|
|
2818
|
|
|
2819 ;; XEmacs change (from Sun)
|
|
|
2820 ;; used to communicate with continue-save-buffer:
|
|
|
2821 (defvar continue-save-buffer-hooks-tail nil)
|
|
|
2822
|
|
|
2823 ;; Not in FSFmacs
|
|
|
2824 (defun basic-write-file-data (realname truename)
|
|
|
2825 ;; call the hooks until the bytes are put
|
|
|
2826 ;; call write-region as a last resort
|
|
|
2827 (let ((region-written nil)
|
|
|
2828 (hooks write-file-data-hooks))
|
|
|
2829 (while (and hooks (not region-written))
|
|
|
2830 (setq region-written (funcall (car hooks) realname)
|
|
|
2831 hooks (cdr hooks)))
|
|
|
2832 (if (not region-written)
|
|
|
2833 (write-region (point-min) (point-max) realname nil t truename))))
|
|
|
2834
|
|
1333
|
2835 ; (defvar auto-save-hook nil
|
|
|
2836 ; "Normal hook run just before auto-saving.")
|
|
|
2837
|
|
428
|
2838 (put 'after-save-hook 'permanent-local t)
|
|
|
2839 (defvar after-save-hook nil
|
|
|
2840 "Normal hook that is run after a buffer is saved to its file.
|
|
|
2841 These hooks are considered to pertain to the visited file.
|
|
|
2842 So this list is cleared if you change the visited file name.")
|
|
|
2843
|
|
1333
|
2844 (defvar save-buffer-coding-system nil
|
|
|
2845 "If non-nil, use this coding system for saving the buffer.
|
|
|
2846 More precisely, use this coding system in place of the
|
|
|
2847 value of `buffer-file-coding-system', when saving the buffer.
|
|
|
2848 Calling `write-region' for any purpose other than saving the buffer
|
|
|
2849 will still use `buffer-file-coding-system'; this variable has no effect
|
|
|
2850 in such cases.")
|
|
|
2851
|
|
|
2852 (make-variable-buffer-local 'save-buffer-coding-system)
|
|
|
2853 (put 'save-buffer-coding-system 'permanent-local t)
|
|
|
2854
|
|
428
|
2855 (defun files-fetch-hook-value (hook)
|
|
4156
|
2856 (let ((localval (copy-list (symbol-value hook)))
|
|
|
2857 (globalval (copy-list (default-value hook))))
|
|
428
|
2858 (if (memq t localval)
|
|
|
2859 (setq localval (append (delq t localval) (delq t globalval))))
|
|
|
2860 localval))
|
|
|
2861
|
|
|
2862 (defun basic-save-buffer ()
|
|
|
2863 "Save the current buffer in its visited file, if it has been modified.
|
|
1333
|
2864 The hooks `write-contents-hooks', `local-write-file-hooks' and
|
|
|
2865 `write-file-hooks' get a chance to do the job of saving; if they do not,
|
|
2116
|
2866 then the buffer is saved in the visited file in the usual way.
|
|
1333
|
2867 After saving the buffer, this function runs `after-save-hook'."
|
|
428
|
2868 (interactive)
|
|
1333
|
2869 (save-current-buffer
|
|
428
|
2870 ;; In an indirect buffer, save its base buffer instead.
|
|
|
2871 (if (buffer-base-buffer)
|
|
|
2872 (set-buffer (buffer-base-buffer)))
|
|
|
2873 (if (buffer-modified-p)
|
|
|
2874 (let ((recent-save (recent-auto-save-p)))
|
|
|
2875 ;; If buffer has no file name, ask user for one.
|
|
|
2876 (or buffer-file-name
|
|
|
2877 (let ((filename
|
|
|
2878 (expand-file-name
|
|
|
2879 (read-file-name "File to save in: ") nil)))
|
|
|
2880 (and (file-exists-p filename)
|
|
|
2881 (or (y-or-n-p (format "File `%s' exists; overwrite? "
|
|
|
2882 filename))
|
|
|
2883 (error "Canceled")))
|
|
|
2884 (set-visited-file-name filename)))
|
|
|
2885 (or (verify-visited-file-modtime (current-buffer))
|
|
|
2886 (not (file-exists-p buffer-file-name))
|
|
|
2887 (yes-or-no-p
|
|
|
2888 (format "%s has changed since visited or saved. Save anyway? "
|
|
|
2889 (file-name-nondirectory buffer-file-name)))
|
|
|
2890 (error "Save not confirmed"))
|
|
|
2891 (save-restriction
|
|
|
2892 (widen)
|
|
1333
|
2893 (save-excursion
|
|
|
2894 (and (> (point-max) 1)
|
|
|
2895 (not find-file-literally)
|
|
|
2896 (not (eq (char-after (1- (point-max))) ?\n))
|
|
|
2897 (not (and (eq selective-display t)
|
|
|
2898 (eq (char-after (1- (point-max))) ?\r)))
|
|
|
2899 (or (eq require-final-newline t)
|
|
|
2900 (and require-final-newline
|
|
|
2901 (y-or-n-p
|
|
|
2902 (format "Buffer %s does not end in newline. Add one? "
|
|
|
2903 (buffer-name)))))
|
|
|
2904 (save-excursion
|
|
|
2905 (goto-char (point-max))
|
|
|
2906 (insert ?\n))))
|
|
|
2907
|
|
|
2908 ;; Support VC version backups.
|
|
|
2909 (if-fboundp 'vc-before-save
|
|
|
2910 (vc-before-save))
|
|
434
|
2911
|
|
444
|
2912 ;; Run the write-file-hooks until one returns non-nil.
|
|
428
|
2913 ;; Bind after-save-hook to nil while running the
|
|
|
2914 ;; write-file-hooks so that if this function is called
|
|
|
2915 ;; recursively (from inside a write-file-hook) the
|
|
|
2916 ;; after-hooks will only get run once (from the
|
|
|
2917 ;; outermost call).
|
|
|
2918 ;;
|
|
|
2919 ;; Ugh, have to duplicate logic of run-hook-with-args-until-success
|
|
|
2920 (let ((hooks (append (files-fetch-hook-value 'write-contents-hooks)
|
|
|
2921 (files-fetch-hook-value
|
|
|
2922 'local-write-file-hooks)
|
|
|
2923 (files-fetch-hook-value 'write-file-hooks)))
|
|
|
2924 (after-save-hook nil)
|
|
|
2925 (local-write-file-hooks nil)
|
|
|
2926 (write-contents-hooks nil)
|
|
|
2927 (write-file-hooks nil)
|
|
|
2928 done)
|
|
|
2929 (while (and hooks
|
|
|
2930 (let ((continue-save-buffer-hooks-tail hooks))
|
|
|
2931 (not (setq done (funcall (car hooks))))))
|
|
|
2932 (setq hooks (cdr hooks)))
|
|
|
2933 ;; If a hook returned t, file is already "written".
|
|
|
2934 ;; Otherwise, write it the usual way now.
|
|
|
2935 (if (not done)
|
|
|
2936 (basic-save-buffer-1)))
|
|
|
2937 ;; XEmacs: next two clauses (buffer-file-number setting and
|
|
1333
|
2938 ;; set-file-modes) moved into basic-save-buffer-1 for use by
|
|
|
2939 ;; continue-save-buffer.
|
|
428
|
2940 )
|
|
|
2941 ;; If the auto-save file was recent before this command,
|
|
|
2942 ;; delete it now.
|
|
|
2943 (delete-auto-save-file-if-necessary recent-save)
|
|
|
2944 ;; Support VC `implicit' locking.
|
|
502
|
2945 (if-fboundp 'vc-after-save
|
|
|
2946 (vc-after-save))
|
|
428
|
2947 (run-hooks 'after-save-hook))
|
|
|
2948 (display-message 'no-log "(No changes need to be saved)"))))
|
|
|
2949
|
|
|
2950 ;; This does the "real job" of writing a buffer into its visited file
|
|
|
2951 ;; and making a backup file. This is what is normally done
|
|
|
2952 ;; but inhibited if one of write-file-hooks returns non-nil.
|
|
|
2953 ;; It returns a value to store in setmodes.
|
|
|
2954 (defun basic-save-buffer-1 ()
|
|
1333
|
2955 (if save-buffer-coding-system
|
|
|
2956 (let ((coding-system-for-write save-buffer-coding-system))
|
|
|
2957 (basic-save-buffer-2))
|
|
|
2958 (basic-save-buffer-2)))
|
|
|
2959
|
|
|
2960 (defun basic-save-buffer-2 ()
|
|
428
|
2961 (let (setmodes tempsetmodes)
|
|
|
2962 (if (not (file-writable-p buffer-file-name))
|
|
|
2963 (let ((dir (file-name-directory buffer-file-name)))
|
|
|
2964 (if (not (file-directory-p dir))
|
|
1333
|
2965 (if (file-exists-p dir)
|
|
|
2966 (error "%s is not a directory" dir)
|
|
|
2967 (error "%s: no such directory" buffer-file-name))
|
|
428
|
2968 (if (not (file-exists-p buffer-file-name))
|
|
|
2969 (error "Directory %s write-protected" dir)
|
|
|
2970 (if (yes-or-no-p
|
|
|
2971 (format "File %s is write-protected; try to save anyway? "
|
|
|
2972 (file-name-nondirectory
|
|
|
2973 buffer-file-name)))
|
|
|
2974 (setq tempsetmodes t)
|
|
|
2975 (error
|
|
|
2976 "Attempt to save to a file which you aren't allowed to write"))))))
|
|
|
2977 (or buffer-backed-up
|
|
|
2978 (setq setmodes (backup-buffer)))
|
|
|
2979 (let ((dir (file-name-directory buffer-file-name)))
|
|
|
2980 (if (and file-precious-flag
|
|
|
2981 (file-writable-p dir))
|
|
|
2982 ;; If file is precious, write temp name, then rename it.
|
|
|
2983 ;; This requires write access to the containing dir,
|
|
|
2984 ;; which is why we don't try it if we don't have that access.
|
|
|
2985 (let ((realname buffer-file-name)
|
|
|
2986 tempname nogood i succeed
|
|
|
2987 (old-modtime (visited-file-modtime)))
|
|
|
2988 (setq i 0)
|
|
|
2989 (setq nogood t)
|
|
|
2990 ;; Find the temporary name to write under.
|
|
|
2991 (while nogood
|
|
|
2992 (setq tempname (format "%s#tmp#%d" dir i))
|
|
|
2993 (setq nogood (file-exists-p tempname))
|
|
|
2994 (setq i (1+ i)))
|
|
|
2995 (unwind-protect
|
|
|
2996 (progn (clear-visited-file-modtime)
|
|
|
2997 (write-region (point-min) (point-max)
|
|
|
2998 tempname nil realname
|
|
|
2999 buffer-file-truename)
|
|
|
3000 (setq succeed t))
|
|
|
3001 ;; If writing the temp file fails,
|
|
|
3002 ;; delete the temp file.
|
|
|
3003 (or succeed
|
|
|
3004 (progn
|
|
1333
|
3005 (ignore-file-errors
|
|
|
3006 (delete-file tempname))
|
|
428
|
3007 (set-visited-file-modtime old-modtime))))
|
|
|
3008 ;; Since we have created an entirely new file
|
|
|
3009 ;; and renamed it, make sure it gets the
|
|
|
3010 ;; right permission bits set.
|
|
|
3011 (setq setmodes (file-modes buffer-file-name))
|
|
|
3012 ;; We succeeded in writing the temp file,
|
|
|
3013 ;; so rename it.
|
|
|
3014 (rename-file tempname buffer-file-name t))
|
|
|
3015 ;; If file not writable, see if we can make it writable
|
|
|
3016 ;; temporarily while we write it.
|
|
|
3017 ;; But no need to do so if we have just backed it up
|
|
|
3018 ;; (setmodes is set) because that says we're superseding.
|
|
|
3019 (cond ((and tempsetmodes (not setmodes))
|
|
|
3020 ;; Change the mode back, after writing.
|
|
|
3021 (setq setmodes (file-modes buffer-file-name))
|
|
1333
|
3022 (set-file-modes buffer-file-name (logior setmodes 128))))
|
|
428
|
3023 (basic-write-file-data buffer-file-name buffer-file-truename)))
|
|
1333
|
3024 ;; #### FSF 21.2. We don't have last-coding-system-used.
|
|
|
3025 ; ;; Now we have saved the current buffer. Let's make sure
|
|
|
3026 ; ;; that buffer-file-coding-system is fixed to what
|
|
|
3027 ; ;; actually used for saving by binding it locally.
|
|
|
3028 ; (if save-buffer-coding-system
|
|
|
3029 ; (setq save-buffer-coding-system last-coding-system-used)
|
|
|
3030 ; (setq buffer-file-coding-system last-coding-system-used))
|
|
428
|
3031 (setq buffer-file-number
|
|
|
3032 (if buffer-file-name
|
|
|
3033 (nth 10 (file-attributes buffer-file-name))
|
|
|
3034 nil))
|
|
|
3035 (if setmodes
|
|
|
3036 (condition-case ()
|
|
|
3037 (set-file-modes buffer-file-name setmodes)
|
|
|
3038 (error nil)))))
|
|
|
3039
|
|
|
3040 ;; XEmacs change, from Sun
|
|
|
3041 (defun continue-save-buffer ()
|
|
|
3042 "Provide a clean way for a write-file-hook to wrap AROUND
|
|
|
3043 the execution of the remaining hooks and writing to disk.
|
|
|
3044 Do not call this function except from a functions
|
|
444
|
3045 on the `write-file-hooks' or `write-contents-hooks' list.
|
|
428
|
3046 A hook that calls this function must return non-nil,
|
|
444
|
3047 to signal completion to its caller. `continue-save-buffer'
|
|
428
|
3048 always returns non-nil."
|
|
|
3049 (let ((hooks (cdr (or continue-save-buffer-hooks-tail
|
|
|
3050 (error
|
|
|
3051 "continue-save-buffer called outside a write-file-hook!"))))
|
|
|
3052 (done nil))
|
|
|
3053 ;; Do something like this:
|
|
|
3054 ;; (let ((write-file-hooks hooks)) (basic-save-buffer))
|
|
|
3055 ;; First run the rest of the hooks.
|
|
|
3056 (while (and hooks
|
|
|
3057 (let ((continue-save-buffer-hooks-tail hooks))
|
|
|
3058 (not (setq done (funcall (car hooks))))))
|
|
|
3059 (setq hooks (cdr hooks)))
|
|
|
3060 ;;
|
|
|
3061 ;; If a hook returned t, file is already "written".
|
|
|
3062 (if (not done)
|
|
|
3063 (basic-save-buffer-1))
|
|
|
3064 'continue-save-buffer))
|
|
|
3065
|
|
|
3066 (defcustom save-some-buffers-query-display-buffer t
|
|
|
3067 "*Non-nil makes `\\[save-some-buffers]' switch to the buffer offered for saving."
|
|
|
3068 :type 'boolean
|
|
|
3069 :group 'editing-basics)
|
|
|
3070
|
|
1333
|
3071 (defun save-some-buffers (&optional arg pred)
|
|
428
|
3072 "Save some modified file-visiting buffers. Asks user about each one.
|
|
|
3073 Optional argument (the prefix) non-nil means save all with no questions.
|
|
1333
|
3074 Optional second argument PRED determines which buffers are considered:
|
|
|
3075 If PRED is nil, all the file-visiting buffers are considered.
|
|
|
3076 If PRED is t, then certain non-file buffers will also be considered.
|
|
|
3077 If PRED is a zero-argument function, it indicates for each buffer whether
|
|
|
3078 to consider it or not when called with that buffer current."
|
|
428
|
3079 (interactive "P")
|
|
|
3080 (save-excursion
|
|
|
3081 ;; `delete-other-windows' can bomb during autoloads generation, so
|
|
|
3082 ;; guard it well.
|
|
|
3083 (if (or noninteractive
|
|
|
3084 (eq (selected-window) (minibuffer-window))
|
|
|
3085 (not save-some-buffers-query-display-buffer))
|
|
|
3086 ;; If playing with windows is unsafe or undesired, just do the
|
|
|
3087 ;; usual drill.
|
|
1333
|
3088 (save-some-buffers-1 arg pred nil)
|
|
428
|
3089 ;; Else, protect the windows.
|
|
|
3090 (when (save-window-excursion
|
|
1333
|
3091 (save-some-buffers-1 arg pred t))
|
|
428
|
3092 ;; Force redisplay.
|
|
|
3093 (sit-for 0)))))
|
|
|
3094
|
|
|
3095 ;; XEmacs - do not use queried flag
|
|
1333
|
3096 (defun save-some-buffers-1 (arg pred switch-buffer)
|
|
428
|
3097 (let* ((switched nil)
|
|
612
|
3098 (last-buffer nil)
|
|
428
|
3099 (files-done
|
|
|
3100 (map-y-or-n-p
|
|
|
3101 (lambda (buffer)
|
|
612
|
3102 (prog1
|
|
|
3103 (and (buffer-modified-p buffer)
|
|
|
3104 (not (buffer-base-buffer buffer))
|
|
|
3105 ;; XEmacs addition:
|
|
|
3106 (not (symbol-value-in-buffer 'save-buffers-skip buffer))
|
|
|
3107 (or
|
|
|
3108 (buffer-file-name buffer)
|
|
1333
|
3109 (and pred
|
|
612
|
3110 (progn
|
|
|
3111 (set-buffer buffer)
|
|
|
3112 (and buffer-offer-save (> (buffer-size) 0)))))
|
|
1333
|
3113 (or (not (functionp pred))
|
|
|
3114 (with-current-buffer buffer (funcall pred)))
|
|
612
|
3115 (if arg
|
|
|
3116 t
|
|
|
3117 ;; #### We should provide a per-buffer means to
|
|
|
3118 ;; disable the switching. For instance, you might
|
|
|
3119 ;; want to turn it off for buffers the contents of
|
|
|
3120 ;; which is meaningless to humans, such as
|
|
|
3121 ;; `.newsrc.eld'.
|
|
|
3122 (when (and switch-buffer
|
|
|
3123 ;; map-y-or-n-p is displaying help
|
|
|
3124 (not (eq last-buffer buffer)))
|
|
|
3125 (unless (one-window-p)
|
|
|
3126 (delete-other-windows))
|
|
|
3127 (setq switched t)
|
|
|
3128 ;; #### Consider using `display-buffer' here for 21.1!
|
|
|
3129 ;;(display-buffer buffer nil (selected-frame)))
|
|
|
3130 (switch-to-buffer buffer t))
|
|
|
3131 (if (buffer-file-name buffer)
|
|
|
3132 (format "Save file %s? "
|
|
|
3133 (buffer-file-name buffer))
|
|
|
3134 (format "Save buffer %s? "
|
|
|
3135 (buffer-name buffer)))))
|
|
|
3136 (setq last-buffer buffer)))
|
|
428
|
3137 (lambda (buffer)
|
|
|
3138 (set-buffer buffer)
|
|
|
3139 (condition-case ()
|
|
|
3140 (save-buffer)
|
|
|
3141 (error nil)))
|
|
|
3142 (buffer-list)
|
|
|
3143 '("buffer" "buffers" "save")
|
|
|
3144 ;;instead of this we just say "yes all", "no all", etc.
|
|
|
3145 ;;"save all the rest"
|
|
|
3146 ;;"save only this buffer" "save no more buffers")
|
|
|
3147 ;; this is rather bogus. --ben
|
|
|
3148 ;; (it makes the dialog box too big, and you get an error
|
|
|
3149 ;; "wrong type argument: framep, nil" when you hit q after
|
|
|
3150 ;; choosing the option from the dialog box)
|
|
|
3151
|
|
|
3152 ;; We should fix the dialog box rather than disabling
|
|
|
3153 ;; this! --hniksic
|
|
|
3154 (list (list ?\C-r (lambda (buf)
|
|
|
3155 ;; #### FSF has an EXIT-ACTION argument
|
|
|
3156 ;; to `view-buffer'.
|
|
1333
|
3157 (view-buffer buf
|
|
|
3158 ; (function
|
|
|
3159 ; (lambda (ignore)
|
|
|
3160 ; (exit-recursive-edit))))
|
|
|
3161 )
|
|
502
|
3162 (with-boundp 'view-exit-action
|
|
|
3163 (setq view-exit-action
|
|
|
3164 (lambda (ignore)
|
|
|
3165 (exit-recursive-edit))))
|
|
428
|
3166 (recursive-edit)
|
|
|
3167 ;; Return nil to ask about BUF again.
|
|
|
3168 nil)
|
|
442
|
3169 "%_Display Buffer"))))
|
|
428
|
3170 (abbrevs-done
|
|
|
3171 (and save-abbrevs abbrevs-changed
|
|
|
3172 (progn
|
|
|
3173 (if (or arg
|
|
1333
|
3174 (eq save-abbrevs 'silently)
|
|
428
|
3175 (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
|
|
|
3176 (write-abbrev-file nil))
|
|
|
3177 ;; Don't keep bothering user if he says no.
|
|
|
3178 (setq abbrevs-changed nil)
|
|
|
3179 t))))
|
|
|
3180 (or (> files-done 0) abbrevs-done
|
|
|
3181 (display-message 'no-log "(No files need saving)"))
|
|
|
3182 switched))
|
|
|
3183
|
|
|
3184
|
|
1333
|
3185
|
|
428
|
3186 (defun not-modified (&optional arg)
|
|
|
3187 "Mark current buffer as unmodified, not needing to be saved.
|
|
|
3188 With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
|
|
|
3189
|
|
|
3190 It is not a good idea to use this function in Lisp programs, because it
|
|
|
3191 prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
|
|
|
3192 (interactive "_P")
|
|
|
3193 (if arg ;; rewritten for I18N3 snarfing
|
|
|
3194 (display-message 'command "Modification-flag set")
|
|
|
3195 (display-message 'command "Modification-flag cleared"))
|
|
|
3196 (set-buffer-modified-p arg))
|
|
|
3197
|
|
|
3198 (defun toggle-read-only (&optional arg)
|
|
1333
|
3199 "Change whether this buffer is visiting its file read-only.
|
|
|
3200 With arg, set read-only iff arg is positive.
|
|
|
3201 If visiting file read-only and `view-read-only' is non-nil, enter view mode."
|
|
|
3202 (interactive "P")
|
|
|
3203 (cond
|
|
|
3204 ((and arg (if (> (prefix-numeric-value arg) 0) buffer-read-only
|
|
|
3205 (not buffer-read-only))) ; If buffer-read-only is set correctly,
|
|
|
3206 nil) ; do nothing.
|
|
|
3207 ;; Toggle.
|
|
|
3208 ((and buffer-read-only view-minor-mode)
|
|
|
3209 ;(View-exit-and-edit)
|
|
|
3210 (view-mode)
|
|
|
3211 (make-local-variable 'view-read-only)
|
|
|
3212 (setq view-read-only t)) ; Must leave view mode.
|
|
|
3213 ((and (not buffer-read-only) view-read-only
|
|
|
3214 (not (eq (get major-mode 'mode-class) 'special)))
|
|
|
3215 ;(view-mode-enter)
|
|
|
3216 (view-mode))
|
|
|
3217 (t (setq buffer-read-only (not buffer-read-only))
|
|
|
3218 (force-mode-line-update))))
|
|
428
|
3219
|
|
|
3220 (defun insert-file (filename &optional codesys)
|
|
|
3221 "Insert contents of file FILENAME into buffer after point.
|
|
|
3222 Set mark after the inserted text.
|
|
|
3223
|
|
771
|
3224 Optional second argument specifies the coding system to use when decoding
|
|
|
3225 the file. Interactively, with a prefix argument, you will be prompted for
|
|
|
3226 the coding system.
|
|
428
|
3227
|
|
771
|
3228 This function is meant for the user to run interactively. Don't call it
|
|
|
3229 from programs! Use `insert-file-contents' instead. \(Its calling sequence
|
|
|
3230 is different; see its documentation)."
|
|
428
|
3231 (interactive "*fInsert file: \nZCoding system: ")
|
|
|
3232 (if (file-directory-p filename)
|
|
|
3233 (signal 'file-error (list "Opening input file" "file is a directory"
|
|
|
3234 filename)))
|
|
|
3235 (let ((tem
|
|
|
3236 (if codesys
|
|
|
3237 (let ((coding-system-for-read
|
|
|
3238 (get-coding-system codesys)))
|
|
|
3239 (insert-file-contents filename))
|
|
|
3240 (insert-file-contents filename))))
|
|
|
3241 (push-mark (+ (point) (car (cdr tem))))))
|
|
|
3242
|
|
|
3243 (defun append-to-file (start end filename &optional codesys)
|
|
|
3244 "Append the contents of the region to the end of file FILENAME.
|
|
771
|
3245 When called from a function, expects three arguments, START, END and
|
|
|
3246 FILENAME. START and END are buffer positions saying what text to write.
|
|
|
3247 Optional fourth argument specifies the coding system to use when encoding
|
|
|
3248 the file. Interactively, with a prefix argument, you will be prompted for
|
|
|
3249 the coding system."
|
|
428
|
3250 (interactive "r\nFAppend to file: \nZCoding system: ")
|
|
|
3251 (if codesys
|
|
|
3252 (let ((buffer-file-coding-system (get-coding-system codesys)))
|
|
|
3253 (write-region start end filename t))
|
|
|
3254 (write-region start end filename t)))
|
|
|
3255
|
|
|
3256 (defun file-newest-backup (filename)
|
|
|
3257 "Return most recent backup file for FILENAME or nil if no backups exist."
|
|
1333
|
3258 ;; `make-backup-file-name' will get us the right directory for
|
|
|
3259 ;; ordinary or numeric backups. It might create a directory for
|
|
|
3260 ;; backups as a side-effect, according to `backup-directory-alist'.
|
|
|
3261 (let* ((filename (file-name-sans-versions
|
|
|
3262 (make-backup-file-name filename)))
|
|
428
|
3263 (file (file-name-nondirectory filename))
|
|
|
3264 (dir (file-name-directory filename))
|
|
|
3265 (comp (file-name-all-completions file dir))
|
|
1333
|
3266 (newest nil)
|
|
|
3267 tem)
|
|
428
|
3268 (while comp
|
|
1333
|
3269 (setq tem (pop comp))
|
|
|
3270 (cond ((and (backup-file-name-p tem)
|
|
|
3271 (string= (file-name-sans-versions tem) file))
|
|
|
3272 (setq tem (concat dir tem))
|
|
|
3273 (if (or (null newest)
|
|
|
3274 (file-newer-than-file-p tem newest))
|
|
|
3275 (setq newest tem)))))
|
|
428
|
3276 newest))
|
|
|
3277
|
|
|
3278 (defun rename-uniquely ()
|
|
|
3279 "Rename current buffer to a similar name not already taken.
|
|
|
3280 This function is useful for creating multiple shell process buffers
|
|
|
3281 or multiple mail buffers, etc."
|
|
|
3282 (interactive)
|
|
|
3283 (save-match-data
|
|
1333
|
3284 (let ((base-name (buffer-name)))
|
|
|
3285 (and (string-match "<[0-9]+>\\'" base-name)
|
|
|
3286 (not (and buffer-file-name
|
|
|
3287 (string= base-name
|
|
|
3288 (file-name-nondirectory buffer-file-name))))
|
|
|
3289 ;; If the existing buffer name has a <NNN>,
|
|
|
3290 ;; which isn't part of the file name (if any),
|
|
|
3291 ;; then get rid of that.
|
|
|
3292 (setq base-name (substring base-name 0 (match-beginning 0))))
|
|
|
3293 (rename-buffer (generate-new-buffer-name base-name))
|
|
|
3294 (force-mode-line-update))))
|
|
428
|
3295
|
|
|
3296 (defun make-directory-path (path)
|
|
|
3297 "Create all the directories along path that don't exist yet."
|
|
|
3298 (interactive "Fdirectory path to create: ")
|
|
|
3299 (make-directory path t))
|
|
|
3300
|
|
|
3301 (defun make-directory (dir &optional parents)
|
|
|
3302 "Create the directory DIR and any nonexistent parent dirs.
|
|
|
3303 Interactively, the default choice of directory to create
|
|
|
3304 is the current default directory for file names.
|
|
|
3305 That is useful when you have visited a file in a nonexistent directory.
|
|
|
3306
|
|
|
3307 Noninteractively, the second (optional) argument PARENTS says whether
|
|
|
3308 to create parent directories if they don't exist."
|
|
|
3309 (interactive (list (let ((current-prefix-arg current-prefix-arg))
|
|
|
3310 (read-directory-name "Create directory: "))
|
|
|
3311 current-prefix-arg))
|
|
|
3312 (let ((handler (find-file-name-handler dir 'make-directory)))
|
|
|
3313 (if handler
|
|
|
3314 (funcall handler 'make-directory dir parents)
|
|
|
3315 (if (not parents)
|
|
|
3316 (make-directory-internal dir)
|
|
|
3317 (let ((dir (directory-file-name (expand-file-name dir)))
|
|
|
3318 create-list)
|
|
|
3319 (while (not (file-exists-p dir))
|
|
|
3320 (setq create-list (cons dir create-list)
|
|
|
3321 dir (directory-file-name (file-name-directory dir))))
|
|
|
3322 (while create-list
|
|
|
3323 (make-directory-internal (car create-list))
|
|
|
3324 (setq create-list (cdr create-list))))))))
|
|
|
3325
|
|
|
3326 (put 'revert-buffer-function 'permanent-local t)
|
|
|
3327 (defvar revert-buffer-function nil
|
|
|
3328 "Function to use to revert this buffer, or nil to do the default.
|
|
|
3329 The function receives two arguments IGNORE-AUTO and NOCONFIRM,
|
|
|
3330 which are the arguments that `revert-buffer' received.")
|
|
|
3331
|
|
|
3332 (put 'revert-buffer-insert-file-contents-function 'permanent-local t)
|
|
|
3333 (defvar revert-buffer-insert-file-contents-function nil
|
|
|
3334 "Function to use to insert contents when reverting this buffer.
|
|
|
3335 Gets two args, first the nominal file name to use,
|
|
849
|
3336 and second, t if reading the auto-save file.
|
|
|
3337 If the current buffer contents are to be discarded, the function must do
|
|
1333
|
3338 so itself.
|
|
|
3339
|
|
|
3340 The function you specify is responsible for updating (or preserving) point.")
|
|
428
|
3341
|
|
|
3342 (defvar before-revert-hook nil
|
|
|
3343 "Normal hook for `revert-buffer' to run before reverting.
|
|
|
3344 If `revert-buffer-function' is used to override the normal revert
|
|
|
3345 mechanism, this hook is not used.")
|
|
|
3346
|
|
|
3347 (defvar after-revert-hook nil
|
|
|
3348 "Normal hook for `revert-buffer' to run after reverting.
|
|
|
3349 Note that the hook value that it runs is the value that was in effect
|
|
|
3350 before reverting; that makes a difference if you have buffer-local
|
|
|
3351 hook functions.
|
|
|
3352
|
|
|
3353 If `revert-buffer-function' is used to override the normal revert
|
|
|
3354 mechanism, this hook is not used.")
|
|
|
3355
|
|
|
3356 (defvar revert-buffer-internal-hook nil
|
|
|
3357 "Don't use this.")
|
|
|
3358
|
|
1333
|
3359 ;; END SYNC WITH FSF 21.2.
|
|
|
3360
|
|
428
|
3361 (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
|
|
|
3362 "Replace the buffer text with the text of the visited file on disk.
|
|
|
3363 This undoes all changes since the file was visited or saved.
|
|
|
3364 With a prefix argument, offer to revert from latest auto-save file, if
|
|
|
3365 that is more recent than the visited file.
|
|
|
3366
|
|
849
|
3367 This command also refreshes certain special buffers that contain text
|
|
|
3368 which doesn't come from a file, but reflects some other data base
|
|
|
3369 instead: for example, Dired buffers and buffer-list buffers. This is
|
|
|
3370 implemented by having the modes set `revert-buffer-function'.
|
|
428
|
3371
|
|
|
3372 When called from Lisp, the first argument is IGNORE-AUTO; only offer
|
|
|
3373 to revert from the auto-save file when this is nil. Note that the
|
|
|
3374 sense of this argument is the reverse of the prefix argument, for the
|
|
|
3375 sake of backward compatibility. IGNORE-AUTO is optional, defaulting
|
|
|
3376 to nil.
|
|
|
3377
|
|
|
3378 Optional second argument NOCONFIRM means don't ask for confirmation at
|
|
|
3379 all.
|
|
|
3380
|
|
|
3381 Optional third argument PRESERVE-MODES non-nil means don't alter
|
|
849
|
3382 the buffer's modes. Otherwise, reinitialize them using `normal-mode'.
|
|
428
|
3383
|
|
|
3384 If the value of `revert-buffer-function' is non-nil, it is called to
|
|
|
3385 do all the work for this command. Otherwise, the hooks
|
|
|
3386 `before-revert-hook' and `after-revert-hook' are run at the beginning
|
|
|
3387 and the end, and if `revert-buffer-insert-file-contents-function' is
|
|
819
|
3388 non-nil, it is called instead of rereading visited file contents.
|
|
|
3389
|
|
849
|
3390 If the buffer-modified flag is nil, and we are not reverting from an
|
|
|
3391 auto-save file, then compare the contents of the buffer and the file.
|
|
|
3392 Revert only if they differ."
|
|
428
|
3393
|
|
|
3394 ;; I admit it's odd to reverse the sense of the prefix argument, but
|
|
|
3395 ;; there is a lot of code out there which assumes that the first
|
|
|
3396 ;; argument should be t to avoid consulting the auto-save file, and
|
|
|
3397 ;; there's no straightforward way to encourage authors to notice a
|
|
|
3398 ;; reversal of the argument sense. So I'm just changing the user
|
|
|
3399 ;; interface, but leaving the programmatic interface the same.
|
|
|
3400 (interactive (list (not current-prefix-arg)))
|
|
|
3401 (if revert-buffer-function
|
|
|
3402 (funcall revert-buffer-function ignore-auto noconfirm)
|
|
|
3403 (let* ((opoint (point))
|
|
819
|
3404 (newbuf nil)
|
|
988
|
3405 (found nil)
|
|
819
|
3406 (delay-prompt nil)
|
|
428
|
3407 (auto-save-p (and (not ignore-auto)
|
|
|
3408 (recent-auto-save-p)
|
|
|
3409 buffer-auto-save-file-name
|
|
|
3410 (file-readable-p buffer-auto-save-file-name)
|
|
|
3411 (y-or-n-p
|
|
|
3412 "Buffer has been auto-saved recently. Revert from auto-save file? ")))
|
|
|
3413 (file-name (if auto-save-p
|
|
|
3414 buffer-auto-save-file-name
|
|
|
3415 buffer-file-name)))
|
|
|
3416 (cond ((null file-name)
|
|
|
3417 (error "Buffer does not seem to be associated with any file"))
|
|
|
3418 ((or noconfirm
|
|
|
3419 (and (not (buffer-modified-p))
|
|
988
|
3420 (dolist (rx revert-without-query found)
|
|
|
3421 (when (string-match rx file-name)
|
|
|
3422 (setq found t))))
|
|
819
|
3423 ;; If we might perform an optimized revert then we
|
|
|
3424 ;; want to delay prompting in case we don't need to
|
|
|
3425 ;; do it at all
|
|
|
3426 (and (not auto-save-p)
|
|
|
3427 (not (buffer-modified-p))
|
|
|
3428 (setq delay-prompt t))
|
|
428
|
3429 (yes-or-no-p (format "Revert buffer from file %s? "
|
|
|
3430 file-name)))
|
|
|
3431 (run-hooks 'before-revert-hook)
|
|
819
|
3432 ;; Only perform our optimized revert if nothing obvious
|
|
|
3433 ;; has changed.
|
|
|
3434 (cond ((or auto-save-p
|
|
|
3435 (buffer-modified-p)
|
|
|
3436 (and (setq newbuf (revert-buffer-internal
|
|
|
3437 file-name))
|
|
988
|
3438 (or noconfirm found
|
|
838
|
3439 (and delay-prompt
|
|
|
3440 (yes-or-no-p
|
|
|
3441 (format "Revert buffer from file %s? "
|
|
|
3442 file-name))))))
|
|
819
|
3443 ;; If file was backed up but has changed since,
|
|
|
3444 ;; we should make another backup.
|
|
|
3445 (and (not auto-save-p)
|
|
|
3446 (not (verify-visited-file-modtime (current-buffer)))
|
|
|
3447 (setq buffer-backed-up nil))
|
|
|
3448 ;; Get rid of all undo records for this buffer.
|
|
|
3449 (or (eq buffer-undo-list t)
|
|
|
3450 (setq buffer-undo-list nil))
|
|
|
3451 ;; Effectively copy the after-revert-hook status,
|
|
|
3452 ;; since after-find-file will clobber it.
|
|
|
3453 (let ((global-hook (default-value 'after-revert-hook))
|
|
|
3454 (local-hook-p (local-variable-p 'after-revert-hook
|
|
|
3455 (current-buffer)))
|
|
|
3456 (local-hook (and (local-variable-p 'after-revert-hook
|
|
|
3457 (current-buffer))
|
|
|
3458 after-revert-hook)))
|
|
|
3459 (let (buffer-read-only
|
|
|
3460 ;; Don't make undo records for the reversion.
|
|
|
3461 (buffer-undo-list t))
|
|
|
3462 (if revert-buffer-insert-file-contents-function
|
|
|
3463 (funcall revert-buffer-insert-file-contents-function
|
|
|
3464 file-name auto-save-p)
|
|
|
3465 (if (not (file-exists-p file-name))
|
|
|
3466 (error "File %s no longer exists!" file-name))
|
|
|
3467 ;; Bind buffer-file-name to nil
|
|
|
3468 ;; so that we don't try to lock the file.
|
|
|
3469 (let ((buffer-file-name nil))
|
|
|
3470 (or auto-save-p
|
|
|
3471 (unlock-buffer)))
|
|
|
3472 (widen)
|
|
|
3473 ;; When reading in an autosave, it's encoded using
|
|
|
3474 ;; `escape-quoted', so we need to use it. (It is always
|
|
|
3475 ;; safe to specify `escape-quoted':
|
|
|
3476 ;;
|
|
|
3477 ;; 1. If file-coding but no Mule, `escape-quoted' is
|
|
|
3478 ;; aliased to `binary'.
|
|
|
3479 ;; 2. If no file-coding, all coding systems devolve into
|
|
|
3480 ;; `binary'.
|
|
|
3481 ;; 3. ASCII and ISO8859-1 are encoded the same in both
|
|
|
3482 ;; `binary' and `escape-quoted', so they will be
|
|
|
3483 ;; compatible for the most part.)
|
|
|
3484 ;;
|
|
|
3485 ;; Otherwise, use coding-system-for-read if explicitly
|
|
|
3486 ;; given (e.g. the "Revert Buffer with Specified
|
|
|
3487 ;; Encoding" menu entries), or use the coding system
|
|
|
3488 ;; that the file was loaded as.
|
|
|
3489 (let* ((coding-system-for-read
|
|
|
3490 (if auto-save-p 'escape-quoted
|
|
|
3491 (or coding-system-for-read
|
|
|
3492 buffer-file-coding-system-when-loaded)))
|
|
|
3493 ;; If the bfcs wasn't changed from its original
|
|
|
3494 ;; value (other than possible EOL change), then we
|
|
|
3495 ;; should update it for the new coding system.
|
|
|
3496 (should-update-bfcs
|
|
|
3497 (eq (coding-system-base
|
|
|
3498 buffer-file-coding-system-when-loaded)
|
|
|
3499 (coding-system-base
|
|
|
3500 buffer-file-coding-system)))
|
|
|
3501 (old-bfcs buffer-file-coding-system)
|
|
|
3502 ;; But if the EOL was changed, match it in the new
|
|
|
3503 ;; value of bfcs.
|
|
|
3504 (adjust-eol
|
|
|
3505 (and should-update-bfcs
|
|
|
3506 (not
|
|
|
3507 (eq (get-coding-system
|
|
|
3508 buffer-file-coding-system-when-loaded)
|
|
|
3509 (get-coding-system
|
|
|
3510 buffer-file-coding-system))))))
|
|
|
3511 (insert-file-contents file-name (not auto-save-p)
|
|
|
3512 nil nil t)
|
|
|
3513 (when should-update-bfcs
|
|
|
3514 (setq buffer-file-coding-system old-bfcs)
|
|
|
3515 (set-buffer-file-coding-system
|
|
|
3516 (if adjust-eol
|
|
|
3517 (coding-system-base
|
|
|
3518 buffer-file-coding-system-when-loaded)
|
|
771
|
3519 buffer-file-coding-system-when-loaded)
|
|
4024
|
3520 (not adjust-eol) t)))))
|
|
819
|
3521 (goto-char (min opoint (point-max)))
|
|
|
3522 ;; Recompute the truename in case changes in symlinks
|
|
|
3523 ;; have changed the truename.
|
|
|
3524 ;;XEmacs: already done by insert-file-contents
|
|
|
3525 ;;(setq buffer-file-truename
|
|
|
3526 ;;(abbreviate-file-name (file-truename buffer-file-name)))
|
|
|
3527 (after-find-file nil nil t t preserve-modes)
|
|
|
3528 ;; Run after-revert-hook as it was before we reverted.
|
|
|
3529 (setq-default revert-buffer-internal-hook global-hook)
|
|
|
3530 (if local-hook-p
|
|
|
3531 (progn
|
|
|
3532 (make-local-variable 'revert-buffer-internal-hook)
|
|
|
3533 (setq revert-buffer-internal-hook local-hook))
|
|
|
3534 (kill-local-variable 'revert-buffer-internal-hook))
|
|
|
3535 (run-hooks 'revert-buffer-internal-hook)))
|
|
|
3536 ((null newbuf)
|
|
|
3537 ;; The resultant buffer is identical, alter
|
|
|
3538 ;; modtime, update mods and exit
|
|
|
3539 (set-visited-file-modtime)
|
|
2030
|
3540 (after-find-file nil nil t t t)
|
|
|
3541 ;; We preserved modes above so fixup the local
|
|
|
3542 ;; variables manually
|
|
|
3543 (condition-case err
|
|
|
3544 (hack-local-variables)
|
|
|
3545 (error (lwarn 'local-variables 'warning
|
|
|
3546 "File local-variables error: %s"
|
|
|
3547 (error-message-string err)))))
|
|
819
|
3548 (t t))
|
|
428
|
3549 t)))))
|
|
|
3550
|
|
2030
|
3551 ;; #### wouldn't something like `revert-buffer-compare-with-file' be a
|
|
|
3552 ;; better name?
|
|
|
3553 ;; #### why is the argument optional?
|
|
819
|
3554 (defun revert-buffer-internal (&optional file-name)
|
|
849
|
3555 "Read contents of FILE-NAME into a buffer, and compare to current buffer.
|
|
|
3556 Return nil if identical, and the new buffer if different."
|
|
|
3557
|
|
819
|
3558 (let* ((newbuf (get-buffer-create " *revert*"))
|
|
3714
|
3559 bmin bmax
|
|
|
3560 ;; #### b-f-c-s is _not necessarily_ the coding system that
|
|
|
3561 ;; was used to read in the file. See its docstring.
|
|
|
3562 (coding-system buffer-file-coding-system))
|
|
819
|
3563 (save-excursion
|
|
|
3564 (set-buffer newbuf)
|
|
826
|
3565 (with-obsolete-variable '(before-change-function after-change-function)
|
|
|
3566 (let (buffer-read-only
|
|
|
3567 (buffer-undo-list t)
|
|
|
3568 after-change-function
|
|
|
3569 after-change-functions
|
|
|
3570 before-change-function
|
|
3638
|
3571 before-change-functions
|
|
3714
|
3572 (coding-system-for-read coding-system)
|
|
|
3573 )
|
|
826
|
3574 (if revert-buffer-insert-file-contents-function
|
|
|
3575 (funcall revert-buffer-insert-file-contents-function
|
|
|
3576 file-name nil)
|
|
|
3577 (if (not (file-exists-p file-name))
|
|
|
3578 (error "File %s no longer exists!" file-name))
|
|
|
3579 (widen)
|
|
863
|
3580 (insert-file-contents file-name nil nil nil t)
|
|
826
|
3581 (setq bmin (point-min)
|
|
|
3582 bmax (point-max))))))
|
|
819
|
3583 (if (not (and (eq bmin (point-min))
|
|
|
3584 (eq bmax (point-max))
|
|
|
3585 (eq (compare-buffer-substrings
|
|
|
3586 newbuf bmin bmax (current-buffer) bmin bmax) 0)))
|
|
|
3587 newbuf
|
|
863
|
3588 (and (kill-buffer newbuf) nil))))
|
|
819
|
3589
|
|
1333
|
3590 ;; BEGIN SYNC WITH FSF 21.2.
|
|
|
3591
|
|
844
|
3592 (defvar recover-file-diff-program "diff"
|
|
|
3593 "Absolute or relative name of the `diff' program used by `recover-file'.")
|
|
|
3594 (defvar recover-file-diff-arguments '("-c")
|
|
|
3595 "List of arguments (switches) to pass to `diff' by `recover-file'.")
|
|
|
3596
|
|
428
|
3597 (defun recover-file (file)
|
|
|
3598 "Visit file FILE, but get contents from its last auto-save file."
|
|
|
3599 ;; Actually putting the file name in the minibuffer should be used
|
|
|
3600 ;; only rarely.
|
|
|
3601 ;; Not just because users often use the default.
|
|
|
3602 (interactive "FRecover file: ")
|
|
|
3603 (setq file (expand-file-name file))
|
|
|
3604 (let ((handler (or (find-file-name-handler file 'recover-file)
|
|
|
3605 (find-file-name-handler
|
|
|
3606 (let ((buffer-file-name file))
|
|
|
3607 (make-auto-save-file-name))
|
|
|
3608 'recover-file))))
|
|
|
3609 (if handler
|
|
|
3610 (funcall handler 'recover-file file)
|
|
464
|
3611 (if (auto-save-file-name-p (file-name-nondirectory file))
|
|
428
|
3612 (error "%s is an auto-save file" file))
|
|
|
3613 (let ((file-name (let ((buffer-file-name file))
|
|
|
3614 (make-auto-save-file-name))))
|
|
|
3615 (cond ((if (file-exists-p file)
|
|
|
3616 (not (file-newer-than-file-p file-name file))
|
|
|
3617 (not (file-exists-p file-name)))
|
|
|
3618 (error "Auto-save file %s not current" file-name))
|
|
844
|
3619 (t
|
|
|
3620 (save-window-excursion
|
|
464
|
3621 ;; XEmacs change: use insert-directory instead of
|
|
844
|
3622 ;; calling ls directly. Add option for diff.
|
|
464
|
3623 (with-output-to-temp-buffer "*Directory*"
|
|
|
3624 (buffer-disable-undo standard-output)
|
|
|
3625 (save-excursion
|
|
1346
|
3626 (let ((switches
|
|
|
3627 (declare-boundp dired-listing-switches)))
|
|
1333
|
3628 (if (file-symlink-p file)
|
|
|
3629 (setq switches (concat switches "L")))
|
|
|
3630 (set-buffer standard-output)
|
|
|
3631 ;; XEmacs had the following line, not in FSF.
|
|
|
3632 (setq default-directory (file-name-directory file))
|
|
|
3633 ;; Use insert-directory-safely, not insert-directory,
|
|
|
3634 ;; because these files might not exist. In particular,
|
|
|
3635 ;; FILE might not exist if the auto-save file was for
|
|
|
3636 ;; a buffer that didn't visit a file, such as "*mail*".
|
|
|
3637 ;; The code in v20.x called `ls' directly, so we need
|
|
|
3638 ;; to emulate what `ls' did in that case.
|
|
|
3639 (insert-directory-safely file switches)
|
|
|
3640 (insert-directory-safely file-name switches))))
|
|
844
|
3641 (block nil
|
|
|
3642 (while t
|
|
|
3643 (case (get-user-response
|
|
|
3644 nil
|
|
|
3645 ;; Formerly included file name. Useless now that
|
|
|
3646 ;; we display an ls of the files, and potentially
|
|
|
3647 ;; fills up the minibuffer, esp. with autosaves
|
|
|
3648 ;; all in one directory.
|
|
|
3649 "Recover auto save file? "
|
|
|
3650 '(("yes" "%_Yes" yes)
|
|
|
3651 ("no" "%_No" no)
|
|
|
3652 ("diff" "%_Diff" diff)))
|
|
|
3653 (no (error "Recover-file cancelled."))
|
|
|
3654 (yes
|
|
|
3655 (switch-to-buffer (find-file-noselect file t))
|
|
1333
|
3656 (let ((buffer-read-only nil)
|
|
|
3657 ;; Keep the current buffer-file-coding-system.
|
|
|
3658 (coding-system buffer-file-coding-system)
|
|
|
3659 ;; Auto-saved file shoule be read without any code conversion.
|
|
|
3660 (coding-system-for-read 'escape-quoted))
|
|
844
|
3661 (erase-buffer)
|
|
1333
|
3662 (insert-file-contents file-name nil)
|
|
4024
|
3663 (set-buffer-file-coding-system coding-system
|
|
|
3664 nil t))
|
|
844
|
3665 (after-find-file nil nil t)
|
|
|
3666 (return nil))
|
|
|
3667 (diff
|
|
|
3668 ;; rather than just diff the two files (which would
|
|
|
3669 ;; be easy), we have to deal with the fact that
|
|
|
3670 ;; they may be in different formats, since
|
|
|
3671 ;; auto-saves are always in escape-quoted. so, we
|
|
|
3672 ;; read the file into a buffer (#### should we look
|
|
|
3673 ;; at or use a file if it's already in a buffer?
|
|
|
3674 ;; maybe we would find hints as to the encoding of
|
|
|
3675 ;; the file?), then we save the resulting buffer in
|
|
|
3676 ;; escape-quoted, do the diff (between two files
|
|
|
3677 ;; both in escape-quoted) and read in the results
|
|
|
3678 ;; using coding system escape-quoted. That way, we
|
|
|
3679 ;; should get what's correct most of the time.
|
|
|
3680 (let ((buffer (generate-new-buffer "*recover*"))
|
|
|
3681 (temp
|
|
|
3682 (make-temp-name
|
|
|
3683 (concat (file-name-as-directory
|
|
|
3684 (temp-directory))
|
|
|
3685 (file-name-nondirectory file) "-"))))
|
|
|
3686 (unwind-protect
|
|
|
3687 (progn
|
|
|
3688 (save-current-buffer
|
|
|
3689 (set-buffer buffer)
|
|
|
3690 (insert-file-contents file)
|
|
|
3691 (let ((coding-system-for-write
|
|
|
3692 'escape-quoted))
|
|
|
3693 (write-region (point-min) (point-max)
|
|
|
3694 temp nil 'silent)))
|
|
|
3695 (with-output-to-temp-buffer "*Autosave Diff*"
|
|
|
3696 (buffer-disable-undo standard-output)
|
|
|
3697 (let ((coding-system-for-read
|
|
|
3698 'escape-quoted))
|
|
|
3699 (condition-case ferr
|
|
|
3700 (apply #'call-process
|
|
|
3701 recover-file-diff-program
|
|
|
3702 nil standard-output nil
|
|
|
3703 (append
|
|
|
3704 recover-file-diff-arguments
|
|
|
3705 (list temp file-name)))
|
|
|
3706 (io-error
|
|
|
3707 (save-excursion
|
|
1346
|
3708 (let ((switches
|
|
|
3709 (declare-boundp
|
|
|
3710 dired-listing-switches)))
|
|
1333
|
3711 (if (file-symlink-p file)
|
|
|
3712 (setq switches (concat switches "L")))
|
|
|
3713 (set-buffer standard-output)
|
|
|
3714 ;; XEmacs had the following line, not in FSF.
|
|
|
3715 (setq default-directory (file-name-directory file))
|
|
1346
|
3716 ;; Use insert-directory-safely,
|
|
|
3717 ;; not insert-directory, because
|
|
|
3718 ;; these files might not exist.
|
|
|
3719 ;; In particular, FILE might not
|
|
|
3720 ;; exist if the auto-save file
|
|
|
3721 ;; was for a buffer that didn't
|
|
|
3722 ;; visit a file, such as
|
|
|
3723 ;; "*mail*". The code in v20.x
|
|
|
3724 ;; called `ls' directly, so we
|
|
|
3725 ;; need to emulate what `ls' did
|
|
|
3726 ;; in that case.
|
|
1333
|
3727 (insert-directory-safely file switches)
|
|
|
3728 (insert-directory-safely file-name switches))
|
|
844
|
3729 (terpri)
|
|
|
3730 (princ "Error during diff: ")
|
|
|
3731 (display-error ferr
|
|
|
3732 standard-output)))))))
|
|
|
3733 (ignore-errors (kill-buffer buffer))
|
|
|
3734 (ignore-file-errors
|
|
|
3735 (delete-file temp)))))))))))))))
|
|
428
|
3736
|
|
|
3737 (defun recover-session ()
|
|
|
3738 "Recover auto save files from a previous Emacs session.
|
|
|
3739 This command first displays a Dired buffer showing you the
|
|
|
3740 previous sessions that you could recover from.
|
|
|
3741 To choose one, move point to the proper line and then type C-c C-c.
|
|
|
3742 Then you'll be asked about a number of files to recover."
|
|
|
3743 (interactive)
|
|
|
3744 (unless (fboundp 'dired)
|
|
|
3745 (error "recover-session requires dired"))
|
|
|
3746 (if (null auto-save-list-file-prefix)
|
|
|
3747 (error
|
|
|
3748 "You set `auto-save-list-file-prefix' to disable making session files"))
|
|
1333
|
3749 (let ((dir (file-name-directory auto-save-list-file-prefix)))
|
|
|
3750 (unless (file-directory-p dir)
|
|
|
3751 (make-directory dir t)))
|
|
851
|
3752 (let* ((auto-save-list-dir
|
|
|
3753 (file-name-directory auto-save-list-file-prefix))
|
|
|
3754 (files (directory-files
|
|
|
3755 auto-save-list-dir
|
|
|
3756 t
|
|
|
3757 (concat "^" (regexp-quote (file-name-nondirectory
|
|
|
3758 auto-save-list-file-prefix)))))
|
|
|
3759 (files (sort (delete-if-not #'Recover-session-files-from-auto-save-list-file
|
|
|
3760 files) #'file-newer-than-file-p)))
|
|
|
3761 (unless files
|
|
|
3762 (error "No sessions can be recovered now"))
|
|
|
3763 (declare-fboundp (dired (cons auto-save-list-dir files)))
|
|
1333
|
3764 (save-excursion
|
|
|
3765 (goto-char (point-min))
|
|
|
3766 (or (looking-at "Move to the session you want to recover,")
|
|
|
3767 (let ((inhibit-read-only t))
|
|
|
3768 (delete-matching-lines "^[ \t]*total.*$")
|
|
|
3769 (insert "Move to the session you want to recover,\n"
|
|
|
3770 "then type C-c C-c to select it.\n\n"
|
|
|
3771 "You can also delete some of these files;\n"
|
|
|
3772 "type d on a line to mark that file for deletion.\n\n"))))
|
|
851
|
3773 (use-local-map (let ((map (make-sparse-keymap)))
|
|
|
3774 (set-keymap-parents map (list (current-local-map)))
|
|
|
3775 map))
|
|
|
3776 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)))
|
|
428
|
3777
|
|
851
|
3778 (defun Recover-session-files-from-auto-save-list-file (file)
|
|
|
3779 "Return the auto save files in list file FILE that are current."
|
|
|
3780 (let (files
|
|
428
|
3781 (buffer (get-buffer-create " *recover*")))
|
|
|
3782 (unwind-protect
|
|
|
3783 (save-excursion
|
|
|
3784 ;; Read in the auto-save-list file.
|
|
|
3785 (set-buffer buffer)
|
|
|
3786 (erase-buffer)
|
|
771
|
3787 (let ((coding-system-for-read 'escape-quoted))
|
|
|
3788 (insert-file-contents file))
|
|
428
|
3789 ;; Loop thru the text of that file
|
|
|
3790 ;; and get out the names of the files to recover.
|
|
|
3791 (while (not (eobp))
|
|
|
3792 (let (thisfile autofile)
|
|
|
3793 (if (eolp)
|
|
|
3794 ;; This is a pair of lines for a non-file-visiting buffer.
|
|
|
3795 ;; Get the auto-save file name and manufacture
|
|
|
3796 ;; a "visited file name" from that.
|
|
|
3797 (progn
|
|
|
3798 (forward-line 1)
|
|
|
3799 (setq autofile
|
|
|
3800 (buffer-substring-no-properties
|
|
|
3801 (point)
|
|
|
3802 (save-excursion
|
|
|
3803 (end-of-line)
|
|
|
3804 (point))))
|
|
|
3805 (setq thisfile
|
|
|
3806 (expand-file-name
|
|
|
3807 (substring
|
|
|
3808 (file-name-nondirectory autofile)
|
|
|
3809 1 -1)
|
|
|
3810 (file-name-directory autofile)))
|
|
|
3811 (forward-line 1))
|
|
|
3812 ;; This pair of lines is a file-visiting
|
|
|
3813 ;; buffer. Use the visited file name.
|
|
|
3814 (progn
|
|
|
3815 (setq thisfile
|
|
|
3816 (buffer-substring-no-properties
|
|
|
3817 (point) (progn (end-of-line) (point))))
|
|
|
3818 (forward-line 1)
|
|
|
3819 (setq autofile
|
|
|
3820 (buffer-substring-no-properties
|
|
|
3821 (point) (progn (end-of-line) (point))))
|
|
|
3822 (forward-line 1)))
|
|
|
3823 ;; Ignore a file if its auto-save file does not exist now.
|
|
|
3824 (if (file-exists-p autofile)
|
|
|
3825 (setq files (cons thisfile files)))))
|
|
851
|
3826 (setq files (nreverse files)))
|
|
428
|
3827 (kill-buffer buffer))))
|
|
|
3828
|
|
851
|
3829 (defun recover-session-finish ()
|
|
|
3830 "Choose one saved session to recover auto-save files from.
|
|
|
3831 This command is used in the special Dired buffer created by
|
|
|
3832 \\[recover-session]."
|
|
|
3833 (interactive)
|
|
|
3834 ;; Get the name of the session file to recover from.
|
|
|
3835 (let ((file (declare-fboundp (dired-get-filename))))
|
|
1346
|
3836 (declare-fboundp (dired-unmark 1))
|
|
851
|
3837 ;; #### dired-do-flagged-delete in FSF.
|
|
|
3838 ;; This version is for ange-ftp
|
|
1346
|
3839 ;;(declare-fboundp (dired-do-deletions t))
|
|
851
|
3840 ;; This version is for efs
|
|
|
3841 (declare-fboundp (dired-expunge-deletions))
|
|
|
3842 (let ((files (Recover-session-files-from-auto-save-list-file file)))
|
|
|
3843 ;; The file contains a pair of line for each auto-saved buffer.
|
|
|
3844 ;; The first line of the pair contains the visited file name
|
|
|
3845 ;; or is empty if the buffer was not visiting a file.
|
|
|
3846 ;; The second line is the auto-save file name.
|
|
|
3847 (if files
|
|
|
3848 (map-y-or-n-p "Recover %s? "
|
|
|
3849 (lambda (file)
|
|
|
3850 (condition-case nil
|
|
|
3851 (save-excursion (recover-file file))
|
|
|
3852 (error
|
|
|
3853 (lwarn 'recover 'alert
|
|
|
3854 "Failed to recover `%s'" file))))
|
|
|
3855 files
|
|
|
3856 '("file" "files" "recover"))
|
|
|
3857 (message "No files can be recovered from this session now")))))
|
|
|
3858
|
|
428
|
3859 (defun kill-some-buffers (&optional list)
|
|
|
3860 "For each buffer in LIST, ask whether to kill it.
|
|
|
3861 LIST defaults to all existing live buffers."
|
|
|
3862 (interactive)
|
|
|
3863 (if (null list)
|
|
|
3864 (setq list (buffer-list)))
|
|
|
3865 (while list
|
|
|
3866 (let* ((buffer (car list))
|
|
|
3867 (name (buffer-name buffer)))
|
|
|
3868 (and (not (string-equal name ""))
|
|
1333
|
3869 (not (eq (aref name 0) ?\ ))
|
|
428
|
3870 (yes-or-no-p
|
|
|
3871 (format
|
|
|
3872 (if (buffer-modified-p buffer)
|
|
|
3873 (gettext "Buffer %s HAS BEEN EDITED. Kill? ")
|
|
|
3874 (gettext "Buffer %s is unmodified. Kill? "))
|
|
|
3875 name))
|
|
|
3876 (kill-buffer buffer)))
|
|
|
3877 (setq list (cdr list))))
|
|
|
3878
|
|
|
3879 (defun auto-save-mode (arg)
|
|
|
3880 "Toggle auto-saving of contents of current buffer.
|
|
|
3881 With prefix argument ARG, turn auto-saving on if positive, else off."
|
|
|
3882 (interactive "P")
|
|
|
3883 (setq buffer-auto-save-file-name
|
|
|
3884 (and (if (null arg)
|
|
|
3885 (or (not buffer-auto-save-file-name)
|
|
|
3886 ;; If autosave is off because buffer has shrunk,
|
|
|
3887 ;; then toggling should turn it on.
|
|
|
3888 (< buffer-saved-size 0))
|
|
|
3889 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
|
|
|
3890 (if (and buffer-file-name auto-save-visited-file-name
|
|
|
3891 (not buffer-read-only))
|
|
|
3892 buffer-file-name
|
|
|
3893 (make-auto-save-file-name))))
|
|
|
3894 ;; If -1 was stored here, to temporarily turn off saving,
|
|
|
3895 ;; turn it back on.
|
|
|
3896 (and (< buffer-saved-size 0)
|
|
|
3897 (setq buffer-saved-size 0))
|
|
|
3898 (if (interactive-p)
|
|
|
3899 (if buffer-auto-save-file-name ;; rewritten for I18N3 snarfing
|
|
|
3900 (display-message 'command "Auto-save on (in this buffer)")
|
|
|
3901 (display-message 'command "Auto-save off (in this buffer)")))
|
|
|
3902 buffer-auto-save-file-name)
|
|
|
3903
|
|
|
3904 (defun rename-auto-save-file ()
|
|
|
3905 "Adjust current buffer's auto save file name for current conditions.
|
|
|
3906 Also rename any existing auto save file, if it was made in this session."
|
|
|
3907 (let ((osave buffer-auto-save-file-name))
|
|
|
3908 (setq buffer-auto-save-file-name
|
|
|
3909 (make-auto-save-file-name))
|
|
|
3910 (if (and osave buffer-auto-save-file-name
|
|
|
3911 (not (string= buffer-auto-save-file-name buffer-file-name))
|
|
|
3912 (not (string= buffer-auto-save-file-name osave))
|
|
|
3913 (file-exists-p osave)
|
|
|
3914 (recent-auto-save-p))
|
|
|
3915 (rename-file osave buffer-auto-save-file-name t))))
|
|
|
3916
|
|
1333
|
3917 ;; END SYNC WITH FSF 21.2.
|
|
|
3918
|
|
464
|
3919 ;; make-auto-save-file-name and auto-save-file-name-p are now only in
|
|
|
3920 ;; auto-save.el.
|
|
428
|
3921
|
|
|
3922
|
|
1333
|
3923 ;; BEGIN SYNC WITH FSF 21.2.
|
|
|
3924
|
|
428
|
3925 (defun wildcard-to-regexp (wildcard)
|
|
|
3926 "Given a shell file name pattern WILDCARD, return an equivalent regexp.
|
|
|
3927 The generated regexp will match a filename iff the filename
|
|
|
3928 matches that wildcard according to shell rules. Only wildcards known
|
|
|
3929 by `sh' are supported."
|
|
|
3930 (let* ((i (string-match "[[.*+\\^$?]" wildcard))
|
|
|
3931 ;; Copy the initial run of non-special characters.
|
|
|
3932 (result (substring wildcard 0 i))
|
|
|
3933 (len (length wildcard)))
|
|
|
3934 ;; If no special characters, we're almost done.
|
|
|
3935 (if i
|
|
|
3936 (while (< i len)
|
|
|
3937 (let ((ch (aref wildcard i))
|
|
|
3938 j)
|
|
|
3939 (setq
|
|
|
3940 result
|
|
|
3941 (concat result
|
|
|
3942 (cond
|
|
1333
|
3943 ((and (eq ch ?\[)
|
|
|
3944 (< (1+ i) len)
|
|
|
3945 (eq (aref wildcard (1+ i)) ?\]))
|
|
|
3946 "\\[")
|
|
428
|
3947 ((eq ch ?\[) ; [...] maps to regexp char class
|
|
|
3948 (progn
|
|
|
3949 (setq i (1+ i))
|
|
|
3950 (concat
|
|
|
3951 (cond
|
|
|
3952 ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
|
|
|
3953 (progn
|
|
|
3954 (setq i (1+ i))
|
|
|
3955 (if (eq (aref wildcard i) ?\])
|
|
|
3956 (progn
|
|
|
3957 (setq i (1+ i))
|
|
|
3958 "[^]")
|
|
|
3959 "[^")))
|
|
|
3960 ((eq (aref wildcard i) ?^)
|
|
|
3961 ;; Found "[^". Insert a `\0' character
|
|
|
3962 ;; (which cannot happen in a filename)
|
|
|
3963 ;; into the character class, so that `^'
|
|
|
3964 ;; is not the first character after `[',
|
|
|
3965 ;; and thus non-special in a regexp.
|
|
|
3966 (progn
|
|
|
3967 (setq i (1+ i))
|
|
|
3968 "[\000^"))
|
|
|
3969 ((eq (aref wildcard i) ?\])
|
|
|
3970 ;; I don't think `]' can appear in a
|
|
|
3971 ;; character class in a wildcard, but
|
|
|
3972 ;; let's be general here.
|
|
|
3973 (progn
|
|
|
3974 (setq i (1+ i))
|
|
|
3975 "[]"))
|
|
|
3976 (t "["))
|
|
|
3977 (prog1 ; copy everything upto next `]'.
|
|
|
3978 (substring wildcard
|
|
|
3979 i
|
|
|
3980 (setq j (string-match
|
|
|
3981 "]" wildcard i)))
|
|
|
3982 (setq i (if j (1- j) (1- len)))))))
|
|
|
3983 ((eq ch ?.) "\\.")
|
|
|
3984 ((eq ch ?*) "[^\000]*")
|
|
|
3985 ((eq ch ?+) "\\+")
|
|
|
3986 ((eq ch ?^) "\\^")
|
|
|
3987 ((eq ch ?$) "\\$")
|
|
|
3988 ((eq ch ?\\) "\\\\") ; probably cannot happen...
|
|
|
3989 ((eq ch ??) "[^\000]")
|
|
|
3990 (t (char-to-string ch)))))
|
|
|
3991 (setq i (1+ i)))))
|
|
|
3992 ;; Shell wildcards should match the entire filename,
|
|
|
3993 ;; not its part. Make the regexp say so.
|
|
|
3994 (concat "\\`" result "\\'")))
|
|
|
3995
|
|
|
3996 (defcustom list-directory-brief-switches "-CF"
|
|
|
3997 "*Switches for list-directory to pass to `ls' for brief listing."
|
|
|
3998 :type 'string
|
|
|
3999 :group 'dired)
|
|
|
4000
|
|
|
4001 (defcustom list-directory-verbose-switches "-l"
|
|
|
4002 "*Switches for list-directory to pass to `ls' for verbose listing,"
|
|
|
4003 :type 'string
|
|
|
4004 :group 'dired)
|
|
|
4005
|
|
1333
|
4006 (defun file-expand-wildcards (pattern &optional full)
|
|
|
4007 "Expand wildcard pattern PATTERN.
|
|
|
4008 This returns a list of file names which match the pattern.
|
|
|
4009
|
|
|
4010 If PATTERN is written as an absolute relative file name,
|
|
|
4011 the values are absolute also.
|
|
|
4012
|
|
|
4013 If PATTERN is written as a relative file name, it is interpreted
|
|
|
4014 relative to the current default directory, `default-directory'.
|
|
|
4015 The file names returned are normally also relative to the current
|
|
|
4016 default directory. However, if FULL is non-nil, they are absolute."
|
|
|
4017 (let* ((nondir (file-name-nondirectory pattern))
|
|
|
4018 (dirpart (file-name-directory pattern))
|
|
|
4019 ;; A list of all dirs that DIRPART specifies.
|
|
|
4020 ;; This can be more than one dir
|
|
|
4021 ;; if DIRPART contains wildcards.
|
|
|
4022 (dirs (if (and dirpart (string-match "[[*?]" dirpart))
|
|
|
4023 (mapcar 'file-name-as-directory
|
|
|
4024 (file-expand-wildcards (directory-file-name dirpart)))
|
|
|
4025 (list dirpart)))
|
|
|
4026 contents)
|
|
|
4027 (while dirs
|
|
|
4028 (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
|
|
|
4029 (file-directory-p (directory-file-name (car dirs))))
|
|
|
4030 (let ((this-dir-contents
|
|
|
4031 ;; Filter out "." and ".."
|
|
|
4032 (delq nil
|
|
|
4033 (mapcar #'(lambda (name)
|
|
|
4034 (unless (string-match "\\`\\.\\.?\\'"
|
|
|
4035 (file-name-nondirectory name))
|
|
|
4036 name))
|
|
|
4037 (directory-files (or (car dirs) ".") full
|
|
|
4038 (wildcard-to-regexp nondir))))))
|
|
|
4039 (setq contents
|
|
|
4040 (nconc
|
|
|
4041 (if (and (car dirs) (not full))
|
|
|
4042 (mapcar (function (lambda (name) (concat (car dirs) name)))
|
|
|
4043 this-dir-contents)
|
|
|
4044 this-dir-contents)
|
|
|
4045 contents))))
|
|
|
4046 (setq dirs (cdr dirs)))
|
|
|
4047 contents))
|
|
|
4048
|
|
428
|
4049 (defun list-directory (dirname &optional verbose)
|
|
|
4050 "Display a list of files in or matching DIRNAME, a la `ls'.
|
|
|
4051 DIRNAME is globbed by the shell if necessary.
|
|
|
4052 Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
|
|
|
4053 Actions controlled by variables `list-directory-brief-switches'
|
|
|
4054 and `list-directory-verbose-switches'."
|
|
|
4055 (interactive (let ((pfx current-prefix-arg))
|
|
|
4056 (list (read-file-name (if pfx (gettext "List directory (verbose): ")
|
|
|
4057 (gettext "List directory (brief): "))
|
|
|
4058 nil default-directory nil)
|
|
|
4059 pfx)))
|
|
|
4060 (let ((switches (if verbose list-directory-verbose-switches
|
|
|
4061 list-directory-brief-switches)))
|
|
|
4062 (or dirname (setq dirname default-directory))
|
|
|
4063 (setq dirname (expand-file-name dirname))
|
|
|
4064 (with-output-to-temp-buffer "*Directory*"
|
|
|
4065 (buffer-disable-undo standard-output)
|
|
|
4066 (princ "Directory ")
|
|
|
4067 (princ dirname)
|
|
|
4068 (terpri)
|
|
|
4069 (save-excursion
|
|
|
4070 (set-buffer "*Directory*")
|
|
1333
|
4071 (setq default-directory
|
|
|
4072 (if (file-directory-p dirname)
|
|
|
4073 (file-name-as-directory dirname)
|
|
|
4074 (file-name-directory dirname)))
|
|
428
|
4075 (let ((wildcard (not (file-directory-p dirname))))
|
|
|
4076 (insert-directory dirname switches wildcard (not wildcard)))))))
|
|
|
4077
|
|
1333
|
4078 (defun shell-quote-wildcard-pattern (pattern)
|
|
|
4079 "Quote characters special to the shell in PATTERN, leave wildcards alone.
|
|
|
4080
|
|
|
4081 PATTERN is assumed to represent a file-name wildcard suitable for the
|
|
|
4082 underlying filesystem. For Unix and GNU/Linux, the characters from the
|
|
|
4083 set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all
|
|
|
4084 the parts of the pattern which don't include wildcard characters are
|
|
|
4085 quoted with double quotes.
|
|
|
4086 Existing quote characters in PATTERN are left alone, so you can pass
|
|
|
4087 PATTERN that already quotes some of the special characters."
|
|
|
4088 (save-match-data
|
|
|
4089 (cond
|
|
|
4090 ((memq system-type '(ms-dos windows-nt))
|
|
|
4091 ;; DOS/Windows don't allow `"' in file names. So if the
|
|
|
4092 ;; argument has quotes, we can safely assume it is already
|
|
|
4093 ;; quoted by the caller.
|
|
|
4094 (if (or (string-match "[\"]" pattern)
|
|
|
4095 ;; We quote [&()#$'] in case their shell is a port of a
|
|
|
4096 ;; Unixy shell. We quote [,=+] because stock DOS and
|
|
|
4097 ;; Windows shells require that in some cases, such as
|
|
|
4098 ;; passing arguments to batch files that use positional
|
|
|
4099 ;; arguments like %1.
|
|
|
4100 (not (string-match "[ \t;&()#$',=+]" pattern)))
|
|
|
4101 pattern
|
|
|
4102 (let ((result "\"")
|
|
|
4103 (beg 0)
|
|
|
4104 end)
|
|
|
4105 (while (string-match "[*?]+" pattern beg)
|
|
|
4106 (setq end (match-beginning 0)
|
|
|
4107 result (concat result (substring pattern beg end)
|
|
|
4108 "\""
|
|
|
4109 (substring pattern end (match-end 0))
|
|
|
4110 "\"")
|
|
|
4111 beg (match-end 0)))
|
|
|
4112 (concat result (substring pattern beg) "\""))))
|
|
|
4113 (t
|
|
|
4114 (let ((beg 0))
|
|
|
4115 (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
|
|
|
4116 (setq pattern
|
|
|
4117 (concat (substring pattern 0 (match-beginning 0))
|
|
|
4118 "\\"
|
|
|
4119 (substring pattern (match-beginning 0)))
|
|
|
4120 beg (1+ (match-end 0)))))
|
|
|
4121 pattern))))
|
|
|
4122
|
|
|
4123
|
|
428
|
4124 (defvar insert-directory-program "ls"
|
|
|
4125 "Absolute or relative name of the `ls' program used by `insert-directory'.")
|
|
|
4126
|
|
|
4127 ;; insert-directory
|
|
|
4128 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
|
|
|
4129 ;; FULL-DIRECTORY-P is nil.
|
|
|
4130 ;; The single line of output must display FILE's name as it was
|
|
|
4131 ;; given, namely, an absolute path name.
|
|
|
4132 ;; - must insert exactly one line for each file if WILDCARD or
|
|
|
4133 ;; FULL-DIRECTORY-P is t, plus one optional "total" line
|
|
|
4134 ;; before the file lines, plus optional text after the file lines.
|
|
|
4135 ;; Lines are delimited by "\n", so filenames containing "\n" are not
|
|
|
4136 ;; allowed.
|
|
|
4137 ;; File lines should display the basename.
|
|
|
4138 ;; - must be consistent with
|
|
|
4139 ;; - functions dired-move-to-filename, (these two define what a file line is)
|
|
|
4140 ;; dired-move-to-end-of-filename,
|
|
|
4141 ;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
|
|
|
4142 ;; dired-insert-headerline
|
|
|
4143 ;; dired-after-subdir-garbage (defines what a "total" line is)
|
|
|
4144 ;; - variable dired-subdir-regexp
|
|
1606
|
4145 ;; - may be passed "--dired" as argument in SWITCHES.
|
|
|
4146 ;; Filename handlers might have to remove this switch if their
|
|
|
4147 ;; "ls" command does not support it.
|
|
1333
|
4148
|
|
|
4149 ;; END SYNC WITH FSF 21.2.
|
|
|
4150
|
|
2671
|
4151 (defvar insert-directory-ls-version 'unknown)
|
|
|
4152
|
|
428
|
4153 (defun insert-directory (file switches &optional wildcard full-directory-p)
|
|
|
4154 "Insert directory listing for FILE, formatted according to SWITCHES.
|
|
|
4155 Leaves point after the inserted text.
|
|
|
4156 SWITCHES may be a string of options, or a list of strings.
|
|
|
4157 Optional third arg WILDCARD means treat FILE as shell wildcard.
|
|
|
4158 Optional fourth arg FULL-DIRECTORY-P means file is a directory and
|
|
|
4159 switches do not contain `d', so that a full listing is expected.
|
|
|
4160
|
|
|
4161 This works by running a directory listing program
|
|
|
4162 whose name is in the variable `insert-directory-program'.
|
|
|
4163 If WILDCARD, it also runs the shell specified by `shell-file-name'."
|
|
|
4164 ;; We need the directory in order to find the right handler.
|
|
|
4165 (let ((handler (find-file-name-handler (expand-file-name file)
|
|
|
4166 'insert-directory)))
|
|
1606
|
4167 (cond
|
|
|
4168 (handler
|
|
|
4169 (funcall handler 'insert-directory file switches
|
|
|
4170 wildcard full-directory-p))
|
|
|
4171 ;; [mswindows-insert-directory should be called
|
|
|
4172 ;; nt-insert-directory - kkm]. not true any more according to
|
|
|
4173 ;; my new naming scheme. --ben
|
|
|
4174 ((and (fboundp 'mswindows-insert-directory)
|
|
|
4175 (eq system-type 'windows-nt))
|
|
|
4176 (declare-fboundp (mswindows-insert-directory
|
|
|
4177 file switches wildcard full-directory-p)))
|
|
|
4178 (t
|
|
|
4179 (let* ((beg (point))
|
|
|
4180 (result
|
|
|
4181 (if wildcard
|
|
|
4182 ;; Run ls in the directory of the file pattern we asked for.
|
|
|
4183 (let ((default-directory
|
|
|
4184 (if (file-name-absolute-p file)
|
|
|
4185 (file-name-directory file)
|
|
|
4186 (file-name-directory (expand-file-name file))))
|
|
|
4187 (pattern (file-name-nondirectory file))
|
|
|
4188 (start 0))
|
|
|
4189 ;; Quote some characters that have special meanings in shells;
|
|
|
4190 ;; but don't quote the wildcards--we want them to be special.
|
|
|
4191 ;; We also currently don't quote the quoting characters
|
|
|
4192 ;; in case people want to use them explicitly to quote
|
|
|
4193 ;; wildcard characters.
|
|
|
4194 ;;#### Unix-specific
|
|
|
4195 (while (string-match "[ \t\n;<>&|()#$]" pattern start)
|
|
|
4196 (setq pattern
|
|
|
4197 (concat (substring pattern 0 (match-beginning 0))
|
|
|
4198 "\\"
|
|
|
4199 (substring pattern (match-beginning 0)))
|
|
|
4200 start (1+ (match-end 0))))
|
|
|
4201 (call-process shell-file-name nil t nil
|
|
|
4202 "-c" (concat "\\" ;; Disregard shell aliases!
|
|
|
4203 insert-directory-program
|
|
|
4204 " -d "
|
|
|
4205 (if (stringp switches)
|
|
|
4206 switches
|
|
|
4207 (mapconcat 'identity switches " "))
|
|
|
4208 " "
|
|
|
4209 pattern)))
|
|
|
4210 ;; SunOS 4.1.3, SVr4 and others need the "." to list the
|
|
|
4211 ;; directory if FILE is a symbolic link.
|
|
|
4212 (apply 'call-process
|
|
|
4213 insert-directory-program nil t nil
|
|
|
4214 (let (list)
|
|
|
4215 (if (listp switches)
|
|
|
4216 (setq list switches)
|
|
|
4217 (if (not (equal switches ""))
|
|
|
4218 (let ((switches switches))
|
|
|
4219 ;; Split the switches at any spaces
|
|
|
4220 ;; so we can pass separate options as separate args.
|
|
|
4221 (while (string-match " " switches)
|
|
|
4222 (setq list (cons (substring switches 0 (match-beginning 0))
|
|
|
4223 list)
|
|
|
4224 switches (substring switches (match-end 0))))
|
|
|
4225 (setq list (cons switches list)))))
|
|
|
4226 (append list
|
|
|
4227 (list
|
|
|
4228 (if full-directory-p
|
|
|
4229 (concat (file-name-as-directory file)
|
|
|
4230 ;;#### Unix-specific
|
|
|
4231 ".")
|
|
|
4232 file))))))))
|
|
2671
|
4233
|
|
|
4234 ;; If we got "//DIRED//" in the output, it means we got a real
|
|
|
4235 ;; directory listing, even if `ls' returned nonzero.
|
|
|
4236 ;; So ignore any errors.
|
|
|
4237 (when (if (stringp switches)
|
|
|
4238 (string-match "--dired\\>" switches)
|
|
|
4239 (member "--dired" switches))
|
|
|
4240 (save-excursion
|
|
|
4241 (forward-line -2)
|
|
|
4242 (when (looking-at "//SUBDIRED//")
|
|
|
4243 (forward-line -1))
|
|
|
4244 (if (looking-at "//DIRED//")
|
|
|
4245 (setq result 0))))
|
|
|
4246
|
|
|
4247 (when (and (not (eq 0 result))
|
|
|
4248 (eq insert-directory-ls-version 'unknown))
|
|
|
4249 ;; The first time ls returns an error,
|
|
|
4250 ;; find the version numbers of ls,
|
|
|
4251 ;; and set insert-directory-ls-version
|
|
|
4252 ;; to > if it is more than 5.2.1, < if it is less, nil if it
|
|
|
4253 ;; is equal or if the info cannot be obtained.
|
|
|
4254 ;; (That can mean it isn't GNU ls.)
|
|
|
4255 (let ((version-out
|
|
|
4256 (with-temp-buffer
|
|
|
4257 (call-process "ls" nil t nil "--version")
|
|
|
4258 (buffer-string))))
|
|
|
4259 (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out)
|
|
|
4260 (let* ((version (match-string 1 version-out))
|
|
|
4261 (split (split-string version "[.]"))
|
|
|
4262 (numbers (mapcar 'string-to-int split))
|
|
|
4263 (min '(5 2 1))
|
|
|
4264 comparison)
|
|
|
4265 (while (and (not comparison) (or numbers min))
|
|
|
4266 (cond ((null min)
|
|
|
4267 (setq comparison '>))
|
|
|
4268 ((null numbers)
|
|
|
4269 (setq comparison '<))
|
|
|
4270 ((> (car numbers) (car min))
|
|
|
4271 (setq comparison '>))
|
|
|
4272 ((< (car numbers) (car min))
|
|
|
4273 (setq comparison '<))
|
|
|
4274 (t
|
|
|
4275 (setq numbers (cdr numbers)
|
|
|
4276 min (cdr min)))))
|
|
|
4277 (setq insert-directory-ls-version (or comparison '=)))
|
|
|
4278 (setq insert-directory-ls-version nil))))
|
|
|
4279
|
|
|
4280 ;; For GNU ls versions 5.2.2 and up, ignore minor errors.
|
|
|
4281 (when (and (eq 1 result) (eq insert-directory-ls-version '>))
|
|
|
4282 (setq result 0))
|
|
|
4283
|
|
1606
|
4284 ;; If `insert-directory-program' failed, signal an error.
|
|
2671
|
4285 (unless (eq 0 result)
|
|
|
4286 ;; Delete the error message it may have output.
|
|
|
4287 (delete-region beg (point))
|
|
|
4288 ;; On non-Posix systems, we cannot open a directory, so
|
|
|
4289 ;; don't even try, because that will always result in
|
|
|
4290 ;; the ubiquitous "Access denied". Instead, show the
|
|
|
4291 ;; command line so the user can try to guess what went wrong.
|
|
|
4292 (if (and (file-directory-p file)
|
|
|
4293 (memq system-type '(ms-dos windows-nt)))
|
|
|
4294 (error
|
|
|
4295 "Reading directory: \"%s %s -- %s\" exited with status %s"
|
|
|
4296 insert-directory-program
|
|
|
4297 (if (listp switches) (concat switches) switches)
|
|
|
4298 file result)
|
|
|
4299 (error "Listing directory failed")))
|
|
1606
|
4300
|
|
|
4301 (when (or (and (listp switches)
|
|
|
4302 (member "--dired" switches))
|
|
|
4303 (string-match "--dired\\>" switches))
|
|
|
4304 (forward-line -2)
|
|
|
4305 (when (looking-at "//SUBDIRED//")
|
|
|
4306 (delete-region (point) (progn (forward-line 1) (point)))
|
|
|
4307 (forward-line -1))
|
|
2671
|
4308 (if (looking-at "//DIRED//")
|
|
|
4309 (let ((end (line-end-position))
|
|
|
4310 (linebeg (point))
|
|
|
4311 error-lines)
|
|
|
4312 ;; Find all the lines that are error messages,
|
|
|
4313 ;; and record the bounds of each one.
|
|
|
4314 (goto-char beg)
|
|
|
4315 (while (< (point) linebeg)
|
|
|
4316 (or (eql (following-char) ?\s)
|
|
|
4317 (push (list (point) (line-end-position)) error-lines))
|
|
|
4318 (forward-line 1))
|
|
|
4319 (setq error-lines (nreverse error-lines))
|
|
|
4320 ;; Now read the numeric positions of file names.
|
|
|
4321 (goto-char linebeg)
|
|
|
4322 (forward-word 1)
|
|
|
4323 (forward-char 3)
|
|
|
4324 (while (< (point) end)
|
|
|
4325 (let ((start (insert-directory-adj-pos
|
|
|
4326 (+ beg (read (current-buffer)))
|
|
|
4327 error-lines))
|
|
|
4328 (end (insert-directory-adj-pos
|
|
|
4329 (+ beg (read (current-buffer)))
|
|
|
4330 error-lines)))
|
|
|
4331 (if (memq (char-after end) '(?\n ?\ ))
|
|
|
4332 ;; End is followed by \n or by " -> ".
|
|
|
4333 (let ((filename-extent (make-extent start end)))
|
|
|
4334 (set-extent-property filename-extent 'dired-file-name t)
|
|
|
4335 (set-extent-property filename-extent 'start-open t)
|
|
|
4336 (set-extent-property filename-extent 'end-open t))
|
|
|
4337 ;; It seems that we can't trust ls's output as to
|
|
|
4338 ;; byte positions of filenames.
|
|
|
4339 (map-extents
|
|
|
4340 #'(lambda (extent maparg)
|
|
|
4341 (delete-extent extent)
|
|
|
4342 nil)
|
|
|
4343 nil beg (point) nil nil 'dired-file-name)
|
|
|
4344 (end-of-line))))
|
|
|
4345 (goto-char end)
|
|
|
4346 (beginning-of-line)
|
|
|
4347 (delete-region (point) (progn (forward-line 1) (point))))
|
|
|
4348 ;; Take care of the case where the ls output contains a
|
|
|
4349 ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
|
|
|
4350 ;; and we went one line too far back (see above).
|
|
|
4351 (forward-line 1))
|
|
|
4352 (if (looking-at "//DIRED-OPTIONS//")
|
|
|
4353 (delete-region (point) (progn (forward-line 1) (point))))))))))
|
|
|
4354
|
|
|
4355 (defun insert-directory-adj-pos (pos error-lines)
|
|
|
4356 "Convert `ls --dired' file name position value POS to a buffer position.
|
|
|
4357 File name position values returned in ls --dired output
|
|
|
4358 count only stdout; they don't count the error messages sent to stderr.
|
|
|
4359 So this function converts to them to real buffer positions.
|
|
|
4360 ERROR-LINES is a list of buffer positions of error message lines,
|
|
|
4361 of the form (START END)."
|
|
|
4362 (while (and error-lines (< (caar error-lines) pos))
|
|
|
4363 (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines)))))
|
|
|
4364 (pop error-lines))
|
|
|
4365 pos)
|
|
428
|
4366
|
|
1333
|
4367 ;; BEGIN SYNC WITH FSF 21.2.
|
|
|
4368
|
|
|
4369 (defun insert-directory-safely (file switches
|
|
|
4370 &optional wildcard full-directory-p)
|
|
|
4371 "Insert directory listing for FILE, formatted according to SWITCHES.
|
|
|
4372
|
|
|
4373 Like `insert-directory', but if FILE does not exist, it inserts a
|
|
|
4374 message to that effect instead of signaling an error."
|
|
|
4375 (if (file-exists-p file)
|
|
|
4376 (insert-directory file switches wildcard full-directory-p)
|
|
|
4377 ;; Simulate the message printed by `ls'.
|
|
|
4378 (insert (format "%s: No such file or directory\n" file))))
|
|
|
4379
|
|
428
|
4380 (defvar kill-emacs-query-functions nil
|
|
|
4381 "Functions to call with no arguments to query about killing XEmacs.
|
|
|
4382 If any of these functions returns nil, killing Emacs is cancelled.
|
|
|
4383 `save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
|
|
|
4384 but `kill-emacs', the low level primitive, does not.
|
|
|
4385 See also `kill-emacs-hook'.")
|
|
|
4386
|
|
1333
|
4387 (defcustom confirm-kill-emacs nil
|
|
|
4388 "How to ask for confirmation when leaving Emacs.
|
|
|
4389 If nil, the default, don't ask at all. If the value is non-nil, it should
|
|
|
4390 be a predicate function such as `yes-or-no-p'."
|
|
|
4391 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
|
|
|
4392 (const :tag "Ask with y-or-n-p" y-or-n-p)
|
|
|
4393 (const :tag "Don't confirm" nil))
|
|
|
4394 :group 'emacs
|
|
|
4395 ;:version "21.1"
|
|
|
4396 )
|
|
|
4397
|
|
428
|
4398 (defun save-buffers-kill-emacs (&optional arg)
|
|
|
4399 "Offer to save each buffer, then kill this XEmacs process.
|
|
|
4400 With prefix arg, silently save all file-visiting buffers, then kill."
|
|
|
4401 (interactive "P")
|
|
|
4402 (save-some-buffers arg t)
|
|
|
4403 (and (or (not (memq t (mapcar #'(lambda (buf) (and (buffer-file-name buf)
|
|
|
4404 (buffer-modified-p buf)))
|
|
|
4405 (buffer-list))))
|
|
|
4406 (yes-or-no-p "Modified buffers exist; exit anyway? "))
|
|
|
4407 (or (not (fboundp 'process-list))
|
|
|
4408 ;; process-list is not defined on VMS.
|
|
|
4409 (let ((processes (process-list))
|
|
|
4410 active)
|
|
|
4411 (while processes
|
|
|
4412 (and (memq (process-status (car processes)) '(run stop open))
|
|
|
4413 (let ((val (process-kill-without-query (car processes))))
|
|
|
4414 (process-kill-without-query (car processes) val)
|
|
|
4415 val)
|
|
|
4416 (setq active t))
|
|
|
4417 (setq processes (cdr processes)))
|
|
|
4418 (or
|
|
|
4419 (not active)
|
|
|
4420 (save-excursion
|
|
|
4421 (save-window-excursion
|
|
|
4422 (delete-other-windows)
|
|
|
4423 (list-processes)
|
|
|
4424 (yes-or-no-p
|
|
|
4425 "Active processes exist; kill them and exit anyway? "))))))
|
|
|
4426 ;; Query the user for other things, perhaps.
|
|
|
4427 (run-hook-with-args-until-failure 'kill-emacs-query-functions)
|
|
1333
|
4428 (or (null confirm-kill-emacs)
|
|
|
4429 (funcall confirm-kill-emacs "Really exit Emacs? "))
|
|
428
|
4430 (kill-emacs)))
|
|
|
4431
|
|
|
4432 (defun symlink-expand-file-name (filename)
|
|
|
4433 "If FILENAME is a symlink, return its non-symlink equivalent.
|
|
|
4434 Unlike `file-truename', this doesn't chase symlinks in directory
|
|
|
4435 components of the file or expand a relative pathname into an
|
|
|
4436 absolute one."
|
|
|
4437 (let ((count 20))
|
|
|
4438 (while (and (> count 0) (file-symlink-p filename))
|
|
|
4439 (setq filename (file-symlink-p filename)
|
|
|
4440 count (1- count)))
|
|
|
4441 (if (> count 0)
|
|
|
4442 filename
|
|
|
4443 (error "Apparently circular symlink path"))))
|
|
|
4444
|
|
|
4445 ;; Suggested by Michael Kifer <kifer@CS.SunySB.EDU>
|
|
|
4446 (defun file-remote-p (file-name)
|
|
|
4447 "Test whether FILE-NAME is looked for on a remote system."
|
|
776
|
4448 (cond ((not (declare-boundp allow-remote-paths)) nil)
|
|
502
|
4449 ((fboundp 'ange-ftp-ftp-path)
|
|
|
4450 (declare-fboundp (ange-ftp-ftp-path file-name)))
|
|
|
4451 ((fboundp 'efs-ftp-path)
|
|
|
4452 (declare-fboundp (efs-ftp-path file-name)))
|
|
428
|
4453 (t nil)))
|
|
|
4454
|
|
1333
|
4455
|
|
|
4456 ;; We use /: as a prefix to "quote" a file name
|
|
|
4457 ;; so that magic file name handlers will not apply to it.
|
|
|
4458
|
|
|
4459 (setq file-name-handler-alist
|
|
|
4460 (cons '("\\`/:" . file-name-non-special)
|
|
|
4461 file-name-handler-alist))
|
|
|
4462
|
|
|
4463 ;; We depend on being the last handler on the list,
|
|
|
4464 ;; so that anything else which does need handling
|
|
|
4465 ;; has been handled already.
|
|
|
4466 ;; So it is safe for us to inhibit *all* magic file name handlers.
|
|
|
4467
|
|
|
4468 (defun file-name-non-special (operation &rest arguments)
|
|
|
4469 (let ((file-name-handler-alist nil)
|
|
|
4470 (default-directory
|
|
|
4471 (if (eq operation 'insert-directory)
|
|
|
4472 (directory-file-name
|
|
|
4473 (expand-file-name
|
|
|
4474 (unhandled-file-name-directory default-directory)))
|
|
|
4475 default-directory))
|
|
|
4476 ;; Get a list of the indices of the args which are file names.
|
|
|
4477 (file-arg-indices
|
|
|
4478 (cdr (or (assq operation
|
|
|
4479 ;; The first four are special because they
|
|
|
4480 ;; return a file name. We want to include the /:
|
|
|
4481 ;; in the return value.
|
|
|
4482 ;; So just avoid stripping it in the first place.
|
|
|
4483 '((expand-file-name . nil)
|
|
|
4484 ;; `identity' means just return the first arg
|
|
|
4485 ;; as stripped of its quoting.
|
|
|
4486 (substitute-in-file-name . identity)
|
|
|
4487 (file-name-directory . nil)
|
|
|
4488 (file-name-as-directory . nil)
|
|
|
4489 (directory-file-name . nil)
|
|
|
4490 (file-name-completion 0 1)
|
|
|
4491 (file-name-all-completions 0 1)
|
|
|
4492 (rename-file 0 1)
|
|
|
4493 (copy-file 0 1)
|
|
|
4494 (make-symbolic-link 0 1)
|
|
|
4495 (add-name-to-file 0 1)))
|
|
|
4496 ;; For all other operations, treat the first argument only
|
|
|
4497 ;; as the file name.
|
|
|
4498 '(nil 0))))
|
|
|
4499 ;; Copy ARGUMENTS so we can replace elements in it.
|
|
|
4500 (arguments (copy-sequence arguments)))
|
|
|
4501 ;; Strip off the /: from the file names that have this handler.
|
|
|
4502 (save-match-data
|
|
|
4503 (while (consp file-arg-indices)
|
|
|
4504 (let ((pair (nthcdr (car file-arg-indices) arguments)))
|
|
|
4505 (and (car pair)
|
|
|
4506 (string-match "\\`/:" (car pair))
|
|
|
4507 (setcar pair
|
|
|
4508 (if (= (length (car pair)) 2)
|
|
|
4509 "/"
|
|
|
4510 (substring (car pair) 2)))))
|
|
|
4511 (setq file-arg-indices (cdr file-arg-indices))))
|
|
|
4512 (if (eq file-arg-indices 'identity)
|
|
|
4513 (car arguments)
|
|
|
4514 (apply operation arguments))))
|
|
|
4515
|
|
|
4516 ;; END SYNC WITH FSF 21.2.
|
|
428
|
4517
|
|
|
4518 ;;; files.el ends here
|
