|
22
|
1 ;;;; Emacs 19 compatibility functions for use in Emacs 18.
|
|
|
2 ;;;; Based on: $Id: emacs-19.el,v 1.1 1997/02/11 05:05:14 steve Exp $
|
|
|
3 ;;;;
|
|
|
4 ;;;; Rewritten by sandy@ibm550.sissa.it after gnu emacs 19 was
|
|
|
5 ;;;; released to make it closer to V19.
|
|
|
6 ;;;; Last modified: Sun Jun 12 00:06:06 1994 by sandy on ibm550
|
|
|
7
|
|
|
8 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
9 ;;; it under the terms of the GNU General Public License as published by
|
|
|
10 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
11 ;;; any later version.
|
|
|
12 ;;;
|
|
|
13 ;;; This program is distributed in the hope that it will be useful,
|
|
|
14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
16 ;;; GNU General Public License for more details.
|
|
|
17 ;;;
|
|
|
18 ;;; A copy of the GNU General Public License can be obtained from this
|
|
|
19 ;;; program's author (send electronic mail to roland@ai.mit.edu) or from
|
|
|
20 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
|
|
|
21 ;;; 02139, USA.
|
|
|
22
|
|
|
23 ;; These functions are used in dired.el, but are also of general
|
|
|
24 ;; interest, so you may want to add this to your .emacs:
|
|
|
25 ;;
|
|
|
26 ;; (autoload 'make-directory "emacs-19" "Make a directory." t)
|
|
|
27 ;; (autoload 'delete-directory "emacs-19" "Remove a directory." t)
|
|
|
28 ;; (autoload 'member "emacs-19" "Like memq, but uses `equal' instead of `eq'.")
|
|
|
29 ;; (autoload 'compiled-function-p "emacs-19" "Emacs 18 doesn't have these.")
|
|
|
30
|
|
|
31 (provide 'emacs-19)
|
|
|
32
|
|
|
33 ;;; Variables
|
|
|
34
|
|
|
35 (defvar insert-directory-program "ls"
|
|
|
36 "Absolute or relative name of the `ls' program used by `insert-directory'.")
|
|
|
37
|
|
|
38 (defvar bv-length) ; make the byte compiler a happy camper
|
|
|
39
|
|
|
40 (defconst directory-abbrev-alist
|
|
|
41 nil
|
|
|
42 "*Alist of abbreviations for file directories.
|
|
|
43 A list of elements of the form (FROM . TO), each meaning to replace
|
|
|
44 FROM with TO when it appears in a directory name. This replacement is
|
|
|
45 done when setting up the default directory of a newly visited file.
|
|
|
46 *Every* FROM string should start with `^'.
|
|
|
47
|
|
|
48 Use this feature when you have directories which you normally refer to
|
|
|
49 via absolute symbolic links. Make TO the name of the link, and FROM
|
|
|
50 the name it is linked to.")
|
|
|
51
|
|
|
52 (defconst automount-dir-prefix "^/tmp_mnt/"
|
|
|
53 "Regexp to match the automounter prefix in a directory name.")
|
|
|
54
|
|
|
55 (defvar abbreviated-home-dir nil
|
|
|
56 "The the user's homedir abbreviated according to `directory-abbrev-list'.")
|
|
|
57
|
|
|
58 ;;; Autoloads
|
|
|
59
|
|
|
60 (autoload 'diff "diff" "Diff two files." t)
|
|
|
61 (autoload 'diff-backup "diff" "Diff a file with its most recent backup.")
|
|
|
62
|
|
|
63 ;;; Functions which are subroutines in Emacs 19.
|
|
|
64
|
|
|
65 ;; Provide a non-working version of find-file-name-handler.
|
|
|
66 ;; If you want it to work, require 'fn-handler.
|
|
|
67
|
|
|
68 (or (fboundp 'find-file-name-handler) (fset 'find-file-name-handler 'ignore))
|
|
|
69 (or (boundp 'file-name-handler-alist) (defvar file-name-handler-alist nil))
|
|
|
70
|
|
|
71 ;; The name of buffer-flush-undo has changed in V19.
|
|
|
72 (fset 'buffer-disable-undo 'buffer-flush-undo)
|
|
|
73
|
|
|
74 (defun current-time ()
|
|
|
75 "Returns the number of seconds since midnight.
|
|
|
76 A poor man's version of the the function `current-time' in emacs 19."
|
|
|
77 (let ((string (current-time-string)))
|
|
|
78 (list
|
|
|
79 0
|
|
|
80 (+ (* 3600 (string-to-int (substring string 11 13)))
|
|
|
81 (* 60 (string-to-int (substring string 14 16)))
|
|
|
82 (string-to-int (substring string 17 19)))
|
|
|
83 0)))
|
|
|
84
|
|
|
85 ;; call-process below may lose if filename starts with a `-', but I
|
|
|
86 ;; fear not all mkdir or rmdir implementations understand `--'.
|
|
|
87
|
|
|
88 (defun delete-directory (fn)
|
|
|
89 "Delete a directory.
|
|
|
90 This is a subr in Emacs 19."
|
|
|
91 (interactive
|
|
|
92 (list (read-file-name "Delete directory: " nil nil 'confirm)))
|
|
|
93 (setq fn (expand-file-name fn))
|
|
|
94 (if (file-directory-p fn)
|
|
|
95 (call-process "rmdir" nil nil nil fn)
|
|
|
96 (error "Not a directory: %s" fn))
|
|
|
97 (if (file-exists-p fn)
|
|
|
98 (error "Could not remove directory %s" fn)))
|
|
|
99
|
|
|
100 (defun make-directory (dir &optional parents)
|
|
|
101 "Create the directory DIR and any nonexistent parent dirs."
|
|
|
102 (interactive "FMake directory: \nP")
|
|
|
103 (if (not parents)
|
|
|
104 (make-directory-internal dir)
|
|
|
105 (let ((dir (directory-file-name (expand-file-name dir)))
|
|
|
106 create-list)
|
|
|
107 (while (not (file-exists-p dir))
|
|
|
108 (setq create-list (cons dir create-list)
|
|
|
109 dir (directory-file-name (file-name-directory dir))))
|
|
|
110 (while create-list
|
|
|
111 (make-directory-internal (car create-list))
|
|
|
112 (setq create-list (cdr create-list))))))
|
|
|
113
|
|
|
114 (defun make-directory-internal (fn)
|
|
|
115 ;; This is a subroutine in emacs 19.
|
|
|
116 (let* ((fn (expand-file-name fn))
|
|
|
117 (handler (find-file-name-handler fn 'make-directory-internal)))
|
|
|
118 (if handler
|
|
|
119 (funcall handler 'make-directory-internal fn)
|
|
|
120 (setq fn (directory-file-name fn))
|
|
|
121 (if (file-exists-p fn)
|
|
|
122 (error "Cannot make directory %s: file already exists" fn)
|
|
|
123 (call-process "mkdir" nil nil nil fn))
|
|
|
124 (or (file-directory-p fn)
|
|
|
125 (error "Could not make directory %s" fn)))))
|
|
|
126
|
|
|
127 (defun kill-new (string)
|
|
|
128 "Save STRING as if killed in a buffer."
|
|
|
129 (setq kill-ring (cons string kill-ring))
|
|
|
130 (if (> (length kill-ring) kill-ring-max)
|
|
|
131 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
|
|
|
132 (setq kill-ring-yank-pointer kill-ring))
|
|
|
133
|
|
|
134 (defun insert-directory (file switches &optional wildcard full-directory-p)
|
|
|
135 "Insert directory listing for FILE, formatted according to SWITCHES.
|
|
|
136 Leaves point after the inserted text.
|
|
|
137 SWITCHES may be a string of options, or a list of strings.
|
|
|
138 Optional third arg WILDCARD means treat FILE as shell wildcard.
|
|
|
139 Optional fourth arg FULL-DIRECTORY-P means file is a directory and
|
|
|
140 switches do not contain `d', so that a full listing is expected.
|
|
|
141
|
|
|
142 This works by running a directory listing program
|
|
|
143 whose name is in the variable `insert-directory-program'.
|
|
|
144 If WILDCARD, it also runs the shell specified by `shell-file-name'."
|
|
|
145 ;; We need the directory in order to find the right handler.
|
|
|
146 (let ((handler (find-file-name-handler (expand-file-name file)
|
|
|
147 'insert-directory)))
|
|
|
148 (if handler
|
|
|
149 (funcall handler 'insert-directory file switches
|
|
|
150 wildcard full-directory-p)
|
|
|
151 (if (eq system-type 'vax-vms)
|
|
|
152 (vms-read-directory file switches (current-buffer))
|
|
|
153 (if wildcard
|
|
|
154 ;; Run ls in the directory of the file pattern we asked for.
|
|
|
155 (let ((default-directory
|
|
|
156 (if (file-name-absolute-p file)
|
|
|
157 (file-name-directory file)
|
|
|
158 (file-name-directory (expand-file-name file))))
|
|
|
159 (pattern (file-name-nondirectory file))
|
|
|
160 (beg 0))
|
|
|
161 ;; Quote some characters that have special meanings in shells;
|
|
|
162 ;; but don't quote the wildcards--we want them to be special.
|
|
|
163 ;; We also currently don't quote the quoting characters
|
|
|
164 ;; in case people want to use them explicitly to quote
|
|
|
165 ;; wildcard characters.
|
|
|
166 (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
|
|
|
167 (setq pattern
|
|
|
168 (concat (substring pattern 0 (match-beginning 0))
|
|
|
169 "\\"
|
|
|
170 (substring pattern (match-beginning 0)))
|
|
|
171 beg (1+ (match-end 0))))
|
|
|
172 (call-process shell-file-name nil t nil
|
|
|
173 "-c" (concat insert-directory-program
|
|
|
174 " -d "
|
|
|
175 (if (stringp switches)
|
|
|
176 switches
|
|
|
177 (mapconcat 'identity switches " "))
|
|
|
178 " "
|
|
|
179 pattern)))
|
|
|
180 ;; SunOS 4.1.3, SVr4 and others need the "." to list the
|
|
|
181 ;; directory if FILE is a symbolic link.
|
|
|
182 (apply 'call-process
|
|
|
183 insert-directory-program nil t nil
|
|
|
184 (let (list)
|
|
|
185 (if (listp switches)
|
|
|
186 (setq list switches)
|
|
|
187 (if (not (equal switches ""))
|
|
|
188 (progn
|
|
|
189 ;; Split the switches at any spaces
|
|
|
190 ;; so we can pass separate options as separate args.
|
|
|
191 (while (string-match " " switches)
|
|
|
192 (setq list (cons (substring switches 0
|
|
|
193 (match-beginning 0))
|
|
|
194 list)
|
|
|
195 switches (substring switches
|
|
|
196 (match-end 0))))
|
|
|
197 (setq list (cons switches list)))))
|
|
|
198 (append list
|
|
|
199 (list
|
|
|
200 (if full-directory-p
|
|
|
201 (concat (file-name-as-directory file) ".")
|
|
|
202 file))))))))))
|
|
|
203
|
|
|
204 (defun file-local-copy (file)
|
|
|
205 "Copy the file FILE into a temporary file on this machine.
|
|
|
206 Returns the name of the local copy, or nil, if FILE is directly
|
|
|
207 accessible."
|
|
|
208 (let* ((file (expand-file-name file))
|
|
|
209 (handler (find-file-name-handler file 'file-local-copy)))
|
|
|
210 ;; Does nothing, if no handler.
|
|
|
211 (if handler
|
|
|
212 (funcall handler 'file-local-copy file))))
|
|
|
213
|
|
|
214 (defun file-truename (filename)
|
|
|
215 "Return the truename of FILENAME, which should be absolute.
|
|
|
216 The truename of a file name is found by chasing symbolic links
|
|
|
217 both at the level of the file and at the level of the directories
|
|
|
218 containing it, until no links are left at any level."
|
|
|
219 (if (or (string= filename "~")
|
|
|
220 (and (string= (substring filename 0 1) "~")
|
|
|
221 (string-match "~[^/]*" filename)))
|
|
|
222 (progn
|
|
|
223 (setq filename (expand-file-name filename))
|
|
|
224 (if (string= filename "")
|
|
|
225 (setq filename "/"))))
|
|
|
226 (let ((handler (find-file-name-handler filename 'file-truename)))
|
|
|
227 ;; For file name that has a special handler, call handler.
|
|
|
228 ;; This is so that ange-ftp can save time by doing a no-op.
|
|
|
229 (if handler
|
|
|
230 (funcall handler 'file-truename filename)
|
|
|
231 (let ((dir (file-name-directory filename))
|
|
|
232 target dirfile file-name-handler-alist)
|
|
|
233 ;; Get the truename of the directory.
|
|
|
234 (setq dirfile (directory-file-name dir))
|
|
|
235 ;; If these are equal, we have the (or a) root directory.
|
|
|
236 (or (string= dir dirfile)
|
|
|
237 (setq dir (file-name-as-directory (file-truename dirfile))))
|
|
|
238 (if (equal ".." (file-name-nondirectory filename))
|
|
|
239 (directory-file-name (file-name-directory
|
|
|
240 (directory-file-name dir)))
|
|
|
241 (if (equal "." (file-name-nondirectory filename))
|
|
|
242 (directory-file-name dir)
|
|
|
243 ;; Put it back on the file name.
|
|
|
244 (setq filename (concat dir (file-name-nondirectory filename)))
|
|
|
245 ;; Is the file name the name of a link?
|
|
|
246 (setq target (file-symlink-p filename))
|
|
|
247 (if target
|
|
|
248 ;; Yes => chase that link, then start all over
|
|
|
249 ;; since the link may point to a directory name that uses links.
|
|
|
250 ;; We can't safely use expand-file-name here
|
|
|
251 ;; since target might look like foo/../bar where foo
|
|
|
252 ;; is itself a link. Instead, we handle . and .. above.
|
|
|
253 (if (file-name-absolute-p target)
|
|
|
254 (file-truename target)
|
|
|
255 (file-truename (concat dir target)))
|
|
|
256 ;; No, we are done!
|
|
|
257 filename)))))))
|
|
|
258
|
|
|
259 (defun generate-new-buffer-name (name)
|
|
|
260 "Return a string which is the name of no existing buffer based on
|
|
|
261 NAME. If there is no live buffer named NAME, return NAME. Otherwise,
|
|
|
262 modify name by appending `<NUMBER>', incrementing NUMBER until an
|
|
|
263 unused name is found. Return that name."
|
|
|
264 (if (get-buffer name)
|
|
|
265 (let ((num 2)
|
|
|
266 attempt)
|
|
|
267 (while (progn
|
|
|
268 (setq attempt (concat name "<" (int-to-string num) ">"))
|
|
|
269 (get-buffer attempt))
|
|
|
270 (setq num (1+ num)))
|
|
|
271 attempt)
|
|
|
272 name))
|
|
|
273
|
|
|
274 (defun abbreviate-file-name (filename)
|
|
|
275 "Return a version of FILENAME shortened using `directory-abbrev-alist'.
|
|
|
276 This also substitutes \"~\" for the user's home directory.
|
|
|
277 Type \\[describe-variable] directory-abbrev-alist RET for more information."
|
|
|
278 ;; Get rid of the prefixes added by the automounter.
|
|
|
279 (if (and (string-match automount-dir-prefix filename)
|
|
|
280 (file-exists-p (file-name-directory
|
|
|
281 (substring filename (1- (match-end 0))))))
|
|
|
282 (setq filename (substring filename (1- (match-end 0)))))
|
|
|
283 (let ((tail directory-abbrev-alist))
|
|
|
284 ;; If any elt of directory-abbrev-alist matches this name,
|
|
|
285 ;; abbreviate accordingly.
|
|
|
286 (while tail
|
|
|
287 (if (string-match (car (car tail)) filename)
|
|
|
288 (setq filename
|
|
|
289 (concat (cdr (car tail)) (substring filename (match-end 0)))))
|
|
|
290 (setq tail (cdr tail)))
|
|
|
291 ;; Compute and save the abbreviated homedir name.
|
|
|
292 ;; We defer computing this until the first time it's needed, to
|
|
|
293 ;; give time for directory-abbrev-alist to be set properly.
|
|
|
294 (or abbreviated-home-dir
|
|
|
295 (setq abbreviated-home-dir
|
|
|
296 (let ((abbreviated-home-dir "$foo"))
|
|
|
297 (concat "^" (abbreviate-file-name (expand-file-name "~"))))))
|
|
|
298 ;; If FILENAME starts with the abbreviated homedir,
|
|
|
299 ;; make it start with `~' instead.
|
|
|
300 (if (string-match abbreviated-home-dir filename)
|
|
|
301 (setq filename
|
|
|
302 (concat "~"
|
|
|
303 ;; If abbreviated-home-dir ends with a slash,
|
|
|
304 ;; don't remove the corresponding slash from
|
|
|
305 ;; filename. On MS-DOS and OS/2, you can have
|
|
|
306 ;; home directories like "g:/", in which it is
|
|
|
307 ;; important not to remove the slash. And what
|
|
|
308 ;; about poor root on Unix systems?
|
|
|
309 (if (eq ?/ (aref abbreviated-home-dir
|
|
|
310 (1- (length abbreviated-home-dir))))
|
|
|
311 "/"
|
|
|
312 "")
|
|
|
313 (substring filename (match-end 0)))))
|
|
|
314 filename))
|
|
|
315
|
|
|
316 (defun file-newest-backup (filename)
|
|
|
317 "Return most recent backup file for FILENAME or nil if no backups exist."
|
|
|
318 (let* ((filename (expand-file-name filename))
|
|
|
319 (file (file-name-nondirectory filename))
|
|
|
320 (dir (file-name-directory filename))
|
|
|
321 (comp (file-name-all-completions file dir))
|
|
|
322 newest)
|
|
|
323 (while comp
|
|
|
324 (setq file (concat dir (car comp))
|
|
|
325 comp (cdr comp))
|
|
|
326 (if (and (backup-file-name-p file)
|
|
|
327 (or (null newest) (file-newer-than-file-p file newest)))
|
|
|
328 (setq newest file)))
|
|
|
329 newest))
|
|
|
330
|
|
|
331 ;; This is used in various files.
|
|
|
332 ;; The usage of bv-length is not very clean,
|
|
|
333 ;; but I can't see a good alternative,
|
|
|
334 ;; so as of now I am leaving it alone.
|
|
|
335 (defun backup-extract-version (fn)
|
|
|
336 "Given the name of a numeric backup file, return the backup number.
|
|
|
337 Uses the free variable `bv-length', whose value should be
|
|
|
338 the index in the name where the version number begins."
|
|
|
339 (if (and (string-match "[0-9]+~$" fn bv-length)
|
|
|
340 (= (match-beginning 0) bv-length))
|
|
|
341 (string-to-int (substring fn bv-length -1))
|
|
|
342 0))
|
|
|
343
|
|
|
344 ;; The standard V18 version of this function doesn't support
|
|
|
345 ;; the arg KEEP-BACKUP-VERSION
|
|
|
346 (defun file-name-sans-versions (name &optional keep-backup-version)
|
|
|
347 "Return FILENAME sans backup versions or strings.
|
|
|
348 This is a separate procedure so your site-init or startup file can
|
|
|
349 redefine it.
|
|
|
350 If the optional argument KEEP-BACKUP-VERSION is non-nil,
|
|
|
351 we do not remove backup version numbers, only true file version numbers."
|
|
|
352 (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
|
|
|
353 (if handler
|
|
|
354 (funcall handler 'file-name-sans-versions name keep-backup-version)
|
|
|
355 (substring name 0
|
|
|
356 (if (eq system-type 'vax-vms)
|
|
|
357 ;; VMS version number is (a) semicolon, optional
|
|
|
358 ;; sign, zero or more digits or (b) period, option
|
|
|
359 ;; sign, zero or more digits, provided this is the
|
|
|
360 ;; second period encountered outside of the
|
|
|
361 ;; device/directory part of the file name.
|
|
|
362 (or (string-match ";[-+]?[0-9]*\\'" name)
|
|
|
363 (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'"
|
|
|
364 name)
|
|
|
365 (match-beginning 1))
|
|
|
366 (length name))
|
|
|
367 (if keep-backup-version
|
|
|
368 (length name)
|
|
|
369 (or (string-match "\\.~[0-9]+~\\'" name)
|
|
|
370 (string-match "~\\'" name)
|
|
|
371 (length name))))))))
|
|
|
372
|
|
|
373 (defun member (x y)
|
|
|
374 "Like memq, but uses `equal' for comparison.
|
|
|
375 This is a subr in Emacs 19."
|
|
|
376 (while (and y (not (equal x (car y))))
|
|
|
377 (setq y (cdr y)))
|
|
|
378 y)
|
|
|
379
|
|
|
380 (defun compiled-function-p (x)
|
|
|
381 "Emacs 18 doesn't have these."
|
|
|
382 nil)
|
|
|
383
|
|
|
384 ;; punt -- this will at least allow handlers to work for this.
|
|
|
385 (defun set-visited-file-modtime (&optional time)
|
|
|
386 (error "set-visited-file-modtime not defined in emacs 18."))
|
|
|
387
|
|
|
388 (defun add-hook (hook function &optional append)
|
|
|
389 "Add to the value of HOOK the function FUNCTION.
|
|
|
390 FUNCTION is not added if already present.
|
|
|
391 FUNCTION is added (if necessary) at the beginning of the hook list
|
|
|
392 unless the optional argument APPEND is non-nil, in which case
|
|
|
393 FUNCTION is added at the end.
|
|
|
394
|
|
|
395 HOOK should be a symbol, and FUNCTION may be any valid function. If
|
|
|
396 HOOK is void, it is first set to nil. If HOOK's value is a single
|
|
|
397 function, it is changed to a list of functions."
|
|
|
398 (or (boundp hook) (set hook nil))
|
|
|
399 ;; If the hook value is a single function, turn it into a list.
|
|
|
400 (let ((old (symbol-value hook)))
|
|
|
401 (if (or (not (listp old)) (eq (car old) 'lambda))
|
|
|
402 (set hook (list old))))
|
|
|
403 (or (if (consp function)
|
|
|
404 ;; Clever way to tell whether a given lambda-expression
|
|
|
405 ;; is equal to anything in the hook.
|
|
|
406 (let ((tail (assoc (cdr function) (symbol-value hook))))
|
|
|
407 (equal function tail))
|
|
|
408 (memq function (symbol-value hook)))
|
|
|
409 (set hook
|
|
|
410 (if append
|
|
|
411 (nconc (symbol-value hook) (list function))
|
|
|
412 (cons function (symbol-value hook))))))
|
|
|
413
|
|
|
414 ;;; after-save.el (Now part of files.el in Gnu Emacs V19)
|
|
|
415
|
|
|
416 ;;; Copyright (C) 1990 Roland McGrath
|
|
|
417 ;;;
|
|
|
418
|
|
|
419 (or (fboundp 'real-save-buffer)
|
|
|
420 (fset 'real-save-buffer (symbol-function 'save-buffer)))
|
|
|
421
|
|
|
422 (defvar after-save-hook nil
|
|
|
423 "A function or list of functions to be run after saving the current buffer.")
|
|
|
424
|
|
|
425 (defun save-buffer (&optional args)
|
|
|
426 "Save the current buffer, and then run `after-save-buffer-hook'.
|
|
|
427 The hooks are only run if the buffer was actually written.
|
|
|
428 For more documentation, do \\[describe-function] real-save-buffer RET."
|
|
|
429 (interactive "p")
|
|
|
430 (let ((modp (buffer-modified-p)))
|
|
|
431 (real-save-buffer args)
|
|
|
432 (if modp
|
|
|
433 (run-hooks 'after-save-hook))))
|
|
|
434
|
|
|
435 ;;; end of after-save
|
|
|
436
|
|
|
437 ;;;;
|
|
|
438 ;;;; Correcting for V18 bugs, and hacking around stupidities.
|
|
|
439 ;;;;
|
|
|
440
|
|
|
441 ;; The 18.57 version has a bug that causes C-x C-v RET (which usually
|
|
|
442 ;; re-visits the current buffer) to fail on dired buffers.
|
|
|
443 ;; Only the last statement was changed to avoid killing the current
|
|
|
444 ;; buffer.
|
|
|
445 (defun find-alternate-file (filename)
|
|
|
446 "Find file FILENAME, select its buffer, kill previous buffer.
|
|
|
447 If the current buffer now contains an empty file that you just visited
|
|
|
448 \(presumably by mistake), use this command to visit the file you really want."
|
|
|
449 (interactive "FFind alternate file: ")
|
|
|
450 (and (buffer-modified-p)
|
|
|
451 (not buffer-read-only)
|
|
|
452 (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
|
|
|
453 (buffer-name))))
|
|
|
454 (error "Aborted"))
|
|
|
455 (let ((obuf (current-buffer))
|
|
|
456 (ofile buffer-file-name)
|
|
|
457 (oname (buffer-name)))
|
|
|
458 (rename-buffer " **lose**")
|
|
|
459 (setq buffer-file-name nil)
|
|
|
460 (unwind-protect
|
|
|
461 (progn
|
|
|
462 (unlock-buffer)
|
|
|
463 (find-file filename))
|
|
|
464 (cond ((eq obuf (current-buffer))
|
|
|
465 (setq buffer-file-name ofile)
|
|
|
466 (lock-buffer)
|
|
|
467 (rename-buffer oname))))
|
|
|
468 (or (eq (current-buffer) obuf)
|
|
|
469 (kill-buffer obuf))))
|
|
|
470
|
|
|
471 ;; At least in Emacs 18.55 this defvar has been forgotten to be copied
|
|
|
472 ;; from lpr.el into loaddefs.el
|
|
|
473
|
|
|
474 (defvar lpr-command (if (eq system-type 'usg-unix-v)
|
|
|
475 "lp" "lpr")
|
|
|
476 "Shell command for printing a file")
|
|
|
477
|
|
|
478
|
|
|
479 ;; buffer-disable-undo used to be called buffer-flush-undo in Emacs
|
|
|
480 ;; 18.55:
|
|
|
481 (or (fboundp 'buffer-disable-undo)
|
|
|
482 (fset 'buffer-disable-undo 'buffer-flush-undo))
|
|
|
483
|
|
|
484 ;;; end of emacs-19.el
|
