From d94bb93e0b23cfbab67860d59ce352a1a3c418c6 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 3 Dec 1998 21:05:40 +0000
Subject: [PATCH] ...

original commit: 7fc74ec47b682da35065802912047d54060d2b3a
---
 collects/framework/text.ss         | 16 ++++------------
 collects/tests/framework/README    |  3 ++-
 collects/tests/framework/canvas.ss | 18 +++++++++++++-----
 3 files changed, 19 insertions(+), 18 deletions(-)

diff --git a/collects/framework/text.ss b/collects/framework/text.ss
index cb69d1f7..5d841678 100644
--- a/collects/framework/text.ss
+++ b/collects/framework/text.ss
@@ -166,8 +166,8 @@
 	     (invalidate-rectangles (append old-rectangles
 					    range-rectangles))))]
 	[ranges null]
-	[pen (make-object pen% "BLACK" 0 'stipple)]
-	[brush (make-object brush% "black" 'stipple)])
+	[pen (make-object pen% "BLACK" 0 'solid)]
+	[brush (make-object brush% "black" 'solid)])
       (public
 	;; the bitmap is used in b/w and the color is used in color.
 	[highlight-range
@@ -200,7 +200,6 @@
 				      (unbox b4)))])
 		(let* ([old-pen (send dc get-pen)]
 		       [old-brush (send dc get-brush)]
-		       [old-logical-function (send dc get-logical-function)]
 		       [b/w-bitmap (rectangle-b/w-bitmap rectangle)]
 		       [color (let* ([rc (rectangle-color rectangle)]
 				     [tmpc (make-object color% 0 0 0)])
@@ -225,17 +224,11 @@
 		  (let/ec k
 		    (cond
 		      [(and before color)
-		       (send pen set-style 'solid)
-		       (send brush set-style 'solid)
 		       (send pen set-colour color)
-		       (send brush set-colour color)
-		       (send dc set-logical-function 'copy)]
+		       (send brush set-colour color)]
 		      [(and (not before) (not color) b/w-bitmap)
 		       (send pen set-stipple b/w-bitmap)
-		       (send pen set-style 'stipple)
-		       (send brush set-stipple b/w-bitmap)
-		       (send brush set-style 'stipple)
-		       (send dc set-logical-function 'and)]
+		       (send brush set-stipple b/w-bitmap)]
 		      [else (k (void))])
 		    (send dc set-pen pen)
 		    (send dc set-brush brush)
@@ -244,7 +237,6 @@
 			  (+ top dy)
 			  width
 			  height)
-		    (send dc set-logical-function old-logical-function)
 		    (send dc set-pen old-pen)
 		    (send dc set-brush old-brush)))))
 	    range-rectangles))])
diff --git a/collects/tests/framework/README b/collects/tests/framework/README
index 24562233..98485822 100644
--- a/collects/tests/framework/README
+++ b/collects/tests/framework/README
@@ -42,7 +42,8 @@ tests.
 
   - frames: |# frame.ss #|
   - canvases: |# canvas.ss #|
-  - edits: |# edit.ss #|
+  - texts: |# text.ss #|
+  - pasteboards: |# text.ss #|
 
 - basic connections between classes
 
diff --git a/collects/tests/framework/canvas.ss b/collects/tests/framework/canvas.ss
index 7456ee06..8e6fcf2e 100644
--- a/collects/tests/framework/canvas.ss
+++ b/collects/tests/framework/canvas.ss
@@ -2,9 +2,17 @@
   (test
    name
    (lambda (x) #t)
-   `(let ([f (make-object frame:basic%)]
-	  [c (make-object ,class f)])
-      (send f show #t))))
+   (lambda ()
+     (send-sexp-to-mred
+      `(let* ([f (make-object frame:basic% "test canvas" #f 300 300)]
+	      [c (make-object ,class (send f get-area-container))])
+	 (send c set-editor (make-object text:basic%))
+	 (send f show #t)))
+      (wait-for-frame "test canvas")
+      (send-sexp-to-mred
+       `(send (get-top-level-focus-window) show #f)))))
 
-(test-creation 'canvas:wide-snip-mixin-creation '(canvas:wide-snip-mixin editor-canvas%))
-(test-creation 'canvas:wide-snip%-creation 'canvas:wide-snip%)
+(test-creation '(canvas:wide-snip-mixin editor-canvas%)
+	       'canvas:wide-snip-mixin-creation)
+(test-creation 'canvas:wide-snip%
+	       'canvas:wide-snip%-creation)