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

cocoa: fix relabel of image checkbox

Browse Source
This commit is contained in:
Matthew Flatt 2010-11-28 07:52:01 -07:00
parent 262531e231
commit f090e732fd
1 changed files with 37 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
collects/mred/private/wx/cocoa/button.rkt
View File

@ -87,41 +87,42 @@
(NSSize-height (NSRect-size frame))))))) (NSSize-height (NSRect-size frame)))))))
cocoa)) cocoa))
(define cocoa (if (and button-type (define-values (cocoa image-cocoa)
(not (string? label)) (if (and button-type
(send label ok?)) (not (string? label))
;; Check-box image: need an view to join a button and an image view: (send label ok?))
;; (Could we use the NSImageButtonCell from the radio-box implementation ;; Check-box image: need an view to join a button and an image view:
;; instead?) ;; (Could we use the NSImageButtonCell from the radio-box implementation
(let* ([frame (tell #:type _NSRect button-cocoa frame)] ;; instead?)
[new-width (+ (NSSize-width (NSRect-size frame)) (let* ([frame (tell #:type _NSRect button-cocoa frame)]
(send label get-width))] [new-width (+ (NSSize-width (NSRect-size frame))
[new-height (max (NSSize-height (NSRect-size frame)) (send label get-width))]
(send label get-height))]) [new-height (max (NSSize-height (NSRect-size frame))
(let ([cocoa (as-objc-allocation (send label get-height))])
(tell (tell NSView alloc) (let ([cocoa (as-objc-allocation
initWithFrame: #:type _NSRect (tell (tell NSView alloc)
(make-NSRect (NSRect-origin frame) initWithFrame: #:type _NSRect
(make-NSSize new-width (make-NSRect (NSRect-origin frame)
new-height))))] (make-NSSize new-width
[image-cocoa (as-objc-allocation new-height))))]
(tell (tell NSImageView alloc) init))]) [image-cocoa (as-objc-allocation
(tellv cocoa addSubview: button-cocoa) (tell (tell NSImageView alloc) init))])
(tellv cocoa addSubview: image-cocoa) (tellv cocoa addSubview: button-cocoa)
(tellv image-cocoa setImage: (bitmap->image label)) (tellv cocoa addSubview: image-cocoa)
(tellv image-cocoa setFrame: #:type _NSRect (tellv image-cocoa setImage: (bitmap->image label))
(make-NSRect (make-NSPoint (NSSize-width (NSRect-size frame)) (tellv image-cocoa setFrame: #:type _NSRect
(quotient (- new-height (make-NSRect (make-NSPoint (NSSize-width (NSRect-size frame))
(send label get-height)) (quotient (- new-height
2)) (send label get-height))
(make-NSSize (send label get-width) 2))
(send label get-height)))) (make-NSSize (send label get-width)
(tellv button-cocoa setFrame: #:type _NSRect (send label get-height))))
(make-NSRect (make-NSPoint 0 0) (tellv button-cocoa setFrame: #:type _NSRect
(make-NSSize new-width new-height))) (make-NSRect (make-NSPoint 0 0)
(set-ivar! button-cocoa wxb (->wxb this)) (make-NSSize new-width new-height)))
cocoa)) (set-ivar! button-cocoa wxb (->wxb this))
button-cocoa)) (values cocoa image-cocoa)))
(values button-cocoa #f)))
(define we (make-will-executor)) (define we (make-will-executor))
@ -146,7 +147,7 @@
[(string? label) [(string? label)
(tellv cocoa setTitleWithMnemonic: #:type _NSString label)] (tellv cocoa setTitleWithMnemonic: #:type _NSString label)]
[else [else
(tellv cocoa setImage: (bitmap->image label))])) (tellv (or image-cocoa cocoa) setImage: (bitmap->image label))]))
(define callback cb) (define callback cb)
(define/public (clicked) (define/public (clicked)