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-24 21:47:29 -05:00
parent 0fd34b4a4b 2bed94df39
commit bd529e0daa
20 changed files with 48 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
extra/shell/shell.factor
View File

@ -50,7 +50,6 @@ DEFER: expansion
METHOD: expand { back-quoted-expr } METHOD: expand { back-quoted-expr }
expr>> expr>>
expr expr
ast>>
command>> command>>
expansion expansion
utf8 <process-stream> utf8 <process-stream>
@ -122,7 +121,7 @@ DEFER: shell
{ [ dup f = ] [ drop ] } { [ dup f = ] [ drop ] }
{ [ dup "exit" = ] [ drop ] } { [ dup "exit" = ] [ drop ] }
{ [ dup "" = ] [ drop shell ] } { [ dup "" = ] [ drop shell ] }
{ [ dup expr ] [ expr ast>> chant shell ] } { [ dup expr ] [ expr chant shell ] }
{ [ t ] [ drop "ix: ignoring input" print shell ] } { [ t ] [ drop "ix: ignoring input" print shell ] }
} }
cond ; cond ;

4
extra/ui/gadgets/labelled/labelled.factor
View File

@ -12,9 +12,9 @@ TUPLE: labelled-gadget < track content ;
: <labelled-gadget> ( gadget title -- newgadget ) : <labelled-gadget> ( gadget title -- newgadget )
{ 0 1 } labelled-gadget new-track { 0 1 } labelled-gadget new-track
swap <label> reverse-video-theme f track-add* swap <label> reverse-video-theme f track-add
swap >>content swap >>content
dup content>> 1 track-add* ; dup content>> 1 track-add ;
M: labelled-gadget focusable-child* labelled-gadget-content ; M: labelled-gadget focusable-child* labelled-gadget-content ;

8
extra/ui/gadgets/labels/labels.factor
View File

@ -65,10 +65,10 @@ M: f >label drop <gadget> ;
: label-on-left ( gadget label -- button ) : label-on-left ( gadget label -- button )
{ 1 0 } <track> { 1 0 } <track>
swap >label f track-add* swap >label f track-add
swap 1 track-add* ; swap 1 track-add ;
: label-on-right ( label gadget -- button ) : label-on-right ( label gadget -- button )
{ 1 0 } <track> { 1 0 } <track>
swap f track-add* swap f track-add
swap >label 1 track-add* ; swap >label 1 track-add ;

10
extra/ui/gadgets/slots/slots.factor
View File

@ -71,9 +71,9 @@ M: value-ref finish-editing
: <slot-editor> ( ref -- gadget ) : <slot-editor> ( ref -- gadget )
{ 0 1 } slot-editor new-track { 0 1 } slot-editor new-track
swap >>ref swap >>ref
dup <toolbar> f track-add* dup <toolbar> f track-add
<source-editor> >>text <source-editor> >>text
dup text>> <scroller> 1 track-add* dup text>> <scroller> 1 track-add
dup revert ; dup revert ;
M: slot-editor pref-dim* call-next-method { 600 200 } vmin ; M: slot-editor pref-dim* call-next-method { 600 200 } vmin ;
@ -97,8 +97,8 @@ TUPLE: editable-slot < track printer ref ;
: display-slot ( gadget editable-slot -- ) : display-slot ( gadget editable-slot -- )
dup clear-track dup clear-track
swap 1 track-add* swap 1 track-add
<edit-button> f track-add* <edit-button> f track-add
drop ; drop ;
: update-slot ( editable-slot -- ) : update-slot ( editable-slot -- )
@ -109,7 +109,7 @@ TUPLE: editable-slot < track printer ref ;
[ clear-track ] [ clear-track ]
[ [
dup ref>> <slot-editor> dup ref>> <slot-editor>
[ 1 track-add* drop ] [ 1 track-add drop ]
[ [ scroll>gadget ] [ request-focus ] bi* ] 2bi [ [ scroll>gadget ] [ request-focus ] bi* ] 2bi
] bi ; ] bi ;

2
extra/ui/gadgets/status-bar/status-bar.factor
View File

