diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor index c696299091..6d5863905b 100644 --- a/basis/ui/tools/listener/completion/completion.factor +++ b/basis/ui/tools/listener/completion/completion.factor @@ -47,6 +47,11 @@ M: vocab-completion completion-banner drop "Vocabularies:" ; M: char-completion completion-banner drop "Unicode code point names:" ; M: history-completion completion-banner drop "Input history:" ; +GENERIC: completion-popup-width ( interactor completion-mode -- x ) + +M: object completion-popup-width 2drop 300 ; +M: history-completion completion-popup-width drop dim>> first ; + ! Completion modes also implement the row renderer protocol M: listener-completion row-columns drop present 1array ; @@ -100,8 +105,10 @@ M: completion-popup hide-glass-hook : hide-completion-popup ( popup -- ) find-world hide-glass ; -: completion-loc/doc ( popup -- loc doc ) - interactor>> [ editor-caret ] [ model>> ] bi ; +: completion-loc/doc/elt ( popup -- loc doc elt ) + [ interactor>> [ editor-caret ] [ model>> ] bi ] + [ completion-mode>> completion-element ] + bi ; GENERIC: completion-string ( object -- string ) @@ -117,8 +124,7 @@ M: engine-word completion-string method-completion-string ; GENERIC# accept-completion-hook 1 ( item popup -- ) : insert-completion ( item popup -- ) - [ completion-string ] [ completion-loc/doc ] bi* - one-word-elt set-elt-string ; + [ completion-string ] [ completion-loc/doc/elt ] bi* set-elt-string ; : accept-completion ( item table -- ) find-completion-popup @@ -135,15 +141,14 @@ GENERIC# accept-completion-hook 1 ( item popup -- ) t >>selection-required? dup '[ _ accept-completion ] >>action ; -: ( object -- object ) - - { 300 120 } >>min-dim - { 300 120 } >>max-dim ; +: ( completion-popup -- scroller ) + [ table>> ] [ interactor>> ] [ completion-mode>> ] tri completion-popup-width + [ ] [ 120 2array ] bi* [ >>min-dim ] [ >>max-dim ] bi ; : ( interactor completion-mode -- popup ) [ vertical completion-popup new-track ] 2dip [ [ >>interactor ] [ >>completion-mode ] bi* ] [ >>table ] 2bi - dup [ table>> ] [ completion-mode>> completion-banner ] bi + dup [ ] [ completion-mode>> completion-banner ] bi 1 track-add COLOR: white >>interior ;