From d1b6a54e578ad5b6980545e9132f90e3f3ebc95f Mon Sep 17 00:00:00 2001 From: espen Date: Tue, 6 May 2008 00:04:42 +0000 Subject: [PATCH] Removed circular object references in signal handler closures --- glib/gcallback.lisp | 48 +++++++++++++++++++++++++++--------------------- gtk/gtk.lisp | 6 +++--- gtk/gtkcontainer.lisp | 6 +++--- gtk/gtkwidget.lisp | 12 ++++++------ 4 files changed, 39 insertions(+), 33 deletions(-) diff --git a/glib/gcallback.lisp b/glib/gcallback.lisp index 357535d..c25f62b 100644 --- a/glib/gcallback.lisp +++ b/glib/gcallback.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: gcallback.lisp,v 1.49 2008-04-11 20:51:45 espen Exp $ +;; $Id: gcallback.lisp,v 1.50 2008-05-06 00:04:42 espen Exp $ (in-package "GLIB") @@ -453,28 +453,34 @@ handler will be called after the default handler for the signal. If :REMOVE is non NIL, the handler will be removed after beeing invoked once. ARGS is a list of additional arguments passed to the callback function." -(let* ((signal-id (compute-signal-id gobject signal)) - (detail-quark (if detail (quark-intern detail) 0)) - (signal-stop-emission - #'(lambda () - (%signal-stop-emission gobject signal-id detail-quark))) - (callback (compute-signal-function gobject signal function object args)) - (wrapper #'(lambda (&rest args) - (let ((*signal-stop-emission* signal-stop-emission)) - (apply callback args))))) - (multiple-value-bind (closure-id callback-id) - (make-callback-closure wrapper signal-handler-marshal) - (let ((handler-id (%signal-connect-closure-by-id - gobject signal-id detail-quark closure-id after))) - (when remove - (update-user-data callback-id - #'(lambda (&rest args) + (let* ((signal-id (compute-signal-id gobject signal)) + (detail-quark (if detail (quark-intern detail) 0)) + (callback + (compute-signal-function gobject signal function object args)) + (wrapper + #'(lambda (&rest args) + (let ((*signal-stop-emission* + #'(lambda () + (%signal-stop-emission (first args) + signal-id detail-quark)))) + (apply callback args))))) + (multiple-value-bind (closure-id callback-id) + (make-callback-closure wrapper signal-handler-marshal) + (let ((handler-id (%signal-connect-closure-by-id + gobject signal-id detail-quark closure-id after))) + (when remove + (update-user-data callback-id + #'(lambda (&rest args) + (let ((gobject (first args))) (unwind-protect - (let ((*signal-stop-emission* signal-stop-emission)) - (apply callback args)) + (let ((*signal-stop-emission* + #'(lambda () + (%signal-stop-emission gobject + signal-id detail-quark)))) + (apply callback args)) (when (signal-handler-is-connected-p gobject handler-id) - (signal-handler-disconnect gobject handler-id)))))) - handler-id)))) + (signal-handler-disconnect gobject handler-id))))))) + handler-id)))) ;;;; Signal emission diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index b00c1ab..8191110 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.93 2008-04-14 19:10:41 espen Exp $ +;; $Id: gtk.lisp,v 1.94 2008-05-06 00:04:42 espen Exp $ (in-package "GTK") @@ -602,8 +602,8 @@ (defmethod compute-signal-function ((bin bin) signal function object args) (declare (ignore signal)) (if (eq object :child) - #'(lambda (&rest emission-args) - (apply function (bin-child bin) (nconc (rest emission-args) args))) + #'(lambda (bin &rest emission-args) + (apply function (bin-child bin) (nconc emission-args args))) (call-next-method))) diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index ac0a836..f352b25 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.25 2008-03-06 22:02:08 espen Exp $ +;; $Id: gtkcontainer.lisp,v 1.26 2008-05-06 00:04:42 espen Exp $ (in-package "GTK") @@ -67,8 +67,8 @@ (defmethod compute-signal-function ((container container) signal function object args) (declare (ignore signal)) (if (eq object :children) - #'(lambda (&rest emission-args) - (let ((all-args (nconc (rest emission-args) args))) + #'(lambda (container &rest emission-args) + (let ((all-args (nconc emission-args args))) (container-foreach container #'(lambda (child) (apply function child all-args))))) diff --git a/gtk/gtkwidget.lisp b/gtk/gtkwidget.lisp index 100b0e2..b27fbb6 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.30 2008-04-11 18:42:40 espen Exp $ +;; $Id: gtkwidget.lisp,v 1.31 2008-05-06 00:04:42 espen Exp $ (in-package "GTK") @@ -70,23 +70,23 @@ (defmethod compute-signal-function ((widget widget) signal function object args) (let ((wrapper (if (eq object :parent) - #'(lambda (&rest emission-args) - (let ((all-args (nconc (rest emission-args) args))) + #'(lambda (widget &rest emission-args) + (let ((all-args (nconc 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) (declare (ignore old-parent)) - (apply #'signal-emit widget signal (rest emission-args))) + (apply #'signal-emit widget signal emission-args)) :remove t)))) (call-next-method)))) (if *widget-display-as-default-in-signal-handler-p* - #'(lambda (&rest args) + #'(lambda (widget &rest args) (let ((display (when (slot-boundp widget 'window) (gdk:drawable-display (widget-window widget))))) (gdk:with-default-display (display) - (apply wrapper args)))) + (apply wrapper widget args)))) wrapper))) -- 2.11.0