repos
/
qt.core
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
cleanup
Annotate for file /src/list.lisp
2010-01-10 tobias
1
(in-package :cl-smoke.qt.core)
2009-05-27 tobias
2
2010-01-30 tobias
3
(defbitfield qlist-data-flags
15:40:15 '
4
:sharable)
'
5
'
6
(defcstruct qlist-data
'
7
(ref :char :count #.(class-size (find-class 'qt:basic-atomic-int)))
'
8
(alloc :int)
'
9
(begin :int)
'
10
(end :int)
'
11
(flags qlist-data-flags)
'
12
(array :pointer))
'
13
'
14
(defcstruct qlist
'
15
(data (:pointer qlist-data)))
'
16
'
17
(defun qlist-size (qlist)
'
18
(let ((data (foreign-slot-value qlist 'qlist 'data)))
'
19
(- (foreign-slot-value data 'qlist-data 'end)
'
20
(foreign-slot-value data 'qlist-data 'begin))))
'
21
2010-01-26 tobias
22
(eval-when (:compile-toplevel :load-toplevel :execute)
2010-01-25 tobias
23
(macrolet ((c-name (name)
18:45:04 '
24
`(nth-value 1 ,name))
'
25
(fun-names-let (name-pre-post-fixes &body body)
'
26
`(flet (,@(mapcar
'
27
#'(lambda (npp)
'
28
`(,(first npp) (type)
'
29
(values
'
30
(intern (string-upcase
'
31
(concatenate 'string
'
32
,(second npp)
'
33
type
'
34
,(third npp)))
'
35
,*package*)
'
36
(concatenate 'string
'
37
(substitute #\_ #\-
'
38
,(second npp))
'
39
type
'
40
(substitute #\_ #\-
'
41
,(third npp))))))
'
42
name-pre-post-fixes))
'
43
,@body)))
2010-01-30 tobias
44
(fun-names-let ((list-free "cl-smoke-free-list-")
2010-01-25 tobias
45
(list-make "cl-smoke-make-list-")
18:45:04 '
46
(list-at "cl-smoke-list-" "-at")
'
47
(list-append "cl-smoke-list-" "-append"))
'
48
(defmacro define-qlist-wrapper (type-name element-type &optional (c-name nil c-name-p)
'
49
&key def-cfuns)
'
50
(let* ((c-name (or c-name type-name))
'
51
(type c-name)
'
52
(lisp-type (symbolicate 'qlist- element-type)))
'
53
`(progn
'
54
,(when (or (not c-name-p) def-cfuns)
'
55
`(progn
'
56
(defcfun ,(c-name (list-free type)) :void
'
57
"Frees LIST."
'
58
(list :pointer))
'
59
(defcfun ,(c-name (list-make type)) :pointer
'
60
"Makes a list.")
'
61
(defcfun ,(c-name (list-at type)) :pointer
'
62
"Returns the a newly constructed copy of the element at
'
63
position AT of LIST."
'
64
(list :pointer)
'
65
(index :int))
'
66
(defcfun ,(c-name (list-append type)) :pointer
'
67
"Appends NEW-ELEMENT to LIST."
'
68
(list :pointer)
'
69
(new-element :pointer))))
'
70
;; To Lisp
'
71
,@(loop for type-name in (ensure-list type-name) collect
'
72
`(defun ,(symbolicate 'from-list- type-name) (list-pointer)
2010-01-30 tobias
73
(declare (optimize (speed 3)))
15:40:15 '
74
(let ((vector (make-array (qlist-size
2010-02-20 tobias
75
list-pointer))))
2010-01-25 tobias
76
(dotimes (index (length vector) vector)
18:45:04 '
77
(setf (elt vector index)
'
78
;; FIXME the returned object is not wrapped by Smoke
'
79
;; -> change this?
2010-02-20 tobias
80
(object-to-lisp
2010-01-25 tobias
81
(,(list-at type)
18:45:04 '
82
list-pointer index)
2010-02-20 tobias
83
(make-smoke-type ,(symbolicate '*smoke-module*)
21:04:46 '
84
,type-name)))))))
2010-01-25 tobias
85
,@(loop for type-name in (ensure-list type-name) collect
18:45:04 '
86
`(define-to-lisp-translation
'
87
(,(format nil "const QList<~A>&" type-name)
'
88
,(format nil "QList<~A>" type-name))
'
89
,(symbolicate 'from-list- type-name)
'
90
,(list-free type)))
'
91
;; From Lisp
'
92
(defun ,(symbolicate 'coerce- lisp-type) (list)
'
93
(let ((qlist (,(list-make type))))
'
94
(loop for element across list do
'
95
(,(list-append type)
'
96
qlist (pointer (make-instance ',element-type :args (list element)))))
'
97
(make-cleanup-pointer
'
98
qlist
'
99
(function ,(list-free type)))))
'
100
(defun ,(symbolicate lisp-type '-p) (list)
'
101
(every #'(lambda (element)
'
102
;(typep element ',element-type))
'
103
(typep element (find-class ',element-type)))
'
104
list))
'
105
,@(loop for type-name in (ensure-list type-name) collect
'
106
`(define-from-lisp-translation (,(format nil "const QList<~A>&" type-name)
'
107
,(format nil "QList<~A>" type-name))
'
108
;; FIXME allow sequence
'
109
(and (vector );,element-type)
'
110
(satisfies ,(symbolicate lisp-type '-p)))
'
111
,(symbolicate 'coerce- lisp-type)))))))))
2009-05-27 tobias
112
2009-09-02 tobias
113
(define-qlist-wrapper "QVariant" qt:variant)
12:00:35 '
114
'
115
(define-qlist-wrapper "QByteArray" qt:byte-array)
2010-01-25 tobias
116
18:45:04 '
117
(define-qlist-wrapper "QObject*" qt:object "void" :def-cfuns t)