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:44:51.000000000 +0100
+++ new-qt.gui/src/signal-slot/connect.lisp	2014-10-30 07:44:52.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)))