diff --git a/core/threads/threads.factor b/core/threads/threads.factor index 32d5e5234d..2a0d8e68ab 100755 --- a/core/threads/threads.factor +++ b/core/threads/threads.factor @@ -12,7 +12,7 @@ SYMBOL: initial-thread TUPLE: thread name quot exit-handler id -continuation state +continuation state runnable mailbox variables sleep-entry ; : self ( -- thread ) 40 getenv ; inline @@ -138,8 +138,11 @@ DEFER: next : (next) ( arg thread -- * ) f >>state dup set-self - dup continuation>> ?box - [ nip continue-with ] [ drop start ] if ; + dup runnable>> [ + continuation>> box> continue-with + ] [ + t >>runnable start + ] if ; : next ( -- * ) expire-sleep-loop diff --git a/extra/ui/tools/interactor/interactor.factor b/extra/ui/tools/interactor/interactor.factor index 74fc437e05..ffac73d082 100755 --- a/extra/ui/tools/interactor/interactor.factor +++ b/extra/ui/tools/interactor/interactor.factor @@ -6,12 +6,12 @@ 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 -ui.tools.workspace accessors ; +concurrency.mailboxes ui.tools.workspace accessors ; IN: ui.tools.interactor ! If waiting is t, we're waiting for user input, and invoking ! evaluate-input resumes the thread. -TUPLE: interactor output history flag thread waiting help ; +TUPLE: interactor output history flag mailbox thread waiting help ; : register-self ( interactor -- ) self >>thread drop ; @@ -40,6 +40,7 @@ TUPLE: interactor output history flag thread waiting help ; interactor construct-editor V{ } clone >>history <flag> >>flag + <mailbox> >>mailbox dup <help-model> >>help swap >>output ; @@ -77,7 +78,7 @@ M: interactor model-changed over empty? [ 2drop ] [ interactor-history push-new ] if ; : interactor-continue ( obj interactor -- ) - thread>> resume-with ; + mailbox>> mailbox-put ; : clear-input ( interactor -- ) gadget-model clear-doc ; @@ -100,14 +101,16 @@ M: interactor model-changed : interactor-yield ( interactor -- obj ) dup thread>> self eq? [ - t >>waiting - [ [ flag>> raise-flag ] curry "input" suspend ] keep - f >>waiting - drop + { + [ t >>waiting drop ] + [ flag>> raise-flag ] + [ mailbox>> mailbox-get ] + [ f >>waiting drop ] + } cleave ] [ drop f ] if ; M: interactor stream-readln - [ interactor-yield ] keep interactor-finish + [ interactor-yield ] [ interactor-finish ] bi dup [ first ] when ; : interactor-call ( quot interactor -- )