diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index fd07a75693..b526bfe9f3 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -194,7 +194,7 @@ M: listener-gadget focusable-child* : (get-listener) ( quot -- listener ) find-window - [ [ raise-window ] [ gadget-child ] bi ] + [ [ raise-window ] [ gadget-child dup request-focus ] bi ] [ listener-window* ] if* ; inline : get-listener ( -- listener ) @@ -415,33 +415,55 @@ M: listener-gadget ungraft* [ com-end ] [ call-next-method ] bi ; ! Foo +USING: summary ui.gadgets.labels ui.gadgets.tables colors ui.render +ui.gadgets.worlds ui.gadgets.glass tools.completion ui.gadgets ; +USE: tools.completion + : ( model -- gadget ) [ summary ] ; +TUPLE: completion-popup < wrapper table interactor ; + +: find-completion-popup ( gadget -- popup ) + [ completion-popup? ] find-parent ; + SINGLETON: completion-renderer M: completion-renderer row-columns drop name>> 1array ; M: completion-renderer row-value drop ; -: ( interactor quot -- table ) +: ( object object -- object ) [ one-word-elt 1/3 seconds ] dip - '[ [ { } ] [ @ keys 20 short head ] if-empty ] - completion-renderer >>renderer ; - -TUPLE: completion-popup < wrapper interactor ; - -: ( interactor quot -- popup ) - dupd - - - { 300 300 } >>min-dim - { 300 300 } >>max-dim - completion-popup new-wrapper - white >>interior - swap >>interactor ; + '[ [ { } ] [ @ keys 20 short head ] if-empty ] ; : hide-completion-popup ( popup -- ) interactor>> f >>completion-popup find-world hide-glass ; +: completion-loc/doc ( popup -- loc doc ) + interactor>> [ editor-caret* ] [ model>> ] bi ; + +: accept-completion ( item table -- ) + find-completion-popup + [ + [ name>> ] [ completion-loc/doc ] bi* + one-word-elt set-elt-string + ] [ hide-completion-popup ] bi ; + +: ( interactor quot -- table ) +
+ completion-renderer >>renderer + dup '[ _ accept-completion ] >>action ; + +: ( object -- object ) + + { 300 120 } >>min-dim + { 300 120 } >>max-dim ; + +: ( interactor quot -- popup ) + [ completion-popup new-gadget ] 2dip + [ drop >>interactor ] [ >>table ] 2bi + dup table>> add-gadget + white >>interior ; + completion-popup H{ { T{ key-down f f "ESC" } [ hide-completion-popup ] } } set-gestures @@ -452,13 +474,23 @@ completion-popup H{ : ( interactor -- table ) [ vocabs-matching ] ; -: show-completion-popup ( interactor popup -- ) +: (show-completion-popup) ( interactor popup -- ) [ >>completion-popup ] keep [ find-world ] dip { 0 0 } show-glass ; +: complete-IN:/USE:? ( object -- object ) + 2 short tail* { "IN:" "USE:" } intersects? ; + +: vocab-completion? ( interactor -- ? ) + [ editor-string ] [ editor-caret* ] bi head " " split + { + [ complete-IN:? ] + [ { ";" } last-split1 ] + } 1|| ; + : word-completion-popup ( interactor -- ) - dup show-completion-popup ; + dup (show-completion-popup) ; : pass-to-popup? ( gesture interactor -- ? ) [ [ key-down? ] [ key-up? ] bi or ] @@ -472,9 +504,6 @@ M: interactor handle-gesture [ call-next-method ] [ 2drop f ] if ] [ call-next-method ] if ; -: test-it ( interactor -- ) - dup show-completion-popup ; - interactor "completion" f { { T{ key-down f f "TAB" } word-completion-popup } } define-command-map \ No newline at end of file