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

Replace fields with local-member-name accessors.

Browse Source 
(cherry picked from commit 848a28266c)
This commit is contained in:
Vincent St-Amour 2012-07-20 16:25:02 -04:00 committed by Ryan Culpepper
parent 4c889bc0bc
commit a53ff364ac
1 changed files with 24 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -34,12 +34,16 @@
,(match-lambda [(sub-report-entry s m 'mzc) #t] ,(match-lambda [(sub-report-entry s m 'mzc) #t]
[_ #f])))) [_ #f]))))
(define-local-member-name get-optimization-coach-menu-item) (define-local-member-name
(define-local-member-name highlighting-shown?) get-optimization-coach-menu-item
(define-local-member-name add-highlights) highlighting-shown?
(define-local-member-name clear-highlights) add-highlights
(define-local-member-name show-optimization-coach-panel) clear-highlights
(define-local-member-name hide-optimization-coach-panel) show-optimization-coach-panel
hide-optimization-coach-panel
get-filters
set-filters!
optimization-coach-visible?)
(define optimization-coach-drracket-button (define optimization-coach-drracket-button
(list (list
@ -70,7 +74,9 @@
;; sub, show it. ;; sub, show it.
;; Note: at the point where these are called, report entries have ;; Note: at the point where these are called, report entries have
;; a single sub. ;; a single sub.
(init-field [filters (map cdr check-boxes)]) ; all enabled by default (define filters (map cdr check-boxes)) ; all enabled by default
(define/public (get-filters) filters)
(define/public (set-filters! fs) (set! filters fs))
;; highlight-range, for ranges that span multiple lines, highlights ;; highlight-range, for ranges that span multiple lines, highlights
;; to the end of the first n-1 lines. Since the space at end of lines ;; to the end of the first n-1 lines. Since the space at end of lines
@ -173,7 +179,8 @@
(inherit get-defs get-frame) (inherit get-defs get-frame)
(init-field [panel #f]) (define panel #f)
(define/public (optimization-coach-visible?) panel)
(define/public (show-optimization-coach-panel) (define/public (show-optimization-coach-panel)
(set! panel (set! panel
@ -185,14 +192,14 @@
[label "Clear"] [label "Clear"]
[parent panel] [parent panel]
[callback (lambda _ (send definitions clear-highlights))]) [callback (lambda _ (send definitions clear-highlights))])
(define filters (get-field filters definitions)) (define filters (send definitions get-filters))
(for ([(l f) (in-pairs check-boxes)]) (for ([(l f) (in-pairs check-boxes)])
(new check-box% (new check-box%
[label l] [label l]
[parent panel] [parent panel]
[callback [callback
(lambda _ (lambda _
(set-field! filters definitions (if (memq f filters) (send definitions set-filters! (if (memq f filters)
(remq f filters) (remq f filters)
(cons f filters))) (cons f filters)))
;; redraw ;; redraw
@ -224,20 +231,22 @@
[demand-callback [demand-callback
(λ (item) (λ (item)
(send item set-label (send item set-label
(if (get-field panel (get-current-tab)) (if (send (get-current-tab)
optimization-coach-visible?)
(string-constant hide-optimization-coach) (string-constant hide-optimization-coach)
(string-constant show-optimization-coach))))] (string-constant show-optimization-coach))))]
[callback [callback
(λ (a b) (λ (a b)
(define tab (get-current-tab)) (define tab (get-current-tab))
(if (get-field panel tab) (if (send tab optimization-coach-visible?)
(send (send tab get-defs) clear-highlights) (send (send tab get-defs) clear-highlights)
(optimization-coach-callback this)))])) (optimization-coach-callback this)))]))
(set-show-menu-sort-key optimization-coach-menu-item 403)) (set-show-menu-sort-key optimization-coach-menu-item 403))
(define/augment (on-tab-change old-tab new-tab) (define/augment (on-tab-change old-tab new-tab)
(send old-tab hide-optimization-coach-panel #f) ; don't close it (send old-tab hide-optimization-coach-panel #f) ; don't close it
(when (get-field panel new-tab) ; if it was open before (when (send new-tab optimization-coach-visible?)
;; if it was open before
(send new-tab show-optimization-coach-panel))) (send new-tab show-optimization-coach-panel)))
(define optimization-coach-menu-item #f) (define optimization-coach-menu-item #f)