[gtk-cffi-cvs] CVS gtk-cffi/g-object

[CVS User rklochkov]

Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object
In directory tiger.common-lisp.net:/tmp/cvs-serv18018/g-object

Modified Files:
	defslots.lisp 
Log Message:
Fix struct in array processing


--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp	2011/09/10 16:26:10	1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp	2011/09/17 20:04:56	1.4
@@ -55,14 +55,18 @@
          (defmethod ,name-lisp ((,class ,class) , at param-list)
            (,fun-name ,class , at param-list))))))
 
-(defun defsetter (prefix name slot-type class params)
+(defun defsetter (prefix name slot-type class params last)
   (let ((name-lisp (if (consp name) (car name) name))
         (name-gtk (if (consp name) (cdr name) name)))
     (let ((setter (symbolicate prefix class '-set- name-gtk))
           (param-list (mapcar #'car params)))
       `(progn
          ,(unless params `(save-setter ,class ,name-lisp))
-         (defcfun ,setter :void (widget pobject) (value ,slot-type) , at params)
+         ,(if last
+              `(defcfun ,setter :void (widget pobject) 
+                        , at params (value ,slot-type)) 
+              `(defcfun ,setter :void (widget pobject) 
+                        (value ,slot-type) , at params))
          (unless (fboundp '(setf ,name-lisp))
            (defgeneric (setf ,name-lisp) (value ,class , at param-list)))
          (defmethod (setf ,name-lisp) (value (object ,class) , at param-list) 
@@ -80,32 +84,39 @@
 (defmacro defgdkgetter (name res-type class &rest params)
   (def-fun 'gdk- name res-type class params :get t))
 
-(defmacro defgtksetter (name slot-type class &rest params)
-  (defsetter 'gtk- name slot-type class params))
+(defmacro defgtksetter (name slot-type class last &rest params)
+  (defsetter 'gtk- name slot-type class params last))
 
-(defmacro defgdksetter (name slot-type class &rest params)
-  (defsetter 'gdk- name slot-type class params))
+(defmacro defgdksetter (name slot-type class last &rest params)
+  (defsetter 'gdk- name slot-type class params last))
 
-(defun inject-class (fun class)
-  (list* (first fun) (second fun) class (nthcdr 2 fun)))
-
-(defmacro defgtkfuns (class &rest funs)
-  (cons 'progn
-        (mapcar (lambda (fun)
-                  (case (car fun)
-                    (:set `(defgtksetter ,@(inject-class (cdr fun) class)))
-                    (:get `(defgtkgetter ,@(inject-class (cdr fun) class)))
-                    (t `(defgtkfun ,@(inject-class fun class)))))
-                funs)))
-
-(defmacro defgdkfuns (class &rest funs)
-  (cons 'progn
-        (mapcar (lambda (fun)
-                  (case (car fun)
-                    (:set `(defgdksetter ,@(inject-class (cdr fun) class)))
-                    (:get `(defgdkgetter ,@(inject-class (cdr fun) class)))
-                    (t `(defgdkfun ,@(inject-class fun class))))) 
-                funs)))
+(flet ((inject-class (fun class)
+         (list* (first fun) (second fun) class (nthcdr 2 fun)))
+       (inject-class2 (fun class last)
+         (list* (first fun) (second fun) class last (nthcdr 2 fun))))
+  (defmacro defgtkfuns (class &rest funs)
+    (cons 'progn
+          (mapcar (lambda (fun)
+                    (case (car fun)
+                      (:set `(defgtksetter ,@(inject-class2 (cdr fun) 
+                                                            class nil)))
+                      (:set-last `(defgtksetter ,@(inject-class2 (cdr fun) 
+                                                                 class t)))
+                      (:get `(defgtkgetter ,@(inject-class (cdr fun) class)))
+                      (t `(defgtkfun ,@(inject-class fun class)))))
+                  funs)))
+
+  (defmacro defgdkfuns (class &rest funs)
+    (cons 'progn
+          (mapcar (lambda (fun)
+                    (case (car fun)
+                      (:set `(defgdksetter ,@(inject-class2 (cdr fun) 
+                                                            class nil)))
+                      (:set-last `(defgdksetter ,@(inject-class2 (cdr fun) 
+                                                                 class t)))
+                      (:get `(defgdkgetter ,@(inject-class (cdr fun) class)))
+                      (t `(defgdkfun ,@(inject-class fun class))))) 
+                  funs))))
    
 
 (defmacro with-object ((name &optional for-free) init &rest body)