]> gitweb.factorcode.org Git - factor.git/commitdiff
tweak error list sorting, listener now shows error list summary in a separate pane
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 21 Apr 2009 05:14:30 +0000 (00:14 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 21 Apr 2009 05:14:30 +0000 (00:14 -0500)
basis/ui/tools/error-list/error-list.factor
basis/ui/tools/listener/listener.factor

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