Overhaul UI listener history code; C-p, C-n cycles through history, C-r displays list
parent
a1338e75d2
commit
c89b68d295
|
@ -81,20 +81,20 @@ M: editor ungraft*
|
||||||
dup caret>> deactivate-editor-model
|
dup caret>> deactivate-editor-model
|
||||||
dup mark>> 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 -- )
|
: set-caret ( loc editor -- )
|
||||||
[ model>> validate-loc ] keep
|
[ model>> validate-loc ] keep
|
||||||
caret>> set-model ;
|
caret>> set-model ;
|
||||||
|
|
||||||
: change-caret ( editor quot -- )
|
: change-caret ( editor quot -- )
|
||||||
[ [ [ editor-caret* ] [ model>> ] bi ] dip call ] [ drop ] 2bi
|
[ [ [ editor-caret ] [ model>> ] bi ] dip call ] [ drop ] 2bi
|
||||||
set-caret ; inline
|
set-caret ; inline
|
||||||
|
|
||||||
: mark>caret ( editor -- )
|
: mark>caret ( editor -- )
|
||||||
[ editor-caret* ] [ mark>> ] bi set-model ;
|
[ editor-caret ] [ mark>> ] bi set-model ;
|
||||||
|
|
||||||
: change-caret&mark ( editor quot -- )
|
: change-caret&mark ( editor quot -- )
|
||||||
[ change-caret ] [ drop mark>caret ] 2bi ; inline
|
[ change-caret ] [ drop mark>caret ] 2bi ; inline
|
||||||
|
@ -150,7 +150,7 @@ M: editor ungraft*
|
||||||
[ loc>x ] [ [ first ] dip line>y ] 2bi 2array ;
|
[ loc>x ] [ [ first ] dip line>y ] 2bi 2array ;
|
||||||
|
|
||||||
: caret-loc ( editor -- loc )
|
: caret-loc ( editor -- loc )
|
||||||
[ editor-caret* ] keep loc>point ;
|
[ editor-caret ] keep loc>point ;
|
||||||
|
|
||||||
: caret-dim ( editor -- dim )
|
: caret-dim ( editor -- dim )
|
||||||
line-height 0 swap 2array ;
|
line-height 0 swap 2array ;
|
||||||
|
@ -220,7 +220,7 @@ M: editor ungraft*
|
||||||
] with-editor-translation ;
|
] with-editor-translation ;
|
||||||
|
|
||||||
: selection-start/end ( editor -- start end )
|
: selection-start/end ( editor -- start end )
|
||||||
[ editor-mark* ] [ editor-caret* ] bi sort-pair ;
|
[ editor-mark ] [ editor-caret ] bi sort-pair ;
|
||||||
|
|
||||||
: (draw-selection) ( x1 x2 -- )
|
: (draw-selection) ( x1 x2 -- )
|
||||||
over -
|
over -
|
||||||
|
@ -298,7 +298,7 @@ M: editor gadget-text* editor-string % ;
|
||||||
} at one-line-elt or ;
|
} at one-line-elt or ;
|
||||||
|
|
||||||
: drag-direction? ( loc editor -- ? )
|
: drag-direction? ( loc editor -- ? )
|
||||||
editor-mark* before? ;
|
editor-mark before? ;
|
||||||
|
|
||||||
: drag-selection-caret ( loc editor element -- loc )
|
: 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-selection-mark ( loc editor element -- loc )
|
||||||
[
|
[
|
||||||
[ drag-direction? not ] keep
|
[ drag-direction? not ] keep
|
||||||
[ editor-mark* ] [ model>> ] bi
|
[ editor-mark ] [ model>> ] bi
|
||||||
] dip prev/next-elt ? ;
|
] dip prev/next-elt ? ;
|
||||||
|
|
||||||
: drag-caret&mark ( editor -- caret mark )
|
: drag-caret&mark ( editor -- caret mark )
|
||||||
|
@ -328,7 +328,7 @@ M: editor gadget-text* editor-string % ;
|
||||||
over gadget-selection? [
|
over gadget-selection? [
|
||||||
drop remove-selection
|
drop remove-selection
|
||||||
] [
|
] [
|
||||||
[ [ [ editor-caret* ] [ model>> ] bi ] dip call ]
|
[ [ [ editor-caret ] [ model>> ] bi ] dip call ]
|
||||||
[ drop model>> ]
|
[ drop model>> ]
|
||||||
2bi remove-doc-range
|
2bi remove-doc-range
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
@ -355,7 +355,7 @@ M: editor gadget-text* editor-string % ;
|
||||||
tuck caret>> set-model mark>> set-model ;
|
tuck caret>> set-model mark>> set-model ;
|
||||||
|
|
||||||
: select-elt ( editor elt -- )
|
: 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 ;
|
editor-select ;
|
||||||
|
|
||||||
: start-of-document ( editor -- ) doc-elt editor-prev ;
|
: 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.
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: inspector kernel help help.markup io io.styles models math.vectors
|
USING: accessors arrays assocs calendar combinators
|
||||||
strings splitting namespaces parser quotations sequences vocabs words
|
combinators.short-circuit compiler.units concurrency.flags
|
||||||
continuations prettyprint listener debugger threads boxes
|
concurrency.mailboxes continuations destructors documents fry generic
|
||||||
concurrency.flags math arrays generic accessors combinators
|
generic.standard.engines.tuple hashtables help help.markup io
|
||||||
combinators.short-circuit combinators.smart
|
io.styles kernel lexer listener math models models.delay models.filter
|
||||||
assocs fry generic.standard.engines.tuple
|
namespaces parser prettyprint quotations sequences strings threads
|
||||||
tools.vocabs concurrency.mailboxes vocabs.parser calendar
|
tools.vocabs ui ui.commands ui.gadgets ui.gadgets.buttons
|
||||||
models.delay models.filter documents hashtables sets destructors lexer
|
ui.gadgets.editors ui.gadgets.frames ui.gadgets.grids
|
||||||
ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.labelled
|
ui.gadgets.labelled ui.gadgets.panes ui.gadgets.scrollers
|
||||||
ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
|
ui.gadgets.status-bar ui.gadgets.tracks ui.gestures ui.operations
|
||||||
ui.gadgets.packs ui.gadgets.tracks ui.gadgets.borders
|
ui.tools.browser ui.tools.common ui.tools.debugger
|
||||||
ui.gadgets.frames ui.gadgets.grids ui.gadgets.status-bar
|
ui.tools.listener.completion ui.tools.listener.history vocabs
|
||||||
ui.gadgets.viewports ui.gadgets.wrappers ui.gestures ui.operations
|
vocabs.parser words ;
|
||||||
ui.tools.browser ui.tools.debugger ui.gadgets.theme
|
|
||||||
ui.tools.inspector ui.tools.common ui ;
|
|
||||||
IN: ui.tools.listener
|
IN: ui.tools.listener
|
||||||
|
|
||||||
! If waiting is t, we're waiting for user input, and invoking
|
! If waiting is t, we're waiting for user input, and invoking
|
||||||
|
@ -44,22 +42,6 @@ completion-popup ;
|
||||||
assoc-stack
|
assoc-stack
|
||||||
] if ;
|
] 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 )
|
: <word-model> ( interactor -- model )
|
||||||
[ one-word-elt <element-model> 1/3 seconds <delay> ] keep
|
[ one-word-elt <element-model> 1/3 seconds <delay> ] keep
|
||||||
'[
|
'[
|
||||||
|
@ -69,9 +51,9 @@ completion-popup ;
|
||||||
|
|
||||||
: <interactor> ( output -- gadget )
|
: <interactor> ( output -- gadget )
|
||||||
interactor new-editor
|
interactor new-editor
|
||||||
V{ } clone >>history
|
|
||||||
<flag> >>flag
|
<flag> >>flag
|
||||||
dup <word-model> >>help
|
dup <word-model> >>help
|
||||||
|
dup model>> <history> >>history
|
||||||
swap >>output ;
|
swap >>output ;
|
||||||
|
|
||||||
M: interactor graft*
|
M: interactor graft*
|
||||||
|
@ -98,18 +80,12 @@ M: object (print-input)
|
||||||
: print-input ( object interactor -- )
|
: print-input ( object interactor -- )
|
||||||
output>> [ (print-input) ] with-output-stream* ;
|
output>> [ (print-input) ] with-output-stream* ;
|
||||||
|
|
||||||
: add-interactor-history ( input interactor -- )
|
|
||||||
over string>> empty? [ 2drop ] [ history>> adjoin ] if ;
|
|
||||||
|
|
||||||
: interactor-continue ( obj interactor -- )
|
: interactor-continue ( obj interactor -- )
|
||||||
mailbox>> mailbox-put ;
|
mailbox>> mailbox-put ;
|
||||||
|
|
||||||
: interactor-finish ( interactor -- )
|
: interactor-finish ( interactor -- )
|
||||||
[ editor-string <input> ] keep
|
[ history>> history-add ] keep
|
||||||
[ print-input ]
|
[ print-input ] [ clear-editor drop ] 2bi ;
|
||||||
[ add-interactor-history ]
|
|
||||||
[ clear-editor drop ]
|
|
||||||
2tri ;
|
|
||||||
|
|
||||||
: interactor-eof ( interactor -- )
|
: interactor-eof ( interactor -- )
|
||||||
dup interactor-busy? [
|
dup interactor-busy? [
|
||||||
|
@ -304,10 +280,8 @@ M: engine-word word-completion-string method-completion-string ;
|
||||||
2bi ;
|
2bi ;
|
||||||
|
|
||||||
: quot-action ( interactor -- lines )
|
: quot-action ( interactor -- lines )
|
||||||
[ [ editor-string <input> ] keep add-interactor-history ]
|
[ history>> history-add drop ] [ control-value ] [ select-all ] tri
|
||||||
[ control-value ]
|
[ parse-lines ] with-compilation-unit ;
|
||||||
[ select-all ]
|
|
||||||
tri ;
|
|
||||||
|
|
||||||
: hide-popup ( listener -- )
|
: hide-popup ( listener -- )
|
||||||
dup popup>> track-remove
|
dup popup>> track-remove
|
||||||
|
@ -358,11 +332,30 @@ M: interactor stream-read-quot
|
||||||
]
|
]
|
||||||
} cond ;
|
} 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 {
|
interactor "interactor" f {
|
||||||
{ T{ key-down f f "RET" } evaluate-input }
|
{ T{ key-down f f "RET" } evaluate-input }
|
||||||
{ T{ key-down f { C+ } "k" } clear-editor }
|
{ T{ key-down f { C+ } "k" } clear-editor }
|
||||||
} define-command-map
|
} 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. ( -- )
|
: welcome. ( -- )
|
||||||
"If this is your first time with Factor, please read the " print
|
"If this is your first time with Factor, please read the " print
|
||||||
"handbook" ($link) ". To see a list of keyboard shortcuts," print
|
"handbook" ($link) ". To see a list of keyboard shortcuts," print
|
||||||
|
@ -437,132 +430,3 @@ M: listener-gadget graft*
|
||||||
|
|
||||||
M: listener-gadget ungraft*
|
M: listener-gadget ungraft*
|
||||||
[ com-end ] [ call-next-method ] bi ;
|
[ 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
|
|
|
@ -140,12 +140,10 @@ M: word com-stack-effect def>> com-stack-effect ;
|
||||||
} define-operation
|
} define-operation
|
||||||
|
|
||||||
[ vocab-spec? ] \ run H{
|
[ vocab-spec? ] \ run H{
|
||||||
{ +keyboard+ T{ key-down f { C+ } "r" } }
|
|
||||||
{ +listener+ t }
|
{ +listener+ t }
|
||||||
} define-operation
|
} define-operation
|
||||||
|
|
||||||
[ vocab? ] \ test H{
|
[ vocab? ] \ test H{
|
||||||
{ +keyboard+ T{ key-down f { C+ } "t" } }
|
|
||||||
{ +listener+ t }
|
{ +listener+ t }
|
||||||
} define-operation
|
} define-operation
|
||||||
|
|
||||||
|
@ -170,12 +168,10 @@ M: word com-stack-effect def>> com-stack-effect ;
|
||||||
: com-profile ( quot -- ) profile profiler-window ;
|
: com-profile ( quot -- ) profile profiler-window ;
|
||||||
|
|
||||||
[ quotation? ] \ com-profile H{
|
[ quotation? ] \ com-profile H{
|
||||||
{ +keyboard+ T{ key-down f { C+ } "r" } }
|
{ +keyboard+ T{ key-down f { C+ } "f" } }
|
||||||
{ +listener+ t }
|
{ +listener+ t }
|
||||||
} define-operation
|
} define-operation
|
||||||
|
|
||||||
USE: ui.gadgets.tables
|
|
||||||
|
|
||||||
! Operations -> commands
|
! Operations -> commands
|
||||||
source-editor
|
source-editor
|
||||||
"word"
|
"word"
|
||||||
|
@ -188,5 +184,5 @@ interactor
|
||||||
"quotation"
|
"quotation"
|
||||||
"These commands operate on the entire contents of the input area."
|
"These commands operate on the entire contents of the input area."
|
||||||
[ ]
|
[ ]
|
||||||
[ quot-action [ parse-lines ] with-compilation-unit ]
|
[ quot-action ]
|
||||||
define-operation-map
|
define-operation-map
|
||||||
|
|
Loading…
Reference in New Issue