From e30871f4a5ca71d115bdc4fa3395d3bd8a6c2074 Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 31 Jul 2006 20:49:26 +0000 Subject: [PATCH] interactor-busy? flag added --- TODO.FACTOR.txt | 13 ++++----- library/threads.factor | 9 ++++-- library/tools/interpreter.factor | 2 +- library/ui/text/interactor.factor | 46 +++++++++++++++++++------------ library/ui/tools/listener.factor | 9 +++++- 5 files changed, 51 insertions(+), 28 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index d1dfe80eb2..f92bfa59cc 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,10 +1,5 @@ + 0.84: -+ remaining walker tasks: -- handled by walker itself -- ^W in interactor -- ^I in interactor - - windows native i/o - fix contribs: parser-combinators, boids, automata, space-invaders - unix i/o: problems with passing f to syscalls @@ -22,8 +17,6 @@ - services do not launch if factor not running - integrated error documentation - roundoff is still not quite right with tracks -- 'show' doesn't work if invoked from a listener on an object which is - itself inspected in the listener - fix top level window positioning - nasty inference regressions - [ [ dup call ] dup call ] infer hangs @@ -56,6 +49,12 @@ + ui: +- remaining walker tasks: + - handled by walker itself + - ^W in interactor + - ^I in interactor + - error handling is still screwy + - continuation handling is also screwy - add-gadget, model-changed, set-model should compile - shortcuts: - find a listener diff --git a/library/threads.factor b/library/threads.factor index 59dc770b26..9154b8c5ce 100644 --- a/library/threads.factor +++ b/library/threads.factor @@ -9,7 +9,10 @@ namespaces queues sequences vectors ; : run-queue ( -- queue ) \ run-queue get-global ; -: schedule-thread ( continuation -- ) run-queue enque ; +: schedule-thread ( continuation0 -- ) run-queue enque ; + +: schedule-thread-with ( obj continuation1 -- ) + 2array schedule-thread ; : sleep-queue ( -- vec ) \ sleep-queue get-global ; @@ -19,7 +22,9 @@ namespaces queues sequences vectors ; : sleep-time ( sorted-queue -- ms ) dup empty? [ drop 1000 ] [ peek first millis [-] ] if ; -: stop ( -- ) run-queue deque continue ; +: stop ( -- ) + run-queue deque dup array? + [ first2 continue-with ] [ continue ] if ; : yield ( -- ) [ schedule-thread stop ] callcc0 ; diff --git a/library/tools/interpreter.factor b/library/tools/interpreter.factor index 2cde0abf44..cc5fb3f10e 100644 --- a/library/tools/interpreter.factor +++ b/library/tools/interpreter.factor @@ -105,7 +105,7 @@ SYMBOL: callframe-end : restore-harness ( obj -- ) dup array? [ init-meta-interp [ ] (meta-call) - [ first2 continue-with ] in-thread drop + first2 schedule-thread-with ] [ set-meta-interp ] if ; diff --git a/library/ui/text/interactor.factor b/library/ui/text/interactor.factor index 09b02f4d69..4f4fe2f3e2 100644 --- a/library/ui/text/interactor.factor +++ b/library/ui/text/interactor.factor @@ -1,29 +1,36 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-text -USING: gadgets gadgets-controls gadgets-panes hashtables help io -kernel namespaces prettyprint styles threads ; +USING: gadgets gadgets-controls gadgets-panes generic hashtables +help io kernel namespaces prettyprint styles threads ; -TUPLE: interactor output continuation ; +TUPLE: interactor output continuation busy? ; C: interactor ( output -- gadget ) [ set-interactor-output ] keep f over set-gadget-delegate dup dup set-control-self ; -: interactor-eval ( string gadget -- ) - interactor-continuation dup - [ [ continue-with ] in-thread ] when 2drop ; +M: interactor graft* ( interactor -- ) + f over set-interactor-busy? delegate graft* ; + +: interactor-eval ( string interactor -- ) + t over set-interactor-busy? + interactor-continuation schedule-thread-with ; SYMBOL: structured-input : interactor-call ( quot gadget -- ) - dup interactor-output [ - "Command: " write over short. - ] with-stream* - >r structured-input set-global - "\"structured-input\" \"gadgets-text\" lookup get-global call" - r> interactor-eval ; + dup interactor-busy? [ + 2drop + ] [ + dup interactor-output [ + "Command: " write over short. + ] with-stream* + >r structured-input set-global + "\"structured-input\" \"gadgets-text\" lookup get-global call" + r> interactor-eval + ] if ; : print-input ( string interactor -- ) interactor-output [ @@ -33,10 +40,14 @@ SYMBOL: structured-input ] with-style ] with-stream* ; -: interactor-commit ( gadget -- ) - dup field-commit - over control-model clear-doc - swap 2dup print-input interactor-eval ; +: interactor-commit ( interactor -- ) + dup interactor-busy? [ + drop + ] [ + dup field-commit + over control-model clear-doc + swap 2dup print-input interactor-eval + ] if ; interactor H{ { T{ key-down f f "RETURN" } [ interactor-commit ] } @@ -44,5 +55,6 @@ interactor H{ { T{ key-down f { C+ } "d" } [ f swap interactor-eval ] } } set-gestures -M: interactor stream-readln ( pane -- line ) +M: interactor stream-readln ( interactor -- line ) + f over set-interactor-busy? [ over set-interactor-continuation stop ] callcc1 nip ; diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index f0135e2f23..0e041da7f2 100644 --- a/library/ui/tools/listener.factor +++ b/library/ui/tools/listener.factor @@ -62,8 +62,15 @@ M: listener-gadget gadget-title drop "Listener" ; listener-gadget-input over quotation? [ interactor-call ] [ set-editor-text ] if ; +: listener-available? ( gadget -- ? ) + dup listener-gadget? [ + listener-gadget-input interactor-busy? not + ] [ + drop f + ] if ; + : listener-tool - [ listener-gadget? ] + [ listener-available? ] [ ] [ call-listener ] ;