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

Clean up listener completion; color code words by search path and private status, color code vocabs by load status

db4
Slava Pestov 2009-02-05 22:15:17 -06:00
parent 17e5997c0d
commit 68d5e3ebaf
2 changed files with 104 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

138
basis/ui/tools/listener/completion/completion.factor
View File

@ -1,15 +1,65 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs calendar colors documents USING: accessors arrays assocs calendar colors colors.constants documents
documents.elements fry kernel words sets splitting math math.vectors documents.elements fry kernel words sets splitting math math.vectors
models.delay models.filter combinators.short-circuit parser present models.delay models.filter combinators.short-circuit parser present
sequences tools.completion generic generic.standard.engines.tuple sequences tools.completion tools.vocabs.browser generic
fonts ui.commands ui.operations ui.gadgets ui.gadgets.editors generic.standard.engines.tuple fonts ui.commands ui.operations
ui.gadgets.glass ui.gadgets.scrollers ui.gadgets.tables ui.gadgets ui.gadgets.editors ui.gadgets.glass ui.gadgets.scrollers
ui.gadgets.tables ui.gadgets.tracks ui.gadgets.labelled
ui.gadgets.theme ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.gadgets.theme ui.gadgets.worlds ui.gadgets.wrappers ui.gestures
ui.render ui.tools.listener.history combinators ; ui.render ui.tools.listener.history combinators vocabs ;
IN: ui.tools.listener.completion IN: ui.tools.listener.completion
! We don't directly depend on the listener tool but we use a few slots
SLOT: completion-popup
SLOT: interactor
SLOT: history
: history-list ( interactor -- alist )
history>> elements>>
[ dup string>> { { CHAR: \n CHAR: \s } } substitute ] { } map>assoc
<reversed> ;
TUPLE: word-completion vocabs ;
C: <word-completion> word-completion
SINGLETONS: vocab-completion char-completion history-completion ;
UNION: listener-completion word-completion vocab-completion char-completion history-completion ;
GENERIC: completion-quot ( interactor completion-mode -- quot )
M: word-completion completion-quot 2drop [ [ { } ] [ words-matching ] if-empty ] ;
M: vocab-completion completion-quot 2drop [ [ { } ] [ vocabs-matching ] if-empty ] ;
M: char-completion completion-quot 2drop [ [ { } ] [ chars-matching ] if-empty ] ;
M: history-completion completion-quot drop '[ drop _ history-list ] ;
GENERIC: completion-element ( completion-mode -- element )
M: object completion-element drop one-word-elt ;
M: history-completion completion-element drop one-line-elt ;
GENERIC: completion-banner ( completion-mode -- string )
M: word-completion completion-banner drop "Words:" ;
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:" ;
! Completion modes also implement the row renderer protocol
M: listener-completion row-columns drop present 1array ;
M: word-completion row-color
[ vocabulary>> ] [ vocabs>> ] bi* {
{ [ 2dup [ vocab-words ] dip memq? ] [ COLOR: black ] }
{ [ over ".private" tail? ] [ COLOR: dark-red ] }
[ COLOR: dark-gray ]
} cond 2nip ;
M: vocab-completion row-color
drop vocab? COLOR: black COLOR: dark-gray ? ;
: complete-IN:/USE:? ( tokens -- ? ) : complete-IN:/USE:? ( tokens -- ? )
2 short tail* { "IN:" "USE:" } intersects? ; 2 short tail* { "IN:" "USE:" } intersects? ;
@ -25,34 +75,25 @@ IN: ui.tools.listener.completion
: up-to-caret ( caret document -- string ) : up-to-caret ( caret document -- string )
[ { 0 0 } ] 2dip doc-range ; [ { 0 0 } ] 2dip doc-range ;
SINGLETONS: word-completion vocab-completion char-completion ;
: completion-mode ( interactor -- symbol ) : completion-mode ( interactor -- symbol )
[ editor-caret ] [ model>> ] bi up-to-caret " \r\n" split [ vocabs>> ] [ editor-caret ] [ model>> ] tri up-to-caret " \r\n" split
{ {
{ [ dup { [ complete-IN:/USE:? ] [ complete-USING:? ] } 1|| ] [ drop vocab-completion ] } { [ dup { [ complete-IN:/USE:? ] [ complete-USING:? ] } 1|| ] [ 2drop vocab-completion ] }
{ [ dup complete-CHAR:? ] [ drop char-completion ] } { [ dup complete-CHAR:? ] [ 2drop char-completion ] }
[ drop word-completion ] [ drop <word-completion> ]
} cond ; } cond ;
! We don't directly depend on the listener tool but we use a few slots TUPLE: completion-popup < track table interactor completion-mode ;
SLOT: completion-popup
SLOT: interactor
SLOT: history
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 ;
SINGLETON: completion-renderer : <completion-model> ( editor element quot -- model )
M: completion-renderer row-columns drop present 1array ; [ <element-model> 1/3 seconds <delay> ] dip
M: completion-renderer row-value drop ;
: <completion-model> ( editor quot -- model )
[ one-word-elt <element-model> 1/3 seconds <delay> ] dip
'[ @ keys 1000 short head ] <filter> ; '[ @ keys 1000 short head ] <filter> ;
M: completion-popup focusable-child* table>> ;
M: completion-popup hide-glass-hook M: completion-popup hide-glass-hook
interactor>> f >>completion-popup request-focus ; interactor>> f >>completion-popup request-focus ;
@ -86,11 +127,12 @@ GENERIC# accept-completion-hook 1 ( item popup -- )
[ nip hide-completion-popup ] [ nip hide-completion-popup ]
2tri ; 2tri ;
: <completion-table> ( interactor quot -- table ) : <completion-table> ( interactor completion-mode -- table )
<completion-model> <table> [ completion-element ] [ completion-quot ] [ nip ] 2tri
[ <completion-model> <table> ] dip
>>renderer
monospace-font >>font monospace-font >>font
t >>selection-required? t >>selection-required?
completion-renderer >>renderer
dup '[ _ accept-completion ] >>action ; dup '[ _ accept-completion ] >>action ;
: <completion-scroller> ( object -- object ) : <completion-scroller> ( object -- object )
@ -98,11 +140,12 @@ GENERIC# accept-completion-hook 1 ( item popup -- )
{ 300 120 } >>min-dim { 300 120 } >>min-dim
{ 300 120 } >>max-dim ; { 300 120 } >>max-dim ;
: <completion-popup> ( interactor quot -- popup ) : <completion-popup> ( interactor completion-mode -- popup )
[ completion-popup new-gadget ] 2dip [ vertical completion-popup new-track ] 2dip
[ drop >>interactor ] [ <completion-table> >>table ] 2bi [ [ >>interactor ] [ >>completion-mode ] bi* ] [ <completion-table> >>table ] 2bi
dup table>> <completion-scroller> add-gadget dup [ table>> <completion-scroller> ] [ completion-mode>> completion-banner ] bi
white <solid> >>interior ; <labelled-gadget> 1 track-add
COLOR: white <solid> >>interior ;
completion-popup H{ completion-popup H{
{ T{ key-down f f "ESC" } [ hide-completion-popup ] } { T{ key-down f f "ESC" } [ hide-completion-popup ] }
@ -112,50 +155,43 @@ completion-popup H{
CONSTANT: completion-popup-offset { -4 0 } CONSTANT: completion-popup-offset { -4 0 }
: (completion-popup-loc) ( interactor element -- loc ) : (completion-popup-loc) ( interactor completion-mode -- loc )
[ drop screen-loc ] [ [ drop screen-loc ] [
[ [ [ editor-caret ] [ model>> ] bi ] dip prev-elt ] [ drop ] 2bi [
[ [ editor-caret ] [ model>> ] bi ] dip
completion-element prev-elt
] [ drop ] 2bi
loc>point loc>point
] 2bi v+ completion-popup-offset v+ ; ] 2bi v+ completion-popup-offset v+ ;
: completion-popup-loc-1 ( interactor element -- loc ) : completion-popup-loc-1 ( interactor completion-mode -- loc )
[ (completion-popup-loc) ] [ drop caret-dim ] 2bi v+ ; [ (completion-popup-loc) ] [ drop caret-dim ] 2bi v+ ;
: completion-popup-loc-2 ( interactor element popup -- loc ) : completion-popup-loc-2 ( interactor completion-mode popup -- loc )
[ (completion-popup-loc) ] dip pref-dim { 0 1 } v* v- ; [ (completion-popup-loc) ] dip pref-dim { 0 1 } v* v- ;
: completion-popup-fits? ( interactor element popup -- ? ) : completion-popup-fits? ( interactor completion-mode popup -- ? )
[ [ completion-popup-loc-1 ] dip pref-dim v+ ] [ [ completion-popup-loc-1 ] dip pref-dim v+ ]
[ 2drop find-world dim>> ] [ 2drop find-world dim>> ]
3bi [ second ] bi@ <= ; 3bi [ second ] bi@ <= ;
: completion-popup-loc ( interactor element popup -- loc ) : completion-popup-loc ( interactor completion-mode popup -- loc )
3dup completion-popup-fits? 3dup completion-popup-fits?
[ drop completion-popup-loc-1 ] [ drop completion-popup-loc-1 ]
[ completion-popup-loc-2 ] [ completion-popup-loc-2 ]
if ; if ;
: show-completion-popup ( interactor quot element -- ) : show-completion-popup ( interactor completion-mode -- )
[ nip ] [ drop <completion-popup> ] 3bi 2dup <completion-popup>
[ nip >>completion-popup drop ] [ nip >>completion-popup drop ]
[ [ 2drop find-world ] [ 2nip ] [ completion-popup-loc ] 3tri ] 3bi [ [ 2drop find-world ] [ 2nip ] [ completion-popup-loc ] 3tri ] 3bi
show-glass ; show-glass ;
: code-completion-popup ( interactor -- ) : code-completion-popup ( interactor -- )
dup completion-mode { dup completion-mode show-completion-popup ;
{ word-completion [ words-matching ] }
{ vocab-completion [ vocabs-matching ] }
{ char-completion [ chars-matching ] }
} at '[ [ { } ] _ if-empty ]
one-word-elt show-completion-popup ;
: history-matching ( interactor -- alist )
history>> elements>>
[ dup string>> { { CHAR: \n CHAR: \s } } substitute ] { } map>assoc
<reversed> ;
: history-completion-popup ( interactor -- ) : history-completion-popup ( interactor -- )
dup '[ drop _ history-matching ] one-line-elt show-completion-popup ; history-completion show-completion-popup ;
: recall-previous ( interactor -- ) : recall-previous ( interactor -- )
history>> history-recall-previous ; history>> history-recall-previous ;

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

@ -35,7 +35,9 @@ completion-popup ;
[ thread>> dup [ thread-registered? ] when ] [ thread>> dup [ thread-registered? ] when ]
bi and not ; bi and not ;
: interactor-use ( interactor -- seq ) SLOT: vocabs
M: interactor vocabs>>
dup interactor-busy? [ drop f ] [ dup interactor-busy? [ drop f ] [
use swap use swap
interactor-continuation name>> interactor-continuation name>>
@ -45,12 +47,19 @@ completion-popup ;
: vocab-exists? ( name -- ? ) : vocab-exists? ( name -- ? )
{ [ vocab ] [ find-vocab-root ] } 1|| ; { [ vocab ] [ find-vocab-root ] } 1|| ;
: word-at-caret ( token interactor -- word/vocab/f ) GENERIC: (word-at-caret) ( token completion-mode -- obj )
dup completion-mode {
{ vocab-completion [ drop dup vocab-exists? [ >vocab-link ] [ drop f ] if ] } M: vocab-completion (word-at-caret)
{ word-completion [ interactor-use assoc-stack ] } drop dup vocab-exists? [ >vocab-link ] [ drop f ] if ;
{ char-completion [ 2drop f ] }
} case ; M: word-completion (word-at-caret)
vocabs>> assoc-stack ;
M: char-completion (word-at-caret)
2drop f ;
: word-at-caret ( token interactor -- obj )
completion-mode (word-at-caret) ;
: <word-model> ( interactor -- model ) : <word-model> ( interactor -- model )
[ token-model>> 1/3 seconds <delay> ] [ token-model>> 1/3 seconds <delay> ]
@ -280,7 +289,7 @@ M: listener-operation invoke-command ( target command -- )
] [ 2drop ] if ; ] [ 2drop ] if ;
M: word accept-completion-hook M: word accept-completion-hook
interactor>> interactor-use use-if-necessary ; interactor>> vocabs>> use-if-necessary ;
M: object accept-completion-hook 2drop ; M: object accept-completion-hook 2drop ;