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

got rid of some bouncing

Browse Source 
svn: r18796
This commit is contained in:
Robby Findler 2010-04-12 15:52:15 +00:00
parent 69b42edc38
commit e333734867
1 changed files with 32 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
collects/drscheme/private/module-language-tools.ss
View File

@ -135,36 +135,39 @@
(inherit get-tab)
(define/private (register-new-buttons buttons opt-out-ids)
(let* ([tab (get-tab)]
[frame (send tab get-frame)]
[directly-specified-buttons
(map (λ (button-spec)
(new switchable-button%
[label (list-ref button-spec 0)]
[bitmap (list-ref button-spec 1)]
[parent (send frame get-toolbar-button-panel)]
[callback
(lambda (button)
((list-ref button-spec 2) frame))]))
(or buttons '()))]
[opt-out-buttons
(if (eq? opt-out-ids #f)
'()
(map
(λ (opt-out-toolbar-button)
((opt-out-toolbar-button-make-button opt-out-toolbar-button)
frame
(send frame get-toolbar-button-panel)))
(filter (λ (opt-out-toolbar-button)
(not (member (opt-out-toolbar-button-id opt-out-toolbar-button)
opt-out-ids)))
opt-out-toolbar-buttons)))])
(send tab set-lang-toolbar-buttons
(sort
(append directly-specified-buttons
opt-out-buttons)
string<=?
#:key (λ (x) (send x get-label))))))
[frame (send tab get-frame)])
(send frame begin-container-sequence)
(let ([directly-specified-buttons
(map (λ (button-spec)
(new switchable-button%
[label (list-ref button-spec 0)]
[bitmap (list-ref button-spec 1)]
[parent (send frame get-toolbar-button-panel)]
[callback
(lambda (button)
((list-ref button-spec 2) frame))]))
(or buttons '()))]
[opt-out-buttons
(if (eq? opt-out-ids #f)
'()
(map
(λ (opt-out-toolbar-button)
((opt-out-toolbar-button-make-button opt-out-toolbar-button)
frame
(send frame get-toolbar-button-panel)))
(filter (λ (opt-out-toolbar-button)
(not (member (opt-out-toolbar-button-id opt-out-toolbar-button)
opt-out-ids)))
opt-out-toolbar-buttons)))])
(send tab set-lang-toolbar-buttons
(sort
(append directly-specified-buttons
opt-out-buttons)
string<=?
#:key (λ (x) (send x get-label)))))
(send frame end-container-sequence)))
(inherit get-text)
(define/private (get-lang-name pos)