mirrors/EQL5
1
Fork 0
mirror of https://gitlab.com/eql/EQL5.git synced 2025-12-05 18:20:28 -08:00
Code Issues Projects Releases Packages Wiki Activity

'Qt_EQL': in 'EQL::addObject' / 'define-qt-wrappers': also add methods of all super classes; make lispifying C names optional;

Browse source
This commit is contained in:
polos 2021-06-14 20:13:15 +02:00
parent 1758101cf2
commit 9738cdad85
9 changed files with 122 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

8
Qt_EQL/tutorial/main.cpp
View file

@ -19,9 +19,13 @@ int main(int argc, char* argv[]) {
// the current package will be used (see above 'in-package');
// pass 'true' as last argument to also call 'define-qt-wrappers'
EQL::addObject(main, "eql-user:*main-widget*");
EQL::addObject(main, "eql-user:*main-widget*"); // add main
EQL::addObject(new Test(main), "*test*", true); // 'define-qt-wrappers'
// note argument 3 (true): 'define-qt-wrappers'
EQL::addObject(new Test(main), "*test*", true); // add 'Test'
// note argument 4 (false): do not lispify C function names
EQL::addObject(new Test2(main), "*test-2*", true, false); // add 'Test2'
EQL::eval("(load \"test.lisp\")"); // will start a REPL
app.processEvents(); // needed for 'qlater' in 'test.lisp'

17
Qt_EQL/tutorial/test.cpp
View file

@ -2,6 +2,8 @@
#include <QtDebug>
#include <eql5/eql_fun.h>
// class Test
Test::Test(QObject* parent, const QString& name) : QObject(parent) {
setObjectName(name);
}
@ -36,3 +38,18 @@ void Test::printMe() {
eql_fun("eql-user:print-qt-object", Q_ARG(QObject*, this));
}
// class Test2, which inherits Test
Test2::Test2(QObject* parent, const QString& name) : Test(parent) {
setObjectName(name);
}
QObject* Test2::newInstance(QObject* parent, const QString& name) {
return new Test2(parent, name);
}
void Test2::printAllMemberFunctions() {
// see comment above
eql_fun("eql:qapropos", Q_ARG(bool, false),
Q_ARG(QObject*, this));
}

13
Qt_EQL/tutorial/test.h
View file

@ -26,4 +26,17 @@ public Q_SLOTS:
void printMe();
};
class Test2 : public Test { // inherits class above
Q_OBJECT
public:
Test2(QObject* = nullptr, const QString& = QString());
// (see comment above)
Q_INVOKABLE QObject* newInstance(QObject* = nullptr, const QString& = QString());
public Q_SLOTS:
// (see comment above)
void printAllMemberFunctions();
};
#endif

6
Qt_EQL/tutorial/test.lisp
View file

@ -21,6 +21,11 @@
(print-me *test*)
(terpri))
(defun test-2 ()
;; call method from *test-2*, which function names are not lispified
;; (see 'main.cpp')
(|printAllMemberFunctions| *test-2*))
(defun print-qt-object (object)
(format t "~%This is an instance of 'Test': ~S~%" object))
@ -35,5 +40,6 @@
(progn
(test)
(test-2)
(qlater 'repl)) ; QLATER: don't block call from 'main.cpp'

14
src/ecl_fun.cpp
View file

@ -1720,14 +1720,19 @@ cl_object qapropos2(cl_object l_search, cl_object l_class, cl_object l_type, cl_
if(obj.pointer) {
qt_eql = true;
mo = ((QObject*)obj.pointer)->metaObject();
classes << QString("%1 : %2")
.arg(mo->className())
.arg(QString(obj.className()))
.toLatin1(); }}}
classes << QByteArray(); }}} // dummy
cl_object l_docs = ECL_NIL;
do {
if(qt_eql && LObjects::q_names.contains(mo->className())) {
break; }
Q_FOREACH(QByteArray cl, classes) {
bool found = false;
bool non = LObjects::n_names.contains(cl);
if(qt_eql) {
cl = QString("%1 : %2")
.arg(mo->className())
.arg(mo->superClass()->className())
.toLatin1(); }
if(non || qt_eql || LObjects::q_names.contains(cl)) {
cl_object l_doc_pro = ECL_NIL;
cl_object l_doc_slo = ECL_NIL;
@ -1755,6 +1760,7 @@ cl_object qapropos2(cl_object l_search, cl_object l_class, cl_object l_type, cl_
l_doc = cl_nreverse(l_doc);
if(l_doc != ECL_NIL) {
l_docs = CONS(CONS(STRING_COPY(cl.data()), l_doc), l_docs); }}}}
} while(qt_eql && (mo = mo->superClass()));
cl_object l_ret = cl_nreverse(l_docs);
return l_ret; }

11
src/eql.cpp
View file

