Split off some code into tools.errors.model and update UI listener's error summary...

diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index 4234a0023b4d9c09a38ed307b33e8f89fc263c7a..d96e0df6c1f59d9d0f8faa30abc5465c8849ead3 100644 (file)
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -60,7 +60,7 @@ SYMBOL: max-stack-items
 
 10 max-stack-items set-global
 
-SYMBOL: error-summary-hook
+SYMBOL: error-summary?
 
 <PRIVATE
 
@@ -99,13 +99,8 @@ SYMBOL: error-summary-hook
     in get auto-use? get [ " - auto" append ] when "( " " )" surround
     H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
 
-[ error-summary ] error-summary-hook set-global
-
-: call-error-summary-hook ( -- )
-    error-summary-hook get call( -- ) ;
-
 :: (listener) ( datastack -- )
-    call-error-summary-hook
+    error-summary? get [ error-summary ] when
     visible-vars.
     datastack datastack.
     prompt.

diff --git a/basis/tools/errors/errors.factor b/basis/tools/errors/errors.factor
index ccedf365e3d209389f1f7d3bd3273ebfdf2beb00..b53d4ef7a2a6578caa20fe9ba4ef0562cded2449 100644 (file)
--- a/basis/tools/errors/errors.factor
+++ b/basis/tools/errors/errors.factor
@@ -22,7 +22,7 @@ M: source-file-error summary
 
 M: source-file-error error.
     [ summary print nl ]
-    [ "Asset: " write asset>> short. nl ]
+    [ asset>> [ "Asset: " write short. nl ] when* ]
     [ error>> error. ]
     tri ;
 

diff --git a/basis/tools/errors/model/authors.txt b/basis/tools/errors/model/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
+++ b/basis/tools/errors/model/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file

diff --git a/basis/tools/errors/model/model.factor b/basis/tools/errors/model/model.factor
new file mode 100644 (file)
index 0000000..c874363
--- /dev/null
+++ b/basis/tools/errors/model/model.factor
@@ -0,0 +1,18 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: models source-files.errors namespaces models.delay init
+kernel calendar ;
+IN: tools.errors.model
+
+SYMBOLS: (error-list-model) error-list-model ;
+
+(error-list-model) [ f <model> ] initialize
+
+error-list-model [ (error-list-model) get-global 100 milliseconds <delay> ] initialize
+
+SINGLETON: updater
+
+M: updater errors-changed drop f (error-list-model) get-global set-model ;
+
+[ updater add-error-observer ] "ui.tools.error-list" add-init-hook
+

diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor
index 5a4fb7376af3d464d0b73eecaaaa8e9def34ac8e..aa23a8ebe18445b9ad4ab4dc0b9f5bcc5e48e006 100644 (file)
--- a/basis/ui/tools/error-list/error-list.factor
+++ b/basis/ui/tools/error-list/error-list.factor
@@ -4,14 +4,14 @@ USING: accessors arrays sequences sorting assocs colors.constants fry
 combinators combinators.smart combinators.short-circuit editors make
 memoize compiler.units fonts kernel io.pathnames prettyprint
 source-files.errors math.parser init math.order models models.arrow
-models.arrow.smart models.search models.mapping models.delay debugger
+models.arrow.smart models.search models.mapping debugger
 namespaces summary locals ui ui.commands ui.gadgets ui.gadgets.panes
 ui.gadgets.tables ui.gadgets.labeled ui.gadgets.tracks ui.gestures
 ui.operations ui.tools.browser ui.tools.common ui.gadgets.scrollers
 ui.tools.inspector ui.gadgets.status-bar ui.operations
 ui.gadgets.buttons ui.gadgets.borders ui.gadgets.packs
 ui.gadgets.labels ui.baseline-alignment ui.images ui.tools.listener
-compiler.errors calendar tools.errors ;
+compiler.errors tools.errors tools.errors.model ;
 IN: ui.tools.error-list
 
 CONSTANT: source-file-icon
@@ -180,23 +180,9 @@ error-list-gadget "toolbar" f {
     { T{ key-down f f "F1" } error-list-help }
 } define-command-map
 
-SYMBOL: error-list-model
-
-error-list-model [ f <model> ] initialize
-
-SINGLETON: updater
-
-M: updater errors-changed
-    drop f error-list-model get-global set-model ;
-
-[ updater add-error-observer ] "ui.tools.error-list" add-init-hook
-
-: <error-list-model> ( -- model )
-    error-list-model get-global
-    1/2 seconds <delay> [ drop all-errors ] <arrow> ;
-
 : error-list-window ( -- )
-    <error-list-model> <error-list-gadget> "Errors" open-status-window ;
+    error-list-model get [ drop all-errors ] <arrow>
+    <error-list-gadget> "Errors" open-status-window ;
 
 : show-error-list ( -- )
     [ error-list-gadget? ] find-window

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index 3a1c68fa2523ba308573ef57114f5eb55e05a557..eca16e72862ca1db9b1ca9f1d62c1f48f1360efb 100644 (file)
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -13,7 +13,7 @@ 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
 
@@ -187,8 +187,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
@@ -366,22 +376,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* ;