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

@@ -91,14 +91,16 @@
             (let ([front (get-front)]
                   [parent (and (version-10.6-or-later?)
                                parent)])
-              (when parent
+              (call-in-run-loop
-                (tellv ns beginSheetModalForWindow: (send parent get-cocoa-window)
+               (lambda ()
-                       completionHandler: #f))
+                 (when parent
-              (begin0
+                   (tellv ns beginSheetModalForWindow: (send parent get-cocoa-window)
-               (tell #:type _NSInteger ns runModal)
+                          completionHandler: #f))
-               (when parent (tell app endSheet: ns))
+                 (begin0
-               (when front (tellv (send front get-cocoa-window)
+                  (tell #:type _NSInteger ns runModal)
-                                  makeKeyAndOrderFront: #f)))))])
+                  (when parent (tell app endSheet: ns))
+                  (when front (tellv (send front get-cocoa-window)
+                                     makeKeyAndOrderFront: #f)))))))])
       (begin0
        (if (zero? result)
            #f

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)
+            (call-in-run-loop
-               NSOkButton)
+             (lambda ()
+               (= (tell #:type _NSInteger (tell NSPageLayout pageLayout) runModalWithPrintInfo: print-info)
+                  NSOkButton)))
             (when front
               (tellv (send front get-cocoa-window) makeKeyAndOrderFront: #f)))))
         (begin

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)]