From ddf8a2e2640e6820eda95f77901f0ef129a44b25 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 31 Dec 2009 17:18:19 +0000 Subject: [PATCH] fixed a bug in my last commit that made the define popup show up in vertical toolbar mode svn: r17454 --- collects/drscheme/private/main.ss | 6 ++-- collects/drscheme/private/unit.ss | 53 ++++++++++++++++++++----------- collects/drscheme/tool-lib.ss | 16 ++++++++-- 3 files changed, 52 insertions(+), 23 deletions(-) diff --git a/collects/drscheme/private/main.ss b/collects/drscheme/private/main.ss index ef3a024b11..2e759a83d9 100644 --- a/collects/drscheme/private/main.ss +++ b/collects/drscheme/private/main.ss @@ -361,8 +361,10 @@ (λ (t a b) (send t tabify-selection a b))) (drscheme:language:register-capability 'drscheme:autocomplete-words (listof string?) '()) (drscheme:language:register-capability 'drscheme:define-popup - (or/c (cons/c string? string?) false/c) - (cons "(define" "(define ...)")) + (or/c (cons/c string? string?) + (list/c string? string? string?) + #f) + (list "(define" "(define ...)" "δ")) ;; The default is #f to keep whatever the user chose as their context. ;; If it's "", then we will kill the user's choice. diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index 7a15377660..a9ab136f02 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -959,21 +959,24 @@ module browser threading seems wrong. (string-constant sort-by-position) (string-constant sort-by-name)))) - (define capability-info (drscheme:language:get-capability-default 'drscheme:define-popup)) + (define drscheme:define-popup-capability-info + (drscheme:language:get-capability-default 'drscheme:define-popup)) (inherit set-message set-hidden?) - (define/public (language-changed new-language) - (set! capability-info (send new-language capability-value 'drscheme:define-popup)) - (cond - [capability-info - (set-message #f (cdr capability-info)) - (set-hidden? #f)] - [else - (set-hidden? #t)])) + (define/public (language-changed new-language vertical?) + (set! drscheme:define-popup-capability-info (send new-language capability-value 'drscheme:define-popup)) + (let ([define-name (get-drscheme:define-popup-name drscheme:define-popup-capability-info + vertical?)]) + (cond + [define-name + (set-message #f define-name) + (set-hidden? #f)] + [else + (set-hidden? #t)]))) (define/override (fill-popup menu reset) - (when capability-info + (when drscheme:define-popup-capability-info (let* ([text (send frame get-definitions-text)] - [unsorted-defns (get-definitions (car capability-info) + [unsorted-defns (get-definitions (car drscheme:define-popup-capability-info) (not sort-by-name?) text)] [defns (if sort-by-name? @@ -1020,7 +1023,7 @@ module browser threading seems wrong. (send item check #t)) (loop (cdr defns))))))))) - (super-new (label define-button-long-label) + (super-new (label "(define ...)") ;; this default is quickly changed [string-constant-untitled (string-constant untitled)] [string-constant-no-full-name-since-not-saved (string-constant no-full-name-since-not-saved)]))) @@ -1903,11 +1906,13 @@ module browser threading seems wrong. (append (remq top-outer-panel l) (list top-outer-panel))))) (send top-outer-panel change-children (λ (l) (list top-panel))) (send transcript-parent-panel change-children (λ (l) (list transcript-panel))) - #; - (if vertical? - (send top-panel change-children (λ (x) (remq name-panel x))) - (send top-panel change-children (λ (x) (cons name-panel (remq name-panel x))))) - (send func-defs-canvas set-message #f (if vertical? "δ" define-button-long-label)) + + (let* ([settings (send definitions-text get-next-settings)] + [language (drscheme:language-configuration:language-settings-language settings)] + [name (get-drscheme:define-popup-name (send language capability-value 'drscheme:define-popup) + vertical?)]) + (when name + (send func-defs-canvas set-message #f name))) (send name-message set-short-title vertical?) (send name-panel set-orientation (not vertical?)) (if vertical? @@ -2029,7 +2034,7 @@ module browser threading seems wrong. (define/public (language-changed) (let* ([settings (send definitions-text get-next-settings)] [language (drscheme:language-configuration:language-settings-language settings)]) - (send func-defs-canvas language-changed language) + (send func-defs-canvas language-changed language (or (toolbar-is-left?) (toolbar-is-right?))) (send language-message set-yellow/lang (not (send definitions-text this-and-next-language-the-same?)) (string-append (send language get-language-name) @@ -4110,6 +4115,18 @@ module browser threading seems wrong. (set! newest-frame this) (send definitions-canvas focus))) + ;; get-drscheme:define-popup-name : (or/c #f (cons/c string? string?) (list/c string? string? string)) boolean -> (or/c #f string?) + (define (get-drscheme:define-popup-name info vertical?) + (and info + (if vertical? + (if (pair? (cdr info)) + (list-ref info 2) + "δ") + (if (pair? (cdr info)) + (list-ref info 1) + (cdr info))))) + + (define execute-warning-canvas% (class canvas% (inherit stretchable-height get-dc get-client-size min-height) diff --git a/collects/drscheme/tool-lib.ss b/collects/drscheme/tool-lib.ss index 4c67f43805..20bbba2a76 100644 --- a/collects/drscheme/tool-lib.ss +++ b/collects/drscheme/tool-lib.ss @@ -1090,10 +1090,20 @@ all of the names in the tools library, for use defining keybindings controls the name of the menu just to the right of the language menu (defaultly named ``Scheme'')} @cap[drscheme:define-popup - (or/c (cons/c string? string?) false/c) - (cons "(define" "(define ...)")]{ + (or/c #f + (list/c string? string? string?) + (cons/c string? string?)) + (list "(define" "(define ...)" "δ")]{ specifies the prefix that the define popup should look for and what - label it should have, or @scheme[#f] if it should not appear at all} + label it should have, or @scheme[#f] if it should not appear at all. + + If the list of three strings alternative is used, the first string is + the prefix that is looked for when finding definitions. The second + and third strings are used as the label of the control, in horizontal + and vertical mode, respectively. + + The pair of strings alternative is deprecated. If it is used, + the pair @scheme[(cons a-str b-str)] is the same as @scheme[(list a-str b-str "δ")].} @cap[drscheme:help-context-term (or/c false/c string?) #f]{ specifies a context query for documentation searches that are initiated in this language, can be @scheme[#f] (no change to the