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

extra/ui/gadgets/buttons/buttons.factor

@@ -230,5 +230,3 @@ M: radio-control model-changed
     swap
     "toolbar" over class command-map commands>> swap
     [ -rot <command-button> add-gadget ] curry assoc-each ;
-
-: toolbar, ( -- ) g <toolbar> f track, ;

extra/ui/gadgets/grids/grids.factor

@@ -24,6 +24,8 @@ grid
     >r >r 2dup swap add-gadget drop r> r>
     3dup grid-child unparent rot grid>> nth set-nth ;
 
+: grid-add* ( grid child i j -- grid ) >r >r dupd swap r> r> grid-add ;
+
 : grid-remove ( grid i j -- )
     >r >r >r <gadget> r> r> r> grid-add ;
 

extra/ui/gadgets/scrollers/scrollers.factor

@@ -29,30 +29,22 @@ scroller H{
     { T{ mouse-scroll } [ do-mouse-scroll ] }
 } set-gestures
 
-: viewport, ( child -- )
-    g model>> <viewport>
-    g-> set-scroller-viewport @center frame, ;
-
 : <scroller-model> ( -- model )
     0 0 0 0 <range> 0 0 0 0 <range> 2array <compose> ;
 
-: x-model ( -- model ) g model>> dependencies>> first ;
-
-: y-model ( -- model ) g model>> dependencies>> second ;
-
 : new-scroller ( gadget class -- scroller )
   new-frame
     t >>root?
     <scroller-model> >>model
     faint-boundary
-    [
-        x-model <x-slider> g-> set-scroller-x @bottom frame,
-        y-model <y-slider> g-> set-scroller-y @right frame,
-        viewport,
-    ] make-gadget ;
 
