mirror of
https://gitlab.com/eql/lqml.git
synced 2025-12-06 02:30:38 -08:00
first working desktop version
This commit is contained in:
pls.153
parent
0e6ff84388
commit
42e8912912
30 changed files with 2561 additions and 3 deletions
29
.gitignore
vendored
Normal file
29
.gitignore
vendored
Normal file
|
|
@ -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
|
||||||
BIN
examples/9999/doc/9999.jpg
Normal file
BIN
examples/9999/doc/9999.jpg
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 27 KiB |
3
examples/9999/doc/readme.txt
Normal file
3
examples/9999/doc/readme.txt
Normal file
|
|
@ -0,0 +1,3 @@
|
||||||
|
simple canvas example: draw in JS, calculate in Lisp
|
||||||
|
|
||||||
|
see also: https://en.wikipedia.org/wiki/Cistercian_numerals
|
||||||
48
examples/9999/lisp/main.lisp
Normal file
48
examples/9999/lisp/main.lisp
Normal file
|
|
@ -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))))))
|
||||||
|
|
||||||
49
examples/9999/qml/main.qml
Normal file
49
examples/9999/qml/main.qml
Normal file
|
|
@ -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))
|
||||||
|
}
|
||||||
|
}
|
||||||
14
examples/9999/run.lisp
Normal file
14
examples/9999/run.lisp
Normal file
|
|
@ -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
|
||||||
|
|
||||||
16
readme-build.md
Normal file
16
readme-build.md
Normal file
|
|
@ -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
|
||||||
|
```
|
||||||
|
|
||||||
27
readme.md
27
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.
|
A lightweight ECL based QML-only binding to Qt6.
|
||||||
|
|
||||||
|
|
@ -7,5 +15,18 @@ A lightweight ECL based QML-only binding to Qt6.
|
||||||
License
|
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
|
||||||
|
|
||||||
|
|
|
||||||
20
slime/qml-start-swank.lisp
Normal file
20
slime/qml-start-swank.lisp
Normal file
|
|
@ -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
|
||||||
|
|
||||||
620
src/cpp/ecl_ext.cpp
Normal file
620
src/cpp/ecl_ext.cpp
Normal 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
87
src/cpp/ecl_ext.h
Normal 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
26
src/cpp/ecl_fun.h
Normal 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
115
src/cpp/lqml.cpp
Normal 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
50
src/cpp/lqml.h
Normal 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
82
src/cpp/main.cpp
Normal 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
252
src/cpp/marshal.cpp
Normal 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
96
src/cpp/marshal.h
Normal 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
134
src/cpp/qml.cpp
Normal 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
42
src/cpp/qml.h
Normal 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
83
src/cpp/qt_ecl.cpp
Normal 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
23
src/cpp/qt_ecl.h
Normal 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
34
src/cpp/single_shot.h
Normal 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
|
||||||
179
src/lisp/ini.lisp
Normal file
179
src/lisp/ini.lisp
Normal file
|
|
@ -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))))))
|
||||||
|
|
||||||
62
src/lisp/package.lisp
Normal file
62
src/lisp/package.lisp
Normal file
|
|
@ -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*)
|
||||||
191
src/lisp/qml.lisp
Normal file
191
src/lisp/qml.lisp
Normal file
|
|
@ -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))
|
||||||
|
|
||||||
27
src/lisp/tr.lisp
Normal file
27
src/lisp/tr.lisp
Normal file
|
|
@ -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))
|
||||||
|
|
||||||
177
src/lisp/x.lisp
Normal file
177
src/lisp/x.lisp
Normal file
|
|
@ -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)
|
||||||
8
src/lqml.asd
Normal file
8
src/lqml.asd
Normal file
|
|
@ -0,0 +1,8 @@
|
||||||
|
(defsystem :lqml
|
||||||
|
:serial t
|
||||||
|
:depends-on ()
|
||||||
|
:components ((:file "lisp/x")
|
||||||
|
(:file "lisp/package")
|
||||||
|
(:file "lisp/ini")
|
||||||
|
(:file "lisp/qml")))
|
||||||
|
|
||||||
53
src/lqml.pro
Normal file
53
src/lqml.pro
Normal file
|
|
@ -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
|
||||||
|
}
|
||||||
|
|
||||||
17
src/make.lisp
Normal file
17
src/make.lisp
Normal file
|
|
@ -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))
|
||||||
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue