From 93b21b51b167178bbb53c77d4c34c3da420de673 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 23 Nov 2010 10:02:45 -0700
Subject: [PATCH] cocoa: try to fix problem with drifting gc-blit window

original commit: 510c3f8a3362fe67979e805910b90c5bd440f586
---
 collects/mred/private/wx/cocoa/canvas.rkt | 5 +++++
 collects/mred/private/wx/cocoa/frame.rkt  | 8 ++++++++
 collects/mred/private/wx/cocoa/panel.rkt  | 4 ++++
 collects/mred/private/wx/cocoa/queue.rkt  | 8 ++++++--
 collects/mred/private/wx/cocoa/window.rkt | 2 ++
 5 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt
index 7488e490..34f80512 100644
--- a/collects/mred/private/wx/cocoa/canvas.rkt
+++ b/collects/mred/private/wx/cocoa/canvas.rkt
@@ -404,6 +404,11 @@
        (super show-children)
        (resume-all-reg-blits))
 
+     (define/override (fixup-locations-children)
+       ;; in atomic mode
+       (suspend-all-reg-blits)
+       (resume-all-reg-blits))
+
      (define/private (do-set-size x y w h)
        (when (pair? blits)
          (atomically (suspend-all-reg-blits)))
diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt
index 7779a020..3956ed8f 100644
--- a/collects/mred/private/wx/cocoa/frame.rkt
+++ b/collects/mred/private/wx/cocoa/frame.rkt
@@ -319,6 +319,9 @@
     (define/override (show-children)
       (when saved-child
         (send saved-child show-children)))
+    (define/override (fixup-locations-children)
+      (when saved-child
+        (send saved-child fixup-locations-children)))
 
     (define/override (children-accept-drag on?)
       (when saved-child
@@ -532,3 +535,8 @@
                    (make-NSPoint x (- (NSSize-height (NSRect-size f)) y)))
                  belowWindowWithWindowNumber: #:type _NSInteger 0)])
     (atomically (hash-ref all-windows n #f))))
+
+(set-fixup-window-locations!
+ (lambda ()
+   (for ([f (in-hash-values all-windows)])
+     (send f fixup-locations-children))))
diff --git a/collects/mred/private/wx/cocoa/panel.rkt b/collects/mred/private/wx/cocoa/panel.rkt
index 48a5c03f..6d57fecc 100644
--- a/collects/mred/private/wx/cocoa/panel.rkt
+++ b/collects/mred/private/wx/cocoa/panel.rkt
@@ -40,6 +40,10 @@
     (define/override (show-children)
       (for ([child (in-list children)])
         (send child show-children)))
+
+    (define/override (fixup-locations-children)
+      (for ([child (in-list children)])
+        (send child fixup-locations-children)))
     
     (define/override (paint-children)
       (for ([child (in-list children)])
diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt
index 654b8cca..651d0eea 100644
--- a/collects/mred/private/wx/cocoa/queue.rkt
+++ b/collects/mred/private/wx/cocoa/queue.rkt
@@ -19,6 +19,7 @@
               set-eventspace-hook!
               set-front-hook!
               set-menu-bar-hooks!
+              set-fixup-window-locations!
               post-dummy-event
 
               try-to-sync-refresh)
@@ -58,8 +59,11 @@
       (let ([priviledged-custodian ((get-ffi-obj 'scheme_make_custodian #f (_fun _pointer -> _scheme)) #f)])
         (parameterize ([current-custodian priviledged-custodian])
           (thread (lambda () (sleep 5.0)))))
-      ;; FIXME: Also need to reset blit windows, since OS may move them incorrectly
-      (void)])
+      ;; Also need to reset blit windows, since OS may move them incorrectly:
+      (fixup-window-locations)])
+
+(define fixup-window-locations void)
+(define (set-fixup-window-locations! f) (set! fixup-window-locations f))
 
 ;; In case we were started in an executable without a bundle,
 ;; explicitly register with the dock so the application can receive
diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt
index 42435566..a76e56fe 100644
--- a/collects/mred/private/wx/cocoa/window.rkt
+++ b/collects/mred/private/wx/cocoa/window.rkt
@@ -379,6 +379,8 @@
       (focus-is-on #f))
     (define/public (show-children)
       (void))
+    (define/public (fixup-locations-children)
+      (void))
     (define/public (fix-dc) 
       (void))
     (define/public (paint-children)