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 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

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 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