Wed Jul 1 12:58:06 CEST 2009 Tobias Rautenkranz * Break API compatibility for qt:with-app and qt:exec & spellcheck diff -rN -u old-qt.gui/src/application.lisp new-qt.gui/src/application.lisp --- old-qt.gui/src/application.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/application.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -1,7 +1,5 @@ (in-package :cl-smoke.qt-impl) -(declaim (optimize (debug 3))) - (defvar *app*) (defvar *widgets* nil) (defvar qt:*exec-p* t @@ -19,7 +17,6 @@ "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)) @@ -69,7 +66,7 @@ (trivial-garbage:cancel-finalization widget))) (cxx:quit (qt:app)) (setf *widgets* nil) - ;; Call the destructer; -> destructed callback is called, + ;; 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))) @@ -84,37 +81,45 @@ (when ,cleanup-p ,remove-app))))) -(defmacro qt:with-app (&body body) +(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: -APP. +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.") `(with-application ((cl-smoke.qt-impl::ensure-app 'qt:application) (kill-app)) - ,@body)) + ,@body)) -(defmacro qt:with-core-app (&body 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)) + ,@body)) - -(defun qt:exec (&rest widgets) - "Executes APP." - (setf *widgets* (append widgets *widgets*)) - (when 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))))) - (cxx:exec (qt:app))))) +(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))))) + (cxx:exec (qt:app))) + (when (typep (qt:app) 'qt:application) + (setf *widgets* (qt:application.top-level-widgets))))) diff -rN -u old-qt.gui/src/lisp-object.lisp new-qt.gui/src/lisp-object.lisp --- old-qt.gui/src/lisp-object.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/lisp-object.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -51,7 +51,7 @@ (defun translate-cxx-lisp-object (pointer) "Returns the object of the cxx-lisp-object at POINTER. -When beeing received as an argument by a slot, +When being received as an argument by a slot, the object must not be deallocated." (multiple-value-bind (value present-p) (gethash (qt-smoke-lisp-object-id pointer) diff -rN -u old-qt.gui/src/list.lisp new-qt.gui/src/list.lisp --- old-qt.gui/src/list.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/list.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -28,24 +28,24 @@ (make-instance ',list-type)) (eval-when (:load-toplevel :execute) ,@(loop for type-name in (ensure-list type-name) collect - `(smoke::add-type ,(format nil "const QList<~A>&" type-name) - ',list-type)) + `(smoke::add-type ,(format nil "const QList<~A>&" type-name) + ',list-type)) ,@(loop for type-name in (ensure-list type-name) collect - `(smoke::add-type ,(format nil "QList<~A>" type-name) ',list-type))) + `(smoke::add-type ,(format nil "QList<~A>" type-name) ',list-type))) ,@(loop for type-name in (ensure-list type-name) collect - `(defmethod translate-from-foreign (list (type ,list-type)) - (let ((vector (make-array (,(symbolicate 'qt-smoke-list- - type '-size) - list)))) - (dotimes (index (length vector) vector) - (setf (aref vector index) - ;; FIXME the retuned object is not wrapped by Smoke - ;; -> change this? - (smoke::object-to-lisp - (,(symbolicate 'qt-smoke-list- - type '-at) - list index) - (smoke::make-smoke-type *smoke-module* ,type-name))))))) + `(defmethod translate-from-foreign (list (type ,list-type)) + (let ((vector (make-array (,(symbolicate 'qt-smoke-list- + type '-size) + list)))) + (dotimes (index (length vector) vector) + (setf (aref vector index) + ;; FIXME the returned object is not wrapped by Smoke + ;; -> change this? + (smoke::object-to-lisp + (,(symbolicate 'qt-smoke-list- + type '-at) + list index) + (smoke::make-smoke-type *smoke-module* ,type-name))))))) (defmethod free-translated-object (pointer (type ,list-type) param) (declare (ignore param)) (,(symbolicate 'qt-smoke-free-list- type) @@ -59,10 +59,10 @@ qlist (function ,(symbolicate 'qt-smoke-free-list- type))))) ,@(loop for type-name in (ensure-list type-name) collect - `(define-from-lisp-translation (,(format nil "const QList<~A>&" type-name) - ,(format nil "QLIst<~A>" type-name)) - list ;; FIXME allow seqence and define element type - ,(symbolicate 'coerce- list-type)))))) + `(define-from-lisp-translation (,(format nil "const QList<~A>&" type-name) + ,(format nil "QLIst<~A>" type-name)) + list ;; FIXME allow sequence and define element type + ,(symbolicate 'coerce- list-type)))))) (define-qlist-wrapper "QVariant") (define-qlist-wrapper ("QObject*" "QWidget*") "void") diff -rN -u old-qt.gui/src/object.lisp new-qt.gui/src/object.lisp --- old-qt.gui/src/object.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/object.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -169,8 +169,8 @@ (let* ((child-event (make-instance 'qt:child-event :pointer (smoke::upcast event (find-class 'qt:child-event))))) - ;; We receive child removed events for any QObject, wherter - ;; it was construted by Smoke or not. Only take ownership of objects + ;; We receive child removed events for any QObject, whether + ;; it was constructed by Smoke or not. Only take ownership of objects ;; that have been constructed by Smoke. (when (smoke::has-pointer-p (smoke::pointer (cxx:child child-event))) (assert receiver) diff -rN -u old-qt.gui/src/ownership.lisp new-qt.gui/src/ownership.lisp --- old-qt.gui/src/ownership.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/ownership.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -74,6 +74,6 @@ ;; QListwidgetitem -;; Relases ownership +;; Releases ownership ;;QList QStandardItemModel::takeColumn ( int column ) ;; etc diff -rN -u old-qt.gui/src/package.lisp new-qt.gui/src/package.lisp --- old-qt.gui/src/package.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/package.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -2,7 +2,7 @@ (:use :cl :smoke :cffi :bordeaux-threads :cxx-support :alexandria)) (defpackage :cl-smoke.qt - (:use) ;; do not use :cl to prevent collition with TIME and CHAR + (:use) ;; do not use :cl to prevent collision with TIME and CHAR (:nicknames :qt) (:export #:app #:app-p diff -rN -u old-qt.gui/src/painter.lisp new-qt.gui/src/painter.lisp --- old-qt.gui/src/painter.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/painter.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -2,9 +2,9 @@ (defmacro qt:with-painter ((painter paint-device) &body body) "Binds a PAINTER instance for PAINT-DEVICE to PAINTER - during the evaulation of BODY. + during the evaluation of BODY. -Makes sure the painter ends after BODY; thus prevening problems with +Makes sure the painter ends after BODY; thus preventing problems with still active and not yet garbage collected painters." `(let ((,painter (make-instance 'qt:painter :args (list ,paint-device)))) (assert (cxx:is-active ,painter) diff -rN -u old-qt.gui/src/qstring.lisp new-qt.gui/src/qstring.lisp --- old-qt.gui/src/qstring.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/qstring.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -21,7 +21,7 @@ (eval-when (:load-toplevel :execute) (setup-type-map)) -;;; make sure, that you have configured slime corretly. +;;; make sure, that you have configured slime correctly. ;;; e.g. ;;; (string #\U9999) crashed slime for me. Adding ;;; (set-language-environment "UTF-8") @@ -41,7 +41,7 @@ (let ((method (smoke::make-smoke-method-from-name (find-class 'qt:byte-array) "data"))) (defmethod cxx:data ((array qt:byte-array)) - (values ;; Discarge second return value (length of string) + (values ;; Discharge second return value (length of string) (foreign-string-to-lisp (smoke::pointer-call method (smoke::pointer array)) :count (cxx:size array)))))) diff -rN -u old-qt.gui/src/signal-slot/connect.lisp new-qt.gui/src/signal-slot/connect.lisp --- old-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -127,7 +127,7 @@ ;; Set the sender as the slots parent, ;; to ensure it does not get gc'ed. ;; FIXME: unset parent on disconnect - ;; this no not critical beause the slot object + ;; this no not critical because the slot object ;; is hidden from the user, who thus can not ;; connect it to other signals. :args (list (qsender qt-signal)) diff -rN -u old-qt.gui/src/signal-slot/signal.lisp new-qt.gui/src/signal-slot/signal.lisp --- old-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -1,5 +1,4 @@ (in-package :cl-smoke.qt-impl) -(declaim (optimize (debug 3))) (defclass qsignal-mixin () ((signal-object :accessor signal-object @@ -54,8 +53,8 @@ (defun find-slot-id (receiver slot) "Returns the ID of RECEIVER from SLOT." - ;; For efficency assume that SLOT is normalized and fallback - ;; to normalzing when not. (Just like Qt does.) + ;; For efficiency assume that SLOT is normalized and fallback + ;; to normalizing when not. (Just like Qt does.) (let ((id (cxx:index-of-slot (cxx:meta-object receiver) slot))) (when (< id 0) diff -rN -u old-qt.gui/src/signal-slot/slot.lisp new-qt.gui/src/signal-slot/slot.lisp --- old-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -30,6 +30,7 @@ (defmethod cxx:qt-metacall ((slot qslot) call id arguments) "Invoke the slots function when it is called. The return value of the invoked slot function is ignored." + (declare (ignore id)) (let ((id (call-next-method))) (if (< id 0) id @@ -48,8 +49,8 @@ (defun find-signal-id (sender signal) "Returns the ID of SIGNAL from SENDER." - ;; For efficency assume that SIGNAL is normalized and fallback - ;; to normalzing when not. (Just like Qt does.) + ;; For efficiency assume that SIGNAL is normalized and fallback + ;; to normalizing when not. (Just like Qt does.) (let ((id (cxx:index-of-signal (cxx:meta-object sender) signal))) (when (< id 0) diff -rN -u old-qt.gui/src/signal-slot/translate.lisp new-qt.gui/src/signal-slot/translate.lisp --- old-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -47,7 +47,7 @@ (if (smoke::pointer-p type) (smoke::object-to-lisp (mem-ref pointer :pointer) type) ;; By value means that they are allocated by the C++ signal - ;; code and have dynamic extend in the slot. The C++ singal code + ;; code and have dynamic extend in the slot. The C++ signal code ;; frees the object when the slot returns. (disown-object (smoke::object-to-lisp pointer type))) (ecase (smoke::type-id type) diff -rN -u old-qt.gui/src/timer.lisp new-qt.gui/src/timer.lisp --- old-qt.gui/src/timer.lisp 2014-10-30 07:46:00.000000000 +0100 +++ new-qt.gui/src/timer.lisp 2014-10-30 07:46:00.000000000 +0100 @@ -25,6 +25,7 @@ `(single-shot #'(lambda () ,@body))) (defmethod cxx:timer-event ((timer single-shot-timer) event) + (declare (ignore event)) (cxx:kill-timer timer (slot-value timer 'timer-id)) (funcall (slot-value timer 'function)) (remove timer *single-shot-timers*))