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/signal-slot/translate.lisp
2009-04-05 tobias
1
(in-package :qt)
17:56:16 '
2
'
3
(defun method-argument-count (metaobject index)
'
4
"Returns the number of arguments the method INDEX of METAOBJECT."
'
5
(let ((signature (cxx:signature (cxx:method metaobject index))))
'
6
(setf signature (subseq signature (1+ (position #\( signature))
'
7
(position #\) signature :from-end t)))
'
8
(if (= 0 (length signature))
'
9
0
'
10
(1+ (count #\, signature)))))
'
11
'
12
(defun find-type (name &optional start end)
'
13
(smoke::make-smoke-type *qt-smoke* (subseq name start end)))
'
14
'
15
(defun method-arguments-type (metaobject index)
'
16
"Returns a type name list for the arguments of method INDEX of METAOBJECT."
'
17
(let* ((signature (cxx:signature (cxx:method metaobject index)))
'
18
(arguments (subseq signature (1+ (position #\( signature))
'
19
(position #\) signature :from-end t)))
'
20
(argument-types ())
'
21
(last-pos (length arguments)))
'
22
(loop as pos = (position #\, arguments :from-end t :end last-pos)
'
23
while pos
'
24
do
'
25
(push (find-type arguments (1+ pos) last-pos) argument-types)
'
26
(setf last-pos pos))
'
27
(when (> last-pos 0)
'
28
(push (find-type arguments 0 last-pos) argument-types))))
'
29
'
30
'
31
(defun arguments-to-lisp2 (argument types values)
'
32
(if (null types)
'
33
values
'
34
(arguments-to-lisp2 (inc-pointer argument (foreign-type-size :pointer))
'
35
(rest types)
'
36
(nconc values
'
37
(list
'
38
(typecase (first types)
'
39
;(smoke::smoke-standard-object
'
40
; (smoke::object-to-lisp
'
41
; (mem-ref
'
42
; (mem-ref argument
'
43
; :pointer) :pointer)
'
44
; (first types)))
'
45
(smoke::smoke-type
'
46
(smoke::type-to-lisp argument
'
47
(first types)))
'
48
(t
'
49
(translate-cxx-lisp-object
'
50
(mem-ref argument :pointer)))))))))
'
51
'
52
(defun arguments-to-lisp (arguments types)
'
53
(arguments-to-lisp2 (inc-pointer arguments ;; index 0 is for the return value
'
54
(foreign-type-size :pointer))
'
55
types ()))
'
56
'
57
'
58
(defun get-type (smoke-type)
'
59
(typecase smoke-type
'
60
(smoke::smoke-standard-object
'
61
(if (smoke::pointer-p smoke-type)
'
62
(error "FOO");;qmetatype.+voidstar+
'
63
(let ((type (meta-type.type (smoke::name smoke-type))))
'
64
(assert (/= 0 type)
'
65
(type)
'
66
"The type ~S has no QMetaType."
'
67
(smoke::name smoke-type))
'
68
type)))
'
69
(t
'
70
*cxx-lisp-object-metatype*)))
'
71
'
72
'
73
(defun types (smoke-types)
'
74
;;FIXME free TYPES on error.
'
75
(let ((types (cffi:foreign-alloc :int :count (1+ (length smoke-types))))
'
76
(index 0))
'
77
(dolist (type smoke-types)
'
78
(setf (cffi:mem-aref types :int index)
'
79
(get-type type))
'
80
(incf index))
'
81
(setf (cffi:mem-aref types :int index)
'
82
0)
'
83
types))