diff --git a/collects/mred/private/wxme/editor-canvas.rkt b/collects/mred/private/wxme/editor-canvas.rkt
index cb492ed0..a9dca0e7 100644
--- a/collects/mred/private/wxme/editor-canvas.rkt
+++ b/collects/mred/private/wxme/editor-canvas.rkt
@@ -440,13 +440,14 @@
            (let-boxes ([x 0]
                        [y 0])
                (get-scroll x y)
-             (let ([y (max (+ y
+             (let ([old-y y]
+                   [y (max (+ y
                               (* wheel-amt
                                  (if (eq? code 'wheel-up)
                                      -1
                                      1)))
                            0)])
-               (do-scroll x y #t))))]
+               (do-scroll x y #t x old-y))))]
         [else
          (when (and media (not (send media get-printing)))
            (using-admin
@@ -490,7 +491,7 @@
         (when (not (send media get-printing))
           (let-boxes ([x 0][y 0][w 0][h 0])
               (get-view x y w h)
-            (redraw x y w h)))
+            (redraw x y w h #f)))
         (let ([bg (get-canvas-background)])
           (when bg
             (let ([adc (get-dc)])
@@ -538,28 +539,31 @@
       (let-boxes ([x 0]
                   [y 0])
           (get-scroll x y)
-        (when fx
-          (set-box! fx (- (* x hpixels-per-scroll) xmargin)))
-        (when fy
-          (if (and media
-                   (or (positive? y)
-                       scroll-bottom-based?))
-              (let ([v (- (if (send media locked-for-read?)
-                              0.0
-                              (send media scroll-line-location (+ y scroll-offset)))
-                          ymargin)])
-                (set-box! fy v)
-                (when (and scroll-bottom-based?
-                           (or (positive? scroll-height)
-                               scroll-to-last?))
-                  (let-boxes ([w 0] [h 0])
-                      (get-client-size w h)
-                    (let ([h (max (- h (* 2 ymargin))
-                                  0)])
-                      (set-box! fy (- (unbox fy) h))))))
-              (set-box! fy (- ymargin))))))
+        (convert-scroll-to-location x y fx fy)))
     (get-dc))
 
+  (define/private (convert-scroll-to-location x y fx fy)
+    (when fx
+      (set-box! fx (- (* x hpixels-per-scroll) xmargin)))
+    (when fy
+      (if (and media
+               (or (positive? y)
+                   scroll-bottom-based?))
+          (let ([v (- (if (send media locked-for-read?)
+                          0.0
+                          (send media scroll-line-location (+ y scroll-offset)))
+                      ymargin)])
+            (set-box! fy v)
+            (when (and scroll-bottom-based?
+                       (or (positive? scroll-height)
+                           scroll-to-last?))
+              (let-boxes ([w 0] [h 0])
+                  (get-client-size w h)
+                (let ([h (max (- h (* 2 ymargin))
+                              0)])
+                  (set-box! fy (- (unbox fy) h))))))
+          (set-box! fy (- ymargin)))))
+
   (define/public (get-view fx fy fw fh [unused-full? #f])
     (let ([w (box 0)]
           [h (box 0)])
@@ -574,10 +578,21 @@
       (when fw
         (set-box! fw (max 0 (- (unbox w) (* 2 xmargin)))))))
 
-  (define/public (redraw localx localy fw fh)
+  (define/public (redraw localx localy fw fh clear?)
     (when (and media
                (not (send media get-printing)))
       (begin-refresh-sequence)
+      (when clear?
+        (let ([bg (get-canvas-background)])
+          (when bg
+            (let ([adc (get-dc)])
+              (let ([b (send adc get-brush)]
+                    [p (send adc get-pen)])
+                (send adc set-brush bg 'solid)
+                (send adc set-pen bg 1 'transparent)
+                (send adc draw-rectangle localx localy fw fh)
+                (send adc set-brush b)
+                (send adc set-pen p))))))
       (let ([x (box 0)]
             [y (box 0)]
             [w (box 0)]
@@ -694,7 +709,7 @@
                               (send hscroll set-value sx))
                             (when vscroll
                               (send vscroll set-value sy))
-                            (do-scroll sx sy refresh?)
+                            (do-scroll sx sy refresh? cx cy)
                             #t)
                           #f)))))))))
 
@@ -863,7 +878,7 @@
 
                     retval)))))))
 
-  (define/private (do-scroll x y refresh?)
+  (define/private (do-scroll x y refresh? old-x old-y)
     (let ([savenoloop? noloop?])
       (set! noloop? #t)
       
@@ -878,8 +893,45 @@
           (set-scroll-pos 'vertical (->long (min y scroll-height)))))
       
       (set! noloop? savenoloop?)
-      
-      (when refresh? (repaint))))
+
+      (when refresh?
+        (if (and #f ;; special scrolling disabled: not faster with Cocoa, broken for Gtk
+                 (not need-refresh?)
+                 (not lazy-refresh?)
+                 (get-canvas-background)
+                 (= x old-x)) ; could handle horizontal scrolling in the future
+            (let-boxes ([fx 0]
+                        [old-fy 0]
+                        [new-fy 0])
+                (begin
+                  (convert-scroll-to-location x y fx new-fy)
+                  (convert-scroll-to-location old-x old-y #f old-fy))
+              (let-boxes ([vx 0][vy 0][vw 0][vh 0])
+                  (get-view vx vy vw vh) ; editor coords
+                (cond
+                 [(and (new-fy . < . old-fy)
+                       (old-fy . < . (+ new-fy vh)))
+                  (let ([dc (get-dc)])
+                    (send dc copy
+                          xmargin ymargin
+                          vw (- (+ new-fy vh) old-fy)
+                          xmargin (+ ymargin (- old-fy new-fy)))
+                    (redraw xmargin ymargin 
+                            vw (- old-fy new-fy)
+                            #t))]
+                 [(and (old-fy . < . new-fy)
+                       (new-fy . < . (+ old-fy vh)))
+                  (let ([dc (get-dc)])
+                    (send dc copy
+                          xmargin (+ ymargin (- new-fy old-fy))
+                          vw (- (+ old-fy vh) new-fy)
+                          xmargin ymargin)
+                    (let ([d (- (+ old-fy vh) new-fy)])
+                      (redraw xmargin (+ ymargin d)
+                              vw (- vh d)
+                              #t)))]
+                 [else (repaint)])))
+            (repaint)))))
 
   (define/override (set-scrollbars x y x2 y2 x3 y3 x4 y4 ?) (void))
 
@@ -1113,7 +1165,7 @@
          [is-shown?
           (if (not (send canvas get-canvas-background))
               (send canvas repaint)
-              (send canvas redraw localx localy w h))]))))
+              (send canvas redraw localx localy w h #f))]))))
 
   (define/override (resized update?)
     (all-in-chain (lambda (a) (send a do-resized update?))))