[gtk-cffi-cvs] CVS gtk-cffi/gdk

[CVS User rklochkov]

Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk
In directory tiger.common-lisp.net:/tmp/cvs-serv8326/gdk

Modified Files:
	pango.lisp 
Log Message:
Added PangoTabArray cffi foreign type
Fixed cffi-struct in array issues
Added pack of slots to GtkTextView


--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp	2011/09/15 10:28:20	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp	2011/09/16 17:58:33	1.3
@@ -1,7 +1,8 @@
 (defpackage #:pango-cffi
-  (:use #:common-lisp #:cffi-object #:cffi)
+  (:use #:common-lisp #:cffi-object #:cffi #:iterate)
   (:export
    #:font
+   #:tab-array
    #:alignment
    #:ellipsize-mode
    #:stretch
@@ -16,22 +17,30 @@
 (g-object-cffi:register-package "Pango" *package*)
 
 
-(defcfun ("pango_font_description_from_string" pango-font)
+(defcfun ("pango_font_description_from_string" string->pango-font)
   :pointer (str gtk-string))
 
-(defcfun ("pango_font_description_to_string" str-pango-font)
+(defcfun ("pango_font_description_to_string" pango-font->string)
   gtk-string (font :pointer))
 
+(defcfun pango-font-description-free :void (font :pointer))
+
 (define-foreign-type font ()
   ()
   (:actual-type :pointer)
   (:simple-parser font))
 
 (defmethod translate-to-foreign (value (type font))
-  (pango-font value))
+  (string->pango-font value))
+
+(defmethod free-translated-object (value (type font) param)
+  (declare (ignore param))
+  (pango-font-description-free value))
 
 (defmethod translate-from-foreign (ptr (name font))
-  (str-pango-font ptr))
+  (prog1
+      (pango-font->string ptr)
+    (pango-font-description-free ptr)))
 
 (defcenum alignment
   :left :center :right)
@@ -64,3 +73,58 @@
 
 (defcenum direction
   :ltr :rtl :ttb-ltr :ttb-rtl :weak-ltr :weak-rtl :neutral)
+
+(define-foreign-type tab-array ()
+  ()
+  (:actual-type :pointer)
+  (:simple-parser tab-array))
+
+;; 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
+;; pixels is t or nil and tab-stop is a fixnum
+
+(defcenum tab-align :left)
+
+(defcfun pango-tab-array-new :pointer (size :int) (pixels :boolean))
+(defcfun pango-tab-array-set-tab :void
+  (tab-array :pointer) (index :int) (alignment tab-align) (location :int))
+(defcfun pango-tab-array-get-size :int (tab-array :pointer))
+(defcfun pango-tab-array-get-tab :void
+  (tab-array :pointer) (index :int) (alignment :pointer) (location :pointer))
+(defcfun pango-tab-array-get-positions-in-pixels :boolean (tab-array :pointer))
+(defcfun pango-tab-array-free :void (tab-array :pointer))
+
+(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}
+tab-stop = fixnum or (align . location), where location is fixnum
+           and align is a tab-align"
+  (let* ((l (length (cdr value)))
+         (res (pango-tab-array-new (car value) l)))
+    (iter (for tab-stop in (cdr value))
+          (for index from 0 to l)
+          (etypecase tab-stop
+            (cons (pango-tab-array-set-tab res index 
+                                           (car tab-stop) (cdr tab-stop)))
+            (fixnum (pango-tab-array-set-tab res index 0 tab-stop))))
+    res))
+
+(defmethod free-translated-object (value (type tab-array) param)
+  (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
+                              (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