Fix hang when clicking presentations in the walker; improve traceback widget
Slava Pestov
parent
f8df1936a6
commit
a5503782d7
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 -- )
|
||||
<flag> over set-interactor-flag
|
||||
<box> swap set-interactor-thread ;
|
||||
|
||||
: <interactor> ( output -- gadget )
|
||||
<source-editor>
|
||||
interactor construct-editor
|
||||
tuck set-interactor-output
|
||||
<box> 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 ;
|
||||
|
|
|
|||
|
|
@ -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 <model> swap set-listener-gadget-stack ;
|
||||
|
|
|
|||
|
|
@ -83,5 +83,7 @@ workspace "workflow" f {
|
|||
} define-command-map
|
||||
|
||||
[
|
||||
<workspace> "Factor workspace" open-status-window
|
||||
<workspace>
|
||||
dup "Factor workspace" open-status-window
|
||||
workspace-listener wait-for-listener
|
||||
] workspace-window-hook set-global
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
: <callstack-display> ( model -- gadget )
|
||||
|
|
@ -17,10 +19,6 @@ IN: ui.tools.traceback
|
|||
[ [ continuation-retain stack. ] when* ]
|
||||
t "Retain stack" <labelled-pane> ;
|
||||
|
||||
: <namestack-display> ( model -- gadget )
|
||||
[ [ continuation-name namestack. ] when* ]
|
||||
f "Dynamic variables" <labelled-pane> ;
|
||||
|
||||
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 <datastack-display> 1/2 track,
|
||||
g gadget-model <retainstack-display> 1/2 track,
|
||||
] { 1 0 } make-track 1/5 track,
|
||||
g gadget-model <callstack-display> 2/5 track,
|
||||
g gadget-model <namestack-display> 2/5 track,
|
||||
] { 1 0 } make-track 1/3 track,
|
||||
g gadget-model <callstack-display> 2/3 track,
|
||||
toolbar,
|
||||
] with-gadget
|
||||
] keep ;
|
||||
|
||||
: <namestack-display> ( model -- gadget )
|
||||
[ [ continuation-name namestack. ] when* ]
|
||||
<pane-control> ;
|
||||
|
||||
TUPLE: variables-gadget ;
|
||||
|
||||
: <variables-gadget> ( model -- gadget )
|
||||
<namestack-display> <scroller>
|
||||
variables-gadget construct-empty
|
||||
[ set-gadget-delegate ] keep ;
|
||||
|
||||
M: variables-gadget pref-dim* drop { 400 400 } ;
|
||||
|
||||
: variables ( traceback -- )
|
||||
gadget-model <variables-gadget>
|
||||
"Dynamic variables" open-status-window ;
|
||||
|
||||
: traceback-window ( continuation -- )
|
||||
<model> <traceback-gadget> "Traceback" open-window ;
|
||||
|
||||
traceback-gadget "toolbar" f {
|
||||
{ T{ key-down f f "v" } variables }
|
||||
} define-command-map
|
||||
|
|
|
|||
|
|
@ -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 } "." ;
|
||||
|
|
|
|||
|
|
@ -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 ( -- )
|
||||
|
|
|
|||
Loading…
Reference in New Issue