! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays sequences sorting assocs colors.constants
-combinators combinators.smart combinators.short-circuit editors
+USING: accessors arrays sequences sorting assocs colors.constants fry
+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
-models.arrow models.search 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.images tools.test ;
+tools.test stack-checker.errors source-files.errors math.parser
+math.order models models.arrow 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 ;
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> ;
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 [
{
{ 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
:> 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
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