Make source file error types a bit more extensible

basis/help/lint/lint.factor

@@ -15,6 +15,10 @@ TUPLE: help-lint-error < source-file-error ;
 
 SYMBOL: +help-lint-failure+
 
++help-lint-failure+
+"vocab:ui/tools/error-list/icons/help-lint-error.tiff"
+[ lint-failures get values ] define-error-type
+
 M: help-lint-error source-file-error-type drop +help-lint-failure+ ;
 
 <PRIVATE

basis/tools/test/test.factor

@@ -16,8 +16,11 @@ SYMBOL: +test-failure+
 M: test-failure source-file-error-type drop +test-failure+ ;
 
 SYMBOL: test-failures
+
 test-failures [ V{ } clone ] initialize
 
++test-failure+ "vocab:ui/tools/error-list/icons/unit-test-error.tiff" [ test-failures get ] define-error-type
+
 <PRIVATE
 
 : <test-failure> ( error experiment file line# -- triple )

basis/ui/tools/error-list/error-list.factor

@@ -2,8 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays sequences sorting assocs colors.constants fry
 combinators combinators.smart combinators.short-circuit editors make
-memoize compiler.errors compiler.units fonts kernel io.pathnames
+memoize compiler.units fonts kernel io.pathnames prettyprint
-prettyprint tools.test help.lint stack-checker.errors
 source-files.errors math.parser init math.order models models.arrow
 models.arrow.smart models.search models.mapping debugger namespaces
 summary locals ui ui.commands ui.gadgets ui.gadgets.panes
@@ -11,29 +10,15 @@ 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.gadgets.labels ui.baseline-alignment ui.images
+compiler.errors ;
 IN: ui.tools.error-list
 
-CONSTANT: error-types
+CONSTANT: source-file-icon
-    {
+    T{ image-name f "vocab:ui/tools/error-list/icons/source-file.tiff" }
-        +compiler-warning+
-        +compiler-error+
-        +test-failure+
-        +help-lint-failure+
-        +linkage-error+
-    }
 
-MEMO: error-list-icon ( object -- object )
+MEMO: error-icon ( type -- image-name )
-    "vocab:ui/tools/error-list/icons/" ".tiff" surround <image-name> ;
+    error-icon-path <image-name> ;
-
-: error-icon ( type -- icon )
-    {
-        { +compiler-error+ [ "compiler-error" ] }
-        { +compiler-warning+ [ "compiler-warning" ] }
-        { +test-failure+ [ "unit-test-error" ] }
-        { +help-lint-failure+ [ "help-lint-error" ] }
-        { +linkage-error+ [ "linkage-error" ] }
-    } case error-list-icon ;
 
 : <checkboxes> ( alist -- gadget )
     [ <shelf> { 15 0 } >>gap ] dip
@@ -51,9 +36,6 @@ error-toggle source-file-table error-table error-display ;
 
 SINGLETON: source-file-renderer
 
-: source-file-icon ( -- image-name )
-    "source-file" error-list-icon ;
-
 M: source-file-renderer row-columns
     drop first2
     [ [ source-file-icon ] [ ] [ length number>string ] tri* ] output>array ;
@@ -81,8 +63,8 @@ M: source-file-renderer filled-column drop 1 ;
         [ invoke-primary-operation ] >>action
         COLOR: dark-gray >>column-line-color
         6 >>gap
-        10 >>min-rows
+        5 >>min-rows
-        10 >>max-rows
+        5 >>max-rows
         60 >>min-cols
         60 >>max-cols
         t >>selection-required?
@@ -126,8 +108,8 @@ M: error-renderer column-alignment drop { 0 1 0 0 } ;
         [ invoke-primary-operation ] >>action
         COLOR: dark-gray >>column-line-color
         6 >>gap
-        20 >>min-rows
+        5 >>min-rows
-        20 >>max-rows
+        5 >>max-rows
         60 >>min-cols
         60 >>max-cols
         t >>selection-required?
@@ -199,11 +181,7 @@ SINGLETON: updater
 
 M: updater definitions-changed
     2drop
-    [
+    all-errors
-        compiler-errors get-global values %
-        test-failures get-global %
-        lint-failures get-global values %
-    ] { } make
     compiler-error-model get-global
     set-model ;
 
@@ -214,4 +192,4 @@ M: updater definitions-changed
 
 : error-list-window ( -- )
     compiler-error-model get-global <error-list-gadget>
-    "Compiler errors" open-status-window ;
+    "Errors" open-status-window ;

core/compiler/errors/errors.factor

@@ -5,8 +5,6 @@ continuations math math.parser accessors definitions
 source-files.errors ;
 IN: compiler.errors
 
-SYMBOLS: +compiler-error+ +compiler-warning+ +linkage-error+ ;
-
 TUPLE: compiler-error < source-file-error ;
 
 M: compiler-error source-file-error-type error>> source-file-error-type ;
@@ -15,6 +13,12 @@ SYMBOL: compiler-errors
 
 compiler-errors [ H{ } clone ] initialize
 
+SYMBOLS: +compiler-error+ +compiler-warning+ +linkage-error+ ;
+
++compiler-error+ "vocab:ui/tools/error-list/icons/compiler-error.tiff" [ compiler-errors get values ] define-error-type
++compiler-warning+ "vocab:ui/tools/error-list/icons/compiler-warning.tiff" [ f ] define-error-type
++linkage-error+ "vocab:ui/tools/error-list/icons/linkage-error.tiff" [ f ] define-error-type
+
 SYMBOL: with-compiler-errors?
 
 : errors-of-type ( type -- assoc )

core/source-files/errors/errors.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel math.order sorting sequences definitions ;
+USING: accessors assocs kernel math.order sorting sequences definitions
+namespaces arrays ;
 IN: source-files.errors
 
 TUPLE: source-file-error error asset file line# ;
@@ -28,3 +29,20 @@ GENERIC: source-file-error-type ( error -- type )
         [ swap file>> = ] [ swap source-file-error-type = ]
         bi-curry* bi and not
     ] 2curry filter-here ;
+
+SYMBOL: source-file-error-types
+
+source-file-error-types [ V{ } clone ] initialize
+
+: error-types ( -- seq ) source-file-error-types get keys ;
+
+: define-error-type ( type icon quot -- )
+    2array swap source-file-error-types get set-at ;
+
+: error-icon-path ( type -- icon )
+    source-file-error-types get at first ;
+
+: all-errors ( -- errors )
+    source-file-error-types get
+    [ second second call( -- seq ) ] map
+    concat ;