Sat Feb 20 22:00:30 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* support all from qt:variant conversions.
diff -rN -u old-qt.core/src/variant.lisp new-qt.core/src/variant.lisp
--- old-qt.core/src/variant.lisp 2014-10-30 06:58:00.000000000 +0100
+++ new-qt.core/src/variant.lisp 2014-10-30 06:58:00.000000000 +0100
@@ -73,41 +73,57 @@
"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))))
+(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 types special-types
+ (remove nil qt-types))
+ collect
+ (if (symbolp type)
+ `(,(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))))
+ 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."