From 8ed37d4e7703b2dd428e55ae388e7a7f857e1fde Mon Sep 17 00:00:00 2001
From: "Taylor R. Campbell" <net/mumble/campbell>
Date: Sat, 13 Sep 2008 09:50:18 +0000
Subject: [PATCH] In OPTIONAL-PORT, require only that if an argument was
 supplied it is a port.  Defer the guarantee that the port is an I/O port
 until it is important: ports with PROMPT-FOR-{COMMAND-,}EXPRESSION operations
 need not support input operations in order for the prompting procedures to
 work.

---
 v7/src/runtime/usrint.scm | 21 ++++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

diff --git a/v7/src/runtime/usrint.scm b/v7/src/runtime/usrint.scm
index 3c1d4f95c..b7288c49b 100644
--- a/v7/src/runtime/usrint.scm
+++ b/v7/src/runtime/usrint.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: usrint.scm,v 1.33 2008/09/09 18:30:21 riastradh Exp $
+$Id: usrint.scm,v 1.34 2008/09/13 09:50:18 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -42,6 +42,7 @@ USA.
       (if operation
 	  (operation port environment prompt level)
 	  (begin
+	    (guarantee-i/o-port port 'PROMPT-FOR-COMMAND-EXPRESSION)
 	    (write-command-prompt port prompt level)
 	    (port/with-input-terminal-mode port 'COOKED
 	      (lambda ()
@@ -51,21 +52,27 @@ USA.
   (%prompt-for-expression
    (optional-port port 'PROMPT-FOR-EXPRESSION)
    (optional-environment environment 'PROMPT-FOR-EXPRESSION)
-   prompt))
+   prompt
+   'PROMPT-FOR-EXPRESSION))
 
 (define (prompt-for-evaluated-expression prompt #!optional environment port)
   (let ((environment
 	 (optional-environment environment 'PROMPT-FOR-EVALUATED-EXPRESSION))
 	(port (optional-port port 'PROMPT-FOR-EVALUATED-EXPRESSION)))
-    (repl-eval (%prompt-for-expression port environment prompt)
-	       environment)))
-
-(define (%prompt-for-expression port environment prompt)
+    (repl-eval
+     (%prompt-for-expression port
+			     environment
+			     prompt
+			     'PROMPT-FOR-EVALUATED-EXPRESSION)
+     environment)))
+
+(define (%prompt-for-expression port environment prompt caller)
   (let ((prompt (canonicalize-prompt prompt ": ")))
     (let ((operation (port/operation port 'PROMPT-FOR-EXPRESSION)))
       (if operation
 	  (operation port environment prompt)
 	  (begin
+	    (guarantee-i/o-port port caller)
 	    (port/with-output-terminal-mode port 'COOKED
 	      (lambda ()
 		(fresh-line port)
@@ -80,7 +87,7 @@ USA.
   (if (default-object? port)
       (interaction-i/o-port)
       (begin
-	(guarantee-i/o-port port caller)
+	(guarantee-port port caller)
 	port)))
 
 (define (optional-environment environment caller)
-- 
2.25.1