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

@@ -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 _) 
+                             (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)))
+                                 (when locked? (send txt lock #t))))
                              (send txt end-edit-sequence)))))))))
 
           (inherit get-defs)

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)
+          (define/augment (after-delete x y)
             (unless inserting-prompt?
               (reset-highlighting))
-              (inner (void) after-delete x y)))
+            (inner (void) after-delete x y))
           
           (define/override get-keymaps
             (λ ()

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@)
     

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

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)))