Fixed <fix-widget> init. Free colors upon destruction.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Thu, 22 Sep 2011 17:55:29 +0000 (10:55 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Thu, 22 Sep 2011 17:55:29 +0000 (10:55 -0700)
src/gtk/fix-layout.scm

index 065fda1d11bda088af9c83f0deb3af3206ab4aa1..ec5fe84112c91e67c0e444919a35cef71f413aa6 100644 (file)
@@ -41,7 +41,8 @@ USA.
   ;; GdkColor structs with .pixels courtesy of gdk_rgb_find_color.
   ;; This is oblivious to GtkStyle settings, e.g. set with
   ;; set-gtk-widget-bg-color!.  It may (re)allocate a previously set
-  ;; background color (but just once).
+  ;; background color (but just once).  Upon destruction, these are
+  ;; just freed -- no GdkColor de-allocating required.
   (colors define standard initial-value '())
 
   ;; Our window geometry (allocation) -- a rectangular extent in
@@ -59,10 +60,22 @@ USA.
 
   (call-next-method widget)
   (%trace "; (initialize-instance <fix-widget>) "widget" "width" "height"\n")
+
+  (let ((alien (gobject-alien widget)))
+    (let ((w (->requisition-fixnum width))
+         (h (->requisition-fixnum height)))
+      (C-call "gtk_widget_set_size_request" alien w h))
+    (C-call "gtk_widget_set_has_window" alien 1)) ; WILL have when realized
+
   (set-gtk-object-destroy-callback! widget)
   (set-gtk-widget-realize-callback! widget fix-widget-realize-callback)
   (set-gtk-widget-size-allocate-callback! widget fix-widget-allocate-callback))
 
+(define-method gtk-object-destroy-callback ((widget <fix-widget>))
+  (call-next-method widget)
+  (for-each (lambda (spec.gdkcolor) (free (cdr spec.gdkcolor)))
+           (fix-widget-colors widget)))
+
 (define-generic fix-widget-realize-callback (widget))
 
 (define-method fix-widget-realize-callback ((widget <fix-widget>))
@@ -109,9 +122,12 @@ USA.
       (set-fix-rect! (fix-widget-geometry widget) #f #f width height)
       (%trace ";  window: "main-GdkWindow"\n"))
 
-    (let ((GtkStyle (C-> GtkWidget "GtkWidget style")))
-      (C-call "gtk_style_attach" GtkStyle GtkStyle main-GdkWindow)
-      (C->= GtkWidget "GtkWidget style" GtkStyle))
+    (let ((alien (C-> GtkWidget "GtkWidget style")))
+      (C-call "gtk_style_attach" alien alien main-GdkWindow)
+      (C-> GtkWidget "GtkWidget style" alien)
+      (C-> alien "GtkStyle bg" alien)
+      (C-array-loc! alien "GdkColor" (C-enum "GTK_STATE_NORMAL"))
+      (C-call "gdk_window_set_background" main-GdkWindow alien))
 
     unspecific))