[Gtk2hs-commit] gtk2hs/tools/apiGen StringUtils.hs,1.2,1.3 Template.chs,1.8,1.9 ApiGen.hs,1.17,1.18 CodeGen.hs,1.9,1.10 FormatDocs.hs,1.7,1.8 Api.hs,1.3,1.4 Marshal.hs,1.6,1.7 MarshalFixup.hs,1.2,1.3

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5321/tools/apiGen

Modified Files:
	StringUtils.hs Template.chs ApiGen.hs CodeGen.hs FormatDocs.hs 
	Api.hs Marshal.hs MarshalFixup.hs 
Log Message:
More code generator improvements:

Preserve import declerations from original modules.
Produce properties using exisiting bound getter/setter methods in cases where
	that makes sense.
Add "implements interface" feature where gobject classes that implement
	'GInterface's get modeled as Haskell class instance declerations.
Change the name of the "Description" section to "Detail" so that the Haddock
	documentation does not have two "Description" sections which is
	probably confusing.
Various other minor changes and code refactoring.


Index: Template.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Template.chs,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- Template.chs	25 Feb 2005 01:32:11 -0000	1.8
+++ Template.chs	27 Feb 2005 20:02:14 -0000	1.9
@@ -31,10 +31,8 @@
 @EXPORTS@
   ) where
 
-import Monad	(liftM)
-
-import System.Glib.FFI
 @IMPORTS@
