Error list: add toggles for different error types, source file icon

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

@@ -0,0 +1,20 @@
+IN: ui.tools.error-list
+USING: help.markup help.syntax ;
+
+ARTICLE: "ui.tools.error-list" "UI error list tool"
+"The error list tool displays messages generated by tools which process source files and definitions."
+$nl
+"The different types of messages displayed:"
+{ $table
+    { "Icon" "Message type" "Reference" }
+    { { $image "vocab:ui/tools/error-list/icons/note.tiff" } "Parser note" { $link "parser" } }
+    { { $image "vocab:ui/tools/error-list/icons/syntax-error.tiff" } "Syntax error" { $link "syntax" } }
+    { { $image "vocab:ui/tools/error-list/icons/compiler-warning.tiff" } "Compiler warning" { $link "compiler-errors" } }
+    { { $image "vocab:ui/tools/error-list/icons/compiler-error.tiff" } "Compiler error" { $link "compiler-errors" } }
+    { { $image "vocab:ui/tools/error-list/icons/unit-test-error.tiff" } "Unit test failure" { $link "tools.test" } }
+    { { $image "vocab:ui/tools/error-list/icons/help-lint-error.tiff" } "Help lint failure" { $link "help.lint" } }
+    { { $image "vocab:ui/tools/error-list/icons/linkage-error.tiff" } "Linkage error" { $link "compiler-errors" } }
+}
+"The " { $vocab-link "source-files.errors" } " vocabulary contains backend code used by this tool." ;
+
+ABOUT: "ui.tools.error-list"

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

@@ -1,33 +1,73 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays sequences sorting assocs colors.constants
+USING: accessors arrays sequences sorting assocs colors.constants fry
-combinators combinators.smart combinators.short-circuit editors
+combinators combinators.smart combinators.short-circuit editors memoize
 compiler.errors compiler.units fonts kernel io.pathnames prettyprint
-stack-checker.errors source-files.errors math.parser math.order models
+tools.test stack-checker.errors source-files.errors math.parser
-models.arrow models.search debugger namespaces summary locals ui
+math.order models models.arrow models.arrow.smart models.search
-ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.tables
+models.mapping debugger namespaces summary locals ui ui.commands
-ui.gadgets.labeled ui.gadgets.tracks ui.gestures ui.operations
+ui.gadgets ui.gadgets.panes ui.gadgets.tables ui.gadgets.labeled
-ui.tools.browser ui.tools.common ui.gadgets.scrollers
+ui.gadgets.tracks ui.gestures ui.operations ui.tools.browser
-ui.tools.inspector ui.gadgets.status-bar ui.operations
+ui.tools.common ui.gadgets.scrollers ui.tools.inspector
-ui.gadgets.buttons ui.gadgets.borders ui.images tools.test ;
+ui.gadgets.status-bar ui.operations ui.gadgets.buttons
+ui.gadgets.borders ui.gadgets.packs ui.gadgets.labels
+ui.baseline-alignment ui.images ;
 IN: ui.tools.error-list
 
-TUPLE: error-list-gadget < tool source-file error source-file-table error-table error-display ;
+CONSTANT: error-types
+    {
+        +compiler-warning+
+        +compiler-error+
+        +test-failure+
+        +linkage-error+
+    }
+
+MEMO: error-list-icon ( object -- object )
+    "vocab:ui/tools/error-list/icons/" ".tiff" surround <image-name> ;
+
+: error-icon ( type -- icon )
+    {
+        { +compiler-error+ [ "compiler-error" ] }
+        { +compiler-warning+ [ "compiler-warning" ] }
+        { +linkage-error+ [ "linkage-error" ] }
+        { +test-failure+ [ "unit-test-error" ] }
+    } case error-list-icon ;
+
+: <checkboxes> ( alist -- gadget )
+    [ <shelf> { 15 0 } >>gap ] dip
+    [ swap <checkbox> add-gadget ] assoc-each ;
+
+: <error-toggle> ( -- model gadget )
+    #! Linkage errors are not shown by default.
+    error-types [ dup +linkage-error+ eq? not <model> ] { } map>assoc
+    [ [ [ error-icon ] dip ] assoc-map <checkboxes> ]
+    [ <mapping> ] bi ;
+
+TUPLE: error-list-gadget < tool
+visible-errors source-file error
+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 length number>string 2array ;
+    drop first2
+    [ [ source-file-icon ] [ ] [ length number>string ] tri* ] output>array ;
+
+M: source-file-renderer prototype-row
+    drop source-file-icon "" "" 3array ;
 
 M: source-file-renderer row-value
     drop dup [ first <pathname> ] when ;
 
 M: source-file-renderer column-titles
-    drop { "File" "Errors" } ;
+    drop { "" "File" "Errors" } ;
 
-M: source-file-renderer column-alignment drop { 0 1 } ;
+M: source-file-renderer column-alignment drop { 0 0 1 } ;
 
-M: source-file-renderer filled-column drop 0 ;
+M: source-file-renderer filled-column drop 1 ;
 
 : <source-file-model> ( model -- model' )
     [ group-by-source-file >alist sort-keys ] <arrow> ;
@@ -48,15 +88,6 @@ M: source-file-renderer filled-column drop 0 ;
 
 SINGLETON: error-renderer
 
-: error-icon ( type -- icon )
-    {
-        { +compiler-error+ [ "compiler-error" ] }
-        { +compiler-warning+ [ "compiler-warning" ] }
-        { +linkage-error+ [ "linkage-error" ] }
-        { +test-failure+ [ "unit-test-error" ] }
-    } case
-    "vocab:ui/tools/error-list/icons/" ".tiff" surround <image-name> ;
-
 M: error-renderer row-columns
     drop [
         {
@@ -123,9 +154,16 @@ error-display "toolbar" f {
     { f com-edit }
 } define-command-map
 
+: <error-list-toolbar> ( error-list -- toolbar )
+    [ <toolbar> ] [ error-toggle>> "Show errors:" label-on-left add-gadget ] bi ;
+
+: <error-model> ( visible-errors model -- model' )
+    [ swap '[ source-file-error-type _ at ] filter ] <smart-arrow> ;
+
 :: <error-list-gadget> ( model -- gadget )
     vertical error-list-gadget new-track
-        model >>model
+        <error-toggle> [ >>error-toggle ] [ >>visible-errors ] bi*
+        dup visible-errors>> model <error-model> >>model 
         f <model> >>source-file
         f <model> >>error
         dup <source-file-table> >>source-file-table
@@ -134,6 +172,7 @@ error-display "toolbar" f {
     :> error-list
     error-list vertical <track>
         { 5 5 } >>gap
+        error-list <error-list-toolbar> f track-add
         error-list source-file-table>> <scroller> "Source files" <labeled-gadget> 1/4 track-add
         error-list error-table>> <scroller> "Errors" <labeled-gadget> 1/2 track-add
         error-list error-display>> "Details" <labeled-gadget> 1/4 track-add
@@ -142,7 +181,7 @@ error-display "toolbar" f {
 M: error-list-gadget focusable-child*
     source-file-table>> ;
 
-: error-list-help ( -- ) "ui-error-list" com-browse ;
+: error-list-help ( -- ) "ui.tools.error-list" com-browse ;
 
 \ error-list-help H{ { +nullary+ t } } define-command