X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/c78ef85cf5ee71d4a7bac409ed544949fe73b53c..d996f9c5bd83a6974ca6e220ae15bc781f47d28e:/gtk/gtkcontainer.lisp diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index b0198ca..128cd67 100644 --- a/gtk/gtkcontainer.lisp +++ b/gtk/gtkcontainer.lisp @@ -20,7 +20,7 @@ ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: gtkcontainer.lisp,v 1.23 2007-01-14 23:18:17 espen Exp $ +;; $Id: gtkcontainer.lisp,v 1.24 2007-07-04 14:24:54 espen Exp $ (in-package "GTK") @@ -79,15 +79,19 @@ (container container) (widget widget)) -(defmethod container-add ((container container) (widget widget) &rest args) - (%container-add container widget) +(defun init-child-slots (container child args) (when args (setf - (slot-value widget 'child-properties) + (slot-value child 'child-properties) (apply #'make-instance (gethash (class-of container) *container-to-child-class-mappings*) - :parent container :child widget args)))) + :parent container :child child args)))) + +(defmethod container-add ((container container) (widget widget) &rest args) + (%container-add container widget) + (init-child-slots container widget args) + widget) (defmethod container-add ((container container) (widgets list) &rest args) (dolist (widget widgets)