Menu
▾
▴
[Gtk2hs-commit] gtk2hs/tools/apiGen CodeGen.hs,1.10,1.11 Docs.hs,1.2,1.3 ApiGen.hs,1.18,1.19 FormatDocs.hs,1.8,1.9 gapi2xml.pl,1.2,1.3 gtk-sources.xml,1.4,1.5
|
From: Duncan C. <dun...@us...> - 2005-03-01 21:20:56
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28810/tools/apiGen Modified Files: CodeGen.hs Docs.hs ApiGen.hs FormatDocs.hs gapi2xml.pl gtk-sources.xml Log Message: Yet more code generator improvements... Most important is that it now works with gtk-2.6.1 CodeGen.hs: do deprecated and version ifdefs a bit better especialy if the whole module is new or deprecated. Docs.hs: seperate documentation of callbacks from documentation of methods. Generalise the summary field to be list of paragraphs rather than just a single paragraph so that we can add things to the summary documentations like deprecation notices. FormatDocs.hs: for deprecated modules, instead of anotating every function with a deprecation warning, just add a note to the module summary. Also put version notes in the module summary rather than at the end of the detail section. gapi2xml.pl, gtk-sources.xml: merge upstream changes to the gapi parser tool and adjust the sources spec file so that it will now work with gtk+-2.6.1. (There seems to be an additional problem with 2.6.2 and 2.6.3 in the filechooser modules which I have not yet tracked down) Index: CodeGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- CodeGen.hs 27 Feb 2005 20:02:16 -0000 1.10 +++ CodeGen.hs 1 Mar 2005 21:20:44 -0000 1.11 @@ -28,9 +28,6 @@ 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 ' '. formattedParamNames. sc '='. indent 1. body @@ -108,6 +105,7 @@ genModuleBody :: KnownSymbols -> Object -> ModuleDoc -> ModuleInfo -> ShowS genModuleBody knownSymbols object apiDoc modInfo = doVersionIfDefs (sepBy' "\n\n") $ + map adjustDeprecatedAndSinceVersion $ sectionHeader "Interfaces" (genImplements object) ++ sectionHeader "Constructors" @@ -119,7 +117,11 @@ ++ sectionHeader "Signals" (genSignals knownSymbols object (moduledoc_signals apiDoc)) where sectionHeader name [] = [] - sectionHeader name entries = (ss "--------------------\n-- ". ss name, ("", False)):entries + sectionHeader name entries = + let header = (ss "--------------------\n-- ". ss name, ("", notDeprecated)) + in header : entries + adjustDeprecatedAndSinceVersion (doc, (since, deprecated)) = + (doc, (moduledoc_since apiDoc `max` since, object_deprecated object || deprecated)) -- 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 @@ -414,37 +416,37 @@ 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, 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_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 (lowerCaseFirstChar (property_name property)). sc ',' - ,(maybe "" propdoc_since doc, notDeprecated)) - | (property, doc) <- properties object (moduledoc_properties docs)] of - [] -> id - cs -> nl.nl.comment.ss "* Properties".nl. - doVersionIfDefs lines cs). - (case [ let signalName = (toStudlyCaps . canonicalSignalName . signal_cname) signal in - (ss " on". ss signalName. sc ','.nl. - ss " after". ss signalName. sc ',' - ,(maybe "" signaldoc_since doc, notDeprecated)) - | (signal, doc) <- signals object (moduledoc_signals docs)] of - [] -> id - cs -> nl.nl.comment.ss "* Signals".nl. - doVersionIfDefs lines cs) + doVersionIfDefs lines $ + map adjustDeprecatedAndSinceVersion $ + [(ss "-- * Types", defaultAttrs) + ,(ss " ".ss (object_name object).sc ',', defaultAttrs) + ,(ss " ".ss (object_name object).ss "Class,", defaultAttrs) + ,(ss " ".ss "castTo".ss (object_name object).sc ',', defaultAttrs)] + ++ sectionHeader "Constructors" + [ (ss " ". ss (cFuncNameToHsName (method_cname constructor)). sc ',' + ,(maybe "" funcdoc_since doc, notDeprecated)) + | (constructor, doc, _) <- constructors object (moduledoc_functions docs) []] + ++ sectionHeader "Methods" + [ (ss " ". ss (cFuncNameToHsName (method_cname method)). sc ',' + ,(maybe "" funcdoc_since doc, method_deprecated method)) + | (method, doc, _) <- methods object (moduledoc_functions docs) + (module_methods modInfo) False] + ++ sectionHeader "Properties" + [ (ss " ". ss (lowerCaseFirstChar (property_name property)). sc ',' + ,(maybe "" propdoc_since doc, notDeprecated)) + | (property, doc) <- properties object (moduledoc_properties docs)] + ++ sectionHeader "Signals" + [ let signalName = (toStudlyCaps . canonicalSignalName . signal_cname) signal in + (ss " on". ss signalName. sc ','.nl. + ss " after". ss signalName. sc ',' + ,(maybe "" signaldoc_since doc, notDeprecated)) + | (signal, doc) <- signals object (moduledoc_signals docs)] + + where defaultAttrs = ("", notDeprecated) + sectionHeader name [] = [] + sectionHeader name entries = (id, defaultAttrs):(ss "-- * ". ss name, defaultAttrs):entries + adjustDeprecatedAndSinceVersion (doc, (since, deprecated)) = + (doc, (moduledoc_since docs `max` since, object_deprecated object || deprecated)) genImports :: ModuleInfo -> ShowS genImports modInfo = Index: FormatDocs.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/FormatDocs.hs,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- FormatDocs.hs 27 Feb 2005 20:02:16 -0000 1.8 +++ FormatDocs.hs 1 Mar 2005 21:20:45 -0000 1.9 @@ -20,7 +20,7 @@ addVersionParagraphs ) where -import Api (NameSpace(namespace_name)) +import Api (NameSpace(..), Object(..), Method(..)) import Docs import Marshal (KnownSymbols, CSymbol(..)) import MarshalFixup (stripKnownPrefixes, knownMiscType, fixCFunctionName) @@ -75,28 +75,43 @@ addVersionParagraphs :: NameSpace -> ModuleDoc -> ModuleDoc addVersionParagraphs namespace apiDoc = apiDoc { - moduledoc_description = moduledoc_description apiDoc ++ moduleVersionParagraph, - moduledoc_functions = functionVersionParagraphs moduleVersion (moduledoc_functions apiDoc) + moduledoc_summary = moduledoc_summary apiDoc ++ moduleVersionParagraph + ++ moduleDeprecatedParagraph, + moduledoc_functions = functionVersionParagraphs moduleVersion (moduledoc_functions apiDoc), + moduledoc_since = moduleVersion } where functionVersionParagraphs :: String -> [FuncDoc] -> [FuncDoc] functionVersionParagraphs baseVersion funcdocs = [ if funcdoc_since funcdoc > baseVersion then funcdoc { funcdoc_paragraphs = funcdoc_paragraphs funcdoc ++ - let line = "* Available since " ++ namespace_name namespace + let line = "Available since " ++ namespace_name namespace ++ " version " ++ funcdoc_since funcdoc - in [DocParaText [DocText line]] + in [DocParaListItem [DocText line]] } - else funcdoc + else let method = lookup (funcdoc_name funcdoc) methodMap + methodDeprecated = maybe False method_deprecated method + objectDeprecated = maybe False object_deprecated object + in if methodDeprecated && not objectDeprecated + then funcdoc { + funcdoc_paragraphs = funcdoc_paragraphs funcdoc ++ + let line = "Warning: this function is deprecated " + ++ "and should not be used in newly-written code." + in [DocParaListItem [DocText line]] + } + else funcdoc | funcdoc <- funcdocs ] + where methodMap = [ (method_cname method, method) + | method <- maybe [] object_methods object ] moduleVersionParagraph = case moduleVersion of "" -> [] since -> - let line = "* Module available since " ++ namespace_name namespace + let line = "Module available since " ++ (let name = namespace_name namespace + in if name == "Gtk" then "Gtk+" else name) ++ " version " ++ since - in [DocParaText [DocText line]] + in [DocParaListItem [DocText line]] -- figure out if the whole module appeared in some version of gtk later -- than the original version @@ -105,6 +120,18 @@ | funcdoc <- moduledoc_functions apiDoc ] of [] -> "" versions -> minimum versions + + moduleDeprecatedParagraph = + if maybe False object_deprecated object + then let line = "Warning: this module is deprecated " + ++ "and should not be used in newly-written code." + + in [DocParaListItem [DocText line]] + else [] + + object = lookup (moduledoc_name apiDoc) + [ (object_cname object, object) + | object <- namespace_objects namespace ] haddocFormatSections :: KnownSymbols -> [DocSection] -> ShowS haddocFormatSections knownSymbols = Index: gapi2xml.pl =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gapi2xml.pl,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- gapi2xml.pl 27 Jan 2005 23:10:15 -0000 1.2 +++ gapi2xml.pl 1 Mar 2005 21:20:45 -0000 1.3 @@ -169,12 +169,19 @@ } $cast_macro =~ s/\\\n\s*//g; $cast_macro =~ s/\s+/ /g; - if ($cast_macro =~ /G_TYPE_CHECK_(\w+)_CAST.*,\s*(\w+),\s*(\w+)/) { + if ($cast_macro =~ /G_TYPE_CHECK_(\w+)_CAST.*,\s*(\w+),\s*(\w+)\)/) { if ($1 eq "INSTANCE") { $objects{$2} = $3 . $objects{$2}; } else { $objects{$2} .= ":$3"; } + } elsif ($cast_macro =~ /G_TYPE_CHECK_(\w+)_CAST.*,\s*([a-zA-Z0-9]+)_(\w+)_get_type\s*\(\),\s*(\w+)\)/) { + $typename = uc ("$2_type_$3"); + if ($1 eq "INSTANCE") { + $objects{$typename} = $4 . $objects{$typename}; + } else { + $objects{$typename} .= ":$4"; + } } elsif ($cast_macro =~ /GTK_CHECK_CAST.*,\s*(\w+),\s*(\w+)/) { $objects{$1} = $2 . $objects{$1}; } elsif ($cast_macro =~ /GTK_CHECK_CLASS_CAST.*,\s*(\w+),\s*(\w+)/) { @@ -309,7 +316,6 @@ ############################################################## foreach $type (sort(keys(%objects))) { - ($inst, $class) = split(/:/, $objects{$type}); $class = $inst . "Class" if (!$class); $initfunc = $pedefs{lc($inst)}; @@ -619,8 +625,9 @@ $fmt = $1; $args = $2; ($params_el, @junk) = $el->getElementsByTagName ("parameters"); (@params) = $params_el->getElementsByTagName ("parameter"); - $params[$fmt-1]->setAttribute ("printf_format", "true"); - $params[$args-1]->setAttribute ("printf_format_args", "true"); + $offset = 1 + $drop_1st; + $params[$fmt-$offset]->setAttribute ("printf_format", "true"); + $params[$args-$offset]->setAttribute ("printf_format_args", "true"); } } } @@ -754,6 +761,7 @@ $parm =~ s/(\w+)\s+const /const \1 /g; $parm =~ s/(\*+)\s*const\s+/\1 /g; $parm =~ s/const\s+/const-/g; + $parm =~ s/unsigned\s+/unsigned-/g; if ($parm =~ /(.*)\(\s*\**\s*(\w+)\)\s+\((.*)\)/) { my $ret = $1; my $cbn = $2; my $params = $3; $cb_elem = addNameElem($parms_elem, 'callback', $cbn); @@ -869,7 +877,7 @@ } else { $tok =~ s/_TYPE//; $tok =~ s/\|.*STATIC_SCOPE//; - $tok =~ s/\s+//g; + $tok =~ s/\W+//g; return StudlyCaps (lc($tok)); } } Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- ApiGen.hs 27 Feb 2005 20:02:15 -0000 1.18 +++ ApiGen.hs 1 Mar 2005 21:20:44 -0000 1.19 @@ -165,7 +165,7 @@ "OBJECT_NAME" -> ss $ module_name moduleInfo "AUTHORS" -> ss $ concat $ intersperse ", " $ module_authors moduleInfo "COPYRIGHT" -> ss $ concat $ intersperse ", " $ module_copyright_holders moduleInfo - "DESCRIPTION" -> haddocFormatSpans knownTypes False 3 (moduledoc_summary moduleDoc) + "DESCRIPTION" -> haddocFormatParas knownTypes False (moduledoc_summary moduleDoc) "DOCUMENTATION" -> genModuleDocumentation knownTypes moduleDoc "TODO" -> genTodoItems object "MODULE_NAME" -> ss $ if null (module_prefix moduleInfo) Index: gtk-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gtk-sources.xml,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- gtk-sources.xml 17 Feb 2005 00:13:21 -0000 1.4 +++ gtk-sources.xml 1 Mar 2005 21:20:45 -0000 1.5 @@ -3,6 +3,8 @@ <library name="gtk"> <namespace name="Gtk"> <dir>gtk+/gtk</dir> + <!-- Stuff that breaks the gapi parser --> + <exclude>gtk+/gtk/gtkclipboard.c</exclude> <!-- Internal stuff --> <exclude>gtk+/gtk/gtkfilechooserdefault.c</exclude> <exclude>gtk+/gtk/gtkfilechooserdefault.h</exclude> Index: Docs.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Docs.hs,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- Docs.hs 14 Feb 2005 02:10:49 -0000 1.2 +++ Docs.hs 1 Mar 2005 21:20:44 -0000 1.3 @@ -15,6 +15,9 @@ import qualified Text.XML.HaXml as Xml +import Char (isUpper) +import List (partition) + ------------------------------------------------------------------------------- -- Types representing the content of the documentation XML file ------------------------------------------------------------------------------- @@ -23,14 +26,16 @@ data ModuleDoc = ModuleDoc { moduledoc_name :: String, -- these docs apply to this object moduledoc_altname :: String, -- sometimes a better index entry - moduledoc_summary :: [DocParaSpan], -- a one line summary + moduledoc_summary :: [DocPara], -- usually 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) moduledoc_functions :: [FuncDoc], -- documentation for each function + moduledoc_callbacks :: [FuncDoc], -- documentation for callback types moduledoc_properties :: [PropDoc], -- documentation for each property - moduledoc_signals :: [SignalDoc] -- documentation for each signal - } + moduledoc_signals :: [SignalDoc], -- documentation for each signal + moduledoc_since :: String -- which version of the api the + } -- module is available from, eg "2.4" noModuleDoc = ModuleDoc { moduledoc_name = "", @@ -40,8 +45,10 @@ moduledoc_sections = [], moduledoc_hierarchy = [], moduledoc_functions = [], + moduledoc_callbacks = [], moduledoc_properties = [], - moduledoc_signals = [] + moduledoc_signals = [], + moduledoc_since = "" } data DocSection = DocSection { @@ -104,8 +111,11 @@ 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 ] + (callbacks, functions') = partition (isUpper.head.funcdoc_name) + (map extractDocFunc functions) in (extractDocModuleinfo moduleinfo) { - moduledoc_functions = map extractDocFunc functions, + moduledoc_functions = functions', + moduledoc_callbacks = callbacks, moduledoc_properties = map extractDocProp properties, moduledoc_signals = map extractDocSignal signals } @@ -126,13 +136,15 @@ in ModuleDoc { moduledoc_name = Xml.verbatim name, moduledoc_altname = Xml.verbatim altname, - moduledoc_summary = map extractDocParaSpan summary, + moduledoc_summary = [DocParaText (map extractDocParaSpan summary)], moduledoc_description = concatMap extractDocPara paras, moduledoc_sections = map extractDocSection sections, moduledoc_hierarchy = map extractDocParaSpan objHierSpans, moduledoc_functions = undefined, + moduledoc_callbacks = undefined, moduledoc_properties = undefined, - moduledoc_signals = undefined + moduledoc_signals = undefined, + moduledoc_since = "" } extractDocSection :: Xml.Content -> DocSection @@ -156,7 +168,8 @@ )) = let since = case since' of [] -> "" - [Xml.CString _ since] -> since + [Xml.CString _ since] | last since == '.' -> init since + | otherwise -> since in FuncDoc { funcdoc_name = name, funcdoc_paragraphs = concatMap extractDocPara paras, |
