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.
hunk ./src/objects/stack.lisp 143
- (get-class type))
+ (get-class type))
hunk ./src/objects/stack.lisp 146
- (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))
hunk ./src/overload-resolution.lisp 532
-
hunk ./src/overload-resolution.lisp 556
+
+(defmethod slot-missing ((class smoke-standard-class) object slot-name operation &optional new-value)
+ (let ((method (find-smoke-method (class-of object) (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))))))))