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

[CVS User rklochkov]

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

Modified Files:
	package.lisp struct.lisp 
Log Message:
Added PangoTabArray cffi foreign type
Fixed cffi-struct in array issues
Added pack of slots to GtkTextView


--- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/package.lisp	2011/08/28 10:31:30	1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/package.lisp	2011/09/16 17:58:33	1.4
@@ -44,4 +44,5 @@
    #:setf-init
    #:init-slots
    #:save-setter
+   #:remove-setter
    #:clear-setters))
--- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp	2011/09/11 15:48:20	1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp	2011/09/16 17:58:33	1.5
@@ -22,6 +22,12 @@
   `(eval-when (:compile-toplevel :load-toplevel :execute)
     (pushnew ',name (get ',class 'slots))))
 
+(defmacro remove-setter (class name)
+  "Use this to unregister setters for SETF-INIT and INIT-SLOTS macro"
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+    (setf (get ',class 'slots)
+          (delete ',name (get ',class 'slots)))))
+
 (defmacro clear-setters (class)
   `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf (get ',class 'slots) nil)))
@@ -131,20 +137,21 @@
         (struct->clos class value)
       (when (obj-free type) (free-struct class value)))))
 
+;; This is needed to get correct mem-aref, when used on array of structs 
+(defmethod cffi::aggregatep ((type cffi-struct))
+  "Returns true, structure types are aggregate."
+  t)
+
 (defun from-foreign (var type count)
+  "VAR - symbol; type - symbol or list -- CFFI type; count -- integer"
   (if count
       (let ((res (make-array count)))
-        (if (subtypep type 'struct)
-            (dotimes (i count)
-              (setf (aref res i)
-                    (struct->clos type (mem-aref var type i))))
-            (dotimes (i count)
-              (setf (aref res i)
-                    (mem-aref var type i))))
+        (dotimes (i count)
+          (setf (aref res i)
+                (mem-aref var type i)))
         res)
-      (if (subtypep type 'struct)
-          (struct->clos type var)
-          (mem-ref var type))))
+      (mem-ref var type)))
+
 
 (defmacro with-foreign-out ((var type &optional count) return-result &body body)
   "The same as WITH-FOREIGN-OBJECT, but returns value of object"