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

Implement missing input stream protocol methods

db4
Slava Pestov 2008-06-18 05:58:26 -05:00
parent 03730f3038
commit 42f421d988
2 changed files with 62 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
extra/ui/tools/interactor/interactor-tests.factor
View File

@ -1,7 +1,7 @@
IN: ui.tools.interactor.tests
USING: ui.tools.interactor ui.gadgets.panes namespaces
ui.gadgets.editors concurrency.promises threads listener
tools.test kernel calendar parser accessors ;
tools.test kernel calendar parser accessors calendar io ;
\ <interactor> must-infer
@ -41,3 +41,47 @@ tools.test kernel calendar parser accessors ;
[ ] [ 1000 sleep ] 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

21
extra/ui/tools/interactor/interactor.factor
View File

@ -6,7 +6,8 @@ models namespaces parser prettyprint quotations sequences
strings threads listener classes.tuple ui.commands ui.gadgets
ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds
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
! If waiting is t, we're waiting for user input, and invoking
@ -110,9 +111,11 @@ M: interactor model-changed
} cleave
] [ drop f ] if ;
: interactor-read ( interactor -- lines )
[ interactor-yield ] [ interactor-finish ] bi ;
M: interactor stream-readln
[ interactor-yield ] [ interactor-finish ] bi
dup [ first ] when ;
interactor-read dup [ first ] when ;
: interactor-call ( quot interactor -- )
dup interactor-busy? [
@ -124,12 +127,22 @@ M: interactor stream-read
swap dup zero? [
2drop ""
] [
>r stream-readln dup length r> min head
>r interactor-read dup [ "\n" join ] when r> short head
] if ;
M: interactor stream-read-partial
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 -- )
[ line>> 1- ] [ column>> ] bi 2array
over set-caret