From 5227ee4d12e595d89ea48820c3fb0a527d4071af Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 11 Sep 2006 15:05:39 +0000
Subject: [PATCH] PR 8268: fixed the symptom, but there is still some question
 if the syntax colorer's behavior should change

svn: r4312
---
 collects/drscheme/private/debug.ss  | 17 ++++++++++-------
 collects/drscheme/private/rep.ss    |  9 ++++-----
 collects/framework/private/color.ss |  2 ++
 collects/framework/private/text.ss  |  2 +-
 collects/lang/htdp-langs.ss         |  4 +++-
 5 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/collects/drscheme/private/debug.ss b/collects/drscheme/private/debug.ss
index 6909e2067f..2e24ac351c 100644
--- a/collects/drscheme/private/debug.ss
+++ b/collects/drscheme/private/debug.ss
@@ -745,7 +745,6 @@ profile todo:
           
           (inherit get-top-level-window)
           (define/augment (after-many-evals)
-            (printf "updating test coverage\n")
             (when test-coverage-info
               (send (get-context) show-test-coverage-annotations
                     test-coverage-info
@@ -840,6 +839,7 @@ profile todo:
             (set! ask-about-reset? ask?)
             (let* ([edit-sequence-ht (make-hash-table)]
                    [locked-ht (make-hash-table)]
+                   [already-frozen-ht (make-hash-table)]
                    [actions-ht (make-hash-table 'equal)]
                    [on/syntaxes (hash-table-map ht (λ (_ pr) pr))]
 
@@ -931,11 +931,13 @@ profile todo:
                     (internal-clear-test-coverage-display)
                     (set! internal-clear-test-coverage-display #f))
                   
-                  ;; freeze the colorers (possibly re-freeze them)
+                  ;; freeze the colorers, but avoid a second freeze (so we can avoid a second thaw)
                   (hash-table-for-each
                    edit-sequence-ht
                    (λ (src _)
-                     (send src freeze-colorer)))
+                     (if (send src is-frozen?)
+                         (hash-table-put! already-frozen-ht src #t)
+                         (send src freeze-colorer))))
                   
                   ;; set new annotations
                   (for-each
@@ -986,10 +988,11 @@ profile todo:
                           (hash-table-for-each
                            edit-sequence-ht
                            (λ (txt _) 
-                             (let ([locked? (send txt is-locked?)])
-                               (when locked? (send txt lock #f))
-                               (send txt thaw-colorer)
-                               (when locked? (send txt lock #t)))
+                             (unless (hash-table-get already-frozen-ht txt #f)
+                               (let ([locked? (send txt is-locked?)])
+                                 (when locked? (send txt lock #f))
+                                 (send txt thaw-colorer)
+                                 (when locked? (send txt lock #t))))
                              (send txt end-edit-sequence)))))))))
 
           (inherit get-defs)
diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss
index 4a6ce11c1f..aa53b569a2 100644
--- a/collects/drscheme/private/rep.ss
+++ b/collects/drscheme/private/rep.ss
@@ -871,11 +871,10 @@ TODO
               (set! prompt-position (get-unread-start-point))
               (reset-region prompt-position 'end)))
           
-          (define/augment after-delete
-            (lambda (x y)
-              (unless inserting-prompt?
-                (reset-highlighting))
-              (inner (void) after-delete x y)))
+          (define/augment (after-delete x y)
+            (unless inserting-prompt?
+              (reset-highlighting))
+            (inner (void) after-delete x y))
           
           (define/override get-keymaps
             (λ ()
diff --git a/collects/framework/private/color.ss b/collects/framework/private/color.ss
index 84aeb4f9bf..5cf75d86de 100644
--- a/collects/framework/private/color.ss
+++ b/collects/framework/private/color.ss
@@ -9,6 +9,8 @@
            (lib "default-lexer.ss" "syntax-color")
            "sig.ss")
            
+  (define original-output-port (current-output-port))
+  (define (oprintf . args) (apply fprintf original-output-port args))
   
   (provide color@)
     
diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss
index 800ffff718..66e55dd264 100644
--- a/collects/framework/private/text.ss
+++ b/collects/framework/private/text.ss
@@ -380,7 +380,7 @@ WARNING: printf is rebound in the body of the unit to always
           (define/augment (after-set-position)
             (hide-caret (= (get-start-position) (get-end-position)))
 	    (inner (void) after-set-position))
-          (super-instantiate ())))
+          (super-new)))
 
       (define nbsp->space<%> (interface ((class->interface text%))))
       (define nbsp->space-mixin
diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss
index 2f6137f9e3..d2d7b0ae88 100644
--- a/collects/lang/htdp-langs.ss
+++ b/collects/lang/htdp-langs.ss
@@ -445,7 +445,9 @@ tracing todo:
           (define/augment (capability-value key)
             (case key
               [(drscheme:special:insert-lambda) #f]
-              [else (drscheme:language:get-capability-default key)]))
+              [else (inner (drscheme:language:get-capability-default key) 
+                           capability-value
+                           key)]))
 
           (super-new)))