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