From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Wed, 17 Aug 2011 21:45:15 +0000 (-0700)
Subject: Added missing gc-cleanup for <g-mount-operation>s.
X-Git-Tag: mit-scheme-pucked-9.2.12~637
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ec9090f0919550982ef2f1aa5451d7bf3909c087;p=mit-scheme.git

Added missing gc-cleanup for <g-mount-operation>s.
---

diff --git a/src/gtk/gio.scm b/src/gtk/gio.scm
index 5f33bc2a0..3a98df09c 100644
--- a/src/gtk/gio.scm
+++ b/src/gtk/gio.scm
@@ -970,12 +970,17 @@ USA.
 (define-class (<g-mount-operation> (constructor ()))
     (<gio>))
 
-(define-method initialize-instance ((gmount <g-mount-operation>))
-  (call-next-method gmount)
-  (let ((alien (gobject-alien gmount)))
+(define-method initialize-instance ((gmountop <g-mount-operation>))
+  (call-next-method gmountop)
+  (add-gc-cleanup gmountop (make-gmountop-cleanup (gio-cleanup-info gmountop)))
+  (let ((alien (gobject-alien gmountop)))
     (set-alien/ctype! alien '|GMountOperation|)
     (C-call "g_mount_operation_new" alien)
-    (error-if-null alien "Could not create:" gmount)))
+    (error-if-null alien "Could not create:" gmountop)))
+
+(define (make-gmountop-cleanup gio-info)
+  (named-lambda (gmountop-cleanup)
+    (cleanup-gio gio-info)))
 
 (define (gfile-mount gfile)
   (let* ((mount-op (make-g-mount-operation))