From 37c43c23d62826f7d78fab46ccaa8e9f10bc851d Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 2 Aug 2011 19:09:14 -0600
Subject: [PATCH] gtk: fix refresh freeze/thaw and reparent interaction

Closes PR 11947
---
 collects/mred/private/wx/gtk/canvas.rkt | 21 ++++++++++--
 collects/mred/private/wx/gtk/window.rkt | 44 ++++++++++++++++++-------
 2 files changed, 52 insertions(+), 13 deletions(-)

diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt
index 052725277e..18a994ff4f 100644
--- a/collects/mred/private/wx/gtk/canvas.rkt
+++ b/collects/mred/private/wx/gtk/canvas.rkt
@@ -227,6 +227,13 @@
   (lambda (gtk)
     (do-value-changed gtk 'vertical)))
 
+(define-signal-handler connect-unrealize "unrealize"
+  (_fun _GtkWidget -> _void)
+  (lambda (gtk)
+    (let ([wx (gtk->wx gtk)])
+      (when wx
+        (send wx unrealize)))))
+
 (define (do-value-changed gtk dir)
   (let ([wx (gtk->wx gtk)])
     (when wx
@@ -401,6 +408,7 @@
                                                       GTK_CAN_FOCUS)))
      (when combo-button-gtk
        (connect-combo-key-and-mouse combo-button-gtk))
+     (connect-unrealize client-gtk)
 
      (when hscroll-adj (connect-value-changed-h hscroll-adj))
      (when vscroll-adj (connect-value-changed-v vscroll-adj))
@@ -455,7 +463,7 @@
      ;; are defined by `canvas-mixin' from ../common/canvas-mixin
      (define/public (queue-paint) (void))
      (define/public (request-canvas-flush-delay)
-       (request-flush-delay client-gtk))
+       (request-flush-delay (get-flush-window)))
      (define/public (cancel-canvas-flush-delay req)
        (cancel-flush-delay req))
      (define/public (queue-canvas-refresh-event thunk)
@@ -480,7 +488,16 @@
 
      (define/public (on-paint) (void))
 
-     (define/public (get-flush-window) client-gtk)
+     (define flush-win-box (mcons #f 0))
+     (define/public (get-flush-window) 
+       (atomically
+        (if (win-box-valid? flush-win-box)
+            flush-win-box
+            (begin
+              (set! flush-win-box (window->win-box (widget-window client-gtk)))
+              flush-win-box))))
+     (define/public (unrealize)
+       (unrealize-win-box flush-win-box))
 
      (define/public (begin-refresh-sequence)
        (send dc suspend-flush))
diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt
index fa80128fb0..9b5b3927ca 100644
--- a/collects/mred/private/wx/gtk/window.rkt
+++ b/collects/mred/private/wx/gtk/window.rkt
@@ -50,7 +50,10 @@
               gdk_display_get_default
 
               request-flush-delay
-              cancel-flush-delay)
+              cancel-flush-delay
+	      win-box-valid?
+	      window->win-box
+	      unrealize-win-box)
  gtk->wx
  gtk_widget_show
  gtk_widget_hide)
@@ -698,20 +701,39 @@
 (define-gdk gdk_window_invalidate_rect (_fun _GdkWindow _pointer _gboolean -> _void))
 (define-gdk gdk_window_process_all_updates (_fun -> _void))
 
-(define (request-flush-delay gtk)
+(define (win-box-valid? win-box)
+  (mcar win-box))
+(define (window->win-box win)
+  (mcons win 0))
+(define (unrealize-win-box win-box)
+  (let ([win (mcar win-box)])
+    (when win
+      (set-mcar! win-box #f)
+      (for ([i (in-range (mcdr win-box))])
+	(gdk_window_thaw_updates win)))))
+
+(define (request-flush-delay win-box)
   (do-request-flush-delay 
-   gtk
-   (lambda (gtk)
-     (let ([win (widget-window gtk)])
+   win-box
+   (lambda (win-box)
+     (let ([win (mcar win-box)])
        (and win
-            (gdk_window_freeze_updates win)
-            #t)))
-   (lambda (gtk)
-     (gdk_window_thaw_updates (widget-window gtk)))))
+       	    (begin
+	      (gdk_window_freeze_updates win)
+	      (set-mcdr! win-box (add1 (mcdr win-box)))
+	      #t))))
+   (lambda (win-box)
+     (let ([win (mcar win-box)])
+       (when win
+         (gdk_window_thaw_updates win)
+         (set-mcdr! win-box (sub1 (mcdr win-box))))))))
 
 (define (cancel-flush-delay req)
   (when req
     (do-cancel-flush-delay 
      req
-     (lambda (gtk)
-       (gdk_window_thaw_updates (widget-window gtk))))))
+     (lambda (win-box)
+       (let ([win (mcar win-box)])
+         (when win
+	   (gdk_window_thaw_updates win)
+           (set-mcdr! win-box (sub1 (mcdr win-box)))))))))