-
Notifications
You must be signed in to change notification settings - Fork 2
/
qlist.lisp
137 lines (119 loc) · 5.84 KB
/
qlist.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
(in-package :qt)
;;; marshalling
(defmarshal (value (:|QStringList| :|const QStringList&|) :around cont :type list)
(let ((qstringlist (sw_qstringlist_new)))
(unwind-protect
(progn
(dolist (str value)
(let ((char* (cffi:foreign-string-alloc str)))
(unwind-protect
(sw_qstringlist_append qstringlist char*)
(cffi:foreign-free char*))))
(funcall cont qstringlist))
(sw_qstringlist_delete qstringlist))))
(defmarshal (value (:|QList<int>| :|const QList<int>&|) :around cont :type list)
(let ((qlist (sw_qlist_int_new)))
(unwind-protect
(progn
(dolist (v value)
(cffi:with-foreign-object (vptr :int)
(setf (cffi:mem-ref vptr :int) v)
(sw_qlist_int_append qlist vptr)))
(funcall cont qlist))
(sw_qlist_int_delete qlist))))
(defmacro define-object-ptr-list-marshaller (type-name)
(let ((type-1 (alexandria:make-keyword (format nil "QList<~A*>" type-name)))
(type-2 (alexandria:make-keyword (format nil "const QList<~A*>&" type-name))))
`(defmarshal (value (,type-1 ,type-2) :around cont :type list)
(let ((qlist (sw_qlist_void_new))
(element-class (with-cache () (find-qclass ,type-name))))
(unwind-protect
(progn
(dolist (v value)
(unless (and (typep v 'abstract-qobject)
(qtypep v element-class))
(error "cannot marshal list element ~s as ~s" v ,type-name))
(sw_qlist_void_append qlist (qobject-pointer v)))
(funcall cont qlist))
(sw_qlist_void_delete qlist))))))
(define-object-ptr-list-marshaller "QObject")
(define-object-ptr-list-marshaller "QStandardItem")
(defmarshal (value (:|QList<QByteArray>| :|const QList<QByteArray>&|) :around cont :type list)
(let ((qlist (sw_qlist_qbytearray_new)))
(unwind-protect
(progn
(dolist (v value)
(let ((vptr (sw_make_qbytearray v)))
(unwind-protect
(sw_qlist_qbytearray_append qlist vptr)
(sw_delete_qbytearray vptr))))
(funcall cont qlist))
(sw_qlist_qbytearray_delete qlist))))
(defmarshal (value (:|QList<QVariant>| :|const QList<QVariant>&|) :around cont :type list)
(let ((qlist (sw_qlist_qvariant_new)))
(unwind-protect
(progn
(dolist (v value)
(sw_qlist_qvariant_append qlist (qobject-pointer (qvariant v))))
(funcall cont qlist))
(sw_qlist_qvariant_delete qlist))))
(defmacro define-copyable-object-list-marshaller (type-name)
(let ((type-1 (alexandria:make-keyword (format nil "QList<~A>" type-name)))
(type-2 (alexandria:make-keyword (format nil "const QList<~A>&" type-name)))
(new-func (qlist-function-name type-name 'new))
(append-func (qlist-function-name type-name 'append))
(delete-func (qlist-function-name type-name 'delete)))
`(defmarshal (value (,type-1 ,type-2) :around cont :type list)
(let ((qlist (,new-func))
(element-class (with-cache () (find-qclass ,type-name))))
(unwind-protect
(progn
(dolist (v value)
(unless (and (typep v 'abstract-qobject)
(qtypep v element-class))
(error "cannot marshal list element ~s as ~s" v ,type-name))
(,append-func qlist (qobject-pointer v)))
(funcall cont qlist))
(,delete-func qlist))))))
(define-copyable-object-list-marshaller "QModelIndex")
(define-copyable-object-list-marshaller "QKeySequence")
;;; unmarshalling
(def-unmarshal (value "QStringList" type)
(iter (for i from 0 below (sw_qstringlist_size value))
(collect (convert-qstring-data (sw_qstringlist_at value i)))))
(def-unmarshal (value "QList<int>" type)
(iter (for i from 0 below (sw_qlist_int_size value))
(collect (cffi:mem-ref (sw_qlist_int_at value i) :int))))
(defmacro define-object-ptr-list-unmarshaller (type-name)
(let ((list-type (format nil "QList<~A*>" type-name)))
`(def-unmarshal (value ,list-type type)
(iter (for i from 0 below (sw_qlist_void_size value))
(collect (%qobject (with-cache () (find-qclass ,type-name))
(sw_qlist_void_at value i)))))))
(def-unmarshal (value "QList<QByteArray>" type)
(iter (for i from 0 below (sw_qlist_qbytearray_size value))
(collect (interpret-call
(%qobject (find-qclass "QByteArray") (sw_qlist_qbytearray_at value i))
"data"))))
(define-object-ptr-list-unmarshaller "QObject")
(define-object-ptr-list-unmarshaller "QStandardItem")
(define-object-ptr-list-unmarshaller "QListWidgetItem")
(define-object-ptr-list-unmarshaller "QTreeWidgetItem")
(define-object-ptr-list-unmarshaller "QTableWidgetItem")
(define-object-ptr-list-unmarshaller "QGraphicsItem")
(defmacro define-copyable-object-list-unmarshaller (type-name)
(let ((list-type (format nil "QList<~A>" type-name))
(size-func (qlist-function-name type-name 'size))
(at-func (qlist-function-name type-name 'at)))
`(def-unmarshal (value ,list-type type)
(iter (for i from 0 below (,size-func value))
;; clone objects so that the pointers don't become invalid
;; when the list is destroyed or they're removed from it
(collect (optimized-new
,type-name
(%qobject (find-qclass ,type-name) (,at-func value i))))))))
(define-copyable-object-list-unmarshaller "QModelIndex")
(define-copyable-object-list-unmarshaller "QKeySequence")
(def-unmarshal (value "QList<QVariant>" type)
(iter (for i from 0 below (sw_qlist_qvariant_size value))
(collect (unvariant (sw_qlist_qvariant_at value i)))))