Definition browser looks better

library/ui/gadgets/sliders.factor

@@ -129,7 +129,7 @@ M: elevator layout*
 : slide-by-line ( -1/1 slider -- ) >r 32 * r> slide-by ;
 
 : <slide-button> ( vector polygon amount -- )
-    >r { 0.5 0.5 0.5 1.0 } swap <polygon-gadget> r>
+    >r gray swap <polygon-gadget> r>
     [ swap slide-by-line ] curry <repeat-button>
     [ set-gadget-orientation ] keep ;
 

library/ui/gadgets/theme.factor

@@ -16,17 +16,15 @@ DEFER: set-editor-font
 IN: gadgets-theme
 USING: arrays gadgets kernel sequences styles ;
 
-: solid-black T{ solid f { 0.0 0.0 0.0 1.0 } } ;
+: black { 0.0 0.0 0.0 1.0 } ;
+: white { 1.0 1.0 1.0 1.0 } ;
+: gray { 0.6 0.6 0.6 1.0 } ;
 
-: solid-white T{ solid f { 1.0 1.0 1.0 1.0 } } ;
+: solid-interior white <solid> swap set-gadget-interior ;
 
-: solid-interior solid-white swap set-gadget-interior ;
+: solid-boundary black <solid> swap set-gadget-boundary ;
 
-: solid-boundary solid-black swap set-gadget-boundary ;
+: faint-boundary gray <solid> swap set-gadget-boundary ;
-
-: faint T{ solid f { 0.62 0.62 0.62 0.8 } } ;
-
-: faint-boundary faint swap set-gadget-boundary ;
 
 : plain-gradient
     T{ gradient f {
@@ -72,7 +70,7 @@ USING: arrays gadgets kernel sequences styles ;
     plain-gradient over set-gadget-interior faint-boundary ;
 
 : roll-button-theme ( button -- )
-    f solid-black solid-black f <button-paint>
+    f black <solid> dup f <button-paint>
     swap set-gadget-boundary ;
 
 : caret-theme ( caret -- )
@@ -86,19 +84,19 @@ USING: arrays gadgets kernel sequences styles ;
     } } swap set-gadget-interior ;
 
 : reverse-video-theme ( label -- )
-    { 1.0 1.0 1.0 1.0 } over set-label-color
+    white over set-label-color
-    solid-black swap set-gadget-interior ;
+    black <solid> swap set-gadget-interior ;
 
 : label-theme ( gadget -- )
-    { 0.0 0.0 0.0 1.0 } over set-label-color
+    black over set-label-color
     { "sans-serif" plain 12 } swap set-label-font ;
 
 : text-theme ( gadget -- )
-    { 0.0 0.0 0.0 1.0 } over set-label-color
+    black over set-label-color
     { "monospace" plain 12 } swap set-label-font ;
 
 : editor-theme ( editor -- )
-    { 0.0 0.0 0.0 1.0 } over set-editor-color
+    black over set-editor-color
     { 1.0 0.0 0.0 1.0 } over set-editor-caret-color
     { 0.8 0.8 1.0 1.0 } over set-editor-selection-color
     { "monospace" plain 12 } swap set-editor-font ;
@@ -110,5 +108,11 @@ USING: arrays gadgets kernel sequences styles ;
 : menu-theme ( gadget -- )
     T{ solid f { 0.95 0.95 0.95 0.95 } }
     over set-gadget-interior
-    T{ solid f { 0.7 0.7 0.7 1.0 } }
+    gray <solid> swap set-gadget-boundary ;
-    swap set-gadget-boundary ;
+
+: title-theme ( gadget -- )
+    { 1 0 } over set-gadget-orientation
+    T{ gradient f {
+        { 0.65 0.65 1.0 1.0 }
+        { 0.65 0.45 1.0 1.0 }
+    } } swap set-gadget-interior ;

library/ui/paint.factor

@@ -117,6 +117,7 @@ M: polygon draw-interior
 : arrow-right { { 0 0 } { 6 3 } { 0 6 } } ;
 : arrow-down  { { 0 0 } { 6 0 } { 3 6 } } ;
 : arrow-left  { { 0 3 } { 6 0 } { 6 6 } } ;
