Sun Apr  5 19:56:16 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * initial import
diff -rN -u old-qt.core/CMakeLists.txt new-qt.core/CMakeLists.txt
--- old-qt.core/CMakeLists.txt	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/CMakeLists.txt	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,7 @@
+cmake_minimum_required(VERSION 2.6)
+
+project(qt)
+
+add_subdirectory(src)
+
+include(UseDoxygen OPTIONAL)
diff -rN -u old-qt.core/TODO new-qt.core/TODO
--- old-qt.core/TODO	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/TODO	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1 @@
+* QApplication and KCmdLineArgs.init call exit() on e.g. "--help"
diff -rN -u old-qt.core/examples/hello-world.lisp new-qt.core/examples/hello-world.lisp
--- old-qt.core/examples/hello-world.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/examples/hello-world.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,63 @@
+(in-package :qt-examples)
+(declaim (optimize (debug 3)))
+
+(defun hello-world ()
+  "Hello world"
+  (qt:with-app
+    (let ((widget (make-instance 'qt:push-button :args '("Hello world"))))
+      (cxx:show widget)
+      (qt:exec))))
+
+
+(defun hello-world-quit ()
+  "Quit on push-button click"
+  (qt:with-app
+    (let ((quit (make-instance 'qt:push-button :args '("Quit"))))
+      (cxx:resize quit 75 30)
+      (cxx:set-font quit (make-instance 'qt:font :args (list "Times"
+                                                             18
+                                                            qt:font.+bold+)))
+      
+      (qt:object.connect quit (qt:qsignal "clicked()")
+                   (qt:app) (qt:qslot "quit()"))
+      (cxx:show quit)
+      (qt:exec))))
+
+(defun hello-world-gc ()
+  "GC on push-button click"
+  (qt:with-app
+    (let ((gc (make-instance 'qt:widget)))
+      (let ((layout (make-instance 'qt:vbox-layout))
+            (button (make-instance 'qt:push-button :args '("GC"))))
+        (trivial-garbage:gc :full t)
+        (cxx:add-widget layout button)
+        (trivial-garbage:gc :full t)
+        (cxx:set-layout gc layout)
+        (trivial-garbage:gc :full t)
+        (qt:connect-function button "clicked()"
+                             #'(lambda () 
+                                 (format t "GC-ing~%")
+                                 (trivial-garbage:gc :full t))))
+        (trivial-garbage:gc :full t)
+      (cxx:show gc)
+        (trivial-garbage:gc :full t)
+      (qt:exec))))
+
+;; You need to run cmake & make to generate the .po and .qm files
+(defun i18n-hello-world ()
+  "i18n hello world"
+  (qt:with-app
+    (qt:with-translator "hello-world"
+      (let ((widget (make-instance 'qt:label)))
+        (setf (qt:property widget 'window-title)
+              (qt:tr "Lisp Qt Example" "hello-world"))
+        (cxx:set-text widget
+                      (format nil (qt:tr "<h1>Hello world</h1>
+
+You are running ~A version ~A on a ~A ~A")
+                              (lisp-implementation-type)
+                              (lisp-implementation-version)
+                              (software-type)
+                              (software-version)))
+        (cxx:show widget)
+        (qt:exec)))))
diff -rN -u old-qt.core/examples/package.lisp new-qt.core/examples/package.lisp
--- old-qt.core/examples/package.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/examples/package.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,15 @@
+(defpackage #:qt-examples
+  (:use #:cl)
+  (:export #:hello-world
+           #:i18n-hello-world
+           #:hello-world-quit
+           #:hello-world-gc
+
+           #:class-browser
+
+           #:tick-tack-toe
+           #:repl
+
+           #:launcher
+           
+           #:load-ui-file))
diff -rN -u old-qt.core/qt.mbd new-qt.core/qt.mbd
--- old-qt.core/qt.mbd	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/qt.mbd	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,65 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+
+;;; SYSDEF.CMAKE
+(defpackage :sysdef.cmake
+  (:use :cl :sysdef)
+  (:export :cmake-file :cmake-library))
+
+(in-package :sysdef.cmake)
+(defclass sysdef.cmake:cmake-file (source-file)
+  ()
+  (:default-initargs :type "txt"))
+
+(defclass sysdef.cmake:cmake-library (component)
+  ())
+;;; end SYSDEF.CMAKE
+
+(in-package :sysdef-user)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (use-package :sysdef.cmake))
+
+(define-system :qt ()
+  (:version 0 0 1)
+  (:documentation "Smoke Qt bindings.")
+  (:keywords "GUI" "Qt")
+  (:author "Tobias Rautenkranz")
+  (:components 
+   ("CMakeLists" sysdef.cmake:cmake-file)
+   ("src" module
+          (:needs "CMakeLists")
+          (:components
+           ("CMakeLists.txt" static-file)
+           "package"
+           ("lib" module
+                  (:needs "package")
+                  (:components 
+                   ("libqt-smoke-extra" sysdef.cmake:cmake-library)
+
+                   ("CMakeLists.txt" static-file)
+                   ("qt-smoke.cpp" static-file)
+                   ("lisp-object.h" static-file)
+                   ("lisp-object.cpp" static-file)
+                   ("qstring.cpp" static-file)
+                   ("qstringlist.cpp" static-file)))
+
+           ("qt" (:needs "package" "lib"))
+           ("object" (:needs "qt"))
+           ("application" (:needs "qt"))
+           ("qstring" (:needs "qt"))
+           ("msg-handler" (:needs "lib"))
+           ("painter" (:needs "qt"))
+           ("i18n" (:needs "qt"))
+	   ("lisp-object" (:needs "qt" "lib"))
+           ("signal-slot" module
+                          (:needs "lisp-object")
+                          (:serial t)
+                          (:components
+                           "signal-slot"
+                           "translate"
+                           "signal"
+                           "slot"
+                           "connect"))
+           ("string-list" (:needs "qt" "lib" "qstring"))
+           ("variant" (:needs "qt" "qstring" "lisp-object"))
+           ("properties" (:needs "variant")))))
+  (:needs :smoke :sysdef.cmake :cffi))
diff -rN -u old-qt.core/src/CMakeLists.txt new-qt.core/src/CMakeLists.txt
--- old-qt.core/src/CMakeLists.txt	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/CMakeLists.txt	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1 @@
+add_subdirectory(lib)
diff -rN -u old-qt.core/src/application.lisp new-qt.core/src/application.lisp
--- old-qt.core/src/application.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/application.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,104 @@
+(in-package :qt)
+
+(declaim (optimize (debug 3)))
+
+(defvar *app*)
+(defvar *widgets* nil)
+
+(defun app ()
+  "Returns the APPLICATION (or CORE-APPLICATION) object,
+within a WITH-APP."
+  (assert (app-p)
+          (*app*))
+  *app*)
+
+(defun app-p ()
+  "Returns t when the APPLICATION object exists and nil otherwise."
+  (boundp '*app*))
+
+
+(let ((argv (null-pointer))
+      (argc (null-pointer)))
+  (declare (cffi:foreign-pointer argv argc))
+  (defun ensure-app (&optional 
+                     (application 'application)
+                     (args #+sbcl sb-ext:*posix-argv*
+                           #-sbcl (list (lisp-implementation-type))))
+    "Constructs the global application object, when there is none,
+with the command line arguments ARGS.
+
+Returns the application object a first value and
+true when a new application was created and false otherwise."
+    (assert (not (null args))
+            (args)
+            "No program name supplied.")
+    (if (app-p)
+        (progn
+          (assert (typep (app) (find-class application))
+                  (application)
+                  "The existing application object ~A is
+not of type ~A." (app) (find-class application))
+          (values (app) nil))
+        (progn
+;          (assert (null-pointer-p (smoke::pointer (core-application.instance))))
+            (foreign-free argv)
+            (foreign-free argc)
+
+          (setf argv (foreign-alloc :string :initial-contents args))
+          (setf argc (foreign-alloc :int :initial-element (length args)))
+          (values (qt:new "QApplication" "QApplication$?" argc argv) t))))
+  (defun kill-app ()
+    (cxx:quit (app))
+    (when (typep (app) (find-class 'qt:application))
+      (application.close-all-windows))
+    (setf *widgets* nil)
+    (trivial-garbage:cancel-finalization (app))
+    ;(smoke::remove-object (smoke::pointer (app)))
+    (smoke::delete-pointer (smoke::pointer (app)) (class-of (app)))
+    (setf (slot-value (app) 'pointer) (null-pointer))
+;    (foreign-free argc)
+    (setf argc (null-pointer))
+;    (foreign-free argv)
+    (setf argv (null-pointer))
+    (makunbound '*app*)))
+
+(defmacro with-application ((ensure-app remove-app) &body body)
+  (let ((cleanup-p (gensym "cleanup-p")))
+    `(let ((,cleanup-p nil))
+       (multiple-value-setq (*app* ,cleanup-p) ,ensure-app)
+       (unwind-protect
+            (progn
+              ,@body)
+         (when ,cleanup-p
+           ,remove-app
+           (makunbound '*app*))))))
+
+(defmacro with-app (&body body)
+  "Ensures that a APPLICATION instance exists, 
+evaluates BODY and executes the APPLICATION instance after BODY.
+The instance can be accessed with:
+APP.
+
+Can be nested.
+
+When a APPLICATION was created, it will be deleted when returning
+from BODY."
+  `(with-application ((ensure-app 'application) (kill-app))
+                      ,@body))
+
+(defmacro with-core-app (&body body)
+  `(with-application ((ensure-app 'core-application) (kill-app))
+                      ,@body))
+  
+
+(defun exec (&rest widgets)
+  "Executes APP."
+  (setf *widgets* (append widgets *widgets*))
+  (restart-bind ((abort-app #'(lambda ()
+                                (application.close-all-windows)
+                                (cxx:quit (app))
+                                (invoke-restart (find-restart 'continue)))
+                   :report-function
+                   #'(lambda (stream)
+                       (format stream "Return from the application event loop."))))
+    (cxx:exec (app))))
diff -rN -u old-qt.core/src/i18n.lisp new-qt.core/src/i18n.lisp
--- old-qt.core/src/i18n.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/i18n.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,42 @@
+(in-package :qt)
+
+(defun tr (message &optional context)
+  "Returns the translated MESSAGE for CONTEXT or
+a string STRING-EQUAL to MESSAGE when no translation was found.
+
+Translations can be loaded with WITH-TRANSLATOR."
+  (qt:core-application.translate (or context "") message))
+
+(defmacro with-installed-translator (translator &body body)
+  `(unwind-protect
+       (progn
+         (cxx:install-translator (qt:app) ,translator)
+         ,@body)
+     (cxx:remove-translator (qt:app) ,translator)))
+
+(defmacro with-translator (base-name &body body)
+  "Loads the translations in the BASE-NAME_LANGCODE.qm file.
+
+Must be in a WITH-APP."
+  (let ((translator (gensym)))
+    `(let ((,translator (make-instance 'translator)))
+       (unless (cxx:load ,translator (format nil "~A_~A"
+                                             ,base-name
+                                             (cxx:name (qt:locale.system))))
+         (cerror "Ignore" "Loading the translations ~A for ~A failed."
+                 ,base-name (cxx:name (qt:locale.system))))
+       (with-installed-translator ,translator
+         ,@body))))
+
+(defmacro with-libqt-translator (&body body)
+  "Loads the translations for the Qt library.
+
+Must be in a WITH-APP."
+  (let ((translator (gensym)))
+    `(let ((,translator (make-instance 'translator)))
+       (unless (cxx:load ,translator (format nil "qt_~A"
+                                             (cxx:name (qt:locale.system)))
+                         (qt:library-info.location qt:library-info.+translations-path+))
+         (cerror "Ignore" "Loading the Qt library translations failed."))
+       (with-installed-translator ,translator
+         ,@body))))
diff -rN -u old-qt.core/src/lib/CMakeLists.txt new-qt.core/src/lib/CMakeLists.txt
--- old-qt.core/src/lib/CMakeLists.txt	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lib/CMakeLists.txt	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,7 @@
+find_package(Qt4)
+set(QT_DONT_USE_QTGUI true)
+include(${QT_USE_FILE})
+
+set(QT_SMOKE_SOURCES qt-smoke.cpp qstring.cpp qstringlist.cpp lisp-object.cpp)
+add_library(qt-smoke-extra MODULE ${QT_SMOKE_SOURCES})
+target_link_libraries(qt-smoke-extra ${QT_LIBRARIES})
diff -rN -u old-qt.core/src/lib/lisp-object.cpp new-qt.core/src/lib/lisp-object.cpp
--- old-qt.core/src/lib/lisp-object.cpp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lib/lisp-object.cpp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,179 @@
+#include "lisp-object.h"
+
+#include <QtGlobal>
+#include <QtDebug>
+
+namespace cl_smoke {
+namespace qt {
+
+/** @struct lisp_object::data
+ * @internal
+ * Holds a reference ID for a lisp object and calls
+ * the destructor callback when it is deleted.
+ */
+
+/** @typedef lisp_object::destructor
+ * Destructor.
+ * @param id The ID
+ */
+
+lisp_object::destructor lisp_object::destruct = NULL;
+
+
+/** Constructor. */
+lisp_object::data::data()
+: id(id),
+  is_set(false)
+{ }
+
+/** Constructor.
+ * @param id The ID.
+ */
+lisp_object::data::data(int id)
+: id(id),
+  is_set(true)
+{ }
+
+/** Destructor. */
+lisp_object::data::~data()
+{
+	Q_ASSERT_X(lisp_object::destruct, __func__,
+			"call setup_lisp_object() first.");
+
+	if (this->is_set)
+		(*lisp_object::destruct)(this->id);
+}
+
+/** @class lisp_object
+ * @brief Holds a reference ID to a lisp object. 
+ *
+ * The registered destructor callback is called when
+ * the last instance for a specific lisp object is deleted.
+ *
+ * Used for lisp objects in QVariants and signal/slots.
+ */
+
+/** Constructor. */
+lisp_object::lisp_object()
+	: d(new data())
+{ }
+
+/** Constructor.
+ * @param id the ID
+ */
+lisp_object::lisp_object(int id)
+	: d(new data(id))
+{ }
+
+/** Constructor.
+ * @param other the lisp_object to copy
+ */
+lisp_object::lisp_object(const lisp_object& other)
+	: d(other.d)
+{ }
+
+/** @fn lisp_object::id() const
+ * Gets the ID.
+ *
+ * @return the ID
+ */
+
+/** @fn lisp_object::set() const
+  * Determines werter the ID is set.
+  *
+  * @return @c true when the id is set and @c false otherwise.
+  */
+
+/** Sets a new ID.
+ * @param id the ID
+ */
+void
+lisp_object::set_id(int id)
+{
+	Q_ASSERT(this->set() ? id != this->id() : true);
+
+	d = new data(id);
+}
+
+} // namespace qt
+} // namespace cl_smoke
+
+using namespace cl_smoke::qt;
+
+/** Initialize the lisp_object.
+ * @relates cl_smoke::qt::lisp_object
+ * @param destruct destructor callback
+ *
+ * @return the QMetaType ID of lisp_object
+ */
+int
+qt_smoke_setup_lisp_object(void* destruct)
+{
+	Q_ASSERT(destruct != NULL);
+	lisp_object::destruct = reinterpret_cast<lisp_object::destructor>(destruct);
+
+	return qRegisterMetaType<lisp_object>();
+}
+
+/** Gets the ID of @a object.
+ * @relates cl_smoke::qt::lisp_object
+ * @param object the lisp_object.
+ *
+ * @return the ID
+ */
+int
+qt_smoke_lisp_object_id(const void* object)
+{
+	return static_cast<const lisp_object*>(object)->id();
+}
+
+
+/** Determines werter the ID of @a object is set.
+ * @relates cl_smoke::qt::lisp_object
+ * @param object the object
+ *
+ * @return @c true when the ID is set and @c false otherwise.
+ */
+int
+qt_smoke_lisp_object_set(const void* object)
+{
+	return static_cast<const lisp_object*>(object)->set();
+}
+
+/** Makes a new lisp_object.
+ * @relates cl_smoke::qt::lisp_object
+ * @param id the ID
+ *
+ * @return A new lisp_object instance.
+ */
+void*
+qt_smoke_make_lisp_object(int id)
+{
+	return new lisp_object(id);
+}
+
+/** Deletes a lisp_object.
+ * @relates cl_smoke::qt::lisp_object
+ * @param object the lisp_object
+ */
+void*
+qt_smoke_free_lisp_object(void* object)
+{
+	delete static_cast<lisp_object*>(object);
+}
+
+#include <QVariant>
+/** Gets the lisp_object of a QVariant.
+ * @relates cl_smoke::qt::lisp_object
+ * @param variant the QVariant
+ * 
+ * @return a new lisp_object.
+ */
+void*
+qt_smoke_lisp_object_value(const void* variant)
+{
+	const QVariant* qvariant = static_cast<const QVariant*>(variant);
+	Q_ASSERT(QVariant::UserType == qvariant->type());
+
+	new lisp_object(qvariant->value<lisp_object>());
+}
diff -rN -u old-qt.core/src/lib/lisp-object.h new-qt.core/src/lib/lisp-object.h
--- old-qt.core/src/lib/lisp-object.h	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lib/lisp-object.h	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,82 @@
+#ifndef LISP_OBJECT_H
+#define LISP_OBJECT_H
+
+#include <QMetaType>
+#include <QSharedData>
+#include <QExplicitlySharedDataPointer>
+#include <smoke.h>
+
+
+extern "C"
+{
+	int
+	qt_smoke_setup_lisp_object(void* destruct);
+
+	int
+	qt_smoke_lisp_object_id(const void* object);
+
+	int
+	qt_smoke_lisp_object_set(const void* object);
+
+	void*
+	qt_smoke_make_lisp_object(int id);
+
+	void*
+	qt_smoke_free_lisp_object(void* object);
+
+	void*
+	qt_smoke_lisp_object_value(const void* variant);
+}
+
+namespace cl_smoke {
+namespace qt {
+
+class lisp_object
+{
+	public:
+		typedef void (*destructor)(int id);
+
+		lisp_object();
+
+		lisp_object(int id);
+
+		lisp_object(const lisp_object& other);
+
+		inline int
+		id() const
+		{ Q_ASSERT(this->set()); return d->id; }
+
+		void
+		set_id(int id);
+
+		inline bool
+		set() const
+		{ return d->is_set; }
+
+		friend int
+		::qt_smoke_setup_lisp_object(void* destruct);
+
+	private:
+		struct data : public QSharedData
+		{
+			data();
+			data(int id);
+			~data();
+			int id;
+			bool is_set;
+
+			private:
+			Q_DISABLE_COPY(data)
+		};
+
+		QExplicitlySharedDataPointer<data> d;
+
+		static destructor destruct;
+};
+
+} // namespace qt
+} // namespace cl_smoke
+
+Q_DECLARE_METATYPE(cl_smoke::qt::lisp_object);
+
+#endif // LISP_OBJECT_H
diff -rN -u old-qt.core/src/lib/qstring.cpp new-qt.core/src/lib/qstring.cpp
--- old-qt.core/src/lib/qstring.cpp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lib/qstring.cpp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,44 @@
+#include <QString>
+#include <QtDebug>
+
+/** @file
+ * @brief QString conversion. */
+
+extern "C" {
+
+/** Converts a QString to a QByteArray.
+ * @param qstring Pointer to a QString
+ *
+ * @return a pointer to a newly allocated char array. 
+ */
+void*
+qt_smoke_qstring_to_byte_array(const void* qstring)
+{
+	Q_ASSERT(qstring);
+	const QString* string = static_cast<const QString*>(qstring);
+
+	return new QByteArray(string->toLocal8Bit());
+}
+
+/** Frees an QString.
+ * @param qstring the QString to free
+ */
+void
+qt_smoke_free_qstring(void* qstring)
+{
+	delete static_cast<QString*>(qstring);
+}
+
+/** Converts a string to a QString.
+ * @param data a char array
+ * @param length the length of @a data
+ *
+ * @return a newly allocated QString
+ */
+void*
+qt_smoke_string_to_qstring(const char* data, int length)
+{
+	return new QString(QString::fromLocal8Bit(data, length));
+}
+
+} // extern "C"
diff -rN -u old-qt.core/src/lib/qstringlist.cpp new-qt.core/src/lib/qstringlist.cpp
--- old-qt.core/src/lib/qstringlist.cpp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lib/qstringlist.cpp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,69 @@
+#include <QStringList>
+#include <QtDebug>
+#include <cstring>
+
+/** @file
+ * @brief QStringList conversion. */
+
+extern "C" {
+
+/** Returns the number of items of @a string_list.
+ * @param string_list the QStringList
+ *
+ * @return the number of items
+ */
+int
+qt_smoke_string_list_size(const void* string_list)
+{
+	Q_ASSERT(string_list);
+	return static_cast<const QStringList*>(string_list)->size();
+}
+
+/** Returns the byte array of @a string_list at position @a index.
+ * @param string_list the QStringList
+ * @param index the index of the string
+ *
+ * @return a new allocated byte-array
+ */
+void*
+qt_smoke_string_list_at(const void* string_list, int index)
+{
+	Q_ASSERT(string_list);
+	const QStringList* list = static_cast<const QStringList*>(string_list);
+
+	Q_ASSERT(0 <= index && index < list->size());
+		
+	return new QByteArray(list->at(index).toLocal8Bit());
+}
+
+/** Free a QStringList.
+ * @param string_list the QStringList to free
+ */
+void
+qt_smoke_free_string_list(void* string_list)
+{
+	delete static_cast<QStringList*>(string_list);
+}
+
+/** Allocates a new QStringList.
+ *
+ * @return a new QStringList
+ */
+void*
+qt_smoke_make_string_list()
+{
+	return new QStringList();
+}
+
+/** Appends @a string to @a string_list
+ * @param string_list the QStringList
+ * @param data the string
+ * @param length the length of @a data
+ */
+void
+qt_smoke_string_list_append(void* string_list, const char* data, int length)
+{
+	static_cast<QStringList*>(string_list)->append(QString::fromLocal8Bit(data, length));
+}
+
+} // extern "C"
diff -rN -u old-qt.core/src/lib/qt-smoke.cpp new-qt.core/src/lib/qt-smoke.cpp
--- old-qt.core/src/lib/qt-smoke.cpp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lib/qt-smoke.cpp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,26 @@
+#include <qnamespace.h>
+#include <QEvent>
+#include <QtDebug>
+
+/** @file
+ * @brief Qt support functions */
+
+extern "C" {
+
+/** Registers a callback to be invoked for every QEvent.
+ * @see QCoreApplication::notifyInternal
+ *
+ * @param callback the callback
+ * 
+ * @return @c true on success and @c false when the callback table is full.
+ */
+int
+qt_smoke_register_event_notify(void* callback)
+{
+	Q_ASSERT(callback);
+
+	return QInternal::registerCallback(QInternal::EventNotifyCallback,
+			reinterpret_cast<qInternalCallback>(callback));
+}
+
+} // extern "C"
diff -rN -u old-qt.core/src/lisp-object.lisp new-qt.core/src/lisp-object.lisp
--- old-qt.core/src/lisp-object.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lisp-object.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,62 @@
+(in-package :qt)
+(declaim (optimize (debug 3)))
+
+(defvar *cxx-lisp-objects* (make-hash-table)
+  "Objects that are currently passed in a C++ class.")
+
+(let ((id 0))
+  (defun gen-cxx-lisp-object-id ()
+    "Returns a new unique ID."
+    (incf id)))
+
+(defcfun qt-smoke-setup-lisp-object :int
+  (destruct :pointer))
+
+(defcfun qt-smoke-lisp-object-id :int
+  (object :pointer))
+
+(defcfun qt-smoke-lisp-object-set :int
+  (object :pointer))
+
+(defcfun qt-smoke-make-lisp-object :pointer
+  (id :int))
+
+(defcfun qt-smoke-free-lisp-object :void
+  (object :pointer))
+
+(defcallback destruct-cxx-lisp-object :void
+    ((id :int))
+  (remhash id *cxx-lisp-objects*))
+
+(defvar *cxx-lisp-object-metatype*)
+
+(eval-when (:load-toplevel)
+  (setf *cxx-lisp-object-metatype*
+        (qt-smoke-setup-lisp-object (callback destruct-cxx-lisp-object)))
+  (assert (>= *cxx-lisp-object-metatype*
+              (smoke::value meta-type.+user+))
+          (*cxx-lisp-object-metatype*)
+          "setup of lisp-object failed"))
+
+(defun make-cxx-lisp-object (object)
+  "Constructs a C++ object wrapper for OBJECT."
+  (let ((id (gen-cxx-lisp-object-id)))
+    (setf (gethash id *cxx-lisp-objects*) object)
+    (qt-smoke-make-lisp-object id)))
+
+(defun free-cxx-lisp-object (pointer)
+  "Deletes the lisp_object at POINTER."
+  (qt-smoke-free-lisp-object pointer))
+;;  (qmetatype.destroy *cxx-lisp-object-metatype* pointer)) ;; FIXME use this?
+
+(defun translate-cxx-lisp-object (pointer)
+  "Returns the object of the cxx-lisp-object at POINTER.
+
+When beeing received as an argument by a slot,
+the object must not be deallocated."
+  (multiple-value-bind (value present-p)
+      (gethash (qt-smoke-lisp-object-id pointer)
+               *cxx-lisp-objects*)
+    (assert present-p (value present-p)
+            "No object for ~A in ~A" pointer *cxx-lisp-objects*)
+    value))
diff -rN -u old-qt.core/src/msg-handler.lisp new-qt.core/src/msg-handler.lisp
--- old-qt.core/src/msg-handler.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/msg-handler.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,26 @@
+(in-package :qt)
+
+(cffi:defcenum qt-msg-type
+  (:debug-message)
+  (:warning-message)
+  (:critical-message)
+  (:fatal-message))
+
+(defcallback qt-msg-handler :void
+    ((type qt-msg-type)
+     (message :string))
+  (ecase type
+    (:debug-message
+     (write-string "qDebug: " *debug-io*)
+     (write-line message *debug-io*))
+    (:warning-message (warn message))
+    (:critical-message (cerror "Ignore" "~A" message))
+    (:fatal-message (error message))))
+
+(defun register-msg-handler ()
+  (with-foreign-object (handler :pointer)
+    (setf (mem-ref handler :pointer) (callback qt-msg-handler))
+    (qt:q-install-msg-handler handler)))
+
+(eval-when (:load-toplevel)
+  (register-msg-handler))
diff -rN -u old-qt.core/src/object.lisp new-qt.core/src/object.lisp
--- old-qt.core/src/object.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/object.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,190 @@
+(in-package :qt)
+(declaim (optimize (debug 3)))
+
+(let ((object (make-instance 'object)))
+  (defmethod cxx:static-meta-object ((class (eql (find-class 'object))) &rest args)
+    "No OBJECT.STATIC-META-OBJECT (r558420)."
+    (declare (ignore args))
+    (cxx:meta-object object))
+  (defmethod cxx:static-meta-object ((class smoke::smoke-wrapper-class) &rest args)
+    (declare (ignore args))
+    (cxx:static-meta-object (smoke::find-smoke-class class))))
+
+(defmethod documentation :around ((class smoke::smoke-standard-class)
+                                  (doc-type t))
+  (if (and (subtypep class (find-class 'object))
+           (not (subtypep class (find-class 'smoke::smoke-wrapper-class))))
+      (format nil "~@[~A~%~]Properties:~%~T~{~<~%~T~0,75:; ~(~A~)~>~}
+
+Signals:
+~{~T~A~%~}
+Slots:
+~{~T~A~%~}"
+              (call-next-method) (sort (class-properties class) #'string<=)
+              (sort (class-signals class) #'string<=)
+              (sort (class-slots class) #'string<=))
+      (call-next-method)))
+
+(defun meta-object-methods (meta-object &optional (direct-only nil))
+  (loop for index from (if direct-only (cxx:method-offset meta-object) 0)
+     below (cxx:method-count meta-object)
+     collect (cxx:method meta-object index)))
+
+
+(defun meta-object-signals (meta-object)
+  (mapcar #'cxx:signature
+          (remove-if-not #'(lambda (m) (enum= qt:meta-method.+signal+
+                                                  (cxx:method-type m)))
+                         (meta-object-methods meta-object))))
+
+(defun class-signals (class)
+  (meta-object-signals (cxx:static-meta-object class)))
+
+(defun meta-object-slots (meta-object)
+  (mapcar #'cxx:signature
+          (remove-if-not #'(lambda (m) (enum= qt:meta-method.+slot+
+                                                  (cxx:method-type m)))
+                         (meta-object-methods meta-object))))
+
+
+(defun class-slots (class)
+  (meta-object-slots (cxx:static-meta-object class)))
+
+
+(defvar *children* (make-hash-table)
+  "A list of custom subclasses of QObject which have a parent
+and therefor must not be garbage collected.")
+
+(defmethod initialize-instance :after ((object object)
+                                        &key pointer &allow-other-keys)
+  "Registers the object to the parent when a parent was set in the constructor
+and the objects metaclass is SMOKE-WRAPPER-CLASS."
+  (when (and (null pointer)
+             (null-pointer-p (smoke::pointer object)))
+    (error "Object ~A has not been constructed" object))
+  (when (and (null pointer)
+             (not (null-pointer-p (smoke::pointer object)))
+;             (typep (class-of object) 'smoke::smoke-wrapper-class)
+             (not (null-pointer-p (smoke::pointer (cxx:parent object)))))
+    (setf (gethash (smoke::pointer object) *children*) object)))
+
+(define-condition wrapper-gc (storage-condition)
+  ((class-name :initarg :class-name
+               :documentation "The class name of the gc'ed object.")
+   (pointer :initarg :pointer))
+  (:report (lambda (condition stream)
+             (format stream "The object ~A ~A of type smoke-wrapper-class
+has a parent but got garbage collected."
+                     (slot-value condition 'class-name)
+                     (slot-value condition 'pointer)))))
+
+(let ((get-parent (smoke::make-smoke-method (smoke::make-smoke-class
+                                             *qt-smoke*
+                                             "QObject")
+                                            "parent"))
+      ;; FIXME this leaks memory when QCoreApplication::exec is never called,
+      ;;  beause then, deleteLater has no effect.
+      (delete-later (smoke::make-smoke-method (smoke::make-smoke-class
+                                               *qt-smoke*
+                                               "QObject")
+                                              "deleteLater")))
+  (defmethod smoke::make-finalize ((object object))
+    "Delete the qt:object OBJECT,
+ by calling cxx:delete-later iff it has no parent."
+    (let ((pointer (pointer object))
+          (name (class-name (class-of object)))
+          (next (call-next-method)))
+      (if (typep (class-of object) 'smoke::smoke-wrapper-class)
+          #'(lambda ()
+              (handler-case 
+                  (if (null-pointer-p (smoke::pointer-call get-parent pointer))
+                      (smoke::pointer-call delete-later pointer)
+                      (error (make-condition 'wrapper-gc :class-name name
+                                             :pointer pointer)))
+                (condition (condition)
+                  (format *debug-io* "error: wrap finalize ~A ~A~%" name
+                          condition))))
+          #'(lambda ()
+              (handler-case 
+                  (progn
+                  (when (null-pointer-p (smoke::pointer-call get-parent pointer))
+                    (funcall next)))
+                (condition (condition)
+                  (format *debug-io* "error: qfinalize ~A ~A ~A~%" name
+                          pointer
+                          condition)))))))
+                                        ;(smoke::pointer-call delete-later pointer)))))))
+  )
+(defun cxx-gc ()
+  "Delete the C++ object that have been queued for deletion when
+QT:CORE-APPLICATION.EXEC is run."
+  (core-application.send-posted-events 
+   (make-instance 'object :pointer (null-pointer))
+event.+deferred-delete+))
+
+
+;(defmethod upcast-object ((objeckt qobject))
+;  (let ((class-name (cxx:classname (cxx:metaobject object))))
+;    (if (string= class-name (name (get-class object)))
+;        object
+;        (let ((real-class (lispify class-name)))
+;;FIXME get smoke module from class name
+;        (make-instance
+;         :pointer upcast (object class))))))))
+        
+     
+;(defmethod upcast-object ((event qevent))
+;  (case (cxx:type event)
+;    (#.qevent.+childadded+
+
+;;;
+;;; The event-notify callback get called by QCoreApplication,
+;;; on notification of an event.
+;;;
+;;; The DATA argument is an array of size three, containing the pointers:
+;;;  void* receiver
+;;;  void* event
+;;;  void* result
+;;; in that order.
+;;; 
+;;; Returning true marks the event as handled; false on the other hand
+;;; leaves the event processing unchanged.
+;;;
+;;; See: QCoreApplication::notifyInternal(QObject *receiver, QEvent *event)
+
+(cffi:defcallback event-notify smoke:cxx-bool
+    ((data :pointer))
+  (declare (optimize (speed 3)))
+  (let ((event (make-instance 'event :pointer (cffi:mem-aref data :pointer 1)
+                              :owned-p nil)))
+    (enum-case (cxx:type event)
+      (event.+child-added+
+       (let* ((child-event (make-instance 'child-event
+                                          :pointer
+                                          (smoke::upcast event (find-class 'child-event))
+                                          :owned-p nil))
+              (child (smoke::get-object
+                      (smoke::pointer (cxx:child child-event)))))
+;         (when (and child
+;                    (typep (class-of child)
+;                           'smoke::smoke-wrapper-class))
+         (when child
+           (setf (gethash (smoke::pointer child) *children*) child))))
+      (event.+child-removed+
+       (let* ((child-event (make-instance 'child-event
+                                          :pointer (smoke::upcast event
+                                                                  (find-class 'child-event))
+                                          :owned-p nil)))
+         (remhash (smoke::pointer (cxx:child child-event)) *children*)))))
+  nil)
+    
+(cffi:defcfun qt-smoke-register-event-notify :boolean
+  (event-notify :pointer))
+
+(defun register-event-notify ()
+  (let ((ret (qt-smoke-register-event-notify (cffi:callback event-notify))))
+    (unless ret
+      (error "The event-notify callback table is full."))))
+
+(eval-when (:load-toplevel)
+ (register-event-notify))
diff -rN -u old-qt.core/src/package.lisp new-qt.core/src/package.lisp
--- old-qt.core/src/package.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/package.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,40 @@
+(defpackage :qt
+  (:use :cl :asdf :smoke :cffi :bordeaux-threads :cxx-support)
+  (:export #:new
+           #:call
+
+           #:app
+           #:app-p
+           #:exec
+           #:with-app
+           #:with-core-app
+
+           #:with-painter
+           
+           #:tr
+           #:with-translator
+           #:with-libqt-translator 
+
+           #:qmethod
+           #:qsignal
+           #:qslot
+
+           #:property
+           #:property-p
+           #:properties
+           #:class-properties
+           #:class-direct-properties
+
+           #:from-variant
+           #:make-variant
+           #:make-lisp-variant
+
+           #:connect
+           #:get-slot
+           #:get-signal
+           #:make-slot
+           #:make-signal
+           #:connect-signal
+           #:connect-function
+           #:sender))
+
diff -rN -u old-qt.core/src/painter.lisp new-qt.core/src/painter.lisp
--- old-qt.core/src/painter.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/painter.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,16 @@
+(in-package :qt)
+
+(defmacro with-painter ((painter paint-device) &body body)
+  "Binds a PAINTER instance for PAINT-DEVICE to PAINTER
+ during the evaulation of BODY.
+
+Makes sure the painter ends after BODY; thus prevening problems with 
+still active and not yet garbage collected painters."
+  `(let ((,painter (make-instance 'painter :args (list ,paint-device))))
+     (assert (cxx:is-active ,painter)
+             (,painter)
+             "Painter ~A for ~A is not active"
+             ,painter ,paint-device)
+     (unwind-protect
+          (progn ,@body)
+       (cxx:end ,painter))))
diff -rN -u old-qt.core/src/properties.lisp new-qt.core/src/properties.lisp
--- old-qt.core/src/properties.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/properties.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,50 @@
+(in-package :qt)
+
+(defun reverse-lispify (symbol)
+  "Converts the name of symbol to C++ style."
+  (smoke::lisp-to-cxx (symbol-name symbol)))
+
+(defun property-name (name)
+  "The property name is a string or a to camelCase converted symbol."
+  (typecase name
+    (string name)
+    (symbol (reverse-lispify name))))
+
+(defun property (object name)
+  "Returns the property NAME of OBJECT."
+  (from-variant (cxx:property object (property-name name))))
+
+(defun (setf property) (new-value object name)
+    (cxx:set-property object (property-name name)
+     (make-instance 'qt:variant
+                    :args (list new-value)))
+  new-value)
+
+(defun property-p (object name)
+  "Returns T when NAME is a property of OBJECT and NIL otherwise."
+  (valid-p (cxx:property object (property-name name))))
+
+(defun meta-object-properties (meta-object &optional (all t))
+  "Returns a list of the properties of META-OBJECT."
+  (loop for index from (if all 0 (cxx:property-offset meta-object))
+     below (cxx:property-count meta-object)
+     collect (smoke::lispify (cxx:name (cxx:property meta-object index)))))
+
+(defgeneric class-properties (class)
+  (:documentation "Returns a list of the properties of CLASS.")
+  (:method ((class class))
+    (meta-object-properties (cxx:static-meta-object class)))
+  (:method ((symbol symbol))
+    (class-properties (find-class symbol))))
+
+(defgeneric class-direct-properties (class)
+  (:documentation "Returns a list of the properties of CLASS.")
+  (:method ((class class))
+    (meta-object-properties (cxx:static-meta-object class) nil))
+  (:method ((symbol symbol))
+    (class-direct-properties (find-class symbol))))
+
+(defun properties (object)
+  "Returns a list of the properties of OBJECT."
+  (warn "FIXME: dynamicPropertyNames not implemented")
+  (meta-object-properties (cxx:meta-object object)))
diff -rN -u old-qt.core/src/qstring.lisp new-qt.core/src/qstring.lisp
--- old-qt.core/src/qstring.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/qstring.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,59 @@
+(in-package :qt)
+
+(defcfun qt-smoke-string-to-qstring :pointer
+  (data :string)
+  (length :int))
+
+(defcfun qt-smoke-free-qstring :void
+  (string :pointer))
+
+(defcfun qt-smoke-qstring-to-byte-array :pointer
+  (qstring :pointer))
+
+(define-foreign-type qstring ()
+  ()
+  (:actual-type :pointer))
+
+(defun setup-type-map ()
+  (smoke::add-type "QString" 'qstring)
+  (smoke::add-type "const QString&" 'qstring))
+
+(eval-when (:load-toplevel :execute)
+  (setup-type-map))
+
+;;; make sure, that you have configured slime corretly.
+;;; e.g.
+;;; (string #\U9999) crashed slime for me. Adding
+;;; (set-language-environment "UTF-8")
+;;; (setq slime-net-coding-system 'utf-8-unix)
+;;; to .emacs helps.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (text-codec.set-codec-for-cstrings
+   (text-codec.codec-for-name (string *default-foreign-encoding*)))
+  (text-codec.set-codec-for-locale
+   (text-codec.codec-for-name (string *default-foreign-encoding*))))
+
+
+(define-parse-method qstring ()
+  (make-instance 'qstring))
+
+(defmethod translate-to-foreign (string (type qstring))
+  (with-foreign-string ((data length) string :null-terminated-p nil)
+    (qt-smoke-string-to-qstring data length)))
+
+(let ((method (smoke::make-smoke-method (find-class 'byte-array)
+                                        "data")))
+  (defmethod cxx:data ((array byte-array) &rest args)
+    (declare (ignore args))
+    (values ;; Discarge second return value (length of string)
+     (foreign-string-to-lisp (smoke::pointer-call method
+                                                  (smoke::pointer array))
+                             :count (cxx:size array)))))
+
+(defmethod translate-from-foreign (string (type qstring))
+  (cxx:data (make-instance 'byte-array
+                           :pointer (qt-smoke-qstring-to-byte-array string))))
+
+(defmethod free-translated-object (pointer (type qstring) param)
+  (declare (ignore param))
+  (qt-smoke-free-qstring pointer))
diff -rN -u old-qt.core/src/qt.lisp new-qt.core/src/qt.lisp
--- old-qt.core/src/qt.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/qt.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,33 @@
+(in-package :qt)
+
+(eval-when (:load-toplevel :compile-toplevel :execute)
+  (define-foreign-library libsmokeqt
+    (:unix "libsmokeqt.so.2")
+    (t (:default "libsmokeqt")))
+
+  (use-foreign-library libsmokeqt)
+
+  (use-foreign-library libqt-smoke-extra)
+  
+  (defcvar "qt_Smoke" :pointer
+    "The Smoke Qt binding")
+
+  (defcfun (init-qt-smoke "_Z13init_qt_Smokev") :void)
+
+  (defvar *qt-binding* (null-pointer))
+
+  (init-qt-smoke))
+
+(eval-when (:load-toplevel :compile-toplevel)
+  (when (null-pointer-p *qt-binding*)
+    (setf *qt-binding* (init *qt-smoke*))))
+  ;(make-smoke-classes *qt-smoke*))
+
+(define-methods *qt-smoke*)
+
+
+(defun new (class-name method-name &rest args)
+  (apply #'new-object *qt-binding* class-name method-name args))
+
+(defun static-call (class-name method-name &rest args)
+  (apply #'smoke::static-call *qt-smoke* class-name method-name args))
diff -rN -u old-qt.core/src/signal-slot/connect.lisp new-qt.core/src/signal-slot/connect.lisp
--- old-qt.core/src/signal-slot/connect.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/signal-slot/connect.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,168 @@
+(in-package :qt)
+
+(defgeneric connect (qsignal slot &optional type)
+  (:documentation "Connects a signal to a slot."))
+
+(defgeneric disconnect (qsignal slot)
+  (:documentation "Disconnects a connection."))
+
+(defgeneric disconnect-all (qsignal)
+  (:documentation "Disconnects all connections of QSIGNAL."))
+
+(defun check-argument-types (signal-arguments slot-arguments)
+  (assert (= (length signal-arguments) (length slot-arguments)))
+  (loop for signal-arg in signal-arguments
+     for slot-arg in slot-arguments do
+     (assert (subtypep signal-arg slot-arg))))
+
+;;FIXME check argument-types
+(defmethod connect ((qsignal qsignal) (qslot qslot) &optional type)
+  (assert (or (slot-boundp (signal-object qsignal) 'argument-types)
+              (slot-boundp qslot 'arguments))
+          ((slot-value (signal-object qsignal) 'argument-types)
+           (slot-value qslot 'arguments))
+          "Argument types must be specified for at least on of
+~A and ~A." qsignal qslot)
+  (when (not (slot-boundp (signal-object qsignal) 'argument-types))
+    (setf (argument-types (signal-object qsignal))
+          (arguments qslot)))
+  (when (not (slot-boundp qslot 'arguments))
+    (setf  (slot-value qslot 'arguments)
+           (argument-types (signal-object qsignal))))
+  (check-argument-types (argument-types (signal-object qsignal))
+                        (arguments qslot))
+  (unless (connect-id (signal-object qsignal) (id (signal-object qsignal))
+                      qslot (id qslot)
+                      type
+                      (types (arguments qslot)))
+    (cerror "Failed to connect ~S to ~S." qsignal qslot)))
+
+(defmethod connect ((sender qsignal) (function function) &optional type)
+  (let ((slot (make-instance 'qslot
+                             :args (list (signal-object sender))
+                             :slot-function function)))
+    (unless (connect-id (signal-object sender) (id (signal-object sender))
+                        slot (id slot)
+                        type 
+                        (types (arguments sender)))
+      (cerror "Failed to connect the function ~S to the signal ~S."
+              function sender))))
+
+(defclass qt-signal-slot-name ()
+  ((name :initarg :name
+       :reader name)))
+
+(defclass qt-signal (qt-signal-slot-name)
+  ((sender :initarg :sender
+           :reader qsender))
+  (:documentation "Qt C++ signal."))
+
+(defclass qt-slot (qt-signal-slot-name)
+  ((receiver :initarg :receiver
+             :reader receiver))
+  (:documentation "Qt C++ slot."))
+
+(defun get-slot (receiver name)
+  "Returns the slot of RECEIVER with NAME."
+  (make-instance 'qt-slot :receiver receiver :name name))
+
+(defun get-signal (sender name)
+  "Returns the signal NAME of SENDER."
+  (make-instance 'qt-signal :sender sender :name name))
+   
+(defmethod connect ((qt-signal qt-signal) (qt-slot qt-slot) &optional type)
+  (unless (object.connect (qsender qt-signal) (qsignal (name qt-signal))
+                          (receiver qt-slot) (qslot (name qt-slot))
+                          (or type +auto-connection+))
+    (cerror "Failed to connect ~A ~A to ~A ~A."
+            (qsender qt-signal) (name qt-signal)
+            (receiver qt-slot) (name qt-slot))))
+
+(defmethod disconnect ((qt-signal qt-signal) (qt-slot qt-slot))
+  (unless (object.disconnect (qsender qt-signal) (qsignal (name qt-signal))
+                             (receiver qt-slot) (qslot (name qt-slot)))
+    (cerror "Failed to disconnect ~A ~A from ~A ~A."
+            (receiver qt-slot) (name qt-slot)
+            (qsender qt-signal) (name qt-signal))))
+
+(defmethod disconnect-all ((sender object))
+  (unless (object.disconnect sender 0 0 0)
+    (cerror "Failed to disconnect everything connected to ~A."
+            sender)))
+
+       
+(defmethod connect ((qt-signal qt-signal) (function function) &optional type)
+  (let* ((signal-id (find-signal-id (qsender qt-signal) (name qt-signal)))
+         (slot (make-instance 'qslot
+                              ;; Set the sender as the slots parent,
+                              ;; to ensure it does not get gc'ed.
+                              ;; FIXME: unset parent on disconnect
+                              ;;   this no not critical beause the slot object
+                              ;;   is hidden from the user, who thus can not
+                              ;;   connect it to other signals.
+                              :args (list (qsender qt-signal))
+                              :slot-function function
+                              :argument-types
+                              (method-arguments-type
+                               (cxx:meta-object (qsender qt-signal))
+                               signal-id))))
+    (if (connect-id (qsender qt-signal) signal-id
+                    slot (id slot)
+                    type (types (arguments slot)))
+        (cxx:connect-notify (qsender qt-signal)
+                            (name qt-signal))
+        (cerror "Ignore" "Failed to connect the signal ~S of ~S to the function ~S."
+                (name qt-signal) (qsender qt-signal) function))))
+  
+(defmethod connect ((qt-signal qt-signal) (slot qslot) &optional type)
+  (let ((signal-id (find-signal-id (qsender qt-signal) (name qt-signal))))
+    (if (slot-boundp slot 'arguments)
+        (check-argument-types (method-arguments-type (cxx:meta-object
+                                                      (qsender qt-signal))
+                                                     signal-id)
+                              (arguments slot))
+        (setf (slot-value slot 'arguments)
+              (method-arguments-type (cxx:meta-object (qsender qt-signal))
+                                     signal-id)))
+    (if (connect-id (qsender qt-signal) signal-id
+                    slot (id slot)
+                    type (types (arguments slot)))
+        (cxx:connect-notify (qsender qt-signal)
+                            (name qt-signal))
+        (cerror "Ignore" "Failed to connect the signal ~S of ~S to the slot ~S."
+                (name qt-signal) (qsender qt-signal) slot))))
+
+(defmethod connect ((qsignal qsignal) (slot qt-slot) &optional type)
+  (let ((slot-id (find-slot-id (receiver slot) (name slot))))
+    (if (slot-boundp (signal-object qsignal) 'argument-types)
+        (check-argument-types (argument-types (signal-object slot))
+                              (method-arguments-type (cxx:meta-object
+                                                      (receiver slot))
+                                                     slot-id))
+        (setf (argument-types (signal-object qsignal))
+              (method-arguments-type (cxx:meta-object (receiver slot))
+                                      slot-id)))
+    (unless (connect-id (signal-object qsignal) (id (signal-object qsignal))
+                        (receiver slot) slot-id
+                        type
+                        (types (argument-types (signal-object qsignal))))
+      (cerror "Failed to connect ~S to ~S." qsignal slot))))
+    
+
+(defun connect-id (sender signal-id receiver slot-id type types)
+  (static-call "QMetaObject" "connect#$#$$$"
+               sender
+               signal-id
+               receiver
+               slot-id
+               (if (null type)
+                   (value +auto-connection+)
+                   (value type))
+               types))
+
+(defun disconnect-id (sender signal-id receiver slot-id)
+  (static-call "QMetaObject" "disconnect#$#$"
+                       sender
+                       signal-id
+                       receiver
+                       slot-id))
diff -rN -u old-qt.core/src/signal-slot/signal-slot.lisp new-qt.core/src/signal-slot/signal-slot.lisp
--- old-qt.core/src/signal-slot/signal-slot.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/signal-slot/signal-slot.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,35 @@
+(in-package :qt)
+
+
+(defclass funcallable-smoke-class (closer-mop:funcallable-standard-class
+                                   smoke::smoke-wrapper-class)
+  ())
+
+(defmethod closer-mop:validate-superclass ((class funcallable-smoke-class)
+                                           (superclass closer-mop:funcallable-standard-class))
+  t)
+
+(defgeneric id (method))
+
+(defun munged-name-p (name)
+  "Returns true when NAME is a METHOD, SLOT or SIGNAL."
+  (and (> (length name) 0)
+       (case (aref name 0)
+         ((#\0 #\1 #\2) t)
+         (t nil))))
+
+(defun qmethod (name)
+  "Equivalent of the METHOD(a) CPP macro."
+  (assert (not (munged-name-p name)))
+  (format nil "0~A" name))
+
+(defun qslot (name)
+  "Equivalent of the SLOT(a) CPP macro."
+  (assert (not (munged-name-p name)))
+  (format nil "1~A" name))
+
+(defun qsignal (name)
+  "Equivalent of the SIGNAL(a) CPP macro."
+  (assert (not (munged-name-p name)))
+  (format nil "2~A" name))
+
diff -rN -u old-qt.core/src/signal-slot/signal.lisp new-qt.core/src/signal-slot/signal.lisp
--- old-qt.core/src/signal-slot/signal.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/signal-slot/signal.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,156 @@
+(in-package :qt)
+(declaim (optimize (debug 3)))
+
+(defclass qsignal-mixin ()
+  ((signal-object :accessor signal-object
+                  :initarg :signal-object
+                  :initform (make-instance 'signal-object)))
+  (:documentation "in SB-PCL you can not have both
+FUNCALLABLE-STANDARD-CLASS and STANDARD-CLASS,
+thus QSIGNAL is split in three classes.
+
+See: 
+ http://www.sbcl.org/manual/Metaobject-Protocol.html#index-validate_002dsuperclass-164"))
+  
+(defclass signal-object (object)
+  ((argument-types :accessor argument-types
+                   :initarg :argument-types
+                   :documentation "List of the argument types"))
+  (:documentation "Qt Signal object.")
+  (:metaclass smoke::smoke-wrapper-class))
+
+(defclass qsignal (qsignal-mixin closer-mop:funcallable-standard-object)
+  ()
+  (:metaclass closer-mop:funcallable-standard-class)
+  (:documentation "A funcallable Qt signal.
+The argument types can be supplied by the :METHOD-TYPES initarg.
+Calling an instance emits the signal."))
+
+(defun make-signal (&rest argument-types)
+  "Returns a funcallable signal. When ARGUMENT-TYPES are not
+specified, they are determined when the first connection is made."
+  (if argument-types
+    (make-instance 'qsignal :argument-types argument-types)
+    (make-instance 'qsignal)))
+
+(defmethod id ((qsignal signal-object))
+  (cxx:method-count (cxx:meta-object qsignal)))
+
+(defmethod initialize-instance :after ((object qsignal) &rest initargs
+                                       &key (argument-types nil arg-types-p)
+                                       &allow-other-keys)
+  (declare (ignore initargs))
+  (when arg-types-p
+    (setf (argument-types (signal-object object))
+          argument-types))
+  (closer-mop:set-funcallable-instance-function object
+                                                #'(lambda (&rest args)
+                                                    (apply #'emit (signal-object object) args))) 
+  )
+
+(defun find-slot-id (receiver slot)
+  "Returns the ID of RECEIVER from SLOT."
+  (let ((id (cxx:index-of-slot (cxx:meta-object receiver)
+                               (cxx:data (meta-object.normalized-signature slot)))))
+    (when (< id 0)
+      (error "No slot ~S for class ~S.
+The valid slots are: ~{~<~%~T~0,75:;~A ~>~}"
+             slot (class-of receiver)
+             (class-slots (class-of receiver))))
+    id))
+
+(defun connect-signal (qsignal receiver slot &optional (type 0))
+  "Connects a signal to a slot. Returns T on success and NIL otherwise."
+  
+  (let ((qsignal (signal-object qsignal))
+        (slot-id (find-slot-id receiver slot)))
+    (when (not (slot-boundp qsignal 'argument-types))
+      (setf (argument-types qsignal)
+            (method-arguments-type (cxx:meta-object receiver)
+                                   slot-id)))
+    (assert (>= slot-id 0)
+            ()
+            "No slot ~S for class ~S."
+            slot (class-name receiver))
+    (assert (static-call "QMetaObject" "connect#$#$$$"
+                         qsignal
+                         (id qsignal)
+                         receiver
+                         slot-id
+                         type
+                         ;; QMetaObject::connect is responsible for freeing
+                         ;; the types array.
+                         (types (method-arguments-type
+                                 (cxx:meta-object receiver)
+                                 slot-id)))
+            ()
+            "Failed to connect ~S to the slot ~S of ~S."
+            qsignal slot receiver)))
+
+(defun disconnect-signal (qsignal receiver slot)
+  (let ((qsignal (signal-object qsignal))
+        (slot-id (cxx:index-of-slot (cxx:meta-object receiver)
+                                  (cxx:data
+                                   (meta-object.normalized-signature slot)))))
+    (assert (>= slot-id 0)
+            ()
+            "No slot ~S for class ~S."
+            slot (class-name receiver))
+    (assert (static-call "QMetaObject" "disconnect#$#$"
+                         qsignal
+                         (id qsignal)
+                         receiver
+                         slot-id)
+            ()
+            "Failed to disconnect ~S to the slot ~S of ~S."
+            qsignal slot receiver)))
+
+(defmethod smoke::push-lisp-object (stack object class)
+  (let ((cxx-object (make-cxx-lisp-object object)))
+    (smoke::push-cleanup stack
+
+                         #'(lambda ()
+                             (qt-smoke-free-lisp-object cxx-object)))
+    (smoke::push-stack2 stack
+                        cxx-object
+                        0)))
+                        
+
+(defun emit (qsignal &rest arguments)
+  "Emits the signal QSIGNAL."
+;;; The first element of args would be used for the return value
+;;; by QMetaObject::invokeMethod(), but for signal-slot connection
+;;; it is ignored.
+  (smoke::with-stack (stack arguments
+                            (argument-types qsignal))
+    (cffi:with-foreign-object (args :pointer (1+ (length arguments)))
+      (loop for i from 1 to (smoke::size stack)
+         for type in (argument-types qsignal)
+         do
+         (setf (mem-aref args :pointer i)
+               (if (or (not (typep type (find-class 'smoke::smoke-type)))
+                       (= 0 (smoke::type-id type))
+                       (= 13 (smoke::type-id type)))
+                   (foreign-slot-value
+                    (mem-aref (pointer stack)
+                              'smoke::smoke-stack-item
+                              i)
+                    'smoke::smoke-stack-item 'smoke::voidp)
+                   (foreign-slot-pointer
+                    (mem-aref (pointer stack)
+                              'smoke::smoke-stack-item
+                              i)
+                    'smoke::smoke-stack-item 'smoke::voidp))))
+      (setf (mem-aref args :pointer 0)
+            (null-pointer))
+      (smoke::static-call *qt-smoke* "QMetaObject" "activate##$?"
+                          qsignal
+                          (cxx:meta-object qsignal)
+                          (id qsignal)
+                          args))))
+
+(defmethod disconnect-all ((qsignal qsignal))
+  (unless (disconnect-id (signal-object qsignal)
+                         (id (signal-object qsignal))
+                         0
+                         0)))
diff -rN -u old-qt.core/src/signal-slot/slot.lisp new-qt.core/src/signal-slot/slot.lisp
--- old-qt.core/src/signal-slot/slot.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/signal-slot/slot.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,84 @@
+(in-package :qt)
+(declaim (optimize (debug 3)))
+
+(defclass qslot (object)
+  ((arguments :reader arguments :initarg :argument-types
+              :documentation "List of the argument types for the slot.")
+   (function :reader slot-function :initarg :slot-function
+             :initform (error "no function specified")
+             :documentation "The function called when the slot is invoked."))
+  (:metaclass smoke::smoke-wrapper-class)
+  (:documentation "A Qt slot that calls its associated function"))
+
+(defun make-slot (function &optional (arguments nil arguments-p))
+  "Returns a slot that calls FUNCTION when it receives a signal."
+  (if arguments-p
+      (make-instance 'qslot
+                     :slot-function function
+                     :argument-types arguments)
+      (make-instance 'qslot
+                     :slot-function function)))
+
+(defmethod id ((slot qslot))
+ (cxx:method-count (cxx:meta-object slot)))
+
+(defparameter *sender* nil)
+(defmacro sender ()
+  "Returns the sender that invoked the slot."
+  `*sender*)
+
+(defun method-argument-count (metaobject index)
+  "Returns the number of arguments for the method INDEX of METAOBJECT."
+  (let ((signature (cxx:signature (cxx:method metaobject index))))
+    (setf signature (subseq signature (1+ (position #\( signature))
+                            (position #\) signature :from-end t)))
+    (if (= 0 (length signature))
+        0
+        (1+ (count #\, signature)))))
+
+(defmethod cxx::qt-metacall ((slot qslot) &rest args
+                             &aux (a (third args)))
+  "Invoke the slots function when it is called. The return value
+of the invoked slot function is ignored."
+  (let ((id (call-next-method)))
+    (if (< id 0)
+        id
+        (if (enum= (first args) meta-object.+invoke-meta-method+)
+            (progn
+              (case id
+                (0 (let ((*sender* (cxx:sender slot)))
+                     (apply (slot-function slot)
+                            (arguments-to-lisp a (arguments slot))))))
+              (1- id))
+            id))))
+
+(defun find-signal-id (sender signal)
+  "Returns the ID of SIGNAL from SENDER."
+  (let ((id (cxx:index-of-signal (cxx:meta-object sender)
+                      (cxx:data (meta-object.normalized-signature signal)))))
+    (when (< id 0)
+      (error "No signal ~S for class ~S."
+             signal (class-of sender)))
+    id))
+
+(defun connect-function (sender signal function &optional (type 0))
+  "Connects FUNCTION to the SIGNAL of SENDER.
+The return value of FUNCTION is ignored."
+  (let* ((signal-id (find-signal-id sender signal))
+         (slot (make-instance 'qslot
+                              :args (list sender)
+                              :slot-function function
+                              :argument-types (method-arguments-type
+                                               (cxx:meta-object sender)
+                                               signal-id))))
+    (let ((ret (static-call "QMetaObject" "connect#$#$$$"
+                            sender
+                            signal-id
+                            slot
+                            (id slot)
+                            type
+                            (types (arguments slot)))))
+      (if ret
+        (cxx:connect-notify sender signal)
+        (cerror "Failed to connect the signal ~S of ~S to the function ~S."
+                signal sender function)))))
diff -rN -u old-qt.core/src/signal-slot/translate.lisp new-qt.core/src/signal-slot/translate.lisp
--- old-qt.core/src/signal-slot/translate.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/signal-slot/translate.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,83 @@
+(in-package :qt)
+
+(defun method-argument-count (metaobject index)
+  "Returns the number of arguments the method INDEX of METAOBJECT."
+  (let ((signature (cxx:signature (cxx:method metaobject index))))
+    (setf signature (subseq signature (1+ (position #\( signature))
+                            (position #\) signature :from-end t)))
+    (if (= 0 (length signature))
+        0
+        (1+ (count #\, signature)))))
+
+(defun find-type (name &optional start end)
+  (smoke::make-smoke-type *qt-smoke* (subseq name start end)))
+    
+(defun method-arguments-type (metaobject index)
+  "Returns a type name list for the arguments of method INDEX of METAOBJECT."
+  (let* ((signature (cxx:signature (cxx:method metaobject index)))
+         (arguments (subseq signature (1+ (position #\( signature))
+                            (position #\) signature :from-end t)))
+         (argument-types ())
+         (last-pos (length arguments)))
+    (loop as pos = (position #\, arguments :from-end t :end last-pos)
+       while pos
+       do
+       (push (find-type arguments (1+ pos) last-pos) argument-types)
+       (setf last-pos pos))
+    (when (> last-pos 0)
+      (push (find-type arguments 0 last-pos) argument-types))))
+
+
+(defun arguments-to-lisp2 (argument types values)
+  (if (null types)
+      values
+        (arguments-to-lisp2 (inc-pointer argument (foreign-type-size :pointer))
+                            (rest types)
+                            (nconc values
+                                   (list 
+                                    (typecase (first types)
+                                        ;(smoke::smoke-standard-object
+                                        ; (smoke::object-to-lisp
+                                        ;  (mem-ref
+                                        ;   (mem-ref argument
+                                        ;            :pointer) :pointer)
+                                        ;  (first types)))
+                                      (smoke::smoke-type
+                                       (smoke::type-to-lisp argument
+                                                            (first types)))
+                                      (t
+                                       (translate-cxx-lisp-object
+                                        (mem-ref argument :pointer)))))))))
+       
+(defun arguments-to-lisp (arguments types)
+  (arguments-to-lisp2 (inc-pointer arguments ;; index 0 is for the return value
+                                   (foreign-type-size :pointer))
+                      types ()))
+
+
+(defun get-type (smoke-type)
+  (typecase smoke-type
+    (smoke::smoke-standard-object
+     (if (smoke::pointer-p smoke-type)
+         (error "FOO");;qmetatype.+voidstar+
+         (let ((type (meta-type.type (smoke::name smoke-type))))
+           (assert (/= 0 type)
+                   (type)
+                   "The type ~S has no QMetaType."
+                   (smoke::name smoke-type))
+           type)))
+    (t
+     *cxx-lisp-object-metatype*)))
+     
+
+(defun types (smoke-types)
+  ;;FIXME free TYPES on error.
+  (let ((types (cffi:foreign-alloc :int :count (1+ (length smoke-types))))
+        (index 0))
+    (dolist (type smoke-types)
+      (setf (cffi:mem-aref types :int index)
+            (get-type type))
+      (incf index))
+    (setf (cffi:mem-aref types :int index)
+          0)
+    types))
diff -rN -u old-qt.core/src/string-list.lisp new-qt.core/src/string-list.lisp
--- old-qt.core/src/string-list.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/string-list.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,51 @@
+(in-package :qt)
+
+(defcfun qt-smoke-string-list-size :int
+  (string-list :pointer))
+
+(defcfun qt-smoke-string-list-at :pointer
+  (string-list :pointer)
+  (index :int))
+
+(defcfun qt-smoke-free-string-list :void
+  (string-list :pointer))
+
+(defcfun qt-smoke-make-string-list :pointer)
+
+(defcfun qt-smoke-string-list-append :void
+  (string-list :pointer)
+  (string :pointer)
+  (length :int))
+
+(define-foreign-type string-list ()
+  ()
+  (:actual-type :pointer))
+
+(eval-when (:load-toplevel)
+  (smoke::add-type "QStringList" 'string-list)
+  (smoke::add-type "const QStringList&" 'string-list))
+
+
+(define-parse-method string-list ()
+  (make-instance 'string-list))
+
+(defmethod translate-to-foreign (sequence (type string-list))
+  (let ((string-list (qt-smoke-make-string-list)))
+    (map nil #'(lambda (string)
+                 (with-foreign-string ((data length) string :null-terminated-p nil)
+                   (qt-smoke-string-list-append string-list data length)))
+         sequence)
+    string-list))
+
+
+(defmethod translate-from-foreign (string-list (type string-list))
+  (let ((vector (make-array (qt-smoke-string-list-size string-list))))
+    (dotimes (index (length vector) vector)
+      (setf (aref vector index)
+            (cxx:data (make-instance 'qt:byte-array
+                                     :pointer (qt-smoke-string-list-at
+                                               string-list index)))))))
+
+(defmethod free-translated-object (string-list (type string-list) param)
+  (declare (ignore param))
+  (qt-smoke-free-string-list string-list))
diff -rN -u old-qt.core/src/variant.lisp new-qt.core/src/variant.lisp
--- old-qt.core/src/variant.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/variant.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,59 @@
+(in-package :qt)
+
+(declaim (optimize (debug 3)))
+
+(defgeneric make-variant (value)
+  (:documentation "Returns a variant for VALUE."))
+
+(defmethod print-object ((variant variant) stream)
+  "Print the type and value of the variant."
+  (if (null-pointer-p (pointer variant))
+      (call-next-method)
+      (print-unreadable-object (variant stream :type t)
+        (format stream "~A~@[ ~S~]" 
+                (cxx:type-name variant)
+                (handler-case (from-variant variant)
+                  (error () nil))))))
+
+(defmethod make-variant (value)
+  "Returns a new VARIANT containing a C++ version of VALUE."
+  (make-instance 'variant :args (list value)))
+
+;; FIXME include in MAKE-VARIANT?
+(defun make-lisp-variant (value)
+  "Returns a new VARIANT that wrapps VALUE."
+  (let ((object (make-cxx-lisp-object value)))
+    (unwind-protect
+         (make-instance 'variant :args (list *cxx-lisp-object-metatype*
+                                             object))
+      (free-cxx-lisp-object object))))
+
+(defcfun qt-smoke-lisp-object-value :pointer
+  (variant :pointer))
+
+(defun valid-p (variant)
+  "Returns true when VARIANT is valid (has a value) and false otherwise."
+  (cxx:is-valid variant))
+
+(defun from-variant (variant)
+  "Returns the value of VARIANT."
+  (ecase (cxx:user-type variant)
+    (#.(value variant.+invalid+)
+     (cerror "Return (VALUES)" "Type of variant ~A is invalid." variant)
+     (values))
+    (#.(value variant.+string+)
+     (cxx:to-string variant))
+    (#.(value variant.+string-list+)
+       (cxx:to-string-list variant))
+    (#.(value variant.+uint+)
+     (cxx:to-uint variant))
+    (#.(value variant.+int+)
+     (cxx:to-int variant))
+    (#.(value variant.+double+)
+     (cxx:to-double variant))
+    (#.*cxx-lisp-object-metatype* ;; FIXME test this!
+     (let* ((lisp-object (qt-smoke-lisp-object-value (smoke::pointer variant)))
+            (value))
+       (setf value (translate-cxx-lisp-object lisp-object))
+       (free-cxx-lisp-object lisp-object)
+       value))))
diff -rN -u old-qt.core/test.lisp new-qt.core/test.lisp
--- old-qt.core/test.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/test.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1,21 @@
+#!/usr/bin/sbcl --script
+
+(load "/home/tobias/software/mudballs/boot.lisp")
+
+(in-package :sysdef-user)
+
+(defmacro with-extra-search-dir (path &body body)
+  "Executes BODY with PATH as additional search directory for Mudball systems."
+  `(let ((*custom-search-modules*
+          (pushnew (wildcard-searcher
+                    (make-pathname :name :wild
+                                   :type "mbd"
+                                   :defaults ,path))
+                   *custom-search-modules*)))
+     ,@body))
+
+(with-extra-search-dir *default-pathname-defaults*
+ (mb:clean :qt)
+ (mb:test :qt))
+
+(sb-ext:quit)
diff -rN -u old-qt.core/tests/test.lisp new-qt.core/tests/test.lisp
--- old-qt.core/tests/test.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/tests/test.lisp	2014-11-16 19:00:12.000000000 +0100
@@ -0,0 +1 @@
+(mb:test :qt.tests)