gtk: no freeze/thaw before/after unmap

Merge to 5.2
This commit is contained in:
Matthew Flatt 2011-10-17 15:52:14 -06:00
parent 3b93da83c4
commit a09543772a

View File

@ -209,6 +209,13 @@
(when wx (when wx
(send wx unrealize))))) (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) (define (do-value-changed gtk dir)
(let ([wx (gtk->wx gtk)]) (let ([wx (gtk->wx gtk)])
(when wx (when wx
@ -385,6 +392,7 @@
(when combo-button-gtk (when combo-button-gtk
(connect-combo-key-and-mouse combo-button-gtk)) (connect-combo-key-and-mouse combo-button-gtk))
(connect-unrealize client-gtk) (connect-unrealize client-gtk)
(connect-unmap client-gtk)
(when hscroll-adj (connect-value-changed-h hscroll-adj)) (when hscroll-adj (connect-value-changed-h hscroll-adj))
(when vscroll-adj (connect-value-changed-v vscroll-adj)) (when vscroll-adj (connect-value-changed-v vscroll-adj))
@ -467,11 +475,14 @@
(define flush-win-box (mcons #f 0)) (define flush-win-box (mcons #f 0))
(define/public (get-flush-window) (define/public (get-flush-window)
(atomically (atomically
(if (zero? (bitwise-and (get-gtk-object-flags client-gtk)
GTK_MAPPED))
(mcons #f #f)
(if (win-box-valid? flush-win-box) (if (win-box-valid? flush-win-box)
flush-win-box flush-win-box
(begin (begin
(set! flush-win-box (window->win-box (widget-window client-gtk))) (set! flush-win-box (window->win-box (widget-window client-gtk)))
flush-win-box)))) flush-win-box)))))
(define/public (unrealize) (define/public (unrealize)
(unrealize-win-box flush-win-box)) (unrealize-win-box flush-win-box))