repos
/
qt.gui
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
filehistory
normal
|
plain
|
shade
|
zebra
Signal slot finalization fix
Annotate for file src/variant.lisp
2009-06-11 tobias
1
(in-package :qt)
2010-01-10 tobias
2
2009-06-11 tobias
3
(defmethod print-object ((variant variant) stream)
2010-01-10 tobias
4
"Print the type and value of the variant."
2009-05-27 tobias
5
(if (null-pointer-p (pointer variant))
2010-01-10 tobias
6
(call-next-method)
2009-05-24 tobias
7
(print-unreadable-object (variant stream :type t :identity t)
2010-01-10 tobias
8
(format stream "~A~@[ ~S~]"
08:52:49 '
9
(cxx:type-name variant)
2009-06-11 tobias
10
(handler-case (from-variant variant)
2010-01-10 tobias
11
(error () nil))))))
08:52:49 '
12
2009-06-11 tobias
13
(defun make-variant (&optional (value nil value-p))
2010-01-10 tobias
14
"Returns a new VARIANT containing a C++ version of VALUE
08:52:49 '
15
or an empty variant when VALUE is not specified."
'
16
(if value-p
2009-06-11 tobias
17
(make-instance 'variant :args (list value))
14:59:48 '
18
(make-instance 'variant)))
2010-01-10 tobias
19
2009-06-11 tobias
20
(defun make-char (character)
2010-01-10 tobias
21
"Returns a char for a lisp CHARACTER."
08:52:49 '
22
(let ((octets (babel:string-to-octets (string character))))
'
23
(case (length octets)
2009-06-11 tobias
24
(1 (make-instance 'char :args (list (aref octets 0))))
14:59:48 '
25
(2 (make-instance 'char :args (list (aref octets 0)
2009-07-22 tobias
26
(aref octets 1))))
2010-01-10 tobias
27
(t (error "qt:char requires the character ~A to be encoded
08:52:49 '
28
in one or two octets, but it is using ~A."
'
29
character (length octets))))))
'
30
'
31
(defun surrogate-p (char)
'
32
(or (cxx:is-high-surrogate char)
'
33
(cxx:is-low-surrogate char)))
'
34
2009-06-11 tobias
35
(defun from-char (char)
2009-07-22 tobias
36
"Returns the lisp character represented by CHAR."
2010-01-10 tobias
37
(assert (not (surrogate-p char))
08:52:49 '
38
(char)
'
39
"The char ~A is part of a surrogate.")
'
40
(char
'
41
(babel:octets-to-string (make-array 2 :element-type '(unsigned-byte 8)
'
42
:initial-contents
'
43
(list
'
44
(char-code (cxx:cell char))
'
45
(char-code (cxx:row char)))))
'
46
0))
'
47
2009-06-11 tobias
48
(defmethod print-object ((char char) stream)
2010-01-10 tobias
49
(if (or (null-pointer-p (pointer char))
08:52:49 '
50
(surrogate-p char))
'
51
(call-next-method)
'
52
(print-unreadable-object (char stream :type t)
2009-06-11 tobias
53
(princ (from-char char) stream))))
2010-01-10 tobias
54
08:52:49 '
55
2009-07-22 tobias
56
;; FIXME include in MAKE-VARIANT?
2009-06-11 tobias
57
(defun make-lisp-variant (value)
2010-01-10 tobias
58
"Returns a new VARIANT that wraps VALUE.
08:52:49 '
59
2009-07-22 tobias
60
The variant contains the actual Lisp object
2010-01-10 tobias
61
and not its C++ value like in MAKE-VARIANT."
08:52:49 '
62
(let ((object (make-cxx-lisp-object value)))
'
63
(unwind-protect
2009-06-11 tobias
64
(make-instance 'variant :args (list *cxx-lisp-object-metatype*
14:59:48 '
65
object))
2010-01-10 tobias
66
(free-cxx-lisp-object object))))
08:52:49 '
67
'
68
(defcfun qt-smoke-lisp-object-value :pointer
'
69
(variant :pointer))
'
70
2009-06-11 tobias
71
(defun variant-boundp (variant)
2010-01-10 tobias
72
"Returns true when VARIANT is valid (has a value) and false otherwise."
08:52:49 '
73
(cxx:is-valid variant))
'
74
2009-06-11 tobias
75
(defun from-variant (variant)
2010-01-10 tobias
76
"Returns the value of VARIANT."
2009-06-10 tobias
77
(ecase (cxx:user-type variant)
2009-06-11 tobias
78
(#.(value variant.+invalid+)
2010-01-10 tobias
79
(cerror "Return (VALUES)" "Type of variant ~A is invalid." variant)
08:52:49 '
80
(values))
2009-06-10 tobias
81
(#.(value variant.+string+)
12:02:01 '
82
(cxx:to-string variant))
'
83
(#.(value variant.+string-list+)
'
84
(cxx:to-string-list variant))
'
85
(#.(value variant.+uint+)
'
86
(cxx:to-uint variant))
'
87
(#.(value variant.+int+)
'
88
(cxx:to-int variant))
'
89
(#.(value variant.+double+)
'
90
(cxx:to-double variant))
'
91
(#.(value variant.+char+)
'
92
(cxx:to-char variant))
'
93
(#.(value variant.+bool+)
'
94
(cxx:to-bool variant))
2010-01-10 tobias
95
(#.*cxx-lisp-object-metatype*
08:52:49 '
96
(let* ((lisp-object (qt-smoke-lisp-object-value (smoke::pointer variant)))
'
97
(value))
'
98
(setf value (translate-cxx-lisp-object lisp-object))
'
99
(free-cxx-lisp-object lisp-object)
'
100
value))))
2009-06-10 tobias
101
2009-06-11 tobias
102
(defmethod value ((variant variant))
2010-01-10 tobias
103
"Returns the value of VARIANT."
2009-06-11 tobias
104
(from-variant variant))
2010-01-10 tobias
105
2009-06-11 tobias
106
(defmethod (setf value) (new-value (variant variant))
14:59:48 '
107
(cxx:operator= variant (make-variant new-value))
2010-01-10 tobias
108
new-value)