Menu
▾
▴
[Gtk2hs-commit] gtk2hs/tools/apiGen CodeGen.hs,1.8,1.9 ModuleScan.hs,1.3,1.4 Template.chs,1.7,1.8 FormatDocs.hs,1.6,1.7 MarshalFixup.hs,1.1,1.2 Makefile,1.9,1.10
|
From: Duncan C. <dun...@us...> - 2005-02-25 01:32:38
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31080/tools/apiGen Modified Files: CodeGen.hs ModuleScan.hs Template.chs FormatDocs.hs MarshalFixup.hs Makefile Log Message: Move TODO messages before Haddock markup section. Move name fixup information to the MarshalFixup module. Use the short {# call foo_bar #} form rather than the full {# call gtk_foo_bar #} when the original module uses this form. Index: Template.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Template.chs,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- Template.chs 11 Feb 2005 18:03:14 -0000 1.7 +++ Template.chs 25 Feb 2005 01:32:11 -0000 1.8 @@ -18,13 +18,13 @@ -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. --- +--@TODO@ -- | -- Maintainer : gtk2hs-users\@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- --- @DESCRIPTION@@TODO@ +-- @DESCRIPTION@ -- module @MODULE_NAME@ ( @DOCUMENTATION@ Index: ModuleScan.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ModuleScan.hs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- ModuleScan.hs 17 Feb 2005 13:51:35 -0000 1.3 +++ ModuleScan.hs 25 Feb 2005 01:32:11 -0000 1.4 @@ -32,7 +32,8 @@ } deriving Show data MethodInfo = MethodInfo { - methodinfo_cname :: String, + methodinfo_cname :: String, -- the full gtk_foo_bar + methodinfo_shortcname :: String, -- just foo_bar methodinfo_unsafe :: Bool -- {#call unsafe foo#} rather than {#call foo#} } deriving Show @@ -170,10 +171,13 @@ scanCCall tokens = case takeWhile (\t -> t/="#}" && t/="#}."&& t/="#})") . tail . dropWhile (/="{#") $ tokens of ("call":"unsafe":cname:[]) -> CCall MethodInfo { methodinfo_cname = cname, + methodinfo_shortcname = cname, methodinfo_unsafe = True } ("call": cname:[]) -> CCall MethodInfo { methodinfo_cname = cname, + methodinfo_shortcname = cname, methodinfo_unsafe = False } ("call":"fun":"unsafe":cname:[]) -> CCall MethodInfo { methodinfo_cname = cname, + methodinfo_shortcname = cname, methodinfo_unsafe = True } ("fun":"pure":_) -> None ("type":_) -> None Index: CodeGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- CodeGen.hs 23 Feb 2005 14:12:35 -0000 1.8 +++ CodeGen.hs 25 Feb 2005 01:32:11 -0000 1.9 @@ -56,7 +56,7 @@ formatParamTypes (paramTypes ++ [returnType]) body = foldl (\body marshaler -> marshaler body) call (paramMarshalers++[returnMarshaler]) - call = ss (genCall (method_cname method) safety) + call = ss (genCall (maybe (method_cname method) methodinfo_shortcname info) safety) safety = case info of Nothing -> False Just info -> methodinfo_unsafe info @@ -369,9 +369,10 @@ , not $ null [ () | VarArgs <- method_parameters method] ] in if null varargsFunctions then id - else nl. comment. nl. comment. + else nl. comment. ss "TODO: the following varargs functions were not bound\n". - lines (map (ss "-- * ".) varargsFunctions) + lines (map (ss "-- ".) varargsFunctions). + ss "\n--" type Deprecated = Bool notDeprecated = False Index: FormatDocs.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/FormatDocs.hs,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- FormatDocs.hs 23 Feb 2005 14:12:35 -0000 1.6 +++ FormatDocs.hs 25 Feb 2005 01:32:11 -0000 1.7 @@ -22,6 +22,7 @@ import Api (NameSpace(namespace_name)) import Docs import Marshal (stripKnownPrefixes, knownMiscType, KnownSymbols, CSymbol(..)) +import MarshalFixup (fixCFunctionName) import StringUtils import Maybe (isJust) @@ -172,6 +173,7 @@ case lookupFM knownSymbols text of Nothing -> "@" ++ escapeHaddockSpecialChars text ++ "@" Just SymEnumValue -> "'" ++ cConstNameToHsName text ++ "'" + Just (SymObjectType _) -> "'" ++ stripKnownPrefixes text ++ "'" _ -> "{" ++ text ++ ", FIXME: unknown literal value}" --TODO fill in the other cases haddocFormatSpan _ _ (DocArg text) = "@" ++ cParamNameToHsName text ++ "@" @@ -179,10 +181,7 @@ cFuncNameToHsName = lowerCaseFirstChar . stripKnownPrefixes - . concatMap upperCaseFirstChar - . map fixNames - . filter (not.null) --to ignore tailing underscores - . splitBy '_' + . toStudlyCapsWithFixups . takeWhile ('('/=) cParamNameToHsName :: String -> String @@ -202,23 +201,12 @@ . filter (not.null) --to ignore tailing underscores . splitBy '_' --- some special cases -fixNames :: String -> String -fixNames "hadjustment" = "HAdjustment" -fixNames "vadjustment" = "VAdjustment" -fixNames "hscale" = "HScale" -fixNames "vscale" = "VScale" -fixNames "hbox" = "HBox" -fixNames "vbox" = "VBox" -fixNames "hbutton" = "HButton" -fixNames "vbutton" = "VButton" -fixNames "hpaned" = "HPaned" -fixNames "vpaned" = "VPaned" -fixNames "hseparator" = "HSeparator" -fixNames "vseparator" = "VSeparator" -fixNames "hscrollbar" = "HScrollbar" -fixNames "vscrollbar" = "VScrollbar" -fixNames other = other +toStudlyCapsWithFixups :: String -> String +toStudlyCapsWithFixups = --change "gtk_foo_bar" to "GtkFooBar" + concatMap upperCaseFirstChar + . map fixCFunctionName + . filter (not.null) --to ignore tailing underscores + . splitBy '_' changeIllegalNames :: String -> String changeIllegalNames "type" = "type_" --this is a common variable name in C but of Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- Makefile 17 Feb 2005 13:51:35 -0000 1.9 +++ Makefile 25 Feb 2005 01:32:11 -0000 1.10 @@ -144,7 +144,7 @@ # tools # ApiGen : ApiGen.hs Api.hs Docs.hs FormatDocs.hs \ - Marshal.hs CodeGen.hs StringUtils.hs ModuleScan.hs + Marshal.hs CodeGen.hs StringUtils.hs ModuleScan.hs MarshalFixup.hs ghc --make $< -o $@ gapi_format_xml : formatXml.c Index: MarshalFixup.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/MarshalFixup.hs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- MarshalFixup.hs 23 Feb 2005 14:12:35 -0000 1.1 +++ MarshalFixup.hs 25 Feb 2005 01:32:11 -0000 1.2 @@ -13,6 +13,27 @@ stripKnownPrefixes ('G':'n':'o':'m':'e':remainder) = remainder stripKnownPrefixes other = other +-- some special cases for when converting "gtk_foo_bar" to "GtkFooBar" +-- eg instead of doing gtk_hadjustment -> GtkHadjustment +-- we would prefer gtk_hadjustment -> GtkHAdjustment +-- so list those special cases here: +fixCFunctionName :: String -> String +fixCFunctionName "hadjustment" = "HAdjustment" +fixCFunctionName "vadjustment" = "VAdjustment" +fixCFunctionName "hscale" = "HScale" +fixCFunctionName "vscale" = "VScale" +fixCFunctionName "hbox" = "HBox" +fixCFunctionName "vbox" = "VBox" +fixCFunctionName "hbutton" = "HButton" +fixCFunctionName "vbutton" = "VButton" +fixCFunctionName "hpaned" = "HPaned" +fixCFunctionName "vpaned" = "VPaned" +fixCFunctionName "hseparator" = "HSeparator" +fixCFunctionName "vseparator" = "VSeparator" +fixCFunctionName "hscrollbar" = "HScrollbar" +fixCFunctionName "vscrollbar" = "VScrollbar" +fixCFunctionName other = other + -- These are ones we have bound and so we can make documentation references to -- them. Otherwise we generate FIXME messages in the docs. knownMiscType :: String -> Bool |
