Tue Jul 13 21:17:41 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Use libsmokebase instead of libsmokeqtcore.
Sat Apr 3 21:11:26 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* slot-value access for static attributes using the class instead of an object.
Sat Apr 3 14:04:39 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Make the slot-* functions work for C++ class attributes.
Allow slot-value to be used to access C++ member variables of objects.
diff -rN -u old-smoke/src/libsmoke/CMakeLists.txt new-smoke/src/libsmoke/CMakeLists.txt
--- old-smoke/src/libsmoke/CMakeLists.txt 2014-10-02 08:24:17.000000000 +0200
+++ new-smoke/src/libsmoke/CMakeLists.txt 2014-10-02 08:24:17.000000000 +0200
@@ -10,21 +10,21 @@
# FIXME look for smoke.h
-find_library(smokeqtcore_LIB smokeqtcore)
-if (smokeqtcore_LIB)
- set(smokeqtcore_FOUND TRUE)
-endif (smokeqtcore_LIB)
-
-if (smokeqtcore_FOUND)
- message(STATUS "Found smokeqtcore: ${smokeqtcore}")
-else (smokeqtcore_FOUND)
- message(FATAL_ERROR "Could not find smokeqtcore")
-endif (smokeqtcore_FOUND)
+find_library(smokebase_LIB smokebase)
+if (smokebase_LIB)
+ set(smokebase_FOUND TRUE)
+endif (smokebase_LIB)
+
+if (smokebase_FOUND)
+ message(STATUS "Found smokebase: ${smokebase}")
+else (smokebase_FOUND)
+ message(FATAL_ERROR "Could not find smokebase")
+endif (smokebase_FOUND)
set(SMOKE_C_SOURCES smoke.cpp smokebinding.cpp)
add_library(clsmoke SHARED ${SMOKE_C_SOURCES})
-target_link_libraries(clsmoke ${QT_LIBRARIES} ${smokeqtcore_LIB})
+target_link_libraries(clsmoke ${QT_LIBRARIES} ${smokebase_LIB})
set_target_properties(clsmoke
PROPERTIES
SOVERSION "0.0"
diff -rN -u old-smoke/src/objects/stack.lisp new-smoke/src/objects/stack.lisp
--- old-smoke/src/objects/stack.lisp 2014-10-02 08:24:17.000000000 +0200
+++ new-smoke/src/objects/stack.lisp 2014-10-02 08:24:17.000000000 +0200
@@ -140,13 +140,17 @@
(let ((class (get-class type)))
(if (has-pointer-p object)
(if (derived-p (class-of (get-object object))
- (get-class type))
+ (get-class type))
(get-object object)
(progn
- (cerror "Remove the old object."
- "The object at pointer ~A is ~A but should be a ~A."
- object (get-object object) type)
- (remove-object object)
+ (when (stack-p type)
+ ;; The first member varible of a class can have the
+ ;; same address as its object.
+ ;; e.g.: QSharedData::ref
+ (cerror "Remove the old object."
+ "The object at pointer ~A is ~A but should be a ~A."
+ object (get-object object) type)
+ (remove-object object))
(instance-to-lisp object (find-smoke-class class) type)))
(instance-to-lisp object (find-smoke-class class) type))))
diff -rN -u old-smoke/src/overload-resolution.lisp new-smoke/src/overload-resolution.lisp
--- old-smoke/src/overload-resolution.lisp 2014-10-02 08:24:17.000000000 +0200
+++ new-smoke/src/overload-resolution.lisp 2014-10-02 08:24:17.000000000 +0200
@@ -529,7 +529,6 @@
(condition-class condition)
(condition-arguments condition)))))
-
(defun call-using-args (object-or-class name arguments)
"Calls the method NAME of OBJECT-OR-CLASS with ARGUMENTS."
(declare (optimize (speed 3))
@@ -554,3 +553,53 @@
(null-pointer)
(cast object-or-class (get-class method)))
sequence arguments)))
+
+(defmethod slot-missing (meta-class (class smoke-standard-class) slot-name operation &optional new-value)
+ (let ((method (find-smoke-method class (lisp-to-cxx (string slot-name)))))
+ (if (or (not (valid-p method)) (not (static-p method)))
+ (call-next-method)
+ (ecase operation
+ (setf
+ (handler-case (funcall (fdefinition
+ (intern
+ (concatenate 'string "SET-"
+ (string-upcase
+ (string slot-name)))
+ :cxx))
+ class new-value)
+ (undefined-function ()
+ (error "The C++ attribute ~A of ~A is read only." slot-name class))
+ (no-applicable-cxx-method (condition)
+ (if (null (viable-functions (condition-method condition)
+ (length (condition-arguments condition))
+ (condition-class condition)))
+ (error "The C++ attribute ~A of ~A is read only." slot-name class)
+ (error condition)))))
+ (slot-boundp t)
+ (slot-makunbound (error "Can not unbind the C++ attribute ~A of ~A." slot-name class))
+ (slot-value (s-call method (null-pointer)))))))
+
+(defmethod slot-missing ((class smoke-standard-class) object slot-name operation &optional new-value)
+ (let ((method (find-smoke-method class (lisp-to-cxx (string slot-name)))))
+ (if (not (valid-p method))
+ (call-next-method)
+ (ecase operation
+ (setf
+ (handler-case (funcall (fdefinition
+ (intern
+ (concatenate 'string "SET-"
+ (string-upcase
+ (string slot-name)))
+ :cxx))
+ object new-value)
+ (undefined-function ()
+ (error "The C++ attribute ~A of ~A is read only." slot-name object))
+ (no-applicable-cxx-method (condition)
+ (if (null (viable-functions (condition-method condition)
+ (length (condition-arguments condition))
+ (condition-class condition)))
+ (error "The C++ attribute ~A of ~A is read only." slot-name object)
+ (error condition)))))
+ (slot-boundp t)
+ (slot-makunbound (error "Can not unbind the C++ attribute ~A of ~A." slot-name object))
+ (slot-value (s-call method (cast object (get-class method))))))))