a bunch of revisions

cpp-lib/cpp/cpp.pro

@@ -1,6 +1,7 @@
 QT          += widgets
 TEMPLATE    = lib
-CONFIG      += plugin release
+CONFIG      += plugin release no_keywords
+LIBS        += -L/usr/local/lib -lecl
 DESTDIR     = ../
 TARGET      = cpp
 OBJECTS_DIR = ./tmp/
@@ -10,5 +11,14 @@ win32 {
   include(../../src/windows.pri)
 }
 
-HEADERS += lib.h
+# 'marshal.*' and 'qt_ecl.*' only needed for calling Lisp
-SOURCES += lib.cpp
+
+HEADERS += \
+  lib.h \
+  ../../src/cpp/marshal.h \
+  ../../src/cpp/qt_ech.h
+
+SOURCES += \
+  lib.cpp \
+  ../../src/cpp/marshal.cpp \
+  ../../src/cpp/qt_ecl.cpp

cpp-lib/cpp/lib.cpp

@@ -1,4 +1,5 @@
 #include "lib.h"
+#include "../../src/cpp/ecl_fun.h" // for calling Lisp
 #include <QApplication>
 #include <QMessageBox>
 #include <QtDebug>
@@ -19,7 +20,10 @@ QObject* ini() {
   return cpp;
 }
 
+// functiones defined Q_INVOKABLE
+
 QVariant CPP::hello(const QVariant& arg) {
+
   QString msg;
   QDebug debug(&msg);
   debug << arg;
@@ -29,4 +33,9 @@ QVariant CPP::hello(const QVariant& arg) {
   return arg;
 }
 
+QVariant CPP::callLisp(const QVariant& arg) {
+
+  return ecl_fun("cl:format", false, "~R", arg);
+}
+
 QT_END_NAMESPACE

cpp-lib/cpp/lib.h

@@ -20,6 +20,7 @@ public:
   // max. 10 arguments of type QVariant
   // return type must also be a QVariant
   Q_INVOKABLE QVariant hello(const QVariant&);
+  Q_INVOKABLE QVariant callLisp(const QVariant&);
 };
 
 QT_END_NAMESPACE

cpp-lib/run.lisp

