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

cocoa: set button control size when font is small

Browse Source 
Closes PR 11404

original commit: d7369f819c014ab15da4b9dc23c6a4ac7f0f5664
This commit is contained in:
Matthew Flatt 2010-11-10 17:48:29 -07:00
parent f83d833348
commit 68fbeb7cde
3 changed files with 27 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -23,6 +23,9 @@
(define MIN-BUTTON-WIDTH 72) (define MIN-BUTTON-WIDTH 72)
(define BUTTON-EXTRA-WIDTH 12) (define BUTTON-EXTRA-WIDTH 12)
(define NSSmallControlSize 1)
(define NSMiniControlSize 2)
(define-objc-class MyButton NSButton (define-objc-class MyButton NSButton
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer) #:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb] [wxb]
@ -61,6 +64,14 @@
(tellv cocoa sizeToFit) (tellv cocoa sizeToFit)
(when (and (eq? event-type 'button) (when (and (eq? event-type 'button)
(string? label)) (string? label))
(when font
(let ([n (send font get-point-size)])
(when (n . < . sys-font-size)
(tellv (tell cocoa cell)
setControlSize: #:type _int
(if (n . < . (- sys-font-size 2))
NSMiniControlSize
NSSmallControlSize)))))
(let ([frame (tell #:type _NSRect cocoa frame)]) (let ([frame (tell #:type _NSRect cocoa frame)])
(tellv cocoa setFrame: #:type _NSRect (tellv cocoa setFrame: #:type _NSRect
(make-NSRect (NSRect-origin frame) (make-NSRect (NSRect-origin frame)

12
collects/mred/private/wx/cocoa/frame.rkt
View File

@ -244,12 +244,12 @@
(not (send p get-sheet))))) (not (send p get-sheet)))))
(let ([p (get-parent)]) (let ([p (get-parent)])
(send p set-sheet this) (send p set-sheet this)
(tell (tell NSApplication sharedApplication) (tellv (tell NSApplication sharedApplication)
beginSheet: cocoa beginSheet: cocoa
modalForWindow: (send p get-cocoa) modalForWindow: (send p get-cocoa)
modalDelegate: #f modalDelegate: #f
didEndSelector: #:type _SEL #f didEndSelector: #:type _SEL #f
contextInfo: #f)) contextInfo: #f))
(tellv cocoa makeKeyAndOrderFront: #f)) (tellv cocoa makeKeyAndOrderFront: #f))
(begin (begin
(when is-a-dialog? (when is-a-dialog?

13
collects/mred/private/wx/cocoa/item.rkt
View File

@ -3,6 +3,7 @@
ffi/unsafe ffi/unsafe
ffi/unsafe/objc ffi/unsafe/objc
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt"
"window.rkt" "window.rkt"
"const.rkt" "const.rkt"
"types.rkt" "types.rkt"
@ -10,11 +11,17 @@
(provide (provide
(protect-out item% (protect-out item%
install-control-font)) install-control-font
sys-font-size))
(import-class NSFont) (import-class NSFont)
(define sys-font (tell NSFont
systemFontOfSize: #:type _CGFloat 13)) (define sys-font-size 13)
(define sys-font
(atomically
(let ([f (tell NSFont systemFontOfSize: #:type _CGFloat sys-font-size)])
(tellv f retain)
f)))
(define (install-control-font cocoa font) (define (install-control-font cocoa font)
(if font (if font