Updated for atk 1.0

[clg] / gtk / gtkwidget.lisp

diff --git a/gtk/gtkwidget.lisp b/gtk/gtkwidget.lisp
index af346f316dc1373db0a6761b5d8d1ba66b3f731a..4a59545184a7d4a1819c31e2299b47797cbabb5c 100644 (file)
--- a/gtk/gtkwidget.lisp
+++ b/gtk/gtkwidget.lisp
@@ -1,5 +1,5 @@
 ;; Common Lisp bindings for GTK+ v2.0
 ;; Common Lisp bindings for GTK+ v2.0

-;; Copyright (C) 2000 Espen S. Johnsen <espejohn@online.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
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public


@@ -15,36 +15,37 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
 ;; 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.3 2000-10-05 17:34:53 espen Exp $
+;; $Id: gtkwidget.lisp,v 1.7 2001-12-12 20:24:41 espen Exp $

 
 (in-package "GTK")
 
 
 
 (in-package "GTK")
 
 

-(defmethod initialize-instance ((widget widget) &rest initargs &key parent)
-  (declare (ignore initargs))
-  (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)))
-    (call-next-method))
+(defmethod shared-initialize ((widget widget) names &rest initargs &key parent)
+  (declare (ignore initargs names))
+  (call-next-method)
+  (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 object-class) (object widget) slot)
+
+(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
       (setf
        child-slots
        (make-instance
   (cond
    ((and (eq slot 'child-slots) (slot-value object 'parent))
     (with-slots (parent child-slots) object
       (setf
        child-slots
        (make-instance

-       (slot-value (class-of parent) 'child-class)
+       (gethash (class-of parent) *container-to-child-class-mappings*)

        :parent parent :child object))))
    (t (call-next-method))))
 
        :parent parent :child object))))
    (t (call-next-method))))
 


