diff --git a/pkgs/draw-pkgs/draw-doc/scribblings/draw/guide.scrbl b/pkgs/draw-pkgs/draw-doc/scribblings/draw/guide.scrbl
index 75088f25ac..95b830f477 100644
--- a/pkgs/draw-pkgs/draw-doc/scribblings/draw/guide.scrbl
+++ b/pkgs/draw-pkgs/draw-doc/scribblings/draw/guide.scrbl
@@ -766,6 +766,29 @@ Different kinds of bitmaps can produce different results:
        when consistency with screen drawing is needed for some other
        reason.}
 
+ @item{Drawing to a bitmap produced by @racket[make-screen-bitmap]
+       from @racketmodname[racket/gui/base]
+       uses the same platform-specific drawing operations
+       as drawing into a @racket[canvas%] instance. A bitmap produced
+       by @racket[make-screen-bitmap] is the same as one produced by
+       @racket[make-platform-bitmap] on Windows or Mac OS X, but it
+       may be sensitive to the X11 server on Unix. On Mac OS X, when
+       the main screen is in Retina mode (at the time that the bitmap
+       is created), the bitmap is also internally scaled so that one
+       drawing unit uses two pixels.
+
+       Use @racket[make-screen-bitmap] when drawing to a bitmap as an
+       offscreen buffer before transferring an image to the screen, or
+       when consistency with screen drawing is needed for some other
+       reason.}
+
+ @item{A bitmap produced by @xmethod[canvas% make-bitmap] from
+       @racketmodname[racket/gui/base] is like a bitmap from
+       @racket[make-screen-bitmap], but on Mac OS X, the bitmap is
+       optimized for drawing to the screen (by taking advantage of
+       system APIs that can, in turn, take advantage of graphics
+       hardware).}
+
 ]
 
 
diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap-dc.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap-dc.rkt
index b9395f6e98..7484c58a64 100644
--- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap-dc.rkt
+++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap-dc.rkt
@@ -40,7 +40,7 @@
         (set! c #f))
       (set! bm v)
       (when (and bm (send bm ok?))
-        (set! c (cairo_create (send bm get-cairo-surface)))
+        (set! c (cairo_create (send bm get-cairo-target-surface)))
         (set! b&w? (not (send bm is-color?)))))
 
     (define/public (internal-set-bitmap v [direct? #f])
diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt
index 09067a01bf..dd022c0385 100644
--- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt
+++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt
@@ -283,6 +283,9 @@
     (def/public (get-loaded-mask) loaded-mask)
     (def/public (set-loaded-mask [(make-or-false bitmap%) m]) (set! loaded-mask m))
 
+    (define/public (draw-bitmap-to cr sx sy dx dy w h alpha clipping)
+      #f)
+
     (define/public (release-bitmap-storage)
       (drop-alpha-s)
       (when s
@@ -632,6 +635,7 @@
     (def/public (ok?) (and s #t))
 
     (define/public (get-cairo-surface) (or s (get-empty-surface)))
+    (define/public (get-cairo-target-surface) (get-cairo-surface))
     (define/public (get-cairo-alpha-surface)
       (or (if (or b&w? alpha-channel?)
               s
@@ -923,7 +927,7 @@
 
 (define quartz-bitmap%
   (class bitmap%
-    (init w h [with-alpha? #t] [resolution 1.0])
+    (init w h [with-alpha? #t] [resolution 1.0] [dest-cg #f])
     (super-make-object (make-alternate-bitmap-kind w h))
     
     (define cocoa-resolution resolution)
@@ -932,15 +936,19 @@
       cocoa-resolution)
     
     (define s
-      (let ([s (cairo_quartz_surface_create (if with-alpha?
-                                                CAIRO_FORMAT_ARGB32
-                                                CAIRO_FORMAT_RGB24)
-                                            (inexact->exact
-                                             (ceiling
-                                              (* cocoa-resolution w)))
-                                            (inexact->exact
-                                             (ceiling
-                                              (* cocoa-resolution h))))])
+      (let* ([sw (inexact->exact
+                  (ceiling
+                   (* cocoa-resolution w)))]
+             [sh (inexact->exact
+                  (ceiling
+                   (* cocoa-resolution h)))]
+             [s (if dest-cg
+                    (cairo_quartz_surface_create_for_cg_context dest-cg sw sh)
+                    (cairo_quartz_surface_create (if with-alpha?
+                                                     CAIRO_FORMAT_ARGB32
+                                                     CAIRO_FORMAT_RGB24)
+                                                 sw
+                                                 sh))])
         ;; initialize bitmap to empty - needed?
         (let ([cr (cairo_create s)])
           (cairo_set_operator cr (if with-alpha?
diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt
index b5314e2cc4..e1d3477751 100644
--- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt
+++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt
@@ -1763,6 +1763,13 @@
                    (cairo_restore cr)
                    (cairo_pattern_destroy p)))])
          (cond
+          [(send src draw-bitmap-to cr
+                 a-src-x a-src-y
+                 a-dest-x a-dest-y
+                 a-dest-w a-dest-h
+                 alpha
+                 clipping-region)
+           (void)]
           [(or (send src is-color?)
                (and (not (eq? style 'opaque))
                     (= alpha 1.0)
diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/local.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/local.rkt
index ab567c965d..99146cfa8a 100644
--- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/local.rkt
+++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/local.rkt
@@ -9,11 +9,13 @@
 
   ;; bitmap%
   get-cairo-surface
+  get-cairo-target-surface
   get-cairo-alpha-surface
   get-cairo-device-scale
   release-bitmap-storage
   get-bitmap-gl-context
   drop-alpha-s
+  draw-bitmap-to
 
   ;; bitmap-dc%
   internal-get-bitmap
diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt
index c60c990360..3a89c2d08f 100644
--- a/pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt
+++ b/pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt
@@ -96,6 +96,8 @@
 
 (define-cairo cairo_get_target (_cfun _cairo_t -> _cairo_surface_t)) ;; not an allocator
 
+(define-cairo cairo_surface_get_type (_cfun _cairo_surface_t -> _int))
+
 ;; Context
 (define-cairo cairo_paint (_cfun _cairo_t -> _void))
 (define-cairo cairo_paint_with_alpha (_cfun _cairo_t _double* -> _void))
@@ -126,6 +128,20 @@
                  (set! warned? #t))
                (values 0 0 0 0)))))
 
+(define-cstruct _cairo_rectangle_t ([x _double]
+                                    [y _double]
+                                    [width _double]
+                                    [height _double]))
+(define-cstruct _cairo_rectangle_list_t ([status _int]
+                                         [rectangles _cairo_rectangle_t-pointer]
+                                         [num_rectangles _int]))
+(provide (struct-out cairo_rectangle_t) _cairo_rectangle_t
+         (struct-out cairo_rectangle_list_t))
+(define-cairo cairo_rectangle_list_destroy (_cfun _cairo_rectangle_list_t-pointer -> _void)
+  #:wrap (deallocator))
+(define-cairo cairo_copy_clip_rectangle_list (_cfun _cairo_t -> _cairo_rectangle_list_t-pointer)
+  #:wrap (allocator cairo_rectangle_list_destroy))
+
 (define-cairo cairo_fill_extents (_cfun _cairo_t 
                                         (x1 : (_ptr o _double)) 
                                         (y1 : (_ptr o _double)) 
@@ -440,6 +456,10 @@
 
 (define/provide CAIRO_CONTENT_COLOR_ALPHA #x3000)
 
+(define-enum 
+  6
+  CAIRO_SURFACE_TYPE_QUARTZ)
+
 ;; ----------------------------------------
 
 (define-cstruct _cairo_path_data_t_header ([type _int]
diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/canvas.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/canvas.rkt
index 9d4d845e23..202ccdf6e7 100644
--- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/canvas.rkt
+++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/canvas.rkt
@@ -432,7 +432,7 @@
      (define/public (get-dc) dc)
 
      (define/public (make-compatible-bitmap w h)
-       (make-screen-bitmap w h))
+       (make-window-bitmap w h (get-cocoa-window)))
 
      (define/override (fix-dc [refresh? #t])
        (when (dc . is-a? . dc%)
diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/cg.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/cg.rkt
index b158602aa3..48d148a39b 100644
--- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/cg.rkt
+++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/cg.rkt
@@ -1,11 +1,19 @@
 #lang racket/base
 (require ffi/unsafe
          ffi/unsafe/objc
+         ffi/unsafe/alloc
          "types.rkt"
          "utils.rkt")
 
 (provide (protect-out (all-defined-out)))
 
+(define-cstruct _CGAffineTransform ([a _CGFloat]
+                                    [b _CGFloat]
+                                    [c _CGFloat]
+                                    [d _CGFloat]
+                                    [e _CGFloat]
+                                    [f _CGFloat]))
+
 (define _CGContextRef (_cpointer 'CGContextRef))
 (define-appserv CGContextSynchronize (_fun _CGContextRef -> _void))
 (define-appserv CGContextFlush (_fun _CGContextRef -> _void))
@@ -14,8 +22,22 @@
 (define-appserv CGContextRotateCTM (_fun _CGContextRef _CGFloat -> _void))
 (define-appserv CGContextSaveGState (_fun _CGContextRef -> _void))
 (define-appserv CGContextRestoreGState (_fun _CGContextRef -> _void))
+(define-appserv CGContextConcatCTM (_fun _CGContextRef _CGAffineTransform -> _void))
 (define-appserv CGContextSetRGBFillColor (_fun _CGContextRef _CGFloat _CGFloat _CGFloat _CGFloat -> _void))
 (define-appserv CGContextFillRect (_fun _CGContextRef _NSRect -> _void))
+(define-appserv CGContextClearRect (_fun _CGContextRef _NSRect -> _void))
 (define-appserv CGContextAddRect (_fun _CGContextRef _NSRect -> _void))
 (define-appserv CGContextAddLines (_fun _CGContextRef (v : (_vector i _NSPoint)) (_long = (vector-length v)) -> _void))
 (define-appserv CGContextStrokePath (_fun _CGContextRef -> _void))
+(define-appserv CGContextClipToRects (_fun _CGContextRef (_vector i _NSRect) _size -> _void))
+(define-appserv CGContextSetAlpha (_fun _CGContextRef _CGFloat -> _void))
+
+(define _CGLayerRef (_cpointer 'CGLayerRef))
+(define-appserv CGLayerRelease (_fun _CGLayerRef ->  _void)
+  #:wrap (deallocator))
+(define-appserv CGLayerCreateWithContext (_fun _CGContextRef _NSSize _pointer -> _CGLayerRef)
+  #:wrap (allocator CGLayerRelease))
+(define-appserv CGLayerGetContext (_fun _CGLayerRef -> _CGContextRef))
+(define-appserv CGLayerGetSize (_fun _CGLayerRef ->  _NSSize))
+(define-appserv CGContextDrawLayerAtPoint (_fun _CGContextRef _NSPoint _CGLayerRef -> _void))
+(define-appserv CGContextDrawLayerInRect (_fun _CGContextRef _NSRect _CGLayerRef -> _void))
diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/dc.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/dc.rkt
index fd8e2eb0da..4a003fcc0a 100644
--- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/dc.rkt
+++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/dc.rkt
@@ -19,9 +19,11 @@
  (protect-out dc%
               do-backing-flush)
  display-bitmap-resolution
- make-screen-bitmap)
+ make-screen-bitmap
+ make-window-bitmap)
+
+(import-class NSOpenGLContext NSScreen NSGraphicsContext)
 
-(import-class NSOpenGLContext NSScreen)
 (define NSOpenGLCPSwapInterval 222)
 
 (define dc%
@@ -62,8 +64,8 @@
     ;; Use a quartz bitmap so that text looks good:
     (define trans? transparent?)
     (define/override (make-backing-bitmap w h) 
-      (make-object quartz-bitmap% w h trans? 
-                   (display-bitmap-resolution 0 void)))
+      (make-window-bitmap w h (send canvas get-cocoa-window) trans?))
+                   
     (define/override (can-combine-text? sz) #t)
 
     (define/override (get-backing-size xb yb)
@@ -89,6 +91,8 @@
     (define/override (cancel-delay req)
       (send canvas cancel-canvas-flush-delay req))))
 
+(define-local-member-name get-layer)
+
 (define (do-backing-flush canvas dc ctx dx dy)
   (tellv ctx saveGraphicsState)
   (begin0
@@ -98,15 +102,20 @@
                  [h (box 0)])
              (send canvas get-client-size w h)
              (let ([cg (tell #:type _CGContextRef ctx graphicsPort)])
-               (unless (send canvas is-flipped?)
-                 (CGContextTranslateCTM cg 0 (unbox h))
-                 (CGContextScaleCTM cg 1 -1))
-               (CGContextTranslateCTM cg dx dy)
-               (let* ([surface (cairo_quartz_surface_create_for_cg_context cg (unbox w) (unbox h))]
-                      [cr (cairo_create surface)])
-                 (cairo_surface_destroy surface)
-                 (backing-draw-bm bm cr (unbox w) (unbox h))
-                 (cairo_destroy cr))))))
+               (cond
+                [(bm . is-a? . layer-bitmap%)
+                 (define layer (send bm get-layer))
+                 (CGContextDrawLayerAtPoint cg (make-NSPoint 0 0) layer)]
+                [else
+                 (unless (send canvas is-flipped?)
+                   (CGContextTranslateCTM cg 0 (unbox h))
+                   (CGContextScaleCTM cg 1 -1))
+                 (CGContextTranslateCTM cg dx dy)
+                 (let* ([surface (cairo_quartz_surface_create_for_cg_context cg (unbox w) (unbox h))]
+                        [cr (cairo_create surface)])
+                   (cairo_surface_destroy surface)
+                   (backing-draw-bm bm cr (unbox w) (unbox h))
+                   (cairo_destroy cr))])))))
    (tellv ctx restoreGraphicsState)))
 
 (define (display-bitmap-resolution num fail)
@@ -129,4 +138,132 @@
 
 (define/top (make-screen-bitmap [exact-positive-integer? w]
                                 [exact-positive-integer? h])
-  (make-object quartz-bitmap% w h #t (display-bitmap-resolution 0 void)))
+  (make-object quartz-bitmap% w h #t
+               (display-bitmap-resolution 0 void)))
+
+(define (make-window-bitmap w h win [trans? #t])
+  (if win
+      (make-object layer-bitmap% w h win
+                   ;; Force to non-transparent, because trying to
+                   ;; draw a layer into a transparent context
+                   ;; (when conversion to a bitmap is needed)
+                   ;; doesn't seem to work.
+                   trans?)
+      (make-screen-bitmap w h)))
+
+(define layer-bitmap%
+  (class quartz-bitmap%
+    (init w h win trans?)
+
+    (define layer (make-layer win w h))
+    (define layer-w w)
+    (define layer-h h)
+    (define/public (get-layer) layer)
+
+    (define is-trans? trans?)
+
+    (super-make-object w h trans? 1
+                       (let ([cg (CGLayerGetContext layer)])
+                         (CGContextTranslateCTM cg 0 h)
+                         (CGContextScaleCTM cg 1 -1)
+                         cg))
+
+    (define/override (draw-bitmap-to cr sx sy dx dy w h alpha clipping-region)
+      ;; Called when the destination rectangle is inside the clipping region
+      (define s (cairo_get_target cr))
+      (cond
+       [(and (= (cairo_surface_get_type s) CAIRO_SURFACE_TYPE_QUARTZ)
+             (= sx 0)
+             (= sy 0)
+             (let ([rs (cairo_copy_clip_rectangle_list cr)])
+               (cond
+                [(and (= CAIRO_STATUS_SUCCESS (cairo_rectangle_list_t-status rs))
+                      (< (cairo_rectangle_list_t-num_rectangles rs) 64))
+                 rs]
+                [else
+                 (cairo_rectangle_list_destroy rs)
+                 #f])))
+        =>
+        (lambda (rs)
+          ;; Use fast layer drawing:
+          (unless (or (zero? (cairo_rectangle_list_t-num_rectangles rs))
+                      (zero? alpha))
+            (atomically
+             (define m (make-cairo_matrix_t 0 0 0 0 0 0))
+             (cairo_get_matrix cr m)
+             (define trans
+               (make-CGAffineTransform (cairo_matrix_t-xx m)
+                                       (cairo_matrix_t-yx m)
+                                       (cairo_matrix_t-xy m)
+                                       (cairo_matrix_t-yy m)
+                                       (cairo_matrix_t-x0 m)
+                                       (cairo_matrix_t-y0 m)))
+             (cairo_surface_flush s)
+             (define cg (cairo_quartz_surface_get_cg_context s))
+             (CGContextSaveGState cg)
+             (CGContextConcatCTM cg trans)
+             (let ([n (cairo_rectangle_list_t-num_rectangles rs)])
+               (define vec
+                 (for/vector #:length n ([i (in-range n)])
+                   (define r (ptr-add (cairo_rectangle_list_t-rectangles rs) i _cairo_rectangle_t))
+                   (make-NSRect (make-NSPoint (cairo_rectangle_t-x r)
+                                              (cairo_rectangle_t-y r))
+                                (make-NSSize (cairo_rectangle_t-width r)
+                                             (cairo_rectangle_t-height r)))))
+               (CGContextClipToRects cg vec n))
+             ;; Flip target, because drawing to layer was flipped
+             (CGContextTranslateCTM cg 0 (+ dy h))
+             (CGContextScaleCTM cg 1 -1)
+             (CGContextSetAlpha cg alpha)
+             (CGContextDrawLayerInRect cg
+                                       (make-NSRect (make-NSPoint dx 0)
+                                                    (make-NSSize w h))
+                                       layer)
+             
+             (CGContextRestoreGState cg)
+             (cairo_surface_mark_dirty s)))
+          (cairo_rectangle_list_destroy rs)
+          #t)]
+       [else #f]))
+
+    (define s-bm #f)
+    (define/override (get-cairo-surface)
+      ;; Convert to a platform bitmap, which Cairo understands
+      (let ([t-bm (or s-bm
+                      (let ([bm (make-object quartz-bitmap%
+                                             layer-w layer-h 
+                                             is-trans?
+                                             1.0)])
+                        (define dc (send bm make-dc))
+                        ;; For some reason, we must touch the DC
+                        ;; to make transarent work right. It works
+                        ;; to draw beyond the visible region:
+                        (send dc draw-rectangle (+ layer-w 5) (+ layer-h 5) 1 1)
+                        (send dc draw-bitmap this 0 0)
+                        (send dc set-bitmap #f)
+                        (set! s-bm bm)
+                        bm))])
+        (send t-bm get-cairo-surface)))
+
+    (define/override (get-cairo-target-surface)
+      (super get-cairo-surface))
+
+    (define/override (drop-alpha-s)
+      (super drop-alpha-s)
+      (set! s-bm #f))
+
+    (define/override (release-bitmap-storage)
+      (super release-bitmap-storage)
+      (set! s-bm #f)
+      (atomically
+       (when layer
+         (CGLayerRelease layer)
+         (set! layer #f))))))
+
+(define (make-layer win w h)
+  (atomically
+   (with-autorelease
+    (let* ([ctx (tell NSGraphicsContext graphicsContextWithWindow: win)]
+           [tmp-cg (tell #:type _CGContextRef ctx graphicsPort)]
+           [layer (CGLayerCreateWithContext tmp-cg (make-NSSize w h) #f)])
+      layer))))
diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt b/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt
index b4615c96b5..5040e9d480 100644
--- a/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt
+++ b/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt
@@ -205,6 +205,8 @@
        [vp (make-object vertical-panel% f)]
        [hp0 (make-object horizontal-panel% vp)]
        [hp (make-object horizontal-panel% vp)]
+       [hp2.75 (new horizontal-panel% [parent vp]
+                    [stretchable-height #f])]
        [hp3 (make-object horizontal-panel% vp)]
        [hp2 hp]
        [hp2.5 hp0]
@@ -222,6 +224,7 @@
        [do-clock #f]
        [use-bitmap? #f]
        [platform-bitmap? #f]
+       [compat-bitmap? #f]
        [use-record? #f]
        [serialize-record? #f]
        [use-bad? #f]
@@ -253,7 +256,7 @@
 	    (define pixel-copy? #f)
 	    (define kern? #f)
 	    (define clip-pre-scale? #f)
-            (define c-clip? #f)
+            (define c-clip #f)
 	    (define mask-ex-mode 'mred)
 	    (define xscale 1)
 	    (define yscale 1)
@@ -261,18 +264,20 @@
 	    (define c-xscale 1)
 	    (define c-yscale 1)
 	    (define c-offset 0)
+            (define c-gray? #f)
 	    (public*
 	     [set-bitmaps (lambda (on?) (set! no-bitmaps? (not on?)) (refresh))]
 	     [set-stipples (lambda (on?) (set! no-stipples? (not on?)) (refresh))]
 	     [set-pixel-copy (lambda (on?) (set! pixel-copy? on?) (refresh))]
 	     [set-kern (lambda (on?) (set! kern? on?) (refresh))]
 	     [set-clip-pre-scale (lambda (on?) (set! clip-pre-scale? on?) (refresh))]
-	     [set-canvas-clip (lambda (on?) (set! c-clip? on?) (refresh))]
+	     [set-canvas-clip (lambda (mode) (set! c-clip mode) (refresh))]
 	     [set-mask-ex-mode (lambda (mode) (set! mask-ex-mode mode) (refresh))]
 	     [set-canvas-scale (lambda (xs ys) (set! c-xscale xs) (set! c-yscale ys) (refresh))]
 	     [set-scale (lambda (xs ys) (set! xscale xs) (set! yscale ys) (refresh))]
 	     [set-offset (lambda (o) (set! offset o) (refresh))]
-	     [set-canvas-offset (lambda (o) (set! c-offset o) (refresh))])
+	     [set-canvas-offset (lambda (o) (set! c-offset o) (refresh))]
+	     [set-canvas-gray (lambda (g?) (set! c-gray? g?) (refresh))])
 	    (override*
 	     [on-paint
 	      (case-lambda
@@ -299,9 +304,13 @@
 				   (make-object bitmap% "no such file")
                                    (let ([w (ceiling (* xscale DRAW-WIDTH))]
                                          [h (ceiling (* yscale DRAW-HEIGHT))])
-                                     (if platform-bitmap?
-                                         (make-platform-bitmap w h)
-                                         (make-object bitmap% w h depth-one?))))
+                                     (cond
+                                      [platform-bitmap?
+                                       (make-platform-bitmap w h)]
+                                      [compat-bitmap?
+                                       (send this make-bitmap w h)]
+                                      [else
+                                       (make-object bitmap% w h depth-one? c-gray?)])))
 			       #f)]
 		       [draw-series
 			(lambda (dc pens pent penx size x y flevel last?)
@@ -1022,12 +1031,27 @@
                                        (or (and (not (or kind (eq? dc can-dc)))
                                                 (send mem-dc get-bitmap))
                                            use-record?))
+                              (when c-gray?
+                                (let ([b (send can-dc get-brush)]
+                                      [p (send can-dc get-pen)])
+                                  (send can-dc set-brush "gray" 'solid)
+                                  (send can-dc set-pen "black" 1 'transparent)
+                                  (send can-dc draw-rectangle 0 0 1024 1024)
+                                  (send can-dc set-brush b)
+                                  (send can-dc set-pen p)))
                               (send can-dc set-origin c-offset c-offset)
                               (send can-dc set-scale c-xscale c-yscale)
                               (send can-dc set-alpha current-c-alpha)
-                              (when c-clip?
+                              (when c-clip
                                 (define r (new region%))
-                                (send r set-rectangle 0 0 200 200)
+                                (case c-clip
+                                  [(square) (send r set-rectangle 0 0 200 200)]
+                                  [(squares)
+                                   (define r2 (new region%))
+                                   (send r set-rectangle 0 0 200 200)
+                                   (send r2 set-rectangle 210 210 40 40)
+                                   (send r union r2)]
+                                  [(octagon) (send r set-polygon octagon)])
                                 (send can-dc set-clipping-region r))
                               (if use-record?
                                   (if serialize-record?
@@ -1084,7 +1108,7 @@
                       (send dc start-doc "Draw Test")
 		      (send dc start-page)
 
-                      (send dc clear)
+                      (send dc erase)
 
 		      (send dc set-alpha current-alpha)
                       (send dc set-rotation (- current-rotation))
@@ -1107,7 +1131,7 @@
 				(send the-color-database find-color "WHITE")))
 
 		      ;(send dc set-clipping-region #f)
-		      (send dc clear)
+		      (send dc erase)
 
                       (let ([clip-dc dc])
                         (if clock-clip?
@@ -1286,14 +1310,15 @@
 	    (super-new [parent parent][style '(hscroll vscroll)])
 	    (init-auto-scrollbars (* 2 DRAW-WIDTH) (* 2 DRAW-HEIGHT) 0 0))
 	  vp)])
-    (make-object choice% #f '("Canvas" "Pixmap" "Bitmap" "Platform" "Record" "Serialize" "Bad") hp0
+    (make-object choice% #f '("Canvas" "Pixmap" "Bitmap" "Platform" "Compatible" "Record" "Serialize" "Bad") hp0
 		 (lambda (self event)
 		   (set! use-bitmap? (< 0 (send self get-selection)))
-		   (set! depth-one? (< 1 (send self get-selection)))
+		   (set! depth-one? (= 2 (send self get-selection)))
 		   (set! platform-bitmap? (= 3 (send self get-selection)))
-		   (set! use-record? (<= 4 (send self get-selection) 5))
-		   (set! serialize-record? (= 5 (send self get-selection)))
-		   (set! use-bad? (< 5 (send self get-selection)))
+		   (set! compat-bitmap? (= 4 (send self get-selection)))
+		   (set! use-record? (<= 5 (send self get-selection) 6))
+		   (set! serialize-record? (= 6 (send self get-selection)))
+		   (set! use-bad? (< 7 (send self get-selection)))
 		   (send canvas refresh)))
     (make-object button% "PS" hp
 		 (lambda (self event)
@@ -1359,12 +1384,29 @@
     (make-object check-box% "Kern" hp2.5
 		 (lambda (self event)
 		   (send canvas set-kern (send self get-value))))
-    (make-object choice% #f '("1" "*2" "/2" "1,*2" "*2,1") hp3
+    (make-object choice% "Clip" 
+		 '("None" "Rectangle" "Rectangle2" "Octagon" 
+		   "Circle" "Wedge" "Round Rectangle" "Lambda" "A"
+		   "Rectangle + Octagon" "Rectangle + Circle" 
+		   "Octagon - Rectangle" "Rectangle & Octagon" "Rectangle ^ Octagon" "Polka"
+		   "Empty")
+		 hp2.75
+		 (lambda (self event)
+		   (set! clip (list-ref
+		               '(none rect rect2 poly circle wedge roundrect lam A 
+				      rect+poly rect+circle poly-rect poly&rect poly^rect 
+				      polka empty)
+		               (send self get-selection)))
+		   (send canvas refresh)))
+    (make-object check-box% "Clip Pre-Scale" hp2.75
+		 (lambda (self event)
+		   (send canvas set-clip-pre-scale (send self get-value))))
+    (make-object choice% #f '("1" "*2" "/2" "1,*2" "*2,1") hp2.75
 		 (lambda (self event)
 		   (send canvas set-scale 
 			 (list-ref '(1 2 1/2 1 2) (send self get-selection))
 			 (list-ref '(1 2 1/2 2 1) (send self get-selection)))))
-    (make-object check-box% "+10" hp3
+    (make-object check-box% "+10" hp2.75
 		 (lambda (self event)
 		   (send canvas set-offset (if (send self get-value) 10 0))))
     (make-object choice% #f '("Cvs 1" "Cvs *2" "Cvs /2" "Cvs 1,*2" "Cvs *2,1") hp3
@@ -1375,26 +1417,17 @@
     (make-object check-box% "Cvs +10" hp3
 		 (lambda (self event)
 		   (send canvas set-canvas-offset (if (send self get-value) 10 0))))
-    (make-object choice% "Clip" 
-		 '("None" "Rectangle" "Rectangle2" "Octagon" 
-		   "Circle" "Wedge" "Round Rectangle" "Lambda" "A"
-		   "Rectangle + Octagon" "Rectangle + Circle" 
-		   "Octagon - Rectangle" "Rectangle & Octagon" "Rectangle ^ Octagon" "Polka"
-		   "Empty")
-		 hp3
+    (make-object choice% "Cvs Clip" '("None" "Empty" "Square" "Squares" "Octagon") hp3
 		 (lambda (self event)
-		   (set! clip (list-ref
-		               '(none rect rect2 poly circle wedge roundrect lam A 
-				      rect+poly rect+circle poly-rect poly&rect poly^rect 
-				      polka empty)
-		               (send self get-selection)))
-		   (send canvas refresh)))
-    (make-object check-box% "Clip Pre-Scale" hp3
+		   (send canvas set-canvas-clip (case (send self get-selection)
+                                                  [(0) #f]
+                                                  [(1) 'empty]
+                                                  [(2) 'square]
+                                                  [(3) 'squares]
+                                                  [(4) 'octagon]))))
+    (make-object check-box% "Cvs Gray" hp3
 		 (lambda (self event)
-		   (send canvas set-clip-pre-scale (send self get-value))))
-    (make-object check-box% "Cvs Clip" hp3
-		 (lambda (self event)
-		   (send canvas set-canvas-clip (send self get-value))))
+		   (send canvas set-canvas-gray (send self get-value))))
     (let ([clock (lambda (clip?)
 		   (thread (lambda ()
 			     (set! clock-clip? clip?)
@@ -1414,7 +1447,7 @@
 			     (set! clock-end #f)
 			     (send canvas refresh))))])
       (set! do-clock clock)
-      (make-object button% "Clip Clock" hp3 (lambda (b e) (clock #t)))
+      (make-object button% "Clip Clock" hp2.75 (lambda (b e) (clock #t)))
       (make-object button% "Print" hp4 (lambda (self event) (send canvas on-paint 'print)))
       (make-object button% "Print Setup" hp4 (lambda (b e) (let ([c (get-page-setup-from-user)])
                                                              (when c