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

framework: sometimes put the text completion menu above the line instead of below it

Browse Source 
closes PR 10829
This commit is contained in:
Robby Findler 2010-12-28 06:48:44 -06:00
parent f849f25272
commit 4e40efaf37
1 changed files with 21 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/framework/private/text.rkt
View File

@ -794,7 +794,7 @@ WARNING: printf is rebound in the body of the unit to always
[(preferences:get 'framework:ask-about-paste-normalization) [(preferences:get 'framework:ask-about-paste-normalization)
(let-values ([(mbr checked?) (let-values ([(mbr checked?)
(message+check-box/custom (message+check-box/custom
(string-constant drracket) (string-constant drscheme)
(string-constant normalize-string-info) (string-constant normalize-string-info)
(string-constant dont-ask-again) (string-constant dont-ask-again)
(string-constant normalize) (string-constant normalize)
@ -3129,12 +3129,15 @@ designates the character that triggers autocompletion
;; should change the current word to the word in the list. ;; should change the current word to the word in the list.
(define/private (show-options word start-pos end-pos cursor) (define/private (show-options word start-pos end-pos cursor)
(let ([x (box 0)] (let ([x (box 0)]
[y (box 0)]) [yb (box 0)]
(position-location start-pos x y #f) [yt (box 0)])
(position-location start-pos x yb #f)
(position-location start-pos #f yt #t)
(set! completions-box (new completion-box% (set! completions-box (new completion-box%
[completions (new scroll-manager% [cursor cursor])] [completions (new scroll-manager% [cursor cursor])]
[menu-x (unbox x)] [line-x (unbox x)]
[menu-y (+ (unbox y) 2)] [line-y-above (unbox yt)]
[line-y-below (unbox yb)]
[editor this])) [editor this]))
(send completions-box redraw))) (send completions-box redraw)))
@ -3373,8 +3376,9 @@ designates the character that triggers autocompletion
(class* object% (completion-box<%>) (class* object% (completion-box<%>)
(init-field completions ; scroll-manager% the possible completions (all of which have base-word as a prefix) (init-field completions ; scroll-manager% the possible completions (all of which have base-word as a prefix)
menu-x ; int the menu's top-left x coordinate line-x ; int the x coordinate of the line where the menu goes
menu-y ; int the menu's top-left y coordinate line-y-above ; int the y coordinate of the top of the line where the menu goes
line-y-below ; int the y coordinate of the bottom of the line where the menu goes
editor ; editor<%> the owner of this completion box editor ; editor<%> the owner of this completion box
) )
@ -3449,12 +3453,18 @@ designates the character that triggers autocompletion
(add1 n))))]))]))) (add1 n))))]))])))
(let ([final-x (cond (let ([final-x (cond
[(< (+ menu-x w) editor-width) [(< (+ line-x w) editor-width)
menu-x] line-x]
[(> editor-width w) [(> editor-width w)
(- editor-width w)] (- editor-width w)]
[else menu-x])] [else line-x])]
[final-y menu-y]) [final-y (cond
[(< (+ line-y-below 2 h) editor-height)
(+ line-y-below 2)]
[(> (- line-y-above h) 0)
(- line-y-above h)]
[else
(+ line-y-below 2)])])
(make-geometry final-x final-y w h vec)))) (make-geometry final-x final-y w h vec))))