[gtk-cffi-cvs] CVS gtk-cffi/g-object
CVS User rklochkov
rklochkov at common-lisp.net
Mon Dec 31 13:33:38 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object
In directory tiger.common-lisp.net:/tmp/cvs-serv30885/g-object
Modified Files:
g-object-class.lisp g-object.lisp g-type.lisp g-value.lisp
package.lisp subclass.lisp
Log Message:
Backed to CFFI 10.7 (was version from git)
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object-class.lisp 2012/08/18 13:55:27 1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object-class.lisp 2012/12/31 13:33:38 1.8
@@ -10,8 +10,8 @@
(defclass g-object-class (object)
((free-after :initform nil)))
-(defcstruct g-object-class
- (type-class (:struct g-type-class))
+(defcstruct* g-object-class-struct
+ (type-class g-type-class) ; :struct
(construct-properties :pointer)
(constructor :pointer)
(set-property :pointer)
@@ -62,20 +62,23 @@
:readable :writable :construct :construct-only :lax-validation
:static-name :static-nick :static-blurb)
-(defcstruct g-param-spec
+(defcstruct* g-param-spec-struct
"GParamSpec"
(g-type-instance :pointer)
(name :string)
(flags g-param-flags)
- (type :ulong)
+ (g-param-spec-type :ulong)
(owner-type :ulong))
(defmethod flags ((g-param-spec g-param-spec))
- (foreign-slot-value (pointer g-param-spec) '(:struct g-param-spec) 'flags))
+ (flags (make-instance 'g-param-spec-struct :pointer (pointer g-param-spec))))
(defmethod g-type ((g-param-spec g-param-spec) &key owner)
- (foreign-slot-value (pointer g-param-spec)
- '(:struct g-param-spec) (if owner 'owner-type 'type)))
+ (let ((struct (make-instance 'g-param-spec-struct
+ :pointer (pointer g-param-spec))))
+ (if owner
+ (owner-type struct)
+ (g-param-spec-type struct))))
(defun show-properties (g-object)
(let ((gclass (make-instance 'g-object-class :object g-object)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2012/12/24 16:32:05 1.15
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2012/12/31 13:33:38 1.16
@@ -16,7 +16,7 @@
(:documentation "Lisp wrapper for GObject"))
(defcstruct g-object
- (g-type-instance (:pointer (:struct g-type-instance)))
+ (g-type-instance :pointer) ;; (:struct g-type-instance)))
(ref-count :uint)
(g-data :pointer))
@@ -145,8 +145,8 @@
(collect (value
(make-instance
'g-value
- :pointer (mem-aref
- params '(:struct g-value-struct) i))))))
+ :pointer (mem-aref
+ params 'g-value-struct i)))))) ; will be :struct
(lisp-return (make-instance 'g-value :pointer return)))
(let ((res (apply lisp-func lisp-params)))
(when (/= (g-type lisp-return) 0)
@@ -162,8 +162,8 @@
closure-ptr))
-(defcfun "g_signal_handler_disconnect" :void
- (instance (:pointer (:struct g-object))) (id :ulong))
+(defcfun g-signal-handler-disconnect :void
+ (instance pobject) (id :ulong))
(defmethod connect ((g-object g-object) c-handler
&key signal data after swapped)
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2012/08/19 16:22:30 1.9
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2012/12/31 13:33:38 1.10
@@ -20,38 +20,37 @@
(defctype g-type :ulong "GType")
-(defcstruct g-type-interface
+(defcstruct* g-type-interface
"GTypeInterface"
- (g-type g-type)
+ (g-type-type g-type)
(g-instance-type g-type))
-(defcstruct g-type-class
+(defcstruct* g-type-class
"GTypeClass"
- (g-type g-type))
+ (g-type-type g-type))
-(defcstruct g-type-instance
+(defcstruct* g-type-instance
"GTypeInstance"
- (g-class (:pointer (:struct g-type-class))))
+ (g-class (struct g-type-interface)))
(defun g-type-from-instance (ptr)
- (foreign-slot-value
- (foreign-slot-value ptr '(:struct g-type-instance) 'g-class)
- '(:struct g-type-class) 'g-type))
+ (g-type-type (g-class (make-instance 'g-type-instance :pointer ptr
+ :free-after nil))))
(defcfun g-type-fundamental g-type (id g-type))
(defcfun g-type-from-name g-type (name :string))
(defcfun g-type-name :string (id :ulong))
-(defcstruct g-type-query
+(defcstruct* g-type-query
"GTypeQuery"
- (type g-type)
+ (g-type-type g-type)
(name :string)
(class-size :uint)
(instance-size :uint))
(defcfun g-type-query :void (type g-type)
- (query (:pointer (:struct g-type-query))))
+ (query (struct g-type-query)))
(defun g-type->keyword (num)
"Integer (GType) -> keyword from +fundamental-gtypes+"
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-value.lisp 2012/10/07 12:02:11 1.8
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-value.lisp 2012/12/31 13:33:38 1.9
@@ -22,10 +22,10 @@
(v-double :double)
(v-pointer :pointer))
-(defcstruct g-value-struct
+(defcstruct* g-value-struct
"GValue struct"
- (g-type :ulong)
- (data (:union g-value-data) :count 2))
+ (g-type-type :ulong)
+ (data g-value-data :count 2)) ;; with new CFFI -> (:union g-value-data)
(defcfun "g_value_init" :pointer (g-value pobject) (type :int))
(defcfun "g_value_set_boolean" :void (g-value pobject) (val :boolean))
@@ -50,10 +50,11 @@
(defmethod gconstructor ((g-value g-value) &key
(value nil value-p) g-type &allow-other-keys)
- (let ((ptr (foreign-alloc '(:struct g-value-struct))))
- (setf (foreign-slot-value ptr '(:struct g-value-struct) 'g-type) 0)
- (init-g-value ptr g-type value value-p)
- ptr))
+ (let ((struct (make-instance 'g-value-struct :new-struct t
+ :free-after nil)))
+ (setf (g-type-type struct) 0)
+ (init-g-value (pointer struct) g-type value value-p)
+ (pointer struct)))
(defmethod (setf value) (val (g-value g-value))
(g-value-set g-value val (g-type g-value)))
@@ -62,7 +63,7 @@
(defmethod unset ((g-value g-value))
;(when (/= (g-type g-value) 0)
- (format t "Unset value ~a~%" g-value)
+; (format t "Unset value ~a~%" g-value)
(g-value-unset g-value))
(defun init-g-value (ptr type value value-p)
@@ -89,7 +90,7 @@
(g-value-set ptr value %type))))))
(defmethod init ((g-value g-value) &key (value nil value-p) g-type)
- (format t "init ~a~%" g-value)
+; (format t "init ~a~%" g-value)
(init-g-value (pointer g-value) g-type value value-p))
@@ -98,7 +99,9 @@
Depends on implementation of GLib/GObject!
Returns integer GType."
(if (null-pointer-p value) 0
- (foreign-slot-value value '(:struct g-value-struct) 'g-type)))
+ (let ((struct (make-instance 'g-value-struct :pointer value
+ :free-after nil)))
+ (g-type-type struct))))
(defmethod g-type ((g-value g-value) &rest rest)
(declare (ignore rest))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2012/10/07 12:02:11 1.12
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2012/12/31 13:33:38 1.13
@@ -74,6 +74,7 @@
#:find-child-property
#:g-object-class
+ #:g-object-class-struct
#:g-param-spec
#:g-object-newv
#:new
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/subclass.lisp 2012/08/18 13:55:27 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/subclass.lisp 2012/12/31 13:33:38 1.4
@@ -28,7 +28,8 @@
(defcfun g-type-register-static g-type
(parent-type g-type) (type-name :string)
- (info (:pointer (:struct g-type-info))) (flags g-type-flags))
+ (info :pointer) ; (:struct g-type-info)))
+ (flags g-type-flags))
(defcfun g-type-register-static-simple g-type
(parent-type g-type) (type-name :string) (class-size :uint)
@@ -43,7 +44,7 @@
(defcfun g-type-add-interface-static :void
(instance-type g-type) (interface-type g-type)
- (info (:pointer (:struct g-interface-info))))
+ (info :pointer)); (:struct g-interface-info))))
\ No newline at end of file
More information about the gtk-cffi-cvs
mailing list