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

add 'close-button style to dialog%; fix cocoa default frame placement

Browse Source
This commit is contained in:
Matthew Flatt 2010-11-25 06:57:58 -07:00
parent ab070b205e
commit 820e832853
7 changed files with 26 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/framework/splash.rkt
View File

@ -286,7 +286,7 @@
(define/augment (on-close) (define/augment (on-close)
(when quit-on-close? (when quit-on-close?
(exit))) (exit)))
(super-new))) (super-new [style '(close-button)])))
(define splash-canvas% (define splash-canvas%
(class canvas% (class canvas%

2
collects/mred/private/mrtop.rkt
View File

@ -237,7 +237,7 @@
(check-label-string cwho label) (check-label-string cwho label)
(check-top-level-parent/false cwho parent) (check-top-level-parent/false cwho parent)
(for-each (lambda (x) (check-dimension cwho x)) (list width height x y)) (for-each (lambda (x) (check-dimension cwho x)) (list width height x y))
(check-style cwho #f '(no-caption resize-border no-sheet) style))) (check-style cwho #f '(no-caption resize-border no-sheet close-button) style)))
(rename [super-on-subwindow-char on-subwindow-char]) (rename [super-on-subwindow-char on-subwindow-char])
(private-field [wx #f]) (private-field [wx #f])
(override (override

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

@ -167,7 +167,9 @@
NSTitledWindowMask NSTitledWindowMask
(if is-sheet? NSUtilityWindowMask 0) (if is-sheet? NSUtilityWindowMask 0)
(if is-dialog? (if is-dialog?
0 (if (memq 'close-button style)
NSClosableWindowMask
0)
(bitwise-ior (bitwise-ior
NSClosableWindowMask NSClosableWindowMask
NSMiniaturizableWindowMask NSMiniaturizableWindowMask
@ -190,7 +192,7 @@
(tellv tb setVisible: #:type _BOOL #f) (tellv tb setVisible: #:type _BOOL #f)
(tellv tb release)))) (tellv tb release))))
(move -11111 (if (= y -11111) 0 y)) (internal-move -11111 (if (= y -11111) 0 y))
(tellv cocoa setAcceptsMouseMovedEvents: #:type _BOOL #t) (tellv cocoa setAcceptsMouseMovedEvents: #:type _BOOL #t)
@ -415,7 +417,7 @@
(define/override (set-size x y w h) (define/override (set-size x y w h)
(unless (and (= x -1) (= y -1)) (unless (and (= x -1) (= y -1))
(move x y)) (internal-move x y))
(let ([f (tell #:type _NSRect cocoa frame)]) (let ([f (tell #:type _NSRect cocoa frame)])
(tellv cocoa setFrame: (tellv cocoa setFrame:
#:type _NSRect (make-NSRect #:type _NSRect (make-NSRect
@ -436,7 +438,7 @@
(NSSize-height (NSRect-size f))))) (NSSize-height (NSRect-size f)))))
(make-NSSize w h)) (make-NSSize w h))
display: #:type _BOOL #t))) display: #:type _BOOL #t)))
(define/override (move x y) (define/override (internal-move x y)
(let ([x (if (= x -11111) (get-x) x)] (let ([x (if (= x -11111) (get-x) x)]
[y (if (= y -11111) (get-y) y)]) [y (if (= y -11111) (get-y) y)])
(tellv cocoa setFrameTopLeftPoint: #:type _NSPoint (make-NSPoint x (- (flip-screen y) (tellv cocoa setFrameTopLeftPoint: #:type _NSPoint (make-NSPoint x (- (flip-screen y)

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

@ -91,10 +91,15 @@
(define (check-for-break) #f) (define (check-for-break) #f)
(define (display-origin xb yb all?) (define (display-origin xb yb all?)
(set-box! xb 0)
(if all? (if all?
(set-box! yb 0) (atomically
(set-box! yb (get-menu-bar-height)))) (with-autorelease
(let* ([screen (tell (tell NSScreen screens) objectAtIndex: #:type _NSUInteger 0)]
[f (tell #:type _NSRect screen visibleFrame)])
(set-box! xb (->long (NSPoint-x (NSRect-origin f)))))))
(set-box! xb 0))
(set-box! yb (get-menu-bar-height)))
(define (display-size xb yb all?) (define (display-size xb yb all?)
(atomically (atomically
(with-autorelease (with-autorelease

4
collects/mred/private/wx/cocoa/window.rkt
View File

@ -520,8 +520,10 @@
(tellv cocoa setNeedsDisplay: #:type _BOOL #t) (tellv cocoa setNeedsDisplay: #:type _BOOL #t)
(tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint x (flip y h)) (tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint x (flip y h))
(make-NSSize w h))))) (make-NSSize w h)))))
(define/public (move x y) (define/public (internal-move x y)
(set-size x y (get-width) (get-height))) (set-size x y (get-width) (get-height)))
(define/public (move x y)
(internal-move x y))
(define accept-drag? #f) (define accept-drag? #f)
(define accept-parent-drag? #f) (define accept-parent-drag? #f)

7
collects/scribblings/gui/dialog-class.scrbl
View File

@ -16,7 +16,9 @@ A dialog is a top-level window that is @defterm{modal}: while the
[height (or/c (integer-in 0 10000) false/c) #f] [height (or/c (integer-in 0 10000) false/c) #f]
[x (or/c (integer-in 0 10000) false/c) #f] [x (or/c (integer-in 0 10000) false/c) #f]
[y (or/c (integer-in 0 10000) false/c) #f] [y (or/c (integer-in 0 10000) false/c) #f]
[style (listof (one-of/c 'no-caption 'resize-border 'no-sheet)) null] [style (listof (one-of/c 'no-caption 'resize-border
'no-sheet 'close-button))
null]
[enabled any/c #t] [enabled any/c #t]
[border (integer-in 0 1000) 0] [border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0] [spacing (integer-in 0 1000) 0]
@ -68,6 +70,9 @@ The @scheme[style] flags adjust the appearance of the dialog on some
@item{@scheme['no-sheet] --- uses a movable window for the dialog, @item{@scheme['no-sheet] --- uses a movable window for the dialog,
even if a parent window is provided (Mac OS X)} even if a parent window is provided (Mac OS X)}
@item{@scheme['close-button] --- include a close button in the
dialog's title bar, which would not normally be included (Mac OS X)}
] ]
Even if the dialog is not shown, a few notification events may be Even if the dialog is not shown, a few notification events may be