[Gtk2hs-commit] gtk2hs/gtk/gdk Drawable.chs,1.6,1.7 Events.hsc,1.4,1.5 GC.chs,1.2,1.3 Keys.chs,1.1,1.2 Pixbuf.chs,1.4,1.5 Region.chs,1.2,1.3

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

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

Modified Files:
	Drawable.chs Events.hsc GC.chs Keys.chs Pixbuf.chs Region.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: Drawable.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/gdk/Drawable.chs,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- Drawable.chs	3 Jul 2003 05:19:36 -0000	1.6
+++ Drawable.chs	9 Jul 2003 22:42:44 -0000	1.7
@@ -69,8 +69,8 @@
   drawDrawable) where
 
 import Monad	(liftM)
-import Foreign
-import UTFCForeign
+import FFI
+
 import GObject	(makeNewGObject)
 import Structs  (Point)
 {#import Hierarchy#}
@@ -282,7 +282,7 @@
 drawLayoutLineWithColors d gc x y text foreground background = let
     withMB :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
     withMB Nothing f = f nullPtr
-    withMB (Just x) f = with' x f
+    withMB (Just x) f = with x f
   in
     withMB foreground $ \fPtr -> withMB background $ \bPtr ->
     {#call unsafe draw_layout_line_with_colors#} (toDrawable d) (toGC gc)
@@ -313,7 +313,7 @@
 drawLayoutWithColors d gc x y text foreground background = let
     withMB :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
     withMB Nothing f = f nullPtr
-    withMB (Just x) f = with' x f
+    withMB (Just x) f = with x f
   in
     withMB foreground $ \fPtr -> withMB background $ \bPtr ->
     {#call unsafe draw_layout_with_colors#} (toDrawable d) (toGC gc)

Index: Events.hsc
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/gdk/Events.hsc,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- Events.hsc	21 Mar 2003 10:52:24 -0000	1.4
+++ Events.hsc	9 Jul 2003 22:42:44 -0000	1.5
@@ -43,6 +43,7 @@
   hasButMiddle,
   Event(..),		-- information in event callbacks from Gdk
   -- selector functions
+#if __GLASGOW_HASKELL__<600
   sent,			-- True if this is event does not come from user input
   area,			-- Rectangle which is to be exposed, etc.
   count,		-- number of upcoming events
@@ -62,7 +63,7 @@
   width, height,	-- new size of a widget
   visible,		-- state of visibility
   wMask, wState,	-- new (?possible? and) real state of a window
-
+#endif
   marshalEvent,		-- convert a pointer to an event data structure
   -- used data structures
   VisibilityState(..),
@@ -76,8 +77,8 @@
   ) where
 
 
-import UTFCForeign
-import Foreign
+
+import FFI
 import LocalData((.&.))
 import GdkEnums	(VisibilityState(..),
 		 CrossingMode(..),
@@ -273,7 +274,7 @@
   (modif_  ::#type guint)	<- #{peek GdkEventKey, state} ptr
   (keyval_ ::#type guint)	<- #{peek GdkEventKey, keyval} ptr
   (string_ ::CString)		<- #{peek GdkEventKey, string} ptr
-  str_				<- peekCString string_
+  str_				<- peekUTFString string_
   (length_ ::#type gint)	<- #{peek GdkEventKey, length} ptr
   return $ Key {
     release = up,

Index: GC.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/gdk/GC.chs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- GC.chs	8 Nov 2002 10:39:21 -0000	1.2
+++ GC.chs	9 Jul 2003 22:42:44 -0000	1.3
@@ -35,7 +35,7 @@
   GCClass,
   castToGC,
   gcNew,
-  GCValues(..),
+  GCValues(GCValues),
   newGCValues,
   Color(..),
   foreground,
@@ -71,14 +71,14 @@
 import Monad	(liftM, when)
 import Maybe	(fromJust, isJust)
 import Exception(handle)
-import Foreign
-import UTFCForeign
+import FFI
+
 import GObject	(makeNewGObject)
 {#import Hierarchy#}
 import Structs
 import Enums	(Function(..), Fill(..), SubwindowMode(..), LineStyle(..), 
 		 CapStyle(..), JoinStyle(..))
-{#import Region#}	(Region)
+{#import Region#}	(Region(Region))
 
 {# context lib="gtk" prefix="gdk" #}
 

Index: Keys.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/gdk/Keys.chs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Keys.chs	6 Oct 2002 16:14:08 -0000	1.1
+++ Keys.chs	9 Jul 2003 22:42:44 -0000	1.2
@@ -34,17 +34,17 @@
   keyvalFromName
   ) where
 
-import UTFCForeign
-import Foreign
+
+import FFI
 import LocalData(unsafePerformIO)
 
 {#context lib="libgdk" prefix ="gdk"#}
 
 {#fun pure keyval_name as ^ {fromIntegral `Integer'} -> `Maybe String'
-    maybePeekCString#}
+    maybePeekUTFString#}
   where
-  maybePeekCString = unsafePerformIO . (maybePeek peekCString)
---   maybePeekCString = maybePeek peekCString
+  maybePeekUTFString = unsafePerformIO . (maybePeek peekCString)
+--   maybePeekUTFString = maybePeek peekCString
 
 {#fun pure keyval_from_name as ^ {`String'} -> `Integer' fromIntegral#}
 

Index: Pixbuf.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/gdk/Pixbuf.chs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- Pixbuf.chs	19 May 2003 17:53:26 -0000	1.4
+++ Pixbuf.chs	9 Jul 2003 22:42:44 -0000	1.5
@@ -83,12 +83,12 @@
   pixbufGetFromDrawable
   ) where
 
-import Foreign
+import FFI
 {#import Hierarchy#}
 import GObject
 import Monad
-import UTFCForeign
-import Structs		(GError(..), GQuark, nullForeignPtr, Rectangle(..))
+
+import Structs		(GError(..), GQuark, Rectangle(..))
 import LocalData	(unsafePerformIO)
 import Exception	(bracket)
 import LocalData	((.|.), shiftL)
@@ -162,10 +162,10 @@
 --   this image was saved.
 --
 pixbufGetOption :: Pixbuf -> String -> IO (Maybe String)
-pixbufGetOption pb key = withCString key $ \strPtr -> do
+pixbufGetOption pb key = withUTFString key $ \strPtr -> do
   resPtr <- {#call unsafe pixbuf_get_option#} pb strPtr
   if (resPtr==nullPtr) then return Nothing else
-    liftM Just $ peekCString resPtr
+    liftM Just $ peekUTFString resPtr
 
 -- pixbufErrorDomain -- helper function
 pixbufErrorDomain :: GQuark
@@ -181,7 +181,7 @@
 --   those in @ref data PixbufError@, an exception is thrown.
 --
 pixbufNewFromFile :: FilePath -> IO (Either (PixbufError,String) Pixbuf)
-pixbufNewFromFile fname = withCString fname $ \strPtr ->
+pixbufNewFromFile fname = withUTFString fname $ \strPtr ->
   alloca $ \errPtrPtr -> do
   pbPtr <- {#call unsafe pixbuf_new_from_file#} strPtr (castPtr errPtrPtr)
   if pbPtr/=nullPtr then liftM Right $ makeNewGObject mkPixbuf (return pbPtr)
@@ -224,13 +224,13 @@
 pixbufSave pb fname iType options =
   let (keys, values) = unzip options in
   let optLen = length keys in
-  withCString fname $ \fnPtr ->
-  withCString iType $ \tyPtr ->
+  withUTFString fname $ \fnPtr ->
+  withUTFString iType $ \tyPtr ->
   allocaArray0 optLen $ \keysPtr ->
   allocaArray optLen $ \valuesPtr ->
   alloca $ \errPtrPtr -> do
-    keyPtrs <- mapM newCString keys
-    valuePtrs <- mapM newCString values
+    keyPtrs <- mapM newUTFString keys
+    valuePtrs <- mapM newUTFString values
     pokeArray keysPtr keyPtrs
     pokeArray valuesPtr valuePtrs
     res <- {#call unsafe pixbuf_savev#} pb fnPtr tyPtr keysPtr valuesPtr
@@ -263,7 +263,7 @@
 --
 pixbufNewFromXPMData :: [String] -> IO Pixbuf
 pixbufNewFromXPMData s =
-  bracket (mapM newCString s) (mapM free) $ \strPtrs ->
+  bracket (mapM newUTFString s) (mapM free) $ \strPtrs ->
     withArray0 nullPtr strPtrs $ \strsPtr ->
       makeNewGObject mkPixbuf $ {#call pixbuf_new_from_xpm_data#} strsPtr
 
@@ -488,4 +488,4 @@
     (fromIntegral x) (fromIntegral y) 0 0
     (fromIntegral width) (fromIntegral height)
   if pbPtr==nullPtr then return Nothing else liftM Just $
-    makeNewGObject mkPixbuf (return pbPtr)
\ No newline at end of file
+    makeNewGObject mkPixbuf (return pbPtr)

Index: Region.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/gdk/Region.chs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Region.chs	3 Nov 2002 20:35:42 -0000	1.2
+++ Region.chs	9 Jul 2003 22:42:44 -0000	1.3
@@ -1,3 +1,4 @@
+{-# OPTIONS -cpp #-}
 --  -*-haskell-*-
 --  GIMP Toolkit (GTK) @entry Region@
 --
@@ -34,7 +35,7 @@
 --
 module Region(
   makeNewRegion,
-  Region,
+  Region(Region),
   regionNew,
   FillRule(..),
   regionPolygon,
@@ -56,8 +57,7 @@
   regionXor) where
 
 import Monad	(liftM)
-import Foreign
-import UTFCForeign
+import FFI
 import Structs	(Point, Rectangle(..))
 import GdkEnums (FillRule(..), OverlapType(..))
 
@@ -69,11 +69,29 @@
 --
 makeNewRegion :: Ptr Region -> IO Region
 makeNewRegion rPtr = do
-  region <- newForeignPtr rPtr (regionDestroy rPtr)
+  region <- newForeignPtr rPtr (region_destroy rPtr)
   return (Region region)
 
+#if __GLASGOW_HASKELL__>=600
+
+foreign import ccall unsafe "&gdk_region_destroy"
+  region_destroy' :: FinalizerPtr Region
+
+region_destroy :: Ptr Region -> FinalizerPtr Region
+region_destroy _ = region_destroy'
+
+#elif __GLASGOW_HASKELL__>=504
+
+foreign import ccall unsafe "gdk_region_destroy"
+  region_destroy :: Ptr Region -> IO ()
+
+#else
+
 foreign import ccall "gdk_region_destroy" unsafe
-  regionDestroy :: Ptr Region -> IO ()
+  region_destroy :: Ptr Region -> IO ()
+
+#endif
+
 
 -- @constructor regionNew@ Create an empty region.
 --