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

cocoa: fix removal of menu shortcut

Browse Source 
Closes PR 11463

original commit: 2282cae59ab233d9f054bb87d1eefb72f82a74ac
This commit is contained in:
Matthew Flatt 2010-11-28 09:21:16 -07:00
parent e73027e3ad
commit 23ce612716
1 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -80,21 +80,22 @@
(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)))))
(if 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))
(tellv item setKeyEquivalent: #:type _NSString ""))))