diff --git a/ChangeLog.n b/ChangeLog.n
index 474437bc1418a7589f65a3e742d21212b4c98aad..11546e110ca808eea22ddde86e88c0ed92908443 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -3,6 +3,13 @@
 don't forget to change the version in utils/packages.lisp if you do anything
 user visible.
 
+*******************************************************************************
+2009-05-14  Andreas Fuchs  <afuchs@franz.com>
+
+	* silica/db-scroll.lisp: new gf `medium-can-scroll-by-copy-region-p':
+	  Determines whether we can use copy-area to scroll.
+	* aclpc/acl-pixmaps.lisp: add a method to prevent copy-area scrolling
+	  if gadget output records are present on the stream. [spr35502]
 *******************************************************************************
 2009-05-11  Duane Rettig  <duane@franz.com>
 
diff --git a/aclpc/acl-pixmaps.lisp b/aclpc/acl-pixmaps.lisp
index e5577644712e37df045a77a062687c544bdca62b..35b38be24ceabd33ab325441f4a01ee1487985c5 100644
--- a/aclpc/acl-pixmaps.lisp
+++ b/aclpc/acl-pixmaps.lisp
@@ -30,6 +30,23 @@
 
 (in-package :acl-clim)
 
+(defmethod silica::medium-can-scroll-by-copy-region-p
+    ((medium acl-window-medium) old-region new-region)
+  "On Windows, copy-region corrupts the output if gadget output
+records (like buttons) are present in the old or new regions."
+  (and (call-next-method)
+       (let ((sheet (medium-sheet medium)))
+        (flet ((any-gadget-output-records-p (region)
+                 (map-over-output-records-overlapping-region
+                  (lambda (record)
+                    (when (typep record 'gadget-output-record)
+                      (return-from any-gadget-output-records-p nil)))
+                  (stream-output-history sheet)
+                  region)
+                 t))
+          (not (or (any-gadget-output-records-p old-region)
+                   (any-gadget-output-records-p new-region)))))))
+
 (defmethod medium-copy-area ((from-medium acl-window-medium) from-x from-y
 			     width height
 			     (to-medium acl-window-medium) to-x to-y
diff --git a/silica/db-scroll.lisp b/silica/db-scroll.lisp
index 2e7ef8d130ce756d13226e946110c7bdf4804ca2..ef600dad2b68373bade315533e3ddbba77c137c3 100644
--- a/silica/db-scroll.lisp
+++ b/silica/db-scroll.lisp
@@ -260,6 +260,14 @@
 (defmethod mirror-region-updated :after ((port basic-port) (viewport viewport))
   (update-scroll-bars viewport))
 
+(defgeneric medium-can-scroll-by-copy-region-p (medium old-region new-region)
+  (:method (medium old-region new-region)
+    (declare (ignore medium))
+    (with-bounding-rectangle* (left top right bottom) old-region
+      (with-bounding-rectangle* (nleft ntop nright nbottom) new-region
+        (ltrb-overlaps-ltrb-p left top right bottom
+                              nleft ntop nright nbottom)))))
+
 (defmethod scroll-extent ((sheet basic-sheet) x y)
   ;;--- CER says that this really isn't right...
   (fix-coordinates x y)
@@ -282,7 +290,9 @@
             (update-region sheet nleft ntop nright nbottom)
 	    ;; Must go after bounding-rectangle-set-position
             (update-scroll-bars viewport)
-            (if (ltrb-overlaps-ltrb-p left top right bottom nleft ntop nright nbottom)
+            (if (medium-can-scroll-by-copy-region-p
+                   medium (make-bounding-rectangle left top right bottom)
+                   (pane-viewport-region sheet))
                 (progn
 		  ;; Move the old stuff to the new position
                   (window-shift-visible-region sheet
@@ -301,7 +311,7 @@
                             medium (bounding-rectangle* region))
                           (if (output-recording-stream-p sheet)
                               (replay (stream-output-history sheet) sheet region)
-                            (repaint-sheet sheet region)))))))
+                              (repaint-sheet sheet region)))))))
               (let ((region (viewport-viewport-region viewport)))
 		;;--- We should make the sheet-region bigger at this point.
 		;;--- Perhaps we do a union of the sheet-region and the viewport.