From: Arthur Gleckler <edu/mit/csail/zurich/arthur>
Date: Wed, 18 Sep 1991 22:47:40 +0000 (+0000)
Subject: Make PROMPT-FOR-INPUT-TRUENAME accept files that are not directories.
X-Git-Tag: 20090517-FFI~10198
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d0dddbdd3e627f8fdf92253c5850e4c9eedc069d;p=mit-scheme.git

Make PROMPT-FOR-INPUT-TRUENAME accept files that are not directories.
The COPY-FILE, DELETE-FILE, and RENAME-FILE commands, which don't
work on directories anyway, will then refuse to accept directories as
arguments.
---

diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index bc92d3911..46e55743d 100644
--- a/v7/src/edwin/filcom.scm
+++ b/v7/src/edwin/filcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.158 1991/09/06 16:19:44 bal Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.159 1991/09/18 22:47:40 arthur Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -549,7 +549,8 @@ If a file with the new name already exists, confirmation is requested first."
 ;;;; Prompting
 
 (define (prompt-for-input-truename prompt default)
-  (pathname->input-truename (prompt-for-pathname prompt default true)))
+  (pathname->input-truename
+   (prompt-for-pathname-non-directory prompt default true)))
 
 (define (prompt-for-output-truename prompt default)
   (pathname->output-truename (prompt-for-pathname prompt default false)))
@@ -564,6 +565,15 @@ If a file with the new name already exists, confirmation is requested first."
 (define-integrable (prompt-for-pathname prompt default require-match?)
   (prompt-for-pathname* prompt default file-exists? require-match?))
 
+(define-integrable (prompt-for-pathname-non-directory
+		    prompt default require-match?)
+  (prompt-for-pathname* prompt
+			default
+			(lambda (file)
+			  (and (file-exists? file)
+			       (not (file-directory? file))))
+			require-match?))
+
 (define (prompt-for-pathname* prompt directory
 			      verify-final-value? require-match?)
   (let ((directory