Thu Jul 23 00:21:01 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* support packages for symbols as property names.

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

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

@@ -17,61 +17,61 @@

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

(boundp '*app*))

-(let ((argv (null-pointer))

- (argc (null-pointer)))

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

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

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

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

-

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

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

- (let ((app (make-instance 'qt:application :args (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

- (trivial-garbage: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*)))

+ (values (qt:app) nil))

+ (progn

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

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