From ab9eec41d3d88a7553715be819e1d2cd5f787a44 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 26 Jul 2004 15:43:25 +0000 Subject: [PATCH] . original commit: 3172aee157039285b5d9b3080b12dfaa3ea666f3 --- collects/tests/mred/item.ss | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) diff --git a/collects/tests/mred/item.ss b/collects/tests/mred/item.ss index 02c32409..81fd741c 100644 --- a/collects/tests/mred/item.ss +++ b/collects/tests/mred/item.ss @@ -1749,7 +1749,7 @@ [label "No-Clear Canvas Test"] [height 250] [width 300] - [style '(metal)])) + [style (if use-metal? '(metal) null)])) (define p (make-object vertical-panel% f)) (define c% (class canvas% (inherit get-dc refresh) @@ -1778,6 +1778,28 @@ (send f show #t) f) +(define (editor-frame canvas-style canvas-bg) + (define f (new frame% + [label "No-Clear Canvas Test"] + [height 250] + [width 300] + [style (if use-metal? '(metal) null)])) + (define c (new editor-canvas% + [parent f] + [style canvas-style])) + (define mb (make-object menu-bar% f)) + (define edit-menu (make-object menu% "Edit" mb)) + (define font-menu (make-object menu% "Font" mb)) + + (when canvas-bg + (send c set-canvas-background (make-object color% canvas-bg))) + (send c set-editor (new text%)) + + (append-editor-operation-menu-items edit-menu #f) + (append-editor-font-menu-items font-menu) + + (send f show #t)) + (define (editor-canvas-oneline-frame) (define f (make-frame frame% "x" #f 200 #f)) @@ -2078,6 +2100,19 @@ "Make No-Clear Canvas" cnp (lambda (b e) (no-clear-canvas-frame))) +(define edp (new horizontal-pane% + [parent ap] + [alignment '(center center)])) +(make-object button% + "Make Editor" edp + (lambda (b e) (editor-frame null #f))) +(make-object button% + "Make Transparent Editor" edp + (lambda (b e) (editor-frame '(transparent) #f))) +(make-object button% + "Make Blue Editor" edp + (lambda (b e) (editor-frame null "blue"))) + (define (choose-next radios) (let loop ([l radios]) (let* ([c (car l)]