From c3c1312851ad08b219fc330a7b84a259bb8a9a61 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 11 Feb 1999 20:07:37 +0000
Subject: [PATCH] ...

original commit: ebf561e60cef781e43010e1b64b1b294f5e357f9
---
 collects/framework/frame.ss                | 1 +
 collects/framework/gen-standard-menus.ss   | 6 +++---
 collects/framework/standard-menus-items.ss | 2 +-
 collects/tests/framework/main.ss           | 3 ++-
 4 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/collects/framework/frame.ss b/collects/framework/frame.ss
index 41cd768c..7ca34e4a 100644
--- a/collects/framework/frame.ss
+++ b/collects/framework/frame.ss
@@ -65,6 +65,7 @@
 	   (make-object % parent))])
       (sequence
 	(apply super-init args)
+	(send (group:get-the-frame-group) insert-frame this)
 	(make-object (get-menu-bar%) this))
       (private
 	[panel (make-root-area-container (get-area-container%) this)])
diff --git a/collects/framework/gen-standard-menus.ss b/collects/framework/gen-standard-menus.ss
index 02ec50d5..9aa14c42 100755
--- a/collects/framework/gen-standard-menus.ss
+++ b/collects/framework/gen-standard-menus.ss
@@ -5,7 +5,7 @@ string=? ; exec mred -mgaqvf $0
 (require-library "pretty.ss")
 (require-library "function.ss")
 
-(load-relative "standard-menus-items.ss")
+(require-library "standard-menus-items.ss" "framework")
 
 (define build-id
   (case-lambda
@@ -111,7 +111,7 @@ string=? ; exec mred -mgaqvf $0
   `(public [,(generic-name generic)
 	    ,(generic-initializer generic)]))
 
-(call-with-output-file "standard-menus.ss"
+(call-with-output-file (build-path (collection-path "framework") "standard-menus.ss")
   (lambda (port)
     (pretty-print
      `(define standard-menus<%>
@@ -131,7 +131,7 @@ string=? ; exec mred -mgaqvf $0
     (pretty-print
      `(define standard-menus-mixin
 	(mixin (basic<%>) (standard-menus<%>) args
-	  (inherit get-menu-bar on-close show)
+	  (inherit get-menu-bar can-close? on-close show)
 	  (sequence (apply super-init args))
 	  ,@(append 
 	     (map (lambda (x)
diff --git a/collects/framework/standard-menus-items.ss b/collects/framework/standard-menus-items.ss
index ae0380d4..9e2cf3b7 100644
--- a/collects/framework/standard-menus-items.ss
+++ b/collects/framework/standard-menus-items.ss
@@ -112,7 +112,7 @@
 	(make-between 'file-menu 'print 'close 'separator)
 	(make-an-item 'file-menu 'close
 		      "Close this file"
-		      '(lambda (item control) (when (on-close) (show #f)) #t)
+		      '(lambda (item control) (when (can-close?) (on-close) (show #f)) #t)
 		      #\w "&Close" "")
 	(make-between 'file-menu 'close 'quit 'nothing)
 	(make-an-item 'file-menu 'quit
diff --git a/collects/tests/framework/main.ss b/collects/tests/framework/main.ss
index 79f23659..441810f7 100644
--- a/collects/tests/framework/main.ss
+++ b/collects/tests/framework/main.ss
@@ -150,11 +150,12 @@
 			(and (list? answer)
 			     (= 2 (length answer))))
 	      (error 'send-sexp-to-mred "unpected result from mred: ~s~n" answer))
+
 	    (if (eof-object? answer)
 		(raise (make-eof-result))
 		(case (car answer)
 		  [(error)
-		   (error 'send-sexp-to-mred (format "mred raised \"~a\"" (second answer)))]
+		   (error 'send-sexp-to-mred "mred raised \"~a\"" (second answer))]
 		  [(cant-read) (error 'mred/cant-parse (second answer))]
 		  [(normal) 
 		   (printf "  ~a // ~a: received from mred:~n" section-name test-name)