diff --git a/collects/mred/private/wx/common/dialog.rkt b/collects/mred/private/wx/common/dialog.rkt
new file mode 100644
index 00000000..a1aa765f
--- /dev/null
+++ b/collects/mred/private/wx/common/dialog.rkt
@@ -0,0 +1,49 @@
+#lang racket/base
+(require racket/class
+         "../../lock.rkt"
+         "queue.rkt")
+
+(provide dialog-mixin)
+
+(define dialog-level-counter 0)
+
+(define (dialog-mixin %)
+  (class %
+    (super-new)
+
+    (define close-sema #f)
+
+    (define dialog-level 0)
+    (define/override (get-dialog-level) dialog-level)
+    
+    (define/override (frame-relative-dialog-status win) 
+      (let ([dl (send win get-dialog-level)])
+        (cond
+         [(= dl dialog-level) 'same]
+         [(dl . > . dialog-level) #f]
+         [else 'other])))
+  
+    (define/override (direct-show on?)
+      ;; atomic mode
+      (when on?
+        (set! dialog-level-counter (add1 dialog-level-counter))
+        (set! dialog-level dialog-level-counter))
+      (unless on?
+        (set! dialog-level 0))
+      (unless on?
+        (atomically
+         (when close-sema
+           (semaphore-post close-sema)
+           (set! close-sema #f))))
+      (super direct-show on?))
+
+    (define/override (show on?)
+      (if on?
+          (let ([s (atomically
+                    (let ([s (or close-sema (make-semaphore))])
+                      (unless close-sema (set! close-sema s))
+                      (semaphore-peek-evt s)))])
+            (super show on?)
+            (yield s)
+            (void))
+          (super show on?)))))
diff --git a/collects/mred/private/wx/gtk/dialog.rkt b/collects/mred/private/wx/gtk/dialog.rkt
index 6c063d65..04477ac8 100644
--- a/collects/mred/private/wx/gtk/dialog.rkt
+++ b/collects/mred/private/wx/gtk/dialog.rkt
@@ -3,6 +3,7 @@
          ffi/unsafe
           "../../syntax.rkt"
           "../common/queue.rkt"
+          "../common/dialog.rkt"
           "../../lock.rkt"
           "types.rkt"
           "utils.rkt"
@@ -19,60 +20,23 @@
 (define-gtk gtk_window_set_transient_for (_fun _GtkWidget _GtkWidget -> _void))
 (define-gtk gtk_window_set_type_hint (_fun _GtkWidget _int -> _void))
 
-(define dialog-level-counter 0)
+(define dialog% 
+  (class (dialog-mixin frame%)
+    (inherit get-gtk
+             get-parent)
 
-(defclass dialog% frame%
-  (inherit get-gtk
-           get-parent)
+    (super-new [is-dialog? #t])
 
-  (super-new [is-dialog? #t])
+    (gtk_window_set_type_hint (get-gtk) GDK_WINDOW_TYPE_HINT_DIALOG)
 
-  (define close-sema #f)
-
-  (gtk_window_set_type_hint (get-gtk) GDK_WINDOW_TYPE_HINT_DIALOG)
-
-  (let ([p (get-parent)])
-    (when p
-      (gtk_window_set_transient_for (get-gtk) (send p get-gtk))))
-
-  (define dialog-level 0)
-  (define/override (get-dialog-level) dialog-level)
-  
-  (define/override (frame-relative-dialog-status win) 
-    (let ([dl (send win get-dialog-level)])
-      (cond
-       [(= dl dialog-level) 'same]
-       [(dl . > . dialog-level) #f]
-       [else 'other])))
-  
-  (define/override (direct-show on?)
-    (when on?
-      (set! dialog-level-counter (add1 dialog-level-counter))
-      (set! dialog-level dialog-level-counter))
-    (unless on?
-      (set! dialog-level 0))
-    (unless on?
-      (atomically
-       (when close-sema
-         (semaphore-post close-sema)
-         (set! close-sema #f))))
-    (super direct-show on?))
-
-  (define/override (center dir wrt)
-    (if (eq? dir 'both)
-        (gtk_window_set_position (get-gtk) 
-                                 (if (get-parent)
-                                     GTK_WIN_POS_CENTER_ON_PARENT
-                                     GTK_WIN_POS_CENTER))
-        (super center dir wrt)))
-
-  (define/override (show on?)
-    (if on?
-        (let ([s (atomically
-                  (let ([s (or close-sema (make-semaphore))])
-                    (unless close-sema (set! close-sema s))
-                    (semaphore-peek-evt s)))])
-          (super show on?)
-          (yield s)
-          (void))
-        (super show on?))))
+    (let ([p (get-parent)])
+      (when p
+        (gtk_window_set_transient_for (get-gtk) (send p get-gtk))))
+    
+    (define/override (center dir wrt)
+      (if (eq? dir 'both)
+          (gtk_window_set_position (get-gtk) 
+                                   (if (get-parent)
+                                       GTK_WIN_POS_CENTER_ON_PARENT
+                                       GTK_WIN_POS_CENTER))
+          (super center dir wrt)))))
diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt
index 30738906..85a05333 100644
--- a/collects/mred/private/wx/gtk/window.rkt
+++ b/collects/mred/private/wx/gtk/window.rkt
@@ -475,15 +475,15 @@
 
     (define shown? #f)
     (define/public (direct-show on?)
-      (atomically
-       (if on?
-           (gtk_widget_show gtk)
-           (gtk_widget_hide gtk))
-       (set! shown? (and on? #t))
-       (register-child-in-parent on?))
+      (if on?
+          (gtk_widget_show gtk)
+          (gtk_widget_hide gtk))
+      (set! shown? (and on? #t))
+      (register-child-in-parent on?)
       (when on? (reset-child-dcs)))
     (define/public (show on?)
-      (direct-show on?))
+      (atomically
+       (direct-show on?)))
     (define/public (reset-child-dcs) (void))
     (define/public (is-shown?) shown?)
     (define/public (is-shown-to-root?)
diff --git a/collects/mred/private/wx/win32/button.rkt b/collects/mred/private/wx/win32/button.rkt
index 85e40db4..80901867 100644
--- a/collects/mred/private/wx/win32/button.rkt
+++ b/collects/mred/private/wx/win32/button.rkt
@@ -33,7 +33,8 @@
     (define/public (get-class) "PLTBUTTON")
     (define/public (get-flags) BS_PUSHBUTTON)
     
-    (super-new [parent parent]
+    (super-new [callback cb]
+               [parent parent]
                [hwnd 
                 (CreateWindowExW 0
                                  (get-class)
diff --git a/collects/mred/private/wx/win32/canvas.rkt b/collects/mred/private/wx/win32/canvas.rkt
index 0fd6d312..077e97e5 100644
--- a/collects/mred/private/wx/win32/canvas.rkt
+++ b/collects/mred/private/wx/win32/canvas.rkt
@@ -18,11 +18,8 @@
 
 (provide canvas%)
 
-(define-user32 GetDC (_wfun _HWND -> _HDC))
 (define-user32 BeginPaint (_wfun _HWND _pointer -> _HDC))
 (define-user32 EndPaint (_wfun _HDC _pointer -> _BOOL))
-(define-user32 InvalidateRect (_wfun _HWND (_or-null _RECT-pointer) _BOOL -> (r : _BOOL)
-                                     -> (unless r (failed 'InvalidateRect))))
 (define-user32 ShowScrollBar (_wfun _HWND _int _BOOL -> (r : _BOOL)
                                     -> (unless r (failed 'ShowScrollbar))))
 
diff --git a/collects/mred/private/wx/win32/choice.rkt b/collects/mred/private/wx/win32/choice.rkt
index 7b0a5480..383c9998 100644
--- a/collects/mred/private/wx/win32/choice.rkt
+++ b/collects/mred/private/wx/win32/choice.rkt
@@ -51,7 +51,8 @@
 
     (SendMessageW hwnd CB_SETCURSEL 0 0)
 
-    (super-new [parent parent]
+    (super-new [callback cb]
+               [parent parent]
                [hwnd hwnd]
                [style style])
 
diff --git a/collects/mred/private/wx/win32/const.rkt b/collects/mred/private/wx/win32/const.rkt
index 2e56a8d7..6f2e9e6d 100644
--- a/collects/mred/private/wx/win32/const.rkt
+++ b/collects/mred/private/wx/win32/const.rkt
@@ -598,3 +598,7 @@
 
 (define SW_SHOW 5)
 (define SW_HIDE 0)
+
+(define HORZRES       8)
+(define VERTRES       10)
+
diff --git a/collects/mred/private/wx/win32/dc.rkt b/collects/mred/private/wx/win32/dc.rkt
index 2ddc3c95..3fd63e7d 100644
--- a/collects/mred/private/wx/win32/dc.rkt
+++ b/collects/mred/private/wx/win32/dc.rkt
@@ -17,9 +17,6 @@
          request-flush-delay
          cancel-flush-delay)
 
-(define-user32 GetDC (_wfun  _HWND -> _HDC))
-(define-user32 ReleaseDC (_wfun _HWND _HDC -> _int))
-
 (define win32-bitmap%
   (class bitmap%
     (init w h hwnd)
diff --git a/collects/mred/private/wx/win32/dialog.rkt b/collects/mred/private/wx/win32/dialog.rkt
index 6456686a..3a5537d6 100644
--- a/collects/mred/private/wx/win32/dialog.rkt
+++ b/collects/mred/private/wx/win32/dialog.rkt
@@ -6,6 +6,7 @@
 	 "../../lock.rkt"
 	 "../common/queue.rkt"
 	 "../common/freeze.rkt"
+	 "../common/dialog.rkt"
          "utils.ss"
          "const.ss"
          "types.ss"
@@ -50,13 +51,11 @@
 
 (define dialog-proc (function-ptr dlgproc _DialogProc))
 
-(define dialog-level-counter 0)
-
 (define dialog% 
-  (class frame%
+  (class (dialog-mixin frame%)
     (super-new)
 
-    (define/override (create-frame parent label w h)
+    (define/override (create-frame parent label w h style)
       (let ([hwnd
              (CreateDialogIndirectParamW hInstance
                                          (make-DLGTEMPLATE
@@ -70,23 +69,4 @@
         (MoveWindow hwnd 0 0 w h #t)
         hwnd))
 
-    (define/override (is-dialog?) #t)
-
-    (define dialog-level 0)
-    (define/override (get-dialog-level) dialog-level)
-    
-    (define/override (frame-relative-dialog-status win) 
-      (let ([dl (send win get-dialog-level)])
-        (cond
-         [(= dl dialog-level) 'same]
-         [(dl . > . dialog-level) #f]
-         [else 'other])))
-
-    (define/override (direct-show on?)
-      (when on?
-        (set! dialog-level-counter (add1 dialog-level-counter))
-        (set! dialog-level dialog-level-counter))
-      (unless on?
-        (set! dialog-level 0))
-      (super direct-show on?))))
-
+    (define/override (is-dialog?) #t)))
diff --git a/collects/mred/private/wx/win32/frame.rkt b/collects/mred/private/wx/win32/frame.rkt
index 7154f107..ff250eb5 100644
--- a/collects/mred/private/wx/win32/frame.rkt
+++ b/collects/mred/private/wx/win32/frame.rkt
@@ -22,14 +22,38 @@
 (define-user32 GetActiveWindow (_wfun -> _HWND))
 (define-user32 SetFocus (_wfun _HWND -> _HWND))
 
+(define-gdi32 GetDeviceCaps (_wfun _HDC _int -> _int))
+
+(define-user32 SystemParametersInfoW (_wfun _UINT _UINT _pointer _UINT -> (r : _BOOL)
+                                            -> (unless r (failed 'SystemParametersInfo))))
+
+(define SPI_GETWORKAREA            #x0030)
+
+(define (display-size xb yb ?)
+  (atomically
+   (let ([hdc (GetDC #f)])
+     (set-box! xb (GetDeviceCaps hdc HORZRES))
+     (set-box! yb (GetDeviceCaps hdc VERTRES))
+     (ReleaseDC #f hdc))))
+
+(define (display-origin xb yb avoid-bars?)
+  (if avoid-bars?
+      (let ([r (make-RECT 0 0 0 0)])
+        (SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
+        (set-box! xb (RECT-left r))
+        (set-box! yb (RECT-top r)))
+      (begin
+        (set-box! xb 0)
+        (set-box! yb 0))))
+
 (define mouse-frame #f)
 
-(define (display-origin xb yb ?)
-  (set-box! xb 0)
-  (set-box! yb 0))
-(define (display-size xb yb ?)
-  (set-box! xb 1024)
-  (set-box! yb 768))
+(define WS_EX_TOOLWINDOW        #x00000080)
+(define WS_EX_TOPMOST           #x00000008)
+(define WS_EX_WINDOWEDGE        #x00000100)
+(define WS_EX_PALETTEWINDOW     (bitwise-ior WS_EX_WINDOWEDGE 
+                                             WS_EX_TOOLWINDOW 
+                                             WS_EX_TOPMOST))
 
 (defclass frame% window%
   (init parent
@@ -46,11 +70,29 @@
            pre-on-char pre-on-event
            reset-cursor-in-child)
 
-  (define/public (create-frame parent label w h)
-    (CreateWindowExW 0 ; (bitwise-ior WS_EX_LAYERED)
+  (define/public (create-frame parent label w h style)
+    (CreateWindowExW (if (memq 'float style)
+                         (bitwise-ior WS_EX_TOOLWINDOW
+                                      (if (memq 'no-caption style)
+                                          WS_EX_TOPMOST
+                                          WS_EX_PALETTEWINDOW))
+                         0)
                      "PLTFrame"
                      (if label label "")
-                     WS_OVERLAPPEDWINDOW
+                     (bitwise-ior
+                      WS_POPUP
+                      (if (memq 'no-resize-border style)
+                          0
+                          (bitwise-ior WS_THICKFRAME
+                                       WS_BORDER
+                                       WS_MAXIMIZEBOX))
+                      (if (memq 'no-system-menu style)
+                          0
+                          WS_SYSMENU)
+                      (if (memq 'no-caption style)
+                          0
+                          (bitwise-ior WS_CAPTION
+                                       WS_MINIMIZEBOX)))
                      0 0 w h
                      #f
                      #f
@@ -58,7 +100,7 @@
                      #f))
 
   (super-new [parent #f]
-	     [hwnd (create-frame parent label w h)]
+	     [hwnd (create-frame parent label w h style)]
 	     [style (cons 'invisible style)])
 
   (define hwnd (get-hwnd))
@@ -79,6 +121,7 @@
     (super show on?))
 
   (define/override (direct-show on?)
+    ;; atomic mode
     (when (eq? mouse-frame this) (set! mouse-frame #f))
     (register-frame-shown this on?)
     (super direct-show on?))
@@ -154,7 +197,7 @@
 
   (define/private (set-frame-focus)
     (when focus-window-path
-      (SetFocus (send (last focus-window-path) get-hwnd))))
+      (SetFocus (send (last focus-window-path) get-focus-hwnd))))
 
   (define/override (child-can-accept-focus?)
     #t)
@@ -246,6 +289,10 @@
   
   (define/override (is-frame?) #t)
 
-  (def/public-unimplemented set-icon)
+  (define/public (set-icon bm mask [mode 'both])
+    (void))
+
   (def/public-unimplemented iconize)
-  (def/public-unimplemented set-title))
+  (define/public (set-title s)
+    (SetWindowTextW (get-hwnd) s)))
+
diff --git a/collects/mred/private/wx/win32/gauge.rkt b/collects/mred/private/wx/win32/gauge.rkt
index 27ff1cc5..a2799cd8 100644
--- a/collects/mred/private/wx/win32/gauge.rkt
+++ b/collects/mred/private/wx/win32/gauge.rkt
@@ -44,7 +44,8 @@
                        hInstance
                        #f))
 
-    (super-new [parent parent]
+    (super-new [callback void]
+               [parent parent]
                [hwnd hwnd]
                [style style])
 
diff --git a/collects/mred/private/wx/win32/group-panel.rkt b/collects/mred/private/wx/win32/group-panel.rkt
index 44b8fc50..8fe5c030 100644
--- a/collects/mred/private/wx/win32/group-panel.rkt
+++ b/collects/mred/private/wx/win32/group-panel.rkt
@@ -46,7 +46,8 @@
                        hInstance
                        #f))
 
-    (super-new [parent parent]
+    (super-new [callback void]
+               [parent parent]
                [hwnd hwnd]
                [style style])
 
diff --git a/collects/mred/private/wx/win32/hbitmap.rkt b/collects/mred/private/wx/win32/hbitmap.rkt
index b8d7caf6..7458c8db 100644
--- a/collects/mred/private/wx/win32/hbitmap.rkt
+++ b/collects/mred/private/wx/win32/hbitmap.rkt
@@ -15,8 +15,6 @@
 (define-gdi32 DeleteDC (_wfun _HDC -> (r : _BOOL)
                               -> (unless r (failed 'DeleteDC))))
 (define-gdi32 SelectObject (_wfun _HDC _HBITMAP -> _HBITMAP))
-(define-user32 GetDC (_wfun  _HWND -> _HDC))
-(define-user32 ReleaseDC (_wfun _HWND _HDC -> _int))
 
 (define (bitmap->hbitmap bm)
   (let* ([w (send bm get-width)]
diff --git a/collects/mred/private/wx/win32/item.rkt b/collects/mred/private/wx/win32/item.rkt
index 6abea495..c4f93ee7 100644
--- a/collects/mred/private/wx/win32/item.rkt
+++ b/collects/mred/private/wx/win32/item.rkt
@@ -28,7 +28,12 @@
   (class %
     (inherit on-set-focus
              on-kill-focus
-             try-mouse)
+             try-mouse
+             wndproc)
+
+    (init-field [callback void])
+    (define/public (command e)
+      (callback this e))
 
     (define old-control-procs null)
 
@@ -51,7 +56,7 @@
             (queue-window-event this (lambda () (on-kill-focus)))
             (default w msg wParam lParam)]
            [else
-            (default w msg wParam lParam)])))
+            (wndproc w msg wParam lParam default)])))
     
     (define/public (default-ctlproc w msg wParam lParam)
       (let loop ([l old-control-procs])
@@ -72,6 +77,6 @@
     (define/public (set-label s)
       (SetWindowTextW (get-hwnd) s))
     
-    (def/public-unimplemented get-label)
-    (def/public-unimplemented command)))
+    (def/public-unimplemented get-label)))
+
 
diff --git a/collects/mred/private/wx/win32/key.rkt b/collects/mred/private/wx/win32/key.rkt
index b56ecdf0..154c65d9 100644
--- a/collects/mred/private/wx/win32/key.rkt
+++ b/collects/mred/private/wx/win32/key.rkt
@@ -217,7 +217,9 @@
                       [e (new key-event%
                               [key-code (if is-up?
                                            'release
-                                           id)]
+                                           (if (equal? id #\033)
+                                               'escape
+                                               id))]
                               [shift-down shift-down?]
                               [control-down control-down?]
                               [meta-down #f]
diff --git a/collects/mred/private/wx/win32/list-box.rkt b/collects/mred/private/wx/win32/list-box.rkt
index c7d441c4..20a57602 100644
--- a/collects/mred/private/wx/win32/list-box.rkt
+++ b/collects/mred/private/wx/win32/list-box.rkt
@@ -78,7 +78,8 @@
     (for ([s (in-list choices)])
       (SendMessageW/str hwnd LB_ADDSTRING 0 s))
 
-    (super-new [parent parent]
+    (super-new [callback cb]
+               [parent parent]
                [hwnd hwnd]
                [style style])
 
diff --git a/collects/mred/private/wx/win32/menu-bar.rkt b/collects/mred/private/wx/win32/menu-bar.rkt
index 33df806d..3e1ea073 100644
--- a/collects/mred/private/wx/win32/menu-bar.rkt
+++ b/collects/mred/private/wx/win32/menu-bar.rkt
@@ -23,10 +23,13 @@
 
     (define menus null)
 
-    (def/public-unimplemented set-label-top)
+    (define/public (set-label-top pos str)
+      (void)) ;; FIXME
+      
     (def/public-unimplemented number)
     (def/public-unimplemented enable-top)
-    (def/public-unimplemented delete)
+    (define/public (delete which pos)
+      (void)) ;; FIXME
 
     (public [append-item append])
     (define (append-item m lbl)
diff --git a/collects/mred/private/wx/win32/menu-item.rkt b/collects/mred/private/wx/win32/menu-item.rkt
index 57e57e7e..daa901de 100644
--- a/collects/mred/private/wx/win32/menu-item.rkt
+++ b/collects/mred/private/wx/win32/menu-item.rkt
@@ -1,6 +1,9 @@
 #lang scheme/base
 (require ffi/unsafe
          scheme/class
+         "utils.rkt"
+         "types.rkt"
+         "const.rkt"
           "../../syntax.rkt")
 
 (provide menu-item%
@@ -14,6 +17,12 @@
   (let ([wb (hash-ref ids id #f)])
     (and wb (weak-box-value wb))))
 
+(define-user32 GetMenuState (_wfun _HMENU _UINT _UINT -> _UINT))
+(define-user32 CheckMenuItem (_wfun _HMENU _UINT _UINT -> _DWORD))
+(define-user32 ModifyMenuW (_wfun _HMENU _UINT _UINT _UINT_PTR _string/utf-16
+                                  -> (r : _BOOL)
+                                  -> (unless r (failed 'ModifyMenuW))))
+
 (defclass menu-item% object%
 
   (define id
@@ -30,13 +39,37 @@
   (define parent #f)
   (define label #f)
   (define checkable? #f)
+  (define submenu #f)
 
-  (define/public (set-parent p lbl chkbl?)
+  (define/public (set-parent p lbl chkbl? subm)
     (set! parent p)
     (set! label lbl)
     (set! checkable? chkbl?)
     id)
 
+  (define/public (set-label hmenu pos str)
+    (if submenu
+        (ModifyMenuW hmenu pos
+                     (bitwise-ior MF_BYPOSITION MF_STRING MF_POPUP)
+                     (cast (send submenu get-hmenu) _HMENU _UINT_PTR)
+                     str)
+        (ModifyMenuW hmenu pos
+                     (bitwise-ior MF_BYPOSITION MF_STRING 
+                                  (GetMenuState hmenu pos MF_BYPOSITION))
+                     id
+                     str)))
+
+  (define/public (set-check hmenu pos on?)
+    (void
+     (CheckMenuItem hmenu pos (bitwise-ior MF_BYPOSITION
+                                           (if on?
+                                               MF_CHECKED
+                                               MF_UNCHECKED)))))
+
+  (define/public (get-check hmenu pos)
+    (let ([s (GetMenuState hmenu pos MF_BYPOSITION)])
+      (not (zero? (bitwise-and s MF_CHECKED)))))
+
   (public [get-id id])
   (define (get-id) id)
 
diff --git a/collects/mred/private/wx/win32/menu.rkt b/collects/mred/private/wx/win32/menu.rkt
index 4991ab20..5ed3cec0 100644
--- a/collects/mred/private/wx/win32/menu.rkt
+++ b/collects/mred/private/wx/win32/menu.rkt
@@ -38,28 +38,57 @@
   (def/public-unimplemented get-font)
   (def/public-unimplemented set-width)
   (def/public-unimplemented set-title)
-  (def/public-unimplemented set-label)
+
+  (define/private (with-item id proc)
+    (let loop ([items items] [pos 0])
+      (cond
+       [(null? items) (void)]
+       [(and (car items)
+             (eq? id (send (car items) id)))
+        (proc (car items) pos)]
+       [else (loop (cdr items) (add1 pos))])))
+
+  (define/public (set-label id str)
+    (with-item
+     id
+     (lambda (i pos)
+       (send i set-label hmenu pos str))))
+
   (def/public-unimplemented set-help-string)
   (def/public-unimplemented number)
 
   (define/public (enable id on?)
-    (for ([i (in-list items)]
-          [pos (in-naturals)])
-      (when (and i (eq? id (send i id)))
-        (void
-         (EnableMenuItem hmenu pos (bitwise-ior MF_BYPOSITION
-                                                (if on? MF_ENABLED MF_GRAYED)))))))
+    (with-item
+     id
+     (lambda (i pos)
+       (void
+        (EnableMenuItem hmenu pos 
+                        (bitwise-ior MF_BYPOSITION
+                                     (if on? MF_ENABLED MF_GRAYED)))))))
+
+  (define/public (check id on?)
+    (with-item
+     id
+     (lambda (i pos)
+       (send i set-check hmenu pos on?))))
+
+  (define/public (checked? id)
+    (with-item
+     id
+     (lambda (i pos)
+       (send i get-check hmenu pos))))
 
-  (def/public-unimplemented check)
-  (def/public-unimplemented checked?)
   (def/public-unimplemented delete-by-position)
-  (def/public-unimplemented delete)
+  (define/public (delete id)
+    (void))
 
   (public [append-item append])
   (define (append-item id label help-str-or-submenu chckable?)
     (let ([i (id-to-menu-item id)])
       (when i
-        (let ([id (send i set-parent this label chckable?)])
+        (let ([id (send i set-parent this label chckable?
+                        (and (help-str-or-submenu . is-a? . menu%)
+                             help-str-or-submenu))])
           (atomically
            (set! items (append items (list i)))
            (AppendMenuW hmenu (bitwise-ior MF_STRING) (cast id _long _pointer) label))))))
diff --git a/collects/mred/private/wx/win32/message.rkt b/collects/mred/private/wx/win32/message.rkt
index 1365fdcc..a72d0027 100644
--- a/collects/mred/private/wx/win32/message.rkt
+++ b/collects/mred/private/wx/win32/message.rkt
@@ -60,7 +60,8 @@
 
     (define/public (get-class) "PLTSTATIC")
     
-    (super-new [parent parent]
+    (super-new [callback void]
+               [parent parent]
                [hwnd 
                 (CreateWindowExW (if (string? label) WS_EX_TRANSPARENT 0)
                                  (get-class)
diff --git a/collects/mred/private/wx/win32/procs.rkt b/collects/mred/private/wx/win32/procs.rkt
index 4bfaf1fd..958cad7d 100644
--- a/collects/mred/private/wx/win32/procs.rkt
+++ b/collects/mred/private/wx/win32/procs.rkt
@@ -57,7 +57,7 @@
 (define (get-panel-background) (make-object color% "gray"))
 (define-unimplemented play-sound)
 (define-unimplemented find-graphical-system-path)
-(define-unimplemented register-collecting-blit)
+(define (register-collecting-blit . args) (void))
 (define-unimplemented unregister-collecting-blit)
 (define (shortcut-visible-in-label? [? #f]) #t)
 (define-unimplemented location->window)
@@ -69,7 +69,7 @@
 (define (get-control-font-size-in-pixels?) #t)
 (define-unimplemented cancel-quit)
 (define-unimplemented fill-private-color)
-(define-unimplemented flush-display)
+(define (flush-display) (void))
 (define-unimplemented write-resource)
 (define-unimplemented get-resource)
 (define-unimplemented bell)
@@ -79,13 +79,13 @@
 (define-unimplemented end-busy-cursor)
 (define-unimplemented is-busy?)
 (define-unimplemented begin-busy-cursor)
-(define-unimplemented get-display-depth)
+(define (get-display-depth) 32)
 (define-unimplemented is-color-display?)
 (define-unimplemented file-selector)
 (define-unimplemented get-the-x-selection)
 (define-unimplemented get-the-clipboard)
 (define-unimplemented show-print-setup)
-(define-unimplemented can-show-print-setup?)
+(define (can-show-print-setup?) #f)
 
 (define (get-highlight-background-color)
   (let ([c (GetSysColor COLOR_HIGHLIGHT)])
diff --git a/collects/mred/private/wx/win32/radio-box.rkt b/collects/mred/private/wx/win32/radio-box.rkt
index 0fcdfef7..583b246e 100644
--- a/collects/mred/private/wx/win32/radio-box.rkt
+++ b/collects/mred/private/wx/win32/radio-box.rkt
@@ -29,7 +29,8 @@
 
     (inherit auto-size set-control-font
              is-enabled-to-root?
-             subclass-control)
+             subclass-control
+             set-focus)
 
     (define callback cb)
     (define current-value val)
@@ -84,7 +85,8 @@
     (unless (= val -1)
       (SendMessageW (list-ref radio-hwnds val) BM_SETCHECK 1 0))
     
-    (super-new [parent parent]
+    (super-new [callback cb]
+               [parent parent]
                [hwnd hwnd]
                [extra-hwnds radio-hwnds]
                [style style])
@@ -115,7 +117,19 @@
                                                     [time-stamp (current-milliseconds)])))))))
 
 
-    (def/public-unimplemented button-focus)
+    (define focused 0)
+
+    (define/public (button-focus i)
+      (if (= i -1)
+          (min focused (length radio-hwnds))
+          (begin
+            (set! focused i)
+            (set-focus (list-ref radio-hwnds i)))))
+
+    (define/override (get-focus-hwnd)
+      (if (= focused -1)
+          hwnd
+          (list-ref radio-hwnds focused)))
 
     (define/public (set-selection val)
       (atomically
diff --git a/collects/mred/private/wx/win32/slider.rkt b/collects/mred/private/wx/win32/slider.rkt
index 51279d65..320e530f 100644
--- a/collects/mred/private/wx/win32/slider.rkt
+++ b/collects/mred/private/wx/win32/slider.rkt
@@ -90,7 +90,8 @@
 
   (define hwnd (or panel-hwnd slider-hwnd))
 
-  (super-new [parent parent]
+  (super-new [callback cb]
+             [parent parent]
              [hwnd hwnd]
              [extra-hwnds
               (if panel-hwnd
diff --git a/collects/mred/private/wx/win32/tab-panel.rkt b/collects/mred/private/wx/win32/tab-panel.rkt
index ce62183a..16b709df 100644
--- a/collects/mred/private/wx/win32/tab-panel.rkt
+++ b/collects/mred/private/wx/win32/tab-panel.rkt
@@ -18,6 +18,12 @@
 (define TCM_SETUNICODEFORMAT #x2005)
 (define TCM_FIRST            #x1300)
 (define TCM_INSERTITEMW  (+ TCM_FIRST 62))
+(define TCM_SETITEMW     (+ TCM_FIRST 61))
+(define TCM_SETCURSEL    (+ TCM_FIRST 12))
+(define TCM_GETCURSEL    (+ TCM_FIRST 11))
+(define TCM_GETITEMCOUNT (+ TCM_FIRST 4))
+(define TCM_DELETEITEM   (+ TCM_FIRST 8))
+(define TCM_DELETEALLITEMS (+ TCM_FIRST 9))
 
 (define-cstruct _TCITEMW
   ([mask _UINT]
@@ -37,7 +43,8 @@
 
     (define callback void)
 
-    (inherit auto-size set-control-font)
+    (inherit auto-size set-control-font
+             is-shown-to-root?)
 
     (define hwnd
       (CreateWindowExW 0
@@ -61,7 +68,9 @@
                        hInstance
                        #f))
 
-    (super-new [parent parent]
+    (super-new [callback (lambda (c) (callback c))]
+               [extra-hwnds (list client-hwnd)]
+               [parent parent]
                [hwnd hwnd]
                [style style])
 
@@ -70,15 +79,17 @@
 
     (SendMessageW hwnd TCM_SETUNICODEFORMAT 1 0)
 
-    (atomically
-     (let ([item (cast (malloc _TCITEMW 'raw) _pointer _TCITEMW-pointer)])
-       (set-TCITEMW-mask! item TCIF_TEXT)
-       (for ([i (in-list choices)]
-             [pos (in-naturals)])
-         (set-TCITEMW-pszText! item i)
-         (SendMessageW hwnd TCM_INSERTITEMW pos (cast item _pointer _LPARAM))
-         (free (TCITEMW-pszText item)))
-       (free item)))
+    (define/private (with-item proc)
+      (atomically
+       (let ([item (cast (malloc _TCITEMW 'raw) _pointer _TCITEMW-pointer)])
+         (set-TCITEMW-mask! item TCIF_TEXT)
+         (proc item 
+               (lambda () (free (TCITEMW-pszText item)))
+               (lambda (msg w)
+                 (SendMessageW hwnd msg w (cast item _pointer _LPARAM))))
+         (free item))))
+
+    (set choices)
 
     (define tab-height 0)
 
@@ -95,6 +106,64 @@
       (unless (or (= w -1) (= h -1))
         (MoveWindow client-hwnd 1 (+ tab-height 2) (- w 4) (- h tab-height 6) #t)))
 
+    (define/override (is-command? cmd)
+      (= cmd 64985))
+
+    (define/public (do-command control-hwnd)
+      (queue-window-event this (lambda ()
+                                 (callback this
+                                           (new control-event%
+                                                [event-type 'tab-panel]
+                                                [time-stamp (current-milliseconds)])))))
+
+    ;; Needed after some actions:
+    (define/private (refresh)
+      (InvalidateRect hwnd #f #f))
+
+    (define/public (set-label pos str)
+      (with-item
+       (lambda (item done-str send-msg)
+         (set-TCITEMW-pszText! item str)
+         (send-msg TCM_SETITEMW pos)
+         (done-str)))
+      (refresh))
+
+    (define/public (set-selection pos)
+      (SendMessageW hwnd TCM_SETCURSEL pos 0)
+      (refresh))
+
+    (define/public (get-selection)
+      (SendMessageW hwnd TCM_GETCURSEL 0 0))
+
+    (define/public (number)
+      (SendMessageW hwnd TCM_GETITEMCOUNT 0 0))
+
+    (define/public (delete pos)
+      (SendMessageW hwnd TCM_DELETEITEM pos 0)
+      (refresh))
+
+    (public [append* append])
+    (define (append* str)
+      (with-item
+       (lambda (item done-str send-msg)
+         (set-TCITEMW-pszText! item str)
+         (send-msg TCM_INSERTITEMW (number))
+         (done-str)))
+      (refresh))
+
+    (define/public (set choices)
+      (let ([sel (get-selection)])
+        (SendMessageW hwnd TCM_DELETEALLITEMS 0 0)
+        (with-item
+         (lambda (item done-str send-msg)
+           (for ([str (in-list choices)]
+                 [pos (in-naturals)])
+             (set-TCITEMW-pszText! item str)
+             (send-msg TCM_INSERTITEMW pos)
+             (done-str))))
+        (let ([sel (max 0 (min (length choices) sel))])
+          (set-selection sel))))
+
     (define/public (set-callback cb)
       (set! callback cb))))
 
diff --git a/collects/mred/private/wx/win32/types.rkt b/collects/mred/private/wx/win32/types.rkt
index 0c41a48a..26856830 100644
--- a/collects/mred/private/wx/win32/types.rkt
+++ b/collects/mred/private/wx/win32/types.rkt
@@ -4,12 +4,14 @@
 (provide _wfun
 	 
 	 _DWORD 	
+	 _UDWORD 	
 	 _ATOM
 	 _WPARAM
 	 _LPARAM
 	 _LRESULT
 	 _BOOL
 	 _UINT
+	 _UINT_PTR
 	 _BYTE
 	 _LONG
 	 _SHORT
@@ -45,12 +47,14 @@
   (_fun #:abi 'stdcall . a))
 
 (define _DWORD _int32)
+(define _UDWORD _uint32)
 (define _ATOM _int)
 (define _WPARAM _long)
 (define _LPARAM _long)
 (define _LRESULT _long)
 (define _BOOL (make-ctype _int (lambda (v) (if v 1 0)) (lambda (v) (not (zero? v)))))
 (define _UINT _uint)
+(define _UINT_PTR _ulong)
 (define _BYTE _uint8)
 (define _HRESULT _int32)
 (define _WCHAR _int16)
diff --git a/collects/mred/private/wx/win32/utils.rkt b/collects/mred/private/wx/win32/utils.rkt
index eff854b3..2c10cf68 100644
--- a/collects/mred/private/wx/win32/utils.rkt
+++ b/collects/mred/private/wx/win32/utils.rkt
@@ -20,7 +20,10 @@
          ShowWindow
          EnableWindow
          SetWindowTextW
-         SetCursor)
+         SetCursor
+         GetDC
+         ReleaseDC
+         InvalidateRect)
 
 (define gdi32-lib (ffi-lib "gdi32.dll"))
 (define user32-lib (ffi-lib "user32.dll"))
@@ -64,3 +67,8 @@
 
 (define-user32 SetCursor (_wfun _HCURSOR -> _HCURSOR))
 
+(define-user32 GetDC (_wfun  _HWND -> _HDC))
+(define-user32 ReleaseDC (_wfun _HWND _HDC -> _int))
+
+(define-user32 InvalidateRect (_wfun _HWND (_or-null _RECT-pointer) _BOOL -> (r : _BOOL)
+                                     -> (unless r (failed 'InvalidateRect))))
diff --git a/collects/mred/private/wx/win32/window.rkt b/collects/mred/private/wx/win32/window.rkt
index 1c311c2d..2c381f8d 100644
--- a/collects/mred/private/wx/win32/window.rkt
+++ b/collects/mred/private/wx/win32/window.rkt
@@ -43,7 +43,7 @@
 (define-user32 CreateWindowExW (_wfun _DWORD
 				      _string/utf-16
 				      _string/utf-16
-				      _DWORD
+				      _UDWORD
 				      _int _int _int _int
 				      _HWND _HMENU _HINSTANCE _pointer
 				      -> _HWND))
@@ -92,8 +92,6 @@
 
 (define-user32 BeginPaint (_wfun _HWND _pointer -> _HDC))
 (define-user32 EndPaint (_wfun _HDC _pointer -> _BOOL))
-(define-user32 InvalidateRect (_wfun _HWND (_or-null _RECT-pointer) _BOOL -> (r : _BOOL)
-                                     -> (unless r (failed 'InvalidateRect))))
 
 (defclass window% object%
   (init-field parent hwnd)
@@ -110,6 +108,7 @@
 
   (define/public (get-hwnd) hwnd)
   (define/public (get-client-hwnd) hwnd)
+  (define/public (get-focus-hwnd) hwnd)
   (define/public (get-eventspace) eventspace)
 
   (define/public (is-hwnd? a-hwnd)
@@ -125,24 +124,24 @@
          [(= msg WM_KILLFOCUS)
           (queue-window-event this (lambda () (on-kill-focus)))
           0]
-         [(= msg WM_SYSKEYDOWN)
-          (when (or (= wParam VK_MENU) (= wParam VK_F4)) ;; F4 is close
-            (unhide-cursor)
-            (begin0
-             (default w msg wParam lParam)
-             (do-key wParam lParam #f #f)))]
+         [(and (= msg WM_SYSKEYDOWN)
+               (or (= wParam VK_MENU) (= wParam VK_F4))) ;; F4 is close
+          (unhide-cursor)
+          (begin0
+           (default w msg wParam lParam)
+           (do-key wParam lParam #f #f))]
          [(= msg WM_KEYDOWN)
           (do-key wParam lParam #f #f)
           0]
          [(= msg WM_KEYUP)
           (do-key wParam lParam #f #t)
           0]
-         [(= msg WM_SYSCHAR)
-          (when (= wParam VK_MENU)
-            (unhide-cursor)
-            (begin0
-             (default w msg wParam lParam)
-             (do-key wParam lParam #t #f)))]
+         [(and (= msg WM_SYSCHAR)
+               (= wParam VK_MENU))
+          (unhide-cursor)
+          (begin0
+           (default w msg wParam lParam)
+           (do-key wParam lParam #t #f))]
          [(= msg WM_CHAR)
           (do-key wParam lParam #t #f)
           0]
@@ -155,12 +154,14 @@
                   0)
                 (default w msg wParam lParam)))]
          [(= msg WM_NOTIFY)
-          #;
           (let* ([nmhdr (cast lParam _LPARAM _NMHDR-pointer)]
-          [control-hwnd (NMHDR-hwndFrom nmhdr)]
-          [wx (any-hwnd->wx control-hwnd)])
-          (when wx (send wx do-command)))
-          0]
+                 [control-hwnd (NMHDR-hwndFrom nmhdr)]
+                 [wx (any-hwnd->wx control-hwnd)])
+            (if (and wx (send wx is-command? (LOWORD (NMHDR-code nmhdr))))
+                (begin
+                  (send wx do-command control-hwnd)
+                  0)
+                (default w msg wParam lParam)))]
          [(or (= msg WM_HSCROLL)
               (= msg WM_VSCROLL))
           (let* ([control-hwnd (cast lParam _LPARAM _HWND)]
@@ -177,10 +178,11 @@
   (define/public (control-scrolled) #f)
 
   (define/public (show on?)
-    (direct-show on?))
+    (atomically (direct-show on?)))
 
   (define shown? #f)
   (define/public (direct-show on?)
+    ;; atomic mode
     (set! shown? (and on? #t))
     (register-child-in-parent on?)
     (unless on? (not-focus-child this))
@@ -361,9 +363,9 @@
   (define/public (no-cursor-handle-here)
     (send parent cursor-updated-here))
 
-  (define/public (set-focus)
+  (define/public (set-focus [child-hwnd hwnd])
     (when (can-accept-focus?)
-      (set-top-focus this null hwnd)))
+      (set-top-focus this null child-hwnd)))
 
   (define/public (can-accept-focus?)
     (child-can-accept-focus?))