: 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 )
- <shelf> { 0 1.5 } <border>
- COLOR: yellow <solid> >>interior
+: add-color-line ( color track -- track )
+ <shelf> { 0 1.5 } <border>
+ rot <solid> >>interior
f track-add ;
: add-content-area ( labeled -- labeled )
- dup content>>
+ [ ] [ content>> ] [ color>> ] tri
vertical <track>
add-color-line
add-content
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 ;
: <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 ] }
! 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
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 table>> <scroller> white-interior "Contents" <labeled-gadget> 1 track-add ;
+ dup model>> <summary-gadget> margins white-interior "Object" object-color <labeled-gadget> f track-add
+ dup table>> <scroller> white-interior "Contents" contents-color <labeled-gadget> 1 track-add ;
M: inspector-gadget focusable-child*
table>> ;
[ 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 ] }
[ 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 ;
! 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
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
[ i:inspector ] >>action
t >>single-click? ;
-: <stack-display> ( model quot title -- gadget )
- [ '[ dup _ when ] <arrow> <stack-table> margins <scroller> white-interior ] dip
- <labeled-gadget> ;
+: <stack-display> ( model quot title color -- gadget )
+ [ '[ dup _ when ] <arrow> <stack-table> margins <scroller> white-interior ] 2dip
+ <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 ;