X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/76ff9f3924bb9aa1b98b42e6e218918706e731e9..80c00d73e8060c5a7cb8944e20c1412646e0796e:/gtk/gtkcontainer.lisp diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index 4dcc7d8..b0198ca 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.21 2006-04-26 12:31:34 espen Exp $ +;; $Id: gtkcontainer.lisp,v 1.23 2007-01-14 23:18:17 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)) @@ -63,13 +64,14 @@ (defmethod shared-initialize ((container container) names &rest initargs initargs :child :children)) -(defmethod compute-signal-function ((container container) signal function object) +(defmethod compute-signal-function ((container container) signal function object args) (declare (ignore signal)) (if (eq object :children) - #'(lambda (&rest args) - (container-foreach container - #'(lambda (child) - (apply function child (rest args))))) + #'(lambda (&rest emission-args) + (let ((all-args (nconc (rest emission-args) args))) + (container-foreach container + #'(lambda (child) + (apply function child all-args))))) (call-next-method))) @@ -87,6 +89,10 @@ (defmethod container-add ((container container) (widget widget) &rest args) (gethash (class-of container) *container-to-child-class-mappings*) :parent container :child widget args)))) +(defmethod container-add ((container container) (widgets list) &rest args) + (dolist (widget widgets) + (apply #'container-add container widget args))) + (defbinding %container-remove () nil (container container) (widget widget)) @@ -160,11 +166,11 @@ (defmethod container-all-children ((container container)) (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))