@ -215,7 +215,7 @@ void EQL::exec(QWidget* widget, const QString& lispFile, const QString& slimeHoo
if(exec_with_simple_restart) {
eval("(eql::exec-with-simple-restart)"); }}
void EQL::addObject(QObject* object, const QByteArray& varName, bool defineWrappers) {
void EQL::addObject(QObject* object, const QByteArray& varName, bool defineWrappers, bool lispifyNames) {
cl_object l_symbol = ECL_NIL;
int p = varName.indexOf(':');
if(p == -1) {
@ -235,9 +235,16 @@ void EQL::addObject(QObject* object, const QByteArray& varName, bool defineWrapp
if(defineWrappers) {
// 'define-qt-wrappers'
STATIC_SYMBOL_PKG (s_define_qt_wrappers, "DEFINE-QT-WRAPPERS", "EQL")
STATIC_SYMBOL_PKG (s_do_not_lispify, "DO-NOT-LISPIFY", "KEYWORD")
if(lispifyNames) {
cl_funcall(2,
s_define_qt_wrappers,
l_object); }}
l_object); }
else {
cl_funcall(3,
s_define_qt_wrappers,
l_object,
s_do_not_lispify); }}}
void EQL::runOnUiThread(void* function_or_closure) {
const cl_env_ptr l_env = ecl_process_env();

2
src/eql5/eql.h
View file

@ -42,7 +42,7 @@ public:
static void ini(int, char**);
static void ini(char**);
static void eval(const char*, const EvalMode = evalMode);
static void addObject(QObject*, const QByteArray&, bool = false);
static void addObject(QObject*, const QByteArray&, bool = false, bool = true);
static EvalMode evalMode;
void exec(const QStringList&);

2
src/link-wrappers.lisp
View file

@ -8,7 +8,7 @@
(defparameter *all-wrappers* (append (loop :for i :from 1 :to 12 :collect (format nil "all-wrappers-~D" i))
(loop :for i :from 1 :to 2 :collect (format nil "all-wrappers-webengine-~D" i))))
(defparameter *lisp-files* (append '("x" "package" "ini"
(defparameter *lisp-files* (append '("x" "package" "ini" "qml"
"enums1" "enums2" "enums3" "enums4" "enums5"
"special-extensions")
*all-wrappers*))

25
src/lisp/ini.lisp
View file

@ -648,29 +648,38 @@
(defun define-qt-wrappers (qt-library &rest what)
"args: (qt-library &rest what)
Defines Lisp methods for all Qt methods/signals/slots of given library.<br>(See example <code>Qt_EQL/trafficlight/</code>).
Defines Lisp methods for all Qt methods/signals/slots of given library.<br>(See example <code>Qt_EQL/trafficlight/</code>). Pass :do-not-lispify if you don't want C++ names to be lispified automatically, like in: 'doThis()' -> '(do-this)' / 'do_that()' -> '(do-that)'.
(define-qt-wrappers *c++*) ; generate wrappers (see \"Qt_EQL/\")
(define-qt-wrappers *c++* :slots) ; Qt slots only (any of :methods :slots :signals)
(my-qt-function *c++* x y) ; instead of: (! \"myQtFunction\" (:qt *c++*) x y)"
(let ((all-functions (cdar (qapropos* nil (ensure-qt-object qt-library)))))
(let ((all-functions (qapropos* nil (ensure-qt-object qt-library)))
(lispify (not (find :do-not-lispify what))))
(setf what (remove-if (lambda (x) (find x '(:do-not-lispify t)))
what))
(unless what
(setf what '(:methods :slots :signals)))
(dolist (functions (loop :for el :in what :collect
(concatenate 'string (string-capitalize el) ":")))
(dolist (fun (rest (find functions all-functions
(dolist (class-functions all-functions)
(dolist (fun (rest (find functions (cdr class-functions)
:key 'first :test 'string=)))
(let* ((p (position #\( fun))
(qt-name (subseq fun (1+ (position #\Space fun :from-end t :end p)) p))
(lisp-name (intern (with-output-to-string (s)
(lisp-name (intern (if lispify
(with-output-to-string (s)
(x:do-string (ch qt-name)
(if (upper-case-p ch)
(format s "-~C" ch)
(write-char (char-upcase ch) s)))))))
(cond ((upper-case-p ch)
(format s "-~C" ch))
((char= #\_ ch)
(write-char #\- s))
(t
(write-char (char-upcase ch) s)))))
qt-name))))
;; no way to avoid EVAL here (excluding non-portable hacks)
(eval `(defgeneric ,lisp-name (object &rest arguments)))
(eval `(defmethod ,lisp-name ((object qt-object) &rest arguments)
(%qinvoke-method object :qt ,qt-name arguments))))))))
(%qinvoke-method object :qt ,qt-name arguments)))))))))
#+linux
(defun %ini-auto-reload (library-name watcher on-file-change)