diff --git a/collects/mred/private/gdi.rkt b/collects/mred/private/gdi.rkt
index 15b66935..659e38ef 100644
--- a/collects/mred/private/gdi.rkt
+++ b/collects/mred/private/gdi.rkt
@@ -32,6 +32,16 @@
      [(canvas x y w h on off on-x on-y off-x) (register-collecting-blit canvas x y w h on off on-x on-y off-x 0)]
      [(canvas x y w h on off on-x on-y off-x off-y)
       (check-instance 'register-collecting-blit canvas% 'canvas% #f canvas)
+      ((check-bounded-integer -10000 10000 #f) 'register-collecting-blit x)
+      ((check-bounded-integer -10000 10000 #f) 'register-collecting-blit y)
+      ((check-bounded-integer 0 10000 #f) 'register-collecting-blit w)
+      ((check-bounded-integer 0 10000 #f) 'register-collecting-blit h)
+      (check-instance 'register-collecting-blit wx:bitmap% 'bitmap% #f on)
+      (check-instance 'register-collecting-blit wx:bitmap% 'bitmap% #f off)
+      ((check-bounded-integer -10000 10000 #f) 'register-collecting-blit on-x)
+      ((check-bounded-integer -10000 10000 #f) 'register-collecting-blit on-y)
+      ((check-bounded-integer -10000 10000 #f) 'register-collecting-blit off-x)
+      ((check-bounded-integer -10000 10000 #f) 'register-collecting-blit off-y)
       (wx:register-collecting-blit (mred->wx canvas) x y w h on off on-x on-y off-x off-y)]))
 
   (define unregister-collecting-blit
diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt
index 432d8847..3be04ed7 100644
--- a/collects/mred/private/wx/cocoa/canvas.rkt
+++ b/collects/mred/private/wx/cocoa/canvas.rkt
@@ -13,6 +13,8 @@
          "cg.rkt"
          "queue.rkt"
          "item.rkt"
+         "gc.rkt"
+         "image.rkt"
          "../common/backing-dc.rkt"
          "../common/event.rkt"
          "../common/queue.rkt"
@@ -24,10 +26,14 @@
 
 ;; ----------------------------------------
 
-(import-class NSView NSGraphicsContext NSScroller NSComboBox)
+(import-class NSView NSGraphicsContext NSScroller NSComboBox NSWindow NSImageView)
 
 (import-protocol NSComboBoxDelegate)
 
+(define NSWindowAbove 1)
+
+(define o (current-error-port))
+
 ;; Called when a canvas has no backing store ready
 (define (clear-background wxb)
   (let ([wx (->wx wxb)])
@@ -174,7 +180,8 @@
              on-size
              register-as-child
              get-size get-position
-             set-focus)
+             set-focus
+             client-to-screen)
 
     (define vscroll-ok? (and (memq 'vscroll style) #t))
     (define vscroll? vscroll-ok?)
@@ -336,7 +343,17 @@
       (super show on?)
       (fix-dc))
 
+    (define/override (hide-children)
+      (super hide-children)
+      (suspend-all-reg-blits))
+
+    (define/override (show-children)
+      (super show-children)
+      (resume-all-reg-blits))
+
     (define/private (do-set-size x y w h)
+      (when (pair? blits)
+        (atomically (suspend-all-reg-blits)))
       (super set-size x y w h)
       (when tr
         (tellv content-cocoa removeTrackingRect: #:type _NSInteger tr)
@@ -369,6 +386,9 @@
                 (make-NSSize (max 0 (- w (if vscroll? scroll-width 0)
                                        x-sb-margin x-sb-margin))
                              scroll-width))))
+      (when (and (pair? blits)
+                 (is-shown-to-root?))
+        (atomically (resume-all-reg-blits)))
       (fix-dc)
       (when auto-scroll?
         (reset-auto-scroll 0 0))
@@ -708,4 +728,73 @@
     (define/public (get-virtual-size xb yb)
       (get-client-size xb yb)
       (when virtual-width (set-box! xb virtual-width))
-      (when virtual-height (set-box! yb virtual-height)))))
+      (when virtual-height (set-box! yb virtual-height)))
+
+    (define blits null)
+    (define reg-blits null)
+
+    (define/private (suspend-all-reg-blits)
+      (let ([cocoa-win (get-cocoa-window)])
+        (for ([r (in-list reg-blits)])
+          (tellv cocoa-win removeChildWindow: (car r))
+          (release (car r))
+          (scheme_remove_gc_callback (cdr r))))
+      (set! reg-blits null))
+
+    (define/public (resume-all-reg-blits)
+      (unless (pair? reg-blits)
+        (when (pair? blits)
+          (set! reg-blits
+                (for/list ([b (in-list blits)])
+                  (let-values ([(x y w h img) (apply values b)])
+                    (register-one-blit x y w h img)))))))
+
+    (define/private (register-one-blit x y w h img)
+      (let ([xb (box x)]
+            [yb (box y)])
+        (client-to-screen xb yb #f)
+        (let* ([cocoa-win (get-cocoa-window)])
+          (atomically
+           (let ([win (as-objc-allocation
+                       (tell (tell NSWindow alloc)
+                             initWithContentRect: #:type _NSRect (make-NSRect (make-NSPoint (unbox xb)
+                                                                                            (- (unbox yb)
+                                                                                               h))
+                                                                              (make-NSSize w h))
+                             styleMask: #:type _int NSBorderlessWindowMask
+                             backing: #:type _int NSBackingStoreBuffered
+                             defer: #:type _BOOL NO))]
+                 [iv (tell (tell NSImageView alloc) init)])
+             (tellv iv setImage: img)
+             (tellv iv setFrame: #:type _NSRect  (make-NSRect (make-NSPoint 0 0)
+                                                              (make-NSSize w h)))
+             (tellv (tell win contentView) addSubview: iv)
+             (tellv win setAlphaValue: #:type _CGFloat 0.0)
+             (tellv cocoa-win addChildWindow: win ordered: #:type _int NSWindowAbove)
+             (tellv iv release)
+             (let ([r (scheme_add_gc_callback
+                       (make-gc-action-desc win (selector setAlphaValue:) 1.0)
+                       (make-gc-action-desc win (selector setAlphaValue:) 0.0))])
+               (cons win r)))))))
+    
+    (define/public (register-collecting-blit x y w h on off on-x on-y off-x off-y)
+      (let ([on (if (and (zero? on-x)
+                         (zero? on-y)
+                         (= (send on get-width) w)
+                         (= (send on get-height) h))
+                    on
+                    (let ([bm (make-object bitmap% w h)])
+                      (let ([dc (make-object bitmap-dc% on)])
+                        (send dc draw-bitmap-section on 0 0 on-x on-y w h)
+                        (send dc set-bitmap #f)
+                        bm)))])
+        (let ([img (bitmap->image on)])
+          (atomically
+           (set! blits (cons (list x y w h img) blits))
+           (when (is-shown-to-root?)
+             (set! reg-blits (cons (register-one-blit x y w h img) reg-blits)))))))
+
+    (define/public (unregister-collecting-blits)
+      (atomically
+       (suspend-all-reg-blits)
+       (set! blits null)))))
diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt
index a82b3eef..457035ff 100644
--- a/collects/mred/private/wx/cocoa/frame.rkt
+++ b/collects/mred/private/wx/cocoa/frame.rkt
@@ -204,6 +204,9 @@
                     (eq? front this))
            (set! front #f)
            (send empty-mb install))
+         (if on?
+             (show-children)
+             (hide-children))
          (if on?
              (begin
                (when is-a-dialog?
@@ -281,6 +284,13 @@
       (when child-sheet (send child-sheet destroy))
       (direct-show #f))
 
+    (define/override (hide-children)
+      (when saved-child
+        (send saved-child hide-children)))
+    (define/override (show-children)
+      (when saved-child
+        (send saved-child show-children)))
+
     (define/override (is-shown?)
       (tell #:type _bool cocoa isVisible))
 
diff --git a/collects/mred/private/wx/cocoa/gc.rkt b/collects/mred/private/wx/cocoa/gc.rkt
new file mode 100644
index 00000000..b582a48a
--- /dev/null
+++ b/collects/mred/private/wx/cocoa/gc.rkt
@@ -0,0 +1,26 @@
+#lang racket/base
+(require ffi/unsafe
+         ffi/unsafe/objc
+         "utils.rkt"
+         "types.rkt")
+
+(provide scheme_add_gc_callback
+         scheme_remove_gc_callback
+         make-gc-action-desc)
+
+(define objc-lib (ffi-lib "libobjc"))
+
+(define msg-send-proc (get-ffi-obj 'objc_msgSend objc-lib _fpointer))
+
+(define-mz scheme_add_gc_callback (_fun _racket _racket -> _racket))
+(define-mz scheme_remove_gc_callback (_fun _racket -> _void))
+
+(define (make-gc-action-desc win sel val)
+  (vector
+   (vector (if (= (ctype-sizeof _CGFloat) 4)
+               'ptr_ptr_float->void
+               'ptr_ptr_double->void)
+           msg-send-proc 
+           win
+           sel
+           val)))
diff --git a/collects/mred/private/wx/cocoa/panel.rkt b/collects/mred/private/wx/cocoa/panel.rkt
index 3837042f..67ced261 100644
--- a/collects/mred/private/wx/cocoa/panel.rkt
+++ b/collects/mred/private/wx/cocoa/panel.rkt
@@ -37,6 +37,10 @@
     (define/override (hide-children)
       (for ([child (in-list children)])
         (send child hide-children)))
+
+    (define/override (show-children)
+      (for ([child (in-list children)])
+        (send child show-children)))
     
     (define/override (paint-children)
       (for ([child (in-list children)])
diff --git a/collects/mred/private/wx/cocoa/procs.rkt b/collects/mred/private/wx/cocoa/procs.rkt
index 374a89a7..90e394c7 100644
--- a/collects/mred/private/wx/cocoa/procs.rkt
+++ b/collects/mred/private/wx/cocoa/procs.rkt
@@ -68,8 +68,10 @@
 (define-unimplemented play-sound)
 (define-unimplemented check-for-break)
 (define-unimplemented find-graphical-system-path)
-(define (register-collecting-blit . args) (void))
-(define (unregister-collecting-blit . args) (void))
+(define (register-collecting-blit canvas x y w h on off on-x on-y off-x off-y)
+  (send canvas register-collecting-blit x y w h on off on-x on-y off-x off-y))
+(define (unregister-collecting-blit canvas)
+  (send canvas unregister-collecting-blits))
 (define (shortcut-visible-in-label? [x #f]) #f)
 (define-unimplemented in-atomic-region)
 (define (set-menu-tester proc)
diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt
index dab0c839..9ff5161c 100644
--- a/collects/mred/private/wx/cocoa/window.rkt
+++ b/collects/mred/private/wx/cocoa/window.rkt
@@ -332,6 +332,8 @@
     (define/public (hide-children)
       (is-responder this #f)
       (focus-is-on #f))
+    (define/public (show-children)
+      (void))
     (define/public (fix-dc) 
       (void))
     (define/public (paint-children)
@@ -364,11 +366,13 @@
              (tellv (send parent get-cocoa-content) addSubview: cocoa)
              (with-autorelease
               (tellv cocoa removeFromSuperview)))
-         (set! is-on? (and on? #t))))
-      (maybe-register-as-child parent on?)
-      (unless on?
-        (hide-children)
-        (is-responder this #f)))
+         (set! is-on? (and on? #t))
+         (maybe-register-as-child parent on?)
+         (if on?
+             (show-children)
+             (begin
+               (hide-children)
+               (is-responder this #f))))))
     (define/public (maybe-register-as-child parent on?)
       ;; override this to call register-as-child if the window
       ;; can have the focus or otherwise needs show-state notifications.
@@ -575,14 +579,16 @@
         (set-box! xb (inexact->exact (floor (NSPoint-x p))))
         (set-box! yb (inexact->exact (floor (flip-client (NSPoint-y p)))))))
 
-    (define/public (client-to-screen xb yb)
+    (define/public (client-to-screen xb yb [flip-y? #t])
       (let* ([p (tell #:type _NSPoint (get-cocoa-window)
                       convertBaseToScreen:
                       #:type _NSPoint
                       (tell #:type _NSPoint (get-cocoa-content) 
                             convertPointToBase: #:type _NSPoint
                             (make-NSPoint (unbox xb) (flip-client (unbox yb)))))])
-        (let ([new-y (send (get-wx-window) flip-screen (NSPoint-y p))])
+        (let ([new-y (if flip-y?
+                         (send (get-wx-window) flip-screen (NSPoint-y p))
+                         (NSPoint-y p))])
           (set-box! xb (inexact->exact (floor (NSPoint-x p))))
           (set-box! yb (inexact->exact (floor new-y))))))