ui.tools.listener: call interactor-finish before try-parse #375

Also changes the parse error handling in try-parse. If a parse error
occurs it is wrapped in a small quotation to defer handling it until the
quotation is ran.

basis/ui/tools/listener/listener-tests.factor

@@ -1,7 +1,7 @@
 USING: accessors arrays calendar concurrency.promises continuations
-documents io kernel listener math namespaces parser threads tools.test
+documents io kernel lexer listener math namespaces parser quotations
-ui.gadgets.debug ui.gadgets.editors ui.gadgets.panes ui.gestures
+sequences threads tools.test ui.gadgets.debug ui.gadgets.editors
-ui.tools.common ui.tools.listener ;
+ui.gadgets.panes ui.gestures ui.tools.common ui.tools.listener ;
 IN: ui.tools.listener.tests
 
 [
@@ -35,7 +35,7 @@ IN: ui.tools.listener.tests
 
     [ ] [ "interactor" get register-self ] unit-test
 
-    [ ] [ <promise> "promise" set ] unit-test
+    { } [ <promise> "promise" set ] unit-test
 
     [
         self "interactor" get thread<<
@@ -95,7 +95,9 @@ IN: ui.tools.listener.tests
 
     [ ] [ "interactor" get interactor-eof ] unit-test
 
-    [ { "Hello\nWorld\n" f } ] [ "promise" get 5 seconds ?promise-timeout ] unit-test
+    { { "Hello\nWorld\n" f } } [
+        "promise" get 5 seconds ?promise-timeout
+    ] unit-test
 ] with-interactive-vocabs
 
 ! Hang
@@ -203,3 +205,21 @@ CONSTANT: text "Hello world.\nThis is a test."
     T{ key-down f f "DOWN" } T{ key-down f { C+ } "n" }
     [ <interactor> get-gesture-handler ] same?
 ] unit-test
+
+! stream-read-quot
+{ [ 3 4 + ] } [
+    <listener-gadget> input>> [ register-self ] keep
+    [ { "3 4 +" } swap interactor-continue ] keep
+    stream-read-quot
+] unit-test
+
+! try-parse
+{ t } [
+    { "goga" } try-parse
+    [ callable? ] [ length 2 = ] [ first lexer-error? ] tri and and
+] unit-test
+
+{ [ sq ] t } [
+    { "sq" } try-parse
+    { "[" } try-parse first lexer-error?
+] unit-test

basis/ui/tools/listener/listener.factor

@@ -4,14 +4,14 @@ USING: accessors arrays assocs calendar combinators
 combinators.short-circuit concurrency.flags concurrency.mailboxes
 continuations destructors documents documents.elements fry hashtables
 help help.markup help.tips io io.styles kernel lexer listener locals
-make math models models.arrow models.delay namespaces parser
+math models models.arrow models.delay namespaces parser prettyprint
-prettyprint quotations sequences source-files.errors strings system
+quotations sequences source-files.errors strings system threads
-threads tools.errors.model ui ui.commands ui.gadgets
+tools.errors.model ui ui.commands ui.gadgets ui.gadgets.editors
-ui.gadgets.editors ui.gadgets.glass ui.gadgets.labeled
+ui.gadgets.glass ui.gadgets.labeled ui.gadgets.panes
-ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar
+ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.theme
-ui.gadgets.theme ui.gadgets.toolbar ui.gadgets.tracks ui.gestures
+ui.gadgets.toolbar ui.gadgets.tracks ui.gestures ui.operations
-ui.operations ui.pens.solid ui.tools.browser ui.tools.common
+ui.pens.solid ui.tools.browser ui.tools.common ui.tools.debugger
-ui.tools.debugger ui.tools.error-list ui.tools.listener.completion
+ui.tools.error-list ui.tools.listener.completion
 ui.tools.listener.history ui.tools.listener.popups vocabs
 vocabs.loader vocabs.parser vocabs.refresh words ;
 IN: ui.tools.listener
@@ -98,11 +98,8 @@ M: input (print-input)
     [ string>> H{ { font-style bold } } format ] with-nesting nl ;
 
 M: word (print-input)
-    "Command: "
+    "Command: " H{ { font-name "sans-serif" } { font-style bold } }
-    [
+    format . ;
-        "sans-serif" font-name ,,
-        bold font-style ,,
-    ] H{ } make format . ;
 
 : print-input ( object interactor -- )
     output>> [ (print-input) ] with-output-stream* ;
@@ -331,28 +328,14 @@ M: object accept-completion-hook 2drop ;
 : debugger-popup ( interactor error continuation -- )
     [ one-line-elt ] 2dip <debugger-popup> show-listener-popup ;
 
-: handle-parse-error ( interactor error -- )
+: try-parse ( lines -- quot/f )
-    dup lexer-error? [ 2dup go-to-error error>> ] when
+    [ parse-lines-interactive ] [ nip '[ _ rethrow ] ] recover ;
-    error-continuation get
-    debugger-popup ;
-
-: try-parse ( lines -- quot/f/error )
-    [ read-quot-step ] [ nip ] recover ;
-
-: handle-interactive ( interactor lines -- quot/f )
-    try-parse dup quotation? [ nip ] [
-        dup not [ drop insert-newline ] [
-            handle-parse-error
-        ] if f
-    ] if ;
 
 M: interactor stream-read-quot ( stream -- quot/f )
-    dup interactor-yield dup [ not ] [ callable? ] bi or
+    dup interactor-yield dup array? [
-    [ nip ] [
+        over interactor-finish try-parse
-        dupd handle-interactive dup quotation? [
+        [ nip ] [ stream-read-quot ] if*
-            swap interactor-finish
+    ] [ nip ] if ;
-        ] [ drop stream-read-quot ] if
-    ] if ;
 
 : interactor-operation ( gesture interactor -- ? )
     [ token-model>> value>> ] keep word-at-caret