repos
/
qt.core
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
initial import
Annotate for file src/variant.lisp
2009-04-05 tobias
1
(in-package :qt)
17:56:16 '
2
'
3
(declaim (optimize (debug 3)))
'
4
'
5
(defgeneric make-variant (value)
'
6
(:documentation "Returns a variant for VALUE."))
'
7
'
8
(defmethod print-object ((variant variant) stream)
'
9
"Print the type and value of the variant."
'
10
(if (null-pointer-p (pointer variant))
'
11
(call-next-method)
'
12
(print-unreadable-object (variant stream :type t)
'
13
(format stream "~A~@[ ~S~]"
'
14
(cxx:type-name variant)
'
15
(handler-case (from-variant variant)
'
16
(error () nil))))))
'
17
'
18
(defmethod make-variant (value)
'
19
"Returns a new VARIANT containing a C++ version of VALUE."
'
20
(make-instance 'variant :args (list value)))
'
21
'
22
;; FIXME include in MAKE-VARIANT?
'
23
(defun make-lisp-variant (value)
'
24
"Returns a new VARIANT that wrapps VALUE."
'
25
(let ((object (make-cxx-lisp-object value)))
'
26
(unwind-protect
'
27
(make-instance 'variant :args (list *cxx-lisp-object-metatype*
'
28
object))
'
29
(free-cxx-lisp-object object))))
'
30
'
31
(defcfun qt-smoke-lisp-object-value :pointer
'
32
(variant :pointer))
'
33
'
34
(defun valid-p (variant)
'
35
"Returns true when VARIANT is valid (has a value) and false otherwise."
'
36
(cxx:is-valid variant))
'
37
'
38
(defun from-variant (variant)
'
39
"Returns the value of VARIANT."
'
40
(ecase (cxx:user-type variant)
'
41
(#.(value variant.+invalid+)
'
42
(cerror "Return (VALUES)" "Type of variant ~A is invalid." variant)
'
43
(values))
'
44
(#.(value variant.+string+)
'
45
(cxx:to-string variant))
'
46
(#.(value variant.+string-list+)
'
47
(cxx:to-string-list variant))
'
48
(#.(value variant.+uint+)
'
49
(cxx:to-uint variant))
'
50
(#.(value variant.+int+)
'
51
(cxx:to-int variant))
'
52
(#.(value variant.+double+)
'
53
(cxx:to-double variant))
'
54
(#.*cxx-lisp-object-metatype* ;; FIXME test this!
'
55
(let* ((lisp-object (qt-smoke-lisp-object-value (smoke::pointer variant)))
'
56
(value))
'
57
(setf value (translate-cxx-lisp-object lisp-object))
'
58
(free-cxx-lisp-object lisp-object)
'
59
value))))