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

db4
Slava Pestov 2008-07-24 21:47:29 -05:00
commit bd529e0daa
20 changed files with 48 additions and 49 deletions

View File

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

View File

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

View File

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

View File

@ -71,9 +71,9 @@ M: value-ref finish-editing
: <slot-editor> ( ref -- gadget )
{ 0 1 } slot-editor new-track
swap >>ref
dup <toolbar> f track-add*
dup <toolbar> f track-add
<source-editor> >>text
dup text>> <scroller> 1 track-add*
dup text>> <scroller> 1 track-add
dup revert ;
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 -- )
dup clear-track
swap 1 track-add*
<edit-button> f track-add*
swap 1 track-add
<edit-button> f track-add
drop ;
: update-slot ( editable-slot -- )
@ -109,7 +109,7 @@ TUPLE: editable-slot < track printer ref ;
[ clear-track ]
[
dup ref>> <slot-editor>
[ 1 track-add* drop ]
[ 1 track-add drop ]
[ [ scroll>gadget ] [ request-focus ] bi* ] 2bi
] bi ;

View File

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

View File

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

View File

@ -8,7 +8,7 @@ ARTICLE: "ui-track-layout" "Track layouts"
"Creating empty tracks:"
{ $subsection <track> }
"Adding children:"
{ $subsection track-add* } ;
{ $subsection track-add } ;
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> } "." } ;
@ -17,7 +17,7 @@ HELP: <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 }" } "." } ;
HELP: track-add*
HELP: track-add
{ $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." } ;

View File

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

View File

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

View File

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

View File

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

View File

@ -25,9 +25,9 @@ TUPLE: debugger < track restarts ;
: <debugger> ( error restarts restart-hook -- gadget )
{ 0 1 } debugger new-track
dup <toolbar> f track-add*
dup <toolbar> f track-add
-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 ;

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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