Different walker interaction style

TODO.FACTOR.txt

@@ -13,8 +13,6 @@
   - better listener multi-line expression handling
   - history doesn't work in a good way if you ^K the input
   - history: move caret to end
-- finish gui stepper
-  - <input> handled by walker itself
 - graphical module manager tool
 - services do not launch if factor not running
 - integrated error documentation
@@ -122,7 +120,5 @@
 [ 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 11 11 11 113 
 ]
 
-- code walker & exceptions -- test and debug problems
-- break: perhaps use current stdio to run break listener
 - httpd search tools
 - remaining HTML issues need fixing

doc/handbook/tools.facts

@@ -38,7 +38,6 @@ $terpri
 "The following variables can be rebound inside a nested scope to customize the behavior of a listener; this can be done to create a development tool with a custom interaction loop:"
 { $subsection listener-prompt }
 { $subsection listener-hook }
-{ $subsection datastack-hook }
 "Finally, the multi-line expression reading word can be used independently of the rest of the listener:"
 { $subsection read-multiline } ;
 

library/tools/interpreter.factor

@@ -93,7 +93,7 @@ SYMBOL: callframe-end
         append
         dup push-c swap push-c length push-c
         meta-interp continue
-    ] callcc1 set-meta-interp drop ;
+    ] callcc1 set-meta-interp 2drop ;
 
 : host-quot ( quot -- ) 0 swap (host-quot) ;
 

library/tools/listener.factor

@@ -8,7 +8,7 @@ SYMBOL: listener-prompt
 SYMBOL: quit-flag
 
 SYMBOL: listener-hook
-SYMBOL: datastack-hook
+SYMBOL: eval-hook
 
 "ok " listener-prompt set-global
 
@@ -32,8 +32,9 @@ SYMBOL: datastack-hook
 
 : listen ( -- )
     listener-hook get call
-    listener-prompt get write flush
+    listener-prompt get write flush [
-    [ read-multiline [ call ] [ bye ] if ] try ;
+        read-multiline [ eval-hook get call ] [ drop bye ] if
+    ] try ;
 
 : (listener) ( -- )
     quit-flag get [ quit-flag off ] [ listen (listener) ] if ;
@@ -41,7 +42,7 @@ SYMBOL: datastack-hook
 : listener ( quot -- )
     [
         use [ clone ] change
-        [ datastack ] datastack-hook set
+        [ call ] eval-hook set
         call
         (listener)
     ] with-scope ;

library/tools/listener.facts

@@ -10,12 +10,6 @@ HELP: quit-flag f
 HELP: listener-hook f
 { $description "Variable holding a quotation called by the listener before reading each line of input. The UI sets this variable to a quotation which updates the stack display in a listener gadget." } ;
 
-HELP: datastack-hook f
-{ $description "Variable holding a quotation called by the UI to produce the elements of the data stack display. Initially, this quotation simply calls " { $link datastack } ", however the single-stepper overrides it to show the stepper data stack instead." } ;
-
-HELP: bye "( -- )"
-{ $description "Terminates the innermost listener loop, returning to its caller." } ;
-
 HELP: (read-multiline) "( quot depth -- newquot ? )"
 { $values { "quot" "the quotation being parsed" } { "depth" "the initial parsing stack depth" } { "newquot" "the quotation being parsed, after another line of input" } { "?" "a flag indicating end of input" } }
 { $description "Internal word used to read multiline expressions." } ;

library/ui/tools/listener.factor

@@ -11,8 +11,7 @@ words ;
 TUPLE: listener-gadget input output stack ;
 
 : ui-listener-hook ( listener -- )
-    >r datastack-hook get call r>
+    >r datastack r> listener-gadget-stack set-model ;
-    listener-gadget-stack set-model ;
 
 : listener-stream ( listener -- stream )
     dup listener-gadget-input swap listener-gadget-output

library/ui/tools/walker.factor

@@ -1,10 +1,11 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-walker
-USING: gadgets gadgets-buttons gadgets-frames gadgets-listener
+USING: arrays gadgets gadgets-buttons gadgets-frames
-gadgets-panes gadgets-scrolling gadgets-text gadgets-tiles
+gadgets-listener gadgets-panes gadgets-scrolling gadgets-text
-gadgets-tracks generic inspector interpreter io kernel listener
+gadgets-tiles gadgets-tracks generic hashtables inspector
-math models namespaces sequences shells threads ;
+interpreter io kernel kernel-internals listener math models
+namespaces sequences shells threads vectors ;
 
 TUPLE: stack-track ;
 
