[gtk-cffi-cvs] CVS gtk-cffi/gdk
CVS User rklochkov
rklochkov at common-lisp.net
Sun Aug 19 16:22:30 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk
In directory tiger.common-lisp.net:/tmp/cvs-serv7466/gdk
Modified Files:
color.lisp gdk-cffi.asd keys.lisp package.lisp pango.lisp
Added Files:
drag-drop.lisp
Log Message:
Fixed GDK for new CFFI version
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/08/18 13:55:27 1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/08/19 16:22:30 1.8
@@ -45,8 +45,9 @@
(:actual-type :pointer)
(:simple-parser prgba))
-(defcfun gdk-rgba-parse :boolean (color rgba-struct) (str :string))
-(defcfun gdk-rgba-to-string :string (color rgba-struct))
+(defcfun gdk-rgba-parse :boolean (color (:pointer (:struct rgba-struct)))
+ (str :string))
+(defcfun gdk-rgba-to-string :string (color (:pointer (:struct rgba-struct))))
(defcfun gdk-rgba-free :void (color :pointer))
(defmethod free-ptr ((class rgba-cffi) ptr)
@@ -54,7 +55,7 @@
(defmethod translate-to-foreign (value (type rgba-cffi))
(if (pointerp value) value
- (let ((color-st (foreign-alloc 'rgba-struct)))
+ (let ((color-st (foreign-alloc '(:pointer (:struct rgba-struct)))))
(assert (gdk-rgba-parse color-st (string value)) (value)
"Bad RGBA color")
color-st)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2012/05/07 09:02:04 1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2012/08/19 16:22:30 1.8
@@ -32,4 +32,5 @@
(:file image :depends-on (visual))
(:file atom :depends-on (loadlib))
(:file pixbuf :depends-on (image gc))
- (:file cairo :depends-on (pixbuf))))
+ (:file cairo :depends-on (pixbuf))
+ (:file drag-drop :depends-on (package))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2011/09/21 12:03:47 1.6
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2012/08/19 16:22:30 1.7
@@ -50,7 +50,7 @@
(level :int))
(defgdkfuns keymap
- (lookup-key :uint (key keymap-key))
+ (lookup-key :uint (key (:pointer (:struct keymap-key))))
(:get direction pango-cffi:direction)
(have-bidi-layouts :boolean)
(:get caps-lock-state :boolean)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2012/05/07 09:02:04 1.11
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2012/08/19 16:22:30 1.12
@@ -56,6 +56,9 @@
#:unichar
#:keymap
+ #:have-bidi-layouts
+ #:caps-lock-state
+ #:num-lock-state
#:keycode
#:group
#:level
@@ -75,6 +78,8 @@
#:cairo-create
#:cairo-set-source-pixbuf
+
+ #:drag-action
))
(in-package #:gdk-cffi)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2012/08/12 17:42:30 1.8
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2012/08/19 16:22:30 1.9
@@ -174,11 +174,11 @@
(end-index :uint))
(defcstruct attr-string
- (attr attribute)
+ (attr (:struct attribute))
(value :string))
(defcstruct attr-language
- (attr attribute)
+ (attr (:struct attribute))
(value language))
(defcstruct color
@@ -187,19 +187,19 @@
(blue :uint16))
(defcstruct attr-color
- (attr attribute)
- (value color))
+ (attr (:struct attribute))
+ (value (:struct color)))
(defcstruct attr-int
- (attr attribute)
+ (attr (:struct attribute))
(value :int))
(defcstruct attr-float
- (attr attribute)
+ (attr (:struct attribute))
(value :float))
(defcstruct attr-font-desc
- (attr attribute)
+ (attr (:struct attribute))
(value font))
(defcstruct rectangle
@@ -207,20 +207,20 @@
(width :int) (height :int))
(defcstruct attr-shape
- (attr attribute)
- (ink rectangle)
- (logical rectangle)
+ (attr (:struct attribute))
+ (ink (:struct rectangle))
+ (logical (:struct rectangle))
(data :pointer)
(copy-func :pointer)
(destroy-func :pointer))
(defcstruct attr-size
- (attr attribute)
+ (attr (:struct attribute))
(size :int)
(absolute :uint))
(defun rect->list (rect)
- (with-foreign-slots ((x y width height) rect rectangle)
+ (with-foreign-slots ((x y width height) rect (:struct rectangle))
(list x y width height)))
(eval-when (:compile-toplevel :load-toplevel)
@@ -243,32 +243,36 @@
(defun translate-to-enum (type value)
(case type
((:style :weight :variant :stretch :underline :gravity :gravity-hint)
- (convert-from-foreign value (intern (symbol-name type) #.*package*)))
+ (convert-from-foreign
+ value `(:struct ,(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 'attribute 'klass)
+ (let* ((type (mem-ref (foreign-slot-value attr '(:struct attribute) 'klass)
'attr-type))
(tail-type (attr->type type)))
- (with-foreign-slots ((start-index end-index) attr attribute)
+ (with-foreign-slots ((start-index end-index) attr (:struct attribute))
(list* type start-index end-index
(ecase tail-type
((attr-language attr-string attr-font-desc attr-float)
- (list (foreign-slot-value attr tail-type 'value)))
+ (list (foreign-slot-value attr `(:struct ,tail-type) 'value)))
(attr-int (list (translate-to-enum
type
- (foreign-slot-value attr tail-type 'value))))
+ (foreign-slot-value attr `(:struct ,tail-type)
+ 'value))))
(attr-color (with-foreign-slots
((red green blue)
- (foreign-slot-value attr 'attr-color 'value)
- color)
+ (foreign-slot-value attr
+ '(:struct attr-color)
+ 'value)
+ (:struct color))
(list red green blue)))
(attr-size (list (foreign-slot-value attr tail-type 'size)))
(attr-shape
- (with-foreign-slots ((ink logical) attr attr-shape)
+ (with-foreign-slots ((ink logical) attr (:struct attr-shape))
(list (rect->list ink) (rect->list logical)))))))))
@@ -285,15 +289,16 @@
((:strikethrough :fallback) :boolean)
(:scale :double)
(t (intern (symbol-name type) #.*package*)))))
- `(defcfun ,(symbolicate 'pango-attr- attr '-new) ,(attr->type attr)
- (value ,(in-type attr)))))
+ `(defcfun ,(symbolicate 'pango-attr- attr '-new)
+ (:pointer (:struct ,(attr->type attr))) (value ,(in-type attr)))))
(template attr (:foreground :background :strikethrough-color :underline-color)
- `(defcfun ,(symbolicate 'pango-attr- attr '-new) attr-color
- (red :uint16) (green :uint16) (blue :uint16)))
+ `(defcfun ,(symbolicate 'pango-attr- attr '-new)
+ (:pointer (:struct attr-color)) (red :uint16) (green :uint16)
+ (blue :uint16)))
(defcfun ("pango_attr_size_new_absolute" pango-attr-absolute-size-new)
- attr-size (size :int))
+ (:pointer (:struct attr-size)) (size :int))
(define-foreign-type rect-list (freeable)
()
@@ -301,8 +306,8 @@
(:actual-type :pointer))
(defmethod translate-to-foreign (value (type rect-list))
- (let ((ptr (foreign-alloc 'rectangle)))
- (with-foreign-slots ((x y width height) ptr rectangle)
+ (let ((ptr (foreign-alloc '(:pointer (:struct rectangle)))))
+ (with-foreign-slots ((x y width height) ptr (:struct rectangle))
(destructuring-bind (new-x new-y new-width new-height) value
(setf x new-x
y new-y
@@ -311,7 +316,8 @@
ptr))
-(defcfun pango-attr-shape-new attr-shape (ink rect-list) (logical rect-list))
+(defcfun pango-attr-shape-new (:pointer (:struct attr-shape))
+ (ink rect-list) (logical rect-list))
(define-foreign-type attr-list (freeable)
((free-from-foreign :initform t))
@@ -356,8 +362,10 @@
'pango-attr- x '-new))))
(cdr (foreign-enum-keyword-list 'attr-type)))))
params)))
- (setf (foreign-slot-value ptr 'attribute 'start-index) start-index
- (foreign-slot-value ptr 'attribute 'end-index) end-index)
+ (setf (foreign-slot-value ptr '(:struct attribute)
+ 'start-index) start-index
+ (foreign-slot-value ptr '(:struct attribute)
+ 'end-index) end-index)
ptr)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/drag-drop.lisp 2012/08/19 16:22:30 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/drag-drop.lisp 2012/08/19 16:22:30 1.1
(in-package :gdk-cffi)
(defbitfield drag-action :default :copy :move :link :private :ask)
More information about the gtk-cffi-cvs
mailing list