diff --git a/collects/typed-scheme/lang/reader.rkt b/collects/typed-scheme/lang/reader.rkt index ef2e9ce68c..b00d3a3b75 100644 --- a/collects/typed-scheme/lang/reader.rkt +++ b/collects/typed-scheme/lang/reader.rkt @@ -4,5 +4,13 @@ typed-scheme #:read r:read #:read-syntax r:read-syntax +#:info make-info (require (prefix-in r: "../typed-reader.rkt")) + +(define (make-info key default use-default) + (case key + [(drscheme:toolbar-buttons) + (list (dynamic-require 'typed-scheme/optimizer/tool/tool + 'performance-report-drracket-button))] + [else (use-default key default)])) diff --git a/collects/typed-scheme/optimizer/tool/tool.rkt b/collects/typed-scheme/optimizer/tool/tool.rkt new file mode 100644 index 0000000000..9d01efad8f --- /dev/null +++ b/collects/typed-scheme/optimizer/tool/tool.rkt @@ -0,0 +1,29 @@ +#lang racket/base + +(require racket/unit racket/class + racket/gui/base mrlib/switchable-button) + +(provide performance-report-drracket-button) + +;; DrRacket tool for reporting missed optimizations in the editor. + +(define reverse-content-bitmap + (let* ((bmp (make-bitmap 16 16)) + (bdc (make-object bitmap-dc% bmp))) + (send bdc erase) + (send bdc set-smoothing 'smoothed) + (send bdc set-pen "black" 1 'transparent) + (send bdc set-brush "blue" 'solid) + (send bdc draw-ellipse 2 2 8 8) + (send bdc set-brush "red" 'solid) + (send bdc draw-ellipse 6 6 8 8) + (send bdc set-bitmap #f) + bmp)) + +(define performance-report-drracket-button + (list + "Performance Report" + reverse-content-bitmap + (λ (drs-frame) + (message-box "Performance Report" + "Coming Soon!")))) diff --git a/collects/typed/racket/lang/reader.rkt b/collects/typed/racket/lang/reader.rkt index 35c0f81dea..bce2cd00e8 100644 --- a/collects/typed/racket/lang/reader.rkt +++ b/collects/typed/racket/lang/reader.rkt @@ -9,6 +9,9 @@ typed/racket (define (make-info key default use-default) (case key + [(drscheme:toolbar-buttons) + (list (dynamic-require 'typed-scheme/optimizer/tool/tool + 'performance-report-drracket-button))] [else (use-default key default)])) (define make-language-info diff --git a/collects/typed/scheme/lang/reader.rkt b/collects/typed/scheme/lang/reader.rkt index 0c7fbe6b9c..16197bc2a2 100644 --- a/collects/typed/scheme/lang/reader.rkt +++ b/collects/typed/scheme/lang/reader.rkt @@ -9,6 +9,9 @@ typed/scheme (define (make-info key default use-default) (case key + [(drscheme:toolbar-buttons) + (list (dynamic-require 'typed-scheme/optimizer/tool/tool + 'performance-report-drracket-button))] [else (use-default key default)])) (define make-language-info