From 4c371500f9bbd981090b5d3a93a7b6afa28c7f72 Mon Sep 17 00:00:00 2001 Message-Id: <4c371500f9bbd981090b5d3a93a7b6afa28c7f72.1714199633.git.mdw@distorted.org.uk> From: Mark Wooding Date: Sun, 7 Jan 2007 20:23:22 +0000 Subject: [PATCH] Added args argument to COMPUTE-SIGNAL-FUNCTION Organization: Straylight/Edgeware From: espen --- gtk/gtk.lisp | 12 ++++++------ gtk/gtkcontainer.lisp | 17 +++++++++++------ gtk/gtkwidget.lisp | 15 ++++++++------- 3 files changed, 25 insertions(+), 19 deletions(-) diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index 2730538..269be02 100644 --- a/gtk/gtk.lisp +++ b/gtk/gtk.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: gtk.lisp,v 1.66 2006-09-14 11:52:40 espen Exp $ +;; $Id: gtk.lisp,v 1.67 2007-01-07 20:23:22 espen Exp $ (in-package "GTK") @@ -436,11 +436,11 @@ (defun (setf bin-child) (child bin) (container-add bin child) child) -(defmethod compute-signal-function ((bin bin) signal function object) +(defmethod compute-signal-function ((bin bin) signal function object args) (declare (ignore signal)) (if (eq object :child) - #'(lambda (&rest args) - (apply function (bin-child bin) (rest args))) + #'(lambda (&rest emission-args) + (apply function (bin-child bin) (nconc (rest emission-args) args))) (call-next-method))) @@ -670,8 +670,8 @@ (defmethod compute-signal-id ((dialog dialog) signal) (ensure-signal-id 'response dialog) (call-next-method))) -(defmethod compute-signal-function ((dialog dialog) signal function object) - (declare (ignore function object)) +(defmethod compute-signal-function ((dialog dialog) signal function object args) + (declare (ignore function object args)) (let ((callback (call-next-method)) (id (dialog-response-id dialog signal))) (if id diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index 4dcc7d8..982a645 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)) diff --git a/gtk/gtkwidget.lisp b/gtk/gtkwidget.lisp index 9155813..d628d5a 100644 --- a/gtk/gtkwidget.lisp +++ b/gtk/gtkwidget.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: gtkwidget.lisp,v 1.25 2006-09-27 08:44:44 espen Exp $ +;; $Id: gtkwidget.lisp,v 1.26 2007-01-07 20:23:22 espen Exp $ (in-package "GTK") @@ -67,12 +67,13 @@ (defmethod slot-unbound ((class gobject-class) (object widget) ((call-next-method)))) -(defmethod compute-signal-function ((widget widget) signal function object) +(defmethod compute-signal-function ((widget widget) signal function object args) (declare (ignore signal)) (if (eq object :parent) - #'(lambda (&rest args) - (if (slot-boundp widget 'parent) - (apply function (widget-parent widget) (rest args)) + #'(lambda (&rest emission-args) + (let ((all-args (nconc (rest emission-args) args))) + (if (slot-boundp widget 'parent) + (apply function (widget-parent widget) all-args) ;; Delay until parent is set (signal-connect widget 'parent-set #'(lambda (old-parent) @@ -80,10 +81,10 @@ (defmethod compute-signal-function ((widget widget) signal function object) (let ((*signal-stop-emission* #'(lambda () (warn "Ignoring emission stop in delayed signal handler")))) - (apply function (widget-parent widget) (rest args)))) + (apply function (widget-parent widget) all-args))) :remove t) ; (warn "Widget has no parent -- ignoring signal") - )) + ))) (call-next-method))) (defun child-property-value (widget slot) -- [mdw]