racket/gui Cocoa: disable App Nap; switch to GUI mode more lazily
On 10.9 and later, `racket/gui` now disables App Nap. Otherwise, a
program like
#lang racket/base
(require racket/class
racket/gui/base)
(define T 0.05)
(let loop ([prev (current-inexact-milliseconds)])
(sleep T)
(define now (current-inexact-milliseconds))
(define delta (- now prev))
(when (delta . > . (* 2000 T))
(printf "long wait ~a at ~a\n" delta now))
(loop now))
will start to report a wait of more than 10 seconds, as App Nap
puts the process to sleep.
Relatedly, when `racket/gui` is started via plain `racket` (as opposed
to GRacket), then it starts in "accessory" mode instead of "regular"
mode, which means that the application does not appear in the dock
or have a menu bar. As soon as a frame is shown or a root menu bar
is created, the application is promoted to "regular" mode. This works
in 10.7 and later.
This commit is contained in:
Matthew Flatt
parent
0a71fe1d28
commit
b336194cf4
|
|
@ -5,7 +5,8 @@
|
|||
racket/draw/private/color
|
||||
"../../lock.rkt"
|
||||
"utils.rkt"
|
||||
"types.rkt")
|
||||
"types.rkt"
|
||||
"queue.rkt")
|
||||
|
||||
(provide
|
||||
(protect-out get-color-from-user))
|
||||
|
|
@ -16,6 +17,7 @@
|
|||
(define-cocoa NSDeviceRGBColorSpace _id)
|
||||
|
||||
(define (get-color-from-user mode)
|
||||
(promote-to-gui!)
|
||||
(cond
|
||||
[(eq? mode 'show)
|
||||
(tellv (tell NSColorPanel sharedColorPanel)
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@
|
|||
(define (file-selector message directory filename
|
||||
extension
|
||||
filters style parent)
|
||||
(promote-to-gui!)
|
||||
(let ([ns (as-objc-allocation-with-retain
|
||||
(if (memq 'put style)
|
||||
(tell NSSavePanel savePanel)
|
||||
|
|
|
|||
|
|
@ -323,6 +323,7 @@
|
|||
|
||||
(define/public (direct-show on?)
|
||||
;; in atomic mode
|
||||
(when on? (promote-to-gui!))
|
||||
(when (and (not on?)
|
||||
(eq? front this))
|
||||
(set! front #f)
|
||||
|
|
@ -597,6 +598,7 @@
|
|||
(when (or (tell #:type _BOOL cocoa isMainWindow)
|
||||
(and (eq? this root-fake-frame)
|
||||
(not (get-app-front-window))))
|
||||
(promote-to-gui!)
|
||||
(install-mb)))
|
||||
|
||||
(define/public (install-mb)
|
||||
|
|
|
|||
|
|
@ -15,7 +15,8 @@
|
|||
"frame.rkt"
|
||||
"cg.rkt"
|
||||
"utils.rkt"
|
||||
"types.rkt")
|
||||
"types.rkt"
|
||||
"queue.rkt")
|
||||
|
||||
(provide
|
||||
(protect-out printer-dc%
|
||||
|
|
@ -94,6 +95,7 @@
|
|||
(define NSOkButton 1)
|
||||
|
||||
(define (show-print-setup parent)
|
||||
(promote-to-gui!)
|
||||
(let* ([pss (current-ps-setup)]
|
||||
[print-info (let ([pi (send pss get-native)])
|
||||
(or pi
|
||||
|
|
@ -193,6 +195,8 @@
|
|||
(tellv view-cocoa unlockFocus)))
|
||||
|
||||
(define/override (end-doc)
|
||||
(promote-to-gui!)
|
||||
|
||||
(define view-cocoa (as-objc-allocation-with-retain
|
||||
(tell (tell PrinterView alloc)
|
||||
initWithFrame: #:type _NSRect (make-NSRect
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@
|
|||
|
||||
(provide
|
||||
(protect-out app
|
||||
promote-to-gui!
|
||||
cocoa-start-event-pump
|
||||
cocoa-install-event-wakeup
|
||||
set-eventspace-hook!
|
||||
|
|
@ -112,27 +113,41 @@
|
|||
(define-appserv TransformProcessType (_fun _ProcessSerialNumber-pointer
|
||||
_uint32
|
||||
-> _OSStatus))
|
||||
(define NSApplicationActivationPolicyRegular 0)
|
||||
(define NSApplicationActivationPolicyAccessory 1)
|
||||
(unless (scheme_register_process_global "PLT_IS_FOREGROUND_APP" #f)
|
||||
(let ([v (TransformProcessType (make-ProcessSerialNumber 0 kCurrentProcess)
|
||||
kProcessTransformToForegroundApplication)])
|
||||
(unless (zero? v)
|
||||
(log-error (format "error from TransformProcessType: ~a" v)))))
|
||||
(cond
|
||||
[(version-10.6-or-later?)
|
||||
;; When a frame or root menu bar is created, we promote to
|
||||
;; NSApplicationActivationPolicyRegular:
|
||||
(tellv app setActivationPolicy: #:type _int NSApplicationActivationPolicyAccessory)]
|
||||
[else
|
||||
(let ([v (TransformProcessType (make-ProcessSerialNumber 0 kCurrentProcess)
|
||||
kProcessTransformToForegroundApplication)])
|
||||
(unless (zero? v)
|
||||
(log-error (format "error from TransformProcessType: ~a" v))))]))
|
||||
|
||||
(define app-delegate (tell (tell RacketApplicationDelegate alloc) init))
|
||||
(tellv app setDelegate: app-delegate)
|
||||
(unless (scheme_register_process_global "Racket-GUI-no-front" #f)
|
||||
(tellv app activateIgnoringOtherApps: #:type _BOOL #t)
|
||||
;; It may not be that easy...
|
||||
(when (version-10.7-or-later?)
|
||||
(with-autorelease
|
||||
(import-class NSRunningApplication)
|
||||
(unless (tell #:type _BOOL (tell NSRunningApplication currentApplication) ownsMenuBar)
|
||||
;; Looks like we haven't yet convinced the system to give us
|
||||
;; the menu bar. Perform a menu-bar dance that is based on
|
||||
;; http://stackoverflow.com/questions/7596643/when-calling-transformprocesstype-the-app-menu-doesnt-show-up
|
||||
(tellv app-delegate performSelector: #:type _SEL (selector tryDockToFront:)
|
||||
withObject: #f
|
||||
afterDelay: #:type _double 0.1)))))
|
||||
|
||||
(define (bring-to-front)
|
||||
(unless (scheme_register_process_global "Racket-GUI-no-front" #f)
|
||||
(tellv app activateIgnoringOtherApps: #:type _BOOL #t)
|
||||
;; It may not be that easy...
|
||||
(when (version-10.7-or-later?)
|
||||
(with-autorelease
|
||||
(import-class NSRunningApplication)
|
||||
(unless (tell #:type _BOOL (tell NSRunningApplication currentApplication) ownsMenuBar)
|
||||
;; Looks like we haven't yet convinced the system to give us
|
||||
;; the menu bar. Perform a menu-bar dance that is based on
|
||||
;; http://stackoverflow.com/questions/7596643/when-calling-transformprocesstype-the-app-menu-doesnt-show-up
|
||||
(tellv app-delegate performSelector: #:type _SEL (selector tryDockToFront:)
|
||||
withObject: #f
|
||||
afterDelay: #:type _double 0.1))))))
|
||||
(define (promote-to-gui!)
|
||||
(when (version-10.6-or-later?)
|
||||
(tellv app setActivationPolicy: #:type _int NSApplicationActivationPolicyRegular))
|
||||
(bring-to-front))
|
||||
|
||||
(define (try-dock-to-front)
|
||||
;; Phase 2 of the 10.9 menu-bar dance started above:
|
||||
|
|
@ -170,6 +185,16 @@
|
|||
|
||||
(tellv app finishLaunching)
|
||||
|
||||
(when (version-10.9-or-later?)
|
||||
(define NSActivityIdleSystemSleepDisabled (arithmetic-shift 1 20))
|
||||
(define NSActivityUserInitiated #x00FFFFFF)
|
||||
(tellv
|
||||
(tell (tell NSProcessInfo processInfo)
|
||||
beginActivityWithOptions: #:type _uint64 (- NSActivityUserInitiated
|
||||
NSActivityIdleSystemSleepDisabled)
|
||||
reason: #:type _NSString "Racket default")
|
||||
retain))
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
;; Create an event to post when Racket has been sleeping but is
|
||||
;; ready to wake up
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@
|
|||
old-cocoa?
|
||||
version-10.6-or-later?
|
||||
version-10.7-or-later?
|
||||
version-10.9-or-later?
|
||||
version-10.10-or-later?)
|
||||
with-autorelease
|
||||
call-with-autorelease
|
||||
|
|
@ -81,5 +82,7 @@
|
|||
(NSAppKitVersionNumber . >= . 1038))
|
||||
(define (version-10.7-or-later?)
|
||||
(NSAppKitVersionNumber . >= . 1138))
|
||||
(define (version-10.9-or-later?)
|
||||
(NSAppKitVersionNumber . >= . 1187))
|
||||
(define (version-10.10-or-later?)
|
||||
(NSAppKitVersionNumber . >= . 1331))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user