racket/gui cocoa: fix "&" in labels

As of Mac OS X 10.8, `setTitleWithMnemonic:` doesn't strip away "&".

original commit: 75dade281885f7b654ee49e93e1b6349b319c1c2
This commit is contained in:
Matthew Flatt 2014-01-06 10:47:02 -07:00
parent 9308ebd949
commit ea1f6ecc1b
5 changed files with 16 additions and 12 deletions

View File

@ -59,7 +59,7 @@
NSRoundedBezelStyle)))
(cond
[(string? label)
(tellv cocoa setTitleWithMnemonic: #:type _NSString label)]
(tellv cocoa setTitle: #:type _NSString (strip-mnemonic label))]
[else
(if button-type
(tellv cocoa setTitle: #:type _NSString "")
@ -182,7 +182,7 @@
(define/override (set-label label)
(cond
[(string? label)
(tellv cocoa setTitleWithMnemonic: #:type _NSString label)]
(tellv cocoa setTitle: #:type _NSString (strip-mnemonic label))]
[else
(tellv (or image-cocoa cocoa) setImage: (bitmap->image label))]))

View File

@ -12,7 +12,8 @@
(provide
(protect-out item%
install-control-font
sys-font-size))
sys-font-size
strip-mnemonic))
(import-class NSFont)
@ -28,6 +29,9 @@
(tellv cocoa setFont: (font->NSFont font))
(tellv cocoa setFont: sys-font)))
(define (strip-mnemonic s)
(regexp-replace #rx"[&](.)" s "\\1"))
(defclass item% window%
(inherit get-cocoa
is-window-enabled?)

View File

@ -94,7 +94,7 @@
(tellv cocoa setEditable: #:type _BOOL #f)
(tellv cocoa setBordered: #:type _BOOL #f)
(tellv cocoa setDrawsBackground: #:type _BOOL #f)
(tellv cocoa setTitleWithMnemonic: #:type _NSString label)
(tellv cocoa setStringValue: #:type _NSString (strip-mnemonic label))
(tellv cocoa sizeToFit)]
[else
(tellv cocoa setImage: (if (label . is-a? . bitmap%)
@ -113,7 +113,7 @@
(define/override (set-label label)
(cond
[(string? label)
(tellv (get-cocoa) setTitleWithMnemonic: #:type _NSString label)]
(tellv (get-cocoa) setStringValue: #:type _NSString (strip-mnemonic label))]
[else
(tellv (get-cocoa) setImage: (bitmap->image label))]))

View File

@ -95,9 +95,9 @@
(set-ivar! button img (bitmap->image label)))
(begin
(init-font button font)
(tellv button setTitleWithMnemonic: #:type _NSString (if (string? label)
label
"<bad>"))))
(tellv button setTitle: #:type _NSString (if (string? label)
(strip-mnemonic label)
"<bad>"))))
(tellv button setButtonType: #:type _int NSRadioButton)))
(tellv cocoa sizeToFit)
(tellv cocoa setTarget: cocoa)

View File

@ -77,13 +77,13 @@
(tellv cocoa setEditable: #:type _BOOL #f)
(tellv cocoa setBordered: #:type _BOOL #f)
(tellv cocoa setDrawsBackground: #:type _BOOL #f)
(tellv cocoa setTitleWithMnemonic: #:type _NSString (format "~a" hi))
(tellv cocoa setStringValue: #:type _NSString (format "~a" hi))
(tellv cocoa sizeToFit)
(let ([r1 (tell #:type _NSRect cocoa frame)])
(tellv cocoa setTitleWithMnemonic: #:type _NSString (format "~a" lo))
(tellv cocoa setStringValue: #:type _NSString (format "~a" lo))
(tellv cocoa sizeToFit)
(let ([r2 (tell #:type _NSRect cocoa frame)])
(tellv cocoa setTitleWithMnemonic: #:type _NSString (format "~a" val))
(tellv cocoa setStringValue: #:type _NSString (format "~a" val))
(values cocoa
(max (NSSize-width (NSRect-size r1))
(NSSize-width (NSRect-size r2)))
@ -164,7 +164,7 @@
(flip (inexact->exact (floor (tell #:type _double slider-cocoa doubleValue)))))
(define/public (update-message [val (get-value)])
(tellv message-cocoa setTitleWithMnemonic: #:type _NSString (format "~a" val)))
(tellv message-cocoa setStringValue: #:type _NSString (format "~a" val)))
(inherit get-cocoa-window)
(define/override (post-mouse-down)