Updated for gtk 2.0

[clg] / gtk / gtkwidget.lisp

diff --git a/gtk/gtkwidget.lisp b/gtk/gtkwidget.lisp
index 626dca076533124ce51d193757e7298d75317fa9..3f263bb56183d8b132e082dde68632e2d20dda58 100644 (file)
--- a/gtk/gtkwidget.lisp
+++ b/gtk/gtkwidget.lisp
@@ -1,5 +1,5 @@
 ;; Common Lisp bindings for GTK+ v2.0
-;; Copyright (C) 2000-2001 Espen S. Johnsen <esj@stud.cs.uit.no>
+;; Copyright (C) 2000-2001 Espen S. Johnsen <espen@users.sourceforge.net>
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -15,29 +15,30 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-;; $Id: gtkwidget.lisp,v 1.4 2001/05/29 15:58:24 espen Exp $
+;; $Id: gtkwidget.lisp,v 1.7 2001/12/12 20:24:41 espen Exp $
 
 (in-package "GTK")
 
 
-(defmethod initialize-instance ((widget widget) &rest initargs &key parent)
-  (declare (ignore initargs))
+(defmethod shared-initialize ((widget widget) names &rest initargs &key parent)
+  (declare (ignore initargs names))
   (call-next-method)
-  (cond
-   ((consp parent)
-    (with-slots ((container parent) child-slots) widget
-      (setf
-       container (car parent)
-       child-slots
-       (apply
-       #'make-instance
-       (slot-value (class-of container) 'child-class)
-       :parent container :child widget (cdr parent)))))
-   (parent
-    (setf (slot-value widget 'parent) parent))))
-
-
-(defmethod slot-unbound ((class gobject) (object widget) slot)
+  (when parent
+    (let ((old-parent (widget-parent widget))
+         (parent-widget (first (mklist parent)))
+         (args (rest (mklist parent))))
+      (when old-parent
+       (container-remove old-parent widget))
+      (apply #'container-add parent-widget widget args))))
+
+(defmethod shared-initialize :after ((widget widget) names &rest initargs
+                                    &key show-all)
+  (declare (ignore initargs names))
+  (when show-all
+    (widget-show-all widget)))
+
+
+(defmethod slot-unbound ((class gobject-class) (object widget) slot)
   (cond
    ((and (eq slot 'child-slots) (slot-value object 'parent))
     (with-slots (parent child-slots) object
@@ -95,6 +96,7 @@ (defbinding widget-realize () nil
 (defbinding widget-unrealize () nil
   (widget widget))
 
+#|
 (defbinding widget-add-accelerator
     (widget signal accel-group key modifiers flags) nil
   (widget widget)
@@ -127,6 +129,7 @@ (defbinding widget-unlock-accelerators () nil
 (defbinding (widget-accelerators-locked-p "gtk_widget_accelerators_locked")
     () boolean
   (widget widget))
+|#
 
 (defbinding widget-event () int
   (widget widget)
@@ -171,18 +174,6 @@ (defbinding widget-allocation () nil
   (width int :out)
   (height int :out))
 
-
-(defbinding widget-set-uposition (widget &key (x t) (y t)) nil
-  (widget widget)
-  ((case x
-     ((t) -2)
-     ((nil) -1)
-     (otherwise x)) int)
-  ((case y
-     ((t) -2)
-     ((nil) -1)
-     (otherwise y)) int))
-
 (defbinding widget-add-events () nil
   (widget widget)
   (events gdk:event-mask))
@@ -194,12 +185,6 @@ (defbinding (widget-ancestor "gtk_widget_get_ancestor") (widget type) widget
   (widget widget)
   ((find-type-number type) type-number))
 
-; (defbinding ("gtk_widget_get_colormap" widget-colormap) () gdk:colormap
-;   (widget widget))
-
-; (defbinding ("gtk_widget_get_visual" widget-visual) () gdk:visual
-;   (widget widget))
-
 (defbinding (widget-pointer "gtk_widget_get_pointer") () nil
   (widget widget)
   (x int :out)
@@ -209,15 +194,9 @@ (defbinding (widget-is-ancestor-p "gtk_widget_is_ancestor") () boolean
   (widget widget)
   (ancestor widget))
 
-(defbinding widget-set-rc-style () nil
-  (widget widget))
-
 (defbinding widget-ensure-style () nil
   (widget widget))
 
-(defbinding widget-restore-default-style () nil
-  (widget widget))
-
 (defbinding widget-reset-rc-styles () nil
   (widget widget))
 
@@ -232,43 +211,25 @@ (defun (setf widget-cursor) (cursor-type widget)
 ;; This will override the values that got set by the
 ;; widget-set-default-* functions.
 
-(defbinding widget-push-style () nil
-  (style style))
-
 (defbinding widget-push-colormap () nil
   (colormap gdk:colormap))
 
-; (defbinding widget-push-visual () nil
-;   (visual gdk:visual))
-
 (defbinding widget-push-composite-child () nil)
 
-(defbinding widget-pop-style () nil)
-
 (defbinding widget-pop-colormap () nil)
 
-;(defbinding widget-pop-visual () nil)
-
 (defbinding widget-pop-composite-child () nil)
 
 
 ;; Set certain default values to be used at widget creation time.
 
-(defbinding widget-set-default-style () nil
-  (style style))
-
 (defbinding widget-set-default-colormap () nil
   (colormap gdk:colormap))
 
-; (defbinding widget-set-default-visual () nil
-;   (visual gdk:visual))
-
 (defbinding widget-get-default-style () style)
 
 (defbinding widget-get-default-colormap () gdk:colormap)
 
-(defbinding widget-get-default-visual () gdk:visual)
-
 (defbinding widget-shape-combine-mask () nil
   (widget widget)
   (shape-mask gdk:bitmap)