+
 {# context lib="@CONTEXT_LIB@" prefix="@CONTEXT_PREFIX@" #}
 
 @MODULE_BODY@

Index: Marshal.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Marshal.hs,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- Marshal.hs	23 Feb 2005 14:12:35 -0000	1.6
+++ Marshal.hs	27 Feb 2005 20:02:16 -0000	1.7
@@ -3,10 +3,6 @@
   CSymbol(..),
   ObjectKind(..),
   EnumKind(..),
-  stripKnownPrefixes,
-  knownMiscType,
-  maybeNullParameter,
-  maybeNullResult,
   genMarshalParameter,
   genMarshalResult,
   genMarshalProperty,
@@ -147,7 +143,7 @@
 genMarshalParameter knownSymbols _ name typeName
             | isUpper (head typeName)
            && symbolIsFlags typeKind =
-	(Nothing, Just shortTypeName,
+	(Nothing, Just ("[" ++ shortTypeName ++ "]"),
 	\body -> body.
                  indent 2. ss "((fromIntegral . fromFlags) ". ss name. ss ")")
   where shortTypeName = stripKnownPrefixes typeName
@@ -183,26 +179,26 @@
 	String -> 	--C type decleration for the return value we will marshal
 	(String,	--Haskell return type 
 	ShowS -> ShowS)	--marshaling code (\body -> ... body ...)
-genMarshalResult _ _ "gboolean" = ("IO Bool", \body -> ss "liftM toBool $". indent 1. body)
-genMarshalResult _ _ "gint"     = ("IO Int",  \body -> ss "liftM fromIntegral $". indent 1. body)
-genMarshalResult _ _ "guint"    = ("IO Int",  \body -> ss "liftM fromIntegral $". indent 1. body)
-genMarshalResult _ _ "gdouble"  = ("IO Double", \body -> ss "liftM realToFrac $". indent 1. body)
-genMarshalResult _ _ "gfloat"   = ("IO Float",  \body -> ss "liftM realToFrac $". indent 1. body)
-genMarshalResult _ _ "void"     = ("IO ()", id)
+genMarshalResult _ _ "gboolean" = ("Bool", \body -> ss "liftM toBool $". indent 1. body)
+genMarshalResult _ _ "gint"     = ("Int",  \body -> ss "liftM fromIntegral $". indent 1. body)
+genMarshalResult _ _ "guint"    = ("Int",  \body -> ss "liftM fromIntegral $". indent 1. body)
+genMarshalResult _ _ "gdouble"  = ("Double", \body -> ss "liftM realToFrac $". indent 1. body)
+genMarshalResult _ _ "gfloat"   = ("Float",  \body -> ss "liftM realToFrac $". indent 1. body)
+genMarshalResult _ _ "void"     = ("()", id)
 genMarshalResult _ funcName "const-gchar*" =
   if maybeNullResult funcName
-    then ("IO (Maybe String)",
+    then ("(Maybe String)",
          \body -> body.
                   indent 1. ss  ">>= maybePeek peekUTFString")
-    else ("IO String",
+    else ("String",
          \body -> body.
                   indent 1. ss  ">>= peekUTFString")
 genMarshalResult _ funcName "gchar*" =
   if maybeNullResult funcName
-    then ("IO (Maybe String)",
+    then ("(Maybe String)",
          \body -> body.
                   indent 1. ss  ">>= maybePeek readUTFString")
-    else ("IO String",
+    else ("String",
          \body -> body.
                   indent 1. ss  ">>= readUTFString")
 genMarshalResult _ _ "const-GSList*" =
@@ -227,10 +223,10 @@
            && last typeName /= '*'
            && symbolIsObject typeKind =
   if maybeNullResult funcName
-    then ("IO (Maybe " ++ shortTypeName ++ ")",
+    then ("(Maybe " ++ shortTypeName ++ ")",
          \body -> ss "maybeNull (" .ss constructor. ss " mk". ss shortTypeName. ss ") $".
                   indent 1. body)
-    else ("IO " ++ shortTypeName,
+    else (shortTypeName,
          \body -> ss constructor. ss " mk". ss shortTypeName. ss " $".
                   indent 1. body)
   where typeName = init typeName'
@@ -242,7 +238,7 @@
 genMarshalResult knownSymbols _ typeName
             | isUpper (head typeName)
            && symbolIsEnum typeKind =
-  ("IO " ++ shortTypeName,
+  (shortTypeName,
   \body -> ss "liftM (toEnum . fromIntegral) $".
            indent 1. body)
   where shortTypeName = stripKnownPrefixes typeName
@@ -251,7 +247,7 @@
 genMarshalResult knownSymbols _ typeName
             | isUpper (head typeName)
            && symbolIsFlags typeKind =
-  ("IO " ++ shortTypeName,
+  ("[" ++ shortTypeName ++ "]",
   \body -> ss "liftM (toFlags . fromIntegral) $".
            indent 1. body)
   where shortTypeName = stripKnownPrefixes typeName

Index: CodeGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- CodeGen.hs	25 Feb 2005 01:32:11 -0000	1.9
+++ CodeGen.hs	27 Feb 2005 20:02:16 -0000	1.10
@@ -1,6 +1,7 @@
 module CodeGen (
   genModuleBody,
   genExports,
+  genImports,
   genTodoItems,
   makeKnownSymbolsMap,
   mungeMethodInfo
@@ -12,9 +13,10 @@
 import Marshal
 import StringUtils
 import ModuleScan
+import MarshalFixup (stripKnownPrefixes, maybeNullParameter, maybeNullResult, fixCFunctionName)
 
 import Prelude hiding (Enum, lines)
-import List   (groupBy, sortBy, isPrefixOf, isSuffixOf)
+import List   (groupBy, sortBy, isPrefixOf, isSuffixOf, partition, find)
 import Maybe  (isNothing)
 import Data.FiniteMap
 
@@ -48,7 +50,7 @@
         formattedParamNames = cat (map (\name -> ss name.sc ' ') paramNames)
 	(returnType', returnMarshaler) =
 		genMarshalResult knownSymbols (method_cname method) (method_return_type method)
-        returnType = (returnType', lookup "Returns" paramDocMap)
+        returnType = ("IO " ++ returnType', lookup "Returns" paramDocMap)
 	functionType = (case classConstraints of
 	                  []  -> id
 			  [c] -> ss c. ss " => "
@@ -60,10 +62,7 @@
         safety = case info of
                   Nothing -> False
                   Just info -> methodinfo_unsafe info
-        formattedDoc = case doc of
-          Nothing  -> ss "-- | \n-- \n"
-          Just doc -> ss "-- | ". haddocFormatParas knownSymbols docNullsAllFixed (funcdoc_paragraphs doc). nl.
-                      ss "--\n"
+        formattedDoc = haddocFormatDeclaration knownSymbols docNullsAllFixed funcdoc_paragraphs doc
         docNullsAllFixed = maybeNullResult (method_cname method)
                         || or [ maybeNullParameter (method_cname method) (parameter_name p)
                               | p <- method_parameters method ]
@@ -109,7 +108,9 @@
 genModuleBody :: KnownSymbols -> Object -> ModuleDoc -> ModuleInfo -> ShowS
 genModuleBody knownSymbols object apiDoc modInfo =
   doVersionIfDefs (sepBy' "\n\n") $
-     sectionHeader "Constructors"
+     sectionHeader "Interfaces"
+     (genImplements object)
+  ++ sectionHeader "Constructors"
      (genConstructors knownSymbols object (moduledoc_functions apiDoc) (module_methods modInfo))
   ++ sectionHeader "Methods"
      (genMethods      knownSymbols object (moduledoc_functions apiDoc) (module_methods modInfo))
@@ -218,26 +219,108 @@
 
 genProperties :: KnownSymbols -> Object -> [PropDoc] -> [(ShowS, (Since, Deprecated))]
 genProperties knownSymbols object apiDoc = 
-  [ (genProperty knownSymbols object property doc, (maybe "" propdoc_since doc, notDeprecated))
-  | (property, doc) <- properties object apiDoc ]
+  map snd $
+  sortBy (comparing fst) $    --sort into the order as they appear in the gtk-docs
 
-genProperty :: KnownSymbols -> Object -> Property -> Maybe PropDoc -> ShowS
-genProperty knownSymbols object property doc = 
+    [ (0
+      ,let doc = extraPropDocumentation getter setter in
+       (genAtterFromGetterSetter knownSymbols object getter setter (Just doc)
+      ,(propdoc_since doc, notDeprecated)))
+    | (getter, setter) <- extraProps ]
+
+ ++ [ (index
+      ,(genAtterFromGetterSetter knownSymbols object getter setter doc
+      ,(maybe "" propdoc_since doc, notDeprecated)))
+    | (((_, doc), index), (getter, setter)) <- directProps ]
+
+ ++ [ (index
+      ,(genAtterFromProperty knownSymbols object property doc
+      ,(maybe "" propdoc_since doc, notDeprecated)))
+    | ((property, doc), index) <- genericProps ]
+
+  where (genericProps, -- existing GObject properties with generic implementation
+         directProps,  -- existing GObject properties but with direct implementation
+         extraProps)   -- extra properties with direct implementation
+          = mergeBy (\((prop,_), _) (method, _) ->
+                      property_name prop `compare` drop 3 (method_name method))
+                    (sortBy (comparing (property_name.fst.fst)) (zip (properties object apiDoc) [1..]))
+                    (sortBy (comparing (method_name.fst)) (methodsThatLookLikeProperties object))
+
+extraPropDocumentation :: Method -> Method -> PropDoc
+extraPropDocumentation getter setter =
+  let propertyName = lowerCaseFirstChar (drop 3 (method_name getter)) in
+  PropDoc {
+    propdoc_name = "",
+    propdoc_paragraphs = [DocParaText
+                           [DocText ("'" ++ propertyName ++ "' property. See ")
+                           ,DocFuncXRef (method_cname getter)
+                           ,DocText " and "
+                           ,DocFuncXRef (method_cname setter)]],
+    propdoc_since = ""
+  }
+
+genAtter :: KnownSymbols -> Object -> Maybe PropDoc -> String -> String -> String -> String -> ShowS
+genAtter knownSymbols object doc propertyName propertyType getter setter = 
   formattedDoc.
   ss propertyName. ss " :: Attr ". objectType. sc ' '. ss propertyType. nl.
   ss propertyName. ss " = Attr ". 
-  indent 1. getter.
-  indent 1. setter
+  indent 1. ss getter.
+  indent 1. ss setter
   where objectType = ss (object_name object)
-        propertyName = lowerCaseFirstChar (property_name property)
+        formattedDoc = haddocFormatDeclaration knownSymbols False propdoc_paragraphs doc
+
+genAtterFromProperty :: KnownSymbols -> Object -> Property -> Maybe PropDoc -> ShowS
+genAtterFromProperty knownSymbols object property doc = 
+  genAtter knownSymbols object doc propertyName propertyType (getter "") (setter "")
+
+  where propertyName = lowerCaseFirstChar (property_name property)
+        (propertyType, gvalueConstructor) = genMarshalProperty knownSymbols (property_type property)
         getter = ss "(\\obj -> do ". ss gvalueConstructor. ss " result <- objectGetProperty \"". ss (property_cname property). ss "\"".
                  indent 7. ss "return result)"
         setter = ss "(\\obj val -> objectSetProperty obj \"". ss (property_cname property). ss "\" (". ss gvalueConstructor. ss " val))"
-        formattedDoc = case doc of
-          Nothing  -> ss "-- | \n-- \n"
-          Just doc -> ss "-- | ". haddocFormatParas knownSymbols False (propdoc_paragraphs doc). nl.
-                      ss "--\n"
-        (propertyType, gvalueConstructor) = genMarshalProperty knownSymbols (property_type property)
+
+genAtterFromGetterSetter :: KnownSymbols -> Object -> Method -> Method -> Maybe PropDoc -> ShowS
+genAtterFromGetterSetter knownSymbols object getterMethod setterMethod doc = 
+  genAtter knownSymbols object doc propertyName propertyType getter setter
+
+  where --propertyName = cFuncNameToHsPropName (method_cname getterMethod)
+        propertyName = lowerCaseFirstChar (drop 3 (method_name getterMethod))
+        (propertyType, _) = genMarshalResult knownSymbols (method_cname getterMethod)
+                              (method_return_type getterMethod)
+        getter = cFuncNameToHsName (method_cname getterMethod)
+        setter = cFuncNameToHsName (method_cname setterMethod)
+--        cFuncNameToHsPropName =
+--            lowerCaseFirstChar
+--          . concatMap upperCaseFirstChar
+--          . map fixCFunctionName
+--          . tail
+--          . dropWhile (/="get")
+--          . filter (not.null)
+--          . splitBy '_'
+
+methodsThatLookLikeProperties :: Object -> [(Method, Method)]
+methodsThatLookLikeProperties object =
+  filter (uncurry checkTypes) $
+  intersectBy comparingMethodName getters setters
+  where getters = [ method
+                  | method <- object_methods object
+                  , not (method_deprecated method) 
+                  , "Get" `isPrefixOf` method_name method ]
+        setters = [ method
+                  | method <- object_methods object
+                  , not (method_deprecated method) 
+                  , "Set" `isPrefixOf` method_name method ]
+
+        comparingMethodName method1 method2 = drop 3 (method_name method1)
+                                           == drop 3 (method_name method2)
+        intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [(a,a)]
+        intersectBy eq xs ys = [ (x,y) | x <- xs, Just y <- [find (eq x) ys] ]
+        
+        checkTypes getter setter =
+            length (method_parameters getter) == 0
+         && length (method_parameters setter) == 1
+         && method_return_type setter == "void"
+--         && method_return_type getter == parameter_type (method_parameters setter !! 0)
 
 signals :: Object -> [SignalDoc] -> [(Signal, Maybe SignalDoc)]
 signals object docs =
@@ -269,10 +352,15 @@
         returnType = convertSignalType knownSymbols (signal_return_type signal)
         signalName = ss (toStudlyCaps . canonicalSignalName . signal_cname $ signal)
         signalCName = sc '"'. ss (signal_cname signal). sc '"'
-        formattedDoc = case doc of
-          Nothing  -> ss "-- | \n-- \n"
-          Just doc -> ss "-- | ". haddocFormatParas knownSymbols False (signaldoc_paragraphs doc). nl.
-                      ss "--\n"
+        formattedDoc = haddocFormatDeclaration knownSymbols False signaldoc_paragraphs doc
+
+genImplements :: Object -> [(ShowS, (Since, Deprecated))]
+genImplements object = 
+  [ (genImplement object implement, ("", notDeprecated))
+  | implement <- object_implements object ] 
+
+genImplement object implements =
+  ss "instance ".ss (stripKnownPrefixes implements). ss "Class ". ss (object_name object)
 
 canonicalSignalName :: String -> String
 canonicalSignalName = map dashToUnderscore
@@ -307,6 +395,7 @@
                                  ++ show (objectParents object)) SymStructType
                 lookup ("GObject":os) = SymObjectType GObjectKind
                 lookup ("GtkObject":os) = SymObjectType GtkObjectKind
+                lookup ("GdkBitmap":os) = SymObjectType GObjectKind -- Hack!
                 lookup (_:os) = lookup os
         objectParents :: Object -> [String]
         objectParents object = object_cname object :
@@ -357,6 +446,24 @@
      cs -> nl.nl.comment.ss "* Signals".nl.
            doVersionIfDefs lines cs)
 
+genImports :: ModuleInfo -> ShowS
+genImports modInfo = 
+  (case [ ss importLine
+        | (importModule, importLine) <- stdModules ] of
+     []   -> id
+     mods -> lines mods. ss "\n\n").
+  lines [ ss importLine
+        | (importModule, importLine) <- extraModules ]
+  where (stdModules, extraModules)
+          | null (module_imports modInfo) =
+             ([(undefined, "import Monad\t(liftM)")]
+             ,[(undefined, "import System.Glib.FFI")
+             ,(undefined, "{#import Graphics.UI.Gtk.Types#}")
+             ,(undefined, "-- CHECKME: extra imports may be required")])
+          | otherwise = partition (\(mod, _) -> mod `elem` knownStdModules)
+                                  (module_imports modInfo)
+        knownStdModules = ["Maybe", "Monad", "Char", "List", "Data.IORef"]
+
 genTodoItems :: Object -> ShowS
 genTodoItems object =
   let varargsFunctions = 

Index: Api.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Api.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- Api.hs	20 Feb 2005 18:52:09 -0000	1.3
+++ Api.hs	27 Feb 2005 20:02:16 -0000	1.4
@@ -56,6 +56,7 @@
     object_methods :: [Method],
     object_properties :: [Property],
     object_signals :: [Signal],
+    object_implements :: [String],
     object_deprecated :: Bool,
     object_isinterface ::Bool
   } deriving Show
@@ -177,7 +178,7 @@
                       remainder) content)) =
   let (parent, deprecated) =
         case remainder of
-          [] | Xml.verbatim cname == "GdkBitmap" -> ([Left "GdkDrawable"], False) --Hack
+          [] -> ([Left "Unknown"], False)
           [("parent", Xml.AttValue parent)] -> (parent, False)
           [("deprecated", Xml.AttValue deprecated),
            ("parent", Xml.AttValue parent)] -> (parent, True)
@@ -189,6 +190,7 @@
     object_methods = catMaybes (map extractMethod content),
     object_properties = catMaybes (map extractProperty content),
     object_signals = catMaybes (map extractSignal content),
+    object_implements = concat (catMaybes (map extractImplements content)),
     object_deprecated = deprecated,
     object_isinterface = False
   }
@@ -203,6 +205,7 @@
     object_methods = catMaybes (map extractMethod content),
     object_properties = catMaybes (map extractProperty content),
     object_signals = catMaybes (map extractSignal content),
+    object_implements = concat (catMaybes (map extractImplements content)),
     object_deprecated = False,
     object_isinterface = True
   }
@@ -338,6 +341,15 @@
   }
 extractSignal _ = Nothing
 
+extractImplements :: Xml.Content -> Maybe [String]
+extractImplements (Xml.CElem (Xml.Elem "implements" [] interfaces)) =
+  Just $ map extractInterface interfaces
+extractImplements _ = Nothing
+
+extractInterface :: Xml.Content -> String
+extractInterface (Xml.CElem (Xml.Elem "interface"
+                    [("cname", Xml.AttValue cname)] [] )) = Xml.verbatim cname
+
 extractMisc :: Xml.Content -> Maybe Misc
 extractMisc (Xml.CElem (Xml.Elem elem
                   (("name", Xml.AttValue name):

Index: FormatDocs.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/FormatDocs.hs,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- FormatDocs.hs	25 Feb 2005 01:32:11 -0000	1.7
+++ FormatDocs.hs	27 Feb 2005 20:02:16 -0000	1.8
@@ -8,6 +8,7 @@
 
 module FormatDocs (
   genModuleDocumentation,
+  haddocFormatDeclaration,
   cFuncNameToHsName,
   cParamNameToHsName,
   toStudlyCaps,
@@ -21,8 +22,8 @@
 
 import Api (NameSpace(namespace_name))
 import Docs
-import Marshal (stripKnownPrefixes, knownMiscType, KnownSymbols, CSymbol(..))
-import MarshalFixup (fixCFunctionName)
+import Marshal (KnownSymbols, CSymbol(..))
+import MarshalFixup (stripKnownPrefixes, knownMiscType, fixCFunctionName)
 import StringUtils
 
 import Maybe (isJust)
@@ -38,7 +39,7 @@
 genModuleDocumentation knownSymbols moduledoc =
   (if null (moduledoc_description moduledoc)
      then id
-     else comment.ss "* Description".nl.
+     else comment.ss "* Detail".nl.
           comment.nl.
           comment.ss "| ".haddocFormatParas knownSymbols False (moduledoc_description moduledoc).nl).
   (if null (moduledoc_sections moduledoc)
@@ -52,6 +53,12 @@
           comment.ss "|  ".haddocFormatHierarchy knownSymbols (moduledoc_hierarchy moduledoc).nl.
           comment.ss "@".nl)
 
+haddocFormatDeclaration :: KnownSymbols -> Bool -> (doc -> [DocPara]) -> Maybe doc -> ShowS
+haddocFormatDeclaration knownSymbols handleNULLs doc_paragraphs Nothing = ss "-- | \n--\n"
+haddocFormatDeclaration knownSymbols handleNULLs doc_paragraphs (Just doc)
+  = ss "-- | ". haddocFormatParas knownSymbols handleNULLs (doc_paragraphs doc). nl.
+    ss "--\n"
+
 haddocFormatHierarchy :: KnownSymbols -> [DocParaSpan] -> ShowS
 haddocFormatHierarchy knownSymbols =
     sepBy "\n-- |"

Index: ApiGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -d -r1.17 -r1.18
--- ApiGen.hs	21 Feb 2005 11:03:06 -0000	1.17
+++ ApiGen.hs	27 Feb 2005 20:02:15 -0000	1.18
@@ -140,7 +140,7 @@
               Just moduleInfo -> do mkDirHier outdir (splitOn '.' (module_prefix moduleInfo))
                                     return moduleInfo
               Nothing -> do
-                when (not (null moduleRoot)) $
+                when (not (null moduleRoot) && not (object_deprecated object)) $
                   putStrLn ("Warning: no existing module found for module "
 	                  ++ show (object_name object))
                 return ModuleInfo {
@@ -172,8 +172,7 @@
                                  then module_name moduleInfo
                                  else module_prefix moduleInfo ++ "." ++ module_name moduleInfo
 	    "EXPORTS"        -> genExports object moduleDoc moduleInfo
-	    "IMPORTS"        -> ss $ "{#import Graphics.UI.Gtk.Types#}\n"
-                                  ++ "-- CHECKME: extra imports may be required\n"
+	    "IMPORTS"        -> genImports moduleInfo
 	    "CONTEXT_LIB"    -> ss $ module_context_lib moduleInfo
 	    "CONTEXT_PREFIX" -> ss $ module_context_prefix  moduleInfo
 	    "MODULE_BODY"    -> genModuleBody knownTypes object moduleDoc moduleInfo

Index: StringUtils.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/StringUtils.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- StringUtils.hs	7 Feb 2005 00:38:02 -0000	1.2
+++ StringUtils.hs	27 Feb 2005 20:02:13 -0000	1.3
@@ -74,3 +74,14 @@
                    ([],_) -> Nothing
                    (w,_:r) -> Just (w,r)
                    (w,[]) -> Just (w,[]))
+
+-- mergeBy cmp xs ys = (only_in_xs, in_both, only_in_ys)
+mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> ([a], [(a, b)], [b])
+mergeBy cmp = merge [] [] []
+  where merge l m r []     ys     = (reverse l, reverse m, reverse (ys++r))
+        merge l m r xs     []     = (reverse (xs++l), reverse m, reverse r)
+        merge l m r (x:xs) (y:ys) = 
+          case x `cmp` y of
+            GT -> merge    l         m  (y:r) (x:xs)    ys
+            EQ -> merge    l  ((x,y):m)    r     xs     ys
+            LT -> merge (x:l)        m     r     xs  (y:ys)

Index: MarshalFixup.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/MarshalFixup.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- MarshalFixup.hs	25 Feb 2005 01:32:11 -0000	1.2
+++ MarshalFixup.hs	27 Feb 2005 20:02:17 -0000	1.3
@@ -53,7 +53,9 @@
 leafClass :: String -> Bool
 leafClass "GtkAdjustment" = True
 leafClass "GdkPixbuf"     = True
-leafClass "GtkIconFactory" = True
+leafClass "GtkIconFactory"  = True
+leafClass "GtkEntryCompletion" = True
+leafClass "GtkFileFilter" = True
 leafClass _ = False
 
 -- This is a table of fixup information. It lists function parameters that