Fixed compatibility issue with labeled gadget

db4
nicolas-p 2015-07-25 09:39:46 +02:00 committed by John Benediktsson
parent 18a4171572
commit f4e8511c0a
8 changed files with 28 additions and 16 deletions
basis/ui
gadgets
tools

View File

@ -18,6 +18,7 @@ CONSTANT: errors-color COLOR: chocolate1
CONSTANT: details-color COLOR: SlateGray2
CONSTANT: debugger-color COLOR: chocolate1
CONSTANT: completion-color COLOR: magenta
CONSTANT: data-stack-color COLOR: DodgerBlue
CONSTANT: retain-stack-color COLOR: HotPink

View File

@ -37,13 +37,24 @@ M: labeled-gadget focusable-child* content>> ;
PRIVATE>
: <labeled-gadget> ( gadget title color -- labeled )
: <labeled> ( 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 color -- labeled )
<labeled-gadget>
COLOR: grey85 <solid> >>boundary ;
: <framed-labeled> ( gadget title color -- labeled )
<labeled> COLOR: grey85 <solid> >>boundary ;
: <labeled-gadget> ( gadget title -- labeled )
vertical labeled-gadget new-track with-lines
add-title-bar
swap >>content dup content>>
vertical <track>
add-content
{ 5 5 } <border>
content-background <solid> >>interior
1 track-add
COLOR: grey85 <solid> >>boundary
{ 3 3 } <border> ;

View File

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

View File

@ -168,11 +168,11 @@ error-display "toolbar" f {
error-list vertical <track> with-lines
error-list <error-list-toolbar> f track-add
error-list source-file-table>> margins <scroller> white-interior
"Source files" source-files-color <labeled-gadget> 1/4 track-add
"Source files" source-files-color <labeled> 1/4 track-add
error-list error-table>> margins <scroller> white-interior
"Errors" errors-color <labeled-gadget> 1/4 track-add
"Errors" errors-color <labeled> 1/4 track-add
error-list error-display>>
"Details" details-color <labeled-gadget> 1/2 track-add
"Details" details-color <labeled> 1/2 track-add
1 track-add ;
M: error-list-gadget focusable-child*

View File

@ -86,8 +86,8 @@ M: hashtable make-slot-descriptions
add-toolbar
swap >>model
dup model>> <inspector-table> >>table
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 ;
dup model>> <summary-gadget> margins white-interior "Object" object-color <labeled> f track-add
dup table>> <scroller> white-interior "Contents" contents-color <labeled> 1 track-add ;
M: inspector-gadget focusable-child*
table>> ;

View File

@ -4,7 +4,7 @@ USING: accessors arrays assocs calendar colors colors.constants
documents documents.elements fry kernel words sets splitting math
math.vectors models.delay models.arrow combinators.short-circuit
parser present sequences tools.completion help.vocabs generic fonts
definitions.icons ui.images ui.commands ui.operations ui.gadgets
definitions.icons ui.images ui.commands ui.operations ui.gadgets ui.gadgets.colors
ui.gadgets.editors ui.gadgets.glass ui.gadgets.scrollers
ui.gadgets.tables ui.gadgets.tracks ui.gadgets.labeled
ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.pens.solid
@ -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
COLOR: yellow <labeled-gadget> 1 track-add ;
completion-color <framed-labeled> 1 track-add ;
completion-popup H{
{ T{ key-down f f "TAB" } [ table>> row-action ] }

View File

@ -335,7 +335,7 @@ M: object accept-completion-hook 2drop ;
: <debugger-popup> ( error continuation -- popup )
over compute-restarts [ hide-glass ] <debugger>
"Error" debugger-color <framed-labeled-gadget> ;
"Error" debugger-color <framed-labeled> ;
: debugger-popup ( interactor error continuation -- )
[ one-line-elt ] 2dip <debugger-popup> show-listener-popup ;

View File

@ -33,12 +33,12 @@ M: stack-entry-renderer row-value drop object>> ;
: <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
<labeled> ;
: <callstack-display> ( model -- gadget )
[ [ call>> callstack. ] when* ]
<pane-control> t >>scrolls? margins <scroller> white-interior
"Call stack" call-stack-color <labeled-gadget> ;
"Call stack" call-stack-color <labeled> ;
: <datastack-display> ( model -- gadget )
[ data>> ] "Data stack" data-stack-color <stack-display> ;