X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/4a8bb854f067550a460b2ab872db545c414b2986..cc8d918eec6976ce68916fd15a4837f5b8e34dba:/gtk/gtkcontainer.lisp diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index 9f810b5..8cb62b7 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 @@ (defbinding %container-add () nil (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)