From c5de10ec4998f2089e9254cad281bbaf9a364321 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 21 Feb 2008 01:25:59 -0600
Subject: [PATCH] More walker work
---
extra/tools/walker/debug/debug.factor | 13 ++++++---
extra/tools/walker/walker-tests.factor | 4 ---
extra/tools/walker/walker.factor | 27 ++++++++++---------
.../ui/gadgets/labelled/labelled-docs.factor | 2 +-
extra/ui/gadgets/labelled/labelled.factor | 4 +--
extra/ui/tools/listener/listener.factor | 2 +-
extra/ui/tools/traceback/traceback.factor | 21 +++++++++------
7 files changed, 42 insertions(+), 31 deletions(-)
mode change 100644 => 100755 extra/ui/gadgets/labelled/labelled.factor
diff --git a/extra/tools/walker/debug/debug.factor b/extra/tools/walker/debug/debug.factor
index 548ab64421..fb3312b729 100755
--- a/extra/tools/walker/debug/debug.factor
+++ b/extra/tools/walker/debug/debug.factor
@@ -2,15 +2,22 @@
! See http://factorcode.org/license.txt for BSD license.
USING: concurrency.promises models tools.walker kernel
sequences concurrency.messaging locals continuations
-threads ;
+threads namespaces namespaces.private ;
IN: tools.walker.debug
:: test-walker | quot |
[let | p [ <promise> ]
s [ f <model> ]
c [ f <model> ] |
- [ s c start-walker-thread p fulfill break ]
- quot compose "Walker test" spawn drop
+ [
+ H{ } clone >n
+ [ s c start-walker-thread p fulfill ] new-walker-hook set
+ [ drop ] show-walker-hook set
+
+ break
+
+ quot call
+ ] "Walker test" spawn drop
step-into-all
p ?promise
diff --git a/extra/tools/walker/walker-tests.factor b/extra/tools/walker/walker-tests.factor
index 6081ef1a65..1302ebe3d8 100755
--- a/extra/tools/walker/walker-tests.factor
+++ b/extra/tools/walker/walker-tests.factor
@@ -97,10 +97,6 @@ IN: temporary
[ { 6 } ]
[ [ [ 3 throw ] [ 2 * ] recover ] test-walker ] unit-test
-[ { "{ 1 2 3 }\n" } ] [
- [ [ { 1 2 3 } . ] with-string-writer ] test-walker
-] unit-test
-
[ { } ] [
[ "a" "b" set "c" "d" set [ ] test-walker ] with-scope
] unit-test
diff --git a/extra/tools/walker/walker.factor b/extra/tools/walker/walker.factor
index 14e65af1df..1b37673c38 100755
--- a/extra/tools/walker/walker.factor
+++ b/extra/tools/walker/walker.factor
@@ -6,8 +6,8 @@ concurrency.messaging quotations kernel.private words
sequences.private assocs models ;
IN: tools.walker
-SYMBOL: new-walker-hook
-SYMBOL: show-walker-hook
+SYMBOL: new-walker-hook ! ( -- )
+SYMBOL: show-walker-hook ! ( thread -- )
! Thread local
SYMBOL: walker-thread
@@ -169,16 +169,19 @@ SYMBOL: +detached+
[ status +running+ eq? ] [
[
{
- { detach [ detach-msg ] }
- { step [ ] }
- { step-out [ ] }
- { step-into [ ] }
- { step-all [ ] }
- { step-into-all [ ] }
- { step-back [ ] }
- { f [ walker-stopped ] }
- [ step-into-msg ]
- } case f
+ { detach [ detach-msg f ] }
+ { step [ f ] }
+ { step-out [ f ] }
+ { step-into [ f ] }
+ { step-all [ f ] }
+ { step-into-all [ f ] }
+ { step-back [ f ] }
+ { f [ +stopped+ set-status f ] }
+ [
+ dup walker-continuation tget set-model
+ step-into-msg
+ ]
+ } case
] handle-synchronous
] [ ] while ;
diff --git a/extra/ui/gadgets/labelled/labelled-docs.factor b/extra/ui/gadgets/labelled/labelled-docs.factor
index 285e470564..f09bcaa825 100755
--- a/extra/ui/gadgets/labelled/labelled-docs.factor
+++ b/extra/ui/gadgets/labelled/labelled-docs.factor
@@ -18,7 +18,7 @@ HELP: <closable-gadget>
{ $notes "The quotation can find the " { $link closable-gadget } " instance, or any other parent gadget by calling " { $link find-parent } " with the gadget it receives on the stack." } ;
HELP: <labelled-pane>
-{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( value -- )" } } { "title" string } { "gadget" "a new " { $link gadget } } }
+{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( value -- )" } } { "scrolls?" "a boolean" } { "title" string } { "gadget" "a new " { $link gadget } } }
{ $description "Creates a new control delegating to a " { $link pane } ", and wraps it in a " { $link labelled-gadget } ". When the value of the model changes, the value is pushed on the stack and the quotation is called using " { $link with-pane } "." } ;
{ <labelled-pane> <pane-control> } related-words
diff --git a/extra/ui/gadgets/labelled/labelled.factor b/extra/ui/gadgets/labelled/labelled.factor
old mode 100644
new mode 100755
index 672d3d96d8..0231aef4d0
--- a/extra/ui/gadgets/labelled/labelled.factor
+++ b/extra/ui/gadgets/labelled/labelled.factor
@@ -21,8 +21,8 @@ M: labelled-gadget focusable-child* labelled-gadget-content ;
: <labelled-scroller> ( gadget title -- gadget )
>r <scroller> r> <labelled-gadget> ;
-: <labelled-pane> ( model quot title -- gadget )
- >r <pane-control> t over set-pane-scrolls? r>
+: <labelled-pane> ( model quot scrolls? title -- gadget )
+ >r >r <pane-control> r> over set-pane-scrolls? r>
<labelled-scroller> ;
: <close-box> ( quot -- button/f )
diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor
index 009d694e21..db26c2a150 100755
--- a/extra/ui/tools/listener/listener.factor
+++ b/extra/ui/tools/listener/listener.factor
@@ -106,7 +106,7 @@ TUPLE: stack-display ;
g workspace-listener swap [
dup <toolbar> f track,
listener-gadget-stack [ stack. ]
- "Data stack" <labelled-pane> 1 track,
+ t "Data stack" <labelled-pane> 1 track,
] { 0 1 } build-track ;
M: stack-display tool-scroller
diff --git a/extra/ui/tools/traceback/traceback.factor b/extra/ui/tools/traceback/traceback.factor
index 2a7dfe654c..a3aa182683 100755
--- a/extra/ui/tools/traceback/traceback.factor
+++ b/extra/ui/tools/traceback/traceback.factor
@@ -1,25 +1,29 @@
! Copyright (C) 2006, 2007 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
-ui.gadgets.tracks ui.gestures ;
+ui.commands ui.gadgets ui.gadgets.labelled assocs
+ui.gadgets.tracks ui.gestures sequences hashtables inspector ;
IN: ui.tools.traceback
: <callstack-display> ( model -- gadget )
[ [ continuation-call callstack. ] when* ]
- "Call stack" <labelled-pane> ;
+ t "Call stack" <labelled-pane> ;
: <datastack-display> ( model -- gadget )
[ [ continuation-data stack. ] when* ]
- "Data stack" <labelled-pane> ;
+ t "Data stack" <labelled-pane> ;
: <retainstack-display> ( model -- gadget )
[ [ continuation-retain stack. ] when* ]
- "Retain stack" <labelled-pane> ;
+ 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 { 300 400 } ;
+M: traceback-gadget pref-dim* drop { 550 600 } ;
: <traceback-gadget> ( model -- gadget )
{ 0 1 } <track> traceback-gadget construct-control [
@@ -27,8 +31,9 @@ M: traceback-gadget pref-dim* drop { 300 400 } ;
[
g gadget-model <datastack-display> 1/2 track,
g gadget-model <retainstack-display> 1/2 track,
- ] { 1 0 } make-track 1/3 track,
- g gadget-model <callstack-display> 2/3 track,
+ ] { 1 0 } make-track 1/5 track,
+ g gadget-model <callstack-display> 2/5 track,
+ g gadget-model <namestack-display> 2/5 track,
] with-gadget
] keep ;