added insert/io

original commit: fc492049564ce0b7d2a3b6f889f4e9b86aef6ed4

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?]{

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,22 +2733,7 @@
              (channel-put write-chan (cons #f to-send))])
           #t))
       
-      (let* ([add-standard
+      (let ([out-style (add-standard (get-out-style-delta))]
-              (λ (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))])
         (set! out-port (make-output-port #f
@@ -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

pkgs/gui-pkgs/gui-lib/info.rkt

@@ -29,4 +29,4 @@
 
 (define pkg-authors '(mflatt))
 
-(define version "1.1")
+(define version "1.2")