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

Refactoring.

Browse Source
This commit is contained in:
Vincent St-Amour 2012-07-25 15:31:55 -04:00
parent 57568ae44c
commit dc6a81ad02
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,8 +27,8 @@
get-optimization-coach-menu-item get-optimization-coach-menu-item
add-highlights add-highlights
clear-highlights clear-highlights
show-optimization-coach-panel show-optimization-coach
hide-optimization-coach-panel hide-optimization-coach
get-filters get-filters
set-filters! set-filters!
optimization-coach-visible? optimization-coach-visible?
@ -198,7 +198,7 @@
;; control panel ;; control panel
(define panel #f) (define panel #f)
(define/public (show-optimization-coach-panel) (define/public (show-optimization-coach)
(define area-container (get-area-container)) (define area-container (get-area-container))
(define definitions (get-definitions-text)) (define definitions (get-definitions-text))
(define filters (send definitions get-filters)) (define filters (send definitions get-filters))
@ -213,7 +213,7 @@
[parent panel] [parent panel]
[callback [callback
(lambda _ (lambda _
(hide-optimization-coach-panel) (hide-optimization-coach)
(send (get-definitions-text) clear-highlights))]) (send (get-definitions-text) clear-highlights))])
(for ([(l f) (in-pairs check-boxes)]) (for ([(l f) (in-pairs check-boxes)])
(new check-box% (new check-box%
@ -236,17 +236,17 @@
[(l f) (in-pairs check-boxes)]) [(l f) (in-pairs check-boxes)])
(send c set-value (memq f filters)))) (send c set-value (memq f filters))))
(define/public (hide-optimization-coach-panel [close #t]) (define/public (hide-optimization-coach [close #t])
(send (get-area-container) delete-child panel)) (send (get-area-container) delete-child panel))
;; tab switching ;; tab switching
(define/augment (on-tab-change old-tab new-tab) (define/augment (on-tab-change old-tab new-tab)
(when (send (send old-tab get-defs) optimization-coach-visible?) (when (send (send old-tab get-defs) optimization-coach-visible?)
(hide-optimization-coach-panel #f)) ; don't close it (hide-optimization-coach #f)) ; don't close it
(when (send (send new-tab get-defs) optimization-coach-visible?) (when (send (send new-tab get-defs) optimization-coach-visible?)
;; if it was open before ;; if it was open before
(show-optimization-coach-panel))) (show-optimization-coach)))
;; entry point ;; entry point
@ -268,7 +268,7 @@
(send definitions get-style-list)) ;; speeds up the copy (send definitions get-style-list)) ;; speeds up the copy
(send definitions copy-self-to definitions-copy) (send definitions copy-self-to definitions-copy)
;; launch OC proper ;; launch OC proper
(show-optimization-coach-panel) (show-optimization-coach)
(send this update-running #t) (send this update-running #t)
(thread ; do the work in a separate thread, to avoid blocking the GUI (thread ; do the work in a separate thread, to avoid blocking the GUI
(lambda () (lambda ()