Mon May 11 13:09:54 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * cleanup variant
diff -rN -u old-qt.core/src/variant.lisp new-qt.core/src/variant.lisp
--- old-qt.core/src/variant.lisp	2014-11-16 03:13:36.000000000 +0100
+++ new-qt.core/src/variant.lisp	2014-11-16 03:13:36.000000000 +0100
@@ -1,8 +1,5 @@
 (in-package :qt)
 
-(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))
@@ -13,13 +10,51 @@
                 (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)))
+(defun make-variant (&optional (value nil value-p))
+  "Returns a new VARIANT containing a C++ version of VALUE
+or an empty variant when VALUE is not specified."
+  (if value-p
+      (make-instance 'variant :args (list value))
+      (make-instance 'variant)))
+
+(defun make-char (character)
+  (let ((octets (babel:string-to-octets (string character))))
+    (case (length octets)
+      (1 (make-instance 'char :args (list (aref octets 0))))
+      (2 (make-instance 'char :args (list (aref octets 0)
+                                          (aref octets 1))))
+      (t (error "qt:char requires the character ~A to be encoded
+in one or two octets, but it is using ~A."
+                character (length octets))))))
+
+(defun surrogate-p (char)
+  (or (cxx:is-high-surrogate char)
+      (cxx:is-low-surrogate char)))
+
+(defun from-char (char)
+  "Returns the lisp character represented by CHAR."
+  (assert (not (surrogate-p char))
+          (char)
+          "The char ~A is part of a surrogate.")
+  (char
+   (babel:octets-to-string (make-array 2 :element-type '(unsigned-byte 8)
+                                       :initial-contents
+                                       (list
+                                        (char-code (cxx:cell char))
+                                        (char-code (cxx:row char)))))
+   0))
+
+(defmethod print-object ((char char) stream)
+  (if (or (null-pointer-p (pointer char))
+          (surrogate-p char))
+      (call-next-method)
+      (print-unreadable-object (char stream :type t)
+        (princ (from-char char) stream))))
+
 
 ;; FIXME include in MAKE-VARIANT?
 (defun make-lisp-variant (value)
-  "Returns a new VARIANT that wrapps VALUE."
+  "Returns a new VARIANT that wraps VALUE."
   (let ((object (make-cxx-lisp-object value)))
     (unwind-protect
          (make-instance 'variant :args (list *cxx-lisp-object-metatype*
@@ -33,14 +68,12 @@
   "Returns true when VARIANT is valid (has a value) and false otherwise."
   (cxx:is-valid variant))
 
-;;FIXME define setf-able value function
-
 (defun from-variant (variant)
   "Returns the value of VARIANT."
   (ecase (cxx:user-type variant)
     (#.(value variant.+invalid+)
-       (cerror "Return NIL" "Type of variant ~A is invalid." variant)
-       nil)
+       (cerror "Return (VALUES)" "Type of variant ~A is invalid." variant)
+       (values))
     (#.(value variant.+string+)
        (cxx:to-string variant))
     (#.(value variant.+string-list+)
@@ -51,9 +84,20 @@
        (cxx:to-int variant))
     (#.(value variant.+double+)
        (cxx:to-double variant))
+    (#.(value variant.+char+)
+       (cxx:to-char variant))
+    (#.(value variant.+bool+)
+       (cxx:to-bool variant))
     (#.*cxx-lisp-object-metatype*
      (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))))
+
+(defmethod value ((variant variant))
+  "Returns the value of VARIANT."
+  (from-variant variant))
+
+(defmethod (setf value) (new-value (variant variant))
+  (cxx:operator= variant (make-variant new-value)))