steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui.tools.deploy: remove usages of 'gadget,', 'g', and 'g->'

db4
Eduardo Cavazos 2008-07-13 14:48:29 -05:00
parent 86f14db12d
commit 40d360c5a5
1 changed files with 50 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
extra/ui/tools/deploy/deploy.factor
View File

@ -1,44 +1,45 @@
! Copyright (C) 2007 Slava Pestov. ! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: ui.gadgets colors kernel ui.render namespaces USING: ui.gadgets colors kernel ui.render namespaces
models models.mapping sequences ui.gadgets.buttons models models.mapping sequences ui.gadgets.buttons
ui.gadgets.packs ui.gadgets.labels tools.deploy.config ui.gadgets.packs ui.gadgets.labels tools.deploy.config
namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
ui.commands assocs ui.gadgets.tracks ui ui.tools.listener ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
tools.deploy vocabs ui.tools.workspace system accessors ; tools.deploy vocabs ui.tools.workspace system accessors ;
IN: ui.tools.deploy IN: ui.tools.deploy
TUPLE: deploy-gadget < pack vocab settings ; TUPLE: deploy-gadget < pack vocab settings ;
: bundle-name ( -- ) : bundle-name ( parent -- parent )
deploy-name get <field> deploy-name get <field>
"Executable name:" label-on-left gadget, ; "Executable name:" label-on-left add-gadget ;
: deploy-ui ( -- ) : deploy-ui ( parent -- parent )
deploy-ui? get deploy-ui? get
"Include user interface framework" <checkbox> gadget, ; "Include user interface framework" <checkbox> add-gadget ;
: exit-when-windows-closed ( -- ) : exit-when-windows-closed ( parent -- parent )
"stop-after-last-window?" get "stop-after-last-window?" get
"Exit when last UI window closed" <checkbox> gadget, ; "Exit when last UI window closed" <checkbox> add-gadget ;
: io-settings ( -- ) : io-settings ( parent -- parent )
"Input/output support:" <label> gadget, "Input/output support:" <label> add-gadget
deploy-io get deploy-io-options <radio-buttons> gadget, ; deploy-io get deploy-io-options <radio-buttons> add-gadget ;
: reflection-settings ( -- ) : reflection-settings ( parent -- parent )
"Reflection support:" <label> gadget, "Reflection support:" <label> add-gadget
deploy-reflection get deploy-reflection-options <radio-buttons> gadget, ; deploy-reflection get deploy-reflection-options <radio-buttons> add-gadget ;
: advanced-settings ( -- ) : advanced-settings ( parent -- parent )
"Advanced:" <label> gadget, "Advanced:" <label> add-gadget
deploy-compiler? get "Use optimizing compiler" <checkbox> gadget, deploy-compiler? get "Use optimizing compiler" <checkbox> add-gadget
deploy-math? get "Rational and complex number support" <checkbox> gadget, deploy-math? get "Rational and complex number support" <checkbox> add-gadget
deploy-threads? get "Threading support" <checkbox> gadget, deploy-threads? get "Threading support" <checkbox> add-gadget
deploy-random? get "Random number generator support" <checkbox> gadget, deploy-random? get "Random number generator support" <checkbox> add-gadget
deploy-word-props? get "Retain all word properties" <checkbox> gadget, deploy-word-props? get "Retain all word properties" <checkbox> add-gadget
deploy-word-defs? get "Retain all word definitions" <checkbox> gadget, deploy-word-defs? get "Retain all word definitions" <checkbox> add-gadget
deploy-c-types? get "Retain all C types" <checkbox> gadget, ; deploy-c-types? get "Retain all C types" <checkbox> add-gadget ;
: deploy-settings-theme ( gadget -- ) : deploy-settings-theme ( gadget -- )
{ 10 10 } >>gap { 10 10 } >>gap
@ -46,17 +47,20 @@ TUPLE: deploy-gadget < pack vocab settings ;
drop ; drop ;
: <deploy-settings> ( vocab -- control ) : <deploy-settings> ( vocab -- control )
default-config [ <model> ] assoc-map [ default-config [ <model> ] assoc-map
[ [
bundle-name <pile>
deploy-ui bundle-name
os macosx? [ exit-when-windows-closed ] when deploy-ui
io-settings os macosx? [ exit-when-windows-closed ] when
reflection-settings io-settings
advanced-settings reflection-settings
] make-pile dup deploy-settings-theme advanced-settings
namespace <mapping> over set-gadget-model
] bind ; dup deploy-settings-theme
namespace <mapping> over set-gadget-model
]
bind ;
: find-deploy-gadget ( gadget -- deploy-gadget ) : find-deploy-gadget ( gadget -- deploy-gadget )
[ deploy-gadget? ] find-parent ; [ deploy-gadget? ] find-parent ;
@ -101,21 +105,16 @@ deploy-gadget "toolbar" f {
{ T{ key-down f f "RET" } com-deploy } { T{ key-down f f "RET" } com-deploy }
} define-command-map } define-command-map
: buttons, ( -- )
g <toolbar> { 10 10 } over set-pack-gap gadget, ;
: <deploy-gadget> ( vocab -- gadget ) : <deploy-gadget> ( vocab -- gadget )
deploy-gadget new-gadget deploy-gadget new-gadget
swap >>vocab over >>vocab
{ 0 1 } >>orientation { 0 1 } >>orientation
[ swap <deploy-settings> >>settings
g vocab>> <deploy-settings> dup settings>> add-gadget
g-> set-deploy-gadget-settings gadget, dup <toolbar> { 10 10 } >>gap add-gadget
buttons, dup deploy-settings-theme
] make-gadget dup com-revert ;
dup deploy-settings-theme
dup com-revert ;
: deploy-tool ( vocab -- ) : deploy-tool ( vocab -- )
vocab-name dup <deploy-gadget> 10 <border> vocab-name dup <deploy-gadget> 10 <border>
"Deploying \"" rot "\"" 3append open-window ; "Deploying \"" rot "\"" 3append open-window ;