Actual colours for labeled gadgets

basis/ui/gadgets/labeled/labeled.factor

@@ -18,20 +18,20 @@ CONSTANT: title-bar-gradient { COLOR: white COLOR: grey90 }
 : add-title-bar ( title track -- track )
     swap >label
     [ t >>bold? ] change-font
-    { 0 5 } <border>
+    { 0 4 } <border>
     title-bar-gradient <gradient> >>interior
     f track-add ;
 
 : add-content ( content track -- track )
     swap 1 track-add ;
 
-: add-color-line ( track -- track )
+: add-color-line ( color track -- track )
     <shelf> { 0 1.5 } <border>
-    COLOR: yellow <solid> >>interior 
+    rot <solid> >>interior 
     f track-add ;
 
 : add-content-area ( labeled -- labeled )
-    dup content>>
+    [ ] [ content>> ] [ color>> ] tri
     vertical <track>
     add-color-line
     add-content
@@ -39,12 +39,13 @@ CONSTANT: title-bar-gradient { COLOR: white COLOR: grey90 }
 
 PRIVATE>
 
-: <labeled-gadget> ( gadget title -- labeled )
+: <labeled-gadget> ( gadget title color -- labeled )
     vertical labeled-gadget new-track with-lines
+    swap >>color
     add-title-bar
     swap >>content
     add-content-area ;
     
-: <framed-labeled-gadget> ( gadget title -- labeled )
+: <framed-labeled-gadget> ( gadget title color -- labeled )
     <labeled-gadget>
     COLOR: grey85 <solid> >>boundary ;

basis/ui/tools/browser/popups/popups.factor

@@ -33,7 +33,7 @@ TUPLE: links-popup < wrapper ;
 
 : <links-popup> ( model quot title -- gadget )
     [ <links-table> COLOR: white <solid> >>interior ] dip
-    <labeled-gadget> links-popup new-wrapper ;
+    COLOR: yellow <labeled-gadget> links-popup new-wrapper ;
 
 links-popup H{
     { T{ key-down f f "ESC" } [ hide-glass ] }

basis/ui/tools/inspector/inspector.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors inspector namespaces kernel models fry
+USING: accessors colors inspector namespaces kernel models fry
 colors.constants models.arrow prettyprint sequences mirrors assocs
 classes io io.styles arrays hashtables math.order sorting refs fonts
 ui.tools.browser ui.commands ui.operations ui.gadgets ui.gadgets.panes
@@ -81,13 +81,20 @@ M: hashtable make-slot-descriptions
         40 >>min-cols
         40 >>max-cols ;
 
+<PRIVATE
+
+CONSTANT: object-color COLOR: aquamarine2
+CONSTANT: contents-color COLOR: orchid2
+
+PRIVATE>
+
 : <inspector-gadget> ( model -- gadget )
     vertical inspector-gadget new-track with-lines
         add-toolbar
         swap >>model
         dup model>> <inspector-table> >>table
-        dup model>> <summary-gadget> margins white-interior "Object" <labeled-gadget> f track-add
+        dup model>> <summary-gadget> margins white-interior "Object" object-color <labeled-gadget> f track-add
-        dup table>> <scroller> white-interior "Contents" <labeled-gadget> 1 track-add ;
+        dup table>> <scroller> white-interior "Contents" contents-color <labeled-gadget> 1 track-add ;
 
 M: inspector-gadget focusable-child*
     table>> ;

basis/ui/tools/listener/completion/completion.factor

@@ -154,7 +154,7 @@ GENERIC# accept-completion-hook 1 ( item popup -- )
     [ vertical completion-popup new-track ] 2dip
     [ [ >>interactor ] [ >>completion-mode ] bi* ] [ <completion-table> >>table ] 2bi
     dup [ <completion-scroller> ] [ completion-mode>> completion-banner ] bi
-    <labeled-gadget> 1 track-add ;
+    COLOR: yellow <labeled-gadget> 1 track-add ;
 
 completion-popup H{
     { T{ key-down f f "TAB" } [ table>> row-action ] }

basis/ui/tools/listener/listener.factor

@@ -333,8 +333,15 @@ M: object accept-completion-hook 2drop ;
     [ history>> history-add drop ] [ control-value ] [ select-all ] tri
     parse-lines-interactive ;
 
+<PRIVATE
+
+CONSTANT: debugger-color COLOR: chocolate1
+
+PRIVATE>
+
 : <debugger-popup> ( error continuation -- popup )
-    over compute-restarts [ hide-glass ] <debugger> "Error" <framed-labeled-gadget> ;
+    over compute-restarts [ hide-glass ] <debugger> 
+    "Error" debugger-color <framed-labeled-gadget> ;
 
 : debugger-popup ( interactor error continuation -- )
     [ one-line-elt ] 2dip <debugger-popup> show-listener-popup ;

basis/ui/tools/traceback/traceback.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays continuations fonts fry inspector
+USING: accessors arrays colors.constants continuations fonts fry inspector
 kernel models models.arrow prettyprint sequences ui.commands
 ui.gadgets ui.gadgets.borders ui.gadgets.buttons
 ui.gadgets.labeled ui.gadgets.lines ui.gadgets.panes ui.gadgets.scrollers
@@ -21,6 +21,10 @@ M: stack-entry-renderer row-columns drop string>> 1array ;
 
 M: stack-entry-renderer row-value drop object>> ;
 
+CONSTANT: data-stack-color COLOR: DodgerBlue
+CONSTANT: retain-stack-color COLOR: HotPink
+CONSTANT: call-stack-color COLOR: GreenYellow
+
 : <stack-table> ( model -- table )
     [ [ <stack-entry> ] map ] <arrow> stack-entry-renderer <table>
         10 >>min-rows
@@ -31,20 +35,20 @@ M: stack-entry-renderer row-value drop object>> ;
         [ i:inspector ] >>action
         t >>single-click? ;
 
-: <stack-display> ( model quot title -- gadget )
+: <stack-display> ( model quot title color -- gadget )
-    [ '[ dup _ when ] <arrow> <stack-table> margins <scroller> white-interior ] dip
+    [ '[ dup _ when ] <arrow> <stack-table> margins <scroller> white-interior ] 2dip
-    <labeled-gadget> ;
+    <labeled-gadget> ; ! Il attend le titre en dernier
 
 : <callstack-display> ( model -- gadget )
     [ [ call>> callstack. ] when* ]
     <pane-control> t >>scrolls? margins <scroller> white-interior
-    "Call stack" <labeled-gadget> ;
+    "Call stack" call-stack-color <labeled-gadget> ;
 
 : <datastack-display> ( model -- gadget )
-    [ data>> ] "Data stack" <stack-display> ;
+    [ data>> ] "Data stack" data-stack-color <stack-display> ;
 
 : <retainstack-display> ( model -- gadget )
-    [ retain>> ] "Retain stack" <stack-display> ;
+    [ retain>> ] "Retain stack" retain-stack-color <stack-display> ;
 
 TUPLE: traceback-gadget < tool ;