Wed May 27 19:18:41 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* QList<QByteArray> and QList<QVariant> conversion & use cxx:operator== and qt:operator== in cxx:=

--- old-qt.core/qt.mbd 2014-10-30 06:59:11.000000000 +0100

+++ new-qt.core/qt.mbd 2014-10-30 06:59:11.000000000 +0100

@@ -48,6 +48,7 @@

("operator" (:needs "qt" "object"))

("application" (:needs "qt"))

("qstring" (:needs "qt"))

+ ("list" (:needs "qt"))

("msg-handler" (:needs "lib"))

("painter" (:needs "qt"))

("timer" (:needs "qt"))

@@ -66,4 +67,4 @@

("variant" (:needs "qt" "qstring" "lisp-object"))

("properties" (:needs "variant")))))

(:uses-macros-from :smoke)

- (:needs :smoke :sysdef.cmake :cffi))

+ (:needs :smoke :sysdef.cmake :cffi :alexandria))

--- old-qt.core/src/lib/qlist.cpp 2014-10-30 06:59:11.000000000 +0100

+++ new-qt.core/src/lib/qlist.cpp 2014-10-30 06:59:11.000000000 +0100

@@ -12,4 +12,5 @@

DEFINE_QLIST_WRAPPER_PTR(void)

DEFINE_QLIST_WRAPPER(QByteArray)

+

} // extern "C"

--- old-qt.core/src/lib/qlist.h 2014-10-30 06:59:11.000000000 +0100

+++ new-qt.core/src/lib/qlist.h 2014-10-30 06:59:11.000000000 +0100

@@ -32,7 +32,7 @@

* size, free and make_list. */

#define DEFINE_QLIST_WRAPPER_ALL_PART(NAME, TYPE) \

CL_SMOKE_QT_EXPORT int \

-qt_smoke_list_ ## NAME ## size(const void* list) \

+qt_smoke_list_ ## NAME ## _size(const void* list) \

{ \

return static_cast<const QList< TYPE >*>(list)->size(); \

} \

@@ -62,7 +62,7 @@

} \

\

CL_SMOKE_QT_EXPORT void \

-qt_smoke_list_ ## NAME ## _append(void* list, void* data, int length) \

+qt_smoke_list_ ## NAME ## _append(void* list, void* data) \

