suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cocoa cechkable menu repairs

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/mred/private/wx/cocoa/menu-item.rkt
View File

@ -18,7 +18,11 @@
(-a _void (selected: [_id sender]) (-a _void (selected: [_id sender])
(let ([wx (->wx wxb)]) (let ([wx (->wx wxb)])
(when wx (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% (defclass menu-item% object%
@ -28,6 +32,11 @@
(define/public (selected) (define/public (selected)
;; called in Cocoa thread ;; called in Cocoa thread
(send parent item-selected this)) (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) (define/public (set-parent p)
(set! parent p)) (set! parent p))
@ -47,7 +56,7 @@
(define submenu #f) (define submenu #f)
(define/public (set-submenu m) (set! submenu m)) (define/public (set-submenu m) (set! submenu m))
(define/public (install menu) (define/public (install menu checkable?)
(if submenu (if submenu
(send submenu install menu label enabled?) (send submenu install menu label enabled?)
(let ([item (as-objc-allocation (let ([item (as-objc-allocation
@ -58,8 +67,12 @@
(set-ivar! item wxb (->wxb this)) (set-ivar! item wxb (->wxb this))
(tellv menu addItem: item) (tellv menu addItem: item)
(tellv item setEnabled: #:type _BOOL enabled?) (tellv item setEnabled: #:type _BOOL enabled?)
(when checked?
(tellv item setState: #:type _int 1))
(tellv item setTarget: item) (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)]) (let ([shortcut (regexp-match #rx"\tCut=(.)(.*)" label)])
(when shortcut (when shortcut
(let* ([s (string-downcase (string (integer->char (string->number (caddr shortcut)))))] (let* ([s (string-downcase (string (integer->char (string->number (caddr shortcut)))))]

8
collects/mred/private/wx/cocoa/menu.rkt
View File

@ -15,7 +15,7 @@
(import-class NSMenu NSMenuItem) (import-class NSMenu NSMenuItem)
(define-struct mitem (item)) (define-struct mitem (item checkable?))
(defclass menu% object% (defclass menu% object%
(init-field label (init-field label
@ -45,7 +45,7 @@
(tellv cocoa setSubmenu: cocoa-menu) (tellv cocoa setSubmenu: cocoa-menu)
(for-each (lambda (item) (for-each (lambda (item)
(if 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)))) (tellv cocoa-menu addItem: (tell NSMenuItem separatorItem))))
items))) items)))
@ -100,10 +100,10 @@
(when (help-str-or-submenu . is-a? . menu%) (when (help-str-or-submenu . is-a? . menu%)
(send i set-submenu help-str-or-submenu) (send i set-submenu help-str-or-submenu)
(send help-str-or-submenu set-parent this)) (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) (send i set-parent this)
(when cocoa-menu (when cocoa-menu
(send i install cocoa-menu))) (send i install cocoa-menu chckable?)))
(define/public (append-separator) (define/public (append-separator)
(set! items (append items (list #f))) (set! items (append items (list #f)))