suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

First stab at using a text% to display messages.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-07-12 16:20:03 -04:00
parent 3c91ae012a
commit 4e3650005a
2 changed files with 27 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/typed-scheme/optimizer/tool/display.rkt
View File

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

26
collects/typed-scheme/optimizer/tool/tool.rkt
View File

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