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^])
(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 opt-out-toolbar-buttons '())
@ -50,7 +50,17 @@
(inherit unregister-toolbar-button get-definitions-text)
(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 (remove-toolbar-button button)
(send toolbar-button-panel change-children (λ (l) (remq button l)))
@ -68,6 +78,8 @@
;; move button panel to the front of the list
(send (get-button-panel) change-children
(λ (l) (cons toolbar-button-panel (remq toolbar-button-panel l))))
(after-initialized)
(set! after-initialized void)
(define/public (initialize-module-language)
(let ([defs (get-definitions-text)])
@ -92,7 +104,8 @@
(define timer #f)
(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 (or (not hash-lang-last-location)
(<= start hash-lang-last-location))
@ -105,7 +118,7 @@
(move-to-new-language)))]
[just-once? #t])))
(send timer stop)
(send timer start 200 #t)))))
(send timer start 200 #t))))))
(define/private (update-in-module-language? new-one)
(unless (equal? new-one in-module-language?)
@ -166,7 +179,8 @@
(define/private (register-new-buttons buttons opt-out-ids)
(let* ([tab (get-tab)]
[frame (send tab get-frame)])
(when (send frame initialized?)
(send frame when-initialized
(λ ()
(send frame begin-container-sequence)
;; 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)
string<=?
#:key (λ (x) (send x get-label)))))
(send frame end-container-sequence))))
(send frame end-container-sequence)))))
(inherit get-text)
(define/private (get-lang-name pos)