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

(defvar *widgets* nil)

(defmethod cl-smoke.qt.core: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))
  ;; QPaintDevices are only valid when a application object exists.
  (loop for object being the hash-values of smoke::*object-map* do
       (when (typep object 'qt:paint-device)
         (delete-object object)))
  ;; Finalize other stuff before deleting the QApplication,
  ;; e.g. QGraphicsScene
  (tg:gc :full t)
  (call-next-method)
  (setf *widgets* nil))

(defmacro qt:with-app (options &body body)
  "Ensures that a APPLICATION instance exists, 
evaluates BODY and executes the APPLICATION instance after BODY.
The instance can be accessed with:
QT:APP.

Can be nested.

When a APPLICATION was created, it will be deleted when returning
from BODY."
  (assert (null options)
          (options)
          "Currently no options can be passed to QT:WITH-APP.")
  `(cl-smoke.qt.core:with-application ((cl-smoke.qt.core:ensure-app 'qt:application)
                                        (cl-smoke.qt.core: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
instance."
  (if qt:*exec-p*
      (restart-bind ((qt::abort-app #'(lambda ()
                                        (cxx:quit (qt:app))
                                        (invoke-restart (find-restart 'continue)))
                       :report-function
                       #'(lambda (stream)
                           (format stream "Return from the application event loop."))
                       :test-function
                       #'(lambda (condition)
                           (declare (ignore condition))
                           (and (qt:app-p)
                                (find-restart 'continue)))))
        (let ((qt:*exec-p* nil))
          (cxx:exec (qt:app))))
      (when (typep (qt:app) 'qt:application)
        (setf *widgets* (qt:application.top-level-widgets)))))