mirrors/lqml
1
Fork 0
mirror of https://gitlab.com/eql/lqml.git synced 2025-12-25 03:20:40 -08:00
Code Issues Projects Releases Packages Wiki Activity

first working desktop version

Browse source
This commit is contained in:
pls.153 2022-01-17 13:10:40 +01:00
parent 0e6ff84388
commit 42e8912912
30 changed files with 2561 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

620
src/cpp/ecl_ext.cpp Normal file
View file

@ -0,0 +1,620 @@
#include "ecl_ext.h"
#include "marshal.h"
#include "lqml.h"
#include "single_shot.h"
#include <QTimer>
#include <QLibrary>
#include <QGuiApplication>
#include <QQuickItem>
#include <QQuickView>
#include <QQmlEngine>
#include <QQmlExpression>
#include <QQmlProperty>
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<QObject*>(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<QObject*>(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<QQuickItem*>(qobject); // type check
if (item != nullptr) {
QList<QQuickItem*> 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<QString, QLibrary*> 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

87
src/cpp/ecl_ext.h Normal file
View file

@ -0,0 +1,87 @@
#ifndef ECL_EXT_H
#define ECL_EXT_H
#include <ecl/ecl.h>
#include <QList>
#include <QVariant>
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

26
src/cpp/ecl_fun.h Normal file
View file

@ -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 <QVariant>
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

115
src/cpp/lqml.cpp Normal file
View file

@ -0,0 +1,115 @@
#include "lqml.h"
#include "qml.h"
#include "ecl_ext.h"
#include <iostream>
#include <QCoreApplication>
#include <QTimer>
#include <QStringList>
#include <QDebug>
const char LQML::version[] = "22.1.1"; // Jan 2022
extern "C" void ini_LQML(cl_object);
#ifdef Q_OS_ANDROID
#include <android/log.h>
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;

50
src/cpp/lqml.h Normal file
View file

@ -0,0 +1,50 @@
#ifndef LQML_H
#define LQML_H
#include <ecl/ecl.h>
#include <QObject>
#include <QByteArray>
#include <QStringList>
#include <QCoreApplication>
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

82
src/cpp/main.cpp Normal file
View file

@ -0,0 +1,82 @@
#include <QDir>
#include <QGuiApplication>
#include <QTimer>
#include <QQmlEngine>
#include <QQmlFileSelector>
#include <QQuickView>
#include <iostream>
#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();
}

252
src/cpp/marshal.cpp Normal file
View file

@ -0,0 +1,252 @@
#include "marshal.h"
#include <ecl/ecl.h>
#include <QVariant>
#include <QObject>
QT_BEGIN_NAMESPACE
// *** Lisp to Qt ***
template<typename T>
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<int>(l_num);
}
template<typename T>
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<uint>(l_num);
}
template<typename T>
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<float>(l_num);
}
qreal toReal(cl_object l_num) {
return toFloat<qreal>(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<char*>(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<char*>(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<double>(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<QObject*>(toUInt<quintptr>(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<QVariantList>()) {
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

96
src/cpp/marshal.h Normal file
View file

@ -0,0 +1,96 @@
#ifndef MARSHAL_H
#define MARSHAL_H
#include <ecl/ecl.h>
#include <QRectF>
#include <QVariant>
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<typename T> T toInt(cl_object);
template<typename T> T toUInt(cl_object);
template<typename T> 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

134
src/cpp/qml.cpp Normal file
View file

@ -0,0 +1,134 @@
#include "qml.h"
#include "lqml.h"
#include "ecl_fun.h"
#include <QQuickView>
QT_BEGIN_NAMESPACE
static Lisp* lisp = 0;
static QObject* lisp_provider(QQmlEngine*, QJSEngine*) { return lisp; }
QObject* iniQml() {
if(!lisp) {
lisp = new Lisp;
qmlRegisterSingletonType<Lisp>("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<QVariantList>();
}
else if(caller_or_function.isString()) {
function = caller_or_function.toString();
arguments = function_or_arguments.toVariant().value<QVariantList>();
}
return qmlApply(caller, function, arguments);
}
QT_END_NAMESPACE

42
src/cpp/qml.h Normal file
View file

@ -0,0 +1,42 @@
#ifndef QML_H
#define QML_H
#include <QtQml>
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

83
src/cpp/qt_ecl.cpp Normal file
View file

@ -0,0 +1,83 @@
#undef SLOT
#include "qt_ecl.h"
#include "marshal.h"
#include "ecl_ext.h"
#include <ecl/ecl.h>
#include <QVariant>
QT_BEGIN_NAMESPACE
static QHash<QByteArray, void*> 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

23
src/cpp/qt_ecl.h Normal file
View file

@ -0,0 +1,23 @@
#ifndef QT_ECL_H
#define QT_ECL_H
#include <QVariant>
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

34
src/cpp/single_shot.h Normal file
View file

@ -0,0 +1,34 @@
#ifndef SINGLE_SHOT_H
#define SINGLE_SHOT_H
#undef SLOT
#include <ecl/ecl.h>
#include <QObject>
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