Tue Jul 13 21:17:41 CEST 2010 Tobias Rautenkranz * Use libsmokebase instead of libsmokeqtcore. Sat Apr 3 21:11:26 CEST 2010 Tobias Rautenkranz * slot-value access for static attributes using the class instead of an object. Sat Apr 3 14:04:39 CEST 2010 Tobias Rautenkranz * Make the slot-* functions work for C++ class attributes. Allow slot-value to be used to access C++ member variables of objects. Sat Apr 3 14:03:07 CEST 2010 Tobias Rautenkranz * Fix attribute vs method map to same Lisp name clash. e.g.: setWidget() and set_widget are in Lisp both #'set-widget. Prefer the method over the attribute; the attribute will be accessible with SLOT-VALUE. diff -rN -u old-smoke/src/libsmoke/CMakeLists.txt new-smoke/src/libsmoke/CMakeLists.txt --- old-smoke/src/libsmoke/CMakeLists.txt 2014-10-05 10:09:07.000000000 +0200 +++ new-smoke/src/libsmoke/CMakeLists.txt 2014-10-05 10:09:07.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-05 10:09:07.000000000 +0200 +++ new-smoke/src/objects/stack.lisp 2014-10-05 10:09:07.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-05 10:09:07.000000000 +0200 +++ new-smoke/src/overload-resolution.lisp 2014-10-05 10:09:07.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)))))))) diff -rN -u old-smoke/src/smoke-to-clos.lisp new-smoke/src/smoke-to-clos.lisp --- old-smoke/src/smoke-to-clos.lisp 2014-10-05 10:09:07.000000000 +0200 +++ new-smoke/src/smoke-to-clos.lisp 2014-10-05 10:09:07.000000000 +0200 @@ -138,8 +138,9 @@ (unless (nth-value 1 (gethash (lispify name :cxx) setf-function-symbols)) (setf (gethash (lispify name :cxx) setf-function-symbols) t) (push (setf-method-definition method) functions))) - (setf (gethash (lispify name "CXX") generics) - name)) + (let ((lisp-name (lispify name "CXX"))) + (unless (and (gethash lisp-name generics) (attribute-p method)) + (setf (gethash lisp-name generics) name)))) (when (static-p method) (let* ((function-symbol (static-method-symbol package method)) (methods (gethash function-symbol function-symbols)))