Clean up interactor gadget

core/listener/listener.factor

@@ -14,10 +14,11 @@ SYMBOL: listener-hook
 
 GENERIC: stream-read-quot ( stream -- quot/f )
 
+: parse-lines-interactive ( lines -- quot/f )
+    [ parse-lines in get ] with-compilation-unit in set ;
+
 : read-quot-step ( lines -- quot/f )
-    [
+    [ parse-lines-interactive ] catch {
-        [ parse-lines in get ] with-compilation-unit in set
-    ] catch {
         { [ dup delegate unexpected-eof? ] [ 2drop f ] }
         { [ dup not ] [ drop ] }
         { [ t ] [ rethrow ] }

core/parser/parser.factor

@@ -301,9 +301,6 @@ SYMBOL: lexer-factory
 : parse-lines ( lines -- quot )
     lexer-factory get call (parse-lines) ;
 
-: parse ( str -- quot )
-    [ string-lines parse-lines ] with-compilation-unit ;
-
 ! Parsing word utilities
 : parse-effect ( -- effect )
     ")" parse-tokens { "--" } split1 dup [

extra/ui/gadgets/editors/editors.factor

@@ -62,10 +62,13 @@ M: editor ungraft*
 
 : editor-mark* ( editor -- loc ) editor-mark model-value ;
 
+: set-caret ( loc editor -- )
+    [ gadget-model validate-loc ] keep
+    editor-caret set-model ;
+
 : change-caret ( editor quot -- )
     over >r >r dup editor-caret* swap gadget-model r> call r>
-    [ gadget-model validate-loc ] keep
+    set-caret ; inline
-    editor-caret set-model ; inline
 
 : mark>caret ( editor -- )
     dup editor-caret* swap editor-mark set-model ;

extra/ui/tools/interactor/interactor.factor

@@ -11,20 +11,9 @@ IN: ui.tools.interactor
 TUPLE: interactor
 history output
 continuation quot busy?
-vars
+use
 help ;
 
-: interactor-use ( interactor -- seq )
-    use swap interactor-vars at ;
-
-: word-at-loc ( loc interactor -- word )
-    over [
-        [ gadget-model T{ one-word-elt } elt-string ] keep
-        interactor-use assoc-stack
-    ] [
-        2drop f
-    ] if ;
-
 : init-caret-help ( interactor -- )
     dup editor-caret 100 <delay> swap set-interactor-help ;
 
@@ -47,6 +36,14 @@ M: interactor ungraft*
     dup dup interactor-help remove-connection
     delegate ungraft* ;
 
+: word-at-loc ( loc interactor -- word )
+    over [
+        [ gadget-model T{ one-word-elt } elt-string ] keep
+        interactor-use assoc-stack
+    ] [
+        2drop f
+    ] if ;
+
 M: interactor model-changed
     2dup interactor-help eq? [
         swap model-value over word-at-loc swap show-summary
@@ -70,34 +67,36 @@ M: interactor model-changed
     t over set-interactor-busy?
     interactor-continuation schedule-thread-with ;
 
-: interactor-finish ( obj interactor -- )
+: interactor-finish ( interactor -- )
     [ editor-string ] keep
     [ interactor-input. ] 2keep
     [ add-interactor-history ] keep
-    dup gadget-model clear-doc
+    gadget-model clear-doc ;
-    interactor-continue ;
-
-: interactor-eval ( interactor -- )
-    [
-        [ editor-string ] keep dup interactor-quot call
-    ] in-thread drop ;
 
 : interactor-eof ( interactor -- )
-    f swap interactor-continue ;
+    dup interactor-busy? [
+        f over interactor-continue
+    ] unless drop ;
 
 : evaluate-input ( interactor -- )
-    dup interactor-busy? [ drop ] [ interactor-eval ] if ;
+    dup interactor-busy? [
+        [
+            [ control-value ] keep interactor-continue
+        ] in-thread
+    ] unless drop ;
 
-: interactor-yield ( interactor quot -- obj )
+: interactor-yield ( interactor -- obj )
-    over set-interactor-quot
     f over set-interactor-busy?
     [ set-interactor-continuation stop ] curry callcc1 ;
 
 M: interactor stream-readln
-    [ interactor-finish ] interactor-yield ;
+    [ interactor-yield ] keep interactor-finish first ;
 
 : interactor-call ( quot interactor -- )
-    2dup interactor-input. interactor-continue ;
+    dup interactor-busy? [
+        2dup interactor-input.
+        2dup interactor-continue
+    ] unless 2drop ;
 
 M: interactor stream-read
     swap dup zero? [
@@ -109,44 +108,41 @@ M: interactor stream-read
 M: interactor stream-read-partial
     stream-read ;
 
-: save-vars ( interactor -- )
+: save-use ( interactor -- )
-    { use in stdio lexer-factory } [ dup get ] H{ } map>assoc
+    use get swap set-interactor-use ;
-    swap set-interactor-vars ;
-
-: restore-vars ( interactor -- )
-    namespace swap interactor-vars update ;
 
 : go-to-error ( interactor error -- )
     dup parse-error-line 1- swap parse-error-col 2array
-    over [ gadget-model validate-loc ] keep
+    over set-caret
-    editor-caret set-model
     mark>caret ;
 
 : handle-parse-error ( interactor error -- )
     dup parse-error? [ 2dup go-to-error delegate ] when
     swap find-workspace debugger-popup ;
 
-: try-parse ( str interactor -- quot/error/f )
+: try-parse ( lines interactor -- quot/error/f )
     [
-        [
+        >r parse-lines-interactive r> save-use
-            [ restore-vars parse ] keep save-vars
     ] [
         >r f swap set-interactor-busy? drop r>
         dup delegate unexpected-eof? [ drop f ] when
-        ] recover
+    ] recover ;
-    ] with-scope ;
 
-: handle-interactive ( str/f interactor -- )
+: handle-interactive ( lines interactor -- quot/f ? )
     tuck try-parse {
-        { [ dup quotation? ] [ swap interactor-finish ] }
+        { [ dup quotation? ] [ nip t ] }
-        { [ dup not ] [ drop "\n" swap user-input ] }
+        { [ dup not ] [ drop "\n" swap user-input f f ] }
-        { [ t ] [ handle-parse-error ] }
+        { [ t ] [ handle-parse-error f f ] }
     } cond ;
 
 M: interactor stream-read-quot
-    [ save-vars ] keep
+    [ save-use ] keep
-    [ [ handle-interactive ] interactor-yield ] keep
+    [ interactor-yield ] keep over quotation? [
-    restore-vars ;
+        drop
+    ] [
+        [ handle-interactive ] keep swap
+        [ interactor-finish ] [ nip stream-read-quot ] if
+    ] if ;
 
 M: interactor pref-dim*
     0 over line-height 4 * 2array swap delegate pref-dim* vmax ;

extra/ui/tools/listener/listener.factor

@@ -96,8 +96,8 @@ M: listener-operation invoke-command ( target command -- )
     get-listener [ word-completion-string ] keep
     listener-gadget-input user-input ;
 
-: quot-action ( interactor -- quot )
+: quot-action ( interactor -- lines )
-    dup editor-string swap
+    dup control-value swap
     2dup add-interactor-history
     select-all ;
 

extra/ui/tools/operations/operations.factor

@@ -196,5 +196,5 @@ interactor
 "These commands operate on the entire contents of the input area."
 [ ]
 [ quot-action ]
-[ parse ]
+[ [ parse-lines ] with-compilation-unit ]
 define-operation-map