...

original commit: 9875d69e8e8cfcc119741273f90770db92066a2a

collects/framework/frame.ss

@@ -69,6 +69,8 @@
       (rename [super-can-close? can-close?]
 	      [super-on-close on-close]
 	      [super-on-focus on-focus])
+      (private
+	[after-init? #f])
       (override
 	[can-close?
 	 (lambda ()
@@ -92,7 +94,13 @@
         
         [on-drop-file
          (lambda (filename)
-           (handler:edit-file filename))])
+           (handler:edit-file filename))]
+	[on-new-child
+	 (lambda (child)
+	   (when after-init?
+	     (error 'frame:basic-mixin
+		    "do not add children directly to a frame:basic (unless using make-root-area-container); use the get-area-container method instead"
+		    )))])
 
       (inherit show)
       (public
@@ -126,13 +134,13 @@
       (private
 	[panel (make-root-area-container (get-area-container%) this)])
       (public
-	[get-area-container (lambda () panel)])))
+	[get-area-container (lambda () panel)])
+      (sequence
+	(set! after-init? #t))))
 
   (include "standard-menus.ss")
 
   (define -editor<%> (interface (standard-menus<%>)
-		       get-init-width
-		       get-init-height
 		       get-entire-label
 		       get-label-prefix
 		       set-label-prefix
@@ -148,14 +156,16 @@
 		       get-editor))
 
   (define editor-mixin
-    (mixin (standard-menus<%>) (-editor<%>) (file-name)
+    (mixin (standard-menus<%>) (-editor<%>) (file-name
+					     [parent #f]
+					     [width frame-width]
+					     [height frame-height]
+					     .
+					     args)
       (inherit get-area-container get-client-size 
-	       set-icon show get-edit-target-window get-edit-target-object)
+	       show get-edit-target-window get-edit-target-object)
       (rename [super-on-close on-close]
 	      [super-set-label set-label])
-      (public
-	[get-init-width (lambda () frame-width)]
-	[get-init-height (lambda () frame-height)])
 	     
       (override
 	[on-close
@@ -322,7 +332,12 @@
 			(format "Welcome to ~a" (application:current-app-name))))]
 	[help-menu:about-string (lambda () (application:current-app-name))])
 	     
-      (sequence (super-init (get-entire-label) #f (get-init-width) (get-init-height)))
+      (sequence (apply super-init
+		       (get-entire-label)
+		       parent
+		       width
+		       height
+		       args))
 	     
       (public
 	[get-canvas (let ([c #f])
@@ -338,11 +353,6 @@
 			  (send (get-canvas) set-editor e))
 			e))])
       (sequence
-	(let ([icon (icon:get)]
-              [mask (icon:get-mask)])
-	  (when (and (send icon ok?)
-                     (send mask ok?))
-	    (set-icon icon mask)))
 	(do-label)
 	(cond
 	 [(and file-name (file-exists? file-name))

collects/framework/gen-standard-menus.ss

@@ -5,6 +5,8 @@ string=? ; exec mred -mgaqvf $0
 (require-library "pretty.ss")
 (require-library "function.ss")
 
+(require-library "errortrace.ss" "errortrace")
+
 (require-library "standard-menus-items.ss" "framework")
 
 (define build-id
@@ -48,7 +50,7 @@ string=? ; exec mred -mgaqvf $0
 		      `(lambda () "")
 		      `(lambda () ,help-string)))))))
 
-(define build-fill-in-between/after-clause
+(define build-fill-in-clause
   (lambda (->name -procedure)
     (lambda (obj)
       `(public
@@ -57,8 +59,14 @@ string=? ; exec mred -mgaqvf $0
 	     [(nothing) '(lambda (menu) (void))]
 	     [(separator) '(lambda (menu) (make-object separator-menu-item% menu))])]))))
 
-(define build-fill-in-between-clause (build-fill-in-between/after-clause between->name between-procedure))
+(define build-fill-in-between-clause
-(define build-fill-in-after-clause (build-fill-in-between/after-clause after->name after-procedure))
+  (build-fill-in-clause
+   between->name
+   between-procedure))
+(define build-fill-in-before/after-clause
+  (build-fill-in-clause
+   before/after->name
+   before/after-procedure))
 
 (define (build-item-menu-clause item)
   (let* ([name (an-item->name item)]
@@ -82,15 +90,17 @@ string=? ; exec mred -mgaqvf $0
 	       (if (preferences:get 'framework:menu-bindings) ,key #f)
 	       (,(build-id item "-help-string"))))])))
 
-(define build-between/after-menu-clause
+(define build-menu-clause
   (lambda (->name -menu)
     (lambda (between/after)
       `(sequence
 	 (,(->name between/after)
 	  ,(menu-name->get-menu (-menu between/after)))))))
 
-(define build-between-menu-clause (build-between/after-menu-clause between->name between-menu))
+(define build-between-menu-clause
-(define build-after-menu-clause (build-between/after-menu-clause after->name after-menu))
+  (build-menu-clause between->name between-menu))
+(define build-before/after-menu-clause
+  (build-menu-clause before/after->name before/after-menu))
 
 (define menu-name->get-menu
   (lambda (menu-name)
@@ -121,7 +131,8 @@ string=? ; exec mred -mgaqvf $0
 			     (cond
 			       [(an-item? x) (an-item->names x)]
 			       [(between? x) (list (between->name x))]
-			       [(after? x) (list (after->name x))]
+			       [(or (after? x) (before? x))
+				(list (before/after->name x))]
 			       [(generic? x) (list (generic-name x))])) 
 			   items))))
      port)
@@ -137,7 +148,8 @@ string=? ; exec mred -mgaqvf $0
 	     (map (lambda (x)
 		    (cond
 		      [(between? x) (build-fill-in-between-clause x)]
-		      [(after? x) (build-fill-in-after-clause x)]
+		      [(or (after? x) (before? x))
+		       (build-fill-in-before/after-clause x)]
 		      [(an-item? x) (build-fill-in-item-clause x)]
 		      [(generic? x) (build-fill-in-generic-clause x)]
 		      [else (printf "~a~n" x)]))
@@ -146,7 +158,8 @@ string=? ; exec mred -mgaqvf $0
 		    (cond
 		      [(between? x) (build-between-menu-clause x)]
 		      [(an-item? x) (build-item-menu-clause x)]
-		      [(after? x) (build-after-menu-clause x)]
+		      [(or (after? x) (before? x))
+		       (build-before/after-menu-clause x)]
 		      [(generic? x) (build-generic-clause x)]))
 		  items)
 	     (list `(sequence (reorder-menus this))))))

collects/framework/standard-menus-items.ss

@@ -1,8 +1,15 @@
 (define-struct generic (name initializer documentation))
 
-(define-struct after (menu name procedure))
+(define-struct before/after (menu name procedure))
-(define (after->name after)
+(define-struct (before struct:before/after) ())
-  (string->symbol (format "~a:after-~a" (after-menu after) (after-name after))))
+(define-struct (after struct:before/after) ())
+(define (before/after->name before/after)
+  (string->symbol (format "~a:~a-~a"
+			  (before/after-menu before/after)
+			  (if (before? before/after)
+			      "before"
+			      "after")
+			  (before/after-name before/after))))
 
 (define-struct between (menu before after procedure))
 (define (between->name between)
@@ -159,6 +166,7 @@
 		      #f "Preferences..." "")
 	(make-after 'edit-menu 'preferences 'nothing)
 	
+	(make-before 'help-menu 'about 'nothing)
 	(make-an-item 'help-menu 'about "Learn something about this application"
 		      #f
 		      #f