From 22e7cb437db55a7e08a70e70b6d5f56b4c683544 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 10 Oct 2010 10:59:04 -0600
Subject: [PATCH] win32: fix submenus and other menu operations

---
 collects/mred/private/wx/win32/menu-item.rkt |  1 +
 collects/mred/private/wx/win32/menu.rkt      | 33 +++++++++++++++-----
 2 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/collects/mred/private/wx/win32/menu-item.rkt b/collects/mred/private/wx/win32/menu-item.rkt
index 379d2db180..6141375a95 100644
--- a/collects/mred/private/wx/win32/menu-item.rkt
+++ b/collects/mred/private/wx/win32/menu-item.rkt
@@ -39,6 +39,7 @@
     (set! parent p)
     (set! label lbl)
     (set! checkable? chkbl?)
+    (set! submenu subm)
     id)
 
   (define/public (set-label hmenu pos str)
diff --git a/collects/mred/private/wx/win32/menu.rkt b/collects/mred/private/wx/win32/menu.rkt
index 33f22ecfc3..a13516f477 100644
--- a/collects/mred/private/wx/win32/menu.rkt
+++ b/collects/mred/private/wx/win32/menu.rkt
@@ -1,6 +1,7 @@
 #lang scheme/base
 (require scheme/class
          ffi/unsafe
+         (only-in racket/list drop take)
          "../../lock.rkt"
          "../../syntax.rkt"
          "utils.rkt"
@@ -26,6 +27,8 @@
 
   (define hmenu (CreatePopupMenu))
 
+  (define/public (get-hmenu) hmenu)
+
   (define/public (set-parent p lbl parent-hmenu)
     (set! label lbl)
     (set! parent p)
@@ -60,8 +63,10 @@
      (lambda (i pos)
        (send i set-label hmenu pos str))))
 
-  (def/public-unimplemented set-help-string)
-  (def/public-unimplemented number)
+  (define/public (set-help-string id str)
+    (void))
+
+  (define/public (number) (length items))
 
   (define/public (enable id on?)
     (with-item
@@ -84,25 +89,37 @@
      (lambda (i pos)
        (send i get-check hmenu pos))))
 
+  (define/private (remove-item! pos)
+    (set! items 
+          (append (take items pos)
+                  (drop items (add1 pos)))))
+
   (define/public (delete-by-position pos)
-    (RemoveMenu hmenu pos MF_BYPOSITION))
+    (atomically
+     (remove-item! pos)
+     (RemoveMenu hmenu pos MF_BYPOSITION)))
 
   (define/public (delete id)
     (with-item
      id
      (lambda (i pos)
-       (RemoveMenu hmenu pos MF_BYPOSITION))))
+       (atomically
+        (remove-item! pos)
+        (RemoveMenu hmenu pos MF_BYPOSITION)))))
 
   (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?
-                        (and (help-str-or-submenu . is-a? . menu%)
-                             help-str-or-submenu))])
+        (let* ([submenu (and (help-str-or-submenu . is-a? . menu%)
+                             help-str-or-submenu)]
+               [id (send i set-parent this label chckable?
+                         submenu)])
           (atomically
            (set! items (append items (list i)))
-           (AppendMenuW hmenu (bitwise-ior MF_STRING) (cast id _long _pointer) label))))))
+           (if submenu
+               (AppendMenuW hmenu (bitwise-ior MF_POPUP MF_STRING) (send submenu get-hmenu) label)
+               (AppendMenuW hmenu (bitwise-ior MF_STRING) (cast id _long _pointer) label)))))))
 
   (define/public (append-separator) 
     (atomically