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

fixed a bug in my last commit that made the define popup show up in vertical toolbar mode

Browse Source 
svn: r17454
This commit is contained in:
Robby Findler 2009-12-31 17:18:19 +00:00
parent 7f2bce0130
commit ddf8a2e264
3 changed files with 52 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/drscheme/private/main.ss
View File

@ -361,8 +361,10 @@
(λ (t a b) (send t tabify-selection a b))) (λ (t a b) (send t tabify-selection a b)))
(drscheme:language:register-capability 'drscheme:autocomplete-words (listof string?) '()) (drscheme:language:register-capability 'drscheme:autocomplete-words (listof string?) '())
(drscheme:language:register-capability 'drscheme:define-popup (drscheme:language:register-capability 'drscheme:define-popup
(or/c (cons/c string? string?) false/c) (or/c (cons/c string? string?)
(cons "(define" "(define ...)")) (list/c string? string? string?)
#f)
(list "(define" "(define ...)" "δ"))
;; The default is #f to keep whatever the user chose as their context. ;; The default is #f to keep whatever the user chose as their context.
;; If it's "", then we will kill the user's choice. ;; If it's "", then we will kill the user's choice.

47
collects/drscheme/private/unit.ss
View File

@ -959,21 +959,24 @@ module browser threading seems wrong.
(string-constant sort-by-position) (string-constant sort-by-position)
(string-constant sort-by-name)))) (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?) (inherit set-message set-hidden?)
(define/public (language-changed new-language) (define/public (language-changed new-language vertical?)
(set! capability-info (send new-language capability-value 'drscheme:define-popup)) (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 (cond
[capability-info [define-name
(set-message #f (cdr capability-info)) (set-message #f define-name)
(set-hidden? #f)] (set-hidden? #f)]
[else [else
(set-hidden? #t)])) (set-hidden? #t)])))
(define/override (fill-popup menu reset) (define/override (fill-popup menu reset)
(when capability-info (when drscheme:define-popup-capability-info
(let* ([text (send frame get-definitions-text)] (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?) (not sort-by-name?)
text)] text)]
[defns (if sort-by-name? [defns (if sort-by-name?
@ -1020,7 +1023,7 @@ module browser threading seems wrong.
(send item check #t)) (send item check #t))
(loop (cdr defns))))))))) (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-untitled (string-constant untitled)]
[string-constant-no-full-name-since-not-saved [string-constant-no-full-name-since-not-saved
(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))))) (append (remq top-outer-panel l) (list top-outer-panel)))))
(send top-outer-panel change-children (λ (l) (list top-panel))) (send top-outer-panel change-children (λ (l) (list top-panel)))
(send transcript-parent-panel change-children (λ (l) (list transcript-panel))) (send transcript-parent-panel change-children (λ (l) (list transcript-panel)))
#;
(if vertical? (let* ([settings (send definitions-text get-next-settings)]
(send top-panel change-children (λ (x) (remq name-panel x))) [language (drscheme:language-configuration:language-settings-language settings)]
(send top-panel change-children (λ (x) (cons name-panel (remq name-panel x))))) [name (get-drscheme:define-popup-name (send language capability-value 'drscheme:define-popup)
(send func-defs-canvas set-message #f (if vertical? "δ" define-button-long-label)) vertical?)])
(when name
(send func-defs-canvas set-message #f name)))
(send name-message set-short-title vertical?) (send name-message set-short-title vertical?)
(send name-panel set-orientation (not vertical?)) (send name-panel set-orientation (not vertical?))
(if vertical? (if vertical?
@ -2029,7 +2034,7 @@ module browser threading seems wrong.
(define/public (language-changed) (define/public (language-changed)
(let* ([settings (send definitions-text get-next-settings)] (let* ([settings (send definitions-text get-next-settings)]
[language (drscheme:language-configuration:language-settings-language 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 (send language-message set-yellow/lang
(not (send definitions-text this-and-next-language-the-same?)) (not (send definitions-text this-and-next-language-the-same?))
(string-append (send language get-language-name) (string-append (send language get-language-name)
@ -4110,6 +4115,18 @@ module browser threading seems wrong.
(set! newest-frame this) (set! newest-frame this)
(send definitions-canvas focus))) (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% (define execute-warning-canvas%
(class canvas% (class canvas%
(inherit stretchable-height get-dc get-client-size min-height) (inherit stretchable-height get-dc get-client-size min-height)

16
collects/drscheme/tool-lib.ss
View File

@ -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 controls the name of the menu just to the right of the language
menu (defaultly named ``Scheme'')} menu (defaultly named ``Scheme'')}
@cap[drscheme:define-popup @cap[drscheme:define-popup
(or/c (cons/c string? string?) false/c) (or/c #f
(cons "(define" "(define ...)")]{ (list/c string? string? string?)
(cons/c string? string?))
(list "(define" "(define ...)" "δ")]{
specifies the prefix that the define popup should look for and what 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]{ @cap[drscheme:help-context-term (or/c false/c string?) #f]{
specifies a context query for documentation searches that are specifies a context query for documentation searches that are
initiated in this language, can be @scheme[#f] (no change to the initiated in this language, can be @scheme[#f] (no change to the