Sun Apr  5 17:36:29 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * initial import
diff -rN -u old-smoke/CMakeLists.txt new-smoke/CMakeLists.txt
--- old-smoke/CMakeLists.txt	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/CMakeLists.txt	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,8 @@
+cmake_minimum_required(VERSION 2.6)
+
+project(smoke)
+
+add_subdirectory(src)
+add_subdirectory(examples)
+
+include(UseDoxygen OPTIONAL)
diff -rN -u old-smoke/TODO new-smoke/TODO
--- old-smoke/TODO	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/TODO	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,22 @@
+Methods:
+	* C++ overload resolution & argument promotion
+		=> no more writing (make-instance 'qt:byte-array :args ("foo"))
+	* Test for null pointer in this and for references
+	* default arguments
+	* fetch name of arguments
+
+* const correctness
+
+* keyword arguments for make-instance
+
+* QApplication and KCmdLineArgs.init call exit() on e.g. "--help"
+
+Testsuite:
+	* Fix segfaults when lots of qt:applictions are created & deleted
+	* Test condition & restarts
+
+finalization:
+	* get rid of owned-p
+	* use QObject::deleteLater ?
+
+* Exceptions
diff -rN -u old-smoke/examples/CMakeLists.txt new-smoke/examples/CMakeLists.txt
--- old-smoke/examples/CMakeLists.txt	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/examples/CMakeLists.txt	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,16 @@
+
+find_package(Qt4)
+set(QT_DONT_USE_QTGUI true)
+include(${QT_USE_FILE})
+
+find_library(SMOKE_KDE_LIBRARY smokekde)
+include(FindPackageHandleStandardArgs)
+find_package_handle_standard_args(smokekde DEFAULT_MSG SMOKE_KDE_LIBRARY)
+
+## kde-hello-world
+if(SMOKE_KDE_LIBRARY)
+	include_directories("${CMAKE_CURRENT_SOURCE_DIR}/../src/smoke-c/")
+
+	add_executable(kde-hello-world kde-hello-world.cpp ../src/smoke-c/csmokebinding.cpp)
+	target_link_libraries(kde-hello-world ${SMOKE_KDE_LIBRARY})
+endif(SMOKE_KDE_LIBRARY)
diff -rN -u old-smoke/examples/kde-hello-world.cpp new-smoke/examples/kde-hello-world.cpp
--- old-smoke/examples/kde-hello-world.cpp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/examples/kde-hello-world.cpp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,164 @@
+/*
+ * Copyright 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
+ *
+ * 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.
+ */
+
+/**
+ * Hello world example using libsmoke-c.
+ * Display an KDE Window. */
+
+#include <smoke/qt_smoke.h>
+#include <smoke/kde_smoke.h>
+
+#include "smoke-c.cpp"
+
+#include <iostream>
+
+using namespace std;
+using namespace cl_smoke;
+
+static void
+destructed(Binding* binding, Smoke::Index class_id,
+	void* object)
+{
+	cout << "destructed: " << binding->className(class_id) << endl;
+}
+
+/** No method dispatch in this example. */
+static int
+dispatch(Binding* binding, Smoke::Index method,
+	void* object, Smoke::Stack args, int abstract)
+{
+	return false;
+}
+
+int
+main(int argc, char** argv)
+{
+	init_kde_Smoke(); // calls also init_qt_Smoke();
+	smoke_binding kde = smoke_init(kde_Smoke, reinterpret_cast<void*>(&destructed),
+			reinterpret_cast<void*>(&dispatch));
+	smoke_binding qt = smoke_init(qt_Smoke, reinterpret_cast<void*>(&destructed),
+			reinterpret_cast<void*>(&dispatch));
+
+	Smoke::StackItem stack[5];
+	Smoke::ModuleIndex m;
+	Smoke::ModuleIndex c;
+
+	// bytearray = new QByteArray("foo");
+	{
+		char str[] = "foo";
+
+		smoke_find_class(&c, qt_Smoke, "QByteArray");
+		smoke_find_method(&m, qt_Smoke, c.index, "QByteArray$");
+
+		stack[1].s_class = str;
+
+		smoke_call_method(qt_Smoke, m.index, NULL, stack);
+	}
+	void* bytearray = stack[0].s_class;
+
+
+	// l10n = ki18n(bar);
+	{
+		char str[] = "hello world";
+		smoke_find_class(&c, kde_Smoke, "QGlobalSpace");
+		smoke_find_method(&m, kde_Smoke, c.index, "ki18n$");
+
+		stack[1].s_class = str;
+
+		smoke_call_method(kde_Smoke, m.index, NULL, stack);
+	}
+	void* l10n = stack[0].s_class;
+
+	// about = KAboutData(bytearray, bytearray, l10n, bytearray);
+	{
+		smoke_find_class(&c, kde_Smoke, "KAboutData");
+		smoke_find_method(&m, kde_Smoke, c.index, "KAboutData####");
+
+		stack[1].s_class = bytearray;
+		stack[2].s_class = bytearray;
+		stack[3].s_class = l10n;
+		stack[4].s_class = bytearray;
+
+		smoke_call_method(kde_Smoke, m.index, NULL, stack);
+	}
+	void* about = stack[0].s_class;
+
+
+	// KCmdLineArgs::init(argc, argv, about);
+	{
+		smoke_find_class(&c, kde_Smoke, "KCmdLineArgs");
+		smoke_find_method(&m, kde_Smoke, c.index, "init$?#");
+
+		stack[1].s_int = argc;
+		stack[2].s_class = argv;
+		stack[3].s_class = about;
+
+		smoke_call_method(kde_Smoke, m.index, NULL, stack);
+	}
+
+	// app = new KApplication();
+	void* app;
+	{
+		smoke_find_class(&c, kde_Smoke, "KApplication");
+		smoke_find_method(&m, kde_Smoke, c.index, "KApplication");
+
+		smoke_call_method(kde_Smoke, m.index, NULL, stack);
+		app = stack[0].s_class;
+
+		smoke_set_binding(c.smoke, kde, c.index, app);
+	}
+
+	{
+		smoke_find_class(&c, kde_Smoke, "KGlobalSettings");
+		smoke_find_method(&m, kde_Smoke, c.index, "Disable");
+		smoke_call_method(kde_Smoke, m.index, NULL, stack);
+	}
+
+	// widget = new KXmlGuiWindow();
+	// widget->setupGUI();
+	// widget->show();
+	// return app->exec();
+	void* widget;
+	{
+		smoke_find_class(&c, kde_Smoke, "KXmlGuiWindow");
+		smoke_find_method(&m, kde_Smoke, c.index, "KXmlGuiWindow");
+
+		smoke_call_method(m.smoke, m.index, NULL, stack);
+		widget = stack[0].s_class;
+		smoke_set_binding(c.smoke, kde, c.index, widget);
+
+		smoke_find_method(&m, c.smoke, c.index, "setupGUI");
+		smoke_call_method(m.smoke, m.index, widget, stack);
+
+		smoke_find_method(&m, c.smoke, c.index, "show");
+		smoke_call_method(m.smoke, m.index, widget, stack);
+
+		smoke_find_class(&c, kde_Smoke, "KApplication");
+		smoke_find_method(&m, c.smoke, c.index, "exec");
+		smoke_call_method(m.smoke, m.index, NULL, stack);
+
+		return stack[0].s_int;
+	}
+}
diff -rN -u old-smoke/smoke.mbd new-smoke/smoke.mbd
--- old-smoke/smoke.mbd	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/smoke.mbd	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,69 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+
+;;; Allow this file to compile even when sysdef.cmake is not loaded.
+;;; You can not add a (MB:LOAD :SYSDEF.CMAKE) on top since when Mudballs
+;;; loads this file it might not know yet about :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 SYDDEF.CMAKE
+
+(in-package :sysdef-user)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (use-package :sysdef.cmake))
+
+(define-system :smoke ()
+  (:version 0 0 1)
+  (:documentation "Smoke bindings. Provides the base functionality to
+implement bindings using the various Smoke modules.")
+  (:author "Tobias Rautenkranz")
+  (:components
+   ("CMakeLists" cmake-file)
+   (:src module
+         (:needs "CMakeLists")
+         (:components
+          ("CMakeLists.txt" static-file)
+          "package"
+          ("translate" (:needs "package"))
+          ("smoke" (:needs "smoke-c" "objects" "clos"))
+          ("object-map" (:needs "objects"))
+          ("class-map" (:needs "package"))
+          ("bindings" (:needs "package"))
+          ("clos" (:needs "smoke-c" "objects" "object-map" "class-map" "bindings"))
+          ("method" (:needs "clos"))
+          (:objects module
+                    (:needs "smoke-c" "utils")
+                    (:serial t)
+                    (:components "object" "enum" "method" "class"
+                                 "type" "instance" "stack"))
+          (:smoke-c module
+                    (:needs "package" "translate")
+                    (:components ("libsmoke-c" cmake-library)
+                                 ("libsmoke-c-util" cmake-library)
+
+                                 ;; Make release-action add this files
+                                 ("CMakeLists.txt" static-file)
+                                 ("csmokebinding.h" static-file)
+                                 ("csmokebinding.cpp" static-file)
+                                 ("smoke-c.cpp" static-file)
+
+                                 ("smoke-c" (:needs "libsmoke-c"
+                                                    "libsmoke-c-util"))
+                                 ("class" (:needs "smoke-c"))
+                                 ("stack" (:needs "class"))
+                                 ("method" (:needs "stack"))
+                                 ("type" (:needs "method"))))
+
+          (:utils module
+                  (:needs "package")
+                  (:components "get-value")))))
+  (:needs :sysdef.cmake :cffi :closer-mop
+          :trivial-garbage :bordeaux-threads))
diff -rN -u old-smoke/src/CMakeLists.txt new-smoke/src/CMakeLists.txt
--- old-smoke/src/CMakeLists.txt	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/CMakeLists.txt	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1 @@
+add_subdirectory(smoke-c)
diff -rN -u old-smoke/src/bindings.lisp new-smoke/src/bindings.lisp
--- old-smoke/src/bindings.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/bindings.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,17 @@
+(in-package :smoke)
+
+(defvar *bindings* (make-hash-table))
+
+;; FIXME is this lock needed? (The user may not have to
+;;       load additional modules while threads are running.
+(defvar *bindings-lock* (make-lock "bindings-lock"))
+
+(defun binding (smoke)
+  "Returns the Smoke binding for the Smoke module SMOKE."
+  (with-lock-held (*bindings-lock*)
+    (gethash (pointer-address smoke) *bindings*)))
+
+(defun (setf binding) (binding smoke)
+  (with-lock-held (*bindings-lock*)
+    (setf (gethash (pointer-address smoke) *bindings*)
+          binding)))
diff -rN -u old-smoke/src/class-map.lisp new-smoke/src/class-map.lisp
--- old-smoke/src/class-map.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/class-map.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,31 @@
+(in-package :smoke)
+
+(defvar *smoke-id-class-map*
+  (make-hash-table)
+  "Maps a Smoke module pointer - id pair to a class.")
+;; FIXME disallow adding a class when threads are running or add a lock.
+
+(defmacro id-class-map (smoke)
+  `(gethash (pointer-address ,smoke)
+            *smoke-id-class-map*))
+
+(defun add-id-class-map (smoke)
+  (unless (nth-value 1 (id-class-map smoke))
+    (setf (id-class-map smoke)
+          (make-hash-table))))
+
+(defun add-id (smoke-class class)
+  "Associates the CLOS class CLASS with SMOKE-CLASS."
+  (setf (gethash (id smoke-class)
+        (id-class-map (smoke smoke-class)))
+        class))
+
+(defun find-smoke-class (class)
+  "Returns the CLOS class for smoke-class CLASS."
+  (let* ((class (real-class class))
+         (ret (gethash (id class)
+                       (id-class-map (smoke class)))))
+    (assert (not (null ret))
+            ()
+            "The class ~A was not found." (name class))
+    ret))
diff -rN -u old-smoke/src/clos-types.lisp new-smoke/src/clos-types.lisp
--- old-smoke/src/clos-types.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/clos-types.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,48 @@
+(in-package :smoke)
+
+(defclass cxx::number () ())
+
+(defclass cxx::rational (cxx::number) ())
+
+(defclass cxx::int (cxx::rational) ())
+(defclass cxx::short (cxx::rational) ())
+
+
+(defclass cxx::real (cxx::number) ())
+
+(defclass cxx::float (cxx::real) ())
+(defclass cxx::double (cxx::real) ())
+
+
+(defclass cxx::char () ())
+(defclass cxx::pointer ()
+  ((next)))
+(defclass cxx::const ()
+  ((next)))
+  
+
+(defgeneric convert (from to))
+
+(defmethod convert (from to)
+  (values nil nil))
+
+(defun char->int (c)
+  (char-code  c))
+
+(defmethod convert ((from character) (to cxx::int))
+  (values #'char->int 1))
+
+(defmethod convert (from (to cxx::const))
+  (call-next-method (const from) to))
+
+(defmethod convert ((from cxx::const) (to cxx::const))
+  (call-next-method (next from) (next to)))
+
+(defun float->int (f)
+  (round f))
+
+(defmethod convert ((from float) (to cxx::int))
+  (values #'float->int 1))
+
+(defmethod convert ((from string) (to cxx::char)))
+;(defmethod convert ((from string) (to qstring)))
diff -rN -u old-smoke/src/clos.lisp new-smoke/src/clos.lisp
--- old-smoke/src/clos.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/clos.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,403 @@
+(in-package #:smoke)
+
+(declaim (optimize (speed 0) (debug 3)))
+
+(declaim (inline lispify))
+(defun lispify (name &optional (package nil))
+  "Returns the interned symbol for name in Lisp style."
+  (declare (string name)
+           (optimize (speed 3)))
+  (if (null package)
+      (values (intern (cxx-to-lisp name)))
+      (values (intern (cxx-to-lisp name) package))))
+
+(defmacro define-string-transform (name documentation &body states)
+  "Defines a function to transform a string."
+  (let ((output (gensym))
+        (index (gensym))
+        (length (gensym)))
+    `(defun ,name (input)
+       ,documentation
+       (declare (simple-string input)
+                (optimize (speed 3)))
+       ;; At least on sbcl 1.0.25.debian CONCATENATE is faster
+       ;; than VECTOR-PUSH-EXTEND
+       (let ((,output "")
+             (,index 0)
+             (,length (length input))
+             (char #\Null))
+         (declare (base-char char))
+         (macrolet ((next-char ()
+                      `(if (>= ,',index ,',length)
+                           (return-from transform ,',output)
+                           (progn
+                             (setf char (aref input ,',index))
+                             (incf ,',index))))
+                    (go-next (tag)
+                      `(progn (next-char)
+                              (go ,tag)))
+                    (append-char (char)
+                      `(setf ,',output (concatenate 'string
+                                                    ,',output
+                                                    (string ,char)))))
+           (block transform
+             (tagbody
+                (next-char) ;; Get first char
+                ,@(reduce #'append
+                          (mapcar #'(lambda (state)
+                                      (if (stringp (second state))
+                                          `(,(first state) . ,(cddr state))
+                                          state))
+                                  states)))))))))
+
+
+(define-string-transform lisp-to-cxx
+    "Converts LISP-STYLE to camelCase.
+Note that (LISP-TO-CXX (CXX-TO-LIST SOME-STRING)) will not neccessarily return
+a string equal to SMOME-STRING."
+  (default 
+      "Downcase, convert _ and dispatch."
+      (case char
+        (#\- (go-next camel-upcase))
+        (#\. (go-next namespace))
+        (t (append-char (char-downcase char))
+           (go-next default))))
+  (camel-upcase
+   "Convert camelCase to lisp-style."
+   (append-char char)
+   (go-next default))
+  (namespace
+   "Convert . to ::"
+   (append-char #\:)
+   (append-char #\:)
+   (go default)))
+
+
+  
+
+(define-string-transform cxx-to-lisp 
+  "Returns camelCase STRING in lisp-style."
+  (begin
+   "Strip leadind Q or K."
+   (case char
+     (#\K (go-next default))
+     (#\Q (go-next default))
+     (t (go default))))
+  (default
+      "Upcase, convert _ and dispatch."
+      (case char
+        (#\: (go-next namespace))
+        (#\_ (append-char #\-)
+             (go-next default))
+        (t (append-char (char-upcase char))
+           (if (lower-case-p char)
+               (go-next camel-case)
+               (go-next default)))))
+  (namespace
+   "Convert camelCase to lisp-style."
+   (assert (eql #\: char))
+   (append-char #\.)
+   (go-next default))
+  (camel-case
+   "Convert camelCase to lisp-style."
+   (if (upper-case-p char)
+       (progn 
+         (append-char #\-)
+         (append-char char)
+         (go-next default))
+       (go default))))
+  
+
+(defclass smoke-standard-object ()
+  ((pointer :reader pointer :initarg :pointer
+            :documentation "Pointer to the C++ object.")
+   (owned-p :accessor owned-p :initarg :owned-p
+            :initform t
+            :documentation "T when the object is owned by Lisp and
+NIL when C++ is the owner.")
+   (const-p :reader const-p :initarg :const-p
+            :initform nil
+            :documentation "T when the object is const and NIL otherwise."))
+  (:documentation "The standard superclass for Smoke classes."))
+
+(defmethod print-object ((object smoke-standard-object) stream)
+  (print-unreadable-object (object stream :type t)
+    (princ (pointer object) stream)))
+
+(defclass smoke-standard-class (standard-class smoke-class)
+  ((enumerations :initform (make-hash-table)
+                 :initarg :enumerations
+                 :reader enumerations
+                 :documentation "The enumerations of the class.
+Maps the type-id of the enumeration to a hash-table that
+maps an enum value to a symbol."))
+  (:documentation "A Smoke C++ class"))
+
+(defclass smoke-wrapper-class (smoke-standard-class)
+  ())
+
+(defclass cxx:class (smoke-wrapper-class)
+  ()
+  (:documentation "Metaclass to extend Smoke Objects."))
+
+
+(defmethod closer-mop:validate-superclass ((class smoke-standard-class) (superclass standard-class))
+  T)
+
+(defmethod closer-mop:validate-superclass ((class smoke-wrapper-class) (superclass smoke-standard-class))
+  T)
+
+(defmethod reinitialize-instance :around
+    ((class smoke-standard-class)
+     &rest args &key direct-superclasses &allow-other-keys)
+  (apply
+   #'call-next-method class
+   :direct-superclasses (or direct-superclasses
+                            (list (find-class
+                                   'smoke-standard-object))) args))
+
+(defmethod initialize-instance :around
+    ((class smoke-standard-class)
+     &rest args &key direct-superclasses &allow-other-keys)
+  "Sets NIL superclass to SMOKE-STANDARD-OBJECT instead of the default STANDARD-OBJECT."
+  (apply
+   #'call-next-method class
+   :direct-superclasses (or direct-superclasses
+                            (list (find-class 'smoke-standard-object)))
+   args))
+
+(defmethod reinitialize-instance :around
+    ((class smoke-wrapper-class)
+     &rest args &key direct-superclasses &allow-other-keys)
+  (assert (not (null direct-superclasses))
+          (direct-superclasses)
+          "No superclass suplied for class ~A" class)
+  (let ((superclass (first direct-superclasses)))
+    (assert (subtypep (class-of superclass) (find-class 'smoke-standard-class))
+            ((first direct-superclasses))
+            "The first superclass must be an subclass of an smoke class.")
+    (apply
+     #'call-next-method class
+     :id (id superclass)
+     :smoke (smoke superclass)
+     :direct-superclasses direct-superclasses
+     args)))
+
+(defmethod initialize-instance :around
+    ((class smoke-wrapper-class)
+     &rest args &key direct-superclasses &allow-other-keys)
+  (assert (not (null direct-superclasses))
+          (direct-superclasses)
+          "No superclass suplied for class ~A" class)
+  (let ((superclass (first direct-superclasses)))
+    (assert (subtypep (class-of superclass) (find-class 'smoke-standard-class))
+            ((first direct-superclasses))
+            "The first superclass must be an subclass of an smoke class.")
+    (apply
+     #'call-next-method class
+     :id (id superclass)
+     :smoke (smoke superclass)
+     :direct-superclasses direct-superclasses
+     args)))
+
+(defun smoke-class-symbol (class)
+  (if (external-p class)
+      (class-name (find-smoke-class class))
+      (lispify (name class))))
+
+
+    
+
+(defun make-smoke-classes (smoke)
+  "Construts a lisp class for each one in the Smoke module SMOKE."
+  (declare (optimize (speed 3)))
+  (add-id-class-map smoke)
+    (map-classes 
+     #'(lambda (class)
+         (unless (external-p class)
+           (add-id class
+                   (closer-mop:ensure-class (lispify (name class))
+                                            :direct-superclasses
+                                            (mapcar #'smoke-class-symbol
+                                                    (smoke-class-direct-superclasses class))
+                                            :id (id class)
+                                            :smoke (smoke class)
+                                            :metaclass 'smoke-standard-class))
+           (export (lispify (name class)))))
+     smoke))
+
+(defun generic-lambda-list (method)
+  "Returns the lisp lambda list for METHOD."
+  (if (static-p method)
+      '(class &rest args)
+      '(object &rest args)))
+
+(defclass smoke-gf (standard-generic-function smoke-method)
+  ()
+  (:metaclass closer-mop:funcallable-standard-class)
+  (:documentation "Smoke generic function"))
+
+(defun smoke-class-of (object)
+  "Returns the class of OBJECT or OBJECT iff it alread is a class."
+  (if (subtypep (class-of object) (find-class 'smoke-class))
+      object
+      (class-of object)))
+  
+;;; To speed up the startup (MAKE-SMOKE-METHODS)
+;;; ENSURE-METHOD is only called as needed.
+(defmethod no-applicable-method ((gf smoke-gf) &rest args)
+  "Calls the smoke method."
+  (let ((method (find-method-using-args (smoke-class-of (first args))
+                                        (name gf) (rest args))))
+    (if (static-p method)
+        (s-call method (null-pointer) (rest args))
+        (s-call method (cast (first args) (get-class method)) (rest args)))))
+
+(defmethod add-method :after ((gf smoke-gf) method)
+  "Adds a method which calls the smoke method, to make call-next-method work."
+  (when (null (rest (closer-mop:generic-function-methods gf)))
+    (closer-mop:ensure-method gf
+                              `(lambda (object &rest args)
+                                 (let ((method (find-method-using-args (smoke-class-of object)
+                                                                       (name ,gf)
+                                                                       args)))
+                                   (if (static-p method)
+                                       (s-call method (null-pointer) args)
+                                       (s-call method (cast object (get-class method)) args)))))))
+
+(defcallback destructed :void
+    ((binding :pointer)
+     (id smoke-index)
+     (object-pointer :pointer))
+  (declare (optimize (speed 3)))
+  (let ((object (get-object object-pointer)))
+    (when object
+      (cancel-finalization object)
+      (remove-object object-pointer)
+      (setf (slot-value object 'pointer) (null-pointer)))))
+
+(defun stack-to-args (stack arg &optional (args nil))
+  "Returns the arguments in STACK, where ARG is the type
+of the first argument, as an list of Lisp objects."
+  (if (end-p arg)
+      args
+      (stack-to-args (cffi:inc-pointer stack
+                                       (cffi:foreign-type-size 'smoke-stack-item))
+                     (next arg)
+                     (append args (list
+                                   (type-to-lisp (cffi:mem-ref stack 'smoke-stack-item)
+                                                 arg))))))
+
+(defgeneric set-returnvalue (stack value type))
+(defmethod set-returnvalue (stack (value smoke-standard-object) type)
+  (assert (class-p type)
+          (type)
+          "The type ~A of the value ~A is not a class."
+          (name type) value)
+  (setf (foreign-slot-value stack 'smoke-stack-item 'class)
+        (pointer value))
+  (when (stack-p type) ;; Pass by value => smoke deletes the object.
+    (cancel-finalization value) ;; Fixme mark object as invalid or copy it
+ ;(remove-object (pointer value))
+    (remove-if-exists (pointer value));;FIXME!
+    (setf (slot-value value 'pointer) (null-pointer))))
+
+(defmethod set-returnvalue (stack (value integer) type)
+  (setf (foreign-slot-value stack 'smoke-stack-item 'int)
+        value))
+
+(defmethod set-returnvalue (stack (value (eql t)) type)
+  (setf (foreign-slot-value stack 'smoke-stack-item 'bool)
+        value))
+
+(defun put-returnvalue (stack value type)
+  (unless (void-p type)
+    (set-returnvalue stack value type)))
+
+(defcallback dispatch-method :boolean
+    ((binding :pointer)
+     (method smoke-index)
+     (object :pointer)
+     (stack smoke-stack)
+     (abstract :boolean))
+  (declare (optimize (speed 3)))
+  (let ((method (make-instance 'smoke-method
+                               :id method
+                               :smoke (smoke-get-smoke binding))))
+    (let ((gf (symbol-function (lispify (name method) "CXX"))))
+      (if (null (closer-mop:generic-function-methods gf))
+          (progn
+            (when abstract
+              (error "Abstract method ~S called." (name method)))
+            nil)
+          (let ((object (get-object object)))
+            (if object
+                (progn
+                  (put-returnvalue stack
+                                   (apply gf object
+                                          (stack-to-args (cffi:inc-pointer stack (cffi:foreign-type-size 'smoke-stack-item))
+                                                         (get-first-argument method)))
+                                   (return-type method))
+                  t)
+                nil))))))
+
+;;FIXME use CHANGE-CLASS instead?
+(defun cast (object class)
+  "Returns a pointer of type CLASS to the C++ object of OBJECT."
+  (assert (derived-p (class-of object) class)
+          ()
+          "Can not cast object ~A of class ~A to class ~A."
+          object (name (class-of object)) (name class))
+  (smoke-cast (smoke (class-of object)) (pointer object)
+              ;(id (class-of object)) (id (real-class class))))
+              (id (class-of object)) (class-id (smoke (class-of object))
+                                               class)))
+
+
+(defun upcast (object class)
+  (assert (derived-p class (class-of object))
+          ()
+          "Can not upcast object ~A of class ~A to class ~A."
+          object (name (class-of object)) (name class))
+  (smoke-cast (smoke class) (pointer object)
+              (id (class-of object)) (id (real-class class))))
+
+
+(defmethod convert-to-class (smoke-class (object smoke-standard-object))
+  (cast object smoke-class))
+
+(defun make-smoke-constructor (class args)
+  (find-method-using-args class
+                          (name class)
+                          args))
+
+(defun call-constructor (object args)
+  (pointer-call (make-smoke-constructor (class-of object)
+                                        args)
+                (null-pointer)
+                args))
+
+(defmethod initialize-instance :after ((object smoke-standard-object) 
+                                       &key args &allow-other-keys)
+  "Initializes a Smoke object. Calls its constructor with the arguments supplied
+by the key :ARGS and sets the smoke binding."
+  (assert (not (and (slot-boundp object 'pointer)
+                    (not (null args))))
+          ((slot-value object 'pointer) args)
+          "Pointer ~A bound and constructor argument :ARGS ~S supplied."
+          (slot-value object 'pointer) args)
+  (unless (slot-boundp object 'pointer)
+    (setf (slot-value object 'pointer) (call-constructor object args))
+    (set-binding object (binding (smoke (class-of object))))
+    (setf (slot-value object 'owned-p) t)
+    (add-object object)))
+
+
+(defmethod instance-to-lisp (pointer class type)
+  (let ((ret (make-instance class
+                            :owned-p (stack-p type)
+                            :pointer pointer)))
+;    (when (stack-p type)
+;      (add-object ret))
+;      (set-binding ret (binding (smoke (class-of ret)))))
+    ret))
diff -rN -u old-smoke/src/marshall.lisp new-smoke/src/marshall.lisp
--- old-smoke/src/marshall.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/marshall.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,152 @@
+(in-package :smoke)
+
+(declaim (optimize (debug 3)))
+
+(defmacro average (&rest args)
+  `(floor (+ ,@args) ,(length args)))
+  
+
+(defun binary-find (lower upper < =)
+  (let ((mid (average lower upper)))
+    (if (= mid lower)
+        nil
+        (if (funcall = mid)
+            mid
+            (if (funcall < mid)
+                (binary-find lower mid < =)
+                (binary-find mid upper < =))))))
+
+(defun serach-method (smoke name)
+  (binary-find 1 (smoke-method-name-size smoke)
+               #'(lambda (index)
+                   (string< name
+                            (smoke-get-method-name smoke index)))
+               #'(lambda (index)
+                   (string= name
+                            (smoke-get-method-name smoke index)))))
+
+(defun find-last (lower upper =)
+  (if (or (>= lower upper)
+          (not (funcall = (1+ lower))))
+      lower
+     (find-last (1+ lower) upper =)))
+  
+                    
+(defun find-methods (smoke name)
+  (let* ((index (serach-method smoke name))
+         (= #'(lambda (index)
+                (string= name
+                         (smoke-get-method-name smoke index)
+                         :end2 (length name))))
+         (upper (find-last index (smoke-method-name-size smoke) =))
+         (methods nil))
+    (loop for i from index to upper do
+         (push (smoke-get-method-name smoke i)
+               methods))
+    methods))
+         
+                    
+
+;(defmethod exact-match ((object singl-float) type))
+(defun type-equal (type type-name)
+  (equal (name type) type-name))
+
+(defun exact-match (object type)
+  (format t "~A ~A~%" object (name type))
+  (ctypecase object 
+    (smoke-standard-object
+     (and (class-p type)
+          (derived-p (class-of object)
+                     (get-class type))))
+    (double-float (type-equal type "double"))
+    (single-float (type-equal type "float"))
+    (integer (type-equal type "int"))
+    (string (or (type-equal type "const char*")
+                (type-equal type "const QString&")))
+    (character (type-equal type "char"))))
+
+(defun exact-match-p (arguments types)
+  (if (or (null arguments) (null types))
+      (and (null arguments)
+           (null types))
+      (if (not (exact-match (first arguments)
+                            (first types)))
+          nil
+          (exact-match-p (rest arguments)
+                         (rest types)))))
+               
+(defun promotion-match (object type)
+  (ctypecase object
+    (character (type-equal type "int"))
+    (float (type-equal type "double"))
+    (boolean (type-equal type "int"))))
+
+(defun standard-conversion-match (object type)
+  (ctypecase object
+    (number (or (type-equal type "short")
+                (type-equal type "int")
+                (type-equal type "long")))))
+
+(defun constructor-match (object type)
+  (if (class-p type)
+      (let ((constructor (make-smoke-constructor (get-class type)
+                              (mung-arg object))))
+        (exact-match object (get-first-argument constructor)))
+      nil))
+  
+(defun find-ambiguous-method (predicate method)
+  (let ((index (- (id method))))
+    (loop as i = (smoke-ambiguous-method (smoke method)
+                                         index)
+       while (> i 0) do
+       (incf index)
+       (let ((ambiguous-method (make-instance 'smoke-method
+                                              :smoke (smoke method)
+                                              :id i)))
+         (when (funcall predicate ambiguous-method)
+           (return ambiguous-method))))))
+
+(defun find-method-using-args (class name arguments)
+  (with-foreign-object (m 'smoke-module-index)
+    (smoke-find-method m (smoke class) (id class)
+                       (concatenate 'string name
+                                    (munged-args arguments)))
+    (let ((method (make-instance 'smoke-method
+                                 :smoke (foreign-slot-value m
+                                                            'smoke-module-index
+                                                            'smoke)
+                                 :id (foreign-slot-value m
+                                                         'smoke-module-index
+                                                         'index))))
+      (when (< (id method) 0)
+        (setf method
+              (find-ambiguous-method #'(lambda (method)
+                                         (exact-match-p arguments (arguments method)))
+                                     method))
+        (assert (not (null method)) (method)
+                "No method ~A::~A for the arguments ~A"
+                (name class) name arguments))
+      method)))
+
+
+(defgeneric get-convert-function (to from))
+(defmethod get-convert-function ((to eql 'int) (from eql 'char)))
+(defmethod get-convert-function ((to cxx::int) (from string)))
+
+(get-convert-function 'int 'char)
+
+;'const int 'char:
+(get-convert-function 'int 'char)
+&& (convert-const-p 'char)
+
+;'int 'const char:
+(get-convert-function 'int 'char)
+&& (not (const-p 'char))
+
+
+(defclass int ()
+  ((const-p)))
+
+(defun get-convert-function (to from))
+
+ 
diff -rN -u old-smoke/src/method.lisp new-smoke/src/method.lisp
--- old-smoke/src/method.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/method.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,143 @@
+(in-package :smoke)
+
+(declaim (optimize (debug 3)))
+
+(defun enum-class-symbol (enum-type)
+  (let ((class-name (name (get-class enum-type))))
+    (if (null class-name)
+        'global-enum-class
+        (lispify class-name))))
+        
+(defun constant-definition (method smoke)
+  "Returns an expression that defines a constant for the enum METHOD.
+The second return value is the expression to export the constant."
+  (let ((symbol 
+         (if (string= (name (get-class method))
+                      "Qt")
+             (lispify (concatenate 'string "+" (name method)
+                                   "+"))
+             (lispify (concatenate 'string
+                                   (name (get-class method))
+                                   ".+"
+                                   (name method) "+")))))
+    (values
+                                        ; `(defconstant ,symbol
+                                        ;    ,(enum-call method))
+     `(alexandria:define-constant ,symbol
+        (make-instance 'enum
+                       :value ,(enum-call method)
+                       :type (make-instance 'smoke-type
+                                            :id ,(id (return-type method))
+                                            :smoke ,smoke))
+        :test #'enum=)
+     `(export (quote ,symbol)))))
+
+(defun static-method-symbol (method)
+  "Returns the lisp symbol for the static method METHOD."
+  (let ((class (get-class method)))
+    (lispify (concatenate 'string
+                          (if (string= (name class)
+                                       "QGlobalSpace")
+                              nil
+                              (concatenate 'string
+                                           (name class)
+                                           "."))
+                          (name method)))))
+
+(defun static-method-definition (method smoke)
+  "Returns an expression to define a function for the static METHOD.
+The second return value is the expression to export the function."
+  (let* ((class (get-class method))
+         (method-name (name method))
+         (name (lispify (concatenate 'string
+                                     (if (string= (name class)
+                                                  "QGlobalSpace")
+                                         nil
+                                         (concatenate 'string
+                                                      (name class)
+                                                      "."))
+                                     (name method)))))
+    (values
+     `(defun ,name (&rest args)
+        (let ((method (find-method-using-args (make-instance 'smoke-class
+                                                             :id ,(id class)
+                                                             :smoke ,smoke)
+                                              ,method-name args)))
+          (s-call method (null-pointer) args)))
+     `(export (quote ,name)))))
+
+(defun hash-table-key-values (hash-table)
+  "Returns a list containing all key-value pairs as CONS of HASH-TABLE."
+  (let ((list))
+    (maphash #'(lambda (key value)
+                 (push (cons key value) list))
+             hash-table)
+    list))
+
+(defun ensure-generic-methods (names-and-ids smoke)
+  "Ensures the generic functions in NAMES-AND-IDS for the Smoke module SMOKE."
+  (dolist (name-id names-and-ids)
+    (ensure-generic-function (first name-id)
+                                              :id (rest name-id)
+                                              :smoke smoke
+                                              :generic-function-class 'smoke-gf
+                                              :lambda-list '(object &rest args))
+
+    (export (first name-id) :CXX)))
+
+(defmacro check-recompile (smoke)
+  "Raises an error when the fasl of the DEFINE-METHOS was not compiled against
+the current smoke module."
+  `(eval-when (:load-toplevel :execute)
+     (unless (= (smoke-methods-size ,smoke)
+                ,(smoke-methods-size (eval smoke)))
+       (error "The smoke module ~A changed, you need to recompile the lisp file."
+              (smoke-get-module-name ,smoke)))))
+
+
+(defmacro define-methods (smoke)
+  "Process the C++ methods of the Smoke module SMOKE.
+Expands to DEFUNs for static methods, DEFINE-CONSTANTs for enum methods
+and a function do define the generic methods a load-time."
+;;; symbol - id pairs are stored in the hash-tables to prevent the
+;;; mulitiple definiton of a function with the same name.
+  (let ((generics (make-hash-table))
+        (constants)
+        (functions)
+        (function-symbols (make-hash-table))
+        (exports))
+    (map-methods 
+     #'(lambda (method)
+         (when (and (enum-p method)
+                    ;; FIXME workaround  for
+                    ;; http://lists.kde.org/?l=kde-bindings&m=123464781307375
+                    (not (string= (name (get-class method))
+                                  "KGlobalSettings")))
+           (multiple-value-bind (def export) (constant-definition method smoke)
+             (push def
+                   constants)
+             (push export exports)))
+         (when (and (not (destructor-p method))
+                    (not (constructor-p method))
+                    (not (enum-p method))
+                    (not (eql nil (name method)))
+                    (string/= (name method) "tr")) ;; we have a custom qt:tr funciton
+           (setf (gethash (lispify (name method) "CXX") generics)
+                 (id method))
+           (when (static-p method)
+             (let ((function-symbol (static-method-symbol method)))
+               (unless (nth-value 1 (gethash function-symbol function-symbols))
+                 (setf (gethash function-symbol function-symbols) t)
+                 (multiple-value-bind (def export) (static-method-definition method smoke)
+                   (push def functions)
+                   (push export exports)))))))
+     (eval smoke))
+    `(progn (check-recompile ,smoke)
+            ,@functions
+            (eval-when (:load-toplevel)
+              (ensure-generic-methods ',(hash-table-key-values generics) ,smoke)
+              (make-smoke-classes ,smoke)
+              )
+            ,@constants
+            ,@exports)))
+
diff -rN -u old-smoke/src/object-map.lisp new-smoke/src/object-map.lisp
--- old-smoke/src/object-map.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/object-map.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,69 @@
+(in-package :smoke)
+
+(defvar *object-map* 
+  #-cmucl (make-weak-hash-table :weakness :value)
+  #+cmucl (make-hash-table :weak-p :value)
+        
+  "Maps eisp object to Smoke C++ object of a class.")
+
+;; FIXME This probably does not scale well. A per thread object-map
+;; or at least a read-write lock should be used.
+(defvar *object-map-mutex* (make-lock "object-map lock"))
+
+(defun get-object (pointer)
+  (with-lock-held (*object-map-mutex*)
+     (gethash (pointer-address pointer) *object-map*)))
+
+(defun (setf get-object) (value pointer)
+  (with-lock-held (*object-map-mutex*)
+    (setf (gethash (pointer-address pointer) *object-map*)
+          value)))
+  
+
+(defun has-pointer-p (pointer)
+  "Returns T when there is an object for POINTER in the map and NIL otherwise."
+  (with-lock-held (*object-map-mutex*)
+    (nth-value 1 (gethash (pointer-address pointer) *object-map*))))
+
+
+(defgeneric make-finalize (object)
+  (:documentation "Returns a function to be called when OBJECT is finalized."))
+
+(defmethod make-finalize (object)
+  (let ((pointer (pointer object))
+        (class (class-of object)))
+    #'(lambda ()
+        (handler-case (delete-pointer pointer class)
+          (condition (condition)
+            (format *debug-io* "error finalize ~A ~A~%" (name class)
+                    condition))))))
+  
+
+(defun add-object (object)
+  (assert (not (has-pointer-p (pointer object)))
+          ()
+          "There exists already a object ~A for the pointer of ~A."
+          (get-object (pointer object)) object)
+  (when (owned-p object)
+    (let ((finalizer (make-finalize object)))
+      (finalize object finalizer)))
+  (setf (get-object (pointer object)) object))
+
+(defun remove-if-exists (pointer)
+  (with-lock-held (*object-map-mutex*)
+    (remhash (pointer-address pointer) *object-map*)))
+
+(defun remove-object (pointer)
+  (assert (has-pointer-p pointer)
+          (pointer)
+          "No object to remove for pointer ~A." pointer)
+  (with-lock-held (*object-map-mutex*)
+    (remhash (pointer-address pointer) *object-map*)))
+
+(defun print-garbage ()
+  (with-lock-held (*object-map-mutex*)
+    (maphash #'(lambda (pointer object)
+                 (format t "~A of type: ~S~%"
+                         (make-pointer pointer)
+                         (class-name (class-of object))))
+             *object-map*)))
diff -rN -u old-smoke/src/objects/class.lisp new-smoke/src/objects/class.lisp
--- old-smoke/src/objects/class.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/objects/class.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,113 @@
+(in-package #:smoke)
+
+;;;
+;;; find-class
+;;; ensure-class
+;;; make-instance
+;;; class-name
+;;; class-slots
+;;; class-direct-subclasses
+;;; class-direct-superclasses
+;;; class-of
+;;; subclassp / subtypep
+
+
+(defclass smoke-class (smoke-symbol)
+  ()
+  (:documentation "A class"))
+
+(defmethod get-struct-slot-value ((class smoke-class) slot-name)
+  (foreign-slot-value (smoke-get-class (smoke class) (id class))
+                      'smoke-class slot-name))
+
+(defmethod name ((class smoke-class))
+  (get-struct-slot-value class 'name))
+
+(defun map-classes (function smoke)
+  "Applys FUNCTION to the classes of SMOKE."
+  (let ((class (make-instance 'smoke-class
+                               :id 0
+                               :smoke smoke)))
+    (loop for id from 1 to (1- (smoke-classes-size smoke)) do
+         (setf (slot-value class 'id) id)
+         (funcall function class))))
+
+(defun external-p (class)
+  "Returns T when CLASS is external in its module; NIL otherwise."
+  (get-struct-slot-value class 'external))
+
+(defmethod get-flag ((class smoke-class) flag)
+  (boole boole-and (get-struct-slot-value class 'flags)
+         (foreign-enum-value 'smoke-class-flags flag)))
+
+(defmethod constructor-p ((class smoke-class))
+  "Returns T when CLASS has a constructor; NIL otherwise."
+  (/= 0 (get-flag class :constructor)))
+
+(define-condition undefined-class (cell-error)
+  ((smoke-name :initarg :smoke-name
+               :initform nil
+               :documentation "The name of the Smoke module"))
+  (:report (lambda (condition stream)
+             (format stream "No Smoke class named ~S in the Smoke module ~S."
+                     (cell-error-name condition)
+                     (slot-value condition 'smoke-name))))
+  (:documentation "A undefined Smoke class"))
+
+;smoke-find-class
+(defun make-smoke-class (smoke name)
+  "Returns the class named NAME of the smoke module SMOKE.
+Signals an undefined-class condition when there is no class for NAME."
+  (with-foreign-object (c 'smoke-module-index)
+    (do () (nil)
+      (smoke-find-class c smoke name)
+      (restart-case
+          (if (null-pointer-p (foreign-slot-value c 'smoke-module-index 'smoke))
+              (error (make-condition 'undefined-class :name name :smoke-name (smoke-get-module-name smoke)))
+              (return))
+        (supply (new-name)
+          :report "Supply a new class name"
+          :interactive read-new-value
+          (setf name new-name))))
+    (make-instance 'smoke-class
+                   :id (foreign-slot-value c 'smoke-module-index 'index)
+                   :smoke (foreign-slot-value c 'smoke-module-index 'smoke))))
+
+(defun real-class (class)
+  "Returns the same class like CLASS, but such that EXTERNAL-P returns NIL."
+  (if (external-p class)
+      (make-smoke-class (smoke class) (name class))
+      class))
+
+(defun class-id (module class)
+  "Returns the class id of CLASS for the Smoke module MODULE."
+  (if (eq (smoke class) module)
+      (id class)
+      (smoke-class-id module (name class))))
+
+;(defun smoke-subclassp (class base-class) TODO
+(defun derived-p (class base-class)
+  "Returns T when CLASS is derived from BASE-CLASS and NIL when not."
+  (values
+   (derived-real-p (real-class class) (real-class base-class))
+   T))
+
+(defun derived-real-p (class base-class)
+  (smoke-is-derived-from (smoke class) (id class)
+                         (smoke base-class) (id base-class)))
+  
+
+(defun smoke-class-direct-superclasses (class)
+  (smoke-add-superclass class nil (get-struct-slot-value class 'parents)))
+
+(defun smoke-add-superclass (class classes index)
+  (let ((class-index (smoke-get-parent-index (smoke class) index)))
+    (assert (< class-index (smoke-classes-size (smoke class))))
+    (if (= 0 class-index)
+        classes
+        (smoke-add-superclass class (append classes
+                                            (list
+                                            (make-instance 'smoke-class
+                                                           :id class-index
+                                                           :smoke (smoke class))))
+                              (1+ index)))))
diff -rN -u old-smoke/src/objects/enum.lisp new-smoke/src/objects/enum.lisp
--- old-smoke/src/objects/enum.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/objects/enum.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,66 @@
+(in-package :cxx-support)
+
+(eval-when (:compile-toplevel  :load-toplevel :execute)
+  (use-package :smoke :cxx-support))
+
+;;;
+;;; One could map enum-values to lisp symbols, store the type in the plist
+;;; an use thouse as enums, but C++ enums may have several symbols for
+;;; the same value and thus lisp symbols can not be used.
+
+(defclass enum ()
+  ((value :reader value
+          :initarg :value)
+   (type  :reader enum-type
+          :initarg :type))
+  (:documentation "Holds the integer value and type of an C++ enum value."))
+
+(defmethod print-object ((enum enum) stream)
+  (print-unreadable-object (enum stream :type t)
+    (format stream "~A ~A" (name (enum-type enum))
+            (value enum))))
+  
+
+(defun check-enum-type (enum enum-type)
+  (assert (type= (enum-type enum)
+                 enum-type)
+          (enum enum-type)
+          "The enums ~A is not of type ~A." enum (name enum-type)))
+
+(defun enum= (enum1 enum2)
+  "Returns true when ENUM1 and ENUM2 are equal and false otherwise."
+  (declare (enum enum1 enum2))
+  (assert (type= (enum-type enum1)
+                 (enum-type enum2))
+          (enum1 enum2)
+          "The enums ~A and ~A have a different type." enum1 enum2)
+  (= (value enum1) (value enum2)))
+
+(defmacro enum-xcase (case keyform &body cases)
+  (let ((type (enum-type (eval (first (first cases))))))
+    (loop for case in cases do
+         (check-enum-type (eval (first case))
+                          type)))
+  `(progn
+  ;   (check-enum-type (enum-type ,keyform)
+  ;                    (enum-type ,(first (first cases))))
+     (,case (value ,keyform)
+       ,@(loop for case in cases
+            collect `(,(value (eval (first case)))
+                       ,@(rest case))))))
+
+(defmacro enum-case (keyform &body cases)
+  `(enum-xcase case ,keyform ,@cases))
+
+(defmacro enum-ecase (keyform &body cases)
+  `(enum-xcase ecase ,keyform ,@cases))
+
+(defmacro enum-cases (keyform &body cases)
+  "Keyform returns a number; cases are enums."
+  `(case ,keyform
+     ,@(loop for case in cases
+            collect `(,(value (eval (first case)))
+                       ,@(rest case)))))
+
+(defun enum-logand (&rest enums)
+  (apply #'logand (mapcar #'value enums)))
diff -rN -u old-smoke/src/objects/instance.lisp new-smoke/src/objects/instance.lisp
--- old-smoke/src/objects/instance.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/objects/instance.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,7 @@
+(in-package #:smoke)
+
+(defclass object (smoke-class)
+  ((pointer :reader pointer :initarg :pointer
+            :initform (null-pointer)
+            :documentation "Pointer to the C++ object."))
+  (:documentation "A Smoke CPP object"))
diff -rN -u old-smoke/src/objects/method.lisp new-smoke/src/objects/method.lisp
--- old-smoke/src/objects/method.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/objects/method.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,311 @@
+(in-package #:smoke)
+(declaim (optimize (debug 3)))
+
+(defclass smoke-method (smoke-symbol)
+  ()
+  (:documentation "A C++ method"))
+
+(defmethod print-object ((smoke-method smoke-method) stream)
+  (if (null-pointer-p (smoke smoke-method))
+      (call-next-method)
+      (print-unreadable-object (smoke-method stream :type t)
+        (princ (method-declaration smoke-method) stream))))
+
+(define-condition undefined-method (undefined-function)
+  ((class-name :initarg :class-name
+               :initform nil))
+  (:report (lambda (condition stream)
+             (format stream "No Smoke method ~S for class ~S."
+                     (cell-error-name condition)
+                     (slot-value condition 'class-name)))) 
+  (:documentation "A undefined Smoke method"))
+  
+(defun valid-p (method)
+  "Returns T when METHOD is valid and NIL otherwise."
+  (/= 0 (id method)))
+
+(defun ambiguous-p (method)
+  "Returns T when METHOD is ambiguous and NIL otherwise."
+  (> 0 (id method)))
+
+;smoke-find-method
+(defun make-smoke-method (class name)
+  "Returns the method called NAME of CLASS.
+Signals a undefined-method condition when no method was found."
+  (with-foreign-object (m 'smoke-module-index)
+    (do () (nil)
+      (smoke-find-method m (smoke class) (id class) name)
+      (restart-case
+          (if  (null-pointer-p (foreign-slot-value m 'smoke-module-index 'smoke))
+               (error (make-condition 'undefined-method :name name :class-name (name class)))
+               (return))
+        (supply (new-name)
+          :report "Supply a new method name"
+          :interactive read-new-value
+          (setf name new-name))))
+    (when (> 0 (foreign-slot-value m 'smoke-module-index 'index))
+      (loop as i = (smoke-ambiguous-method (smoke class)
+                                           (- (foreign-slot-value m 'smoke-module-index 'index)))
+           while (> i 0)
+         do (decf (foreign-slot-value m 'smoke-module-index 'index))
+           (let ((m (make-instance 'smoke-method :id i :smoke (smoke class))))
+              (format t " ~A ~A~%" (name m) (signature m))))
+      (error "The method ~S of ~S is ambigious" name (name class)));;TODO
+    (make-instance 'smoke-method
+                   :id (foreign-slot-value m 'smoke-module-index 'index)
+                   :smoke (foreign-slot-value m 'smoke-module-index 'smoke))))
+
+(defun type-equal (type type-name)
+  "Returns true when TYPE is of the type named TYPE-NAME and false otherwise."
+  (equal (name type) type-name))
+
+(defun exact-match (object type)
+  "Returns true when the type of OBJECT is exactly the same as TYPE and
+false otherwise."
+  (ctypecase object 
+    (smoke-standard-object
+     (and (class-p type)
+          (derived-p (class-of object)
+                     (get-class type))))
+    (double-float (type-equal type "double"))
+    (single-float (type-equal type "float"))
+    (integer (type-equal type "int"))
+                 ;; int is also enum
+                 ;; FIXME remove magic number 12
+                 ;;(= (type-id type) 12)))
+    (string (or (type-equal type "const char*")
+                (type-equal type "const QString&")))
+    (enum (type= (enum-type object)
+                     type))
+    (sequence (type-equal type "const QStringList&"))
+    (character (type-equal type "char"))))
+
+(defun exact-match-p (arguments types)
+  "Returns true when all the type of ARGUMENTS is the same as the
+corresponing type of TYPES and the length of the ARGUMENTS and TYPES list
+is equal."
+  (if (or (null arguments) (null types))
+      (and (null arguments)
+           (null types))
+      (if (not (exact-match (first arguments)
+                            (first types)))
+          nil
+          (exact-match-p (rest arguments)
+                         (rest types)))))
+
+(defun mung-arg (argument)
+  "Returns the mung char for ARUGMENT."
+  ;; FIXME void* is #\$ but void[] is #\?
+  ;; FIXME Get rid of the mugging stuff and compute the applicable methods
+  ;;  including argument promotion
+  (case argument
+    ((t nil) #\$) ;; Booleans
+    (otherwise
+     (ctypecase argument
+       (number #\$)
+       (string #\$)
+       (foreign-pointer #\?)
+       (sequence #\?)
+       (enum #\$)
+       (smoke-standard-object #\#)))))
+
+(defun munged-args (arguments &optional (string nil))
+  "Maps the type of every item of ARGUMENTS to a char;
+Returns the list of the chars."
+  (if (null arguments)
+      string
+      (munged-args (rest arguments)
+                   (append string (list (mung-arg (first arguments)))))))
+
+(defun find-ambiguous-method (predicate method)
+  "Returns a method of the ambiguous method METHOD such that
+PREDICATE is true. NIL is returned when no matching method is found."
+  (assert (ambiguous-p method)
+          (method)
+          "The method is not ambiguous.")
+  (let ((index (- (id method))))
+    (loop as i = (smoke-ambiguous-method (smoke method)
+                                         index)
+       while (> i 0) do
+       (incf index)
+       (let ((ambiguous-method (make-instance 'smoke-method
+                                              :smoke (smoke method)
+                                              :id i)))
+         (when (funcall predicate ambiguous-method)
+           (return ambiguous-method))))))
+
+(defun find-method-using-args (class name arguments)
+  "Returns the method of class CLASS with the name NAME
+for the arguments ARGUMENTS."
+  (with-foreign-object (m 'smoke-module-index)
+    (smoke-find-method m (smoke class) (id class)
+                       (concatenate 'string name
+                                    (munged-args arguments)))
+    (let ((method (make-instance 'smoke-method
+                                 :smoke (foreign-slot-value m
+                                                            'smoke-module-index
+                                                            'smoke)
+                                 :id (foreign-slot-value m
+                                                         'smoke-module-index
+                                                         'index))))
+      (assert (valid-p method)
+              (method)
+              "No method ~A::~A for the arguments ~A" (name class) name arguments)
+      (when (ambiguous-p method)
+        (setf method
+              (find-ambiguous-method #'(lambda (method)
+                                         (exact-match-p arguments (arguments method)))
+                                     method))
+        (assert (not (null method)) (method)
+                "No method ~A::~A for the arguments ~A"
+                (name class) name arguments))
+      method)))
+
+
+(defun map-methods (function smoke)
+  "Applys FUNCTION to the methods of SMOKE.
+The method argument to function must not be modified."
+  (let ((method (make-instance 'smoke-method
+                               :id 0
+                               :smoke smoke)))
+    (loop for id from 1 to (1- (smoke-methods-size smoke)) do
+         (when (= (mod id (floor (smoke-methods-size smoke) 10)) 0)
+           (format t "[ ~A ]~%" (* 10
+                                   (floor (* 10 id)
+                                          (smoke-methods-size smoke)))))
+         (setf (slot-value method 'id) id)
+         (funcall function method))))
+
+(defmethod get-struct-slot-value ((method smoke-method) slot-name)
+  (foreign-slot-value (smoke-get-method (smoke method) (id method))
+                      'smoke-method slot-name))
+
+(defmethod name ((method smoke-method))
+  (smoke-get-method-name (smoke method)
+                         (get-struct-slot-value method 'name)))
+
+(defun signature (method)
+  "Returns the signature of METHOD."
+  (format nil "~A(~{~A~^, ~}) ~:[~;const~]"
+          (name method)
+          (mapcar #'name (arguments method))
+          (const-p method)))
+
+(defun access (method)
+  "Returns the access for METHOD. (public or protected)"
+  (if (protected-p method)
+      "protected"
+      "public"))
+
+(defun modifiers (method)
+  (format nil "~A~:[~; static~]" (access method)
+          (static-p method)))
+
+(defun return-type (method)
+  "Returns the return type of METHOD."
+  (make-instance 'smoke-type
+                 :id (get-struct-slot-value method 'return-type)
+                 :smoke (smoke method)))
+
+(defun method-declaration (method)
+  (format nil "~A~:[ void~; ~1:*~A~] ~A::~A"
+          (modifiers method)
+          (name (return-type method))
+          (name (get-class method))
+          (signature method)))
+
+(defgeneric get-flag (object flag)
+  (:documentation "Returns the value for FLAG of OBJECT."))
+
+(defmethod get-flag ((method smoke-method) flag)
+  (logand (get-struct-slot-value method 'flags)
+          (foreign-enum-value 'smoke-method-flags flag)))
+
+(defgeneric constructor-p (object)
+  (:documentation "Returns T when OBJECT is a constructor."))
+
+(defmethod constructor-p ((method smoke-method))
+  (/= 0 (get-flag method :constructor)))
+
+(defun destructor-p (method)
+  "Returns T when METHOD is a destructor; NIL otherwise."
+  (/= 0 (get-flag method :destructor)))
+
+(defun static-p (method)
+  "Retruns T when METHOD is static and NIL otherwise."
+  (/= 0 (get-flag method :static)))
+
+(defun protected-p (method)
+  "Returns T when METHOD is protected; NIL otherwise."
+  (/= 0 (get-flag method :protected)))
+
+(defmethod const-p ((method smoke-method))
+  "Returns T when METHOD is a const method and NIL otherwise."
+  (/= 0 (get-flag method :const)))
+
+(defun ambigious-p (method)
+  "Returns T when METHOD is ambigious and NIL otherwise."
+  (< 0 (id method)))
+
+(defun enum-p (method)
+  "Returns T when METHOD is enum value and NIL otherwise."
+  (/= 0 (get-flag method :enum)))
+
+(defmethod get-class ((method smoke-method))
+  (make-instance 'smoke-class
+                 :id (get-struct-slot-value method 'class)
+                 :smoke (smoke method)))
+
+  
+
+(defclass smoke-argument (smoke-type)
+  ()
+  (:documentation "A argument to a method"))
+
+(defmethod id ((argument smoke-argument))
+  (smoke-get-argument (smoke argument) (slot-value argument 'id)))
+
+(defun last-p (argument)
+  "Returns T when ARGUMENT is the last argument and NIL otherwise."
+  (= 0 (smoke-get-argument (smoke argument) (1+ (slot-value argument 'id)))))
+
+(defun end-p (argument)
+  "Returns T when ARGUMENT is the after last element and NIL otherwise."
+  (= 0 (id argument)))
+
+(defun next (argument)
+  "Returns the argument following ARGUMENT."
+  (assert (not (end-p argument))
+          (argument)
+          "Access after end element")
+  (make-instance 'smoke-argument
+                 :id (1+ (slot-value argument 'id))
+                 :smoke (smoke argument)))
+
+(defun get-arguments-length (method)
+  "Returns the number of arguments for METHOD."
+  (get-struct-slot-value method 'num-args))
+    
+(defun get-first-argument (method)
+  "Returns the first argument of METHOD"
+  (make-instance 'smoke-argument
+                 :id (get-struct-slot-value method 'arguments)
+                 :smoke (smoke method)))
+
+(defun get-argument (method index)
+  "Returns the type of METHODs argument with number INDEX."
+  (make-instance 'smoke-argument
+                 :id (+ (get-struct-slot-value method 'arguments) index)
+                 :smoke (smoke method)))
+
+
+(defun build-argument-list (list argument)
+  (if (end-p argument)
+      list
+      (build-argument-list (append list (list argument))
+                           (next argument))))
+
+(defun arguments (method)
+  "Returns a list of the arguments of METHOD."
+  (build-argument-list nil (get-first-argument method)))
+
diff -rN -u old-smoke/src/objects/object.lisp new-smoke/src/objects/object.lisp
--- old-smoke/src/objects/object.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/objects/object.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,22 @@
+(in-package #:smoke)
+
+(defclass smoke-symbol ()
+  ((id :reader id :initarg :id
+       :documentation "The objects index.")
+   (smoke :reader smoke :initarg :smoke
+          :initform (null-pointer)
+          :documentation "Pointer to the Smoke module."))
+  (:documentation "A method or class in a Smoke module."))
+
+(defmethod print-object ((smoke-symbol smoke-symbol) stream)
+  (if (null-pointer-p (smoke smoke-symbol))
+      (call-next-method)
+      (print-unreadable-object (smoke-symbol stream :type t)
+        (princ (name smoke-symbol) stream))))
+
+(defgeneric name (smoke-symbol)
+  (:documentation "Returns the name of SMOKE-SYMBOL."))
+
+(defgeneric get-struct-slot-value (smoke-symbol slot-name)
+  (:documentation "Returns the slot value of SLOT-NAME of
+the SMOKE-SYMBOLs struct."))
diff -rN -u old-smoke/src/objects/stack.lisp new-smoke/src/objects/stack.lisp
--- old-smoke/src/objects/stack.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/objects/stack.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,171 @@
+(in-package #:smoke)
+
+(declaim (optimize (debug 3)))
+(defclass call-stack ()
+  ((pointer :reader pointer :initarg :pointer
+            :initform (null-pointer)
+            :documentation "Pointer to the Smoke stack")
+   (top :accessor top :initarg :top
+        :initform (null-pointer)
+        :documentation "Pointer to push the next argument to.")
+   (cleanup-stack :accessor cleanup-stack
+                  :initform nil
+                  :documentation "Cleanup functions"))
+  (:documentation "Contains the argument passed to a Smoke method."))
+
+(defmethod size ((stack call-stack))
+  "Returns the size (number of arguments) of STACK."
+  (/ 
+   (- (pointer-address (top stack))
+      (pointer-address (pointer stack)))
+   (foreign-type-size 'smoke-stack-item)))
+
+(defun make-call-stack (smoke-stack)
+  (make-instance 'call-stack
+                 :pointer smoke-stack
+                 :top (inc-pointer smoke-stack (foreign-type-size 'smoke-stack-item))))
+
+(defun push-stack (stack value type)
+  (setf (foreign-slot-value (top stack)
+                            'smoke-stack-item type) value)
+  (incf-pointer (top stack) (foreign-type-size 'smoke-stack-item)))
+  
+(defun push-cleanup (stack function)
+  "Adds the cleanup function FUNCTION to STACK"
+  (push function (cleanup-stack stack)))
+
+(defun push-stack2 (stack value type-id)
+  (ecase type-id
+    (0 (push-stack stack value 'voidp))
+    (1 (push-stack stack value 'bool))
+    (2 (push-stack stack value 'char))
+    (3 (push-stack stack value 'uchar))
+    (4 (push-stack stack value 'short))
+    (5 (push-stack stack value 'ushort))
+    (6 (push-stack stack value 'int))
+    (7 (push-stack stack value 'uint))
+    (8 (push-stack stack value 'long))
+    (9 (push-stack stack value 'ulong))
+    (10 (push-stack stack value 'float))
+    (11 (push-stack stack value 'double))
+    (12 (push-stack stack (value value) 'enum-value))
+    (13 (push-stack stack value 'class))))
+
+(defun push-smoke-stack (stack lisp-value smoke-type)
+  (typecase smoke-type
+    (smoke-type
+     (cond
+       ((class-p smoke-type)
+        (push-stack2 stack
+                     (convert-to-class (get-class smoke-type) lisp-value)
+                     (type-id smoke-type)))
+;       ((pointer-p smoke-type)
+       (t
+        (let ((cffi-type (get-type (name smoke-type))))
+          (if (null cffi-type)
+              (progn
+              ;  (assert (typep lisp-value 'foreign-pointer)
+              ;          (lisp-value)
+              ;          "The lisp-value ~S is not a foreign-pointer."
+              ;          lisp-value)
+                (push-stack2 stack
+                             lisp-value
+                             (type-id smoke-type)))
+              (multiple-value-bind (pointer args) (convert-to-foreign lisp-value
+                                                                      cffi-type)
+                (push-cleanup stack
+                              #'(lambda ()
+                                  (free-converted-object pointer
+                                                         cffi-type
+                                                         args)))
+                (push-stack2 stack
+                             pointer
+                             (type-id smoke-type))))))))
+;       (t (push-stack2 stack lisp-value (type-id smoke-type)))))
+    (t (push-lisp-object stack lisp-value smoke-type))))
+
+(defgeneric push-lisp-object (stack object class)
+  (:documentation "Push the OBJECT on STACK."))
+
+(defun set-smoke-stack (stack args arguments)
+  "Pushes the arguments ARGS onto the Smoke stack STACK."
+  (when (null args)
+    (assert (null arguments)
+            ()
+            "To few arguments supplied. Missing: ~A" arguments))
+  (unless (null args)
+    (assert (not (null arguments))
+            ()
+            "To many arguments suppliend (Arguments ~A)." args)
+      (push-smoke-stack stack (first args) (first arguments))
+      (set-smoke-stack stack (rest args) (rest arguments))))
+
+(defmacro with-stack ((stack args types) &body body)
+  (let ((smoke-stack (gensym "STACK")))
+    `(with-foreign-object (,smoke-stack 'smoke-stack-item (1+ (length ,args)))
+       (let ((,stack (make-call-stack ,smoke-stack)))
+         (unwind-protect
+              (progn
+                (set-smoke-stack ,stack ,args
+                                 ,types)
+                ,@body)
+           (mapcar #'funcall (cleanup-stack ,stack)))))))
+
+(defun enum-to-lisp (stack-item type)
+  "Returns the Lisp representation for STACK-ITEM of the basic C type TYPE."
+  (ecase (type-id type)
+    (0 (let ((cffi-type (get-type (name type))))
+         (if (null cffi-type)
+             (progn 
+               ;(warn "Unknown translation from ~A to lisp." (name type))
+               (foreign-slot-value stack-item 'smoke-stack-item 'voidp))
+             (convert-from-foreign (foreign-slot-value stack-item
+                                                       'smoke-stack-item
+                                                       'voidp)
+                                   cffi-type))))
+    (1 (foreign-slot-value stack-item 'smoke-stack-item 'bool))
+    (2 (code-char (foreign-slot-value stack-item 'smoke-stack-item 'char)))
+    (3 (code-char (foreign-slot-value stack-item 'smoke-stack-item 'uchar)))
+    (4 (code-char (foreign-slot-value stack-item 'smoke-stack-item 'short)))
+    (5 (code-char (foreign-slot-value stack-item 'smoke-stack-item 'ushort)))
+    (6 (foreign-slot-value stack-item 'smoke-stack-item 'int))
+    (7 (foreign-slot-value stack-item 'smoke-stack-item 'uint))
+    (8 (foreign-slot-value stack-item 'smoke-stack-item 'long))
+    (9 (foreign-slot-value stack-item 'smoke-stack-item 'ulong))
+    (10 (foreign-slot-value stack-item 'smoke-stack-item 'float))
+    (11 (foreign-slot-value stack-item 'smoke-stack-item 'double))
+    (12 (make-instance 'enum
+                       :value (foreign-slot-value stack-item 'smoke-stack-item 'enum-value)
+                       :type type))))
+
+(defgeneric instance-to-lisp (pointer class type)
+  (:documentation "Returns a clos instance for POINTER."))
+
+(defun object-to-lisp (object type)
+  (if (class-p type)
+      (let ((class (get-class type)))
+        (if (has-pointer-p object)
+            (get-object object)
+            (instance-to-lisp object (find-smoke-class class) type)))
+      nil))
+
+
+
+(defun class-to-lisp (stack-item type)
+  "Returns the Lisp representation for STACK-ITEM of type C++ class."
+  (object-to-lisp (foreign-slot-value stack-item
+                                      'smoke-stack-item
+                                      'class)
+                  type))
+
+(defun type-to-lisp (stack-item type)
+  "Returns the Lisp representation of STACK-ITEM"
+  (cond
+    ((void-p type)
+     (values))
+    ((class-p type)
+     (class-to-lisp stack-item type))
+    (t
+     (enum-to-lisp stack-item type))))
+
+    
diff -rN -u old-smoke/src/objects/type.lisp new-smoke/src/objects/type.lisp
--- old-smoke/src/objects/type.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/objects/type.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,78 @@
+(in-package #:smoke)
+
+(defclass smoke-type (smoke-symbol)
+  ()
+  (:documentation "A type"))
+
+
+(defmethod get-struct-slot-value ((type smoke-type) slot-name)
+  (foreign-slot-value (smoke-get-type (smoke type) (id type))
+                      'smoke-type slot-name))
+
+(defun make-smoke-type (smoke name)
+  "Returns the type in the Smoke module SMOKE named NAME."
+  (make-instance 'smoke-type
+                 :id (smoke-find-type smoke name)
+                 :smoke smoke))
+
+(defmethod name ((type smoke-type))
+  (get-struct-slot-value type 'name))
+
+(defun type= (type1 type2)
+  (and t ;(pointer-eq (smoke type1)
+       ;            (smoke type2))
+       (= (id type1)
+          (id type2))))
+
+(defmethod get-flag ((type smoke-type) flag)
+  (boole boole-and (get-struct-slot-value type 'flags)
+         (foreign-enum-value 'smoke-type-flags flag)))
+
+(defun stack-p (type)
+  "Returns T when TYPE is stored on the stack; NIL otherwise."
+  (/= 0 (get-flag type :stack)))
+
+(defun reference-p (type)
+  "Returns T when TYPE is a reference ('type&'); NIL otherwise."
+  (/= 0 (get-flag type :reference)))
+
+(defun pointer-p (type)
+  "Returns T when TYPE is a pointer ('type*'); NIL otherwise."
+  (/= 0 (get-flag type :pointer)))
+
+(defmethod const-p ((type smoke-type))
+  "Returns T when TYPE is const; NIL otherwise."
+  (/= 0 (get-flag type :const)))
+
+(defun class-p (type)
+  "Returns T when TYPE is a smoke class"
+  (and (eql (type-id type) 13)
+       (/= -1 (get-struct-slot-value type 'class))))
+
+(defun type-id (type)
+  "Returns the ID of TYPE."
+  (boole boole-and (get-struct-slot-value type 'flags)
+         (foreign-enum-value 'smoke-type-flags :type-id)))
+
+(defun void-p (type)
+  "Return T when TYPE is a void type (no value)."
+  (null (name type)))
+
+(defgeneric get-class (smoke-symbol)
+  (:documentation "Returns the smoke-class associated with SMOKE-SYMBOL."))
+
+(defmethod get-class ((type smoke-type))
+  "Return the smoke-class of TYPE."
+  (assert (/= -1 (get-struct-slot-value type 'class))
+          (type)
+          "The type ~S is not a smoke class." (name type))
+  (make-instance 'smoke-class
+                 :id (get-struct-slot-value type 'class)
+                 :smoke (smoke type)))
+
+
+;; FIXME why macro?
+(defmacro smoke-type-p (type smoke type-name)
+  (let ((t2 (smoke-find-type smoke type-name)))
+    `(and (= (id ,type) ,(id t2))
+          (pointer-eq (smoke ,type) ,(smoke t2)))))
diff -rN -u old-smoke/src/package.lisp new-smoke/src/package.lisp
--- old-smoke/src/package.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/package.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,39 @@
+(defpackage #:cxx-support
+  (:use #:cl)
+  (:export #:enum
+           #:enum=
+           #:enum-logand
+           #:value
+           #:enum-type
+           #:enum-case
+           #:enum-cases
+           #:enum-ecase))
+
+(defpackage #:smoke
+  (:use #:cl #:asdf #:cffi #:trivial-garbage #:bordeaux-threads #:cxx-support)
+  (:export #:init
+
+           #:make-smoke-classes
+           
+           #:new-object
+           #:delete-object
+           #:smoke-call
+           #:call
+
+           #:name
+           #:id
+           #:type=
+
+           #:define-methods
+
+           #:cxx-bool
+
+           #:pointer))
+
+(defpackage #:cxx
+  (:use) ;; do not use #:cl
+  (:export #:class))
+
+
+
+(in-package #:smoke)
diff -rN -u old-smoke/src/run-test.lisp new-smoke/src/run-test.lisp
--- old-smoke/src/run-test.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/run-test.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,16 @@
+#|
+exec sbcl --noinform --noprint --disable-debugger --load $0 --end-toplevel-options "$@"
+|#
+
+;(asdf:operate 'asdf:load-op 'smoke :verbose nil)
+;(require :sb-cover)
+;(declaim (optimize sb-cover:store-coverage-data))
+;(asdf:oos 'asdf:load-op :smoke :force t)
+(require :smoke-tests)
+(in-package :smoke-tests)
+(setup)
+(5am:run!)
+;(smoke-destruct *kde-binding*)
+;(smoke-destruct *qt-binding*)
+;(sb-cover:report "./report/")
+(sb-ext:quit)
diff -rN -u old-smoke/src/smoke-c/CMakeLists.txt new-smoke/src/smoke-c/CMakeLists.txt
--- old-smoke/src/smoke-c/CMakeLists.txt	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke-c/CMakeLists.txt	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,11 @@
+find_package(Qt4 REQUIRED)
+set(QT_DONT_USE_QTGUI true)
+include(${QT_USE_FILE})
+
+set(SMOKE_C_SOURCES smoke-c.cpp csmokebinding.cpp)
+add_library(smoke-c MODULE ${SMOKE_C_SOURCES})
+
+add_library(smoke-c-util MODULE smoke-c-util.cpp)
+
+install(TARGETS smoke-c smoke-c-util
+	LIBRARY DESTINATION lib)
diff -rN -u old-smoke/src/smoke-c/class.lisp new-smoke/src/smoke-c/class.lisp
--- old-smoke/src/smoke-c/class.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke-c/class.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,50 @@
+(in-package #:smoke)
+
+(defcenum smoke-class-flags
+  "Class properties"
+  (:constructor #x01)
+  (:copy-constructor #x02)
+  (:virtual-destructor #x04)
+  (:undefined #x10))
+
+
+(defcstruct smoke-class
+  "Describe a class"
+  (name :string)
+  (external cxx-bool)
+  (parents smoke-index)
+  (class-function :pointer)
+  (enum-function :pointer)
+  (flags :unsigned-short))
+
+(defcfun smoke-find-class :void
+  (m :pointer smoke-module-index)
+  (smoke :pointer)
+  (name :string))
+
+(defcfun smoke-class-id smoke-index
+  (smoke :pointer)
+  (name :string))
+
+(defcfun smoke-classes-size smoke-index
+  (smoke :pointer))
+
+(defcfun smoke-get-class (:pointer smoke-class)
+  (smoke :pointer)
+  (class smoke-index))
+
+(defcfun smoke-get-parent-index smoke-index
+  (smoke :pointer)
+  (class smoke-index))
+
+(defcfun smoke-is-derived-from :boolean
+  (smoke :pointer)
+  (class smoke-index)
+  (smoke-base :pointer)
+  (base-class smoke-index))
+
+(defcfun smoke-cast :pointer
+  (smoke :pointer)
+  (object :pointer)
+  (from smoke-index)
+  (to smoke-index))
diff -rN -u old-smoke/src/smoke-c/csmokebinding.cpp new-smoke/src/smoke-c/csmokebinding.cpp
--- old-smoke/src/smoke-c/csmokebinding.cpp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke-c/csmokebinding.cpp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,84 @@
+#include "csmokebinding.h"
+
+#include <QtGlobal>
+
+namespace cl_smoke
+{
+
+/** @class Binding
+ * @brief The Smoke binding.
+ */
+
+
+/** @typedef Binding::destructed
+ * Callback when a Smoke object is destructed.
+ *
+ * @param binding Smoke binding of the object
+ * @param class_id class id
+ * @param object the object
+ */
+
+
+/** @typedef Binding::dispatch_method
+ * Callback when a Smoke method gets called.
+ *
+ * @param binding Smoke binding of @a object
+ * @param method index of the method
+ * @param object the object for which the method is called
+ * @param args the arguments to the method
+ * @param abstract @c true when the method is abstract and @c false otherwise
+ *
+ * @return @c true when the method call was handled and @c false
+ *when the default method shall be invoked.
+ */
+
+/** Constructor.
+ * @param smoke the Smoke module
+ * @param destruct destruct callback
+ * @param dispatch method dispatch callback
+ */
+Binding::Binding(Smoke *smoke, destructed destruct,
+		dispatch_method dispatch)
+	: SmokeBinding(smoke),
+	destruct(destruct),
+	dispatch(dispatch)
+{
+	Q_ASSERT(smoke);
+	Q_ASSERT(destruct);
+	Q_ASSERT(dispatch);
+}
+
+/** Invoked when a Smoke object is destructed. */
+void
+Binding::deleted(Smoke::Index classId, void *obj)
+{
+	destruct(this, classId, obj);
+}
+
+/** Invoked whne a Smoke method gets called. */
+bool
+Binding::callMethod(Smoke::Index method, void* object,
+		Smoke::Stack stack, bool abstract)
+{
+	return dispatch(this, method, object, stack, abstract);
+}
+
+/**
+ * @todo Returning a const char* would be better
+ */
+char*
+Binding::className(Smoke::Index classId)
+{
+	return const_cast<char*>(smoke->classes[classId].className);
+}
+
+/** Gets the Smoke instance associated with the binding.
+ * @return a pointer to the Smoke instance
+ */
+Smoke*
+Binding::get_smoke() const
+{
+	return smoke;
+}
+
+} // namespace cl_smoke
diff -rN -u old-smoke/src/smoke-c/csmokebinding.h new-smoke/src/smoke-c/csmokebinding.h
--- old-smoke/src/smoke-c/csmokebinding.h	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke-c/csmokebinding.h	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,40 @@
+#ifndef CSMOKEBINDING_H
+#define CSMOKEBINDING_H
+
+#include <smoke.h>
+
+namespace cl_smoke
+{
+
+class Binding : public SmokeBinding
+{
+	public:
+		typedef void (*destructed)(Binding* binding, Smoke::Index class_id,
+				void* object);
+
+		typedef int (*dispatch_method)(Binding* binding, Smoke::Index method,
+				void* object, Smoke::Stack args, int abstract);
+
+		Binding(Smoke *smoke, destructed destruct, dispatch_method dispatch);
+
+		virtual void
+		deleted(Smoke::Index classId, void *obj);
+
+		virtual bool
+		callMethod(Smoke::Index method, void* object,
+				Smoke::Stack stack, bool abstract);
+
+		virtual char* 
+		className(Smoke::Index classId);
+
+		Smoke*
+		get_smoke() const;
+
+	private:
+		const destructed destruct;
+		const dispatch_method dispatch;
+};
+
+} // namespace cl_smoke
+
+#endif // CSMOKEBINDING_H
diff -rN -u old-smoke/src/smoke-c/method.lisp new-smoke/src/smoke-c/method.lisp
--- old-smoke/src/smoke-c/method.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke-c/method.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,58 @@
+(in-package #:smoke)
+
+(declaim (optimize (debug 3)))
+
+(defcenum smoke-method-flags
+  "Method flags"
+  (:static #x01)
+  (:const #x02)
+  (:copy-constructor #x04)
+  (:internal #x08)
+  (:enum #x10)
+  (:constructor #x20)
+  (:destructor #x40)
+  (:protected #x80))
+
+(defcstruct smoke-method
+  "Describe a method"
+  (class smoke-index)
+  (name smoke-index)
+  (arguments smoke-index)
+  (num-args :unsigned-char)
+  (flags :unsigned-char)
+  (return-type smoke-index)
+  (method smoke-index))
+
+(defcfun smoke-find-method :void
+  (m :pointer smoke-module-index)
+  (smoke :pointer)
+  (class smoke-index)
+  (method :string))
+
+(defcfun smoke-methods-size smoke-index
+  (smoke :pointer))
+
+(defcfun smoke-get-method (:pointer smoke-method)
+  (smoke :pointer)
+  (method smoke-index))
+
+(defcfun smoke-get-method-name :string
+  (smoke :pointer)
+  (method-index smoke-index))
+
+(defcfun smoke-method-name-size smoke-index
+  (smoke :pointer))
+
+(defcfun smoke-call-method :string
+  (smoke :pointer)
+  (method smoke-index)
+  (object :pointer)
+  (stack smoke-stack))
+
+(defcfun smoke-get-argument smoke-index
+  (smoke :pointer)
+  (argument smoke-index))
+
+(defcfun smoke-ambiguous-method smoke-index
+  (smoke :pointer)
+  (ambiguous smoke-index))
diff -rN -u old-smoke/src/smoke-c/smoke-c-util.cpp new-smoke/src/smoke-c/smoke-c-util.cpp
--- old-smoke/src/smoke-c/smoke-c-util.cpp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke-c/smoke-c-util.cpp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,18 @@
+
+/** @file
+ * \@brief Utility functions
+ */
+
+extern "C" {
+
+/** Gets the size of the C++ bool type in bytes.
+ *
+ * @return the size of bool
+ */
+int
+smoke_sizeof_bool()
+{
+	return sizeof(bool);
+}
+
+} // extern "C"
diff -rN -u old-smoke/src/smoke-c/smoke-c.cpp new-smoke/src/smoke-c/smoke-c.cpp
--- old-smoke/src/smoke-c/smoke-c.cpp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke-c/smoke-c.cpp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,430 @@
+#include "csmokebinding.h"
+
+#include <smoke.h>
+
+#include <stdexcept>
+#include <QtGlobal>
+
+/** @file 
+ * \@brief C wrapper the Smoke bindings.
+ *
+ * \example examples/kde-hello-world.cpp
+ * This KDE example creates a KXmlGuiWindow.
+ * Note that C++ is only used to make the example shorter
+ * (by allowing to directly include smoke-c.cpp), but it could also
+ * be implemented in C using \c dlsym.
+ *
+ * \image html doc/images/kde-hello-world.png "Screenshot"
+ * \image latex doc/images/kde-hello-world.png "Screenshot" width=5cm
+ */
+
+
+/** @brief Common Lisp smoke binding namespace. */
+namespace cl_smoke
+{
+
+/** A Binding */
+typedef void* smoke_binding;
+
+/** Casts the void pointer smoke_binding to the Binding class.
+ * @param smoke the smoke binding
+ *
+ * @return pointer to the Binding instance
+ */
+static inline
+Binding*
+get_smoke_binding(smoke_binding binding)
+{
+	return static_cast<Binding*>(binding);
+}
+
+/** Casts the void pointer smoke to the Smoke class.
+ * @param smoke the Smoke module
+ *
+ * @return pointer to the Smoke module.
+ */
+static inline
+Smoke*
+get_smoke(void* smoke)
+{
+	return static_cast<Smoke*>(smoke);
+}
+} // namespace cl_smoke
+
+using namespace cl_smoke;
+
+extern "C" {
+
+/** Returns the Smoke module of a Smoke binding.
+ * @related cl_smoke::Binding
+ * @param binding the Binding
+ *
+ * @return the Smoke module
+ */
+void*
+smoke_get_smoke(smoke_binding binding)
+{
+	return get_smoke_binding(binding)->get_smoke();
+}
+
+/** Creates a new Smoke binding.
+ * The binding is allocated on the heap an can be freed with smoke_destruct().
+ * @related cl_smoke::Binding
+ * @param smoke pointer to a Smoke module instance
+ * @param destruct callback for object destruction
+ * @param dispatch method dispatch callback
+ *
+ * @return a pointer to a new Smoke binding.
+ */
+smoke_binding
+smoke_init(void* smoke, void* destruct, void* dispatch)
+{
+	return new Binding(static_cast<Smoke*>(smoke),
+			reinterpret_cast<Binding::destructed>(destruct),
+			reinterpret_cast<Binding::dispatch_method>(dispatch));
+}
+
+/** Deletes the smoke binding.
+ * @related cl_smoke::Binding
+ */
+void
+smoke_destruct(smoke_binding binding)
+{
+	delete get_smoke_binding(binding)->get_smoke();
+	delete get_smoke_binding(binding);
+}
+
+/** Gets a Smoke modules name.
+ * @param smoke the Smoke module
+ *
+ * @return the module name
+ */
+const char*
+smoke_get_module_name(void* smoke)
+{
+	return get_smoke(smoke)->moduleName();
+}
+
+///////////////////////////
+/// Class
+///////////////////////////
+
+/** Finds a class.
+ * @param c pointer to write the result to
+ * @param smoke the smoke module
+ * @param name the name of the class
+ */
+void
+smoke_find_class(Smoke::ModuleIndex* c, void* smoke, const char* name)
+{
+	*c = get_smoke(smoke)->findClass(name);
+}
+
+/** Gets the class ID for a Smoke module.
+ * @param smoke the Smoke module
+ * @param name the class name
+ *
+ * @return the class ID in the supplied Smoke module
+ */
+Smoke::Index
+smoke_class_id(void* smoke, const char* name)
+{
+	Smoke::ModuleIndex m = get_smoke(smoke)->idClass(name, true);
+	Q_ASSERT(m.smoke == smoke);
+
+	return m.index;
+}
+
+
+
+/** Gets the number of classes.
+ *
+ * @return the number of classes
+ */
+Smoke::Index
+smoke_classes_size(void* smoke)
+{
+	return get_smoke(smoke)->numClasses;
+}
+
+/** Sets the binding for an newly constructed instance.
+ * @param smoke the Smoke module
+ * @param binding the Smoke binding
+ * @param class_index the index of the instances class
+ * @param object pointer to the class instance.
+ */
+void
+smoke_set_binding(void* smoke, smoke_binding binding, Smoke::Index class_index, void* object)
+{
+	Q_ASSERT(object != NULL);
+	Q_ASSERT(binding != NULL);
+	Q_ASSERT(class_index > 0 && class_index <= smoke_classes_size(smoke));
+
+	const Smoke::Class* klass = &get_smoke(smoke)->classes[class_index];	
+
+	Smoke::StackItem stack[2];
+        stack[1].s_voidp = get_smoke_binding(binding);
+
+	(*klass->classFn)(0, object, stack);
+}
+
+/** Gets a class
+ * @param smoke the smoke binding
+ * @param class_index the index of the class
+ *
+ * @return A pointer to the class into the array of class structs
+ */
+const struct Smoke::Class*
+smoke_get_class(void* smoke, Smoke::Index class_index)
+{
+	Q_ASSERT(class_index >= 0 && class_index <= smoke_classes_size(smoke));
+	return &get_smoke(smoke)->classes[class_index];
+}
+
+/** Determines werter a class is from a base class.
+ * @param smoke the Smoke module of @a class_index
+ * @param class_index the class index
+ * @param smoke_base the Smoke module of the base class @a base_index
+ * @param base_index the index of the base class
+ *
+ * @return Returns 0 when the class is not derived from the base class and nonzero value otherwise.
+ */
+int
+smoke_is_derived_from(void* smoke, Smoke::Index class_index, void* smoke_base, Smoke::Index base_index)
+{
+	Q_ASSERT(!smoke_get_class(smoke, class_index)->external);
+	Q_ASSERT(!smoke_get_class(smoke_base, base_index)->external);
+
+	return get_smoke(smoke)->isDerivedFrom(get_smoke(smoke), class_index,
+		get_smoke(smoke_base), base_index);
+}
+
+/** Returns the index of a base class.
+ * @param smoke the Smoke module
+ * @param class_index the class index
+ * 
+ * @return the index of a parent
+ */
+Smoke::Index
+smoke_get_parent_index(void* smoke, Smoke::Index class_index)
+{
+	Q_ASSERT(class_index >= 0);
+
+	return get_smoke(smoke)->inheritanceList[class_index];
+}
+
+//////////////////////////////
+/// Method
+//////////////////////////////
+
+/** Gets the method map.
+ * @param smoke the Smoke module
+ * @param method the index of the method
+ *
+ * @return a pointer to the @c MethodMap entry.
+ */
+const Smoke::MethodMap*
+smoke_get_method_map(void* smoke, Smoke::Index method)
+{
+	Q_ASSERT(method >= 0 && method <= get_smoke(smoke)->numMethodMaps);
+
+	return &get_smoke(smoke)->methodMaps[method];
+}
+
+/** Gets a methods name.
+ * @param smoke the Smoke module
+ * @param method_name the method name index
+ *
+ * @return the method name
+ */
+const char*
+smoke_get_method_name(void* smoke, Smoke::Index method_name)
+{
+	Q_ASSERT(method_name >= 0 && method_name <= get_smoke(smoke)->numMethodNames);
+
+	return get_smoke(smoke)->methodNames[method_name];
+}
+
+/** Gets the number of method names.
+ * @param smoke the Smoke module
+ *
+ * @return the number of method names
+ */
+Smoke::Index
+smoke_method_name_size(void *smoke)
+{
+	return get_smoke(smoke)->numMethodNames;
+}
+
+/** Gets the number of methods.
+ * @param smoke the Smoke module
+ *
+ * @return the number of methods
+ */
+Smoke::Index
+smoke_methods_size(void* smoke)
+{
+	return get_smoke(smoke)->numMethods;
+}
+
+/** Gets a method.
+ * @param smoke the smoke binding
+ * @param method the index of the method
+ *
+ * @return a pointer to the method struct
+ */
+const struct Smoke::Method*
+smoke_get_method(void* smoke, Smoke::Index method)
+{
+	Q_ASSERT(method >= 0 && method <= smoke_methods_size(smoke));
+
+	return &get_smoke(smoke)->methods[method];
+}
+
+/** Finds a method of a class.
+ * @param m pointer to write the result to
+ * @param smoke the smoke binding
+ * @param class_index index of the class
+ * @param method_name method name
+ */
+void
+smoke_find_method(Smoke::ModuleIndex* m, void* smoke,
+		Smoke::Index class_index, const char* method_name)
+{
+	*m = get_smoke(smoke)->findMethod(get_smoke(smoke)->className(class_index),
+			method_name);
+	if(m->index > 0)
+		m->index = smoke_get_method_map(m->smoke, m->index)->method;
+}
+
+/** Gets the type index of an argument.
+ * @param smoke the smoke binding
+ * @param argument the argument index
+ *
+ * @return the type index
+ */
+Smoke::Index
+smoke_get_argument(void* smoke, Smoke::Index argument)
+{
+	Q_ASSERT(argument >= 0);
+
+	return get_smoke(smoke)->argumentList[argument];
+}
+
+/** Calls a method.
+ * The methods return value is stored in the first element of the stack.
+ * @param smoke the smoke binding
+ * @param method the index of the method
+ * @param object A pointer to the class instance, or NULL for static and constructor calls
+ * @param stack The stack with the methods arguments.
+ *
+ * @return NULL on success or a description of the exception that occurred.
+ */
+const char*
+smoke_call_method(void* smoke, Smoke::Index method, void* object,
+	Smoke::Stack stack)
+{
+ 	Smoke::Method meth = *smoke_get_method(smoke, method);
+	Q_ASSERT(!(meth.flags & Smoke::mf_internal));
+	Q_ASSERT_X((NULL == object
+				&& (meth.flags & (Smoke::mf_static
+						| Smoke::mf_enum
+						| Smoke::mf_copyctor
+						| Smoke::mf_ctor)))
+			|| object,
+			__func__, "object is NULL");
+	Q_ASSERT(meth.flags & Smoke::mf_ctor ?  NULL == object : true);
+ 	const Smoke::Class* klass = smoke_get_class(smoke, meth.classId);
+
+	try
+	{
+		Q_ASSERT(klass->classFn != NULL);
+		(*klass->classFn)(meth.method, object, stack);
+	}
+	catch (std::exception& e)
+	{
+		qFatal(e.what());
+		return e.what();
+	}
+	catch (...)
+	{
+		qFatal("exception");
+		return NULL;
+	}
+
+	return NULL;
+}
+
+///////////////////////////
+/// Type
+//////////////////////////
+
+/** Gets the number of types.
+ * @param smoke the Smoke module
+ *
+ * @return the number of types
+ */
+Smoke::Index
+smoke_types_size(void* smoke)
+{
+	return get_smoke(smoke)->numTypes;
+}
+
+/** Gets a type.
+ * @param smoke the Smoke module
+ * @param type the index of the type
+ *
+ * @return a pointer to the type struct
+ */
+const struct Smoke::Type*
+smoke_get_type(void* smoke, Smoke::Index type)
+{
+	Q_ASSERT(type >= 0 && type <= smoke_types_size(smoke));
+
+	return &get_smoke(smoke)->types[type];
+}
+
+/** Gets the index of a type.
+ * @param smoke the Smoke module
+ * @param name the types name
+ *
+ * @return the index of the type
+ */
+Smoke::Index
+smoke_find_type(void* smoke, const char* name)
+{
+	return get_smoke(smoke)->idType(name);
+}
+
+/** Casts an object.
+ * @param smoke the Smoke module
+ * @param object the objec
+ * @param from the class index of @a object
+ * @param to the class index to cast to
+ *
+ * @return the casted object
+ */
+void*
+smoke_cast(void* smoke, void* object, Smoke::Index from, Smoke::Index to)
+{
+	Q_ASSERT(from > 0 && from <= smoke_classes_size(smoke));
+	Q_ASSERT(to > 0 && to <= smoke_classes_size(smoke));
+
+	return get_smoke(smoke)->cast(object, from, to);
+}
+
+/** Gets an ambiguous method.
+ * @param smoke the Smoke module
+ * @param ambiguous the index
+ *
+ * @return the index of a method
+ */
+Smoke::Index
+smoke_ambiguous_method(void* smoke, Smoke::Index ambiguous)
+{
+	Q_ASSERT(ambiguous >= 0);
+
+	return get_smoke(smoke)->ambiguousMethodList[ambiguous];
+}
+
+} // extern "C"
diff -rN -u old-smoke/src/smoke-c/smoke-c.lisp new-smoke/src/smoke-c/smoke-c.lisp
--- old-smoke/src/smoke-c/smoke-c.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke-c/smoke-c.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,64 @@
+(in-package #:smoke)
+
+(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 libsmoke-c)
+)
+ 
+
+
+(eval-when (:load-toplevel :compile-toplevel :execute)
+  (use-foreign-library libsmoke-c-util)
+  (defcfun smoke-sizeof-bool :int)
+  (defun cffi-bool-type ()
+    "Returns a cffi unsigned int type with the same size as a C++ bool."
+    (load-foreign-library 'libsmoke-c-util)
+    (intern (format nil "UINT~A" (* 8
+                                    (smoke-sizeof-bool)))
+                                 ;   (foreign-funcall smoke-sizeof-bool :int)))
+            (find-package :keyword)))
+
+  (defmacro defcxxbool ()
+    `(defctype cxx-bool (:boolean ,(cffi-bool-type)))))
+
+(defcxxbool)
+
+(close-foreign-library 'libsmoke-c-util)
+
+(defctype smoke-binding :pointer
+  "A Smoke binding")
+
+(defctype smoke-index :short
+  "An index")
+
+(defcfun smoke-init smoke-binding
+  (smoke :pointer)
+  (destruct :pointer)
+  (dispatch :pointer))
+
+(defcfun smoke-destruct :void
+  (smoke smoke-binding))
+
+(defcstruct smoke-module-index
+  "asdf"
+  (smoke :pointer)
+  (index smoke-index))
+
+
+(defcfun smoke-set-binding :void
+  "Sets the binding for an newly constructed instance."
+  (smoke :pointer)
+  (smoke-binding smoke-binding)
+  (class smoke-index)
+  (object :pointer))
+
+(defcfun smoke-get-smoke :pointer
+  (smoke-binding smoke-binding))
+
+(defcfun smoke-get-module-name :string
+  (smoke :pointer))
diff -rN -u old-smoke/src/smoke-c/stack.lisp new-smoke/src/smoke-c/stack.lisp
--- old-smoke/src/smoke-c/stack.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke-c/stack.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,21 @@
+(in-package #:smoke)
+
+(defcunion smoke-stack-item
+  "A variable on the Smoke stack"
+  (voidp :pointer)
+  (bool cxx-bool)
+  (char :char)
+  (uchar :unsigned-char)
+  (short :short)
+  (ushort :unsigned-short)
+  (int :int)
+  (uint :unsigned-int)
+  (long :long)
+  (ulong :unsigned-long)
+  (float :float)
+  (double :double)
+  (enum-value :long)
+  (class :pointer))
+
+(defctype smoke-stack (:pointer smoke-stack-item)
+  "A Smoke call stack.")
diff -rN -u old-smoke/src/smoke-c/type.lisp new-smoke/src/smoke-c/type.lisp
--- old-smoke/src/smoke-c/type.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke-c/type.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,28 @@
+(in-package #:smoke)
+
+(defcenum smoke-type-flags
+  "Type properties"
+  (:type-id #x0F)
+
+  (:stack #x10)
+  (:pointer #x20)
+  (:reference #x30)
+
+  (:const #x40))
+
+(defcstruct smoke-type
+  "A type"
+  (name :string)
+  (class smoke-index)
+  (flags :unsigned-short))
+
+(defcfun smoke-find-type smoke-index
+  (smoke :pointer)
+  (name :string))
+
+(defcfun smoke-types-size smoke-index
+  (smoke :pointer))
+
+(defcfun smoke-get-type (:pointer smoke-type)
+  (smoke :pointer)
+  (type smoke-index))
diff -rN -u old-smoke/src/smoke.lisp new-smoke/src/smoke.lisp
--- old-smoke/src/smoke.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/smoke.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,138 @@
+(in-package #:smoke)
+
+(declaim (optimize (debug 3)))
+
+(defun s-call (method object &optional (args nil))
+  (with-stack (stack args (arguments method) )
+    (smoke-call-method (smoke method) (id method)
+                       object (pointer stack))
+    (type-to-lisp (pointer stack) (return-type method))))
+
+(defun pointer-call (method object &optional (args nil))
+  (with-stack (stack args (arguments method) )
+    (smoke-call-method (smoke method) (id method)
+                       object (pointer stack))
+    (foreign-slot-value (pointer stack) 'smoke-stack-item 'class)))
+
+
+(defun smoke-call (class pointer method-name &optional (args nil))
+  (s-call
+   (make-smoke-method class method-name)
+   pointer args))
+
+(defun static-call (smoke class-name method-name &rest args)
+  (s-call
+   (make-smoke-method (make-smoke-class smoke class-name)
+                           method-name)
+   (null-pointer) args))
+
+(defun enum-call (method)
+  "Return the enum value for METHOD."
+  ;; FIXME:
+  ;; we could use static call, but QGraphicsEllipseItem::Type has
+  ;; wrongly QGraphicsGridLayout as return type. Smoke ignores case
+  ;; and confuses it with the member function type() ??
+  ;; (27.2.09)
+  ;; 
+  (assert (enum-p method))
+  (with-stack (stack nil nil)
+    (smoke-call-method (smoke method) (id method)
+                       (null-pointer) (pointer stack))
+    (foreign-slot-value (pointer stack) 'smoke-stack-item 'long)))
+
+#|
+(defun new-object (binding class-name method-name &rest args)
+  (let* ((smoke (smoke-get-smoke binding))
+         (pointer
+          (pointer-call
+           (make-smoke-method (make-smoke-class smoke class-name)
+                                         method-name)
+                      (null-pointer) args)))
+    (let ((object (instance-to-lisp object (find-smoke-class class)
+                                    (return-type)))
+|#
+(defun new-object (binding class-name method-name &rest args)
+  (let* ((smoke (smoke-get-smoke binding))
+         (method (make-smoke-method (make-smoke-class smoke class-name)
+                                    method-name))
+         (pointer
+          (pointer-call method (null-pointer) args))
+         (object (instance-to-lisp pointer 
+                                   (find-smoke-class (get-class (return-type method)))
+                                   (return-type method))))
+    (set-binding object (binding (smoke (class-of object))))
+    (add-object object)
+    object))
+  
+(defun delete-pointer (pointer class)
+  "Destructs the object at POINTER of type CLASS.
+Calls the destrutor and frees the memory."
+  (let ((method-name (concatenate 'string "~" (name class))))
+    (s-call
+                (make-smoke-method class method-name)
+                pointer))
+  (setf pointer (null-pointer)))
+
+(defun delete-object (object)
+  (let ((method-name (concatenate 'string "~" (name object))))
+    (s-call
+                (make-smoke-method object method-name)
+                (pointer object)))
+  (setf (slot-value object 'pointer) (null-pointer)))
+
+(defun set-binding (object binding)
+  (smoke-set-binding (smoke (class-of object)) binding (id (class-of object)) (pointer object)))
+
+(defun init (smoke)
+  "Returns the a new Smoke binding for the Smoke module SMOKE."
+  (use-foreign-library libsmoke-c)
+  (let ((binding (smoke-init smoke
+                             (callback destructed)
+                             (callback dispatch-method))))
+    (setf (binding smoke) binding)
+    binding))
+
+(defun call (object method-name &rest args)
+  (smoke-call (class-of object)
+              (pointer object)
+              method-name
+              args))
+
+(defmethod documentation ((class smoke-standard-class) (doc-type t))
+  (format nil "~@[~A~%~]C++ name: ~A" (call-next-method) (name class)))
+
+(defmethod documentation ((gf smoke-gf) (doc-type t))
+  (let ((methods (all-methods (name gf))))
+    (format nil "~@[~A~%~]~{~T~A~%~}"
+            (call-next-method)
+            (sort (mapcar #'method-declaration methods) #'string<=))))
+
+(defun all-methods (name)
+  "Returns a list of all methods named NAME."
+  (let ((methods))
+    (maphash #'(lambda (address value)
+                 (declare (ignore value))
+                 (let ((smoke (make-pointer address)))
+                   (map-methods #'(lambda (method)
+                                    (when (and (string= name (name method))
+                                               (not (enum-p method)))
+                                      (push (make-instance 'smoke-method
+                                                           :id (id method)
+                                                           :smoke (smoke method))
+                                            methods)))
+                                smoke)))
+             *smoke-id-class-map*)
+    methods))
+
+(defun fgrep-methods (smoke str)
+  (map-methods #'(lambda (method)
+                     (when (search str (name method))
+                       (format t "~A::~A~%" (name (get-class method))
+                               (signature method))))
+               smoke))
+
+(defun fgrep-classes (smoke str)
+  (map-classes #'(lambda (class)
+                   (when (search str (name class))
+                     (format t "~A~%" (name class))))
+               smoke))
diff -rN -u old-smoke/src/test.lisp new-smoke/src/test.lisp
--- old-smoke/src/test.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/test.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,10 @@
+#|
+exec sbcl --noinform --load $0 --end-toplevel-options "$@"
+|#
+
+(sb-ext:disable-debugger)
+(require :smoke)
+(in-package :smoke)
+(setup)
+(test)
+(sb-ext:quit)
diff -rN -u old-smoke/src/tests.lisp new-smoke/src/tests.lisp
--- old-smoke/src/tests.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/tests.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,5 @@
+(in-package :smoke)
+
+(5am:def-suite smoke-suite)
+(5am:in-suite smoke-suite)
+
diff -rN -u old-smoke/src/translate.lisp new-smoke/src/translate.lisp
--- old-smoke/src/translate.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/translate.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,26 @@
+(in-package :smoke)
+
+(defvar *type-map* (make-hash-table :test 'equal))
+
+(defun get-type (name)
+  "Return the CFFI type for NAME."
+  (gethash name *type-map*))
+
+(defun add-type (name type)
+  "Registers the CFFI type TYPE with NAME."
+  (setf (gethash name *type-map*) type))
+
+(defun setup-type-map ()
+  "Setup C string <-> Lisp string translation."
+  (add-type "char*" :string)
+  (add-type "const char*" :string))
+
+(eval-when (:load-toplevel :execute)
+  (setup-type-map))
+
+(defgeneric convert-to-class (smoke-class object))
+
+;(defmethod convert-to-class (smoke-class (pointer cffi:foreign-pointer))
+(defmethod convert-to-class (smoke-class pointer)
+  (assert (cffi:pointerp pointer))
+  pointer)
diff -rN -u old-smoke/src/utils/get-value.lisp new-smoke/src/utils/get-value.lisp
--- old-smoke/src/utils/get-value.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-smoke/src/utils/get-value.lisp	2014-09-30 19:52:08.000000000 +0200
@@ -0,0 +1,5 @@
+(in-package #:smoke)
+
+ (defun read-new-value ()
+   (format *query-io* "Enter a new value: ")
+   (multiple-value-list (eval (read *query-io*))))