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

CVS User rklochkov rklochkov at common-lisp.net
Mon Dec 24 16:32:05 UTC 2012


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

Modified Files:
	defslots.lisp g-object.lisp 
Log Message:
Reloading after CVS was broken



--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp	2012/10/07 12:02:11	1.15
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp	2012/12/24 16:32:05	1.16
@@ -147,18 +147,21 @@
 (defgeneric foreach (class func &optional data)
   (:documentation "For each element in CLASS execute FUNC"))
 (defmacro make-foreach (class &rest params)
-  (let ((gtk-name (symbolicate 'gtk- class '-foreach))
-        (cb-name (gensym)))
-  `(progn
-     (defcfun ,gtk-name :void
-       (,class pobject) (func pfunction) (data (pdata :free-to-foreign t)))
-     (defcallback ,cb-name :void ,params ;((tag pobject) (data pdata))
-       (funcall *callback* ,@(mapcar #'car params)))
-     (defmethod foreach ((,class ,class) func &optional data)
-       (if (functionp func)
-           (let ((*callback* func))
-             (,gtk-name ,class (callback ,cb-name) data))
-           (,gtk-name ,class func data))))))
+  "Class is a symbol: class or list: (class gtk-name)"
+  (destructuring-bind (class gtk-name) 
+      (if (listp class) class 
+          (list class (symbolicate 'gtk- class '-foreach)))
+    (let ((cb-name (gensym)))
+      `(progn
+         (defcfun ,gtk-name :void
+           (,class pobject) (func pfunction) (data (pdata :free-to-foreign t)))
+         (defcallback ,cb-name :void ,params ;((tag pobject) (data pdata))
+           (funcall *callback* ,@(mapcar #'car params)))
+         (defmethod foreach ((,class ,class) func &optional data)
+           (if (functionp func)
+               (let ((*callback* func))
+                 (,gtk-name ,class (callback ,cb-name) data))
+               (,gtk-name ,class func data)))))))
 
 (defmacro set-callback (object setter cb-standard func data destroy-notify
                         &rest add-params)
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp	2012/08/18 13:55:27	1.14
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp	2012/12/24 16:32:05	1.15
@@ -62,17 +62,18 @@
      ,@(when set
         `((defcfun ,set :void 
             (object pobject) (name cffi-keyword) (value pobject))
-          (defgeneric (setf ,name) (values ,object &rest keys))
-          (defmethod (setf ,name) (values (,object ,object) &rest keys)
-            "Usage: 
+          (defgeneric (setf ,name) (values ,object &rest keys)
+            (:method (values (,object ,object) &rest keys)
+              "Usage: 
           (setf (property object :property) value)
           (setf (property object :prop1 :prop2) (list value1 value2))"
-            (mapc (lambda (key value)
-                    (declare (type (or symbol string) key))
-                    (let ((skey (string-downcase key)))
-                      (with-g-value (:value value :g-type (,type ,object skey))
-                        (,set ,object skey *g-value*))))
-                  keys (if (listp values) values (list values))))))
+              (mapc (lambda (key value)
+                      (declare (type (or symbol string) key))
+                      (let ((skey (string-downcase key)))
+                        (with-g-value (:value value 
+                                       :g-type (,type ,object skey))
+                          (,set ,object skey *g-value*))))
+                    keys (if (listp values) values (list values)))))))
 
      (defcfun ,get :void 
        (object pobject) (name cffi-keyword) (value pobject))





More information about the gtk-cffi-cvs mailing list