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

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

--- old-smoke/src/clos.lisp 2014-09-30 10:27:02.000000000 +0200

+++ new-smoke/src/clos.lisp 2014-09-30 10:27:02.000000000 +0200

@@ -229,7 +229,7 @@

:type string

:documentation "The C++ name of the method."))

(:metaclass closer-mop:funcallable-standard-class)

- (:documentation "Smoke generic function"))

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

(defun smoke-class-of (object)

"Returns the class of OBJECT or OBJECT iff it alread is a class."

@@ -252,23 +252,16 @@

gf

`(lambda ,lambda-list

(declare (optimize (speed 3)))

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

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

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

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

-#|

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

-|#

(defcallback destructed :void

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

(let ((object (get-object object-pointer)))

(when object

(cancel-finalization object)

--- old-smoke/src/method.lisp 2014-09-30 10:27:02.000000000 +0200

+++ new-smoke/src/method.lisp 2014-09-30 10:27:02.000000000 +0200

@@ -39,14 +39,7 @@

The second return value is the expression to export the function."

(let* ((class (get-class method))

(method-name (name method))

- (name (lispify (concatenate 'string

- (if (string= (name class)

- "QGlobalSpace")

- nil

- (concatenate 'string

- (name class)

- "."))

- (name method)))))

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

(values

`(defun ,name (&rest args)

(call-using-args (find-class (quote ,(lispify (name class))))

@@ -64,6 +57,11 @@

:lambda-list '(object &rest args))

(export (first symbol-name) :CXX)))

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

+

(defmacro check-recompile (smoke)

"Raises an error when the fasl of the DEFINE-METHOS was not compiled against

the current smoke module."

@@ -79,7 +77,6 @@

(error "The smoke module ~A changed, you need to recompile the lisp file."

(smoke-get-module-name ,smoke)))))

-

(defmacro define-methods (smoke)

"Process the C++ methods of the Smoke module SMOKE.

Expands to DEFUNs for static methods, DEFINE-CONSTANTs for enum methods

@@ -90,6 +87,7 @@

(constants)

(functions)

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

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

(exports))

(map-methods

#'(lambda (method)

@@ -107,8 +105,16 @@

(not (enum-p method))

(not (eql nil (name method)))

(string/= (name method) "tr")) ;; we have a custom qt:tr funciton

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

(when (static-p method)

(let ((function-symbol (static-method-symbol method)))

(unless (nth-value 1 (gethash function-symbol function-symbols))