Wed Jul 1 12:58:06 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Break API compatibility for qt:with-app and qt:exec & spellcheck

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

+++ new-qt.gui/src/application.lisp 2014-10-30 07:00:53.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)))))

--- old-qt.gui/src/lisp-object.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/lisp-object.lisp 2014-10-30 07:00:53.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)

--- old-qt.gui/src/list.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/list.lisp 2014-10-30 07:00:53.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")

--- old-qt.gui/src/object.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/object.lisp 2014-10-30 07:00:53.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)

--- old-qt.gui/src/ownership.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/ownership.lisp 2014-10-30 07:00:53.000000000 +0100

@@ -74,6 +74,6 @@

;; QListwidgetitem

-;; Relases ownership

+;; Releases ownership

;;QList<QStandardItem *> QStandardItemModel::takeColumn ( int column )

;; etc

--- old-qt.gui/src/package.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/package.lisp 2014-10-30 07:00:53.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

--- old-qt.gui/src/painter.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/painter.lisp 2014-10-30 07:00:53.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)

--- old-qt.gui/src/qstring.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/qstring.lisp 2014-10-30 07:00:53.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))))))

--- old-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:00:53.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))

--- old-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:00:53.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)

--- old-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:00:53.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)

--- old-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:00:53.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)

--- old-qt.gui/src/timer.lisp 2014-10-30 07:00:53.000000000 +0100

+++ new-qt.gui/src/timer.lisp 2014-10-30 07:00:53.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*))