diff --git a/extra/automata/ui/ui.factor b/extra/automata/ui/ui.factor index 5678a6f06b..78f1074eb8 100644 --- a/extra/automata/ui/ui.factor +++ b/extra/automata/ui/ui.factor @@ -23,11 +23,8 @@ IN: automata.ui ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -QUALIFIED: ui.gadgets QUALIFIED: ui.gadgets.grids -: add-gadget ( parent child -- parent ) over ui.gadgets:add-gadget ; - : grid-add ( grid child i j -- grid ) >r >r dupd swap r> r> ui.gadgets.grids:grid-add ; diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor index b1f594b8c2..6b175eeb5e 100755 --- a/extra/boids/ui/ui.factor +++ b/extra/boids/ui/ui.factor @@ -120,24 +120,24 @@ VARS: population-label cohesion-label alignment-label separation-label ; [ "1 - Randomize" [ drop randomize ] button* ] [ 1 over set-pack-fill - population-label> over add-gadget - "3 - Add 10" [ drop add-10-boids ] button* over add-gadget - "2 - Sub 10" [ drop sub-10-boids ] button* over add-gadget ] + population-label> add-gadget + "3 - Add 10" [ drop add-10-boids ] button* add-gadget + "2 - Sub 10" [ drop sub-10-boids ] button* add-gadget ] [ 1 over set-pack-fill - cohesion-label> over add-gadget - "q - +0.1" [ drop inc-cohesion-weight ] button* over add-gadget - "a - -0.1" [ drop dec-cohesion-weight ] button* over add-gadget ] + cohesion-label> add-gadget + "q - +0.1" [ drop inc-cohesion-weight ] button* add-gadget + "a - -0.1" [ drop dec-cohesion-weight ] button* add-gadget ] [ 1 over set-pack-fill - alignment-label> over add-gadget - "w - +0.1" [ drop inc-alignment-weight ] button* over add-gadget - "s - -0.1" [ drop dec-alignment-weight ] button* over add-gadget ] + alignment-label> add-gadget + "w - +0.1" [ drop inc-alignment-weight ] button* add-gadget + "s - -0.1" [ drop dec-alignment-weight ] button* add-gadget ] [ 1 over set-pack-fill - separation-label> over add-gadget - "e - +0.1" [ drop inc-separation-weight ] button* over add-gadget - "d - -0.1" [ drop dec-separation-weight ] button* over add-gadget ] + separation-label> add-gadget + "e - +0.1" [ drop inc-separation-weight ] button* add-gadget + "d - -0.1" [ drop dec-separation-weight ] button* add-gadget ] } [ call ] map [ [ gadget, ] each ] make-shelf 1 over set-pack-fill diff --git a/extra/ui/gadgets/books/books.factor b/extra/ui/gadgets/books/books.factor index 93a8d271af..ce15bd9e6c 100755 --- a/extra/ui/gadgets/books/books.factor +++ b/extra/ui/gadgets/books/books.factor @@ -19,7 +19,7 @@ M: book model-changed : new-book ( pages model class -- book ) new-gadget swap >>model - [ add-gadgets ] keep ; inline + [ swap add-gadgets drop ] keep ; inline : ( pages model -- book ) book new-book ; diff --git a/extra/ui/gadgets/borders/borders.factor b/extra/ui/gadgets/borders/borders.factor index 7d6a24fed1..d1cf7cfb29 100644 --- a/extra/ui/gadgets/borders/borders.factor +++ b/extra/ui/gadgets/borders/borders.factor @@ -10,7 +10,7 @@ TUPLE: border < gadget { align initial: { 1/2 1/2 } } ; : new-border ( child class -- border ) - new-gadget [ add-gadget ] keep ; inline + new-gadget [ swap add-gadget drop ] keep ; inline : ( child gap -- border ) swap border new-border diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor index 1bea304f15..1a2555d538 100755 --- a/extra/ui/gadgets/gadgets-tests.factor +++ b/extra/ui/gadgets/gadgets-tests.factor @@ -9,9 +9,9 @@ io.streams.string math.geometry.rect ; ! c contains b contains a "a" set "b" set - "a" get "b" get add-gadget + "a" get "b" get swap add-gadget drop "c" set - "b" get "c" get add-gadget + "b" get "c" get swap add-gadget drop ! position a and b { 100 200 } "a" get set-rect-loc @@ -33,8 +33,8 @@ io.streams.string math.geometry.rect ; "g3" set { 100 200 } "g3" get set-rect-dim -"g1" get "g2" get add-gadget -"g2" get "g3" get add-gadget +"g1" get "g2" get swap add-gadget drop +"g2" get "g3" get swap add-gadget drop [ { 30 30 } ] [ "g1" get screen-loc ] unit-test [ { 30 30 } ] [ "g1" get screen-rect rect-loc ] unit-test @@ -49,11 +49,11 @@ io.streams.string math.geometry.rect ; "g1" set { 300 300 } "g1" get set-rect-dim "g2" set -"g2" get "g1" get add-gadget +"g2" get "g1" get swap add-gadget drop { 20 20 } "g2" get set-rect-loc { 20 20 } "g2" get set-rect-dim "g3" set -"g3" get "g1" get add-gadget +"g3" get "g1" get swap add-gadget drop { 100 100 } "g3" get set-rect-loc { 20 20 } "g3" get set-rect-dim @@ -66,7 +66,7 @@ io.streams.string math.geometry.rect ; [ t ] [ { 110 110 } "g1" get pick-up "g3" get eq? ] unit-test "g4" set -"g4" get "g2" get add-gadget +"g4" get "g2" get swap add-gadget drop { 5 5 } "g4" get set-rect-loc { 1 1 } "g4" get set-rect-dim @@ -123,7 +123,7 @@ M: mock-gadget ungraft* : add-some-children 3 [ over over set-gadget-model - dup "g" get add-gadget + dup "g" get swap add-gadget drop swap 1+ number>string set ] each ; diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index 3fc185a10e..ebe3773ce9 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -285,22 +285,27 @@ SYMBOL: in-layout? not-in-layout dup (clear-gadget) relayout ; -: ((add-gadget)) ( gadget box -- ) - [ children>> ?push ] keep (>>children) ; +: ((add-gadget)) ( parent child -- parent ) + over children>> ?push >>children ; -: (add-gadget) ( gadget box -- ) - over unparent - dup pick (>>parent) - [ ((add-gadget)) ] 2keep - graft-state>> second [ graft ] [ drop ] if ; +: (add-gadget) ( parent child -- parent ) + dup unparent + over >>parent + tuck ((add-gadget)) + tuck graft-state>> second + [ graft ] + [ drop ] + if ; -: add-gadget ( gadget parent -- ) +: add-gadget ( parent child -- parent ) not-in-layout - [ (add-gadget) ] keep relayout ; - -: add-gadgets ( seq parent -- ) + (add-gadget) + dup relayout ; + +: add-gadgets ( parent children -- parent ) not-in-layout - swap [ over (add-gadget) ] each relayout ; + [ (add-gadget) ] each + dup relayout ; : parents ( gadget -- seq ) [ parent>> ] follow ; @@ -352,7 +357,7 @@ M: f request-focus-on 2drop ; : focus-path ( world -- seq ) [ focus>> ] follow ; -: gadget, ( gadget -- ) gadget get add-gadget ; +: gadget, ( gadget -- ) gadget get swap add-gadget drop ; : g ( -- gadget ) gadget get ; diff --git a/extra/ui/gadgets/grids/grids.factor b/extra/ui/gadgets/grids/grids.factor index b539934771..474e6b95c0 100644 --- a/extra/ui/gadgets/grids/grids.factor +++ b/extra/ui/gadgets/grids/grids.factor @@ -12,7 +12,7 @@ grid : new-grid ( children class -- grid ) new-gadget - [ (>>grid) ] [ >r concat r> add-gadgets ] [ nip ] 2tri ; + [ (>>grid) ] [ >r concat r> swap add-gadgets drop ] [ nip ] 2tri ; inline : ( children -- grid ) @@ -21,7 +21,7 @@ grid : grid-child ( grid i j -- gadget ) rot grid>> nth nth ; : grid-add ( gadget grid i j -- ) - >r >r 2dup add-gadget r> r> + >r >r 2dup swap add-gadget drop r> r> 3dup grid-child unparent rot grid>> nth set-nth ; : grid-remove ( grid i j -- ) diff --git a/extra/ui/gadgets/incremental/incremental.factor b/extra/ui/gadgets/incremental/incremental.factor index c74f6676ad..8c227d76ce 100755 --- a/extra/ui/gadgets/incremental/incremental.factor +++ b/extra/ui/gadgets/incremental/incremental.factor @@ -45,7 +45,7 @@ M: incremental pref-dim* : add-incremental ( gadget incremental -- ) not-in-layout - 2dup (add-gadget) + 2dup swap (add-gadget) drop over prefer-incremental over layout-later 2dup incremental-loc diff --git a/extra/ui/gadgets/lists/lists.factor b/extra/ui/gadgets/lists/lists.factor index 776814853f..c2539e146a 100755 --- a/extra/ui/gadgets/lists/lists.factor +++ b/extra/ui/gadgets/lists/lists.factor @@ -48,7 +48,7 @@ TUPLE: list < pack index presenter color hook ; M: list model-changed nip dup clear-gadget - dup over add-gadgets + dup over swap add-gadgets drop bound-index ; : selected-rect ( list -- rect ) diff --git a/extra/ui/gadgets/menus/menus.factor b/extra/ui/gadgets/menus/menus.factor index 3e1145a8b6..4f815bc33d 100644 --- a/extra/ui/gadgets/menus/menus.factor +++ b/extra/ui/gadgets/menus/menus.factor @@ -15,7 +15,7 @@ TUPLE: menu-glass < gadget ; : ( menu world -- glass ) menu-glass new-gadget >r over menu-loc over set-rect-loc r> - [ add-gadget ] keep ; + [ swap add-gadget drop ] keep ; M: menu-glass layout* gadget-child prefer ; @@ -26,7 +26,7 @@ M: menu-glass layout* gadget-child prefer ; : show-glass ( gadget world -- ) over hand-clicked set-global [ hide-glass ] keep - [ add-gadget ] 2keep + [ swap add-gadget drop ] 2keep set-world-glass ; : show-menu ( gadget owner -- ) diff --git a/extra/ui/gadgets/panes/panes.factor b/extra/ui/gadgets/panes/panes.factor index 973c8c5725..9b547ce544 100755 --- a/extra/ui/gadgets/panes/panes.factor +++ b/extra/ui/gadgets/panes/panes.factor @@ -22,10 +22,10 @@ selection-color caret mark selecting? ; drop ; : add-output ( current pane -- ) - [ set-pane-output ] [ add-gadget ] 2bi ; + [ set-pane-output ] [ swap add-gadget drop ] 2bi ; : add-current ( current pane -- ) - [ set-pane-current ] [ add-gadget ] 2bi ; + [ set-pane-current ] [ swap add-gadget drop ] 2bi ; : prepare-line ( pane -- ) [ clear-selection ] @@ -120,7 +120,7 @@ C: pane-stream GENERIC: write-gadget ( gadget stream -- ) M: pane-stream write-gadget - pane-stream-pane pane-current add-gadget ; + pane-stream-pane pane-current swap add-gadget drop ; M: style-stream write-gadget stream>> write-gadget ; @@ -299,12 +299,12 @@ M: paragraph dispose drop ; : gadget-write ( string gadget -- ) over empty? - [ 2drop ] [ >r