tweak error list sorting, listener now shows error list summary in a separate pane

db4
Slava Pestov 2009-04-21 00:14:30 -05:00
parent 461ddfac1a
commit 782a2beff3
2 changed files with 25 additions and 17 deletions

View File

@ -97,7 +97,7 @@ M: error-renderer column-titles
M: error-renderer column-alignment drop { 0 1 0 0 } ; M: error-renderer column-alignment drop { 0 1 0 0 } ;
: sort-errors ( seq -- seq' ) : sort-errors ( seq -- seq' )
[ [ [ asset>> unparse-short ] [ line#>> ] bi 2array ] keep ] { } map>assoc [ [ [ line#>> ] [ asset>> unparse-short ] bi 2array ] keep ] { } map>assoc
sort-keys values ; sort-keys values ;
: file-matches? ( error pathname/f -- ? ) : file-matches? ( error pathname/f -- ? )

View File

@ -32,9 +32,10 @@ output history flag mailbox thread waiting token-model word-model popup ;
: interactor-busy? ( interactor -- ? ) : interactor-busy? ( interactor -- ? )
#! We're busy if there's no thread to resume. #! We're busy if there's no thread to resume.
[ waiting>> ] {
[ thread>> dup [ thread-registered? ] when ] [ waiting>> ]
bi and not ; [ thread>> dup [ thread-registered? ] when ]
} 1&& not ;
SLOT: vocabs SLOT: vocabs
@ -171,7 +172,7 @@ M: interactor dispose drop ;
over set-caret over set-caret
mark>caret ; mark>caret ;
TUPLE: listener-gadget < tool input output scroller ; TUPLE: listener-gadget < tool error-summary output scroller input ;
{ 600 700 } listener-gadget set-tool-dim { 600 700 } listener-gadget set-tool-dim
@ -181,17 +182,22 @@ TUPLE: listener-gadget < tool input output scroller ;
: listener-streams ( listener -- input output ) : listener-streams ( listener -- input output )
[ input>> ] [ output>> <pane-stream> ] bi ; [ input>> ] [ output>> <pane-stream> ] bi ;
: init-listener ( listener -- listener ) : init-input/output ( listener -- listener )
<interactor> <interactor>
[ >>input ] [ pane new-pane t >>scrolls? >>output ] bi [ >>input ] [ pane new-pane t >>scrolls? >>output ] bi
dup listener-streams >>output drop ; dup listener-streams >>output drop ;
: <listener-gadget> ( -- gadget ) : init-error-summary ( listener -- listener )
<pane> >>error-summary
dup error-summary>> f track-add ;
: <listener-gadget> ( -- listener )
vertical listener-gadget new-track vertical listener-gadget new-track
add-toolbar add-toolbar
init-listener init-input/output
dup output>> <scroller> >>scroller dup output>> <scroller> >>scroller
dup scroller>> 1 track-add ; dup scroller>> 1 track-add
init-error-summary ;
M: listener-gadget focusable-child* M: listener-gadget focusable-child*
input>> dup popup>> or ; input>> dup popup>> or ;
@ -357,18 +363,20 @@ interactor "completion" f {
{ T{ key-down f { C+ } "r" } history-completion-popup } { T{ key-down f { C+ } "r" } history-completion-popup }
} define-command-map } define-command-map
: ui-error-summary ( -- ) : ui-error-summary ( listener -- )
error-counts keys [ error-summary>> [
[ icon>> 1array \ $image prefix " " 2array ] { } map-as error-counts keys [
{ "Press " { $command tool "common" show-error-list } " to view errors." } [ icon>> 1array \ $image prefix " " 2array ] { } map-as
append print-element nl { "Press " { $command tool "common" show-error-list } " to view errors." }
] unless-empty ; append print-element
] unless-empty
] with-pane ;
: listener-thread ( listener -- ) : listener-thread ( listener -- )
dup listener-streams [ dup listener-streams [
[ com-browse ] help-hook set [ com-browse ] help-hook set
'[ [ _ input>> ] 2dip debugger-popup ] error-hook set [ '[ [ _ input>> ] 2dip debugger-popup ] error-hook set ]
[ ui-error-summary ] error-summary-hook set [ '[ _ ui-error-summary ] error-summary-hook set ] bi
tip-of-the-day. nl tip-of-the-day. nl
listener listener
] with-streams* ; ] with-streams* ;