X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/9afb775d6948dea9e0c6125016c94b55dce90d70..19406f20ddb51fdcf94bf9a91c12c53717bad724:/gtk/gtkwidget.lisp diff --git a/gtk/gtkwidget.lisp b/gtk/gtkwidget.lisp index 1547716..692b155 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.27 2007/02/19 14:29:33 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) @@ -411,9 +412,9 @@ (defbinding widget-queue-draw-area () nil (defbinding widget-reset-shapes () nil (widget widget)) -;; (defbinding widget-set-double-buffered () nil -;; (widget widget) -;; (double-buffered boolean)) +(defbinding widget-set-double-buffered () nil + (widget widget) + (double-buffered boolean)) ;; (defbinding widget-set-redraw-on-allocate () nil ;; (widget widget)