[gtk-cffi-cvs] CVS gtk-cffi/gdk
CVS User rklochkov
rklochkov at common-lisp.net
Mon Dec 31 13:33:38 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk
In directory tiger.common-lisp.net:/tmp/cvs-serv30885/gdk
Modified Files:
color.lisp event.lisp keys.lisp pango.lisp
Log Message:
Backed to CFFI 10.7 (was version from git)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/08/24 19:27:54 1.9
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/12/31 13:33:38 1.10
@@ -8,8 +8,8 @@
(blue :int16))
(defcfun gdk-color-parse :boolean (str :string)
- (color (:pointer (:struct color-struct))))
-(defcfun gdk-color-to-string :string (color (:pointer (:struct color-struct))))
+ (color :pointer))
+(defcfun gdk-color-to-string :string (color :pointer))
(defcfun gdk-color-free :void (color :pointer))
(define-foreign-type color-cffi (freeable)
@@ -22,7 +22,7 @@
(defmethod translate-to-foreign (value (type color-cffi))
(if (pointerp value) value
- (let ((color-st (foreign-alloc '(:struct color-struct))))
+ (let ((color-st (foreign-alloc (cffi-objects::struct-type 'color-struct))))
(gdk-color-parse (string value) color-st)
color-st)))
@@ -44,9 +44,9 @@
(:actual-type :pointer)
(:simple-parser prgba))
-(defcfun gdk-rgba-parse :boolean (color (:pointer (:struct rgba-struct)))
+(defcfun gdk-rgba-parse :boolean (color :pointer)
(str :string))
-(defcfun gdk-rgba-to-string :string (color (:pointer (:struct rgba-struct))))
+(defcfun gdk-rgba-to-string :string (color :pointer))
(defcfun gdk-rgba-free :void (color :pointer))
(defmethod free-ptr ((class (eql 'rgba-cffi)) ptr)
@@ -54,7 +54,7 @@
(defmethod translate-to-foreign (value (type rgba-cffi))
(if (pointerp value) value
- (let ((color-st (foreign-alloc '(:pointer (:struct rgba-struct)))))
+ (let ((color-st (foreign-alloc :pointer)))
(assert (gdk-rgba-parse color-st (string value)) (value)
"Bad RGBA color")
color-st)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/event.lisp 2012/10/07 12:02:11 1.5
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/event.lisp 2012/12/31 13:33:38 1.6
@@ -120,14 +120,13 @@
(defctype region :pointer) ;; = GdkRegion*
-(defcstruct event-expose
- ""
- (type event-type)
+(defcstruct* event-expose
+ (event-expose-type event-type)
(window window)
(send-event :int8)
(area (:struct rectangle))
(region region)
- (count :int))
+ (event-expose-count :int))
(defcenum visibility-state
:unobscured :partial :obscured)
@@ -237,7 +236,7 @@
(send-event :int8)
(message-tyoe gdk-atom)
(data-format :ushort)
- (data (:union client-data-union)))
+ (data client-data-union)) ; :union
(defcstruct event-no-expose
""
@@ -292,26 +291,26 @@
(defcunion event
(type event-type)
- (any (:struct event-any))
- (expose (:struct event-expose))
- (no-expose (:struct event-no-expose))
- (visibility (:struct event-visibility))
- (motion (:struct event-motion))
- (button (:struct event-button))
- (scroll (:struct event-scroll))
- (key (:struct event-key))
- (crossing (:struct event-crossing))
- (focus-change (:struct event-focus))
- (configure (:struct event-configure))
- (property (:struct event-property))
- (selection (:struct event-selection))
- (owner-change (:struct event-owner-change))
- (proximity (:struct event-proximity))
- (client (:struct event-client))
- (dnd (:struct event-dnd))
- (window-state (:struct event-window-state))
- (setting (:struct event-setting))
- (grab-broken (:struct event-grab-broken)))
+ (any event-any)
+ (expose event-expose)
+ (no-expose event-no-expose)
+ (visibility event-visibility)
+ (motion event-motion)
+ (button event-button)
+ (scroll event-scroll)
+ (key event-key)
+ (crossing event-crossing)
+ (focus-change event-focus)
+ (configure event-configure)
+ (property event-property)
+ (selection event-selection)
+ (owner-change event-owner-change)
+ (proximity event-proximity)
+ (client event-client)
+ (dnd event-dnd)
+ (window-state event-window-state)
+ (setting event-setting)
+ (grab-broken event-grab-broken))
(defclass event (object)
((event-type :accessor event-type)))
@@ -320,7 +319,7 @@
:after ((event event)
&key pointer &allow-other-keys)
(setf (event-type event)
- (case (foreign-slot-value pointer '(:union event) 'type)
+ (case (foreign-slot-value pointer 'event 'type) ; :union
((:nothing :delete :destroy :map :unmap) 'event-any)
(:expose 'event-expose)
(:motion-notify 'event-motion)
@@ -348,7 +347,8 @@
(t 'event-any))))
(defmethod get-slot ((event event) field)
- (foreign-slot-value (pointer event) (list :struct (event-type event))
+ (foreign-slot-value (pointer event)
+ (cffi-objects::struct-type (event-type event))
(find-symbol (string field) :gdk-cffi)))
(defun parse-event (ev-pointer field)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2012/08/19 16:22:30 1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2012/12/31 13:33:38 1.8
@@ -50,7 +50,7 @@
(level :int))
(defgdkfuns keymap
- (lookup-key :uint (key (:pointer (:struct keymap-key))))
+ (lookup-key :uint (key :pointer))
(:get direction pango-cffi:direction)
(have-bidi-layouts :boolean)
(:get caps-lock-state :boolean)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2012/08/24 19:27:54 1.10
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2012/12/31 13:33:38 1.11
@@ -168,45 +168,45 @@
:rise :shape :scale :fallback :letter-spacing :underline-color
:strikethrough-color :absolute-size :gravity :gravity-hint))
-(defcstruct attribute
+(defcstruct* attribute
(klass (:pointer attr-type))
(start-index :uint)
(end-index :uint))
-(defcstruct attr-string
+(defcstruct* attr-string
(attr (:struct attribute))
(value :string))
-(defcstruct attr-language
+(defcstruct* attr-language
(attr (:struct attribute))
(value language))
-(defcstruct color
+(defcstruct* color
(red :uint16)
(green :uint16)
(blue :uint16))
-(defcstruct attr-color
+(defcstruct* attr-color
(attr (:struct attribute))
(value (:struct color)))
-(defcstruct attr-int
+(defcstruct* attr-int
(attr (:struct attribute))
(value :int))
-(defcstruct attr-float
+(defcstruct* attr-float
(attr (:struct attribute))
(value :float))
-(defcstruct attr-font-desc
+(defcstruct* attr-font-desc
(attr (:struct attribute))
(value font))
-(defcstruct rectangle
+(defcstruct* rectangle
(x :int) (y :int)
(width :int) (height :int))
-(defcstruct attr-shape
+(defcstruct* attr-shape
(attr (:struct attribute))
(ink (:struct rectangle))
(logical (:struct rectangle))
@@ -214,13 +214,13 @@
(copy-func :pointer)
(destroy-func :pointer))
-(defcstruct attr-size
+(defcstruct* attr-size
(attr (:struct attribute))
(size :int)
(absolute :uint))
(defun rect->list (rect)
- (with-foreign-slots ((x y width height) rect (:struct rectangle))
+ (with-foreign-slots ((x y width height) rect rectangle) ; :struct
(list x y width height)))
(eval-when (:compile-toplevel :load-toplevel)
@@ -244,35 +244,39 @@
(case type
((:style :weight :variant :stretch :underline :gravity :gravity-hint)
(convert-from-foreign
- value `(:struct ,(intern (symbol-name type) #.*package*))))
+ value `(cffi-objects::struct-type
+ ,(intern (symbol-name type) #.*package*))))
((:strikethrough :fallback) (convert-from-foreign value :boolean))
(t value)))
(defun attr->list (attr)
- (let* ((type (mem-ref (foreign-slot-value attr '(:struct attribute) 'klass)
+ (let* ((type (mem-ref (foreign-slot-value
+ attr (cffi-objects::struct-type 'attribute) 'klass)
'attr-type))
(tail-type (attr->type type)))
- (with-foreign-slots ((start-index end-index) attr (:struct attribute))
+ (with-foreign-slots ((start-index end-index) attr attribute) ; :struct
(list* type start-index end-index
(ecase tail-type
((attr-language attr-string attr-font-desc attr-float)
- (list (foreign-slot-value attr `(:struct ,tail-type) 'value)))
+ (list (foreign-slot-value
+ attr (cffi-objects::struct-type tail-type) 'value)))
(attr-int (list (translate-to-enum
type
- (foreign-slot-value attr `(:struct ,tail-type)
- 'value))))
+ (foreign-slot-value
+ attr (cffi-objects::struct-type tail-type)
+ 'value))))
(attr-color (with-foreign-slots
((red green blue)
- (foreign-slot-value attr
- '(:struct attr-color)
- 'value)
- (:struct color))
+ (foreign-slot-value
+ attr (cffi-objects::struct-type 'attr-color)
+ 'value)
+ color) ; :struct
(list red green blue)))
(attr-size (list (foreign-slot-value attr tail-type 'size)))
(attr-shape
- (with-foreign-slots ((ink logical) attr (:struct attr-shape))
+ (with-foreign-slots ((ink logical) attr attr-shape) ; :struct
(list (rect->list ink) (rect->list logical)))))))))
@@ -290,15 +294,15 @@
(:scale :double)
(t (intern (symbol-name type) #.*package*)))))
`(defcfun ,(symbolicate 'pango-attr- attr '-new)
- (:pointer (:struct ,(attr->type attr))) (value ,(in-type attr)))))
+ :pointer (value ,(in-type attr)))))
(template attr (:foreground :background :strikethrough-color :underline-color)
`(defcfun ,(symbolicate 'pango-attr- attr '-new)
- (:pointer (:struct attr-color)) (red :uint16) (green :uint16)
+ (struct attr-color) (red :uint16) (green :uint16)
(blue :uint16)))
(defcfun ("pango_attr_size_new_absolute" pango-attr-absolute-size-new)
- (:pointer (:struct attr-size)) (size :int))
+ (struct attr-size) (size :int))
(define-foreign-type rect-list (freeable)
()
@@ -306,8 +310,8 @@
(:actual-type :pointer))
(defmethod translate-to-foreign (value (type rect-list))
- (let ((ptr (foreign-alloc '(:pointer (:struct rectangle)))))
- (with-foreign-slots ((x y width height) ptr (:struct rectangle))
+ (let ((ptr (foreign-alloc :pointer)))
+ (with-foreign-slots ((x y width height) ptr rectangle) ; :struct
(destructuring-bind (new-x new-y new-width new-height) value
(setf x new-x
y new-y
@@ -316,7 +320,7 @@
ptr))
-(defcfun pango-attr-shape-new (:pointer (:struct attr-shape))
+(defcfun pango-attr-shape-new :pointer
(ink rect-list) (logical rect-list))
(define-foreign-type attr-list (freeable)
@@ -362,9 +366,9 @@
'pango-attr- x '-new))))
(cdr (foreign-enum-keyword-list 'attr-type)))))
params)))
- (setf (foreign-slot-value ptr '(:struct attribute)
+ (setf (foreign-slot-value ptr (cffi-objects::struct-type 'attribute)
'start-index) start-index
- (foreign-slot-value ptr '(:struct attribute)
+ (foreign-slot-value ptr (cffi-objects::struct-type 'attribute)
'end-index) end-index)
ptr)))
More information about the gtk-cffi-cvs
mailing list