fix cocoa menu-bar set menu label

collects/mred/private/wx/cocoa/menu-bar.rkt

@@ -1,14 +1,13 @@
 #lang scheme/base
-(require scheme/class
-         scheme/foreign
-         ffi/objc
+(require racket/class
+         ffi/unsafe
+         ffi/unsafe/objc
+         (only-in racket/list take drop)
          "../../syntax.rkt"
          "utils.rkt"
          "types.rkt"
          "const.rkt"
          "queue.rkt")
-(unsafe!)
-(objc-unsafe!)
 
 (provide menu-bar%)
 
@@ -113,7 +112,6 @@
 (defclass menu-bar% object%
   (define menus null)
 
-  (def/public-unimplemented set-label-top)
   (def/public-unimplemented number)
   (def/public-unimplemented enable-top)
 
@@ -130,7 +128,9 @@
   (public [append-menu append])
   (define (append-menu menu title)
     (set! menus (append menus (list (cons menu title))))
-    (send menu set-parent this))
+    (send menu set-parent this)
+    (when (eq? current-mb this)
+      (send menu install cocoa-mb title)))
 
   (define/public (install)
     (let loop ()
@@ -148,6 +148,15 @@
   (define/public (get-top-window)
     top-wx)
 
+  (define/public (set-label-top pos str)
+    (set! menus (append
+                 (take menus pos)
+                 (list (cons (car (list-ref menus pos)) str))
+                 (drop menus (add1 pos))))
+    (when (eq? current-mb this)
+      (tellv (tell cocoa-mb itemAtIndex: #:type _NSInteger 1)
+             setTitle: #:type _NSString (clean-menu-label str))))
+
   (define/public (do-on-menu-click)
     (let ([es (send top-wx get-eventspace)])
       (when es

collects/mred/private/wx/cocoa/menu.rkt

@@ -17,9 +17,6 @@
 
 (define-struct mitem (item))
 
-(define (clean-label str)
-  (regexp-replace* #rx"&(.)" str "\\1"))
-
 (defclass menu% object%
   (init-field label
               callback
@@ -37,13 +34,13 @@
       (set! cocoa
             (as-objc-allocation
              (tell (tell NSMenuItem alloc)
-                   initWithTitle: #:type _NSString (clean-label label)
+                   initWithTitle: #:type _NSString (clean-menu-label label)
                    action: #:type _SEL #f
                    keyEquivalent: #:type _NSString "")))
       (set! cocoa-menu
             (as-objc-allocation
              (tell (tell NSMenu alloc)
-                   initWithTitle: #:type _NSString (clean-label label))))
+                   initWithTitle: #:type _NSString (clean-menu-label label))))
       (tellv cocoa-menu setAutoenablesItems: #:type _BOOL #f)
       (tellv cocoa setSubmenu: cocoa-menu)
       (for-each (lambda (item)
@@ -137,9 +134,9 @@
   (define/public (set-label item label)
     (adjust item
             (lambda (item-cocoa)
-              (tellv item-cocoa setTitle: #:type _NSString (clean-label label)))
+              (tellv item-cocoa setTitle: #:type _NSString (clean-menu-label label)))
             (lambda (mitem)
-              (send (mitem-item mitem) set-label (clean-label label)))))
+              (send (mitem-item mitem) set-label (clean-menu-label label)))))
 
   (define/public (check item on?)
     (adjust item

collects/mred/private/wx/cocoa/utils.rkt

@@ -13,7 +13,8 @@
          define-mz
          as-objc-allocation
          retain release
-         with-autorelease)
+         with-autorelease
+         clean-menu-label)
 
 (define cocoa-lib (ffi-lib (format "/System/Library/Frameworks/Cocoa.framework/Cocoa")))
 (define cf-lib (ffi-lib (format "/System/Library/Frameworks/CoreFoundation.framework/CoreFoundation")))
@@ -46,3 +47,6 @@
     (begin0
      (thunk)
      (release pool))))
+
+(define (clean-menu-label str)
+  (regexp-replace* #rx"&(.)" str "\\1"))