Thu Jun 4 00:02:12 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Fix QT:APPLICATION cleanup in QT:WITH-APP and add restart to slot invocation.

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

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

@@ -44,23 +44,33 @@

not of type ~A." (app) (find-class application))

(values (app) nil))

(progn

- ;(assert (null-pointer-p (smoke::pointer (core-application.instance))))

+ (assert (null-pointer-p (smoke::pointer (core-application.instance)))

+ ()

+ "Active QCoreApplication not created by QT:WITH-APP.")

(foreign-free argv)

(foreign-free argc)

(setf argv (foreign-alloc :string :initial-contents args))

(setf argc (foreign-alloc :int :initial-element (length args)))

- (values (make-instance 'qt:application :args (list argc argv)) t))))

+ (let ((app (make-instance 'qt:application :args (list argc argv))))

+ (tg:cancel-finalization app)

+ (values app t)))))

(defun kill-app ()

+ (when (typep (app) 'application)

+ (application.close-all-windows)

+ ;; widgets are only valid as long, as an application object exists.

+ ;; QApplication::~QApplication() deletes all widgets in

+ ;; QApplication::allWidgets().

+ ;;

+ ;; see: qt4/src/gui/kernel/qapplication.cpp

+ (loop for widget across (application.all-widgets) do

+ (trivial-garbage:cancel-finalization widget)))

(cxx:quit (app))

- (when (typep (app) (find-class 'qt:application))

- (application.close-all-windows))

(setf *widgets* nil)

- (trivial-garbage:cancel-finalization (app))

- (smoke::remove-object (smoke::pointer (app)))

- ;; FIXME leak memory or memory fault!

- ;(smoke::delete-pointer (smoke::pointer (app)) (class-of (app)))

- (cxx:delete-later (app))

+ ;; Call the destructer; -> destructed callback is called,

+ ;; (~QApplication() is virtual) which takes care of cleanup

+ ;; on the Lisp side.

+ (smoke::delete-pointer (smoke::pointer (app)) (class-of (app)))

(setf (slot-value (app) 'pointer) (null-pointer))

(makunbound '*app*)))

@@ -95,7 +105,6 @@

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

(when *exec-p*

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

- (application.close-all-windows)

(cxx:quit (app))

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

:report-function

@@ -104,5 +113,6 @@

:test-function

#'(lambda (condition)

(declare (ignore condition))

- (find-restart 'continue))))

+ (and (app-p)

+ (find-restart 'continue)))))

(cxx:exec (app)))))

--- old-qt.gui/src/operator.lisp 2014-10-30 07:01:04.000000000 +0100

+++ new-qt.gui/src/operator.lisp 2014-10-30 07:01:04.000000000 +0100

@@ -74,9 +74,6 @@

(defun cxx:aref (object index)

"Returns the element of OBJECT at position INDEX."

- ;;FIXME smoke does not support casting operators => can not

- ;; return a useful value with operator[]."

- ;;(cxx:operator[] object index))

(declare ((integer 0) index))

(assert (< index (cxx:size object))

(index)

@@ -91,6 +88,13 @@

(index)

"Index ~A for ~A requested, but the length is ~A"

index object (cxx:size object))

+ ;; FIXME smoke generates no destructor for QByteRef

+ ;; kaylptusCxxToSmoke.pm 954:

+ ;; # Also, if the class has no explicit destructor, generate a default one.

+ ;; if ( !$hasDestructor && !$hasPrivatePureVirtual && !$isGlobalSpace && $classNode->{NodeType} ne 'namespace' ) {

+ ;; > $hasPublicDestructor = 1;

+ ;; > $hasPublicProtectedConstructor = 1;

+ ;;

(cxx:operator= (cxx:operator[] object index)

new-value)

new-value)

--- old-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:01:04.000000000 +0100

+++ new-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:01:04.000000000 +0100

@@ -35,10 +35,13 @@

id

(if (enum= call meta-object.+invoke-meta-method+)

(progn

- (case id

+ (ccase id

(0 (let ((*sender* (cxx:sender slot)))

- (apply (slot-function slot)

- (arguments-to-lisp arguments (arguments slot))))))

+ (with-simple-restart

+ (continue "Skip the function ~A of slot ~A."

+ (slot-function slot) slot)

+ (apply (slot-function slot)

+ (arguments-to-lisp arguments (arguments slot)))))))

(1- id))

id))))