diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3dd0d9c --- /dev/null +++ b/.gitignore @@ -0,0 +1,29 @@ +TODO +lqml +build +_* +*.a +*.fas* +*.*history +*.lib +*.o +*.obj +*.so* +*.qm +*.stash +*.ts +*~ +*.~ +#*.*# +*.user +t.lisp +tr.h +moc_*.cpp +Makefile +Makefile.* +cache +tmp* +qrc_*.cpp +assets +android-build +*.tgz diff --git a/examples/9999/doc/9999.jpg b/examples/9999/doc/9999.jpg new file mode 100644 index 0000000..59c3b2b Binary files /dev/null and b/examples/9999/doc/9999.jpg differ diff --git a/examples/9999/doc/readme.txt b/examples/9999/doc/readme.txt new file mode 100644 index 0000000..6d1c5df --- /dev/null +++ b/examples/9999/doc/readme.txt @@ -0,0 +1,3 @@ +simple canvas example: draw in JS, calculate in Lisp + +see also: https://en.wikipedia.org/wiki/Cistercian_numerals diff --git a/examples/9999/lisp/main.lisp b/examples/9999/lisp/main.lisp new file mode 100644 index 0000000..39c4b40 --- /dev/null +++ b/examples/9999/lisp/main.lisp @@ -0,0 +1,48 @@ +(in-package :qml-user) + +(defvar *number* 0) + +;;; QML items + +(defvar *canvas* "canvas") +(defvar *input* "input") + +(defun draw-line (x1 y1 x2 y2) + (qjs |drawLine| *canvas* + x1 y1 x2 y2)) + +(defun draw-number (number) + (setf *number* number) + (q! |requestPaint| *canvas*)) + +(defun paint () + (draw-line 0 -150 0 150) + (let ((dy -50) + (dig 1)) + (labels ((line (x1 y1 x2 y2) + (when (find dig '(2 4)) + (setf x1 (- x1) + x2 (- x2))) + (when (>= dig 3) + (setf y1 (- y1) + y2 (- y2) + dy 50)) + (draw-line (* 100 x1) (+ dy (* 100 y1)) + (* 100 x2) (+ dy (* 100 y2)))) + (draw (n) + (case n + (1 (line 0 -1 1 -1)) + (2 (line 0 0 1 0)) + (3 (line 0 -1 1 0)) + (4 (line 0 0 1 -1)) + (5 (draw 1) (draw 4)) + (6 (line 1 -1 1 0)) + (7 (draw 1) (draw 6)) + (8 (draw 2) (draw 6)) + (9 (draw 1) (draw 8))))) + (let ((num *number*)) + (x:while (plusp num) + (draw (mod num 10)) + (setf num (floor (/ num 10))) + (incf dig)))))) + diff --git a/examples/9999/qml/main.qml b/examples/9999/qml/main.qml new file mode 100644 index 0000000..39be60d --- /dev/null +++ b/examples/9999/qml/main.qml @@ -0,0 +1,49 @@ +import QtQuick +import QtQuick.Controls +import Lisp + +Rectangle { + width: 220 + height: 320 + input.height + color: "lavender" + + Canvas { + id: canvas + objectName: "canvas" + width: 220 + height: 320 + + property var painter + + function drawLine(x1, y1, x2, y2) { + painter.moveTo(x1, y1) + painter.lineTo(x2, y2) + } + + onPaint: { + var 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() + } + } + + TextField { + id: input + objectName: "input" + width: parent.width + anchors.bottom: parent.bottom + horizontalAlignment: Qt.AlignHCenter + text: "0000" + inputMask: "9999" + + onTextChanged: Lisp.call("qml-user:draw-number", Number(text)) + } +} diff --git a/examples/9999/run.lisp b/examples/9999/run.lisp new file mode 100644 index 0000000..7a77ab1 --- /dev/null +++ b/examples/9999/run.lisp @@ -0,0 +1,14 @@ +(in-package :qml-user) + +(load "lisp/main") + +(qset *quick-view* + |x| 75 + |y| 75) + +;;; for Slime after copying 'qml-start-swank.lisp' from LQML sources +;;; to your Slime directory, which is assumed to be '~/slime/' + +(when (find "-slime" (ext:command-args) :test 'string=) + (load "~/slime/qml-start-swank")) ; for 'slime-connect' from Emacs + diff --git a/readme-build.md b/readme-build.md new file mode 100644 index 0000000..05db772 --- /dev/null +++ b/readme-build.md @@ -0,0 +1,16 @@ + +Build +----- + +Currently still using qmake, will be ported to CMake + +* make sure you have both **ECL** and **Qt6** installed +* make sure to use `qmake` from Qt6 + +``` +$ cd src/build +$ qmake ../lqml.pro +$ make +$ sudo make install +``` + diff --git a/readme.md b/readme.md index 6cd61c4..0c3b602 100644 --- a/readme.md +++ b/readme.md @@ -1,5 +1,13 @@ -Summary -------- + +WIP +--- + +Currently Linux/desktop only, will be extended to all platforms (including +mobile); not so sure about Windows though... + + +Description +----------- A lightweight ECL based QML-only binding to Qt6. @@ -7,5 +15,18 @@ A lightweight ECL based QML-only binding to Qt6. License ------- -Both ECL and Qt6 are LGPL. LQML can be considered public domain. +Both ECL and Qt6 are LGPL. +LQML can be considered public domain. + + +TODO +---- + +* port to CMake +* generate help from docu strings +* make example work on android +* make example work on iOS +* add sokoban example +* add item model example +* add cpp-lib example diff --git a/slime/qml-start-swank.lisp b/slime/qml-start-swank.lisp new file mode 100644 index 0000000..6b2d732 --- /dev/null +++ b/slime/qml-start-swank.lisp @@ -0,0 +1,20 @@ +;;; This file is intended to be loaded by an implementation to +;;; get a running swank server +;;; e.g. ecl -load start-swank.lisp +;;; +;;; Default port is 4005 + +;;; For additional swank-side configurations see +;;; 6.2 section of the Slime user manual. + +(load (merge-pathnames "swank-loader.lisp" *load-truename*)) + +(swank-loader:init + :delete t ; delete any existing SWANK packages + :reload nil ; reload SWANK, even if the SWANK package already exists + :load-contribs t) ; load all contribs + +(swank:create-server :port 4005 + :style :spawn + :dont-close t) ; allow to quit/restart Emacs + diff --git a/src/cpp/ecl_ext.cpp b/src/cpp/ecl_ext.cpp new file mode 100644 index 0000000..cfd5ae5 --- /dev/null +++ b/src/cpp/ecl_ext.cpp @@ -0,0 +1,620 @@ +#include "ecl_ext.h" +#include "marshal.h" +#include "lqml.h" +#include "single_shot.h" +#include +#include +#include +#include +#include +#include +#include +#include + +QT_BEGIN_NAMESPACE + +void iniCLFunctions() { + cl_object qml(STRING("QML")); + if (cl_find_package(qml) == ECL_NIL) { + cl_make_package(1, qml); + } + si_select_package(qml); + DEFUN ("%js", js2, 2) + DEFUN ("pixel-ratio", pixel_ratio, 0) + DEFUN ("%qapropos", qapropos2, 3) + DEFUN ("qchild-items", qchild_items, 1) + DEFUN ("qescape", qescape, 1) + DEFUN ("%qexec", qexec2, 1) + DEFUN ("qexit", qexit, 0) + DEFUN ("qfind-child", qfind_child, 2) + DEFUN ("%qfind-children", qfind_children2, 3) + DEFUN ("qfrom-utf8", qfrom_utf8, 1) + DEFUN ("%qinvoke-method", qinvoke_method2, 3) + DEFUN ("%qload-c++", qload_cpp, 2) + DEFUN ("qlocal8bit", qlocal8bit, 1) + DEFUN ("%qlog", qlog2, 1) + DEFUN ("%qml-get", qml_get2, 2) + DEFUN ("%qml-set", qml_set2, 3) + DEFUN ("qobject-name", qobject_name, 1) + DEFUN ("qprocess-events", qprocess_events, 0) + DEFUN ("%qquit", qquit2, 1) + DEFUN ("%qrun-on-ui-thread", qrun_on_ui_thread2, 2) + DEFUN ("%qget", qget2, 2) + DEFUN ("%qset", qset2, 2) + DEFUN ("%qsingle-shot", qsingle_shot2, 2) + DEFUN ("qtranslate", qtranslate, 3) + DEFUN ("qutf8", qutf8, 1) + DEFUN ("qversion", qversion, 0) + DEFUN ("reload", reload, 0) + DEFUN ("root-item", root_item, 0) + DEFUN ("%set-shutdown-p", set_shutdown_p, 1) +} + + + +// *** utils *** + +void error_msg(const char* fun, cl_object l_args) { + STATIC_SYMBOL_PKG (s_break_on_errors, "*BREAK-ON-ERRORS*", "QML") + if (cl_symbol_value(s_break_on_errors) != ECL_NIL) { + STATIC_SYMBOL_PKG (s_break, "%BREAK", "QML") // see "ini.lisp" + cl_funcall(4, + s_break, + STRING("~%[LQML:error] ~A ~{~S~^ ~}~%"), + STRING(fun), + l_args); + } + else { + STATIC_SYMBOL (s_error_output, "*ERROR-OUTPUT*") + cl_format(4, + cl_symbol_value(s_error_output), + STRING("~%[LQML:error] ~A ~{~S~^ ~}~%"), + STRING(fun), + l_args); + } +} + + + +// *** main functions *** + +cl_object set_shutdown_p(cl_object l_obj) { + LQML::cl_shutdown_p = (l_obj != ECL_NIL); + ecl_return1(ecl_process_env(), l_obj); +} + +cl_object qget2(cl_object l_obj, cl_object l_name) { + QObject* qobject = toQObjectPointer(l_obj); + if (ECL_STRINGP(l_name) && (qobject != nullptr)) { + const QMetaObject* mo = qobject->metaObject(); + int n = mo->indexOfProperty(toCString(l_name)); + if (n != -1) { + QMetaProperty mp(mo->property(n)); + QVariant var(mp.read(qobject)); + cl_object l_ret1 = from_qvariant(var); + ecl_return2(ecl_process_env(), l_ret1, ECL_T); + } + } + ecl_process_env()->nvalues = 1; + error_msg("QGET", LIST2(l_obj, l_name)); + ecl_return1(ecl_process_env(), ECL_NIL); +} + +cl_object qset2(cl_object l_obj, cl_object l_args) { + QObject* qobject = toQObjectPointer(l_obj); + if (qobject != nullptr) { + const QMetaObject* mo = qobject->metaObject(); + for (cl_object l_do = l_args; l_do != ECL_NIL; l_do = cl_cddr(l_do)) { + cl_object l_name = cl_first(l_do); + cl_object l_val = cl_second(l_do); + int n = mo->indexOfProperty(toCString(l_name)); + if (n == -1) { + goto fail; + } + QMetaProperty mp(mo->property(n)); + QVariant var; + if (mp.isEnumType()) { + var = toInt(l_val); + } + else { + var = toQVariant(l_val, mp.typeId()); + } + if (!mp.write(qobject, var)) { + goto fail; + } + } + ecl_return2(ecl_process_env(), l_args, ECL_T); + } +fail: + error_msg("QSET", LIST2(l_obj, l_args)); + ecl_return1(ecl_process_env(), ECL_NIL); +} + +cl_object qfind_child(cl_object l_obj, cl_object l_name) { + ecl_process_env()->nvalues = 1; + QString name(toQString(l_name)); + if (!name.isEmpty()) { + QObject* qobject = toQObjectPointer(l_obj); + if (qobject != nullptr) { + QObject* obj = qobject->findChild(name); + if (obj != nullptr) { + cl_object l_ret = from_qobject_pointer(obj); + return l_ret; + } + } + } + error_msg("QFIND-CHILD", LIST2(l_obj, l_name)); + return ECL_NIL; +} + +cl_object qfind_children2(cl_object l_obj, cl_object l_name, cl_object l_class) { + ecl_process_env()->nvalues = 1; + QString objectName(toQString(l_name)); + QByteArray className(toCString(l_class)); + QObject* qobject = toQObjectPointer(l_obj); + if (qobject != nullptr) { + QObjectList children = qobject->findChildren(objectName); + cl_object l_children = ECL_NIL; + Q_FOREACH(QObject* child, children) { + QByteArray className2(child->metaObject()->className()); + if (className.isEmpty() || (className == className2)) { + l_children = CONS(from_qobject_pointer(child), + l_children); + } + } + l_children = cl_nreverse(l_children); + return l_children; + } + error_msg("QFIND-CHILDREN", LIST3(l_obj, l_name, l_class)); + return ECL_NIL; +} + +cl_object qchild_items(cl_object l_item) { + ecl_process_env()->nvalues = 1; + QObject* qobject = toQObjectPointer(l_item); + QQuickItem* item = qobject_cast(qobject); // type check + if (item != nullptr) { + QList children = item->childItems(); + cl_object l_children = ECL_NIL; + Q_FOREACH(QQuickItem* child, children) { + l_children = CONS(from_qobject_pointer(child), + l_children); + } + l_children = cl_nreverse(l_children); + return l_children; + } + error_msg("QCHILD-ITEMS", LIST1(l_item)); + return ECL_NIL; +} + +cl_object qload_cpp(cl_object l_lib_name, cl_object l_unload) { /// qload-c++ + static QHash libraries; + QString libName = toQString(l_lib_name); + bool unload = (l_unload != ECL_NIL); + if (!libName.isEmpty()) { + if (!libName.contains('/')) { + libName.prepend("./"); + } + QLibrary* lib = libraries.value(libName, 0); + if (lib) { + if (lib->isLoaded()) { + lib->unload(); // for both unload/reload + if (!unload) { + cl_sleep(ecl_make_singlefloat(0.5)); + } + } + } + if (unload) { + ecl_process_env()->nvalues = 1; + if (lib) { + delete lib; + libraries.remove(libName); + return l_lib_name; + } + return ECL_NIL; + } + if (!lib) { + lib = new QLibrary(libName); + libraries[libName] = lib; + } + typedef QObject* (*Ini)(); + Ini ini = (Ini)lib->resolve("ini"); + if (ini) { + QObject* main = ini(); + if (main) { + ecl_return1(ecl_process_env(), ECL_T); + } + } + } + error_msg("QLOAD-C++", LIST2(l_lib_name, l_unload)); + ecl_return1(ecl_process_env(), ECL_NIL); +} + + + +// *** convenience functions *** + +cl_object qtranslate(cl_object l_con, cl_object l_src, cl_object l_n) { + QByteArray context(toQString(l_con).toUtf8()); + QByteArray source(toQString(l_src).toUtf8()); + int n = toInt(l_n); + cl_object l_ret; + if (n == -1) { + l_ret = from_qstring(QCoreApplication::translate(context, source)); + } + else { + l_ret = from_qstring(QCoreApplication::translate(context, source, 0, n)); + } + ecl_return1(ecl_process_env(), l_ret); +} + +cl_object qlocal8bit(cl_object l_str) { + // returns 'ecl_simple_base_string', not Unicode + cl_object l_ret = from_cstring(toQString(l_str).toLocal8Bit()); + ecl_return1(ecl_process_env(), l_ret); +} + +cl_object qutf8(cl_object l_str) { + // returns 'ecl_simple_base_string', not Unicode + cl_object l_ret = from_cstring(toQString(l_str).toUtf8()); + ecl_return1(ecl_process_env(), l_ret); +} + +cl_object qfrom_utf8(cl_object l_ba) { + cl_object l_ret = from_qstring(QString::fromUtf8(toQByteArray(l_ba))); + ecl_return1(ecl_process_env(), l_ret); +} + +cl_object qescape(cl_object l_str) { + cl_object l_ret = from_qstring(toQString(l_str).toHtmlEscaped()); + ecl_return1(ecl_process_env(), l_ret); +} + +cl_object qprocess_events() { + QGuiApplication::processEvents(); + ecl_return1(ecl_process_env(), ECL_T); +} + +cl_object qexec2(cl_object l_milliseconds) { + ecl_process_env()->nvalues = 1; + if (l_milliseconds != ECL_NIL) { + static QTimer* timer = 0; + if (!timer) { + timer = new QTimer; + LQML::eventLoop = new QEventLoop; + timer->setSingleShot(true); + QObject::connect(timer, &QTimer::timeout, LQML::me, &LQML::exitEventLoop); + } + timer->start(toInt(l_milliseconds)); + LQML::eventLoop->exec(); + return l_milliseconds; + } + QCoreApplication::exit(); // prevent "the event loop is already running" + QGuiApplication::exec(); + return ECL_T; +} + +cl_object qexit() { + ecl_process_env()->nvalues = 1; + if (LQML::eventLoop) { + if (LQML::eventLoop->isRunning()) { + LQML::eventLoop->exit(); + return ECL_T; + } + } + return ECL_NIL; +} + +cl_object qsingle_shot2(cl_object l_msec, cl_object l_fun) { + ecl_process_env()->nvalues = 1; + if (l_fun != ECL_NIL) { + new SingleShot(toInt(l_msec), l_fun); // see "delete this;" in "single_shot.h" + return l_msec; + } + error_msg("QSINGLE-SHOT", LIST2(l_msec, l_fun)); + return ECL_NIL; +} + +cl_object qversion() { + cl_object l_ret1 = from_cstring(LQML::version); + cl_object l_ret2 = from_cstring(qVersion()); + ecl_return2(ecl_process_env(), l_ret1, l_ret2); +} + +cl_object qrun_on_ui_thread2(cl_object l_function_or_closure, cl_object l_blocking) { + ecl_process_env()->nvalues = 1; + if (l_function_or_closure != ECL_NIL) { + QObject o; + if (o.thread() == qGuiApp->thread()) { + // direct call + LQML::me->runOnUiThread(l_function_or_closure); + return ECL_T; + } + else { + // queued call in main event loop (GUI thread) + QMetaObject::invokeMethod(LQML::me, + "runOnUiThread", + (l_blocking != ECL_NIL) ? Qt::BlockingQueuedConnection : Qt::QueuedConnection, + Q_ARG(void*, l_function_or_closure)); + return ECL_T; + } + } + error_msg("QRUN-ON-UI-THREAD", LIST1(l_function_or_closure)); + return ECL_NIL; +} + +cl_object qlog2(cl_object l_msg) { + // for android logging only; see 'ini.lisp::qlog' and 'lqml.cpp::logMessageHandler' + qDebug() << toQString(l_msg); + ecl_return1(ecl_process_env(), ECL_NIL); +} + +cl_object qinvoke_method2(cl_object l_obj, cl_object l_name, cl_object l_args) { + // max. 10 arguments + // supported argument types: T, NIL, INTEGER, FLOAT, STRING, + // (nested) LIST of mentioned arguments + // + // N.B. does not support default arguments if used to call JS functions + ecl_process_env()->nvalues = 1; + const int MAX = 10; + QVariant arg[MAX]; + QGenericArgument genA[MAX]; + const char* v = "QVariant"; + int i = 0; + for (cl_object l_do_list = l_args; l_do_list != ECL_NIL; l_do_list = cl_cdr(l_do_list), i++) { + cl_object l_el = cl_car(l_do_list); + arg[i] = toQVariant(l_el); + genA[i] = QGenericArgument(v, &arg[i]); + } + QGenericArgument null; + for (; i < MAX; i++) { + genA[i] = null; + } + QObject* qobject = toQObjectPointer(l_obj); + QByteArray name(toCString(l_name)); + if ((qobject != nullptr) && !name.isEmpty()) { + QVariant ret; + QGenericReturnArgument genR(v, &ret); + QMetaObject::invokeMethod(qobject, name, genR, + genA[0], genA[1], genA[2], genA[3], genA[4], genA[5], genA[6], genA[7], genA[8], genA[9]); + cl_object l_ret = from_qvariant(ret); + return l_ret; + } + error_msg("QJS", LIST3(l_obj, l_name, l_args)); + return ECL_NIL; +} + +cl_object js2(cl_object l_item, cl_object l_str) { + ecl_process_env()->nvalues = 1; + QObject* qobject = toQObjectPointer(l_item); + if (qobject != nullptr) { + QQmlExpression exp(LQML::quickView->rootContext(), qobject, toQString(l_str)); + cl_object l_ret = from_qvariant(exp.evaluate()); + return l_ret; + } + error_msg("JS", LIST2(l_item, l_str)); + return ECL_NIL; +} + +cl_object qml_get2(cl_object l_item, cl_object l_name) { + QObject* qobject = toQObjectPointer(l_item); + QByteArray name = toCString(l_name); + if ((qobject != nullptr) && !name.isEmpty()) { + QQmlProperty property(qobject, name); + if (property.isValid()) { + cl_object l_val = from_qvariant(property.read()); + ecl_return2(ecl_process_env(), l_val, ECL_T); + } + } + error_msg("QML-GET", LIST2(l_item, l_name)); + ecl_return1(ecl_process_env(), ECL_NIL); +} + +cl_object qml_set2(cl_object l_item, cl_object l_name, cl_object l_value) { + ecl_process_env()->nvalues = 1; + QObject* qobject = toQObjectPointer(l_item); + QByteArray name = toCString(l_name); + if ((qobject != nullptr) && !name.isEmpty()) { + QQmlProperty property(qobject, name); + if (property.isValid()) { + cl_object l_ret = property.write(toQVariant(l_value, property.propertyType())) + ? ECL_T : ECL_NIL; + return l_ret; + } + } + error_msg("QML-SET", LIST3(l_item, l_name, l_value)); + return ECL_NIL; +} + +cl_object qobject_name(cl_object l_obj) { + ecl_process_env()->nvalues = 1; + QObject* qobject = toQObjectPointer(l_obj); + if (qobject != nullptr) { + cl_object l_ret = from_qstring(qobject->objectName()); + return l_ret; + } + error_msg("QOBJECT-NAME", LIST1(l_obj)); + return ECL_NIL; +} + +cl_object root_item() { + ecl_process_env()->nvalues = 1; + cl_object l_ret = from_qobject_pointer(LQML::quickView->rootObject()); + ecl_return1(ecl_process_env(), l_ret); +} + +cl_object qquit2(cl_object l_status) { + qGuiApp->quit(); + cl_shutdown(); + LQML::cl_shutdown_p = true; + int s = toInt(l_status); + if (s < 0) { + abort(); + } else { + exit(s); + } + return ECL_NIL; +} + +cl_object pixel_ratio() { + cl_object l_ret = ecl_make_doublefloat(LQML::quickView->effectiveDevicePixelRatio()); + ecl_return1(ecl_process_env(), l_ret); +} + +cl_object reload() { + LQML::quickView->engine()->clearComponentCache(); + QUrl source(LQML::quickView->source()); + LQML::quickView->setSource(source); + cl_object l_ret = from_qstring(source.toString()); + ecl_return1(ecl_process_env(), l_ret); +} + + + +// *** meta info *** + +static QByteArrayList metaInfo(const QByteArray& type, + const QByteArray& qclass, + const QByteArray& search, + const QMetaObject* mo, + bool no_offset = false) { + QByteArrayList info; + if ("methods" == type) { + for (int i = mo->methodOffset(); i < mo->methodCount(); i++) { + QMetaMethod mm(mo->method(i)); + if (mm.methodType() == QMetaMethod::Method) { + QString sig(mm.methodSignature()); + QString ret(mm.typeName()); + if (ret.isEmpty()) { + ret = "void"; + } + ret.append(" "); + if (!sig.startsWith("_q_")) { + QString name(ret + sig); + QByteArray rm('(' + qclass + '*'); + if (mm.parameterNames().size() > 1) { + rm.append(','); + } + name.replace(rm, "("); + if (name.contains(search, Qt::CaseInsensitive)) { + info << name.toLatin1(); + } + } + } + } + } else if ("properties" == type) { + // 'no_offset' is for properties only (QML) + for (int i = (no_offset ? 0 : mo->propertyOffset()); i < mo->propertyCount(); i++) { + QMetaProperty mp(mo->property(i)); + QString name = QString("%1 %2%3").arg(mp.typeName()) + .arg(mp.name()) + .arg(mp.isWritable() ? "" : " const"); + if (name.contains(search, Qt::CaseInsensitive)) { + info << name.toLatin1(); + } + } + } else { + int _type = ("signals" == type) ? QMetaMethod::Signal : QMetaMethod::Slot; + for (int i = mo->methodOffset(); i < mo->methodCount(); i++) { + QMetaMethod mm(mo->method(i)); + if (mm.methodType() == _type) { + QString ret(mm.typeName()); + if (ret.isEmpty()) { + ret = "void"; + } + QString sig(mm.methodSignature()); + if (!sig.startsWith("_q_")) { + QString name(QString("%1 %2").arg(ret).arg(sig)); + if (name.contains(search, Qt::CaseInsensitive)) { + info << name.toLatin1(); + } + } + } + } + } + return info; +} + +static bool metaInfoLessThan(const QByteArray& s1, const QByteArray& s2) { + if (s1.contains('(')) { + return s1.mid(1 + s1.lastIndexOf(' ', s1.indexOf('('))) < + s2.mid(1 + s2.lastIndexOf(' ', s2.indexOf('('))); + } + return s1.mid(1 + s1.indexOf(' ')) < + s2.mid(1 + s2.indexOf(' ')); +} + +static cl_object collectInfo(const QByteArray& type, + const QByteArray& qclass, + const QByteArray& qsearch, + bool* found, + const QMetaObject* mo, + bool no_offset = false) { + cl_object l_info = ECL_NIL; + QByteArrayList info = metaInfo(type, qclass, qsearch, mo, no_offset); + std::sort(info.begin(), info.end(), metaInfoLessThan); + if (info.size()) { + *found = true; + Q_FOREACH(QByteArray i, info) { + l_info = CONS(STRING_COPY(i.constData()), l_info); + } + } + l_info = cl_nreverse(l_info); + return l_info; +} + +cl_object qapropos2(cl_object l_search, cl_object l_obj, cl_object l_no_offset) { + ecl_process_env()->nvalues = 1; + QByteArray search; + if (ECL_STRINGP(l_search)) { + search = toCString(l_search); + } + bool no_offset = (l_no_offset != ECL_NIL); // for QML (all instance properties) + const QMetaObject* mo = 0; + QObject* obj = toQObjectPointer(l_obj); + if (obj != nullptr) { + mo = obj->metaObject(); + cl_object l_docs = ECL_NIL; + do { + bool found = false; + const QMetaObject* super = mo->superClass(); + QString superName; + if (super != nullptr) { + superName = QString(" : %1").arg(super->className()); + } + QByteArray _class = (QString(mo->className()) + superName).toLatin1(); + cl_object l_doc_pro = ECL_NIL; + cl_object l_doc_slo = ECL_NIL; + cl_object l_doc_sig = ECL_NIL; + l_doc_pro = collectInfo("properties", _class, search, &found, mo, no_offset); + cl_object l_doc_met = collectInfo("methods", _class, search, &found, mo); + l_doc_slo = collectInfo("slots", _class, search, &found, mo); + l_doc_sig = collectInfo("signals", _class, search, &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); + } + l_doc = cl_nreverse(l_doc); + if (l_doc != ECL_NIL) { + l_docs = CONS(CONS(STRING_COPY(_class.data()), l_doc), l_docs); + } + } + } while ((mo = mo->superClass())); + cl_object l_ret = cl_nreverse(l_docs); + return l_ret; + } + error_msg("QAPROPOS", LIST3(l_search, l_obj, l_no_offset)); + return ECL_NIL; +} + +QT_END_NAMESPACE diff --git a/src/cpp/ecl_ext.h b/src/cpp/ecl_ext.h new file mode 100644 index 0000000..d027c07 --- /dev/null +++ b/src/cpp/ecl_ext.h @@ -0,0 +1,87 @@ +#ifndef ECL_EXT_H +#define ECL_EXT_H + +#include +#include +#include + +QT_BEGIN_NAMESPACE + +#define DEFUN(name, c_name, num_args) \ + ecl_def_c_function(ecl_read_from_cstring(name), (cl_objectfn_fixed)c_name, num_args); + +#define STRING(s) ecl_make_constant_base_string(s, -1) + +#define STRING_COPY(s) (s ? ecl_make_simple_base_string(s, -1) : ECL_NIL) + +#define PRINT(x) cl_print(1, x) + +#define TERPRI() cl_terpri(0) + +#define STATIC_SYMBOL(var, name) \ + static cl_object var = cl_intern(1, ecl_make_constant_base_string(name, -1)); + +#define STATIC_SYMBOL_PKG(var, name, pkg) \ + static cl_object var = cl_intern(2, \ + ecl_make_constant_base_string(name, -1), \ + cl_find_package(ecl_make_constant_base_string(pkg, -1))); + +#define LEN(x) fixint(cl_length(x)) + +#define LIST1(a1) \ + CONS(a1, ECL_NIL) +#define LIST2(a1, a2) \ + CONS(a1, LIST1(a2)) +#define LIST3(a1, a2, a3) \ + CONS(a1, LIST2(a2, a3)) +#define LIST4(a1, a2, a3, a4) \ + CONS(a1, LIST3(a2, a3, a4)) +#define LIST5(a1, a2, a3, a4, a5) \ + CONS(a1, LIST4(a2, a3, a4, a5)) +#define LIST6(a1, a2, a3, a4, a5, a6) \ + CONS(a1, LIST5(a2, a3, a4, a5, a6)) +#define LIST7(a1, a2, a3, a4, a5, a6, a7) \ + CONS(a1, LIST6(a2, a3, a4, a5, a6, a7)) +#define LIST8(a1, a2, a3, a4, a5, a6, a7, a8) \ + CONS(a1, LIST7(a2, a3, a4, a5, a6, a7, a8)) +#define LIST9(a1, a2, a3, a4, a5, a6, a7, a8, a9) \ + CONS(a1, LIST8(a2, a3, a4, a5, a6, a7, a8, a9)) +#define LIST10(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) \ + CONS(a1, LIST9(a2, a3, a4, a5, a6, a7, a8, a9, a10)) + +cl_object js2 (cl_object, cl_object); +cl_object pixel_ratio (); +cl_object qapropos2 (cl_object, cl_object, cl_object); +cl_object qchild_items (cl_object); +cl_object qescape (cl_object); +cl_object qexec2 (cl_object); +cl_object qexit (); +cl_object qfind_child (cl_object, cl_object); +cl_object qfind_children2 (cl_object, cl_object, cl_object); +cl_object qfrom_utf8 (cl_object); +cl_object qinvoke_method2 (cl_object, cl_object, cl_object); +cl_object qload_cpp (cl_object, cl_object); +cl_object qlocal8bit (cl_object); +cl_object qlog2 (cl_object); +cl_object qml_get2 (cl_object, cl_object); +cl_object qml_set2 (cl_object, cl_object, cl_object); +cl_object qobject_name (cl_object); +cl_object qprocess_events (); +cl_object qquit2 (cl_object); +cl_object qrun_on_ui_thread2 (cl_object, cl_object); +cl_object qget2 (cl_object, cl_object); +cl_object qset2 (cl_object, cl_object); +cl_object qsingle_shot2 (cl_object, cl_object); +cl_object qtranslate (cl_object, cl_object, cl_object); +cl_object qutf8 (cl_object); +cl_object qversion (); +cl_object reload (); +cl_object root_item (); +cl_object set_shutdown_p (cl_object); + +void iniCLFunctions(); +void error_msg(const char*, cl_object); + +QT_END_NAMESPACE + +#endif diff --git a/src/cpp/ecl_fun.h b/src/cpp/ecl_fun.h new file mode 100644 index 0000000..e23c785 --- /dev/null +++ b/src/cpp/ecl_fun.h @@ -0,0 +1,26 @@ +// header to be included in external Qt libraries +// for calling ECL functions from Qt + +#ifndef ECL_FUN_H +#define ECL_FUN_H + +#include + +QT_BEGIN_NAMESPACE + +extern QVariant ecl_fun( + const QByteArray&, + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant()); + +QT_END_NAMESPACE + +#endif diff --git a/src/cpp/lqml.cpp b/src/cpp/lqml.cpp new file mode 100644 index 0000000..33a68e7 --- /dev/null +++ b/src/cpp/lqml.cpp @@ -0,0 +1,115 @@ +#include "lqml.h" +#include "qml.h" +#include "ecl_ext.h" +#include +#include +#include +#include +#include + +const char LQML::version[] = "22.1.1"; // Jan 2022 + +extern "C" void ini_LQML(cl_object); + +#ifdef Q_OS_ANDROID + +#include + +static void logMessageHandler(QtMsgType, const QMessageLogContext& context, const QString& msg) { + // for logging on android (see 'adb logcat') + // examples: + // Lisp: (qlog "x: ~A y: ~A" x y) + // QML: console.log("message") + QString report(msg); + if (context.file && !QString(context.file).isEmpty()) { + report += " in file "; + report += QString(context.file); + report += " line "; + report += QString::number(context.line); + } + if (context.function && !QString(context.function).isEmpty()) { + report += " function "; + report += QString(context.function); + } + __android_log_write(ANDROID_LOG_DEBUG, "[EQL5]", report.toLocal8Bit().constData()); +} + +#endif + +LQML::LQML(int argc, char* argv[], QQuickView* view) : QObject() { + me = this; + quickView = view; + iniQml(); +#ifdef Q_OS_ANDROID + qInstallMessageHandler(logMessageHandler); // see above +#endif + if (!cl_booted_p) { + cl_boot(argc, argv); } + iniCLFunctions(); + ecl_init_module(NULL, ini_LQML); + eval("(in-package :qml-user)"); + eval(QString("(setf *quick-view* (make-qobject %1))").arg((quintptr)view)); +} + +LQML::~LQML() { + if (!LQML::cl_shutdown_p) { + cl_shutdown(); + } +} + +void LQML::ini(int argc, char* argv[]) { + cl_booted_p = true; + cl_boot(argc, argv); +} + +static cl_object safe_eval(const char* lisp_code) { + cl_object ret = ECL_NIL; + CL_CATCH_ALL_BEGIN(ecl_process_env()) { + ret = si_safe_eval(3, + ecl_read_from_cstring(lisp_code), + ECL_NIL, + ecl_make_fixnum(EVAL_ERROR_VALUE)); + } + CL_CATCH_ALL_END; + return ret; +} + +void LQML::eval(const QString& lisp_code) { + cl_object ret = safe_eval(lisp_code.toLatin1().constData()); + if (ecl_t_of(ret) == t_fixnum && (fix(ret) == EVAL_ERROR_VALUE)) { + qDebug() << "Error evaluating " << lisp_code; + exit(-1); + } +} + +void LQML::ignoreIOStreams() { + // [Windows] print output would cause a gui exe to crash (without console) + eval("(eql::ignore-io-streams)"); +} + +void LQML::exec(lisp_ini ini, const QByteArray& expression, const QByteArray& package) { + // see my_app example + ecl_init_module(NULL, ini); + eval(QString("(in-package :%1)").arg(QString(package))); + eval(expression); +} + +void LQML::runOnUiThread(void* function_or_closure) { + const cl_env_ptr l_env = ecl_process_env(); + CL_CATCH_ALL_BEGIN(l_env) { + CL_UNWIND_PROTECT_BEGIN(l_env) { + cl_object l_fun = (cl_object)function_or_closure; + cl_funcall(1, l_fun); + } + CL_UNWIND_PROTECT_EXIT {} + CL_UNWIND_PROTECT_END; + } + CL_CATCH_ALL_END; +} + +bool LQML::cl_booted_p = false; +bool LQML::cl_shutdown_p = false; +QEventLoop* LQML::eventLoop = 0; +LQML* LQML::me = nullptr; +QQuickView* LQML::quickView = nullptr; + diff --git a/src/cpp/lqml.h b/src/cpp/lqml.h new file mode 100644 index 0000000..db79970 --- /dev/null +++ b/src/cpp/lqml.h @@ -0,0 +1,50 @@ +#ifndef LQML_H +#define LQML_H + +#include +#include +#include +#include +#include + +class QQuickView; + +QT_BEGIN_NAMESPACE + +#define EVAL_ERROR_VALUE -1 + +typedef void (*lisp_ini)(cl_object); + +class LQML : public QObject { + Q_OBJECT +public: + LQML(int, char* [], QQuickView*); + ~LQML(); + + static bool cl_booted_p; + static bool cl_shutdown_p; + static const char version[]; + static QEventLoop* eventLoop; + static void ini(int, char* []); + static void eval(const QString&); + static LQML* me; + static QQuickView* quickView; + + void exec(lisp_ini, const QByteArray& = "nil", const QByteArray& = "qml-user"); // see my_app example + void ignoreIOStreams(); + + void printVersion() { + eval("(multiple-value-bind (lqml qt)" + " (qml:qversion)" + " (format t \"LQML ~A (ECL ~A, Qt ~A)~%\" lqml (lisp-implementation-version) qt))"); + } + + Q_INVOKABLE void runOnUiThread(void*); + +public Q_SLOTS: + void exitEventLoop() { eventLoop->exit(); } +}; + +QT_END_NAMESPACE + +#endif diff --git a/src/cpp/main.cpp b/src/cpp/main.cpp new file mode 100644 index 0000000..84a632a --- /dev/null +++ b/src/cpp/main.cpp @@ -0,0 +1,82 @@ +#include +#include +#include +#include +#include +#include +#include +#include "lqml.h" + +#ifdef Q_OS_MACOS +#define ADD_MACOS_BUNDLE_IMPORT_PATH \ + view.engine()->addImportPath(app.applicationDirPath() + QStringLiteral("/../PlugIns")); +#else +#define ADD_MACOS_BUNDLE_IMPORT_PATH +#endif + +int catch_all_qexec() { + int ret = 0; + CL_CATCH_ALL_BEGIN(ecl_process_env()) { + ret = QGuiApplication::exec(); + } + CL_CATCH_ALL_END; + return ret; +} + +int main(int argc, char* argv[]) { + QGuiApplication app(argc, argv); + //app.setOrganizationName("MyProject"); + //app.setOrganizationDomain("my.org"); + app.setApplicationName(QFileInfo(app.applicationFilePath()).baseName()); + + QQuickView view; + ADD_MACOS_BUNDLE_IMPORT_PATH + view.engine()->addImportPath(QStringLiteral(":/")); + if (qEnvironmentVariableIntValue("QT_QUICK_CORE_PROFILE")) { + QSurfaceFormat f = view.format(); + f.setProfile(QSurfaceFormat::CoreProfile); + f.setVersion(4, 4); + view.setFormat(f); + } + view.connect(view.engine(), &QQmlEngine::quit, &app, &QCoreApplication::quit); + + LQML lqml(argc, argv, &view); + QStringList arguments(QCoreApplication::arguments()); + if (arguments.contains("-v") || arguments.contains("--version")) { + lqml.printVersion(); + std::cout << std::endl; + exit(0); + } + + new QQmlFileSelector(view.engine(), &view); + QUrl url("qrc:///qml/main.qml"); + if (!QFile::exists(url.fileName())) { + url = "qml/main.qml"; + } + view.setSource(url); + if (view.status() == QQuickView::Error) { + return -1; + } + view.setResizeMode(QQuickView::SizeRootObjectToView); + QTimer::singleShot(0, &view, &QQuickView::show); + + // load .eclrc + if (arguments.contains("-norc")) { + arguments.removeAll("-norc"); + } + else { + LQML::eval("(x:when-it (probe-file \"~/.eclrc\") (load x:it))"); + } + + // load Lisp file + if (arguments.length() > 1) { + QString arg1(QDir::fromNativeSeparators(arguments.at(1))); + if (arg1.endsWith(".lisp")) { + LQML::eval(QString("(load \"%1\")").arg(arg1)); + //LQML::eval("(loop (with-simple-restart (restart-qt-events \"Restart Qt event processing.\") (qexec)))"); + } + } + + return catch_all_qexec(); +} + diff --git a/src/cpp/marshal.cpp b/src/cpp/marshal.cpp new file mode 100644 index 0000000..5909b46 --- /dev/null +++ b/src/cpp/marshal.cpp @@ -0,0 +1,252 @@ +#include "marshal.h" +#include +#include +#include + +QT_BEGIN_NAMESPACE + +// *** Lisp to Qt *** + +template +T toInt(cl_object l_num) { + T i = 0; + if (cl_integerp(l_num) == ECL_T) { + i = fixint(l_num); + } + return i; +} + +int toInt(cl_object l_num) { + return toInt(l_num); +} + +template +T toUInt(cl_object l_num) { + T i = 0; + if (cl_integerp(l_num) == ECL_T) { + i = fixnnint(l_num); + } + return i; +} + +uint toUInt(cl_object l_num) { + return toUInt(l_num); +} + +template +T toFloat(cl_object l_num) { + T f = 0; + if (ECL_SINGLE_FLOAT_P(l_num)) { + f = sf(l_num); + } + else if (ECL_DOUBLE_FLOAT_P(l_num)) { + f = df(l_num); + } +#ifdef ECL_LONG_FLOAT + else if (ECL_LONG_FLOAT_P(l_num)) { + f = ecl_long_float(l_num); + } +#endif + else if (cl_integerp(l_num) == ECL_T) { + f = fixint(l_num); + } + else { + cl_object l_f = cl_float(1, l_num); + if (ECL_DOUBLE_FLOAT_P(l_f)) { + f = df(l_f); + } + else if (ECL_SINGLE_FLOAT_P(l_f)) { + f = sf(l_f); + } +#ifdef ECL_LONG_FLOAT + else if (ECL_LONG_FLOAT_P(l_f)) { + f = ecl_long_float(l_f); + } +#endif + } + return f; +} + +float toFloat(cl_object l_num) { + return toFloat(l_num); +} + +qreal toReal(cl_object l_num) { + return toFloat(l_num); +} + +QByteArray toCString(cl_object l_str) { + QByteArray ba; + if (ECL_STRINGP(l_str)) { + if (ECL_BASE_STRING_P(l_str)) { + ba = QByteArray(reinterpret_cast(l_str->base_string.self), + l_str->base_string.fillp); + } + else { + uint l = l_str->string.fillp; + ba.resize(l); + ecl_character* l_s = l_str->string.self; + for (uint i = 0; i < l; i++) { + ba[i] = l_s[i]; + } + } + } + return ba; +} + +QByteArray toQByteArray(cl_object l_vec) { + QByteArray ba; + if (ECL_VECTORP(l_vec)) { + int len = LEN(l_vec); + ba.resize(len); + for (int i = 0; i < len; i++) { + ba[i] = toInt(ecl_aref(l_vec, i)); + } + } + return ba; +} + +QString toQString(cl_object l_str) { + QString s; + if (ECL_STRINGP(l_str)) { + if (ECL_BASE_STRING_P(l_str)) { + s = QString::fromLatin1(reinterpret_cast(l_str->base_string.self), + l_str->base_string.fillp); + } + else { + uint l = l_str->string.fillp; + s.resize(l); + ecl_character* l_s = l_str->string.self; + for (uint i = 0; i < l; i++) { + s[i] = QChar(l_s[i]); + } + } + } + return s; +} + +TO_QT_FLOAT_2 (QPointF) +TO_QT_FLOAT_2 (QSizeF) +TO_QT_FLOAT_4 (QRectF) + +QVariant toQVariant(cl_object l_arg, int type) { + QVariant var; + switch (type) { + case QMetaType::QPointF: var = toQPointF(l_arg); break; + case QMetaType::QRectF: var = toQRectF(l_arg); break; + case QMetaType::QSizeF: var = toQSizeF(l_arg); break; + default: + if (cl_integerp(l_arg) == ECL_T) { // int + var = QVariant(toInt(l_arg)); + } + else if (cl_floatp(l_arg) == ECL_T) { // double + var = QVariant(toFloat(l_arg)); + } + else if (cl_stringp(l_arg) == ECL_T) { // string + var = QVariant(toQString(l_arg)); + } + else if (l_arg == ECL_T) { // true + var = QVariant(true); + } + else if (l_arg == ECL_NIL) { // false + var = QVariant(false); + } + else if (cl_listp(l_arg) == ECL_T) { // list + var = QVariant::fromValue(toQVariantList(l_arg)); + } + else { // default: undefined + var = QVariant(); + } + break; + } + return var; +} + +QVariantList toQVariantList(cl_object l_list) { + QVariantList l; + if (ECL_LISTP(l_list)) { + for (cl_object l_do_list = l_list; l_do_list != ECL_NIL; l_do_list = cl_cdr(l_do_list)) { + cl_object l_el = cl_car(l_do_list); + l << toQVariant(l_el); + } + } + return l; +} + +QObject* toQObjectPointer(cl_object l_obj) { + STATIC_SYMBOL_PKG (s_qobject_p, "QOBJECT-P", "QML") // see 'ini.lisp' + STATIC_SYMBOL_PKG (s_pointer_address, "POINTER-ADDRESS", "FFI") + if (cl_funcall(2, s_qobject_p, l_obj) != ECL_NIL) { + return reinterpret_cast(toUInt(cl_funcall(2, s_pointer_address, l_obj))); + } + return nullptr; +} + + + +// *** Qt to Lisp + +cl_object from_cstring(const QByteArray& s) { + cl_object l_s = ecl_alloc_simple_base_string(s.length()); + memcpy(l_s->base_string.self, s.constData(), s.length()); + return l_s; +} + +static cl_object make_vector() { + STATIC_SYMBOL_PKG (s_make_vector, "%MAKE-VECTOR", "QML") // see "ini.lisp" + cl_object l_vector = cl_funcall(1, s_make_vector); + return l_vector; +} + +cl_object from_qbytearray(const QByteArray& ba) { + cl_object l_vec = make_vector(); + for (int i = 0; i < ba.size(); i++) { + cl_vector_push_extend(2, ecl_make_fixnum(ba.at(i)), l_vec); + } + return l_vec; +} + +cl_object from_qstring(const QString& s) { + cl_object l_s = ecl_alloc_simple_extended_string(s.length()); + ecl_character* l_p = l_s->string.self; + for (int i = 0; i < s.length(); i++) { + l_p[i] = s.at(i).unicode(); + } + return l_s; +} + +TO_CL_FLOAT_2 (QPointF, qpointf, x, y) +TO_CL_FLOAT_2 (QSizeF, qsizef, width, height) +TO_CL_FLOAT_4 (QRectF, qrectf, x, y, width, height) + +cl_object from_qvariant(const QVariant& var) { + cl_object l_obj = ECL_NIL; + const int type = var.typeId(); + switch (type) { + case QMetaType::Bool: l_obj = var.toBool() ? ECL_T : ECL_NIL; break; + case QMetaType::Double: l_obj = ecl_make_doublefloat(var.toDouble()); break; + case QMetaType::Int: l_obj = ecl_make_integer(var.toInt()); break; + case QMetaType::UInt: l_obj = ecl_make_unsigned_integer(var.toUInt()); break; + case QMetaType::ULongLong: l_obj = ecl_make_unsigned_integer(var.toULongLong()); break; + case QMetaType::QByteArray: l_obj = from_qbytearray(var.toByteArray()); break; + case QMetaType::QPointF: l_obj = from_qpointf(var.toPointF()); break; + case QMetaType::QRectF: l_obj = from_qrectf(var.toRectF()); break; + case QMetaType::QSizeF: l_obj = from_qsizef(var.toSizeF()); break; + case QMetaType::QString: l_obj = from_qstring(var.toString()); break; + // special case (can be nested) + case QMetaType::QVariantList: + Q_FOREACH(QVariant v, var.value()) { + l_obj = CONS(from_qvariant(v), l_obj); + } + l_obj = cl_nreverse(l_obj); + break; + } + return l_obj; +} + +cl_object from_qobject_pointer(QObject* qobject) { + STATIC_SYMBOL_PKG (s_make_qobject, "MAKE-QOBJECT", "QML") // see 'ini.lisp' + return cl_funcall(2, s_make_qobject, ecl_make_unsigned_integer((quintptr)qobject)); +} + +QT_END_NAMESPACE diff --git a/src/cpp/marshal.h b/src/cpp/marshal.h new file mode 100644 index 0000000..35e18ba --- /dev/null +++ b/src/cpp/marshal.h @@ -0,0 +1,96 @@ +#ifndef MARSHAL_H +#define MARSHAL_H + +#include +#include +#include + +QT_BEGIN_NAMESPACE + +#define STRING(s) ecl_make_constant_base_string(s, -1) + +#define STRING_COPY(s) (s ? ecl_make_simple_base_string(s, -1) : ECL_NIL) + +#define STATIC_SYMBOL(var, name) \ + static cl_object var = cl_intern(1, ecl_make_constant_base_string(name, -1)); + +#define STATIC_SYMBOL_PKG(var, name, pkg) \ + static cl_object var = cl_intern(2, \ + ecl_make_constant_base_string(name, -1), \ + cl_find_package(ecl_make_constant_base_string(pkg, -1))); + +#define LEN(x) fixint(cl_length(x)) + +#define LIST1(a1) \ + CONS(a1, ECL_NIL) +#define LIST2(a1, a2) \ + CONS(a1, LIST1(a2)) +#define LIST3(a1, a2, a3) \ + CONS(a1, LIST2(a2, a3)) +#define LIST4(a1, a2, a3, a4) \ + CONS(a1, LIST3(a2, a3, a4)) +#define LIST5(a1, a2, a3, a4, a5) \ + CONS(a1, LIST4(a2, a3, a4, a5)) +#define LIST6(a1, a2, a3, a4, a5, a6) \ + CONS(a1, LIST5(a2, a3, a4, a5, a6)) +#define LIST7(a1, a2, a3, a4, a5, a6, a7) \ + CONS(a1, LIST6(a2, a3, a4, a5, a6, a7)) +#define LIST8(a1, a2, a3, a4, a5, a6, a7, a8) \ + CONS(a1, LIST7(a2, a3, a4, a5, a6, a7, a8)) +#define LIST9(a1, a2, a3, a4, a5, a6, a7, a8, a9) \ + CONS(a1, LIST8(a2, a3, a4, a5, a6, a7, a8, a9)) +#define LIST10(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) \ + CONS(a1, LIST9(a2, a3, a4, a5, a6, a7, a8, a9, a10)) + +#define TO_CL_FLOAT_2(cap_name, name, x1, x2) \ +static cl_object from_##name(const cap_name& q) { \ + cl_object l_ret = LIST2(ecl_make_doublefloat(q.x1()), ecl_make_doublefloat(q.x2())); \ + return l_ret; \ +} + +#define TO_CL_FLOAT_4(cap_name, name, x1, x2, x3, x4) \ +static cl_object from_##name(const cap_name& q) { \ + cl_object l_ret = LIST4(ecl_make_doublefloat(q.x1()), ecl_make_doublefloat(q.x2()), ecl_make_doublefloat(q.x3()), ecl_make_doublefloat(q.x4())); \ + return l_ret; \ +} + +#define TO_QT_FLOAT_2(name) \ +static name to##name(cl_object x) { \ + if(LISTP(x)) { \ + return name(toReal(cl_first(x)), toReal(cl_second(x))); \ + } \ + return name(); \ +} + +#define TO_QT_FLOAT_4(name) \ +static name to##name(cl_object x) { \ + if(LISTP(x)) { \ + return name(toReal(cl_first(x)), toReal(cl_second(x)), toReal(cl_third(x)), toReal(cl_fourth(x))); \ + } \ + return name(); \ +} + +template T toInt(cl_object); +template T toUInt(cl_object); +template T toFloat(cl_object); + +int toInt(cl_object); +uint toUInt(cl_object); +float toFloat(cl_object); +qreal toReal(cl_object); +QByteArray toCString(cl_object); +QByteArray toQByteArray(cl_object); +QString toQString(cl_object); +QVariant toQVariant(cl_object, int = -1); +QVariantList toQVariantList(cl_object); +QObject* toQObjectPointer(cl_object); + +cl_object from_cstring(const QByteArray&); +cl_object from_qbytearray(const QByteArray&); +cl_object from_qstring(const QString&); +cl_object from_qvariant(const QVariant&); +cl_object from_qobject_pointer(QObject*); + +QT_END_NAMESPACE + +#endif diff --git a/src/cpp/qml.cpp b/src/cpp/qml.cpp new file mode 100644 index 0000000..66784c5 --- /dev/null +++ b/src/cpp/qml.cpp @@ -0,0 +1,134 @@ +#include "qml.h" +#include "lqml.h" +#include "ecl_fun.h" +#include + +QT_BEGIN_NAMESPACE + +static Lisp* lisp = 0; + +static QObject* lisp_provider(QQmlEngine*, QJSEngine*) { return lisp; } + +QObject* iniQml() { + if(!lisp) { + lisp = new Lisp; + qmlRegisterSingletonType("Lisp", 1, 0, "Lisp", lisp_provider); + } + return lisp; +} + +static QVariant qmlApply(QObject* caller, const QString& function, const QVariantList& arguments) { + QVariant var = + ecl_fun("qml:qml-apply", + QVariant((quintptr)caller), + QVariant(function), + QVariant(arguments)); + QString str(var.toString()); + if(str.startsWith("#<>")) { // prepared in Lisp for JS eval + QQmlExpression exp(LQML::quickView->rootContext(), caller, str.mid(3)); + return exp.evaluate(); + } + return var; +} + +QVariant Lisp::call(const QJSValue& caller_or_function, + const QJSValue& function_or_arg0, + const QJSValue& arg1, + const QJSValue& arg2, + const QJSValue& arg3, + const QJSValue& arg4, + const QJSValue& arg5, + const QJSValue& arg6, + const QJSValue& arg7, + const QJSValue& arg8, + const QJSValue& arg9, + const QJSValue& arg10, + const QJSValue& arg11, + const QJSValue& arg12, + const QJSValue& arg13, + const QJSValue& arg14, + const QJSValue& arg15, + const QJSValue& arg16) { + QObject* caller = 0; + QString function; + QVariantList arguments; + if(caller_or_function.isQObject()) { + caller = caller_or_function.toQObject(); + function = function_or_arg0.toString(); + } + else if(caller_or_function.isString()) { + function = caller_or_function.toString(); + if(!function_or_arg0.isUndefined()) { + arguments << function_or_arg0.toVariant(); + } + } + if(!arg1.isUndefined()) { + arguments << arg1.toVariant(); + if(!arg2.isUndefined()) { + arguments << arg2.toVariant(); + if(!arg3.isUndefined()) { + arguments << arg3.toVariant(); + if(!arg4.isUndefined()) { + arguments << arg4.toVariant(); + if(!arg5.isUndefined()) { + arguments << arg5.toVariant(); + if(!arg6.isUndefined()) { + arguments << arg6.toVariant(); + if(!arg7.isUndefined()) { + arguments << arg7.toVariant(); + if(!arg8.isUndefined()) { + arguments << arg8.toVariant(); + if(!arg9.isUndefined()) { + arguments << arg9.toVariant(); + if(!arg10.isUndefined()) { + arguments << arg10.toVariant(); + if(!arg11.isUndefined()) { + arguments << arg11.toVariant(); + if(!arg12.isUndefined()) { + arguments << arg12.toVariant(); + if(!arg13.isUndefined()) { + arguments << arg13.toVariant(); + if(!arg14.isUndefined()) { + arguments << arg14.toVariant(); + if(!arg15.isUndefined()) { + arguments << arg15.toVariant(); + if(!arg16.isUndefined()) { + arguments << arg16.toVariant(); + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + return qmlApply(caller, function, arguments); +} + +QVariant Lisp::apply(const QJSValue& caller_or_function, + const QJSValue& function_or_arguments, + const QJSValue& arguments_or_undefined) { + QObject* caller = 0; + QString function; + QVariantList arguments; + if(caller_or_function.isQObject()) { + caller = caller_or_function.toQObject(); + function = function_or_arguments.toString(); + arguments = arguments_or_undefined.toVariant().value(); + } + else if(caller_or_function.isString()) { + function = caller_or_function.toString(); + arguments = function_or_arguments.toVariant().value(); + } + return qmlApply(caller, function, arguments); +} + +QT_END_NAMESPACE diff --git a/src/cpp/qml.h b/src/cpp/qml.h new file mode 100644 index 0000000..8bbb8db --- /dev/null +++ b/src/cpp/qml.h @@ -0,0 +1,42 @@ +#ifndef QML_H +#define QML_H + +#include + +QT_BEGIN_NAMESPACE + +QObject* iniQml(); + +class Lisp : public QObject { + Q_OBJECT + +public: + Q_INVOKABLE QVariant call( + const QJSValue&, + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue()); + + Q_INVOKABLE QVariant apply( + const QJSValue&, + const QJSValue& = QJSValue(), + const QJSValue& = QJSValue()); +}; + +QT_END_NAMESPACE + +#endif diff --git a/src/cpp/qt_ecl.cpp b/src/cpp/qt_ecl.cpp new file mode 100644 index 0000000..c65808f --- /dev/null +++ b/src/cpp/qt_ecl.cpp @@ -0,0 +1,83 @@ +#undef SLOT + +#include "qt_ecl.h" +#include "marshal.h" +#include "ecl_ext.h" +#include +#include + +QT_BEGIN_NAMESPACE + +static QHash lisp_functions; + +static cl_object lisp_apply(cl_object l_fun, cl_object l_args) { + cl_object l_ret = Cnil; + const cl_env_ptr l_env = ecl_process_env(); + CL_CATCH_ALL_BEGIN(l_env) { + CL_UNWIND_PROTECT_BEGIN(l_env) { + l_ret = cl_apply(2, l_fun, l_args); + } + CL_UNWIND_PROTECT_EXIT {} + CL_UNWIND_PROTECT_END; + } + CL_CATCH_ALL_END; + return l_ret; +} + +#define PUSH_ARG(x) l_args = CONS(from_qvariant(x), l_args) + +QVariant ecl_fun(const QByteArray& pkgFun, + const QVariant& a1, + const QVariant& a2, + const QVariant& a3, + const QVariant& a4, + const QVariant& a5, + const QVariant& a6, + const QVariant& a7, + const QVariant& a8, + const QVariant& a9, + const QVariant& a10) { + void* symbol = lisp_functions.value(pkgFun); + 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) { + symbol = l_sym; + lisp_functions[pkgFun] = symbol; + } + } + cl_object l_args = Cnil; + if(!a1.isNull()) { PUSH_ARG(a1); + if(!a2.isNull()) { PUSH_ARG(a2); + if(!a3.isNull()) { PUSH_ARG(a3); + if(!a4.isNull()) { PUSH_ARG(a4); + if(!a5.isNull()) { PUSH_ARG(a5); + if(!a6.isNull()) { PUSH_ARG(a6); + if(!a7.isNull()) { PUSH_ARG(a7); + if(!a8.isNull()) { PUSH_ARG(a8); + if(!a9.isNull()) { PUSH_ARG(a9); + if(!a10.isNull()) { PUSH_ARG(a10); } + } + } + } + } + } + } + } + } + } + l_args = cl_nreverse(l_args); + if(symbol) { + cl_object l_ret = lisp_apply((cl_object)symbol, l_args); + return toQVariant(l_ret); + } + error_msg(QString("ecl_fun(): %1").arg(QString(pkgFun)).toLatin1().constData(), l_args); + return QVariant(); +} + +QT_END_NAMESPACE + diff --git a/src/cpp/qt_ecl.h b/src/cpp/qt_ecl.h new file mode 100644 index 0000000..ca7ea6c --- /dev/null +++ b/src/cpp/qt_ecl.h @@ -0,0 +1,23 @@ +#ifndef QT_ECL_H +#define QT_ECL_H + +#include + +QT_BEGIN_NAMESPACE + +QVariant ecl_fun( + const QByteArray&, + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant(), + const QVariant& = QVariant()); + +QT_END_NAMESPACE + +#endif diff --git a/src/cpp/single_shot.h b/src/cpp/single_shot.h new file mode 100644 index 0000000..27eca58 --- /dev/null +++ b/src/cpp/single_shot.h @@ -0,0 +1,34 @@ +#ifndef SINGLE_SHOT_H +#define SINGLE_SHOT_H + +#undef SLOT + +#include +#include + +QT_BEGIN_NAMESPACE + +struct SingleShot : public QObject { + int id; + void* function; + + SingleShot(int msec, void* fun) : id(startTimer(msec)), function(fun) {} + + void timerEvent(QTimerEvent*) { + killTimer(id); + const cl_env_ptr l_env = ecl_process_env(); + CL_CATCH_ALL_BEGIN(l_env) { + CL_UNWIND_PROTECT_BEGIN(l_env) { + cl_funcall(1, (cl_object)function); + } + CL_UNWIND_PROTECT_EXIT {} + CL_UNWIND_PROTECT_END; + } + CL_CATCH_ALL_END; + delete this; + } +}; + +QT_END_NAMESPACE + +#endif diff --git a/src/lisp/ini.lisp b/src/lisp/ini.lisp new file mode 100644 index 0000000..f30810d --- /dev/null +++ b/src/lisp/ini.lisp @@ -0,0 +1,179 @@ +#+ecl +(si::trap-fpe t nil) ; ignore floating point exceptions (they happen on Qt side) + +(in-package :qml) + +(defvar *break-on-errors* t) + +(defun make-qobject (address) + (ffi:make-pointer address :pointer-void)) + +(defun qobject-p (x) + (eql 'si:foreign-data (type-of x))) + +(defmacro alias (s1 s2) + `(setf (symbol-function ',s1) (function ,s2))) + +(defmacro ! (fun &rest args) + `(qfun ,(cadar args) ,fun ,@(rest args))) + +(defun %reference-name () + (format nil "%~A%" (gensym))) + +(defun qexec (&optional ms) + (%qexec ms)) + +(defun qsleep (seconds) + (%qexec (floor (* 1000 seconds))) + nil) + +(defmacro qsingle-shot (milliseconds function) + ;; check for LAMBDA, #'LAMBDA + (if (find (first function) '(lambda function)) + ;; hold a reference (will be called later from Qt event loop) + `(qrun (lambda () + (%qsingle-shot ,milliseconds (setf (symbol-function (intern ,(%reference-name))) ; lambda + ,function)))) + `(qrun (lambda () + (%qsingle-shot ,milliseconds ,function))))) ; 'foo + +(defmacro qlater (function) + `(qsingle-shot 0 ,function)) + +(defun %ensure-persistent-function (fun) + (typecase fun + (symbol ; 'foo + fun) + (function ; lambda + ;; hold a reference (will be called later from Qt event loop) + (setf (symbol-function (intern (%reference-name))) + fun)))) + +(defun %make-vector () + (make-array 0 :adjustable t :fill-pointer t)) + +(defun %break (&rest args) + (apply 'break args)) + +(defun ignore-io-streams () + (setf *standard-output* (make-broadcast-stream) + *trace-output* *standard-output* + *error-output* *standard-output* + *terminal-io* (make-two-way-stream (make-string-input-stream "") + *standard-output*))) + +(defmacro tr (source &optional context (plural-number -1)) + ;; see compiler-macro in "tr.lisp" + (let ((source* (ignore-errors (eval source))) + (context* (ignore-errors (eval context)))) + `(qml:qtranslate ,(if (stringp context*) + context* + (if *compile-file-truename* (file-namestring *compile-file-truename*) "")) + ,source* + ,plural-number))) + +(defun %string-or-nil (x) + (typecase x + (string + x) + (symbol + (unless (member x '(t nil)) + (symbol-name x))))) + +(defun qfind-children (object &optional object-name class-name) + (%qfind-children object object-name class-name)) + +(defun qload-c++ (library-name &optional unload) + (%qload-c++ library-name unload)) + +(defun define-qt-wrappers (qt-library &rest what) + ;; N.B. This works only for Qt6 functions with the following signature: + ;; "QVariant foo(QVariant, ...)" ; max 10 QVariant arguments + (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 (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)))) + ;; there seems to be no simple 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-name arguments))))))))) + +(defun qinvoke-method (object function-name &rest arguments) + (%qinvoke-method object function-name arguments)) + +(defmacro qget (object name) + `(%qget ,object ,(if (symbolp name) + (symbol-name name) + name))) + +(defmacro qset (object &rest arguments) + (assert (evenp (length arguments))) + `(%qset ,object ',(let (name) + (mapcar (lambda (x) + (setf name (not name)) + (if (and name (symbolp x)) + (symbol-name x) + x)) + arguments)))) + +(defun qrun-on-ui-thread (function &optional (blocking t)) + (%qrun-on-ui-thread function blocking)) + +(defvar *gui-thread* mp:*current-process*) + +(defmacro qrun-on-ui-thread* (&body body) + (let ((values (gensym))) + `(if (eql *gui-thread* mp:*current-process*) + ,(if (second body) + (cons 'progn body) + (first body)) + (let (,values) + (qrun (lambda () + (setf ,values (multiple-value-list ,(if (second body) + (cons 'progn body) + (first body)))))) + (values-list ,values))))) + +(defmacro qrun* (&body body) ; alias + `(qrun-on-ui-thread* ,@body)) + +(defun qquit (&optional (exit-status 0) (kill-all-threads t)) + (declare (ignore kill-all-threads)) ; only here to be equivalent to EXT:QUIT + (assert (typep exit-status 'fixnum)) + (%qquit exit-status)) + +(alias qfun qinvoke-method) +(alias qrun qrun-on-ui-thread) +(alias qq qquit) + +;;; for android logging + +(defun qlog (arg1 &rest args) + ;; (qlog 12) + ;; (qlog 1 "plus" 2 "gives" 3) + ;; (qlog "x ~A y ~A" x y) + (%qlog (if (and (stringp arg1) + (find #\~ arg1)) + (apply 'format nil arg1 args) + (x:join (mapcar 'princ-to-string (cons arg1 args)))))) + diff --git a/src/lisp/package.lisp b/src/lisp/package.lisp new file mode 100644 index 0000000..4a2fd93 --- /dev/null +++ b/src/lisp/package.lisp @@ -0,0 +1,62 @@ +(defpackage :qml + (:use :common-lisp) + (:export + #:*break-on-errors* + #:*quick-view* + #:*root* + #:*root-item* + #:*caller* + #:children + #:find-quick-item + #:js + #:make-qobject + #:pixel-ratio + #:qapropos + #:qapropos* + #:qml-call + #:qml-get + #:qml-set + #:qml-set-all + #:q! + #:q< + #:q> + #:q>* + #:qjs + #+linux + #:qchild-items + #:qescape + #:qexec + #:qexit + #:qfind-child + #:qfind-children + #:qfrom-utf8 + #:qfun + #:qget + #:qset + #:qlater + #:qload-c++ + #:qlocal8bit + #:qlog + #:qobject-p + #:qprocess-events + #:qq + #:qquit + #:qrun + #:qrun-on-ui-thread + #:qrun* + #:qrun-on-ui-thread* + #:qsingle-shot + #:qsleep + #:qtranslate + #:qutf8 + #:qversion + #:qvariant-from-value + #:qvariant-value + #:root-item + #:reload + #:tr)) + +(defpackage :qml-user + (:use :common-lisp :qml)) + +(pushnew :qml *features*) diff --git a/src/lisp/qml.lisp b/src/lisp/qml.lisp new file mode 100644 index 0000000..7de8e0e --- /dev/null +++ b/src/lisp/qml.lisp @@ -0,0 +1,191 @@ +(in-package :qml) + +(defvar *quick-view* nil) ; is set in 'lqml.cpp' on startup +(defvar *caller* nil) +(defvar *root* nil) +(defvar *root-item* nil) ; see note in 'find-quick-item' + +(defun string-to-symbol (name) + (let ((upper (string-upcase name)) + (p (position #\: name))) + (if p + (find-symbol (subseq upper (1+ (position #\: name :from-end t))) + (subseq upper 0 p)) + (find-symbol upper)))) + +;;; function calls from QML + +(defun print-js-readably (object) + "Prints (nested) lists, vectors, T, NIL, floats in JS notation, which will be + passed to JS 'eval()'." + (if (and (not (stringp object)) + (vectorp object)) + (print-js-readably (coerce object 'list)) + (typecase object + (cons + (write-char #\[) + (do ((list object (rest list))) + ((null list) (write-char #\])) + (print-js-readably (first list)) + (when (rest list) + (write-char #\,)))) + (float + ;; JS can't read 'd0' 'l0' + (let ((str (princ-to-string object))) + (x:when-it (position-if (lambda (ch) (find ch "dl")) str) + (setf (char str x:it) #\e)) + (princ str))) + (t + (cond ((eql 't object) + (princ "true")) + ((eql 'nil object) + (princ "false")) + (t + (prin1 object))))))) + +(defun print-to-js-string (object) + (with-output-to-string (*standard-output*) + (princ "#<>") ; mark for passing to JS "eval()" + (print-js-readably object))) + +(defun qml-apply (caller function arguments) + "Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this + function. The variable *CALLER* will be bound to the calling QQuickItem, if + passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'." + (let* ((*caller* (if (zerop caller) ; don't change LET* + *caller* + (make-qobject caller))) + (value (apply (string-to-symbol function) + arguments))) + (if (stringp value) + value + (print-to-js-string value)))) + +;;; utils + +(defun find-quick-item (object-name) + "Finds the first QQuickItem matching OBJECT-NAME. Locally set *ROOT-ITEM* if + you want to find items inside a specific item, like in a QML Repeater. See + also note in sources." + ;; + ;; when to use *ROOT-ITEM* + ;; + ;; say you have a Repeater QML item with multiple instances of the same + ;; QQuickItem. The children of those QQuickItems all have the same object + ;; names, respectively. In order to access those child items, we need to + ;; search in the specific item of the Repeater. + ;; + ;; So, we locally bind *ROOT-ITEM* in order to find a specific child item + ;; inside the Repeater: + ;; + ;; (setf qml:*root-item* (q! |itemAt| ui:*repeater* 0)) ; (1) set + ;; ;; everything we do here will only affect children of the first + ;; ;; item in ui:*repeater* (see index 0 above) + ;; (q< |text| ui:*edit*) + ;; (setf qml:*root-item* nil) ; (2) reset + ;; + ;; N.B. we need SETF (instead of LET) because of the global var and threads + ;; (QRUN* is used internally here) + ;; + (let ((parent (or *root-item* (root-item)))) + (when (and parent (/= 0 (ffi:pointer-address parent))) + (if (string= (qobject-name parent) object-name) + parent + (qfind-child parent object-name))))) + +(defun quick-item (item/name) + (cond ((stringp item/name) + (find-quick-item item/name)) + ((qobject-p item/name) + item/name) + ((not item/name) + (root-item)))) + +(defun children (item/name) + "Like QML function 'children'." + (qrun* (qchild-items (quick-item item/name)))) + +;;; get/set QML properties, call QML methods (through JS) + +(defun qml-get (item/name property-name) + "Gets QQmlProperty of either ITEM or first object matching NAME." + (qrun* (%qml-get (quick-item item/name) property-name))) + +(defun qml-set (item/name property-name value) + "Sets QQmlProperty of either ITEM, or first object matching NAME. + Returns T on success." + (qrun* (%qml-set (quick-item item/name) property-name value))) + +(defun qml-set-all (name property-name value) + "Sets QQmlProperty of all objects matching NAME." + (assert (stringp name)) + (qrun* (dolist (item (qfind-children (root-item) name)) + (qml-set item property-name value)))) + +(defmacro q! (method-name item/name &rest arguments) + "Convenience macro for QML-CALL. Use symbol instead of string name." + `(js ,item/name ,(symbol-name method-name) ,@arguments)) + +(defmacro q> (property-name item/name value) + "Convenience macro for QML-SET. Use symbol instead of string name." + `(qml-set ,item/name ,(symbol-name property-name) ,value)) + +(defmacro q< (property-name item/name) + "Convenience macro for QML-GET. Use symbol instead of string name." + `(qml-get ,item/name ,(symbol-name property-name))) + +(defmacro q>* (property-name item/name value) + "Convenience macro for QML-SET-ALL. Use symbol instead of string name." + `(qml-set-all ,item/name ,(symbol-name property-name) ,value)) + +;;; JS + +(defun js (item/name fun &rest arguments) + "Evaluates a JS string, with 'this' bound to either ITEM, or first object + matching NAME. Use this function instead of the (faster) QJS if you need to + evaluate generic JS code, or for JS functions with default arguments." + (qrun* (%js (quick-item item/name) + (apply 'format nil + (format nil "~A(~A)" + fun + (x:join (loop repeat (length arguments) collect "~S") #\,)) + (mapcar 'js-arg arguments))))) + +(defun js-arg (object) + "Used for arguments in function JS." + (if (stringp object) + object + (with-output-to-string (*standard-output*) + (print-js-readably object)))) + +(defmacro qjs (method-name item/name &rest arguments) + `(qrun* (qfun (quick-item ,item/name) + ,(if (symbolp method-name) + (symbol-name method-name) + method-name) + ,@arguments))) + +;;; apropos + +(defun %to-qobject (x) + (if (qobject-p x) + x + (quick-item x))) + +(defun qapropos (name &optional class offset) + (dolist (sub1 (%qapropos (%string-or-nil name) (%to-qobject class) offset)) + (format t "~%~%~A~%" (first sub1)) + (dolist (sub2 (rest sub1)) + (format t "~% ~A~%~%" (first sub2)) + (dolist (sub3 (rest sub2)) + (let* ((par (position #\( sub3)) + (x (if par + (position #\Space sub3 :end par :from-end t) + (position #\Space sub3)))) + (format t " ~A~A~%" (make-string (max 0 (- 15 x))) sub3))))) + (terpri) + nil) + +(defun qapropos* (name &optional class offset) + (%qapropos (%string-or-nil name) (%to-qobject class) offset)) + diff --git a/src/lisp/tr.lisp b/src/lisp/tr.lisp new file mode 100644 index 0000000..83689dd --- /dev/null +++ b/src/lisp/tr.lisp @@ -0,0 +1,27 @@ +(defpackage :qml-tr + (:use :cl :qml)) + +(in-package :qml-tr) + +(defparameter *sources* (make-hash-table :test 'equal)) + +(progn + (when (probe-file "tr.h") + (delete-file "tr.h")) + (define-compiler-macro tr (&whole form src &optional con (n -1)) + (let* ((source (ignore-errors (eval src))) + (context* (ignore-errors (eval con))) + (context (if (stringp context*) + context* + (file-namestring *compile-file-truename*)))) + (with-open-file (out "tr.h" :direction :output :if-exists :append :if-does-not-exist :create) + (if (stringp source) + (unless (gethash (cons source context) *sources*) + (setf (gethash (cons source context) *sources*) t) + (format out "QCoreApplication::translate(~S, ~S, 0~A);~%" + context + source + (if (= -1 n) "" (format nil ", ~D" n)))) + (error "[TR: error] ~S from context ~S doesn't evaluate to a string" src context)))) + form)) + diff --git a/src/lisp/x.lisp b/src/lisp/x.lisp new file mode 100644 index 0000000..3c51db0 --- /dev/null +++ b/src/lisp/x.lisp @@ -0,0 +1,177 @@ +(defpackage :x + (:use :common-lisp) + (:export + #:cc + #:check-recompile + #:bytes-to-string + #:d + #:do-string + #:do-with + #:empty-string + #:ensure-list + #:ends-with + #:it + #:it* + #:if-it + #:if-it* + #:join + #:let-it + #:path + #:split + #:starts-with + #:string-substitute + #:string-to-bytes + #:when-it + #:when-it* + #:while + #:while-it + #:with-gensyms)) + +(provide :x) + +(in-package :x) + +(defmacro if-it (exp then &optional else) + `(let ((it ,exp)) + (if it ,then ,else))) + +(defmacro if-it* (exp then &optional else) + `(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))) + +(defmacro when-it* (exp &body body) + `(let ((it* ,exp)) + (when it* ,@body))) + +(defmacro with-gensyms (syms &body body) + `(let ,(mapcar (lambda (s) + `(,s (gensym))) + syms) + ,@body)) + +(defmacro while (exp &body body) + `(do () + ((not ,exp)) + ,@body)) + +(defmacro while-it (exp &body body) + `(do ((it)) + ((not (setf it ,exp))) + ,@body)) + +(defmacro do-string ((var str) &body body) + `(block nil + (map nil (lambda (,var) + ,@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))) + +(defun cc (&rest args) + "Convenient string concatenation." + (apply 'concatenate 'string args)) + +(defun empty-string (s) + (zerop (length s))) + +(defun %str-with (sub str starts) + (let ((l1 (length str)) + (l2 (length sub))) + (when (>= l1 l2) + (string= sub (subseq str (if starts 0 (- l1 l2)) (when starts l2)))))) + +(defun starts-with (sub str) + (%str-with sub str t)) + +(defun ends-with (sub str) + (%str-with sub str nil)) + +(defun string-substitute (new old string) + (let ((len (length old))) + (with-output-to-string (s) + (do ((e (search old string) (search old string :start2 (+ e len))) + (b 0 (+ e len))) + ((not e) (write-string (subseq string b) s)) + (write-string (subseq string b e) s) + (write-string new s))))) + +(defun ensure-list (x) + (if (listp x) x (list x))) + +(defun split (str &optional (sep #\Space)) + (etypecase sep + (character + (unless (zerop (length str)) + (let (list) + (do ((e (position sep str) (position sep str :start (1+ e))) + (b 0 (1+ e))) + ((not e) (push (subseq str b) list)) + (push (subseq str b e) list)) + (nreverse list)))) + (string + (let ((len (length sep)) + list) + (do ((e (search sep str) (search sep str :start2 (+ e len))) + (b 0 (+ e len))) + ((not e) (push (subseq str b) list)) + (push (subseq str b e) list)) + (nreverse list))))) + +(defun join (list &optional (sep #\Space)) + (format nil (concatenate 'string "~{~A~^" (string sep) "~}") + list)) + +(defun bytes-to-string (b) + (map 'string 'code-char b)) + +(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) diff --git a/src/lqml.asd b/src/lqml.asd new file mode 100644 index 0000000..6974724 --- /dev/null +++ b/src/lqml.asd @@ -0,0 +1,8 @@ +(defsystem :lqml + :serial t + :depends-on () + :components ((:file "lisp/x") + (:file "lisp/package") + (:file "lisp/ini") + (:file "lisp/qml"))) + diff --git a/src/lqml.pro b/src/lqml.pro new file mode 100644 index 0000000..39b95b2 --- /dev/null +++ b/src/lqml.pro @@ -0,0 +1,53 @@ +LISP_FILES = make.lisp \ + lisp/x.lisp \ + lisp/package.lisp \ + lisp/ini.lisp \ + lisp/qml.lisp \ + lqml.asd + +lisp.output = liblqml.a +lisp.commands = ecl -shell $$PWD/make.lisp +lisp.input = LISP_FILES + +QMAKE_EXTRA_COMPILERS += lisp + +QT += quick qml +TEMPLATE = app +CONFIG += no_keywords release +INCLUDEPATH += /usr/local/include +LIBS += -L/usr/local/lib -lecl -L. -llqml +TARGET = lqml +DESTDIR = . + +linux { + target.path = /usr/bin +} + +osx { + target.path = /usr/local/bin +} + +INSTALLS = target + +win32 { + include(windows.pri) +} + +HEADERS += cpp/marsahl.h \ + cpp/ecl_ext.h \ + cpp/lqml.h \ + cpp/qml.h \ + cpp/qt_ecl.h \ + cpp/single_shot.h + +SOURCES += cpp/marshal.cpp \ + cpp/ecl_ext.cpp \ + cpp/lqml.cpp \ + cpp/qml.cpp \ + cpp/qt_ecl.cpp \ + cpp/main.cpp + +clang { + QMAKE_CXXFLAGS += -std=c++17 +} + diff --git a/src/make.lisp b/src/make.lisp new file mode 100644 index 0000000..b75d936 --- /dev/null +++ b/src/make.lisp @@ -0,0 +1,17 @@ +(require :asdf) + +(push (merge-pathnames "../") + asdf:*central-registry*) + +(asdf:make-build "lqml" + :monolithic t + :type :static-library + :move-here "./" + :init-name "ini_LQML") + +(let ((from "lqml--all-systems.a") + (to "liblqml.a")) + (when (probe-file to) + (delete-file to)) + (rename-file from to)) +