From a09543772a93ca8d7cf58fa2c4e60f3c559f031b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 17 Oct 2011 15:52:14 -0600 Subject: [PATCH] gtk: no freeze/thaw before/after unmap Merge to 5.2 --- collects/mred/private/wx/gtk/canvas.rkt | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index abe4cff19c..03736853ea 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -209,6 +209,13 @@ (when wx (send wx unrealize))))) +(define-signal-handler connect-unmap "unmap" + (_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 @@ -385,6 +392,7 @@ (when combo-button-gtk (connect-combo-key-and-mouse combo-button-gtk)) (connect-unrealize client-gtk) + (connect-unmap client-gtk) (when hscroll-adj (connect-value-changed-h hscroll-adj)) (when vscroll-adj (connect-value-changed-v vscroll-adj)) @@ -467,11 +475,14 @@ (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)))) + (if (zero? (bitwise-and (get-gtk-object-flags client-gtk) + GTK_MAPPED)) + (mcons #f #f) + (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))