Mon May 11 13:09:54 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* cleanup variant
hunk ./src/variant.lisp 3
-(defgeneric make-variant (value)
- (:documentation "Returns a variant for VALUE."))
-
hunk ./src/variant.lisp 13
-(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))))
+
hunk ./src/variant.lisp 57
- "Returns a new VARIANT that wrapps VALUE."
+ "Returns a new VARIANT that wraps VALUE."
hunk ./src/variant.lisp 71
-;;FIXME define setf-able value function
-
hunk ./src/variant.lisp 75
- (cerror "Return NIL" "Type of variant ~A is invalid." variant)
- nil)
+ (cerror "Return (VALUES)" "Type of variant ~A is invalid." variant)
+ (values))
hunk ./src/variant.lisp 87
+ (#.(value variant.+char+)
+ (cxx:to-char variant))
+ (#.(value variant.+bool+)
+ (cxx:to-bool variant))
hunk ./src/variant.lisp 97
+
+(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)))