Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 85 lines (67 sloc) 3.035 kb
0d03b82 @dmitryvk Initial commit
authored
1 (in-package :glib)
2
3 (define-foreign-type glist-type ()
4 ((type :reader glist-type-type :initarg :type :initform :pointer)
5 (free-from-foreign :reader glist-type-free-from-foreign :initarg :free-from-foreign :initform t)
6 (free-to-foreign :reader glist-type-free-to-foreign :initarg :free-to-foreign :initform t))
7 (:actual-type :pointer))
8
9 (define-parse-method glist (type &key (free-from-foreign t) (free-to-foreign t))
10 (make-instance 'glist-type
11 :type type
12 :free-from-foreign free-from-foreign
13 :free-to-foreign free-to-foreign))
14
15 (defcstruct g-list
16 (data :pointer)
17 (next :pointer)
18 (prev :pointer))
19
20 (defcfun g-list-first (:pointer g-list) (list (:pointer g-list)))
21
22 (defcfun g-list-free :void (list (:pointer g-list)))
23
24 (defun g-list-next (list)
25 (if (null-pointer-p list)
26 (null-pointer)
27 (foreign-slot-value list 'g-list 'next)))
28
29 (defmethod translate-from-foreign (pointer (type glist-type))
30 (prog1
31 (iter (for c initially pointer then (g-list-next c))
32 (until (null-pointer-p c))
33 (collect (convert-from-foreign (foreign-slot-value c 'g-list 'data) (glist-type-type type))))
34 (when (glist-type-free-from-foreign type)
35 (g-list-free pointer))))
36
37
38 (define-foreign-type gslist-type ()
39 ((type :reader gslist-type-type :initarg :type :initform :pointer)
40 (free-from-foreign :reader gslist-type-free-from-foreign :initarg :free-from-foreign :initform t)
41 (free-to-foreign :reader gslist-type-free-to-foreign :initarg :free-to-foreign :initform t))
42 (:actual-type :pointer))
43
44 (define-parse-method gslist (type &key (free-from-foreign t) (free-to-foreign t))
45 (make-instance 'gslist-type
46 :type type
47 :free-from-foreign free-from-foreign
48 :free-to-foreign free-to-foreign))
49
50 (defcstruct g-slist
51 (data :pointer)
52 (next :pointer))
53
f97b627 @andy128k added translate-to-foreign method for GSList
andy128k authored
54 (defcfun g-slist-alloc (:pointer g-slist))
55
0d03b82 @dmitryvk Initial commit
authored
56 (defcfun g-slist-free :void (list (:pointer g-slist)))
57
58 (defun g-slist-next (list)
59 (if (null-pointer-p list)
60 (null-pointer)
61 (foreign-slot-value list 'g-slist 'next)))
62
63 (defmethod translate-from-foreign (pointer (type gslist-type))
64 (prog1
65 (iter (for c initially pointer then (g-slist-next c))
66 (until (null-pointer-p c))
2023a6b @dmitryvk glib: Fix typo in GSList foreign type
authored
67 (collect (convert-from-foreign (foreign-slot-value c 'g-slist 'data) (gslist-type-type type))))
0d03b82 @dmitryvk Initial commit
authored
68 (when (gslist-type-free-from-foreign type)
f97b627 @andy128k added translate-to-foreign method for GSList
andy128k authored
69 (g-slist-free pointer))))
70
71 (defmethod translate-to-foreign (list (type gslist-type))
72 (let ((result (null-pointer)) last)
73 (iter (for item in list)
74 (for n = (g-slist-alloc))
75 (for ptr = (convert-to-foreign item (gslist-type-type type)))
76 (setf (foreign-slot-value n 'g-slist 'data) ptr)
77 (setf (foreign-slot-value n 'g-slist 'next) (null-pointer))
78 (when last
79 (setf (foreign-slot-value last 'g-slist 'next) n))
80 (setf last n)
81 (when (first-iteration-p)
82 (setf result n)))
83 result))
84
Something went wrong with that request. Please try again.