Mon May 11 19:55:42 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Support (setf (getter-method) value) for C++ set* methods.

- (:documentation "Smoke generic function"))

+ (:documentation "Smoke generic function."))

- (call-using-args ,(first lambda-list) (name ,(cxx-generic-function gf))

+ (call-using-args ,(first lambda-list)

+ (name ,(cxx-generic-function gf))

-#|

- (let ((method (find-method-using-args (smoke-class-of ,(first lambda-list))

- (name ,(cxx-generic-function gf))

- (list ,@(rest lambda-list)))))

- (if (static-p method)

- (s-call method (null-pointer) (list ,@lambda-list))

- (s-call method (cast ,(first lambda-list) (get-class method))

- (list ,@(rest lambda-list))))))))))

-|#

- ((binding :pointer)

- (id smoke-index)

- (object-pointer :pointer))

- (declare (optimize (speed 3)))

+ ((binding :pointer)

+ (id smoke-index)

+ (object-pointer :pointer))

+ (declare (ignore binding id)

+ (optimize (speed 3)))

- (name (lispify (concatenate 'string

- (if (string= (name class)

- "QGlobalSpace")

- nil

- (concatenate 'string

- (name class)

- "."))

- (name method)))))

+ (name (static-method-symbol method)))

+(defun setf-method-definition (method)

+ `(defun (setf ,(lispify (subseq (name method) 3) :cxx)) (new-value object)

+ (,(lispify (name method) :cxx) object new-value)

+ new-value))

+

-

+ (setf-function-symbols (make-hash-table))

- (setf (gethash (lispify (name method) "CXX") generics)

- (name method))

+ (let ((name (name method)))

+ (when (and (starts-with-subseq "set" name)

+ (> (length name) 3)

+ (upper-case-p (char name 3))

+ (= 1 (get-arguments-length method)))

+ (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))