@@ -31,7 +32,7 @@ C: walker-track ( cs rs ds quot -- gadget )
         { [ <walker-input> ] set-walker-track-input [ <scroller> ] 1/6 }
     } { 0 1 } make-track* ;
 
-TUPLE: walker-gadget track ds rs cs quot ;
+TUPLE: walker-gadget track ds rs cs quot ns ;
 
 : find-walker-gadget [ walker-gadget? ] find-parent ;
 
@@ -39,9 +40,18 @@ TUPLE: walker-gadget track ds rs cs quot ;
 
 : walker-gadget-input walker-gadget-track walker-track-input ;
 
+: update-stacks ( walker -- )
+    meta-d get over walker-gadget-ds set-model
+    meta-r get over walker-gadget-rs set-model
+    meta-c get over walker-gadget-cs set-model
+    meta-callframe swap walker-gadget-quot set-model ;
+
+: with-walker ( walker quot -- )
+    swap dup walker-gadget-ns
+    [ slip update-stacks ] bind ; inline
+
 : walker-command ( button word -- )
-    unit swap find-walker-gadget walker-gadget-input
+    >r find-walker-gadget r> unit with-walker ;
-    interactor-call ;
 
 : <walker-toolbar> ( -- gadget )
     {
@@ -67,12 +77,6 @@ TUPLE: walker-gadget track ds rs cs quot ;
     gadget get walker-gadget-ds
     gadget get walker-gadget-quot ;
 
-: walker-listener-hook ( walker -- )
-    meta-d get over walker-gadget-ds set-model
-    meta-r get over walker-gadget-rs set-model
-    meta-c get over walker-gadget-cs set-model
-    meta-callframe swap walker-gadget-quot set-model ;
-
 : walker-stream ( walker -- stream )
     dup walker-gadget-input swap walker-gadget-pane
     <duplex-stream> ;
@@ -86,35 +90,48 @@ M: walker-gadget pref-dim*
 M: walker-gadget focusable-child* ( listener -- gadget )
     walker-gadget-input ;
 
-: init-walker ( -- )
+: walker-namestack ( walker -- ns )
-    [ walker-listener-hook ] curry listener-hook set
+    [ global , walker-stream stdio associate , ] V{ } make ;
-    "walk " listener-prompt set
+
+: walker-continuation ( -- continuation )
     continuation
-    V{ } clone over set-continuation-call
     V{ } clone over set-continuation-data
+    V{ } clone over set-continuation-retain
+    V{ } clone over set-continuation-call ;
+
+: init-walker ( walker -- )
+    H{ } clone over set-walker-gadget-ns
+    walker-continuation swap [
         set-meta-interp
-    [ ] (meta-call) ;
+        [ ] (meta-call)
+    ] with-walker ;
+
+: walker-call ( quot walker -- )
+    [ host-quot ] with-walker ;
+
+: (walk) ( quot walker -- )
+    [ meta-call ] with-walker ;
+
+: walker-listener ( walker -- )
+    [
+        dup init-walker
+        dup [ walker-call ] curry eval-hook set
+    ] listener ;
 
 : walker-thread ( walker -- )
     [
         init-namespaces
-        dup walker-stream [
+        dup walker-stream [ walker-listener ] with-stream*
-            [ init-walker clear ] listener
-        ] with-stream*
     ] in-thread drop ;
 
 C: walker-gadget ( -- gadget )
     dup init-walker-models {
         { [ <walker-toolbar> ] f f @top }
         { [ walker-models <walker-track> ] set-walker-gadget-track f @center }
-    } make-frame* dup walker-thread ;
+    } make-frame*
-
+    dup walker-thread ;
-: (walk) ( quot walker -- )
-    >r [ meta-call ] curry r>
-    walker-gadget-input interactor-call ;
 
 : walker-tool
     [ walker-gadget? ] [ <walker-gadget> ] [ (walk) ] ;
 
-: walk ( quot -- )
+: walk ( quot -- ) walker-tool call-tool ;
-    walker-tool call-tool ;