@ -12,7 +12,7 @@ IN: ui.gadgets.status-bar
: open-status-window ( gadget title -- ) : open-status-window ( gadget title -- )
f <model> [ <world> ] keep f <model> [ <world> ] keep
<status-bar> f track-add* <status-bar> f track-add
open-world-window ; open-world-window ;
: show-summary ( object gadget -- ) : show-summary ( object gadget -- )

2
extra/ui/gadgets/tiling/tiling.factor
View File

@ -38,7 +38,7 @@ TUPLE: tiling < track gadgets tiles first focused ;
: tiling-map-gadgets ( tiling -- tiling ) : tiling-map-gadgets ( tiling -- tiling )
dup clear-track dup clear-track
dup tiling-gadgets-to-map [ 1 track-add* ] each ; dup tiling-gadgets-to-map [ 1 track-add ] each ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

4
extra/ui/gadgets/tracks/tracks-docs.factor
View File

@ -8,7 +8,7 @@ ARTICLE: "ui-track-layout" "Track layouts"
"Creating empty tracks:" "Creating empty tracks:"
{ $subsection <track> } { $subsection <track> }
"Adding children:" "Adding children:"
{ $subsection track-add* } ; { $subsection track-add } ;
HELP: track HELP: track
{ $class-description "A track is like a " { $link pack } " except each child is resized to a fixed multiple of the track's dimension in the direction of " { $link gadget-orientation } ". Tracks are created by calling " { $link <track> } "." } ; { $class-description "A track is like a " { $link pack } " except each child is resized to a fixed multiple of the track's dimension in the direction of " { $link gadget-orientation } ". Tracks are created by calling " { $link <track> } "." } ;
@ -17,7 +17,7 @@ HELP: <track>
{ $values { "orientation" "an orientation specifier" } { "track" "a new " { $link track } } } { $values { "orientation" "an orientation specifier" } { "track" "a new " { $link track } } }
{ $description "Creates a new track which lays out children along the given axis. Children are laid out vertically if the orientation is " { $snippet "{ 0 1 }" } " and horizontally if the orientation is " { $snippet "{ 1 0 }" } "." } ; { $description "Creates a new track which lays out children along the given axis. Children are laid out vertically if the orientation is " { $snippet "{ 0 1 }" } " and horizontally if the orientation is " { $snippet "{ 1 0 }" } "." } ;
HELP: track-add* HELP: track-add
{ $values { "gadget" gadget } { "track" track } { "constraint" "a number between 0 and 1, or " { $link f } } } { $values { "gadget" gadget } { "track" track } { "constraint" "a number between 0 and 1, or " { $link f } } }
{ $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ; { $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ;

6
extra/ui/gadgets/tracks/tracks-tests.factor
View File

@ -4,13 +4,13 @@ IN: ui.gadgets.tracks.tests
[ { 100 100 } ] [ [ { 100 100 } ] [
{ 0 1 } <track> { 0 1 } <track>
<gadget> { 100 100 } >>dim 1 track-add* <gadget> { 100 100 } >>dim 1 track-add
pref-dim pref-dim
] unit-test ] unit-test
[ { 100 110 } ] [ [ { 100 110 } ] [
{ 0 1 } <track> { 0 1 } <track>
<gadget> { 10 10 } >>dim f track-add* <gadget> { 10 10 } >>dim f track-add
<gadget> { 100 100 } >>dim 1 track-add* <gadget> { 100 100 } >>dim 1 track-add
pref-dim pref-dim
] unit-test ] unit-test

2
extra/ui/gadgets/tracks/tracks.factor
View File

@ -50,7 +50,7 @@ M: track pref-dim* ( gadget -- dim )
tri tri
set-axis ; set-axis ;
: track-add* ( track gadget constraint -- track ) : track-add ( track gadget constraint -- track )
pick sizes>> push add-gadget ; pick sizes>> push add-gadget ;
: track-remove ( track gadget -- track ) : track-remove ( track gadget -- track )

2
extra/ui/gadgets/worlds/worlds.factor
View File

@ -40,7 +40,7 @@ M: world request-focus-on ( child gadget -- )
{ 0 0 } >>window-loc { 0 0 } >>window-loc
swap >>status swap >>status
swap >>title swap >>title
swap 1 track-add* swap 1 track-add
dup request-focus ; dup request-focus ;
M: world layout* M: world layout*

4
extra/ui/tools/browser/browser.factor
View File

@ -22,9 +22,9 @@ TUPLE: browser-gadget < track pane history ;
: <browser-gadget> ( -- gadget ) : <browser-gadget> ( -- gadget )
{ 0 1 } browser-gadget new-track { 0 1 } browser-gadget new-track
dup init-history dup init-history
dup <toolbar> f track-add* dup <toolbar> f track-add
dup <help-pane> >>pane dup <help-pane> >>pane
dup pane>> <scroller> 1 track-add* ; dup pane>> <scroller> 1 track-add ;
M: browser-gadget call-tool* show-help ; M: browser-gadget call-tool* show-help ;

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

@ -25,9 +25,9 @@ TUPLE: debugger < track restarts ;
: <debugger> ( error restarts restart-hook -- gadget ) : <debugger> ( error restarts restart-hook -- gadget )
{ 0 1 } debugger new-track { 0 1 } debugger new-track
dup <toolbar> f track-add* dup <toolbar> f track-add
-rot <restart-list> >>restarts -rot <restart-list> >>restarts
dup restarts>> rot <debugger-display> <scroller> 1 track-add* ; dup restarts>> rot <debugger-display> <scroller> 1 track-add ;
M: debugger focusable-child* debugger-restarts ; M: debugger focusable-child* debugger-restarts ;

4
extra/ui/tools/inspector/inspector.factor
View File

@ -17,9 +17,9 @@ TUPLE: inspector-gadget < track object pane ;
: <inspector-gadget> ( -- gadget ) : <inspector-gadget> ( -- gadget )
{ 0 1 } inspector-gadget new-track { 0 1 } inspector-gadget new-track
dup <toolbar> f track-add* dup <toolbar> f track-add
<pane> >>pane <pane> >>pane
dup pane>> <scroller> 1 track-add* ; dup pane>> <scroller> 1 track-add ;
: inspect-object ( obj mirror keys inspector -- ) : inspect-object ( obj mirror keys inspector -- )
2nip swap >>object refresh ; 2nip swap >>object refresh ;

8
extra/ui/tools/listener/listener.factor
View File

@ -14,7 +14,7 @@ TUPLE: listener-gadget < track input output stack ;
: listener-output, ( listener -- listener ) : listener-output, ( listener -- listener )
<scrolling-pane> >>output <scrolling-pane> >>output
dup output>> <scroller> "Output" <labelled-gadget> 1 track-add* ; dup output>> <scroller> "Output" <labelled-gadget> 1 track-add ;
: listener-streams ( listener -- input output ) : listener-streams ( listener -- input output )
[ input>> ] [ output>> <pane-stream> ] bi ; [ input>> ] [ output>> <pane-stream> ] bi ;
@ -27,7 +27,7 @@ TUPLE: listener-gadget < track input output stack ;
dup input>> dup input>>
{ 0 100 } <limited-scroller> { 0 100 } <limited-scroller>
"Input" <labelled-gadget> "Input" <labelled-gadget>
f track-add* ; f track-add ;
: welcome. ( -- ) : welcome. ( -- )
"If this is your first time with Factor, please read the " print "If this is your first time with Factor, please read the " print
@ -125,10 +125,10 @@ TUPLE: stack-display < track ;
: <stack-display> ( workspace -- gadget ) : <stack-display> ( workspace -- gadget )
listener>> listener>>
{ 0 1 } stack-display new-track { 0 1 } stack-display new-track
over <toolbar> f track-add* over <toolbar> f track-add
swap swap
stack>> [ [ stack. ] curry try ] t "Data stack" <labelled-pane> stack>> [ [ stack. ] curry try ] t "Data stack" <labelled-pane>
1 track-add* ; 1 track-add ;
M: stack-display tool-scroller M: stack-display tool-scroller
find-workspace workspace-listener tool-scroller ; find-workspace workspace-listener tool-scroller ;

4
extra/ui/tools/profiler/profiler.factor
View File

@ -9,9 +9,9 @@ TUPLE: profiler-gadget < track pane ;
: <profiler-gadget> ( -- gadget ) : <profiler-gadget> ( -- gadget )
{ 0 1 } profiler-gadget new-track { 0 1 } profiler-gadget new-track
dup <toolbar> f track-add* dup <toolbar> f track-add
<pane> >>pane <pane> >>pane
dup pane>> <scroller> 1 track-add* ; dup pane>> <scroller> 1 track-add ;
: with-profiler-pane ( gadget quot -- ) : with-profiler-pane ( gadget quot -- )
>r profiler-gadget-pane r> with-pane ; >r profiler-gadget-pane r> with-pane ;

4
extra/ui/tools/search/search.factor
View File

@ -62,9 +62,9 @@ search-field H{
: <live-search> ( string seq limited? presenter -- gadget ) : <live-search> ( string seq limited? presenter -- gadget )
{ 0 1 } live-search new-track { 0 1 } live-search new-track
<search-field> >>field <search-field> >>field
dup field>> f track-add* dup field>> f track-add
-roll <search-list> >>list -roll <search-list> >>list
dup list>> <scroller> 1 track-add* dup list>> <scroller> 1 track-add
swap swap
over field>> set-editor-string over field>> set-editor-string

8
extra/ui/tools/tools.factor
View File

@ -38,10 +38,10 @@ IN: ui.tools
<listener-gadget> >>listener <listener-gadget> >>listener
dup <workspace-book> >>book dup <workspace-book> >>book
dup <workspace-tabs> f track-add* dup <workspace-tabs> f track-add
dup book>> 1/5 track-add* dup book>> 1/5 track-add
dup listener>> 4/5 track-add* dup listener>> 4/5 track-add
dup <toolbar> f track-add* ; dup <toolbar> f track-add ;
: resize-workspace ( workspace -- ) : resize-workspace ( workspace -- )
dup track-sizes over control-value zero? [ dup track-sizes over control-value zero? [

10
extra/ui/tools/traceback/traceback.factor
View File

@ -30,13 +30,13 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
dup model>> dup model>>
{ 1 0 } <track> { 1 0 } <track>
over <datastack-display> 1/2 track-add* over <datastack-display> 1/2 track-add
swap <retainstack-display> 1/2 track-add* swap <retainstack-display> 1/2 track-add
1/3 track-add* 1/3 track-add
dup model>> <callstack-display> 2/3 track-add* dup model>> <callstack-display> 2/3 track-add
dup <toolbar> f track-add* ; dup <toolbar> f track-add ;
: <namestack-display> ( model -- gadget ) : <namestack-display> ( model -- gadget )
[ [ continuation-name namestack. ] when* ] [ [ continuation-name namestack. ] when* ]

6
extra/ui/tools/walker/walker.factor
View File

@ -62,9 +62,9 @@ M: walker-gadget focusable-child*
swap >>status swap >>status
dup continuation>> <traceback-gadget> >>traceback dup continuation>> <traceback-gadget> >>traceback
dup <toolbar> f track-add* dup <toolbar> f track-add
dup status>> self <thread-status> f track-add* dup status>> self <thread-status> f track-add
dup traceback>> 1 track-add* ; dup traceback>> 1 track-add ;
: walker-help ( -- ) "ui-walker" help-window ; : walker-help ( -- ) "ui-walker" help-window ;

2
extra/ui/tools/workspace/workspace.factor
View File

@ -62,7 +62,7 @@ M: gadget tool-scroller drop f ;
: show-popup ( gadget workspace -- ) : show-popup ( gadget workspace -- )
dup hide-popup dup hide-popup
over >>popup over >>popup
over f track-add* drop over f track-add drop
request-focus ; request-focus ;
: show-titled-popup ( workspace gadget title -- ) : show-titled-popup ( workspace gadget title -- )