Merge branch 'master' of git://factorcode.org/git/factor
commit
bd529e0daa
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
@ -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." } ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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*
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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? [
|
||||
|
|
|
@ -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* ]
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
Loading…
Reference in New Issue