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

sped up opening of language dialog by doing work when show details is clicked

Browse Source 
svn: r1187
This commit is contained in:
Robby Findler 2005-10-31 21:05:01 +00:00
parent 4148dc0764
commit 2e84a99401
1 changed files with 90 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

138
collects/drscheme/private/language-configuration.ss
View File

@ -348,16 +348,23 @@
;; get/set-selected-language-settings (union #f (-> settings)) ;; get/set-selected-language-settings (union #f (-> settings))
(define get/set-selected-language-settings #f) (define get/set-selected-language-settings #f)
;; language-mixin : (implements language<%>) (implements area-container<%>) get/set -> (define details-computed? #f)
;; language-mixin : (implements language<%>)
;; (-> (implements area-container<%>))
;; get/set
;; ->
;; ((implements hierlist<%>) -> (implements hierlist<%>)) ;; ((implements hierlist<%>) -> (implements hierlist<%>))
;; a mixin that responds to language selections and updates the details-panel ;; a mixin that responds to language selections and updates the details-panel
(define (language-mixin language language-details-panel get/set-settings) (define (language-mixin language get-language-details-panel get/set-settings)
(λ (%) (λ (%)
(class* % (hieritem-language<%>) (class* % (hieritem-language<%>)
(init-rest args) (init-rest args)
(public selected) (public selected)
(define (selected) (define (selected)
(send details-panel active-child language-details-panel) (let ([ldp (get-language-details-panel)])
(when ldp
(send details-panel active-child ldp)))
(send one-line-summary-message set-label (send language get-one-line-summary)) (send one-line-summary-message set-label (send language get-one-line-summary))
(send revert-to-defaults-button enable #t) (send revert-to-defaults-button enable #t)
(update-manual-ordering-text language) (update-manual-ordering-text language)
@ -432,6 +439,9 @@
n-sp n-sp
(+ n-ep 1))))) (+ n-ep 1)))))
;; construct-details : (union (-> void) #f)
(define construct-details void)
;; add-language-to-dialog : (instanceof language<%>) -> void ;; add-language-to-dialog : (instanceof language<%>) -> void
;; adds the language to the dialog ;; adds the language to the dialog
;; opens all of the turn-down tags ;; opens all of the turn-down tags
@ -469,44 +479,68 @@
[second-number #f]) ;; only non-#f during the second iteration in which case it is the first iterations number [second-number #f]) ;; only non-#f during the second iteration in which case it is the first iterations number
(cond (cond
[(null? (cdr positions)) [(null? (cdr positions))
(let-values ([(language-details-panel get/set-settings) (let* ([language-details-panel #f]
(make-details-panel language)]) [real-get/set-settings
(let* ([position (car positions)] (case-lambda
[number (car numbers)] [()
[mixin (compose (cond
number-mixin [(equal? (send language-to-show get-language-position)
(language-mixin language language-details-panel get/set-settings))] (send language get-language-position))
[item settings-to-show]
(send hier-list new-item [else
(if second-number (send language default-settings)])]
(compose second-number-mixin mixin) [(x) (void)])]
mixin))] [get-language-details-panel
[text (send item get-editor)] (lambda () language-details-panel)]
[delta (send language get-style-delta)]) [get/set-settings (lambda x (apply real-get/set-settings x))]
(send item set-number number) [position (car positions)]
(when second-number [number (car numbers)]
(send item set-second-number second-number)) [mixin (compose
(send text insert position) number-mixin
(when delta (language-mixin language get-language-details-panel get/set-settings))]
(cond [item
[(list? delta) (send hier-list new-item
(for-each (λ (x) (if second-number
(send text change-style (compose second-number-mixin mixin)
(car x) mixin))]
(cadr x) [text (send item get-editor)]
(caddr x))) [delta (send language get-style-delta)])
delta)]
[(is-a? delta style-delta%) (set! construct-details
(send text change-style (let ([old construct-details])
(send language get-style-delta) (lambda ()
0 (old)
(send text last-position))]))) (let-values ([(language-details-panel-real get/set-settings)
(cond (make-details-panel language)])
[(equal? (send language-to-show get-language-position) (set! language-details-panel language-details-panel-real)
(send language get-language-position)) (set! real-get/set-settings get/set-settings))
(get/set-settings settings-to-show)]
[else (cond
(get/set-settings (send language default-settings))]))] [(equal? (send language-to-show get-language-position)
(send language get-language-position))
(get/set-settings settings-to-show)
(send details-panel active-child language-details-panel)]
[else
(get/set-settings (send language default-settings))]))))
(send item set-number number)
(when second-number
(send item set-second-number second-number))
(send text insert position)
(when delta
(cond
[(list? delta)
(for-each (λ (x)
(send text change-style
(car x)
(cadr x)
(caddr x)))
delta)]
[(is-a? delta style-delta%)
(send text change-style
(send language get-style-delta)
0
(send text last-position))])))]
[else (let* ([position (car positions)] [else (let* ([position (car positions)]
[number (car numbers)] [number (car numbers)]
[sub-ht/sub-hier-list [sub-ht/sub-hier-list
@ -651,13 +685,21 @@
;; details-callback : -> void ;; details-callback : -> void
;; flips the details-shown? flag and resets the GUI ;; flips the details-shown? flag and resets the GUI
(define (details-callback) (define (details-callback)
(set! details-shown? (not details-shown?)) (let ([do-construction? (and construct-details #t)])
(when re-center (when do-construction?
(send re-center begin-container-sequence)) (send details-button enable #f)
(update-show/hide-details) (construct-details)
(when re-center (set! construct-details #f))
(send re-center center 'both)
(send re-center end-container-sequence))) (set! details-shown? (not details-shown?))
(when re-center
(send re-center begin-container-sequence))
(update-show/hide-details)
(when re-center
(send re-center center 'both)
(send re-center end-container-sequence))
(when do-construction?
(send details-button enable #t))))
;; show/hide-details : -> void ;; show/hide-details : -> void
;; udpates the GUI based on the details-shown? flag ;; udpates the GUI based on the details-shown? flag