Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-07-13 15:51:05 -05:00
commit 92fb077a94
3 changed files with 64 additions and 61 deletions

View File

@ -49,6 +49,10 @@ M: track pref-dim*
: track-add ( gadget track constraint -- )
over track-sizes push swap add-gadget drop ;
: track-add* ( track gadget constraint -- track )
pick sizes>> push
add-gadget ;
: track, ( gadget constraint -- )
gadget get swap track-add ;

View File

@ -7,6 +7,7 @@ ui.gadgets.viewports ui.gadgets.lists ui.gadgets.tracks
ui.gadgets.scrollers ui.gadgets.panes hashtables io kernel math
models namespaces sequences sequences words continuations
debugger prettyprint ui.tools.traceback help editors ;
IN: ui.tools.debugger
: <restart-list> ( restarts restart-hook -- gadget )
@ -15,18 +16,18 @@ IN: ui.tools.debugger
TUPLE: debugger < track restarts ;
: <debugger-display> ( restart-list error -- gadget )
[
<pane> [ [ print-error ] with-pane ] keep gadget,
gadget,
] make-filled-pile ;
<filled-pile>
<pane>
swapd tuck [ print-error ] with-pane
add-gadget
swap add-gadget ;
: <debugger> ( error restarts restart-hook -- gadget )
{ 0 1 } debugger new-track
[
toolbar,
<restart-list> g-> set-debugger-restarts
swap <debugger-display> <scroller> 1 track,
] make-gadget ;
dup <toolbar> f track-add*
-rot <restart-list> >>restarts
dup restarts>> rot <debugger-display> <scroller> 1 track-add* ;
M: debugger focusable-child* debugger-restarts ;

View File

@ -6,57 +6,60 @@ 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 system accessors ;
IN: ui.tools.deploy
TUPLE: deploy-gadget < pack vocab settings ;
: bundle-name ( -- )
: bundle-name ( parent -- parent )
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
"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
"Exit when last UI window closed" <checkbox> gadget, ;
"Exit when last UI window closed" <checkbox> add-gadget ;
: io-settings ( -- )
"Input/output support:" <label> gadget,
deploy-io get deploy-io-options <radio-buttons> gadget, ;
: io-settings ( parent -- parent )
"Input/output support:" <label> add-gadget
deploy-io get deploy-io-options <radio-buttons> add-gadget ;
: reflection-settings ( -- )
"Reflection support:" <label> gadget,
deploy-reflection get deploy-reflection-options <radio-buttons> gadget, ;
: reflection-settings ( parent -- parent )
"Reflection support:" <label> add-gadget
deploy-reflection get deploy-reflection-options <radio-buttons> add-gadget ;
: advanced-settings ( -- )
"Advanced:" <label> gadget,
deploy-compiler? get "Use optimizing compiler" <checkbox> gadget,
deploy-math? get "Rational and complex number support" <checkbox> gadget,
deploy-threads? get "Threading support" <checkbox> gadget,
deploy-random? get "Random number generator support" <checkbox> gadget,
deploy-word-props? get "Retain all word properties" <checkbox> gadget,
deploy-word-defs? get "Retain all word definitions" <checkbox> gadget,
deploy-c-types? get "Retain all C types" <checkbox> gadget, ;
: advanced-settings ( parent -- parent )
"Advanced:" <label> add-gadget
deploy-compiler? get "Use optimizing compiler" <checkbox> add-gadget
deploy-math? get "Rational and complex number support" <checkbox> add-gadget
deploy-threads? get "Threading support" <checkbox> add-gadget
deploy-random? get "Random number generator support" <checkbox> add-gadget
deploy-word-props? get "Retain all word properties" <checkbox> add-gadget
deploy-word-defs? get "Retain all word definitions" <checkbox> add-gadget
deploy-c-types? get "Retain all C types" <checkbox> add-gadget ;
: deploy-settings-theme ( gadget -- )
: deploy-settings-theme ( gadget -- gadget )
{ 10 10 } >>gap
1 >>fill
drop ;
1 >>fill ;
: <deploy-settings> ( vocab -- control )
default-config [ <model> ] assoc-map [
default-config [ <model> ] assoc-map
[
<pile>
bundle-name
deploy-ui
os macosx? [ exit-when-windows-closed ] when
io-settings
reflection-settings
advanced-settings
] make-pile dup deploy-settings-theme
deploy-settings-theme
namespace <mapping> over set-gadget-model
] bind ;
]
bind ;
: find-deploy-gadget ( gadget -- deploy-gadget )
[ deploy-gadget? ] find-parent ;
@ -101,19 +104,14 @@ deploy-gadget "toolbar" f {
{ T{ key-down f f "RET" } com-deploy }
} define-command-map
: buttons, ( -- )
g <toolbar> { 10 10 } over set-pack-gap gadget, ;
: <deploy-gadget> ( vocab -- gadget )
deploy-gadget new-gadget
swap >>vocab
over >>vocab
{ 0 1 } >>orientation
[
g vocab>> <deploy-settings>
g-> set-deploy-gadget-settings gadget,
buttons,
] make-gadget
dup deploy-settings-theme
swap <deploy-settings> >>settings
dup settings>> add-gadget
dup <toolbar> { 10 10 } >>gap add-gadget
deploy-settings-theme
dup com-revert ;
: deploy-tool ( vocab -- )