Copying pristine 48 done, 4 queued. sbcl.lisp
Mon May 11 19:55:42 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * Support (setf (getter-method) value) for C++ set* methods.
diff -rN -u old-smoke/src/clos.lisp new-smoke/src/clos.lisp
--- old-smoke/src/clos.lisp	2015-11-30 01:38:29.513107248 +0100
+++ new-smoke/src/clos.lisp	2015-11-30 01:38:30.083067766 +0100
@@ -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)
diff -rN -u old-smoke/src/method.lisp new-smoke/src/method.lisp
--- old-smoke/src/method.lisp	2015-11-30 01:38:29.511107387 +0100
+++ new-smoke/src/method.lisp	2015-11-30 01:38:30.093067073 +0100
@@ -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))