From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 16 Oct 1993 07:34:43 +0000 (+0000)
Subject: Prompting commands now do standard modifications to prompt strings
X-Git-Tag: 20090517-FFI~7744
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b211ecfd974bb1f6177a5ecc2de4101974ee5b48;p=mit-scheme.git

Prompting commands now do standard modifications to prompt strings
BEFORE passing them to custom operations; operations must compensate.
---

diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm
index 98aefa68f..76a76e20c 100644
--- a/v7/src/edwin/intmod.scm
+++ b/v7/src/edwin/intmod.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: intmod.scm,v 1.68 1993/10/16 06:02:08 cph Exp $
+;;;	$Id: intmod.scm,v 1.69 1993/10/16 07:34:12 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -915,21 +915,19 @@ If this is an error, the debugger examines the error condition."
 (define (parse-command-prompt port prompt)
   (standard-prompt-spacing port)
   (let ((prompt
-	 (let ((prefix
-		(string-append (number->string (nearest-cmdl/level)) " ")))
-	   (if (and (string-prefix? prefix prompt)
-		    (not (string=? prefix prompt)))
-	       (string-tail prompt (string-length prefix))
-	       prompt))))
+	 (string-trim-right
+	  (let ((prefix
+		 (string-append (number->string (nearest-cmdl/level)) " ")))
+	    (if (and (string-prefix? prefix prompt)
+		     (not (string=? prefix prompt)))
+		(string-tail prompt (string-length prefix))
+		prompt)))))
     (if (not (and suppress-standard-prompts?
 		  (or (string=? prompt user-initial-prompt)
 		      (member prompt standard-prompts))))
 	(begin
 	  (write-string prompt port)
-	  (if (let ((n (string-length prompt)))
-		(and (> n 0)
-		     (not (char=? #\space (string-ref prompt (- n 1))))))
-	      (write-char #\space port))))))
+	  (write-char #\space port)))))
 
 (define suppress-standard-prompts? #t)
 (define standard-prompts '("]=>" "error>" "break>" "bkpt>" "debug>" "where>"))
diff --git a/v7/src/edwin/prompt.scm b/v7/src/edwin/prompt.scm
index 7b7cef80c..158508c71 100644
--- a/v7/src/edwin/prompt.scm
+++ b/v7/src/edwin/prompt.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: prompt.scm,v 1.159 1993/08/02 22:24:52 cph Exp $
+;;;	$Id: prompt.scm,v 1.160 1993/10/16 07:34:43 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -669,7 +669,10 @@ a repetition of this command will exit."
 ;;;; Confirmation Prompts
 
 (define (prompt-for-confirmation? prompt)
-  (prompt-for-typein (string-append prompt " (y or n)? ") false
+  (prompt-for-typein (if (string-suffix? " " prompt)
+			 prompt
+			 (string-append prompt " (y or n)? "))
+		     false
     (lambda ()
       (let loop ((lost? false))
 	(let ((char (keyboard-read)))