1 ! Copyright (C) 2009, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
4 USING: accessors arrays assocs calendar colors combinators
5 combinators.smart compiler.errors debugger editors init
6 io.pathnames kernel math.parser models models.arrow
7 models.arrow.smart models.delay models.mapping models.search
8 namespaces prettyprint sequences sorting source-files.errors
9 source-files.errors.debugger summary ui ui.commands ui.gadgets
10 ui.gadgets.buttons ui.gadgets.labeled ui.gadgets.labels
11 ui.gadgets.packs ui.gadgets.panes ui.gadgets.scrollers
12 ui.gadgets.status-bar ui.gadgets.tables ui.gadgets.toolbar
13 ui.gadgets.tracks ui.gestures ui.images ui.operations ui.theme
14 ui.tools.browser ui.tools.common ui.tools.inspector ;
16 IN: ui.tools.error-list
18 CONSTANT: source-file-icon
19 T{ image-name f "vocab:ui/tools/error-list/icons/source-file.png" }
21 MEMO: error-icon ( type -- image-name )
22 error-icon-path <image-name> ;
24 : <checkboxes> ( alist -- gadget )
25 [ <shelf> { 15 0 } >>gap ] dip
26 [ swap <checkbox> add-gadget ] assoc-each ;
28 : <error-toggle> ( -- model gadget )
29 ! Linkage errors are not shown by default.
30 error-types get [ fatal?>> <model> ] assoc-map
31 [ [ [ error-icon ] dip ] assoc-map <checkboxes> ]
34 TUPLE: error-list-gadget < tool
35 visible-errors source-file error
36 error-toggle source-file-table error-table error-display ;
38 SINGLETON: source-file-renderer
40 M: source-file-renderer row-columns
43 [ +listener-input+ or ]
44 [ length number>string ] tri*
47 M: source-file-renderer prototype-row
48 drop source-file-icon "" "" 3array ;
50 M: source-file-renderer row-value
51 drop dup [ first [ <pathname> ] [ f ] if* ] when ;
53 M: source-file-renderer row-value? row-value = ;
55 M: source-file-renderer column-titles
56 drop { "" "File" "Errors" } ;
58 M: source-file-renderer column-alignment drop { 0 0 1 } ;
60 M: source-file-renderer filled-column drop 1 ;
62 : <source-file-model> ( model -- model' )
63 [ group-by-source-file sort-keys ] <arrow> ;
65 :: <source-file-table> ( error-list -- table )
66 error-list model>> <source-file-model>
69 [ invoke-primary-operation ] >>action
70 COLOR: dark-gray >>column-line-color
76 t >>selection-required?
77 error-list source-file>> >>selection ;
79 SINGLETON: error-renderer
81 M: error-renderer row-columns
84 [ error-type error-icon ]
85 [ line#>> [ number>string ] [ "" ] if* ]
86 [ asset>> [ unparse-short ] [ "" ] if* ]
87 [ error>> safe-summary ]
91 M: error-renderer prototype-row
92 drop [ +compiler-error+ error-icon "" "" "" ] output>array ;
94 M: error-renderer row-value
97 M: error-renderer column-titles
98 drop { "" "Line" "Asset" "Error" } ;
100 M: error-renderer column-alignment drop { 0 1 0 0 } ;
102 : sort-errors ( seq -- seq' )
103 [ [ [ line#>> 0 or ] [ asset>> unparse-short ] bi 2array ] keep ] { } map>assoc
106 : file-matches? ( error pathname/f -- ? )
107 [ path>> ] [ dup [ string>> ] when ] bi* = ;
109 : <error-table-model> ( error-list -- model )
110 [ model>> ] [ source-file>> ] bi
111 [ file-matches? ] <search>
112 [ sort-errors ] <arrow> ;
114 :: <error-table> ( error-list -- table )
115 error-list <error-table-model>
118 [ invoke-primary-operation ] >>action
119 COLOR: dark-gray >>column-line-color
125 t >>selection-required?
126 error-list error>> >>selection ;
128 TUPLE: error-display < track ;
130 : <error-display> ( error-list -- gadget )
131 vertical error-display new-track with-lines
133 dup model>> [ [ print-error ] when* ] <pane-control>
134 margins <scroller> white-interior 1 track-add
137 : com-inspect ( error-display -- )
138 control-value [ inspector ] when* ;
140 : com-help ( error-display -- )
141 control-value [ error>> error-help-window ] when* ;
143 : com-edit ( error-display -- )
144 control-value [ edit-error ] when* ;
146 error-display "toolbar" f {
152 : <error-list-toolbar> ( error-list -- toolbar )
153 [ <toolbar> ] [ error-toggle>> "Show errors:" label-on-left f track-add ] bi
156 : <error-model> ( visible-errors model -- model' )
157 [ swap '[ error-type _ at ] filter ] <smart-arrow> ;
159 :: <error-list-gadget> ( model -- gadget )
160 vertical error-list-gadget new-track
161 <error-toggle> [ >>error-toggle ] [ >>visible-errors ] bi*
162 dup visible-errors>> model <error-model> >>model
163 f <model> >>source-file
165 dup <source-file-table> >>source-file-table
166 dup <error-table> >>error-table
167 dup <error-display> >>error-display
169 error-list vertical <track> with-lines
170 error-list <error-list-toolbar> f track-add
171 error-list source-file-table>> margins <scroller> white-interior
172 "Source files" source-files-color <colored-labeled-gadget> 1/4 track-add
173 error-list error-table>> margins <scroller> white-interior
174 "Errors" errors-color <colored-labeled-gadget> 1/4 track-add
175 error-list error-display>>
176 "Details" details-color <colored-labeled-gadget> 1/2 track-add
179 M: error-list-gadget focusable-child*
180 source-file-table>> ;
182 SYMBOLS: error-list-model ;
184 SINGLETON: error-list-updater
186 M: error-list-updater errors-changed
187 drop f error-list-model get-global model>> set-model ;
189 : error-list-help ( -- ) "ui.tools.error-list" com-browse ;
191 \ error-list-help H{ { +nullary+ t } } define-command
193 \ error-list-gadget "toolbar" f {
194 { T{ key-down f f "F1" } error-list-help }
197 : error-list-window ( -- )
198 error-list-model get-global [ drop all-errors ] <arrow>
199 <error-list-gadget> "Errors" open-status-window ;
201 : show-error-list ( -- )
202 [ error-list-gadget? ] find-window
203 [ raise-window ] [ error-list-window ] if* ;
205 \ show-error-list H{ { +nullary+ t } } define-command
208 f <model> 100 milliseconds <delay> error-list-model set-global
209 error-list-updater add-error-observer
210 ] "ui.tools.error-list" add-startup-hook