Wed May 27 19:18:41 CEST 2009 Tobias Rautenkranz * QList and QList conversion & use cxx:operator== and qt:operator== in cxx:= diff -rN -u old-qt.gui/qt.mbd new-qt.gui/qt.mbd --- old-qt.gui/qt.mbd 2014-10-10 10:23:06.000000000 +0200 +++ new-qt.gui/qt.mbd 2014-10-10 10:23:07.000000000 +0200 @@ -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)) diff -rN -u old-qt.gui/src/lib/qlist.cpp new-qt.gui/src/lib/qlist.cpp --- old-qt.gui/src/lib/qlist.cpp 2014-10-10 10:23:06.000000000 +0200 +++ new-qt.gui/src/lib/qlist.cpp 2014-10-10 10:23:06.000000000 +0200 @@ -12,4 +12,5 @@ DEFINE_QLIST_WRAPPER_PTR(void) DEFINE_QLIST_WRAPPER(QByteArray) + } // extern "C" diff -rN -u old-qt.gui/src/lib/qlist.h new-qt.gui/src/lib/qlist.h --- old-qt.gui/src/lib/qlist.h 2014-10-10 10:23:06.000000000 +0200 +++ new-qt.gui/src/lib/qlist.h 2014-10-10 10:23:06.000000000 +0200 @@ -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*>(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*>(list) \ ->append(static_cast(data)); \ @@ -76,11 +76,11 @@ qt_smoke_list_ ## NAME ## _at(const void* list, int index) \ { \ const QList< TYPE >* qlist = static_cast *>(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*>(list) \ ->append(*static_cast(data)); \ diff -rN -u old-qt.gui/src/list.lisp new-qt.gui/src/list.lisp --- old-qt.gui/src/list.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.gui/src/list.lisp 2014-10-10 10:23:07.000000000 +0200 @@ -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") diff -rN -u old-qt.gui/src/operator.lisp new-qt.gui/src/operator.lisp --- old-qt.gui/src/operator.lisp 2014-10-10 10:23:06.000000000 +0200 +++ new-qt.gui/src/operator.lisp 2014-10-10 10:23:07.000000000 +0200 @@ -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) diff -rN -u old-qt.gui/src/package.lisp new-qt.gui/src/package.lisp --- old-qt.gui/src/package.lisp 2014-10-10 10:23:06.000000000 +0200 +++ new-qt.gui/src/package.lisp 2014-10-10 10:23:07.000000000 +0200 @@ -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 diff -rN -u old-qt.gui/src/properties.lisp new-qt.gui/src/properties.lisp --- old-qt.gui/src/properties.lisp 2014-10-10 10:23:06.000000000 +0200 +++ new-qt.gui/src/properties.lisp 2014-10-10 10:23:07.000000000 +0200 @@ -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)))) diff -rN -u old-qt.gui/src/qstring.lisp new-qt.gui/src/qstring.lisp --- old-qt.gui/src/qstring.lisp 2014-10-10 10:23:06.000000000 +0200 +++ new-qt.gui/src/qstring.lisp 2014-10-10 10:23:07.000000000 +0200 @@ -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)))) diff -rN -u old-qt.gui/src/variant.lisp new-qt.gui/src/variant.lisp --- old-qt.gui/src/variant.lisp 2014-10-10 10:23:06.000000000 +0200 +++ new-qt.gui/src/variant.lisp 2014-10-10 10:23:07.000000000 +0200 @@ -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~]"