Menu
▾
▴
[Gtk2hs-commit] gtk2hs/tools/apiGen ApiGen.hs,1.9,1.10 format-docs.xsl,1.8,1.9
|
From: Duncan C. <dun...@us...> - 2005-01-30 19:49:21
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2537/tools/apiGen Modified Files: ApiGen.hs format-docs.xsl Log Message: First go at generating signals including documentation. Ignore virstual methods as they are internal. Index: format-docs.xsl =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/format-docs.xsl,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- format-docs.xsl 26 Jan 2005 12:13:28 -0000 1.8 +++ format-docs.xsl 30 Jan 2005 19:49:11 -0000 1.9 @@ -81,6 +81,7 @@ <apidoc> <xsl:for-each select="book"> <module> + <!-- top level module information --> <module-info> <name><xsl:value-of select="refentry/refnamediv/refname"/></name> <altname><xsl:value-of select="refentry/refsynopsisdiv/anchor/@id"/></altname> @@ -104,6 +105,7 @@ </xsl:for-each> </object-hierarchy> </module-info> + <!-- Function documentation --> <xsl:for-each select="refentry/refsect1[title='Details']/refsect2[contains(title,' ()')]"> <function> <name><xsl:value-of select="indexterm/primary"/></name> @@ -123,6 +125,8 @@ </params> </function> </xsl:for-each> + <!-- Properties documentation --> +<!-- <xsl:for-each select="refentry/refsect1[title='Properties']/variablelist/varlistentry"> <property> <name><xsl:value-of select="term/literal"/></name> @@ -134,6 +138,39 @@ </doc> </property> </xsl:for-each> +--> + <!-- Properties documentation (new formatting) --> + <xsl:for-each select="refentry/refsect1[title='Properties']/refsect2"> + <property> + <name><xsl:value-of select="substring-before(substring-after(title,'"'),'"')"/></name> + <since> + <xsl:value-of select="normalize-space(substring-after(para[starts-with(text(),'Since')], 'Since'))"/> + </since> + <doc> + <xsl:apply-templates select="para[not(starts-with(text(),'Since')) and normalize-space(text())!='']"/> + </doc> + </property> + </xsl:for-each> + <!-- Signals documentation --> + <xsl:for-each select="refentry/refsect1[title='Signals']/refsect2"> + <signal> + <name><xsl:value-of select="substring-before(substring-after(title,'"'),'"')"/></name> + <since> + <xsl:value-of select="normalize-space(substring-after(para[starts-with(text(),'Since')], 'Since'))"/> + </since> + <doc> + <xsl:apply-templates select="para[not(starts-with(text(),'Since')) and normalize-space(text())!='']"/> + </doc> + <params> + <xsl:for-each select="variablelist/varlistentry"> + <param> + <name><xsl:value-of select="term/parameter"/></name> + <xsl:apply-templates select="listitem/simpara"/> + </param> + </xsl:for-each> + </params> + </signal> + </xsl:for-each> </module> </xsl:for-each> </apidoc> Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- ApiGen.hs 27 Jan 2005 23:10:14 -0000 1.9 +++ ApiGen.hs 30 Jan 2005 19:49:11 -0000 1.10 @@ -159,13 +159,12 @@ extractObject _ = Nothing extractMethod :: Xml.Content -> Maybe Method -extractMethod (Xml.CElem (Xml.Elem method +extractMethod (Xml.CElem (Xml.Elem "method" [("name", Xml.AttValue name), ("cname", Xml.AttValue cname)] (Xml.CElem (Xml.Elem "return-type" [("type", Xml.AttValue return_type)] []) - :content))) | method == "method" - || method == "virtual_method" = + :content))) = Just $ Method { method_name = Xml.verbatim name, method_cname = Xml.verbatim cname, @@ -281,7 +280,8 @@ moduledoc_sections :: [DocSection], -- any additional titled subsections moduledoc_hierarchy :: [DocParaSpan], -- a tree of parent objects (as text) moduledoc_functions :: [FuncDoc], -- documentation for each function - moduledoc_properties :: [PropDoc] -- documentation for each property + moduledoc_properties :: [PropDoc], -- documentation for each property + moduledoc_signals :: [SignalDoc] -- documentation for each signal } noModuleDoc = ModuleDoc { @@ -292,7 +292,8 @@ moduledoc_sections = [], moduledoc_hierarchy = [], moduledoc_functions = [], - moduledoc_properties = [] + moduledoc_properties = [], + moduledoc_signals = [] } data DocSection = DocSection { @@ -320,6 +321,13 @@ propdoc_since :: Since -- which version of the api the } -- function is available from, eg "2.4" +data SignalDoc = SignalDoc { + signaldoc_name :: String, -- C signal name + signaldoc_paragraphs :: [DocPara], -- documentation markup + signaldoc_params :: [ParamDoc], -- parameter documentation + signaldoc_since :: Since -- which version of the api the + } -- function is available from, eg "2.4" + data DocPara = DocParaText [DocParaSpan] -- an ordinary word-wrapped paragraph | DocParaProgram String -- a verbatum section @@ -347,9 +355,11 @@ extractDocModule (Xml.CElem (Xml.Elem "module" [] (moduleinfo:rest))) = let functions = [ e | e@(Xml.CElem (Xml.Elem "function" _ _)) <- rest ] properties = [ e | e@(Xml.CElem (Xml.Elem "property" _ _)) <- rest ] + signals = [ e | e@(Xml.CElem (Xml.Elem "signal" _ _)) <- rest ] in (extractDocModuleinfo moduleinfo) { moduledoc_functions = map extractDocFunc functions, - moduledoc_properties = map extractDocProp properties + moduledoc_properties = map extractDocProp properties, + moduledoc_signals = map extractDocSignal signals } extractDocModuleinfo :: Xml.Content -> ModuleDoc @@ -373,7 +383,8 @@ moduledoc_sections = map extractDocSection sections, moduledoc_hierarchy = map extractDocParaSpan objHierSpans, moduledoc_functions = undefined, - moduledoc_properties = undefined + moduledoc_properties = undefined, + moduledoc_signals = undefined } extractDocSection :: Xml.Content -> DocSection @@ -431,6 +442,24 @@ propdoc_since = since } +extractDocSignal :: Xml.Content -> SignalDoc +extractDocSignal + (Xml.CElem (Xml.Elem "signal" [] + [Xml.CElem (Xml.Elem "name" [] [Xml.CString _ name]) + ,Xml.CElem (Xml.Elem "since" [] since') + ,Xml.CElem (Xml.Elem "doc" [] paras) + ,Xml.CElem (Xml.Elem "params" [] params)] + )) = + let since = case since' of + [] -> "" + [Xml.CString _ since] -> since + in SignalDoc { + signaldoc_name = name, + signaldoc_paragraphs = concatMap extractDocPara paras, + signaldoc_params = map extractParamDoc params, + signaldoc_since = since + } + extractDocPara :: Xml.Content -> [DocPara] extractDocPara (Xml.CElem elem@(Xml.Elem "para" [] _)) = case Xml.xmlUnEscape Xml.stdXmlEscaper elem of @@ -563,7 +592,7 @@ haddocFormatPara :: DocPara -> ShowS haddocFormatPara (DocParaText spans) = haddocFormatSpans 3 spans haddocFormatPara (DocParaProgram prog) = - ((ss "* FIXME: port the follwing code example from C to Haskell or remove it".nl. + ((ss "* FIXME: if the follwing is a C code example, port it to Haskell or remove it".nl. comment).) . sepBy "\n-- > " . List.lines @@ -737,6 +766,7 @@ genConstructors knownTypes object (moduledoc_functions apiDoc) ++ genMethods knownTypes object (moduledoc_functions apiDoc) ++ genProperties knownTypes object (moduledoc_properties apiDoc) + ++ genSignals knownTypes object (moduledoc_signals apiDoc) genMethods :: KnownTypes -> Object -> [FuncDoc] -> [(ShowS, Since)] genMethods knownTypes object apiDoc = @@ -819,6 +849,36 @@ Just doc -> ss "-- | ". haddocFormatParas (propdoc_paragraphs doc). nl. comment. nl +signals :: Object -> [SignalDoc] -> [(Signal, Maybe SignalDoc)] +signals object docs = + [ (signal, map dashToUnderscore (signal_cname signal) `lookup` docmap) + | signal <- object_signals object ] + where docmap = [ (map dashToUnderscore (signaldoc_name doc), doc) + | doc <- docs ] + dashToUnderscore '-' = '_' + dashToUnderscore c = c + +genSignals :: KnownTypes -> Object -> [SignalDoc] -> [(ShowS, Since)] +genSignals knownTypes object apiDoc = + [ (genSignal object signal doc, maybe "" signaldoc_since doc) + | (signal, doc) <- signals object apiDoc ] + +genSignal :: Object -> Signal -> Maybe SignalDoc -> ShowS +genSignal object property doc = + formattedDoc. + ss "on". signalName. ss ", after". signalName. ss " :: ". nl. + ss "on". signalName. ss " = connect_{-type-}". connectType. sc ' '. signalCName. ss " False". nl. + ss "after". signalName. ss " = connect_{-type-}". connectType. sc ' '. signalCName. ss " True". nl + + where connectType = id + signalName = ss (upperCaseFirstChar (cFuncNameToHsName (signal_cname property))) + signalCName = sc '"'. ss (signal_cname property). sc '"' + formattedDoc = case doc of + Nothing -> ss "-- | \n-- \n" + Just doc -> ss "-- | ". haddocFormatParas (signaldoc_paragraphs doc). nl. + comment. nl + + -- We would like to be able to look up a type name and find out if it is a -- known class or enum so we can marshal it properly type KnownTypes = [(String, CTypeKind)] @@ -861,7 +921,7 @@ | namespace <- api , object <- namespace_objects namespace ] -genExports :: Object -> [FuncDoc] -> ShowS +genExports :: Object -> ModuleDoc -> ShowS genExports object docs = comment.ss "* Types". indent 1.ss (object_name object).sc ','. @@ -869,26 +929,30 @@ indent 1.ss "castTo".ss (object_name object).sc ','. (case [ (ss " ". ss (cFuncNameToHsName (method_cname constructor)). sc ',' ,maybe "" funcdoc_since doc) - | (constructor, doc) <- constructors object docs] of + | (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 docs] of + | (method, doc) <- methods object (moduledoc_functions docs)] of [] -> id cs -> nl.nl.comment.ss "* Methods".nl. doVersionIfDefs lines cs). - (case [ ss " ". ss (cFuncNameToHsName (property_cname property)). sc ',' - | property {-, doc-} <- object_properties object {-docs-}] of + (case [ (ss " ". ss (cFuncNameToHsName (property_cname property)). sc ',' + ,maybe "" propdoc_since doc) + | (property, doc) <- properties object (moduledoc_properties docs)] of [] -> id cs -> nl.nl.comment.ss "* Properties".nl. - lines cs). - (case [ ss " ". ss (cFuncNameToHsName (signal_cname signal)). sc ',' - | signal {-, doc-} <- object_signals object {-docs-}] of + doVersionIfDefs lines cs). + (case [ let signalName = (upperCaseFirstChar . cFuncNameToHsName . signal_cname) signal in + (ss " on". ss signalName. sc ','.nl. + ss " after". ss signalName. sc ',' + ,maybe "" signaldoc_since doc) + | (signal, doc) <- signals object (moduledoc_signals docs)] of [] -> id cs -> nl.nl.comment.ss "* Signals".nl. - lines cs) + doVersionIfDefs lines cs) genTodoItems :: Object -> ShowS genTodoItems object = @@ -1166,7 +1230,7 @@ "DOCUMENTATION" -> genModuleDocumentation moduleDoc "TODO" -> genTodoItems object "MODULE_NAME" -> ss (modPrefix ++ object_name object) - "EXPORTS" -> genExports object (moduledoc_functions moduleDoc) + "EXPORTS" -> genExports object moduleDoc "IMPORTS" -> ss $ "{#import Graphics.UI.Gtk.Types#}\n" ++ "-- CHECKME: extra imports may be required\n" "CONTEXT_LIB" -> ss (if null lib then namespace_library namespace else lib) |