+: close-box   { { 0 0 } { 6 0 } { 6 6 } { 0 6 } } ;
 
 : <polygon-gadget> ( color points -- gadget )
     dup max-dim

library/ui/tools/browser.factor

@@ -38,18 +38,15 @@ TUPLE: tile definition gadget ;
     definitions-showing delete
     unparent ;
 
-: <tile-content> ( definition toolbar -- gadget )
+: <tile-content> ( definition -- gadget )
-    >r [ see ] make-pane r> 2array
+    [ [ see ] make-pane <default-border> ] keep
-    make-pile { 5 5 } over set-pack-gap
+    unparse [ find-tile close-tile ] <labelled-gadget>
-    <default-border> dup faint-boundary ;
+    dup faint-boundary ;
 
 C: tile ( definition -- gadget )
-    2dup { tile } <toolbar>
+    over <tile-content> over set-gadget-delegate
-    <tile-content> over set-gadget-delegate
     [ set-tile-definition ] keep ;
 
-tile "toolbar" { { "Close" f [ close-tile ] } } define-commands
-
 : show-definition ( definition definitions -- )
     2dup definition-index dup 0 >= [
         over nth-gadget swap scroll>rect drop

library/ui/tools/listener.factor

@@ -59,7 +59,7 @@ C: listener-gadget ( -- gadget )
         {
             [ <listener-input> ]
             set-listener-gadget-input
-            [ <scroller> "Input" <labelled-gadget> ]
+            [ <scroller> "Input" f <labelled-gadget> ]
             1/6
         }
     } { 0 1 } make-track* ;

library/ui/tools/messages.factor

@@ -44,10 +44,10 @@ M: messages batch-ends
     <messages-button> gadget. ;
 
 : <errors> ( gadget -- newgadget )
-    <scroller> "Compiler errors" <labelled-gadget> ;
+    <scroller> "Compiler errors" f <labelled-gadget> ;
 
 : <warnings> ( gadget -- newgadget )
-    <scroller> "Compiler warnings" <labelled-gadget> ;
+    <scroller> "Compiler warnings" f <labelled-gadget> ;
 
 C: messages ( -- gadget )
     {

library/ui/tools/search.factor

@@ -130,7 +130,8 @@ C: history-search ( string seq -- gadget )
     live-search-list list-value ;
 
 : show-titled-popup ( workspace gadget title -- )
-    <labelled-gadget> swap show-popup ;
+    [ find-workspace hide-popup ] <labelled-gadget>
+    swap show-popup ;
 
 : workspace-listener ( workspace -- listener )
     listener-gadget swap find-tool tool-gadget nip ;

library/ui/ui.factor

@@ -139,9 +139,24 @@ C: titled-gadget ( gadget title -- )
 
 TUPLE: labelled-gadget content ;
 
-C: labelled-gadget ( gadget title -- gadget )
+: <close-box> ( quot -- button/f )
+    gray close-box <polygon-gadget> swap <bevel-button> ;
+
+: <title-label> <label> dup title-theme ;
+
+: <title-bar> ( title quot -- gadget )
+    [
+        {
+            { [ <close-box> ] f f @left }
+            { [ <title-label> ] f f @center }
+        } make-frame
+    ] [
+        <title-label>
+    ] if* ;
+
+C: labelled-gadget ( gadget title quot -- gadget )
     {
-        { [ <label> dup reverse-video-theme ] f f @top }
+        { [ <title-bar> ] f f @top }
         { f set-labelled-gadget-content f @center }
     } make-frame* ;
 
@@ -149,7 +164,7 @@ M: labelled-gadget focusable-child* labelled-gadget-content ;
 
 : <labelled-pane> ( model quot title -- gadget )
     >r <pane-control> t over set-pane-scrolls? <scroller> r>
-    <labelled-gadget> ;
+    f <labelled-gadget> ;
 
 : pane-window ( quot title -- )
     >r make-pane <scroller> r> open-titled-window ;