add GC for QGET, QFUN return values; fix possible memory leaks (e.g. overridden metho...
[eql:eql.git] / src / eql.cpp
1 // copyright (c) 2010-2011 Polos Ruetz\r
2 \r
3 #include "eql.h"\r
4 #include "ecl_fun.h"\r
5 #include "gen/_lobjects.h"\r
6 #include <QApplication>\r
7 #include <QTimer>\r
8 #include <QStringList>\r
9 \r
10 const char EQL::version[] = "11.2.5"; // 2011-02-22\r
11 \r
12 static void eval(const char* lisp_code) {\r
13     CL_CATCH_ALL_BEGIN(ecl_process_env()) {\r
14         si_safe_eval(2, ecl_read_from_cstring((char*)lisp_code), Cnil); }\r
15     CL_CATCH_ALL_END; }\r
16 \r
17 extern "C" void ini_EQL(cl_object);\r
18 \r
19 EQL::EQL() : QObject(), fun(0) {\r
20     iniCLFunctions();\r
21     LObjects::ini(this);\r
22     read_VV(OBJNULL, ini_EQL); } // see src/make-eql-lib.lisp\r
23 \r
24 EQL::~EQL() {\r
25     cl_shutdown(); }\r
26 \r
27 QString EQL::home() {\r
28     static QString path;\r
29     if(path.isEmpty()) {\r
30         path = QApplication::applicationDirPath();\r
31 #ifdef Q_OS_DARWIN\r
32         path.truncate(path.lastIndexOf('/', path.indexOf(".app")));\r
33 #endif\r
34         path.append('/'); }\r
35     return path; }\r
36 \r
37 void EQL::singleShot() {\r
38     if(fun) {\r
39         cl_funcall(1, (cl_object)fun);\r
40         fun = 0; }}\r
41 \r
42 void EQL::exec(const QStringList& args) {\r
43     QStringList arguments(args);\r
44     si_select_package(make_simple_base_string((char*)"EQL"));\r
45     eval(QString("(set-home \"%1\")").arg(home()).toAscii().constData());\r
46     bool tpl = false;\r
47     QStringList forms;\r
48     if(arguments.count() == 1) {\r
49         tpl = true;\r
50         forms << "(si:top-level)"; }\r
51     if(arguments.contains("-qgui")) {\r
52         arguments.removeAll("-qgui");\r
53         forms << "(qgui)"; }\r
54 #ifndef Q_OS_WIN\r
55     if(arguments.contains("-qtpl")) {\r
56         arguments.removeAll("-qtpl");\r
57         tpl = true;\r
58         forms << "(si::qtop-level)"; }\r
59 #endif\r
60     if(arguments.count() > 1) {\r
61         forms.prepend(QString(\r
62                 "(with-input-from-string (s \"(load \\\"%1\\\")\")"\r
63                 "  (let ((*standard-input* s))"\r
64                 "    (si:top-level)))")\r
65                       .arg(arguments.at(1))); }\r
66     QString code;\r
67     if(forms.length() == 1) {\r
68         code = forms.first(); }\r
69     else {\r
70         code = "(progn " + forms.join(" ") + ")"; }\r
71     eval(code.toAscii().constData());\r
72     if(tpl) {\r
73         qquit(); }}\r
74 \r
75 void EQL::exec(lisp_ini ini, const QByteArray& expression, const QByteArray& package) {\r
76     eval(QString("(eql::set-home \"%1\")").arg(home()).toAscii().constData());\r
77     read_VV(OBJNULL, ini);\r
78     si_select_package(make_simple_base_string((char*)package.constData()));\r
79     eval(expression.constData()); }\r
80 \r
81 void EQL::exec(QWidget* widget, const QByteArray& file) {\r
82     eval(QString("(set-home \"%1\")").arg(home()).toAscii().constData());\r
83     const QMetaObject* mo = widget->metaObject();\r
84     QByteArray className(mo->className());\r
85     while(!className.startsWith('Q')) {\r
86         mo = mo->superClass();\r
87         if(!mo) {\r
88             break; }\r
89         className = mo->className(); }\r
90     eval(QString(\r
91             "(progn"\r
92             "  (defvar *qt-main* (qt-object %1 0 (eql:qid \"%2\")))"\r
93             "  (export '*qt-main*))")\r
94          .arg((ulong)widget)\r
95          .arg(QString(className))\r
96          .toAscii().constData());\r
97     si_select_package(make_simple_base_string((char*)"CL-USER"));\r
98     eval(QString("(load \"%1\")").arg(QString(file)).toAscii().constData()); }\r
99 \r
100 bool EQL::is_arg_return_value = false;\r