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

an attempt to fix the 'toolbar buttons are wrong on initialization' bug in drracket

Browse Source
This commit is contained in:
Robby Findler 2011-05-15 21:47:03 -05:00
parent 66178570b6
commit 7b3039d22d
1 changed files with 66 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/drracket/private/module-language-tools.rkt
View File

@ -19,7 +19,7 @@
[prefix drracket:language-configuration: drracket:language-configuration^]) [prefix drracket:language-configuration: drracket:language-configuration^])
(export drracket:module-language-tools^) (export drracket:module-language-tools^)
(define-local-member-name initialized? move-to-new-language get-in-module-language?) (define-local-member-name when-initialized move-to-new-language get-in-module-language?)
(define-struct opt-out-toolbar-button (make-button id) #:transparent) (define-struct opt-out-toolbar-button (make-button id) #:transparent)
(define opt-out-toolbar-buttons '()) (define opt-out-toolbar-buttons '())
@ -50,7 +50,17 @@
(inherit unregister-toolbar-button get-definitions-text) (inherit unregister-toolbar-button get-definitions-text)
(define toolbar-button-panel #f) (define toolbar-button-panel #f)
(define/public (initialized?) (and toolbar-button-panel #t)) (define/public (when-initialized thunk)
(cond
[toolbar-button-panel
(thunk)]
[else
(set! after-initialized
(let ([old-after-initialized after-initialized])
(λ ()
(old-after-initialized)
(thunk))))]))
(define after-initialized void)
(define/public (get-toolbar-button-panel) toolbar-button-panel) (define/public (get-toolbar-button-panel) toolbar-button-panel)
(define/public (remove-toolbar-button button) (define/public (remove-toolbar-button button)
(send toolbar-button-panel change-children (λ (l) (remq button l))) (send toolbar-button-panel change-children (λ (l) (remq button l)))
@ -68,6 +78,8 @@
;; move button panel to the front of the list ;; move button panel to the front of the list
(send (get-button-panel) change-children (send (get-button-panel) change-children
(λ (l) (cons toolbar-button-panel (remq toolbar-button-panel l)))) (λ (l) (cons toolbar-button-panel (remq toolbar-button-panel l))))
(after-initialized)
(set! after-initialized void)
(define/public (initialize-module-language) (define/public (initialize-module-language)
(let ([defs (get-definitions-text)]) (let ([defs (get-definitions-text)])
@ -92,7 +104,8 @@
(define timer #f) (define timer #f)
(define/private (modification-at start) (define/private (modification-at start)
(when (send (send (get-tab) get-frame) initialized?) (send (send (get-tab) get-frame) when-initialized
(λ ()
(when in-module-language? (when in-module-language?
(when (or (not hash-lang-last-location) (when (or (not hash-lang-last-location)
(<= start hash-lang-last-location)) (<= start hash-lang-last-location))
@ -105,7 +118,7 @@
(move-to-new-language)))] (move-to-new-language)))]
[just-once? #t]))) [just-once? #t])))
(send timer stop) (send timer stop)
(send timer start 200 #t))))) (send timer start 200 #t))))))
(define/private (update-in-module-language? new-one) (define/private (update-in-module-language? new-one)
(unless (equal? new-one in-module-language?) (unless (equal? new-one in-module-language?)
@ -166,7 +179,8 @@
(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)])
(when (send frame initialized?) (send frame when-initialized
(λ ()
(send frame begin-container-sequence) (send frame begin-container-sequence)
;; avoid any time with both sets of buttons in the panel so the window doesn't get too wide ;; avoid any time with both sets of buttons in the panel so the window doesn't get too wide
@ -200,7 +214,7 @@
opt-out-buttons) opt-out-buttons)
string<=? string<=?
#:key (λ (x) (send x get-label))))) #:key (λ (x) (send x get-label)))))
(send frame end-container-sequence)))) (send frame end-container-sequence)))))
(inherit get-text) (inherit get-text)
(define/private (get-lang-name pos) (define/private (get-lang-name pos)