From 4e3650005a6d205b7e252499e792dc40405da01f Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 12 Jul 2011 16:20:03 -0400
Subject: [PATCH] First stab at using a text% to display messages.

---
 .../typed-scheme/optimizer/tool/display.rkt   |  6 ++---
 collects/typed-scheme/optimizer/tool/tool.rkt | 26 +++++++++++++++++--
 2 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/collects/typed-scheme/optimizer/tool/display.rkt b/collects/typed-scheme/optimizer/tool/display.rkt
index d912864268..51d7eb3280 100644
--- a/collects/typed-scheme/optimizer/tool/display.rkt
+++ b/collects/typed-scheme/optimizer/tool/display.rkt
@@ -1,7 +1,7 @@
 #lang racket/base
 
-(require racket/string unstable/pretty racket/class racket/gui/base
-         unstable/sequence)
+(require racket/string racket/class racket/gui/base
+         unstable/sequence unstable/pretty)
 
 (provide format-message make-color-table)
 
@@ -11,7 +11,7 @@
                          (syntax-line stx)
                          (syntax-column stx)
                          (pretty-format/write (syntax->datum stx))
-                         msg))
+                         (break-lines msg)))
                "\n\n"))
 
 (define lowest-badness-color  (make-object color% "pink"))
diff --git a/collects/typed-scheme/optimizer/tool/tool.rkt b/collects/typed-scheme/optimizer/tool/tool.rkt
index 9bcc480dc1..098f82bce2 100644
--- a/collects/typed-scheme/optimizer/tool/tool.rkt
+++ b/collects/typed-scheme/optimizer/tool/tool.rkt
@@ -15,6 +15,19 @@
    bitmap%
    (collection-file-path "performance-report.png" "icons") 'png/mask))
 
+(define read-only-text%
+  (class text%
+    ;; we allow an initial grace period where write are allowed, to
+    ;; initialize the editor
+    (define init-done? #f)
+    (define/augment (can-delete? start len)
+      (not init-done?))
+    (define/augment (can-insert? start len)
+      (not init-done?))
+    (define/public (init-done)
+      (set! init-done? #t))
+    (super-new)))
+
 ;; performance-report-callback : drracket:unit:frame<%> -> void
 (define (performance-report-callback drr-frame)
   (send (send drr-frame get-definitions-text) add-highlights))
@@ -54,8 +67,17 @@
            (send this highlight-range start end color)
            (send this set-clickback start end
                  (lambda (ed start end)
-                   (message-box "Performance Report"
-                                (format-message stxs+msgs))))
+                   (define text (new read-only-text%))
+                   (define win (new dialog%
+                                    [label "Performance Report"]
+                                    [width  700]
+                                    [height 300]))
+                   (define editor-canvas
+                     (new editor-canvas% [parent win] [editor text]))
+                   (send text insert-port (open-input-string
+                                           (format-message stxs+msgs)))
+                   (send text init-done)
+                   (send win show #t)))
            ;; record highlights to undo them later
            (cons (list start end color)
                  ;; missed optimizations have irritants, circle them