From 0550b28e904f39efa93a205f1ebdba39aae3a6b1 Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 31 Jul 2006 03:20:08 +0000 Subject: [PATCH] Different walker interaction style --- TODO.FACTOR.txt | 4 -- doc/handbook/tools.facts | 1 - library/tools/interpreter.factor | 2 +- library/tools/listener.factor | 9 ++-- library/tools/listener.facts | 6 --- library/ui/tools/listener.factor | 3 +- library/ui/tools/walker.factor | 75 ++++++++++++++++++++------------ 7 files changed, 53 insertions(+), 47 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 052ad4c568..5778873e41 100644 --- a/TODO.FACTOR.txt +++ b/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 - - 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 diff --git a/doc/handbook/tools.facts b/doc/handbook/tools.facts index fce8ad3e59..1242eeda0f 100644 --- a/doc/handbook/tools.facts +++ b/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 } ; diff --git a/library/tools/interpreter.factor b/library/tools/interpreter.factor index ab8dff8027..e866c9cb30 100644 --- a/library/tools/interpreter.factor +++ b/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) ; diff --git a/library/tools/listener.factor b/library/tools/listener.factor index f03be82b60..7d27810b45 100644 --- a/library/tools/listener.factor +++ b/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 - [ read-multiline [ call ] [ bye ] if ] try ; + listener-prompt get write flush [ + 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 ; diff --git a/library/tools/listener.facts b/library/tools/listener.facts index e7dd7db6eb..863092b251 100644 --- a/library/tools/listener.facts +++ b/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." } ; diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index d97dfac2df..f0135e2f23 100644 --- a/library/ui/tools/listener.factor +++ b/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> - listener-gadget-stack set-model ; + >r datastack r> listener-gadget-stack set-model ; : listener-stream ( listener -- stream ) dup listener-gadget-input swap listener-gadget-output diff --git a/library/ui/tools/walker.factor b/library/ui/tools/walker.factor index 0a74e405ae..0e5db811c5 100644 --- a/library/ui/tools/walker.factor +++ b/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 -gadgets-panes gadgets-scrolling gadgets-text gadgets-tiles -gadgets-tracks generic inspector interpreter io kernel listener -math models namespaces sequences shells threads ; +USING: arrays gadgets gadgets-buttons gadgets-frames +gadgets-listener gadgets-panes gadgets-scrolling gadgets-text +gadgets-tiles gadgets-tracks generic hashtables inspector +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 ) { [ ] set-walker-track-input [ ] 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 - interactor-call ; + >r find-walker-gadget r> unit with-walker ; : ( -- 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 ; @@ -86,35 +90,48 @@ M: walker-gadget pref-dim* M: walker-gadget focusable-child* ( listener -- gadget ) walker-gadget-input ; -: init-walker ( -- ) - [ walker-listener-hook ] curry listener-hook set - "walk " listener-prompt set +: walker-namestack ( walker -- ns ) + [ global , walker-stream stdio associate , ] V{ } make ; + +: walker-continuation ( -- continuation ) continuation - V{ } clone over set-continuation-call V{ } clone over set-continuation-data - set-meta-interp - [ ] (meta-call) ; + 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) + ] 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 [ - [ init-walker clear ] listener - ] with-stream* + dup walker-stream [ walker-listener ] with-stream* ] in-thread drop ; C: walker-gadget ( -- gadget ) dup init-walker-models { { [ ] f f @top } { [ walker-models ] set-walker-gadget-track f @center } - } make-frame* dup walker-thread ; - -: (walk) ( quot walker -- ) - >r [ meta-call ] curry r> - walker-gadget-input interactor-call ; + } make-frame* + dup walker-thread ; : walker-tool [ walker-gadget? ] [ ] [ (walk) ] ; -: walk ( quot -- ) - walker-tool call-tool ; +: walk ( quot -- ) walker-tool call-tool ;