Sun Jan 10 09:52:49 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Split up in qt.gui & cleanup name prefix.

--- old-qt.gui/src/variant.lisp 2014-10-30 07:42:52.000000000 +0100

+++ new-qt.gui/src/variant.lisp 1970-01-01 01:00:00.000000000 +0100

@@ -1,118 +0,0 @@

-(in-package :cl-smoke.qt-impl)

-

-(defmethod print-object ((variant qt:variant) stream)

- "Print the type and value of the 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~]"

- (cxx:type-name variant)

- (handler-case (qt:from-variant variant)

- (error () nil))))))

-

-(defun qt: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 'qt:variant :arg0 value)

- (make-instance 'qt:variant)))

-

-(defun qt:make-char (character)

- "Returns a char for a lisp CHARACTER."

- (let ((octets (babel:string-to-octets (string character))))

- (case (length octets)

- (1 (make-instance 'qt:char :arg0 (aref octets 0)))

- (2 (make-instance 'qt: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 qt: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 qt:char) stream)

- (if (or (null-pointer-p (pointer char))

- (surrogate-p char))

- (call-next-method)

- (print-unreadable-object (char stream :type t)

- (princ (qt:from-char char) stream))))

-

-

-;; FIXME include in MAKE-VARIANT? how??

-(defun qt:make-lisp-variant (value)

- "Returns a new VARIANT that wraps VALUE.

-

-The variant contains the actual Lisp object VALUE

-and not its C++ value like in MAKE-VARIANT."

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

- (unwind-protect

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

- object))

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

-

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

- (variant :pointer))

-

-(defun qt:variant-boundp (variant)

- "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 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 (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 qt:value ((variant qt:variant))

- "Returns the value of VARIANT."

- (qt:from-variant variant))

-

-(defmethod (setf qt:value) (new-value (variant qt:variant))

- (cxx:operator= variant (qt:make-variant new-value))

- new-value)