Wed Jun 10 14:14:34 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Transfer ownerhip only for smoke classes.

--- old-qt.gui/src/object.lisp 2014-10-30 07:47:33.000000000 +0100

+++ new-qt.gui/src/object.lisp 2014-10-30 07:47:33.000000000 +0100

@@ -66,7 +66,7 @@

(not (null-pointer-p (smoke::pointer object)))

; (typep (class-of object) 'cxx:class)

(not (null-pointer-p (smoke::pointer (cxx:parent object)))))

- (smoke::disown-object object)))

+ (smoke::transfer-ownership-to object (cxx:parent object))))

(define-condition wrapper-gc (storage-condition)

((class-name :initarg :class-name

@@ -91,7 +91,6 @@

*qt-smoke*

"QObject")

"deleteLater")))

-

(defun print-object-to-string (object)

(with-output-to-string (stream)

(print-object object stream)))

@@ -107,7 +106,8 @@

(handler-case

(if (null-pointer-p (smoke::pointer-call *get-parent* pointer))

(smoke::pointer-call *delete-later* pointer)

- (error (make-condition 'wrapper-gc :class-name name

+ (error (make-condition 'wrapper-gc

+ :class-name (name class)

:pointer pointer)))

(error (condition)

(smoke::report-finalize-error condition "qt:object wrap"

@@ -116,7 +116,7 @@

(handler-case

(if (null-pointer-p (smoke::pointer-call *get-parent* pointer))

(funcall next)

- (cerror 'continue "Finalizer for object with a parent called."))

+ (cerror "Ignore" "Finalizer for object with a parent called."))

(error (condition)

(smoke::report-finalize-error condition "qt:object"

(name class) pointer)))))))

@@ -139,13 +139,16 @@

(cffi:defcallback event-notify smoke:cxx-bool

((data :pointer))

(declare (optimize (speed 3)))

- (let ((event (make-instance 'event :pointer (cffi:mem-aref data :pointer 1))))

+ (let ((receiver (smoke::get-object (cffi:mem-aref data :pointer 0)))

+ (event (make-instance 'event :pointer (cffi:mem-aref data :pointer 1))))

(enum-case (cxx:type event)

(event.+child-added+

- (let* ((child-event (make-instance 'child-event

+ (let ((child-event (make-instance 'child-event

:pointer

(smoke::upcast event (find-class 'child-event)))))

- (smoke::disown-object (cxx:child child-event))))

+ (when (smoke::has-pointer-p (smoke::pointer (cxx:child child-event)))

+ (assert receiver)

+ (smoke::transfer-ownership-to (cxx:child child-event) receiver))))

(event.+child-removed+

(let* ((child-event (make-instance 'child-event

:pointer (smoke::upcast event

@@ -154,7 +157,8 @@

;; it was construted by Smoke or not. Only take ownership of objects

;; that have been constructed by Smoke.

(when (smoke::has-pointer-p (smoke::pointer (cxx:child child-event)))

- (smoke::take-ownership (cxx:child child-event)))))))

+ (assert receiver)

+ (smoke::take-ownership (cxx:child child-event) receiver))))))

nil)

(eval-when (:compile-toplevel :load-toplevel :execute)