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

72
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,13 +479,25 @@
[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
[()
(cond
[(equal? (send language-to-show get-language-position)
(send language get-language-position))
settings-to-show]
[else
(send language default-settings)])]
[(x) (void)])]
[get-language-details-panel
(lambda () language-details-panel)]
[get/set-settings (lambda x (apply real-get/set-settings x))]
[position (car positions)]
[number (car numbers)] [number (car numbers)]
[mixin (compose [mixin (compose
number-mixin number-mixin
(language-mixin language language-details-panel get/set-settings))] (language-mixin language get-language-details-panel get/set-settings))]
[item [item
(send hier-list new-item (send hier-list new-item
(if second-number (if second-number
@ -483,6 +505,24 @@
mixin))] mixin))]
[text (send item get-editor)] [text (send item get-editor)]
[delta (send language get-style-delta)]) [delta (send language get-style-delta)])
(set! construct-details
(let ([old construct-details])
(lambda ()
(old)
(let-values ([(language-details-panel-real get/set-settings)
(make-details-panel language)])
(set! language-details-panel language-details-panel-real)
(set! real-get/set-settings get/set-settings))
(cond
[(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) (send item set-number number)
(when second-number (when second-number
(send item set-second-number second-number)) (send item set-second-number second-number))
@ -500,13 +540,7 @@
(send text change-style (send text change-style
(send language get-style-delta) (send language get-style-delta)
0 0
(send text last-position))]))) (send text last-position))])))]
(cond
[(equal? (send language-to-show get-language-position)
(send language get-language-position))
(get/set-settings settings-to-show)]
[else
(get/set-settings (send language default-settings))]))]
[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)
(let ([do-construction? (and construct-details #t)])
(when do-construction?
(send details-button enable #f)
(construct-details)
(set! construct-details #f))
(set! details-shown? (not details-shown?)) (set! details-shown? (not details-shown?))
(when re-center (when re-center
(send re-center begin-container-sequence)) (send re-center begin-container-sequence))
(update-show/hide-details) (update-show/hide-details)
(when re-center (when re-center
(send re-center center 'both) (send re-center center 'both)
(send re-center end-container-sequence))) (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