diff --git a/gui-lib/mred/private/wx/gtk/x11.rkt b/gui-lib/mred/private/wx/gtk/x11.rkt index 45eceee6..f013eccd 100644 --- a/gui-lib/mred/private/wx/gtk/x11.rkt +++ b/gui-lib/mred/private/wx/gtk/x11.rkt @@ -97,16 +97,13 @@ (XFreePixmap dpy pixmap))) (lambda () (proc dpy win w h d))))))) -(define-x11 XDestroyWindow (_fun _Display _Window -> _void) - #:wrap (deallocator cadr)) + +;; No finalization here, because we rely on destroying the +;; enclosing window to release a created window, if +;; necessary. +(define-x11 XDestroyWindow (_fun _Display _Window -> _void)) (define-x11 XCreateSimpleWindow (_fun _Display _Window _int _int _int _int _int _long _long - -> _Window) - #:wrap (lambda (proc) - (lambda (dpy win x y w h bw b bg) - (((allocator (lambda (win) - (XDestroyWindow dpy win))) - (lambda () - (proc dpy win x y w h bw b bg))))))) + -> _Window)) diff --git a/gui-test/tests/gracket/gc-blits.rkt b/gui-test/tests/gracket/gc-blits.rkt new file mode 100644 index 00000000..38b4865d --- /dev/null +++ b/gui-test/tests/gracket/gc-blits.rkt @@ -0,0 +1,22 @@ +#lang racket/base +(require racket/class + racket/gui/base) + +(define w 50) +(define h 50) +(define on (make-bitmap w h)) +(define off (make-bitmap w h)) +(send (send on make-dc) draw-rectangle 5 5 (- w 10) (- h 10)) + +(send + (for/fold ([prev-f #f]) ([i (in-range 10)]) + (define f (new frame% [label "GC Blit"] [width 100] [height 100])) + (define c (new canvas% [parent f])) + (register-collecting-blit c 0 0 w h on off) + (send f show #t) + (collect-garbage) + (yield (system-idle-evt)) + (when prev-f (send prev-f show #f)) + f) + show #f) +