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

54
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,25 +72,28 @@
(tellv item setAction: #:type _SEL (if checkable? (tellv item setAction: #:type _SEL (if checkable?
(selector selectedCheckable:) (selector selectedCheckable:)
(selector selected:))) (selector selected:)))
(let ([shortcut (regexp-match #rx"\tCut=(.)(.*)" label)]) (set-menu-item-shortcut item label)
(when shortcut
(let* ([s (string-downcase (string (integer->char (string->number (caddr shortcut)))))]
[flags (- (char->integer (string-ref (cadr shortcut) 0))
(char->integer #\A))]
[mods (+ (if (positive? (bitwise-and flags 1))
NSShiftKeyMask
0)
(if (positive? (bitwise-and flags 2))
NSAlternateKeyMask
0)
(if (positive? (bitwise-and flags 4))
NSControlKeyMask
0)
(if (positive? (bitwise-and flags 8))
0
NSCommandKeyMask))])
(tellv item setKeyEquivalent: #:type _NSString s)
(tellv item setKeyEquivalentModifierMask: #:type _NSUInteger mods))))
(release item)))) (release item))))
(super-new)) (super-new))
(define (set-menu-item-shortcut item label)
(let ([shortcut (regexp-match #rx"\tCut=(.)(.*)" label)])
(when shortcut
(let* ([s (string-downcase (string (integer->char (string->number (caddr shortcut)))))]
[flags (- (char->integer (string-ref (cadr shortcut) 0))
(char->integer #\A))]
[mods (+ (if (positive? (bitwise-and flags 1))
NSShiftKeyMask
0)
(if (positive? (bitwise-and flags 2))
NSAlternateKeyMask
0)
(if (positive? (bitwise-and flags 4))
NSControlKeyMask
0)
(if (positive? (bitwise-and flags 8))
0
NSCommandKeyMask))])
(tellv item setKeyEquivalent: #:type _NSString s)
(tellv item setKeyEquivalentModifierMask: #:type _NSUInteger mods)))))

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