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

finix initial size of cocoa frame

Browse Source 
original commit: ca29be4eb132bf17dfe552aa78981c1f3115b9c1
This commit is contained in:
Matthew Flatt 2010-08-03 17:13:54 -06:00
parent 1bf7884280
commit 4995e89a21
1 changed files with 32 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -101,31 +101,38 @@
(let ([is-sheet? (and #f (let ([is-sheet? (and #f
is-dialog? is-dialog?
parent parent
(not (send parent frame-is-dialog?)))]) (not (send parent frame-is-dialog?)))]
(as-objc-allocation [init-rect (let-values ([(x y) (init-pos x y)])
(tell (tell (if is-sheet? (make-NSRect (make-NSPoint x y)
MyPanel (make-NSSize (max 30 w)
MyWindow) (max (if (memq 'no-caption style)
alloc) 0
initWithContentRect: #:type _NSRect (let-values ([(x y) (init-pos x y)]) 22)
(make-NSRect (make-NSPoint x y) h))))])
(make-NSSize (max 30 w) (let ([c (as-objc-allocation
(max 0 h)))) (tell (tell (if is-sheet?
styleMask: #:type _int (if (memq 'no-caption style) MyPanel
NSBorderlessWindowMask MyWindow)
(bitwise-ior alloc)
NSTitledWindowMask initWithContentRect: #:type _NSRect init-rect
(if is-sheet? NSUtilityWindowMask 0) styleMask: #:type _int (if (memq 'no-caption style)
(if is-dialog? NSBorderlessWindowMask
0 (bitwise-ior
(bitwise-ior NSTitledWindowMask
NSClosableWindowMask (if is-sheet? NSUtilityWindowMask 0)
NSMiniaturizableWindowMask (if is-dialog?
(if (memq 'no-resize-border style) 0
0 (bitwise-ior
NSResizableWindowMask))))) NSClosableWindowMask
backing: #:type _int NSBackingStoreBuffered NSMiniaturizableWindowMask
defer: #:type _BOOL NO)))] (if (memq 'no-resize-border style)
0
NSResizableWindowMask)))))
backing: #:type _int NSBackingStoreBuffered
defer: #:type _BOOL NO))])
;; use init rect as frame size, not content size
(tellv c setFrame: #:type _NSRect init-rect display: #:type _BOOL #f)
c))]
[no-show? #t]) [no-show? #t])
(define cocoa (get-cocoa)) (define cocoa (get-cocoa))
(tellv cocoa setDelegate: cocoa) (tellv cocoa setDelegate: cocoa)