steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More work on history completion

db4
Slava Pestov 2009-01-13 20:47:17 -06:00
parent 9a5b7d44fd
commit 94e0522efc
1 changed files with 18 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
basis/ui/tools/listener/listener.factor
View File

@ -442,7 +442,7 @@ USE: tools.completion
: <summary-gadget> ( model -- gadget ) : <summary-gadget> ( model -- gadget )
[ summary ] <filter> <label-control> ; [ summary ] <filter> <label-control> ;
TUPLE: completion-popup < wrapper table interactor ; TUPLE: completion-popup < wrapper table interactor element ;
: find-completion-popup ( gadget -- popup ) : find-completion-popup ( gadget -- popup )
[ completion-popup? ] find-parent ; [ completion-popup? ] find-parent ;
@ -451,25 +451,28 @@ SINGLETON: completion-renderer
M: completion-renderer row-columns drop present 1array ; M: completion-renderer row-columns drop present 1array ;
M: completion-renderer row-value drop ; M: completion-renderer row-value drop ;
: <completion-model> ( object object -- object ) : <completion-model> ( editor quot -- model )
[ one-word-elt <element-model> 1/3 seconds <delay> ] dip [ one-word-elt <element-model> 1/3 seconds <delay> ] dip
'[ @ keys 1000 short head ] <filter> ; '[ @ keys 1000 short head ] <filter> ;
: hide-completion-popup ( popup -- ) M: completion-popup hide-glass-hook
interactor>> f >>completion-popup find-world hide-glass ; interactor>> f >>completion-popup drop ;
: completion-loc/doc ( popup -- loc doc ) : hide-completion-popup ( popup -- )
interactor>> [ editor-caret* ] [ model>> ] bi ; find-world hide-glass ;
: completion-loc/doc/elt ( popup -- loc doc elt )
[ interactor>> [ editor-caret* ] [ model>> ] bi ] [ element>> ] bi ;
: accept-completion ( item table -- ) : accept-completion ( item table -- )
find-completion-popup find-completion-popup
[ [ [ present ] [ completion-loc/doc/elt ] bi* set-elt-string ]
[ name>> ] [ completion-loc/doc ] bi* [ hide-completion-popup ]
one-word-elt set-elt-string bi ;
] [ hide-completion-popup ] bi ;
: <completion-table> ( interactor quot -- table ) : <completion-table> ( interactor quot -- table )
<completion-model> <table> <completion-model> <table>
t >>selection-required?
completion-renderer >>renderer completion-renderer >>renderer
dup '[ _ accept-completion ] >>action ; dup '[ _ accept-completion ] >>action ;
@ -491,21 +494,23 @@ completion-popup H{
} set-gestures } set-gestures
: show-completion-popup ( interactor quot -- ) : show-completion-popup ( interactor quot -- )
dupd <completion-popup>
[ >>completion-popup ] keep [ >>completion-popup ] keep
[ find-world ] dip [ find-world ] dip
{ 0 0 } show-glass ; { 0 0 } show-glass ;
: word-completion-popup ( interactor -- ) : word-completion-popup ( interactor -- )
dup vocab-completion? dup dup vocab-completion?
[ vocabs-matching ] [ words-matching ] ? [ vocabs-matching ] [ words-matching ] ?
<completion-popup> one-word-elt >>element
show-completion-popup ; show-completion-popup ;
: history-matching ( string interactor -- alist ) : history-matching ( string interactor -- alist )
history>> <reversed> dup zip completions ; history>> <reversed> dup zip completions ;
: history-completion-popup ( interactor -- ) : history-completion-popup ( interactor -- )
dup '[ _ history-matching ] show-completion-popup ; dup dup '[ _ history-matching ]
<completion-popup> one-line-elt >>element
show-completion-popup ;
: pass-to-popup? ( gesture interactor -- ? ) : pass-to-popup? ( gesture interactor -- ? )
[ [ key-down? ] [ key-up? ] bi or ] [ [ key-down? ] [ key-up? ] bi or ]