 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 ;
 

: hide-completion-popup ( popup -- )
    find-world hide-glass ;

: completion-loc/doc ( popup -- loc doc )
    interactor>> [ editor-caret ] [ model>> ] bi ;

GENERIC: completion-string ( object -- string )


        t >>selection-required?
        dup '[ _ accept-completion ] >>action ;

: <completion-scroller> ( completion-popup -- scroller )
    [ table>> ] [ interactor>> ] [ completion-mode>> ] tri completion-popup-width
    [ <limited-scroller> ] [ 120 2array ] bi* [ >>min-dim ] [ >>max-dim ] bi ;

: <completion-popup> ( interactor completion-mode -- popup )
    [ vertical completion-popup new-track ] 2dip
    [ [ >>interactor ] [ >>completion-mode ] bi* ] [ <completion-table> >>table ] 2bi
    dup [ <completion-scroller> ] [ completion-mode>> completion-banner ] bi
    <labelled-gadget> 1 track-add
    COLOR: white <solid> >>interior ;

