Implement missing input stream protocol methods
parent
03730f3038
commit
42f421d988
|
@ -1,7 +1,7 @@
|
||||||
IN: ui.tools.interactor.tests
|
IN: ui.tools.interactor.tests
|
||||||
USING: ui.tools.interactor ui.gadgets.panes namespaces
|
USING: ui.tools.interactor ui.gadgets.panes namespaces
|
||||||
ui.gadgets.editors concurrency.promises threads listener
|
ui.gadgets.editors concurrency.promises threads listener
|
||||||
tools.test kernel calendar parser accessors ;
|
tools.test kernel calendar parser accessors calendar io ;
|
||||||
|
|
||||||
\ <interactor> must-infer
|
\ <interactor> must-infer
|
||||||
|
|
||||||
|
@ -41,3 +41,47 @@ tools.test kernel calendar parser accessors ;
|
||||||
[ ] [ 1000 sleep ] unit-test
|
[ ] [ 1000 sleep ] unit-test
|
||||||
|
|
||||||
[ ] [ "interactor" get interactor-eof ] unit-test
|
[ ] [ "interactor" get interactor-eof ] unit-test
|
||||||
|
|
||||||
|
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||||
|
|
||||||
|
: text "Hello world.\nThis is a test." ;
|
||||||
|
|
||||||
|
[ ] [ text "interactor" get set-editor-string ] unit-test
|
||||||
|
|
||||||
|
[ ] [ <promise> "promise" set ] unit-test
|
||||||
|
|
||||||
|
[ ] [
|
||||||
|
[
|
||||||
|
"interactor" get register-self
|
||||||
|
"interactor" get contents "promise" get fulfill
|
||||||
|
] in-thread
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ ] [ 100 sleep ] unit-test
|
||||||
|
|
||||||
|
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||||
|
|
||||||
|
[ ] [ 100 sleep ] unit-test
|
||||||
|
|
||||||
|
[ ] [ "interactor" get interactor-eof ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ "promise" get 2 seconds ?promise-timeout text = ] unit-test
|
||||||
|
|
||||||
|
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||||
|
|
||||||
|
[ ] [ text "interactor" get set-editor-string ] unit-test
|
||||||
|
|
||||||
|
[ ] [ <promise> "promise" set ] unit-test
|
||||||
|
|
||||||
|
[ ] [
|
||||||
|
[
|
||||||
|
"interactor" get register-self
|
||||||
|
"interactor" get stream-read1 "promise" get fulfill
|
||||||
|
] in-thread
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ ] [ 100 sleep ] unit-test
|
||||||
|
|
||||||
|
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||||
|
|
||||||
|
[ CHAR: H ] [ "promise" get 2 seconds ?promise-timeout ] unit-test
|
||||||
|
|
|
@ -6,7 +6,8 @@ models namespaces parser prettyprint quotations sequences
|
||||||
strings threads listener classes.tuple ui.commands ui.gadgets
|
strings threads listener classes.tuple ui.commands ui.gadgets
|
||||||
ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds
|
ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds
|
||||||
ui.gestures definitions calendar concurrency.flags
|
ui.gestures definitions calendar concurrency.flags
|
||||||
concurrency.mailboxes ui.tools.workspace accessors sets ;
|
concurrency.mailboxes ui.tools.workspace accessors sets
|
||||||
|
destructors ;
|
||||||
IN: ui.tools.interactor
|
IN: ui.tools.interactor
|
||||||
|
|
||||||
! If waiting is t, we're waiting for user input, and invoking
|
! If waiting is t, we're waiting for user input, and invoking
|
||||||
|
@ -110,9 +111,11 @@ M: interactor model-changed
|
||||||
} cleave
|
} cleave
|
||||||
] [ drop f ] if ;
|
] [ drop f ] if ;
|
||||||
|
|
||||||
|
: interactor-read ( interactor -- lines )
|
||||||
|
[ interactor-yield ] [ interactor-finish ] bi ;
|
||||||
|
|
||||||
M: interactor stream-readln
|
M: interactor stream-readln
|
||||||
[ interactor-yield ] [ interactor-finish ] bi
|
interactor-read dup [ first ] when ;
|
||||||
dup [ first ] when ;
|
|
||||||
|
|
||||||
: interactor-call ( quot interactor -- )
|
: interactor-call ( quot interactor -- )
|
||||||
dup interactor-busy? [
|
dup interactor-busy? [
|
||||||
|
@ -124,12 +127,22 @@ M: interactor stream-read
|
||||||
swap dup zero? [
|
swap dup zero? [
|
||||||
2drop ""
|
2drop ""
|
||||||
] [
|
] [
|
||||||
>r stream-readln dup length r> min head
|
>r interactor-read dup [ "\n" join ] when r> short head
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M: interactor stream-read-partial
|
M: interactor stream-read-partial
|
||||||
stream-read ;
|
stream-read ;
|
||||||
|
|
||||||
|
M: interactor stream-read1
|
||||||
|
dup interactor-read {
|
||||||
|
{ [ dup not ] [ 2drop f ] }
|
||||||
|
{ [ dup empty? ] [ drop stream-read1 ] }
|
||||||
|
{ [ dup first empty? ] [ 2drop CHAR: \n ] }
|
||||||
|
[ nip first first ]
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
M: interactor dispose drop ;
|
||||||
|
|
||||||
: go-to-error ( interactor error -- )
|
: go-to-error ( interactor error -- )
|
||||||
[ line>> 1- ] [ column>> ] bi 2array
|
[ line>> 1- ] [ column>> ] bi 2array
|
||||||
over set-caret
|
over set-caret
|
||||||
|
|
Loading…
Reference in New Issue