Sun Jan 10 09:52:49 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Split up in qt.gui & cleanup name prefix.

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

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

@@ -1,87 +1,18 @@

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

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

-(defvar *app*)

(defvar *widgets* nil)

-(defvar qt:*exec-p* t

- "Run exec if true and not otherwise.")

-(defun qt:app ()

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

-within a WITH-APP."

- (assert (qt:app-p)

- (*app*)

- "No application.")

- *app*)

-

-(defun qt:app-p ()

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

- (boundp '*app*))

-

-(defun ensure-app (&optional

- (application 'qt:application)

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

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

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

- "Constructs the global application object, when there is none,

-with the command line arguments ARGS.

-

-Returns the application object a first value and

-true when a new application was created and false otherwise."

- (assert (not (null args))

- (args)

- "No program name supplied.")

- (if (qt:app-p)

- (progn

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

- (application)

- "The existing application object ~A is

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

- (values (qt:app) nil))

- (progn

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

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

- (cerror (format nil "Delete the active application ~A."

- (qt:core-application.instance))

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

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

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

- (let* ((argc (smoke:make-auto-pointer

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

- (argv (smoke:make-auto-pointer

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

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

- ;; argc and argv must remain valid during the lifetime of APP.

- (setf (qt:property app 'cmdline-args)

- (qt:make-lisp-variant (list argc argv)))

- (tg:cancel-finalization app)

- (values app t)))))

-

-(defun kill-app ()

- (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 (qt:application.all-widgets) do

- (tg:cancel-finalization widget)))

- (cxx:quit (qt:app))

- (setf *widgets* nil)

- ;; Call the destructor; -> destructed callback is called,

- ;; (~QApplication() is virtual) which takes care of cleanup on the

- ;; Lisp side.

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

- (let ((cleanup-p (gensym)))

- `(multiple-value-bind (*app* ,cleanup-p) ,ensure-app

- (unwind-protect

- (progn ,@body)

- (when ,cleanup-p

- ,remove-app)))))

+(defmethod delete-app :around ((application 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 (qt:application.all-widgets) do

+ (tg:cancel-finalization widget))

+ (call-next-method)

+ (setf *widgets* nil))

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

"Ensures that a APPLICATION instance exists,

@@ -96,16 +27,10 @@

(assert (null options)

(options)

"Currently no options can be passed to QT:WITH-APP.")

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

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

+ (cl-smoke.qt.core::kill-app))

,@body))

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

- (assert (null options)

- (options)

- "Currently no options can be passed to QT:WITH-CORE-APP.")

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

- ,@body))

-

(defun qt:exec ()

"Executes APP. When QT:*EXEC-P* is false it returns immediately

and transfers the ownership of the top-level widgets to the qt:application