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

add a View menu item for the optimization coach

Browse Source
This commit is contained in:
Robby Findler 2012-07-17 13:45:33 -05:00
parent a66c735b82
commit 3b5eb1da41
2 changed files with 44 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/string-constants/private/english-string-constants.rkt
View File

@ -1658,4 +1658,8 @@ please adhere to these guidelines:
(always-use-platform-specific-linefeed-convention "Always use the platform-specific linefeed convention")
;; optimization coach
(hide-optimization-coach "Hide Optimization Coach Info")
(show-optimization-coach "Show Optimization Coach Info")
)

44
collects/typed-racket/optimizer/tool/tool.rkt
View File

@ -3,7 +3,8 @@
(require racket/class racket/port racket/list racket/match unstable/sequence
racket/gui/base racket/unit drracket/tool mrlib/switchable-button
images/compile-time framework
(for-syntax racket/base images/icons/misc images/icons/style))
(for-syntax racket/base images/icons/misc images/icons/style)
string-constants)
(require "report.rkt" "display.rkt")
@ -33,6 +34,7 @@
,(match-lambda [(sub-report-entry s m 'mzc) #t]
[_ #f]))))
(define-local-member-name get-coach-menu-item)
(define-unit tool@
@ -95,6 +97,9 @@
(cons (highlight-part start end-of-line)
(loop (add1 end-of-line)))])))
(define on? #f)
(define/public (highlighting-shown?) on?)
(define report-cache #f)
(define/public (add-highlights #:use-cache? [use-cache? #f])
(clear-highlights)
@ -114,12 +119,14 @@
(set! color-table (make-color-table max-badness)))
(set! undo-thunks (for/fold ([res '()])
([r (in-list report)])
(append (highlight-entry r) res))))
(append (highlight-entry r) res)))
(set! on? #t))
(define/public (clear-highlights)
(for ([h (in-list undo-thunks)]) (h))
(set! highlights '())
(send (get-tab) hide-optimization-coach-panel))
(send (get-tab) hide-optimization-coach-panel)
(set! on? #f))
(define/augment (on-insert start len)
(clear-highlights))
@ -202,10 +209,37 @@
(define tab-switch-mixin
(mixin (drracket:unit:frame<%>) ()
(super-new)
(inherit set-show-menu-sort-key get-current-tab)
(define/public (get-coach-menu-item) coach-menu-item)
(define/override (add-show-menu-items show-menu)
(super add-show-menu-items show-menu)
(set! coach-menu-item
(new menu-item%
[label (string-constant show-optimization-coach)]
[parent show-menu]
[demand-callback
(λ (item)
(send item set-label
(if (get-field panel (get-current-tab))
(string-constant hide-optimization-coach)
(string-constant show-optimization-coach))))]
[callback
(λ (a b)
(define tab (get-current-tab))
(if (get-field panel tab)
(send (send tab get-defs) clear-highlights)
(optimization-coach-callback this)))]))
(set-show-menu-sort-key coach-menu-item 403))
(define/augment (on-tab-change old-tab new-tab)
(send old-tab hide-optimization-coach-panel #f) ; don't close it
(when (get-field panel new-tab) ; if it was open before
(send new-tab show-optimization-coach-panel)))))
(send new-tab show-optimization-coach-panel)))
(define coach-menu-item #f)
(super-new)))
(drracket:get/extend:extend-unit-frame tab-switch-mixin))