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

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

db4
Slava Pestov 2008-07-13 15:51:05 -05:00
parent 966ef323bc 202e15cd9c
commit 92fb077a94
3 changed files with 64 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/ui/gadgets/tracks/tracks.factor
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 ;

31
extra/ui/tools/debugger/debugger.factor
View File

@ -1,12 +1,13 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays ui ui.commands ui.gestures ui.gadgets
ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons
ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations
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 ;
ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons
ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations
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 ;

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

@ -1,62 +1,65 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ui.gadgets colors kernel ui.render namespaces
models models.mapping 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 system accessors ;
models models.mapping 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 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 -- )
{ 10 10 } >>gap
1 >>fill
drop ;
: deploy-settings-theme ( gadget -- gadget )
{ 10 10 } >>gap
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
namespace <mapping> over set-gadget-model
] bind ;
deploy-settings-theme
namespace <mapping> over set-gadget-model
]
bind ;
: find-deploy-gadget ( gadget -- deploy-gadget )
[ deploy-gadget? ] find-parent ;
@ -101,21 +104,16 @@ 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
{ 0 1 } >>orientation
[
g vocab>> <deploy-settings>
g-> set-deploy-gadget-settings gadget,
buttons,
] make-gadget
dup deploy-settings-theme
over >>vocab
{ 0 1 } >>orientation
swap <deploy-settings> >>settings
dup settings>> add-gadget
dup <toolbar> { 10 10 } >>gap add-gadget
deploy-settings-theme
dup com-revert ;
: deploy-tool ( vocab -- )
vocab-name dup <deploy-gadget> 10 <border>
"Deploying \"" rot "\"" 3append open-window ;