From f6f9b0874e7a1a1f423fb2ac8cac1a08d5baeb32 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 18 Feb 2009 19:25:34 -0600
Subject: [PATCH] change remove-gadget semantics so that removing glass from
 world doesn't break

---
 basis/ui/gadgets/gadgets.factor             | 20 +++++++++++++-------
 basis/ui/gadgets/worlds/worlds-tests.factor |  8 +++-----
 basis/ui/gadgets/worlds/worlds.factor       |  3 +++
 3 files changed, 19 insertions(+), 12 deletions(-)

diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor
index e508aa59c2..e38f56c7f1 100644
--- a/basis/ui/gadgets/gadgets.factor
+++ b/basis/ui/gadgets/gadgets.factor
@@ -295,16 +295,22 @@ PRIVATE>
 
 GENERIC: remove-gadget ( gadget parent -- )
 
-M: gadget remove-gadget
-    over (unparent)
-    [ unfocus-gadget ]
-    [ children>> delete ]
-    [ nip relayout ]
-    2tri ;
+M: gadget remove-gadget 2drop ;
 
 : unparent ( gadget -- )
     not-in-layout
-    [ dup parent>> dup [ remove-gadget ] [ 2drop ] if ] when* ;
+    [
+        dup parent>> dup
+        [
+            [ remove-gadget ] [
+                over (unparent)
+                [ unfocus-gadget ]
+                [ children>> delete ]
+                [ nip relayout ]
+                2tri
+            ] 2bi
+        ] [ 2drop ] if
+    ] when* ;
 
 : clear-gadget ( gadget -- )
     not-in-layout
diff --git a/basis/ui/gadgets/worlds/worlds-tests.factor b/basis/ui/gadgets/worlds/worlds-tests.factor
index aeef3a6e5d..f738a8cff4 100644
--- a/basis/ui/gadgets/worlds/worlds-tests.factor
+++ b/basis/ui/gadgets/worlds/worlds-tests.factor
@@ -48,14 +48,12 @@ IN: ui.gadgets.worlds.tests
 
 TUPLE: focusing < gadget ;
 
-: <focusing>
-    focusing new ;
+: <focusing> ( -- gadget ) focusing new ;
 
 TUPLE: focus-test < gadget ;
 
-: <focus-test>
-    focus-test new
-    dup <focusing> add-gadget drop ;
+: <focus-test> ( -- gadget )
+    focus-test new <focusing> add-gadget ;
 
 M: focus-test focusable-child* gadget-child ;
 
diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index aedd7a8985..e276cd91fd 100644
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -61,6 +61,9 @@ M: world focusable-child* gadget-child ;
 
 M: world children-on nip children>> ;
 
+M: world remove-gadget
+    2dup glass>> eq? [ 2drop ] [ call-next-method ] if ;
+
 : (draw-world) ( world -- )
     dup handle>> [
         {