diff --git a/collects/mred/private/wx/cocoa/README.txt b/collects/mred/private/wx/cocoa/README.txt
new file mode 100644
index 00000000..df44db48
--- /dev/null
+++ b/collects/mred/private/wx/cocoa/README.txt
@@ -0,0 +1,15 @@
+
+Allocation rules:
+
+ * Use `as-objc-allocation' when creating a Cocoa object. When the
+   resulting reference becomes unreachable, the Cocoa object will be
+   releaset.
+
+ * Use `with-autorelease' in atomic mode around calls that autorelease
+   and where the release should take effect immediate. Do not create
+   an autorelease pool except in atomic mode.
+
+ * Other autoreleased objects may end up in the root pool installed by
+   "pool.rkt". The root pool is periodically destroyed and replaced;
+   call `queue-autorelease-flush' if you need to encurage replacement
+   of the pool.
diff --git a/collects/mred/private/wx/gtk/README.txt b/collects/mred/private/wx/gtk/README.txt
new file mode 100644
index 00000000..2f55c326
--- /dev/null
+++ b/collects/mred/private/wx/gtk/README.txt
@@ -0,0 +1,17 @@
+
+Allocation rules:
+
+ * Use `as-gtk-allocation' when creating a Gtk widget that is the main
+   container for a given window<%> object. When the resulting
+   reference becomes unreachable, the widget will be released with
+   gtk_widget_destroy() through a finalizer.
+
+ * Use `atomically' to create and attach a sub-widget within the main
+   widget.  Don't use gtk_widget_destroy(); the containing widget will
+   destroy the enclosing widget.
+
+ * For temporary objects, use `atomically' to wrap both the allocation
+   and release.
+
+Every call to a function whose name contains "new" needs to be in one
+of those cases.
diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt
index 863654ae..8d71ad50 100644
--- a/collects/mred/private/wx/gtk/canvas.rkt
+++ b/collects/mred/private/wx/gtk/canvas.rkt
@@ -135,7 +135,8 @@
           (let ([gc (send wx get-canvas-background-for-clearing)])      
             (when gc
               (gdk_draw_rectangle (widget-window gtk) gc #t
-                                  0 0 32000 32000))))))
+                                  0 0 32000 32000)
+              (gdk_gc_unref gc))))))
     #t))
 
 (define-signal-handler connect-expose-border "expose-event"
@@ -197,61 +198,62 @@
     (define-values (client-gtk gtk 
                                hscroll-adj vscroll-adj hscroll-gtk vscroll-gtk resize-box
                                combo-button-gtk)
-      (cond
-       [(or (memq 'hscroll style)
-            (memq 'vscroll style))
-        (let* ([client-gtk (gtk_drawing_area_new)]
-               [hadj (gtk_adjustment_new 0.0 0.0 1.0 1.0 1.0 1.0)]
-               [vadj (gtk_adjustment_new 0.0 0.0 1.0 1.0 1.0 1.0)])
-          (let ([h (gtk_hbox_new #f 0)]
-                [v (gtk_vbox_new #f 0)]
-                [v2 (gtk_vbox_new #f 0)]
-                [h2 (gtk_vbox_new #f 0)]
-                [hscroll (gtk_hscrollbar_new hadj)]
-                [vscroll (gtk_vscrollbar_new vadj)]
-                [resize-box (gtk_drawing_area_new)])
-            (when has-border?
-              (gtk_container_set_border_width h margin))
-            (gtk_box_pack_start h v #t #t 0)
-            (gtk_box_pack_start v client-gtk #t #t 0)
-            (gtk_box_pack_start h v2 #f #f 0)
-            (gtk_box_pack_start v2 vscroll #t #t 0)
-            (gtk_box_pack_start v h2 #f #f 0)
-            (gtk_box_pack_start h2 hscroll #t #t 0)
-            (gtk_box_pack_start v2 resize-box #f #f 0)
-            (gtk_widget_show hscroll)
-            (gtk_widget_show vscroll)
-            (gtk_widget_show h)
-            (gtk_widget_show v)
-            (gtk_widget_show v2)
-            (gtk_widget_show h2)
-            (gtk_widget_show resize-box)
-            (gtk_widget_show client-gtk)
-            (unless (memq 'hscroll style)
-              (gtk_widget_hide hscroll)
-              (gtk_widget_hide resize-box))
-            (unless (memq 'vscroll style)
-              (gtk_widget_hide v2))
-            (values client-gtk h hadj vadj 
-                    (and (memq 'hscroll style) h2)
-                    (and (memq 'vscroll style) v2)
-                    (and (memq 'hscroll style) (memq 'vscroll style) resize-box)
-                    #f)))]
-       [is-combo?
-        (let* ([gtk (gtk_combo_box_entry_new_text)]
-               [orig-entry (gtk_bin_get_child gtk)])
-          (values orig-entry gtk #f #f #f #f #f (extract-combo-button gtk)))]
-       [has-border?
-        (let ([client-gtk (gtk_drawing_area_new)]
-              [h (gtk_hbox_new #f 0)])
-          (gtk_box_pack_start h client-gtk #t #t 0)
-          (gtk_container_set_border_width h margin)
-          (connect-expose-border h)
-          (gtk_widget_show client-gtk)
-          (values client-gtk h #f #f #f #f #f #f))]
-       [else
-        (let ([client-gtk (gtk_drawing_area_new)])
-          (values client-gtk client-gtk #f #f #f #f #f #f))]))
+      (atomically ;; need to connect all children to gtk to avoid leaks
+       (cond
+        [(or (memq 'hscroll style)
+             (memq 'vscroll style))
+         (let* ([client-gtk (gtk_drawing_area_new)]
+                [hadj (gtk_adjustment_new 0.0 0.0 1.0 1.0 1.0 1.0)]
+                [vadj (gtk_adjustment_new 0.0 0.0 1.0 1.0 1.0 1.0)])
+           (let ([h (as-gtk-allocation (gtk_hbox_new #f 0))]
+                 [v (gtk_vbox_new #f 0)]
+                 [v2 (gtk_vbox_new #f 0)]
+                 [h2 (gtk_vbox_new #f 0)]
+                 [hscroll (gtk_hscrollbar_new hadj)]
+                 [vscroll (gtk_vscrollbar_new vadj)]
+                 [resize-box (gtk_drawing_area_new)])
+             (when has-border?
+               (gtk_container_set_border_width h margin))
+             (gtk_box_pack_start h v #t #t 0)
+             (gtk_box_pack_start v client-gtk #t #t 0)
+             (gtk_box_pack_start h v2 #f #f 0)
+             (gtk_box_pack_start v2 vscroll #t #t 0)
+             (gtk_box_pack_start v h2 #f #f 0)
+             (gtk_box_pack_start h2 hscroll #t #t 0)
+             (gtk_box_pack_start v2 resize-box #f #f 0)
+             (gtk_widget_show hscroll)
+             (gtk_widget_show vscroll)
+             (gtk_widget_show h)
+             (gtk_widget_show v)
+             (gtk_widget_show v2)
+             (gtk_widget_show h2)
+             (gtk_widget_show resize-box)
+             (gtk_widget_show client-gtk)
+             (unless (memq 'hscroll style)
+               (gtk_widget_hide hscroll)
+               (gtk_widget_hide resize-box))
+             (unless (memq 'vscroll style)
+               (gtk_widget_hide v2))
+             (values client-gtk h hadj vadj 
+                     (and (memq 'hscroll style) h2)
+                     (and (memq 'vscroll style) v2)
+                     (and (memq 'hscroll style) (memq 'vscroll style) resize-box)
+                     #f)))]
+        [is-combo?
+         (let* ([gtk (as-gtk-allocation (gtk_combo_box_entry_new_text))]
+                [orig-entry (gtk_bin_get_child gtk)])
+           (values orig-entry gtk #f #f #f #f #f (extract-combo-button gtk)))]
+        [has-border?
+         (let ([client-gtk (gtk_drawing_area_new)]
+               [h (as-gtk-allocation (gtk_hbox_new #f 0))])
+           (gtk_box_pack_start h client-gtk #t #t 0)
+           (gtk_container_set_border_width h margin)
+           (connect-expose-border h)
+           (gtk_widget_show client-gtk)
+           (values client-gtk h #f #f #f #f #f #f))]
+        [else
+         (let ([client-gtk (as-gtk-allocation (gtk_drawing_area_new))])
+           (values client-gtk client-gtk #f #f #f #f #f #f))])))
 
     (super-new [parent parent]
                [gtk gtk]
@@ -481,15 +483,15 @@
                                                bg-col))
     (define/public (set-canvas-background col) (set! bg-col col))
     (define/public (get-canvas-background-for-clearing) 
+      ;; called in event-dispatch mode
       (if now-drawing?
           (begin
             (set! refresh-after-drawing? #t)
             #f)
           (if clear-bg?
-              (let ([conv (lambda (x) (bitwise-ior x (arithmetic-shift x 8)))])
-                (unless gc
-                  (let ([w (widget-window gtk)])
-                    (set! gc (gdk_gc_new w))))
+              (let* ([conv (lambda (x) (bitwise-ior x (arithmetic-shift x 8)))]
+                     [w (widget-window gtk)]
+                     [gc (gdk_gc_new w)])
                 (gdk_gc_set_rgb_fg_color gc (make-GdkColor 0
                                                            (conv (color-red bg-col))
                                                            (conv (color-green bg-col))
diff --git a/collects/mred/private/wx/gtk/choice.rkt b/collects/mred/private/wx/gtk/choice.rkt
index 7c30ae0c..0f79c489 100644
--- a/collects/mred/private/wx/gtk/choice.rkt
+++ b/collects/mred/private/wx/gtk/choice.rkt
@@ -35,7 +35,7 @@
         choices style font)
   (inherit get-gtk set-auto-size)
 
-  (define gtk (gtk_combo_box_new_text))
+  (define gtk (as-gtk-allocation (gtk_combo_box_new_text)))
   (define count (length choices))
 
   (for ([l (in-list choices)])
diff --git a/collects/mred/private/wx/gtk/gauge.rkt b/collects/mred/private/wx/gtk/gauge.rkt
index 6670f323..2bb45011 100644
--- a/collects/mred/private/wx/gtk/gauge.rkt
+++ b/collects/mred/private/wx/gtk/gauge.rkt
@@ -15,6 +15,9 @@
 
 (define-gtk gtk_progress_bar_new (_fun _pointer -> _GtkWidget))
 (define-gtk gtk_progress_bar_set_fraction (_fun _GtkWidget _double* -> _void))
+(define-gtk gtk_progress_bar_set_orientation (_fun _GtkWidget _int -> _void))
+
+(define GTK_PROGRESS_BOTTOM_TO_TOP 2)
 
 (defclass gauge% item%
   (init parent
@@ -26,10 +29,13 @@
   (inherit get-gtk set-auto-size)
 
   (super-new [parent parent]
-             [gtk (gtk_progress_bar_new #f)]
+             [gtk (as-gtk-allocation (gtk_progress_bar_new #f))]
              [no-show? (memq 'deleted style)])
   (define gtk (get-gtk))
 
+  (when (memq 'vertical style)
+    (gtk_progress_bar_set_orientation gtk GTK_PROGRESS_BOTTOM_TO_TOP))
+
   (set-auto-size)
 
   (define range rng)
diff --git a/collects/mred/private/wx/gtk/group-panel.rkt b/collects/mred/private/wx/gtk/group-panel.rkt
index a147a034..4c718d49 100644
--- a/collects/mred/private/wx/gtk/group-panel.rkt
+++ b/collects/mred/private/wx/gtk/group-panel.rkt
@@ -2,6 +2,7 @@
 (require scheme/class
          scheme/foreign
           "../../syntax.rkt"
+          "../../lock.rkt"
          "window.rkt"
          "client-window.rkt"
          "panel.rkt"
@@ -29,9 +30,11 @@
     (inherit set-size set-auto-size infer-client-delta
              get-gtk get-height)
 
-    (define gtk (gtk_frame_new label))
-    (define client-gtk (gtk_fixed_new))
-    (gtk_container_add gtk client-gtk)
+    (define gtk (as-gtk-allocation (gtk_frame_new label)))
+    (define client-gtk 
+      (atomically (let ([client-gtk (gtk_fixed_new)])
+                    (gtk_container_add gtk client-gtk)
+                    client-gtk)))
     (gtk_widget_show client-gtk)
     
     (super-new [parent parent]
diff --git a/collects/mred/private/wx/gtk/list-box.rkt b/collects/mred/private/wx/gtk/list-box.rkt
index f2234825..1fdb8638 100644
--- a/collects/mred/private/wx/gtk/list-box.rkt
+++ b/collects/mred/private/wx/gtk/list-box.rkt
@@ -75,7 +75,7 @@
   (define items choices)
   (define data (map (lambda (c) (box #f)) choices))
 
-  (define store (gtk_list_store_new 1 G_TYPE_STRING))
+  (define store (as-gobject-allocation (gtk_list_store_new 1 G_TYPE_STRING)))
   (define (reset-content)
     (let ([iter (make-GtkTreeIter 0 #f #f #f)])
       (for ([s (in-list items)])
@@ -88,23 +88,23 @@
                (pair? data))
       (set-selection 0)))
     
-  (define column
-    (let ([renderer (gtk_cell_renderer_text_new)])
-      (gtk_tree_view_column_new_with_attributes
-       "column"
-       renderer
-       "text"
-       0
-       #f)))
-
-  (define gtk (gtk_scrolled_window_new #f #f))
+  (define gtk (as-gtk-allocation (gtk_scrolled_window_new #f #f)))
   (gtk_scrolled_window_set_policy gtk GTK_POLICY_NEVER GTK_POLICY_ALWAYS)
 
   (define client-gtk
-    (let* ([client-gtk (gtk_tree_view_new_with_model store)])
-      (gtk_tree_view_set_headers_visible client-gtk #f)
-      (gtk_tree_view_append_column client-gtk column)
-      client-gtk))
+    (atomically
+     (let* ([client-gtk (gtk_tree_view_new_with_model store)]
+            [column (let ([renderer (gtk_cell_renderer_text_new)])
+                      (gtk_tree_view_column_new_with_attributes
+                       "column"
+                       renderer
+                       "text"
+                       0
+                       #f))])
+       (gobject-unref store)
+       (gtk_tree_view_set_headers_visible client-gtk #f)
+       (gtk_tree_view_append_column client-gtk column)
+       client-gtk)))
 
   (gtk_container_add gtk client-gtk)
   (gtk_widget_show client-gtk)
@@ -139,11 +139,12 @@
                                [time-stamp (current-milliseconds)])))))))
 
   (define/private (get-iter i)
-    (let ([iter (make-GtkTreeIter 0 #f #f #f)]
-          [p (gtk_tree_path_new_from_indices i -1)])
-      (gtk_tree_model_get_iter store iter p)
-      (gtk_tree_path_free p)
-      iter))
+    (atomically
+     (let ([iter (make-GtkTreeIter 0 #f #f #f)]
+           [p (gtk_tree_path_new_from_indices i -1)])
+       (gtk_tree_model_get_iter store iter p)
+       (gtk_tree_path_free p)
+       iter)))
 
   (def/public-unimplemented get-label-font)
 
@@ -155,9 +156,10 @@
     (gtk_list_store_set store (get-iter i) 0 s -1))
 
   (define/public (set-first-visible-item i)
-    (let ([p (gtk_tree_path_new_from_indices i -1)])
-      (gtk_tree_view_scroll_to_cell client-gtk p #f #t 0.0 0.0)
-      (gtk_tree_path_free p)))
+    (atomically
+     (let ([p (gtk_tree_path_new_from_indices i -1)])
+       (gtk_tree_view_scroll_to_cell client-gtk p #f #t 0.0 0.0)
+       (gtk_tree_path_free p))))
 
   (define/public (set choices)
     (atomically
@@ -210,10 +212,11 @@
   (define/public (get-data i) (unbox (list-ref data i)))
 
   (define/public (selected? i)
-    (let ([p (gtk_tree_path_new_from_indices i -1)])
-      (begin0
-       (gtk_tree_selection_path_is_selected selection p)
-       (gtk_tree_path_free p))))
+    (atomically
+     (let ([p (gtk_tree_path_new_from_indices i -1)])
+       (begin0
+        (gtk_tree_selection_path_is_selected selection p)
+        (gtk_tree_path_free p)))))
 
   (define/public (select i [on? #t] [extend? #t])
     (atomically
diff --git a/collects/mred/private/wx/gtk/menu-bar.rkt b/collects/mred/private/wx/gtk/menu-bar.rkt
index a51a944a..8a752538 100644
--- a/collects/mred/private/wx/gtk/menu-bar.rkt
+++ b/collects/mred/private/wx/gtk/menu-bar.rkt
@@ -2,6 +2,7 @@
 (require scheme/class
          scheme/foreign
           "../../syntax.rkt"
+          "../../lock.rkt"
           "../common/freeze.rkt"
           "../common/queue.rkt"
           "widget.rkt"
@@ -73,7 +74,7 @@
 
   (define menus null)
 
-  (define gtk (gtk_menu_bar_new))
+  (define gtk (as-gtk-allocation (gtk_menu_bar_new)))
   (super-new [gtk gtk])
 
   (define/public (get-gtk) gtk)
@@ -88,15 +89,16 @@
     (install-widget-parent top)
     ;; return initial size; also, add a menu to make sure there is one,
     ;; and force the menu bar to be at least that tall always
-    (let ([item (gtk_menu_item_new_with_mnemonic "Xyz")])
-      (gtk_menu_shell_append gtk item)
-      (gtk_widget_show item)
-      (begin0
-       (let ([req (make-GtkRequisition 0 0)])
-         (gtk_widget_size_request gtk req)
-         (gtk_widget_set_usize gtk -1 (GtkRequisition-height req))
-         (GtkRequisition-height req))
-       (gtk_container_remove gtk item))))
+    (atomically
+     (let ([item (gtk_menu_item_new_with_mnemonic "Xyz")])
+       (gtk_menu_shell_append gtk item)
+       (gtk_widget_show item)
+       (begin0
+        (let ([req (make-GtkRequisition 0 0)])
+          (gtk_widget_size_request gtk req)
+          (gtk_widget_set_usize gtk -1 (GtkRequisition-height req))
+          (GtkRequisition-height req))
+        (gtk_container_remove gtk item)))))
 
   (define/public (get-top-window)
     top-wx)
@@ -129,12 +131,13 @@
   (public [append-menu append])
   (define (append-menu menu title)
     (send menu set-parent this)
-    (let* ([item (gtk_menu_item_new_with_mnemonic (fixup-mneumonic title))]
-           [item-wx (new top-menu% [parent this] [gtk item])])
-      (connect-select item)
-      (set! menus (append menus (list (list item menu item-wx))))
-      (let ([gtk (send menu get-gtk)])
-        (g_object_ref gtk)
-        (gtk_menu_item_set_submenu item gtk))
-      (gtk_menu_shell_append gtk item)
-      (gtk_widget_show item))))
+    (atomically
+     (let* ([item (gtk_menu_item_new_with_mnemonic (fixup-mneumonic title))]
+            [item-wx (new top-menu% [parent this] [gtk item])])
+       (connect-select item)
+       (set! menus (append menus (list (list item menu item-wx))))
+       (let ([gtk (send menu get-gtk)])
+         (g_object_ref gtk)
+         (gtk_menu_item_set_submenu item gtk))
+       (gtk_menu_shell_append gtk item)
+       (gtk_widget_show item)))))
diff --git a/collects/mred/private/wx/gtk/menu.rkt b/collects/mred/private/wx/gtk/menu.rkt
index 0698d6a4..4d145ec9 100644
--- a/collects/mred/private/wx/gtk/menu.rkt
+++ b/collects/mred/private/wx/gtk/menu.rkt
@@ -4,6 +4,7 @@
          "widget.rkt"
          "window.rkt"
           "../../syntax.rkt"
+          "../../lock.rkt"
          "types.rkt"
          "const.rkt"
          "utils.rkt"
@@ -80,7 +81,7 @@
 
   (define cb callback)
   
-  (define gtk (gtk_menu_new))
+  (define gtk (as-gtk-allocation (gtk_menu_new)))
   (define/public (get-gtk) gtk)
 
   (super-new [gtk gtk])
@@ -175,34 +176,36 @@
   
   (public [append-item append])
   (define (append-item i label help-str-or-submenu chckable?)
-    (let ([item-gtk ((if chckable?
-                         gtk_check_menu_item_new_with_mnemonic
-                         gtk_menu_item_new_with_mnemonic)
-                     (fixup-mneumonic label))])
-      (if (help-str-or-submenu . is-a? . menu%)
-          (let ([submenu help-str-or-submenu])
-            (let ([gtk (send submenu get-gtk)])
-              (g_object_ref gtk)
-              (gtk_menu_item_set_submenu item-gtk gtk)
-              (send submenu set-parent this)
-              (send submenu set-self-item i
-                    (lambda () (gtk_menu_item_set_submenu item-gtk #f)))
-              (set! items (append items (list (list submenu item-gtk label chckable?))))))
-          (let ([item (new menu-item-handler% 
-                           [gtk item-gtk]
-                           [menu this]
-                           [menu-item i]
-                           [parent this])])
-            (set! items (append items (list (list item item-gtk label chckable?))))
-            (adjust-shortcut item-gtk label)))
-      (gtk_menu_shell_append gtk item-gtk)
-      (gtk_widget_show item-gtk)))
+    (atomically
+     (let ([item-gtk ((if chckable?
+                          gtk_check_menu_item_new_with_mnemonic
+                          gtk_menu_item_new_with_mnemonic)
+                      (fixup-mneumonic label))])
+       (if (help-str-or-submenu . is-a? . menu%)
+           (let ([submenu help-str-or-submenu])
+             (let ([gtk (send submenu get-gtk)])
+               (g_object_ref gtk)
+               (gtk_menu_item_set_submenu item-gtk gtk)
+               (send submenu set-parent this)
+               (send submenu set-self-item i
+                     (lambda () (gtk_menu_item_set_submenu item-gtk #f)))
+               (set! items (append items (list (list submenu item-gtk label chckable?))))))
+           (let ([item (new menu-item-handler% 
+                            [gtk item-gtk]
+                            [menu this]
+                            [menu-item i]
+                            [parent this])])
+             (set! items (append items (list (list item item-gtk label chckable?))))
+             (adjust-shortcut item-gtk label)))
+       (gtk_menu_shell_append gtk item-gtk)
+       (gtk_widget_show item-gtk))))
 
   (define/public (append-separator)
-    (let ([item-gtk (gtk_separator_menu_item_new)])
-      (set! items (append items (list (list (new separator-item-handler%) item-gtk #f #f))))
-      (gtk_menu_shell_append gtk item-gtk)
-      (gtk_widget_show item-gtk)))
+    (atomically
+     (let ([item-gtk (gtk_separator_menu_item_new)])
+       (set! items (append items (list (list (new separator-item-handler%) item-gtk #f #f))))
+       (gtk_menu_shell_append gtk item-gtk)
+       (gtk_widget_show item-gtk))))
 
   (def/public-unimplemented select)
   (def/public-unimplemented get-font)
diff --git a/collects/mred/private/wx/gtk/panel.rkt b/collects/mred/private/wx/gtk/panel.rkt
index 5a54ed8b..7b34a75b 100644
--- a/collects/mred/private/wx/gtk/panel.rkt
+++ b/collects/mred/private/wx/gtk/panel.rkt
@@ -57,7 +57,7 @@
     (inherit set-size get-gtk)
     
     (super-new [parent parent]
-               [gtk (gtk_fixed_new)] ; (gtk_alignment_new 0.0 0.0 1.0 1.0)]
+               [gtk (as-gtk-allocation (gtk_fixed_new))]
                [no-show? (memq 'deleted style)])
     
     (define gtk (get-gtk))
diff --git a/collects/mred/private/wx/gtk/radio-box.rkt b/collects/mred/private/wx/gtk/radio-box.rkt
index 011e5426..8bb12b75 100644
--- a/collects/mred/private/wx/gtk/radio-box.rkt
+++ b/collects/mred/private/wx/gtk/radio-box.rkt
@@ -44,26 +44,28 @@
   (inherit set-auto-size
            on-set-focus)
 
-  (define gtk (if (memq 'horizontal style)
-                  (gtk_hbox_new #f 0)
-                  (gtk_vbox_new #f 0)))
+  (define gtk (as-gtk-allocation
+               (if (memq 'horizontal style)
+                   (gtk_hbox_new #f 0)
+                   (gtk_vbox_new #f 0))))
   (define radio-gtks (for/list ([lbl (in-list labels)])
-                       (let ([radio-gtk (cond
-                                         [(string? lbl)
-                                          (gtk_radio_button_new_with_mnemonic #f (mnemonic-string lbl))]
-                                         [(send lbl ok?)
-                                          (let ([pixbuf (bitmap->pixbuf lbl)])
-                                            (let ([radio-gtk (gtk_radio_button_new #f)]
-                                                  [image-gtk (gtk_image_new_from_pixbuf pixbuf)])
-                                              (release-pixbuf pixbuf)
-                                              (gtk_container_add radio-gtk image-gtk)
-                                              (gtk_widget_show image-gtk)
-                                              radio-gtk))]
-                                         [else
-                                          (gtk_radio_button_new_with_mnemonic #f "<bad bitmap>")])])
-                         (gtk_box_pack_start gtk radio-gtk #t #t 0)
-                         (gtk_widget_show radio-gtk)
-                         radio-gtk)))
+                       (atomically
+                        (let ([radio-gtk (cond
+                                          [(string? lbl)
+                                           (gtk_radio_button_new_with_mnemonic #f (mnemonic-string lbl))]
+                                          [(send lbl ok?)
+                                           (let ([pixbuf (bitmap->pixbuf lbl)])
+                                             (let ([radio-gtk (gtk_radio_button_new #f)]
+                                                   [image-gtk (gtk_image_new_from_pixbuf pixbuf)])
+                                               (release-pixbuf pixbuf)
+                                               (gtk_container_add radio-gtk image-gtk)
+                                               (gtk_widget_show image-gtk)
+                                               radio-gtk))]
+                                          [else
+                                           (gtk_radio_button_new_with_mnemonic #f "<bad bitmap>")])])
+                          (gtk_box_pack_start gtk radio-gtk #t #t 0)
+                          (gtk_widget_show radio-gtk)
+                          radio-gtk))))
   (for ([radio-gtk (in-list (cdr radio-gtks))])
     (let ([g (gtk_radio_button_get_group (car radio-gtks))])
       (gtk_radio_button_set_group radio-gtk g)))
@@ -108,8 +110,9 @@
      (if (= i -1)
          (when (pair? radio-gtks)
            (unless dummy-gtk 
-             (set! dummy-gtk (gtk_radio_button_new
-                              (gtk_radio_button_get_group (car radio-gtks)))))
+             (set! dummy-gtk (as-gtk-allocation
+                              (gtk_radio_button_new
+                               (gtk_radio_button_get_group (car radio-gtks))))))
            (gtk_toggle_button_set_active dummy-gtk #t))
          (gtk_toggle_button_set_active (list-ref radio-gtks i) #t))
      (set! no-clicked? #f)))
diff --git a/collects/mred/private/wx/gtk/slider.rkt b/collects/mred/private/wx/gtk/slider.rkt
index 48a0098d..edcf5ad9 100644
--- a/collects/mred/private/wx/gtk/slider.rkt
+++ b/collects/mred/private/wx/gtk/slider.rkt
@@ -39,9 +39,10 @@
   (inherit get-gtk set-auto-size)
 
   (super-new [parent parent]
-             [gtk (if (memq 'vertical style)
-                      (gtk_vscale_new #f)
-                      (gtk_hscale_new #f))]
+             [gtk (as-gtk-allocation
+                   (if (memq 'vertical style)
+                       (gtk_vscale_new #f)
+                       (gtk_hscale_new #f)))]
              [callback cb]
              [no-show? (memq 'deleted style)])
   (define gtk (get-gtk))
diff --git a/collects/mred/private/wx/gtk/utils.rkt b/collects/mred/private/wx/gtk/utils.rkt
index c157df50..1785cb1e 100644
--- a/collects/mred/private/wx/gtk/utils.rkt
+++ b/collects/mred/private/wx/gtk/utils.rkt
@@ -17,6 +17,10 @@
          g_object_ref
          g_object_unref
 
+         gobject-ref
+         gobject-unref
+         as-gobject-allocation
+
          as-gtk-allocation
          as-gtk-window-allocation
 
@@ -90,6 +94,14 @@
 (define-gobj g_object_unref (_fun _pointer -> _void))
 (define-gobj g_object_ref_sink (_fun _pointer -> _pointer))
 
+(define gobject-unref ((deallocator) g_object_unref))
+(define gobject-ref ((allocator gobject-unref) g_object_ref))
+
+(define-syntax-rule (as-gobject-allocation expr)
+  ((gobject-allocator (lambda () expr))))
+
+(define gobject-allocator (allocator gobject-unref))
+
 (define-gtk gtk_widget_destroy (_fun _GtkWidget -> _void))
 
 (define gtk-destroy ((deallocator) (lambda (v)
diff --git a/collects/mred/private/wx/gtk/widget.rkt b/collects/mred/private/wx/gtk/widget.rkt
index cf407082..4ee5f740 100644
--- a/collects/mred/private/wx/gtk/widget.rkt
+++ b/collects/mred/private/wx/gtk/widget.rkt
@@ -1,12 +1,12 @@
-#lang scheme/base
-(require scheme/foreign
-         scheme/class
+#lang racket/base
+(require ffi/unsafe
+         racket/class
          "../../syntax.rkt"
+         "../../lock.rkt"
          "../common/queue.rkt"
          "queue.rkt"
          "utils.rkt"
          "types.rkt")
-(unsafe!)
 
 (provide widget%
          gtk->wx
@@ -25,13 +25,17 @@
 
 (define-gtk gtk_widget_destroy (_fun _pointer -> _void))
 
-
 (define-gtk gtk_vbox_new (_fun _gboolean _int -> _GtkWidget))
 (define-gtk gtk_hbox_new (_fun _gboolean _int -> _GtkWidget))
 (define-gtk gtk_box_pack_start (_fun _GtkWidget _GtkWidget _gboolean _gboolean _uint -> _void))
 (define-gtk gtk_box_pack_end (_fun _GtkWidget _GtkWidget _gboolean _gboolean _uint -> _void))
 (define-gtk gtk_widget_get_parent (_fun _GtkWidget -> (_or-null _GtkWidget)))
 
+(define-signal-handler connect-destroy "destroy"
+  (_fun _GtkWidget _pointer -> _void)
+  (lambda (gtk cell)
+    (free-immobile-cell cell)))
+
 (define widget%
   (class object%
     (init gtk
@@ -52,10 +56,12 @@
     
     (super-new)
 
-    (let ([cell (malloc-immobile-cell (make-weak-box this))])
-      (g_object_set_data gtk "wx" cell)
-      (for ([gtk (in-list extra-gtks)])
-        (g_object_set_data gtk "wx" cell)))))
+    (atomically
+     (let ([cell (malloc-immobile-cell (make-weak-box this))])
+       (g_object_set_data gtk "wx" cell)
+       (for ([gtk (in-list extra-gtks)])
+         (g_object_set_data gtk "wx" cell))
+       (connect-destroy gtk cell)))))
 
 (define (gtk->wx gtk)
   (let ([ptr (g_object_get_data gtk "wx")])