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

cocoa: fix menu set-label

Browse Source 
original commit: 99266dcdcf8a14de3cb916bf248958e9964b6f1c
This commit is contained in:
Matthew Flatt 2010-10-26 09:47:36 -06:00
parent a7d96b37ce
commit a8ff7273c0
2 changed files with 36 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,15 +1,14 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
ffi/objc ffi/unsafe/objc
"../../syntax.rkt" "../../syntax.rkt"
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"const.rkt") "const.rkt")
(unsafe!)
(objc-unsafe!)
(provide menu-item%) (provide menu-item%
set-menu-item-shortcut)
(import-class NSMenuItem) (import-class NSMenuItem)
@ -73,6 +72,12 @@
(tellv item setAction: #:type _SEL (if checkable? (tellv item setAction: #:type _SEL (if checkable?
(selector selectedCheckable:) (selector selectedCheckable:)
(selector selected:))) (selector selected:)))
(set-menu-item-shortcut item label)
(release item))))
(super-new))
(define (set-menu-item-shortcut item label)
(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)))))]
@ -91,7 +96,4 @@
0 0
NSCommandKeyMask))]) NSCommandKeyMask))])
(tellv item setKeyEquivalent: #:type _NSString s) (tellv item setKeyEquivalent: #:type _NSString s)
(tellv item setKeyEquivalentModifierMask: #:type _NSUInteger mods)))) (tellv item setKeyEquivalentModifierMask: #:type _NSUInteger mods)))))
(release item))))
(super-new))

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

@ -1,15 +1,14 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
ffi/unsafe/objc
(only-in scheme/list drop take) (only-in scheme/list drop take)
ffi/objc
"../common/event.rkt" "../common/event.rkt"
"../../syntax.rkt" "../../syntax.rkt"
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"window.rkt") "window.rkt"
(unsafe!) "menu-item.rkt")
(objc-unsafe!)
(provide menu%) (provide menu%)
@ -136,7 +135,8 @@
(define/public (set-label item label) (define/public (set-label item label)
(adjust item (adjust item
(lambda (item-cocoa) (lambda (item-cocoa)
(tellv item-cocoa setTitle: #:type _NSString (clean-menu-label label))) (tellv item-cocoa setTitle: #:type _NSString (clean-menu-label (regexp-replace #rx"\t.*" label "")))
(set-menu-item-shortcut item-cocoa label))
(lambda (mitem) (lambda (mitem)
(send (mitem-item mitem) set-label (clean-menu-label label))))) (send (mitem-item mitem) set-label (clean-menu-label label)))))