fix problems and consistency with fullscreen in frame%

The `fullscreen` method implied `show` on Mac OS X and Windows, but
not on Gtk, and a frae shown that was was not properly registered
as shown (e.g., the application could exit). For consistency, adjust
`fullscreen` to not imply `show`. Also, shift to a remaining frame
on Mac OS X when a fullscreen frame is closed.
This commit is contained in:
Matthew Flatt 2015-10-04 14:12:31 -06:00
parent ea576d3177
commit cdc992ccb9
3 changed files with 82 additions and 53 deletions

View File

@ -124,7 +124,7 @@ See also @method[frame% set-status-text].
void?]{
Puts the frame in fullscreen mode or restores the frame to
non-fullscreen mode.
non-fullscreen mode. The frame's show state is not affected.
@Unmonitored[@elem{A frame's mode} @elem{the user} @elem{a
frame has been put in fullscreen mode} @elem{@method[frame% is-fullscreened?]}]
@ -133,9 +133,9 @@ On Mac OS X, the @racket[frame%] must be created with the style
@racket['fullscreen-button] for fullscreen mode to work, and Mac OS X
10.7 or later is required.
@history[#:added "6.0.0.6"]
}
@history[#:added "1.9"
#:changed "1.18" @elem{Changed @method[frame% fullscreen] with @racket[#t]
to not imply @method[window<%> show] on Windows and Mac OS X.}]}
@defmethod[(get-menu-bar)
(or/c (is-a?/c menu-bar%) #f)]{

View File

@ -27,7 +27,7 @@
(import-class NSWindow NSGraphicsContext NSMenu NSPanel
NSApplication NSAutoreleasePool NSScreen
NSToolbar)
NSToolbar NSArray)
(define NSWindowCloseButton 0)
(define NSWindowToolbarButton 3)
@ -360,7 +360,11 @@
contextInfo: #f))
(if float?
(tellv cocoa orderFront: #f)
(tellv cocoa makeKeyAndOrderFront: #f)))
(begin
(tellv cocoa makeKeyAndOrderFront: #f)
(when unshown-fullscreen?
(set! unshown-fullscreen? #f)
(tellv cocoa toggleFullScreen: #f)))))
(begin
(when is-a-dialog?
(let ([p (get-parent)])
@ -371,7 +375,13 @@
endSheet: cocoa))))
(when (is-shown?) ; otherwise, `deminiaturize' can show the window
(tellv cocoa deminiaturize: #f)
(tellv cocoa orderOut: #f))
(define fs? (fullscreened?))
(set! unshown-fullscreen? fs?)
(tellv cocoa orderOut: #f)
(when fs?
;; Need to select another window to get rid of
;; the window's screen:
(tellv (get-app-front-window) orderFront: #f)))
(force-window-focus)))
(register-frame-shown this on?)
(let ([num (tell #:type _NSInteger cocoa windowNumber)])
@ -699,11 +709,19 @@
(tellv cocoa miniaturize: cocoa)
(tellv cocoa deminiaturize: cocoa)))
(define unshown-fullscreen? #f)
(define/public (fullscreened?)
(positive? (bitwise-and (tell #:type _NSUInteger cocoa styleMask) NSFullScreenWindowMask)))
(and (version-10.7-or-later?)
(if (tell #:type _bool cocoa isVisible)
(positive? (bitwise-and (tell #:type _NSUInteger cocoa styleMask) NSFullScreenWindowMask))
unshown-fullscreen?)))
(define/public (fullscreen on?)
(unless (eq? (and on? #t) (fullscreened?))
(tellv cocoa toggleFullScreen: #f)))
(when (version-10.7-or-later?)
(unless (eq? (and on? #t) (fullscreened?))
(if (tell #:type _bool cocoa isVisible)
(tellv cocoa toggleFullScreen: #f)
(set! unshown-fullscreen? (and on? #t))))))
(define/public (set-title s)
(tellv cocoa setTitle: #:type _NSString s))

View File

@ -313,7 +313,12 @@
(ShowWindow hwnd SW_RESTORE))
(when on?
(unless float-without-caption?
(BringWindowToTop hwnd))))
(BringWindowToTop hwnd)))
(when (and on? unshown-fullscreen?)
(set! unshown-fullscreen? #f)
(fullscreen #t))
(when (not on?)
(set! unshown-fullscreen? (fullscreened?))))
(define/public (destroy)
(direct-show #f))
@ -589,54 +594,60 @@
(define pre-fullscreen-rect #f)
(define pre-fullscreen-style 0)
(define unshown-fullscreen? #f)
(define/public (fullscreened?)
; check our dimensions against those of the nearest monitor
(define win-rect (GetWindowRect hwnd))
(define mon (MonitorFromWindow hwnd MONITOR_DEFAULTTONEAREST))
(define mi (cast (malloc _MONITORINFO)
_pointer
_MONITORINFO-pointer))
(set-MONITORINFO-cbSize! mi (ctype-sizeof _MONITORINFO))
(GetMonitorInfoW mon mi)
(define mon-rect (MONITORINFO-rcMonitor mi))
(and (= (RECT-left mon-rect) (RECT-left win-rect))
(= (RECT-right mon-rect) (RECT-right win-rect))
(= (RECT-top mon-rect) (RECT-top win-rect))
(= (RECT-bottom mon-rect) (RECT-bottom win-rect))))
(cond
[(is-shown?)
;; check our dimensions against those of the nearest monitor
(define win-rect (GetWindowRect hwnd))
(define mon (MonitorFromWindow hwnd MONITOR_DEFAULTTONEAREST))
(define mi (cast (malloc _MONITORINFO)
_pointer
_MONITORINFO-pointer))
(set-MONITORINFO-cbSize! mi (ctype-sizeof _MONITORINFO))
(GetMonitorInfoW mon mi)
(define mon-rect (MONITORINFO-rcMonitor mi))
(and (= (RECT-left mon-rect) (RECT-left win-rect))
(= (RECT-right mon-rect) (RECT-right win-rect))
(= (RECT-top mon-rect) (RECT-top win-rect))
(= (RECT-bottom mon-rect) (RECT-bottom win-rect)))]
[else unshown-fullscreen?]))
(define/public (fullscreen on?)
(if on?
(let ([mon (MonitorFromWindow hwnd MONITOR_DEFAULTTONEAREST)]
[mi (cast (malloc _MONITORINFO)
_pointer
_MONITORINFO-pointer)])
(set-MONITORINFO-cbSize! mi (ctype-sizeof _MONITORINFO))
(GetMonitorInfoW mon mi)
(define mon-rect (MONITORINFO-rcMonitor mi))
(define current-style (cast (GetWindowLongPtrW hwnd GWL_STYLE) _pointer _intptr))
(if (is-shown?)
(let ([mon (MonitorFromWindow hwnd MONITOR_DEFAULTTONEAREST)]
[mi (cast (malloc _MONITORINFO)
_pointer
_MONITORINFO-pointer)])
(set-MONITORINFO-cbSize! mi (ctype-sizeof _MONITORINFO))
(GetMonitorInfoW mon mi)
(define mon-rect (MONITORINFO-rcMonitor mi))
(define current-style (cast (GetWindowLongPtrW hwnd GWL_STYLE) _pointer _intptr))
; if (fullscreen #t) is called repeatedly, we don't want to overwrite
; a useful description of the window's pre-fullscreened state with one
; that says to fullscreen it again
(when (eq? pre-fullscreen-rect #f)
(set! pre-fullscreen-rect (GetWindowRect hwnd)))
(when (= pre-fullscreen-style 0)
(set! pre-fullscreen-style current-style))
(SetWindowLongPtrW hwnd GWL_STYLE
(cast
(bitwise-ior (bitwise-and current-style (bitwise-not WS_OVERLAPPEDWINDOW)
WS_POPUP))
_intptr _pointer))
(SetWindowPos hwnd HWND_TOP
(RECT-left mon-rect)
(RECT-top mon-rect)
(- (RECT-right mon-rect) (RECT-left mon-rect))
(- (RECT-bottom mon-rect) (RECT-top mon-rect))
(bitwise-ior SWP_NOCOPYBITS SWP_SHOWWINDOW)))
;; if (fullscreen #t) is called repeatedly, we don't want to overwrite
;; a useful description of the window's pre-fullscreened state with one
;; that says to fullscreen it again
(when (eq? pre-fullscreen-rect #f)
(set! pre-fullscreen-rect (GetWindowRect hwnd)))
(when (= pre-fullscreen-style 0)
(set! pre-fullscreen-style current-style))
(SetWindowLongPtrW hwnd GWL_STYLE
(cast
(bitwise-ior (bitwise-and current-style (bitwise-not WS_OVERLAPPEDWINDOW)
WS_POPUP))
_intptr _pointer))
(SetWindowPos hwnd HWND_TOP
(RECT-left mon-rect)
(RECT-top mon-rect)
(- (RECT-right mon-rect) (RECT-left mon-rect))
(- (RECT-bottom mon-rect) (RECT-top mon-rect))
(bitwise-ior SWP_NOCOPYBITS SWP_SHOWWINDOW)))
(set! unshown-fullscreen? (and on? #t)))
(begin
(unless (= pre-fullscreen-style 0)
(SetWindowLongPtrW hwnd GWL_STYLE (cast pre-fullscreen-style _intptr _pointer))