From 7aac5a700402a9bcd2aced4f0c7c49569f0c36f2 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 11 Apr 2009 14:07:39 +0000
Subject: [PATCH] pasteboard printing fix & editor-canvas chaining fix

svn: r14490

original commit: ccf5809b45a62393491203add9e73fda2fb03cc5
---
 collects/mred/private/wxme/editor-canvas.ss | 27 +++++++++++++++------
 collects/mred/private/wxme/pasteboard.ss    | 21 ++++++++--------
 2 files changed, 30 insertions(+), 18 deletions(-)

diff --git a/collects/mred/private/wxme/editor-canvas.ss b/collects/mred/private/wxme/editor-canvas.ss
index 78c236f9..db19417a 100644
--- a/collects/mred/private/wxme/editor-canvas.ss
+++ b/collects/mred/private/wxme/editor-canvas.ss
@@ -907,14 +907,15 @@
               (set! media #f)
               (if oldadmin
                   (begin
-                    (send admin set-nextadmin oldadmin)
-                    (send admin set-prevadmin (send oldadmin get-prevadmin))
-                    (send oldadmin set-prevadmin admin)
-                    (send oldadmin adjust-std-flag)
-                    (let ([a (send admin get-prevadmin)])
-                      (when a
-                        (send a set-nextadmin admin)
-                        (send a adjust-std-flag)))
+                    (unless (in-chain? admin oldadmin)
+                      (send admin set-nextadmin oldadmin)
+                      (send admin set-prevadmin (send oldadmin get-prevadmin))
+                      (send oldadmin set-prevadmin admin)
+                      (send oldadmin adjust-std-flag)
+                      (let ([a (send admin get-prevadmin)])
+                        (when a
+                          (send a set-nextadmin admin)
+                          (send a adjust-std-flag))))
                     ;; get the right cursor:
                     (send admin update-cursor))
                   (begin
@@ -927,6 +928,16 @@
       (when update?
         (repaint))))
 
+  (define/private (in-chain? admin oldadmin)
+    (or (let loop ([oldadmin oldadmin])
+          (and oldadmin
+               (or (eq? admin oldadmin)
+                   (loop (send oldadmin get-prevadmin)))))
+        (let loop ([oldadmin oldadmin])
+          (and oldadmin
+               (or (eq? admin oldadmin)
+                   (loop (send oldadmin get-nextadmin)))))))
+
   (define/public (allow-scroll-to-last to-last?)
     (set! scroll-to-last? to-last?)
     (reset-visual #f)
diff --git a/collects/mred/private/wxme/pasteboard.ss b/collects/mred/private/wxme/pasteboard.ss
index 6b8ae007..80b023d9 100644
--- a/collects/mred/private/wxme/pasteboard.ss
+++ b/collects/mred/private/wxme/pasteboard.ss
@@ -2088,8 +2088,8 @@
                       [h 0.0])
               (get-extent w h)
 
-            (let ([hcount (->long (ceiling (/ W w)))]
-                  [vcount (->long (ceiling (/ H h)))])
+            (let ([hcount (->long (ceiling (/ w W)))]
+                  [vcount (->long (ceiling (/ h H)))])
 
               (if (not print?)
                   (page . <= . (* hcount vcount))
@@ -2097,20 +2097,21 @@
                                 (if (negative? page)
                                     (values 1 (* hcount vcount))
                                     (values page page))])
-                    (for ([p (in-range start end)])
+                    (for ([p (in-range start (add1 end))])
                       (let ([vpos (quotient (- p 1) hcount)]
                             [hpos (modulo (- p 1) hcount)])
                         (let ([x (* hpos w)]
                               [y (* vpos h)])
                           (when (negative? page)
-                            (send dc start-page)
+                            (send dc start-page))
                             
-                            (draw dc (+ (- x) hm) (+ (- y) vm)
-                                  x y (+ x w) (+ y h)
-                                  #f
-                                  #f)
-                            (when (negative? page)
-                              (send dc end-page))))))))))))))
+                          (draw dc (+ (- x) hm) (+ (- y) vm)
+                                x y (+ x w) (+ y h)
+                                'no-caret
+                                #f)
+
+                          (when (negative? page)
+                            (send dc end-page)))))))))))))
 
   ;; ----------------------------------------
   )