From 02bf0c08d89fc61ef916fd6d1d82a80a82c4f8e8 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 8 Oct 2011 06:09:14 -0600 Subject: [PATCH] another attempt to fix the 64-bit Lion hidden-window problem This fix uses the same`run'-vs-`finishLaunch' technique as before, but patches up the modal-dialog problem by calling `run' again with a callback to start a modal loop. Merge to 5.2. original commit: f6e5468dbb85c2ed48178ac43fb25084430413ef --- collects/mred/private/wx/cocoa/filedialog.rkt | 18 +++++---- collects/mred/private/wx/cocoa/printer-dc.rkt | 9 +++-- collects/mred/private/wx/cocoa/queue.rkt | 40 +++++++++++++++++-- 3 files changed, 52 insertions(+), 15 deletions(-) diff --git a/collects/mred/private/wx/cocoa/filedialog.rkt b/collects/mred/private/wx/cocoa/filedialog.rkt index 904acd7f..2afb2781 100644 --- a/collects/mred/private/wx/cocoa/filedialog.rkt +++ b/collects/mred/private/wx/cocoa/filedialog.rkt @@ -91,14 +91,16 @@ (let ([front (get-front)] [parent (and (version-10.6-or-later?) parent)]) - (when parent - (tellv ns beginSheetModalForWindow: (send parent get-cocoa-window) - completionHandler: #f)) - (begin0 - (tell #:type _NSInteger ns runModal) - (when parent (tell app endSheet: ns)) - (when front (tellv (send front get-cocoa-window) - makeKeyAndOrderFront: #f)))))]) + (call-in-run-loop + (lambda () + (when parent + (tellv ns beginSheetModalForWindow: (send parent get-cocoa-window) + completionHandler: #f)) + (begin0 + (tell #:type _NSInteger ns runModal) + (when parent (tell app endSheet: ns)) + (when front (tellv (send front get-cocoa-window) + makeKeyAndOrderFront: #f)))))))]) (begin0 (if (zero? result) #f diff --git a/collects/mred/private/wx/cocoa/printer-dc.rkt b/collects/mred/private/wx/cocoa/printer-dc.rkt index 2df653c5..10879424 100644 --- a/collects/mred/private/wx/cocoa/printer-dc.rkt +++ b/collects/mred/private/wx/cocoa/printer-dc.rkt @@ -16,7 +16,8 @@ "bitmap.rkt" "cg.rkt" "utils.rkt" - "types.rkt") + "types.rkt" + "queue.rkt") (provide (protect-out printer-dc% @@ -105,8 +106,10 @@ (if (atomically (let ([front (get-front)]) (begin0 - (= (tell #:type _NSInteger (tell NSPageLayout pageLayout) runModalWithPrintInfo: print-info) - NSOkButton) + (call-in-run-loop + (lambda () + (= (tell #:type _NSInteger (tell NSPageLayout pageLayout) runModalWithPrintInfo: print-info) + NSOkButton))) (when front (tellv (send front get-cocoa-window) makeKeyAndOrderFront: #f))))) (begin diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index d0ac5d21..e455b988 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/collects/mred/private/wx/cocoa/queue.rkt @@ -21,6 +21,7 @@ set-menu-bar-hooks! set-fixup-window-locations! post-dummy-event + call-in-run-loop try-to-sync-refresh sync-cocoa-events) @@ -30,7 +31,8 @@ queue-event yield) -(import-class NSApplication NSAutoreleasePool NSColor NSProcessInfo NSArray) +(import-class NSApplication NSAutoreleasePool NSColor NSProcessInfo NSArray + NSRunLoop) (import-protocol NSApplicationDelegate) ;; Extreme hackery to hide original arguments from @@ -78,7 +80,11 @@ (queue-file-event (string->path filename))] [-a _void (applicationDidFinishLaunching: [_id notification]) (unless got-file? - (queue-start-empty-event))] + (queue-start-empty-event)) + (tellv app stop: self)] + [-a _void (callbackAndStopLoop) + (run-loop-callback) + (tellv app stop: self)] [-a _BOOL (applicationShouldHandleReopen: [_id app] hasVisibleWindows: [_BOOL has-visible?]) ;; If we have any visible windows, return #t to do the default thing. ;; Otherwise return #f, because we don't want any invisible windows resurrected. @@ -132,7 +138,34 @@ (unless (zero? v) (log-error (format "error from CGDisplayRegisterReconfigurationCallback: ~a" v)))) -(tellv app finishLaunching) +;; To make sure that `finishLaunching' is called, call `run' +;; and have `applicationDidFinishLaunching' quit the run loop. +;; This seems to work better than calling `finishLaunching' +;; directly undet 64-bt Lion, where calling just `finishLaunching' +;; somehow doesn't get the start-up AppleEvents. +(tellv app run) + +;; Use `call-in-run-loop' to run something that needs to be +;; within `run', such as a modal-dialog run loop. It starts +;; a `run' with a high-priority callback to run `thunk', and +;; the run loop is stopped immediately after `thunk' returns. +(define (call-in-run-loop thunk) + (define result #f) + (set! run-loop-callback + (lambda () + (set! run-loop-callback void) + (set! result (thunk)))) + (tellv (tell NSRunLoop currentRunLoop) + performSelector: #:type _SEL (selector callbackAndStopLoop) + target: app-delegate + argument: #f + order: #:type _NSUInteger 0 + modes: (tell NSArray + arrayWithObjects: #:type (_vector i _id) (vector NSDefaultRunLoopMode) + count: #:type _NSUInteger 1)) + (tellv app run) + result) +(define run-loop-callback void) ;; ------------------------------------------------------------ ;; Create an event to post when MzScheme has been sleeping but is @@ -221,7 +254,6 @@ (define kCFSocketReadCallBack 1) -(import-class NSRunLoop) (let* ([rl (tell #:type _CFRunLoopRef (tell NSRunLoop currentRunLoop) getCFRunLoop)] [cfs (CFSocketCreateWithNative (CFAllocatorGetDefault) ready_sock kCFSocketReadCallBack socket_callback sock-context)]