Menu
▾
▴
[Gtk2hs-commit] gtk2hs/tools/apiGen glib-sources.xml,NONE,1.1 Api.hs,1.1,1.2 ApiGen.hs,1.14,1.15 CodeGen.hs,1.2,1.3 Docs.hs,1.1,1.2 FormatDocs.hs,1.1,1.2 Makefile,1.6,1.7 Marshal.hs,1.1,1.2 format-docs.xsl,1.10,1.11 gnomecanvas-sources.xml,1.2,1.3
|
From: Duncan C. <dun...@us...> - 2005-02-14 02:11:01
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18599/tools/apiGen Modified Files: Api.hs ApiGen.hs CodeGen.hs Docs.hs FormatDocs.hs Makefile Marshal.hs format-docs.xsl gnomecanvas-sources.xml Added Files: glib-sources.xml Log Message: Lots of little improvements to the generated documentation. Generalise the "KnownTypes" table to "KnownSymbols" and use that in various places to make the recognition of things we should hyperlink more accurate. Convert enum value names to Haskell style names. Recognise type names and enum value names even when they are not marked up in the original docs. Deal with deprecated objects and methods, but only generate deprecated methods where they exist in the original modules (ie don't add new deprecated methods) Handle "shared" methods but ignore the *_get_type() ones. Change to using FM's for the KnownSymbols map so it's not all quite so slow. Index: Marshal.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Marshal.hs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- Marshal.hs 5 Feb 2005 02:57:40 -0000 1.1 +++ Marshal.hs 14 Feb 2005 02:10:49 -0000 1.2 @@ -1,6 +1,8 @@ module Marshal ( - KnownTypes, - CTypeKind(..), + KnownSymbols, + CSymbol(..), + ObjectKind(..), + EnumKind(..), stripKnownPrefixes, genMarshalParameter, genMarshalResult, @@ -9,15 +11,35 @@ import StringUtils import Char (isUpper) +import Data.FiniteMap -type KnownTypes = [(String, CTypeKind)] +type KnownSymbols = FiniteMap String CSymbol -data CTypeKind = GObjectKind - | GtkObjectKind - | EnumKind - | FlagsKind - deriving (Eq, Show) +data CSymbol = SymObjectType ObjectKind + | SymEnumType EnumKind + | SymEnumValue + | SymStructType + deriving Eq +data ObjectKind = GObjectKind | GtkObjectKind + deriving Eq +data EnumKind = EnumKind | FlagsKind + deriving Eq + +symbolIsObject (Just (SymObjectType _)) = True +symbolIsObject _ = False + +symbolIsGObject (Just (SymObjectType GObjectKind)) = True +symbolIsGObject _ = False + +symbolIsGtkObject (Just (SymObjectType GtkObjectKind)) = True +symbolIsGtkObject _ = False + +symbolIsEnum (Just (SymEnumType EnumKind)) = True +symbolIsEnum _ = False + +symbolIsFlags (Just (SymEnumType FlagsKind)) = True +symbolIsFlags _ = False stripKnownPrefixes :: String -> String stripKnownPrefixes ('A':'t':'k':remainder) = remainder @@ -32,7 +54,7 @@ ------------------------------------------------------------------------------- genMarshalParameter :: - KnownTypes -> --a collection of types we know to be objects or enums + KnownSymbols -> --a collection of types we know to be objects or enums String -> --parameter name suggestion (will be unique) String -> --C type decleration for the parameter we will marshal (Maybe String, --parameter class constraints (or none) @@ -77,36 +99,35 @@ indent 1. body. indent 2. sc ' '. ss name. ss "Ptr") -genMarshalParameter knownTypes name typeName' +genMarshalParameter knownSymbols name typeName' | isUpper (head typeName') && last typeName' == '*' && last typeName /= '*' - && (typeKind == Just GObjectKind - || typeKind == Just GtkObjectKind) = + && symbolIsObject typeKind = (Just $ shortTypeName ++ "Class " ++ name, Just name, \body -> body. indent 2. ss " (to". ss shortTypeName. sc ' '. ss name. ss ")") where typeName = init typeName' shortTypeName = stripKnownPrefixes typeName - typeKind = shortTypeName `lookup` knownTypes + typeKind = lookupFM knownSymbols typeName -genMarshalParameter knownTypes name typeName +genMarshalParameter knownSymbols name typeName | isUpper (head typeName) - && typeKind == Just EnumKind = + && symbolIsEnum typeKind = (Nothing, Just shortTypeName, \body -> body. indent 2. ss " ((fromIntegral . fromEnum) ". ss name. ss ")") where shortTypeName = stripKnownPrefixes typeName - typeKind = shortTypeName `lookup` knownTypes + typeKind = lookupFM knownSymbols typeName -genMarshalParameter knownTypes name typeName +genMarshalParameter knownSymbols name typeName | isUpper (head typeName) - && typeKind == Just FlagsKind = + && symbolIsFlags typeKind = (Nothing, Just shortTypeName, \body -> body. indent 2. ss " ((fromIntegral . fromFlags) ". ss name. ss ")") where shortTypeName = stripKnownPrefixes typeName - typeKind = shortTypeName `lookup` knownTypes + typeKind = lookupFM knownSymbols typeName genMarshalParameter _ name unknownType = (Nothing, Just $ "{-" ++ unknownType ++ "-}", @@ -115,7 +136,7 @@ -- Takes the type string and returns the Haskell Type and the marshaling code -- -genMarshalResult :: KnownTypes -> String -> (String, ShowS -> ShowS) +genMarshalResult :: KnownSymbols -> String -> (String, ShowS -> ShowS) 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) @@ -140,42 +161,41 @@ indent 1. ss ">>= fromGList". indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})") -genMarshalResult knownTypes typeName' +genMarshalResult knownSymbols typeName' | isUpper (head typeName') && last typeName' == '*' && last typeName /= '*' - && (typeKind == Just GObjectKind - || typeKind == Just GtkObjectKind) = + && symbolIsObject typeKind = ("IO " ++ shortTypeName, \body -> ss constructor. ss " mk". ss shortTypeName. ss " $". indent 1. body) where typeName = init typeName' shortTypeName = stripKnownPrefixes typeName - typeKind = shortTypeName `lookup` knownTypes - constructor | typeKind == Just GObjectKind = "makeNewGObject" - | typeKind == Just GtkObjectKind = "makeNewObject" + typeKind = lookupFM knownSymbols typeName + constructor | symbolIsGObject typeKind = "makeNewGObject" + | symbolIsGtkObject typeKind = "makeNewObject" -genMarshalResult knownTypes typeName +genMarshalResult knownSymbols typeName | isUpper (head typeName) - && typeKind == Just EnumKind = + && symbolIsEnum typeKind = ("IO " ++ shortTypeName, \body -> ss "liftM (toEnum . fromIntegral) $". indent 1. body) where shortTypeName = stripKnownPrefixes typeName - typeKind = shortTypeName `lookup` knownTypes + typeKind = lookupFM knownSymbols typeName -genMarshalResult knownTypes typeName +genMarshalResult knownSymbols typeName | isUpper (head typeName) - && typeKind == Just FlagsKind = + && symbolIsFlags typeKind = ("IO " ++ shortTypeName, \body -> ss "liftM (toFlags . fromIntegral) $". indent 1. body) where shortTypeName = stripKnownPrefixes typeName - typeKind = shortTypeName `lookup` knownTypes + typeKind = lookupFM knownSymbols typeName genMarshalResult _ unknownType = ("{-" ++ unknownType ++ "-}", id) -genMarshalProperty :: KnownTypes -> String -> (String, String) +genMarshalProperty :: KnownSymbols -> String -> (String, String) genMarshalProperty _ "gint" = ("Int", "GVint") genMarshalProperty _ "guint" = ("Int", "GVuint") genMarshalProperty _ "gfloat" = ("Float", "GVfloat") @@ -183,26 +203,25 @@ genMarshalProperty _ "gboolean" = ("Bool", "GVboolean") genMarshalProperty _ "gchar*" = ("String", "GVstring") -genMarshalProperty knownTypes typeName +genMarshalProperty knownSymbols typeName | isUpper (head typeName) - && (typeKind == Just GObjectKind - || typeKind == Just GtkObjectKind) = + && symbolIsObject typeKind = (shortTypeName, "GVobject") where shortTypeName = stripKnownPrefixes typeName - typeKind = shortTypeName `lookup` knownTypes + typeKind = lookupFM knownSymbols typeName -genMarshalProperty knownTypes typeName +genMarshalProperty knownSymbols typeName | isUpper (head typeName) - && typeKind == Just EnumKind = + && symbolIsEnum typeKind = (shortTypeName, "GVenum") where shortTypeName = stripKnownPrefixes typeName - typeKind = shortTypeName `lookup` knownTypes + typeKind = lookupFM knownSymbols typeName -genMarshalProperty knownTypes typeName +genMarshalProperty knownSymbols typeName | isUpper (head typeName) - && typeKind == Just FlagsKind = + && symbolIsFlags typeKind = (shortTypeName, "GVflags") where shortTypeName = stripKnownPrefixes typeName - typeKind = shortTypeName `lookup` knownTypes + typeKind = lookupFM knownSymbols typeName genMarshalProperty _ unknown = ("{-" ++ unknown ++ "-}", "{-" ++ unknown ++ "-}") Index: CodeGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- CodeGen.hs 10 Feb 2005 02:58:01 -0000 1.2 +++ CodeGen.hs 14 Feb 2005 02:10:49 -0000 1.3 @@ -2,7 +2,8 @@ genModuleBody, genExports, genTodoItems, - makeKnownTypesMap + makeKnownSymbolsMap, + mungeMethodInfo ) where import Api @@ -13,23 +14,28 @@ import ModuleScan import Prelude hiding (Enum, lines) -import List (groupBy, sortBy, isPrefixOf) +import List (groupBy, sortBy, isPrefixOf, isSuffixOf) +import Maybe (isNothing) +import Data.FiniteMap import Debug.Trace (trace) ------------------------------------------------------------------------------- -- Now lets actually generate some code fragments based on the api info ------------------------------------------------------------------------------- -genFunction :: KnownTypes -> Method -> Maybe FuncDoc -> Maybe MethodInfo -> ShowS -genFunction knownTypes method doc info = +genFunction :: KnownSymbols -> Method -> Maybe FuncDoc -> Maybe MethodInfo -> ShowS +genFunction knownSymbols method doc info = formattedDoc. + (if method_deprecated method + then ss "-- * Warning this function is deprecated\n--\n" + else id). ss functionName. ss " :: ". functionType. nl. ss functionName. sc ' '. sepBy " " paramNames. ss " =". indent 1. body where functionName = cFuncNameToHsName (method_cname method) (classConstraints', paramTypes', paramMarshalers) = - unzip3 [ case genMarshalParameter knownTypes + unzip3 [ case genMarshalParameter knownSymbols (changeIllegalNames (cParamNameToHsName (parameter_name p))) (parameter_type p) of (c, ty, m) -> (c, (ty, parameter_name p), m) @@ -40,7 +46,7 @@ paramNames = [ changeIllegalNames (cParamNameToHsName (parameter_name p)) | ((Just _, _), p) <- zip paramTypes' (method_parameters method) ] (returnType', returnMarshaler) = - genMarshalResult knownTypes (method_return_type method) + genMarshalResult knownSymbols (method_return_type method) returnType = (returnType', lookup "Returns" paramDocMap) functionType = (case classConstraints of [] -> id @@ -55,7 +61,7 @@ Just info -> if methodinfo_unsafe info then ss "unsafe " else id formattedDoc = case doc of Nothing -> ss "-- | \n-- \n" - Just doc -> ss "-- | ". haddocFormatParas (funcdoc_paragraphs doc). nl. + Just doc -> ss "-- | ". haddocFormatParas knownSymbols (funcdoc_paragraphs doc). nl. comment. nl paramDocMap = case doc of Nothing -> [] @@ -91,41 +97,44 @@ sepBy' ("\n" ++ replicate (columnIndent+5) ' ' ++ "-- ") . map (sepBy " ") . wrapText 3 (80 - columnIndent - 8) + . map (mungeWord knownSymbols) . words - . concatMap haddocFormatSpan + . concatMap (haddocFormatSpan knownSymbols) columnIndent = maximum [ length parmType | (parmType, _) <- paramTypes ] -genModuleBody :: String -> KnownTypes -> Object -> ModuleDoc -> ModuleInfo -> ShowS -genModuleBody modPrefix knownTypes object apiDoc modInfo = +genModuleBody :: KnownSymbols -> Object -> ModuleDoc -> ModuleInfo -> ShowS +genModuleBody knownSymbols object apiDoc modInfo = doVersionIfDefs (sepBy' "\n\n") $ - genConstructors knownTypes object (moduledoc_functions apiDoc) - ++ genMethods knownTypes object (moduledoc_functions apiDoc) - (mungeMethodInfo modPrefix object (module_methods modInfo)) - ++ genProperties knownTypes object (moduledoc_properties apiDoc) - ++ genSignals knownTypes object (moduledoc_signals apiDoc) + genConstructors knownSymbols object (moduledoc_functions apiDoc) + ++ genMethods knownSymbols object (moduledoc_functions apiDoc) (module_methods modInfo) + ++ genProperties knownSymbols object (moduledoc_properties apiDoc) + ++ genSignals knownSymbols object (moduledoc_signals apiDoc) -- fixup the names of the C functions we got from scaning the original modules -- we want the fully qualified "gtk_foo_bar" rather than "foo_bar" so that the -- names match up consistently with the ones from the API xml file. -mungeMethodInfo :: String -> Object -> [MethodInfo] -> [MethodInfo] -mungeMethodInfo nameSpacePrefix object = - map (\methodInfo -> if methodinfo_cname methodInfo `elem` shortMethodNames - then methodInfo { - methodinfo_cname = prefix ++ methodinfo_cname methodInfo - } - else methodInfo) +mungeMethodInfo :: Object -> ModuleInfo -> ModuleInfo +mungeMethodInfo object modInfo = + modInfo { + module_methods = map (\methodInfo -> + if methodinfo_cname methodInfo `elem` shortMethodNames + then methodInfo { + methodinfo_cname = prefix ++ methodinfo_cname methodInfo + } + else methodInfo) (module_methods modInfo) + } where shortMethodNames = map (stripPrefix . method_cname) (object_methods object) stripPrefix cname | prefix `isPrefixOf` cname = drop (length prefix) cname | otherwise = cname - prefix = nameSpacePrefix ++ "_" + prefix = module_context_prefix modInfo ++ "_" -genMethods :: KnownTypes -> Object -> [FuncDoc] -> [MethodInfo] -> [(ShowS, Since)] -genMethods knownTypes object apiDoc methodInfo = - [ (genFunction knownTypes method doc info, maybe "" funcdoc_since doc) - | (method, doc, info) <- methods object apiDoc methodInfo] +genMethods :: KnownSymbols -> Object -> [FuncDoc] -> [MethodInfo] -> [(ShowS, (Since, Deprecated))] +genMethods knownSymbols object apiDoc methodInfo = + [ (genFunction knownSymbols method doc info, (maybe "" funcdoc_since doc, method_deprecated method)) + | (method, doc, info) <- methods object apiDoc methodInfo True] -methods :: Object -> [FuncDoc] -> [MethodInfo] -> [(Method, Maybe FuncDoc, Maybe MethodInfo)] -methods object docs methodsInfo = +methods :: Object -> [FuncDoc] -> [MethodInfo] -> Bool -> [(Method, Maybe FuncDoc, Maybe MethodInfo)] +methods object docs methodsInfo sortByExisting = map snd $ sortBy (comparing fst) [ let (doc, docIndex) = case lookup (method_cname method) docmap of @@ -133,10 +142,14 @@ Just (doc, index) -> (Just doc, index) (info,infoIndex)= case lookup (method_cname method) infomap of Nothing -> (Nothing, endInfoIndex) - Just (info, index) -> (Just info, index) - in ((infoIndex,docIndex),(mungeMethod object method, doc, info)) + Just (info, index) -> (Just info, index) + index | sortByExisting = (infoIndex, docIndex) --preserve order from existing module + | otherwise = (docIndex, infoIndex) --use gtk-doc order + in (index,(mungeMethod object method, doc, info)) | method <- object_methods object - , null [ () | VarArgs <- method_parameters method] ] --exclude VarArgs methods + , null [ () | VarArgs <- method_parameters method] --exclude VarArgs methods + , not ("_get_type" `isSuffixOf` method_cname method && method_shared method) + , not (method_deprecated method && isNothing (lookup (method_cname method) infomap)) ] where docmap = [ (funcdoc_name doc, (doc,index)) | (doc,index) <- zip docs [1..] ] infomap = [ (methodinfo_cname info, (info,index)) @@ -156,9 +169,9 @@ method_parameters = self : method_parameters method } -genConstructors :: KnownTypes -> Object -> [FuncDoc] -> [(ShowS, Since)] -genConstructors knownTypes object apiDoc = - [ (genFunction knownTypes constructor doc Nothing, maybe "" funcdoc_since doc) +genConstructors :: KnownSymbols -> Object -> [FuncDoc] -> [(ShowS, (Since, Deprecated))] +genConstructors knownSymbols object apiDoc = + [ (genFunction knownSymbols constructor doc Nothing, (maybe "" funcdoc_since doc, notDeprecated)) | (constructor, doc) <- constructors object apiDoc ] constructors :: Object -> [FuncDoc] -> [(Method, Maybe FuncDoc)] @@ -174,7 +187,9 @@ method_name = cFuncNameToHsName (constructor_cname constructor), method_cname = constructor_cname constructor, method_return_type = object_cname object ++ "*", - method_parameters = constructor_parameters constructor + method_parameters = constructor_parameters constructor, + method_shared = False, + method_deprecated = False } properties :: Object -> [PropDoc] -> [(Property, Maybe PropDoc)] @@ -186,13 +201,13 @@ dashToUnderscore '-' = '_' dashToUnderscore c = c -genProperties :: KnownTypes -> Object -> [PropDoc] -> [(ShowS, Since)] -genProperties knownTypes object apiDoc = - [ (genProperty knownTypes object property doc, maybe "" propdoc_since doc) +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 ] -genProperty :: KnownTypes -> Object -> Property -> Maybe PropDoc -> ShowS -genProperty knownTypes object property doc = +genProperty :: KnownSymbols -> Object -> Property -> Maybe PropDoc -> ShowS +genProperty knownSymbols object property doc = formattedDoc. ss propertyName. ss " :: Attr ". objectType. sc ' '. ss propertyType. nl. ss propertyName. ss " = Attr ". @@ -201,13 +216,13 @@ where objectType = ss (object_name object) propertyName = cFuncNameToHsName (property_cname property) getter = ss "(\\obj -> do ". ss gvalueConstructor. ss " result <- objectGetProperty \"". ss (property_cname property). ss "\"". - indent 7. ss "return result" + 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 (propdoc_paragraphs doc). nl. + Just doc -> ss "-- | ". haddocFormatParas knownSymbols (propdoc_paragraphs doc). nl. comment. nl - (propertyType, gvalueConstructor) = genMarshalProperty knownTypes (property_type property) + (propertyType, gvalueConstructor) = genMarshalProperty knownSymbols (property_type property) signals :: Object -> [SignalDoc] -> [(Signal, Maybe SignalDoc)] signals object docs = @@ -218,13 +233,13 @@ dashToUnderscore '-' = '_' dashToUnderscore c = c -genSignals :: KnownTypes -> Object -> [SignalDoc] -> [(ShowS, Since)] -genSignals knownTypes object apiDoc = - [ (genSignal object signal doc, maybe "" signaldoc_since doc) +genSignals :: KnownSymbols -> Object -> [SignalDoc] -> [(ShowS, (Since, Deprecated))] +genSignals knownSymbols object apiDoc = + [ (genSignal knownSymbols object signal doc, (maybe "" signaldoc_since doc, notDeprecated)) | (signal, doc) <- signals object apiDoc ] -genSignal :: Object -> Signal -> Maybe SignalDoc -> ShowS -genSignal object property doc = +genSignal :: KnownSymbols -> Object -> Signal -> Maybe SignalDoc -> ShowS +genSignal knownSymbols object property doc = formattedDoc. ss "on". signalName. ss ", after". signalName. ss " :: ". nl. ss "on". signalName. ss " = connect_{-type-}". connectType. sc ' '. signalCName. ss " False". nl. @@ -235,30 +250,35 @@ signalCName = sc '"'. ss (signal_cname property). sc '"' formattedDoc = case doc of Nothing -> ss "-- | \n-- \n" - Just doc -> ss "-- | ". haddocFormatParas (signaldoc_paragraphs doc). nl. + Just doc -> ss "-- | ". haddocFormatParas knownSymbols (signaldoc_paragraphs doc). nl. comment. nl -makeKnownTypesMap :: API -> KnownTypes -makeKnownTypesMap api = - concat - [ [ (enum_name enum +makeKnownSymbolsMap :: API -> KnownSymbols +makeKnownSymbolsMap api = + (listToFM + . reverse + . concat) + [ [ (enum_cname enum ,case enum_variety enum of - "enum" -> EnumKind - "flags" -> FlagsKind) + EnumVariety -> SymEnumType EnumKind + FlagsVariety -> SymEnumType FlagsKind) | enum <- namespace_enums namespace ] - ++ [ (object_name object, objectKind object) + ++ [ (object_cname object, objectKind object) | object <- namespace_objects namespace ] + ++ [ ("GObject", SymObjectType GObjectKind) ] + ++ [ (member_cname member, SymEnumValue) + | enum <- namespace_enums namespace + , member <- enum_members enum ] | namespace <- api ] -- find if an object inherits via GtkObject or directly from GObject - where objectKind :: Object -> CTypeKind + where objectKind :: Object -> CSymbol objectKind object = lookup (objectParents object) where lookup [] = trace ( "Warning: " ++ object_name object ++ " does not inherit from GObject! " - ++ show (objectParents object)) GObjectKind - lookup ("GTypeModule":os) = GObjectKind -- GTypeModule is a GObject - lookup ("GObject":os) = GObjectKind - lookup ("GtkObject":os) = GtkObjectKind + ++ show (objectParents object)) SymStructType + lookup ("GObject":os) = SymObjectType GObjectKind + lookup ("GtkObject":os) = SymObjectType GtkObjectKind lookup (_:os) = lookup os objectParents :: Object -> [String] objectParents object = object_cname object : @@ -270,26 +290,27 @@ | namespace <- api , object <- namespace_objects namespace ] -genExports :: Object -> ModuleDoc -> ShowS -genExports object docs = +genExports :: Object -> ModuleDoc -> ModuleInfo -> ShowS +genExports object docs modInfo = comment.ss "* Types". indent 1.ss (object_name object).sc ','. indent 1.ss (object_name object).ss "Class,". indent 1.ss "castTo".ss (object_name object).sc ','. (case [ (ss " ". ss (cFuncNameToHsName (method_cname constructor)). sc ',' - ,maybe "" funcdoc_since doc) + ,(maybe "" funcdoc_since doc, notDeprecated)) | (constructor, doc) <- constructors object (moduledoc_functions docs)] of [] -> id cs -> nl.nl.comment.ss "* Constructors".nl. doVersionIfDefs lines cs). (case [ (ss " ". ss (cFuncNameToHsName (method_cname method)). sc ',' - ,maybe "" funcdoc_since doc) - | (method, doc, _) <- methods object (moduledoc_functions docs) []] of + ,(maybe "" funcdoc_since doc, method_deprecated method)) + | (method, doc, _) <- methods object (moduledoc_functions docs) + (module_methods modInfo) False] of [] -> id cs -> nl.nl.comment.ss "* Methods".nl. doVersionIfDefs lines cs). (case [ (ss " ". ss (cFuncNameToHsName (property_cname property)). sc ',' - ,maybe "" propdoc_since doc) + ,(maybe "" propdoc_since doc, notDeprecated)) | (property, doc) <- properties object (moduledoc_properties docs)] of [] -> id cs -> nl.nl.comment.ss "* Properties".nl. @@ -297,7 +318,7 @@ (case [ let signalName = (upperCaseFirstChar . cFuncNameToHsName . signal_cname) signal in (ss " on". ss signalName. sc ','.nl. ss " after". ss signalName. sc ',' - ,maybe "" signaldoc_since doc) + ,(maybe "" signaldoc_since doc, notDeprecated)) | (signal, doc) <- signals object (moduledoc_signals docs)] of [] -> id cs -> nl.nl.comment.ss "* Signals".nl. @@ -319,11 +340,16 @@ ss "TODO: the following varargs functions were not bound\n". lines (map (ss "-- * ".) varargsFunctions) -doVersionIfDefs :: ([ShowS] -> ShowS) -> [(ShowS, Since)] -> ShowS +type Deprecated = Bool +notDeprecated = False + +doVersionIfDefs :: ([ShowS] -> ShowS) -> [(ShowS, (Since, Deprecated))] -> ShowS doVersionIfDefs lines = lines - . map (\group -> sinceVersion (snd (head group)) - (lines (map fst group))) + . map (\group@((_,(since, deprecated)):_) -> + sinceVersion since + . ifdefDeprecated deprecated + $ (lines (map fst group))) . groupBy (\(_,a) (_,b) -> a == b) sinceVersion :: Since -> ShowS -> ShowS @@ -333,5 +359,12 @@ ss "\n#endif" sinceVersion _ body = body +ifdefDeprecated :: Deprecated -> ShowS -> ShowS +ifdefDeprecated True body = + ss "#ifndef DISABLE_DEPRECATED\n". + body. + ss "\n#endif" +ifdefDeprecated _ body = body + comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering comparing p x y = compare (p x) (p y) Index: Api.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Api.hs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- Api.hs 5 Feb 2005 02:57:39 -0000 1.1 +++ Api.hs 14 Feb 2005 02:10:48 -0000 1.2 @@ -2,6 +2,7 @@ API, NameSpace(..), Enum(..), + EnumVariety(..), Member(..), Object(..), Constructor(..), @@ -32,10 +33,13 @@ data Enum = Enum { enum_name :: String, enum_cname :: String, - enum_variety :: String, + enum_variety :: EnumVariety, enum_members :: [Member] } deriving Show +data EnumVariety = EnumVariety | FlagsVariety + deriving Show + data Member = Member { member_name :: String, member_cname :: String, @@ -49,7 +53,9 @@ object_constructors :: [Constructor], object_methods :: [Method], object_properties :: [Property], - object_signals :: [Signal] + object_signals :: [Signal], + object_deprecated :: Bool, + object_isinterface ::Bool } deriving Show data Constructor = Constructor { @@ -69,7 +75,9 @@ method_name :: String, method_cname :: String, method_return_type :: String, - method_parameters :: [Parameter] + method_parameters :: [Parameter], + method_shared :: Bool, --TODO: figure out what this means! + method_deprecated :: Bool } deriving Show data Property = Property { @@ -116,37 +124,47 @@ Just $ Enum { enum_name = Xml.verbatim name, enum_cname = Xml.verbatim cname, - enum_variety = Xml.verbatim variety, + enum_variety = case Xml.verbatim variety of + "enum" -> EnumVariety + "flags" -> FlagsVariety, enum_members = map extractEnumMember members } extractEnum _ = Nothing extractEnumMember :: Xml.Content -> Member -extractEnumMember (Xml.CElem (Xml.Elem "enum" - (("name", Xml.AttValue name): - ("cname", Xml.AttValue cname):value) [])) = +extractEnumMember (Xml.CElem (Xml.Elem "member" + (("cname", Xml.AttValue cname): + ("name", Xml.AttValue name):value) [])) = Member { member_name = Xml.verbatim name, member_cname = Xml.verbatim cname, member_value = case value of [] -> "" - [("cname", Xml.AttValue value)] -> Xml.verbatim value + [("value", Xml.AttValue value)] -> Xml.verbatim value } extractObject :: Xml.Content -> Maybe Object extractObject (Xml.CElem (Xml.Elem "object" - [("name", Xml.AttValue name), - ("cname", Xml.AttValue cname), - ("parent", Xml.AttValue parent)] content)) = - Just $ Object { + (("name", Xml.AttValue name): + ("cname", Xml.AttValue cname): + remainder) content)) = + let (parent, deprecated) = + case remainder of + [] | Xml.verbatim cname == "GdkBitmap" -> ([Left "GdkDrawable"], False) --Hack + [("parent", Xml.AttValue parent)] -> (parent, False) + [("deprecated", Xml.AttValue deprecated), + ("parent", Xml.AttValue parent)] -> (parent, True) + in Just $ Object { object_name = Xml.verbatim name, object_cname = Xml.verbatim cname, object_parent = Xml.verbatim parent, object_constructors = catMaybes (map extractConstructor content), object_methods = catMaybes (map extractMethod content), object_properties = catMaybes (map extractProperty content), - object_signals = catMaybes (map extractSignal content) + object_signals = catMaybes (map extractSignal content), + object_deprecated = deprecated, + object_isinterface = False } extractObject (Xml.CElem (Xml.Elem "interface" [("name", Xml.AttValue name), @@ -158,18 +176,30 @@ object_constructors = catMaybes (map extractConstructor content), object_methods = catMaybes (map extractMethod content), object_properties = catMaybes (map extractProperty content), - object_signals = catMaybes (map extractSignal content) + object_signals = catMaybes (map extractSignal content), + object_deprecated = False, + object_isinterface = True } +extractObject (Xml.CElem (Xml.Elem "object" [("name", Xml.AttValue name)] [])) | null (Xml.verbatim name) = Nothing +extractObject other@(Xml.CElem (Xml.Elem "object" _ _)) = error $ "extractObject: " ++ Xml.verbatim other +extractObject other@(Xml.CElem (Xml.Elem "interface" _ _)) = error $ "extractObject: " ++ Xml.verbatim other extractObject _ = Nothing extractMethod :: Xml.Content -> Maybe Method extractMethod (Xml.CElem (Xml.Elem "method" - [("name", Xml.AttValue name), - ("cname", Xml.AttValue cname)] + (("name", Xml.AttValue name): + ("cname", Xml.AttValue cname): + remainder) (Xml.CElem (Xml.Elem "return-type" [("type", Xml.AttValue return_type)] []) :content))) = - Just $ Method { + let (shared, deprecated) = + case remainder of + [] -> (False, False) + [("shared", _)] -> (True, False) + [("deprecated", _)] -> (False, True) + [("deprecated", _), ("shared", _)] -> (True, True) + in Just $ Method { method_name = Xml.verbatim name, method_cname = Xml.verbatim cname, method_return_type = Xml.verbatim return_type, @@ -177,8 +207,11 @@ case content of [] -> [] [Xml.CElem (Xml.Elem "parameters" [] parameters)] - -> map extractParameter parameters + -> map extractParameter parameters, + method_shared = shared, + method_deprecated = deprecated } +extractMethod other@(Xml.CElem (Xml.Elem "method" _ _)) = error $ "extractMethod: " ++ Xml.verbatim other extractMethod _ = Nothing extractParameter :: Xml.Content -> Parameter Index: FormatDocs.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/FormatDocs.hs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- FormatDocs.hs 5 Feb 2005 02:57:39 -0000 1.1 +++ FormatDocs.hs 14 Feb 2005 02:10:49 -0000 1.2 @@ -11,45 +11,50 @@ cFuncNameToHsName, cParamNameToHsName, haddocFormatParas, + haddocFormatSpans, haddocFormatSpan, + mungeWord, changeIllegalNames, addVersionParagraphs ) where import Api (NameSpace(namespace_name)) import Docs -import Marshal (stripKnownPrefixes) +import Marshal (stripKnownPrefixes, KnownSymbols, CSymbol(..)) import StringUtils +import Maybe (isJust) +import Char (toLower, isUpper, isAlpha) import qualified List (lines) +import Data.FiniteMap ------------------------------------------------------------------------------- -- Functions for formatting haddock documentation ------------------------------------------------------------------------------- -genModuleDocumentation :: ModuleDoc -> ShowS -genModuleDocumentation moduledoc = +genModuleDocumentation :: KnownSymbols -> ModuleDoc -> ShowS +genModuleDocumentation knownSymbols moduledoc = (if null (moduledoc_description moduledoc) then id else comment.ss "* Description".nl. comment.nl. - comment.ss "| ".haddocFormatParas (moduledoc_description moduledoc).nl). + comment.ss "| ".haddocFormatParas knownSymbols (moduledoc_description moduledoc).nl). (if null (moduledoc_sections moduledoc) then id - else nl.comment.haddocFormatSections (moduledoc_sections moduledoc).nl.comment.nl). + else nl.comment.haddocFormatSections knownSymbols (moduledoc_sections moduledoc).nl.comment.nl). (if null (moduledoc_hierarchy moduledoc) then id else nl.comment.ss "* Class Hierarchy".nl. comment.ss "|".nl. comment.ss "@".nl. - comment.ss "| ".haddocFormatHierarchy (moduledoc_hierarchy moduledoc).nl. + comment.ss "| ".haddocFormatHierarchy knownSymbols (moduledoc_hierarchy moduledoc).nl. comment.ss "@".nl) -haddocFormatHierarchy :: [DocParaSpan] -> ShowS -haddocFormatHierarchy = +haddocFormatHierarchy :: KnownSymbols -> [DocParaSpan] -> ShowS +haddocFormatHierarchy knownSymbols = sepBy "\n-- |" . Prelude.lines - . concatMap haddocFormatSpan + . concatMap (haddocFormatSpan knownSymbols) addVersionParagraphs :: NameSpace -> ModuleDoc -> ModuleDoc addVersionParagraphs namespace apiDoc = @@ -85,75 +90,93 @@ [] -> "" versions -> minimum versions -haddocFormatSections :: [DocSection] -> ShowS -haddocFormatSections = +haddocFormatSections :: KnownSymbols -> [DocSection] -> ShowS +haddocFormatSections knownSymbols = sepBy' "\n\n-- " . map (\section -> ss "** ". ss (section_title section). nl. comment.nl. - comment.ss "| ".haddocFormatParas (section_paras section)) + comment.ss "| ".haddocFormatParas knownSymbols (section_paras section)) -haddocFormatParas :: [DocPara] -> ShowS -haddocFormatParas = +haddocFormatParas :: KnownSymbols -> [DocPara] -> ShowS +haddocFormatParas knownSymbols = sepBy' "\n--\n-- " - . map haddocFormatPara + . map (haddocFormatPara knownSymbols) -haddocFormatPara :: DocPara -> ShowS -haddocFormatPara (DocParaText spans) = haddocFormatSpans 3 spans -haddocFormatPara (DocParaProgram prog) = +haddocFormatPara :: KnownSymbols -> DocPara -> ShowS +haddocFormatPara knownSymbols (DocParaText spans) = haddocFormatSpans knownSymbols 3 spans +haddocFormatPara knownSymbols (DocParaProgram prog) = ((ss "* FIXME: if the follwing is a C code example, port it to Haskell or remove it".nl. comment).) . sepBy "\n-- > " . List.lines $ prog -haddocFormatPara (DocParaTitle title) = +haddocFormatPara knownSymbols (DocParaTitle title) = ss "* ". ss title -haddocFormatPara (DocParaDefItem term spans) = - let def = (unwords . words . escape . concatMap haddocFormatSpan) term in +haddocFormatPara knownSymbols (DocParaDefItem term spans) = + let def = (unwords . words . escape . concatMap (haddocFormatSpan knownSymbols)) term in sc '['. ss def. ss "] ". - haddocFormatSpans (length def + 6) spans + haddocFormatSpans knownSymbols (length def + 6) spans where escape [] = [] escape (']':cs) = '\\': ']' : escape cs --we must escape ] in def terms escape (c:cs) = c : escape cs -haddocFormatPara (DocParaListItem spans) = +haddocFormatPara knownSymbols (DocParaListItem spans) = ss "* ". - haddocFormatSpans 5 spans + haddocFormatSpans knownSymbols 5 spans -haddocFormatSpans :: Int -> [DocParaSpan] -> ShowS -haddocFormatSpans initialCol = +haddocFormatSpans :: KnownSymbols -> Int -> [DocParaSpan] -> ShowS +haddocFormatSpans knownSymbols initialCol = sepBy' "\n-- " . map (sepBy " ") . wrapText initialCol 77 + . map (mungeWord knownSymbols) . words - . concatMap haddocFormatSpan + . concatMap (haddocFormatSpan knownSymbols) -haddocFormatSpan :: DocParaSpan -> String -haddocFormatSpan (DocText text) = escapeHaddockSpecialChars text -haddocFormatSpan (DocTypeXRef text) = "\"" ++ stripKnownPrefixes text ++ "\"" -haddocFormatSpan (DocFuncXRef text) = "'" ++ cFuncNameToHsName text ++ "'" -haddocFormatSpan (DocOtherXRef text) = "'{FIXME: gtk-doc cross reference to:" ++ text ++ "}'" -haddocFormatSpan (DocEmphasis text) = "/" ++ text ++ "/" -haddocFormatSpan (DocLiteral "TRUE") = "@True@" -haddocFormatSpan (DocLiteral "FALSE") = "@False@" +haddocFormatSpan :: KnownSymbols -> DocParaSpan -> String +haddocFormatSpan _ (DocText text) = escapeHaddockSpecialChars text +haddocFormatSpan knownSymbols (DocTypeXRef text) = + case lookupFM knownSymbols text of + Nothing -> "{" ++ text ++ ", FIXME: unknown type/value}" + Just (SymObjectType _) -> "\"" ++ stripKnownPrefixes text ++ "\"" + Just (SymEnumType _) -> "'" ++ stripKnownPrefixes text ++ "'" + Just SymEnumValue -> "'" ++ cConstNameToHsName text ++ "'" + _ -> "{" ++ text ++ ", FIXME: unknown type/value}" --TODO fill in the other cases +-- | looksLikeConstant text = "'" ++ cConstNameToHsName text ++ "'" +-- | otherwise = "\"" ++ stripKnownPrefixes text ++ "\"" +haddocFormatSpan _ (DocFuncXRef text) = "'" ++ cFuncNameToHsName text ++ "'" +haddocFormatSpan _ (DocOtherXRef text) = "'{FIXME: gtk-doc cross reference to:" ++ text ++ "}'" +haddocFormatSpan _ (DocEmphasis text) = "/" ++ text ++ "/" +haddocFormatSpan _ (DocLiteral "TRUE") = "@True@" +haddocFormatSpan _ (DocLiteral "FALSE") = "@False@" --likely that something should be changed to a Maybe type if this is emitted: -haddocFormatSpan (DocLiteral "NULL") = "{@NULL@, FIXME: this should probably be converted" +haddocFormatSpan _ (DocLiteral "NULL") = "{@NULL@, FIXME: this should probably be converted" ++ " to a Maybe data type}" -haddocFormatSpan (DocLiteral text) = "@" ++ escapeHaddockSpecialChars text ++ "@" -haddocFormatSpan (DocArg text) = "@" ++ cParamNameToHsName text ++ "@" +haddocFormatSpan _ (DocLiteral text) = "@" ++ escapeHaddockSpecialChars text ++ "@" +haddocFormatSpan _ (DocArg text) = "@" ++ cParamNameToHsName text ++ "@" cFuncNameToHsName :: String -> String cFuncNameToHsName = lowerCaseFirstChar . stripKnownPrefixes - . concatMap upperCaseFirstChar - . filter (not.null) --to ignore leading underscores - . splitBy '_' + . toStudlyCaps . takeWhile ('('/=) cParamNameToHsName :: String -> String cParamNameToHsName = --change "gtk_foo_bar" to "gtkFooBar" lowerCaseFirstChar - . concatMap upperCaseFirstChar + . toStudlyCaps + +cConstNameToHsName :: String -> String +cConstNameToHsName = --change "GTK_UPDATE_DISCONTINUOUS" to "updateDiscontinuous" + lowerCaseFirstChar + . stripKnownPrefixes + . toStudlyCaps + . map toLower + +toStudlyCaps :: String -> String +toStudlyCaps = --change "gtk_foo_bar" to "GtkFooBar" + concatMap upperCaseFirstChar . filter (not.null) --to ignore tailing underscores . splitBy '_' @@ -169,4 +192,43 @@ || c == '"' || c == '@' || c == '<' || c == ''' = '\\': c : escape cs - escape (c:cs) = c : escape cs + escape (c:cs) = c : escape cs + +mungeWord :: KnownSymbols -> String -> String +mungeWord knownSymbols ('G':'T':'K':'+':remainder) = "Gtk+" ++ remainder +mungeWord knownSymbols word + | word' == "TRUE" = "@True@" ++ remainder + | word' == "FALSE" = "@False@" ++ remainder + | word' == "NULL" = "{@NULL@, FIXME: this should probably be converted to a Maybe data type}" + ++ remainder + | isJust e = case e of + Just (SymObjectType _) -> "\"" ++ stripKnownPrefixes word' ++ "\"" ++ remainder + Just (SymEnumType _) -> "'" ++ stripKnownPrefixes word' ++ "'" ++ remainder + Just SymEnumValue -> "'" ++ cConstNameToHsName word' ++ "'" ++ remainder + | otherwise = word + where e = lookupFM knownSymbols word' + (word', remainder) = span (\c -> isAlpha c || c == '_') word +{- +mungeWord _ "GTK+" = "Gtk+" +mungeWord _ "GTK+," = "Gtk+," +mungeWord _ "GTK+." = "Gtk+." +mungeWord _ "TRUE" = "@True@" +mungeWord _ "FALSE" = "@False@" +mungeWord _ "TRUE," = "@True@," +mungeWord _ "FALSE," = "@False@," +mungeWord _ "NULL" = "{@NULL@, FIXME: this should probably be converted to a Maybe data type}" +mungeWord knownSymbols word | isJust e = case e of + Just (SymObjectType _) -> "\"" ++ stripKnownPrefixes word' ++ "\"" ++ remainder + Just (SymEnumType _) -> "'" ++ stripKnownPrefixes word' ++ "'" ++ remainder + Just SymEnumValue -> "'" ++ cConstNameToHsName word' ++ "'" ++ remainder + where e = lookupFM knownSymbols word' + (word', remainder) = span (\c -> isAlpha c || c == '_') word +mungeWord _ word = word +-} + +-- eg C constants with names like GTK_UPDATE_DISCONTINUOUS +looksLikeConstant :: String -> Bool +looksLikeConstant ('G':'T':'K':'_':rest) = all (\c -> isUpper c || c == '_') rest +looksLikeConstant ('G':'D':'K':'_':rest) = all (\c -> isUpper c || c == '_') rest +looksLikeConstant ('P':'A':'N':'G':'O':'_':rest) = all (\c -> isUpper c || c == '_') rest +looksLikeConstant _ = False Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- ApiGen.hs 10 Feb 2005 02:58:01 -0000 1.14 +++ ApiGen.hs 14 Feb 2005 02:10:48 -0000 1.15 @@ -14,7 +14,7 @@ import StringUtils (ss, templateSubstitute, splitOn) import ModuleScan -import Monad (when) +import Monad (when, liftM) import List (isPrefixOf, intersperse) import System (getArgs, exitWith, ExitCode(..)) import Directory (doesDirectoryExist, createDirectory) @@ -75,7 +75,7 @@ -- included from Gdk and Pango includeApi = [ extractAPI (Xml.xmlParse apiFile content) | (apiFile, content) <- zip includeApiFiles includeApiFilesContents] - knownTypes = makeKnownTypesMap (api ++ concat includeApi) + knownTypes = makeKnownSymbolsMap (api ++ concat includeApi) ----------------------------------------------------------------------------- -- Read in the documentation xml file if supplied @@ -118,6 +118,7 @@ return noModuleDoc Just moduleDoc -> return $ addVersionParagraphs namespace moduleDoc moduleInfo <- + liftM (mungeMethodInfo object) $ case maybeModuleInfo of Just moduleInfo -> do mkDirHier outdir (splitOn '.' (module_prefix moduleInfo)) return moduleInfo @@ -147,19 +148,18 @@ "OBJECT_NAME" -> ss $ module_name moduleInfo "AUTHORS" -> ss $ concat $ intersperse ", " $ module_authors moduleInfo "COPYRIGHT" -> ss $ concat $ intersperse ", " $ module_copyright_holders moduleInfo - "DESCRIPTION" -> ss (moduledoc_summary moduleDoc) - "DOCUMENTATION" -> genModuleDocumentation moduleDoc + "DESCRIPTION" -> haddocFormatSpans knownTypes 3 (moduledoc_summary moduleDoc) + "DOCUMENTATION" -> genModuleDocumentation knownTypes moduleDoc "TODO" -> genTodoItems object "MODULE_NAME" -> ss $ if null (module_prefix moduleInfo) then module_name moduleInfo else module_prefix moduleInfo ++ "." ++ module_name moduleInfo - "EXPORTS" -> genExports object moduleDoc + "EXPORTS" -> genExports object moduleDoc moduleInfo "IMPORTS" -> ss $ "{#import Graphics.UI.Gtk.Types#}\n" ++ "-- CHECKME: extra imports may be required\n" "CONTEXT_LIB" -> ss $ module_context_lib moduleInfo "CONTEXT_PREFIX" -> ss $ module_context_prefix moduleInfo - "MODULE_BODY" -> genModuleBody (module_context_prefix moduleInfo) - knownTypes object moduleDoc moduleInfo + "MODULE_BODY" -> genModuleBody knownTypes object moduleDoc moduleInfo _ -> ss "" ) "" ) [ (namespace ,object --- NEW FILE: glib-sources.xml --- <gapi-parser-input> <api filename="glib-api.xml"> <library name="gobject"> <namespace name="GObject"> <dir>glib-2.4.8/gobject</dir> <!-- exclude programs --> <exclude>glib-2.4.8/gobject/glib-genmarshal.c</exclude> <exclude>glib-2.4.8/gobject/gobject-query.c</exclude> <exclude>glib-2.4.8/gobject/stamp-gmarshal.h</exclude> <exclude>glib-2.4.8/gobject/testgobject.c</exclude> <!-- this file causes the gapi parser to go into a infinite loop --> <exclude>glib-2.4.8/gobject/gvalue.h</exclude> </namespace> </library> </api> </gapi-parser-input> Index: format-docs.xsl =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/format-docs.xsl,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- format-docs.xsl 5 Feb 2005 01:21:47 -0000 1.10 +++ format-docs.xsl 14 Feb 2005 02:10:49 -0000 1.11 @@ -100,7 +100,7 @@ <module-info> <name><xsl:value-of select="refentry/refnamediv/refname"/></name> <altname><xsl:value-of select="refentry/refsynopsisdiv/anchor/@id"/></altname> - <summary><xsl:value-of select="refentry/refnamediv/refpurpose"/></summary> + <summary><xsl:apply-templates select="refentry/refnamediv/refpurpose"/></summary> <description> <xsl:for-each select="refentry/refsect1[title='Description']"> <xsl:apply-templates select="para | section | refsect2"/> @@ -155,7 +155,7 @@ </xsl:for-each> --> <!-- Properties documentation (new formatting) --> - <xsl:for-each select="refentry/refsect1[title='Properties']/refsect2"> + <xsl:for-each select="refentry/refsect1[title='Properties' or title='Style Properties']/refsect2"> <property> <name><xsl:value-of select="substring-before(substring-after(title,'"'),'"')"/></name> <since> Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- Makefile 7 Feb 2005 00:38:02 -0000 1.6 +++ Makefile 14 Feb 2005 02:10:49 -0000 1.7 @@ -73,11 +73,11 @@ ./mkdocxml.sh $< | xsltproc format-docs.xsl - > $@ gtk-modules : gtk-api.xml gtk-docs.xml Template.chs ApiGen \ - gdk-api.xml pango-api.xml atk-api.xml + gdk-api.xml pango-api.xml atk-api.xml glib-api.xml @mkdir -p $@ ./ApiGen $< Template.chs --doc=gtk-docs.xml --outdir=$@ \ --includeapi=gdk-api.xml --includeapi=pango-api.xml \ - --includeapi=atk-api.xml \ + --includeapi=atk-api.xml --includeapi=glib-api.xml \ --modprefix=Graphics.UI.Gtk.{-Category-} \ --scanmodules=../../gtk/Graphics/UI/Gtk @@ -124,9 +124,11 @@ # # gnomecanvas modules # -gnomecanvas-modules : gnomecanvas-api.xml Template.chs ApiGen +gnomecanvas-modules : gnomecanvas-api.xml Template.chs ApiGen \ + gtk-api.xml @mkdir -p $@ - ./ApiGen $< Template.chs --outdir=$@ + ./ApiGen $< Template.chs --outdir=$@ \ + --includeapi=gtk-api.xml ######################## Index: Docs.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Docs.hs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- Docs.hs 5 Feb 2005 02:58:45 -0000 1.1 +++ Docs.hs 14 Feb 2005 02:10:49 -0000 1.2 @@ -23,7 +23,7 @@ data ModuleDoc = ModuleDoc { moduledoc_name :: String, -- these docs apply to this object moduledoc_altname :: String, -- sometimes a better index entry - moduledoc_summary :: String, -- a one line summary + moduledoc_summary :: [DocParaSpan], -- a one line summary moduledoc_description :: [DocPara], -- the main description moduledoc_sections :: [DocSection], -- any additional titled subsections moduledoc_hierarchy :: [DocParaSpan], -- a tree of parent objects (as text) @@ -35,7 +35,7 @@ noModuleDoc = ModuleDoc { moduledoc_name = "", moduledoc_altname = "", - moduledoc_summary = "", + moduledoc_summary = [], moduledoc_description = [], moduledoc_sections = [], moduledoc_hierarchy = [], @@ -126,7 +126,7 @@ in ModuleDoc { moduledoc_name = Xml.verbatim name, moduledoc_altname = Xml.verbatim altname, - moduledoc_summary = Xml.verbatim summary, + moduledoc_summary = map extractDocParaSpan summary, moduledoc_description = concatMap extractDocPara paras, moduledoc_sections = map extractDocSection sections, moduledoc_hierarchy = map extractDocParaSpan objHierSpans, @@ -241,6 +241,9 @@ extractDocParaOrSpan (Xml.CElem (Xml.Elem "programlisting" _ content)) = let listing = concat [ str | (Xml.CString _ str) <- content ] in Right $ DocParaProgram listing +extractDocParaOrSpan para@(Xml.CElem (Xml.Elem "para" _ _)) = + case extractDocPara para of + [para'] -> Right para' --handle this special case, we do not expect nested paras very often extractDocParaOrSpan content@(Xml.CElem _ ) = Left $ extractDocParaSpan content extractDocParaOrSpan content@(Xml.CString _ _) = Left $ extractDocParaSpan content extractDocParaOrSpan other = error $ "extractDocParaOrSpan: " ++ Xml.verbatim other Index: gnomecanvas-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gnomecanvas-sources.xml,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- gnomecanvas-sources.xml 27 Jan 2005 23:10:15 -0000 1.2 +++ gnomecanvas-sources.xml 14 Feb 2005 02:10:49 -0000 1.3 @@ -2,7 +2,7 @@ <api filename="gnomecanvas-api.xml"> <library name="gnomecanvas"> <namespace name="Gnome"> - <dir>libgnomecanvas-2.6.0/libgnomecanvas</dir> + <dir>libgnomecanvas-2.6.1.1/libgnomecanvas</dir> </namespace> </library> </api> |
