1 ! Copyright (C) 2007 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: ui.gadgets colors kernel ui.render namespaces
4 models models.mapping sequences ui.gadgets.buttons
5 ui.gadgets.packs ui.gadgets.labels tools.deploy.config
6 namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
7 ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
8 tools.deploy vocabs ui.tools.workspace system accessors ;
12 TUPLE: deploy-gadget < pack vocab settings ;
14 : bundle-name ( parent -- parent )
15 deploy-name get <field>
16 "Executable name:" label-on-left add-gadget ;
18 : deploy-ui ( parent -- parent )
20 "Include user interface framework" <checkbox> add-gadget ;
22 : exit-when-windows-closed ( parent -- parent )
23 "stop-after-last-window?" get
24 "Exit when last UI window closed" <checkbox> add-gadget ;
26 : io-settings ( parent -- parent )
27 "Input/output support:" <label> add-gadget
28 deploy-io get deploy-io-options <radio-buttons> add-gadget ;
30 : reflection-settings ( parent -- parent )
31 "Reflection support:" <label> add-gadget
32 deploy-reflection get deploy-reflection-options <radio-buttons> add-gadget ;
34 : advanced-settings ( parent -- parent )
35 "Advanced:" <label> add-gadget
36 deploy-compiler? get "Use optimizing compiler" <checkbox> add-gadget
37 deploy-math? get "Rational and complex number support" <checkbox> add-gadget
38 deploy-threads? get "Threading support" <checkbox> add-gadget
39 deploy-random? get "Random number generator support" <checkbox> add-gadget
40 deploy-word-props? get "Retain all word properties" <checkbox> add-gadget
41 deploy-word-defs? get "Retain all word definitions" <checkbox> add-gadget
42 deploy-c-types? get "Retain all C types" <checkbox> add-gadget ;
44 : deploy-settings-theme ( gadget -- gadget )
48 : <deploy-settings> ( vocab -- control )
49 default-config [ <model> ] assoc-map
54 os macosx? [ exit-when-windows-closed ] when
60 namespace <mapping> >>model
64 : find-deploy-gadget ( gadget -- deploy-gadget )
65 [ deploy-gadget? ] find-parent ;
67 : find-deploy-vocab ( gadget -- vocab )
68 find-deploy-gadget vocab>> ;
70 : find-deploy-config ( gadget -- config )
71 find-deploy-vocab deploy-config ;
73 : find-deploy-settings ( gadget -- settings )
74 find-deploy-gadget settings>> ;
76 : com-revert ( gadget -- )
77 dup find-deploy-config
78 swap find-deploy-settings set-control-value ;
80 : com-save ( gadget -- )
81 dup find-deploy-settings control-value
82 swap find-deploy-vocab set-deploy-config ;
84 : com-deploy ( gadget -- )
86 dup find-deploy-vocab [ deploy ] curry call-listener
90 "ui.tools.deploy" help-window ;
96 : com-close ( gadget -- )
99 deploy-gadget "toolbar" f {
104 { T{ key-down f f "RET" } com-deploy }
107 : <deploy-gadget> ( vocab -- gadget )
108 deploy-gadget new-gadget
110 { 0 1 } >>orientation
111 swap <deploy-settings> >>settings
112 dup settings>> add-gadget
113 dup <toolbar> { 10 10 } >>gap add-gadget
114 deploy-settings-theme
117 : deploy-tool ( vocab -- )
118 vocab-name dup <deploy-gadget> 10 <border>
119 "Deploying \"" rot "\"" 3append open-window ;