From 8d96441673d07568b02d047e9f59575c09dec128 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 19 Nov 2009 20:29:36 +0000
Subject: [PATCH] PR 10591

svn: r16897
---
 collects/framework/private/text.ss | 23 +++++++++++--------
 collects/tests/framework/text.ss   | 37 ++++++++++++++++++++++++++++++
 2 files changed, 50 insertions(+), 10 deletions(-)

diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss
index 668834e816..e12ad06ec6 100644
--- a/collects/framework/private/text.ss
+++ b/collects/framework/private/text.ss
@@ -451,15 +451,18 @@ WARNING: printf is rebound in the body of the unit to always
       (super on-paint before dc left-margin top-margin right-margin bottom-margin dx dy draw-caret)
       (when before
         (let-values ([(view-x view-y view-width view-height)
-                      (let ([b1 (box 0)]
-                            [b2 (box 0)]
-                            [b3 (box 0)]
-                            [b4 (box 0)])
-                        (send (get-admin) get-view b1 b2 b3 b4)
-                        (values (unbox b1)
-                                (unbox b2)
-                                (unbox b3)
-                                (unbox b4)))])
+                      (let ([admin (get-admin)])
+                        (if admin
+                            (let ([b1 (box 0)]
+                                  [b2 (box 0)]
+                                  [b3 (box 0)]
+                                  [b4 (box 0)])
+                              (send admin get-view b1 b2 b3 b4)
+                              (values (unbox b1)
+                                      (unbox b2)
+                                      (unbox b3)
+                                      (unbox b4)))
+                            (values left-margin top-margin right-margin bottom-margin)))])
           (let* ([old-pen (send dc get-pen)]
                  [old-brush (send dc get-brush)]
                  [old-smoothing (send dc get-smoothing)]
@@ -472,7 +475,7 @@ WARNING: printf is rebound in the body of the unit to always
                            [top (rectangle-top rectangle)]
                            [right (if (number? (rectangle-right rectangle))
                                       (rectangle-right rectangle)
-                                      (+ view-x view-width))]
+                                      view-x)]
                            [bottom (rectangle-bottom rectangle)]
                            [width (max 0 (- right left))]
                            [height (max 0 (- bottom top))])
diff --git a/collects/tests/framework/text.ss b/collects/tests/framework/text.ss
index 00fe7cc228..f0047ebfa2 100644
--- a/collects/tests/framework/text.ss
+++ b/collects/tests/framework/text.ss
@@ -161,3 +161,40 @@
          #:exists 'truncate)
        (send t load-file)
        (length (send t get-highlighted-ranges)))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;  print-to-dc
+;;
+
+(test
+ 'print-to-dc
+ (λ (x) (equal? x 'no-error))
+ (λ ()
+   (send-sexp-to-mred
+    '(let* ([t (new text:basic%)]
+            [bmp (make-object bitmap% 100 40)]
+            [dc (new bitmap-dc% (bitmap bmp))])
+       (send t insert "Hello world")
+       (send dc clear)
+       (send t print-to-dc dc 1)
+       'no-error))))
+
+
+(test
+ 'print-to-dc2
+ (λ (x) (equal? x 'no-error))
+ (λ ()
+   (send-sexp-to-mred
+    `(let* ([f (new frame% [label ""])]
+            [t (new text:basic%)]
+            [ec (new editor-canvas% [parent f] [editor t])]
+            [bmp (make-object bitmap% 100 40)]
+            [dc (new bitmap-dc% (bitmap bmp))])
+       (send t insert "Hello world")
+       (send t highlight-range 2 5 "orange")
+       (send f reflow-container)
+       (send dc clear)
+       (send t print-to-dc dc 1)
+       'no-error))))
\ No newline at end of file