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.

diff --git a/src/gtk/pango.scm b/src/gtk/pango.scm
index 5be39e7efa25afd8ac8029648919a74f94b466c7..66142d5d20024aad47c0dcb8570272d5ade0a959 100644 (file)
--- 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)
       "<null>"
-      (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.
 \f
 ;;; 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