Thu Jun 11 16:59:48 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* :qt and :qt-impl packages to prevent collision with :cl symbols and fix object with non smoke parent.

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

+++ new-qt.gui/src/variant.lisp 2014-10-30 07:47:27.000000000 +0100

@@ -1,6 +1,6 @@

-(in-package :qt)

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

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

+(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)))

@@ -8,22 +8,22 @@

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

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

(cxx:type-name variant)

- (handler-case (from-variant variant)

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

(error () nil))))))

-(defun make-variant (&optional (value nil value-p))

+(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 'variant :args (list value))

- (make-instance 'variant)))

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

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

-(defun make-char (character)

+(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 'char :args (list (aref octets 0))))

- (2 (make-instance 'char :args (list (aref octets 0)

+ (1 (make-instance 'qt:char :args (list (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."

@@ -33,7 +33,7 @@

(or (cxx:is-high-surrogate char)

(cxx:is-low-surrogate char)))

-(defun from-char (char)

+(defun qt:from-char (char)

"Returns the lisp character represented by CHAR."

(assert (not (surrogate-p char))

(char)

@@ -46,30 +46,30 @@

(char-code (cxx:row char)))))

0))

-(defmethod print-object ((char char) stream)

+(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 (from-char char) stream))))

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

;; FIXME include in MAKE-VARIANT?

-(defun make-lisp-variant (value)

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

"Returns a new VARIANT that wraps VALUE.

The variant contains the actual Lisp object

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

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

(unwind-protect

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

- object))

+ (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 variant-boundp (variant)

+(defun qt:variant-boundp (variant)

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

(cxx:is-valid variant))

@@ -78,14 +78,16 @@

,@(loop for type in types collect

(if (symbolp type)

- `(,(value (symbol-value (alexandria:symbolicate 'variant.+ 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 from-variant (variant)

+(defun qt:from-variant (variant)

"Returns the value of VARIANT."

(variant-conversions (variant)

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

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

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

(values))

bit-array bool byte-array

@@ -107,10 +109,10 @@

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

value))))

-(defmethod value ((variant variant))

+(defmethod qt:value ((variant qt:variant))

"Returns the value of VARIANT."

- (from-variant variant))

+ (qt:from-variant variant))

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

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

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

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

new-value)