[Gtk2hs-commit] gtk2hs/gtk/general General.chs,1.10,1.11 IconFactory.chs,1.4,1.5 StockItems.hsc,1.8,1.9 Structs.hsc,1.19,1.20 Style.chs,1.2,1.3 UTFCForeign.hs,1.5,NONE

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

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

Modified Files:
	General.chs IconFactory.chs StockItems.hsc Structs.hsc 
	Style.chs 
Removed Files:
	UTFCForeign.hs 
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: General.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/general/General.chs,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- General.chs	27 Feb 2003 10:09:17 -0000	1.10
+++ General.chs	9 Jul 2003 22:42:44 -0000	1.11
@@ -1,3 +1,4 @@
+{-# OPTIONS -cpp #-}
 -- -*-haskell-*-
 --  GIMP Toolkit (GTK) @entry General@
 --
@@ -58,8 +59,8 @@
        hiding   (init)
 import System   (getProgName, getArgs, ExitCode(ExitSuccess, ExitFailure))
 import Monad	(liftM, mapM)
-import Foreign
-import UTFCForeign
+import FFI
+
 import LocalData(newIORef, readIORef, writeIORef)
 import Exception (ioError, Exception(ErrorCall))
 import Object	(makeNewObject)
@@ -77,7 +78,7 @@
 --getDefaultLanguage :: IO String
 --getDefaultLanguage = do
 --  strPtr <- {#call unsafe get_default_language#}
---  str <- peekCString strPtr
+--  str <- peekUTFString strPtr
 --  destruct strPtr
 --  return str
 
@@ -97,7 +98,7 @@
   args <- getArgs
   let allArgs = (prog:args)
       argc    = length allArgs
-  withMany withCString allArgs $ \addrs  ->
+  withMany withUTFString allArgs $ \addrs  ->
     withArray	       addrs   $ \argv ->
     withObject	       argv    $ \argvp ->
     withObject	       argc    $ \argcp -> do 
@@ -106,8 +107,8 @@
         argc'   <- peek argcp
         argv'   <- peek argvp
         _:addrs'  <- peekArray argc' argv'  -- drop the program name
-        mapM peekCString addrs'
-        else ioError (ErrorCall "Cannot initialize GUI.")
+        mapM peekUTFString addrs'
+        else error "Cannot initialize GUI."
 
 -- @function eventsPending@ Inquire the number of events pending on the event
 -- queue
@@ -179,11 +180,21 @@
 
 {#pointer Function#}
 
-foreign export dynamic mkHandler :: IO {#type gint#} -> IO Function
-
 {#pointer DestroyNotify#}
 
+#if __GLASGOW_HASKELL__>=600
+
+foreign import ccall "wrapper" mkHandler :: IO {#type gint#} -> IO Function
+
+foreign import ccall "wrapper" mkDestructor :: IO () -> IO DestroyNotify
+
+#else
+
+foreign export dynamic mkHandler :: IO {#type gint#} -> IO Function
+
 foreign export dynamic mkDestructor :: IO () -> IO DestroyNotify
+
+#endif
 
 type HandlerId = {#type guint#}
 

Index: IconFactory.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/general/IconFactory.chs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- IconFactory.chs	8 Nov 2002 10:39:21 -0000	1.4
+++ IconFactory.chs	9 Jul 2003 22:42:44 -0000	1.5
@@ -1,3 +1,4 @@
+{-# OPTIONS -cpp #-}
 -- -*-haskell-*-
 --  GIMP Toolkit (GTK) @entry IconFactory@
 --
@@ -73,8 +74,7 @@
   ) where
 
 import Monad	(liftM)
-import Foreign
-import UTFCForeign
+import FFI
 import GObject	(makeNewGObject)
 {#import Hierarchy#}
 {#import Signal#}
@@ -97,7 +97,7 @@
 --   default factories by iconFactoryAddDefault.
 --
 iconFactoryAdd :: IconFactory -> String -> IconSet -> IO ()
-iconFactoryAdd i stockId iconSet = withCString stockId $ \strPtr ->
+iconFactoryAdd i stockId iconSet = withUTFString stockId $ \strPtr ->
   {#call unsafe icon_factory_add#} i strPtr iconSet
 
 -- @method iconFactoryAddDefault@ Add all entries of the IconFactory to the
@@ -145,9 +145,27 @@
   isPtr <- {#call unsafe icon_set_new#}
   liftM IconSet $ newForeignPtr isPtr (icon_set_unref isPtr)
 
+#if __GLASGOW_HASKELL__>=600
+
+foreign import ccall unsafe "&gtk_icon_set_unref"
+  icon_set_unref' :: FinalizerPtr IconSet
+
+icon_set_unref :: Ptr IconSet -> FinalizerPtr IconSet
+icon_set_unref _ = icon_set_unref'
+
+#elif __GLASGOW_HASKELL__>=504
+
+foreign import ccall unsafe "gtk_icon_set_unref"
+  icon_set_unref :: Ptr IconSet -> IO ()
+
+#else
+
 foreign import ccall "gtk_icon_set_unref" unsafe
   icon_set_unref :: Ptr IconSet -> IO ()
 
+#endif
+
+
 -- @method iconSizeCheck@ Check if a given IconSize is registered.
 --
 -- * Useful if your application expects a theme to install a set with a
@@ -162,13 +180,13 @@
 --
 iconSizeRegister :: Int -> String -> Int -> IO IconSize
 iconSizeRegister height name width = liftM fromIntegral $
-  withCString name $ \strPtr -> {#call unsafe icon_size_register#} 
+  withUTFString name $ \strPtr -> {#call unsafe icon_size_register#} 
   strPtr (fromIntegral width) (fromIntegral height)
 
 -- @method iconSizeRegisterAlias@ Register an additional alias for a name.
 --
 iconSizeRegisterAlias :: IconSize -> String -> IO ()
-iconSizeRegisterAlias target alias = withCString alias $ \strPtr ->
+iconSizeRegisterAlias target alias = withUTFString alias $ \strPtr ->
   {#call unsafe icon_size_register_alias#} strPtr (fromIntegral target)
 
 -- @method iconSizeFromName@ Lookup an IconSize by name.
@@ -178,7 +196,7 @@
 --
 iconSizeFromName :: String -> IO IconSize
 iconSizeFromName name = liftM fromIntegral $
-  withCString name {#call unsafe icon_size_from_name#}
+  withUTFString name {#call unsafe icon_size_from_name#}
 
 -- @method iconSizeGetName@ Lookup the name of an IconSize.
 --
@@ -187,7 +205,7 @@
 iconSizeGetName :: IconSize -> IO (Maybe String)
 iconSizeGetName size = do
   strPtr <- {#call unsafe icon_size_get_name#} (fromIntegral size)
-  if strPtr==nullPtr then return Nothing else liftM Just $ peekCString strPtr
+  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr
 
 -- @method iconSourceGetDirection@ Retrieve the @ref data TextDirection@ of
 -- this IconSource.
@@ -208,7 +226,7 @@
 iconSourceGetFilename :: IconSource -> IO (Maybe String)
 iconSourceGetFilename is = do
   strPtr <- {#call unsafe icon_source_get_filename#} is
-  if strPtr==nullPtr then return Nothing else liftM Just $ peekCString strPtr
+  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr
 
 -- @method iconSourceGetSize@ Retrieve the @ref type IconSize@ of this
 -- IconSource.
@@ -245,9 +263,27 @@
   isPtr <- {#call unsafe icon_source_new#}
   liftM IconSource $ newForeignPtr isPtr (icon_source_free isPtr)
 
+#if __GLASGOW_HASKELL__>=600
+
+foreign import ccall unsafe "&gtk_icon_source_free"
+  icon_source_free' :: FinalizerPtr IconSource
+
+icon_source_free :: Ptr IconSource -> FinalizerPtr IconSource
+icon_source_free _ = icon_source_free'
+
+#elif __GLASGOW_HASKELL__>=504
+
+foreign import ccall unsafe "gtk_icon_source_free"
+  icon_source_free :: Ptr IconSource -> IO ()
+
+#else
+
 foreign import ccall "gtk_icon_source_free" unsafe
   icon_source_free :: Ptr IconSource -> IO ()
 
+#endif
+
+
 -- @method iconSourceSetDirection@ Mark this @ref data IconSource@ that it
 -- should only apply to the specified @ref data TextDirection@.
 --
@@ -266,7 +302,7 @@
 --
 iconSourceSetFilename :: IconSource -> FilePath -> IO ()
 iconSourceSetFilename is name = 
-  withCString name $ {#call unsafe icon_source_set_filename#} is
+  withUTFString name $ {#call unsafe icon_source_set_filename#} is
 
 -- @method iconSourceSetSize@ Set this @ref data IconSource@ to a specific
 -- size.

Index: StockItems.hsc
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/general/StockItems.hsc,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- StockItems.hsc	17 May 2003 22:57:07 -0000	1.8
+++ StockItems.hsc	9 Jul 2003 22:42:44 -0000	1.9
@@ -123,8 +123,8 @@
   ) where
 
 import Monad	(liftM)
-import Foreign
-import UTFCForeign
+import FFI
+
 import LocalData(unsafePerformIO)	-- to read CStrings lazyly
 import GList	(GSList, fromGSListRev)
 import Events	(Modifier)
@@ -161,16 +161,16 @@
 			    <- #{peek GtkStockItem, keyval} siPtr
     (transDom	:: CString) <- #{peek GtkStockItem, translation_domain} siPtr
     return $ StockItem {
-      siStockId  = unsafePerformIO $ peekCString' stockId,
-      siLabel	 = unsafePerformIO $ peekCString' label,
+      siStockId  = unsafePerformIO $ peekUTFString' stockId,
+      siLabel	 = unsafePerformIO $ peekUTFString' label,
       -- &%!?$ c2hs and hsc should agree on types
       siModifier = fromIntegral modifier, 
       siKeyval	 = fromIntegral keyval,
-      siTransDom = unsafePerformIO $ peekCString' transDom }
+      siTransDom = unsafePerformIO $ peekUTFString' transDom }
     where
-      peekCString' :: CString -> IO String
-      peekCString' strPtr | strPtr==nullPtr = return ""
-			  | otherwise	    = peekCString strPtr
+      peekUTFString' :: CString -> IO String
+      peekUTFString' strPtr | strPtr==nullPtr = return ""
+			  | otherwise	    = peekUTFString strPtr
 
   poke siPtr (StockItem {
     siStockId = stockId,
@@ -178,14 +178,14 @@
     siModifier= modifier,
     siKeyval  = keyval,
     siTransDom= transDom }) = do
-    stockIdPtr <- newCString stockId
+    stockIdPtr <- newUTFString stockId
     #{poke GtkStockItem, stock_id} siPtr stockIdPtr
-    labelPtr   <- newCString label
+    labelPtr   <- newUTFString label
     #{poke GtkStockItem, label}	   siPtr labelPtr
     #{poke GtkStockItem, modifier} siPtr 
       ((fromIntegral modifier)::#{type GdkModifierType})
     #{poke GtkStockItem, keyval}   siPtr ((fromIntegral keyval)::#{type guint})
-    transDomPtr<- newCString transDom
+    transDomPtr<- newUTFString transDom
     #{poke GtkStockItem, translation_domain} siPtr transDomPtr
 
 
@@ -202,21 +202,15 @@
   pokeArray aPtr sis
   stock_add aPtr (fromIntegral items)
 
-foreign import ccall "gtk_stock_add" unsafe 
-  stock_add :: Ptr StockItem -> #{type guint} -> IO ()
-
 -- @method stockLookupItem@ Lookup an item in stock.
 --
 stockLookupItem :: StockId -> IO (Maybe StockItem)
 stockLookupItem stockId = 
   alloca $ \siPtr ->
-  withCString stockId $ \strPtr -> do
+  withUTFString stockId $ \strPtr -> do
   res <- stock_lookup strPtr siPtr
   if (toBool res) then liftM Just $ peek siPtr else return Nothing
 
-foreign import ccall "gtk_stock_lookup" unsafe
-  stock_lookup :: CString -> Ptr StockItem -> IO #type gboolean
-
 -- @function stockListIds@ Produce a list of all known stock identifiers.
 --
 -- * Retrieve a list of all known stock identifiers. These can either be
@@ -229,16 +223,39 @@
 stockListIds = do
   lPtr <- stock_list_ids
   sPtrs <- fromGSListRev lPtr
-  res <- mapM peekCString sPtrs
+  res <- mapM peekUTFString sPtrs
   mapM_ g_free sPtrs
   return res
 
+#if __GLASGOW_HASKELL__>=600
+
+foreign import ccall unsafe "gtk_stock_add"
+  stock_add :: Ptr StockItem -> #{type guint} -> IO ()
+
+foreign import ccall unsafe "gtk_stock_lookup"
+  stock_lookup :: CString -> Ptr StockItem -> IO #type gboolean
+
+foreign import ccall unsafe "gtk_stock_list_ids"
+  stock_list_ids :: IO GSList
+
+foreign import ccall unsafe "g_free"
+  g_free :: Ptr a -> IO ()
+
+#else
+
+foreign import ccall "gtk_stock_add" unsafe 
+  stock_add :: Ptr StockItem -> #{type guint} -> IO ()
+
+foreign import ccall "gtk_stock_lookup" unsafe
+  stock_lookup :: CString -> Ptr StockItem -> IO #type gboolean
+
 foreign import ccall "gtk_stock_list_ids" unsafe
   stock_list_ids :: IO GSList
 
 foreign import ccall "g_free" unsafe
   g_free :: Ptr a -> IO ()
 
+#endif
 -- @constant stockAdd@ Standard icon and menu entry.
 -- @constant stockApply@ Standard icon and menu entry.
 -- @constant stockBold@ Standard icon and menu entry.

Index: Structs.hsc
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/general/Structs.hsc,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- Structs.hsc	17 May 2003 19:29:38 -0000	1.19
+++ Structs.hsc	9 Jul 2003 22:42:44 -0000	1.20
@@ -33,6 +33,7 @@
   Rectangle(..),
   Color(..),
   GCValues(..),
+#if __GLASGOW_HASKELL__<600
   foreground,
   background,
   function,
@@ -50,6 +51,7 @@
   lineStyle,
   capStyle,
   joinStyle,
+#endif
   pokeGCValues,
   newGCValues,
   widgetGetState,
@@ -84,7 +86,6 @@
   priorityLow,
   priorityDefault,
   priorityHigh,
-  nullForeignPtr,
   drawingAreaGetDrawWindow,
   drawingAreaGetSize,
   pangoScale,
@@ -101,10 +102,9 @@
   ) where
 
 import Monad		(liftM)
-import Foreign
-import UTFCForeign
-import LocalData	(unsafePerformIO,	-- for nullForeignPtr
-			testBit)
+import FFI
+
+import LocalData	(testBit)
 import Object		(makeNewObject)
 import GObject		(makeNewGObject)
 import Hierarchy
@@ -167,12 +167,23 @@
     gdkColormapAllocColor cPtr ptr 0 1
     return ()
 
+#if __GLASGOW_HASKELL__>=504
+
+foreign import ccall unsafe "gdk_colormap_get_system"
+  gdkColormapGetSystem :: IO (Ptr ())
+
+foreign import ccall unsafe "gdk_colormap_alloc_color"
+  gdkColormapAllocColor :: Ptr () -> Ptr Color -> CInt -> CInt -> IO CInt
+
+#else
+
 foreign import ccall "gdk_colormap_get_system" unsafe
   gdkColormapGetSystem :: IO (Ptr ())
 
 foreign import ccall "gdk_colormap_alloc_color" unsafe
   gdkColormapAllocColor :: Ptr () -> Ptr Color -> CInt -> CInt -> IO CInt
 
+#endif
 
 -- @entry GC@
 
@@ -625,11 +636,6 @@
 priorityLow	= #const G_PRIORITY_LOW
 
 
--- helper function: nullForeignPtr
--- this must be a performance hit
-nullForeignPtr :: ForeignPtr a
-nullForeignPtr = unsafePerformIO $ newForeignPtr nullPtr (return ())
-
 -- @entry Widget FileSelection@
 
 -- @method fileSelectionGetButtons@ Extract the buttons of a fileselection.
@@ -804,6 +810,6 @@
     (domain  :: GQuark)		<- #{peek GError, domain} ptr
     (code    :: #{type gint})	<- #{peek GError, code} ptr
     (msgPtr  :: CString)	<- #{peek GError, message} ptr
-    msg <- peekCString msgPtr
+    msg <- peekUTFString msgPtr
     return $ GError domain code msg
   poke _ = error "GError::poke: not implemented"

Index: Style.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/general/Style.chs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Style.chs	16 May 2003 22:25:16 -0000	1.2
+++ Style.chs	9 Jul 2003 22:42:44 -0000	1.3
@@ -62,8 +62,8 @@
   ) where
 
 import Monad		(liftM)
-import Foreign
-import UTFCForeign
+import FFI
+
 {#import GObject#}	(makeNewGObject)
 {#import Hierarchy#}
 import Enums		(StateType)

--- UTFCForeign.hs DELETED ---