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

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
+    // note argument 4 (false): do not lispify C function names
-    app.processEvents();                 // needed for 'qlater' in 'test.lisp'
+    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
 }
 

Qt_EQL/tutorial/test.cpp

@@ -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));
+}

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

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'
 

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")
+                classes << QByteArray(); }}} // dummy
-                        .arg(mo->className())
-                        .arg(QString(obj.className()))
-                        .toLatin1(); }}}
     cl_object l_docs = ECL_NIL;
-    Q_FOREACH(QByteArray cl, classes) {
+    do {
-        bool found = false;
+        if(qt_eql && LObjects::q_names.contains(mo->className())) {
-        bool non = LObjects::n_names.contains(cl);
+            break; }
-        if(non || qt_eql || LObjects::q_names.contains(cl)) {
+        Q_FOREACH(QByteArray cl, classes) {
-            cl_object l_doc_pro = ECL_NIL;
+            bool found = false;
-            cl_object l_doc_slo = ECL_NIL;
+            bool non = LObjects::n_names.contains(cl);
-            cl_object l_doc_sig = ECL_NIL;
+            if(qt_eql) {
-            cl_object l_doc_ovr = ECL_NIL;
+                cl = QString("%1 : %2")
-            if(!non) {
+                     .arg(mo->className())
-                l_doc_pro = collect_info("properties", cl, search, non, &found, mo, no_offset); }
+                     .arg(mo->superClass()->className())
-            cl_object l_doc_met = collect_info("methods", cl, search, non, &found, mo);
+                     .toLatin1(); }
-            if(!non) {
+            if(non || qt_eql || LObjects::q_names.contains(cl)) {
-                l_doc_slo = collect_info("slots", cl, search, non, &found, mo);
+                cl_object l_doc_pro = ECL_NIL;
-                l_doc_sig = collect_info("signals", cl, search, non, &found, mo); }
+                cl_object l_doc_slo = ECL_NIL;
-            l_doc_ovr = collect_info("override", cl, search, non, &found, mo);
+                cl_object l_doc_sig = ECL_NIL;
-            if(found) {
+                cl_object l_doc_ovr = ECL_NIL;
-                cl_object l_doc = ECL_NIL;
+                if(!non) {
-                if(l_doc_pro != ECL_NIL) {
+                    l_doc_pro = collect_info("properties", cl, search, non, &found, mo, no_offset); }
-                    l_doc = CONS(CONS(STRING("Properties:"), l_doc_pro), l_doc); }
+                cl_object l_doc_met = collect_info("methods", cl, search, non, &found, mo);
-                if(l_doc_met != ECL_NIL) {
+                if(!non) {
-                    l_doc = CONS(CONS(STRING("Methods:"), l_doc_met), l_doc); }
+                    l_doc_slo = collect_info("slots", cl, search, non, &found, mo);
-                if(l_doc_slo != ECL_NIL) {
+                    l_doc_sig = collect_info("signals", cl, search, non, &found, mo); }
-                    l_doc = CONS(CONS(STRING("Slots:"), l_doc_slo), l_doc); }
+                l_doc_ovr = collect_info("override", cl, search, non, &found, mo);
-                if(l_doc_sig != ECL_NIL) {
+                if(found) {
-                    l_doc = CONS(CONS(STRING("Signals:"), l_doc_sig), l_doc); }
+                    cl_object l_doc = ECL_NIL;
-                if((l_doc_ovr != ECL_NIL) && !qt_eql) {
+                    if(l_doc_pro != ECL_NIL) {
-                    l_doc = CONS(CONS(STRING("Override:"), l_doc_ovr), l_doc); }
+                        l_doc = CONS(CONS(STRING("Properties:"), l_doc_pro), l_doc); }
-                l_doc = cl_nreverse(l_doc);
+                    if(l_doc_met != ECL_NIL) {
-                if(l_doc != ECL_NIL) {
+                        l_doc = CONS(CONS(STRING("Methods:"), l_doc_met), l_doc); }
-                    l_docs = CONS(CONS(STRING_COPY(cl.data()), l_doc), l_docs); }}}}
+                    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; }
 

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,
+        STATIC_SYMBOL_PKG (s_do_not_lispify, "DO-NOT-LISPIFY", "KEYWORD")
-                   s_define_qt_wrappers,
+        if(lispifyNames) {
-                   l_object); }}
+            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();

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&);

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*))

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.<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)
-                               :key 'first :test 'string=)))
+        (dolist (fun (rest (find functions (cdr class-functions)
-        (let* ((p (position #\( fun))
+                                 :key 'first :test 'string=)))
-               (qt-name (subseq fun (1+ (position #\Space fun :from-end t :end p)) p))
+          (let* ((p (position #\( fun))
-               (lisp-name (intern (with-output-to-string (s)
+                 (qt-name (subseq fun (1+ (position #\Space fun :from-end t :end p)) p))
-                                    (x:do-string (ch qt-name)
+                 (lisp-name (intern (if lispify
-                                      (if (upper-case-p ch)
+                                        (with-output-to-string (s)
-                                          (format s "-~C" ch)
+                                          (x:do-string (ch qt-name)
-                                          (write-char (char-upcase ch) s)))))))
+                                            (cond ((upper-case-p ch)
-          ;; no way to avoid EVAL here (excluding non-portable hacks)
+                                                   (format s "-~C" ch))
-          (eval `(defgeneric ,lisp-name (object &rest arguments)))
+                                                  ((char= #\_ ch)
-          (eval `(defmethod ,lisp-name ((object qt-object) &rest arguments)
+                                                   (write-char #\- s))
-                   (%qinvoke-method object :qt ,qt-name arguments))))))))
+                                                  (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)