From 2ecec626b35432408d9d558fc4aac66ce3cf4dba Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 23 Jun 2011 17:00:57 -0400
Subject: [PATCH] Remove highlights after editing.

---
 collects/typed-scheme/info.rkt                |  2 +
 collects/typed-scheme/optimizer/tool/tool.rkt | 52 ++++++++++++++-----
 2 files changed, 42 insertions(+), 12 deletions(-)

diff --git a/collects/typed-scheme/info.rkt b/collects/typed-scheme/info.rkt
index 1d42db462b..6360474d1d 100644
--- a/collects/typed-scheme/info.rkt
+++ b/collects/typed-scheme/info.rkt
@@ -2,3 +2,5 @@
 
 (define scribblings '(("scribblings/ts-reference.scrbl" (multi-page) (language 4))
 		      ("scribblings/ts-guide.scrbl" (multi-page) (language 5))))
+(define drracket-tools '(("optimizer/tool/tool.rkt")))
+(define drracket-tool-names '("Performance Report"))
diff --git a/collects/typed-scheme/optimizer/tool/tool.rkt b/collects/typed-scheme/optimizer/tool/tool.rkt
index 471a65e8ef..a91c4c8475 100644
--- a/collects/typed-scheme/optimizer/tool/tool.rkt
+++ b/collects/typed-scheme/optimizer/tool/tool.rkt
@@ -1,12 +1,14 @@
 #lang racket/base
 
-(require racket/unit racket/class racket/port racket/list
-         racket/gui/base mrlib/switchable-button)
+(require racket/class racket/port racket/list
+         racket/gui/base mrlib/switchable-button
+         racket/unit drracket/tool)
 
 (require (prefix-in tr: typed-scheme/typed-reader)
          typed-scheme/optimizer/logging)
 
-(provide performance-report-drracket-button)
+(provide performance-report-drracket-button
+         tool@)
 
 ;; DrRacket tool for reporting missed optimizations in the editor.
 
@@ -23,6 +25,8 @@
     (send bdc set-bitmap #f)
     bmp))
 
+(define highlights '())
+
 ;; performance-report-callback : drracket:unit:frame<%> -> void
 (define (performance-report-callback drr-frame)
   (define defs     (send drr-frame get-definitions-text)) ; : text%
@@ -40,15 +44,17 @@
        (expand (tr:read-syntax portname input)))))
   (set! log (reverse log))
   ;; highlight
-  (for ([l (in-list log)])
-    (let ([stx (log-entry-stx l)]
-          [pos (sub1 (log-entry-pos l))]
-          ;; opt or missed opt?
-          [opt? (regexp-match #rx"^TR opt:" (log-entry-msg l))])
-      (send defs highlight-range
-            pos
-            (+ pos (syntax-span stx))
-            (if opt? "lightgreen" "pink"))))
+  (define new-highlights
+    (for/list ([l (in-list log)])
+      (let* ([stx (log-entry-stx l)]
+             [pos (sub1 (log-entry-pos l))]
+             [end (+ pos (syntax-span stx))]
+             ;; opt or missed opt?
+             [opt? (regexp-match #rx"^TR opt:" (log-entry-msg l))]
+             [color (if opt? "lightgreen" "pink")])
+        (send defs highlight-range pos end color)
+        (list pos end color)))) ; record the highlight, to undo it later
+  (set! highlights (append new-highlights highlights))
   (message-box
    "Performance Report"
    (with-output-to-string
@@ -56,6 +62,28 @@
       (for ([l (in-list log)])
         (displayln (log-entry-msg l)))))))
 
+(define remove-highlights-mixin
+  (mixin ((class->interface text%)) ()
+    (inherit begin-edit-sequence
+             end-edit-sequence
+             insert
+             get-text)
+    (define (clear-highlights)
+      (for ([h (in-list highlights)])
+        (send this unhighlight-range . h)))
+    (define/augment (after-insert start len)
+      (clear-highlights))
+    (define/augment (after-delete start len)
+      (clear-highlights))
+    (super-new)))
+
+(define-unit tool@
+  (import drracket:tool^)
+  (export drracket:tool-exports^)
+  (define (phase1) (void))
+  (define (phase2) (void))
+  (drracket:get/extend:extend-definitions-text remove-highlights-mixin))
+
 (define performance-report-drracket-button
   (list
    "Performance Report"