Added more binding

diff --git a/gtk/gtkwidget.lisp b/gtk/gtkwidget.lisp
index c680614852edfb2d3a2772a4007c45fc9663b9a5..7f9aa5cb2b63498a0584daf4c7f785a17bc4a727 100644 (file)
--- a/gtk/gtkwidget.lisp
+++ b/gtk/gtkwidget.lisp
@@ -15,7 +15,7 @@
 ;; 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.14 2005-01-06 21:00:51 espen Exp $
+;; $Id: gtkwidget.lisp,v 1.15 2005-01-12 13:51:02 espen Exp $
 
 (in-package "GTK")
 
@@ -37,23 +37,30 @@ (defmethod shared-initialize :after ((widget widget) names &rest initargs
   (when (or all-visible show-all)
     (widget-show-all widget)))
 
-
-(defmethod slot-unbound ((class gobject-class) (object widget) slot)
+(defmethod slot-unbound ((class gobject-class) (object widget) 
+                        (slot (eql 'child-properties)))
   (cond
-   ((and (eq slot 'child-properties) (slot-value object 'parent))
+   ((slot-boundp object 'parent)
     (with-slots (parent child-properties) object
-      (setf
-       child-properties
-       (make-instance
-       (gethash (class-of parent) *container-to-child-class-mappings*)
+      (setf child-properties
+       (make-instance 
+        (gethash (class-of parent) *container-to-child-class-mappings*)
        :parent parent :child object))))
-   (t (call-next-method))))
+   ((call-next-method))))
+
+(defmethod slot-boundp-using-class ((class gobject-class) (object widget) slot)
+  (or
+   (and 
+    (eq (slot-definition-name slot) 'child-properties) 
+    (slot-boundp object 'parent))
+   (call-next-method)))
 
 (defmethod create-callback-function ((widget widget) function arg1)
   (if (eq arg1 :parent)
       #'(lambda (&rest args)
          (if (slot-boundp widget 'parent)
              (apply function (widget-parent widget) (rest args))
+           ;; Delay until parent is set
            (signal-connect widget 'parent-set
             #'(lambda (old-parent)
                 (declare (ignore old-parent))
@@ -77,10 +84,6 @@ (defmacro with-child-properties (slots widget &body body)
      ,@body))
 
 
-(defmacro widget-destroyed (place)
-  `(setf ,place nil))
-
-
 ;;; Bindings
 
 (defbinding widget-destroy () nil
@@ -122,19 +125,23 @@ (defbinding widget-queue-draw () nil
 (defbinding widget-queue-resize () nil
   (widget widget))
 
-(defbinding widget-size-request () nil
+(defbinding widget-queue-resize-no-redraw () nil
+  (widget widget))
+
+(defbinding widget-size-request
+    (widget &optional (requisition (make-instance 'requisition))) nil
   (widget widget)
-  (requisition requisition))
+  (requisition requisition :return))
 
-(defbinding widget-get-child-requisition () nil
+(defbinding widget-get-child-requisition 
+    (widget &optional (requisition (make-instance 'requisition))) nil
   (widget widget)
-  (requisition requisition))
+  (requisition requisition :return))
 
 (defbinding widget-size-allocate () nil
   (widget widget)
   (allocation allocation))
 
-
 (defbinding widget-add-accelerator
     (widget signal accel-group key modifiers flags) nil
   (widget widget)
@@ -151,13 +158,19 @@ (defbinding widget-remove-accelerator
   ((gdk:keyval-from-name key) unsigned-int)
   (modifiers gdk:modifier-type))
 
-(defbinding (widget-set-accelerator-path "gtk_widget_set_accel_path") () nil
+(defbinding widget-set-accel-path () nil
   (widget widget)
   (accel-path string)
   (accel-group accel-group))
-  
 
-(defbinding widget-event () int
+(defbinding widget-list-accel-closures () (glist pointer)
+  (widget widget))
+
+(defbinding widget-can-activate-accel-p () boolean
+  (widget widget)
+  (signal-id unsigned-int))
+
+(defbinding widget-event () boolean
   (widget widget)
   (event gdk:event))
 
@@ -181,9 +194,6 @@ (defun widget-intersection (widget area)
 (defun widget-intersect-p (widget area)
   (%widget-intersect widget area nil))
 
-;; (defbinding (widget-is-focus-p "gtk_widget_is_focus") () boolean
-;;   (widget widget))
-
 (defbinding widget-grab-focus () nil
   (widget widget))
 
@@ -206,7 +216,7 @@ (defbinding widget-get-pointer () nil
   (x int :out)
   (y int :out))
 
-(defbinding (widget-is-ancestor-p "gtk_widget_is_ancestor") () boolean
+(defbinding widget-is-ancestor-p () boolean
   (widget widget)
   (ancestor widget))
 
@@ -218,7 +228,7 @@ (defbinding widget-translate-coordinates () boolean
 
 (defun widget-hide-on-delete (widget)
   "Utility function; intended to be connected to the DELETE-EVENT
-signal on a GtkWindow. The function calls WIDGET-HIDE on its
+signal on a WINDOW. The function calls WIDGET-HIDE on its
 argument, then returns T. If connected to DELETE-EVENT, the
 result is that clicking the close button for a window (on the window
 frame, top right corner usually) will hide but not destroy the
@@ -238,23 +248,34 @@ (defbinding widget-push-colormap () nil
 
 (defbinding widget-pop-colormap () nil)
 
-(defbinding widget-set-default-colormap () nil
+(defbinding %widget-set-default-colormap () nil
   (colormap gdk:colormap))
 
-(defbinding widget-get-default-style () style)
+(defun (setf widget-default-colormap) (colormap)
+  (%widget-set-default-colormap colormap)
+  colormap)
+
+(defbinding (widget-default-style "gtk_widget_get_default_style") () style)
 
-(defbinding widget-get-default-colormap () gdk:colormap)
+(defbinding (widget-default-colromap "gtk_widget_get_default_colormap") 
+    () gdk:colormap)
 
-(defbinding widget-get-default-visual () gdk:visual)
+(defbinding (widget-default-visual "gtk_widget_get_default_visual") 
+    () gdk:visual)
 
-(defbinding widget-get-default-direction () text-direction)
+(defbinding (widget-default-direction "gtk_widget_get_default_direction")
+    () text-direction)
 
-(defbinding widget-set-default-direction () nil
-  (direction  text-direction))
+(defbinding %widget-set-default-direction () nil
+  (direction text-direction))
+
+(defun (setf widget-default-direction) (direction)
+  (%widget-set-default-direction direction)
+  direction)
 
 (defbinding widget-shape-combine-mask () nil
   (widget widget)
-  (shape-mask gdk:bitmap)
+  (shape-mask (or null gdk:bitmap))
   (x-offset int)
   (y-offset int))
 
@@ -274,15 +295,15 @@ (defbinding widget-modify-style () nil
   (widget widget)
   (style rc-style))
 
-(defbinding widget-modify-style () rc-style
+(defbinding widget-get-modifier-style () rc-style
   (widget widget))
 
-(defbinding (widget-modify-foreground "gtk_widget_modify_fg") () nil
+(defbinding widget-modify-fg () nil
   (widget widget)
   (state state-type)
   (color gdk:color))
 
-(defbinding (widget-modify-background "gtk_widget_modify_bg") () nil
+(defbinding widget-modify-bg () nil
   (widget widget)
   (state state-type)
   (color gdk:color))
@@ -312,11 +333,12 @@ (defbinding widget-create-pango-layout (widget &optional text) pango:layout
   (widget widget)
   (text (or string null)))
 
-(defbinding widget-render-icon () gdk:pixbuf
+(defbinding widget-render-icon (widget stock-id &optional size detail) 
+    gdk:pixbuf
   (widget widget)
   (stock-id string)
-  (size icon-size)
-  (detail string))
+  ((or size -1) (or icon-size int))
+  (detail (or null string)))
 
 (defbinding widget-push-composite-child () nil)
 
@@ -329,31 +351,53 @@ (defbinding widget-queue-draw-area () nil
 (defbinding widget-reset-shapes () nil
   (widget widget))
 
-(defbinding widget-set-double-buffered () nil
-  (widget widget)
-  (double-buffered boolean))
+;; (defbinding widget-set-double-buffered () nil
+;;   (widget widget)
+;;   (double-buffered boolean))
 
-(defbinding widget-set-redraw-on-allocate () nil
-  (widget widget)
-  (redraw-on-allocate boolean))
+;; (defbinding widget-set-redraw-on-allocate () nil
+;;   (widget widget)
+;;   (redraw-on-allocate boolean))
 
 (defbinding widget-set-scroll-adjustments () boolean
   (widget widget)
-  (hadjustment adjustment)
-  (vadjustment adjustment))
+  (hadjustment (or null adjustment))
+  (vadjustment (or null adjustment)))
 
 (defbinding widget-mnemonic-activate () boolean
   (widget widget)
   (group-cycling boolean))
 
+(defbinding widget-class-find-style-property (class name) param
+  ((type-class-peek class) pointer)
+  (name string))
+
+(defbinding widget-class-list-style-properties (class)
+    (vector (copy-of param) n-properties)
+  ((type-class-peek class) pointer)
+  (n-properties unsigned-int :out))
+
 (defbinding widget-region-intersect () pointer ;gdk:region
   (widget widget)
   (region pointer)) ;gdk:region))
 
-(defbinding widget-send-expose () int
+(defbinding widget-send-expose () boolean
   (widget widget)
   (event gdk:event))
 
+(defbinding %widget-style-get-property () nil
+  (widget widget)
+  (name string)
+  (value gvalue))
+
+(defun style-property-value (widget style)
+  (let* ((name (string-downcase style))
+        (param (widget-class-find-style-property (class-of widget) name)))
+    (if (not param)
+       (error "~A has no such style property: ~A" widget style)
+      (with-gvalue (gvalue (param-value-type param))
+        (%widget-style-get-property widget (string-downcase style) gvalue)))))
+
 (defbinding widget-get-accessible () atk:object
   (widget widget))
 
@@ -368,6 +412,22 @@ (defbinding widget-child-notify () nil
 (defbinding widget-freeze-child-notify () nil
   (widget widget))
 
+(defbinding widget-get-clipboard () clipboard
+  (widget widget)
+  (selection int #|gdk:atom|#))
+
+(defbinding widget-get-display () gdk:display
+  (widget widget))
+
+(defbinding widget-get-root-window () gdk:window
+  (widget widget))
+
+(defbinding widget-get-screen () gdk:screen
+  (widget widget))
+
+(defbinding widget-has-screen-p () boolean
+  (widget widget))
+
 (defbinding %widget-get-size-request () nil
   (widget widget)
   (width int :out)
@@ -385,6 +445,17 @@ (defbinding widget-set-size-request (widget width height) nil
 (defbinding widget-thaw-child-notify () nil
   (widget widget))
 
+(defbinding widget-list-mnemonic-labels () (glist widget)
+  (widget widget))
+
+(defbinding widget-add-mnemonic-label () nil
+  (widget widget)
+  (label widget))
+
+(defbinding widget-remove-mnemonic-label () nil
+  (widget widget)
+  (label widget))
+
 
 ;;; Additional bindings and functions
 
@@ -402,3 +473,10 @@ (defbinding get-event-widget () widget
 (defun (setf widget-cursor) (cursor-type widget)
   (let ((cursor (make-instance 'gdk:cursor :type cursor-type)))
     (gdk:window-set-cursor (widget-window widget) cursor)))
+
+(defbinding %widget-get-parent-window () gdk:window
+  (widget widget))
+
+(defun %widget-parent-window (widget)
+  (when (slot-boundp widget 'parent)
+    (%widget-get-parent-window widget)))