Improved deploy tool

extra/tools/deploy/config/config.factor

@@ -47,6 +47,7 @@ SYMBOL: deploy-image
 
 : default-config ( -- assoc )
     V{
+        { deploy-ui?                f }
         { deploy-io                 2 }
         { deploy-reflection         1 }
         { deploy-compiler?          t }

extra/ui/gadgets/editors/editors.factor

@@ -37,10 +37,11 @@ TUPLE: loc-monitor editor ;
 : field-theme ( gadget -- )
     gray <solid> swap set-gadget-boundary ;
 
-: <field> ( model -- )
+: <field> ( model -- gadget )
     drop
     <editor>
     2 <border>
+    { 1 0 } over set-border-fill
     dup field-theme ;
 
 : construct-editor ( class -- tuple )

extra/ui/gadgets/labels/labels.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays hashtables io kernel math namespaces
 opengl sequences io.streams.lines strings splitting
-ui.gadgets ui.gadgets.controls ui.gadgets.packs ui.gadgets.theme
+ui.gadgets ui.gadgets.controls ui.gadgets.tracks
-ui.render colors ;
+ui.gadgets.theme ui.render colors ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.
@@ -55,7 +55,7 @@ M: object >label ;
 M: f >label drop <gadget> ;
 
 : label-on-left ( gadget label -- button )
-    [ >label gadget, gadget, ] make-shelf ;
+    [ >label f track, 1 track, ] { 1 0 } make-track ;
 
 : label-on-right ( label gadget -- button )
-    [ gadget, >label gadget, ] make-shelf ;
+    [ f track, >label 1 track, ] { 1 0 } make-track ;

extra/ui/gadgets/packs/packs.factor

@@ -71,3 +71,7 @@ M: pack children-on ( rect gadget -- seq )
 
 : make-shelf ( quot -- pack )
     <shelf> make-gadget ; inline
+
+: build-pack ( quot quot orientation -- pack )
+    <pack> build-gadget ; inline
+

extra/ui/tools/deploy/deploy.factor

@@ -5,13 +5,18 @@ ui.gadgets.controls models sequences ui.gadgets.buttons
 ui.gadgets.packs ui.gadgets.labels tools.deploy.config
 namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
 ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
-tools.deploy.app vocabs ;
+tools.deploy vocabs ui.tools.workspace ;
 IN: ui.tools.deploy
 
 TUPLE: deploy-gadget vocab settings ;
 
 : bundle-name ( -- )
-    "bundle-name" get <field> "Bundle name:" label-on-left gadget, ;
+    "bundle-name" get <field>
+    "Bundle name:" label-on-left gadget, ;
+
+: deploy-ui ( -- )
+    deploy-ui? get
+    "Include user interface framework" <checkbox> gadget, ;
 
 : exit-when-windows-closed ( -- )
     "stop-after-last-window?" get
@@ -40,6 +45,7 @@ TUPLE: deploy-gadget vocab settings ;
     default-config [ <model> ] assoc-map [
         [
             bundle-name
+            deploy-ui
             exit-when-windows-closed
             io-settings
             reflection-settings
@@ -70,22 +76,34 @@ TUPLE: deploy-gadget vocab settings ;
 
 : com-deploy ( gadget -- )
     dup com-save
-    find-deploy-vocab [ deploy.app ] curry call-listener ;
+    find-deploy-vocab [ deploy ] curry call-listener ;
+
+: com-help ( -- )
+    "ui-deploy" help-window ;
+
+\ com-help H{
+    { +nullary+ t }
+} define-command
 
 deploy-gadget "toolbar" f {
+    { f com-help }
     { f com-revert }
     { f com-save }
     { T{ key-down f f "RETURN" } com-deploy }
 } define-command-map
 
+: buttons,
+    g <toolbar> { 10 10 } over set-pack-gap gadget, ;
+
 : <deploy-gadget> ( vocab -- gadget )
     dup f deploy-gadget construct-boa [
         <deploy-settings>
-        g-> set-deploy-gadget-settings
+        g-> set-deploy-gadget-settings gadget,
-        10 <border> 1 track,
+        buttons,
-        toolbar,
+    ] { 0 1 } build-pack
-    ] { 0 1 } build-track dup com-revert ;
+    dup deploy-settings-theme
+    dup com-revert ;
 
 : deploy-tool ( vocab -- )
-    vocab-name dup <deploy-gadget>
+    vocab-name dup <deploy-gadget> 10 <border>
     "Deploying \"" rot "\"" 3append open-window ;