port of EQL/Qt4 to Qt5

.gitignore

@@ -0,0 +1,39 @@
+*.a
+*.dll
+*.dylib
+*.exe
+*.fas*
+*.*history
+*.lib
+*.o
+*.obj
+*.so*
+*.DS_Store
+*.qm
+*.ts
+*~
+*.~
+#*.*#
+.*.lisp
+.*.ui
+.*.txt
+*.user
+t.lisp
+tr.h
+moc_*.cpp
+Makefile
+eql
+eql5
+eql.app
+gui/.*
+my_app/my_app
+my_app/my_app.app/*
+my_app/.*
+src/ECL*
+src/tmp
+eql_profile*
+eql_local_server
+cache
+tmp
+palindrome.htm
+positions.js

LICENSE-1.MIT

@@ -0,0 +1,20 @@
+Copyright (c) 2010-2014 Polos (Paul) Ruetz
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
+

LICENSE-2-MAKE-QIMAGE.txt

@@ -0,0 +1,25 @@
+;; Copyright (c) 2012, Mark Cox
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+
+;; - Redistributions of source code must retain the above copyright
+;;   notice, this list of conditions and the following disclaimer.
+
+;; - Redistributions in binary form must reproduce the above copyright
+;;   notice, this list of conditions and the following disclaimer in the
+;;   documentation and/or other materials provided with the distribution.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Qt_EQL/README.txt

@@ -0,0 +1,27 @@
+BUILD / RUN
+===========
+
+Build the plugins in "cpp/", "cpp_calling_lisp/" before running the examples.
+
+See "trafficlight/" for an example of integrating a Qt/C++ application.
+
+
+
+NOTES
+=====
+
+This offers the same possibilities as found in the "Qt_EQL/" example,
+but with a better, more dynamic workflow, and without the restriction of
+"CONFIG += no_keywords" in your "*.pro" file.
+
+So, integrating any existing Qt/C++ project is straightforward, since you can
+call any property/method/slot/signal of any Qt class (see QFIND-CHILD,
+QFIND-CHILDREN, QFUN+).
+
+Calling Lisp from C++ through "eql_fun()" is easy, and you can use any Qt
+class/type supported by EQL, see examples in "cpp_calling_lisp/lib.cpp".
+
+To automatically generate generic function wrappers for your Qt functions,
+see function DEFINE-QT-WRAPPERS.
+
+Linux only: see also function QAUTO-RELOAD-C++.

Qt_EQL/auto-reload.lisp

@@ -0,0 +1,21 @@
+;;;
+;;; Linux only!
+;;;
+;;; just edit/recompile "cpp/*"
+;;;
+
+(in-package :eql-user)
+
+#+linux
+(qauto-reload-c++ *lib* (in-home "Qt_EQL/eql_cpp"))
+
+#+linux
+(setf *lib-reloaded* 'show-current-apropos)
+
+(defun show-current-apropos (variable plugin)
+  (qset (qapp) "quitOnLastWindowClosed" nil) 
+  (let ((obj (symbol-value variable)))
+    (assert (qt-object-p obj))
+    (qmsg (with-output-to-string (*standard-output*)
+            (format t "<b>Plugin ~S currently offers:</b><pre>" plugin)
+            (qapropos nil obj)))))

Qt_EQL/cpp/eql_cpp.pro

@@ -0,0 +1,12 @@
+QT          += widgets
+TEMPLATE    = lib
+CONFIG      += plugin release
+DESTDIR     = ../
+TARGET      = eql_cpp
+OBJECTS_DIR = ./tmp/
+MOC_DIR     = ./tmp/
+
+include(../../src/windows.pri)
+
+HEADERS += lib.h
+SOURCES += lib.cpp

Qt_EQL/cpp/lib.cpp

@@ -0,0 +1,32 @@
+#include "lib.h"
+
+QT_BEGIN_NAMESPACE
+
+QObject* ini()
+{
+    // any QObject inherited class will do (e.g. main window of a C++ application)
+    static QObject* cpp = 0;
+    if(!cpp) {
+        cpp = new CPP;
+        cpp->setObjectName("Qt_EQL_dynamic");
+    }
+    return cpp;
+}
+
+// insert here your function implementations
+
+QVariantList CPP::hello(const QVariantList& list)
+{
+    QString msg;
+    QDebug debug(&msg);
+    debug << list;
+    QMessageBox::information(0, "QVariantList", msg);
+
+    QVariantList ret(list);
+    if(!ret.isEmpty()) {
+        ret[0] = "hello from Lisp";
+    }
+    return ret;
+}
+
+QT_END_NAMESPACE

Qt_EQL/cpp/lib.h

@@ -0,0 +1,26 @@
+#ifndef LIB_H
+#define LIB_H
+
+#include <QtWidgets>
+
+#ifdef Q_WS_WIN
+#define LIB_EXPORT __declspec(dllexport)
+#else
+#define LIB_EXPORT
+#endif
+
+QT_BEGIN_NAMESPACE
+
+extern "C" { LIB_EXPORT QObject* ini(); }
+
+class CPP : public QObject
+{
+    Q_OBJECT
+public:
+    // insert here your function declarations, prepended by Q_INVOKABLE
+    Q_INVOKABLE QVariantList hello(const QVariantList&);
+};
+
+QT_END_NAMESPACE
+
+#endif

Qt_EQL/cpp_calling_lisp/eql_cpp.pro

@@ -0,0 +1,13 @@
+QT          += widgets
+TEMPLATE    = lib
+CONFIG      += plugin release
+LIBS        += -L../.. -leql5
+DESTDIR     = ../
+TARGET      = eql_fun_cpp
+OBJECTS_DIR = ./tmp/
+MOC_DIR     = ./tmp/
+
+include(../../src/windows.pri)
+
+HEADERS += lib.h
+SOURCES += lib.cpp

Qt_EQL/cpp_calling_lisp/lib.cpp

@@ -0,0 +1,62 @@
+#include "lib.h"
+#include "../../src/eql_fun.h" // for eql_fun()
+
+QT_BEGIN_NAMESPACE
+
+QObject* ini()
+{
+    // any QObject inherited class will do (e.g. main window of a C++ application)
+    static QObject* cpp = 0;
+    if(!cpp) {
+        cpp = new CPP;
+        cpp->setObjectName("Qt_EQL_dynamic");
+    }
+    return cpp;
+}
+
+// insert here your function implementations
+
+void CPP::runExamples()
+{
+    ulong n = 123;
+
+    // (1) call user defined function
+    {
+        QVariant ret = eql_fun("eql-user:say-number", QVariant::String, // see: ecl_fun.cpp:toQVariant()
+                               Q_ARG(ulong, n));                        // see: ecl_fun.cpp:to_lisp_arg()
+
+        QMessageBox::information(0, "Example 1",
+                                 "<pre><b>eql_fun(\"eql-user:say-number\"...);</b><br><br>" + ret.toString());
+    }
+
+    // (2) call FORMAT directly
+    {
+        QVariant ret = eql_fun("format", QVariant::String,
+                               Q_ARG(bool, false),   // max. 10 Q_ARG()
+                               Q_ARG(QString, "~R"),
+                               Q_ARG(ulong, n));
+
+        QMessageBox::information(0, "Example 2",
+                                 "<pre><b>eql_fun(\"format\"...);</b><br><br>" + ret.toString());
+    }
+
+    // (3) returning a pointer
+    {
+        QVariant ret = eql_fun("qnew", QMetaType::VoidStar,
+                               Q_ARG(QString, "QLabel"));
+
+        QLabel* object = Q_PTR(QLabel*, ret); // type checked at run time; 0 if check fails
+        if(object) {
+            // ...
+        }
+
+        QString msg;
+        QDebug out(&msg);
+        out << "<p>Q_PTR returned:<b>" << object << "</b></p><p>(type checked at run time)</p>";
+
+        QMessageBox::information(0, "Example 3",
+                                 "<pre><b>eql_fun(\"qnew\"...);</b>" + msg);
+    }
+}
+
+QT_END_NAMESPACE

Qt_EQL/cpp_calling_lisp/lib.h

@@ -0,0 +1,26 @@
+#ifndef LIB_H
+#define LIB_H
+
+#include <QtWidgets>
+
+#ifdef Q_WS_WIN
+#define LIB_EXPORT __declspec(dllexport)
+#else
+#define LIB_EXPORT
+#endif
+
+QT_BEGIN_NAMESPACE
+
+extern "C" { LIB_EXPORT QObject* ini(); }
+
+class CPP : public QObject
+{
+    Q_OBJECT
+public:
+    // insert here your function declarations, prepended by Q_INVOKABLE
+    Q_INVOKABLE void runExamples();
+};
+
+QT_END_NAMESPACE
+
+#endif

Qt_EQL/looping.lisp

@@ -0,0 +1,15 @@
+;;; Lisp calling C++ calling Lisp
+
+(in-package :eql-user)
+
+(defvar *lib* (qload-c++ (in-home "Qt_EQL/eql_fun_cpp")))
+
+(defun say-number (n)
+  (format nil "~R" n))
+
+;; see examples in "cpp_calling_lisp/lib.cpp"
+
+(! "runExamples" (:qt *lib*)) ; note :qt
+
+(qq)
+

Qt_EQL/make.bat

@@ -0,0 +1,4 @@
+@echo off
+
+cd cpp
+nmake

Qt_EQL/reload.lisp

@@ -0,0 +1,30 @@
+;;;
+;;; OSX note: unloading may not work!
+;;;
+;;; Simple demo:
+;;;
+;;;    0) do: eql reload.lisp -qtpl
+;;;
+;;;    1) make some changes in "cpp/lib.h", "cpp/lib.cpp"
+;;;    2) do: (recompile-c++)
+;;;    3) goto 1)
+;;;
+;;; Call plugin functions like this:
+;;;
+;;;     (qfun+ *lib* "myFunction")   ; a)
+;;;     (! "myFunction" (:qt *lib*)) ; b)
+;;;
+
+(in-package :eql-user)
+
+(defvar *lib* (qload-c++ (in-home "Qt_EQL/eql_cpp")))
+
+(defun recompile-c++ ()
+  (qload-c++ (in-home "Qt_EQL_dynamic/eql_cpp")
+             :unload)
+  (ext:run-program #+msvc "make.bat" #-msvc "make"
+                   #+msvc nil        #-msvc '("-C" "cpp/")
+                   :output t)
+  (setf *lib* (qload-c++ (in-home "Qt_EQL/eql_cpp")))
+  (assert (qt-object-p *lib*))
+  (qapropos nil *lib*))

Qt_EQL/test.lisp

@@ -0,0 +1,17 @@
+(in-package :eql-user)
+
+(defvar *lib* (qload-c++ (in-home "Qt_EQL/eql_cpp")))
+
+(assert (qt-object-p *lib*))
+
+(qapropos nil *lib*)
+
+;; test call
+
+(qlet ((a "QVariant(QString)"    "hello from C++")
+       (b "QVariant(int)"        42)
+       (c "QVariant(double)"     pi)
+       (d "QVariant(QByteArray)" #(69 81 76)))
+  (qmsg (! "hello" (:qt *lib*) (list a b c d)))) ; note :qt
+
+(qq)

Qt_EQL/trafficlight/README.txt

@@ -0,0 +1,32 @@
+This is a simple example of integrating an existing Qt/C++ application
+
+
+BUILD / RUN / CALL
+==================
+
+qmake
+make
+
+eql run.lisp -qtpl
+
+________________________________________
+
+Option 1:
+
+  (qfun+ *trafficlight* "stop")
+  (qfun+ *trafficlight* "start")
+________________________________________
+
+Option 2:
+
+  (! "stop"  (:qt *trafficlight*))
+  (! "start" (:qt *trafficlight*))
+________________________________________
+
+Option 3:
+
+  (define-qt-wrappers *trafficlight*)
+
+  (start *trafficlight*)
+  (stop *trafficlight*)
+________________________________________

Qt_EQL/trafficlight/lib.cpp

@@ -0,0 +1,19 @@
+#include "lib.h"
+#include "trafficlight.h"
+
+QT_BEGIN_NAMESPACE
+
+QObject* ini()
+{
+    static QWidget* widget = 0;
+
+    if(!widget) {
+        widget = new TrafficLight;
+        widget->resize(110, 300);
+        widget->show();
+    }
+
+    return widget;
+}
+
+QT_END_NAMESPACE

Qt_EQL/trafficlight/lib.h

@@ -0,0 +1,18 @@
+#ifndef LIB_H
+#define LIB_H
+
+#include <QtGui>
+
+#ifdef Q_WS_WIN
+#define LIB_EXPORT __declspec(dllexport)
+#else
+#define LIB_EXPORT
+#endif
+
+QT_BEGIN_NAMESPACE
+
+extern "C" { LIB_EXPORT QObject* ini(); }
+
+QT_END_NAMESPACE
+
+#endif

Qt_EQL/trafficlight/run.lisp

@@ -0,0 +1,23 @@
+(in-package :eql-user)
+
+(defvar *trafficlight* (qload-c++ (in-home "Qt_EQL/trafficlight/trafficlight")))
+(defvar *lights*       (qfind-children *trafficlight* nil "LightWidget"))
+(defvar *red*          (first *lights*))
+(defvar *yellow*       (second *lights*))
+(defvar *green*        (third *lights*))
+
+(qapropos nil *trafficlight*)
+(qapropos nil *red*)
+
+;;; generate wrappers
+
+(define-qt-wrappers *trafficlight*)
+(define-qt-wrappers *red*)
+
+;;; now you can do:
+;;;
+;;; (start *trafficlight*)
+;;; (stop *trafficlight*)
+;;;
+;;; (turn-on *red*)
+;;; (turn-off *green*)

Qt_EQL/trafficlight/trafficlight.cpp

@@ -0,0 +1,18 @@
+// original copyright:
+//
+// ** Copyright (C) 2010 Nokia Corporation and/or its subsidiary(-ies).
+// ** You may use this file under the terms of the BSD license
+
+#include "trafficlight.h"
+
+void LightWidget::paintEvent(QPaintEvent *)
+{
+    if (!m_on)
+        return;
+
+    QPainter painter(this);
+    painter.setRenderHint(QPainter::Antialiasing);
+    painter.setBrush(m_color);
+    painter.drawEllipse(0, 0, width(), height());
+}
+

Qt_EQL/trafficlight/trafficlight.h

@@ -0,0 +1,134 @@
+// original copyright:
+//
+// ** Copyright (C) 2010 Nokia Corporation and/or its subsidiary(-ies).
+// ** You may use this file under the terms of the BSD license
+
+#ifndef TRAFFICLIGHT_H
+#define TRAFFICLIGHT_H
+
+#include <QtWidgets>
+
+class LightWidget : public QWidget
+{
+    Q_OBJECT
+    Q_PROPERTY(bool on READ isOn WRITE setOn)
+public:
+    LightWidget(const QColor &color, QWidget *parent = 0)
+        : QWidget(parent), m_color(color), m_on(false) {}
+
+    bool isOn() const
+        { return m_on; }
+    void setOn(bool on)
+    {
+        if (on == m_on)
+            return;
+        m_on = on;
+        update();
+    }
+
+public slots:
+    void turnOff() { setOn(false); }
+    void turnOn() { setOn(true); }
+
+protected:
+    virtual void paintEvent(QPaintEvent *);
+
+private:
+    QColor m_color;
+    bool m_on;
+};
+
+class TrafficLightWidget : public QWidget
+{
+public:
+    TrafficLightWidget(QWidget *parent = 0)
+        : QWidget(parent)
+    {
+        QVBoxLayout *vbox = new QVBoxLayout(this);
+        m_red = new LightWidget(Qt::red);
+        m_red->setObjectName("red");
+        vbox->addWidget(m_red);
+        m_yellow = new LightWidget(Qt::yellow);
+        m_yellow->setObjectName("yellow");
+        vbox->addWidget(m_yellow);
+        m_green = new LightWidget(Qt::green);
+        m_green->setObjectName("green");
+        vbox->addWidget(m_green);
+        QPalette pal = palette();
+        pal.setColor(QPalette::Background, Qt::black);
+        setPalette(pal);
+        setAutoFillBackground(true);
+    }
+
+    LightWidget *redLight() const
+        { return m_red; }
+    LightWidget *yellowLight() const
+        { return m_yellow; }
+    LightWidget *greenLight() const
+        { return m_green; }
+
+private:
+    LightWidget *m_red;
+    LightWidget *m_yellow;
+    LightWidget *m_green;
+};
+
+class TrafficLight : public QWidget
+{
+    Q_OBJECT
+public:
+    TrafficLight(QWidget *parent = 0)
+        : QWidget(parent)
+    {
+        QVBoxLayout *vbox = new QVBoxLayout(this);
+        TrafficLightWidget *widget = new TrafficLightWidget();
+        vbox->addWidget(widget);
+        vbox->setMargin(0);
+
+        machine = new QStateMachine(this);
+        QState *redGoingYellow = createLightState(widget->redLight(), 2000);
+        redGoingYellow->setObjectName("redGoingYellow");
+        QState *yellowGoingGreen = createLightState(widget->yellowLight(), 500);
+        yellowGoingGreen->setObjectName("yellowGoingGreen");
+        redGoingYellow->addTransition(redGoingYellow, SIGNAL(finished()), yellowGoingGreen);
+        QState *greenGoingYellow = createLightState(widget->greenLight(), 2000);
+        greenGoingYellow->setObjectName("greenGoingYellow");
+        yellowGoingGreen->addTransition(yellowGoingGreen, SIGNAL(finished()), greenGoingYellow);
+        QState *yellowGoingRed = createLightState(widget->yellowLight(), 500);
+        yellowGoingRed->setObjectName("yellowGoingRed");
+        greenGoingYellow->addTransition(greenGoingYellow, SIGNAL(finished()), yellowGoingRed);
+        yellowGoingRed->addTransition(yellowGoingRed, SIGNAL(finished()), redGoingYellow);
+
+        machine->addState(redGoingYellow);
+        machine->addState(yellowGoingGreen);
+        machine->addState(greenGoingYellow);
+        machine->addState(yellowGoingRed);
+        machine->setInitialState(redGoingYellow);
+        machine->start();
+    }
+
+    QState *createLightState(LightWidget *light, int duration, QState *parent = 0)
+    {
+        QState *lightState = new QState(parent);
+        QTimer *timer = new QTimer(lightState);
+        timer->setInterval(duration);
+        timer->setSingleShot(true);
+        QState *timing = new QState(lightState);
+        QObject::connect(timing, SIGNAL(entered()), light, SLOT(turnOn()));
+        QObject::connect(timing, SIGNAL(entered()), timer, SLOT(start()));
+        QObject::connect(timing, SIGNAL(exited()), light, SLOT(turnOff()));
+        QFinalState *done = new QFinalState(lightState);
+        timing->addTransition(timer, SIGNAL(timeout()), done);
+        lightState->setInitialState(timing);
+        return lightState;
+    }
+
+    Q_INVOKABLE void start() { machine->start(); }
+    Q_INVOKABLE void stop() { machine->stop(); }
+
+private:
+    QStateMachine *machine;
+
+};
+
+#endif

Qt_EQL/trafficlight/trafficlight.pro

@@ -0,0 +1,15 @@
+QT          += widgets
+TEMPLATE    = lib
+CONFIG      += plugin release
+DESTDIR     = ./
+TARGET      = trafficlight
+OBJECTS_DIR = ./tmp/
+MOC_DIR     = ./tmp/
+
+include(../../src/windows.pri)
+
+HEADERS += lib.h \
+           trafficlight.h
+
+SOURCES += lib.cpp \
+           trafficlight.cpp

Qt_EQL_plugin/Qt/main.cpp

@@ -0,0 +1,14 @@
+#include <QApplication>
+#include <QWidget>
+#include "qt_application.h"
+
+int main(int argc, char** argv)
+{
+    QApplication qapp(argc, argv);
+
+    MainWindow window;
+    window.setGeometry(50, 50, 500, 300);
+    window.show();
+
+    return qapp.exec();
+}

Qt_EQL_plugin/Qt/qt_application.cpp

@@ -0,0 +1,64 @@
+#include <QtWidgets>
+#include <QLibrary>
+#include <QtDebug>
+
+#include "qt_application.h"
+
+typedef void (*OnShowPlugin)(QWidget*);
+typedef void (*OnHidePlugin)();
+
+static OnShowPlugin onShowPlugin = 0;
+static OnHidePlugin onHidePlugin = 0;
+
+MainWindow::MainWindow() : pluginWidget(0)
+{
+    setWindowTitle("Qt Application");
+
+    QWidget* central = new QWidget;
+    QLabel* label = new QLabel;
+    label->setText(tr("<h3>QMainWindow with a dockable plugin widget.</h3>"));
+    QPushButton* buttonShow = new QPushButton(tr("show plugin"));
+    QPushButton* buttonHide = new QPushButton(tr("hide plugin"));
+    setCentralWidget(central);
+
+    QHBoxLayout* layout = new QHBoxLayout(central);
+    QVBoxLayout* buttonLayout = new QVBoxLayout;
+    buttonLayout->addWidget(buttonShow);
+    buttonLayout->addWidget(buttonHide);
+    buttonLayout->addStretch();
+    layout->addWidget(label);
+    layout->addLayout(buttonLayout);
+
+    connect(buttonShow, SIGNAL(clicked()), SLOT(showPlugin()));
+    connect(buttonHide, SIGNAL(clicked()), SLOT(hidePlugin()));
+}
+
+void MainWindow::showPlugin()
+{
+    static bool loaded = false;
+    if(!loaded) {
+        loaded = true;
+        QLibrary plugin("./qt_plugin");
+        onShowPlugin = (OnShowPlugin)plugin.resolve("onShowPlugin");
+        onHidePlugin = (OnHidePlugin)plugin.resolve("onHidePlugin");
+        pluginWidget = new QDockWidget(this);
+        addDockWidget(Qt::TopDockWidgetArea, pluginWidget);
+    }
+
+    if(onShowPlugin) {
+        onShowPlugin(pluginWidget);
+    }
+
+    pluginWidget->show();
+}
+
+void MainWindow::hidePlugin()
+{
+    if(pluginWidget) {
+        pluginWidget->hide();
+    }
+
+    if(onHidePlugin) {
+        onHidePlugin();
+    }
+}

Qt_EQL_plugin/Qt/qt_application.h

@@ -0,0 +1,24 @@
+#ifndef QT_APPLICATION_H
+#define QT_APPLICATION_H
+
+#include <QMainWindow>
+
+QT_BEGIN_NAMESPACE
+
+class MainWindow : public QMainWindow
+{
+    Q_OBJECT
+
+public:
+    MainWindow();
+
+    QDockWidget* pluginWidget;
+
+public slots:
+    void showPlugin();
+    void hidePlugin();
+};
+
+QT_END_NAMESPACE
+
+#endif

Qt_EQL_plugin/Qt/qt_application.pro

@@ -0,0 +1,10 @@
+QT          += widgets
+TEMPLATE     = app
+CONFIG      += release
+TARGET       = qt_application
+DESTDIR      = ../
+OBJECTS_DIR  = ./tmp/
+MOC_DIR      = ./tmp/
+
+HEADERS = qt_application.h
+SOURCES = qt_application.cpp main.cpp

Qt_EQL_plugin/README.txt

@@ -0,0 +1,34 @@
+*** N.B: MS folks: You'll need Windows >= 7 ***
+
+
+INTRO / DESCRIPTION
+===================
+
+This is a very basic example of using EQL in a Qt plugin.
+So, if some 3rd party Qt application offers a way to integrate Qt plugins, you
+can use EQL for your plugin.
+
+We assume that the 3rd party application offers us a QWidget as parent for
+our plugin. In this example it's a QDockWidget, which is bound to
+eql:*qt-main* in Lisp.
+
+
+
+BUILD / RUN
+===========
+
+- build dummy application in "Qt/"
+- build plugin in this directory
+- run the "qt_application" executable
+
+
+
+NOTES
+=====
+
+See also the function "set-data" in "ini.lisp": it shows a simple way for data
+exchange between the application and the plugin.
+It uses a dynamic Qt property, which can be accessed from both sides, C++ and
+Lisp, since the property is added to the plugin parent widget of the application:
+"pluginWidget" in C++, "*qt-main*" in Lisp.
+

Qt_EQL_plugin/ini.lisp

@@ -0,0 +1,49 @@
+(in-package :eql-user)
+
+(defvar *label* (qnew "QLabel"))
+(defvar *edit*  (qnew "QLineEdit"))
+(defvar *font*  (qnew "QFont(QString,int)"
+                      #+darwin  "Monaco"      #+darwin  12
+                      #+linux   "Monospace"   #+linux   9
+                      #+windows "Courier New" #+windows 10))
+
+(defun ini ()
+  (let* ((widget (qnew "QWidget"))
+         (layout (qnew "QVBoxLayout(QWidget*)" widget)))
+    (dolist (w (list *label* *edit*))
+      (qset w "font" *font*)
+      (! "addWidget" layout w))
+    (! "setWidget" *qt-main* widget)
+    (qconnect *edit* "returnPressed()" 'eval-edit)
+    (qlater 'delayed-ini)))
+
+(defun delayed-ini ()
+  (qset *edit* "text" "(in-package :eql-user)")
+  (eval-edit)
+  (qset *label* "text" "Enter Lisp expression and hit Return:"))
+
+(defun eval-edit ()
+  (qset *label* "text"
+        (handler-case (let ((result (eval (read-from-string (qget *edit* "text")))))
+                        (! "clear" *edit*)
+                        (princ-to-string result))
+          (error (condition)
+            (x:cc "<b style='color:red'>Error:</b> " (qescape (princ-to-string condition)))))))
+
+(let (loaded)
+  (defun ? ()
+    (unless loaded
+      (setf loaded t)
+      (load "../src/lisp/qselect.lisp"))
+    (eql::%qselect (lambda (widget) (qset *label* "text" (format nil "~A ; see qsel:*q*" widget))))))
+
+(defun set-data (data)
+  "Example of using dynamic Qt properties for simple data exchange."
+  (! "setProperty" *qt-main* "data"
+     (typecase data
+       ;; 2 example cases
+       (string (qnew "QVariant(QString)"    data))   ; string
+       (vector (qnew "QVariant(QByteArray)" data)))) ; binary data (vector of octets)
+  data)
+
+(ini)

Qt_EQL_plugin/qt_plugin.cpp

@@ -0,0 +1,19 @@
+#include "qt_plugin.h"
+#include "eql.h"
+
+QT_BEGIN_NAMESPACE
+
+void onShowPlugin(QWidget* widget)
+{
+    static EQL* eql = 0;
+    if(!eql) {
+        eql = new EQL;
+        eql->exec(widget, "ini.lisp");
+    }
+}
+
+void onHidePlugin()
+{
+}
+
+QT_END_NAMESPACE

Qt_EQL_plugin/qt_plugin.h

@@ -0,0 +1,23 @@
+#ifndef QT_PLUGIN_H
+#define QT_PLUGIN_H
+
+#include <Qt>
+
+#ifdef Q_WS_WIN
+#define LIB_EXPORT __declspec(dllexport)
+#else
+#define LIB_EXPORT
+#endif
+
+QT_BEGIN_NAMESPACE
+
+class QWidget;
+
+extern "C" {
+    LIB_EXPORT void onShowPlugin(QWidget*);
+    LIB_EXPORT void onHidePlugin();
+}
+
+QT_END_NAMESPACE
+
+#endif

Qt_EQL_plugin/qt_plugin.pro

@@ -0,0 +1,13 @@
+TEMPLATE     = lib
+CONFIG      += dll no_keywords release
+INCLUDEPATH += ../src
+LIBS        += -L.. -leql5
+TARGET       = qt_plugin
+DESTDIR      = ./
+OBJECTS_DIR  = ./tmp/
+MOC_DIR      = ./tmp/
+
+include(../src/windows.pri)
+
+HEADERS = qt_plugin.h
+SOURCES = qt_plugin.cpp

README-1.txt

@@ -0,0 +1,157 @@
+*********************************
+* EQL5 is a Qt5 port of EQL/Qt4 *
+*********************************
+
+# contact: gmail, polos.ruetz
+# mailing list: http://groups.google.com/group/eql-user/topics
+#
+# MANY THANKS to the users of the eql-user mailing list for their contributions!
+
+
+
+TESTED WITH
+===========
+
+* ECL 16
+* Qt 5.5
+* Linux
+
+
+
+REQUIREMENTS
+============
+
+* ECL threads + unicode
+* Qt5
+* /should/ run cross-platform
+
+
+
+BUILD
+=====
+
+(N.B. for rebuilding, please see README-REBUILD.txt)
+
+  [Windows]
+    You first need to adapt the file src/windows.pri (include & library paths).
+    
+  [MSVC]
+    substitute make with nmake
+
+  [OSX]
+    To force creation of a Makefile (instead of an Xcode project), use this flag:
+        qmake -spec macx-g++
+
+1) In src/ run:
+
+    ecl -shell make-eql-lib.lisp
+
+2) Do: (use qmake-qt4 if you have Qt5 installed)
+
+    qmake eql_lib.pro
+    make
+
+    qmake eql_exe.pro
+    make
+
+   This will build both the EQL executable and shared library.
+
+3) cd ..
+
+  [Linux]
+    You need to create links to EQL, something like (note the "5"):
+        cd /usr/lib
+        sudo ln -s ~/eql5/libeql5.so.1 libeql5.so.1
+        cd /usr/bin
+        sudo ln -s ~/eql5/eql5 eql5
+
+  [OSX]
+    You need to create links to EQL, something like (note the "5"):
+        cd /usr/lib
+        sudo ln -s ~/eql5/libeql5.1.dylib libeql5.1.dylib
+        cd /usr/bin
+        sudo ln -s ~/eql5/eql5.app/Contents/MacOS/eql5 eql5
+        
+  [Windows]
+    Add your EQL directory to the Path environment variable, see:
+    <Control Panel:System:Advanced:Environment Variables>
+
+
+
+RUN
+===
+
+PLEASE NOTE:
+You will often need to "reset" (command) your console/shell after EQL finished
+working, especially during development time or other exits than "(eql:qquit)".
+
+
+You can run a simple interactive REPL UI doing:
+    eql5 -qgui
+
+To run a Lisp file without top-level, do:
+    eql5 examples/2-clock
+
+(If you don't see the application window, it might be in the background.
+Use your taskbar to show it.)
+
+If you start the EQL executable without arguments, it will start the usual ECL top-level
+(without processing Qt events).
+
+To _not_ load ~/.eclrc on startup, do:
+    eql5 -norc
+
+To quit the tool, do:
+    (eql:qquit) or
+    (eql:qq)
+
+In order to run (sort of) a top-level processing Qt events, do (requires ECL threads):
+    eql5 -qtpl
+
+    Note: If you want to use "ecl-readline" together with "-qtpl", just compile
+          "eql5/src/lisp/ecl-readline.lisp" (which depends on the "readline" C library).
+          It will then be loaded automatically on startup.
+
+
+
+QT MODULES (network, sql, opengl)
+==========
+
+To build an EQL module (corresponding to a Qt module), do the following in src/:
+
+    qmake module_<name>.pro (e.g. qmake module_network.pro)
+    make
+
+  [Linux,OSX]
+    You need to create links to the modules, see EQL library above.
+
+In Lisp, use the function QREQUIRE to load a module:
+    (qrequire :network)
+
+
+
+TIP
+===
+
+You might want to put this in your ~/.eclrc file:
+
+    #+eql
+    (setf eql:*qtpl*            t  ; same as -qtpl
+          eql:*break-on-errors* t)
+
+
+
+NOTES
+=====
+
+For additional information see doc/index.html.
+
+
+
+LICENSE
+=======
+
+MIT
+
+for MAKE-QIMAGE (contributed by Mark Cox), please see LICENSE-MAKE-QIMAGE.txt
+

README-2-REBUILD.txt

@@ -0,0 +1,47 @@
+REBUILD STEPS (on every upgrade of: ECL, Qt, EQL)
+=============
+
+Change to eql/src/ and do:
+
+1) remove directory tmp/
+   remove slime/thread-safe.fas*
+   remove src/lisp/ecl-readline.fas* (only on upgrading ECL; to recompile manually)
+
+2) ecl -shell make-eql-lib.lisp
+
+3) qmake, make in this order: (MSVC: nmake; use qmake-qt4 if you have Qt5 installed)
+
+    eql_lib.pro
+    eql_exe.pro
+
+    module_network.pro
+    module_...
+
+Optionally (integrate wrapper functions):
+
+4) eql5 make-eql-lib-wrappers.lisp
+
+5) re-link EQL library:
+
+    touch tmp/eql.o    (or delete "tmp/eql.o*")
+    qmake eql_lib.pro
+    make
+
+
+IMPORTANT NOTES
+===============
+
+C++:
+
+You always need to rebuild from any "*.pro" file (EQL modules, Qt_EQL...) after
+upgrading EQL.
+
+The simplest way to clean everything is to remove the whole "tmp/" directory in
+the respective build directory, since the Makefile generated by Qt not always
+works correctly with "make clean" (e.g. on Windows).
+
+Lisp:
+
+It's also recommended to recompile any compiled EQL code (because of the tight
+ECL/C++ integration).
+

README-3-OPTIONAL.txt

@@ -0,0 +1,51 @@
+Wrapper functions
+=================
+
+If you want to use wrapper functions for all Qt functions, see:
+
+  "src/lisp/all-wrappers.lisp"
+
+Examples:
+
+  (|show| widget)
+
+  (|toString| (|currentTime.QTime|)) ; static function
+
+  (|begin(QWidget*)| painter)
+
+
+Notes
+=====
+
+If you want to add the wrappers permanently, build EQL as usual, then run
+
+  eql5 make-eql-lib-wrappers.lisp
+
+Re-link EQL doing something like:
+
+  touch tmp/eql.o*   (or delete "tmp/eql.o*")
+  qmake eql_lib.pro
+  make
+
+(The resulting shared library will be considerably bigger than before).
+
+---
+
+The convenience macro X:DO-WITH has been adapted to work with the wrappers:
+
+  (x:do-with item
+    (|setTextAlignment| 0 |Qt.AlignRight|)
+    (|setText| 0 "123"))
+
+---
+
+Normally not needed, but if you want to generate the wrappers for your
+Qt version (much different from Qt 5.5) do:
+
+  cd src/lisp
+  eql5 define-all-wrappers.lisp
+
+---
+
+See also note in Sokoban example (no more casts needed).
+

doc/Debugging.htm

@@ -0,0 +1,139 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<style>
+pre    { color: black; background-color: #F4F4F4; }
+code   { color: black; }
+.input { color: blue; }
+</style>
+</head>
+<div style="width: 600px">
+<h2>Debugging</h2>
+This is a simple <b>tutorial</b> using the top-level processing Qt events:
+<pre>
+  $ <span class="input">eql5 -qtpl</span>
+</pre>
+<br>
+<h3>Example 1: Error on REPL (trivial)</h3>
+<pre>
+
+  EQL-USER[1]&gt; <span class="input">(/ 0)</span>
+
+  Condition of type: DIVISION-BY-ZERO
+
+  Available restarts:
+
+  1. (RESTART-TOPLEVEL) Go back to Top-Level REPL.
+  2. (RESTART-QT-EVENTS) Restart Qt event processing.
+
+  ** BREAK [LEVEL 2]&gt;
+
+</pre>
+&nbsp;&nbsp;&nbsp;<img src="debug-dialog.png"/>
+<p>Note that all debug input is handled in a debug dialog, <b>not</b> in the
+console window.</p>
+<p>So, either type the restart number in the dialog
+<pre><span class="input">  :r1</span></pre>
+or just click Cancel / hit Escape, which will always choose <code>:r1</code>.
+<br>Type <code>:h</code> for all available debug options.
+<p>Both restarts will have the same effect here, see note at bottom.</p>
+<br>&nbsp;
+<h3>Example 2: Error during Qt event processing</h3>
+Start calculator example:
+<pre>
+  $ <span class="input">eql5 -qtpl examples/X-extras/calculator</span>
+</pre>
+<br>
+Let's run this function:
+<pre>
+  EQL-USER[1]&gt; <span class="input">(clc:auto "42 ? blah")</span>
+</pre>
+<br>
+This will output 2 errors, without breaking into the debugger:
+<pre>
+
+  [EQL:err] QFIND-CHILD #&lt;QDialog "" 0x39737d0 [1]&gt; "?"
+
+  [EQL:err] QINVOKE-METHOD NIL NIL "animateClick" (400)
+
+</pre>
+<p><b>Note</b>: After eventual print output (like the above), you
+  won't see a fresh top-level prompt.<br>Don't get confused by this, as
+  you can continue to enter commands.</p>
+<br>
+Now make EQL errors break into the debugger:
+<pre>
+  EQL-USER[2]&gt; <span class="input">(setf eql:*break-on-errors* t)</span>
+</pre>
+<br>
+Run our function again:
+<pre>
+
+  EQL-USER[3]&gt; <span class="input">(clc:auto "42 ? blah")</span>
+
+  Condition of type: SIMPLE-CONDITION
+
+  [EQL:err] QFIND-CHILD #&lt;QDialog "" 0x39737d0 [1]&gt; "?"
+
+  Available restarts:
+
+  1. (CONTINUE) Return from BREAK.
+  2. (RESTART-QT-EVENTS) Restart Qt event processing.
+
+  ** BREAK [LEVEL 1]&gt;
+
+</pre>
+&nbsp;&nbsp;&nbsp;<img src="debug-dialog.png"/>
+<p>Now there are 2 possible restarts:</p>
+<pre><span class="input">  :r1</span></pre>
+<code>(CONTINUE)</code> will continue execution, which will break on
+the next error, then finish our function.
+<pre><span class="input">  :r2</span></pre>
+<code>(RESTART-QT-EVENTS)</code> will abort execution, returning to
+the REPL immediately.
+<br><br>
+<hr>
+<br><br>
+<h3>Notes</h3>
+There is one situation where interactive debugging won't work, and
+this is in code inside an (overridden)
+<pre>  "paintEvent(QPaintEvent*)"</pre> function, as this may cause
+recursive paint events and segfaults.
+<br>&nbsp;
+<br>&nbsp;<br>
+To exit instantly from EQL during debugging (on nasty errors), just type
+<pre><span class="input">  :qq</span> / <span class="input">:exit</span></pre>
+in the debug dialog (or REPL).
+<br>&nbsp;
+<br>&nbsp;<br>
+On simple <code>read</code> errors on the REPL (e.g. non-existing packages, non-external symbols), the debugger will not be entered (as this would cause an unrecoverable <code>break</code>, since <code>read</code> runs in its own thread here); instead, the erroneous input string will be returned as-is.
+<br>&nbsp;
+<br>&nbsp;<br>
+The conflicting case
+<pre>  (RESTART-TOPLEVEL)
+  (RESTART-QT-EVENTS)</pre>
+is resolved automatically (<code>RESTART-QT-EVENTS</code> would block the REPL in this case).
+<br>&nbsp;
+<br>&nbsp;
+<br>
+<h3>Tips</h3>
+You might want to put this in your <code>~/.eclrc</code> file:
+<pre>
+
+  #+eql
+  (setf eql:*qtpl*            t  ; same as -qtpl
+        eql:*break-on-errors* t)
+
+</pre>
+<br>
+<p>In order to automatically switch the REPL to a given package after loading a file, add this line:</p>
+<pre>  (qlater (lambda () (in-package :my-package)))</pre>
+<br>
+<p>If you use ECL readline (see <code>ecl-readline.lisp</code> in sources):<br>After entering <code>:qq</code> (quitting the top-level), the console/shell should always be reset (but you won't probably see the command while typing it; an <code>alias</code> might help):</p>
+<pre>
+  $ <span class="input">reset</span>
+</pre>
+<br>&nbsp;
+<br>&nbsp;
+</div>
+</html>

doc/Deploy.htm

@@ -0,0 +1,14 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+</head>
+<h2>Deploy</h2>
+<p>Please follow the <code>my_app/README.txt</code> (which assumes that your lisp files are in <code>my_app/lisp/</code>)</p>
+<p>The dependencies are:</p>
+<ul>
+<li><code>eql5</code>, <code>ecl</code>, <code>QtCore</code>, <code>QtGui</code>, <code>QtWidgets</code>, <code>QtPrintSupport</code> shared libraries
+<li>your <code>*.ui</code> files (if any)
+<li>your <code>*.qm</code> translation files (if any)
+</ul>
+A detailed description of deploying Qt applications can be found in Qt Assistant.
+</html>

doc/EQL-Slime-Integration.htm

@@ -0,0 +1,64 @@
+<html>
+<head>
+<style>
+body { font-family: sans-serif; font-size: 14px; }
+pre  { background-color: #F4F4F4; }
+</style>
+</head>
+<body>
+<div style="width: 700px; margin: 20px;">
+<h2>EQL (ECL + Qt) in Slime -- how does it work?</h2>
+<ul>
+  <li><p>Start swank using the EQL executable, running the swank server in an ECL thread, and using the main thread for the Qt main event loop.</p>
+  <li><p>Wrap every internal EQL function in a macro, which will call the function either directly (if called from GUI/main thread), or, if called from another ECL thread, will wrap the function call in a closure.</p>
+  <li><p>This closure will be passed to a queued, blocking Qt function running in the GUI thread, which will in turn call the closure.</p>
+</ul>
+<p>The crucial part is passing a Lisp closure from an ECL thread to Qt and calling it from C++ in the GUI/main thread.</p>
+<p>This is trivial in ECL/Qt, since both ECL and Qt use/wrap native C threads, and Qt offers a nice utility with <code>Q_INVOKABLE</code>.</p>
+<p>First let's wrap the actual Lisp function, e.g. <code>(foo x y)</code> in a closure, so we only need to pass <b>one ECL closure pointer</b> to C++.
+<p>No need to pass Lisp arguments to C++, they are in the closure; no return value needed from C++, Lisp return values will be assigned in the closure:</p>
+<pre>
+
+  ;; in some ECL thread
+  (let (values)
+    (run-in-gui-thread
+
+      ;; in ECL main/GUI thread
+      (lambda ()
+        (setf values (multiple-value-list (foo x y)))))
+
+    ;; back in some ECL thread
+    (values-list values))
+
+</pre>
+<p>Here the implementation of the ECL function <code>run-in-gui-thread</code> (embedded in Qt):</p>
+<pre>
+
+  cl_object run_in_gui_thread(cl_object closure) // define ECL function
+  {
+      QMetaObject::invokeMethod(
+          object,                       // any QObject from GUI thread
+          "runInGuiThread",             // see Q_INVOKABLE
+          Qt::BlockingQueuedConnection, // blocking for return values
+          Q_ARG(void*, closure));       // 'closure' is just a pointer
+
+      return Cnil;
+  }
+
+</pre>
+<p>Now the Lisp closure will run in the GUI/main thread, and the implementation of the Qt function <code>runInGuiThread</code> is as simple as:</p>
+<pre>
+
+  Q_INVOKABLE void runInGuiThread(void* closure) // note Q_INVOKABLE
+  {
+      cl_funcall(1, (cl_object)closure); // ECL function call
+  }
+
+</pre>
+<p>After introducing a macro <code>qrun*</code>, and wrapping all EQL functions in it (see <nobr><code>"slime/thread-safe.lisp"</code></nobr>), we are done!</p>
+<p>(Please note that the above code is a stripped down version, see sources for the actual implementation.)</p>
+<br>
+</div>
+</body>
+</html>
+

doc/Notes.htm

@@ -0,0 +1,71 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+</head>
+<body>
+<h2>Notes</h2>
+<p>Pass <code>-norc</code> on the command line to <b>not</b> load <code>~/.eclrc</code> on startup.<br>Since <code>:eql</code> and <code>:eql5</code> are in <code>*features*</code>, you can use e.g. <code>#+eql</code> / <code>#-eql5</code>.</p>
+<p>To run a Lisp file directly, do e.g. <code>eql5
+    examples/5-colliding-mice -qtpl</code>.</p>
+<p>See the EQL UI (command <code>eql -qgui</code>) for a complete list of all
+  supported classes and functions.</p>
+<p>In the above mentioned UI you find a "<b>Select</b>" button, allowing you
+  to select any Qt widget (even in other main widgets), if previously loaded
+  from the UI command line. After selecting a widget, the
+  parameter <code>qsel:*q*</code> will be set to it.</p>
+  <p>See command line option <code>-qtpl</code> for a top-level processing Qt
+  events (see also <b>readline</b> note in <code>../README.txt</code>).<br>It uses a simple GUI dialog for
+  debug input (needed because <code>read</code> runs in its own thread).<br>On
+  eventual print output, you won't see a fresh prompt, but the REPL will
+  remain ready for input.<br>You can set this option permanently by adding this in <code>~./eclrc</code>:
+  <br><code>#+eql (setf eql:*qtpl* t)</code>
+</p>
+<p>If you want to use temporary Qt objects, you can use the <code>qlet</code>
+  convenience macro (see the function list). It's a <code>let*</code> variant
+  for Qt objects, deleting them  when leaving its body.</p>
+<p>No universal GC (garbage collection) for Qt objects:
+<ul>
+<li>Qt widgets always live inside an object hierarchy, so deleting a widget
+  will delete all its child widgets/objects.
+<li>For local widgets/objects, you have the <code>qlet</code> macro, which are
+  deleted when leaving the <code>qlet</code> body.
+</ul>
+<ul>
+<li>So, always use <code>qlet</code> (instead of <code>qnew</code>) if you only
+  need a local Qt object inside a function (e.g. <code>QDialog</code>, <code>QRegExp</code>).
+<li><b>GC</b> is implemented (using the ECL finalizer) for Qt value types (like <code>QFont</code>) returned by the functions
+ <code>qget</code> and <code>qfun</code>.<br>These types are printed adding <b>GC</b>: <code>#&lt;QFont 0x9243840 GC&gt;</code>.
+</ul>
+</p>
+<p>Enumeration example: <code>|Qt.AlignCenter|</code>.<br>So, all enumerations
+  are defined as constants, using case preserving symbol names (allowing
+  convenient tab completion in Emacs).
+</p>
+<p>Errors in EQL functions don't break into the debugger; if you want them to
+  do so, set the variable <code>eql:*break-on-errors*</code>
+  to <code>T</code>.
+<br>(So the choice is left to you: depending on the situation, either option
+may be more convenient than the other.)
+</p>
+<p>
+The currently available <b>Qt5 Modules</b> (see <code>qrequire</code>) are:
+<br><code>:network :opengl :sql</code>
+</p> 
+<p>If you want to use CLOS together with <code>qt-object</code> instances
+  (which are of type <code>struct</code>), see
+  examples <code>X-extras/CLOS-encapsulation.lisp</code>
+  and <code>5-colliding-mice.lisp</code>.<br>So there's a simple way to
+  use either <code>defclass</code> or <code>defstruct</code> to
+  encapsulate a <code>qt-object</code>.</p>
+<hr>
+<p>If you're interested in <b>embedding</b> EQL in existing Qt/C++ projects,
+  see example in directory <code>Qt_EQL_dynamic/</code> (which can be used
+  together with Slime).
+</p>
+<p>See also <b>plugin</b> example in directory <code>Qt_EQL_plugin/</code>.
+</p>
+<hr>
+<p>The necessary parsing for generating the <code>src/gen/*</code> files is
+  done by parsing the Qt documentation. See <code>helper/README.txt</code> if you want do it yourself
+</body>
+</html>

doc/QtDesigner.htm

@@ -0,0 +1,23 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+</head>
+<h2>Qt Designer</h2>
+<ul>
+<li>In Qt Designer, set a unique <code>objectName</code> to every object you want to use from Lisp.
+<li>In Lisp, load the <code>*.ui</code> file using <code>qload-ui</code> (which will return the main widget of the UI).
+<li>To get the single widgets from the UI, use <code>qfind-child</code>.
+</ul>
+<p>For an example, see <code>examples/3-main-window.lisp</code>.</p>
+<hr>
+<p>
+If you want to translate your UI files to the corresponding EQL code, do the following
+at the command line:
+<br><code>&nbsp;&nbsp;eql -quic file.ui</code>
+<br>which will generate a file named <code>ui-file.lisp</code>. See also function <code>quic</code>.
+</p>
+<p>
+For a quick test of the generated file, try this:
+<br><code>&nbsp;&nbsp;eql ui-file.lisp</code>
+</p>
+</html>

doc/QtLinguist.htm

@@ -0,0 +1,21 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+</head>
+<h2>Qt Linguist</h2>
+For every new project:
+<ul>
+<li>In Lisp, wrap the strings you want to translate in the <code>tr</code> macro (as you would do in Qt), optionally passing a context and/or a plural indicator (see Qt Assistant). Both string and context can be Lisp forms evaluating to constant strings.
+<li>Adapt the <code>my_app/eql-lupdate</code> file, adding your Qt Designer <code>*.ui</code> files (if any), and listing the respective  <code>*.ts</code> files for all languages you want to support.
+<li>Adapt the <code>my_app/eql-lrelease</code> file, simply listing all <code>*.ts</code> files (see above).
+</ul>
+For every new release (in order to create the <code>*.qm</code> files):
+<ul>
+<li>In <code>my_app/</code>, run <code>eql make.lisp</code> (compiling all files). This will find all source strings to translate and save them in the file  <code>tr.h</code> (only a dummy needed for the Qt <code>lupdate</code> function). This is done using a compiler macro, see <code>my_app/tr.lisp</code>.</i> 
+<li>Run the <code>my_app/eql-lupdate</code> script; this will create/update the single <code>*.ts</code> files for every language.
+<li>Use Qt Linguist on the <code>*.ts</code> files (as usual).
+<li>Run the <code>my_app/eql-lrelease</code> script.
+</ul>
+<p>Note: you may need to copy the respective <code>qt_*.qm</code> files (see <code>translations/</code> in the Qt sources), in order to load the translated texts used by Qt itself.</p>
+<p>See <code>my_app/main.cpp</code> for an example how to load your translation files.</p>
+</html>

doc/Slime-REPL-hook.htm

@@ -0,0 +1,102 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+</head>
+<h2>Slime REPL Hook</h2>
+<p>
+<p><b>Please note:</b></p>
+<p>
+You need to enable this mode manually by uncommenting this line in <code>eql-start-swank.lisp</code> in your Slime directory:
+<br>&nbsp;&nbsp;<code>(setf eql:*slime-mode* :repl-hook)</code>
+</p>
+<p>Requires <b>ECL threads</b>.</p>
+<p>
+This should work with any Slime version that plays together with ECL.
+<br>Tested with ECL 12.7.1 (Windows: ECL 12.12.1)
+</p>
+<ul>
+<h3>Prepare</h3>
+<ul>
+<li>Add to your <code>~/.emacs</code> file:
+<pre>
+(add-to-list 'load-path "~/slime/")         ; slime path
+(add-to-list 'load-path "~/slime/contrib/") ; slime/contrib path
+(require 'slime)
+(slime-require 'swank-listener-hooks)       ; EQL requires a listener hook
+(slime-setup '(slime-fancy))
+</pre>
+<li>Add to your <code>~/.swank.lisp</code> file (or copy file <code>eql/slime/.swank.lisp</code> in your home directory):
+<br>(Please note: this isn't really optional -- you <b>need</b> to set this option for a useful Slime + EQL.)
+<pre>
+(setf swank:*globally-redirect-io* t) ; show print output in Emacs
+</pre>
+<li>Copy file <code>eql/slime/eql-start-swank.lisp</code> in your <code>slime/</code> directory
+</ul>
+<br>
+<h3>Run</h3>
+<ul>
+<li>Run the swank server (the command line option <code>-slime</code> can be omitted if the file name contains "start-swank"), optionally passing a Lisp file:
+<pre>
+eql &lt;path-to-slime&gt;/eql-start-swank.lisp [file.lisp]
+</pre>
+<li>Run Emacs and do:
+<code>Meta-X slime-connect</code> (please note:
+use <code>slime-connect</code>) and hit <code>Return</code> 2 times
+(confirming the default values).
+<p>Please note: if <code>:dont-close</code> is set to <code>T</code>
+    in <code>eql-start-swank.lisp</code>, quitting/restarting Emacs will not
+    affect a running EQL program, that is: if you quit/restart Emacs, you can
+    connect to the same swank/EQL you left when quitting Emacs.</p>
+</ul>
+<br>
+<h3>Notes</h3>
+<h4>Eval Region</h4>
+<ul>
+<li><b>Load</b> your Lisp file <b>from the Slime REPL</b>: <code>(load "file.lisp")</code>
+<li><b>Run</b> your program <b>from the Slime REPL</b> (not using Eval Region).
+<li>Only at this point you may use Eval Region for re-defining functions etc.
+</ul>
+<p>The point here is: if you directly try to Eval Region an expression containing an
+  EQL function, your swank server <b>will crash</b>, because it will not be
+  evaluated in the GUI thread (Qt GUI methods need to be called from the GUI thread).
+</p>
+<p>So, only run EQL functions <b>directly</b> from the <b>Slime REPL</b>.
+<br>If you want to use <b>Eval Region</b> containing EQL functions, use the
+method described above.
+</p>
+<hr>
+<p>You may use the macro <code>qeval</code> if you want to ensure evaluation
+  in the GUI thread (this is meant to be used together with Eval Region only).
+<br>It behaves like a <code>progn</code>, so you can do something like this:
+<pre>
+(qeval
+  (defvar *label* (qnew "QLabel"))
+  (defvar *edit*  (qnew "QLineEdit")))
+</pre>
+Wrapping forms in <code>qeval</code> will have no effect if you
+run your code outside of Slime (so there's no need to
+remove <code>qeval</code> in your final program).</p>
+<hr>
+<p>But note: the advantage using <b>Eval Region</b>
+  (<i>without</i> <code>qeval</code>) is that Lisp error conditions (not
+  driven by Qt events) will not stop/pause your EQL program (that is, Qt event
+  processing will continue).</p>
+<p>Instead, if there is an error in code you either enter in the Slime REPL, or
+  run with Eval Region wrapped in <code>qeval</code>, the
+program will always pause (Qt event processing will be stopped until you take some
+  action).</p>
+<br>
+<h4>Abort / Restart</h4>
+<p>Be careful after entering the Slime debugger. If you see this:
+<br>
+<br><code>[ABORT] Return to SLIME's top level.</code>
+<br><code>[RESTART-QT-EVENTS] Last resort only - prefer "Return to SLIME's top level"</code>
+<br>
+<br>Always choose the first one, otherwise you'll be stuck.
+</p>
+<br>
+<h4>Help</h4>
+<p>For help see the <code>qapropos</code> and <code>qgui</code> functions.</p>
+</ul>
+<br>
+</html>

doc/Slime.htm

@@ -0,0 +1,57 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+</head>
+<h2>Slime</h2>
+Requires <b>ECL threads</b>.
+<p>
+This should work with any Slime version that plays together with ECL.
+<br>Tested with ECL 12.7.1 (Windows: ECL 12.12.1)
+</p>
+<br>
+<h3>Prepare</h3>
+<ul>
+<li>Add to your <code>~/.emacs</code> file:
+<pre>
+(add-to-list 'load-path "~/slime/") ; slime path
+(require 'slime)
+(slime-setup '(slime-fancy))
+</pre>
+<li>Add to your <code>~/.swank.lisp</code> file (or copy file <code>eql/slime/.swank.lisp</code> in your home directory):
+<br>(Please note: this isn't really optional -- you <b>need</b> to set this option for a useful Slime + EQL.)
+<pre>
+(setf swank:*globally-redirect-io* t) ; show print output in Emacs
+</pre>
+<li>Copy file <code>eql/slime/eql-start-swank.lisp</code> in your <code>slime/</code> directory
+</ul>
+<br>
+<h3>Run</h3>
+<ul>
+<li>Run the swank server (the command line option <code>-slime</code> can be omitted if the file name contains "start-swank"), optionally passing a Lisp file:
+<pre>
+eql &lt;path-to-slime&gt;/eql-start-swank.lisp [file.lisp]
+</pre>
+<li>Run Emacs and do:
+<code>Meta-X slime-connect</code> (please note:
+use <code>slime-connect</code>) and hit <code>Return</code> 2 times
+(confirming the default values).
+<p>Please note: if <code>:dont-close</code> is set to <code>T</code>
+    in <code>eql-start-swank.lisp</code>, quitting/restarting Emacs will not
+    affect a running EQL program, that is: if you quit/restart Emacs, you can
+    connect to the same swank/EQL you left when quitting Emacs.</p>
+</ul>
+<br>
+<h3>Loading files</h3>
+<p>If you experience slow loading of files (compared to direct loading), use <code>qload</code> instead of <code>load</code>, which will reduce all thread switches during the load process to a single one.</p>
+<p>Another case where you need to use <code>qload</code> is when you use Qt classes which use threads internally (see e.g. <code>examples/X-extras/move-blocks.lisp</code>).</p>
+<br>
+<h3>Help</h3>
+<p>For help see the <code>qapropos</code> and <code>qgui</code> functions.</p>
+<p>To kill the swank process (Slime), use function <code>qquit</code> / <code>qq</code> (since quitting Emacs will not kill it).</p>
+<br>
+<h3>Notes</h3>
+<p>All EQL functions are wrapped in <code>qrun*</code> (see <code>eql/slime/thread-safe.lisp</code>), so it's safe to call them either directly from the REPL or using 'eval region' (or from any other ECL thread).</p>
+<p>This Slime mode is both convenient and simple to use, but conses a little more for every EQL function call.
+<br>If you absolutely want direct EQL function calls, please see the less convenient <a href="Slime-REPL-hook.htm">Slime REPL Hook</a> mode.</p>
+</br>
+</html>

doc/auto-doc.htm

@@ -0,0 +1,529 @@
+<html><body><p>
+<b>DEFINE-QT-WRAPPERS (qt-library &rest what)</b>
+<p>Defines Lisp methods for all Qt methods/signals/slots of given library.<br>(See example <code>Qt_EQL_dynamic/trafficlight/</code>).</p>
+<pre>
+  (define-qt-wrappers *c++*)        ; generate wrappers (see "Qt_EQL_dynamic/")
+  (define-qt-wrappers *c++* :slots) ; Qt slots only (any of :methods :slots :signals)
+  
+  (my-qt-function *c++* x y) ; instead of: (! "myQtFunction" (:qt *c++*) x y)
+</pre>
+</p><br>
+<p>
+<b>DEFVAR-UI (main-widget &rest variables)</b>
+<p>This macro simplifies the definition of UI variables:</p>
+<pre>
+  (defvar-ui *main* *label* *line-edit*...)
+  
+  ;; the above will expand to:
+  
+  (progn
+  &nbsp;&nbsp;(defvar *label*     (qfind-child *main* "label"))
+  &nbsp;&nbsp;(defvar *line-edit* (qfind-child *main* "line_edit"))
+  &nbsp;&nbsp;...)
+</pre>
+</p><br>
+<p>
+<b>ENSURE-QT-OBJECT (object)</b>
+<p>Returns the <code>qt-object</code> of the given class/struct (see method <code>the-qt-object</code> in example <code>X-extras/CLOS-encapsulation.lisp</code>).<br>This function is used internally whenever a <code>qt-object</code> argument is expected.</p>
+</p><br>
+<p>
+<b>QADD-EVENT-FILTER (object event function)
</b>
+<p>Convenience function. Adds a Lisp function to be called on a given event type.<br>If the object argument is <code>NIL</code>, the event will be captured for the whole application.<br>If the Lisp function returns <code>NIL</code>, the event will be processed by Qt afterwards.<br><br>Returns a handle which can be used to remove the filter, see <code>qremove-event-filter</code>.<br><br>See also <code>qoverride</code> for <code>QObject::eventFilter(QObject*,QEvent*)</code> and <br><code>QObject::installEventFilter(QObject*)</code>,<br><code>QObject::removeEventFilter(QObject*)</code>.<br><br>The event class corresponds to the respective event type (no cast needed).
</p>
+<pre>
+  (qadd-event-filter nil |QEvent.MouseButtonPress| (lambda (object mouse-event) (print object) nil))
+</pre>
+</p><br>
+<p>
+<b>QAPP ()
</b>
+<p>Convenience function returning <code>qApp</code>.
</p>
+</p><br>
+<p>
+<b>QAPROPOS (&optional search-string class-name)
</b>
+<p>Finds all occurrencies of the given search string in the given object's meta information.<br>Constructors are listed under "Methods".<br>To list the user defined functions of external C++ classes (see Qt_EQL), pass the object instead of the class name.
</p>
+<pre>
+  (qapropos "html" "QTextEdit")
+  (qapropos nil "QWidget")
+  (qapropos)             
+  (qapropos '|toString|)   ; wrapper function symbol
+  (qapropos nil *qt-main*) ; see Qt_EQL, Qt_EQL_dynamic (custom Qt classes, Qt3Support classes)
+</pre>
+</p><br>
+<p>
+<b>QAPROPOS* (&optional search-string class-name)</b>
+<p>Similar to <code>qapropos</code>, returning the results as nested list.</p>
+</p><br>
+<p>
+<b>QAUTO-RELOAD-C++ (variable library-name)</b>
+<p><b>Linux only.</b><br><br>Extends <code>qload-c++</code> (see <code>Qt_EQL_dynamic/</code>).<br><br>Defines a global variable (see return value of <code>qload-c++</code>), which will be updated on every change of the C++ plugin (e.g. after recompiling, the plugin will automatically be reloaded, and the <code>variable</code> will be set to its new value).<br><br>If you want to be notified on every change of the plugin, set <code>*&lt;variable&gt;-reloaded*</code>. It will then be called after reloading, passing both the variable name and the plugin name.<br>See <code>qload-c++</code> for an example how to call plugin functions.</p>
+<pre>
+  (qauto-reload-c++ *c++* "eql_cpp")
+  
+  (setf *c++-reloaded* (lambda (var lib) (qapropos nil (symbol-value var)))) ; optional: set a notifier
+</pre>
+</p><br>
+<p>
+<b>QCALL-DEFAULT ()
</b>
+<p>To use anywhere inside an overridden function (see <code>qoverride</code>).<br>Calls the base implementation of the virtual Qt method <b>after</b> leaving the function body.<br><br>Optionally call the base implementation directly (if you want to do post-processing of the return value).
</p>
+</p><br>
+<p>
+<b>QCLEAR-EVENT-FILTERS ()
</b>
+<p>Clears all added event filters.
</p>
+</p><br>
+<p>
+<b>QCONNECT (caller signal receiver/function &optional slot)
</b>
+<p>Connects either a Qt signal to a Qt slot, or a Qt signal to a Lisp function.
</p>
+<pre>
+  (qconnect edit "textChanged(QString)" label "setText(QString)")
+  (qconnect edit "textChanged(QString)" (lambda (txt) (print txt)))
+</pre>
+</p><br>
+<p>
+<b>QCOPY (object)
</b>
+<p>Copies <code>object</code> using copy-on-write, if such a constructor is available (non QObject derived classes only).<br>This function is short for e.g: <code>(qnew "QPixmap(QPixmap)" pixmap)</code><br><br>Note that the returned value will not be garbage collected (analogous to <code>qnew</code>).
</p>
+<pre>
+  (qcopy pixmap) ; QPen, QBrush, QFont, QPalette, QPixmap, QImage...
+</pre>
+</p><br>
+<p>
+<b>QDELETE (object &optional later)
</b>
+<br>
+<b>QDEL
</b>
+<p>Deletes any Qt object, and sets the <code>pointer</code> value to <code>0</code>. Deleting a widget deletes all its child widgets, too.<br>If <code>later</code> is not <code>NIL</code>, the function <code>QObject::deleteLater()</code> will be called instead (but note: the <code>object</code> pointer will be set to <code>0</code> immediately.)<br>Returns <code>T</code> if the object has effectively been deleted.<br><br>See also <code>qlet</code> for local Qt objects.
</p>
+<pre>
+  (qdel widget)
+  (qdel socket :later)
+</pre>
+</p><br>
+<p>
+<b>QDISCONNECT (caller &optional signal receiver/function slot)
</b>
+<p>Disconnects signals to either Qt slots or Lisp functions. Anything but the caller can be either <code>NIL</code> or omitted.<br>Returns <code>T</code> if something has effectively been disconnected.
</p>
+<pre>
+  (qdisconnect edit "textChanged(QString)" label "setText(QString)")
+  (qdisconnect edit "textChanged(QString)")
+  (qdisconnect edit nil label)
+  (qdisconnect edit)
+</pre>
+</p><br>
+<p>
+<b>QENUMS (class-name &optional enum-name)
</b>
+<p>Returns the meta enum list of the given <code>class-name</code> and <code>enum-name</code> (see <code>Q_ENUMS</code> in Qt sources).<br>Omitting <code>enum-name</code> will return all meta enum lists  of the class/scope.
</p>
+<pre>
+  (qenums "QLineEdit" "EchoMode") ; gives '("QLineEdit" ("EchoMode" ("Normal" . 0) ...))
+  (qenums "Qt")
+</pre>
+</p><br>
+<p>
+<b>QEQL (object1 object2)</b>
+<p>Returns <code>T</code> for same instances of a Qt class.<br>To test for same Qt classes only, do:</p>
+<pre>
+  (= (qt-object-id object1) (qt-object-id object2))
+</pre>
+</p><br>
+<p>
+<b>QESCAPE (string)
</b>
+<p>Calls <code>QString::toHtmlEscaped()</code>.
</p>
+</p><br>
+<p>
+<b>QEVAL (&rest forms)</b>
+<p>Slime mode <code>:repl-hook</code> only (not needed in default Slime mode): evaluate forms in GUI thread. Defaults to a simple <code>progn</code> outside of Slime.</p>
+</p><br>
+<p>
+<b>QEXEC (&optional milliseconds)
</b>
+<p>Convenience function to call <code>QApplication::exec()</code>.<br>Optionally pass the time in milliseconds after which <code>QEventLoop::exit()</code> will be called.<br>See also <code>qsleep</code>.
</p>
+</p><br>
+<p>
+<b>QEXIT ()
</b>
+<p>Calls <code>QEventLoop::exit()</code>, in order to exit event processing after a call to <code>qexec</code> with a timeout.<br>Returns <code>T</code> if the event loop has effectively been exited.
</p>
+</p><br>
+<p>
+<b>QFIND-BOUND (&optional class-name)</b>
+<p>Finds all symbols bound to Qt objects, returning both the Qt class names and the respective Lisp variables.<br>Optionally finds the occurrencies of the passed Qt class name only.</p>
+<pre>
+  (qfind-bound "QLineEdit")
+</pre>
+</p><br>
+<p>
+<b>QFIND-BOUND* (&optional class-name)</b>
+<p>Like <code>qfind-bound</code>, but returning the results as list of conses.</p>
+</p><br>
+<p>
+<b>QFIND-CHILD (object object-name)
</b>
+<p>Calls <code>QObject::findChild&lt;QObject*&gt;()</code>.<br>Can be used to get the child objects of any Qt object (typically from a UI, see <code>qload-ui</code>), identified by <code>QObject::objectName()</code>.
</p>
+<pre>
+  (qfind-child *main* "editor")
+</pre>
+</p><br>
+<p>
+<b>QFIND-CHILDREN (object &optional object-name class-name)
</b>
+<p>Calls <code>QObject::findChildren&lt;QObject*&gt;()</code>, returning a list of all child objects matching <code>object-name</code> and <code>class-name</code>.<br>Omitting the <code>&optional</code> arguments will find all children, recursively.
</p>
+<pre>
+  (qfind-children *qt-main* nil "LightWidget") ; see Qt_EQL example
+</pre>
+</p><br>
+<p>
+<b>QFROM-UTF8 (byte-array)
</b>
+<p>Returns the byte array (vector of octets) converted using <code>QString::fromUtf8()</code>.
</p>
+</p><br>
+<p>
+<b>QGUI (&optional process-events)</b>
+<p>Launches the EQL convenience GUI.<br>If you don't have an interactive environment, you can pass <code>T</code> to run a pseudo Qt event loop. A better option is to start the tool like so:<br><code>eql -qgui</code>, in order to run the Qt event loop natively.</p>
+</p><br>
+<p>
+<b>QID (name)
</b>
+<p>Returns the internally used ID of the object name. Non QObject classes have negative ids.
</p>
+<pre>
+  (qid "QWidget")
+</pre>
+</p><br>
+<p>
+<b>QINVOKE-METHOD (object function-name &rest arguments)
</b>
+<br>
+<b>QFUN
</b>
+<p>Calls any of Qt methods, slots, signals. Static methods can be called by passing the string name of an object.<br><br>The most convenient way of calling Qt methods is to use the wrapper functions (see alternative 2 below), which allows for tab completion, showing all possible candidates in case of ambiguous type lists (overloaded methods). Additionally, static functions are shown as one symbol (easily catching the eye).<br><br>(Optionally you can pass the argument types (as for <code>qconnect</code> and <code>qoverride</code>), which may result in better performance, but only in some edge cases.)
</p>
+<pre>
+  (qfun item "setText" 0 "Some objects are EQL.")
+  (qfun "QDateTime" "currentDateTime")            ; static method
+  (qfun slider "valueChanged" 10)                 ; emit signal
+  
+  ;; alternative 1: (macro '!')
+  
+  (! "setText" item 0 "Some objects are EQL.")
+  (! "currentDateTime" "QDateTime")
+  (! "valueChanged" slider 10)
+  
+  ;; alternative 2: (wrapper functions)
+  
+  (|setText| item 0 "Some objects are EQL.")
+  (|currentDateTime.QDateTime|)
+  (|valueChanged| slider 10)
+</pre>
+</p><br>
+<p>
+<b>QINVOKE-METHOD* (object cast-class-name function-name &rest arguments)</b>
+<br>
+<b>QFUN*</b>
+<p>Similar to <code>qinvoke-method</code>, additionally passing a class name, enforcing a cast to that class.<br>Note that this cast is not type safe (the same as a C cast, so dirty hacks are possible).<br><br>Note: using the (recommended) wrapper functions (see <code>qfun</code>), casts are applied automatically where needed.</p>
+<pre>
+  (qfun* graphics-text-item "QGraphicsItem" "setPos" (list x y)) ; multiple inheritance problem
+  (qfun* event "QKeyEvent" "key")                                ; not needed with QADD-EVENT-FILTER
+  
+  ;; alternatively:
+  
+  (! "setPos" ("QGraphicsItem" graphics-text-item) (list x y))
+  (! "key" ("QKeyEvent" event))
+  
+  ;; better/recommended:
+  
+  (|setPos| graphics-text-item (list x y))
+</pre>
+</p><br>
+<p>
+<b>QINVOKE-METHOD+ (object function-name &rest arguments)</b>
+<br>
+<b>QFUN+</b>
+<p>Use this variant to call user defined functions (declared <code>Q_INVOKABLE</code>), slots, signals from external C++ classes.<br><br>In order to call ordinary functions, slots, signals from external C++ classes, just use the ordinary <code>qfun</code>.</p>
+<pre>
+  (qfun+ *qt-main* "foo") ; see Qt_EQL, Qt_EQL_dynamic
+  
+  ;; alternatively:
+  
+  (! "foo" (:qt *qt-main*))
+</pre>
+</p><br>
+<p>
+<b>QINVOKE-METHODS (object &rest functions)</b>
+<br>
+<b>QFUNS</b>
+<p>A simple syntax for nested <code>qfun</code> calls.</p>
+<pre>
+  (qfuns object "funA" "funB" "funC")      ; expands to: (qfun (qfun (qfun object "funA") "funB") "funC")
+  (qfuns object ("funA" 1) ("funB" a b c)) ; expands to: (qfun (qfun object "funA" 1) "funB" a b c)
+  (qfuns "QApplication" "font" "family")
+  (qfuns *table-view* "model" ("index" 0 2) "data" "toString")
+  
+  ;; alternatively:
+  
+  (! ("funC" "funB" "funA" object))
+  (! (("funB" a b c) ("funA" 1) object))
+  (! ("family" "font" "QApplication"))
+  (! ("toString" "data" ("index" 0 2) "model" *table-view*))
+  
+  ;; using wrapper functions, the above reads:
+  
+  (|funC| (|funB| (|funA| object)))
+  (|funB| (|funA| object 1) a b c)
+  (|family| (|font.QApplication|))
+  (|toString| (|data| (|index| (|model| *table-view*) 0 2)))
+</pre>
+</p><br>
+<p>
+<b>QLATER (function)</b>
+<p>Convenience macro: a <code>qsingle-shot</code> with a <code>0</code> timeout.<br>This will call <code>function</code> as soon as the Qt event loop is idle.</p>
+<pre>
+  (qlater 'delayed-ini)
+</pre>
+</p><br>
+<p>
+<b>QLET (((variable-1 expression-1) (variable-2 expression-2)) &body body)</b>
+<p>Similar to <code>let*</code> (and to local C++ variables).<br><br>Creates temporary Qt objects, deleting them at the end of the <code>qlet</code> body.<br>If <code>expression</code> is a string, it will be substituted with <code>(qnew expression)</code>, optionally including constructor arguments.</p>
+<pre>
+  (qlet ((painter "QPainter"))
+  &nbsp;&nbsp;...)
+  
+  (qlet ((reg-exp "QRegExp(QString)" "^\\S+$"))
+  &nbsp;&nbsp;...)
+</pre>
+</p><br>
+<p>
+<b>QLOAD (file-name)</b>
+<p>Convenience function for Slime (or when loading EQL files from an ECL thread).<br>Loading files that create many Qt objects can be slow on the Slime REPL (many thread switches).<br>This function reduces all thread switches (GUI related) to a single one.</p>
+</p><br>
+<p>
+<b>QLOAD-C++
 (library-name &optional unload)
</b>
+<p>Loads a custom Qt/C++ plugin (see <code>Qt_EQL_dynamic/</code>).<br>The <code>library-name</code> has to be passed as path to the plugin, without file ending.<br><br>This offers a simple way to extend your application with your own Qt/C++ functions.<br>The plugin will be reloaded (if supported by the OS) every time you call this function (Linux: see also <code>qauto-reload-c++</code>).<br>If the <code>unload</code> argument is not <code>NIL</code>, the plugin will be unloaded (if supported by the OS).
</p>
+<pre>
+  (defparameter *c++* (qload-c++ "eql_cpp")) ; load (Linux: see also QAUTO-RELOAD-C++)
+  
+  (qapropos nil *c++*)                       ; documentation
+  
+  (! "mySpeedyQtFunction" (:qt *c++*))       ; call library function (note :qt)
+</pre>
+</p><br>
+<p>
+<b>QLOAD-UI (file-name)
</b>
+<p>Calls a custom <code>QUiLoader::load()</code> function, loading a UI file created by Qt Designer. Returns the top level widget of the UI.<br>Use <code>qfind-child</code> to retrieve the child widgets.
</p>
+<pre>
+  (qload-ui "my-fancy-gui.ui")
+</pre>
+</p><br>
+<p>
+<b>QLOCAL8BIT (string)
</b>
+<p>Converts a Unicode pathname to a simple ECL base string, using <code>QString::toLocal8Bit()</code> (see <code>QLocale</code> settings).<br>Depending on the OS (namely Windows), this is necessary if you get a filename from Qt and want to use it in ECL.<br><br>See also <b>QUTF8</b>.
</p>
+</p><br>
+<p>
+<b>QMESSAGE-BOX (x)</b>
+<br>
+<b>QMSG</b>
+<p>Convenience function: a simple message box, converting <code>x</code> to a string if necessary.<br>Returns its argument (just like <code>print</code>).</p>
+</p><br>
+<p>
+<b>QNEW-INSTANCE (class-name &rest arguments/properties)
</b>
+<br>
+<b>QNEW
</b>
+<p>Creates a new Qt object, optionally passing the given arguments to the constructor.<br>Additionally you can pass any number of property/value pairs.<br>Please note how you can abbreviate long type lists.
</p>
+<pre>
+  (qnew "QWidget")
+  (qnew "QPixmap(int,int)" 50 50) ; constructor
+  (qnew "QLabel" "text" "Readme") ; set property
+  (qnew "QMatrix4x4(qreal...)" 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4)
+</pre>
+</p><br>
+<p>
+<b>QNEW-INSTANCE* (class-name &rest arguments/properties)</b>
+<br>
+<b>QNEW*</b>
+<p>Convenience function for the REPL.<br>Same as <code>qnew</code>, but showing the object immediately (if of type <code>QWidget</code>).</p>
+</p><br>
+<p>
+<b>QNULL-OBJECT (object)</b>
+<br>
+<b>QNULL</b>
+<p>Checks for a <code>0</code> Qt object pointer.</p>
+</p><br>
+<p>
+<b>QOBJECT-NAMES (&optional type)
</b>
+<p>Returns all supported object names. Passing either <code>:q</code> or <code>:n</code> returns only the QObject inherited, or not QObject inherited names, respectively.
</p>
+</p><br>
+<p>
+<b>QOK ()
</b>
+<p>Needed to get the boolean <b>ok</b> value in cases like this:
</p>
+<pre>
+  (! "getFont(bool*)" "QFontDialog" nil)
+  
+  (|getFont.QFontDialog| nil) ; NIL needed for &lt;bool*&gt;
+</pre>
+</p><br>
+<p>
+<b>QOVERRIDE (object name function)
</b>
+<p>Sets a Lisp function to be called on a virtual Qt method.<br>To remove a function, pass <code>NIL</code> instead of the function argument.<br><br>If you call <code>qcall-default</code> anywhere inside your overridden function, the base implementation will be called <b>afterwards</b>.<br>Instead of <code>qcall-default</code> you can directly call the base implementation, which is useful if you want to do post-processing of the returned value.
</p>
+<pre>
+  (qoverride edit "keyPressEvent(QKeyEvent*)" (lambda (ev) (print (|key| ev)) (qcall-default)))
+</pre>
+</p><br>
+<p>
+<b>QPROCESS-EVENTS ()
</b>
+<p>Convenience function to call <code>QApplication::processEvents()</code>.
</p>
+</p><br>
+<p>
+<b>QPROPERTIES (object &optional (depth 1))</b>
+<p>Prints all current properties of <code>object</code>, searching both all Qt properties and all Qt methods which don't require arguments (marked with '<b>*</b>').<br>Optionally pass a <code>depth</code> indicating how many super-classes to include. Pass <code>T</code> to include all super-classes.</p>
+<pre>
+  (qproperties (|font.QApplication|))
+  (qproperties (qnew "QVariant(QString)" "42"))
+  (qproperties *tool-button* 2)                 ; depth 2: both QToolButton and QAbstractButton
+</pre>
+</p><br>
+<p>
+<b>QPROPERTY (object name)
</b>
+<br>
+<b>QGET
</b>
+<p>Gets a Qt property. Enumerator values are returned as <code>int</code> values.<br>Returns <code>T</code> as second return value for successful calls.
</p>
+<pre>
+  (qget label "text")
+</pre>
+</p><br>
+<p>
+<b>QQUIT (&optional (exit-status 0) (kill-all-threads t))</b>
+<br>
+<b>QQ</b>
+<p>Terminates EQL. Use this function to quit gracefully, <b>not</b> <code>ext:quit</code>.</p>
+</p><br>
+<p>
+<b>QREMOVE-EVENT-FILTER (handle)
</b>
+<p>Removes the event filter corresponding to <code>handle</code>, which is the return value of <code>qadd-event-filter</code>.<br>Returns <code>handle</code> if the event filter has effectively been removed.<br>See also <code>qclear-event-filters</code>.
</p>
+</p><br>
+<p>
+<b>QREQUIRE
 (module &optional quiet)
</b>
+<p>Loads an EQL module, corresponding to a Qt module.<br>Returns the module name if both loading and initializing have been successful.<br>If the <code>quiet</code> argument is not <code>NIL</code>, no error message will be shown on failure.<br><br>Currently available modules: <code>:network :opengl :sql</code>
</p>
+<pre>
+  (qrequire :network)
+</pre>
+</p><br>
+<p>
+<b>QRGB (red green blue &optional (alpha 255))</b>
+<p>Constructs a <code>(unsigned-byte 32)</code> value that represents a 32 bit pixel color specified by the red, green, blue and alpha values.</p>
+</p><br>
+<p>
+<b>QRUN-IN-GUI-THREAD (function &optional (blocking t))
</b>
+<br>
+<b>QRUN
</b>
+<p>Runs <code>function</code> in GUI thread while (by default) blocking the calling thread (if called from main thread, <code>function</code> will simply be called directly).<br>This is needed to run GUI code from ECL threads other than the main thread.<br>Returns <code>T</code> on success.<br><br>There are 2 reasons to always wrap any EQL function like this, if called from another ECL thread:<ul><li>Qt GUI methods always need to run in the GUI thread<li>EQL functions are not designed to be reentrant (not needed for GUI code)</ul>See also macro <code>qrun*</code>.
</p>
+<pre>
+  (qrun 'update-view-data)
+</pre>
+</p><br>
+<p>
+<b>QRUN-IN-GUI-THREAD* (&body body)</b>
+<br>
+<b>QRUN*</b>
+<p>Convenience macro for <code>qrun</code>, wrapping <code>body</code> in a closure (passing arguments, return values).</p>
+<pre>
+  (qrun* (|setValue| ui:*progress-bar* value))
+  
+  (let ((item (qrun* (qnew "QTableWidgetItem")))) ; return value(s)
+  &nbsp;&nbsp;...)
+</pre>
+</p><br>
+<p>
+<b>QSELECT (&optional on-selected)</b>
+<br>
+<b>QSEL</b>
+<p>Allows to select (by clicking) any (child) widget.<br>The variable <code>qsel:*q*</code> is set to the latest selected widget.<br><br>Optionally pass a function to be called upon selecting, with the selected widget as argument.</p>
+<pre>
+  (qsel (lambda (widget) (qmsg widget)))
+</pre>
+</p><br>
+<p>
+<b>QSENDER ()
</b>
+<p>Corresponding to <code>QObject::sender()</code>. To use inside a Lisp function connected to a Qt signal.
</p>
+</p><br>
+<p>
+<b>QSET-COLOR (widget color-role color)</b>
+<p>Convenience function for simple color settings (avoiding <code>QPalette</code> boilerplate).<br>Use <code>QPalette</code> directly for anything more involved.</p>
+<pre>
+  (qset-color widget |QPalette.Window| "white")
+</pre>
+</p><br>
+<p>
+<b>QSET-NULL (object)</b>
+<p>Sets the Qt object pointer to <code>0</code>. This function is called automatically after <code>qdel</code>.</p>
+</p><br>
+<p>
+<b>QSET-PROPERTY (object name value)
</b>
+<br>
+<b>QSET
</b>
+<p>Sets a Qt property. Enumerators have to be passed as <code>int</code> values.<br>Returns <code>T</code> as second return value for successful calls.
</p>
+<pre>
+  (qset label "alignment" |Qt.AlignCenter|)
+</pre>
+</p><br>
+<p>
+<b>QSIGNAL (name)</b>
+<p>Needed in functions which expect a <code>const char*</code> Qt signal (not needed in <code>qconnect</code>).</p>
+</p><br>
+<p>
+<b>QSINGLE-SHOT (milliseconds function)
</b>
+<p>A single shot timer similar to <code>QTimer::singleShot()</code>.
</p>
+<pre>
+  (qsingle-shot 1000 'one-second-later)
+  
+  (let ((ms 500))
+  &nbsp;&nbsp;(qsingle-shot ms (lambda () (qmsg ms))))
+</pre>
+</p><br>
+<p>
+<b>QSLEEP (seconds)</b>
+<p>Similar to <code>sleep</code>, but continuing to process Qt events.</p>
+</p><br>
+<p>
+<b>QSLOT (name)</b>
+<p>Needed in functions which expect a <code>const char*</code> Qt slot (not needed in <code>qconnect</code>).</p>
+</p><br>
+<p>
+<b>QSTATIC-META-OBJECT (class-name)
</b>
+<p>Returns the <code>::staticMetaObject</code> of the given class name.
</p>
+<pre>
+  (qstatic-meta-object "QEasingCurve")
+</pre>
+</p><br>
+<p>
+<b>QSUPER-CLASS-NAME (name)
</b>
+<p>Returns the super class of an object name, or <code>NIL</code> if the class doesn't inherit another Qt class.<br>Returns <code>T</code> as second return value for successful calls.
</p>
+<pre>
+  (qsuper-class-name "QGraphicsLineItem")
+</pre>
+</p><br>
+<p>
+<b>QT-OBJECT-?
 (object)
</b>
+<p>Returns the specific <code>qt-object</code> of a generic <code>qt-object</code>.<br>Works for QObject and QEvent inherited classes only.
</p>
+<pre>
+  (qt-object-? (|parentWidget| widget))
+  (qt-object-? (|widget| (|itemAt| box-layout 0)))
+  (qt-object-? event)
+</pre>
+</p><br>
+<p>
+<b>QT-OBJECT-NAME (object)
</b>
+<p>Returns the Qt class name.
</p>
+</p><br>
+<p>
+<b>QUI-CLASS (file-name &optional object-name)
</b>
+<p>Finds the class name for the given user-defined object name in the given UI file.<br>Omitting the object name will return the top level class name of the UI.
</p>
+<pre>
+  (qui-class "examples/data/main-window.ui" "editor") ; returns "QTextEdit"
+</pre>
+</p><br>
+<p>
+<b>QUI-NAMES (file-name)
</b>
+<p>Finds all user-defined object names in the given UI file.
</p>
+<pre>
+  (qui-names "examples/data/main-window.ui")
+</pre>
+</p><br>
+<p>
+<b>QUIC (&optional (file.h "ui.h") (file.lisp "ui.lisp") (ui-package :ui))</b>
+<p>Takes C++ code from a file generated by the <code>uic</code> user interface compiler, and generates the corresponding EQL code.<br>See also command line option <code>-quic</code>.</p>
+</p><br>
+<p>
+<b>QUTF8 (string)
</b>
+<p>Converts a Unicode pathname to a simple ECL base string, using <code>QString::toUtf8()</code>.<br>Depending on the OS (namely OSX, Linux), this is necessary if you get a filename from Qt and want to use it in ECL.<br><br>See also <b>QLOCAL8BIT</b>.
</p>
+</p><br>
+<p>
+<b>QVERSION ()
</b>
+<p>Returns the EQL version number as "&lt;year&gt;.&lt;month&gt;.&lt;counter&gt;", analogous to the ECL version number.<br>The second return value is the Qt version as returned by <code>qVersion()</code>.
</p>
+</p><br>
+<p>
+<b>TR (source &optional context plural-number)</b>
+<p>Macro expanding to <code>qtranslate</code>, which calls <code>QCoreApplication::translate()</code>.<br>Both <code>source</code> and <code>context</code> can be Lisp forms evaluating to constant strings (at compile time).<br>The <code>context</code> argument defaults to the Lisp file name. For the <code>plural-number</code>, see Qt Assistant.</p>
+</p><br>
+</body></html>

doc/auto-doc.lisp

@@ -0,0 +1,78 @@
+;;; copyright (c) 2010-2013 Polos Ruetz
+
+(in-package :eql-user)
+
+(defparameter *help* nil)
+
+(defun add-cpp-docu ()
+  (with-open-file (s (eql:in-home "src/ecl_fun.cpp") :direction :input)
+    (let (curr ex)
+      (flet ((add-curr ()
+               (when curr
+                 (push (reverse curr) *help*)
+                 (setf curr nil)))
+             (trim (str)
+               (string-trim '(#\/ #\Space) str)))
+        (x:while-it (read-line s nil nil)
+          (let ((line (string-trim " " x:it)))
+            (when (x:starts-with "///" line)
+              (when (x:starts-with "cl_object " ex)
+                (add-curr)
+                (let* ((pos (search "///" ex :start2 3)) ; exception: Lisp name at end of line
+                       (fun (if pos
+                                (trim (subseq ex (+ 3 pos)))
+                                (trim (subseq ex 10)))))
+                  (push (if pos
+                            fun
+                            (substitute #\- #\_ (string-trim "2" (subseq fun 0 (position #\( fun)))))
+                        curr)))
+              (push (trim line) curr))
+            (setf ex line)))
+        (add-curr)))))
+
+(defun add-lisp-docu ()
+  (do-external-symbols (sym (find-package :eql))
+    (let ((name (symbol-name sym)))
+      (when (or (char= #\Q (char name 0))
+                (find name '("ENSURE-QT-OBJECT" "DEFINE-QT-WRAPPERS" "DEFVAR-UI" "TR") :test 'string=))
+        (x:when-it (documentation sym 'function)
+          (let ((fun  (string-downcase (symbol-name sym)))
+                (docu (mapcar #'(lambda (s) (string-trim " " s)) (x:split x:it #\Newline))))
+            (unless (string= fun (subseq (second docu) 7))
+              (push (cons fun docu) *help*))))))))
+
+(defun help ()
+  (setf *help* nil)
+  (add-cpp-docu)
+  (add-lisp-docu)
+  (with-open-file (s (eql:in-home "doc/auto-doc.htm") :direction :output :if-exists :supersede)
+    (write-string "<html><body>" s)
+    (flet ((el (tag x)
+             (format nil "<~A>~A</~A>" tag x tag))
+           (! (x)
+             (format s "~A~%" x))
+           (tab ()
+             (write-string "  " s)))
+      (setf *help* (sort *help* #'string< :key #'first))
+      (dolist (curr *help*)
+        (! "<p>")
+        (! (el "b" (format nil "~A ~A" (string-upcase (first curr)) (subseq (second curr) 6))))
+        (let ((n 2))
+          (when (x:starts-with "alias:" (third curr))
+            (incf n)
+            (! "<br>")
+            (! (el "b" (string-upcase (subseq (third curr) 7)))))
+          (! (el "p" (nth n curr)))
+          (let ((examples (nthcdr (1+ n) curr)))
+            (when examples
+              (! "<pre>")
+              (dolist (example examples)
+                (tab)
+                (! example))
+              (! "</pre>"))))
+        (! "</p><br>"))
+      (write-string "</body></html>" s))))
+
+(progn
+  (help)
+  (eql:qq))

doc/index.html

@@ -0,0 +1,18 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+</head>
+<body style="margin-left: 25px;">
+<img src="EQL.png">
+<ul>
+<li><a href="auto-doc.htm">Function List</a>
+<li><a href="Slime.htm">Slime</a>
+<li><a href="Debugging.htm">Debugging</a>
+<li><a href="QtDesigner.htm">Qt Designer</a>
+<li><a href="QtLinguist.htm">Qt Linguist</a>
+<li><a href="Deploy.htm">Deploy</a>
+<li><a href="Notes.htm">Notes</a>
+</ul>
+<p><a href="http://groups.google.com/d/forum/eql-user">Mailing List (Google Groups)</a></p>
+</body>
+</html>

doc/style.css

@@ -0,0 +1,5 @@
+a:link { text-decoration: none; color: blue; }
+a:hover, a:visited, a:visited:hover { text-decoration: underline; color: blue; }
+body { font-family: sans-serif; font-size: 10pt; }
+code, pre { color: mediumblue; }
+.added { color: red; }

examples/0-Tutorial/0.lisp

@@ -0,0 +1,8 @@
+;; Lisp versus C++ (note reversed order)
+
+(|currentTime.QTime|)                               ; QTime::currentTime()
+
+(|toString| (|currentTime.QTime|))                  ; QTime::currentTime().toString()
+
+(|toString| (|addSecs| (|currentTime.QTime|) 1000)) ; QTime::currentTime().addSecs(1000).toString()
+

examples/0-Tutorial/1.lisp

@@ -0,0 +1,11 @@
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+;;; Ported Qt Widgets Tutorial - Creating a Window
+
+(in-package :eql-user)
+
+(let ((window (qnew "QWidget"
+                    "size" '(320 240)
+                    "windowTitle" "Top-level widget")))
+  (|show| window))

examples/0-Tutorial/2.lisp

@@ -0,0 +1,15 @@
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+;;; Ported Qt Widgets Tutorial - Child Widgets
+
+(in-package :eql-user)
+
+(let ((window (qnew "QWidget"
+                    "size" '(320 240)
+                    "windowTitle" "Child widget"))
+      (button (qnew "QPushButton"
+                    "text" "Press me"
+                    "pos" '(100 100))))
+  (|setParent| button window)
+  (|show| window))

examples/0-Tutorial/3.lisp

@@ -0,0 +1,17 @@
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+;;; Ported Qt Widgets Tutorial - Using Layouts
+
+(in-package :eql-user)
+
+(let ((window    (qnew "QWidget"
+                       "windowTitle" "Window layout"))
+      (label     (qnew "QLabel"
+                       "text" "Name:"))
+      (line-edit (qnew "QLineEdit"))
+      (layout    (qnew "QHBoxLayout")))
+  (dolist (w (list label line-edit))
+    (|addWidget| layout w))
+  (|setLayout| window layout)
+  (|show| window))

examples/0-Tutorial/4.lisp

@@ -0,0 +1,44 @@
+#-qt-wrapper-functions
+(load (in-home "src/lisp/all-wrappers"))
+
+;;; Ported Qt Widgets Tutorial - Nested Layouts
+
+(in-package :eql-user)
+
+(defun start ()
+  (let ((window       (qnew "QWidget"
+                            "windowTitle" "Nested layouts"))
+        (query-label  (qnew "QLabel"
+                            "text" "Query:"))
+        (query-edit   (qnew "QLineEdit"))
+        (result-view  (qnew "QTableView"))
+        (query-layout (qnew "QHBoxLayout"))
+        (main-layout  (qnew "QVBoxLayout")))
+    (dolist (w (list query-label query-edit))
+      (|addWidget| query-layout w))
+    (|addLayout| main-layout query-layout)
+    (|addWidget| main-layout result-view)
+    (|setLayout| window main-layout)
+    (setup-model-and-view result-view)
+    (|show| window)))
+
+(defun setup-model-and-view (view)
+  (let ((model (qnew "QStandardItemModel")))
+    (|setHorizontalHeaderLabels| model '("Name" "Office"))
+    (dolist (row '(("Verne Nilsen" "123")
+                   ("Carlos Tang" "77")
+                   ("Bronwyn Hawcroft" "119")
+                   ("Alessandro Hanssen" "32")
+                   ("Andrew John Bakken" "54")
+                   ("Vanessa Weatherley" "85")
+                   ("Rebecca Dickens" "17")
+                   ("David Bradley" "42")
+                   ("Knut Walters" "25")
+                   ("Andrea Jones" "34")))
+      (|appendRow| model (loop :for text :in row
+                               :collect (qnew "QStandardItem(QString)" text))))
+    (|setModel| view model)
+    (|hide| (|verticalHeader| view))
+    (|setStretchLastSection| (|horizontalHeader| view) t)))
+
+(start)

examples/1-hello-world.lisp

@@ -0,0 +1,10 @@
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+;;; hello world
+
+(in-package :eql-user)
+
+(qnew* "QLabel"                      ; QNEW* is QNEW followed by |show|
+       "text" "<h1>hello world</h1>"
+       "pos" '(50 50))

examples/2-clock.lisp

@@ -0,0 +1,94 @@
+;;; This is (kind of) a port of the Qt Script Example "Clock"
+
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+(defpackage :clock
+  (:use :common-lisp :eql)
+  (:export
+   #:*clock*
+   #:start))
+
+(in-package :clock)
+
+(defparameter *show-seconds* t)
+(defparameter *show-minutes* t)
+
+(defvar *clock* (qnew "QWidget(QWidget*,Qt::WindowFlags)" nil |Qt.WindowStaysOnTopHint|
+                      "size" '(170 170)
+                      "pos" '(50 50)))
+
+(defun start ()
+  (let ((timer (qnew "QTimer(QObject*)" *clock*)))
+    (qconnect timer "timeout()" (lambda () (|update| *clock*)))
+    (qoverride *clock* "paintEvent(QPaintEvent*)" 'paint)
+    (|start| timer 500)
+    (x:do-with *clock* |show| |raise|)))
+
+(defun pen (width &optional (color "black"))
+  (x:let-it (qnew "QPen")
+    (x:do-with x:it
+      (|setCapStyle| |Qt.RoundCap|)
+      (|setWidth| width)
+      (|setColor| color))))
+
+(defun brush (color)
+  (x:let-it (qnew "QBrush")
+    (x:do-with x:it
+      (|setStyle| |Qt.SolidPattern|)
+      (|setColor| color))))
+
+(defparameter *pen-clock*        (pen 8 "steelblue"))
+(defparameter *pen-hour-marks*   (pen 4))
+(defparameter *pen-minute-marks* (pen 2 "steelblue"))
+(defparameter *pen-hour*         (pen 7))
+(defparameter *pen-minute*       (pen 5))
+(defparameter *pen-second*       (pen 2 "red"))
+(defparameter *brush-clock*      (brush "white"))
+(defparameter *brush-second*     (brush "gold"))
+
+(defun paint (ev)
+  (macrolet ((with-save (() &body body)
+               `(progn (|save| p) ,@body (|restore| p))))
+    (qlet ((p "QPainter(QWidget*)" *clock*))
+      (let* ((size (|size| *clock*))
+             (scale (/ (apply 'min size) 170)))
+        (|translate| p (mapcar (lambda (x) (/ x 2)) size))
+        (|scale| p scale scale))
+      (|rotate| p -90)
+      (|setRenderHint| p |QPainter.Antialiasing|)
+      (|setPen| p *pen-clock*)
+      (|setBrush|  p *brush-clock*)
+      (|drawEllipse| p '(-75 -75 150 150))
+      (|setPen| p *pen-hour-marks*)
+      (dotimes (n 12)
+        (|rotate| p 30)
+        (|drawLine| p '(55 0 65 0)))
+      (|setPen| p *pen-minute-marks*)
+      (dotimes (n 60)
+        (|rotate| p 6)
+        (|drawLine| p '(63 0 65 0)))
+      (multiple-value-bind (sec min hour)
+          (get-decoded-time)
+        (with-save ()
+          (|rotate| p (+ (* 30 hour) (/ min 2)))
+          (|setPen| p *pen-hour*)
+          (|setOpacity| p 0.5)
+          (|drawLine| p '(-10 0 36 0)))
+        (when *show-minutes*
+          (with-save ()
+            (|rotate| p (* 6 min))
+            (|setPen| p *pen-minute*)
+            (|setOpacity| p 0.5)
+            (|drawLine| p '(-15 0 65 0))))
+        (when *show-seconds*
+          (with-save ()
+            (|rotate| p (* 6 sec))
+            (|setPen| p *pen-second*)
+            (|setBrush| p *brush-second*)
+            (|drawEllipse| p '(-1.5 -1.5 3 3))
+            (|setOpacity| p 0.7)
+            (|drawLine| p '(-15 0 52 0))
+            (|drawEllipse| p '(53 -4 8 8))))))))
+
+(start)

examples/3-main-window.lisp

@@ -0,0 +1,55 @@
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+(defpackage :main-window
+  (:use :common-lisp :eql)
+  (:export
+   #:start))
+
+(in-package :main-window)
+
+(defvar *main*        (qload-ui (in-home "examples/data/main-window.ui")))
+(defvar *editor*      (qfind-child *main* "editor"))
+(defvar *action-open* (qfind-child *main* "action_open"))
+(defvar *action-save* (qfind-child *main* "action_save"))
+
+(defun os-pathname (name)
+  "Needed because ECL uses base strings (not Unicode) for pathnames internally."
+  #+(or darwin linux)
+  (qutf8 name)
+  #+win32
+  (qlocal8bit name))
+
+(defun read-file (file)
+  (with-open-file (s (os-pathname file) :direction :input)
+    (let ((str (make-string (file-length s))))
+      (read-sequence str s)
+      str)))
+
+(defun set-icon (action name)
+  (|setIcon| action (qnew "QIcon(QString)"
+                          (in-home (format nil "examples/data/icons/~A.png" name)))))
+
+(defun start ()
+  (x:do-with (qset *main*)
+    ("pos" '(50 50))
+    ("size" '(700 500)))
+  (set-icon *action-open* "open")
+  (set-icon *action-save* "save")
+  (qconnect *action-open* "triggered()" 'file-open)
+  (qconnect *action-save* "triggered()" 'file-save)
+  (|setHtml| *editor* (read-file (in-home "examples/data/utf8.htm")))
+  (x:do-with *main* |show| |raise|))
+
+(defun file-open ()
+  (let ((file (|getOpenFileName.QFileDialog|)))
+    (unless (x:empty-string file)
+      (|setHtml| *editor* (read-file file)))))
+
+(defun file-save ()
+  (let ((file (|getSaveFileName.QFileDialog|)))
+    (unless (x:empty-string file)
+      (with-open-file (s (os-pathname file) :direction :output :if-exists :supersede)
+        (write-string (|toHtml| *editor*) s)))))
+
+(start)

examples/4-wiggly-widget.lisp

@@ -0,0 +1,70 @@
+;;; This is a port of the Qt Example "Wiggly Widget"
+
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+(defpackage :wiggly-widget
+  (:nicknames :wiggly)
+  (:use :common-lisp :eql)
+  (:export
+   #:start))
+
+(in-package :wiggly-widget)
+
+(defparameter *curve* #.(coerce (loop :for i :below 16 :collect (round (* 100 (sin (* i (/ pi 8))))))
+                                'vector)
+  "Vector of 16 values ranging from -100 to 100.")
+
+(defvar *wiggly* (qnew "QWidget"
+                       "font" (x:let-it (|font.QApplication|)
+                                (|setPointSize| x:it (+ 20 (|pointSize| x:it))))
+                       "autoFillBackground" t))
+
+(defvar *edit*   (qnew "QLineEdit" "alignment" |Qt.AlignCenter|))
+(defvar *timer*  (qnew "QTimer"))
+
+(defparameter *step* 0)
+
+(defun start ()
+  (|setBackgroundRole| *wiggly* |QPalette.Light|)
+  (let ((dlg (qnew "QDialog" "size" '(600 200)))
+        (vbox (qnew "QVBoxLayout")))
+    (|setLayout| dlg vbox)
+    (dolist (w (list *wiggly* *edit*))
+      (|addWidget| vbox w))
+    (qconnect *timer* "timeout()" 'timeout)
+    (qoverride *wiggly* "paintEvent(QPaintEvent*)" 'paint)
+    (|start| *timer* 50)
+    (|setText| *edit* "= never odd or even =")
+    (x:do-with dlg |show| |raise|)))
+
+(defun paint (ev)
+  (qlet ((painter "QPainter(QWidget*)" *wiggly*) ; local QPainter variable: no need to call "begin", "end"
+         (pen "QPen")
+         (metrics "QFontMetrics(QFont)" (|font| *wiggly*)))
+    (let* ((txt (|text| *edit*))
+           (x (/ (- (|width| *wiggly*)
+                    (|width| metrics txt))
+                 2))
+           (y (/ (- (+ (|height| *wiggly*) (|ascent| metrics))
+                    (|descent| metrics))
+                 2))
+           (h (|height| metrics)))
+      (dotimes (i (length txt))
+        (let ((ix (mod (+ i *step*) 16))
+              (ch (char txt i)))
+          (|setColor| pen (|fromHsv.QColor| (* 16 (- 15 ix)) 255 191))
+          (x:do-with painter
+            (|setPen| pen)
+            (|drawText| (list (floor x)
+                              (floor (- y (/ (* h (svref *curve* ix)) 400))))
+                        (string ch)))
+          (incf x (|width| metrics ch)))))))
+
+(defun timeout ()
+  (incf *step*)
+  (|update| *wiggly*))
+
+(progn
+  (start)
+  (qlater (lambda () (in-package :wiggly))))

examples/5-colliding-mice.lisp

@@ -0,0 +1,248 @@
+;;; This is a port of the Qt Example "Colliding Mice"
+;;;
+;;; Note (OSX only):
+;;;
+;;; Seldom crashes (OSX 10.4, Qt 4.6.2) are not related to this tool, as they happen even in the original Qt example.
+;;;
+;;; The good news: if a seg.fault happens (in C++), just choose the restart option "Abort" (below "Continue"),
+;;; and the application will continue to run.
+
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+(defpackage :colliding-mice
+  (:nicknames :mice)
+  (:use :common-lisp :eql)
+  (:export
+   #:start))
+
+(in-package :colliding-mice)
+
+(defconstant +2pi+ (* 2 pi))
+
+(defvar *graphics-scene* (qnew "QGraphicsScene"
+                               "sceneRect" '(-300 -300 600 600)))
+(defvar *timer*          (qnew "QTimer"))
+(defvar *mouse-count*    0)
+
+(defstruct mouse ; DEFSTRUCT (instead of DEFCLASS) is simpler in this case
+  (item          (qnew "QGraphicsItem"))
+  (brush         (brush (|fromRgb.QColor| (random 256) (random 256) (random 256))))
+  (angle         0)
+  (speed         0)
+  (eye-direction 0))
+
+(defmethod the-qt-object ((object mouse)) ; see example "X-extras/CLOS-encapsulation.lisp"
+  (mouse-item object))
+
+(let ((shape (x:let-it (qnew "QPainterPath")
+               (|addRect| x:it '(-10 -20 20 40)))))
+  (defun new-mouse ()
+    (incf *mouse-count*)
+    (let ((mouse (make-mouse)))
+      (|setRotation| mouse (random (* 360 16)))
+      (x:do-with (qoverride mouse)
+        ("boundingRect()"
+         (lambda () '(-18.5 -22.5 36.5 60.5)))
+        ("shape()"
+         (lambda () shape))
+        ("paint(QPainter*,QStyleOptionGraphicsItem*,QWidget*)"
+         (lambda (painter s w) (paint mouse painter)))
+        ("advance(int)"
+         (lambda (step) (advance mouse step))))
+      mouse)))
+
+(defun brush (color &optional (style |Qt.SolidPattern|))
+  (x:let-it (qnew "QBrush")
+    (|setStyle| x:it style)
+    (when color
+      (|setColor| x:it color))))
+
+(defparameter *brush-eyes*      (brush "white"))
+(defparameter *brush-nose*      (brush "black"))
+(defparameter *brush-ears*      (brush "olive"))
+(defparameter *brush-colliding* (brush "red"))
+(defparameter *brush-tail*      (brush nil |Qt.NoBrush|))
+
+(defparameter *painter-path-tail* (x:let-it (qnew "QPainterPath")
+                                    (x:do-with x:it
+                                      (|moveTo| '(0 20))
+                                      (|cubicTo| '(-5 22) '(-5 22) '(0 25))
+                                      (|cubicTo| '(5  27) '(5  32) '(0 30))
+                                      (|cubicTo| '(-5 32) '(-5 42) '(0 35)))))
+
+(defun paint (mouse painter)
+  (|setBrush| painter (mouse-brush mouse))
+  (|drawEllipse| painter '(-10 -20 20 40))
+  ;; eyes
+  (|setBrush| painter *brush-eyes*)
+  (|drawEllipse| painter '(-10 -17 8 8))
+  (|drawEllipse| painter '(2 -17 8 8))
+  ;; nose
+  (|setBrush| painter *brush-nose*)
+  (|drawEllipse| painter '(-2 -22 4 4))
+  ;; pupils
+  (let ((dir (mouse-eye-direction mouse)))
+    (|drawEllipse| painter (list (- dir 8) -17 4 4))
+    (|drawEllipse| painter (list (+ dir 4) -17 4 4)))
+  ;; ears
+  (|setBrush| painter (if (null (|collidingItems| (|scene| mouse) mouse))
+                                   *brush-ears*
+                                   *brush-colliding*))
+  (|drawEllipse| painter '(-17 -12 16 16))
+  (|drawEllipse| painter '(1 -12 16 16))
+  ;; tail
+  (|setBrush| painter *brush-tail*)
+  (|drawPath| painter *painter-path-tail*))
+
+(defun advance (mouse step)
+  (unless (zerop step)
+    (labels ((normalize-angle (a)
+               (x:while (minusp a)
+                 (incf a +2pi+))
+               (x:while (> a +2pi+)
+                 (decf a +2pi+))
+               a)
+             (dx (line)
+               (- (third line) (first line)))
+             (dy (line)
+               (- (fourth line) (second line)))
+             (len (line)
+               (let ((x (dx line))
+                     (y (dy line)))
+                 (sqrt (+ (* x x) (* y y)))))
+             (map-from (p)
+               (|mapFromScene| mouse p))
+             (map-to (p)
+               (|mapToScene| mouse p)))
+      (let ((line-to-center (append '(0 0) (map-from '(0 0)))))
+        (if (> (len line-to-center) 150)
+            (let ((angle-to-center (acos (/ (dx line-to-center) (len line-to-center)))))
+              (when (minusp (dy line-to-center))
+                (setf angle-to-center (- +2pi+ angle-to-center)))
+              (setf angle-to-center (normalize-angle (+ (- pi angle-to-center)
+                                                        (/ pi 2))))
+              (cond ((< (/ pi 4) angle-to-center pi)
+                     ;; rotate left
+                     (incf (mouse-angle mouse)
+                           (if (< (mouse-angle mouse) (/ (- pi) 2)) 0.25 -0.25)))
+                    ((and (>= angle-to-center pi)
+                          (< angle-to-center (+ pi (/ pi 2) (/ pi 4))))
+                     ;; rotate right
+                     (incf (mouse-angle mouse)
+                           (if (< (mouse-angle mouse) (/ pi 2)) 0.25 -0.25)))))
+            (let ((sin (sin (mouse-angle mouse))))
+              (incf (mouse-angle mouse) (cond ((minusp sin) 0.25)
+                                              ((plusp sin) -0.25)
+                                              (t 0))))))
+      ;; try not to crash with any other mice
+      (let ((danger-mice (|items| (|scene| mouse)
+                                  (append (map-to '(0 0))
+                                          (map-to '(-30 -50))
+                                          (map-to '(30 -50)))
+                                  |Qt.IntersectsItemShape|
+                                  |Qt.AscendingOrder|)))
+        (dolist (danger-mouse danger-mice)
+          (unless (qeql mouse danger-mouse)
+            (let* ((line-to-mouse (append '(0 0)
+                                          (|mapFromItem| mouse danger-mouse '(0 0))))
+                   (angle-to-mouse (acos (/ (dx line-to-mouse) (len line-to-mouse)))))
+              (when (minusp (dy line-to-mouse))
+                (setf angle-to-mouse (- +2pi+ angle-to-mouse)))
+              (setf angle-to-mouse (normalize-angle (+ (- pi angle-to-mouse)
+                                                       (/ pi 2))))
+              (cond ((and (>= angle-to-mouse 0)
+                          (< angle-to-mouse (/ pi 2)))
+                     ;; rotate right
+                     (incf (mouse-angle mouse) 0.5))
+                    ((and (<= angle-to-mouse +2pi+)
+                          (> angle-to-mouse (- +2pi+ (/ pi 2))))
+                     ;; rotate left
+                     (decf (mouse-angle mouse) 0.5))))))
+        ;; add some random movement
+        (when (and (> (length danger-mice) 1)
+                   (zerop (random 10)))
+          (let ((rnd (/ (random 100) 500))
+                (angle (mouse-angle mouse)))
+            (setf (mouse-angle mouse)
+                  (if (zerop (random 2)) (+ angle rnd) (- angle rnd)))))
+        (incf (mouse-speed mouse) (/ (- (random 100) 50) 100))
+        (let ((dx (* 10 (sin (mouse-angle mouse)))))
+          (setf (mouse-eye-direction mouse)
+                (if (< (abs (/ dx 5)) 1) 0 (/ dx 5)))
+          (|setRotation| mouse (+ dx (|rotation| mouse)))
+          (|setPos| mouse (|mapToParent| mouse (list 0 (- (+ 3 (* 3 (sin (mouse-speed mouse)))))))))))))
+
+(defun start ()
+  (setf *random-state* (make-random-state t))
+  (let ((view (qnew "QGraphicsView"
+                    "windowTitle" "Colliding Mice"
+                    "size" '(400 300))))
+    (|setItemIndexMethod| *graphics-scene* |QGraphicsScene.NoIndex|)
+    (x:do-with view
+      (|setScene| *graphics-scene*)
+      (|setRenderHint| |QPainter.Antialiasing|)
+      (|setBackgroundBrush| (qnew "QBrush(QPixmap)"
+                                  (qnew "QPixmap(QString)"
+                                        (in-home "examples/data/icons/cheese.jpg"))))
+      (|setCacheMode| |QGraphicsView.CacheBackground|)
+      (|setViewportUpdateMode| |QGraphicsView.BoundingRectViewportUpdate|)
+      (|setDragMode| |QGraphicsView.ScrollHandDrag|))
+    (let ((count 7))
+      (dotimes (i count)
+        (flet ((pos (fun)
+                 (truncate (* 200 (funcall fun (/ (* i +2pi+) count))))))
+          (let ((item (new-mouse)))
+            (|setPos| item (list (pos 'sin) (pos 'cos)))
+            (|addItem| *graphics-scene* item)))))
+    (qconnect *timer* "timeout()" *graphics-scene* "advance()")
+    (|start| *timer* 30)
+    (x:do-with view |show| |raise|)))
+
+;;; for playing around interactively
+
+(defun m+ (&optional (n 1))
+  "Add n mice."
+  (dotimes (i n)
+    (let ((item (new-mouse)))
+      (|setPos| item (list (- 100 (random 200)) (- 100 (random 200))))
+      (|addItem| *graphics-scene* item)))
+  *mouse-count*)
+
+(defun m- (&optional (n 1))
+  "Remove n mice."
+  (dotimes (i n)
+    (when (zerop *mouse-count*)
+      (return))
+    (decf *mouse-count*)
+    (qdel (first (last (|items| *graphics-scene*)))))
+  *mouse-count*)
+
+(defun iv (&optional (ms 30))
+  "Change move interval."
+  (|setInterval| *timer* ms))
+
+(defun ? ()
+  ;; demo of QSLEEP (a SLEEP processing Qt events)
+  (let ((max (print (length (|items| *graphics-scene*)))))
+    (dotimes (n max)
+      (print (m-))
+      (qsleep 1))
+    (dotimes (n max)
+      (print (m+))
+      (qsleep 1))))
+
+#|
+(require :profile)
+
+(progn
+  (use-package :profile)
+  (profile:profile
+   paint
+   advance))
+|#
+
+(progn
+  (start)
+  (qlater (lambda () (in-package :mice))))
+

examples/6-download.lisp

@@ -0,0 +1,48 @@
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+(unless (eql:qrequire :network)
+  (error "EQL module :network could not be found/loaded")
+  (eql:qq))
+
+(defpackage :download
+  (:use :common-lisp :eql)
+  (:export
+   #:ini
+   #:download))
+
+(in-package :download)
+
+(defvar *manager* (qnew "QNetworkAccessManager"))
+(defvar *ini*     t)
+
+(defun download (name)
+  (when *ini*
+    (setf *ini* nil)
+    (qconnect *manager* "finished(QNetworkReply*)" 'download-finished))
+  (qlet ((url "QUrl(QString)" name)
+         (request "QNetworkRequest(QUrl)" url))
+    (|get| *manager* request)))
+
+(defun download-finished (reply)
+  (|deleteLater| reply) ; QNetworkReply*: heap result, delete manually
+  (let ((error (|error| reply)))
+    (if (= |QNetworkReply.NoError| error)
+        (let ((data (|readAll| reply)))
+          (save-data data)
+          (|information.QMessageBox| nil "EQL"
+                                     (format nil (tr "Downloaded ~:D bytes, see \"download.data\".") (length data))))
+        (show-error error))))
+
+(defun save-data (data)
+  (with-open-file (s "download.data" :direction :output :if-exists :supersede
+                     :element-type '(signed-byte 8))
+    (write-sequence data s)))
+
+(defun show-error (error)
+  (let ((msg (x:when-it (find error (cdadr (qenums "QNetworkReply" "NetworkError")) :key 'cdr)
+               (format nil (tr "Download error: <span style='color:red; font-weight:bold;'>~A</span>")
+                       (car x:it)))))
+    (|critical.QMessageBox| nil "EQL" (or msg (tr "Unknown download error.")))))
+
+(download "http://planet.lisp.org/")

examples/7-Sokoban/3rd-party/CONTRIBUTORS

@@ -0,0 +1,6 @@
+# Please add yourself to this file when you submit a patch.
+
+Julian Fondren <ayrnieu@gmail.com>
+    - Maintainer.
+    - Contributed simple-ui ! :D
+    - also: raw-ui , cl-sokoban.el

examples/7-Sokoban/3rd-party/COPYING

@@ -0,0 +1,3 @@
+BSD with no advertisement clause.
+
+Copyrights held by their respective authors.

examples/7-Sokoban/3rd-party/README.txt

@@ -0,0 +1 @@
+Please see http://www.cliki.net/CL-Sokoban for the original game.

examples/7-Sokoban/3rd-party/levels.lisp

@@ -0,0 +1,816 @@
+(in-package :cl-sokoban)
+
+(defmaze
+  "    #####          "
+  "    #   #          "
+  "    #$  #          "
+  "  ###  $##         "
+  "  #  $ $ #         "
+  "### # ## #   ######"
+  "#   # ## #####  ..#"
+  "# $  $          ..#"
+  "##### ### #@##  ..#"
+  "    #     #########"
+  "    #######        ")
+
+(defmaze
+  "############  "
+  "#..  #     ###"
+  "#..  # $  $  #"
+  "#..  #$####  #"
+  "#..    @ ##  #"
+  "#..  # #  $ ##"
+  "###### ##$ $ #"
+  "  # $  $ $ $ #"
+  "  #    #     #"
+  "  ############")
+
+(defmaze
+  "        ######## "
+  "        #     @# "
+  "        # $#$ ## "
+  "        # $  $#  "
+  "        ##$ $ #  "
+  "######### $ # ###"
+  "#....  ## $  $  #"
+  "##...    $  $   #"
+  "#....  ##########"
+  "########         ")
+
+(defmaze
+  "           ########"
+  "           #  ....#"
+  "############  ....#"
+  "#    #  $ $   ....#"
+  "# $$$#$  $ #  ....#"
+  "#  $     $ #  ....#"
+  "# $$ #$ $ $########"
+  "#  $ #     #       "
+  "## #########       "
+  "#    #    ##       "
+  "#     $   ##       "
+  "#  $$#$$  @#       "
+  "#    #    ##       "
+  "###########        ")
+
+(defmaze
+  "        #####    "
+  "        #   #####"
+  "        # #$##  #"
+  "        #     $ #"
+  "######### ###   #"
+  "#....  ## $  $###"
+  "#....    $ $$ ## "
+  "#....  ##$  $ @# "
+  "#########  $  ## "
+  "        # $ $  # "
+  "        ### ## # "
+  "          #    # "
+  "          ###### ")
+
+(defmaze
+  "######  ### "
+  "#..  # ##@##"
+  "#..  ###   #"
+  "#..     $$ #"
+  "#..  # # $ #"
+  "#..### # $ #"
+  "#### $ #$  #"
+  "   #  $# $ #"
+  "   # $  $  #"
+  "   #  ##   #"
+  "   #########")
+
+(defmaze
+  "       ##### "
+  " #######   ##"
+  "## # @## $$ #"
+  "#    $      #"
+  "#  $  ###   #"
+  "### #####$###"
+  "# $  ### ..# "
+  "# $ $ $ ...# "
+  "#    ###...# "
+  "# $$ # #...# "
+  "#  ### ##### "
+  "####         ")
+
+(defmaze
+  "  ####          "
+  "  #  ###########"
+  "  #    $   $ $ #"
+  "  # $# $ #  $  #"
+  "  #  $ $  #    #"
+  "### $# #  #### #"
+  "#@#$ $ $  ##   #"
+  "#    $ #$#   # #"
+  "#   $    $ $ $ #"
+  "#####  #########"
+  "  #      #      "
+  "  #      #      "
+  "  #......#      "
+  "  #......#      "
+  "  #......#      "
+  "  ########      ")
+
+(defmaze
+  "          #######"
+  "          #  ...#"
+  "      #####  ...#"
+  "      #      . .#"
+  "      #  ##  ...#"
+  "      ## ##  ...#"
+  "     ### ########"
+  "     # $$$ ##    "
+  " #####  $ $ #####"
+  "##   #$ $   #   #"
+  "#@ $  $    $  $ #"
+  "###### $$ $ #####"
+  "     #      #    "
+  "     ########    ")
+
+(defmaze
+  " ###  #############"
+  "##@####       #   #"
+  "# $$   $$  $ $ ...#"
+  "#  $$$#    $  #...#"
+  "# $   # $$ $$ #...#"
+  "###   #  $    #...#"
+  "#     # $ $ $ #...#"
+  "#    ###### ###...#"
+  "## #  #  $ $  #...#"
+  "#  ## # $$ $ $##..#"
+  "# ..# #  $      #.#"
+  "# ..# # $$$ $$$ #.#"
+  "##### #       # #.#"
+  "    # ######### #.#"
+  "    #           #.#"
+  "    ###############")
+
+(defmaze
+  "          ####     "
+  "     #### #  #     "
+  "   ### @###$ #     "
+  "  ##      $  #     "
+  " ##  $ $$## ##     "
+  " #  #$##     #     "
+  " # # $ $$ # ###    "
+  " #   $ #  # $ #####"
+  "####    #  $$ #   #"
+  "#### ## $         #"
+  "#.    ###  ########"
+  "#.. ..# ####       "
+  "#...#.#            "
+  "#.....#            "
+  "#######            ")
+
+(defmaze
+  "################ "
+  "#              # "
+  "# # ######     # "
+  "# #  $ $ $ $#  # "
+  "# #   $@$   ## ##"
+  "# #  $ $ $###...#"
+  "# #   $ $  ##...#"
+  "# ###$$$ $ ##...#"
+  "#     # ## ##...#"
+  "#####   ## ##...#"
+  "    #####     ###"
+  "        #     #  "
+  "        #######  ")
+
+(defmaze
+  "   #########       "
+  "  ##   ##  ######  "
+  "###     #  #    ###"
+  "#  $ #$ #  #  ... #"
+  "# # $#@$## # #.#. #"
+  "#  # #$  #    . . #"
+  "# $    $ # # #.#. #"
+  "#   ##  ##$ $ . . #"
+  "# $ #   #  #$#.#. #"
+  "## $  $   $  $... #"
+  " #$ ######    ##  #"
+  " #  #    ##########"
+  " ####              ")
+
+(defmaze
+  "       #######    "
+  " #######     #    "
+  " #     # $@$ #    "
+  " #$$ #   #########"
+  " # ###......##   #"
+  " #   $......## # #"
+  " # ###......     #"
+  "##   #### ### #$##"
+  "#  #$   #  $  # # "
+  "#  $ $$$  # $## # "
+  "#   $ $ ###$$ # # "
+  "#####     $   # # "
+  "    ### ###   # # "
+  "      #     #   # "
+  "      ########  # "
+  "             #### ")
+
+(defmaze
+  "   ########      "
+  "   #   #  #      "
+  "   #  $   #      "
+  " ### #$   ####   "
+  " #  $  ##$   #   "
+  " #  # @ $ # $#   "
+  " #  #      $ ####"
+  " ## ####$##     #"
+  " # $#.....# #   #"
+  " #  $..*$. $# ###"
+  "##  #.....#   #  "
+  "#   ### #######  "
+  "# $$  #  #       "
+  "#  #     #       "
+  "######   #       "
+  "     #####       ")
+
+(defmaze
+  "#####         "
+  "#   ##        "
+  "#    #  ####  "
+  "# $  ####  #  "
+  "#  $$ $   $#  "
+  "###@ #$    ## "
+  " #  ##  $ $ ##"
+  " # $  ## ## .#"
+  " #  #$##$  #.#"
+  " ###   $..##.#"
+  "  #    #.*...#"
+  "  # $$ #.....#"
+  "  #  #########"
+  "  #  #        "
+  "  ####        ")
+
+(defmaze
+  "   ##########   "
+  "   #..  #   #   "
+  "   #..      #   "
+  "   #..  #  #### "
+  "  #######  #  ##"
+  "  #            #"
+  "  #  #  ##  #  #"
+  "#### ##  #### ##"
+  "#  $  ##### #  #"
+  "# # $  $  # $  #"
+  "# @$  $   #   ##"
+  "#### ## ####### "
+  "   #    #       "
+  "   ######       ")
+
+(defmaze
+  "     ###########   "
+  "     #  .  #   #   "
+  "     # #.    @ #   "
+  " ##### ##..# ####  "
+  "##  # ..###     ###"
+  "# $ #...   $ #  $ #"
+  "#    .. ##  ## ## #"
+  "####$##$# $ #   # #"
+  "  ## #    #$ $$ # #"
+  "  #  $ # #  # $## #"
+  "  #               #"
+  "  #  ###########  #"
+  "  ####         ####")
+
+(defmaze
+  "  ######           "
+  "  #   @####        "
+  "##### $   #        "
+  "#   ##    ####     "
+  "# $ #  ##    #     "
+  "# $ #  ##### #     "
+  "## $  $    # #     "
+  "## $ $ ### # #     "
+  "## #  $  # # #     "
+  "## # #$#   # #     "
+  "## ###   # # ######"
+  "#  $  #### # #....#"
+  "#    $    $   ..#.#"
+  "####$  $# $   ....#"
+  "#       #  ## ....#"
+  "###################")
+
+(defmaze
+  "    ##########     "
+  "#####        ####  "
+  "#     #   $  #@ #  "
+  "# #######$####  ###"
+  "# #    ## #  #$ ..#"
+  "# # $     #  #  #.#"
+  "# # $  #     #$ ..#"
+  "# #  ### ##     #.#"
+  "# ###  #  #  #$ ..#"
+  "# #    #  ####  #.#"
+  "# #$   $  $  #$ ..#"
+  "#    $ # $ $ #  #.#"
+  "#### $###    #$ ..#"
+  "   #    $$ ###....#"
+  "   #      ## ######"
+  "   ########        ")
+
+(defmaze
+  "#########      "
+  "#       #      "
+  "#       ####   "
+  "## #### #  #   "
+  "## #@##    #   "
+  "# $$$ $  $$#   "
+  "#  # ## $  #   "
+  "#  # ##  $ ####"
+  "####  $$$ $#  #"
+  " #   ##   ....#"
+  " # #   # #.. .#"
+  " #   # # ##...#"
+  " ##### $  #...#"
+  "     ##   #####"
+  "      #####    ")
+
+(defmaze
+  "######     ####    "
+  "#    #######  #####"
+  "#   $#  #  $  #   #"
+  "#  $  $  $ # $ $  #"
+  "##$ $   # @# $    #"
+  "#  $ ########### ##"
+  "# #   #.......# $# "
+  "# ##  # ......#  # "
+  "# #   $........$ # "
+  "# # $ #.... ..#  # "
+  "#  $ $####$#### $# "
+  "# $   ### $   $  ##"
+  "# $     $ $  $    #"
+  "## ###### $ ##### #"
+  "#         #       #"
+  "###################")
+
+(defmaze
+  "    #######        "
+  "    #  #  ####     "
+  "##### $#$ #  ##    "
+  "#.. #  #  #   #    "
+  "#.. # $#$ #  $#### "
+  "#.  #     #$  #  # "
+  "#..   $#  # $    # "
+  "#..@#  #$ #$  #  # "
+  "#.. # $#     $#  # "
+  "#.. #  #$$#$  #  ##"
+  "#.. # $#  #  $#$  #"
+  "#.. #  #  #   #   #"
+  "##. ####  #####   #"
+  " ####  ####   #####")
+
+(defmaze
+  "###############    "
+  "#..........  .#### "
+  "#..........$$.#  # "
+  "###########$ #   ##"
+  "#      $  $     $ #"
+  "## ####   #  $ #  #"
+  "#      #   ##  # ##"
+  "#  $#  # ##  ### ##"
+  "# $ #$###    ### ##"
+  "###  $ #  #  ### ##"
+  "###    $ ## #  # ##"
+  " # $  #  $  $ $   #"
+  " #  $  $#$$$  #   #"
+  " #  #  $      #####"
+  " # @##  #  #  #    "
+  " ##############    ")
+
+(defmaze
+  "####               "
+  "#  ##############  "
+  "#  #   ..#......#  "
+  "#  # # ##### ...#  "
+  "##$#    ........#  "
+  "#   ##$######  ####"
+  "# $ #     ######@ #"
+  "##$ # $   ######  #"
+  "#  $ #$$$##       #"
+  "#      #    #$#$###"
+  "# #### #$$$$$    # "
+  "# #    $     #   # "
+  "# #   ##        ###"
+  "# ######$###### $ #"
+  "#        #    #   #"
+  "##########    #####")
+
+(defmaze
+  " #######       "
+  " #  #  #####   "
+  "##  #  #...### "
+  "#  $#  #...  # "
+  "# $ #$$ ...  # "
+  "#  $#  #... .# "
+  "#   # $########"
+  "##$       $ $ #"
+  "##  #  $$ #   #"
+  " ######  ##$$@#"
+  "      #      ##"
+  "      ######## ")
+
+(defmaze
+  " ################# "
+  " #...   #    #   ##"
+  "##.....  $## # #$ #"
+  "#......#  $  #    #"
+  "#......#  #  # #  #"
+  "######### $  $ $  #"
+  "  #     #$##$ ##$##"
+  " ##   $    # $    #"
+  " #  ## ### #  ##$ #"
+  " # $ $$     $  $  #"
+  " # $    $##$ ######"
+  " #######  @ ##     "
+  "       ######      ")
+
+(defmaze
+  "         #####   "
+  "     #####   #   "
+  "    ## $  $  ####"
+  "##### $  $ $ ##.#"
+  "#       $$  ##..#"
+  "#  ###### ###.. #"
+  "## #  #    #... #"
+  "# $   #    #... #"
+  "#@ #$ ## ####...#"
+  "####  $ $$  ##..#"
+  "   ##  $ $  $...#"
+  "    # $$  $ #  .#"
+  "    #   $ $  ####"
+  "    ######   #   "
+  "         #####   ")
+
+(defmaze
+  "#####              "
+  "#   ##             "
+  "# $  #########     "
+  "## # #       ######"
+  "## #   $#$#@  #   #"
+  "#  #      $ #   $ #"
+  "#  ### ######### ##"
+  "#  ## ..*..... # ##"
+  "## ## *.$..$.$ # ##"
+  "# $########## ##$ #"
+  "#  $   $  $    $  #"
+  "#  #   #   #   #  #"
+  "###################")
+
+(defmaze
+  "       ########### "
+  "       #   #     # "
+  "#####  #     $ $ # "
+  "#   ##### $## # ## "
+  "# $ ##   # ## $  # "
+  "# $  @$$ # ##$$$ # "
+  "## ###   # ##    # "
+  "## #   ### #####$# "
+  "## #     $  #....# "
+  "#  ### ## $ #....##"
+  "# $   $ #   #..$. #"
+  "#  ## $ #  ##.... #"
+  "#####   ######...##"
+  "    #####    ##### ")
+
+(defmaze
+  "  ####            "
+  "  #  #########    "
+  " ##  ##  #   #    "
+  " #  $# $@$   #### "
+  " #$  $  # $ $#  ##"
+  "##  $## #$ $     #"
+  "#  #  # #   $$$  #"
+  "# $    $  $## ####"
+  "# $ $ #$#  #  #   "
+  "##  ###  ###$ #   "
+  " #  #....     #   "
+  " ####......####   "
+  "   #....####      "
+  "   #...##         "
+  "   #...#          "
+  "   #####          ")
+
+(defmaze
+  "      ####   "
+  "  #####  #   "
+  " ##     $#   "
+  "## $  ## ### "
+  "#@$ $ # $  # "
+  "#### ##   $# "
+  " #....#$ $ # "
+  " #....#   $# "
+  " #....  $$ ##"
+  " #... # $   #"
+  " ######$ $  #"
+  "      #   ###"
+  "      #$ ### "
+  "      #  #   "
+  "      ####   ")
+
+(defmaze
+  "############"
+  "##     ##  #"
+  "##   $   $ #"
+  "#### ## $$ #"
+  "#   $ #    #"
+  "# $$$ # ####"
+  "#   # # $ ##"
+  "#  #  #  $ #"
+  "# $# $#    #"
+  "#   ..# ####"
+  "####.. $ #@#"
+  "#.....# $# #"
+  "##....#  $ #"
+  "###..##    #"
+  "############")
+
+(defmaze
+  " #########    "
+  " #....   ##   "
+  " #.#.#  $ ##  "
+  "##....# # @## "
+  "# ....#  #  ##"
+  "#     #$ ##$ #"
+  "## ###  $    #"
+  " #$  $ $ $#  #"
+  " # #  $ $ ## #"
+  " #  ###  ##  #"
+  " #    ## ## ##"
+  " #  $ #  $  # "
+  " ###$ $   ### "
+  "   #  #####   "
+  "   ####       ")
+
+(defmaze
+  "############ ######"
+  "#   #    # ###....#"
+  "#   $$#   @  .....#"
+  "#   # ###   # ....#"
+  "## ## ###  #  ....#"
+  " # $ $     # # ####"
+  " #  $ $##  #      #"
+  "#### #  #### # ## #"
+  "#  # #$   ## #    #"
+  "# $  $  # ## #   ##"
+  "# # $ $    # #   # "
+  "#  $ ## ## # ##### "
+  "# $$     $$  #     "
+  "## ## ### $  #     "
+  " #    # #    #     "
+  " ###### ######     ")
+
+(defmaze
+  "            #####  "
+  "#####  ######   #  "
+  "#   ####  $ $ $ #  "
+  "# $   ## ## ##  ## "
+  "#   $ $     $  $ # "
+  "### $  ## ##     ##"
+  "  # ##### #####$$ #"
+  " ##$##### @##     #"
+  " # $  ###$### $  ##"
+  " # $  #   ###  ### "
+  " # $$ $ #   $$ #   "
+  " #     #   ##  #   "
+  " #######.. .###    "
+  "    #.........#    "
+  "    #.........#    "
+  "    ###########    ")
+
+(defmaze
+  "###########        "
+  "#......   #########"
+  "#......   #  ##   #"
+  "#..### $    $     #"
+  "#... $ $ #   ##   #"
+  "#...#$#####    #  #"
+  "###    #   #$  #$ #"
+  "  #  $$ $ $  $##  #"
+  "  #  $   #$#$ ##$ #"
+  "  ### ## #    ##  #"
+  "   #  $ $ ## ######"
+  "   #    $  $  #    "
+  "   ##   # #   #    "
+  "    #####@#####    "
+  "        ###        ")
+
+(defmaze
+  "      #### "
+  "####### @# "
+  "#     $  # "
+  "#   $## $# "
+  "##$#...# # "
+  " # $...  # "
+  " # #. .# ##"
+  " #   # #$ #"
+  " #$  $    #"
+  " #  #######"
+  " ####      ")
+
+(defmaze
+  "             ######"
+  " #############....#"
+  "##   ##     ##....#"
+  "#  $$##  $ @##....#"
+  "#      $$ $#  ....#"
+  "#  $ ## $$ # # ...#"
+  "#  $ ## $  #  ....#"
+  "## ##### ### ##.###"
+  "##   $  $ ##   .  #"
+  "# $###  # ##### ###"
+  "#   $   #       #  "
+  "#  $ #$ $ $###  #  "
+  "# $$$# $   # ####  "
+  "#    #  $$ #       "
+  "######   ###       "
+  "     #####         ")
+
+(defmaze
+  "    ############ "
+  "    #          ##"
+  "    #  # #$$ $  #"
+  "    #$ #$#  ## @#"
+  "   ## ## # $ # ##"
+  "   #   $ #$  # # "
+  "   #   # $   # # "
+  "   ## $ $   ## # "
+  "   #  #  ##  $ # "
+  "   #    ## $$# # "
+  "######$$   #   # "
+  "#....#  ######## "
+  "#.#... ##        "
+  "#....   #        "
+  "#....   #        "
+  "#########        ")
+
+(defmaze
+  "           #####   "
+  "          ##   ##  "
+  "         ##     #  "
+  "        ##  $$  #  "
+  "       ## $$  $ #  "
+  "       # $    $ #  "
+  "####   #   $$ #####"
+  "#  ######## ##    #"
+  "#.            $$$@#"
+  "#.# ####### ##   ##"
+  "#.# #######. #$ $##"
+  "#........... #    #"
+  "##############  $ #"
+  "             ##  ##"
+  "              #### ")
+
+(defmaze
+  "     ########     "
+  "  ####      ######"
+  "  #    ## $ $   @#"
+  "  # ## ##$#$ $ $##"
+  "### ......#  $$ ##"
+  "#   ......#  #   #"
+  "# # ......#$  $  #"
+  "# #$...... $$# $ #"
+  "#   ### ###$  $ ##"
+  "###  $  $  $  $ # "
+  "  #  $  $  $  $ # "
+  "  ######   ###### "
+  "       #####      ")
+
+(defmaze
+  "        #######    "
+  "    #####  #  #### "
+  "    #   #   $    # "
+  " #### #$$ ## ##  # "
+  "##      # #  ## ###"
+  "#  ### $#$  $  $  #"
+  "#...    # ##  #   #"
+  "#...#    @ # ### ##"
+  "#...#  ###  $  $  #"
+  "######## ##   #   #"
+  "          #########")
+
+(defmaze
+  " #####             "
+  " #   #             "
+  " # # #######       "
+  " #      $@######   "
+  " # $ ##$ ###   #   "
+  " # #### $    $ #   "
+  " # ##### #  #$ ####"
+  "##  #### ##$      #"
+  "#  $#  $  # ## ## #"
+  "#         # #...# #"
+  "######  ###  ...  #"
+  "     #### # #...# #"
+  "          # ### # #"
+  "          #       #"
+  "          #########")
+
+(defmaze
+  "##### ####      "
+  "#...# #  ####   "
+  "#...###  $  #   "
+  "#....## $  $### "
+  "##....##   $  # "
+  "###... ## $ $ # "
+  "# ##    #  $  # "
+  "#  ## # ### ####"
+  "# $ # #$  $    #"
+  "#  $ @ $    $  #"
+  "#   # $ $$ $ ###"
+  "#  ######  ###  "
+  "# ##    ####    "
+  "###             ")
+
+(defmaze
+  "##########    "
+  "#        #### "
+  "# ###### #  ##"
+  "# # $ $ $  $ #"
+  "#       #$   #"
+  "###$  $$#  ###"
+  "  #  ## # $## "
+  "  ##$#   $ @# "
+  "   #  $ $ ### "
+  "   # #   $  # "
+  "   # ##   # # "
+  "  ##  ##### # "
+  "  #         # "
+  "  #.......### "
+  "  #.......#   "
+  "  #########   ")
+
+(defmaze
+  "         ####     "
+  " #########  ##    "
+  "##  $      $ #####"
+  "#   ## ##   ##...#"
+  "# #$$ $ $$#$##...#"
+  "# #   @   #   ...#"
+  "#  $# ###$$   ...#"
+  "# $  $$  $ ##....#"
+  "###$       #######"
+  "  #  #######      "
+  "  ####            ")
+
+(defmaze
+  "  #########  "
+  "  #*.$#$.$#  "
+  "  #.*.$.$.#  "
+  "  #*.$.$.$#  "
+  "  #.*.$.$.#  "
+  "  #*.$.$.$#  "
+  "  ###   ###  "
+  "    #   #    "
+  "###### ######"
+  "#           #"
+  "# $ $ $ $ $ #"
+  "## $ $ $ $ ##"
+  " #$ $ $ $ $# "
+  " #   $@$   # "
+  " #  #####  # "
+  " ####   #### ")
+
+(defmaze
+  "       ####     "
+  "       #  ##    "
+  "       #   ##   "
+  "       # $$ ##  "
+  "     ###$  $ ## "
+  "  ####    $   # "
+  "###  # #####  # "
+  "#    # #....$ # "
+  "# #   $ ....# # "
+  "#  $ # #.*..# # "
+  "###  #### ### # "
+  "  #### @$  ##$##"
+  "     ### $     #"
+  "       #  ##   #"
+  "       #########")
+
+(defmaze
+  "      ############ "
+  "     ##..    #   # "
+  "    ##..* $    $ # "
+  "   ##..*.# # # $## "
+  "   #..*.# # # $  # "
+  "####...#  #    # # "
+  "#  ## #          # "
+  "# @$ $ ###  #   ## "
+  "# $   $   # #   #  "
+  "###$$   # # # # #  "
+  "  #   $   # # #####"
+  "  # $# #####      #"
+  "  #$   #   #    # #"
+  "  #  ###   ##     #"
+  "  #  #      #    ##"
+  "  ####      ###### ")
+
+
+
+(setf *mazes* (nreverse *mazes*))

examples/7-Sokoban/3rd-party/sokoban.lisp

@@ -0,0 +1,101 @@
+(defpackage :cl-sokoban
+  (:nicknames :sokoban)
+  (:use :cl)
+  (:export #:*mazes*
+           #:*rules*
+           #:maze #:maze-player #:maze-dimensions #:maze-text
+           #:copy-maze
+           #:simple-ui
+           #:move
+           #:defmaze))
+
+(in-package :cl-sokoban)
+
+(defvar *mazes* nil
+  "A list of two-dimensional character arrays, describing Sokoban puzzles.")
+
+(defvar *rules*
+  '(("@ " " @")
+    ("@." " &")
+    ("& " ".@")
+    ("&." ".&")
+    ("@$ " " @$")
+    ("@$." " @*")
+    ("&$ " ".@$")
+    ("&$." ".@*")
+    ("@* " " &$")
+    ("@*." " &*")
+    ("&* " ".&$")
+    ("&*." ".&*"))
+  "A list of textual transformation rules that the cl-sokoban mover steps
+through.  A rule has the format (\"from\" \" to \"); when \"from\" matches
+the maze, \" to \" replaces it in the maze.")
+
+(defstruct (maze :named (:type vector) (:copier nil))
+  player
+  dimensions
+  text)
+(defun copy-maze (maze)
+  (make-maze :player (maze-player maze)
+             :dimensions (maze-dimensions maze)
+             :text (mapcar #'copy-seq (maze-text maze))))
+
+(defun simple-ui ()
+  (do ((input "" (read-line)))
+      ((search "q" input))
+    (cond ((search "n" input) (move :north (first *mazes*)))
+          ((search "e" input) (move :east (first *mazes*)))
+          ((search "w" input) (move :west (first *mazes*)))
+          ((search "s" input) (move :south (first *mazes*))))
+    (format t "~{~&~A~%~}" (maze-text (first *mazes*)))))
+
+(defun find-player (rows)
+  (loop for y from 0
+       for row in rows
+       for x? = (or (position #\@ row)
+                    (position #\& row))
+       when x? return (cons x? y)
+       finally (error "Maze lacks a player (@): ~S" rows)))
+
+(defun move (direction maze)
+  (loop for (from to) in *rules*
+     when (string= from (lookahead (length from) direction maze))
+     do (return (setahead to direction maze))))
+
+(defun move-point (location direction)
+  (case direction
+    (:east (cons (1+ (car location)) (cdr location)))
+    (:west (cons (1- (car location)) (cdr location)))
+    (:north (cons (car location) (1- (cdr location))))
+    (:south (cons (car location) (1+ (cdr location))))))
+
+(defun off-maze-p (location maze)
+  (destructuring-bind (x . y) (maze-dimensions maze)
+    (or (>= (car location) x)
+        (>= (cdr location) y)
+        (< (car location) 0)
+        (< (cdr location) 0))))
+
+(defun lookahead (distance direction maze)
+  (do ((location (maze-player maze) (move-point location direction))
+       (index 0 (1+ index))
+       (chars nil (cons (elt (elt (maze-text maze) (cdr location))
+                             (car location))
+                        chars)))
+      ((or (= index distance)
+           (off-maze-p location maze))
+       (coerce (reverse chars) 'string))))
+
+(defun setahead (string direction maze)
+  (loop for char across string
+     for location = (maze-player maze) then (move-point location direction)
+     do (let ((row (elt (maze-text maze) (cdr location))))
+          (setf (elt row (car location)) char)))
+  (setf (maze-player maze) (find-player (maze-text maze))))
+
+(defun defmaze (&rest rows)
+  (push (make-maze :text rows
+                   :dimensions (cons (length (first rows))
+                                     (length rows))
+                   :player (find-player rows))
+        *mazes*))

examples/7-Sokoban/eql-sokoban.lisp

@@ -0,0 +1,197 @@
+;;; This is a simple GUI for CL-Sokoban, see http://www.cliki.net/CL-Sokoban 
+;;;
+;;; ------------------------------------------------------------------------
+;;;
+;;; IMPORTANT NOTE
+;;;
+;;; If you use one of: QGraphicsSvgItem, QGraphicsTextItem, QGraphicsWidget
+;;; you need a "cast" in order to call QGraphicsItem methods:
+;;;
+;;;   (! "setPos" ("QGraphicsItem" graphics-text-item) '(0 0)))
+;;;
+;;; (because of multiple inheritance from both QObject and QGraphicsItem)
+;;;
+;;; If you use the wrapper functions instead (see "src/lisp/all-wrappers"),
+;;; this cast is done automatically:
+;;;
+;;;   (|setPos| graphics-text-item '(0 0)))
+;;;
+;;; ------------------------------------------------------------------------
+
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+(load (eql:in-home "examples/7-Sokoban/3rd-party/sokoban"))
+(load (eql:in-home "examples/7-Sokoban/3rd-party/levels"))
+
+(defpackage :eql-sokoban
+  (:use :common-lisp :eql)
+  (:export
+   #:start))
+
+(in-package :eql-sokoban)
+
+(defconstant +item-types+ '((#\# . :wall)
+                            (#\$ . :object)
+                            (#\* . :object2)
+                            (#\. . :goal)
+                            (#\@ . :player)
+                            (#\& . :player2)))
+
+(defparameter *items*           nil)
+(defparameter *item-size*       nil)
+(defparameter *maze*            nil)
+(defparameter *my-mazes*        (mapcar 'sokoban:copy-maze sokoban:*mazes*))
+(defparameter *scene-size*      '(650 550))
+(defparameter *print-text-maze* nil "additionally print maze to terminal")
+
+(defvar *scene* (qnew "QGraphicsScene"
+                      "sceneRect" (append '(0 0) *scene-size*)
+                      "backgroundBrush" (qnew "QBrush(QColor)" "#DED6AD")))
+(defvar *view*  (qnew "QGraphicsView"
+                      "windowTitle" "Sokoban"
+                      "size" (mapcar (lambda (x) (+ 50 x)) *scene-size*)))
+(defvar *level* (qnew "QSlider(Qt::Orientation)" |Qt.Vertical|
+                      "tickInterval" 5
+                      "tickPosition" |QSlider.TicksRight|
+                      "maximum" (1- (length *my-mazes*))))
+
+(defun assoc* (item alist)
+  (cdr (assoc item alist)))
+
+(defun char-type (char)
+  (cdr (assoc char +item-types+)))
+
+(defun type-char (type)
+  (car (find type +item-types+ :key 'cdr)))
+
+(defun ini ()
+  (x:do-with *view*
+    (|setScene| *scene*)
+    (|setRenderHint| |QPainter.Antialiasing|)
+    (|setCacheMode| |QGraphicsView.CacheBackground|)
+    (|setViewportUpdateMode| |QGraphicsView.BoundingRectViewportUpdate|))
+  (let ((zoom-in  (qnew "QToolButton"
+                        "text" "Zoom In"))
+        (zoom-out (qnew "QToolButton"
+                        "text" "Zoom Out"))
+        (main     (qnew "QWidget"
+                        "windowTitle" "Sokoban"
+                        "size" (|size| *view*)))
+        (help     (qnew "QLabel"
+                        "text" "<b>Arrows</b> = Move, <b>N</b> = Next, <b>P</b> = Previous, <b>R</b> = Restart"))
+        (hbox1    (qnew "QHBoxLayout"))
+        (hbox2    (qnew "QHBoxLayout"))
+        (layout   (qnew "QVBoxLayout")))
+    (dolist (w (list *level* *view*))
+      (|addWidget| hbox1 w))
+    (dolist (w (list zoom-in zoom-out help))
+      (|addWidget| hbox2 w))
+    (dolist (l (list hbox1 hbox2))
+      (!"addLayout" layout l))
+    (|setStretchFactor| hbox2 help 1)
+    (|setLayout| main layout)
+    (qconnect *level* "valueChanged(int)" (lambda (val) (set-maze) (draw)))
+    (qconnect zoom-in  "clicked()" (lambda () (zoom :in)))
+    (qconnect zoom-out "clicked()" (lambda () (zoom :out)))
+    (qadd-event-filter nil |QEvent.KeyPress| 'key-pressed)
+    (x:do-with main |show| |raise|)))
+
+(defun set-maze ()
+  (setf *maze* (nth (|value| *level*) *my-mazes*))
+  (create-items)
+  (draw-items :wall))
+
+(defun clear-items ()
+  (|clear| *scene*)
+  (setf *items* (mapcar (lambda (x) (list (cdr x))) +item-types+)))
+
+(defun create-items ()
+  (clear-items)
+  (flet ((add (types)
+           (dolist (type (x:ensure-list types))
+             (let ((item (create-item type)))
+               (push item (cdr (assoc type *items*)))
+               (|addItem| *scene* item)))))
+    (dolist (row (sokoban:maze-text *maze*))
+      (x:do-string (char row)
+        (unless (char= #\Space char)
+          (let ((type (char-type char)))
+            (cond ((find type '(:player :player2))
+                   (add '(:player :player2)))
+                  ((find type '(:object :object2))
+                   (add '(:object :object2 :goal)))
+                  ((eql :wall type)
+                   (add :wall)))))))))
+
+(let (pixmaps)
+  (defun create-item (type)
+    (let* ((char (type-char type))
+           (file (in-home (format nil "examples/7-Sokoban/pics/~(~A~).png" type)))
+           (pixmap (cdr (or (assoc file pixmaps :test 'string=)
+                            (first (push (cons file (qnew "QPixmap(QString)" file))
+                                         pixmaps)))))
+           (item (qnew "QGraphicsPixmapItem(QPixmap)" pixmap)))
+      (unless *item-size*
+        (setf *item-size* (cddr (|boundingRect| item))))
+      item)))
+
+(defun key-pressed (obj event)
+  (flet ((change-level (x)
+           (|setValue| *level* (+ x (|value| *level*)))))
+    (case (|key| event)
+      (#.|Qt.Key_Up|
+         (sokoban:move :north *maze*))
+      (#.|Qt.Key_Down|
+         (sokoban:move :south *maze*))
+      (#.|Qt.Key_Left|
+         (sokoban:move :west *maze*))
+      (#.|Qt.Key_Right|
+         (sokoban:move :east *maze*))
+      (#.|Qt.Key_N|
+         (change-level 1))
+      (#.|Qt.Key_P|
+         (change-level -1))
+      (#.|Qt.Key_R|
+         (let ((level (|value| *level*)))
+           (setf (nth level *my-mazes*)
+                 (sokoban:copy-maze (nth level sokoban:*mazes*)))
+           (set-maze)))
+      (t (return-from key-pressed)))
+    (draw)
+    t)) ; event filter
+
+(defun draw-items (type)
+  (let ((char (type-char type))
+        (items (assoc* type *items*))
+        (y 0))
+    (unless (eql :wall type)
+      (dolist (item items)
+        (|setVisible| item nil)))
+    (dolist (row (sokoban:maze-text *maze*))
+      (let ((x 0))
+        (x:do-string (curr-char row)
+          (when (char= char curr-char)
+            (let ((item (first items)))
+              (|setPos| item (list x y))
+              (|setVisible| item t))
+            (setf items (rest items)))
+          (incf x (first *item-size*))))
+      (incf y (second *item-size*)))))
+  
+(defun draw ()
+  (dolist (type '(:player :object :goal :player2 :object2))
+    (draw-items type))
+  (when *print-text-maze*
+    (format t "~{~&~A~%~}" (sokoban:maze-text *maze*))))
+
+(defun zoom (direction)
+  (let ((f (if (eql :in direction) 3/2 2/3)))
+    (|scale| *view* f f)))
+
+(defun start ()
+  (ini)
+  (set-maze)
+  (draw))
+
+(start)

examples/8-OpenGL/README.txt

@@ -0,0 +1,3 @@
+You'll need cl-opengl (see Quicklisp)
+
+Run it: eql run.lisp

examples/8-OpenGL/gl-widget.lisp

@@ -0,0 +1,201 @@
+;;; This is a port of the Qt OpenGL Example "Grabber"
+
+(defpackage :gl-widget
+  (:use :common-lisp :eql)
+  (:export
+   #:*gl-widget*
+   #:*timer*
+   #:*x-rotation-changed*
+   #:*y-rotation-changed*
+   #:*z-rotation-changed*
+   #:ini-gl-widget
+   #:set-x-rotation
+   #:set-y-rotation
+   #:set-z-rotation))
+
+(provide :gl-widget)
+
+(in-package :gl-widget)
+
+(defconstant +360+ (* 360 16))
+
+(defvar *gl-widget* (qnew "QGLWidget"))
+(defvar *timer*     (qnew "QTimer"))
+
+(defparameter *gear1*     0)
+(defparameter *gear2*     0)
+(defparameter *gear3*     0)
+(defparameter *x-rot*     0)
+(defparameter *y-rot*     0)
+(defparameter *z-rot*     0)
+(defparameter *gear1-rot* 0)
+(defparameter *last-pos*  (list 0 0))
+
+(defparameter *x-rotation-changed* nil)
+(defparameter *y-rotation-changed* nil)
+(defparameter *z-rotation-changed* nil)
+
+(defun ini-gl-widget ()
+  (x:do-with (qoverride *gl-widget*)
+    ("initializeGL()"                'initialize-gl)
+    ("paintGL()"                     'paint-gl)
+    ("resizeGL(int,int)"             'resize-gl)
+    ("mousePressEvent(QMouseEvent*)" 'mouse-press-event)
+    ("mouseMoveEvent(QMouseEvent*)"  'mouse-move-event))
+  (qconnect *timer* "timeout()" 'advance-gears)
+  (|start| *timer* 20))
+
+(defmacro set-rotation (axis)
+  (flet ((axis-symbol (frm)
+           (intern (format nil frm axis))))
+    (let ((rot     (axis-symbol "*~A-ROT*"))
+          (changed (axis-symbol "*~A-ROTATION-CHANGED*")))
+      `(defun ,(axis-symbol "SET-~A-ROTATION") (angle)
+         (setf angle (normalize-angle angle))
+         (when (/= angle ,rot)
+           (setf ,rot angle)
+           (when ,changed
+             (funcall ,changed angle))
+           (|updateGL| *gl-widget*))))))
+
+(set-rotation :x)
+(set-rotation :y)
+(set-rotation :z)
+
+(defun initialize-gl ()
+  (gl:light :light0 :position #(5 5 10 1))
+  (gl:enable :lighting)
+  (gl:enable :light0)
+  (gl:enable :depth-test)
+  (setf *gear1* (make-gear #(0.8 0.1 0.0 1.0) 1.0 4.0 1.0 0.7 20)
+        *gear2* (make-gear #(0.0 0.8 0.2 1.0) 0.5 2.0 2.0 0.7 10)
+        *gear3* (make-gear #(0.2 0.2 1.0 1.0) 1.3 2.0 0.5 0.7 10))
+  (gl:enable :normalize)
+  (gl:clear-color 0 0 0 1))
+
+(defun paint-gl ()
+  (gl:clear :color-buffer :depth-buffer)
+  (gl:push-matrix)
+  (gl:rotate (/ *x-rot* 16) 1 0 0)
+  (gl:rotate (/ *y-rot* 16) 0 1 0)
+  (gl:rotate (/ *z-rot* 16) 0 0 1)
+  (draw-gear *gear1* -3.0 -2.0 0.0 (/ *gear1-rot* 16))
+  (draw-gear *gear2*  3.1 -2.0 0.0 (- (* -2 (/ *gear1-rot* 16)) 9))
+  (gl:rotate 90 1 0 0)
+  (draw-gear *gear3* -3.1 -1.8 -2.2 (- (* 2 (/ *gear1-rot* 16)) 2))
+  (gl:pop-matrix))
+
+(defun resize-gl (width height)
+  (if (|isVisible| *gl-widget*) ; needed in OSX
+      (let ((side (min width height)))
+        (gl:viewport (/ (- width side) 2) (/ (- height side) 2) side side)
+        (gl:matrix-mode :projection)
+        (gl:load-identity)
+        (gl:frustum -1 1 -1 1 5 60)
+        (gl:matrix-mode :modelview)
+        (gl:load-identity)
+        (gl:translate 0 0 -40))
+      (qlater (lambda () (apply 'resize-gl (|size| *gl-widget*))))))
+
+(defun mouse-press-event (event)
+  (setf *last-pos* (|pos| event)))
+
+(defun mouse-move-event (event)
+  (let ((dx (- (|x| event) (first  *last-pos*)))
+        (dy (- (|y| event) (second *last-pos*)))
+        (buttons (|buttons| event)))
+    (flet ((button (enum)
+             (plusp (logand enum buttons))))
+      (cond ((button |Qt.LeftButton|)
+             (set-x-rotation (+ *x-rot* (* 8 dy)))
+             (set-y-rotation (+ *y-rot* (* 8 dx))))
+            ((button |Qt.RightButton|)
+             (set-x-rotation (+ *x-rot* (* 8 dy)))
+             (set-z-rotation (+ *z-rot* (* 8 dx)))))
+      (setf *last-pos* (|pos| event)))))
+
+(defun advance-gears ()
+  (incf *gear1-rot* (* 2 16))
+  (|updateGL| *gl-widget*))
+
+(defun make-gear (reflectance inner-radius outer-radius thickness tooth-size tooth-count)
+  (let ((list (gl:gen-lists 1))
+        (r0 inner-radius)
+        (r1 (- outer-radius (/ tooth-size 2)))
+        (r2 (+ outer-radius (/ tooth-size 2)))
+        (delta (/ (/ (* 2 pi) tooth-count) 4))
+        (z (/ thickness 2)))
+    (gl:new-list list :compile)
+    (gl:material :front :ambient-and-diffuse reflectance)
+    (gl:shade-model :flat)
+    (dotimes (i 2)
+      (let ((sign (if (zerop i) 1 -1)))
+        (gl:normal 0 0 sign)
+        (gl:begin :quad-strip)
+        (dotimes (j (1+ tooth-count))
+          (let ((angle (/ (* 2 pi j) tooth-count)))
+            (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* sign z))
+            (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* sign z))
+            (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* sign z))
+            (gl:vertex (* r1 (cos (+ angle (* 3 delta))))
+                       (* r1 (sin (+ angle (* 3 delta))))
+                       (* sign z))))
+        (gl:end)
+        (gl:begin :quads)
+        (dotimes (j tooth-count)
+          (let ((angle (/ (* 2 pi j) tooth-count)))
+            (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* sign z))
+            (gl:vertex (* r2 (cos (+ angle delta)))
+                       (* r2 (sin (+ angle delta)))
+                       (* sign z))
+            (gl:vertex (* r2 (cos (+ angle (* 2 delta))))
+                       (* r2 (sin (+ angle (* 2 delta))))
+                       (* sign z))
+            (gl:vertex (* r1 (cos (+ angle (* 3 delta))))
+                       (* r1 (sin (+ angle (* 3 delta))))
+                       (* sign z))))
+        (gl:end)))
+    (gl:begin :quad-strip)
+    (dotimes (i tooth-count)
+      (dotimes (j 2)
+        (let ((angle (/ (* 2 pi (+ i (/ j 2)))
+                        tooth-count))
+              (s1 r1)
+              (s2 r2))
+          (when (= 1 j)
+            (rotatef s1 s2))
+          (gl:normal (cos angle) (sin angle) 0)
+          (gl:vertex (* s1 (cos angle)) (* s1 (sin angle)) z)
+          (gl:vertex (* s1 (cos angle)) (* s1 (sin angle)) (- z))
+          (gl:normal (- (* s2 (sin (+ angle delta))) (* s1 (sin angle)))
+                     (- (* s1 (cos angle)) (* s2 (cos (+ angle delta))))
+                     0)
+          (gl:vertex (* s2 (cos (+ angle delta))) (* s2 (sin (+ angle delta))) z)
+          (gl:vertex (* s2 (cos (+ angle delta))) (* s2 (sin (+ angle delta))) (- z)))))
+    (gl:vertex r1 0 z)
+    (gl:vertex r1 0 (- z))
+    (gl:end)
+    (gl:shade-model :smooth)
+    (gl:begin :quad-strip)
+    (dotimes (i (1+ tooth-count))
+      (let ((angle (/ (* i 2 pi) tooth-count)))
+        (gl:normal (- (cos angle)) (- (sin angle)) 0)
+        (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) z)
+        (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (- z))))
+    (gl:end)
+    (gl:end-list)
+    list))
+
+(defun draw-gear (gear dx dy dz angle)
+  (gl:push-matrix)
+  (gl:translate dx dy dz)
+  (gl:rotate angle 0 0 1)
+  (gl:call-list gear)
+  (gl:pop-matrix))
+
+(defun normalize-angle (angle)
+  (x:while (minusp angle)
+    (incf angle +360+))
+  (x:while (> angle +360+)
+    (decf angle +360+))
+  angle)

examples/8-OpenGL/main-window.lisp

@@ -0,0 +1,136 @@
+;;; This is a port of the Qt OpenGL Example "Grabber"
+
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+(require :gl-widget (eql:in-home "examples/8-OpenGL/gl-widget"))
+
+(defpackage :main-window
+  (:use :common-lisp :eql :gl-widget)
+  (:export
+   #:start))
+
+(in-package :main-window)
+
+(defvar *me*                (qnew "QMainWindow"))
+(defvar *pixmap-label*      (qnew "QLabel"))
+(defvar *pixmap-label-area* (qnew "QScrollArea"
+                                  "sizePolicy" (qnew "QSizePolicy(QSizePolicy::Policy,QSizePolicy::Policy)"
+                                                     |QSizePolicy.Ignored| |QSizePolicy.Ignored|)
+                                  "minimumSize" '(50 50)))
+
+(defun ini ()
+  (ini-gl-widget)
+  (let ((widget-area    (qnew "QScrollArea"
+                              "widgetResizable" t
+                              "horizontalScrollBarPolicy" |Qt.ScrollBarAlwaysOff|
+                              "verticalScrollBarPolicy"   |Qt.ScrollBarAlwaysOff|
+                              "sizePolicy" (qnew "QSizePolicy(QSizePolicy::Policy,QSizePolicy::Policy)"
+                                                 |QSizePolicy.Ignored| |QSizePolicy.Ignored|)
+                              "minimumSize" (list 50 50)))
+        (central-widget (qnew "QWidget"))
+        (central-layout (qnew "QGridLayout"))
+        (x-slider (create-slider '*x-rotation-changed* 'set-x-rotation))
+        (y-slider (create-slider '*y-rotation-changed* 'set-y-rotation))
+        (z-slider (create-slider '*z-rotation-changed* 'set-z-rotation)))
+    (|setCentralWidget| *me* central-widget)
+    (|setWidget| widget-area *gl-widget*)
+    (|setWidget| *pixmap-label-area* *pixmap-label*)
+    (create-menus)
+    (x:do-with (|addWidget| central-layout)
+      (widget-area         0 0)
+      (*pixmap-label-area* 0 1)
+      (x-slider            1 0 1 2)
+      (y-slider            2 0 1 2)
+      (z-slider            3 0 1 2))
+    (|setLayout| central-widget central-layout)
+    (|setValue| x-slider (* 15  16))
+    (|setValue| y-slider (* 345 16))
+    (|setValue| z-slider 0)
+    (x:do-with *me*
+      (|setWindowTitle| (tr "Grabber"))
+      (|resize| (list 400 300)))))
+
+(defun render-into-pixmap ()
+  (let ((size (get-size)))
+    (when (every 'plusp size)
+      (set-pixmap (|renderPixmap| *gl-widget* (first size) (second size))))))
+
+(defun grab-frame-buffer ()
+  (set-pixmap (|fromImage.QPixmap| (|grabFrameBuffer| *gl-widget*))))
+
+(defun clear-pixmap ()
+  (set-pixmap (qnew "QPixmap")))
+
+(defun about ()
+  (|about.QMessageBox|
+    *me*
+    (tr "About Grabber")
+    (tr "The <b>Grabber</b> example demonstrates two approaches for rendering OpenGL into a Qt pixmap.")))
+
+(defun add-action (menu text shortcut function)
+  (let ((action (|addAction| menu text)))
+    (when shortcut
+      (|setShortcut| action (qnew "QKeySequence(QString)" shortcut)))
+    (qconnect action "triggered()" function)))
+
+(defun create-menus ()
+  (let* ((menu-bar (|menuBar| *me*))
+         (file-menu (|addMenu| menu-bar (tr "&File")))
+         (help-menu (|addMenu| menu-bar (tr "&Help"))))
+    ;; file menu
+    (add-action file-menu (tr "&Render into Pixmap...") "Ctrl+R" 'render-into-pixmap)
+    (add-action file-menu (tr "&Grab Frame Buffer")     "Ctrl+G" 'grab-frame-buffer)
+    (add-action file-menu (tr "&Clear Pixmap")          "Ctrl+L" 'clear-pixmap)
+    (|addSeparator| file-menu)
+    (add-action file-menu (tr "E&xit")                  "Ctrl+Q" (lambda () (|close| *me*)))
+    ;; help menu
+    (add-action help-menu (tr "&About")    nil 'about)
+    (add-action help-menu (tr "About &Qt") nil (lambda () (|aboutQt| (qapp))))))
+
+(defun create-slider (changed setter)
+  (let ((slider (qnew "QSlider(Qt::Orientation)" |Qt.Horizontal|
+                      "minimum"      0
+                      "maximum"      (* 360 16)
+                      "singleStep"   (* 1   16)
+                      "pageStep"     (* 15  16)
+                      "tickInterval" (* 15  16)
+                      "tickPosition" |QSlider.TicksRight|)))
+    (qconnect slider "valueChanged(int)" setter)
+    (setf (symbol-value changed) (lambda (x) (|setValue| slider x)))
+    slider))
+
+(defun set-pixmap (pixmap)
+  (|setPixmap| *pixmap-label* pixmap)
+  (let* ((size (|size| pixmap))
+         (width (first size)))
+    (when (equal (list (1- width) (second size))
+                 (|maximumViewportSize| *pixmap-label-area*))
+      (setf (first size) (1- width)))
+    (|resize| *pixmap-label* size)))
+
+(defun get-size ()
+  (let ((text (|getText.QInputDialog|
+                 *me*
+                 (tr "Grabber")
+                 (tr "Enter pixmap size:")
+                 |QLineEdit.Normal|
+                 (format nil "~{~D~^ x ~}" (|size| *gl-widget*))
+                 nil))) ; ok
+    (if (qok)
+        (progn
+          (qlet ((reg-exp "QRegExp(QString)" "([0-9]+) *x *([0-9]+)"))
+            (flet ((cap (n)
+                     (parse-integer (|cap| reg-exp n))))
+              (when (|exactMatch| reg-exp text)
+                (let ((width  (cap 1))
+                      (height (cap 2)))
+                  (when (and (< 0 width  2048)
+                             (< 0 height 2048))
+                    (return-from get-size (list width height)))))))
+          (|size| *gl-widget*))
+        '(0 0))))
+
+(defun start ()
+  (ini)
+  (x:do-with *me* |show| |raise|))

examples/8-OpenGL/run.lisp

@@ -0,0 +1,11 @@
+#+unix (si::trap-fpe t nil)
+
+(ql:quickload :cl-opengl)
+
+(unless (eql:qrequire :opengl)
+  (error "EQL module :opengl could not be found/loaded")
+  (eql:qq))
+
+(load (eql:in-home "examples/8-OpenGL/main-window"))
+
+(main-window:start)

examples/9-simple-lisp-editor/README.txt

@@ -0,0 +1,83 @@
+NOTES
+=====
+
+This is only an experimental, simple, "scratch buffer" like toy editor.
+
+Run it:
+  
+  0) You'll need the :network module (see QREQUIRE).
+
+  1) Run the independent local Lisp server:
+      eql -norc local-server
+
+  2) Run the editor:
+      eql editor <file>.lisp (defaults to "my.lisp")
+
+The main motivation behind this editor is the need for a popup completer
+for the (huge) Qt library.
+
+The completer works for:
+
+  qnew
+  qlet
+  qset
+  qget
+  qfun
+  qconnect
+  qoverride
+  qfind-child
+
+It tries to be intelligent, for example:
+
+  - it looks for the type (Qt class) for both global and local variables
+  - it automatically cuts optional type lists in Qt function calls (qfun)
+
+
+
+USAGE NOTES
+===========
+
+There's no "New" button; instead, "new.lisp" can be used as simple template.
+
+Please see the context menu of the editor window for generic editor commands
+(offered by Qt, which include some other commands too, like Ctrl+<arrow key>).
+
+"Eval Region" note: (see initial status-bar message)
+Remember to change to the desired package prior to eval anything.
+
+Tab completion note: hitting Tab will pop up a window with symbol completions.
+This works in both the editor and command line widget, at any cursor position.
+Currently, tab completion works for all CL and EQL symbols (including Qt
+enums).
+If the inserted symbol is a function, its argument list (if available) will be
+shown in the status bar.
+Hitting Tab after a " character will show the pathname completer instead (works
+for absolute path names only).
+
+Auto indent note: hitting the Ctrl+Tab keys will auto indent the paragraph
+starting from the current line until the next empty line found.
+
+On errors, the local Lisp server will pop up a debug dialog, asking for an
+ECL debug command (even for internal errors of "local-server.lisp").
+
+If you want to pause/continue the local-server process, use the usual Ctrl+C
+(terminal command) and :c (ECL command).
+(N.B. might not work on Windows).
+
+The "Save and Run" action (Ctrl+R) will load the current code in the local
+Lisp server process (if you don't see the application window, it might be
+in the background. Use your taskbar to show it).
+
+When using "Save and Run", on errors, after the local-server entered the
+debugger, you can enter the ECL debugger command :f, which will send the
+position of the offending region to the editor, and it will be marked red.
+
+Closing & re-opening the editor does not affect the local-server process.
+You may even open multiple editor instances, which will all connect to the
+same local-server.
+
+You can put an ini file ".ini-eql-editor.lisp" in your working directory,
+which will be loaded on startup, having full access to all editor variables
+and functions.
+Example: (! "showMaximized" editor::*main*)
+

examples/9-simple-lisp-editor/data/auto-indent.lisp

@@ -0,0 +1,42 @@
+(mapcar (lambda (x)
+          (if (atom x)
+              (cons (symbol-name x) 2) ; default: 2 spaces
+              (cons (symbol-name (car x)) (cdr x))))
+        '(case
+          ccase
+          ecase
+          typecase
+          ctypecase
+          etypecase
+          handler-bind
+          handler-case
+          catch
+          defun
+          defmacro
+          destructuring-bind
+          do
+          do*
+          dolist
+          dotimes
+          do-all-symbols
+          do-symbols
+          do-with
+          flet
+          labels
+          lambda
+          let
+          let*
+          let-it
+          loop
+          multiple-value-bind
+          qlet
+          unless
+          when
+          with-open-file
+          with-output-to-string
+          ;; package :x
+          do-string
+          when-it
+          when-it*
+          while
+          while-it))

examples/9-simple-lisp-editor/data/editor.ui

@@ -0,0 +1,246 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<ui version="4.0">
+ <class>main_window</class>
+ <widget class="QMainWindow" name="main_window">
+  <property name="geometry">
+   <rect>
+    <x>0</x>
+    <y>0</y>
+    <width>605</width>
+    <height>435</height>
+   </rect>
+  </property>
+  <property name="windowTitle">
+   <string>MainWindow</string>
+  </property>
+  <widget class="QWidget" name="centralwidget">
+   <layout class="QVBoxLayout" name="verticalLayout_2">
+    <item>
+     <widget class="QSplitter" name="splitter">
+      <property name="orientation">
+       <enum>Qt::Vertical</enum>
+      </property>
+      <widget class="QWidget" name="layoutWidget">
+       <layout class="QVBoxLayout" name="verticalLayout">
+        <item>
+         <widget class="QTextEdit" name="editor"/>
+        </item>
+        <item>
+         <widget class="QTextEdit" name="command"/>
+        </item>
+       </layout>
+      </widget>
+      <widget class="QTextEdit" name="output"/>
+     </widget>
+    </item>
+    <item>
+     <layout class="QHBoxLayout" name="horizontalLayout">
+      <item>
+       <widget class="QLineEdit" name="find">
+        <property name="sizePolicy">
+         <sizepolicy hsizetype="Fixed" vsizetype="Fixed">
+          <horstretch>0</horstretch>
+          <verstretch>0</verstretch>
+         </sizepolicy>
+        </property>
+        <property name="minimumSize">
+         <size>
+          <width>175</width>
+          <height>0</height>
+         </size>
+        </property>
+        <property name="maximumSize">
+         <size>
+          <width>175</width>
+          <height>16777215</height>
+         </size>
+        </property>
+        <property name="toolTip">
+         <string>Hit Return for next hit</string>
+        </property>
+       </widget>
+      </item>
+      <item>
+       <widget class="QLineEdit" name="replace">
+        <property name="sizePolicy">
+         <sizepolicy hsizetype="Fixed" vsizetype="Fixed">
+          <horstretch>0</horstretch>
+          <verstretch>0</verstretch>
+         </sizepolicy>
+        </property>
+        <property name="minimumSize">
+         <size>
+          <width>175</width>
+          <height>1</height>
+         </size>
+        </property>
+        <property name="maximumSize">
+         <size>
+          <width>175</width>
+          <height>16777215</height>
+         </size>
+        </property>
+        <property name="toolTip">
+         <string>Hit Return for replace</string>
+        </property>
+       </widget>
+      </item>
+      <item>
+       <widget class="QToolButton" name="button_next">
+        <property name="text">
+         <string>Next</string>
+        </property>
+        <property name="autoRaise">
+         <bool>true</bool>
+        </property>
+       </widget>
+      </item>
+      <item>
+       <widget class="QToolButton" name="button_replace">
+        <property name="text">
+         <string>Replace</string>
+        </property>
+        <property name="autoRaise">
+         <bool>true</bool>
+        </property>
+       </widget>
+      </item>
+      <item>
+       <spacer name="horizontalSpacer_2">
+        <property name="orientation">
+         <enum>Qt::Horizontal</enum>
+        </property>
+        <property name="sizeHint" stdset="0">
+         <size>
+          <width>40</width>
+          <height>20</height>
+         </size>
+        </property>
+       </spacer>
+      </item>
+      <item>
+       <widget class="QLabel" name="sel_label">
+        <property name="text">
+         <string/>
+        </property>
+       </widget>
+      </item>
+      <item>
+       <widget class="QToolButton" name="select">
+        <property name="text">
+         <string>Select</string>
+        </property>
+       </widget>
+      </item>
+     </layout>
+    </item>
+   </layout>
+  </widget>
+  <widget class="QMenuBar" name="menubar">
+   <property name="geometry">
+    <rect>
+     <x>0</x>
+     <y>0</y>
+     <width>605</width>
+     <height>19</height>
+    </rect>
+   </property>
+  </widget>
+  <widget class="QStatusBar" name="statusbar"/>
+  <widget class="QToolBar" name="toolBar">
+   <property name="windowTitle">
+    <string>toolBar</string>
+   </property>
+   <attribute name="toolBarArea">
+    <enum>TopToolBarArea</enum>
+   </attribute>
+   <attribute name="toolBarBreak">
+    <bool>false</bool>
+   </attribute>
+   <addaction name="action_open"/>
+   <addaction name="action_save"/>
+   <addaction name="action_save_as"/>
+   <addaction name="separator"/>
+   <addaction name="action_save_and_run"/>
+   <addaction name="separator"/>
+   <addaction name="action_copy"/>
+   <addaction name="action_cut"/>
+   <addaction name="action_insert_file"/>
+   <addaction name="separator"/>
+   <addaction name="action_eval_region"/>
+   <addaction name="action_repeat_eval"/>
+   <addaction name="separator"/>
+   <addaction name="action_reset_lisp"/>
+  </widget>
+  <action name="action_open">
+   <property name="text">
+    <string>Open</string>
+   </property>
+  </action>
+  <action name="action_save">
+   <property name="text">
+    <string>Save</string>
+   </property>
+  </action>
+  <action name="action_save_as">
+   <property name="text">
+    <string>Save As</string>
+   </property>
+  </action>
+  <action name="action_save_and_run">
+   <property name="text">
+    <string>Save and Run</string>
+   </property>
+  </action>
+  <action name="action_eval_region">
+   <property name="text">
+    <string>Eval Region</string>
+   </property>
+   <property name="toolTip">
+    <string>Eval expression enclosed in currently highlighted parenthesis</string>
+   </property>
+  </action>
+  <action name="action_repeat_eval">
+   <property name="text">
+    <string>Repeat Eval</string>
+   </property>
+   <property name="toolTip">
+    <string>Eval starting from left paren of latest eval</string>
+   </property>
+  </action>
+  <action name="action_copy">
+   <property name="text">
+    <string>Copy ( )</string>
+   </property>
+   <property name="toolTip">
+    <string>Copy highlighted region</string>
+   </property>
+  </action>
+  <action name="action_cut">
+   <property name="text">
+    <string>Cut ( )</string>
+   </property>
+   <property name="toolTip">
+    <string>Cut highlighted region</string>
+   </property>
+  </action>
+  <action name="action_insert_file">
+   <property name="text">
+    <string>Insert File</string>
+   </property>
+   <property name="toolTip">
+    <string>Insert a file at current cursor position</string>
+   </property>
+  </action>
+  <action name="action_reset_lisp">
+   <property name="text">
+    <string>Reset Lisp</string>
+   </property>
+   <property name="toolTip">
+    <string>Restart local Lisp server</string>
+   </property>
+  </action>
+ </widget>
+ <resources/>
+ <connections/>
+</ui>

examples/9-simple-lisp-editor/data/eql-keywords.lisp

@@ -0,0 +1,97 @@
+'("define-qt-wrappers"
+  "defvar-ui"
+  "ensure-qt-object"
+  "in-home"
+  "new-qt-object"
+  "qadd-event-filter"
+  "qapp"
+  "qapropos"
+  "qapropos*"
+  #+linux
+  "qauto-reload-c++"
+  "qcall-default"
+  "qclear-event-filters"
+  "qconnect"
+  "qcopy"
+  "qdel"
+  "qdelete"
+  "qdisconnect"
+  "qenums"
+  "qeql"
+  "qescape"
+  "qevents"
+  "qexec"
+  "qexit"
+  "qfind-bound"
+  "qfind-bound*"
+  "qfind-child"
+  "qfind-children"
+  "qfrom-utf8"
+  "qfun"
+  "qfun*"
+  "qfun+"
+  "qfuns"
+  "qget"
+  "qgui"
+  "qid"
+  "qinvoke-method"
+  "qinvoke-method*"
+  "qinvoke-method+"
+  "qinvoke-methods"
+  "qlater"
+  "qlet"
+  "qload"
+  "qload-c++"
+  "qload-ui"
+  "qlocal8bit"
+  "qmessage-box"
+  "qmsg"
+  "qnew"
+  "qnew-instance"
+  "qnew*"
+  "qnew-instance*"
+  "qnull"
+  "qnull-object"
+  "qobject-names"
+  "qok"
+  "qoverride"
+  "qprocess-events"
+  "qproperties"
+  "qproperty"
+  "qq"
+  "qquit"
+  "qremove-event-filter"
+  "qrequire"
+  "qrgb"
+  "qrun"
+  "qrun-in-gui-thread"
+  "qrun*"
+  "qrun-in-gui-thread*"
+  "qsel"
+  "qselect"
+  "qsender"
+  "qset"
+  "qset-color"
+  "qset-ini"
+  "qset-null"
+  "qset-property"
+  "qsignal"
+  "qsingle-shot"
+  "qsleep"
+  "qslot"
+  "qstatic-meta-object"
+  "qsuper-class-name"
+  "qt-object"
+  "qt-object-id"
+  "qt-object-name"
+  "qt-object-p"
+  "qt-object-pointer"
+  "qt-object-unique"
+  "qt-object-?"
+  "qtranslate"
+  "quic"
+  "qui-class"
+  "qui-names"
+  "qutf8"
+  "qversion"
+  "tr")

examples/9-simple-lisp-editor/data/lisp-keywords.lisp

@@ -0,0 +1,769 @@
+(let ((hash (make-hash-table :test 'equal)))
+  (dolist (kw '("abort"
+                "abs"
+                "acons"
+                "acos"
+                "acosh"
+                "add-method"
+                "adjoin"
+                "adjust-array"
+                "adjustable-array-p"
+                "allocate-instance"
+                "alpha-char-p"
+                "alphanumericp"
+                "and"
+                "append"
+                "apply"
+                "apropos"
+                "apropos-list"
+                "aref"
+                "arithmetic-error-operands"
+                "arithmetic-error-operation"
+                "array-dimension"
+                "array-dimensions"
+                "array-displacement"
+                "array-element-type"
+                "array-has-fill-pointer-p"
+                "array-in-bounds-p"
+                "array-rank"
+                "array-row-major-index"
+                "array-total-size"
+                "arrayp"
+                "ash"
+                "asin"
+                "asinh"
+                "assert"
+                "assoc"
+                "assoc-if"
+                "assoc-if-not"
+                "atan"
+                "atanh"
+                "atom"
+                "bit"
+                "bit-and"
+                "bit-andc1"
+                "bit-andc2"
+                "bit-eqv"
+                "bit-ior"
+                "bit-nand"
+                "bit-nor"
+                "bit-not"
+                "bit-orc1"
+                "bit-orc2"
+                "bit-vector-p"
+                "bit-xor"
+                "block"
+                "boole"
+                "both-case-p"
+                "boundp"
+                "break"
+                "broadcast-stream-streams"
+                "butlast"
+                "byte"
+                "byte-position"
+                "byte-size"
+                "caaaar"
+                "caaadr"
+                "caaar"
+                "caadar"
+                "caaddr"
+                "caadr"
+                "caar"
+                "cadaar"
+                "cadadr"
+                "cadar"
+                "caddar"
+                "cadddr"
+                "caddr"
+                "cadr"
+                "call-method"
+                "call-next-method"
+                "car"
+                "case"
+                "catch"
+                "ccase"
+                "cdaaar"
+                "cdaadr"
+                "cdaar"
+                "cdadar"
+                "cdaddr"
+                "cdadr"
+                "cdar"
+                "cddaar"
+                "cddadr"
+                "cddar"
+                "cdddar"
+                "cddddr"
+                "cdddr"
+                "cddr"
+                "cdr"
+                "ceiling"
+                "cell-error-name"
+                "cerror"
+                "change-class"
+                "char"
+                "char-code"
+                "char-downcase"
+                "char-equal"
+                "char-greaterp"
+                "char-int"
+                "char-lessp"
+                "char-name"
+                "char-not-equal"
+                "char-not-greaterp"
+                "char-not-lessp"
+                "char-upcase"
+                "char/="
+                "char<"
+                "char<="
+                "char="
+                "char>"
+                "char>="
+                "character"
+                "characterp"
+                "check-type"
+                "cis"
+                "class-name"
+                "class-of"
+                "clear-input"
+                "clear-output"
+                "close"
+                "clrhash"
+                "code-char"
+                "coerce"
+                "compile"
+                "compile-file"
+                "compile-file-pathname"
+                "compiled-function-p"
+                "compiler-macro-function"
+                "complement"
+                "complex"
+                "complexp"
+                "compute-applicable-methods"
+                "compute-restarts"
+                "concatenate"
+                "concatenated-stream-streams"
+                "cond"
+                "conjugate"
+                "cons"
+                "consp"
+                "constantly"
+                "constantp"
+                "continue"
+                "copy-alist"
+                "copy-list"
+                "copy-pprint-dispatch"
+                "copy-readtable"
+                "copy-seq"
+                "copy-structure"
+                "copy-symbol"
+                "copy-tree"
+                "cos"
+                "cosh"
+                "count"
+                "count-if"
+                "count-if-not"
+                "ctypecase"
+                "decf"
+                "declaim"
+                "decode-float"
+                "decode-universal-time"
+                "defclass"
+                "defconstant"
+                "defgeneric"
+                "define-compiler-macro"
+                "define-condition"
+                "define-method-combination"
+                "define-modify-macro"
+                "define-setf-expander"
+                "define-symbol-macro"
+                "defmacro"
+                "defmethod"
+                "defpackage"
+                "defparameter"
+                "defsetf"
+                "defstruct"
+                "deftype"
+                "defun"
+                "defvar"
+                "delete"
+                "delete-duplicates"
+                "delete-file"
+                "delete-if"
+                "delete-if-not"
+                "delete-package"
+                "denominator"
+                "deposit-field"
+                "describe"
+                "describe-object"
+                "destructuring-bind"
+                "digit-char"
+                "digit-char-p"
+                "directory"
+                "directory-namestring"
+                "disassemble"
+                "do"
+                "do*"
+                "do-all-symbols"
+                "do-external-symbols"
+                "do-symbols"
+                "documentation"
+                "dolist"
+                "dotimes"
+                "dribble"
+                "ecase"
+                "echo-stream-input-stream"
+                "echo-stream-output-stream"
+                "eighth"
+                "elt"
+                "encode-universal-time"
+                "endp"
+                "enough-namestring"
+                "ensure-directories-exist"
+                "ensure-generic-function"
+                "eq"
+                "eql"
+                "equal"
+                "equalp"
+                "error"
+                "etypecase"
+                "eval"
+                "eval-when"
+                "evenp"
+                "every"
+                "exp"
+                "export"
+                "expt"
+                "fboundp"
+                "fceiling"
+                "fdefinition"
+                "ffloor"
+                "fifth"
+                "file-author"
+                "file-error-pathname"
+                "file-length"
+                "file-namestring"
+                "file-position"
+                "file-string-length"
+                "file-write-date"
+                "fill"
+                "fill-pointer"
+                "find"
+                "find-all-symbols"
+                "find-class"
+                "find-if"
+                "find-if-not"
+                "find-method"
+                "find-package"
+                "find-restart"
+                "find-symbol"
+                "finish-output"
+                "first"
+                "flet"
+                "float"
+                "float-digits"
+                "float-precision"
+                "float-radix"
+                "float-sign"
+                "floatp"
+                "floor"
+                "fmakunbound"
+                "force-output"
+                "format"
+                "formatter"
+                "fourth"
+                "fresh-line"
+                "fround"
+                "ftruncate"
+                "funcall"
+                "function"
+                "function-keywords"
+                "function-lambda-expression"
+                "functionp"
+                "gcd"
+                "gensym"
+                "gentemp"
+                "get"
+                "get-decoded-time"
+                "get-dispatch-macro-character"
+                "get-internal-real-time"
+                "get-internal-run-time"
+                "get-macro-character"
+                "get-output-stream-string"
+                "get-properties"
+                "get-setf-expansion"
+                "get-universal-time"
+                "getf"
+                "gethash"
+                "go"
+                "graphic-char-p"
+                "handler-bind"
+                "handler-case"
+                "hash-table-count"
+                "hash-table-p"
+                "hash-table-rehash-size"
+                "hash-table-rehash-threshold"
+                "hash-table-size"
+                "hash-table-test"
+                "host-namestring"
+                "identity"
+                "if"
+                "ignore-errors"
+                "imagpart"
+                "import"
+                "in-package"
+                "incf"
+                "initialize-instance"
+                "input-stream-p"
+                "inspect"
+                "integer-decode-float"
+                "integer-length"
+                "integerp"
+                "interactive-stream-p"
+                "intern"
+                "intersection"
+                "invalid-method-error"
+                "invoke-debugger"
+                "invoke-restart"
+                "invoke-restart-interactively"
+                "isqrt"
+                "keywordp"
+                "labels"
+                "lambda"
+                "last"
+                "lcm"
+                "ldb"
+                "ldb-test"
+                "ldiff"
+                "length"
+                "let"
+                "let*"
+                "lisp-implementation-type"
+                "lisp-implementation-version"
+                "list"
+                "list*"
+                "list-all-packages"
+                "list-length"
+                "listen"
+                "listp"
+                "load"
+                "load-logical-pathname-translations"
+                "load-time-value"
+                "locally"
+                "log"
+                "logand"
+                "logandc1"
+                "logandc2"
+                "logbitp"
+                "logcount"
+                "logeqv"
+                "logical-pathname"
+                "logical-pathname-translations"
+                "logior"
+                "lognand"
+                "lognor"
+                "lognot"
+                "logorc1"
+                "logorc2"
+                "logtest"
+                "logxor"
+                "long-site-name"
+                "loop"
+                "loop-finish"
+                "lower-case-p"
+                "machine-instance"
+                "machine-type"
+                "machine-version"
+                "macro-function"
+                "macroexpand"
+                "macroexpand-1"
+                "macrolet"
+                "make-array"
+                "make-broadcast-stream"
+                "make-concatenated-stream"
+                "make-condition"
+                "make-dispatch-macro-character"
+                "make-echo-stream"
+                "make-hash-table"
+                "make-instance"
+                "make-instances-obsolete"
+                "make-list"
+                "make-load-form"
+                "make-load-form-saving-slots"
+                "make-method"
+                "make-package"
+                "make-pathname"
+                "make-random-state"
+                "make-sequence"
+                "make-string"
+                "make-string-input-stream"
+                "make-string-output-stream"
+                "make-symbol"
+                "make-synonym-stream"
+                "make-two-way-stream"
+                "makunbound"
+                "map"
+                "map-into"
+                "mapc"
+                "mapcan"
+                "mapcar"
+                "mapcon"
+                "maphash"
+                "mapl"
+                "maplist"
+                "mask-field"
+                "max"
+                "member"
+                "member-if"
+                "member-if-not"
+                "merge"
+                "merge-pathnames"
+                "method-combination-error"
+                "method-qualifiers"
+                "min"
+                "minusp"
+                "mismatch"
+                "mod"
+                "muffle-warning"
+                "multiple-value-bind"
+                "multiple-value-call"
+                "multiple-value-list"
+                "multiple-value-prog1"
+                "multiple-value-setq"
+                "name-char"
+                "namestring"
+                "nbutlast"
+                "nconc"
+                "next-method-p"
+                "nintersection"
+                "ninth"
+                "no-applicable-method"
+                "no-next-method"
+                "not"
+                "notany"
+                "notevery"
+                "nreconc"
+                "nreverse"
+                "nset-difference"
+                "nset-exclusive-or"
+                "nstring-capitalize"
+                "nstring-downcase"
+                "nstring-upcase"
+                "nsublis"
+                "nsubst"
+                "nsubst-if"
+                "nsubst-if-not"
+                "nsubstitute"
+                "nsubstitute-if"
+                "nsubstitute-if-not"
+                "nth"
+                "nth-value"
+                "nthcdr"
+                "null"
+                "numberp"
+                "numerator"
+                "nunion"
+                "oddp"
+                "open"
+                "open-stream-p"
+                "or"
+                "output-stream-p"
+                "package-error-package"
+                "package-name"
+                "package-nicknames"
+                "package-shadowing-symbols"
+                "package-use-list"
+                "package-used-by-list"
+                "packagep"
+                "pairlis"
+                "parse-integer"
+                "parse-namestring"
+                "pathname"
+                "pathname-device"
+                "pathname-directory"
+                "pathname-host"
+                "pathname-match-p"
+                "pathname-name"
+                "pathname-type"
+                "pathname-version"
+                "pathnamep"
+                "peek-char"
+                "phase"
+                "plusp"
+                "pop"
+                "position"
+                "position-if"
+                "position-if-not"
+                "pprint"
+                "pprint-dispatch"
+                "pprint-exit-if-list-exhausted"
+                "pprint-fill"
+                "pprint-indent"
+                "pprint-linear"
+                "pprint-logical-block"
+                "pprint-newline"
+                "pprint-pop"
+                "pprint-tab"
+                "pprint-tabular"
+                "prin1"
+                "prin1-to-string"
+                "princ"
+                "princ-to-string"
+                "print"
+                "print-not-readable-object"
+                "print-object"
+                "print-unreadable-object"
+                "probe-file"
+                "proclaim"
+                "prog"
+                "prog*"
+                "prog1"
+                "prog2"
+                "progn"
+                "progv"
+                "provide"
+                "psetf"
+                "psetq"
+                "push"
+                "pushnew"
+                "quote"
+                "random"
+                "random-state-p"
+                "rassoc"
+                "rassoc-if"
+                "rassoc-if-not"
+                "rational"
+                "rationalize"
+                "rationalp"
+                "read"
+                "read-byte"
+                "read-char"
+                "read-char-no-hang"
+                "read-delimited-list"
+                "read-from-string"
+                "read-line"
+                "read-preserving-whitespace"
+                "read-sequence"
+                "readtable-case"
+                "readtablep"
+                "realp"
+                "realpart"
+                "reduce"
+                "reinitialize-instance"
+                "rem"
+                "remf"
+                "remhash"
+                "remove"
+                "remove-duplicates"
+                "remove-if"
+                "remove-if-not"
+                "remove-method"
+                "remprop"
+                "rename-file"
+                "rename-package"
+                "replace"
+                "require"
+                "rest"
+                "restart-bind"
+                "restart-case"
+                "restart-name"
+                "return"
+                "return-from"
+                "revappend"
+                "reverse"
+                "room"
+                "rotatef"
+                "round"
+                "row-major-aref"
+                "rplaca"
+                "rplacd"
+                "sbit"
+                "scale-float"
+                "schar"
+                "search"
+                "second"
+                "set"
+                "set-difference"
+                "set-dispatch-macro-character"
+                "set-exclusive-or"
+                "set-macro-character"
+                "set-pprint-dispatch"
+                "set-syntax-from-char"
+                "setf"
+                "setq"
+                "seventh"
+                "shadow"
+                "shadowing-import"
+                "shared-initialize"
+                "shiftf"
+                "short-site-name"
+                "signal"
+                "signum"
+                "simple-bit-vector-p"
+                "simple-condition-format-arguments"
+                "simple-condition-format-control"
+                "simple-string-p"
+                "simple-vector-p"
+                "sin"
+                "sinh"
+                "sixth"
+                "sleep"
+                "slot-boundp"
+                "slot-exists-p"
+                "slot-makunbound"
+                "slot-missing"
+                "slot-unbound"
+                "slot-value"
+                "software-type"
+                "software-version"
+                "some"
+                "sort"
+                "special-operator-p"
+                "sqrt"
+                "stable-sort"
+                "standard-char-p"
+                "step"
+                "store-value"
+                "stream-element-type"
+                "stream-error-stream"
+                "stream-external-format"
+                "streamp"
+                "string"
+                "string-capitalize"
+                "string-downcase"
+                "string-equal"
+                "string-greaterp"
+                "string-left-trim"
+                "string-lessp"
+                "string-not-equal"
+                "string-not-greaterp"
+                "string-not-lessp"
+                "string-right-trim"
+                "string-trim"
+                "string-upcase"
+                "string/="
+                "string<"
+                "string<="
+                "string="
+                "string>"
+                "string>="
+                "stringp"
+                "sublis"
+                "subseq"
+                "subsetp"
+                "subst"
+                "subst-if"
+                "subst-if-not"
+                "substitute"
+                "substitute-if"
+                "substitute-if-not"
+                "subtypep"
+                "svref"
+                "sxhash"
+                "symbol-function"
+                "symbol-macrolet"
+                "symbol-name"
+                "symbol-package"
+                "symbol-plist"
+                "symbol-value"
+                "symbolp"
+                "synonym-stream-symbol"
+                "tagbody"
+                "tailp"
+                "tan"
+                "tanh"
+                "tenth"
+                "terpri"
+                "the"
+                "third"
+                "throw"
+                "time"
+                "trace"
+                "translate-logical-pathname"
+                "translate-pathname"
+                "tree-equal"
+                "truename"
+                "truncate"
+                "two-way-stream-input-stream"
+                "two-way-stream-output-stream"
+                "type-error-datum"
+                "type-error-expected-type"
+                "type-of"
+                "typecase"
+                "typep"
+                "unbound-slot-instance"
+                "unexport"
+                "unintern"
+                "union"
+                "unless"
+                "unread-char"
+                "untrace"
+                "unuse-package"
+                "unwind-protect"
+                "update-instance-for-different-class"
+                "update-instance-for-redefined-class"
+                "upgraded-array-element-type"
+                "upgraded-complex-part-type"
+                "upper-case-p"
+                "use-package"
+                "use-value"
+                "user-homedir-pathname"
+                "values"
+                "values-list"
+                "vector"
+                "vector-pop"
+                "vector-push"
+                "vector-push-extend"
+                "vectorp"
+                "warn"
+                "when"
+                "wild-pathname-p"
+                "with-accessors"
+                "with-compilation-unit"
+                "with-condition-restarts"
+                "with-hash-table-iterator"
+                "with-input-from-string"
+                "with-open-file"
+                "with-open-stream"
+                "with-output-to-string"
+                "with-package-iterator"
+                "with-simple-restart"
+                "with-slots"
+                "with-standard-io-syntax"
+                "write"
+                "write-byte"
+                "write-char"
+                "write-line"
+                "write-sequence"
+                "write-string"
+                "write-to-string"
+                "y-or-n-p"
+                "yes-or-no-p"
+                "zerop"
+                ;; package :x
+                "bytes-to-string"
+                "d"
+                "do-string"
+                "do-with"
+                "empty-string"
+                "ensure-compiled"
+                "ensure-list"
+                "ends-with"
+                "it"
+                "it*"
+                "if-it"
+                "if-it*"
+                "join"
+                "let-it"
+                "split"
+                "starts-with"
+                "string-split"
+                "string-substitute"
+                "string-to-bytes"
+                "when-it"
+                "when-it*"
+                "while"
+                "while-it"
+                "with-gensyms"))
+    (setf (gethash kw hash) t))
+  hash)

examples/9-simple-lisp-editor/debug-dialog.lisp

@@ -0,0 +1,43 @@
+(defpackage :debug-dialog
+  (:use :common-lisp :eql)
+  (:export
+   #:command))
+
+(provide :debug-dialog)
+
+(in-package :debug-dialog)
+
+(defun command (messages font)
+  (qlet ((dlg "QDialog(QWidget*,Qt::WindowFlags)" nil |Qt.WindowStaysOnTopHint|
+              "windowTitle" (tr "Debug Dialog")
+              "size" '(600 400))
+         (msg "QTextEdit")
+         (lb  "QLabel" "text" (tr "Enter debug command (:h for help)"))
+         (cmd "QLineEdit")
+         (box "QDialogButtonBox")
+         (lay "QVBoxLayout(QWidget*)" dlg))
+    (x:do-with (qset msg)
+      ("readOnly" t)
+      ("font" font)
+      ("tabStopWidth" (qlet ((fm "QFontMetrics(QFont)" font))
+                        (* 8 (! "width(QChar)" fm #\Space)))))
+    (x:do-with (! "addButton" box)
+      |QDialogButtonBox.Ok|
+      |QDialogButtonBox.Cancel|)
+    (x:do-with (! "addWidget" lay)
+      msg lb cmd box)
+    (qset-color msg |QPalette.Base| "lightyellow")
+    (qconnect box "accepted()" dlg "accept()")
+    (qconnect box "rejected()" dlg "reject()")
+    (! "setFocus" cmd)
+    (qlater (lambda () (x:do-with dlg "activateWindow" "raise")))
+    (add-messages msg messages)
+    (if (= |QDialog.Accepted| (! "exec" dlg))
+        (qget cmd "text")
+        ":r1")))
+
+(defun add-messages (text-edit messages)
+  (dolist (msg messages)
+    (x:do-with text-edit
+      ("setTextColor" (cdr msg))
+      ("insertPlainText" (car msg)))))

examples/9-simple-lisp-editor/exe/README.txt

@@ -0,0 +1,23 @@
+BUILD
+=====
+
+  eql5 make
+  qmake
+  make
+
+
+QUIT
+====
+
+See menu of "Q" system tray icon.
+
+
+NOTES
+=====
+
+If you don't want console output, pass command line option "-silent"
+(or set "local-server::*silent*" to T).
+
+Additionally, comment this line in "local_server.pro" (Windows):
+# CONFIG += console
+

examples/9-simple-lisp-editor/exe/local_server.pro

@@ -0,0 +1,13 @@
+TEMPLATE     = app
+CONFIG      += no_keywords release
+CONFIG      += console
+INCLUDEPATH += ../../../src
+LIBS        += -lecl -L. -leql-local-server -L../../.. -leql5
+TARGET       = eql_local_server
+DESTDIR      = ./
+OBJECTS_DIR  = ./tmp/
+MOC_DIR      = ./tmp/
+
+include(../../../src/windows.pri)
+
+SOURCES += main.cpp

examples/9-simple-lisp-editor/exe/main.cpp

@@ -0,0 +1,27 @@
+#include <QCoreApplication>
+#include <QTextCodec>
+#include <ecl/ecl.h>
+#include "eql.h"
+
+extern "C" void ini_app(cl_object);
+
+int catch_all_qexec() {
+    int ret = 0;
+    CL_CATCH_ALL_BEGIN(ecl_process_env()) {
+        ret = QCoreApplication::exec(); }
+    CL_CATCH_ALL_END;
+    return ret; }
+
+int main(int argc, char** argv) {
+
+    EQL::ini(argv);
+
+    QCoreApplication qapp(argc, argv);
+
+    QTextCodec* utf8 = QTextCodec::codecForName("UTF-8");
+    QTextCodec::setCodecForLocale(utf8);
+
+    EQL eql;
+    eql.exec(ini_app);
+
+    return catch_all_qexec(); }

examples/9-simple-lisp-editor/exe/make.lisp

@@ -0,0 +1,30 @@
+#-eql5
+(error "Please use the EQL5 executable")
+
+(require :cmp)
+
+#+msvc
+(setf c::*compile-in-constants* t)
+
+(defparameter *lisp-files* '("input-hook"
+                             "top-level"
+                             "query-dialog"
+                             "debug-dialog"
+                             "settings"
+                             "local-server"))
+
+(dolist (f *lisp-files*)
+  (let ((file (format nil "../~A.lisp" f)))
+    (load file)
+    (compile-file file :system-p t)))
+
+(c:build-static-library "eql-local-server"
+                        :lisp-files (mapcar (lambda (file)
+                                              (format nil "../~A.~A" file #+msvc "obj" #-msvc "o"))
+                                            *lisp-files*)
+                        :init-name "ini_app")
+
+(dolist (file *lisp-files*)
+  (delete-file (format nil "../~A.~A" file #+msvc "obj" #-msvc "o")))
+
+(eql:qq)

examples/9-simple-lisp-editor/input-hook.lisp

@@ -0,0 +1,59 @@
+;;; idea & most code from "ecl-readline.lisp"
+
+(defpackage input-hook
+    (:use :common-lisp)
+  (:export
+   #:new))
+
+(provide :input-hook)
+
+(in-package :input-hook)
+
+(defvar *functions* nil)
+
+(defun new (function)
+  (let ((stream (make-instance 'gray::input-hook-stream)))
+    (push (cons stream function) *functions*)
+    stream))
+
+(in-package :gray)
+
+(defclass input-hook-stream (fundamental-character-input-stream)
+  ((in-buffer  :initform (make-string 0))
+   (in-index   :initform 0)
+   (out-buffer :initform (make-array 0 :element-type 'character :adjustable t :fill-pointer t))))
+
+(defmethod stream-read-char ((stream input-hook-stream))
+  (if (ensure-stream-data stream)
+      (with-slots (in-buffer in-index) stream
+        (let ((ch (char in-buffer in-index)))
+          (incf in-index)
+          ch))
+      :eof))
+
+(defmethod stream-unread-char ((stream input-hook-stream) character)
+  (with-slots (in-index) stream
+    (when (> in-index 0)
+      (decf in-index))))
+
+(defmethod stream-listen ((stream input-hook-stream))
+  nil)
+
+(defmethod stream-clear-input ((stream input-hook-stream))
+  nil)
+
+(defmethod stream-close ((stream input-hook-stream) &key abort)
+  (call-next-method))
+
+(defmethod stream-peek-char ((stream input-hook-stream))
+  (if (ensure-stream-data stream)
+      (with-slots (in-buffer in-index) stream
+        (char in-buffer in-index))
+      :eof))
+
+(defun ensure-stream-data (stream)
+  (with-slots (in-buffer in-index) stream
+    (when (= in-index (length in-buffer))
+      (setf in-buffer (funcall (cdr (assoc stream input-hook::*functions*)))
+            in-index 0))
+    in-buffer))

examples/9-simple-lisp-editor/local-client.lisp

@@ -0,0 +1,61 @@
+;;; copyright (c) Polos Ruetz
+
+(unless (eql:qrequire :network)
+  (error "[EQL] module :network required")
+  (eql:qq))
+
+(defpackage :local-client
+  (:use :common-lisp :eql)
+  (:export
+   #:*function*
+   #:*server-name*
+   #:ini
+   #:request))
+
+(provide :local-client)
+
+(in-package :local-client)
+
+(defvar *function*    nil)
+(defvar *socket*      (qnew "QLocalSocket"))
+(defvar *server-name* "EQL:local-server")
+
+(defun ini (&optional fun)
+  (setf *function* fun)
+  (qconnect *socket* "readyRead()" 'read-data))
+
+(let (size bytes-read type data)
+  (defun reset-data ()
+    (setf size nil
+          data nil))
+  (defun read-data ()
+    (when *function*
+      (let ((all (! "readAll" *socket*)))
+        ;; data may arrive splitted in more blocks
+        (if size
+            (when (< bytes-read size)
+              (push all data)
+              (incf bytes-read (length all)))
+            (let* ((spc (char-code #\Space))
+                   (head (x:bytes-to-string (subseq all 0 (1+ (position spc all :start (1+ (position spc all)))))))
+                   end)
+              (multiple-value-setq (size end)
+                (read-from-string head))
+              (multiple-value-setq (type end)
+                (read-from-string head nil nil :start end))
+              (push (subseq all end) data)
+              (setf bytes-read (length (first data)))))
+        (when (= size bytes-read)
+          (funcall *function* type (qfrom-utf8 (apply 'concatenate 'vector (nreverse data))))
+          (reset-data))))))
+
+(defun request (str)
+  (reset-data)
+  (x:do-with *socket*
+    ("abort")
+    ("connectToServer" *server-name*)
+    ("waitForConnected"))
+  (when (! "isWritable" *socket*)
+    (let ((utf8 (qutf8 str)))
+      (! "write(QByteArray)" *socket* (x:string-to-bytes (format nil "~D ~A" (length utf8) utf8))))
+    t))

examples/9-simple-lisp-editor/local-server.lisp

@@ -0,0 +1,328 @@
+;;; copyright (c) Polos Ruetz
+
+#-qt-wrapper-functions ; see README-OPTIONAL.txt
+(load (in-home "src/lisp/all-wrappers"))
+
+(unless (eql:qrequire :network)
+  (error "[EQL] module :network required")
+  (eql:qq))
+
+(require :input-hook   (probe-file "input-hook.lisp"))
+(require :top-level    (probe-file "top-level.lisp"))
+(require :query-dialog (probe-file "query-dialog.lisp"))
+(require :debug-dialog (probe-file "debug-dialog.lisp"))
+(require :settings     (probe-file "settings.lisp"))
+
+(defpackage :local-server
+  (:use :common-lisp :eql)
+  (:export
+   #:+
+   #:++
+   #:+++
+   #:*
+   #:**
+   #:***
+   #:/
+   #://
+   #:///
+   #:*function*
+   #:*prompt*
+   #:ini
+   #:clear
+   #:output
+   #:send-to-client))
+
+(provide :local-server)
+
+(in-package :local-server)
+
+(defvar *function*               'feed-top-level)
+(defvar *server*                 (qnew "QLocalServer"))
+(defvar *client*                 nil)
+(defvar *prompt*                 t)
+(defvar *standard-output-buffer* (make-string-output-stream))
+(defvar *trace-output-buffer*    (make-string-output-stream))
+(defvar *error-output-buffer*    (make-string-output-stream))
+(defvar *terminal-out-buffer*    (make-string-output-stream))
+(defvar *gui-debug-io*           nil)
+(defvar *sharp-q*                nil) ; see "CL_EQL/"
+(defvar *silent*                 (find "-silent" (! "arguments" "QApplication") :test 'string=))
+
+;; REPL variables
+(defvar +   nil)
+(defvar ++  nil)
+(defvar +++ nil)
+(defvar *   nil)
+(defvar **  nil)
+(defvar *** nil)
+(defvar /   nil)
+(defvar //  nil)
+(defvar /// nil)
+
+(defun ini (&optional (name "EQL:local-server"))
+  (! "removeServer" "QLocalServer" name)
+  (if (! "listen" *server* name)
+      (progn
+        (ini-streams)
+        (set-debugger-hook)
+        (setf si::*tpl-print-current-hook* 'send-file-position)
+        (qset (qapp) "quitOnLastWindowClosed" nil)
+        (qconnect *server* "newConnection()" 'new-client-connection)
+        (multiple-value-bind (eql-version qt-version)
+            (qversion)
+          (format t "~%EQL local-server (EQL ~A, ECL ~A, Qt ~A)~@
+                       Use local-client to send input.~%"
+                  eql-version (lisp-implementation-version) qt-version))
+        (ini-system-tray)
+        t)
+      (progn
+        (! "critical" "QMessageBox" nil (tr "EQL local-server")
+              (format nil (tr "Unable to start the server: ~A.") (! "errorString" *server*)))
+        nil)))
+
+(defun ini-streams ()
+  (if *silent*
+      (setf *standard-output* *standard-output-buffer*
+            *trace-output*    *trace-output-buffer*
+            *error-output*    *error-output-buffer*)
+      (setf *standard-output* (make-broadcast-stream *standard-output*
+                                                     *standard-output-buffer*)
+            *trace-output*    (make-broadcast-stream *trace-output*
+                                                     *trace-output-buffer*)
+            *error-output*    (make-broadcast-stream *error-output*
+                                                     *error-output-buffer*)))
+  (setf *terminal-io*  (make-two-way-stream (two-way-stream-input-stream *terminal-io*)
+                                            (if *silent*
+                                                *terminal-out-buffer*
+                                                (make-broadcast-stream (two-way-stream-output-stream *terminal-io*)
+                                                                       *terminal-out-buffer*)))
+        *query-io*     (make-two-way-stream (input-hook:new 'handle-query-io)
+                                            (two-way-stream-output-stream *terminal-io*))
+        *gui-debug-io* (make-two-way-stream (input-hook:new 'handle-debug-io)
+                                            (two-way-stream-output-stream *terminal-io*))))
+
+(defun file-data (file)
+  "To use together with '#.' reader macro, for embedding data in compiled files."
+  (with-open-file (s file :direction :input :element-type '(signed-byte 8))
+    (let ((data (make-array (file-length s) :element-type '(signed-byte 8))))
+      (read-sequence data s)
+      data)))
+
+(defun ini-system-tray ()
+  (let* ((tray (qnew "QSystemTrayIcon(QIcon)"
+                     (qnew "QIcon(QPixmap)"
+                           (x:let-it (qnew "QPixmap")
+                             (! "loadFromData" x:it
+                                ;; embed data
+                                #.(file-data (in-home "examples/9-simple-lisp-editor/data/local_server.png"))
+                                "PNG")))))
+         (menu (qnew "QMenu"))
+         (quit (qnew "QAction(QObject*)" menu
+                     "text" (tr "Quit EQL server"))))
+    (! "addAction(QAction*)" menu quit)
+    (qconnect quit "triggered()" (lambda () (qdel tray) (qquit)))
+    (x:do-with tray
+      ("setContextMenu" menu)
+      ("show"))))
+
+(let (size bytes-read data)
+  (defun reset (&optional data-only)
+    (unless data-only
+      (when (and *client* (not (qnull *client*)))
+        (qdisconnect *client*)
+        (qdel *client*)))
+    (setf size nil
+          data nil))
+  (defun new-client-connection ()
+    (reset)
+    (setf *client* (! "nextPendingConnection" *server*))
+    (qconnect *client* "readyRead()" 'read-from-client)
+    (qconnect *client* "disconnected()" (lambda () (qdel *client* :later))))
+  (defun read-from-client ()
+    (when *function*
+      (restart-all-timers) ; see (stop-all-timers)
+      (let ((all (! "readAll" *client*)))
+        ;; data may arrive splitted in more blocks
+        (if size
+            (when (< bytes-read size)
+              (push all data)
+              (incf bytes-read (length all)))
+            (let ((head (x:bytes-to-string (subseq all 0 (1+ (position (char-code #\Space) all)))))
+                  end)
+              (multiple-value-setq (size end)
+                (read-from-string head))
+              (let ((data* (subseq all end)))
+                (setf bytes-read (length data*))
+                (if (and (= #.(char-code #\#) (svref data* 0))
+                         (= #.(char-code #\q) (svref data* 1)))
+                    (setf *sharp-q* t
+                          *print-pretty* nil ; for "CL_EQL/" return values
+                          eql:*break-on-errors* t
+                          data* (subseq data* 2))
+                    (setf *sharp-q* nil))
+                (push data* data))))
+        (when (= size bytes-read)
+          (funcall *function* (qfrom-utf8 (apply 'concatenate 'vector (nreverse data))))
+          (reset :data-only))))))
+
+(defun current-package-name ()
+  (if (eql (find-package :cl-user) *package*)
+      "CL-USER"
+      (car (sort (list* (package-name *package*) (package-nicknames *package*))
+                 (lambda (x y) (< (length x) (length y)))))))
+
+(let ((n 0))
+  (defun feed-top-level (str)
+    (unless (x:empty-string str)
+      (if *prompt*
+          (let ((pkg (if (zerop n) "EQL-USER" (current-package-name)))
+                (counter (princ-to-string (incf n))))
+            (format t "~%~A [~A] ~A~%~A"
+                    pkg
+                    counter
+                    (make-string (- 50 (length counter) (length pkg)) :initial-element #\-)
+                    str))
+          (format t "~%~A~%~%~A" #.(make-string 50 :initial-element #\_) str))
+      (setf si::*read-string* str)
+      (start-top-level))))
+
+(defun send-output (type var)
+  (let ((str (get-output-stream-string var)))
+    (unless (x:empty-string str)
+      (when (eql :output type)
+        ;; cut prompt
+        (x:when-it (position #\> str)
+          (setf str (subseq str (1+ x:it)))))
+      (send-to-client type str))))
+
+(defun start-top-level ()
+  (if *sharp-q*
+      (clear)
+      (send-output :expression *standard-output-buffer*))
+  (setf *debug-io* *gui-debug-io*)
+  (clear-gui-debug-buffers)
+  (si::%top-level)
+  (unless *sharp-q*
+    (send-output :error  *error-output-buffer*)
+    (send-output :trace  *trace-output-buffer*)
+    (send-output :output *standard-output-buffer*))
+  (send-to-client :values (format nil "~{#||#~S~}" si::*latest-values*))) ; "#||#": used as separator
+
+(defun clear-gui-debug-buffers ()
+  (get-output-stream-string *error-output-buffer*)
+  (get-output-stream-string *terminal-out-buffer*))
+
+(defun clear ()
+  "To use from a client to clear the output buffer. See also function OUTPUT."
+  (get-output-stream-string *standard-output-buffer*))
+
+(defun output ()
+  "To use from a client to get the current buffer string immediately (e.g. inside a loop). See also function CLEAR."
+  (send-to-client :output (get-output-stream-string *standard-output-buffer*)))
+
+(defun send-file-position (file pos)
+  (send-to-client :file-position (format nil "(~S . ~D)" file pos)))
+
+(defun send-to-client (type &optional (str ""))
+  (flet ((pause ()
+           (qprocess-events)
+           (sleep 0.05)))
+    (when (and *client*
+               (not (qnull *client*)))
+      (x:while (not (zerop (! "bytesToWrite" *client*)))
+        (pause))
+      (if (! "isWritable" *client*)
+          (let ((utf8 (qutf8 str)))
+            (! "write(QByteArray)" *client* (x:string-to-bytes (format nil "~D ~S ~A" (length utf8) type utf8)))
+            (pause))
+          (! "critical" "QMessageBox" nil "EQL" (tr "Could not write to client."))))))
+
+(defun handle-query-io ()
+  (let ((txt (query-dialog:get-text (get-output-stream-string *terminal-out-buffer*))))
+    (unless *sharp-q*
+      (send-to-client :activate-editor))
+    (send-to-client :values txt)
+    (format nil "~A~%" txt)))
+
+(defun handle-debug-io ()
+  (stop-all-timers) ; see (restart-all-timers)
+  (let ((cmd (debug-dialog:command (list (cons (get-output-stream-string *error-output-buffer*) "red")
+                                         (cons (get-output-stream-string *terminal-out-buffer*) "black"))
+                                   eql::*code-font*)))
+    (unless *sharp-q*
+      (send-to-client :activate-editor))
+    (send-to-client :values "")
+    (format nil "~A~%" (if (x:empty-string cmd) ":r1" cmd))))
+
+(defun set-debugger-hook ()
+  (setf *debugger-hook* (lambda (cond x)
+                          ;; allow terminal input after console interrupts
+                          (when (eql 'si:interactive-interrupt (type-of cond))
+                            (setf *debug-io* *terminal-io*)))))
+
+(let (timers)
+  (defun stop-all-timers ()
+    "Stop all timers (which need to have a parent) on errors, in order to avoid recursive debug loops. The timers will be restarted on next command from client."
+    (setf timers nil)
+    (dolist (w (cons (qapp) (! "allWidgets" "QApplication")))
+      (dolist (o (! "children" w))
+        (when (and (= #.(qid "QTimer") (qt-object-id o))
+                   (! "isActive" o))
+          (! "stop" o)
+          (push o timers)))))
+  (defun restart-all-timers ()
+    (dolist (timer timers)
+      (! "start" timer))
+    (setf timers nil)))
+
+;;; extensions
+
+(defun widget-selected (widget)
+  (send-to-client :widget-selected (princ-to-string widget)))
+
+;;; see '?' in "CL_EQL/"
+
+(defvar *eval-socket* nil)
+
+(defun %ini-remote-eval ()
+  (unless *eval-socket*
+    (setf *eval-socket* (qnew "QLocalSocket")))
+  (when (= |QLocalSocket.UnconnectedState| (! "state" *eval-socket*))
+    (x:do-with *eval-socket*
+      ("connectToServer" "EQL:eval-server")
+      ("waitForConnected"))))
+
+(defun %remote-eval (exp)
+  (%ini-remote-eval)
+  (when (! "isWritable" *eval-socket*)
+    (let ((utf8 (qutf8 (prin1-to-string exp))))
+      (x:do-with *eval-socket*
+        ("write(QByteArray)" (x:string-to-bytes (format nil "~D ~A" (length utf8) utf8)))
+        ("waitForBytesWritten")
+        ("waitForReadyRead")))
+    ;; data may arrive splitted in more blocks
+    (let* ((block-1 (! "readAll" *eval-socket*))
+           (pos-space (position (char-code #\Space) block-1)))
+      (when pos-space
+        (let ((head (x:bytes-to-string (subseq block-1 0 (1+ pos-space))))
+               data bytes-read)
+          (multiple-value-bind (size end)
+              (read-from-string head)
+            (push (subseq block-1 end) data)
+            (setf bytes-read (length (first data)))
+            (x:while (< bytes-read size)
+              (qprocess-events)
+              (! "waitForReadyRead" *eval-socket*)
+              (let ((block (! "readAll" *eval-socket*)))
+                (incf bytes-read (length block))
+                (push block data)))
+            (unless (zerop size)
+              (values (read-from-string (qfrom-utf8 (apply 'concatenate 'vector (nreverse data))))))))))))
+  
+#|
+(defun %log (str)
+  (with-open-file (out "/tmp/log.txt" :direction :output :if-does-not-exist :create :if-exists :append)
+    (format out "### ~A~%" (subseq str 0 (min (length str) 80)))))
+|#
+
+(ini)

examples/9-simple-lisp-editor/make-client.lisp

@@ -0,0 +1,21 @@
+#-eql5
+(error "Please use the EQL5 executable")
+
+(require :cmp)
+
+(defparameter *lisp-files* '("local-client"))
+
+(dolist (f *lisp-files*)
+  (let ((file (format nil "~A.lisp" f)))
+    (load file)
+    (compile-file file :system-p t)))
+
+(c:build-fasl "eql-local-client"
+              :lisp-files (mapcar (lambda (file)
+                                    (format nil "~A.~A" file #+msvc "obj" #-msvc "o"))
+                                  *lisp-files*))
+
+(dolist (file *lisp-files*)
+  (delete-file (format nil "~A.~A" file #+msvc "obj" #-msvc "o")))
+
+(eql:qq)

examples/9-simple-lisp-editor/make-editor.lisp

@@ -0,0 +1,23 @@
+#-eql5
+(error "Please use the EQL5 executable")
+
+(require :cmp)
+
+(defparameter *lisp-files* '("local-client"
+                             "settings"
+                             "editor"))
+
+(dolist (f *lisp-files*)
+  (let ((file (format nil "~A.lisp" f)))
+    (load file)
+    (compile-file file :system-p t)))
+
+(c:build-fasl "eql-editor"
+              :lisp-files (mapcar (lambda (file)
+                                    (format nil "~A.~A" file #+msvc "obj" #-msvc "o"))
+                                  *lisp-files*))
+
+(dolist (file *lisp-files*)
+  (delete-file (format nil "~A.~A" file #+msvc "obj" #-msvc "o")))
+
+(eql:qq)

examples/9-simple-lisp-editor/make-server.lisp

@@ -0,0 +1,26 @@
+#-eql5
+(error "Please use the EQL5 executable")
+
+(require :cmp)
+
+(defparameter *lisp-files* '("input-hook"
+                             "top-level"
+                             "query-dialog"
+                             "debug-dialog"
+                             "settings"
+                             "local-server"))
+
+(dolist (f *lisp-files*)
+  (let ((file (format nil "~A.lisp" f)))
+    (load file)
+    (compile-file file :system-p t)))
+
+(c:build-fasl "eql-local-server"
+              :lisp-files (mapcar (lambda (file)
+                                    (format nil "~A.~A" file #+msvc "obj" #-msvc "o"))
+                                  *lisp-files*))
+
+(dolist (file *lisp-files*)
+  (delete-file (format nil "~A.~A" file #+msvc "obj" #-msvc "o")))
+
+(eql:qq)

examples/9-simple-lisp-editor/my.lisp

@@ -0,0 +1,29 @@
+(in-package :eql-user)
+
+(defvar *window*    (qnew "QDialog"
+                          "windowTitle" "My Personal Analyst"))
+(defvar *label*     (qnew "QLabel"
+                          "text" "Please enter your <b>Top Secret</b> (you will feel better)"))
+(defvar *line-edit* (qnew "QLineEdit"
+                          "echoMode" |QLineEdit.Password|))
+(defvar *layout*    (qnew "QVBoxLayout(QWidget*)" *window*))
+
+(defun start ()
+  (x:do-with (qfun *layout* "addWidget")
+    *label*
+    *line-edit*)
+  (qconnect *line-edit* "returnPressed()" 'analyze)
+  (x:do-with *window* "show" "raise"))
+
+(defun analyze ()
+  (qlet ((dlg "QProgressDialog"
+              "maximum" 20
+              "labelText" "<h1 style='color:crimson'>Wow!</h1><p>(updating WikiLeaks...)</p>"))
+    (x:do-with dlg "show" "raise")
+    (dotimes (n (qget dlg "maximum"))
+      (sleep 0.1)
+      (qset dlg "value" n)
+      (qprocess-events)))
+  (qfun *line-edit* "clear"))
+
+(start)

examples/9-simple-lisp-editor/new.lisp

@@ -0,0 +1,6 @@
+(defpackage :my
+  (:use :common-lisp :eql)
+  (:export))
+
+(in-package :my)
+

examples/9-simple-lisp-editor/query-dialog.lisp

@@ -0,0 +1,25 @@
+(defpackage :query-dialog
+  (:use :common-lisp :eql)
+  (:export
+    #:*default-text*
+    #:get-text))
+
+(provide :query-dialog)
+
+(in-package :query-dialog)
+
+(defvar *default-text* "")
+
+(defun get-text (message)
+  (qlet ((dlg "QInputDialog(QWidget*,Qt::WindowFlags)" nil |Qt.WindowStaysOnTopHint|))
+    (x:do-with dlg
+      ("setInputMode" |QInputDialog.TextInput|)
+      ("setWindowTitle" (tr "Query Dialog"))
+      ("setLabelText" message)
+      ("setTextValue" *default-text*)
+      ("resize" '(400 0)))
+    (qlater (lambda () (x:do-with dlg "activateWindow" "raise")))
+    (if (= |QDialog.Accepted| (! "exec" dlg))
+        (! "textValue" dlg)
+        "")))
+

examples/9-simple-lisp-editor/send.lisp

@@ -0,0 +1,76 @@
+;;;
+;;; Send EQL code to "local-server": a trivial one-way use of EQL from any CL
+;;;
+;;;
+;;; Run: (after building the executable in "send/")
+;;;
+;;;   eql local-server.lisp
+;;;   ecl -load send.lisp / clisp -i send.lisp / sbcl --load send.lisp
+;;;
+;;;
+;;; Examples: (note #!)
+;;;
+;;;   #q (qmsg (package-name *package*))
+;;;
+;;;   #q (qmsg #!(package-name *package*))
+;;;
+;;;   (let ((a 1)
+;;;         (b 2))
+;;;     #q (qmsg (list #!a #!b)))
+;;;
+;;;   (defun msg (x)
+;;;     #q (qmsg #!x))
+;;;
+;;;   #q (load "../2-clock.lisp")
+;;;   #q (! "showMaximized" clock:*clock*)
+
+(set-dispatch-macro-character #\# #\q (lambda (stream c n) (%read-q stream)))
+
+(defmacro while-it (exp &body body)
+  `(do ((it))
+     ((not (setf it ,exp)))
+     ,@body))
+
+(defun %read-q (in)
+  (let ((string-q (with-output-to-string (out)
+                    (let ((ex #\Space)
+                          parens in-string)
+                      (loop
+                        (let ((ch (read-char in)))
+                          (write-char ch out)
+                          (unless (char= #\\ ex)
+                            (if (char=  #\" ch)
+                                (setf in-string (not in-string))
+                                (unless in-string
+                                  (case ch
+                                    (#\( (if parens (incf parens) (setf parens 1)))
+                                    (#\) (decf parens)))
+                                  (when (and parens (zerop parens))
+                                    (return)))))
+                          (setf ex ch))))))
+        list-q)
+    (while-it (search "#!" string-q)
+      (multiple-value-bind (exp end)
+          (read-from-string (subseq string-q (+ it 2)))
+        (unless (zerop it)
+          (push (subseq string-q 0 it) list-q))
+        (push (list 'prin1-to-string exp) list-q)
+        (setf string-q (subseq string-q (+ it 2 end)))))
+    (push string-q list-q)
+    `(send-q (list ,@(reverse list-q)))))
+
+(defun send-q (data)
+  (#+ecl                 ext:run-program
+   #+clisp                   run-program
+   #+sbcl             sb-ext:run-program
+   #+darwin                  "./send/send.app/Contents/MacOS/send"
+   #+(and unix (not darwin)) "./send/send"
+   #+win32                   "send/send.exe"
+   #+clisp                   :arguments
+   (list (etypecase data
+           (string
+             data)
+           (list
+             (format nil "~{~A~^ ~}" (mapcar (lambda (x) (string-trim " " x)) data)))))
+   #+ecl :error #+ecl nil))
+

examples/9-simple-lisp-editor/send/send.cpp

@@ -0,0 +1,31 @@
+#include <QtCore>
+#include <QtNetwork>
+#include <QtDebug>
+#include <iostream>
+
+int main(int argc, char** argv) {
+    QCoreApplication qapp(argc, argv);
+    QLocalSocket socket;
+    socket.connectToServer("EQL:local-server");
+    socket.waitForConnected();
+    qapp.processEvents();
+    QString exp(QCoreApplication::arguments().at(1));
+    if(socket.isWritable()) {
+        QString data(QString::number(exp.size()) + " " + exp);
+        socket.write(data.toLatin1());
+        qapp.processEvents();
+        socket.waitForBytesWritten();
+        while(true) {
+            socket.waitForReadyRead();
+            qapp.processEvents();
+            QString data(socket.readAll());
+            QString type(data.section(' ', 1, 1));
+            if(!(":EXPRESSION" == type)) {
+                QString print(data.section(' ', 2).trimmed());
+                if(!print.isEmpty()) {
+                    std::cout << qPrintable(print) << std::endl; }
+                if(":VALUES" == type) {
+                    exit(0); }}}}
+    qCritical() << "[send] error:" << exp;
+    return -1; }
+

examples/9-simple-lisp-editor/send/send.pro

@@ -0,0 +1,9 @@
+QT          += network
+TEMPLATE    = app
+CONFIG      += release
+DESTDIR     = ./
+TARGET      = send
+OBJECTS_DIR = ./tmp/
+MOC_DIR     = ./tmp/
+
+SOURCES += send.cpp