X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/4c371500f9bbd981090b5d3a93a7b6afa28c7f72..d996f9c5bd83a6974ca6e220ae15bc781f47d28e:/gtk/gtkcontainer.lisp diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index 982a645..128cd67 100644 --- a/gtk/gtkcontainer.lisp +++ b/gtk/gtkcontainer.lisp @@ -20,13 +20,14 @@ ;; 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.22 2007-01-07 20:23:22 espen Exp $ +;; $Id: gtkcontainer.lisp,v 1.24 2007-07-04 14:24:54 espen Exp $ (in-package "GTK") (defgeneric container-add (container widget &rest args)) (defgeneric container-remove (container widget)) -(defgeneric container-children (container)) +(defgeneric container-all-children (container)) +(defgeneric container-internal-children (container)) (defgeneric (setf container-children) (children container)) @@ -78,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) @@ -165,11 +170,11 @@ (nreverse internal))) (defmethod container-internal-children ((container container)) - (let ((public-children (container-children container)) + (let ((external-children (container-children container)) (all-children (container-all-children container))) (loop for child in all-children - unless (find child public-children) + unless (find child external-children) collect child))) (defmethod (setf container-children) (children (container container))