X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/0d270bd94e469f012bfab2022aaca91dc9b953c3..8c9bc7fbba4ecf6a4d5eefec23b1563c8f16cf10:/gtk/gtkwidget.lisp?ds=sidebyside diff --git a/gtk/gtkwidget.lisp b/gtk/gtkwidget.lisp index 709421b..4a59545 100644 --- 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 +;; Copyright (C) 2000-2001 Espen S. Johnsen ;; ;; 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-unrealize () nil (widget widget)) +#| (defbinding widget-add-accelerator (widget signal accel-group key modifiers flags) nil (widget widget) @@ -127,6 +129,7 @@ (defbinding (widget-accelerators-locked-p "gtk_widget_accelerators_locked") () boolean (widget widget)) +|# (defbinding widget-event () int (widget widget) @@ -171,18 +174,6 @@ (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 @@ (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 @@ (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 @@ ;; 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)