Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / ui / tools / listener / listener.factor

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index 6484b8e1c4f9c366c58f952e1a83187193887110..4b9a4a1ef37644e511755bea9d4e4bdbf98755fd 100644 (file)
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -6,14 +6,15 @@ compiler.units help.tips concurrency.flags concurrency.mailboxes
 continuations destructors documents documents.elements fry hashtables
 help help.markup io io.styles kernel lexer listener math models sets
 models.delay models.arrow namespaces parser prettyprint quotations
-sequences strings threads tools.vocabs vocabs vocabs.loader
+sequences strings threads vocabs vocabs.refresh vocabs.loader
 vocabs.parser words debugger ui ui.commands ui.pens.solid ui.gadgets
 ui.gadgets.glass ui.gadgets.buttons ui.gadgets.editors
 ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers
 ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures
 ui.operations ui.tools.browser ui.tools.common ui.tools.debugger
 ui.tools.listener.completion ui.tools.listener.popups
-ui.tools.listener.history ui.tools.error-list ;
+ui.tools.listener.history ui.images ui.tools.error-list
+tools.errors.model ;
 FROM: source-files.errors => all-errors ;
 IN: ui.tools.listener
 
@@ -32,17 +33,17 @@ output history flag mailbox thread waiting token-model word-model popup ;
 
 : interactor-busy? ( interactor -- ? )
     #! We're busy if there's no thread to resume.
-    [ waiting>> ]
-    [ thread>> dup [ thread-registered? ] when ]
-    bi and not ;
+    {
+        [ waiting>> ]
+        [ thread>> dup [ thread-registered? ] when ]
+    } 1&& not ;
 
-SLOT: vocabs
+SLOT: manifest
 
-M: interactor vocabs>>
+M: interactor manifest>>
     dup interactor-busy? [ drop f ] [
-        use swap
         interactor-continuation name>>
-        assoc-stack
+        manifest swap assoc-stack
     ] if ;
 
 : vocab-exists? ( name -- ? )
@@ -54,7 +55,9 @@ M: vocab-completion (word-at-caret)
     drop dup vocab-exists? [ >vocab-link ] [ drop f ] if ;
 
 M: word-completion (word-at-caret)
-    vocabs>> assoc-stack ;
+    manifest>> dup [
+        '[ _ _ search-manifest ] [ drop f ] recover
+    ] [ 2drop f ] if ;
 
 M: char-completion (word-at-caret)
     2drop f ;
@@ -167,11 +170,11 @@ M: interactor stream-read1
 M: interactor dispose drop ;
 
 : go-to-error ( interactor error -- )
-    [ line>> 1- ] [ column>> ] bi 2array
+    [ line>> 1 - ] [ column>> ] bi 2array
     over set-caret
     mark>caret ;
 
-TUPLE: listener-gadget < tool input output scroller ;
+TUPLE: listener-gadget < tool error-summary output scroller input ;
 
 { 600 700 } listener-gadget set-tool-dim
 
@@ -181,17 +184,35 @@ TUPLE: listener-gadget < tool input output scroller ;
 : listener-streams ( listener -- input output )
     [ input>> ] [ output>> <pane-stream> ] bi ;
 
-: init-listener ( listener -- listener )
+: init-input/output ( listener -- listener )
     <interactor>
     [ >>input ] [ pane new-pane t >>scrolls? >>output ] bi
     dup listener-streams >>output drop ;
 
-: <listener-gadget> ( -- gadget )
+: error-summary. ( -- )
+    error-counts keys [
+        H{ { table-gap { 3 3 } } } [
+            [ [ [ icon>> write-image ] with-cell ] each ] with-row
+        ] tabular-output
+        { "Press " { $command tool "common" show-error-list } " to view errors." }
+        print-element
+    ] unless-empty ;
+
+: <error-summary> ( -- gadget )
+    error-list-model get [ drop error-summary. ] <pane-control>
+        COLOR: light-yellow <solid> >>interior ;
+
+: init-error-summary ( listener -- listener )
+    <error-summary> >>error-summary
+    dup error-summary>> f track-add ;
+
+: <listener-gadget> ( -- listener )
     vertical listener-gadget new-track
         add-toolbar
-        init-listener
+        init-input/output
         dup output>> <scroller> >>scroller
-        dup scroller>> 1 track-add ;
+        dup scroller>> 1 track-add
+        init-error-summary ;
 
 M: listener-gadget focusable-child*
     input>> dup popup>> or ;
@@ -280,15 +301,16 @@ M: listener-operation invoke-command ( target command -- )
 : clear-stack ( listener -- )
     [ [ clear ] \ clear ] dip (call-listener) ;
 
-: use-if-necessary ( word seq -- )
+: use-if-necessary ( word manifest -- )
     2dup [ vocabulary>> ] dip and [
-        2dup [ assoc-stack ] keep = [ 2drop ] [
-            [ vocabulary>> vocab-words ] dip push
-        ] if
+        manifest [
+            [ vocabulary>> use-vocab ]
+            [ dup name>> associate use-words ] bi
+        ] with-variable
     ] [ 2drop ] if ;
 
 M: word accept-completion-hook
-    interactor>> vocabs>> use-if-necessary ;
+    interactor>> manifest>> use-if-necessary ;
 
 M: object accept-completion-hook 2drop ;
 
@@ -357,18 +379,11 @@ interactor "completion" f {
     { T{ key-down f { C+ } "r" } history-completion-popup }
 } define-command-map
 
-: ui-error-summary ( -- )
-    error-counts keys [
-        [ icon>> 1array \ $image prefix " " 2array ] { } map-as
-        { "Press " { $command tool "common" show-error-list } " to view errors." }
-        append print-element nl
-    ] unless-empty ;
-
 : listener-thread ( listener -- )
     dup listener-streams [
         [ com-browse ] help-hook set
         '[ [ _ input>> ] 2dip debugger-popup ] error-hook set
-        [ ui-error-summary ] error-summary-hook set
+        error-summary? off
         tip-of-the-day. nl
         listener
     ] with-streams* ;
@@ -429,4 +444,4 @@ M: listener-gadget graft*
     [ call-next-method ] [ restart-listener ] bi ;
 
 M: listener-gadget ungraft*
-    [ com-end ] [ call-next-method ] bi ;
\ No newline at end of file
+    [ com-end ] [ call-next-method ] bi ;