From 54b24fd8b1060c80362898744e797b5d285935d7 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sun, 13 Jul 2008 01:24:43 -0500
Subject: [PATCH] ui.gadgets: new effects for add-gadget, add-gadgets, and
 (add-gadget)

---
 extra/ui/gadgets/gadgets.factor | 31 ++++++++++++++++++-------------
 1 file changed, 18 insertions(+), 13 deletions(-)

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 ;