From c314dc44cd35863a22e7f05e7809fe66e8431bf3 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 23 Mar 1999 04:33:33 +0000
Subject: [PATCH] ...

original commit: 87e5573d77e7d732757125b30e88c9f11154fb2a
---
 collects/framework/frame.ss  | 16 +++++++++-------
 collects/framework/group.ss  |  4 +++-
 collects/framework/main.ss   |  2 ++
 collects/framework/prefs.ss  | 26 +++++++-------------------
 collects/framework/scheme.ss |  1 +
 5 files changed, 22 insertions(+), 27 deletions(-)

diff --git a/collects/framework/frame.ss b/collects/framework/frame.ss
index cfbdeb1f..0d9264bc 100644
--- a/collects/framework/frame.ss
+++ b/collects/framework/frame.ss
@@ -753,6 +753,7 @@
       
       (rename [super-on-close on-close])
       (private
+	[outer-info-panel 'top-info-panel-uninitialized]
 	[close-panel-callback
 	 (preferences:add-callback
 	  'framework:show-status-line
@@ -763,7 +764,7 @@
 	    (send super-root change-children
 		  (lambda (l)
 		    (if v
-			(list rest-panel (get-info-panel))
+			(list rest-panel outer-info-panel)
 			(list rest-panel))))))])
       (override
 	[on-close
@@ -808,12 +809,13 @@
 
       (public
 	[get-info-panel
-	 (let* ([outer-info-panel (make-object horizontal-panel% super-root)]
-		[info-panel (make-object horizontal-panel% outer-info-panel)]
-		[spacer (make-object grow-box-spacer-pane% outer-info-panel)])
-	   (lambda ()
-	     (send outer-info-panel stretchable-height #f)
-	     info-panel))])
+	 (begin
+	   (set! outer-info-panel (make-object horizontal-panel% super-root))
+	   (let ([info-panel (make-object horizontal-panel% outer-info-panel)]
+		 [spacer (make-object grow-box-spacer-pane% outer-info-panel)])
+	     (lambda ()
+	       (send outer-info-panel stretchable-height #f)
+	       info-panel)))])
       (private
 	[lock-message (make-object message%
 			(let ([b (icon:get-unlock-bitmap)])
diff --git a/collects/framework/group.ss b/collects/framework/group.ss
index d2f0d377..d150bc89 100644
--- a/collects/framework/group.ss
+++ b/collects/framework/group.ss
@@ -2,6 +2,7 @@
   (import mred-interfaces^
 	  [application : framework:application^]
 	  [frame : framework:frame^]
+	  [preferences : framework:preferences^]
 	  [mzlib:function : mzlib:function^]
 	  [mzlib:file : mzlib:file^])
 
@@ -99,7 +100,8 @@
 
 	[get-mdi-parent
 	 (lambda ()
-	   (if (eq? (system-type) 'windows)
+	   (if (and (eq? (system-type) 'windows)
+		    (preferences:get 'framework:windows-mdi))
 	       (begin
 		 (set! get-mdi-parent (lambda () mdi-parent))
 		 (set! mdi-parent (make-object frame% (application:current-app-name)
diff --git a/collects/framework/main.ss b/collects/framework/main.ss
index 43d662fa..ff34d906 100644
--- a/collects/framework/main.ss
+++ b/collects/framework/main.ss
@@ -7,6 +7,8 @@
   
   ;; preferences
 
+  (preferences:set-default 'framework:windows-mdi #t boolean?)
+
   (preferences:set-default 'framework:menu-bindings #t boolean?)
 
   (preferences:set-default 'framework:verify-change-format #f boolean?)
diff --git a/collects/framework/prefs.ss b/collects/framework/prefs.ss
index 34c2c7f9..201d5bb5 100644
--- a/collects/framework/prefs.ss
+++ b/collects/framework/prefs.ss
@@ -55,11 +55,7 @@
 		       (format
 			"no default for ~a"
 			p))
-		      (raise (exn:make-during-preferences
-			      (if (exn? exn)
-				  (exn-message exn)
-				  (format "~s" exn))
-			      ((debug-info-handler))))))))))))
+		      (raise exn)))))))))
   
   (define get-callbacks
     (lambda (p)
@@ -82,12 +78,7 @@
       (andmap (lambda (x)
 		(guard "calling callback" p value
 		       (lambda () (x p value))
-		       (lambda (exn)
-			 (raise (exn:make-during-preferences
-				 (if (exn? exn)
-				     (exn-message exn)
-				     (format "~s" exn))
-				 ((debug-info-handler)))))))
+		       raise))
 	      (get-callbacks p))))
   
   (define get
@@ -173,12 +164,7 @@
 						     (lambda ()
 						       (k value))))
 				    value))
-				 (lambda (exn)
-				   (raise (exn:make-during-preferences
-					   (if (exn? exn)
-					       (exn-message exn)
-					       (format "~s" exn))
-					   ((debug-info-handler)))))))])
+				 raise))])
 		  (list p marshalled))]
 	       [else (error 'prefs.ss "robby error.2: ~a" ht-value)]))])
       (lambda () 
@@ -340,8 +326,8 @@
 	       [make-check
 		(lambda (pref title bool->pref pref->bool)
 		  (let*  ([callback
-			   (lambda (_ command)
-			     (set pref (bool->pref (send command checked?))))]
+			   (lambda (check-box _)
+			     (set pref (bool->pref (send check-box get-value))))]
 			  [pref-value (get pref)]
 			  [initial-value (pref->bool pref-value)]
 			  [c (make-object check-box% title main callback)])
@@ -375,6 +361,8 @@
 
 	  
 	  (make-check 'framework:display-line-numbers "Display line numbers in buffer; not character offsets" id id)
+	  (when (eq? (system-type) 'windows)
+	    (make-check 'framework:windows-mdi "Use MDI Windows" id id))
 
 	  main))
       #f)
diff --git a/collects/framework/scheme.ss b/collects/framework/scheme.ss
index 5749c196..7451eb08 100644
--- a/collects/framework/scheme.ss
+++ b/collects/framework/scheme.ss
@@ -156,6 +156,7 @@
        [after-insert
 	(lambda (start size)
 	  (send backward-cache invalidate start)
+	  (send forward-cache forward-invalidate start size)
 	  (highlight-parens)
 	  (super-after-insert start size))]
        [after-delete