From fda0aca5fdfacca8a36e64d96c209649298a96ca Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 15 Jan 2000 20:49:42 +0000
Subject: [PATCH] ...

original commit: 12287f8a0274d981ddf2f64ce5cfdd6dddc8aab0
---
 collects/framework/exit.ss       |  2 +-
 collects/framework/frame.ss      |  3 ++-
 collects/tests/framework/exit.ss |  6 +++---
 collects/tests/framework/main.ss | 16 ++++------------
 4 files changed, 10 insertions(+), 17 deletions(-)

diff --git a/collects/framework/exit.ss b/collects/framework/exit.ss
index 0bfb0fb4..d6e6b17e 100644
--- a/collects/framework/exit.ss
+++ b/collects/framework/exit.ss
@@ -45,7 +45,7 @@
 		       (string-append "Are you sure you want to "
 				      w
 				      "?")]
-		      [(user-says) (gui-utils:get-choice message capw "Cancel")])
+		      [(user-says) (gui-utils:get-choice message capw "Cancel" "Warning" #f)])
 	  user-says)
 	#t))
 
diff --git a/collects/framework/frame.ss b/collects/framework/frame.ss
index f9866ae5..2b895e0b 100644
--- a/collects/framework/frame.ss
+++ b/collects/framework/frame.ss
@@ -1328,10 +1328,11 @@
 	       (set-editor position-edit)
 	       (stretchable-width #f)
 	       (stretchable-height #f))
-	(determine-width "0000:000-0000:000" 
+	(determine-width "0000:000-0000:000"
 			 position-canvas
 			 position-edit)
 	(editor-position-changed)
+	(send position-edit hide-caret #t)
 	(send position-edit lock #t))))
   
   (define pasteboard-info<%> (interface (info<%>)))
diff --git a/collects/tests/framework/exit.ss b/collects/tests/framework/exit.ss
index d5738efc..870a5831 100644
--- a/collects/tests/framework/exit.ss
+++ b/collects/tests/framework/exit.ss
@@ -5,7 +5,7 @@
       (lambda ()
 	(with-handlers ([eof-result? (lambda (x) 'passed)])
 	  (send-sexp-to-mred '(preferences:set 'framework:verify-exit #f))
-	  (send-sexp-to-mred '(exit:exit))
+	  (send-sexp-to-mred '(begin (exit:exit) (sleep/yield 1)))
 	  'failed)))
 
 (test 'exit/prompt
@@ -65,7 +65,7 @@
 	   `(begin
 	      (preferences:set 'framework:verify-exit #f)
 	      (exit:insert-can?-callback (lambda () (call-with-output-file ,tmp-file void) #t))
-	      (exit:exit))))))
+	      (begin (exit:exit) (sleep/yield 1)))))))
 
 (test 'exit-callback-removed
       (lambda (x) (and (eq? x 'passed) (not (mred-running?))))
@@ -75,7 +75,7 @@
 	   `(begin
 	      (preferences:set 'framework:verify-exit #f)
 	      ((exit:insert-can?-callback (lambda () (error 'called-exit-callback))))
-	      (exit:exit))))))
+	      (begin (exit:exit) (sleep/yield 1)))))))
 
 (test 'exit-callback-stops-exit
       (lambda (x) (eq? x 'passed))
diff --git a/collects/tests/framework/main.ss b/collects/tests/framework/main.ss
index 436dba38..14064fb6 100644
--- a/collects/tests/framework/main.ss
+++ b/collects/tests/framework/main.ss
@@ -142,24 +142,18 @@
 					   ov))))])
 		   (pretty-print sexp)
 		   (newline)))])
-	  (printf "1~n")
 	  (unless (and in-port
 		       out-port
 		       (or (not (char-ready? in-port))
 			   (not (eof-object? (peek-char in-port)))))
 	    (restart-mred))
 	  (printf "  ~a // ~a: sending to mred:~n" section-name test-name)
-	  (printf "2~n")
 	  (show-text sexp)
-	  (printf "3~n")
 	  (write sexp out-port)
-	  (printf "4~n")
 	  (newline out-port)
-	  (printf "5~n")
 	  (let ([answer
 		 (with-handlers ([(lambda (x) #t)
 				  (lambda (x)
-				    (printf "8 ~a~n" (exn-message x))
 				    (list 'cant-read
 					  (string-append
 					   (exn-message x)
@@ -168,18 +162,17 @@
 					    string
 					    (let loop ()
 					      (if (char-ready? in-port)
-						  (cons (read-char in-port)
-							(loop))
+						  (let ([char (read-char in-port)])
+						    (if (eof-object? char)
+							null
+							(cons char (loop))))
 						  null))))))])
-		   (printf "6~n")
 		   (read in-port))])
 	    (unless (or (eof-object? answer)
 			(and (list? answer)
 			     (= 2 (length answer))))
 	      (error 'send-sexp-to-mred "unpected result from mred: ~s~n" answer))
 
-	  (printf "7~n")
-
 	    (if (eof-object? answer)
 		(raise (make-eof-result))
 		(case (car answer)
@@ -210,7 +203,6 @@
 				(sexp/proc)
 				(begin0 (send-sexp-to-mred sexp/proc)
 					(send-sexp-to-mred ''check-for-errors)))])
-
 		       (not (passed? result))))])
 	      (when failed
 		(printf "FAILED ~a: ~a~n" failed test-name)