Overhaul UI listener history code; C-p, C-n cycles through history, C-r displays list
Slava Pestov
parent
a1338e75d2
commit
c89b68d295
|
|
@ -81,20 +81,20 @@ M: editor ungraft*
|
|||
dup caret>> deactivate-editor-model
|
||||
dup mark>> deactivate-editor-model ;
|
||||
|
||||
: editor-caret* ( editor -- loc ) caret>> value>> ;
|
||||
: editor-caret ( editor -- loc ) caret>> value>> ;
|
||||
|
||||
: editor-mark* ( editor -- loc ) mark>> value>> ;
|
||||
: editor-mark ( editor -- loc ) mark>> value>> ;
|
||||
|
||||
: set-caret ( loc editor -- )
|
||||
[ model>> validate-loc ] keep
|
||||
caret>> set-model ;
|
||||
|
||||
: change-caret ( editor quot -- )
|
||||
[ [ [ editor-caret* ] [ model>> ] bi ] dip call ] [ drop ] 2bi
|
||||
[ [ [ editor-caret ] [ model>> ] bi ] dip call ] [ drop ] 2bi
|
||||
set-caret ; inline
|
||||
|
||||
: mark>caret ( editor -- )
|
||||
[ editor-caret* ] [ mark>> ] bi set-model ;
|
||||
[ editor-caret ] [ mark>> ] bi set-model ;
|
||||
|
||||
: change-caret&mark ( editor quot -- )
|
||||
[ change-caret ] [ drop mark>caret ] 2bi ; inline
|
||||
|
|
@ -150,7 +150,7 @@ M: editor ungraft*
|
|||
[ loc>x ] [ [ first ] dip line>y ] 2bi 2array ;
|
||||
|
||||
: caret-loc ( editor -- loc )
|
||||
[ editor-caret* ] keep loc>point ;
|
||||
[ editor-caret ] keep loc>point ;
|
||||
|
||||
: caret-dim ( editor -- dim )
|
||||
line-height 0 swap 2array ;
|
||||
|
|
@ -220,7 +220,7 @@ M: editor ungraft*
|
|||
] with-editor-translation ;
|
||||
|
||||
: selection-start/end ( editor -- start end )
|
||||
[ editor-mark* ] [ editor-caret* ] bi sort-pair ;
|
||||
[ editor-mark ] [ editor-caret ] bi sort-pair ;
|
||||
|
||||
: (draw-selection) ( x1 x2 -- )
|
||||
over -
|
||||
|
|
@ -298,7 +298,7 @@ M: editor gadget-text* editor-string % ;
|
|||
} at one-line-elt or ;
|
||||
|
||||
: drag-direction? ( loc editor -- ? )
|
||||
editor-mark* before? ;
|
||||
editor-mark before? ;
|
||||
|
||||
: drag-selection-caret ( loc editor element -- loc )
|
||||
[
|
||||
|
|
@ -308,7 +308,7 @@ M: editor gadget-text* editor-string % ;
|
|||
: drag-selection-mark ( loc editor element -- loc )
|
||||
[
|
||||
[ drag-direction? not ] keep
|
||||
[ editor-mark* ] [ model>> ] bi
|
||||
[ editor-mark ] [ model>> ] bi
|
||||
] dip prev/next-elt ? ;
|
||||
|
||||
: drag-caret&mark ( editor -- caret mark )
|
||||
|
|
@ -328,7 +328,7 @@ M: editor gadget-text* editor-string % ;
|
|||
over gadget-selection? [
|
||||
drop remove-selection
|
||||
] [
|
||||
[ [ [ editor-caret* ] [ model>> ] bi ] dip call ]
|
||||
[ [ [ editor-caret ] [ model>> ] bi ] dip call ]
|
||||
[ drop model>> ]
|
||||
2bi remove-doc-range
|
||||
] if ; inline
|
||||
|
|
@ -355,7 +355,7 @@ M: editor gadget-text* editor-string % ;
|
|||
tuck caret>> set-model mark>> set-model ;
|
||||
|
||||
: select-elt ( editor elt -- )
|
||||
[ [ [ editor-caret* ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi
|
||||
[ [ [ editor-caret ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi
|
||||
editor-select ;
|
||||
|
||||
: start-of-document ( editor -- ) doc-elt editor-prev ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test ui.tools.listener.completion ;
|
||||
IN: ui.tools.listener.completion.tests
|
||||
|
|
@ -0,0 +1,140 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs calendar colors documents fry kernel
|
||||
sets splitting math math.vectors models.delay models.filter
|
||||
combinators.short-circuit parser present sequences tools.completion
|
||||
ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.glass
|
||||
ui.gadgets.scrollers ui.gadgets.tables
|
||||
ui.gadgets.theme ui.gadgets.worlds ui.gadgets.wrappers ui.gestures
|
||||
ui.render ui.tools.listener.history ;
|
||||
IN: ui.tools.listener.completion
|
||||
|
||||
: complete-IN:/USE:? ( tokens -- ? )
|
||||
2 short tail* { "IN:" "USE:" } intersects? ;
|
||||
|
||||
: chop-; ( seq -- seq' )
|
||||
{ ";" } split1-last [ ] [ ] ?if ;
|
||||
|
||||
: complete-USING:? ( tokens -- ? )
|
||||
chop-; { "USING:" } intersects? ;
|
||||
|
||||
: up-to-caret ( caret document -- string )
|
||||
[ { 0 0 } ] 2dip doc-range ;
|
||||
|
||||
: vocab-completion? ( interactor -- ? )
|
||||
[ editor-caret ] [ model>> ] bi up-to-caret " \r\n" split
|
||||
{ [ complete-IN:/USE:? ] [ complete-USING:? ] } 1|| ;
|
||||
|
||||
! We don't directly depend on the listener tool but we use a couple
|
||||
! of slots
|
||||
SLOT: interactor
|
||||
SLOT: history
|
||||
|
||||
TUPLE: completion-popup < wrapper table interactor element ;
|
||||
|
||||
: find-completion-popup ( gadget -- popup )
|
||||
[ completion-popup? ] find-parent ;
|
||||
|
||||
SINGLETON: completion-renderer
|
||||
M: completion-renderer row-columns drop present 1array ;
|
||||
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> ;
|
||||
|
||||
M: completion-popup hide-glass-hook
|
||||
interactor>> f >>completion-popup request-focus ;
|
||||
|
||||
: hide-completion-popup ( popup -- )
|
||||
find-world hide-glass ;
|
||||
|
||||
: completion-loc/doc ( popup -- loc doc )
|
||||
interactor>> [ editor-caret ] [ model>> ] bi ;
|
||||
|
||||
: accept-completion ( item table -- )
|
||||
find-completion-popup
|
||||
[ [ present ] [ completion-loc/doc ] bi* one-word-elt set-elt-string ]
|
||||
[ hide-completion-popup ]
|
||||
bi ;
|
||||
|
||||
: <completion-table> ( interactor quot -- table )
|
||||
<completion-model> <table>
|
||||
monospace-font >>font
|
||||
t >>selection-required?
|
||||
completion-renderer >>renderer
|
||||
dup '[ _ accept-completion ] >>action ;
|
||||
|
||||
: <completion-scroller> ( object -- object )
|
||||
<limited-scroller>
|
||||
{ 300 120 } >>min-dim
|
||||
{ 300 120 } >>max-dim ;
|
||||
|
||||
: <completion-popup> ( interactor quot -- popup )
|
||||
[ completion-popup new-gadget ] 2dip
|
||||
[ drop >>interactor ] [ <completion-table> >>table ] 2bi
|
||||
dup table>> <completion-scroller> add-gadget
|
||||
white <solid> >>interior ;
|
||||
|
||||
completion-popup H{
|
||||
{ T{ key-down f f "ESC" } [ hide-completion-popup ] }
|
||||
{ T{ key-down f f "TAB" } [ table>> row-action ] }
|
||||
{ T{ key-down f f " " } [ table>> row-action ] }
|
||||
} set-gestures
|
||||
|
||||
CONSTANT: completion-popup-offset { -4 0 }
|
||||
|
||||
: (completion-popup-loc) ( interactor element -- loc )
|
||||
[ drop screen-loc ] [
|
||||
[ [ [ editor-caret ] [ model>> ] bi ] dip prev-elt ] [ drop ] 2bi
|
||||
loc>point
|
||||
] 2bi v+ completion-popup-offset v+ ;
|
||||
|
||||
: completion-popup-loc-1 ( interactor element -- loc )
|
||||
[ (completion-popup-loc) ] [ drop caret-dim ] 2bi v+ ;
|
||||
|
||||
: completion-popup-loc-2 ( interactor element popup -- loc )
|
||||
[ (completion-popup-loc) ] dip pref-dim { 0 1 } v* v- ;
|
||||
|
||||
: completion-popup-fits? ( interactor element popup -- ? )
|
||||
[ [ completion-popup-loc-1 ] dip pref-dim v+ ]
|
||||
[ 2drop find-world dim>> ]
|
||||
3bi [ second ] bi@ <= ;
|
||||
|
||||
: completion-popup-loc ( interactor element popup -- loc )
|
||||
3dup completion-popup-fits?
|
||||
[ drop completion-popup-loc-1 ]
|
||||
[ completion-popup-loc-2 ]
|
||||
if ;
|
||||
|
||||
: show-completion-popup ( interactor quot element -- )
|
||||
[ nip ] [ drop <completion-popup> ] 3bi
|
||||
[ nip >>completion-popup drop ]
|
||||
[ [ 2drop find-world ] [ 2nip ] [ completion-popup-loc ] 3tri ] 3bi
|
||||
show-glass ;
|
||||
|
||||
: word-completion-popup ( interactor -- )
|
||||
dup vocab-completion?
|
||||
[ vocabs-matching ] [ words-matching ] ? '[ [ { } ] _ 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 -- )
|
||||
dup '[ drop _ history-matching ] one-line-elt show-completion-popup ;
|
||||
|
||||
: recall-previous ( interactor -- )
|
||||
history>> history-recall-previous ;
|
||||
|
||||
: recall-next ( interactor -- )
|
||||
history>> history-recall-next ;
|
||||
|
||||
: selected-word ( editor -- word )
|
||||
dup completion-popup>> [
|
||||
[ table>> selected-row drop ] [ hide-completion-popup ] bi
|
||||
] [
|
||||
selected-token dup search [ ] [ no-word ] ?if
|
||||
] ?if ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: documents namespaces tools.test io.styles
|
||||
ui.tools.listener.history kernel ;
|
||||
IN: ui.tools.listener.history.tests
|
||||
|
||||
[ ] [ <document> "d" set ] unit-test
|
||||
[ ] [ "d" get <history> "h" set ] unit-test
|
||||
|
||||
[ ] [ "1" "d" get set-doc-string ] unit-test
|
||||
[ T{ input f "1" } ] [ "h" get history-add ] unit-test
|
||||
|
||||
[ ] [ "2" "d" get set-doc-string ] unit-test
|
||||
[ T{ input f "2" } ] [ "h" get history-add ] unit-test
|
||||
|
||||
[ ] [ "3" "d" get set-doc-string ] unit-test
|
||||
[ T{ input f "3" } ] [ "h" get history-add ] unit-test
|
||||
|
||||
[ ] [ "" "d" get set-doc-string ] unit-test
|
||||
|
||||
[ ] [ "h" get history-recall-previous ] unit-test
|
||||
[ "3" ] [ "d" get doc-string ] unit-test
|
||||
|
||||
[ ] [ "h" get history-recall-previous ] unit-test
|
||||
[ "2" ] [ "d" get doc-string ] unit-test
|
||||
|
||||
[ ] [ "h" get history-recall-previous ] unit-test
|
||||
[ "1" ] [ "d" get doc-string ] unit-test
|
||||
|
||||
[ ] [ "h" get history-recall-previous ] unit-test
|
||||
[ "1" ] [ "d" get doc-string ] unit-test
|
||||
|
||||
[ ] [ "h" get history-recall-next ] unit-test
|
||||
[ "2" ] [ "d" get doc-string ] unit-test
|
||||
|
||||
[ ] [ "22" "d" get set-doc-string ] unit-test
|
||||
|
||||
[ ] [ "h" get history-recall-next ] unit-test
|
||||
[ "3" ] [ "d" get doc-string ] unit-test
|
||||
|
||||
[ ] [ "h" get history-recall-previous ] unit-test
|
||||
[ "22" ] [ "d" get doc-string ] unit-test
|
||||
|
||||
[ ] [ "h" get history-recall-previous ] unit-test
|
||||
[ "1" ] [ "d" get doc-string ] unit-test
|
||||
|
||||
[ ] [ "222" "d" get set-doc-string ] unit-test
|
||||
[ T{ input f "222" } ] [ "h" get history-add ] unit-test
|
||||
|
||||
[ ] [ "h" get history-recall-previous ] unit-test
|
||||
[ ] [ "h" get history-recall-previous ] unit-test
|
||||
[ ] [ "h" get history-recall-previous ] unit-test
|
||||
|
||||
[ "22" ] [ "d" get doc-string ] unit-test
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors documents io.styles kernel math math.order
|
||||
sequences fry ;
|
||||
IN: ui.tools.listener.history
|
||||
|
||||
TUPLE: history document elements index ;
|
||||
|
||||
: <history> ( document -- history )
|
||||
V{ } clone 0 history boa ;
|
||||
|
||||
: history-add ( history -- input )
|
||||
dup elements>> length 1+ >>index
|
||||
[ document>> doc-string [ <input> ] [ empty? ] bi ] keep
|
||||
'[ [ _ elements>> push ] keep ] unless ;
|
||||
|
||||
: save-history ( history -- )
|
||||
[ document>> doc-string ] keep
|
||||
'[ <input> _ [ index>> ] [ elements>> ] bi set-nth ]
|
||||
unless-empty ;
|
||||
|
||||
: update-document ( history -- )
|
||||
[ [ index>> ] [ elements>> ] bi nth string>> ]
|
||||
[ document>> ] bi
|
||||
set-doc-string ;
|
||||
|
||||
: change-history-index ( history i -- )
|
||||
over elements>> length 1-
|
||||
'[ _ + _ min 0 max ] change-index drop ;
|
||||
|
||||
: history-recall ( history i -- )
|
||||
[ [ elements>> empty? ] keep ] dip '[
|
||||
_
|
||||
[ save-history ]
|
||||
[ _ change-history-index ]
|
||||
[ update-document ]
|
||||
tri
|
||||
] unless ;
|
||||
|
||||
: history-recall-previous ( history -- )
|
||||
-1 history-recall ;
|
||||
|
||||
: history-recall-next ( history -- )
|
||||
1 history-recall ;
|
||||
|
|
@ -1,20 +1,18 @@
|
|||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: inspector kernel help help.markup io io.styles models math.vectors
|
||||
strings splitting namespaces parser quotations sequences vocabs words
|
||||
continuations prettyprint listener debugger threads boxes
|
||||
concurrency.flags math arrays generic accessors combinators
|
||||
combinators.short-circuit combinators.smart
|
||||
assocs fry generic.standard.engines.tuple
|
||||
tools.vocabs concurrency.mailboxes vocabs.parser calendar
|
||||
models.delay models.filter documents hashtables sets destructors lexer
|
||||
ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.labelled
|
||||
ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
|
||||
ui.gadgets.packs ui.gadgets.tracks ui.gadgets.borders
|
||||
ui.gadgets.frames ui.gadgets.grids ui.gadgets.status-bar
|
||||
ui.gadgets.viewports ui.gadgets.wrappers ui.gestures ui.operations
|
||||
ui.tools.browser ui.tools.debugger ui.gadgets.theme
|
||||
ui.tools.inspector ui.tools.common ui ;
|
||||
USING: accessors arrays assocs calendar combinators
|
||||
combinators.short-circuit compiler.units concurrency.flags
|
||||
concurrency.mailboxes continuations destructors documents fry generic
|
||||
generic.standard.engines.tuple hashtables help help.markup io
|
||||
io.styles kernel lexer listener math models models.delay models.filter
|
||||
namespaces parser prettyprint quotations sequences strings threads
|
||||
tools.vocabs ui ui.commands ui.gadgets ui.gadgets.buttons
|
||||
ui.gadgets.editors ui.gadgets.frames ui.gadgets.grids
|
||||
ui.gadgets.labelled ui.gadgets.panes ui.gadgets.scrollers
|
||||
ui.gadgets.status-bar ui.gadgets.tracks ui.gestures ui.operations
|
||||
ui.tools.browser ui.tools.common ui.tools.debugger
|
||||
ui.tools.listener.completion ui.tools.listener.history vocabs
|
||||
vocabs.parser words ;
|
||||
IN: ui.tools.listener
|
||||
|
||||
! If waiting is t, we're waiting for user input, and invoking
|
||||
|
|
@ -44,22 +42,6 @@ completion-popup ;
|
|||
assoc-stack
|
||||
] if ;
|
||||
|
||||
: complete-IN:/USE:? ( tokens -- ? )
|
||||
2 short tail* { "IN:" "USE:" } intersects? ;
|
||||
|
||||
: chop-; ( seq -- seq' )
|
||||
{ ";" } split1-last [ ] [ ] ?if ;
|
||||
|
||||
: complete-USING:? ( tokens -- ? )
|
||||
chop-; { "USING:" } intersects? ;
|
||||
|
||||
: up-to-caret ( caret document -- string )
|
||||
[ { 0 0 } ] 2dip doc-range ;
|
||||
|
||||
: vocab-completion? ( interactor -- ? )
|
||||
[ editor-caret ] [ model>> ] bi up-to-caret " \r\n" split
|
||||
{ [ complete-IN:/USE:? ] [ complete-USING:? ] } 1|| ;
|
||||
|
||||
: <word-model> ( interactor -- model )
|
||||
[ one-word-elt <element-model> 1/3 seconds <delay> ] keep
|
||||
'[
|
||||
|
|
@ -69,9 +51,9 @@ completion-popup ;
|
|||
|
||||
: <interactor> ( output -- gadget )
|
||||
interactor new-editor
|
||||
V{ } clone >>history
|
||||
<flag> >>flag
|
||||
dup <word-model> >>help
|
||||
dup model>> <history> >>history
|
||||
swap >>output ;
|
||||
|
||||
M: interactor graft*
|
||||
|
|
@ -98,18 +80,12 @@ M: object (print-input)
|
|||
: print-input ( object interactor -- )
|
||||
output>> [ (print-input) ] with-output-stream* ;
|
||||
|
||||
: add-interactor-history ( input interactor -- )
|
||||
over string>> empty? [ 2drop ] [ history>> adjoin ] if ;
|
||||
|
||||
: interactor-continue ( obj interactor -- )
|
||||
mailbox>> mailbox-put ;
|
||||
|
||||
: interactor-finish ( interactor -- )
|
||||
[ editor-string <input> ] keep
|
||||
[ print-input ]
|
||||
[ add-interactor-history ]
|
||||
[ clear-editor drop ]
|
||||
2tri ;
|
||||
[ history>> history-add ] keep
|
||||
[ print-input ] [ clear-editor drop ] 2bi ;
|
||||
|
||||
: interactor-eof ( interactor -- )
|
||||
dup interactor-busy? [
|
||||
|
|
@ -304,10 +280,8 @@ M: engine-word word-completion-string method-completion-string ;
|
|||
2bi ;
|
||||
|
||||
: quot-action ( interactor -- lines )
|
||||
[ [ editor-string <input> ] keep add-interactor-history ]
|
||||
[ control-value ]
|
||||
[ select-all ]
|
||||
tri ;
|
||||
[ history>> history-add drop ] [ control-value ] [ select-all ] tri
|
||||
[ parse-lines ] with-compilation-unit ;
|
||||
|
||||
: hide-popup ( listener -- )
|
||||
dup popup>> track-remove
|
||||
|
|
@ -358,11 +332,30 @@ M: interactor stream-read-quot
|
|||
]
|
||||
} cond ;
|
||||
|
||||
: pass-to-popup? ( gesture interactor -- ? )
|
||||
[ [ key-down? ] [ key-up? ] bi or ]
|
||||
[ completion-popup>> ]
|
||||
bi* and ;
|
||||
|
||||
M: interactor handle-gesture
|
||||
2dup pass-to-popup? [
|
||||
2dup completion-popup>>
|
||||
focusable-child resend-gesture
|
||||
[ call-next-method ] [ 2drop f ] if
|
||||
] [ call-next-method ] if ;
|
||||
|
||||
interactor "interactor" f {
|
||||
{ T{ key-down f f "RET" } evaluate-input }
|
||||
{ T{ key-down f { C+ } "k" } clear-editor }
|
||||
} define-command-map
|
||||
|
||||
interactor "completion" f {
|
||||
{ T{ key-down f f "TAB" } word-completion-popup }
|
||||
{ T{ key-down f { C+ } "p" } recall-previous }
|
||||
{ T{ key-down f { C+ } "n" } recall-next }
|
||||
{ T{ key-down f { C+ } "r" } history-completion-popup }
|
||||
} define-command-map
|
||||
|
||||
: welcome. ( -- )
|
||||
"If this is your first time with Factor, please read the " print
|
||||
"handbook" ($link) ". To see a list of keyboard shortcuts," print
|
||||
|
|
@ -436,133 +429,4 @@ M: listener-gadget graft*
|
|||
[ call-next-method ] [ restart-listener ] bi ;
|
||||
|
||||
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
|
||||
present ;
|
||||
USE: tools.completion
|
||||
|
||||
: <summary-gadget> ( model -- gadget )
|
||||
[ summary ] <filter> <label-control> ;
|
||||
|
||||
TUPLE: completion-popup < wrapper table interactor element ;
|
||||
|
||||
: find-completion-popup ( gadget -- popup )
|
||||
[ completion-popup? ] find-parent ;
|
||||
|
||||
SINGLETON: completion-renderer
|
||||
M: completion-renderer row-columns drop present 1array ;
|
||||
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> ;
|
||||
|
||||
M: completion-popup hide-glass-hook
|
||||
interactor>> f >>completion-popup request-focus ;
|
||||
|
||||
: hide-completion-popup ( popup -- )
|
||||
find-world hide-glass ;
|
||||
|
||||
: completion-loc/doc ( popup -- loc doc )
|
||||
interactor>> [ editor-caret ] [ model>> ] bi ;
|
||||
|
||||
: accept-completion ( item table -- )
|
||||
find-completion-popup
|
||||
[ [ present ] [ completion-loc/doc ] bi* one-word-elt set-elt-string ]
|
||||
[ hide-completion-popup ]
|
||||
bi ;
|
||||
|
||||
: <completion-table> ( interactor quot -- table )
|
||||
<completion-model> <table>
|
||||
monospace-font >>font
|
||||
t >>selection-required?
|
||||
completion-renderer >>renderer
|
||||
dup '[ _ accept-completion ] >>action ;
|
||||
|
||||
: <completion-scroller> ( object -- object )
|
||||
<limited-scroller>
|
||||
{ 300 120 } >>min-dim
|
||||
{ 300 120 } >>max-dim ;
|
||||
|
||||
: <completion-popup> ( interactor quot -- popup )
|
||||
[ completion-popup new-gadget ] 2dip
|
||||
[ drop >>interactor ] [ <completion-table> >>table ] 2bi
|
||||
dup table>> <completion-scroller> add-gadget
|
||||
white <solid> >>interior ;
|
||||
|
||||
completion-popup H{
|
||||
{ T{ key-down f f "ESC" } [ hide-completion-popup ] }
|
||||
{ T{ key-down f f "TAB" } [ table>> row-action ] }
|
||||
{ T{ key-down f f " " } [ table>> row-action ] }
|
||||
} set-gestures
|
||||
|
||||
CONSTANT: completion-popup-offset { -4 0 }
|
||||
|
||||
: (completion-popup-loc) ( interactor element -- loc )
|
||||
[ drop screen-loc ] [
|
||||
[ [ [ editor-caret ] [ model>> ] bi ] dip prev-elt ] [ drop ] 2bi
|
||||
loc>point
|
||||
] 2bi v+ completion-popup-offset v+ ;
|
||||
|
||||
: completion-popup-loc-1 ( interactor element -- loc )
|
||||
[ (completion-popup-loc) ] [ drop caret-dim ] 2bi v+ ;
|
||||
|
||||
: completion-popup-loc-2 ( interactor element popup -- loc )
|
||||
[ (completion-popup-loc) ] dip pref-dim { 0 1 } v* v- ;
|
||||
|
||||
: completion-popup-fits? ( interactor element popup -- ? )
|
||||
[ [ completion-popup-loc-1 ] dip pref-dim v+ ]
|
||||
[ 2drop find-world dim>> ]
|
||||
3bi [ second ] bi@ <= ;
|
||||
|
||||
: completion-popup-loc ( interactor element popup -- loc )
|
||||
3dup completion-popup-fits?
|
||||
[ drop completion-popup-loc-1 ]
|
||||
[ completion-popup-loc-2 ]
|
||||
if ;
|
||||
|
||||
: show-completion-popup ( interactor quot element -- )
|
||||
[ nip ] [ drop <completion-popup> ] 3bi
|
||||
[ nip >>completion-popup drop ]
|
||||
[ [ 2drop find-world ] [ 2nip ] [ completion-popup-loc ] 3tri ] 3bi
|
||||
show-glass ;
|
||||
|
||||
: word-completion-popup ( interactor -- )
|
||||
dup vocab-completion?
|
||||
[ vocabs-matching ] [ words-matching ] ? '[ [ { } ] _ if-empty ]
|
||||
one-word-elt show-completion-popup ;
|
||||
|
||||
: history-matching ( interactor -- alist )
|
||||
history>>
|
||||
[ dup string>> { { CHAR: \n CHAR: \s } } substitute ] { } map>assoc
|
||||
<reversed> ;
|
||||
|
||||
: history-completion-popup ( interactor -- )
|
||||
dup '[ drop _ history-matching ] one-line-elt show-completion-popup ;
|
||||
|
||||
: pass-to-popup? ( gesture interactor -- ? )
|
||||
[ [ key-down? ] [ key-up? ] bi or ]
|
||||
[ completion-popup>> ]
|
||||
bi* and ;
|
||||
|
||||
M: interactor handle-gesture
|
||||
2dup pass-to-popup? [
|
||||
2dup completion-popup>>
|
||||
focusable-child resend-gesture
|
||||
[ call-next-method ] [ 2drop f ] if
|
||||
] [ call-next-method ] if ;
|
||||
|
||||
: selected-word ( editor -- word )
|
||||
dup completion-popup>> [
|
||||
[ table>> selected-row drop ] [ hide-completion-popup ] bi
|
||||
] [
|
||||
selected-token dup search [ ] [ no-word ] ?if
|
||||
] ?if ;
|
||||
|
||||
interactor "completion" f {
|
||||
{ T{ key-down f f "TAB" } word-completion-popup }
|
||||
{ T{ key-down f { C+ } "p" } history-completion-popup }
|
||||
} define-command-map
|
||||
[ com-end ] [ call-next-method ] bi ;
|
||||
|
|
@ -140,12 +140,10 @@ M: word com-stack-effect def>> com-stack-effect ;
|
|||
} define-operation
|
||||
|
||||
[ vocab-spec? ] \ run H{
|
||||
{ +keyboard+ T{ key-down f { C+ } "r" } }
|
||||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
||||
[ vocab? ] \ test H{
|
||||
{ +keyboard+ T{ key-down f { C+ } "t" } }
|
||||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
||||
|
|
@ -170,12 +168,10 @@ M: word com-stack-effect def>> com-stack-effect ;
|
|||
: com-profile ( quot -- ) profile profiler-window ;
|
||||
|
||||
[ quotation? ] \ com-profile H{
|
||||
{ +keyboard+ T{ key-down f { C+ } "r" } }
|
||||
{ +keyboard+ T{ key-down f { C+ } "f" } }
|
||||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
||||
USE: ui.gadgets.tables
|
||||
|
||||
! Operations -> commands
|
||||
source-editor
|
||||
"word"
|
||||
|
|
@ -188,5 +184,5 @@ interactor
|
|||
"quotation"
|
||||
"These commands operate on the entire contents of the input area."
|
||||
[ ]
|
||||
[ quot-action [ parse-lines ] with-compilation-unit ]
|
||||
[ quot-action ]
|
||||
define-operation-map
|
||||
|
|
|
|||
Loading…
Reference in New Issue