Thu Jun 11 16:59:48 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* :qt and :qt-impl packages to prevent collision with :cl symbols and fix object with non smoke parent.

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

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

@@ -1,4 +1,4 @@

-(in-package :qt)

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

(declaim (optimize (debug 3)))

@@ -7,15 +7,15 @@

(defvar *exec-p* t

"Run exec if true and not otherwise.")

-(defun app ()

+(defun qt:app ()

"Returns the APPLICATION (or CORE-APPLICATION) object,

within a WITH-APP."

- (assert (app-p)

+ (assert (qt:app-p)

(*app*)

"No application.")

*app*)

-(defun app-p ()

+(defun qt:app-p ()

"Returns t when the APPLICATION object exists and nil otherwise."

(boundp '*app*))

@@ -24,7 +24,7 @@

(argc (null-pointer)))

(declare (cffi:foreign-pointer argv argc))

(defun ensure-app (&optional

- (application 'application)

+ (application 'qt:application)

(args #+sbcl sb-ext:*posix-argv*

#+ccl ccl:*command-line-argument-list*

#-(or sbcl ccl) (list (lisp-implementation-type))))

@@ -36,17 +36,19 @@

(assert (not (null args))

(args)

"No program name supplied.")

- (if (app-p)

+ (if (qt:app-p)

(progn

- (assert (typep (app) (find-class application))

+ (assert (typep (qt:app) (find-class application))

(application)

"The existing application object ~A is

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

- (values (app) nil))

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

+ (values (qt:app) nil))

(progn

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

- ()

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

+ (when (not (null-pointer-p (smoke::pointer

+ (qt:core-application.instance))))

+ (cerror "Delete the active application." "Active application not created by QT:WITH-APP.")

+ (smoke::delete-pointer (smoke::pointer (qt:core-application.instance))

+ (find-class 'qt:core-application)))

(foreign-free argv)

(foreign-free argc)

@@ -56,22 +58,22 @@

(tg:cancel-finalization app)

(values app t)))))

(defun kill-app ()

- (when (typep (app) 'application)

- (application.close-all-windows)

+ (when (typep (qt:app) 'qt:application)

+ (qt: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

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

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

- (cxx:quit (app))

+ (cxx:quit (qt:app))

(setf *widgets* nil)

;; 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))

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

+ (setf (slot-value (qt:app) 'pointer) (null-pointer))

(makunbound '*app*)))

(defmacro with-application ((ensure-app remove-app) &body body)

@@ -82,7 +84,7 @@

(when ,cleanup-p

,remove-app)))))

-(defmacro with-app (&body body)

+(defmacro qt:with-app (&body body)

"Ensures that a APPLICATION instance exists,

evaluates BODY and executes the APPLICATION instance after BODY.

The instance can be accessed with:

@@ -92,20 +94,20 @@

When a APPLICATION was created, it will be deleted when returning

from BODY."

- `(with-application ((ensure-app 'application) (kill-app))

+ `(with-application ((cl-smoke.qt-impl::ensure-app 'qt:application) (kill-app))

,@body))

-(defmacro with-core-app (&body body)

- `(with-application ((ensure-app 'core-application) (kill-app))

+(defmacro qt:with-core-app (&body body)

+ `(with-application ((cl-smoke.qt-impl::ensure-app 'qt:core-application) (kill-app))

,@body))

-(defun exec (&rest widgets)

+(defun qt:exec (&rest widgets)

"Executes APP."

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

(when *exec-p*

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

- (cxx:quit (app))

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

+ (cxx:quit (qt:app))

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

:report-function

#'(lambda (stream)

@@ -113,6 +115,6 @@

:test-function

#'(lambda (condition)

(declare (ignore condition))

- (and (app-p)

+ (and (qt:app-p)

(find-restart 'continue)))))

- (cxx:exec (app)))))

+ (cxx:exec (qt:app)))))