X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/646e702a5d3af15e1d7935957e1b104abc5d059f..a68868d1113c91678cbdbac1cb77aa15c47c7ad2:/gtk/gtkcontainer.lisp diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index 3dee0b6..89634c1 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.21 2006/04/26 12:31:34 espen Exp $ +;; $Id: gtkcontainer.lisp,v 1.22 2007/01/07 20:23:22 espen Exp $ (in-package "GTK") @@ -63,13 +63,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 +88,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))