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

fix gc of ps/pdf/svg cairo-surface stream

Browse Source 
(cherry picked from commit aed7bdf0c9)
This commit is contained in:
Matthew Flatt 2011-04-20 14:25:58 -06:00 committed by Eli Barzilay
parent 5957da6bd9
commit 1601f8b73e
1 changed files with 8 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/racket/draw/unsafe/cairo.rkt
View File

@ -279,9 +279,11 @@
(lambda (proc w h)
(let* ([new-proc (lambda (null bytes len)
(proc bytes len))]
[free-cell-box (box #f)]
[s (p new-proc #f w h)]
[b (malloc-immobile-cell new-proc)])
(cairo_surface_set_user_data s cell-key b free-immobile-cell)
[b (malloc-immobile-cell (cons new-proc free-cell-box))])
(parameterize ([current-sud-box free-cell-box])
(cairo_surface_set_user_data s cell-key b free-immobile-cell))
s)))))
(define-cairo cairo_ps_surface_create_for_stream
_stream-surface-proc
@ -293,8 +295,11 @@
_stream-surface-proc
#:wrap stream-surface-allocator)
(define current-sud-box (make-parameter #f))
(define-cairo cairo_surface_set_user_data
(_fun _cairo_surface_t _pointer _pointer (_fun #:atomic? #t _pointer -> _void)
(_fun _cairo_surface_t _pointer _pointer
(_fun #:atomic? #t #:keep (lambda (v) (set-box! (current-sud-box) v))
_pointer -> _void)
-> _int))
(define-cairo cairo_ps_surface_set_eps (_fun _cairo_surface_t _bool -> _void)