From e35f7ebd7050c5c3d0f991b9f3211d4b05218709 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 24 Mar 2004 14:55:01 +0000
Subject: [PATCH] .

original commit: f1a17951d9016165f20fed44688106098f7500d7
---
 collects/framework/private/text.ss | 62 ++++++++++++++++++------------
 1 file changed, 38 insertions(+), 24 deletions(-)

diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss
index 68128c7b..7fc83725 100644
--- a/collects/framework/private/text.ss
+++ b/collects/framework/private/text.ss
@@ -1,3 +1,9 @@
+#|
+
+WARNING: printf is rebound in the body of the unit to always
+         print to the original output port.
+
+|#
 
 (module text mzscheme
   (require (lib "string-constant.ss" "string-constants")
@@ -25,6 +31,9 @@
       
       (rename [-keymap% keymap%])
       
+      (define original-output-port (current-output-port))
+      (define (printf . args) (apply fprintf original-output-port args))
+      
       (define-struct range (start end b/w-bitmap color caret-space?))
       (define-struct rectangle (left top right bottom b/w-bitmap color))
       
@@ -851,7 +860,9 @@
                    get-start-position
                    get-end-position
                    get-snip-position
-                   last-position)
+                   last-position
+                   lock
+                   is-locked?)
           
           ;; private field
           (define eventspace (current-eventspace))
@@ -988,29 +999,32 @@
           ;; do-insertion : (listof (cons (union string snip) style-delta)) -> void
           ;; thread: eventspace main thread
           (define/private (do-insertion txts)
-            (begin-edit-sequence)
-            (let loop ([txts txts])
-              (cond
-                [(null? txts) (void)]
-                [else 
-                 (let* ([fst (car txts)]
-                        [str/snp (car fst)]
-                        [sd (cdr fst)])
-                   (insert (if (is-a? str/snp snip%)
-                               (send str/snp copy)
-                               str/snp)
-                           insertion-point
-                           insertion-point
-                           #f)
-                   (let ([inserted-count
-                          (if (is-a? str/snp snip%)
-                              1
-                              (string-length str/snp))])
-                     (change-style sd insertion-point (+ insertion-point inserted-count))
-                     (set! insertion-point (+ insertion-point inserted-count))
-                     (set! unread-start-point (+ unread-start-point inserted-count))))
-                 (loop (cdr txts))]))
-            (end-edit-sequence))
+            (let ([locked? (is-locked?)])
+              (begin-edit-sequence)
+              (lock #f)
+              (let loop ([txts txts])
+                (cond
+                  [(null? txts) (void)]
+                  [else 
+                   (let* ([fst (car txts)]
+                          [str/snp (car fst)]
+                          [sd (cdr fst)])
+                     (insert (if (is-a? str/snp snip%)
+                                 (send str/snp copy)
+                                 str/snp)
+                             insertion-point
+                             insertion-point
+                             #f)
+                     (let ([inserted-count
+                            (if (is-a? str/snp snip%)
+                                1
+                                (string-length str/snp))])
+                       (change-style sd insertion-point (+ insertion-point inserted-count))
+                       (set! insertion-point (+ insertion-point inserted-count))
+                       (set! unread-start-point (+ unread-start-point inserted-count))))
+                   (loop (cdr txts))]))
+              (lock locked?)
+              (end-edit-sequence)))
           
           (define input-buffer-thread
             (thread