From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 23 Aug 1997 05:20:15 +0000 (+0000)
Subject: Work around problem in NT: prompting for a directory with a wildcard
X-Git-Tag: 20090517-FFI~5021
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=be3b1e2a91f63a50d3f186d06d7b4d58d28e148b;p=mit-scheme.git

Work around problem in NT: prompting for a directory with a wildcard
was causing an error.  On unix, this works because FILE-DIRECTORY?
accepts such specifications as arguments -- but on NT, it doesn't.
---

diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index 4b5c3f004..0f633a8a9 100644
--- a/v7/src/edwin/filcom.scm
+++ b/v7/src/edwin/filcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: filcom.scm,v 1.191 1997/07/25 07:07:24 cph Exp $
+;;;	$Id: filcom.scm,v 1.192 1997/08/23 05:20:15 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-97 Massachusetts Institute of Technology
 ;;;
@@ -688,11 +688,15 @@ Prefix arg means treat the plaintext file as binary data."
 
 (define (prompt-for-directory prompt default)
   (->namestring
-   (let ((directory
-	  (prompt-for-pathname* prompt default file-directory? false)))
-     (if (file-directory? directory)
-	 (pathname-as-directory directory)
-	 directory))))
+   (let ((file-directory?
+	  (lambda (pathname)
+	    (and (not (pathname-wild? pathname))
+		 (file-directory? pathname)))))
+     (let ((directory
+	    (prompt-for-pathname* prompt default file-directory? false)))
+       (if (file-directory? directory)
+	   (pathname-as-directory directory)
+	   directory)))))
 
 (define (prompt-for-existing-directory prompt default)
   (->namestring