mirror of
https://gitlab.com/eql/EQL5.git
synced 2026-01-04 08:11:46 -08:00
100 lines
4.4 KiB
Common Lisp
100 lines
4.4 KiB
Common Lisp
;;; Generates C++ glue code, typically for the JavaScript / Lisp bridge of QtWebKit
|
|
;;;
|
|
;;; Assumes the first line of a function documentation string to contain a signature like this:
|
|
;;; "Qt: <return type> <function name as seen in JavaScript> ( <argument type>, ...)"
|
|
;;; (don't worry about whitespace, it will be normalized anyway)
|
|
;;;
|
|
;;; Optionally you may define default values; null default values are written as "= 0".
|
|
;;;
|
|
;;; Examples:
|
|
;;;
|
|
;;; "Qt: void funA(int, QString)"
|
|
;;;
|
|
;;; "Qt: QString funB(QWebElement, QString = \"ok\", QVariantList = 0)"
|
|
;;;
|
|
;;; (Packages COMMON-LISP and EQL are excluded from search.)
|
|
|
|
(defun qvariant-type (type)
|
|
(cond ((string= "qreal" type)
|
|
"Real")
|
|
((string= "qlonglong" type)
|
|
"LongLong")
|
|
((x:starts-with "Q" type)
|
|
(subseq type 1))
|
|
(t
|
|
(string-capitalize type))))
|
|
|
|
(defun to-qvariant-type (type)
|
|
(if (find type '("QBitmap" "QIcon" "QImage" "QPixmap") :test 'string=)
|
|
(format nil "ret.value<~A>()" type)
|
|
(format nil "ret.to~A()" (qvariant-type type))))
|
|
|
|
(defun qt-value-p (type)
|
|
(and (x:starts-with "Q" type)
|
|
(not (x:ends-with "*" type))))
|
|
|
|
(defun const-reference (type)
|
|
(if (qt-value-p type)
|
|
(format nil "const ~A&" type)
|
|
type))
|
|
|
|
(defun default-value (type value)
|
|
(if (and (qt-value-p type)
|
|
(string= "0" value))
|
|
(format nil "~A()" type)
|
|
value))
|
|
|
|
(defun generate-invokables (&optional (directory "./"))
|
|
(let ((file (x:cc directory "_invokables.h"))
|
|
processed)
|
|
(ensure-directories-exist file)
|
|
(with-open-file (s file :direction :output :if-exists :supersede)
|
|
(format s "// THIS FILE IS GENERATED (see \"invokables.lisp\" in sources)~%~%")
|
|
(do-all-symbols (symbol)
|
|
(unless (find (symbol-package symbol)
|
|
'#.(mapcar 'find-package (list 'cl 'eql)))
|
|
(let ((doc (documentation symbol 'function)))
|
|
(when (and doc
|
|
(string-equal "Qt: " (subseq doc 0 (min 4 (length doc))))
|
|
(not (find symbol processed)))
|
|
(push symbol processed)
|
|
(let ((sig (x:bytes-to-string (! "normalizedSignature" "QMetaObject"
|
|
(subseq doc 4 (1+ (position #\) doc))))))
|
|
(pkg-name (string-downcase (package-name (symbol-package symbol))))
|
|
(sym-name (string-downcase (symbol-name symbol))))
|
|
(format t "~%\"~A:~A\"~% ~A~%" pkg-name sym-name sig)
|
|
(let* ((a (position #\Space sig))
|
|
(b (position #\( sig :start a))
|
|
(c (position #\) sig :start b))
|
|
(ret (subseq sig 0 a))
|
|
(fun (subseq sig (1+ a) b))
|
|
(types* (mapcar (lambda (type) (x:split type #\=))
|
|
(x:split (subseq sig (1+ b) c) #\,)))
|
|
(types (mapcar 'first types*))
|
|
(defaults (mapcar (lambda (type value) (default-value type value))
|
|
types
|
|
(mapcar 'second types*)))
|
|
(vars (loop :for i :from 1 :to (length types) :collect (format nil "x~D" i)))
|
|
(void (string= "void" ret)))
|
|
(format s "Q_INVOKABLE ~A ~A(~{~A~^, ~}) {~%"
|
|
ret
|
|
fun
|
|
(mapcar (lambda (type var default)
|
|
(format nil "~A ~A~A"
|
|
(const-reference type)
|
|
var
|
|
(if default (format nil " = ~A" default) "")))
|
|
types vars defaults))
|
|
(unless void
|
|
(format s " QVariant ret =~%"))
|
|
(format s " eql_fun(\"~A:~A\"" pkg-name sym-name)
|
|
(unless void
|
|
(format s ", QVariant::~A" (qvariant-type ret)))
|
|
(mapc (lambda (type var)
|
|
(format s ",~% Q_ARG(~A, ~A)" type var))
|
|
types vars)
|
|
(format s ");")
|
|
(unless void
|
|
(format s "~% return ~A;" (to-qvariant-type ret)))
|
|
(format s " }~%~%")))))))))
|
|
(terpri))
|