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
(require scheme/class
scheme/foreign
ffi/objc
#lang racket/base
(require racket/class
ffi/unsafe
ffi/unsafe/objc
"../../syntax.rkt"
"utils.rkt"
"types.rkt"
"const.rkt")
(unsafe!)
(objc-unsafe!)
(provide menu-item%)
(provide menu-item%
set-menu-item-shortcut)
(import-class NSMenuItem)
@ -73,25 +72,28 @@
(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)))))]
[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))))
(set-menu-item-shortcut item label)
(release item))))
(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
(require scheme/class
scheme/foreign
#lang racket/base
(require racket/class
ffi/unsafe
ffi/unsafe/objc
(only-in scheme/list drop take)
ffi/objc
"../common/event.rkt"
"../../syntax.rkt"
"utils.rkt"
"types.rkt"
"window.rkt")
(unsafe!)
(objc-unsafe!)
"window.rkt"
"menu-item.rkt")
(provide menu%)
@ -136,7 +135,8 @@
(define/public (set-label item label)
(adjust item
(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)
(send (mitem-item mitem) set-label (clean-menu-label label)))))