diff --git a/collects/tests/mred/draw.ss b/collects/tests/mred/draw.ss
index 79bc2169..c6362ad2 100644
--- a/collects/tests/mred/draw.ss
+++ b/collects/tests/mred/draw.ss
@@ -53,9 +53,8 @@
        [hp2 hp]
        [hp3 (make-object horizontal-pane% vp)]
        [bb (make-object bitmap% (sys-path "bb.gif") 'gif)]
-       [return (let ([bm (make-object bitmap% (sys-path "return.xbm") 'xbm)]
-		     [dc (make-object bitmap-dc%)])
-		 (send dc set-bitmap bm)
+       [return (let* ([bm (make-object bitmap% (sys-path "return.xbm") 'xbm)]
+		      [dc (make-object bitmap-dc% bm)])
 		 (send dc draw-line 0 3 20 3)
 		 (send dc set-bitmap #f)
 		 bm)]
@@ -310,51 +309,52 @@
 				  (send dc set-brush b))))
 
 			    (when last?
-			      ; Splines
-			      (define op (send dc get-pen))
-			      (define (draw-ess dx dy)
-				(send dc draw-spline 
-				      (+ dx 200) (+ dy 10)
-				      (+ dx 218) (+ dy 12)
-				      (+ dx 220) (+ dy 20))
-				(send dc draw-spline 
-				      (+ dx 220) (+ dy 20)
-				      (+ dx 222) (+ dy 28)
-				      (+ dx 240) (+ dy 30)))
-			      (send dc set-pen pen0s)
-			      (draw-ess 0 0)
-			      (send dc set-pen (make-object pen% "RED" 0 'solid))
-			      (draw-ess -2 2)
-
-			      ; Brush patterns:
-			      (let ([pat-list (list 'bdiagonal-hatch
-						    'crossdiag-hatch
-						    'fdiagonal-hatch
-						    'cross-hatch
-						    'horizontal-hatch
-						    'vertical-hatch)]
-				    [b (make-object brush% "BLACK" 'solid)]
-				    [ob (send dc get-brush)]
-				    [obg (send dc get-background)]
-				    [blue (make-object color% "BLUE")])
-				(let loop ([x 245][y 10][l pat-list])
-				  (unless (null? l)
-				    (send b set-color "BLACK")
-				    (send b set-style (car l))
-				    (send dc set-brush b)
-				    (send dc draw-rectangle x y 20 20)
-				    (send dc set-brush ob)
-				    (send b set-color "GREEN")
-				    (send dc set-brush b)
-				    (send dc draw-rectangle (+ x 25) y 20 20)
-				    (send dc set-background blue)
-				    (send dc draw-rectangle (+ x 50) y 20 20)
-				    (send dc set-background obg)
-				    (send dc set-brush ob)
-				    (loop x (+ y 25) (cdr l)))))
-
-			      (send dc set-pen op)
+			      (let ([op (send dc get-pen)])
 
+				; Splines
+				(define (draw-ess dx dy)
+				  (send dc draw-spline 
+					(+ dx 200) (+ dy 10)
+					(+ dx 218) (+ dy 12)
+					(+ dx 220) (+ dy 20))
+				  (send dc draw-spline 
+					(+ dx 220) (+ dy 20)
+					(+ dx 222) (+ dy 28)
+					(+ dx 240) (+ dy 30)))
+				(send dc set-pen pen0s)
+				(draw-ess 0 0)
+				(send dc set-pen (make-object pen% "RED" 0 'solid))
+				(draw-ess -2 2)
+			      
+				; Brush patterns:
+				(let ([pat-list (list 'bdiagonal-hatch
+						      'crossdiag-hatch
+						      'fdiagonal-hatch
+						      'cross-hatch
+						      'horizontal-hatch
+						      'vertical-hatch)]
+				      [b (make-object brush% "BLACK" 'solid)]
+				      [ob (send dc get-brush)]
+				      [obg (send dc get-background)]
+				      [blue (make-object color% "BLUE")])
+				  (let loop ([x 245][y 10][l pat-list])
+				    (unless (null? l)
+				      (send b set-color "BLACK")
+				      (send b set-style (car l))
+				      (send dc set-brush b)
+				      (send dc draw-rectangle x y 20 20)
+				      (send dc set-brush ob)
+				      (send b set-color "GREEN")
+				      (send dc set-brush b)
+				      (send dc draw-rectangle (+ x 25) y 20 20)
+				      (send dc set-background blue)
+				      (send dc draw-rectangle (+ x 50) y 20 20)
+				      (send dc set-background obg)
+				      (send dc set-brush ob)
+				      (loop x (+ y 25) (cdr l)))))
+				
+				(send dc set-pen op))
+				
 			      ; B&W 8x8 stipple:
 			      (unless no-bitmaps?
 				(let ([bml (get-b&w-light-stipple)]
@@ -400,6 +400,7 @@
 					(loop (cdr fam) (cdr stl) (cdr wgt) (cdr sze) x (+ y h))))))
 				(send dc set-pen save-pen)))
 
+			    ; Bitmap copying:
 			    (when (and (not no-bitmaps?) last?)
 			      (let ([x 5] [y 165])
 				(send dc draw-bitmap (get-icon) x y 'xor)
@@ -418,11 +419,14 @@
 						       mode color)
 						 (set! x (+ x w 10))))
 					     (printf "bad bitmap~n")))])
+				  ;; BB icon
 				  (do-one bb 'solid black)
 				  (let ([start x])
+				    ;; First three return icons:
 				    (do-one return 'solid black)
 				    (do-one return 'solid red)
 				    (do-one return 'opaque red)
+				    ;; Next three, on a bluew background
 				    (let ([end x]
 					  [b (send dc get-brush)])
 				      (send dc set-brush (make-object brush% "BLUE" 'solid))
@@ -434,11 +438,27 @@
 				      (do-one return 'solid red)
 				      (do-one return 'opaque red)
 				      (set! y (- y 18))))
+				  ;; Another BB icon, make sure color has no effect
 				  (do-one bb 'solid red)
+				  ;; Another return, blacnk on red
 				  (let ([bg (send dc get-background)])
 				    (send dc set-background (send the-color-database find-color "BLACK"))
 				    (do-one return 'opaque red)
 				    (send dc set-background bg))
+				  ;; Return by drawing into color, copying color to monochrome, then
+				  ;;  monochrome back oonto canvas:
+				  (let* ([w (send return get-width)]
+					 [h (send return get-height)]
+					 [color (make-object bitmap% w h)]
+					 [mono (make-object bitmap% w h #t)]
+					 [cdc (make-object bitmap-dc% color)]
+					 [mdc (make-object bitmap-dc% mono)])
+				    (send cdc clear)
+				    (send cdc draw-bitmap return 0 0)
+				    (send mdc clear)
+				    (send mdc draw-bitmap color 0 0)
+				    (send dc draw-bitmap mono
+					  (- x w 10) (+ y 18)))
 				  (send dc set-pen pens))))
 
 			    (when (and (not no-stipples?) last?)
diff --git a/collects/tests/mred/frame-steps.txt b/collects/tests/mred/frame-steps.txt
index 106ecb94..50e3d11a 100644
--- a/collects/tests/mred/frame-steps.txt
+++ b/collects/tests/mred/frame-steps.txt
@@ -8,12 +8,12 @@ names; they're essentially the same set of tests, but for different
 sets of controls. There are just too many kinds of controls to fit in
 one frame.
 
-Note that the clock in the upper right of the "Test Selector" frame
-should increment every second.
+The clock in the upper right of the "Test Selector" frame should
+increment every second.
 
-The field of buttons at the bottom of the Selector frame open little
-frames for testing individual control types in detail. Those frames
-come with their own instructions.
+The buttons at the bottom of the Selector frame open little frames for
+testing individual control types in detail. Those frames come with
+their own instructions.
 
 Make XXX Frame
 --------------
@@ -55,13 +55,18 @@ Medium Frame should contain:
  Text (a media-text)
    initial & starting
 
-
 The names on labels must match the above exactly (except that <>
 indicates an image). Watch out for letters that are dropped or
 &s that are dropped.
 
 Make sure all the controls with moving parts work.
 
+Tabbing and arrow keys should work correctly. The canvas in the bottom
+middle area does not receive the focus via tabs in Big Frame, but it
+does in Medium Frame. When it receives the focus via a tab, "Tab in"
+is drawn inthe canvas; when the focus leaves the canvas for any reason
+(tab out, mouse click somewhere else, etc.), "Tab in" is erased.
+
 Window Resizing
 ---------------
 
@@ -197,6 +202,10 @@ Combinations to try:
    * Busy + Bull + Cross - everywhere changed
        - Uncheck Busy and verify Bull + Cross
        (that's enough)
+
+Also, while the busy cursor is on, try creating a new Big/Medium Frame
+and make sure that the busy cursor is active in the new frame and over
+all controls in the new frame.
       
 Popup Menus (Big Frame)
 -----------
diff --git a/collects/tests/mred/item.ss b/collects/tests/mred/item.ss
index 14e2bae9..5adc3251 100644
--- a/collects/tests/mred/item.ss
+++ b/collects/tests/mred/item.ss
@@ -130,8 +130,9 @@
 
 (define popup-test-canvas%
   (class canvas% (objects names . args)
-    (inherit popup-menu get-dc)
+    (inherit popup-menu get-dc refresh)
     (public
+      [tab-in? #f]
       [last-m null]
       [last-choice #f])
     (override
@@ -141,7 +142,9 @@
 	   (send dc clear)
 	   (send dc draw-text "Left: popup hide state" 0 0)
 	   (send dc draw-text "Right: popup previous" 0 20)
-	   (send dc draw-text (format "Last pick: ~s" last-choice) 0 40)))]
+	   (send dc draw-text (format "Last pick: ~s" last-choice) 0 40)
+	   (when tab-in?
+	     (send dc draw-text "Tab in" 0 60))))]
       [on-event
        (lambda (e)
 	 (if (send e button-down?)
@@ -172,7 +175,12 @@
 			    m)
 			  last-m)])
 	       (set! last-m m)
-	       (popup-menu m (inexact->exact x) (inexact->exact y)))))])
+	       (popup-menu m (inexact->exact x) (inexact->exact y)))))]
+      [on-tab-in (lambda () (set! tab-in? #t) (refresh))]
+      [on-focus (lambda (on?)
+		  (when (and tab-in? (not on?))
+		    (set! tab-in? #f)
+		    (refresh)))])
     (sequence
       (apply super-init args))))
 
@@ -489,7 +497,7 @@
 				       ; "text msg" "image msg"
 				       "text")
 				 cp2)])
-      
+      (send canvas accept-tab-focus #t)
       (add-focus-note f2 ep2)
       (send f2 set-info ep2)
       
diff --git a/src/mred/wrap/mred.ss b/src/mred/wrap/mred.ss
index e6b76b55..4a4d1386 100644
--- a/src/mred/wrap/mred.ss
+++ b/src/mred/wrap/mred.ss
@@ -746,7 +746,12 @@
 					     (when (and (is-a? o wx-text-editor-canvas%)
 							(send o is-single-line?))
 					       (let ([e (send o get-editor)])
-						 (send e set-position 0 (send e last-position) #f #t 'local))))))))])
+						 (as-exit
+						  (lambda ()
+						    (send e set-position 0 (send e last-position) #f #t 'local)))))
+					     (when (or (is-a? o wx-canvas%)
+						       (is-a? o wx-editor-canvas%))
+					       (as-exit (lambda () (send o on-tab-in)))))))))])
 			   (if (is-a? o wx:radio-box%)
 			       (let ([n (send o number)]
 				     [s (send o button-focus -1)]
@@ -1409,6 +1414,7 @@
 		      (private
 			[tabable? #f])
 		      (public
+			[on-tab-in (lambda () (send (wx->mred this) on-tab-in))]
 			[get-tab-focus (lambda () tabable?)]
 			[set-tab-focus (lambda (v) (set! tabable? v))])
 		      (override
@@ -1474,6 +1480,7 @@
 	   [(#\tab #\return escape) (not single-line-canvas?)]
 	   [else (not meta?)]))])
     (public
+      [on-tab-in (lambda () (send (wx->mred this) on-tab-in))]
       [set-single-line (lambda () (set! single-line-canvas? #t))]
       [is-single-line? (lambda () single-line-canvas?)]
       [set-line-count (lambda (n)
@@ -3247,6 +3254,7 @@
       [on-event (lambda (e) (send wx do-on-event e))]
       [on-paint (lambda () (when wx (send wx do-on-paint)))]
       [on-scroll (lambda (e) (send wx do-on-scroll e))]
+      [on-tab-in (lambda () (void))]
       
       [min-client-width (param (lambda () wx) 'min-client-width)]
       [min-client-height (param (lambda () wx) 'min-client-height)]
@@ -4585,6 +4593,14 @@
     (check-instance 'unregister-collecting-blit canvas% 'canvas% #f canvas)
     (wx:unregister-collecting-blit (mred->wx canvas))))
 
+(define bitmap-dc%
+  (class wx:bitmap-dc% ([bm #f])
+    (inherit set-bitmap)
+    (sequence
+      (super-init)
+      (when bm
+	(set-bitmap bm)))))
+
 (define (find-item-frame item)
   (let loop ([i item])
     (let ([p (send i get-parent)])