[Gtk2hs-commit] gtk2hs/gtk/glib GList.chs,1.6,1.7 GObject.chs,1.5,1.6 GType.chs,1.3,1.4 GValue.chs,1.4,1.5 GValueTypes.chs,1.4,1.5

[<as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/glib
In directory sc8-pr-cvs1:/tmp/cvs-serv25460/gtk/glib

Modified Files:
	GList.chs GObject.chs GType.chs GValue.chs GValueTypes.chs 
Log Message:
Make compile with GHC
6.00. There are two major changes in the FFI which made me
separate everything that has to do with Foreign and Foreign.C into
a new file called general/FFI.hs. The file UTFCForeign.hs is now
obsolete as its string conversion functions are now in FFI.hs. The
nullForeignPtr function is also located here. All files now import
FFI instead of Foreign and UTFCForeign. The major changes are:
newForeignPtr now takes a pointer to a C function as
finalizer. Every destructor function is now defined differently
depending on whether the new GHC is used or not. In particular
there is now a function called free :: Ptr a -> IO () imported
from the Foreign library. In addition to that I defined a function
foreignFree which can be used as finalizer to a C data
structure. It is equivalent to free if GHC version <=5.04 is
used. The second change is that ForeignPtr are no longer accepted
as arguments to foreign calls. This change is mainly reflected in
c2hs, but also in some files which directly called functions.



Index: GList.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/glib/GList.chs,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- GList.chs	24 Mar 2003 23:56:39 -0000	1.6
+++ GList.chs	9 Jul 2003 22:42:44 -0000	1.7
@@ -43,7 +43,7 @@
   ) where
 
 import Monad	(liftM)
-import Foreign
+import FFI
 import Object	(makeNewObject)
 {#import Hierarchy#}
 {#import Signal#}
@@ -124,4 +124,4 @@
     makeList current (x:xs) = do
       newHead <- {#call unsafe list_prepend#} current ((castPtr.conv) x)
       makeList newHead xs
-    makeList current [] = return current
\ No newline at end of file
+    makeList current [] = return current

Index: GObject.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/glib/GObject.chs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- GObject.chs	3 Nov 2002 20:35:44 -0000	1.5
+++ GObject.chs	9 Jul 2003 22:42:44 -0000	1.6
@@ -1,3 +1,4 @@
+{-# OPTIONS -cpp #-}
 -- -*-haskell-*-
 --  GIMP Toolkit (GTK) @entry Widget GObject@
 --
@@ -38,7 +39,7 @@
   ) where
 
 
-import Foreign
+import FFI
 import LocalData(newIORef, readIORef, writeIORef)
 import Hierarchy(GObjectClass, toGObject, unGObject)
 {#import GValue#}
@@ -54,8 +55,26 @@
 
 -- decrease the reference counter of an object
 --
-objectUnref :: GObjectClass obj => Ptr obj -> IO ()
-objectUnref = {#call object_unref#} . castPtr
+#if __GLASGOW_HASKELL__>=600
+
+foreign import ccall unsafe "&g_object_unref"
+  object_unref' :: FinalizerPtr a
+
+objectUnref :: Ptr a -> FinalizerPtr a
+objectUnref _ = object_unref'
+
+#elif __GLASGOW_HASKELL__>=504
+
+foreign import ccall unsafe "g_object_unref"
+  objectUnref :: Ptr a -> IO ()
+
+#else
+
+foreign import ccall "g_object_unref" unsafe
+  objectUnref :: Ptr a -> IO ()
+
+#endif
+
 
 -- This is a convenience function to generate an object that does not
 -- derive from Object. It adds objectUnref as finalizer.
@@ -72,7 +91,15 @@
 
 {#pointer GWeakNotify#}
 
+#if __GLASGOW_HASKELL__>=600
+
+foreign import ccall "wrapper" mkDestructor :: IO () -> IO GWeakNotify
+
+#else
+
 foreign export dynamic mkDestructor :: IO () -> IO GWeakNotify
+
+#endif
 
 -- @method objectWeakref@ attach a callback that will be called after the
 -- destroy hooks have been called

Index: GType.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/glib/GType.chs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- GType.chs	3 Nov 2002 20:35:44 -0000	1.3
+++ GType.chs	9 Jul 2003 22:42:44 -0000	1.4
@@ -34,8 +34,9 @@
   ) where
 
 import Monad	(liftM)
-import Foreign
-import UTFCForeign
+import FFI
+
+import LocalData (unsafePerformIO)
 
 {# context lib="glib" prefix="g" #}
 
@@ -47,7 +48,7 @@
 -- * Internally used by Hierarchy.
 --
 typeInstanceIsA :: Ptr () -> GType -> Bool
-typeInstanceIsA obj p =
-  toBool ({#call fun unsafe g_type_check_instance_is_a#} obj p)
+typeInstanceIsA obj p = toBool $
+  unsafePerformIO ({#call unsafe g_type_check_instance_is_a#} obj p)
 
 

Index: GValue.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/glib/GValue.chs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- GValue.chs	3 Nov 2002 20:35:44 -0000	1.4
+++ GValue.chs	9 Jul 2003 22:42:44 -0000	1.5
@@ -37,8 +37,8 @@
   ) where
 
 import Monad	(liftM)
-import Foreign
-import UTFCForeign
+import FFI
+
 import GType	(GType)
 import Hierarchy(GObject)
 

Index: GValueTypes.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/glib/GValueTypes.chs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- GValueTypes.chs	3 Nov 2002 20:35:44 -0000	1.4
+++ GValueTypes.chs	9 Jul 2003 22:42:44 -0000	1.5
@@ -1,5 +1,5 @@
 -- -*-haskell-*-
---  GIMP Toolkit (GTK) @entry GValueTypes@
+--  GIMP Toolkit (GTK) GValueTypes
 --
 --  Author : Axel Simon
 --          
@@ -55,8 +55,7 @@
   ) where
 
 import Monad	(liftM)
-import Foreign
-import UTFCForeign
+import FFI
 import GObject
 {#import Hierarchy#}
 import GType	(GType)
@@ -119,7 +118,7 @@
 
 valueSetString :: GValue -> Maybe String -> IO ()
 valueSetString gv (Just str) = do
-  strPtr <- newCString str
+  strPtr <- newUTFString str
   {#call unsafe value_set_static_string#} gv strPtr
 
 valueSetString gv Nothing = 
@@ -128,14 +127,13 @@
 valueGetString :: GValue -> IO (Maybe String)
 valueGetString gv = do
   strPtr <- {#call unsafe value_get_string#} gv
-  if strPtr==nullPtr then return Nothing else liftM Just $ peekCString strPtr
+  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr
 
 -- * for some weird reason the API says that gv is a gpointer, not a GObject
+--
 valueSetObject :: GValue -> GObject -> IO ()
-valueSetObject gv obj = g_value_set_object gv obj
-
-foreign import ccall "g_value_set_object" unsafe
-  g_value_set_object :: GValue -> GObject -> IO ()
+valueSetObject gv obj = withForeignPtr (unGObject obj) $ \objPtr ->
+  {#call unsafe g_value_set_object#} gv (castPtr objPtr)
 
 valueGetObject :: GValue -> IO GObject
 valueGetObject gv = makeNewGObject mkGObject $