[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