Sun May 31 19:33:32 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Rework QObject parent ownership transfer
hunk ./src/application.lisp 103
- (format stream "Return from the application event loop."))))
+ (format stream "Return from the application event loop."))
+ :test-function
+ #'(lambda (condition)
+ (declare (ignore condition))
+ (find-restart 'continue))))
hunk ./src/lisp-object.lisp 2
-(declaim (optimize (debug 3)))
hunk ./src/lisp-object.lisp 3
-(defvar *cxx-lisp-objects* (make-hash-table)
+(defvar *cxx-lisp-objects* (smoke::make-synchronized-hash-table)
hunk ./src/lisp-object.lisp 30
-(defvar *cxx-lisp-object-metatype*)
+(defvar *cxx-lisp-object-metatype* "Metatype ID of the C++ lisp_object.")
hunk ./src/object.lisp 2
-(declaim (optimize (debug 3)))
hunk ./src/object.lisp 7
- (defmethod cxx:static-meta-object ((class smoke::smoke-wrapper-class))
+ (defmethod cxx:static-meta-object ((class cxx:class))
hunk ./src/object.lisp 10
-(defmethod documentation :around ((class smoke::smoke-standard-class)
+(defmethod documentation :around ((class cxx:class)
hunk ./src/object.lisp 13
- (not (subtypep class (find-class 'smoke::smoke-wrapper-class))))
+ (not (subtypep class (find-class 'cxx:class))))
hunk ./src/object.lisp 58
-(defvar *children* (make-hash-table)
- "A list of custom subclasses of QObject which have a parent
-and therefor must not be garbage collected.")
-
hunk ./src/object.lisp 67
-; (typep (class-of object) 'smoke::smoke-wrapper-class)
+; (typep (class-of object) 'cxx:class)
hunk ./src/object.lisp 69
- (setf (gethash (smoke::pointer object) *children*) object)))
+ (smoke::disown-object object)))
hunk ./src/object.lisp 76
- (format stream "The object ~A ~A of type smoke-wrapper-class
+ (format stream "The object ~A ~A of type cxx:class
hunk ./src/object.lisp 95
- (defmethod smoke::make-finalize ((object object))
+(defun print-object-to-string (object)
+ (with-output-to-string (stream)
+ (print-object object stream)))
+
+(defmethod smoke::make-finalize ((object object))
hunk ./src/object.lisp 103
- (name (class-name (class-of object)))
+ (class (class-of object))
hunk ./src/object.lisp 105
- (if (typep (class-of object) 'smoke::smoke-wrapper-class)
+ (if (typep (class-of object) 'cxx:class)
hunk ./src/object.lisp 112
- (condition (condition)
- (format *debug-io* "error: wrap finalize ~A ~A~%" name
- condition))))
+ (error (condition)
+ (smoke::report-finalize-error condition "qt:object wrap"
+ (name class) pointer))))
hunk ./src/object.lisp 117
- (progn
- (when (null-pointer-p (smoke::pointer-call *get-parent* pointer))
- (funcall next)))
- (condition (condition)
- (format *debug-io* "error: qfinalize ~A ~A ~A~%" name
- pointer
- condition))))))
- ;(smoke::pointer-call delete-later pointer)))))))
- )
+ (if (null-pointer-p (smoke::pointer-call *get-parent* pointer))
+ (funcall next)
+ (cerror 'continue "Finalizer for object with a parent called."))
+ (error (condition)
+ (smoke::report-finalize-error condition "qt:object"
+ (name class) pointer)))))))
hunk ./src/object.lisp 142
- (let ((event (make-instance 'event :pointer (cffi:mem-aref data :pointer 1)
- :owned-p nil)))
+ (let ((event (make-instance 'event :pointer (cffi:mem-aref data :pointer 1))))
hunk ./src/object.lisp 147
- (smoke::upcast event (find-class 'child-event))
- :owned-p nil))
- (child (smoke::get-object
- (smoke::pointer (cxx:child child-event)))))
-; (when (and child
-; (typep (class-of child)
-; 'smoke::smoke-wrapper-class))
- (when child
- (setf (gethash (smoke::pointer child) *children*) child))))
+ (smoke::upcast event (find-class 'child-event)))))
+ (smoke::disown-object (cxx:child child-event))))
hunk ./src/object.lisp 152
- (find-class 'child-event))
- :owned-p nil)))
- (remhash (smoke::pointer (cxx:child child-event)) *children*)))))
+ (find-class 'child-event)))))
+ ;; We receive child removed events for any QObject, wherter
+ ;; 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)))))))
hunk ./src/package.lisp 24
+ #:remove-property
hunk ./src/properties.lisp 17
+
hunk ./src/properties.lisp 24
+(defun remove-property (object name)
+ "Removes the property NAME from OBJECT."
+ (setf (property object name) (qt:make-variant)))
+
hunk ./src/signal-slot/signal-slot.lisp 5
- smoke::smoke-wrapper-class)
+ cxx:class)
hunk ./src/signal-slot/slot.lisp 10
- (:metaclass smoke::smoke-wrapper-class)
+ (:metaclass cxx:class)