improved the language dialog's handling of the (quasi-) menu key shortcuts.

closes PR 11073 (hopefully)
This commit is contained in:
Robby Findler 2010-08-02 11:20:53 -05:00
parent 53ff7a1092
commit 621ccbc2b4
2 changed files with 41 additions and 26 deletions

View File

@ -291,6 +291,7 @@
;; actual language selections ;; actual language selections
(define hieritem-language<%> (define hieritem-language<%>
(interface (hierarchical-list-item<%>) (interface (hierarchical-list-item<%>)
get-language
selected)) selected))
(define selectable-hierlist% (define selectable-hierlist%
@ -370,10 +371,10 @@
cached-fringe) cached-fringe)
(define/override (on-select i) (define/override (on-select i)
(when i
(set! most-recent-languages-hier-list-selection i))
(cond (cond
[(and i (is-a? i hieritem-language<%>)) [(and i (is-a? i hieritem-language<%>))
(preferences:set 'drracket:language-dialog:hierlist-default (send (send i get-language) get-language-position))
(set! most-recent-languages-hier-list-selection i)
(something-selected i)] (something-selected i)]
[else [else
(non-language-selected)])) (non-language-selected)]))
@ -416,7 +417,7 @@
[stretchable-width #f] [stretchable-width #f]
[min-width 32])) [min-width 32]))
(define in-source-discussion-editor-canvas (add-discussion in-source-discussion-panel)) (define in-source-discussion-editor-canvas (add-discussion in-source-discussion-panel))
(define most-recent-languages-hier-list-selection #f) (define most-recent-languages-hier-list-selection (preferences:get 'drracket:language-dialog:hierlist-default))
(define use-chosen-language-rb (define use-chosen-language-rb
(new radio-box% (new radio-box%
[label #f] [label #f]
@ -429,7 +430,8 @@
(when most-recent-languages-hier-list-selection (when most-recent-languages-hier-list-selection
(send languages-hier-list select (send languages-hier-list select
most-recent-languages-hier-list-selection)) most-recent-languages-hier-list-selection))
(send use-language-in-source-rb set-selection #f)) (send use-language-in-source-rb set-selection #f)
(send languages-hier-list focus))
(define languages-hier-list-panel (new horizontal-panel% [parent languages-choice-panel])) (define languages-hier-list-panel (new horizontal-panel% [parent languages-choice-panel]))
(define languages-hier-list-spacer (new horizontal-panel% (define languages-hier-list-spacer (new horizontal-panel%
[parent languages-hier-list-panel] [parent languages-hier-list-panel]
@ -473,8 +475,8 @@
(λ (%) (λ (%)
(class* % (hieritem-language<%>) (class* % (hieritem-language<%>)
(init-rest args) (init-rest args)
(public selected) (define/public (get-language) language)
(define (selected) (define/public (selected)
(update-gui-based-on-selected-language language get-language-details-panel get/set-settings)) (update-gui-based-on-selected-language language get-language-details-panel get/set-settings))
(apply super-make-object args)))) (apply super-make-object args))))
@ -782,36 +784,47 @@
[(not (and language-to-show settings-to-show)) [(not (and language-to-show settings-to-show))
(no-language-selected)] (no-language-selected)]
[(is-a? language-to-show drracket:module-language:module-language<%>) [(is-a? language-to-show drracket:module-language:module-language<%>)
(let ([hier-default (preferences:get 'drracket:language-dialog:hierlist-default)])
(when hier-default
(select-a-language-in-hierlist hier-default)))
;; the above changes the radio button selections, so do it before calling module-language-selected
(module-language-selected)] (module-language-selected)]
[else [else
(send languages-hier-list focus) ;; only focus when the module language isn't selected (send languages-hier-list focus) ;; only focus when the module language isn't selected
(send use-chosen-language-rb set-selection 0) (send use-chosen-language-rb set-selection 0)
(send use-language-in-source-rb set-selection #f) (send use-language-in-source-rb set-selection #f)
(let ([language-position (send language-to-show get-language-position)]) (select-a-language-in-hierlist (send language-to-show get-language-position))]))
(cond
[(null? (cdr language-position)) (define (select-a-language-in-hierlist language-position)
;; nothing to open here (cond
(send (car (send languages-hier-list get-items)) select #t) [(null? (cdr language-position))
(void)] ;; nothing to open here
[else (send (car (send languages-hier-list get-items)) select #t)
(let loop ([hi languages-hier-list] (void)]
[else
;; skip the first position, since it is flattened into the dialog (let loop ([hi languages-hier-list]
[first-pos (cadr language-position)]
[position (cddr language-position)]) ;; skip the first position, since it is flattened into the dialog
(let ([child [first-pos (cadr language-position)]
;; know that this `car' is okay by construction of the dialog [position (cddr language-position)])
(car (let ([matching-children
(filter (λ (x) (filter (λ (x)
(equal? (send (send x get-editor) get-text) (equal? (send (send x get-editor) get-text)
first-pos)) first-pos))
(send hi get-items)))]) (send hi get-items))])
(cond
[(null? matching-children)
;; just give up here. probably this means that a bad preference was saved
;; and we're being called from the module-language case in 'open-current-language'
(void)]
[else
(let ([child (car matching-children)])
(cond (cond
[(null? position) [(null? position)
(send child select #t)] (send child select #t)]
[else [else
(send child open) (send child open)
(loop child (car position) (cdr position))])))]))])) (loop child (car position) (cdr position))]))])))]))
;; docs-callback : -> void ;; docs-callback : -> void
(define (docs-callback) (define (docs-callback)

View File

@ -95,6 +95,8 @@
(finder:default-filters))) (finder:default-filters)))
(application:current-app-name (string-constant drscheme)) (application:current-app-name (string-constant drscheme))
(drr:set-default 'drracket:language-dialog:hierlist-default #f (λ (x) (or (not x) (and (list? x) (andmap string? x)))))
(drr:set-default 'drracket:create-executable-gui-type 'stand-alone (λ (x) (memq x '(launcher stand-alone distribution)))) (drr:set-default 'drracket:create-executable-gui-type 'stand-alone (λ (x) (memq x '(launcher stand-alone distribution))))
(drr:set-default 'drracket:create-executable-gui-base 'racket (λ (x) (memq x '(racket gracket)))) (drr:set-default 'drracket:create-executable-gui-base 'racket (λ (x) (memq x '(racket gracket))))