From d920342fa16664b414e8ac1890523cd13c145a12 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 15 Sep 2010 16:30:44 -0600
Subject: [PATCH] cocoa cechkable menu repairs

---
 collects/mred/private/wx/cocoa/menu-item.rkt | 19 ++++++++++++++++---
 collects/mred/private/wx/cocoa/menu.rkt      |  8 ++++----
 2 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/collects/mred/private/wx/cocoa/menu-item.rkt b/collects/mred/private/wx/cocoa/menu-item.rkt
index fc8e75dfc8..5495e00ee8 100644
--- a/collects/mred/private/wx/cocoa/menu-item.rkt
+++ b/collects/mred/private/wx/cocoa/menu-item.rkt
@@ -18,7 +18,11 @@
   (-a _void (selected: [_id sender]) 
       (let ([wx (->wx wxb)])
         (when wx
-          (send wx selected)))))
+          (send wx selected))))
+  (-a _void (selectedCheckable: [_id sender]) 
+      (let ([wx (->wx wxb)])
+        (when wx
+          (send wx selected-checkable self)))))
 
 
 (defclass menu-item% object%
@@ -28,6 +32,11 @@
   (define/public (selected)
     ;; called in Cocoa thread
     (send parent item-selected this))
+  (define/public (selected-checkable cocoa)
+    ;; called in Cocoa thread
+    (set! checked? (not checked?))
+    (tellv cocoa setState: #:type _int (if checked? 1 0))
+    (send parent item-selected this))
 
   (define/public (set-parent p)
     (set! parent p))
@@ -47,7 +56,7 @@
   (define submenu #f)
   (define/public (set-submenu m) (set! submenu m))
 
-  (define/public (install menu)
+  (define/public (install menu checkable?)
     (if submenu
         (send submenu install menu label enabled?)
         (let ([item (as-objc-allocation
@@ -58,8 +67,12 @@
           (set-ivar! item wxb (->wxb this))
           (tellv menu addItem: item)
           (tellv item setEnabled: #:type _BOOL enabled?)
+          (when checked?
+            (tellv item setState: #:type _int 1))
           (tellv item setTarget: item)
-          (tellv item setAction: #:type _SEL (selector selected:))
+          (tellv item setAction: #:type _SEL (if checkable?
+                                                 (selector selectedCheckable:)
+                                                 (selector selected:)))
           (let ([shortcut (regexp-match #rx"\tCut=(.)(.*)" label)])
             (when shortcut
               (let* ([s (string-downcase (string (integer->char (string->number (caddr shortcut)))))]
diff --git a/collects/mred/private/wx/cocoa/menu.rkt b/collects/mred/private/wx/cocoa/menu.rkt
index a671fffd4e..422554f91c 100644
--- a/collects/mred/private/wx/cocoa/menu.rkt
+++ b/collects/mred/private/wx/cocoa/menu.rkt
@@ -15,7 +15,7 @@
 
 (import-class NSMenu NSMenuItem)
 
-(define-struct mitem (item))
+(define-struct mitem (item checkable?))
 
 (defclass menu% object%
   (init-field label
@@ -45,7 +45,7 @@
       (tellv cocoa setSubmenu: cocoa-menu)
       (for-each (lambda (item)
                   (if item
-                      (send (mitem-item item) install cocoa-menu)
+                      (send (mitem-item item) install cocoa-menu (mitem-checkable? item))
                       (tellv cocoa-menu addItem: (tell NSMenuItem separatorItem))))
                 items)))
 
@@ -100,10 +100,10 @@
     (when (help-str-or-submenu . is-a? . menu%)
       (send i set-submenu help-str-or-submenu)
       (send help-str-or-submenu set-parent this))
-    (set! items (append items (list (make-mitem i))))
+    (set! items (append items (list (make-mitem i chckable?))))
     (send i set-parent this)
     (when cocoa-menu
-      (send i install cocoa-menu)))
+      (send i install cocoa-menu chckable?)))
 
   (define/public (append-separator)
     (set! items (append items (list #f)))