From 86b2e602a82003dd6aadb00d9037ca545fca69a7 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 16 Jul 2014 09:47:41 -0500
Subject: [PATCH] added insert/io

original commit: fc492049564ce0b7d2a3b6f889f4e9b86aef6ed4
---
 .../gui-doc/scribblings/framework/text.scrbl  | 14 ++++-
 .../gui-lib/framework/private/text.rkt        | 52 ++++++++++++-------
 pkgs/gui-pkgs/gui-lib/info.rkt                |  2 +-
 3 files changed, 48 insertions(+), 20 deletions(-)

diff --git a/pkgs/gui-pkgs/gui-doc/scribblings/framework/text.scrbl b/pkgs/gui-pkgs/gui-doc/scribblings/framework/text.scrbl
index 6406a935..2c7b8133 100644
--- a/pkgs/gui-pkgs/gui-doc/scribblings/framework/text.scrbl
+++ b/pkgs/gui-pkgs/gui-doc/scribblings/framework/text.scrbl
@@ -963,7 +963,19 @@
 
     Both @racket[start] and @racket[end] must be less than
     @method[text:ports<%> get-insertion-point] (or else it is safe to delete
-    them so you don't need this method).
+    them via @method[text% delete], so you don't need this method).
+  }
+  
+  @defmethod[(insert/io [str string?] [pos exact-integer?]) void?]{
+    Inserts @racket[str] at the position @racket[start] without changing
+    the behavior of the ports (otherwise, inserting the text would break
+    internal invariants of the port).
+
+    The @racket[pos] argument must be less than
+    @method[text:ports<%> get-insertion-point] (or else it is safe to insert
+    the string via @method[text% insert], so you don't need this method).
+    
+    @history[#:added "1.2"]
   }
   
   @defmethod[(do-submission) void?]{
diff --git a/pkgs/gui-pkgs/gui-lib/framework/private/text.rkt b/pkgs/gui-pkgs/gui-lib/framework/private/text.rkt
index dffa3f7d..5bda22cd 100644
--- a/pkgs/gui-pkgs/gui-lib/framework/private/text.rkt
+++ b/pkgs/gui-pkgs/gui-lib/framework/private/text.rkt
@@ -2340,6 +2340,20 @@
         (delete start end #f)
         (set! allow-edits? before-allowed?)))
     
+    (define/public-final (insert/io str start [style #f])
+      (unless (<= start insertion-point)
+        (error 'insert/io "expected start (~a) <= insertion-point (~a)"
+               start (string-length str) insertion-point))
+      (define len (string-length str))
+      (set! insertion-point (+ insertion-point len))
+      (set! unread-start-point (+ unread-start-point len))
+      (let ([before-allowed? allow-edits?])
+        (set! allow-edits? #t)
+        (insert str start start #f)
+        (when style
+          (change-style (add-standard style) start (+ start len)))
+        (set! allow-edits? before-allowed?)))
+      
     (define/public-final (get-in-port)
       (unless in-port (error 'get-in-port "not ready"))
       in-port)
@@ -2719,24 +2733,9 @@
              (channel-put write-chan (cons #f to-send))])
           #t))
       
-      (let* ([add-standard
-              (λ (sd)
-                (cond
-                  [(string? sd)
-                   (let ([style-list (get-style-list)])
-                     (or (send style-list find-named-style sd)
-                         (send style-list find-named-style "Standard")
-                         (send style-list basic-style)))]
-                  [sd
-                   (let* ([style-list (get-style-list)] 
-                          [std (send style-list find-named-style "Standard")])
-                     (if std
-                         (send style-list find-or-create-style std sd)
-                         (let ([basic (send style-list basic-style)])
-                           (send style-list find-or-create-style basic sd))))]))]
-             [out-style (add-standard (get-out-style-delta))]
-             [err-style (add-standard (get-err-style-delta))]
-             [value-style (add-standard (get-value-style-delta))])
+      (let ([out-style (add-standard (get-out-style-delta))]
+            [err-style (add-standard (get-err-style-delta))]
+            [value-style (add-standard (get-value-style-delta))])
         (set! out-port (make-output-port #f
                                          always-evt
                                          (make-write-bytes-proc out-style)
@@ -2763,6 +2762,23 @@
           (install-handlers err-port)
           (install-handlers value-port))))
     
+    (define/private (add-standard sd)
+      (cond
+        [(string? sd)
+         (define style-list (get-style-list))
+         (or (send style-list find-named-style sd)
+             (send style-list find-named-style "Standard")
+             (send style-list basic-style))]
+        [sd
+         (define style-list (get-style-list))
+         (define std (send style-list find-named-style "Standard"))
+         (cond
+           [std
+            (send style-list find-or-create-style std sd)]
+           [else
+            (define basic (send style-list basic-style))
+            (send style-list find-or-create-style basic sd)])]))
+    
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;;
     ;;  helpers
diff --git a/pkgs/gui-pkgs/gui-lib/info.rkt b/pkgs/gui-pkgs/gui-lib/info.rkt
index 979675f9..757432d3 100644
--- a/pkgs/gui-pkgs/gui-lib/info.rkt
+++ b/pkgs/gui-pkgs/gui-lib/info.rkt
@@ -29,4 +29,4 @@
 
 (define pkg-authors '(mflatt))
 
-(define version "1.1")
+(define version "1.2")