cocoa cechkable menu repairs

This commit is contained in:
Matthew Flatt 2010-09-15 16:30:44 -06:00
parent d094fff51e
commit d920342fa1
2 changed files with 20 additions and 7 deletions

View File

@ -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)))))]

View File

@ -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)))