[gtk-cffi-cvs] CVS gtk-cffi/gdk
CVS User rklochkov
rklochkov at common-lisp.net
Sun Sep 18 18:10:47 UTC 2011
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk
In directory tiger.common-lisp.net:/tmp/cvs-serv20455/gdk
Modified Files:
color.lisp pango.lisp
Log Message:
Fixed bug: now when one needs to free returned value after processing
(for example, color, font, structure), she or he may add " :free t" flag to
the foreign typename
Finished GtkTextView and GtkTextTag
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2011/08/26 17:16:14 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2011/09/18 18:10:47 1.3
@@ -9,12 +9,16 @@
(defcfun "gdk_color_parse" :boolean (str gtk-string) (color color-struct))
(defcfun "gdk_color_to_string" gtk-string (color color-struct))
+(defcfun gdk-color-free :void (color :pointer))
-(define-foreign-type color-cffi ()
+(define-foreign-type color-cffi (freeable)
()
- (:actual-type :pointer)
+ (:actual-type color-struct)
(:simple-parser pcolor))
+(defmethod free-ptr ((class color-cffi) ptr)
+ (gdk-color-free ptr))
+
(defmethod translate-to-foreign (value (type color-cffi))
(if (pointerp value) value
(let ((color-st (foreign-alloc 'color-struct)))
@@ -22,11 +26,16 @@
color-st)))
(defmethod translate-from-foreign (ptr (type color-cffi))
- (gdk-color-to-string ptr))
+ (prog1
+ (gdk-color-to-string ptr)
+ (free-if-needed type ptr)))
(defmethod free-translated-object (value (name color-cffi) param)
(foreign-free value))
+(defcfun (color-equal "gdk_color_equal") :boolean
+ (color pcolor) (color2 pcolor))
+
(defcstruct rgba-struct
"GdkRGBA"
(red :double)
@@ -34,13 +43,17 @@
(blue :double)
(alpha :double))
-(define-foreign-type rgba-cffi ()
+(define-foreign-type rgba-cffi (freeable)
()
- (:actual-type :pointer)
+ (:actual-type rgba-struct)
(: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-free :void (color :pointer))
+
+(defmethod free-ptr ((class rgba-cffi) ptr)
+ (gdk-rgba-free ptr))
(defmethod translate-to-foreign (value (type rgba-cffi))
(if (pointerp value) value
@@ -50,7 +63,9 @@
color-st)))
(defmethod translate-from-foreign (ptr (type rgba-cffi))
- (gdk-rgba-to-string ptr))
+ (prog1
+ (gdk-rgba-to-string ptr)
+ (free-if-needed type ptr)))
(defmethod free-translated-object (value (name rgba-cffi) param)
(foreign-free value))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2011/09/16 17:58:33 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2011/09/18 18:10:47 1.4
@@ -3,6 +3,7 @@
(:export
#:font
#:tab-array
+ #:language
#:alignment
#:ellipsize-mode
#:stretch
@@ -25,10 +26,15 @@
(defcfun pango-font-description-free :void (font :pointer))
-(define-foreign-type font ()
+(define-foreign-type font (freeable)
()
- (:actual-type :pointer)
- (:simple-parser font))
+ (:actual-type :pointer))
+
+(defmethod free-ptr ((type font) ptr)
+ (pango-font-description-free ptr))
+
+(define-parse-method font (&key free)
+ (make-instance 'font :free free))
(defmethod translate-to-foreign (value (type font))
(string->pango-font value))
@@ -37,10 +43,11 @@
(declare (ignore param))
(pango-font-description-free value))
-(defmethod translate-from-foreign (ptr (name font))
- (prog1
- (pango-font->string ptr)
- (pango-font-description-free ptr)))
+(defmethod translate-from-foreign (ptr (type font))
+ (unless (null-pointer-p ptr)
+ (prog1
+ (pango-font->string ptr)
+ (free-if-needed type ptr))))
(defcenum alignment
:left :center :right)
@@ -74,10 +81,12 @@
(defcenum direction
:ltr :rtl :ttb-ltr :ttb-rtl :weak-ltr :weak-rtl :neutral)
-(define-foreign-type tab-array ()
+(define-foreign-type tab-array (freeable)
()
- (:actual-type :pointer)
- (:simple-parser tab-array))
+ (:actual-type :pointer))
+
+(define-parse-method tab-array (&key free)
+ (make-instance 'tab-array :free free))
;; We need to pass positions-in-pixels (boolean) and list of tab-stops
;; in lisp it is handy to represent as (pixels {tab-stop}*), where
@@ -94,6 +103,10 @@
(defcfun pango-tab-array-get-positions-in-pixels :boolean (tab-array :pointer))
(defcfun pango-tab-array-free :void (tab-array :pointer))
+(defmethod free-ptr ((type tab-array) ptr)
+ (pango-tab-array-free ptr))
+
+
(defmethod translate-to-foreign (value (type tab-array))
"VALUE should be (pixels {tab-stop}*)
pixels = {t = the tab positions are in pixels} or {nil = in Pango units}
@@ -113,18 +126,28 @@
(declare (ignore param))
(pango-tab-array-free value))
-(defmethod translate-from-foreign (ptr (name tab-array))
- (cons (pango-tab-array-get-positions-in-pixels ptr)
- (prog1
- (iter (for index from 0 below (pango-tab-array-get-size ptr))
- (collect
- (destructuring-bind (alignment location)
- (with-foreign-outs ((alignment 'tab-align)
- (location :int)) :ignore
+(defmethod translate-from-foreign (ptr (type tab-array))
+ (unless (null-pointer-p ptr)
+ (prog1
+ (cons (pango-tab-array-get-positions-in-pixels ptr)
+ (iter (for index from 0 below (pango-tab-array-get-size ptr))
+ (collect
+ (destructuring-bind (alignment location)
+ (with-foreign-outs ((alignment 'tab-align)
+ (location :int)) :ignore
(pango-tab-array-get-tab ptr index
alignment location))
- (if (eq alignment :left)
- location
- (cons alignment location)))))
- (pango-tab-array-free ptr))))
-
\ No newline at end of file
+ (if (eq alignment :left)
+ location
+ (cons alignment location))))))
+ (free-if-needed type ptr))))
+
+
+(defctype language :pointer)
+;; for language we don't need foreign type, because we don't need
+;; to free these pointers for languages
+(defcfun (string->language "pango_language_from_string") language
+ (str gtk-string))
+(defcfun (language->string "pango_language_to_string") gtk-string
+ (language language))
+
More information about the gtk-cffi-cvs
mailing list