Improved deploy tool

core/bootstrap/ui/ui.factor

@@ -12,3 +12,5 @@ vocabs vocabs.loader ;
 
     "ui.freetype" require
 ] when
+
+macosx? [ "ui.tools.deploy" require ] when

extra/ui/gadgets/editors/editors.factor

@@ -37,13 +37,6 @@ TUPLE: loc-monitor editor ;
 : field-theme ( gadget -- )
     gray <solid> swap set-gadget-boundary ;
 
-: <field> ( model -- gadget )
-    drop
-    <editor>
-    2 <border>
-    { 1 0 } over set-border-fill
-    dup field-theme ;
-
 : construct-editor ( class -- tuple )
     >r <editor> { set-gadget-delegate } r>
     (construct-control) ; inline
@@ -435,3 +428,28 @@ M: editor stream-write
 M: editor stream-close drop ;
 
 M: editor stream-flush drop ;
+
+! Fields are like editors except they edit an external model
+TUPLE: field model editor ;
+
+: <field-border> ( gadget -- border )
+    2 <border>
+    { 1 0 } over set-border-fill
+    dup field-theme ;
+
+: <field> ( model -- gadget )
+    <editor> dup <field-border>
+    { set-field-model set-field-editor set-gadget-delegate }
+    field construct ;
+
+M: field graft*
+    dup field-model model-value
+    over field-editor set-editor-string
+    dup field-editor control-model add-connection ;
+
+M: field ungraft*
+    dup field-editor control-model remove-connection ;
+
+M: field model-changed
+    dup field-editor editor-string
+    swap field-model set-model ;

extra/ui/gadgets/worlds/worlds.factor

@@ -95,7 +95,6 @@ SYMBOL: ui-error-hook
             ] [
                 over <world-error> ui-error
                 f swap set-world-active?
-                drop
             ] recover
         ] with-variable
     ] [

extra/ui/tools/deploy/deploy.factor

@@ -5,7 +5,7 @@ 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 vocabs ui.tools.workspace ;
+tools.deploy.app vocabs ui.tools.workspace ui.operations ;
 IN: ui.tools.deploy
 
 TUPLE: deploy-gadget vocab settings ;
@@ -43,6 +43,7 @@ TUPLE: deploy-gadget vocab settings ;
 
 : <deploy-settings> ( -- control )
     default-config [ <model> ] assoc-map [
+        f <model> "bundle-name" set
         [
             bundle-name
             deploy-ui
@@ -61,7 +62,7 @@ TUPLE: deploy-gadget vocab settings ;
     find-deploy-gadget deploy-gadget-vocab ;
 
 : find-deploy-config
-    find-deploy-vocab deploy-config ;
+    find-deploy-vocab deploy.app-config ;
 
 : find-deploy-settings
     find-deploy-gadget deploy-gadget-settings ;
@@ -76,7 +77,7 @@ TUPLE: deploy-gadget vocab settings ;
 
 : com-deploy ( gadget -- )
     dup com-save
-    find-deploy-vocab [ deploy ] curry call-listener ;
+    find-deploy-vocab [ deploy.app ] curry call-listener ;
 
 : com-help ( -- )
     "ui-deploy" help-window ;
@@ -107,3 +108,5 @@ deploy-gadget "toolbar" f {
 : deploy-tool ( vocab -- )
     vocab-name dup <deploy-gadget> 10 <border>
     "Deploying \"" rot "\"" 3append open-window ;
+
+[ vocab-spec? ] \ deploy-tool H{ } define-operation

extra/ui/tools/operations/operations.factor

@@ -7,8 +7,7 @@ help.topics inference inspector io.files io.styles kernel
 namespaces parser prettyprint quotations tools.annotations
 editors tools.profiler tools.test tools.time tools.walker
 ui.commands ui.gadgets.editors ui.gestures ui.operations vocabs
-vocabs.loader words sequences tools.browser classes
+vocabs.loader words sequences tools.browser classes ;
-ui.tools.deploy ;
 IN: ui.tools.operations
 
 V{ } clone operations set-global
@@ -156,8 +155,6 @@ M: word com-stack-effect word-def com-stack-effect ;
     { +listener+ t }
 } define-operation
 
-[ vocab-spec? ] \ deploy-tool H{ } define-operation
-
 ! Quotations
 [ quotation? ] \ com-stack-effect H{
     { +keyboard+ T{ key-down f { C+ } "i" } }
@@ -184,13 +181,8 @@ M: word com-stack-effect word-def com-stack-effect ;
 } define-operation
 
 ! Profiler presentations
-[ usage-profile? ] \ com-show-profile H{
+[ dup usage-profile? swap vocab-profile? or ]
-    { +primary+ t }
+\ com-show-profile H{ { +primary+ t } } define-operation
-} define-operation
-
-[ vocab-profile? ] \ com-show-profile H{
-    { +primary+ t }
-} define-operation
 
 ! Operations -> commands
 source-editor