fix cocoa pref menu

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

@@ -163,8 +163,6 @@
         (tellv cocoa setFocusState: #:type _BOOL on?)
         (tellv cocoa setNeedsDisplay: #:type _BOOL #t)))
 
-    (define is-visible? #f)
-
     ;; Avoid multiple queued paints:
     (define paint-queued? #f)
     ;; To handle paint requests that happen while on-paint
@@ -178,7 +176,7 @@
         (set! paint-queued? #t)
         (queue-window-event this (lambda () 
                                    (set! paint-queued? #f)
-                                   (when is-visible?
+                                   (when (is-shown-to-root?)
                                      (set! now-drawing? #t)
                                      (fix-dc)
                                      (on-paint)
@@ -268,7 +266,6 @@
     (define tr 0)
 
     (define/override (show on?)
-      (set! is-visible? on?)
       ;; FIXME: what if we're in the middle of an on-paint?
       (super show on?))
 

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

@@ -72,18 +72,20 @@
                    (tellv mb addItem: item)
                    (tellv item release)))])
   (let ([apple (tell (tell NSMenu alloc) initWithTitle: #:type _NSString "")])
-    (let ([std (lambda (title sel [shortcut ""] [mods #f])
+    (let ([std (lambda (title sel [shortcut ""] [mods #f] [delegate? #f])
                  (let ([item (tell (tell NSMenuItem alloc) 
                                    initWithTitle: #:type _NSString title
                                    action: #:type _SEL sel
                                    keyEquivalent: #:type _NSString shortcut)])
                    (when mods
                      (tellv item setKeyEquivalentModifierMask: #:type _NSInteger mods))
-                   (tellv item setTarget: app)
+                   (tellv item setTarget: (if delegate?
+                                              (tell app delegate)
+                                              app))
                    (tellv apple addItem: item)
                    (tellv item release)))])
       (std (format "About ~a" app-name) (selector orderFrontStandardAboutPanel:))
-      (std "Preferences..."  (selector openPreferences:))
+      (std "Preferences..."  (selector openPreferences:) "," #f #t)
       (tellv apple addItem: (tell NSMenuItem separatorItem))
       (let ([services (tell (tell NSMenu alloc) initWithTitle: #:type _NSString "Services")])
         (tellv app setServicesMenu: services)

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

@@ -7,6 +7,7 @@
          "const.rkt"
          "types.rkt"
          "../common/queue.rkt"
+         "../common/handlers.rkt"
          "../../lock.rkt"
          "../common/freeze.rkt")
 (unsafe!)
@@ -37,8 +38,13 @@
       (queue-quit-event)
       0]
   [-a _BOOL (openPreferences: [_id app])
-      (log-error "prefs")
-      #t])
+      (queue-prefs-event)
+      #t]
+  [-a _BOOL (validateMenuItem: [_id menuItem])
+      (if (ptr-equal? (selector openPreferences:) 
+                      (tell #:type _SEL menuItem action))
+          (not (eq? (application-pref-handler) nothing-application-pref-handler))
+          (super-tell #:type _BOOL validateMenuItem: menuItem))])
 
 (tellv app finishLaunching)
 

collects/mred/private/wx/common/event.rkt

@@ -91,8 +91,7 @@
   (init-properties [[(symbol-in button check-box choice
                                 list-box list-box-dclick text-field
                                 text-field-enter slider radio-box
-                                menu-popdown menu-popdown-none tab-panel
-                                menu) 
+                                menu-popdown menu-popdown-none tab-panel) 
                      event-type]
                     ;; FIXME: should have no default
                     'button])

collects/mred/private/wx/common/handlers.rkt

@@ -3,26 +3,31 @@
 (provide application-file-handler
          application-quit-handler
          application-about-handler
-         application-pref-handler)
+         application-pref-handler
+
+         nothing-application-pref-handler)
 
 (define afh void)
 (define application-file-handler
   (case-lambda
    [(proc) (set! afh proc)]
    [() afh]))
+
 (define aqh void)
 (define application-quit-handler
   (case-lambda
    [(proc) (set! aqh proc)]
    [() aqh]))
+
 (define aah void)
 (define application-about-handler
   (case-lambda
    [(proc) (set! aah proc)]
    [() aah]))
-(define aph void)
+
+(define (nothing-application-pref-handler) (void))
+(define aph nothing-application-pref-handler)
 (define application-pref-handler
   (case-lambda
    [(proc) (set! aph proc)]
    [() aph]))
-

collects/mred/private/wx/common/queue.rkt

@@ -38,7 +38,8 @@
          get-top-level-windows
          other-modal?
 
-         queue-quit-event)
+         queue-quit-event
+         queue-prefs-event)
 
 ;; ------------------------------------------------------------
 ;; This module must be instantiated only once:
@@ -348,3 +349,7 @@
 (define (queue-quit-event)
   ;; called in event-pump thread
   (queue-event main-eventspace (application-quit-handler) 'med))
+
+(define (queue-prefs-event)
+  ;; called in event-pump thread
+  (queue-event main-eventspace (application-pref-handler) 'med))