Sun Jan 10 09:52:09 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Split up in qt.core.
- Fix qt:with-core-app
- cleanup name prefixes
diff -rN -u old-qt.core/cl-smoke.qt.core.asd new-qt.core/cl-smoke.qt.core.asd
--- old-qt.core/cl-smoke.qt.core.asd 1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/cl-smoke.qt.core.asd 2014-10-30 06:58:17.000000000 +0100
@@ -0,0 +1,41 @@
+(defsystem :cl-smoke.qt.core
+ :name :cl-smoke.qt.core
+ :version (0 0 1)
+ :author "Tobias Rautenkranz"
+ :license "GPL with linking exception"
+ :description "Smoke Qt core bindings."
+ :depends-on (:cl-smoke.smoke :cffi :alexandria)
+
+ :components
+ ((:module "src"
+ :components
+ ((:file "package")
+ (:module "lib" :depends-on ("package"))
+ (:file "qt.core" :depends-on ("package" "lib"))
+ (:file "ownership" :depends-on ("qt.core"))
+ (:file "event" :depends-on ("qt.core"))
+ (:file "object" :depends-on ("qt.core" "signal-slot" "qstring" "event"))
+ (:file "operator" :depends-on ("qt.core" "object"))
+ (:file "application" :depends-on ("qt.core" "properties"))
+ (:file "qstring" :depends-on ("qt.core"))
+ (:file "list" :depends-on ("qt.core"))
+ (:file "msg-handler" :depends-on ("lib" "qt.core"))
+ (:file "timer" :depends-on ("qt.core"))
+ (:file "i18n" :depends-on ("qt.core"))
+ (:file "lisp-object" :depends-on ("qt.core" "lib"))
+ (:module "signal-slot"
+ :serial t
+ :depends-on ("lisp-object")
+ :components
+ ((:file "signal-slot")
+ (:file "translate" :depends-on ("signal-slot"))
+ (:file "signal" :depends-on ("translate"))
+ (:file "slot" :depends-on ("signal"))
+ (:file "connect" :depends-on ("slot"))))
+ (:file "string-list" :depends-on ("qt.core" "lib" "qstring"))
+ (:file "variant" :depends-on ("qt.core" "qstring" "lisp-object"))
+ (:file "properties" :depends-on ("variant"))))))
+
+(defmethod perform ((operation test-op) (c (eql (find-system :cl-smoke.qt.core))))
+ (operate 'asdf:load-op :cl-smoke.qt.tests)
+ (operate 'asdf:test-op :cl-smoke.qt.tests))
diff -rN -u old-qt.core/examples/hello-world.lisp new-qt.core/examples/hello-world.lisp
--- old-qt.core/examples/hello-world.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/examples/hello-world.lisp 1970-01-01 01:00:00.000000000 +0100
@@ -1,63 +0,0 @@
-(in-package :qt-examples)
-(declaim (optimize (debug 3)))
-
-(defun hello-world ()
- "Hello world"
- (qt:with-app
- (let ((widget (make-instance 'qt:push-button :args '("Hello world"))))
- (cxx:show widget)
- (qt:exec))))
-
-
-(defun hello-world-quit ()
- "Quit on push-button click"
- (qt:with-app
- (let ((quit (make-instance 'qt:push-button :args '("Quit"))))
- (cxx:resize quit 75 30)
- (cxx:set-font quit (make-instance 'qt:font :args (list "Times"
- 18
- qt:font.+bold+)))
-
- (qt:object.connect quit (qt:qsignal "clicked()")
- (qt:app) (qt:qslot "quit()"))
- (cxx:show quit)
- (qt:exec))))
-
-(defun hello-world-gc ()
- "GC on push-button click"
- (qt:with-app
- (let ((gc (make-instance 'qt:widget)))
- (let ((layout (make-instance 'qt:vbox-layout))
- (button (make-instance 'qt:push-button :args '("GC"))))
- (trivial-garbage:gc :full t)
- (cxx:add-widget layout button)
- (trivial-garbage:gc :full t)
- (cxx:set-layout gc layout)
- (trivial-garbage:gc :full t)
- (qt:connect-function button "clicked()"
- #'(lambda ()
- (format t "GC-ing~%")
- (trivial-garbage:gc :full t))))
- (trivial-garbage:gc :full t)
- (cxx:show gc)
- (trivial-garbage:gc :full t)
- (qt:exec))))
-
-;; You need to run cmake & make to generate the .po and .qm files
-(defun i18n-hello-world ()
- "i18n hello world"
- (qt:with-app
- (qt:with-translator "hello-world"
- (let ((widget (make-instance 'qt:label)))
- (setf (qt:property widget 'window-title)
- (qt:tr "Lisp Qt Example" "hello-world"))
- (cxx:set-text widget
- (format nil (qt:tr "<h1>Hello world</h1>
-
-You are running ~A version ~A on a ~A ~A")
- (lisp-implementation-type)
- (lisp-implementation-version)
- (software-type)
- (software-version)))
- (cxx:show widget)
- (qt:exec)))))
diff -rN -u old-qt.core/examples/package.lisp new-qt.core/examples/package.lisp
--- old-qt.core/examples/package.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/examples/package.lisp 1970-01-01 01:00:00.000000000 +0100
@@ -1,15 +0,0 @@
-(defpackage #:qt-examples
- (:use #:cl)
- (:export #:hello-world
- #:i18n-hello-world
- #:hello-world-quit
- #:hello-world-gc
-
- #:class-browser
-
- #:tick-tack-toe
- #:repl
-
- #:launcher
-
- #:load-ui-file))
diff -rN -u old-qt.core/qt.asd new-qt.core/qt.asd
--- old-qt.core/qt.asd 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/qt.asd 1970-01-01 01:00:00.000000000 +0100
@@ -1,47 +0,0 @@
-(defpackage qt-system
- (:use :cl :asdf))
-
-(in-package qt-system)
-
-(asdf:defsystem :qt
- :name :qt
- :version (0 0 1)
- :author "Tobias Rautenkranz"
- :license "GPL with linking exception"
- :description "Smoke Qt bindings."
- :depends-on (:smoke :smoke :cffi :alexandria)
-
- :components
- ((:module "src"
- :components
- ((:file "package")
- (:module "lib" :depends-on ("package"))
- (:file "qt" :depends-on ("package" "lib"))
- (:file "ownership" :depends-on ("qt"))
- (:file "event" :depends-on ("qt"))
- (:file "object" :depends-on ("qt" "signal-slot" "qstring" "event"))
- (:file "operator" :depends-on ("qt" "object"))
- (:file "application" :depends-on ("qt" "properties"))
- (:file "qstring" :depends-on ("qt"))
- (:file "list" :depends-on ("qt"))
- (:file "msg-handler" :depends-on ("lib" "qt"))
- (:file "painter" :depends-on ("qt"))
- (:file "timer" :depends-on ("qt"))
- (:file "i18n" :depends-on ("qt"))
- (:file "lisp-object" :depends-on ("qt" "lib"))
- (:module "signal-slot"
- :serial t
- :depends-on ("lisp-object")
- :components
- ((:file "signal-slot")
- (:file "translate" :depends-on ("signal-slot"))
- (:file "signal" :depends-on ("translate"))
- (:file "slot" :depends-on ("signal"))
- (:file "connect" :depends-on ("slot"))))
- (:file "string-list" :depends-on ("qt" "lib" "qstring"))
- (:file "variant" :depends-on ("qt" "qstring" "lisp-object"))
- (:file "properties" :depends-on ("variant"))))))
-
-(defmethod asdf:perform ((operation test-op) (c (eql (find-system :qt))))
- (operate 'asdf:load-op :qt.tests)
- (operate 'asdf:test-op :qt.tests))
diff -rN -u old-qt.core/src/application.lisp new-qt.core/src/application.lisp
--- old-qt.core/src/application.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/application.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,7 +1,6 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defvar *app*)
-(defvar *widgets* nil)
(defvar qt:*exec-p* t
"Run exec if true and not otherwise.")
@@ -18,7 +17,7 @@
(boundp '*app*))
(defun ensure-app (&optional
- (application 'qt:application)
+ (application 'qt:core-application)
(args #+sbcl sb-ext:*posix-argv*
#+ccl ccl:*command-line-argument-list*
#-(or sbcl ccl) (list (lisp-implementation-type))))
@@ -49,31 +48,25 @@
(foreign-alloc :int :initial-element (length args))))
(argv (smoke:make-auto-pointer
(foreign-alloc :string :initial-contents args)))
- (app (make-instance 'qt:application :args (list argc argv))))
+ (app (make-instance application :args (list argc argv))))
;; argc and argv must remain valid during the lifetime of APP.
(setf (qt:property app 'cmdline-args)
(qt:make-lisp-variant (list argc argv)))
(tg:cancel-finalization app)
(values app t)))))
+(defgeneric delete-app (application)
+ (:method (application)
+ (cxx:quit application)
+ ;; Call the destructor; -> destructed callback is called,
+ ;; (~QApplication() is virtual) which takes care of cleanup on the
+ ;; Lisp side.
+ (smoke::delete-pointer (smoke:pointer application) (class-of application))
+ (setf (slot-value application 'pointer) (null-pointer))
+ (makunbound '*app*)))
+
(defun kill-app ()
- (when (typep (qt:app) 'qt:application)
- (qt:application.close-all-windows)
- ;; widgets are only valid as long, as an application object
- ;; exists. QApplication::~QApplication() deletes all widgets in
- ;; QApplication::allWidgets().
- ;;
- ;; see: qt4/src/gui/kernel/qapplication.cpp
- (loop for widget across (qt:application.all-widgets) do
- (tg:cancel-finalization widget)))
- (cxx:quit (qt:app))
- (setf *widgets* nil)
- ;; Call the destructor; -> destructed callback is called,
- ;; (~QApplication() is virtual) which takes care of cleanup on the
- ;; Lisp side.
- (smoke::delete-pointer (smoke:pointer (qt:app)) (class-of (qt:app)))
- (setf (slot-value (qt:app) 'pointer) (null-pointer))
- (makunbound '*app*))
+ (delete-app (qt:app)))
(defmacro with-application ((ensure-app remove-app) &body body)
(let ((cleanup-p (gensym)))
@@ -83,46 +76,28 @@
(when ,cleanup-p
,remove-app)))))
-(defmacro qt:with-app (options &body body)
- "Ensures that a APPLICATION instance exists,
-evaluates BODY and executes the APPLICATION instance after BODY.
-The instance can be accessed with:
-QT:APP.
-
-Can be nested.
-
-When a APPLICATION was created, it will be deleted when returning
-from BODY."
- (assert (null options)
- (options)
- "Currently no options can be passed to QT:WITH-APP.")
- `(with-application ((cl-smoke.qt-impl::ensure-app 'qt:application) (kill-app))
- ,@body))
-
(defmacro qt:with-core-app (options &body body)
(assert (null options)
(options)
"Currently no options can be passed to QT:WITH-CORE-APP.")
- `(with-application ((cl-smoke.qt-impl::ensure-app 'qt:core-application) (kill-app))
+ `(with-application ((cl-smoke.qt.core::ensure-app 'qt:core-application) (kill-app))
,@body))
(defun qt:exec ()
"Executes APP. When QT:*EXEC-P* is false it returns immediately
and transfers the ownership of the top-level widgets to the qt:application
instance."
- (if qt:*exec-p*
- (restart-bind ((qt::abort-app #'(lambda ()
- (cxx:quit (qt:app))
- (invoke-restart (find-restart 'continue)))
- :report-function
- #'(lambda (stream)
- (format stream "Return from the application event loop."))
- :test-function
- #'(lambda (condition)
- (declare (ignore condition))
- (and (qt:app-p)
- (find-restart 'continue)))))
- (let ((qt:*exec-p* nil))
- (cxx:exec (qt:app))))
- (when (typep (qt:app) 'qt:application)
- (setf *widgets* (qt:application.top-level-widgets)))))
+ (when qt:*exec-p*
+ (restart-bind ((qt::abort-app #'(lambda ()
+ (cxx:quit (qt:app))
+ (invoke-restart (find-restart 'continue)))
+ :report-function
+ #'(lambda (stream)
+ (format stream "Return from the application event loop."))
+ :test-function
+ #'(lambda (condition)
+ (declare (ignore condition))
+ (and (qt:app-p)
+ (find-restart 'continue)))))
+ (let ((qt:*exec-p* nil))
+ (cxx:exec (qt:app))))))
diff -rN -u old-qt.core/src/event.lisp new-qt.core/src/event.lisp
--- old-qt.core/src/event.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/event.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defun cast-event (event)
(enum-case (cxx:type event)
diff -rN -u old-qt.core/src/i18n.lisp new-qt.core/src/i18n.lisp
--- old-qt.core/src/i18n.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/i18n.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defun qt:tr (message &optional context)
"Returns the translated MESSAGE for CONTEXT or
diff -rN -u old-qt.core/src/lib/CMakeLists.txt new-qt.core/src/lib/CMakeLists.txt
--- old-qt.core/src/lib/CMakeLists.txt 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/lib/CMakeLists.txt 2014-10-30 06:58:17.000000000 +0100
@@ -8,13 +8,12 @@
set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fvisibility=hidden -fvisibility-inlines-hidden")
endif(CXX_VISIBILITY)
-set(QT_SMOKE_SOURCES qt-smoke.cpp qstring.cpp qstringlist.cpp lisp-object.cpp qlist.cpp)
-add_library(qt-smoke-extra MODULE ${QT_SMOKE_SOURCES})
-target_link_libraries(qt-smoke-extra ${QT_LIBRARIES})
-set_target_properties(qt-smoke-extra
+set(QT_SMOKE_SOURCES qt_smoke.cpp qstring.cpp qstringlist.cpp lisp_object.cpp qlist.cpp)
+add_library(clsmokeqtcore MODULE ${QT_SMOKE_SOURCES})
+target_link_libraries(clsmokeqtcore ${QT_LIBRARIES})
+set_target_properties(clsmokeqtcore
PROPERTIES
SOVERSION "0.0"
VERSION "0.0.1")
-install(TARGETS qt-smoke-extra
- LIBRARY DESTINATION lib)
+install(TARGETS clsmokeqtcore LIBRARY DESTINATION lib)
diff -rN -u old-qt.core/src/lib/lisp-object.cpp new-qt.core/src/lib/lisp-object.cpp
--- old-qt.core/src/lib/lisp-object.cpp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/lib/lisp-object.cpp 1970-01-01 01:00:00.000000000 +0100
@@ -1,179 +0,0 @@
-#include "lisp-object.h"
-
-#include <QtGlobal>
-#include <QtDebug>
-
-namespace cl_smoke {
-namespace qt {
-
-/** @struct lisp_object::data
- * @internal
- * Holds a reference ID for a lisp object and calls
- * the destructor callback when it is deleted.
- */
-
-/** @typedef lisp_object::destructor
- * Destructor.
- * @param id The ID
- */
-
-lisp_object::destructor lisp_object::destruct = NULL;
-
-
-/** Constructor. */
-lisp_object::data::data()
-: id(id),
- is_set(false)
-{ }
-
-/** Constructor.
- * @param id The ID.
- */
-lisp_object::data::data(unsigned int id)
-: id(id),
- is_set(true)
-{ }
-
-/** Destructor. */
-lisp_object::data::~data()
-{
- Q_ASSERT_X(lisp_object::destruct, __func__,
- "call setup_lisp_object() first.");
-
- if (this->is_set)
- (*lisp_object::destruct)(this->id);
-}
-
-/** @class lisp_object
- * @brief Holds a reference ID to a lisp object.
- *
- * The registered destructor callback is called when
- * the last instance for a specific lisp object is deleted.
- *
- * Used for lisp objects in QVariants and signal/slots.
- */
-
-/** Constructor. */
-lisp_object::lisp_object()
- : d(new data())
-{ }
-
-/** Constructor.
- * @param id the ID
- */
-lisp_object::lisp_object(unsigned int id)
- : d(new data(id))
-{ }
-
-/** Constructor.
- * @param other the lisp_object to copy
- */
-lisp_object::lisp_object(const lisp_object& other)
- : d(other.d)
-{ }
-
-/** @fn lisp_object::id() const
- * Gets the ID.
- *
- * @return the ID
- */
-
-/** @fn lisp_object::set() const
- * Determines werter the ID is set.
- *
- * @return @c true when the id is set and @c false otherwise.
- */
-
-/** Sets a new ID.
- * @param id the ID
- */
-void
-lisp_object::set_id(unsigned int id)
-{
- Q_ASSERT(this->set() ? id != this->id() : true);
-
- d = new data(id);
-}
-
-} // namespace qt
-} // namespace cl_smoke
-
-using namespace cl_smoke::qt;
-
-/** Initialize the lisp_object.
- * @relates cl_smoke::qt::lisp_object
- * @param destruct destructor callback
- *
- * @return the QMetaType ID of lisp_object
- */
-int
-qt_smoke_setup_lisp_object(void* destruct)
-{
- Q_ASSERT(destruct != NULL);
- lisp_object::destruct = reinterpret_cast<lisp_object::destructor>(destruct);
-
- return qRegisterMetaType<lisp_object>();
-}
-
-/** Gets the ID of @a object.
- * @relates cl_smoke::qt::lisp_object
- * @param object the lisp_object.
- *
- * @return the ID
- */
-unsigned int
-qt_smoke_lisp_object_id(const void* object)
-{
- return static_cast<const lisp_object*>(object)->id();
-}
-
-
-/** Determines werter the ID of @a object is set.
- * @relates cl_smoke::qt::lisp_object
- * @param object the object
- *
- * @return @c true when the ID is set and @c false otherwise.
- */
-int
-qt_smoke_lisp_object_is_set(const void* object)
-{
- return static_cast<const lisp_object*>(object)->set();
-}
-
-/** Makes a new lisp_object.
- * @relates cl_smoke::qt::lisp_object
- * @param id the ID
- *
- * @return A new lisp_object instance.
- */
-void*
-qt_smoke_make_lisp_object(unsigned int id)
-{
- return new lisp_object(id);
-}
-
-/** Deletes a lisp_object.
- * @relates cl_smoke::qt::lisp_object
- * @param object the lisp_object
- */
-void*
-qt_smoke_free_lisp_object(void* object)
-{
- delete static_cast<lisp_object*>(object);
-}
-
-#include <QVariant>
-/** Gets the lisp_object of a QVariant.
- * @relates cl_smoke::qt::lisp_object
- * @param variant the QVariant
- *
- * @return a new lisp_object.
- */
-void*
-qt_smoke_lisp_object_value(const void* variant)
-{
- const QVariant* qvariant = static_cast<const QVariant*>(variant);
- Q_ASSERT(QVariant::UserType == qvariant->type());
-
- new lisp_object(qvariant->value<lisp_object>());
-}
diff -rN -u old-qt.core/src/lib/lisp-object.h new-qt.core/src/lib/lisp-object.h
--- old-qt.core/src/lib/lisp-object.h 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/lib/lisp-object.h 1970-01-01 01:00:00.000000000 +0100
@@ -1,83 +0,0 @@
-#ifndef LISP_OBJECT_H
-#define LISP_OBJECT_H
-
-#include <QMetaType>
-#include <QSharedData>
-#include <QExplicitlySharedDataPointer>
-#include <smoke.h>
-
-#include "cl_smoke_qt.h"
-
-extern "C"
-{
- CL_SMOKE_QT_EXPORT int
- qt_smoke_setup_lisp_object(void* destruct);
-
- CL_SMOKE_QT_EXPORT unsigned int
- qt_smoke_lisp_object_id(const void* object);
-
- CL_SMOKE_QT_EXPORT int
- qt_smoke_lisp_object_is_set(const void* object);
-
- CL_SMOKE_QT_EXPORT void*
- qt_smoke_make_lisp_object(unsigned int id);
-
- CL_SMOKE_QT_EXPORT void*
- qt_smoke_free_lisp_object(void* object);
-
- CL_SMOKE_QT_EXPORT void*
- qt_smoke_lisp_object_value(const void* variant);
-}
-
-namespace cl_smoke {
-namespace qt {
-
-class lisp_object
-{
- public:
- typedef void (*destructor)(unsigned int id);
-
- lisp_object();
-
- lisp_object(unsigned int id);
-
- lisp_object(const lisp_object& other);
-
- inline unsigned int
- id() const
- { Q_ASSERT(this->set()); return d->id; }
-
- void
- set_id(unsigned int id);
-
- inline bool
- set() const
- { return d->is_set; }
-
- friend int
- ::qt_smoke_setup_lisp_object(void* destruct);
-
- private:
- struct data : public QSharedData
- {
- data();
- data(unsigned int id);
- ~data();
- unsigned int id;
- bool is_set;
-
- private:
- Q_DISABLE_COPY(data)
- };
-
- QExplicitlySharedDataPointer<data> d;
-
- static destructor destruct;
-};
-
-} // namespace qt
-} // namespace cl_smoke
-
-Q_DECLARE_METATYPE(cl_smoke::qt::lisp_object);
-
-#endif // LISP_OBJECT_H
diff -rN -u old-qt.core/src/lib/lisp_object.cpp new-qt.core/src/lib/lisp_object.cpp
--- old-qt.core/src/lib/lisp_object.cpp 1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lib/lisp_object.cpp 2014-10-30 06:58:17.000000000 +0100
@@ -0,0 +1,181 @@
+#include "lisp_object.h"
+
+#include "cl_smoke_qt.h"
+
+#include <QtGlobal>
+#include <QtDebug>
+#include <QVariant>
+
+namespace cl_smoke {
+namespace qt {
+
+/** @struct lisp_object::data
+ * @internal
+ * Holds a reference ID for a lisp object and calls
+ * the destructor callback when it is deleted.
+ */
+
+/** @typedef lisp_object::destructor
+ * Destructor.
+ * @param id The ID
+ */
+
+lisp_object::destructor lisp_object::destruct = NULL;
+
+
+/** Constructor. */
+lisp_object::data::data()
+: id(id),
+ is_set(false)
+{ }
+
+/** Constructor.
+ * @param id The ID.
+ */
+lisp_object::data::data(unsigned int id)
+: id(id),
+ is_set(true)
+{ }
+
+/** Destructor. */
+lisp_object::data::~data()
+{
+ Q_ASSERT_X(lisp_object::destruct, __func__,
+ "call setup_lisp_object() first.");
+
+ if (this->is_set)
+ (*lisp_object::destruct)(this->id);
+}
+
+/** @class lisp_object
+ * @brief Holds a reference ID to a lisp object.
+ *
+ * The registered destructor callback is called when
+ * the last instance for a specific lisp object is deleted.
+ *
+ * Used for lisp objects in QVariants and signal/slots.
+ */
+
+/** Constructor. */
+lisp_object::lisp_object()
+ : d(new data())
+{ }
+
+/** Constructor.
+ * @param id the ID
+ */
+lisp_object::lisp_object(unsigned int id)
+ : d(new data(id))
+{ }
+
+/** Constructor.
+ * @param other the lisp_object to copy
+ */
+lisp_object::lisp_object(const lisp_object& other)
+ : d(other.d)
+{ }
+
+/** @fn lisp_object::id() const
+ * Gets the ID.
+ *
+ * @return the ID
+ */
+
+/** @fn lisp_object::set() const
+ * Determines werter the ID is set.
+ *
+ * @return @c true when the id is set and @c false otherwise.
+ */
+
+/** Sets a new ID.
+ * @param id the ID
+ */
+void
+lisp_object::set_id(unsigned int id)
+{
+ Q_ASSERT(this->set() ? id != this->id() : true);
+
+ d = new data(id);
+}
+
+} // namespace qt
+} // namespace cl_smoke
+
+using namespace cl_smoke::qt;
+
+/** Initialize the lisp_object.
+ * @relates cl_smoke::qt::lisp_object
+ * @param destruct destructor callback
+ *
+ * @return the QMetaType ID of lisp_object
+ */
+CL_SMOKE_QT_EXPORT int
+cl_smoke_setup_lisp_object(void* destruct)
+{
+ Q_ASSERT(destruct != NULL);
+ lisp_object::destruct = reinterpret_cast<lisp_object::destructor>(destruct);
+
+ return qRegisterMetaType<lisp_object>();
+}
+
+/** Gets the ID of @a object.
+ * @relates cl_smoke::qt::lisp_object
+ * @param object the lisp_object.
+ *
+ * @return the ID
+ */
+CL_SMOKE_QT_EXPORT unsigned int
+cl_smoke_lisp_object_id(const void* object)
+{
+ return static_cast<const lisp_object*>(object)->id();
+}
+
+
+/** Determines werter the ID of @a object is set.
+ * @relates cl_smoke::qt::lisp_object
+ * @param object the object
+ *
+ * @return @c true when the ID is set and @c false otherwise.
+ */
+CL_SMOKE_QT_EXPORT int
+cl_smoke_lisp_object_is_set(const void* object)
+{
+ return static_cast<const lisp_object*>(object)->set();
+}
+
+/** Makes a new lisp_object.
+ * @relates cl_smoke::qt::lisp_object
+ * @param id the ID
+ *
+ * @return A new lisp_object instance.
+ */
+CL_SMOKE_QT_EXPORT void*
+cl_smoke_make_lisp_object(unsigned int id)
+{
+ return new lisp_object(id);
+}
+
+/** Deletes a lisp_object.
+ * @relates cl_smoke::qt::lisp_object
+ * @param object the lisp_object
+ */
+CL_SMOKE_QT_EXPORT void*
+cl_smoke_free_lisp_object(void* object)
+{
+ delete static_cast<lisp_object*>(object);
+}
+
+/** Gets the lisp_object of a QVariant.
+ * @relates cl_smoke::qt::lisp_object
+ * @param variant the QVariant
+ *
+ * @return a new lisp_object.
+ */
+CL_SMOKE_QT_EXPORT void*
+cl_smoke_lisp_object_value(const void* variant)
+{
+ const QVariant* qvariant = static_cast<const QVariant*>(variant);
+ Q_ASSERT(QVariant::UserType == qvariant->type());
+
+ new lisp_object(qvariant->value<lisp_object>());
+}
diff -rN -u old-qt.core/src/lib/lisp_object.h new-qt.core/src/lib/lisp_object.h
--- old-qt.core/src/lib/lisp_object.h 1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lib/lisp_object.h 2014-10-30 06:58:17.000000000 +0100
@@ -0,0 +1,83 @@
+#ifndef LISP_OBJECT_H
+#define LISP_OBJECT_H
+
+#include "cl_smoke_qt.h"
+
+#include <QMetaType>
+#include <QSharedData>
+#include <QExplicitlySharedDataPointer>
+#include <smoke.h>
+
+extern "C"
+{
+ CL_SMOKE_QT_EXPORT int
+ cl_smoke_setup_lisp_object(void* destruct);
+
+ CL_SMOKE_QT_EXPORT unsigned int
+ cl_smoke_lisp_object_id(const void* object);
+
+ CL_SMOKE_QT_EXPORT int
+ cl_smoke_lisp_object_is_set(const void* object);
+
+ CL_SMOKE_QT_EXPORT void*
+ cl_smoke_make_lisp_object(unsigned int id);
+
+ CL_SMOKE_QT_EXPORT void*
+ cl_smoke_free_lisp_object(void* object);
+
+ CL_SMOKE_QT_EXPORT void*
+ cl_smoke_lisp_object_value(const void* variant);
+}
+
+namespace cl_smoke {
+namespace qt {
+
+class lisp_object
+{
+ public:
+ typedef void (*destructor)(unsigned int id);
+
+ lisp_object();
+
+ lisp_object(unsigned int id);
+
+ lisp_object(const lisp_object& other);
+
+ inline unsigned int
+ id() const
+ { Q_ASSERT(this->set()); return d->id; }
+
+ void
+ set_id(unsigned int id);
+
+ inline bool
+ set() const
+ { return d->is_set; }
+
+ friend int
+ ::cl_smoke_setup_lisp_object(void* destruct);
+
+ private:
+ struct data : public QSharedData
+ {
+ data();
+ data(unsigned int id);
+ ~data();
+ unsigned int id;
+ bool is_set;
+
+ private:
+ Q_DISABLE_COPY(data)
+ };
+
+ QExplicitlySharedDataPointer<data> d;
+
+ static destructor destruct;
+};
+
+} // namespace qt
+} // namespace cl_smoke
+
+Q_DECLARE_METATYPE(cl_smoke::qt::lisp_object);
+
+#endif // LISP_OBJECT_H
diff -rN -u old-qt.core/src/lib/qlist.h new-qt.core/src/lib/qlist.h
--- old-qt.core/src/lib/qlist.h 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/lib/qlist.h 2014-10-30 06:58:17.000000000 +0100
@@ -1,9 +1,10 @@
#ifndef CL_SMOKE_QT_QLIST_H
#define CL_SMOKE_QT_QLIST_H
-#include <QList>
#include "cl_smoke_qt.h"
+#include <QList>
+
/** @file
*/
@@ -32,19 +33,19 @@
* size, free and make_list. */
#define DEFINE_QLIST_WRAPPER_ALL_PART(NAME, TYPE) \
CL_SMOKE_QT_EXPORT int \
-qt_smoke_list_ ## NAME ## _size(const void* list) \
+cl_smoke_list_ ## NAME ## _size(const void* list) \
{ \
return static_cast<const QList< TYPE >*>(list)->size(); \
} \
\
CL_SMOKE_QT_EXPORT void \
-qt_smoke_free_list_ ## NAME (void* list) \
+cl_smoke_free_list_ ## NAME (void* list) \
{ \
delete static_cast<QList< TYPE >*>(list); \
} \
\
CL_SMOKE_QT_EXPORT void* \
-qt_smoke_make_list_ ## NAME () \
+cl_smoke_make_list_ ## NAME () \
{ \
return new QList< TYPE >(); \
} \
@@ -55,14 +56,14 @@
*/
#define DEFINE_QLIST_WRAPPER_PTR_PART(NAME, TYPE) \
CL_SMOKE_QT_EXPORT const void* \
-qt_smoke_list_ ## NAME ## _at(const void* list, int index) \
+cl_smoke_list_ ## NAME ## _at(const void* list, int index) \
{ \
const QList< TYPE >* qlist = static_cast<const QList< TYPE > *>(list); \
return qlist->at(index); \
} \
\
CL_SMOKE_QT_EXPORT void \
-qt_smoke_list_ ## NAME ## _append(void* list, void* data) \
+cl_smoke_list_ ## NAME ## _append(void* list, void* data) \
{ \
static_cast<QList< TYPE >*>(list) \
->append(static_cast<TYPE>(data)); \
@@ -73,14 +74,14 @@
*/
#define DEFINE_QLIST_WRAPPER_VALUE_PART(NAME, TYPE) \
CL_SMOKE_QT_EXPORT const void* \
-qt_smoke_list_ ## NAME ## _at(const void* list, int index) \
+cl_smoke_list_ ## NAME ## _at(const void* list, int index) \
{ \
const QList< TYPE >* qlist = static_cast<const QList< TYPE > *>(list); \
return new TYPE(qlist->at(index)); \
} \
\
CL_SMOKE_QT_EXPORT void \
-qt_smoke_list_ ## NAME ## _append(void* list, void* data) \
+cl_smoke_list_ ## NAME ## _append(void* list, void* data) \
{ \
static_cast<QList< TYPE >*>(list) \
->append(*static_cast<TYPE*>(data)); \
diff -rN -u old-qt.core/src/lib/qstring.cpp new-qt.core/src/lib/qstring.cpp
--- old-qt.core/src/lib/qstring.cpp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/lib/qstring.cpp 2014-10-30 06:58:17.000000000 +0100
@@ -1,5 +1,4 @@
#include <QString>
-#include <QtDebug>
#include "cl_smoke_qt.h"
@@ -14,9 +13,8 @@
* @return a pointer to a newly allocated char array.
*/
CL_SMOKE_QT_EXPORT void*
-qt_smoke_qstring_to_byte_array(const void* qstring)
+cl_smoke_qstring_to_byte_array(const void* qstring)
{
- Q_ASSERT(qstring);
const QString* string = static_cast<const QString*>(qstring);
return new QByteArray(string->toLocal8Bit());
@@ -26,7 +24,7 @@
* @param qstring the QString to free
*/
CL_SMOKE_QT_EXPORT void
-qt_smoke_free_qstring(void* qstring)
+cl_smoke_free_qstring(void* qstring)
{
delete static_cast<QString*>(qstring);
}
@@ -38,7 +36,7 @@
* @return a newly allocated QString
*/
CL_SMOKE_QT_EXPORT void*
-qt_smoke_string_to_qstring(const char* data, int length)
+cl_smoke_string_to_qstring(const char* data, int length)
{
return new QString(QString::fromLocal8Bit(data, length));
}
diff -rN -u old-qt.core/src/lib/qstringlist.cpp new-qt.core/src/lib/qstringlist.cpp
--- old-qt.core/src/lib/qstringlist.cpp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/lib/qstringlist.cpp 2014-10-30 06:58:17.000000000 +0100
@@ -1,8 +1,7 @@
+#include "cl_smoke_qt.h"
+
#include <QStringList>
#include <QtDebug>
-#include <cstring>
-
-#include "cl_smoke_qt.h"
/** @file
* @brief QStringList conversion. */
@@ -15,7 +14,7 @@
* @return the number of items
*/
CL_SMOKE_QT_EXPORT int
-qt_smoke_string_list_size(const void* string_list)
+cl_smoke_string_list_size(const void* string_list)
{
Q_ASSERT(string_list);
return static_cast<const QStringList*>(string_list)->size();
@@ -28,7 +27,7 @@
* @return a new allocated byte-array
*/
CL_SMOKE_QT_EXPORT void*
-qt_smoke_string_list_at(const void* string_list, int index)
+cl_smoke_string_list_at(const void* string_list, int index)
{
Q_ASSERT(string_list);
const QStringList* list = static_cast<const QStringList*>(string_list);
@@ -42,7 +41,7 @@
* @param string_list the QStringList to free
*/
CL_SMOKE_QT_EXPORT void
-qt_smoke_free_string_list(void* string_list)
+cl_smoke_free_string_list(void* string_list)
{
delete static_cast<QStringList*>(string_list);
}
@@ -52,7 +51,7 @@
* @return a new QStringList
*/
CL_SMOKE_QT_EXPORT void*
-qt_smoke_make_string_list()
+cl_smoke_make_string_list()
{
return new QStringList();
}
@@ -63,7 +62,7 @@
* @param length the length of @a data
*/
CL_SMOKE_QT_EXPORT void
-qt_smoke_string_list_append(void* string_list, const char* data, int length)
+cl_smoke_string_list_append(void* string_list, const char* data, int length)
{
static_cast<QStringList*>(string_list)->append(QString::fromLocal8Bit(data, length));
}
diff -rN -u old-qt.core/src/lib/qt-smoke.cpp new-qt.core/src/lib/qt-smoke.cpp
--- old-qt.core/src/lib/qt-smoke.cpp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/lib/qt-smoke.cpp 1970-01-01 01:00:00.000000000 +0100
@@ -1,53 +0,0 @@
-#include <qnamespace.h>
-#include <QEvent>
-#include <QtDebug>
-
-#include "cl_smoke_qt.h"
-
-/** @file
- * @brief Qt support functions */
-
-#include <exception>
-
-static void
-terminate()
-{
- qFatal("caught an exception.");
-}
-
-extern "C" {
-
-/** Registers a callback to be invoked for every QEvent.
- * @see QCoreApplication::notifyInternal
- *
- * @param callback the callback
- *
- * @return @c true on success and @c false otherwise
- */
-CL_SMOKE_QT_EXPORT int
-qt_smoke_register_event_notify(void* callback)
-{
- Q_ASSERT(callback);
- std::set_terminate(terminate);
-
- return QInternal::registerCallback(QInternal::EventNotifyCallback,
- reinterpret_cast<qInternalCallback>(callback));
-}
-
-/** Returns the most specific QMetaObject of the QObject instance @a object.
- * Used to determine the actual class of an object. Smoke can not be used since it calls the
- * metaObject() of the class the method was called for.
- *
- * @param object A QObject
- *
- * @return QMetaObject
- */
-CL_SMOKE_QT_EXPORT void*
-qt_smoke_meta_object(void* object)
-{
- Q_ASSERT(object);
- static_cast<QObject*>(object)->metaObject();
-}
-
-
-} // extern "C"
diff -rN -u old-qt.core/src/lib/qt_smoke.cpp new-qt.core/src/lib/qt_smoke.cpp
--- old-qt.core/src/lib/qt_smoke.cpp 1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lib/qt_smoke.cpp 2014-10-30 06:58:17.000000000 +0100
@@ -0,0 +1,53 @@
+#include "cl_smoke_qt.h"
+
+#include <qnamespace.h>
+#include <QEvent>
+#include <QtDebug>
+
+/** @file
+ * @brief Qt support functions */
+
+#include <exception>
+
+static void
+terminate()
+{
+ qFatal("caught an exception.");
+}
+
+extern "C" {
+
+/** Registers a callback to be invoked for every QEvent.
+ * @see QCoreApplication::notifyInternal
+ *
+ * @param callback the callback
+ *
+ * @return @c true on success and @c false otherwise
+ */
+CL_SMOKE_QT_EXPORT int
+cl_smoke_register_event_notify(void* callback)
+{
+ Q_ASSERT(callback);
+ std::set_terminate(terminate);
+
+ return QInternal::registerCallback(QInternal::EventNotifyCallback,
+ reinterpret_cast<qInternalCallback>(callback));
+}
+
+/** Returns the most specific QMetaObject of the QObject instance @a object.
+ * Used to determine the actual class of an object. Smoke can not be used since it calls the
+ * metaObject() of the class the method was called for.
+ *
+ * @param object A QObject
+ *
+ * @return QMetaObject
+ */
+CL_SMOKE_QT_EXPORT void*
+cl_smoke_meta_object(void* object)
+{
+ Q_ASSERT(object);
+ static_cast<QObject*>(object)->metaObject();
+}
+
+
+} // extern "C"
diff -rN -u old-qt.core/src/lisp-object.lisp new-qt.core/src/lisp-object.lisp
--- old-qt.core/src/lisp-object.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/lisp-object.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defvar *cxx-lisp-objects* (smoke::make-synchronized-hash-table)
"Objects that are currently passed in a C++ class.")
@@ -14,19 +14,19 @@
while (nth-value 1 (gethash id *cxx-lisp-objects*)))
id))
-(defcfun qt-smoke-setup-lisp-object :int
+(defcfun cl-smoke-setup-lisp-object :int
(destruct :pointer))
-(defcfun qt-smoke-lisp-object-id :unsigned-int
+(defcfun cl-smoke-lisp-object-id :unsigned-int
(object :pointer))
-(defcfun qt-smoke-lisp-object-is-set :int
+(defcfun cl-smoke-lisp-object-is-set :int
(object :pointer))
-(defcfun qt-smoke-make-lisp-object :pointer
+(defcfun cl-smoke-make-lisp-object :pointer
(id :unsigned-int))
-(defcfun qt-smoke-free-lisp-object :void
+(defcfun cl-smoke-free-lisp-object :void
(object :pointer))
(defcallback destruct-cxx-lisp-object :void
@@ -37,7 +37,7 @@
(eval-startup ()
(setf *cxx-lisp-object-metatype*
- (qt-smoke-setup-lisp-object (callback destruct-cxx-lisp-object)))
+ (cl-smoke-setup-lisp-object (callback destruct-cxx-lisp-object)))
(assert (>= *cxx-lisp-object-metatype*
(smoke::value qt:meta-type.+user+))
(*cxx-lisp-object-metatype*)
@@ -47,11 +47,11 @@
"Constructs a C++ object wrapper for OBJECT."
(let ((id (gen-cxx-lisp-object-id)))
(setf (gethash id *cxx-lisp-objects*) object)
- (qt-smoke-make-lisp-object id)))
+ (cl-smoke-make-lisp-object id)))
(defun free-cxx-lisp-object (pointer)
"Deletes the lisp_object at POINTER."
- (qt-smoke-free-lisp-object pointer))
+ (cl-smoke-free-lisp-object pointer))
;; (qmetatype.destroy *cxx-lisp-object-metatype* pointer)) ;; FIXME use this?
(defun translate-cxx-lisp-object (pointer)
@@ -60,7 +60,7 @@
When being received as an argument by a slot,
the object must not be deallocated."
(multiple-value-bind (value present-p)
- (gethash (qt-smoke-lisp-object-id pointer)
+ (gethash (cl-smoke-lisp-object-id pointer)
*cxx-lisp-objects*)
(assert present-p (value present-p)
"No object for ~A in ~A" pointer *cxx-lisp-objects*)
diff -rN -u old-qt.core/src/list.lisp new-qt.core/src/list.lisp
--- old-qt.core/src/list.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/list.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,30 +1,30 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defmacro define-qlist-wrapper (type-name element-type &optional c-name)
(let* ((c-name (or c-name type-name))
(type (string-upcase c-name))
(list-type (symbolicate 'qlist- type)))
`(progn
- (defcfun ,(concatenate 'string "qt_smoke_list_" c-name "_size") :int
+ (defcfun ,(concatenate 'string "cl_smoke_list_" c-name "_size") :int
"Returns the size of LIST."
(list :pointer))
- (defcfun ,(concatenate 'string "qt_smoke_free_list_" c-name) :void
+ (defcfun ,(concatenate 'string "cl_smoke_free_list_" c-name) :void
"Frees LIST."
(list :pointer))
- (defcfun ,(concatenate 'string "qt_smoke_make_list_" c-name) :pointer
+ (defcfun ,(concatenate 'string "cl_smoke_make_list_" c-name) :pointer
"Makes a list.")
- (defcfun ,(concatenate 'string "qt_smoke_list_" c-name "_at") :pointer
+ (defcfun ,(concatenate 'string "cl_smoke_list_" c-name "_at") :pointer
"Returns the a newly constructed copy of the element at position AT of LIST."
(list :pointer)
(index :int))
- (defcfun ,(concatenate 'string "qt_smoke_list_" c-name "_append") :pointer
+ (defcfun ,(concatenate 'string "cl_smoke_list_" c-name "_append") :pointer
"Appends NEW-ELEMENT to LIST."
(list :pointer)
(new-element :pointer))
;; To Lisp
,@(loop for type-name in (ensure-list type-name) collect
`(defun ,(symbolicate 'from- type-name) (list-pointer)
- (let ((vector (make-array (,(symbolicate 'qt-smoke-list-
+ (let ((vector (make-array (,(symbolicate 'cl-smoke-list-
type '-size)
list-pointer))))
(dotimes (index (length vector) vector)
@@ -32,7 +32,7 @@
;; FIXME the returned object is not wrapped by Smoke
;; -> change this?
(smoke::object-to-lisp
- (,(symbolicate 'qt-smoke-list-
+ (,(symbolicate 'cl-smoke-list-
type '-at)
list-pointer index)
(smoke::make-smoke-type *smoke-module*
@@ -42,16 +42,16 @@
(,(format nil "const QList<~A>&" type-name)
,(format nil "QList<~A>" type-name))
,(symbolicate 'from- type-name)
- ,(symbolicate 'qt-smoke-free-list- type)))
+ ,(symbolicate 'cl-smoke-free-list- type)))
;; From Lisp
(defun ,(symbolicate 'coerce- list-type) (list)
- (let ((qlist (,(symbolicate 'qt-smoke-make-list- type))))
+ (let ((qlist (,(symbolicate 'cl-smoke-make-list- type))))
(loop for element across list do
- (,(symbolicate 'qt-smoke-list- type '-append)
+ (,(symbolicate 'cl-smoke-list- type '-append)
qlist (pointer (make-instance ',element-type :args (list element)))))
(make-cleanup-pointer
qlist
- (function ,(symbolicate 'qt-smoke-free-list- type)))))
+ (function ,(symbolicate 'cl-smoke-free-list- type)))))
(defun ,(symbolicate list-type '-p) (list)
(every #'(lambda (element)
(typep element ',element-type))
diff -rN -u old-qt.core/src/msg-handler.lisp new-qt.core/src/msg-handler.lisp
--- old-qt.core/src/msg-handler.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/msg-handler.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
;; FIXME Determine the actual size of the QtMsgType enum.
(cffi:defctype qt-msg-type :int)
diff -rN -u old-qt.core/src/object.lisp new-qt.core/src/object.lisp
--- old-qt.core/src/object.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/object.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
;; Smoke always calls the method of the class the object is assumed to
;; be and not the most specific method like required for virtual
@@ -6,10 +6,10 @@
;; determine the actual class. This is only needed for objects not
;; constructed by Smoke, since otherwise we would know the most
;; specific class.
-(defcfun qt-smoke-meta-object :pointer (object :pointer))
+(defcfun cl-smoke-meta-object :pointer (object :pointer))
(defun meta-object (object)
(make-instance 'qt:meta-object
- :pointer (qt-smoke-meta-object (pointer object))))
+ :pointer (cl-smoke-meta-object (pointer object))))
(defmethod cxx:static-meta-object ((class cxx:class))
(cxx:static-meta-object (smoke::find-smoke-class class)))
@@ -226,11 +226,11 @@
nil)
(eval-when (:compile-toplevel :load-toplevel :execute)
- (cffi:defcfun qt-smoke-register-event-notify :boolean
+ (cffi:defcfun cl-smoke-register-event-notify :boolean
(event-notify :pointer)))
(defun register-event-notify ()
- (let ((ret (qt-smoke-register-event-notify (cffi:callback event-notify))))
+ (let ((ret (cl-smoke-register-event-notify (cffi:callback event-notify))))
(unless ret
(error "Registering event-notify callback failed."))))
diff -rN -u old-qt.core/src/operator.lisp new-qt.core/src/operator.lisp
--- old-qt.core/src/operator.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/operator.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,5 +1,4 @@
-(in-package :cl-smoke.qt-impl)
-(declaim (optimize (debug 3)))
+(in-package :cl-smoke.qt.core)
(defun cxx:= (object &rest more-objects)
(if (null more-objects)
diff -rN -u old-qt.core/src/ownership.lisp new-qt.core/src/ownership.lisp
--- old-qt.core/src/ownership.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/ownership.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,79 +1 @@
-(in-package :cl-smoke.qt-impl)
-
-;; undo-stack
-(define-takes-ownership cxx:push ((undo-stack qt:undo-stack) undo-command)
- undo-command)
-
-
-#|
-;; FIXME TODO
-;; application
-(define-takes-ownership cxx:set-style ((application application) (style style))
- ;; NOT QString style
- style) ;; STATIC
-
-
-;; core-application
-(define-takes-ownership cxx:post-event ((app core-application) receiver (event event))
- event) ;; STATIC
-(define-takes-ownership cxx:post-event ((app core-application) receiver event priority)
- event) ;; STATIC
-|#
-
-;; AbstractFileEngine::beginEntryList return value
-
-;; grid-layout
-(define-takes-ownership cxx:add-item ((layout qt:grid-layout) (item qt:layout-item)
- row column)
- item)
-(define-takes-ownership cxx:add-item ((layout qt:grid-layout) (item qt:layout-item)
- row column row-span)
- item)
-(define-takes-ownership cxx:add-item ((layout qt:grid-layout) (item qt:layout-item)
- row column row-span colum-span)
- item)
-(define-takes-ownership cxx:add-item ((layout qt:grid-layout) (item qt:layout-item)
- row column row-span colum-span aligment)
- item)
-
-(define-takes-ownership cxx:add-item ((layout qt:layout) (item qt:layout-item))
- item)
-
-;; QIcon::QIcon(QIconEngine* engine)
-
-(define-takes-ownership cxx:register-editor ((factory qt:item-editor-factory)
- type creator)
- creator)
-
-
-(define-takes-ownership cxx:set-child ((this qt:standard-item) row colum item)
- item)
-(define-takes-ownership cxx:set-child ((this qt:standard-item) row item)
- item)
-(define-takes-ownership cxx:set-horizontal-header-item ((this qt:standard-item-model)
- column item)
- item)
-(define-takes-ownership cxx:set-vertical-header-item ((this qt:standard-item-model)
- row item)
- item)
-(define-takes-ownership cxx:set-item ((this qt:standard-item-model)
- row column item)
- item)
-(define-takes-ownership cxx:set-item ((this qt:standard-item-model)
- row item)
- item)
-(define-takes-ownership cxx:set-item-prototype ((this qt:standard-item-model)
- item)
- item)
-
-
-;; Allocates return value
-;; QLineEdit::createStandardContextMenu()
-
-;; parent
-;; QListwidgetitem
-
-
-;; Releases ownership
-;;QList<QStandardItem *> QStandardItemModel::takeColumn ( int column )
-;; etc
+(in-package :cl-smoke.qt.core)
diff -rN -u old-qt.core/src/package.lisp new-qt.core/src/package.lisp
--- old-qt.core/src/package.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/package.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(defpackage :cl-smoke.qt-impl
+(defpackage :cl-smoke.qt.core
(:use :cl :smoke :cffi :bordeaux-threads :cxx-support :alexandria))
(defpackage :cl-smoke.qt
diff -rN -u old-qt.core/src/painter.lisp new-qt.core/src/painter.lisp
--- old-qt.core/src/painter.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/painter.lisp 1970-01-01 01:00:00.000000000 +0100
@@ -1,16 +0,0 @@
-(in-package :cl-smoke.qt-impl)
-
-(defmacro qt:with-painter ((painter paint-device) &body body)
- "Binds a PAINTER instance for PAINT-DEVICE to PAINTER
- during the evaluation of BODY.
-
-Makes sure the painter ends after BODY; thus preventing problems with
-still active and not yet garbage collected painters in CXX:PAINT-EVENT."
- `(let ((,painter (make-instance 'qt:painter :arg0 ,paint-device)))
- (assert (cxx:is-active ,painter)
- (,painter)
- "Painter ~A for ~A is not active"
- ,painter ,paint-device)
- (unwind-protect
- (progn ,@body)
- (cxx:end ,painter))))
diff -rN -u old-qt.core/src/properties.lisp new-qt.core/src/properties.lisp
--- old-qt.core/src/properties.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/properties.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defun reverse-lispify (symbol)
"Converts the name of symbol to C++ style."
diff -rN -u old-qt.core/src/qstring.lisp new-qt.core/src/qstring.lisp
--- old-qt.core/src/qstring.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/qstring.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,13 +1,13 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
-(defcfun qt-smoke-string-to-qstring :pointer
+(defcfun cl-smoke-string-to-qstring :pointer
(data :string)
(length :int))
-(defcfun qt-smoke-free-qstring :void
+(defcfun cl-smoke-free-qstring :void
(string :pointer))
-(defcfun qt-smoke-qstring-to-byte-array :pointer
+(defcfun cl-smoke-qstring-to-byte-array :pointer
(qstring :pointer))
;;; make sure, that you have configured slime correctly.
@@ -34,16 +34,16 @@
(defun from-qstring (qstring)
(cxx:const-data (make-instance 'qt:byte-array
- :pointer (qt-smoke-qstring-to-byte-array qstring))))
+ :pointer (cl-smoke-qstring-to-byte-array qstring))))
(define-to-lisp-translation ("QString" "const QString&")
- from-qstring qt-smoke-free-qstring)
+ from-qstring cl-smoke-free-qstring)
(defun coerce-qstring (string)
(make-cleanup-pointer
(with-foreign-string ((data length) string :null-terminated-p nil)
- (qt-smoke-string-to-qstring data length))
- #'qt-smoke-free-qstring))
+ (cl-smoke-string-to-qstring data length))
+ #'cl-smoke-free-qstring))
(define-from-lisp-translation ("const QString&" "QString") string
coerce-qstring)
diff -rN -u old-qt.core/src/qt.core.lisp new-qt.core/src/qt.core.lisp
--- old-qt.core/src/qt.core.lisp 1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/qt.core.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -0,0 +1,38 @@
+;;; Copyright (C) 2009, 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;;
+;;; As a special exception, the copyright holders of this library give you
+;;; permission to link this library with independent modules to produce an
+;;; executable, regardless of the license terms of these independent
+;;; modules, and to copy and distribute the resulting executable under
+;;; terms of your choice, provided that you also meet, for each linked
+;;; independent module, the terms and conditions of the license of that
+;;; module. An independent module is a module which is not derived from or
+;;; based on this library. If you modify this library, you may extend this
+;;; exception to your version of the library, but you are not obligated to
+;;; do so. If you do not wish to do so, delete this exception statement
+;;; from your version.
+
+(in-package :cl-smoke.qt.core)
+
+(eval-when (:load-toplevel :compile-toplevel :execute)
+ (define-smoke-module :cl-smoke.qt libsmokeqtcore
+ (*qt-core-smoke* "qtcore_Smoke")
+ (init-qt-smoke "init_qtcore_Smoke"))
+
+ (define-foreign-library libclsmokeqtcore
+ (:unix "libclsmokeqtcore.so")
+ (t (:default "libclsmokeqtcore")))
+ (use-foreign-library libclsmokeqtcore))
diff -rN -u old-qt.core/src/qt.lisp new-qt.core/src/qt.lisp
--- old-qt.core/src/qt.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/qt.lisp 1970-01-01 01:00:00.000000000 +0100
@@ -1,38 +0,0 @@
-;;; Copyright (C) 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-;;;
-;;; As a special exception, the copyright holders of this library give you
-;;; permission to link this library with independent modules to produce an
-;;; executable, regardless of the license terms of these independent
-;;; modules, and to copy and distribute the resulting executable under
-;;; terms of your choice, provided that you also meet, for each linked
-;;; independent module, the terms and conditions of the license of that
-;;; module. An independent module is a module which is not derived from or
-;;; based on this library. If you modify this library, you may extend this
-;;; exception to your version of the library, but you are not obligated to
-;;; do so. If you do not wish to do so, delete this exception statement
-;;; from your version.
-
-(in-package :cl-smoke.qt-impl)
-
-(define-smoke-module :cl-smoke.qt libsmokeqt
- (*qt-smoke* "qt_Smoke")
- (init-qt-smoke "init_qt_Smoke"))
-
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (define-foreign-library libqt-smoke-extra
- (:unix "libqt-smoke-extra.so")
- (t (:default "libqt-smoke-extra")))
- (use-foreign-library libqt-smoke-extra))
diff -rN -u old-qt.core/src/signal-slot/connect.lisp new-qt.core/src/signal-slot/connect.lisp
--- old-qt.core/src/signal-slot/connect.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/signal-slot/connect.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defgeneric qt:connect (qsignal slot &optional type)
(:documentation "Connects a signal to a slot."))
@@ -138,9 +138,8 @@
:arg0 (qsender qt-signal)
:slot-function function
:argument-types
- (method-arguments-type
- (cxx:meta-object (qsender qt-signal))
- signal-id))))
+ (method-arguments-type (qsender qt-signal)
+ signal-id))))
;; Ensure that the slot is not gc'ed as long as the QT-SIGNAL
;; exists.
;;
@@ -160,13 +159,11 @@
(defmethod qt:connect ((qt-signal qt-signal) (slot qslot) &optional type)
(let ((signal-id (find-signal-id (qsender qt-signal) (name qt-signal))))
(if (slot-boundp slot 'arguments)
- (check-argument-types (method-arguments-type (cxx:meta-object
- (qsender qt-signal))
+ (check-argument-types (method-arguments-type (qsender qt-signal)
signal-id)
(arguments slot))
(setf (slot-value slot 'arguments)
- (method-arguments-type (cxx:meta-object (qsender qt-signal))
- signal-id)))
+ (method-arguments-type (qsender qt-signal) signal-id)))
(if (connect-id (qsender qt-signal) signal-id
slot (id slot)
type (types (arguments slot)))
@@ -179,12 +176,10 @@
(let ((slot-id (find-slot-id (receiver slot) (name slot))))
(if (slot-boundp (signal-object qsignal) 'argument-types)
(check-argument-types (argument-types (signal-object slot))
- (method-arguments-type (cxx:meta-object
- (receiver slot))
+ (method-arguments-type (receiver slot)
slot-id))
(setf (argument-types (signal-object qsignal))
- (method-arguments-type (cxx:meta-object (receiver slot))
- slot-id)))
+ (method-arguments-type (receiver slot) slot-id)))
(unless (connect-id (signal-object qsignal) (id (signal-object qsignal))
(receiver slot) slot-id
type
diff -rN -u old-qt.core/src/signal-slot/signal-slot.lisp new-qt.core/src/signal-slot/signal-slot.lisp
--- old-qt.core/src/signal-slot/signal-slot.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/signal-slot/signal-slot.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defclass funcallable-smoke-class (closer-mop:funcallable-standard-class
diff -rN -u old-qt.core/src/signal-slot/signal.lisp new-qt.core/src/signal-slot/signal.lisp
--- old-qt.core/src/signal-slot/signal.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/signal-slot/signal.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defclass qsignal-mixin ()
((signal-object :accessor signal-object
@@ -69,7 +69,7 @@
(defun make-lisp-object (object)
(smoke:make-cleanup-pointer (make-cxx-lisp-object object)
- #'qt-smoke-free-lisp-object))
+ #'cl-smoke-free-lisp-object))
(defun convert-arguments (arguments types)
@@ -79,7 +79,8 @@
(smoke::convert-argument argument type)
(progn (assert (typep argument type)
()
- "The argument ~S is not of type ~S.")
+ "The argument ~S is not of type ~S."
+ argument type)
(make-lisp-object argument))))
arguments types))
diff -rN -u old-qt.core/src/signal-slot/slot.lisp new-qt.core/src/signal-slot/slot.lisp
--- old-qt.core/src/signal-slot/slot.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/signal-slot/slot.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defclass qslot (qt:object)
((arguments :reader arguments :initarg :argument-types
diff -rN -u old-qt.core/src/signal-slot/translate.lisp new-qt.core/src/signal-slot/translate.lisp
--- old-qt.core/src/signal-slot/translate.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/signal-slot/translate.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,22 +1,29 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
-(defun find-type (name &optional start end)
- (smoke::make-smoke-type *smoke-module* (subseq name start end)))
-
-(defun method-arguments-type (metaobject index)
- "Returns a type name list for the arguments of method INDEX of METAOBJECT."
- (let* ((signature (cxx:signature (cxx:method metaobject index)))
+(defun find-type (smoke-module name &optional start end)
+ (let ((type (smoke::make-smoke-type smoke-module (subseq name start end))))
+ (assert (not (zerop (id type)))
+ ()
+ "No type named ~S found in ~A."
+ (subseq name start end) smoke-module)
+ type))
+
+(defun method-arguments-type (object index)
+ "Returns a type name list for the arguments of method INDEX of OBJECTs metaobject."
+ (let* ((metaobject (cxx:meta-object object))
+ (signature (cxx:signature (cxx:method metaobject index)))
(arguments (subseq signature (1+ (position #\( signature))
(position #\) signature :from-end t)))
(argument-types ())
- (last-pos (length arguments)))
+ (last-pos (length arguments))
+ (smoke-module (smoke::smoke (class-of object))))
(loop as pos = (position #\, arguments :from-end t :end last-pos)
while pos
do
- (push (find-type arguments (1+ pos) last-pos) argument-types)
+ (push (find-type smoke-module arguments (1+ pos) last-pos) argument-types)
(setf last-pos pos))
(when (> last-pos 0)
- (push (find-type arguments 0 last-pos) argument-types))))
+ (push (find-type smoke-module arguments 0 last-pos) argument-types))))
(defun arguments-to-lisp2 (argument types values)
diff -rN -u old-qt.core/src/string-list.lisp new-qt.core/src/string-list.lisp
--- old-qt.core/src/string-list.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/string-list.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,44 +1,44 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
-(defcfun qt-smoke-string-list-size :int
+(defcfun cl-smoke-string-list-size :int
(string-list :pointer))
-(defcfun qt-smoke-string-list-at :pointer
+(defcfun cl-smoke-string-list-at :pointer
(string-list :pointer)
(index :int))
-(defcfun qt-smoke-free-string-list :void
+(defcfun cl-smoke-free-string-list :void
(string-list :pointer))
-(defcfun qt-smoke-make-string-list :pointer)
+(defcfun cl-smoke-make-string-list :pointer)
-(defcfun qt-smoke-string-list-append :void
+(defcfun cl-smoke-string-list-append :void
(string-list :pointer)
(string :pointer)
(length :int))
(defun from-string-list (string-list)
- (let ((vector (make-array (qt-smoke-string-list-size string-list)
+ (let ((vector (make-array (cl-smoke-string-list-size string-list)
:initial-element ""
:element-type 'string)))
(dotimes (index (length vector) vector)
(setf (aref vector index)
(cxx:data (make-instance 'qt:byte-array
- :pointer (qt-smoke-string-list-at
+ :pointer (cl-smoke-string-list-at
string-list index)))))))
(define-to-lisp-translation ("QStringList" "const QStringList&")
- from-string-list qt-smoke-free-string-list)
+ from-string-list cl-smoke-free-string-list)
(defun coerce-string-list (sequence)
- (let ((string-list (qt-smoke-make-string-list)))
+ (let ((string-list (cl-smoke-make-string-list)))
(map nil
#'(lambda (string)
(with-foreign-string ((data length) string :null-terminated-p nil)
- (qt-smoke-string-list-append string-list data length)))
+ (cl-smoke-string-list-append string-list data length)))
sequence)
(make-cleanup-pointer
- string-list #'qt-smoke-free-string-list)))
+ string-list #'cl-smoke-free-string-list)))
(defun string-list-p (sequence)
(every #'stringp sequence))
diff -rN -u old-qt.core/src/timer.lisp new-qt.core/src/timer.lisp
--- old-qt.core/src/timer.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/timer.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defclass single-shot-timer (qt:object)
((function :initarg :function
diff -rN -u old-qt.core/src/variant.lisp new-qt.core/src/variant.lisp
--- old-qt.core/src/variant.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/src/variant.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -1,4 +1,4 @@
-(in-package :cl-smoke.qt-impl)
+(in-package :cl-smoke.qt.core)
(defmethod print-object ((variant qt:variant) stream)
"Print the type and value of the variant."
@@ -66,7 +66,7 @@
object))
(free-cxx-lisp-object object))))
-(defcfun qt-smoke-lisp-object-value :pointer
+(defcfun cl-smoke-lisp-object-value :pointer
(variant :pointer))
(defun qt:variant-boundp (variant)
@@ -103,7 +103,7 @@
ulong-long
url
(#.*cxx-lisp-object-metatype*
- (let* ((lisp-object (qt-smoke-lisp-object-value (smoke::pointer variant)))
+ (let* ((lisp-object (cl-smoke-lisp-object-value (smoke::pointer variant)))
(value))
(setf value (translate-cxx-lisp-object lisp-object))
(free-cxx-lisp-object lisp-object)
diff -rN -u old-qt.core/test.lisp new-qt.core/test.lisp
--- old-qt.core/test.lisp 2014-10-30 06:58:17.000000000 +0100
+++ new-qt.core/test.lisp 2014-10-30 06:58:17.000000000 +0100
@@ -3,7 +3,7 @@
# Used for testing on darcs record.
|#
-(asdf:operate 'asdf:load-op :qt)
-(asdf:operate 'asdf:test-op :qt)
+(asdf:operate 'asdf:load-op :cl-smoke.qt.core)
+(asdf:operate 'asdf:test-op :cl-smoke.qt.core)
(sb-ext:quit)