From d00befc16d2e492bf38e5e8e23aac8a3387653cd Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 15 Jul 2011 19:56:06 -0700 Subject: [PATCH] Named the cleanup thunks. Also threw without-interrupts around the use of a string, from pango_font_description_to_string, that must be g_freed. --- src/gtk/pango.scm | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/src/gtk/pango.scm b/src/gtk/pango.scm index 5be39e7ef..66142d5d2 100644 --- a/src/gtk/pango.scm +++ b/src/gtk/pango.scm @@ -92,7 +92,7 @@ USA. (guarantee-string string 'pango-font-description-from-string) (let ((font (make-alien '|PangoFontDescription|)) (copy (make-alien '|PangoFontDescription|))) - (add-gc-cleanup font (pango-font-description-cleanup copy)) + (add-gc-cleanup font (make-pango-font-description-cleanup copy)) (C-call "pango_font_description_from_string" copy string) (if (alien-null? copy) (begin @@ -102,14 +102,13 @@ USA. (copy-alien-address! font copy) font)))) -(define (pango-font-description-cleanup alien) - (lambda () - (without-interrupts - (lambda () - (if (not (alien-null? alien)) - (begin - (C-call "pango_font_description_free" alien) - (alien-null! alien))))))) +(define (make-pango-font-description-cleanup alien) + (named-lambda (pango-font-description-cleanup) + ;;without-interrupts + (if (not (alien-null? alien)) + (begin + (C-call "pango_font_description_free" alien) + (alien-null! alien))))) (define (pango-font-description-free font) (guarantee-pango-font-description font 'pango-font-description-free) @@ -124,11 +123,13 @@ USA. (guarantee-pango-font-description font 'pango-font-description-to-string) (if (alien-null? font) "" - (let ((cstr (make-alien '|char|))) - (C-call "pango_font_description_to_string" cstr font) - (let ((str (c-peek-cstring cstr))) - (C-call "g_free" cstr) - str)))) + (without-interrupts + (lambda () + (let ((cstr (make-alien '|char|))) + (C-call "pango_font_description_to_string" cstr font) + (let ((str (c-peek-cstring cstr))) + (C-call "g_free" cstr) + str)))))) (define-integrable (guarantee-pango-font-description object operator) (if (not (and (alien? object) @@ -157,7 +158,7 @@ USA. (guarantee-pango-font-description font 'pango-context-get-metrics) (let ((alien (make-alien '|PangoFontMetrics|)) (copy (make-alien '|PangoFontMetrics|))) - (add-gc-cleanup alien (pango-font-metrics-cleanup copy)) + (add-gc-cleanup alien (make-pango-font-metrics-cleanup copy)) (C-call "pango_context_get_metrics" copy context font 0) (copy-alien-address! alien copy) alien)) @@ -177,8 +178,8 @@ USA. ;;; PangoFontMetrics -(define (pango-font-metrics-cleanup alien) - (lambda () +(define (make-pango-font-metrics-cleanup alien) + (named-lambda (pango-font-metrics-cleanup) ;;without-interrupts (if (not (alien-null? alien)) (begin -- 2.25.1