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

added guard against passing #f to the make-button procedure

Browse Source
This commit is contained in:
Robby Findler 2010-04-15 23:07:27 -04:00
parent 10c6213a8f
commit d4c0aa1daf
1 changed files with 32 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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