-: <scroller> ( gadget -- scroller )
+    dup model>> dependencies>> first  <x-slider> >>x dup x>> @bottom grid-add*
-    scroller new-scroller ;
+    dup model>> dependencies>> second <y-slider> >>y dup y>> @right  grid-add*
+
+    swap over model>> <viewport> >>viewport
+    dup viewport>> @center grid-add* ;
+    
+: <scroller> ( gadget -- scroller ) scroller new-scroller ;
 
 : scroll ( value scroller -- )
     [

extra/ui/gadgets/sliders/sliders.factor

@@ -138,10 +138,11 @@ M: elevator layout*
     [ swap find-slider slide-by-line ] curry <repeat-button>
     [ set-gadget-orientation ] keep ;
 
-: elevator, ( orientation -- )
+: elevator, ( gadget orientation -- gadget )
-    dup <elevator> g-> set-slider-elevator
+  tuck <elevator> >>elevator
-    swap <thumb> g-> set-slider-thumb add-gadget
+  swap <thumb>    >>thumb
-    @center frame, ;
+  dup elevator>> over thumb>> add-gadget
+  @center grid-add* ;
 
 : <left-button> ( -- button )
     { 0 1 } arrow-left -1 <slide-button> ;
@@ -149,26 +150,12 @@ M: elevator layout*
 : <right-button> ( -- button )
     { 0 1 } arrow-right 1 <slide-button> ;
 
-: build-x-slider ( slider -- slider )
-    [
-        <left-button> @left frame,
-        { 0 1 } elevator,
-        <right-button> @right frame,
-    ] make-gadget ; inline
-
 : <up-button> ( -- button )
     { 1 0 } arrow-up -1 <slide-button> ;
 
 : <down-button> ( -- button )
     { 1 0 } arrow-down 1 <slide-button> ;
 
-: build-y-slider ( slider -- slider )
-    [
-        <up-button> @top frame,
-        { 1 0 } elevator,
-        <down-button> @bottom frame,
-    ] make-gadget ; inline
-
 : <slider> ( range orientation -- slider )
     slider new-frame
         swap >>orientation
@@ -176,10 +163,16 @@ M: elevator layout*
         32 >>line ;
 
 : <x-slider> ( range -- slider )
-    { 1 0 } <slider> build-x-slider ;
+  { 1 0 } <slider>
+    <left-button> @left grid-add*
+    { 0 1 } elevator,
+    <right-button> @right grid-add* ;
 
 : <y-slider> ( range -- slider )
-    { 0 1 } <slider> build-y-slider ;
+  { 0 1 } <slider>
+    <up-button> @top grid-add*
+    { 1 0 } elevator,
+    <down-button> @bottom grid-add* ;
 
 M: slider pref-dim*
     dup call-next-method

extra/ui/gadgets/slots/slots.factor

@@ -71,11 +71,9 @@ M: value-ref finish-editing
 : <slot-editor> ( ref -- gadget )
   { 0 1 } slot-editor new-track
     swap >>ref
-    [
+    dup <toolbar> f track-add*
-        toolbar,
+    <source-editor> >>text
-        <source-editor> g-> set-slot-editor-text
+    dup text>> <scroller> 1 track-add*
-        <scroller> 1 track,
-    ] make-gadget
     dup revert ;
     
 M: slot-editor pref-dim* call-next-method { 600 200 } vmin ;

extra/ui/gadgets/tabs/tabs.factor

@@ -49,8 +49,12 @@ DEFER: (del-page)
 
 : <tabbed> ( assoc -- tabbed )
   tabbed new-frame
-    [ g 0 <model> >>model
+    0 <model> >>model
-      <pile> 1 >>fill [ >>toggler ] keep swap @left grid-add
+    <pile> 1 >>fill >>toggler
-      [ keys >vector g swap >>names ]
+    dup toggler>> @left grid-add*
-      [ values g model>> <book> [ >>content ] keep swap @center grid-add ] bi
+    swap
-      g redo-toggler g ] with-gadget ;
+      [ keys >vector >>names ]
+      [ values over model>> <book> >>content dup content>> @center grid-add* ]
+    bi
+    dup redo-toggler ;
+    

extra/ui/tools/listener/listener.factor

@@ -12,9 +12,9 @@ IN: ui.tools.listener
 
 TUPLE: listener-gadget < track input output stack ;
 
-: listener-output, ( -- )
+: listener-output, ( listener -- listener )
-    <scrolling-pane> g-> set-listener-gadget-output
+  <scrolling-pane> >>output
-    <scroller> "Output" <labelled-gadget> 1 track, ;
+  dup output>> <scroller> "Output" <labelled-gadget> 1 track-add* ;
 
 : listener-streams ( listener -- input output )
     [ input>> ] [ output>> <pane-stream> ] bi ;
@@ -22,10 +22,12 @@ TUPLE: listener-gadget < track input output stack ;
 : <listener-input> ( listener -- gadget )
     output>> <pane-stream> <interactor> ;
 
-: listener-input, ( -- )
+: listener-input, ( listener -- listener )
-    g <listener-input> g-> set-listener-gadget-input
+  dup <listener-input> >>input
+  dup input>>
     { 0 100 } <limited-scroller>
-    "Input" <labelled-gadget> f track, ;
+    "Input" <labelled-gadget>
+  f track-add* ;
 
 : welcome. ( -- )
    "If this is your first time with Factor, please read the " print
@@ -171,7 +173,8 @@ M: stack-display tool-scroller
 : <listener-gadget> ( -- gadget )
   { 0 1 } listener-gadget new-track
     dup init-listener
-    [ listener-output, listener-input, ] make-gadget ;
+    listener-output,
+    listener-input, ;
     
 : listener-help ( -- ) "ui-listener" help-window ;
 

extra/ui/tools/tools-tests.factor

@@ -5,12 +5,10 @@ ui.gadgets.labelled ui.gadgets.presentations
 ui.gadgets.scrollers vocabs tools.test.ui ui ;
 IN: ui.tools.tests
 
+[ f ]
 [
-    [ f ] [
+  <gadget> 0 <model> >>model <workspace-tabs> children>> empty?
-        0 <model> <gadget> [ set-gadget-model ] keep gadget set
+] unit-test
-        <workspace-tabs> gadget-children empty?
-    ] unit-test
-] with-scope
 
 [ ] [ <workspace> "w" set ] unit-test
 [ ] [ "w" get com-scroll-up ] unit-test