1 ! Copyright (C) 2009, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays sequences sorting assocs colors.constants fry
4 combinators combinators.smart combinators.short-circuit editors make
5 memoize compiler.units fonts kernel io.pathnames prettyprint
6 source-files.errors source-files.errors.debugger math.parser init math.order
7 models models.arrow models.arrow.smart models.search models.mapping debugger
8 namespaces summary locals ui ui.commands ui.gadgets ui.gadgets.panes
9 ui.gadgets.tables ui.gadgets.labeled ui.gadgets.tracks ui.gestures
10 ui.operations ui.tools.browser ui.tools.common ui.gadgets.scrollers
11 ui.tools.inspector ui.gadgets.status-bar
12 ui.gadgets.buttons ui.gadgets.borders ui.gadgets.packs
13 ui.gadgets.labels ui.baseline-alignment ui.images
14 compiler.errors tools.errors tools.errors.model ;
15 IN: ui.tools.error-list
17 CONSTANT: source-file-icon
18 T{ image-name f "vocab:ui/tools/error-list/icons/source-file.tiff" }
20 MEMO: error-icon ( type -- image-name )
21 error-icon-path <image-name> ;
23 : <checkboxes> ( alist -- gadget )
24 [ <shelf> { 15 0 } >>gap ] dip
25 [ swap <checkbox> add-gadget ] assoc-each ;
27 : <error-toggle> ( -- model gadget )
28 #! Linkage errors are not shown by default.
29 error-types get [ fatal?>> <model> ] assoc-map
30 [ [ [ error-icon ] dip ] assoc-map <checkboxes> ]
33 TUPLE: error-list-gadget < tool
34 visible-errors source-file error
35 error-toggle source-file-table error-table error-display ;
37 SINGLETON: source-file-renderer
39 M: source-file-renderer row-columns
42 [ +listener-input+ or ]
43 [ length number>string ] tri*
46 M: source-file-renderer prototype-row
47 drop source-file-icon "" "" 3array ;
49 M: source-file-renderer row-value
50 drop dup [ first [ <pathname> ] [ f ] if* ] when ;
52 M: source-file-renderer row-value? row-value = ;
54 M: source-file-renderer column-titles
55 drop { "" "File" "Errors" } ;
57 M: source-file-renderer column-alignment drop { 0 0 1 } ;
59 M: source-file-renderer filled-column drop 1 ;
61 : <source-file-model> ( model -- model' )
62 [ group-by-source-file sort-keys ] <arrow> ;
64 :: <source-file-table> ( error-list -- table )
65 error-list model>> <source-file-model>
68 [ invoke-primary-operation ] >>action
69 COLOR: dark-gray >>column-line-color
75 t >>selection-required?
76 error-list source-file>> >>selection ;
78 SINGLETON: error-renderer
80 M: error-renderer row-columns
83 [ error-type error-icon ]
84 [ line#>> [ number>string ] [ "" ] if* ]
85 [ asset>> [ unparse-short ] [ "" ] if* ]
86 [ error>> safe-summary ]
90 M: error-renderer prototype-row
91 drop [ +compiler-error+ error-icon "" "" "" ] output>array ;
93 M: error-renderer row-value
96 M: error-renderer column-titles
97 drop { "" "Line" "Asset" "Error" } ;
99 M: error-renderer column-alignment drop { 0 1 0 0 } ;
101 : sort-errors ( seq -- seq' )
102 [ [ [ line#>> 0 or ] [ asset>> unparse-short ] bi 2array ] keep ] { } map>assoc
105 : file-matches? ( error pathname/f -- ? )
106 [ file>> ] [ dup [ string>> ] when ] bi* = ;
108 : <error-table-model> ( error-list -- model )
109 [ model>> ] [ source-file>> ] bi
110 [ file-matches? ] <search>
111 [ sort-errors ] <arrow> ;
113 :: <error-table> ( error-list -- table )
114 error-list <error-table-model>
117 [ invoke-primary-operation ] >>action
118 COLOR: dark-gray >>column-line-color
124 t >>selection-required?
125 error-list error>> >>selection ;
127 TUPLE: error-display < track ;
129 : <error-display> ( error-list -- gadget )
130 vertical error-display new-track
133 dup model>> [ [ print-error ] when* ] <pane-control> <scroller> 1 track-add ;
135 : com-inspect ( error-display -- )
136 control-value [ inspector ] when* ;
138 : com-help ( error-display -- )
139 control-value [ error>> error-help-window ] when* ;
141 : com-edit ( error-display -- )
142 control-value [ edit-error ] when* ;
144 error-display "toolbar" f {
150 : <error-list-toolbar> ( error-list -- toolbar )
151 [ <toolbar> ] [ error-toggle>> "Show errors:" label-on-left add-gadget ] bi ;
153 : <error-model> ( visible-errors model -- model' )
154 [ swap '[ error-type _ at ] filter ] <smart-arrow> ;
156 :: <error-list-gadget> ( model -- gadget )
157 vertical \ error-list-gadget new-track
158 <error-toggle> [ >>error-toggle ] [ >>visible-errors ] bi*
159 dup visible-errors>> model <error-model> >>model
160 f <model> >>source-file
162 dup <source-file-table> >>source-file-table
163 dup <error-table> >>error-table
164 dup <error-display> >>error-display
166 error-list vertical <track>
168 error-list <error-list-toolbar> f track-add
169 error-list source-file-table>> <scroller> "Source files" <labeled-gadget> 1/4 track-add
170 error-list error-table>> <scroller> "Errors" <labeled-gadget> 1/4 track-add
171 error-list error-display>> "Details" <labeled-gadget> 1/2 track-add
172 { 5 5 } <filled-border> 1 track-add ;
174 M: error-list-gadget focusable-child*
175 source-file-table>> ;
177 : error-list-help ( -- ) "ui.tools.error-list" com-browse ;
179 \ error-list-help H{ { +nullary+ t } } define-command
181 \ error-list-gadget "toolbar" f {
182 { T{ key-down f f "F1" } error-list-help }
185 MEMO: get-error-list-gadget ( -- gadget )
186 error-list-model get-global [ drop all-errors ] <arrow>
187 <error-list-gadget> ;
189 [ \ get-error-list-gadget reset-memoized ] "ui.tools.error-list" add-startup-hook
191 : show-error-list ( -- )
192 [ get-error-list-gadget eq? ] find-window
193 [ raise-window ] [ get-error-list-gadget "Errors" open-status-window ] if* ;
195 \ show-error-list H{ { +nullary+ t } } define-command