]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/ui/tools/listener/listener.factor
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
index 3a1c68fa2523ba308573ef57114f5eb55e05a557..4b9a4a1ef37644e511755bea9d4e4bdbf98755fd 100644 (file)
@@ -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.images ;
+ui.tools.listener.history ui.images ui.tools.error-list
+tools.errors.model ;
 FROM: source-files.errors => all-errors ;
 IN: ui.tools.listener
 
@@ -37,13 +38,12 @@ output history flag mailbox thread waiting token-model word-model popup ;
         [ 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 -- ? )
@@ -55,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 ;
@@ -168,7 +170,7 @@ 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 ;
 
@@ -187,8 +189,18 @@ TUPLE: listener-gadget < tool error-summary output scroller input ;
     [ >>input ] [ pane new-pane t >>scrolls? >>output ] bi
     dup listener-streams >>output drop ;
 
+: 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 )
-    <pane> COLOR: light-yellow <solid> >>interior ;
+    error-list-model get [ drop error-summary. ] <pane-control>
+        COLOR: light-yellow <solid> >>interior ;
 
 : init-error-summary ( listener -- listener )
     <error-summary> >>error-summary
@@ -289,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 ;
 
@@ -366,22 +379,11 @@ interactor "completion" f {
     { T{ key-down f { C+ } "r" } history-completion-popup }
 } define-command-map
 
-: error-summary. ( listener -- )
-    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
-    ] with-pane ;
-
 : listener-thread ( listener -- )
     dup listener-streams [
         [ com-browse ] help-hook set
-        [ '[ [ _ input>> ] 2dip debugger-popup ] error-hook set ]
-        [ '[ _ error-summary. ] error-summary-hook set ] bi
+        '[ [ _ input>> ] 2dip debugger-popup ] error-hook set
+        error-summary? off
         tip-of-the-day. nl
         listener
     ] with-streams* ;
@@ -442,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 ;