From 0863437394e0770a86775ef6e8405ce366c2ec0e Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 20 Apr 2016 12:37:09 -0500
Subject: [PATCH] dont allow undoing of the color changes that IO uses to
 indicate which port is which

closes PR 15291
---
 gui-lib/framework/private/text.rkt |  2 +-
 gui-test/framework/tests/text.rkt  | 42 ++++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+), 1 deletion(-)

diff --git a/gui-lib/framework/private/text.rkt b/gui-lib/framework/private/text.rkt
index ba33eb7c..d96f12fb 100644
--- a/gui-lib/framework/private/text.rkt
+++ b/gui-lib/framework/private/text.rkt
@@ -2639,7 +2639,7 @@
     (define/private (do-insertion txts showing-input?)
       (define locked? (is-locked?))
       (define sf? (get-styles-fixed))
-      (begin-edit-sequence)
+      (begin-edit-sequence #f)
       (lock #f)
       (set-styles-fixed #f)
       (set! allow-edits? #t)
diff --git a/gui-test/framework/tests/text.rkt b/gui-test/framework/tests/text.rkt
index 51c4f451..86285dc7 100644
--- a/gui-test/framework/tests/text.rkt
+++ b/gui-test/framework/tests/text.rkt
@@ -620,3 +620,45 @@
            (flush-output port))
          (semaphore-wait clear-output-done)
          (send text get-text))))))
+
+(test
+ 'text:ports%.undo-does-not-remove-port-colors
+ (λ (x+y)
+   (equal? (list-ref x+y 0)
+           (list-ref x+y 1)))
+ (λ ()
+   (queue-sexp-to-mred
+    `(let ()
+       (define t (new (text:ports-mixin
+                       (editor:standard-style-list-mixin
+                        text:wide-snip%))))
+       
+       (send t set-max-undo-history 'forever)
+       (define last-undo? #f)
+       (send t add-undo (λ () (set! last-undo? #t)))
+       
+       (define vp (send t get-value-port))
+       (define op (send t get-out-port))
+       
+       (display "1" vp)
+       (display "2" op)
+       (flush-output vp)
+       (flush-output op)
+       
+       (define (to-vec c) (vector (send c red) (send c green) (send c blue)))
+       
+       (define (get-colors)
+         (let loop ([s (send t find-first-snip)])
+           (cond
+             [s (cons (list (send s get-text 0 (send s get-count))
+                            (to-vec (send (send s get-style) get-foreground)))
+                      (loop (send s next)))]
+             [else '()])))
+       
+       (define before (get-colors))
+       (let loop ()
+         (unless last-undo?
+           (send t undo)
+           (loop)))
+       (define after (get-colors))
+       (list before after)))))