Removed makefile
[trivial-gtk.git] / gir-parser.lisp
blobf0e537419790e0e8f850dbf0d3c1e93291dfc08d
1 (in-package :gir)
3 (defun is-object-record (record)
4 (let* ((record-string (string record))
5 (record-string-len (length record-string)))
6 (or
7 (and (> record-string-len 6)
8 (string= "OBJECT" (string-upcase (subseq record-string (- record-string-len 6))))))))
10 (defun parse-function-types (method)
11 (iterate
12 (for item in (s-xml:xml-element-children method))
13 (case (s-xml:xml-element-name item)
14 (GIR-CORE::|return-value|
15 (let ((return-type (first (xml-element-children item))))
16 (format t "~T~S~%" (resolve-type (s-xml:xml-element-attribute return-type 'GIR-C::|type|)))))
17 (GIR-CORE::|parameters|
18 (iterate
19 (for parameter in (s-xml:xml-element-children item))
20 (format t "( ~A " (s-xml:xml-element-attribute parameter :|name|))
21 (format t " ~S )~%"
22 (resolve-type (xml-element-attribute (car (s-xml:xml-element-children parameter)) 'GIR-C::|type|))))))))
24 (defun parse-signal-types (gsignal)
25 (let ((name (s-xml:xml-element-attribute gsignal :|name|)))
26 (format t "~%; ----------------- ~A ----------------~%" name)
27 (format t "(defmacro make-~A-callback (name &rest body) ~%" (lispize name))
28 (format t "~T(defcallback ,name ")
29 (iterate
30 (for item in (s-xml:xml-element-children gsignal))
31 (when (s-xml::xml-element-p item)
32 (case (s-xml:xml-element-name item)
33 (GIR-CORE::|return-value|
34 (let ((return-type (first (xml-element-children item))))
35 (format t "~T~S~%" (resolve-type (s-xml:xml-element-attribute return-type 'GIR-C::|type|)))))
36 (GIR-CORE::|parameters|
37 (iterate
38 (for parameter in (s-xml:xml-element-children item))
39 (format t "( ~A " (s-xml:xml-element-attribute parameter :|name|))
40 (format t " ~S )~%"
41 (resolve-type (xml-element-attribute (car (s-xml:xml-element-children parameter)) 'GIR-C::|type|))))))))
42 (format t "))~%")))
46 (defun parse-record (record)
47 (let ((c-type (s-xml:xml-element-attribute record 'GIR-C::|type|))
48 (name (s-xml:xml-element-attribute record :|name|)))
49 ;; we punt on object records (I think they are meant to be opaque)
50 (unless (is-object-record name)
51 (format t "~%; ----------------- ~A ----------------~%" name)
52 (format t "~%(defcstruct ~A ~%" name)
53 (iterate
54 (for field in (s-xml:xml-element-children record))
55 (when (eql (s-xml:xml-element-name field) 'GIR-CORE::|field|)
56 (format t "~T(~A ~S)~%"
57 (lispize (s-xml:xml-element-attribute field :|name|))
58 (resolve-type (s-xml:xml-element-attribute field :|value|)))))
59 (format t ")~%")
60 (iterate
61 (for method in (s-xml:xml-element-children record))
62 (when (eql (s-xml:xml-element-name method) 'GIR-CORE::|callback|)
63 (let ((name (s-xml:xml-element-attribute method :|name|)))
64 (format t "(defcfun (~S ~A) " name (lispize name))
65 ;; to do -- still need to parse callbacks as methods!
66 (parse-function-types method))))
68 (format t ")~%"))))
71 (defun parse-function (function)
72 (let ((c-identifier (s-xml:xml-element-attribute function 'GIR-C:|identifier|))
73 (name (s-xml:xml-element-attribute function :|name|)))
74 (format t "~%; ----------------- ~A ---------------- " name)
75 (format t "~%(defcfun (~S ~A) ~%" c-identifier (lispize name))
76 (parse-function-types function)
77 (format t ")~%")))
79 (defun parse-constructor (constructor)
80 (let ((c-identifier (s-xml:xml-element-attribute constructor 'GIR-C:|identifier|))
81 (name (s-xml:xml-element-attribute constructor :|name|)))
82 (format t "~%; ----------------- ~A ---------------- " (lispize c-identifier))
83 (format t "~%(defcfun (~S ~A) ~%" c-identifier (lispize c-identifier))
84 (parse-function-types constructor)
85 (format t ")~%")))
87 ;; callbacks associated with the records are actually methods
91 (defun parse-enum-members (enum)
92 (iterate
93 (for member in (s-xml:xml-element-children enum))
94 (when (eql (s-xml:xml-element-name member) 'GIR-CORE::|member|)
95 (format t "~T(~S ~S)~%"
96 (alexandria:make-keyword
97 (string-upcase (s-xml:xml-element-attribute member :|name|)))
98 (parse-integer (s-xml:xml-element-attribute member :|value|))))))
100 (defun parse-enumeration (enum)
101 (let ((c-type (s-xml:xml-element-attribute enum 'GIR-C::|type|))
102 (name (s-xml:xml-element-attribute enum :|name|)))
103 (format t "~%; ----------------- ~A ----------------~%" (lispize c-type))
104 (add-type (string c-type) :unsigned-int)
105 (format t "(defcenum ~A ~% " name)
106 (parse-enum-members enum)
107 (format t ")~%")))
109 (defun parse-bitfield (bitfield)
110 (let ((c-type (s-xml:xml-element-attribute bitfield 'GIR-C::|type|))
111 (name (s-xml:xml-element-attribute bitfield :|name|)))
112 (format t "~%; ----------------- ~A ----------------~%" (lispize c-type))
113 (format t "(defcenum ~A ~% " name)
114 (add-type (string c-type) :unsigned-int)
115 (parse-enum-members bitfield)
116 (format t ")~%")))
118 (defun parse-class (gclass)
119 (iterate
120 (for method in (s-xml:xml-element-children gclass))
121 (when (s-xml::xml-element-p method)
122 (case (s-xml:xml-element-name method)
123 (GIR-CORE::|constructor| (parse-constructor method))
124 (GIR-CORE::|method| (parse-function method))
125 (GIR-CORE::|callback| (parse-signal-types method))))))
127 (defun parse-boxed (boxed)
128 (iterate
129 (for method in (s-xml:xml-element-children boxed))
130 (when (s-xml::xml-element-p method)
131 (case (s-xml:xml-element-name method)
132 (GIR-CORE::|constructor| (parse-function-types method))
133 (GIR-CORE::|method| (parse-function-types method))
134 (GIR-CORE::|callback| (parse-signal-types method))))))
136 (defun parse-callback (callback)
137 (let ((name (s-xml:xml-element-attribute callback :|name|)))
138 (add-type name :pointer)
139 (parse-signal-types callback)))
141 (defparameter *gir-top-level-elements*
143 ;; first pass
145 (GIR-CORE::|bitfield| . parse-bitfield)
146 (GIR-CORE::|enumeration| . parse-enumeration))
147 ;; second pass
148 ((GIR-CORE::|callback| . parse-callback))
149 ;; third pass
150 ((GIR-CORE::|record| . parse-record)
151 (GIR-CORE::|function| . parse-function))
152 ;; fourth pass
153 ((GIR-CORE::|class| . parse-class)
154 (GIR-GLIB::|boxed| . parse-boxed))))
157 (defun parse-element (elements entry)
158 (let ((name (s-xml:xml-element-name entry)))
159 (let ((fun (cdr (assoc name elements))))
160 (if fun
161 (funcall fun entry)))))
164 (defun parse-namespace (namespace)
165 (let ((namespace-name
166 (alexandria::make-keyword
167 (string-upcase (s-xml:xml-element-attribute namespace :|name|)))))
168 (format t "(defpackage ~S (:use :common-lisp :cffi :iterate))~%~%" namespace-name)
169 (format t "(inpackage ~S)~%" namespace-name)
170 (iterate
171 (for top-level-elements in *gir-top-level-elements*)
172 (iterate
173 (for entry in (xml-element-children namespace))
174 (parse-element top-level-elements entry)))))
176 (defun parse-repository (repository)
177 (iterate
178 (for namespace in (s-xml:xml-element-children repository))
179 (parse-namespace namespace)))