diff --git a/extra/concurrency/flags/flags-docs.factor b/extra/concurrency/flags/flags-docs.factor index 11c85240b9..1b2c1b754e 100644 --- a/extra/concurrency/flags/flags-docs.factor +++ b/extra/concurrency/flags/flags-docs.factor @@ -14,6 +14,10 @@ HELP: raise-flag { $values { "flag" flag } } { $description "Raises a flag, notifying any threads waiting on it. Does nothing if the flag has already been raised." } ; +HELP: wait-for-flag +{ $values { "flag" flag } } +{ $description "Waits for a flag to be raised. If the flag has already been raised, returns immediately." } ; + HELP: lower-flag { $values { "flag" flag } } { $description "Attempts to lower a flag. If the flag has been raised previously, returns immediately, otherwise waits for it to be raised first." } ; @@ -26,8 +30,9 @@ $nl "Essentially, a flag can be thought of as a counting semaphore where the count never goes above one." { $subsection flag } { $subsection flag? } -"Raising and lowering flags:" +"Waiting for a flag to be raised:" { $subsection raise-flag } +{ $subsection wait-for-flag } { $subsection lower-flag } ; ABOUT: "concurrency.flags" diff --git a/extra/concurrency/flags/flags.factor b/extra/concurrency/flags/flags.factor index d4e60d63ee..888b617b85 100644 --- a/extra/concurrency/flags/flags.factor +++ b/extra/concurrency/flags/flags.factor @@ -13,9 +13,14 @@ TUPLE: flag value? thread ; [ resume ] [ drop t over set-flag-value? ] if ] unless drop ; +: wait-for-flag ( flag -- ) + dup flag-value? [ drop ] [ + [ flag-thread >box ] curry "flag" suspend drop + ] if ; + : lower-flag ( flag -- ) dup flag-value? [ f swap set-flag-value? ] [ - [ flag-thread >box ] curry "flag" suspend drop + wait-for-flag ] if ; diff --git a/extra/ui/tools/interactor/interactor.factor b/extra/ui/tools/interactor/interactor.factor index 3c9809f343..9e43460aa9 100755 --- a/extra/ui/tools/interactor/interactor.factor +++ b/extra/ui/tools/interactor/interactor.factor @@ -1,18 +1,15 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs combinators continuations documents -ui.tools.workspace hashtables io io.styles kernel math + hashtables io io.styles kernel math math.vectors models namespaces parser prettyprint quotations sequences sequences.lib strings threads listener tuples ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds ui.gestures -definitions boxes calendar ; +definitions boxes calendar concurrency.flags ui.tools.workspace ; IN: ui.tools.interactor -TUPLE: interactor -history output -thread quot -help ; +TUPLE: interactor history output flag thread help ; : interactor-continuation ( interactor -- continuation ) interactor-thread box-value @@ -35,12 +32,16 @@ help ; : init-interactor-history ( interactor -- ) V{ } clone swap set-interactor-history ; +: init-interactor-state ( interactor -- ) + over set-interactor-flag + swap set-interactor-thread ; + : ( output -- gadget ) interactor construct-editor tuck set-interactor-output - over set-interactor-thread dup init-interactor-history + dup init-interactor-state dup init-caret-help ; M: interactor graft* @@ -97,7 +98,10 @@ M: interactor model-changed ] unless drop ; : interactor-yield ( interactor -- obj ) - [ interactor-thread >box ] curry "input" suspend ; + [ + [ interactor-thread >box ] keep + interactor-flag raise-flag + ] curry "input" suspend ; M: interactor stream-readln [ interactor-yield ] keep interactor-finish ?first ; diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor index 7617b0f32d..0577ae38bd 100755 --- a/extra/ui/tools/listener/listener.factor +++ b/extra/ui/tools/listener/listener.factor @@ -6,7 +6,7 @@ kernel models namespaces parser quotations sequences ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.labelled ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.operations vocabs words -prettyprint listener debugger threads boxes ; +prettyprint listener debugger threads boxes concurrency.flags ; IN: ui.tools.listener TUPLE: listener-gadget input output stack ; @@ -131,10 +131,18 @@ M: stack-display tool-scroller listener ] with-stream* ; +: start-listener-thread ( listener -- ) + [ listener-thread ] curry "Listener" spawn drop ; + +: wait-for-listener ( listener -- ) + #! Wait for the listener to start. + listener-gadget-input interactor-flag wait-for-flag ; + : restart-listener ( listener -- ) + #! Returns when listener is ready to receive input. dup com-end dup clear-output - [ listener-thread ] curry - "Listener" spawn drop ; + dup start-listener-thread + wait-for-listener ; : init-listener ( listener -- ) f swap set-listener-gadget-stack ; diff --git a/extra/ui/tools/tools.factor b/extra/ui/tools/tools.factor index 2b3c652352..0156fe80ea 100755 --- a/extra/ui/tools/tools.factor +++ b/extra/ui/tools/tools.factor @@ -83,5 +83,7 @@ workspace "workflow" f { } define-command-map [ - "Factor workspace" open-status-window + + dup "Factor workspace" open-status-window + workspace-listener wait-for-listener ] workspace-window-hook set-global diff --git a/extra/ui/tools/traceback/traceback.factor b/extra/ui/tools/traceback/traceback.factor index a3aa182683..d4a0544f0a 100755 --- a/extra/ui/tools/traceback/traceback.factor +++ b/extra/ui/tools/traceback/traceback.factor @@ -1,8 +1,10 @@ -! Copyright (C) 2006, 2007 Slava Pestov. +! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: continuations kernel models namespaces prettyprint ui ui.commands ui.gadgets ui.gadgets.labelled assocs -ui.gadgets.tracks ui.gestures sequences hashtables inspector ; +ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes +ui.gadgets.status-bar ui.gadgets.scrollers +ui.gestures sequences hashtables inspector ; IN: ui.tools.traceback : ( model -- gadget ) @@ -17,10 +19,6 @@ IN: ui.tools.traceback [ [ continuation-retain stack. ] when* ] t "Retain stack" ; -: ( model -- gadget ) - [ [ continuation-name namestack. ] when* ] - f "Dynamic variables" ; - TUPLE: traceback-gadget ; M: traceback-gadget pref-dim* drop { 550 600 } ; @@ -31,11 +29,32 @@ M: traceback-gadget pref-dim* drop { 550 600 } ; [ g gadget-model 1/2 track, g gadget-model 1/2 track, - ] { 1 0 } make-track 1/5 track, - g gadget-model 2/5 track, - g gadget-model 2/5 track, + ] { 1 0 } make-track 1/3 track, + g gadget-model 2/3 track, + toolbar, ] with-gadget ] keep ; +: ( model -- gadget ) + [ [ continuation-name namestack. ] when* ] + ; + +TUPLE: variables-gadget ; + +: ( model -- gadget ) + + variables-gadget construct-empty + [ set-gadget-delegate ] keep ; + +M: variables-gadget pref-dim* drop { 400 400 } ; + +: variables ( traceback -- ) + gadget-model + "Dynamic variables" open-status-window ; + : traceback-window ( continuation -- ) "Traceback" open-window ; + +traceback-gadget "toolbar" f { + { T{ key-down f f "v" } variables } +} define-command-map diff --git a/extra/ui/tools/walker/walker-docs.factor b/extra/ui/tools/walker/walker-docs.factor index 38b4e2a837..54caf8be12 100755 --- a/extra/ui/tools/walker/walker-docs.factor +++ b/extra/ui/tools/walker/walker-docs.factor @@ -7,5 +7,4 @@ ARTICLE: "ui-walker" "UI walker" $nl "The walker can travel backwards through time, and restore stacks. This does not undo side effects and therefore can only be used reliably on referentially transparent code." { $command-map walker-gadget "toolbar" } -{ $command-map walker-gadget "other" } "Walkers are instances of " { $link walker-gadget } "." ; diff --git a/extra/ui/tools/walker/walker.factor b/extra/ui/tools/walker/walker.factor index 17ca7552ce..ea38b9c8db 100755 --- a/extra/ui/tools/walker/walker.factor +++ b/extra/ui/tools/walker/walker.factor @@ -26,10 +26,6 @@ TUPLE: walker-gadget status continuation thread ; : com-abandon ( walker -- ) abandon walker-command ; -: com-inspect ( walker -- ) - walker-continuation model-value - [ inspect ] curry call-listener ; - M: walker-gadget ungraft* dup delegate ungraft* detach walker-command ; @@ -69,12 +65,8 @@ walker-gadget "toolbar" f { { T{ key-down f f "b" } com-back } { T{ key-down f f "c" } com-continue } { T{ key-down f f "a" } com-abandon } - { T{ key-down f f "F1" } walker-help } -} define-command-map - -walker-gadget "other" f { - { T{ key-down f f "n" } com-inspect } { T{ key-down f f "d" } close-window } + { T{ key-down f f "F1" } walker-help } } define-command-map : walker-window ( -- )