X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/860e6a2e42d678b2c086c32ad607d266cddc5540..4886872cc0e830d358e3dfb46042ea2ac0346a05:/gtk/gtkcontainer.lisp diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index 0e36a2c..305da72 100644 --- a/gtk/gtkcontainer.lisp +++ b/gtk/gtkcontainer.lisp @@ -15,21 +15,23 @@ ;; 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: gtkcontainer.lisp,v 1.7 2002/03/24 12:58:34 espen Exp $ +;; $Id: gtkcontainer.lisp,v 1.12 2004/11/07 17:55:29 espen Exp $ (in-package "GTK") -(defmethod shared-initialize ((container container) names &rest initargs) +(defmethod shared-initialize ((container container) names &rest initargs + &key child children child-args) + (declare (ignore child)) (call-next-method) - (dolist (child (get-all initargs :child)) - (apply #'container-add container (mklist child)))) + (dolist (child (append children (get-all initargs :child))) + (apply #'container-add container (append (mklist child) child-args)))) (defbinding %container-add () nil (container container) (widget widget)) -(defun container-add (container widget &rest args) +(defmethod container-add ((container container) (widget widget) &rest args) (%container-add container widget) (when args (setf @@ -44,7 +46,7 @@ (container container) (widget widget)) -(defun container-remove (container widget) +(defmethod container-remove ((container container) (widget widget)) (%container-remove container widget) (slot-makunbound widget 'child-slots)) @@ -65,24 +67,21 @@ (defbinding container-check-resize () nil (container container)) -(defvar *callback-marshal* - (system:foreign-symbol-address "gtk_callback_marshal")) +(def-callback-marshal %foreach-callback (nil widget)) (defbinding %container-foreach (container callback-id) nil (container container) - (*callback-marshal* pointer) + ((callback %foreach-callback) pointer) (callback-id unsigned-int)) (defun container-foreach (container function) - (let ((callback-id (register-callback-function function))) - (unwind-protect - (%container-foreach container callback-id) - (destroy-user-data callback-id)))) + (with-callback-function (id function) + (%container-foreach container id))) (defun map-container (seqtype func container) (case seqtype ((nil) - (%container-foreach container func) + (container-foreach container func) nil) (list (let ((list nil))