suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gtk: fix refresh freeze/thaw and reparent interaction

Browse Source 
Closes PR 11947
This commit is contained in:
Matthew Flatt 2011-08-02 19:09:14 -06:00
parent 9a14b47ccc
commit 37c43c23d6
2 changed files with 52 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/mred/private/wx/gtk/canvas.rkt
View File

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

42
collects/mred/private/wx/gtk/window.rkt
View File

@ -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
(begin
(gdk_window_freeze_updates win)
#t)))
(lambda (gtk)
(gdk_window_thaw_updates (widget-window gtk)))))
(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)))))))))