Propagate destroy through <gtk-container>. Use it with <fix-layout>s.

diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index fe51b033bfcbc58887602f9554a8d5347cb985b5..31c7f46a4e568ada2f8ce000ad074942a3cfd57f 100644 (file)
--- a/src/gtk/fix-layout.scm
+++ b/src/gtk/fix-layout.scm
@@ -65,6 +65,11 @@ USA.
 
 (define-guarantee fix-layout "a <fix-layout>")
 
+(define-method gtk-object-destroy-callback ((layout <fix-layout>))
+  (call-next-method layout)
+  (let ((drawing (fix-layout-drawing layout)))
+    (if drawing (fix-drawing-remove-widget! drawing layout))))
+
 (define-integrable (allocate-color! layout spec)
   (let* ((colors (fix-layout-colors layout))
         (entry (assoc spec colors)))

diff --git a/src/gtk/gtk-object.scm b/src/gtk/gtk-object.scm
index e9ae02d382e4b5f0de7e82046d6fb1de6f720400..f8969b56973244c11b34134c98b995cf666bf914 100644 (file)
--- a/src/gtk/gtk-object.scm
+++ b/src/gtk/gtk-object.scm
@@ -452,6 +452,10 @@ USA.
   ;; they were added.
   (reverse-children define standard initial-value '()))
 
+(define-method gtk-object-destroy-callback ((container <gtk-container>))
+  (call-next-method container)
+  (for-each gtk-object-destroy (gtk-container-reverse-children container)))
+
 (define-guarantee gtk-container "a <gtk-container>")
 
 (define (gtk-container-children container)

diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index 94d470498c5119fd5c89b3c6abbaa39b0db4cee6..c1041f6cd4599929e906d90a3e9d506fc920dda0 100644 (file)
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -213,7 +213,9 @@ USA.
   (import (gtk pango)
           make-pango-layout pango-rectangle pangos->pixels pixels->pangos)
   (import (gtk gtk-object)
-         parse-gdkcolor set-gtk-object-destroy-callback!)
+         parse-gdkcolor
+         set-gtk-object-destroy-callback!
+         gtk-object-destroy-callback)
   (export (gtk)
 
          <fix-layout> fix-layout? make-fix-layout set-fix-layout-size!