[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-serv31071/gdk

Modified Files:
	color.lisp loadlib.lisp package.lisp pango.lisp rectangle.lisp 
Log Message:
Refactored freeable
Added loadlib to gio
Fixed compilation without loading



--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp	2011/09/18 18:10:47	1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp	2012/01/25 19:15:08	1.4
@@ -26,12 +26,7 @@
       color-st)))
 
 (defmethod translate-from-foreign (ptr (type color-cffi))
-  (prog1
-      (gdk-color-to-string ptr)
-    (free-if-needed type ptr)))
-
-(defmethod free-translated-object (value (name color-cffi) param)
-  (foreign-free value))
+  (gdk-color-to-string ptr))
 
 (defcfun (color-equal "gdk_color_equal") :boolean 
   (color pcolor) (color2 pcolor))
@@ -63,9 +58,4 @@
       color-st)))
 
 (defmethod translate-from-foreign (ptr (type rgba-cffi))
-  (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
+  (gdk-rgba-to-string ptr))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/loadlib.lisp	2011/08/26 17:16:14	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/loadlib.lisp	2012/01/25 19:15:08	1.3
@@ -7,9 +7,10 @@
 
 (in-package :gdk-cffi)
 
-(define-foreign-library :gdk
-  (:unix "libgdk-3.so.0")
-  (:windows "libgdk-win32-3xs-0.dll"))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (define-foreign-library :gdk
+    (:unix "libgdk-3.so.0")
+    (:windows "libgdk-win32-3xs-0.dll"))
 
-(load-foreign-library :gdk)
+  (load-foreign-library :gdk))
 
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp	2011/09/21 12:03:47	1.6
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp	2012/01/25 19:15:08	1.7
@@ -71,3 +71,4 @@
 
 (in-package #:gdk-cffi)
 (register-package "Gdk" *package*)
+(register-package *package* 'gdk)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp	2011/09/18 18:10:47	1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp	2012/01/25 19:15:08	1.5
@@ -28,26 +28,18 @@
 
 (define-foreign-type font (freeable)
   ()
-  (:actual-type :pointer))
+  (:actual-type :pointer)
+  (:simple-parser font))
 
 (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))
 
-(defmethod free-translated-object (value (type font) param)
-  (declare (ignore param))
-  (pango-font-description-free value))
-
 (defmethod translate-from-foreign (ptr (type font))
   (unless (null-pointer-p ptr)
-    (prog1
-        (pango-font->string ptr)
-      (free-if-needed type ptr))))
+    (pango-font->string ptr)))
 
 (defcenum alignment
   :left :center :right)
@@ -122,25 +114,23 @@
             (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 free-translated-object (value (type tab-array) param)
+;  (declare (ignore param))
+;  (pango-tab-array-free value))
 
 (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))))))
-      (free-if-needed type ptr))))
+    (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))))))))
 
 
 (defctype language :pointer)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/rectangle.lisp	2011/09/10 16:26:10	1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/rectangle.lisp	2012/01/25 19:15:08	1.4
@@ -8,7 +8,7 @@
 
 (defcstruct-accessors (rectangle . cairo_rectangle_t))
 
-(defcfun  gdk-rectangle-intersect :boolean
+(defcfun gdk-rectangle-intersect :boolean
   (src1 (struct rectangle)) (src2 (struct rectangle)) 
   (dest (struct rectangle :out t)))