Thu Aug 27 10:37:36 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Update to the new smokegenerator.

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

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

@@ -11,12 +11,6 @@

(make-instance 'qt:meta-object

:pointer (qt-smoke-meta-object (pointer object))))

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

- (let ((object (make-instance 'qt:object)))

- (defmethod cxx:static-meta-object ((class (eql (find-class 'qt:object))))

- "No OBJECT.STATIC-META-OBJECT (r558420)."

- (cxx:meta-object object))))

-

(defmethod cxx:static-meta-object ((class cxx:class))

(cxx:static-meta-object (smoke::find-smoke-class class)))

@@ -40,8 +34,12 @@

(null-pointer-p (pointer object)))

(call-next-method)

(if (string= "" (cxx:object-name object))

- (print-unreadable-object (object stream :type t :identity t))

(print-unreadable-object (object stream :type t :identity t)

+ (when (smoke::const-p object)

+ (princ "CONST " stream)))

+ (print-unreadable-object (object stream :type t :identity t)

+ (when (smoke::const-p object)

+ (princ "CONST " stream))

(princ (cxx:object-name object) stream)))))

(defmethod print-object ((object qt:meta-object) stream)

@@ -85,13 +83,15 @@

;; FIXME this might not be that smart.

-(eval-startup ()

+(eval-startup (:compile-toplevel :execute)

(defparameter *destroyed-slot* (qt:make-slot

#'(lambda (object)

(foreign-funcall-pointer

(get-callback 'smoke::destructed)

() :pointer (smoke:pointer object))))))

+(defvar *toplevel-objects* nil)

+

(defun ensure-smoke-parent (object)

(declare (optimize (speed 3)))

(let ((parent (cxx:parent object)))

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

(qt:connect (qt:get-signal parent "destroyed(QObject*)")

*destroyed-slot* qt:+direct-connection+)

(tg:cancel-finalization parent)

- (smoke::transfer-ownership-to parent (ensure-smoke-parent parent)))

+ (if (null-pointer-p (smoke:pointer (cxx:parent parent)))

+ (push parent *toplevel-objects*)

+ (smoke::transfer-ownership-to parent (ensure-smoke-parent parent))))

parent))

(defmethod initialize-instance :after ((object qt:object)