steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Actual colours for labeled gadgets

db4
nicolas-p 2015-07-22 19:18:13 +02:00 committed by John Benediktsson
parent 48376ff10c
commit d3b27e44b4
6 changed files with 39 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
basis/ui/gadgets/labeled/labeled.factor
View File

@ -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 )
<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
@ -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 ;

2
basis/ui/tools/browser/popups/popups.factor
View File

@ -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 ] }

13
basis/ui/tools/inspector/inspector.factor
View File

@ -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 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>> ;

2
basis/ui/tools/listener/completion/completion.factor
View File

@ -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 ] }

9
basis/ui/tools/listener/listener.factor
View File

@ -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 ;

18
basis/ui/tools/traceback/traceback.factor
View File

@ -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 )
[ '[ 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 ;