mirror of
https://gitlab.com/eql/EQL5.git
synced 2025-12-15 23:00:50 -08:00
264 lines
10 KiB
C++
264 lines
10 KiB
C++
// copyright (c) Polos Ruetz
|
|
|
|
#include "eql5/eql.h"
|
|
#include "ecl_fun.h"
|
|
#include "gen/_lobjects.h"
|
|
#include <iostream>
|
|
#include <QApplication>
|
|
#include <QTimer>
|
|
#include <QStringList>
|
|
#include <QDebug>
|
|
|
|
const char EQL::version[] = "21.3.4"; // March 2021
|
|
|
|
extern "C" void ini_EQL(cl_object);
|
|
|
|
static const char* _argv_[] = {"EQL5"};
|
|
|
|
#ifdef COMPILE_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
|
|
|
|
EQL::EQL() : QObject() {
|
|
#ifdef COMPILE_ANDROID
|
|
qInstallMessageHandler(logMessageHandler); // see above
|
|
#endif
|
|
if(!cl_booted_p) {
|
|
cl_boot(1, (char**)_argv_); }
|
|
iniCLFunctions();
|
|
LObjects::ini(this);
|
|
ecl_init_module(NULL, ini_EQL); } // see "src/make.lisp"
|
|
|
|
EQL::~EQL() {
|
|
if(!EQL::cl_shutdown_p) {
|
|
cl_shutdown(); }}
|
|
|
|
void EQL::ini(char** argv) {
|
|
cl_booted_p = true;
|
|
cl_boot(1, argv); }
|
|
|
|
void EQL::ini(int argc, char** argv) {
|
|
cl_booted_p = true;
|
|
cl_boot(argc, argv); }
|
|
|
|
static void safe_eval_debug(const char* lisp_code) {
|
|
CL_CATCH_ALL_BEGIN(ecl_process_env()) {
|
|
si_safe_eval(2, ecl_read_from_cstring((char*)lisp_code), ECL_NIL); }
|
|
CL_CATCH_ALL_END; }
|
|
|
|
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((char*)lisp_code),
|
|
ECL_NIL,
|
|
ecl_make_fixnum(EVAL_ERROR_VALUE)); }
|
|
CL_CATCH_ALL_END;
|
|
return ret; }
|
|
|
|
void EQL::eval(const char* lisp_code, const EvalMode mode) {
|
|
switch(mode) {
|
|
case DebugOnError:
|
|
safe_eval_debug(lisp_code);
|
|
break;
|
|
case LogOnError:
|
|
case DieOnError:
|
|
cl_object ret = safe_eval(lisp_code);
|
|
if (ecl_t_of(ret) == t_fixnum && fix(ret) == EVAL_ERROR_VALUE) {
|
|
qDebug() << "Error evaluating " << lisp_code;
|
|
if (mode == DieOnError) {
|
|
exit(-1); }}}}
|
|
|
|
void EQL::ignoreIOStreams() {
|
|
// [Windows] print output would cause a gui exe to crash (without console)
|
|
eval("(eql::ignore-io-streams)"); }
|
|
|
|
void EQL::exec(const QStringList& args) {
|
|
cl_object s_qtpl = cl_intern(1, ecl_make_constant_base_string("*QTPL*", -1));
|
|
bool exec_with_simple_restart = false;
|
|
QStringList arguments(args);
|
|
eval("(in-package :eql-user)");
|
|
QStringList forms;
|
|
// .eclrc
|
|
if(arguments.contains("-norc")) {
|
|
arguments.removeAll("-norc"); }
|
|
else {
|
|
eval("(x:when-it (probe-file \"~/.eclrc\") (load x:it))"); }
|
|
if (arguments.contains("-debug-on-error")) {
|
|
arguments.removeAll("-debug-on-error");
|
|
evalMode = DebugOnError; }
|
|
// Slime
|
|
int i_swank = arguments.indexOf(QRegExp("*start-swank*.lisp", Qt::CaseInsensitive, QRegExp::Wildcard));
|
|
if(arguments.contains("-slime") || (i_swank != -1)) {
|
|
arguments.removeAll("-slime");
|
|
QString swankFile;
|
|
if(i_swank != -1) {
|
|
swankFile = arguments.at(i_swank);
|
|
arguments.removeAt(i_swank); }
|
|
QApplication::setQuitOnLastWindowClosed(false);
|
|
forms << "(unless eql:*slime-mode*" // see mode :REPL-HOOK in "slime/eql-start-swank.lisp"
|
|
" (setf eql:*slime-mode* t))"
|
|
"(setf eql:*qtpl* nil)";
|
|
if(arguments.length() == 2) {
|
|
QString fileName(QDir::fromNativeSeparators(arguments.at(1)));
|
|
forms << QString("(load \"%1\")").arg(fileName);
|
|
arguments.removeAt(1); }
|
|
if(!swankFile.isEmpty()) {
|
|
arguments << swankFile; }
|
|
exec_with_simple_restart = true; }
|
|
// -qtpl
|
|
else if(arguments.contains("-qtpl") || (cl_symbol_value(s_qtpl) == ECL_T)) {
|
|
arguments.removeAll("-qtpl");
|
|
evalMode = DebugOnError;
|
|
ecl_setq(ecl_process_env(), s_qtpl, ECL_T);
|
|
QApplication::setQuitOnLastWindowClosed(false);
|
|
forms << "(when (directory (in-home \"lib/ecl-readline.fas*\"))"
|
|
" (load (x:check-recompile (in-home \"lib/ecl-readline\"))))"
|
|
<< "(qsingle-shot 500 'eql::start-read-thread)";
|
|
exec_with_simple_restart = true; }
|
|
// -qgui
|
|
if(arguments.contains("-qgui")) {
|
|
arguments.removeAll("-qgui");
|
|
forms << "(qgui)"; }
|
|
// -quic
|
|
if(arguments.contains("-quic")) {
|
|
arguments.removeAll("-quic");
|
|
bool maximized = false;
|
|
if(arguments.contains(":maximized")) {
|
|
arguments.removeAll(":maximized");
|
|
maximized = true; }
|
|
if(arguments.length() >= 2) {
|
|
QString uiFile(QDir::fromNativeSeparators(arguments.at(1)));
|
|
int sep = uiFile.lastIndexOf('/') + 1;
|
|
forms << QString("(ext:run-program \"uic\" (list \"-o\" \"ui.h\" \"%1\"))").arg(uiFile)
|
|
<< QString("(eql:quic \"ui.h\" \"%1ui-%2.lisp\" %3 %4)")
|
|
.arg(uiFile.left(sep))
|
|
.arg(uiFile.mid(sep, uiFile.length() - sep - 3))
|
|
.arg((arguments.length() == 2) ? ":ui" : arguments.at(2))
|
|
.arg(maximized ? ":maximized" : "")
|
|
<< QString("(delete-file \"ui.h\")")
|
|
<< QString("(eql:qq)"); }
|
|
else {
|
|
std::cout << "\nPlease pass a file.ui (Qt Designer).\n" << std::endl;
|
|
exit(-1); }}
|
|
else {
|
|
if(arguments.length() == 1) {
|
|
// simple top-level
|
|
if(forms.isEmpty()) {
|
|
qexec = false;
|
|
forms << "(si:top-level)"; }}
|
|
else {
|
|
// load file
|
|
QString fileName(QDir::fromNativeSeparators(arguments.at(1)));
|
|
forms.prepend(QString("(load \"%1\")").arg(fileName)); }}
|
|
// eval
|
|
QString code;
|
|
if(forms.length() == 1) {
|
|
code = forms.first(); }
|
|
else {
|
|
code = "(progn " + forms.join(" ") + ")"; }
|
|
eval(code.toLatin1().constData());
|
|
// RESTART for Qt event loop
|
|
if(exec_with_simple_restart) {
|
|
qexec = false;
|
|
eval("(eql::exec-with-simple-restart)"); }}
|
|
|
|
void EQL::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)).toLatin1().constData());
|
|
eval(expression.constData()); }
|
|
|
|
enum { NotFound = -1 };
|
|
|
|
void EQL::exec(QWidget* widget, const QString& lispFile, const QString& slimeHookFile) {
|
|
// see Qt_EQL example
|
|
bool exec_with_simple_restart = false;
|
|
QStringList forms;
|
|
eval("(in-package :eql)");
|
|
forms << QString("(defvar *qt-main* (qt-object %1 0 (qid \"%2\")))")
|
|
.arg((quintptr)widget)
|
|
.arg(QString(LObjects::vanillaQtSuperClassName(widget->metaObject())))
|
|
<< QString("(export '*qt-main*)")
|
|
<< QString("(in-package :eql-user)")
|
|
<< QString("(load \"%1\")").arg(lispFile);
|
|
if(!slimeHookFile.isEmpty()) {
|
|
QString startSwankFile(QCoreApplication::arguments().last());
|
|
if(NotFound == startSwankFile.indexOf(QRegExp("*start-swank*.lisp", Qt::CaseInsensitive, QRegExp::Wildcard))) {
|
|
std::cout << "\nPlease pass the pathname for \"eql-start-swank.lisp\".\n" << std::endl;
|
|
exit(-1); }
|
|
QApplication::setQuitOnLastWindowClosed(false);
|
|
forms << QString("(load \"%1\")").arg(startSwankFile)
|
|
<< QString("(setf eql::*slime-hook-file* \"%1\")").arg(slimeHookFile)
|
|
<< QString("(setf eql:*slime-mode* t"
|
|
" eql:*qtpl* nil)");
|
|
exec_with_simple_restart = true; }
|
|
eval(QString("(progn " + forms.join(" ") + ")").toLatin1().constData());
|
|
if(exec_with_simple_restart) {
|
|
eval("(eql::exec-with-simple-restart)"); }}
|
|
|
|
void EQL::addObject(QObject* object, const QByteArray& varName, bool defineWrappers, bool lispifyNames) {
|
|
cl_object l_symbol = ECL_NIL;
|
|
int p = varName.indexOf(':');
|
|
if(p == -1) {
|
|
// use current package
|
|
l_symbol = cl_intern(1,
|
|
STRING_COPY(varName.toUpper().constData())); }
|
|
else {
|
|
// use provided package
|
|
QByteArray pkg = varName.left(p);
|
|
QByteArray var = varName.mid(varName.lastIndexOf(':') + 1);
|
|
l_symbol = cl_intern(2,
|
|
STRING_COPY(var.toUpper().constData()),
|
|
cl_find_package(STRING_COPY(pkg.toUpper().constData()))); }
|
|
cl_object l_object = qt_object_from_name(LObjects::vanillaQtSuperClassName(object->metaObject()), object);
|
|
// 'defvar'
|
|
ecl_defvar(l_symbol, l_object);
|
|
if(defineWrappers) {
|
|
// 'define-qt-wrappers'
|
|
STATIC_SYMBOL_PKG (s_define_qt_wrappers, "DEFINE-QT-WRAPPERS", "EQL")
|
|
STATIC_SYMBOL_PKG (s_do_not_lispify, "DO-NOT-LISPIFY", "KEYWORD")
|
|
if(lispifyNames) {
|
|
cl_funcall(2,
|
|
s_define_qt_wrappers,
|
|
l_object); }
|
|
else {
|
|
cl_funcall(3,
|
|
s_define_qt_wrappers,
|
|
l_object,
|
|
s_do_not_lispify); }}}
|
|
|
|
void EQL::runOnUiThread(void* function_or_closure) {
|
|
const cl_env_ptr l_env = ecl_process_env();
|
|
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; }
|
|
|
|
EQL::EvalMode EQL::evalMode = DieOnError;
|
|
bool EQL::cl_booted_p = false;
|
|
bool EQL::cl_shutdown_p = false;
|
|
bool EQL::return_value_p = false;
|
|
bool EQL::qexec = true;
|
|
QEventLoop* EQL::eventLoop = 0;
|