add missing meta type handling for QMatrix, QTransform
[eql:eql.git] / helper / parse.lisp
1 ;;; copyright (c) 2010-2011 Polos Ruetz
2
3 (load "load-modules")
4 (load "../src/lisp/x")
5 (load "share")
6
7 (use-package :x)
8
9 (defconstant +skip+
10   (list "( Type )"
11         "(preliminary)"
12         "(deprecated)"
13         "<Attribute>"
14         "<FormatRange>"
15         "<WizardButton>"
16         "<WritingSystem>"
17         "[4][4]"
18         "const char * const[]"
19         "defaultAction"
20         "int *"
21         "iterator"
22         "macEvent"
23         "operator"
24         "placeholderText"
25         "printerSelectionOption"
26         "qreal *"
27         "setPrinterSelectionOption"
28         "setupUi"
29         "singleShot"
30         "quint32"
31         "qwsSet"
32         "void *"
33         "winPage"
34         "x11"
35         "CFbsBitmap"
36         "CGImageRef"
37         "DefaultAction"
38         "EditFocus"
39         "Engine"
40         "FILE"
41         "FT_Face"
42         "GLfloat *"
43         "GLfloat["
44         "Handle"
45         "HANDLE"
46         "HBITMAP"
47         "HCURSOR"
48         "HDC"
49         "HICON"
50         "KeyValue"
51         "NavigationMode"
52         "MSG"
53         "PaperSources"
54         "PlaceholderText"
55         "RawHeaderPair"
56         "RenderFlags"
57         "RSgImage"
58         "SearchHit"
59         "T "
60         "Q_PID"
61         "QDataStream"
62         "QDecoration"
63         "QGenericArgument"
64         "QGenericMatrix"
65         "QHash"
66         "QIODevice"
67         "QList<Country>"
68         "QList<QPair<"
69         "QList<T>"
70         "QList<Tab>"
71         "QList<QVariant>"
72         "QMap"
73         "QMetaClassInfo"
74         "QMetaEnum"
75         "QMetaMethod"
76         "QMetaProperty"
77         "QPrinterInfo"
78         "QSet<"
79         "QSymbianEvent"
80         "QTextObjectInterface"
81         "QWebNetworkRequest"
82         "QWSEvent"
83         "QXmlStreamReader"
84         "WinPage"
85         "WId"
86         "X11"
87         "XEvent"
88         "**"
89         "QFont getFont ( bool * , QWidget * , const char * )"                 ; "const char *" is ignored
90         "QFont getFont ( bool * , const QFont & , QWidget * , const char * )" ; "const char *" is ignored
91         "QString nativeArguments () const"
92         "void setNativeArguments ( const QString & )"
93         ))
94
95
96 (defparameter *check* nil)
97
98 (defun text (str)
99   (with-output-to-string (s)
100     (let ((buf (make-string 1000))
101           ex skip skip-name enc p)
102       (labels ((white-space (ch)
103                  (find ch '(#\Space #\Tab)))
104                (write-char* (ch)
105                  (unless (or skip-name
106                              (and (white-space ch)
107                                   (white-space ex)))
108                    (write-char ch s)
109                    (setf ex ch)))
110                (buf-add (ch)
111                  (setf (char buf (incf p)) ch))
112                (buf ()
113                  (subseq buf 0 (1+ p))))
114         (dotimes (i (length str))
115           (let ((ch (char str i)))
116             (if skip
117                 (if (char= #\> ch)
118                     (progn
119                       (setf skip nil)
120                       (let ((buf* (buf)))
121                         (cond ((string= "i" buf*) (setf skip-name t))
122                               ((string= "/i" buf*) (setf skip-name nil)))))
123                     (buf-add ch))
124                 (case ch
125                   (#\< (setf skip t p -1))
126                   (#\& (setf enc t p -1))
127                   (#\; (when enc
128                          (setf enc nil)
129                          (let ((buf* (buf)))
130                            (write-char* (cond ((string= "amp" buf*) #\&)
131                                               ((string= "lt" buf*) #\<)
132                                               ((string= "gt" buf*) #\>)
133                                               ((string= "nbsp" buf*) #\Space)
134                                               (t (error (format nil "Parse error at: &~A;" buf*))))))))
135                   (t (if enc
136                          (buf-add ch)
137                          (write-char* ch)))))))))))
138
139 (let (html)
140   (defun read-html (class)
141     (let ((path (html-file class)))
142       (if (probe-file path)
143           (with-open-file (s path :direction :input)
144             (setf html (make-string (file-length s)))
145             (read-sequence html s))
146           (progn
147             (incf *not-found*)
148             (warn (format nil "Html file not found: ~S" path))))))
149   (defun super-class (class)
150     (let ((a (search "<p>Inherits" html)))
151       (when a
152         (let* ((b (search* "<" html (1+ a)))
153                (c (search* "</" html (1+ b)))
154                (d (search* "<" html (1+ c)))
155                (super (text (subseq html b c))))
156           (unless (find #\< super) ; template
157             (when (search* "and" (subseq html c d))
158               (format *check* "~A: ~A and ~A~%"
159                       class
160                       super
161                       (text (subseq html d (search* "</" html (1+ d))))))
162             super)))))
163   (defun parse (type class s so no-new)
164     ;; "bool QPainter::begin ( QPaintDevice * )": multiple inheritance problem
165     (let ((qpainter (and (string= "QPainter" class)
166                          (string= "public functions" type))))
167       (when qpainter
168         (dolist (device (list "QImage" "QPicture" "QPixmap" "QPrinter" "QWidget")) 
169           (format s "~%   \"new QPainter ( ~A * )\"~
170                      ~%   \"bool begin ( ~A * )\""
171                   device device)))
172       (let ((static (starts-with "static" type))
173             (protected (search "protected" type))
174             (p (search* (format nil "<h2>~A</h2>" type) html)))
175         (when p
176           (let* ((tb1 (search* "<table" html p))
177                  (tb2 (search* "</table>" html tb1))
178                  (funs (subseq html tb1 tb2))
179                  tr1 (tr2 0))
180             (loop
181               (setf tr1 (search* "<tr" funs tr2))
182               (unless tr1
183                 (return))
184               (setf tr2 (search* "</tr>" funs tr1))
185               (let* ((fun (string-trim " " (text (subseq funs tr1 tr2))))
186                      (new (and (not static)
187                                (or (starts-with (format nil "Q_INVOKABLE ~A (" class) fun)
188                                    (starts-with (format nil "~A (" class) fun))))
189                      (virtual (starts-with "virtual" fun)))
190                 (unless (or (and qpainter (search "QPaintDevice" fun :test 'string=))
191                             (and new no-new)
192                             (and new protected)
193                             (find #\~ fun) ; destructor
194                             (dolist (str +skip+)
195                               (when (search str fun)
196                                 (return t)))
197                             ;; template problem
198                             (and (string= "QVariant" class)
199                                  (string= "bool canConvert () const" fun))
200                             ;; primitives
201                             (and (string= "QColor" class)
202                                  (not static)))
203                   (when virtual
204                     (format so "~%   \"~A\"" fun))
205                   (unless (and virtual protected)
206                     (format s "~%   \"~A~A\"" (cond (new "new ") ; constructor
207                                                     (protected "protected ")
208                                                     (static "static ")
209                                                     (t ""))
210                             (subseq fun (if (starts-with "Q_INVOKABLE" fun) 12 0)))))))))))))
211
212 (defun parse-classes (classes s so non)
213   (dolist (class classes)
214     (let* ((no-new (starts-with "//" class))
215            (class* (string-left-trim "/" class))
216            (file class*))
217       (x:when-it (search "::" class*)
218         (setf file   (subseq class* 0 x:it)
219               class* (subseq class* (+ 2 x:it))))
220       (read-html file)
221       (format t "~%parsing ~A" class*)
222       (let ((super (super-class class)))
223         (format s "  ((~S . ~S)" class* super)
224         (format so "  ((~S . ~S)" class* super))
225       (dolist (type (list "public functions"
226                           "protected functions"
227                           "reimplemented public functions"
228                           "reimplemented protected functions"
229                           "static public members"
230                           "static protected members"))
231         (parse type class* s so no-new)
232         (write-char #\.))
233       (format s ")~%")
234       (format so ")~%")))
235   (format s "))~%")
236   (format so "))~%"))
237
238 (defun start ()
239   (with-open-file (*check* "multiple-inheritance.txt" :direction :output :if-exists :supersede)
240     (mapc (lambda (names non)
241             (let ((pre (if non #\n #\q)))
242               (with-open-file (s (format nil "parsed/~C-methods.lisp" pre) :direction :output :if-exists :supersede)
243                 (with-open-file (so (format nil "parsed/~C-override.lisp" pre) :direction :output :if-exists :supersede)
244                   (format so "(defparameter *~C-override* '(~%" pre)
245                   (format s "(defparameter *~C-methods* '(~%" pre)
246                   (parse-classes (mapcar (lambda (name)
247                                            (string-trim "= " (if-it (position #\( name)
248                                                                  (subseq name 0 it)
249                                                                  name)))
250                                          names)
251                                  s so non)))))
252           (list *q-names* *n-names*)
253           (list nil :non)))
254   (if (zerop *not-found*)
255       (format t "~%OK~%~%")
256       (warn (format nil "Html files not found: ~D" *not-found*))))
257
258 (start)