diff --git a/collects/framework/splash.rkt b/collects/framework/splash.rkt index 9bb519ec57..3edea6e37b 100644 --- a/collects/framework/splash.rkt +++ b/collects/framework/splash.rkt @@ -286,7 +286,7 @@ (define/augment (on-close) (when quit-on-close? (exit))) - (super-new))) + (super-new [style '(close-button)]))) (define splash-canvas% (class canvas% diff --git a/collects/mred/private/mrtop.rkt b/collects/mred/private/mrtop.rkt index c107cfb154..a290834db2 100644 --- a/collects/mred/private/mrtop.rkt +++ b/collects/mred/private/mrtop.rkt @@ -237,7 +237,7 @@ (check-label-string cwho label) (check-top-level-parent/false cwho parent) (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]) (private-field [wx #f]) (override diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt index 58ec55651b..79e5c6a3a6 100644 --- a/collects/mred/private/wx/cocoa/frame.rkt +++ b/collects/mred/private/wx/cocoa/frame.rkt @@ -167,7 +167,9 @@ NSTitledWindowMask (if is-sheet? NSUtilityWindowMask 0) (if is-dialog? - 0 + (if (memq 'close-button style) + NSClosableWindowMask + 0) (bitwise-ior NSClosableWindowMask NSMiniaturizableWindowMask @@ -190,7 +192,7 @@ (tellv tb setVisible: #:type _BOOL #f) (tellv tb release)))) - (move -11111 (if (= y -11111) 0 y)) + (internal-move -11111 (if (= y -11111) 0 y)) (tellv cocoa setAcceptsMouseMovedEvents: #:type _BOOL #t) @@ -415,7 +417,7 @@ (define/override (set-size x y w h) (unless (and (= x -1) (= y -1)) - (move x y)) + (internal-move x y)) (let ([f (tell #:type _NSRect cocoa frame)]) (tellv cocoa setFrame: #:type _NSRect (make-NSRect @@ -436,7 +438,7 @@ (NSSize-height (NSRect-size f))))) (make-NSSize w h)) display: #:type _BOOL #t))) - (define/override (move x y) + (define/override (internal-move x y) (let ([x (if (= x -11111) (get-x) x)] [y (if (= y -11111) (get-y) y)]) (tellv cocoa setFrameTopLeftPoint: #:type _NSPoint (make-NSPoint x (- (flip-screen y) diff --git a/collects/mred/private/wx/cocoa/procs.rkt b/collects/mred/private/wx/cocoa/procs.rkt index 77866d045d..a6caa39307 100644 --- a/collects/mred/private/wx/cocoa/procs.rkt +++ b/collects/mred/private/wx/cocoa/procs.rkt @@ -91,10 +91,15 @@ (define (check-for-break) #f) (define (display-origin xb yb all?) - (set-box! xb 0) (if all? - (set-box! yb 0) - (set-box! yb (get-menu-bar-height)))) + (atomically + (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?) (atomically (with-autorelease diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index a76e56fe3a..a23a7a7295 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -520,8 +520,10 @@ (tellv cocoa setNeedsDisplay: #:type _BOOL #t) (tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint x (flip y h)) (make-NSSize w h))))) - (define/public (move x y) + (define/public (internal-move x y) (set-size x y (get-width) (get-height))) + (define/public (move x y) + (internal-move x y)) (define accept-drag? #f) (define accept-parent-drag? #f) diff --git a/collects/mred/private/wxtop.rkt b/collects/mred/private/wxtop.rkt index a0858c4816..c1fd3e71a6 100644 --- a/collects/mred/private/wxtop.rkt +++ b/collects/mred/private/wxtop.rkt @@ -90,7 +90,7 @@ [panel #f] [use-default-position? (and (= -11111 (list-ref args 2)) - (= -11111 (list-ref args (if dlg? 3 1))))] + (= -11111 (list-ref args (if dlg? 3 1))))] [enabled? #t] [focus #f] diff --git a/collects/scribblings/gui/dialog-class.scrbl b/collects/scribblings/gui/dialog-class.scrbl index 98f5e55dd6..15df432952 100644 --- a/collects/scribblings/gui/dialog-class.scrbl +++ b/collects/scribblings/gui/dialog-class.scrbl @@ -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] [x (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] [border (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, 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