Sun Mar 13 20:40:35 CET 2011 Tobias Rautenkranz * Fix loading on OSX. Thanks to Elliott Slaughter Sat Apr 3 14:34:21 CEST 2010 Tobias Rautenkranz * Account for possible lisp-object metatype id change when loading an image. Sat Feb 20 22:04:46 CET 2010 Tobias Rautenkranz * cleanup Sat Feb 20 22:02:38 CET 2010 Tobias Rautenkranz * Make qt:application cleanup more stable Sat Feb 20 22:00:30 CET 2010 Tobias Rautenkranz * support all from qt:variant conversions. Mon Feb 15 16:33:05 CET 2010 Tobias Rautenkranz * Build a shared library not a module. Fixes a build error on OS X. Thu Feb 4 16:06:38 CET 2010 Tobias Rautenkranz * Test building libclsmokeqtcore Thu Feb 4 10:22:53 CET 2010 Tobias Rautenkranz * Add qvector.cpp Sat Jan 30 16:40:15 CET 2010 Tobias Rautenkranz * Get the QList size using Lisp instead of an external C function. Tue Jan 26 17:19:51 CET 2010 Tobias Rautenkranz * Fix define-qlist-wrapper usage for other modules. (i.e. qt.gui) Mon Jan 25 20:07:22 CET 2010 Tobias Rautenkranz * Export delete-app since other modules (qt.gui) might like to add methods to it. diff -rN -u old-qt.core/src/application.lisp new-qt.core/src/application.lisp --- old-qt.core/src/application.lisp 2014-11-24 14:11:40.000000000 +0100 +++ new-qt.core/src/application.lisp 2014-11-24 14:11:40.000000000 +0100 @@ -57,12 +57,12 @@ (defgeneric delete-app (application) (:method (application) - (cxx:quit application) - ;; Call the destructor; -> destructed callback is called, - ;; (~QApplication() is virtual) which takes care of cleanup on the - ;; Lisp side. - (smoke::delete-pointer (smoke:pointer application) (class-of application)) - (setf (slot-value application 'pointer) (null-pointer)) + (unless (null-pointer-p (smoke:pointer application)) + (cxx:quit application) + ;; Call the destructor; -> destructed callback is called, + ;; (~QApplication() is virtual) which takes care of cleanup on the + ;; Lisp side. + (smoke::delete-pointer (smoke:pointer application) (class-of application))) (makunbound '*app*))) (defun kill-app () diff -rN -u old-qt.core/src/lib/CMakeLists.txt new-qt.core/src/lib/CMakeLists.txt --- old-qt.core/src/lib/CMakeLists.txt 2014-11-24 14:11:40.000000000 +0100 +++ new-qt.core/src/lib/CMakeLists.txt 2014-11-24 14:11:40.000000000 +0100 @@ -11,7 +11,7 @@ set(QT_SMOKE_SOURCES qt_smoke.cpp qstring.cpp qstringlist.cpp lisp_object.cpp qlist.cpp qvector.cpp) -add_library(clsmokeqtcore MODULE ${QT_SMOKE_SOURCES}) +add_library(clsmokeqtcore SHARED ${QT_SMOKE_SOURCES}) target_link_libraries(clsmokeqtcore ${QT_LIBRARIES}) set_target_properties(clsmokeqtcore PROPERTIES diff -rN -u old-qt.core/src/lib/qlist.h new-qt.core/src/lib/qlist.h --- old-qt.core/src/lib/qlist.h 2014-11-24 14:11:40.000000000 +0100 +++ new-qt.core/src/lib/qlist.h 2014-11-24 14:11:40.000000000 +0100 @@ -32,12 +32,6 @@ /** @internal * size, free and make_list. */ #define DEFINE_QLIST_WRAPPER_ALL_PART(NAME, TYPE) \ -CL_SMOKE_QT_EXPORT int \ -cl_smoke_list_ ## NAME ## _size(const void* list) \ -{ \ - return static_cast*>(list)->size(); \ -} \ -\ CL_SMOKE_QT_EXPORT void \ cl_smoke_free_list_ ## NAME (void* list) \ { \ diff -rN -u old-qt.core/src/lib/qvector.cpp new-qt.core/src/lib/qvector.cpp --- old-qt.core/src/lib/qvector.cpp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.core/src/lib/qvector.cpp 2014-11-24 14:11:40.000000000 +0100 @@ -0,0 +1,27 @@ +#include "cl_smoke_qt.h" + +#include +#include + +extern "C" { + +/** Construct a 0 sized QVector. + * Since the QVectorData is QVectorData::shared_null the template type does not matter. + * @return A null QVector + */ +CL_SMOKE_QT_EXPORT void* +cl_smoke_make_qvector() +{ + return new QVector(); +} + +/** Deletes a null QVector. i.e.: The QVectorData pointer is 0. + * @param qvector a null QVector + */ +CL_SMOKE_QT_EXPORT void +cl_smoke_delete_qvector(void* qvector) +{ + delete static_cast*>(qvector); +} + +} // extern "C" diff -rN -u old-qt.core/src/list.lisp new-qt.core/src/list.lisp --- old-qt.core/src/list.lisp 2014-11-24 14:11:40.000000000 +0100 +++ new-qt.core/src/list.lisp 2014-11-24 14:11:40.000000000 +0100 @@ -1,6 +1,25 @@ (in-package :cl-smoke.qt.core) -(eval-when (:compile-toplevel :execute) +(defbitfield qlist-data-flags + :sharable) + +(defcstruct qlist-data + (ref :char :count #.(class-size (find-class 'qt:basic-atomic-int))) + (alloc :int) + (begin :int) + (end :int) + (flags qlist-data-flags) + (array :pointer)) + +(defcstruct qlist + (data (:pointer qlist-data))) + +(defun qlist-size (qlist) + (let ((data (foreign-slot-value qlist 'qlist 'data))) + (- (foreign-slot-value data 'qlist-data 'end) + (foreign-slot-value data 'qlist-data 'begin)))) + +(eval-when (:compile-toplevel :load-toplevel :execute) (macrolet ((c-name (name) `(nth-value 1 ,name)) (fun-names-let (name-pre-post-fixes &body body) @@ -22,8 +41,7 @@ ,(third npp)))))) name-pre-post-fixes)) ,@body))) - (fun-names-let ((list-size "cl-smoke-list-" "-size") - (list-free "cl-smoke-free-list-") + (fun-names-let ((list-free "cl-smoke-free-list-") (list-make "cl-smoke-make-list-") (list-at "cl-smoke-list-" "-at") (list-append "cl-smoke-list-" "-append")) @@ -35,9 +53,6 @@ `(progn ,(when (or (not c-name-p) def-cfuns) `(progn - (defcfun ,(c-name (list-size type)) :int - "Returns the size of LIST." - (list :pointer)) (defcfun ,(c-name (list-free type)) :void "Frees LIST." (list :pointer)) @@ -55,17 +70,18 @@ ;; To Lisp ,@(loop for type-name in (ensure-list type-name) collect `(defun ,(symbolicate 'from-list- type-name) (list-pointer) - (let ((vector (make-array (,(list-size type) - list-pointer)))) + (declare (optimize (speed 3))) + (let ((vector (make-array (qlist-size + list-pointer)))) (dotimes (index (length vector) vector) (setf (elt vector index) ;; FIXME the returned object is not wrapped by Smoke ;; -> change this? - (smoke:object-to-lisp + (object-to-lisp (,(list-at type) list-pointer index) - (smoke:make-smoke-type ,(symbolicate '*smoke-module*) - ,type-name))))))) + (make-smoke-type ,(symbolicate '*smoke-module*) + ,type-name))))))) ,@(loop for type-name in (ensure-list type-name) collect `(define-to-lisp-translation (,(format nil "const QList<~A>&" type-name) diff -rN -u old-qt.core/src/package.lisp new-qt.core/src/package.lisp --- old-qt.core/src/package.lisp 2014-11-24 14:11:40.000000000 +0100 +++ new-qt.core/src/package.lisp 2014-11-24 14:11:40.000000000 +0100 @@ -2,6 +2,7 @@ (:use :cl :smoke :cffi :bordeaux-threads :cxx-support :alexandria) (:export #:define-qvector-translations #:with-application + #:delete-app #:ensure-app #:kill-app)) diff -rN -u old-qt.core/src/qt.core.lisp new-qt.core/src/qt.core.lisp --- old-qt.core/src/qt.core.lisp 2014-11-24 14:11:40.000000000 +0100 +++ new-qt.core/src/qt.core.lisp 2014-11-24 14:11:40.000000000 +0100 @@ -33,6 +33,7 @@ (init-qt-smoke "init_qtcore_Smoke")) (define-foreign-library libclsmokeqtcore - (:unix "libclsmokeqtcore.so") + (:darwin "libclsmokeqtcore.dylib") + (:unix "libclsmokeqtcore.so") (t (:default "libclsmokeqtcore"))) (use-foreign-library libclsmokeqtcore)) diff -rN -u old-qt.core/src/variant.lisp new-qt.core/src/variant.lisp --- old-qt.core/src/variant.lisp 2014-11-24 14:11:40.000000000 +0100 +++ new-qt.core/src/variant.lisp 2014-11-24 14:11:40.000000000 +0100 @@ -73,41 +73,62 @@ "Returns true when VARIANT is valid (has a value) and false otherwise." (cxx:is-valid variant)) -(defmacro variant-conversions ((variant) &body types) - `(ecase (cxx:user-type ,variant) - - ,@(loop for type in types collect - (if (symbolp type) - `(,(value (symbol-value - (let ((*package* (find-package :cl-smoke.qt))) - (alexandria:symbolicate 'variant.+ type '+)))) - (,(intern (format nil "TO-~A" type) :cxx) ,variant)) - type)))) +(defun copy-object-from-pointer (class pointer) + (make-instance class :arg0 (make-instance class :pointer pointer))) -(defun qt:from-variant (variant) - "Returns the value of VARIANT." - (variant-conversions (variant) - (#.(value qt:variant.+invalid+) - (cerror "Return (VALUES)" "Type of variant ~A is invalid." variant) - (values)) - bit-array bool byte-array - char - date date-time double - int - line line-f list locale long-long - point point-f - rect rect-f reg-exp - size size-f string string-list - time - uint - ulong-long - url - (#.*cxx-lisp-object-metatype* - (let* ((lisp-object (cl-smoke-lisp-object-value (pointer variant))) - (value)) - (setf value (translate-cxx-lisp-object lisp-object)) - (free-cxx-lisp-object lisp-object) - value)))) +(eval-startup () +;; *cxx-lisp-object-metatype* can change when loading an image +(eval ' + (macrolet + ((variant-conversions ((variant) &body types) + (let* ((special-types '(long-long ulong-long map list hash)) + (exclude-types + (append '(63) ;; ColorGroup + (mapcar #'(lambda (s) + (value + (symbol-value + (intern (format nil "VARIANT.+~A+" s) + :qt)))) + special-types))) + (qt-types (loop for i from 1 to (value qt:variant.+user-type+) + when (and (qt:variant.type-to-name i) + ;; type-to-name returns longlong but + ;; should be LongLong + (not (member i exclude-types))) + collect + (smoke::lispify (qt:variant.type-to-name i) + :qt)))) + `(ecase (cxx:user-type ,variant) + ,@(loop for type in (append special-types + (remove nil qt-types)) + collect + `(,(value (symbol-value + (let ((*package* + (find-package :cl-smoke.qt))) + (symbolicate 'variant.+ type '+)))) + ,(if (fboundp (intern (format nil "TO-~A" type) :cxx)) + `(,(intern (format nil "TO-~A" type) :cxx) ,variant) + `(copy-object-from-pointer + ;; intern since these types are in + ;; qt.gui not qt.core + (intern ,(symbol-name type) :qt) + (cxx:const-data ,variant))))) + ,@(loop for type in types + collect + `(,(eval (first type)) + ,@(rest type))))))) + (defun qt:from-variant (variant) + "Returns the value of VARIANT." + (variant-conversions (variant) + ((value qt:variant.+invalid+) + (cerror "Return (VALUES)" "Type of variant ~A is invalid." variant) + (values)) + (*cxx-lisp-object-metatype* + (let* ((lisp-object (cl-smoke-lisp-object-value (pointer variant))) + (value)) + (setf value (translate-cxx-lisp-object lisp-object)) + (free-cxx-lisp-object lisp-object) + value))))))) (defmethod qt:value ((variant qt:variant)) "Returns the value of VARIANT." diff -rN -u old-qt.core/src/vector.lisp new-qt.core/src/vector.lisp --- old-qt.core/src/vector.lisp 2014-11-24 14:11:40.000000000 +0100 +++ new-qt.core/src/vector.lisp 2014-11-24 14:11:40.000000000 +0100 @@ -93,16 +93,6 @@ (null-pointer))) (cl-smoke-delete-qvector vector)) -(defun from-vector-point (elements) - (make-cleanup-pointer - (make-qvector (make-smoke-type *smoke-module* "QPoint") - elements) - #'free-qvector)) - -(defun vector-point-p (sequence) - (every #'(lambda (element) (typep element 'qt:point)) - sequence)) - (defmacro define-qvector-translations (element-type lisp-type) `(progn (defun ,(symbolicate 'from-vector- element-type) (elements) diff -rN -u old-qt.core/test.lisp new-qt.core/test.lisp --- old-qt.core/test.lisp 2014-11-24 14:11:40.000000000 +0100 +++ new-qt.core/test.lisp 2014-11-24 14:11:40.000000000 +0100 @@ -1,4 +1,11 @@ #| +v v v v v v v +cmake ./ +make +************* +cmake ./ || exit 1 +make || exit 1 +^ ^ ^ ^ ^ ^ ^ exec -a "$0" sbcl --noinform --noprint --disable-debugger --load $0 --end-toplevel-options "$@" # Used for testing on darcs record. |#