@@ -62,40 +63,41 @@ (defmacro with-child-slots (slots widget &body body)
 (defmacro widget-destroyed (place)
   `(setf ,place nil))
 
 (defmacro widget-destroyed (place)
   `(setf ,place nil))
 

-(define-foreign widget-destroy () nil
+(defbinding widget-destroy () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-unparent () nil
+(defbinding widget-unparent () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-show () nil
+(defbinding widget-show () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-show-now () nil
+(defbinding widget-show-now () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-hide () nil
+(defbinding widget-hide () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-show-all () nil
+(defbinding widget-show-all () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-hide-all () nil
+(defbinding widget-hide-all () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-map () nil
+(defbinding widget-map () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-unmap () nil
+(defbinding widget-unmap () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-realize () nil
+(defbinding widget-realize () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-unrealize () nil
+(defbinding widget-unrealize () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-add-accelerator
+#|
+(defbinding widget-add-accelerator

     (widget signal accel-group key modifiers flags) nil
   (widget widget)
   ((name-to-string signal) string)
     (widget signal accel-group key modifiers flags) nil
   (widget widget)
   ((name-to-string signal) string)


@@ -104,122 +106,98 @@ (define-foreign widget-add-accelerator
   (modifiers gdk:modifier-type)
   (flags accel-flags))
 
   (modifiers gdk:modifier-type)
   (flags accel-flags))
 

-(define-foreign widget-remove-accelerator
+(defbinding widget-remove-accelerator

     (widget accel-group key modifiers) nil
   (widget widget)
   (accel-group accel-group)
   ((gdk:keyval-from-name key) unsigned-int)
   (modifiers gdk:modifier-type))
 
     (widget accel-group key modifiers) nil
   (widget widget)
   (accel-group accel-group)
   ((gdk:keyval-from-name key) unsigned-int)
   (modifiers gdk:modifier-type))
 

-(define-foreign widget-accelerator-signal
+(defbinding widget-accelerator-signal

     (widget accel-group key modifiers) unsigned-int
   (widget widget)
   (accel-group accel-group)
   ((gdk:keyval-from-name key) unsigned-int)
   (modifiers gdk:modifier-type))
 
     (widget accel-group key modifiers) unsigned-int
   (widget widget)
   (accel-group accel-group)
   ((gdk:keyval-from-name key) unsigned-int)
   (modifiers gdk:modifier-type))
 

-(define-foreign widget-lock-accelerators () nil
+(defbinding widget-lock-accelerators () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-unlock-accelerators () nil
+(defbinding widget-unlock-accelerators () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign
-    ("gtk_widget_accelerators_locked" widget-accelerators-locked-p) () boolean
+(defbinding (widget-accelerators-locked-p "gtk_widget_accelerators_locked")
+    () boolean

   (widget widget))
   (widget widget))

+|#

 
 

-(define-foreign widget-event () int
+(defbinding widget-event () int

   (widget widget)
   (event gdk:event))
 
   (widget widget)
   (event gdk:event))
 

-(define-foreign get-event-widget () widget
+(defbinding get-event-widget () widget

   (event gdk:event))
 
   (event gdk:event))
 

-(define-foreign widget-activate () boolean
+(defbinding widget-activate () boolean

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-set-scroll-adjustments () boolean
+(defbinding widget-set-scroll-adjustments () boolean

   (widget widget)
   (hadjustment adjustment)
   (vadjustment adjustment))
 
   (widget widget)
   (hadjustment adjustment)
   (vadjustment adjustment))
 

-(define-foreign widget-reparent () nil
+(defbinding widget-reparent () nil

   (widget widget)
   (new-parent widget))
 
   (widget widget)
   (new-parent widget))
 

-(define-foreign widget-popup () nil
-  (widget widget)
-  (x int)
-  (y int))
+; (defbinding widget-popup () nil
+;   (widget widget)
+;   (x int)
+;   (y int))

 
 

-(define-foreign widget-grab-focus () nil
+(defbinding widget-grab-focus () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-grab-default () nil
+(defbinding widget-grab-default () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign grab-add () nil
+(defbinding grab-add () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign grab-get-current () widget)
+(defbinding grab-get-current () widget)

 
 

-(define-foreign grab-remove () nil
+(defbinding grab-remove () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-allocation () nil
+(defbinding widget-allocation () nil

   (widget widget)
   (width int :out)
   (height int :out))
 
   (widget widget)
   (width int :out)
   (height int :out))
 

-
-(define-foreign 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))
-
-(define-foreign widget-add-events () nil
+(defbinding widget-add-events () nil

   (widget widget)
   (events gdk:event-mask))
 
   (widget widget)
   (events gdk:event-mask))
 

-(define-foreign ("gtk_widget_get_toplevel" widget-toplevel) () widget
+(defbinding (widget-toplevel "gtk_widget_get_toplevel") () widget

   (widget widget))
 
   (widget widget))
 

-(define-foreign ("gtk_widget_get_ancestor"
-                 widget-ancestor) (widget type) widget
+(defbinding (widget-ancestor "gtk_widget_get_ancestor") (widget type) widget

   (widget widget)
   ((find-type-number type) type-number))
 
   (widget widget)
   ((find-type-number type) type-number))
 

-; (define-foreign ("gtk_widget_get_colormap" widget-colormap) () gdk:colormap
-;   (widget widget))
-
-; (define-foreign ("gtk_widget_get_visual" widget-visual) () gdk:visual
-;   (widget widget))
-
-(define-foreign ("gtk_widget_get_pointer" widget-pointer) () nil
+(defbinding (widget-pointer "gtk_widget_get_pointer") () nil

   (widget widget)
   (x int :out)
   (y int :out))
 
   (widget widget)
   (x int :out)
   (y int :out))
 

-(define-foreign ("gtk_widget_is_ancestor" widget-is-ancestor-p) () boolean
+(defbinding (widget-is-ancestor-p "gtk_widget_is_ancestor") () boolean

   (widget widget)
   (ancestor widget))
 
   (widget widget)
   (ancestor widget))
 

-(define-foreign widget-set-rc-style () nil
-  (widget widget))
-
-(define-foreign widget-ensure-style () nil
-  (widget widget))
-
-(define-foreign widget-restore-default-style () nil
+(defbinding widget-ensure-style () nil

   (widget widget))
 
   (widget widget))
 

-(define-foreign widget-reset-rc-styles () nil
+(defbinding widget-reset-rc-styles () nil

   (widget widget))
 
 (defun (setf widget-cursor) (cursor-type widget)
   (widget widget))
 
 (defun (setf widget-cursor) (cursor-type widget)


@@ -233,50 +211,32 @@ (defun (setf widget-cursor) (cursor-type widget)
 ;; This will override the values that got set by the
 ;; widget-set-default-* functions.
 
 ;; This will override the values that got set by the
 ;; widget-set-default-* functions.
 

-(define-foreign widget-push-style () nil
-  (style style))
-
-(define-foreign widget-push-colormap () nil
+(defbinding widget-push-colormap () nil

   (colormap gdk:colormap))
 
   (colormap gdk:colormap))
 

-; (define-foreign widget-push-visual () nil
-;   (visual gdk:visual))
-
-(define-foreign widget-push-composite-child () nil)
+(defbinding widget-push-composite-child () nil)

 
 

-(define-foreign widget-pop-style () nil)
+(defbinding widget-pop-colormap () nil)

 
 

-(define-foreign widget-pop-colormap () nil)
-
-;(define-foreign widget-pop-visual () nil)
-
-(define-foreign widget-pop-composite-child () nil)
+(defbinding widget-pop-composite-child () nil)

 
 
 ;; Set certain default values to be used at widget creation time.
 
 
 
 ;; Set certain default values to be used at widget creation time.
 

-(define-foreign widget-set-default-style () nil
-  (style style))
-
-(define-foreign widget-set-default-colormap () nil
+(defbinding widget-set-default-colormap () nil

   (colormap gdk:colormap))
 
   (colormap gdk:colormap))
 

-; (define-foreign widget-set-default-visual () nil
-;   (visual gdk:visual))
-
-(define-foreign widget-get-default-style () style)
-
-(define-foreign widget-get-default-colormap () gdk:colormap)
+(defbinding widget-get-default-style () style)

 
 

-(define-foreign widget-get-default-visual () gdk:visual)
+(defbinding widget-get-default-colormap () gdk:colormap)

 
 

-(define-foreign widget-shape-combine-mask () nil
+(defbinding widget-shape-combine-mask () nil

   (widget widget)
   (shape-mask gdk:bitmap)
   (x-offset int)
   (y-offset int))
 
 ;; defined in gtkglue.c
   (widget widget)
   (shape-mask gdk:bitmap)
   (x-offset int)
   (y-offset int))
 
 ;; defined in gtkglue.c

-(define-foreign widget-mapped-p () boolean
+(defbinding widget-mapped-p () boolean

   (widget widget))
 
   (widget widget))