diff --git a/Qt_EQL/tutorial/main.cpp b/Qt_EQL/tutorial/main.cpp index 62ddd92..21e2817 100644 --- a/Qt_EQL/tutorial/main.cpp +++ b/Qt_EQL/tutorial/main.cpp @@ -19,13 +19,17 @@ 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' - EQL::eval("(load \"test.lisp\")"); // will start a REPL - app.processEvents(); // needed for 'qlater' in 'test.lisp' + // note argument 4 (false): do not lispify C function names + EQL::addObject(new Test2(main), "*test-2*", true, false); // add 'Test2' - return 0; // no 'app.exec()' because of REPL + EQL::eval("(load \"test.lisp\")"); // will start a REPL + app.processEvents(); // needed for 'qlater' in 'test.lisp' + + return 0; // no 'app.exec()' because of REPL } diff --git a/Qt_EQL/tutorial/test.cpp b/Qt_EQL/tutorial/test.cpp index 2a86e79..ad0215d 100644 --- a/Qt_EQL/tutorial/test.cpp +++ b/Qt_EQL/tutorial/test.cpp @@ -2,6 +2,8 @@ #include #include +// 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)); +} diff --git a/Qt_EQL/tutorial/test.h b/Qt_EQL/tutorial/test.h index 773a17a..2546abd 100644 --- a/Qt_EQL/tutorial/test.h +++ b/Qt_EQL/tutorial/test.h @@ -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 diff --git a/Qt_EQL/tutorial/test.lisp b/Qt_EQL/tutorial/test.lisp index 65a5e00..d006232 100644 --- a/Qt_EQL/tutorial/test.lisp +++ b/Qt_EQL/tutorial/test.lisp @@ -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' diff --git a/src/ecl_fun.cpp b/src/ecl_fun.cpp index 41b7e37..f731489 100644 --- a/src/ecl_fun.cpp +++ b/src/ecl_fun.cpp @@ -1720,41 +1720,47 @@ 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; - Q_FOREACH(QByteArray cl, classes) { - bool found = false; - bool non = LObjects::n_names.contains(cl); - if(non || qt_eql || LObjects::q_names.contains(cl)) { - cl_object l_doc_pro = ECL_NIL; - cl_object l_doc_slo = ECL_NIL; - cl_object l_doc_sig = ECL_NIL; - cl_object l_doc_ovr = ECL_NIL; - if(!non) { - l_doc_pro = collect_info("properties", cl, search, non, &found, mo, no_offset); } - cl_object l_doc_met = collect_info("methods", cl, search, non, &found, mo); - if(!non) { - l_doc_slo = collect_info("slots", cl, search, non, &found, mo); - l_doc_sig = collect_info("signals", cl, search, non, &found, mo); } - l_doc_ovr = collect_info("override", cl, search, non, &found, mo); - if(found) { - cl_object l_doc = ECL_NIL; - if(l_doc_pro != ECL_NIL) { - l_doc = CONS(CONS(STRING("Properties:"), l_doc_pro), l_doc); } - if(l_doc_met != ECL_NIL) { - l_doc = CONS(CONS(STRING("Methods:"), l_doc_met), l_doc); } - if(l_doc_slo != ECL_NIL) { - l_doc = CONS(CONS(STRING("Slots:"), l_doc_slo), l_doc); } - if(l_doc_sig != ECL_NIL) { - l_doc = CONS(CONS(STRING("Signals:"), l_doc_sig), l_doc); } - if((l_doc_ovr != ECL_NIL) && !qt_eql) { - l_doc = CONS(CONS(STRING("Override:"), l_doc_ovr), l_doc); } - l_doc = cl_nreverse(l_doc); - if(l_doc != ECL_NIL) { - l_docs = CONS(CONS(STRING_COPY(cl.data()), l_doc), l_docs); }}}} + 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; + cl_object l_doc_sig = ECL_NIL; + cl_object l_doc_ovr = ECL_NIL; + if(!non) { + l_doc_pro = collect_info("properties", cl, search, non, &found, mo, no_offset); } + cl_object l_doc_met = collect_info("methods", cl, search, non, &found, mo); + if(!non) { + l_doc_slo = collect_info("slots", cl, search, non, &found, mo); + l_doc_sig = collect_info("signals", cl, search, non, &found, mo); } + l_doc_ovr = collect_info("override", cl, search, non, &found, mo); + if(found) { + cl_object l_doc = ECL_NIL; + if(l_doc_pro != ECL_NIL) { + l_doc = CONS(CONS(STRING("Properties:"), l_doc_pro), l_doc); } + if(l_doc_met != ECL_NIL) { + l_doc = CONS(CONS(STRING("Methods:"), l_doc_met), l_doc); } + if(l_doc_slo != ECL_NIL) { + l_doc = CONS(CONS(STRING("Slots:"), l_doc_slo), l_doc); } + if(l_doc_sig != ECL_NIL) { + l_doc = CONS(CONS(STRING("Signals:"), l_doc_sig), l_doc); } + if((l_doc_ovr != ECL_NIL) && !qt_eql) { + l_doc = CONS(CONS(STRING("Override:"), l_doc_ovr), l_doc); } + 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; } diff --git a/src/eql.cpp b/src/eql.cpp index 2a42a76..5b54cee 100644 --- a/src/eql.cpp +++ b/src/eql.cpp @@ -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") - cl_funcall(2, - s_define_qt_wrappers, - l_object); }} + STATIC_SYMBOL_PKG (s_do_not_lispify, "DO-NOT-LISPIFY", "KEYWORD") + if(lispifyNames) { + cl_funcall(2, + s_define_qt_wrappers, + 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(); diff --git a/src/eql5/eql.h b/src/eql5/eql.h index 3fabf04..276a1e6 100644 --- a/src/eql5/eql.h +++ b/src/eql5/eql.h @@ -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&); diff --git a/src/link-wrappers.lisp b/src/link-wrappers.lisp index ec99553..3f79269 100644 --- a/src/link-wrappers.lisp +++ b/src/link-wrappers.lisp @@ -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*)) diff --git a/src/lisp/ini.lisp b/src/lisp/ini.lisp index ddc4d55..c6d56e7 100644 --- a/src/lisp/ini.lisp +++ b/src/lisp/ini.lisp @@ -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.
(See example Qt_EQL/trafficlight/). + Defines Lisp methods for all Qt methods/signals/slots of given library.
(See example Qt_EQL/trafficlight/). 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 - :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) - (x:do-string (ch qt-name) - (if (upper-case-p ch) - (format s "-~C" ch) - (write-char (char-upcase ch) s))))))) - ;; 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)))))))) + (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 (if lispify + (with-output-to-string (s) + (x:do-string (ch qt-name) + (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))))))))) #+linux (defun %ini-auto-reload (library-name watcher on-file-change)