Mon Jul 27 21:39:43 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Fix ownership transfer for lambda slot to no Smoke object.
diff -rN -u old-qt.gui/src/signal-slot/connect.lisp new-qt.gui/src/signal-slot/connect.lisp
--- old-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:00:42.000000000 +0100
+++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:00:42.000000000 +0100
@@ -124,20 +124,30 @@
(defmethod qt:connect ((qt-signal qt-signal) (function function) &optional type)
(let* ((signal-id (find-signal-id (qsender qt-signal) (name qt-signal)))
(slot (make-instance 'qslot
- ;; Set the sender as the slots parent,
- ;; to ensure it does not get gc'ed.
- ;;
- ;; FIXME: unset parent on disconnect.
- ;; This no not critical because the slot
- ;; object is not accessible to the user,
- ;; who thus can not connect it to other
- ;; signals.
- :args (list (qsender qt-signal))
:slot-function function
:argument-types
(method-arguments-type
(cxx:meta-object (qsender qt-signal))
signal-id))))
+ ;; Ensure that the slot is not gc'ed as long as the QT-SIGNAL
+ ;; exists.
+ ;;
+ ;; FIXME: remove on disconnect.
+ ;; This no not critical because the slot
+ ;; object is not accessible to the user,
+ ;; who thus can not connect it to other
+ ;; signals.
+ (if (smoke::has-pointer-p (smoke:pointer (qsender qt-signal)))
+ (setf (cxx:parent slot) (qsender qt-signal))
+ ;; when QT-SIGNAL is not a Smoke instance.
+ (progn
+ (unless (qt:property-p (qsender qt-signal) 'connected-slots)
+ (setf (qt:property (qsender qt-signal) 'connected-slots)
+ (qt:make-lisp-variant (list))))
+ (setf (qt:property (qsender qt-signal) 'connected-slots)
+ (qt:make-lisp-variant
+ (cons slot
+ (qt:property (qsender qt-signal) 'connected-slots))))))
(if (connect-id (qsender qt-signal) signal-id
slot (id slot)
type (types (arguments slot)))