Sun Jun 21 11:29:25 CEST 2009 Tobias Rautenkranz * *SMOKE-MODULE* must be passed instead of *QT-SMOKE*. diff -rN -u old-qt.gui/src/application.lisp new-qt.gui/src/application.lisp --- old-qt.gui/src/application.lisp 2014-10-30 07:46:26.000000000 +0100 +++ new-qt.gui/src/application.lisp 2014-10-30 07:46:26.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))) diff -rN -u old-qt.gui/src/list.lisp new-qt.gui/src/list.lisp --- old-qt.gui/src/list.lisp 2014-10-30 07:46:26.000000000 +0100 +++ new-qt.gui/src/list.lisp 2014-10-30 07:46:26.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) 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:46:26.000000000 +0100 +++ new-qt.gui/src/object.lisp 2014-10-30 07:46:26.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)) diff -rN -u old-qt.gui/src/qstring.lisp new-qt.gui/src/qstring.lisp --- old-qt.gui/src/qstring.lisp 2014-10-30 07:46:26.000000000 +0100 +++ new-qt.gui/src/qstring.lisp 2014-10-30 07:46:26.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) diff -rN -u old-qt.gui/src/signal-slot/connect.lisp new-qt.gui/src/signal-slot/connect.lisp --- old-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:46:26.000000000 +0100 +++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:46:26.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)))) diff -rN -u old-qt.gui/src/signal-slot/translate.lisp new-qt.gui/src/signal-slot/translate.lisp --- old-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:46:26.000000000 +0100 +++ new-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:46:26.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."