Sun Jun 21 11:29:25 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* *SMOKE-MODULE* must be passed instead of *QT-SMOKE*.

--- old-qt.gui/src/application.lisp 2014-10-30 07:00:54.000000000 +0100

+++ new-qt.gui/src/application.lisp 2014-10-30 07:00:54.000000000 +0100

@@ -4,7 +4,7 @@

(defvar *app*)

(defvar *widgets* nil)

-(defvar *exec-p* t

+(defvar qt:*exec-p* t

"Run exec if true and not otherwise.")

(defun qt:app ()

@@ -105,7 +105,7 @@

(defun qt:exec (&rest widgets)

"Executes APP."

(setf *widgets* (append widgets *widgets*))

- (when *exec-p*

+ (when qt:*exec-p*

(restart-bind ((qt::abort-app #'(lambda ()

(cxx:quit (qt:app))

(invoke-restart (find-restart 'continue)))

--- old-qt.gui/src/list.lisp 2014-10-30 07:00:54.000000000 +0100

+++ new-qt.gui/src/list.lisp 2014-10-30 07:00:54.000000000 +0100

@@ -45,7 +45,7 @@

(,(symbolicate 'qt-smoke-list-

type '-at)

list index)

- (smoke::make-smoke-type *qt-smoke* ,type-name)))))))

+ (smoke::make-smoke-type *smoke-module* ,type-name)))))))

(defmethod free-translated-object (pointer (type ,list-type) param)

(declare (ignore param))

(,(symbolicate 'qt-smoke-free-list- type)

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

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

@@ -55,15 +55,16 @@

(meta-object-slots (cxx:static-meta-object class) :all all))

(defun parent-p (object)

- (not (null-pointer-p (smoke::pointer-call (smoke::make-smoke-method (find-class 'qt:object)

+ (not (null-pointer-p (smoke::pointer-call (smoke::make-smoke-method-from-name (find-class 'qt:object)

"parent")

(smoke::pointer object)))))

(defun find-smoke-parent (object)

"Returns the first parent of OBJECT or OBJECT that is a Smoke class.

-(the destructed callback is called when the object is freed.)"

+ (the destructed callback is called when the object is freed.)"

;; FIXME allow usage of non smoke objects by connecting to the

;; destroyed() signal.

+ (declare (optimize (speed 3)))

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

(if (not (null-pointer-p (smoke::pointer parent)))

(if (smoke::has-pointer-p (smoke::pointer parent))

@@ -75,6 +76,7 @@

&key (pointer nil pointer-p) &allow-other-keys)

"Registers the object to the parent when a parent was set in the constructor

and the objects metaclass is SMOKE-WRAPPER-CLASS."

+ (declare (optimize (speed 3)))

(when (and (not pointer-p)

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

(error "Object ~A has not been constructed" object))

@@ -96,46 +98,40 @@

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

(defparameter *get-parent*

- (smoke::make-smoke-method (smoke::make-smoke-class

- *qt-smoke*

- "QObject")

- "parent"))

+ (smoke::make-smoke-method-from-name (find-class 'qt:object) "parent"))

;; FIXME this leaks memory when QCoreApplication::exec is never called,

;; beause then, deleteLater has no effect.

(defparameter *delete-later*

- (smoke::make-smoke-method (smoke::make-smoke-class

- *qt-smoke*

- "QObject")

- "deleteLater")))

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

- (with-output-to-string (stream)

- (print-object object stream)))

+ (smoke::make-smoke-method-from-name (find-class 'qt:object) "deleteLater")))

(defmethod smoke::make-finalize ((object qt:object))

- "Delete the qt:object OBJECT,

+ "Delete the qt:object OBJECT,

by calling cxx:delete-later iff it has no parent."

- (let ((pointer (pointer object))

- (class (class-of object))

- (next (call-next-method)))

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

- #'(lambda ()

- (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 class)

- :pointer pointer)))

- (error (condition)

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

- (name class) pointer))))

- #'(lambda ()

- (handler-case

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

+ (let ((pointer (pointer object))

+ (class (class-of object))

+ (next (call-next-method)))

+ (declare (function next))

+ (if (typep (class-of object) 'cxx:class)

+ #'(lambda ()

+ (declare (optimize (speed 3)))

+ (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 class)

+ :pointer pointer)))

+ (error (condition)

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

+ (name class) pointer))))

+ #'(lambda ()

+ (declare (optimize (speed 3)))

+ (handler-case

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

(funcall next)

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

- (error (condition)

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

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

+ (error (condition)

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

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

;;;

@@ -188,7 +184,7 @@

(defun register-event-notify ()

(let ((ret (qt-smoke-register-event-notify (cffi:callback event-notify))))

(unless ret

- (error "The event-notify callback table is full."))))

+ (error "The Qt event-notify callback table is full."))))

(smoke:eval-startup ()

(register-event-notify))

--- old-qt.gui/src/qstring.lisp 2014-10-30 07:00:54.000000000 +0100

+++ new-qt.gui/src/qstring.lisp 2014-10-30 07:00:54.000000000 +0100

@@ -38,7 +38,7 @@

(make-instance 'qstring))

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

-(let ((method (smoke::make-smoke-method (find-class 'qt:byte-array)

+ (let ((method (smoke::make-smoke-method-from-name (find-class 'qt:byte-array)

"data")))

(defmethod cxx:data ((array qt:byte-array))

(values ;; Discarge second return value (length of string)

--- old-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:00:54.000000000 +0100

+++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:00:54.000000000 +0100

@@ -40,11 +40,12 @@

(defmethod qt:connect ((sender qsignal) (function function) &optional type)

(let ((slot (make-instance 'qslot

:args (list (signal-object sender))

+ :argument-types (argument-types (signal-object sender))

:slot-function function)))

(unless (connect-id (signal-object sender) (id (signal-object sender))

slot (id slot)

type

- (types (arguments sender)))

+ (types (argument-types (signal-object sender))))

(cerror "Failed to connect the function ~S to the signal ~S."

function sender))))

--- old-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:00:54.000000000 +0100

+++ new-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:00:54.000000000 +0100

@@ -1,7 +1,7 @@

(in-package :cl-smoke.qt-impl)

(defun find-type (name &optional start end)

- (smoke::make-smoke-type *qt-smoke* (subseq name start end)))

+ (smoke::make-smoke-type *smoke-module* (subseq name start end)))

(defun method-arguments-type (metaobject index)

"Returns a type name list for the arguments of method INDEX of METAOBJECT."

@@ -86,7 +86,7 @@

(smoke::smoke-standard-object

(if (smoke::pointer-p smoke-type)

(error "FOO");;qmetatype.+voidstar+

- (let ((type (meta-type.type (smoke::name smoke-type))))

+ (let ((type (qt:meta-type.type (smoke::name smoke-type))))

(assert (/= 0 type)

(type)

"The type ~S has no QMetaType."