{ \

static_cast<QList< TYPE >*>(list) \

->append(static_cast<TYPE>(data)); \

@@ -76,11 +76,11 @@

qt_smoke_list_ ## NAME ## _at(const void* list, int index) \

{ \

const QList< TYPE >* qlist = static_cast<const QList< TYPE > *>(list); \

- return &qlist->at(index); \

+ return new TYPE(qlist->at(index)); \

} \

\

CL_SMOKE_QT_EXPORT void \

-qt_smoke_list_ ## NAME ## _append(void* list, void* data, int length) \

+qt_smoke_list_ ## NAME ## _append(void* list, void* data) \

{ \

static_cast<QList< TYPE >*>(list) \

->append(*static_cast<TYPE*>(data)); \

--- old-qt.core/src/list.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.core/src/list.lisp 2014-10-30 06:59:11.000000000 +0100

@@ -0,0 +1,64 @@

+(in-package :qt)

+

+(defmacro define-qlist-wrapper (type-name)

+ (let* ((type (string-upcase type-name))

+ (list-type (symbolicate 'qlist- type)))

+ `(progn

+ (defcfun ,(concatenate 'string "qt_smoke_list_" type-name "_size") :int

+ "Returns the size of LIST."

+ (list :pointer))

+ (defcfun ,(concatenate 'string "qt_smoke_free_list_" type-name) :void

+ "Frees LIST."

+ (list :pointer))

+ (defcfun ,(concatenate 'string "qt_smoke_make_list_" type-name) :pointer

+ "Makes a list.")

+ (defcfun ,(concatenate 'string "qt_smoke_list_" type-name "_at") :pointer

+ "Returns the a newly constructed copy of the element at position AT of LIST."

+ (list :pointer)

+ (index :int))

+ (defcfun ,(concatenate 'string "qt_smoke_list_" type-name "_append") :pointer

+ "Appends NEW-ELEMENT to LIST."

+ (list :pointer)

+ (new-element :pointer))

+ (define-foreign-type ,list-type ()

+ ()

+ (:actual-type :pointer))

+ (define-parse-method ,list-type ()

+ (make-instance ',list-type))

+ (eval-when (:load-toplevel :execute)

+ (smoke::add-type ,(format nil "const QList<~A>&" type-name)

+ ',list-type)

+ (smoke::add-type ,(format nil "QList<~A>" type-name) ',list-type))

+ (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 *qt-smoke* ,type-name))))))

+ (defmethod free-translated-object (pointer (type ,list-type) param)

+ (declare (ignore param))

+ (,(symbolicate 'qt-smoke-free-list- type)

+ pointer))

+ (defun ,(symbolicate 'coerce- list-type) (list)

+ (let ((qlist (,(symbolicate 'qt-smoke-make-list- type))))

+ (loop for element in list do

+ (,(symbolicate 'qt-smoke-list- type '-append)

+ qlist (pointer (make-instance ',type :args (list element)))))

+ (smoke::make-cleanup-pointer

+ qlist

+ (function ,(symbolicate 'qt-smoke-free-list- type)))))

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

+;(define-qlist-wrapper "void")

+(define-qlist-wrapper "QByteArray")

--- old-qt.core/src/operator.lisp 2014-10-30 06:59:11.000000000 +0100

+++ new-qt.core/src/operator.lisp 2014-10-30 06:59:11.000000000 +0100

@@ -4,7 +4,11 @@

(if (null more-objects)

t

(every #'(lambda (o)

- (qt:operator== object o))

+ ;; Consider Class::operator== and operator==

+ ;; FIXME integrate this in the overload resolution

+ (handler-case (qt:operator== object o)

+ (smoke::no-applicable-cxx-method ()

+ (cxx:operator== object o))))

more-objects)))

(defun cxx:/= (object &rest more-objects)

--- old-qt.core/src/package.lisp 2014-10-30 06:59:11.000000000 +0100

+++ new-qt.core/src/package.lisp 2014-10-30 06:59:11.000000000 +0100

@@ -1,5 +1,5 @@

(defpackage :qt

- (:use :cl :smoke :cffi :bordeaux-threads :cxx-support)

+ (:use :cl :smoke :cffi :bordeaux-threads :cxx-support :alexandria)

(:export #:app

#:app-p

#:exec

--- old-qt.core/src/properties.lisp 2014-10-30 06:59:11.000000000 +0100

+++ new-qt.core/src/properties.lisp 2014-10-30 06:59:11.000000000 +0100

@@ -44,7 +44,11 @@

(:method ((symbol symbol))

(class-direct-properties (find-class symbol))))

+(defun dynamic-properties (object)

+ (map 'list (compose #'smoke::lispify #'cxx:data)

+ (cxx:dynamic-property-names object)))

+

(defun properties (object)

"Returns a list of the properties of OBJECT."

- (warn "FIXME: dynamicPropertyNames not implemented")

- (meta-object-properties (cxx:meta-object object)))

+ (nconc (dynamic-properties object)

+ (meta-object-properties (cxx:meta-object object))))

--- old-qt.core/src/qstring.lisp 2014-10-30 06:59:11.000000000 +0100

+++ new-qt.core/src/qstring.lisp 2014-10-30 06:59:11.000000000 +0100

@@ -37,10 +37,6 @@

(define-parse-method qstring ()

(make-instance 'qstring))

-(defmethod translate-to-foreign (string (type qstring))

- (with-foreign-string ((data length) string :null-terminated-p nil)

- (qt-smoke-string-to-qstring data length)))

-

(smoke:eval-startup (:compile-toplevel :execute)

(let ((method (smoke::make-smoke-method (find-class 'byte-array)

"data")))

@@ -60,7 +56,8 @@

(defun coerce-qstring (string)

(make-cleanup-pointer

- (translate-to-foreign string (make-instance 'qt::qstring))

+ (with-foreign-string ((data length) string :null-terminated-p nil)

+ (qt-smoke-string-to-qstring data length))

#'(lambda (pointer)

(free-translated-object pointer (make-instance 'qt::qstring)

nil))))

--- old-qt.core/src/variant.lisp 2014-10-30 06:59:11.000000000 +0100

+++ new-qt.core/src/variant.lisp 2014-10-30 06:59:11.000000000 +0100

@@ -2,7 +2,8 @@

(defmethod print-object ((variant variant) stream)

"Print the type and value of the variant."

- (if (null-pointer-p (pointer variant))

+ (if (or (not (slot-boundp variant 'pointer))

+ (null-pointer-p (pointer variant)))

(call-next-method)

(print-unreadable-object (variant stream :type t :identity t)

(format stream "~A~@[ ~S~]"