src/lisp-object.lisp
Sun Apr 5 19:56:16 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* initial import
--- old-qt.core/src/lisp-object.lisp 1970-01-01 01:00:00.000000000 +0100
+++ new-qt.core/src/lisp-object.lisp 2014-11-11 13:37:10.000000000 +0100
@@ -0,0 +1,62 @@
+(in-package :qt)
+(declaim (optimize (debug 3)))
+
+(defvar *cxx-lisp-objects* (make-hash-table)
+ "Objects that are currently passed in a C++ class.")
+
+(let ((id 0))
+ (defun gen-cxx-lisp-object-id ()
+ "Returns a new unique ID."
+ (incf id)))
+
+(defcfun qt-smoke-setup-lisp-object :int
+ (destruct :pointer))
+
+(defcfun qt-smoke-lisp-object-id :int
+ (object :pointer))
+
+(defcfun qt-smoke-lisp-object-set :int
+ (object :pointer))
+
+(defcfun qt-smoke-make-lisp-object :pointer
+ (id :int))
+
+(defcfun qt-smoke-free-lisp-object :void
+ (object :pointer))
+
+(defcallback destruct-cxx-lisp-object :void
+ ((id :int))
+ (remhash id *cxx-lisp-objects*))
+
+(defvar *cxx-lisp-object-metatype*)
+
+(eval-when (:load-toplevel)
+ (setf *cxx-lisp-object-metatype*
+ (qt-smoke-setup-lisp-object (callback destruct-cxx-lisp-object)))
+ (assert (>= *cxx-lisp-object-metatype*
+ (smoke::value meta-type.+user+))
+ (*cxx-lisp-object-metatype*)
+ "setup of lisp-object failed"))
+
+(defun make-cxx-lisp-object (object)
+ "Constructs a C++ object wrapper for OBJECT."
+ (let ((id (gen-cxx-lisp-object-id)))
+ (setf (gethash id *cxx-lisp-objects*) object)
+ (qt-smoke-make-lisp-object id)))
+
+(defun free-cxx-lisp-object (pointer)
+ "Deletes the lisp_object at POINTER."
+ (qt-smoke-free-lisp-object pointer))
+;; (qmetatype.destroy *cxx-lisp-object-metatype* pointer)) ;; FIXME use this?
+
+(defun translate-cxx-lisp-object (pointer)
+ "Returns the object of the cxx-lisp-object at POINTER.
+
+When beeing received as an argument by a slot,
+the object must not be deallocated."
+ (multiple-value-bind (value present-p)
+ (gethash (qt-smoke-lisp-object-id pointer)
+ *cxx-lisp-objects*)
+ (assert present-p (value present-p)
+ "No object for ~A in ~A" pointer *cxx-lisp-objects*)
+ value))