/test.lisp
Ignoring non-repository paths: /test.lisp
Sun Mar 13 20:40:35 CET 2011 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Fix loading on OSX.
Thanks to Elliott Slaughter
Sat Apr 3 14:34:21 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Account for possible lisp-object metatype id change when loading an image.
Sat Feb 20 22:04:46 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* cleanup
Sat Feb 20 22:02:38 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Make qt:application cleanup more stable
Sat Feb 20 22:00:30 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* support all from qt:variant conversions.
Mon Feb 15 16:33:05 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Build a shared library not a module.
Fixes a build error on OS X.
Thu Feb 4 16:06:38 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test building libclsmokeqtcore
diff -rN -u old-qt.core/src/application.lisp new-qt.core/src/application.lisp
--- old-qt.core/src/application.lisp 2014-10-30 07:35:11.000000000 +0100
+++ new-qt.core/src/application.lisp 2014-10-30 07:35:11.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-10-30 07:35:11.000000000 +0100
+++ new-qt.core/src/lib/CMakeLists.txt 2014-10-30 07:35:11.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/list.lisp new-qt.core/src/list.lisp
--- old-qt.core/src/list.lisp 2014-10-30 07:35:11.000000000 +0100
+++ new-qt.core/src/list.lisp 2014-10-30 07:35:11.000000000 +0100
@@ -72,16 +72,16 @@
`(defun ,(symbolicate 'from-list- type-name) (list-pointer)
(declare (optimize (speed 3)))
(let ((vector (make-array (qlist-size
- list-pointer))))
+ 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/qt.core.lisp new-qt.core/src/qt.core.lisp
--- old-qt.core/src/qt.core.lisp 2014-10-30 07:35:11.000000000 +0100
+++ new-qt.core/src/qt.core.lisp 2014-10-30 07:35:11.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-10-30 07:35:11.000000000 +0100
+++ new-qt.core/src/variant.lisp 2014-10-30 07:35:11.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-10-30 07:35:11.000000000 +0100
+++ new-qt.core/src/vector.lisp 2014-10-30 07:35:11.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-10-30 07:35:11.000000000 +0100
+++ new-qt.core/test.lisp 2014-10-30 07:35:11.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.
|#