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:44:20.000000000 +0100
+++ new-qt.gui/qt.mbd	2014-10-30 07:44:20.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:44:20.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:44:20.000000000 +0100
+++ new-qt.gui/src/object.lisp	2014-10-30 07:44:20.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)