Sun Apr 5 19:56:16 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* initial import

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

+++ new-qt.core/src/variant.lisp 2014-11-11 13:38:13.000000000 +0100

@@ -0,0 +1,59 @@

+(in-package :qt)

+

+(declaim (optimize (debug 3)))

+

+(defgeneric make-variant (value)

+ (:documentation "Returns a variant for VALUE."))

+

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

+ "Print the type and value of the variant."

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

+ (call-next-method)

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

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

+ (cxx:type-name variant)

+ (handler-case (from-variant variant)

+ (error () nil))))))

+

+(defmethod make-variant (value)

+ "Returns a new VARIANT containing a C++ version of VALUE."

+ (make-instance 'variant :args (list value)))

+

+;; FIXME include in MAKE-VARIANT?

+(defun make-lisp-variant (value)

+ "Returns a new VARIANT that wrapps VALUE."

+ (let ((object (make-cxx-lisp-object value)))

+ (unwind-protect

+ (make-instance 'variant :args (list *cxx-lisp-object-metatype*

+ object))

+ (free-cxx-lisp-object object))))

+

+(defcfun qt-smoke-lisp-object-value :pointer

+ (variant :pointer))

+

+(defun valid-p (variant)

+ "Returns true when VARIANT is valid (has a value) and false otherwise."

+ (cxx:is-valid variant))

+

+(defun from-variant (variant)

+ "Returns the value of VARIANT."

+ (ecase (cxx:user-type variant)

+ (#.(value variant.+invalid+)

+ (cerror "Return (VALUES)" "Type of variant ~A is invalid." variant)

+ (values))

+ (#.(value variant.+string+)

+ (cxx:to-string variant))

+ (#.(value variant.+string-list+)

+ (cxx:to-string-list variant))

+ (#.(value variant.+uint+)

+ (cxx:to-uint variant))

+ (#.(value variant.+int+)

+ (cxx:to-int variant))

+ (#.(value variant.+double+)

+ (cxx:to-double variant))

+ (#.*cxx-lisp-object-metatype* ;; FIXME test this!

+ (let* ((lisp-object (qt-smoke-lisp-object-value (smoke::pointer variant)))

+ (value))

+ (setf value (translate-cxx-lisp-object lisp-object))

+ (free-cxx-lisp-object lisp-object)

+ value))))