Sun Aug 2 13:29:02 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* qt:event upcasting cleanup
diff -rN -u old-qt.gui/qt.mbd new-qt.gui/qt.mbd
--- old-qt.gui/qt.mbd 2014-10-30 07:00:39.000000000 +0100
+++ new-qt.gui/qt.mbd 2014-10-30 07:00:39.000000000 +0100
@@ -45,7 +45,8 @@
("qt" (:needs "package" "lib"))
("ownership" (:needs "qt"))
- ("object" (:needs "qt" "signal-slot" "qstring"))
+ ("event" (:needs "qt"))
+ ("object" (:needs "qt" "signal-slot" "qstring" "event"))
("operator" (:needs "qt" "object"))
("application" (:needs "qt" "properties"))
("qstring" (:needs "qt"))
diff -rN -u old-qt.gui/src/event.lisp new-qt.gui/src/event.lisp
--- old-qt.gui/src/event.lisp 1970-01-01 01:00:00.000000000 +0100
+++ new-qt.gui/src/event.lisp 2014-10-30 07:00:39.000000000 +0100
@@ -0,0 +1,10 @@
+(in-package :cl-smoke.qt-impl)
+
+(defun cast-event (event)
+ (enum-case (cxx:type event)
+ ((qt:event.+child-added+ qt:event.+child-removed+
+ qt:event.+child-polished+)
+ (setf (slot-value event 'smoke::pointer)
+ (smoke::upcast event (find-class 'qt:child-event)))
+ (change-class event 'qt:child-event)))
+ event)
diff -rN -u old-qt.gui/src/object.lisp new-qt.gui/src/object.lisp
--- old-qt.gui/src/object.lisp 2014-10-30 07:00:39.000000000 +0100
+++ new-qt.gui/src/object.lisp 2014-10-30 07:00:39.000000000 +0100
@@ -195,28 +195,23 @@
((data :pointer))
(declare (optimize (speed 3)))
(let ((receiver (smoke::get-object (cffi:mem-aref data :pointer 0)))
- (event (make-instance 'qt:event
- :pointer (cffi:mem-aref data :pointer 1))))
+ (event (cast-event
+ (make-instance 'qt:event
+ :pointer (cffi:mem-aref data :pointer 1)))))
(enum-case (cxx:type event)
(qt:event.+child-added+
- (let ((child-event (make-instance 'qt:child-event
- :pointer
- (smoke::upcast event (find-class 'qt:child-event)))))
- (tg:cancel-finalization (cxx:child child-event))
- (when (smoke::has-pointer-p (smoke::pointer (cxx:child child-event)))
- (unless receiver
- (setf receiver (ensure-smoke-parent (cxx:child child-event))))
- (smoke::transfer-ownership-to (cxx:child child-event) receiver))))
+ (tg:cancel-finalization (cxx:child event))
+ (when (smoke::has-pointer-p (smoke::pointer (cxx:child event)))
+ (unless receiver
+ (setf receiver (ensure-smoke-parent (cxx:child event))))
+ (smoke::transfer-ownership-to (cxx:child event) receiver)))
(qt:event.+child-removed+
- (let* ((child-event (make-instance 'qt:child-event
- :pointer (smoke::upcast event
- (find-class 'qt:child-event)))))
- ;; We receive child removed events for any QObject, whether
- ;; it was constructed 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)))
- (assert receiver)
- (smoke::take-ownership (cxx:child child-event) receiver))))))
+ ;; We receive child removed events for any QObject, whether
+ ;; it was constructed by Smoke or not. Only take ownership of
+ ;; objects that have been constructed by Smoke.
+ (when (smoke::has-pointer-p (smoke::pointer (cxx:child event)))
+ (assert receiver)
+ (smoke::take-ownership (cxx:child event) receiver)))))
nil)
(eval-when (:compile-toplevel :load-toplevel :execute)