@@ -5,3 +5,6 @@
 ;; qrun* needed in Slime (not running on UI thread)
 
 (qrun* (print (hello *cpp* '(1 "two" (1.25 #(50 -50 75))))))
+
+(qrun* (print (call-lisp *cpp* 125)))
+

examples/9999/lisp/main.lisp

@@ -7,6 +7,12 @@
 (defvar *canvas* "canvas")
 (defvar *input*  "input")
 
+(defmacro with-path ((color &optional (line-width 14)) &body body)
+  `(progn
+     (qjs |begin| *canvas* ,color ,line-width)
+     ,@body
+     (qjs |end| *canvas*)))
+
 (defun draw-line (x1 y1 x2 y2)
   (qjs |drawLine| *canvas*
        x1 y1 x2 y2))
@@ -16,33 +22,35 @@
   (q! |requestPaint| *canvas*))
 
 (defun paint ()
-  (draw-line 0 -150 0 150)
+  (with-path ("black")
-  (let ((dy -50)
+    (draw-line 0 -150 0 150))
-        (dig 1))
+  (with-path ("blue")
-    (labels ((line (x1 y1 x2 y2)
+    (let ((dy -50)
-               (when (find dig '(2 4))
+          (dig 1))
-                 (setf x1 (- x1)
+      (labels ((line (x1 y1 x2 y2)
-                       x2 (- x2)))
+                 (when (find dig '(2 4))
-               (when (>= dig 3)
+                   (setf x1 (- x1)
-                 (setf y1 (- y1)
+                         x2 (- x2)))
-                       y2 (- y2)
+                 (when (>= dig 3)
-                       dy 50))
+                   (setf y1 (- y1)
-               (draw-line (* 100 x1) (+ dy (* 100 y1))
+                         y2 (- y2)
-                          (* 100 x2) (+ dy (* 100 y2))))
+                         dy 50))
-             (draw (n)
+                 (draw-line (* 100 x1) (+ dy (* 100 y1))
-               (case n
+                            (* 100 x2) (+ dy (* 100 y2))))
-                 (1 (line 0 -1  1 -1))
+               (draw (n)
-                 (2 (line 0  0  1  0))
+                 (case n
-                 (3 (line 0 -1  1  0))
+                   (1 (line 0 -1  1 -1))
-                 (4 (line 0  0  1 -1))
+                   (2 (line 0  0  1  0))
-                 (5 (draw 1) (draw 4))
+                   (3 (line 0 -1  1  0))
-                 (6 (line 1 -1  1  0))
+                   (4 (line 0  0  1 -1))
-                 (7 (draw 1) (draw 6))
+                   (5 (draw 1) (draw 4))
-                 (8 (draw 2) (draw 6))
+                   (6 (line 1 -1  1  0))
-                 (9 (draw 1) (draw 8)))))
+                   (7 (draw 1) (draw 6))
-      (let ((num *number*))
+                   (8 (draw 2) (draw 6))
-        (x:while (plusp num)
+                   (9 (draw 1) (draw 8)))))
-          (draw (mod num 10))
+        (let ((num *number*))
-          (setf num (floor (/ num 10)))
+          (x:while (plusp num)
-          (incf dig))))))
+            (draw (mod num 10))
+            (setf num (floor (/ num 10)))
+            (incf dig)))))))
 

examples/9999/qml/main.qml

@@ -13,24 +13,33 @@ Rectangle {
     width: 220
     height: 320
 
-    property var painter
+    property var ctx
-      
+
+    // functions to be called from Lisp
+
+    function begin(color, width) {
+      ctx.beginPath()
+      ctx.strokeStyle = color
+      ctx.lineWidth = width
+      ctx.lineCap = "round"
+    }
+
+    function end() {
+      ctx.stroke()
+    }
+
     function drawLine(x1, y1, x2, y2) {
-      painter.moveTo(x1, y1)
+      ctx.moveTo(x1, y1)
-      painter.lineTo(x2, y2)
+      ctx.lineTo(x2, y2)
     }
 
     onPaint: {
-      var ctx = getContext("2d")
+      ctx = getContext("2d")
-      painter = ctx
       ctx.reset()
-      ctx.strokeStyle = "blue"
-      ctx.lineWidth = 10
-      ctx.lineCap = "round"
       ctx.translate(110, 160)
-            
+
       Lisp.call("qml-user:paint")
-            
+
       ctx.stroke()
     }
   }

readme.md

@@ -26,6 +26,9 @@ Only tested with **Qt5.15** and latest **Qt6**. It's recommended to use the new
 Qt online installer (see [doc/get-qt6](doc/get-qt6.md)), where you can choose
 to install different Qt versions side by side, sharing the same Qt Creator.
 
+The **mobile** part is currently only tested with **Qt5.15**, because the Qt6
+port still lacks significant parts of mobile (as of Qt6.2).
+
 
 TODO
 ----

src/cpp/ecl_ext.cpp

@@ -348,7 +348,7 @@ cl_object qsingle_shot2(cl_object l_msec, cl_object l_fun) {
   ///   (qsingle-shot 1000 'one-second-later)
   ecl_process_env()->nvalues = 1;
   if (l_fun != ECL_NIL) {
-    new SingleShot(toInt(l_msec), l_fun); // see "delete this;" in "single_shot.h"
+    new SingleShot(toInt(l_msec), l_fun);
     return l_msec;
   }
   error_msg("QSINGLE-SHOT", LIST2(l_msec, l_fun));

src/cpp/main.cpp

@@ -51,12 +51,12 @@ int main(int argc, char* argv[]) {
 
   new QQmlFileSelector(view.engine(), &view);
   QString qml("qml/main.qml");
-  QUrl url("qrc:///" + qml);
+  QUrl url("qrc:///" + qml);        // (1) try resources first (final app)
   bool set = false;
   if (QFile::exists(url.fileName())) {
     set = true;
   } else {
-    url = QUrl::fromLocalFile(qml);
+    url = QUrl::fromLocalFile(qml); // (2) use local file (development)
     if (QFile::exists(QDir::currentPath() + "/" + qml)) {
       set = true;
     }
@@ -81,10 +81,11 @@ int main(int argc, char* argv[]) {
   bool slime = false;
   if (arguments.contains("-slime")
 #if QT_VERSION < 0x060000
-  || (arguments.indexOf(QRegularExpression::wildcardToRegularExpression("*start-swank*.lisp")) != -1)) {
+  || (arguments.indexOf(QRegularExpression::wildcardToRegularExpression("*start-swank*.lisp")) != -1)
 #else
-  || (arguments.indexOf(QRegularExpression::fromWildcard(QString("*start-swank*.lisp"))) != -1)) {
+  || (arguments.indexOf(QRegularExpression::fromWildcard(QString("*start-swank*.lisp"))) != -1)
 #endif
+    ) {
     arguments.removeAll("-slime");
     slime = true;
   }

src/cpp/marshal.cpp

@@ -188,7 +188,7 @@ QObject* toQObjectPointer(cl_object l_obj) {
 
 
 
-// *** Qt to Lisp
+// *** Qt to Lisp ***
 
 cl_object from_cstring(const QByteArray& s) {
   cl_object l_s = ecl_alloc_simple_base_string(s.length());

src/cpp/marshal.h

@@ -56,7 +56,7 @@ static cl_object from_##name(const cap_name& q) { \
 
 #define TO_QT_FLOAT_2(name) \
 static name to##name(cl_object x) { \
-  if(LISTP(x)) { \
+  if (LISTP(x)) { \
     return name(toReal(cl_first(x)), toReal(cl_second(x))); \
   } \
   return name(); \
@@ -64,7 +64,7 @@ static name to##name(cl_object x) { \
 
 #define TO_QT_FLOAT_4(name) \
 static name to##name(cl_object x) { \
-  if(LISTP(x)) { \
+  if (LISTP(x)) { \
     return name(toReal(cl_first(x)), toReal(cl_second(x)), toReal(cl_third(x)), toReal(cl_fourth(x))); \
   } \
   return name(); \

src/cpp/qml.cpp

@@ -1,7 +1,6 @@
 #include "qml.h"
 #include "lqml.h"
 #include "ecl_fun.h"
-#include <QQuickView>
 
 QT_BEGIN_NAMESPACE
 

src/cpp/qt_ecl.cpp

@@ -36,29 +36,29 @@ QVariant ecl_fun(const QByteArray& pkgFun,
                  const QVariant& a9,
                  const QVariant& a10) {
   void* symbol = lisp_functions.value(pkgFun);
-  if(!symbol) {
+  if (!symbol) {
     int p = pkgFun.indexOf(':');
     QByteArray pkg = (p == -1) ? "qml-user" : pkgFun.left(p);
     QByteArray fun = pkgFun.mid(pkgFun.lastIndexOf(':') + 1);
     cl_object l_sym = cl_find_symbol(2,
                                      make_constant_base_string(fun.toUpper().constData()),
                                      cl_find_package(make_constant_base_string(pkg.toUpper().constData())));
-    if(l_sym != Cnil) {
+    if (l_sym != Cnil) {
       symbol = l_sym;
       lisp_functions[pkgFun] = symbol;
     }
   }
   cl_object l_args = Cnil;
-  if(!a1.isNull()) { PUSH_ARG(a1);
+  if (!a1.isNull()) { PUSH_ARG(a1);
-    if(!a2.isNull()) { PUSH_ARG(a2);
+    if (!a2.isNull()) { PUSH_ARG(a2);
-      if(!a3.isNull()) { PUSH_ARG(a3);
+      if (!a3.isNull()) { PUSH_ARG(a3);
-        if(!a4.isNull()) { PUSH_ARG(a4);
+        if (!a4.isNull()) { PUSH_ARG(a4);
-          if(!a5.isNull()) { PUSH_ARG(a5);
+          if (!a5.isNull()) { PUSH_ARG(a5);
-            if(!a6.isNull()) { PUSH_ARG(a6);
+            if (!a6.isNull()) { PUSH_ARG(a6);
-              if(!a7.isNull()) { PUSH_ARG(a7);
+              if (!a7.isNull()) { PUSH_ARG(a7);
-                if(!a8.isNull()) { PUSH_ARG(a8);
+                if (!a8.isNull()) { PUSH_ARG(a8);
-                  if(!a9.isNull()) { PUSH_ARG(a9);
+                  if (!a9.isNull()) { PUSH_ARG(a9);
-                    if(!a10.isNull()) { PUSH_ARG(a10); }
+                    if (!a10.isNull()) { PUSH_ARG(a10); }
                   }
                 }
               }
@@ -69,7 +69,7 @@ QVariant ecl_fun(const QByteArray& pkgFun,
     }
   }
   l_args = cl_nreverse(l_args);
-  if(symbol) {
+  if (symbol) {
     cl_object l_ret = lisp_apply((cl_object)symbol, l_args);
     return toQVariant(l_ret);
   }

src/lisp/ini.lisp

@@ -142,6 +142,7 @@
   `(qrun-on-ui-thread* ,@body))
 
 (defun qfind-children (object &optional object-name class-name)
+  ;; for internal use
   (%qfind-children object object-name class-name))
 
 (defun qload-c++ (library-name &optional unload)

src/lisp/package.lisp

@@ -8,7 +8,6 @@
    #:children
    #:define-qt-wrappers
    #:find-quick-item
-   #:js
    #:pixel-ratio
    #:qapropos
    #:qapropos*

src/lisp/x.lisp

@@ -2,11 +2,9 @@
   (:use :common-lisp)
   (:export
    #:cc
-   #:check-recompile
    #:bytes-to-string
    #:d
    #:do-string
-   #:do-with
    #:empty-string
    #:ensure-list
    #:ends-with
@@ -15,8 +13,6 @@
    #:if-it
    #:if-it*
    #:join
-   #:let-it
-   #:path
    #:split
    #:starts-with
    #:string-substitute
@@ -39,11 +35,6 @@
   `(let ((it* ,exp))
     (if it* ,then ,else)))
 
-(defmacro let-it (exp &body body)
-  `(let ((it ,exp))
-     ,@body
-     it))
-
 (defmacro when-it (exp &body body)
   `(let ((it ,exp))
     (when it ,@body)))
@@ -74,15 +65,6 @@
                 ,@body)
           ,str)))
 
-(defmacro do-with (with &body body)
-  `(progn
-     ,@(mapcar (lambda (line)
-                 (append with (if (or (atom line)
-                                      (eql 'quote (first line)))
-                                  (list line)
-                                  line)))
-               body)))
-
 (defun d (&rest args)
   "A simple debug print."
   (print (cons :debug args)))
@@ -147,31 +129,3 @@
 (defun string-to-bytes (s)
   (map 'vector 'char-code s))
 
-(defun path (name)
-  "Needed because ECL uses base strings (not Unicode) for pathnames internally."
-  #+(or darwin linux)
-  (funcall (intern "QUTF8" :eql) name)
-  #+win32
-  (if (< (funcall (intern "%WINDOWS-VERSION" :eql)) #xa0)
-      (funcall (intern "QLOCAL8BIT" :eql) name)           ; Windows 7 and lower
-      name))                                              ; Windows 8 and higher
-
-(defun check-recompile (file-name)
-  "Given a global file name without file ending, ensures re-compiling on every ECL/Qt5/EQL5 version change."
-  (labels ((ver-name ()
-             (format nil "~A.ver" file-name))
-           (version ()
-             (multiple-value-bind (eql5 qt5)
-                 (funcall (find-symbol "QVERSION" :eql))
-               (format nil "EQL5 ~A (ECL ~A, Qt ~A)" eql5 (lisp-implementation-version) qt5)))
-           (write-version ()
-             (with-open-file (s (ver-name) :direction :output :if-exists :supersede)
-               (princ (version) s)))
-           (read-version ()
-             (x:when-it (probe-file (ver-name))
-               (with-open-file (s x:it :direction :input)
-                 (read-line s)))))
-    (unless (equal (version) (read-version))
-      (compile-file file-name)
-      (write-version)))
-  file-name)