Menu
▾
▴
gtk2hs-commit — Mailing list for Darcs commit messages.
You can subscribe to this list here.
| 2003 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(4) |
Jun
|
Jul
(68) |
Aug
(4) |
Sep
|
Oct
(23) |
Nov
(95) |
Dec
(9) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2004 |
Jan
(3) |
Feb
|
Mar
|
Apr
(51) |
May
(81) |
Jun
(2) |
Jul
(86) |
Aug
(143) |
Sep
(3) |
Oct
(31) |
Nov
(63) |
Dec
(90) |
| 2005 |
Jan
(277) |
Feb
(157) |
Mar
(99) |
Apr
(195) |
May
(151) |
Jun
(148) |
Jul
(98) |
Aug
(123) |
Sep
(20) |
Oct
(174) |
Nov
(155) |
Dec
(26) |
| 2006 |
Jan
(51) |
Feb
(19) |
Mar
(16) |
Apr
(12) |
May
(5) |
Jun
|
Jul
(11) |
Aug
(7) |
Sep
(10) |
Oct
(31) |
Nov
(174) |
Dec
(56) |
| 2007 |
Jan
(45) |
Feb
(52) |
Mar
(10) |
Apr
(5) |
May
(47) |
Jun
(16) |
Jul
(80) |
Aug
(29) |
Sep
(14) |
Oct
(59) |
Nov
(46) |
Dec
(16) |
| 2008 |
Jan
(10) |
Feb
(1) |
Mar
|
Apr
|
May
(49) |
Jun
(26) |
Jul
(8) |
Aug
(4) |
Sep
(25) |
Oct
(53) |
Nov
(9) |
Dec
(1) |
| 2009 |
Jan
(66) |
Feb
(11) |
Mar
(1) |
Apr
(14) |
May
(8) |
Jun
(1) |
Jul
(2) |
Aug
(2) |
Sep
(9) |
Oct
(23) |
Nov
(35) |
Dec
|
| 2010 |
Jan
(7) |
Feb
(2) |
Mar
(39) |
Apr
(19) |
May
(161) |
Jun
(19) |
Jul
(32) |
Aug
(65) |
Sep
(113) |
Oct
(120) |
Nov
(2) |
Dec
|
| 2012 |
Jan
|
Feb
(5) |
Mar
(4) |
Apr
(7) |
May
(9) |
Jun
(14) |
Jul
(1) |
Aug
|
Sep
(1) |
Oct
(1) |
Nov
(12) |
Dec
(2) |
| 2013 |
Jan
(1) |
Feb
(17) |
Mar
(4) |
Apr
(4) |
May
(9) |
Jun
|
Jul
(8) |
Aug
|
Sep
(2) |
Oct
|
Nov
|
Dec
|
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:26
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Embedding In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/Embedding Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Embedding added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:26
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Gdk In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/Gdk Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Gdk added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:26
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/Misc Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:26
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Multiline In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/Multiline Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Multiline added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:25
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/MenuComboToolbar Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:25
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/Layout Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:25
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/General In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/General Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/General added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:22
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Display In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/Display Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Display added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:22
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/Entry Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:21
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/Abstract Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:01:21
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Buttons In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17153/gtk/Graphics/UI/Gtk/Buttons Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Buttons added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:00:25
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16827/gtk/Graphics Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:00:25
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16827/gtk/Graphics/UI Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 14:00:24
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16827/gtk/Graphics/UI/Gtk Log Message: Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-08 07:37:21
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22606 Modified Files: ChangeLog Log Message: Extend the XSLT script to extract module level documentation, the summary, description and any extra sections including program listings. The object hierarchy has not yet been added. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.263 retrieving revision 1.264 diff -u -d -r1.263 -r1.264 --- ChangeLog 7 Jan 2005 17:45:39 -0000 1.263 +++ ChangeLog 8 Jan 2005 07:37:10 -0000 1.264 @@ -4,6 +4,10 @@ module level documentation and produce contents list. Also note in the documentation what gtk version the module as a whole and individual functions are avaliable from, eg "available since Gtk version 2.4". + + * tools/apiGen/format-docs.xsl: extract module level documentation, + the summary, description and any extra sections including program + listings. The object hierarchy has not yet been added. * tools/apiGen/Template.chs: added Haddock headers and rename some template variables. Move major documentation section to export list. |
|
From: Duncan C. <dun...@us...> - 2005-01-08 07:37:21
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22606/tools/apiGen Modified Files: format-docs.xsl Log Message: Extend the XSLT script to extract module level documentation, the summary, description and any extra sections including program listings. The object hierarchy has not yet been added. Index: format-docs.xsl =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/format-docs.xsl,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- format-docs.xsl 6 Jan 2005 01:02:22 -0000 1.1 +++ format-docs.xsl 8 Jan 2005 07:37:11 -0000 1.2 @@ -13,7 +13,7 @@ </xsl:template> <xsl:template match="xref"> -<xref-other><xsl:value-of select="."/></xref-other> +<xref-other><xsl:value-of select="@linkend"/></xref-other> </xsl:template> <xsl:template match="emphasis"> @@ -30,6 +30,31 @@ <xsl:template match="/"> <apidoc> + <module> + <name><xsl:value-of select="/book/refentry/refnamediv/refname"/></name> + <summary><xsl:value-of select="/book/refentry/refnamediv/refpurpose"/></summary> + <description> + <xsl:for-each select="/book/refentry/refsect1[title='Description']/para"> + <para><xsl:apply-templates/></para> + </xsl:for-each> + </description> + <extra-sections> + <xsl:for-each select="/book/refentry/refsect1[title='Description']/section"> + <section> + <title><xsl:value-of select="title"/></title> + <xsl:for-each select="para | programlisting"> + <xsl:if test="name()='para'"> + <para><xsl:apply-templates/></para> + </xsl:if> + <xsl:if test="name()='programlisting'"> + <xsl:copy-of select="."/> + </xsl:if> + </xsl:for-each> + </section> + </xsl:for-each> + </extra-sections> + <object-hierarchy></object-hierarchy> + </module> <xsl:for-each select="/book/refentry/refsect1[title='Details']/refsect2[contains(title,' ()')]"> <function> <name><xsl:value-of select="indexterm/primary"/></name> |
|
From: Duncan C. <dun...@us...> - 2005-01-07 17:45:51
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30094 Modified Files: ChangeLog Log Message: Update the ApiGen tool to produce more and better formatted documentation. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.262 retrieving revision 1.263 diff -u -d -r1.262 -r1.263 --- ChangeLog 20 Dec 2004 03:30:58 -0000 1.262 +++ ChangeLog 7 Jan 2005 17:45:39 -0000 1.263 @@ -1,3 +1,26 @@ +2005-01-07 Duncan Coutts <du...@co...> + + * tools/apiGen/ApiGen.hs: several documentation improvements, add + module level documentation and produce contents list. Also note in the + documentation what gtk version the module as a whole and individual + functions are avaliable from, eg "available since Gtk version 2.4". + + * tools/apiGen/Template.chs: added Haddock headers and rename some + template variables. Move major documentation section to export list. + + * tools/apiGen/gen-all.sh: fix buglet. + + * tools/apiGen/README: update TODO list. + +2005-01-06 Duncan Coutts <du...@co...> + + * tools/apiGen/ApiGen.hs, tools/apiGen/Template.chs + tools/apiGen/format-docs.xsl, tools/apiGen/gen-all.sh, + tools/apiGen/gapi2xml.pl, tools/apiGen/gapi_pp.pl, + tools/apiGen/README: new tool to semi-automatically generate binding + modules from C headder files with Haddock documentation extracted from + gtk-doc docbook xml files. Perl scripts by gtk-sharp team. + 2004-12-19 Duncan Coutts <du...@co...> * configure.ac: add support for conditionals in Makefile.am so that |
|
From: Duncan C. <dun...@us...> - 2005-01-07 17:45:51
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30094/tools/apiGen Modified Files: ApiGen.hs Template.chs gen-all.sh README Log Message: Update the ApiGen tool to produce more and better formatted documentation. Index: README =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/README,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- README 6 Jan 2005 01:02:21 -0000 1.1 +++ README 7 Jan 2005 17:45:40 -0000 1.2 @@ -71,7 +71,5 @@ Some improvements that would be good: * Complete marshaling code for more types * Emit top level module documentation, including: - - module summary / description - object heirarchy - * Add a Haddock contents annotations (eg: constructors, methods, signals) * Emit signal and property bindings with documentation Index: Template.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Template.chs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- Template.chs 6 Jan 2005 01:02:22 -0000 1.1 +++ Template.chs 7 Jan 2005 17:45:40 -0000 1.2 @@ -17,10 +17,16 @@ -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- --- | @MODULE_DOCUMENTATION@ @MODULE_TODO@ +-- | +-- Maintainer : gtk2hs-users\@lists.sourceforge.net +-- Stability : provisional +-- Portability : non-portable (uses gtk+ C library) +-- +-- @DESCRIPTION@ @TODO@ -- module @MODULE_NAME@ ( -@MODULE_EXPORTS@ +@DOCUMENTATION@ +@EXPORTS@ ) where import Monad (liftM) Index: gen-all.sh =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gen-all.sh,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- gen-all.sh 6 Jan 2005 01:02:22 -0000 1.1 +++ gen-all.sh 7 Jan 2005 17:45:40 -0000 1.2 @@ -16,7 +16,7 @@ ./gapi_pp.pl $HEADDER | ./gapi2xml.pl Gtk $APIFILE gtk+ >> /dev/null || exit # ./gapi_format_xml $APIFILE.tmp $APIFILE || exit - rm $APIFILE.tmp +# rm $APIFILE.tmp if test -f $DOCBOOKFRAG; then cat <(echo \ Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- ApiGen.hs 6 Jan 2005 01:02:21 -0000 1.1 +++ ApiGen.hs 7 Jan 2005 17:45:40 -0000 1.2 @@ -5,9 +5,10 @@ import Prelude hiding (Enum, lines) import Monad (when) -import Maybe (catMaybes) +import Maybe (catMaybes, fromJust) import Char (toLower, toUpper, isAlpha, isAlphaNum, isUpper) import List (isPrefixOf, groupBy, sortBy) +import qualified List (lines) import System (getArgs, exitWith, ExitCode(..)) import qualified Text.XML.HaXml as Xml @@ -161,12 +162,35 @@ ------------------------------------------------------------------------------- data ApiDoc = ApiDoc { - doc_target :: String, -- C function name - doc_paragraphs :: [DocPara], -- documentation markup - doc_since :: Maybe String -- which version of the api the + apidoc_name :: String, + apidoc_summary :: String, + apidoc_description :: [DocPara], + apidoc_extrasections :: [DocSection], + apidoc_functions :: [FuncDoc] + } + +noApiDoc = ApiDoc { + apidoc_name = "", + apidoc_summary = "", + apidoc_description = [], + apidoc_extrasections = [], + apidoc_functions = [] + } + +data DocSection = DocSection { + section_title :: String, + section_paras :: [DocPara] + } + +data FuncDoc = FuncDoc { + funcdoc_name :: String, -- C function name + funcdoc_paragraphs :: [DocPara], -- documentation markup + funcdoc_since :: Maybe String -- which version of the api the } -- function is avaliable from, eg "2.4" -type DocPara = [DocParaSpan] +data DocPara = TextPara [DocParaSpan] + | ProgramListing String + data DocParaSpan = DocText String -- just simple text | DocFuncXRef String -- cross reference to a function name | DocTypeXRef String -- cross reference to a type name @@ -175,11 +199,40 @@ | DocLiteral String -- some literal like numbers | DocArg String -- function argument names -extractDocumentation :: Xml.Document -> [ApiDoc] -extractDocumentation (Xml.Document _ _ (Xml.Elem "apidoc" [] functions)) = - map extractDocFunc functions +extractDocumentation :: Xml.Document -> ApiDoc +extractDocumentation (Xml.Document _ _ (Xml.Elem "apidoc" [] (moduleinfo:functions))) = + (extractDocModuleinfo moduleinfo) { + apidoc_functions = map extractDocFunc functions + } -extractDocFunc :: Xml.Content -> ApiDoc +extractDocModuleinfo :: Xml.Content -> ApiDoc +extractDocModuleinfo + (Xml.CElem (Xml.Elem "module" [] + [Xml.CElem (Xml.Elem "name" [] name) + ,Xml.CElem (Xml.Elem "summary" [] summary) + ,Xml.CElem (Xml.Elem "description" [] paras) + ,Xml.CElem (Xml.Elem "extra-sections" [] sections) + ,Xml.CElem (Xml.Elem "object-hierarchy" [] _)] + )) = ApiDoc { + apidoc_name = Xml.verbatim name, + apidoc_summary = Xml.verbatim summary, + apidoc_description = map extractDocPara paras, + apidoc_extrasections = map extractDocSection sections, + apidoc_functions = undefined + } + +extractDocSection :: Xml.Content -> DocSection +extractDocSection + (Xml.CElem (Xml.Elem "section" [] + (Xml.CElem (Xml.Elem "title" [] [Xml.CString _ title]) + :paras))) = + DocSection { + section_title = title, + section_paras = map extractDocPara paras + } +extractDocSection other = error $ "extractDocSection: " ++ Xml.verbatim other + +extractDocFunc :: Xml.Content -> FuncDoc extractDocFunc (Xml.CElem (Xml.Elem "function" [] [Xml.CElem (Xml.Elem "name" [] [Xml.CString _ name]) @@ -189,20 +242,23 @@ let since = case since' of [] -> Nothing [Xml.CString _ since] -> Just since - in ApiDoc { - doc_target = name, - doc_paragraphs = map extractDocPara paras, - doc_since = since + in FuncDoc { + funcdoc_name = name, + funcdoc_paragraphs = map extractDocPara paras, + funcdoc_since = since } - + extractDocPara :: Xml.Content -> DocPara extractDocPara (Xml.CElem elem@(Xml.Elem "para" [] _)) = case Xml.xmlUnEscape Xml.stdXmlEscaper elem of - (Xml.Elem _ [] spans) -> map extractDocParaSpan spans + (Xml.Elem _ [] spans) -> TextPara (map extractDocParaSpan spans) +extractDocPara (Xml.CElem (Xml.Elem "programlisting" _ [Xml.CString _ listing])) = + ProgramListing listing extractDocParaSpan :: Xml.Content -> DocParaSpan extractDocParaSpan (Xml.CString _ text) = DocText text -extractDocParaSpan (Xml.CElem (Xml.Elem tag [] (CString _ text))) = +extractDocParaSpan (Xml.CElem (Xml.Elem tag [] content)) = + let text = concat [ str | (Xml.CString _ str) <- content ] in case tag of "xref-func" -> DocFuncXRef text "xref-type" -> DocTypeXRef text @@ -212,28 +268,92 @@ "arg" -> DocArg text extractDocParaSpan other = error $ "extractDocParaSpan: " ++ Xml.verbatim other +------------------------------------------------------------------------------- +-- Functions for formatting haddock documentation +------------------------------------------------------------------------------- + +genModuleDocumentation :: ApiDoc -> ShowS +genModuleDocumentation apidoc = + (if null (apidoc_description apidoc) + then id + else comment.ss "* Description".nl. + comment.nl. + comment.ss "| ".haddocFormatParas (apidoc_description apidoc).nl). + (if null (apidoc_extrasections apidoc) + then id + else nl.comment.haddocFormatSections (apidoc_extrasections apidoc).nl.comment) + +addVersionParagraphs :: NameSpace -> ApiDoc -> ApiDoc +addVersionParagraphs namespace apiDoc = + apiDoc { + apidoc_description = apidoc_description apiDoc ++ moduleVersionParagraph, + apidoc_functions = functionVersionParagraphs moduleVersion (apidoc_functions apiDoc) + } + where functionVersionParagraphs :: Maybe 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 + ++ " version " ++ fromJust (funcdoc_since funcdoc) + in [TextPara [DocText line]] + } + else funcdoc + | funcdoc <- funcdocs ] + + moduleVersionParagraph = + case moduleVersion of + Nothing -> [] + Just since -> + let line = "Module available since " ++ namespace_name namespace + ++ " version " ++ since + in [TextPara [DocText line]] + + -- figure out if the whole module appeared in some version of gtk later + -- than the original version + moduleVersion :: Maybe String + moduleVersion = minimum [ funcdoc_since funcdoc + | funcdoc <- apidoc_functions apiDoc ] + +haddocFormatSections :: [DocSection] -> ShowS +haddocFormatSections = + sepBy' "\n\n-- " + . map (\section -> + ss "* ". ss (section_title section). nl. + comment.nl. + comment.ss "| ".haddocFormatParas (section_paras section)) + haddocFormatParas :: [DocPara] -> ShowS haddocFormatParas = - ((ss "-- | ". drop 3).) - . cat - . map ((.(ss "--\n")) - . cat - . map (\line -> (ss "-- ").line.ss "\n") - . map (sepBy " ") - . wrapText 77 - . words - . concatMap haddocFormatSpan) + sepBy' "\n--\n-- " + . map haddocFormatPara + +haddocFormatPara :: DocPara -> ShowS +haddocFormatPara (TextPara spans) = + sepBy' "\n-- " + . map (sepBy " ") + . wrapText 77 + . words + . concatMap haddocFormatSpan + $ spans +haddocFormatPara (ProgramListing prog) = + ((ss "* FIXME: port the follwing code example from C to Haskell or remove it".nl. + comment).) + . sepBy "\n-- > " + . List.lines + $ prog haddocFormatSpan :: DocParaSpan -> String haddocFormatSpan (DocText text) = escapeHaddockSpecialChars text -haddocFormatSpan (DocTypeXRef text) = "\"" ++ 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@" --likely that something should be changed to a Maybe type if this is emitted: -haddocFormatSpan (DocLiteral "NULL") = "@CHECKME: Nothing@" +haddocFormatSpan (DocLiteral "NULL") = "{@NULL@, FIXME: this should probably be converted" + ++ "to a Maybe data type}" haddocFormatSpan (DocLiteral text) = "@" ++ text ++ "@" haddocFormatSpan (DocArg text) = "@" ++ text ++ "@" @@ -241,7 +361,7 @@ cFuncNameToHsName = lowerCaseFirstChar . stripKnownPrefixes - . concatMap (upperCaseFirstChar "cFuncNameToHsName") + . concatMap upperCaseFirstChar . splitBy '_' . takeWhile ('('/=) @@ -256,7 +376,7 @@ -- wraps a list of words to lines of words wrapText :: Int -> [String] -> [[String]] -wrapText width = wrap 3 [] +wrapText width = wrap 0 [] where wrap :: Int -> [String] -> [String] -> [[String]] wrap col line (word:words) | col + length word + 1 > width = reverse line : wrap 0 [] (word:words) @@ -267,7 +387,7 @@ ------------------------------------------------------------------------------- -- Now lets actually generate some code fragments based on the api info ------------------------------------------------------------------------------- -genFunction :: Object -> Method -> Maybe ApiDoc -> ShowS +genFunction :: Object -> Method -> Maybe FuncDoc -> ShowS genFunction object method doc = formattedDoc. ss functionName. ss " :: ". functionType. nl. @@ -294,14 +414,15 @@ call = ss "{# call ". ss (method_cname method). ss " #}" formattedDoc = case doc of Nothing -> ss "-- | \n-- \n" - Just doc -> haddocFormatParas (doc_paragraphs doc) + Just doc -> ss "-- | ". haddocFormatParas (funcdoc_paragraphs doc). nl. + comment. nl -genMethods :: Object -> [ApiDoc] -> [(ShowS, Maybe ApiDoc)] +genMethods :: Object -> [FuncDoc] -> [(ShowS, Maybe FuncDoc)] genMethods object apiDoc = [ (genFunction object method doc, doc) | (method, doc) <- methods object apiDoc ] -methods :: Object -> [ApiDoc] -> [(Method, Maybe ApiDoc)] +methods :: Object -> [FuncDoc] -> [(Method, Maybe FuncDoc)] methods object docs = map snd $ sortBy (\(i,_) (j,_) -> i `compare` j) @@ -310,7 +431,7 @@ (Just (doc, index)) -> (index,(mungeMethod object method, Just doc)) | method <- object_methods object , null [ () | VarArgs <- method_parameters method] ] --exclude VarArgs methods - where docmap = [ (doc_target doc, (doc,index)) | (doc,index) <- zip docs [1..]] + where docmap = [ (funcdoc_name doc, (doc,index)) | (doc,index) <- zip docs [1..]] mungeMethod :: Object -> Method -> Method @@ -325,24 +446,24 @@ method_parameters = self : method_parameters method } -genConstructors :: Object -> [ApiDoc] -> [(ShowS, Maybe ApiDoc)] +genConstructors :: Object -> [FuncDoc] -> [(ShowS, Maybe FuncDoc)] genConstructors object apiDoc = [ (genFunction object constructor doc, doc) | (constructor, doc) <- constructors object apiDoc ] -constructors :: Object -> [ApiDoc] -> [(Method, Maybe ApiDoc)] +constructors :: Object -> [FuncDoc] -> [(Method, Maybe FuncDoc)] constructors object docs = [ (mungeConstructor object constructor, constructor_cname constructor `lookup` docmap) | constructor <- object_constructors object , null [ () | VarArgs <- constructor_parameters constructor] ] - where docmap = [ (doc_target doc, doc) | doc <- docs ] + where docmap = [ (funcdoc_name doc, doc) | doc <- docs ] mungeConstructor :: Object -> Constructor -> Method mungeConstructor object constructor = Method { method_name = (object_name object++) . drop (length (object_cname object)) - . concatMap (upperCaseFirstChar "mungeConstructor") + . concatMap upperCaseFirstChar . splitBy '_' . constructor_cname $ constructor, @@ -351,11 +472,19 @@ method_parameters = constructor_parameters constructor } -genExports :: Object -> [ApiDoc] -> ShowS +genExports :: Object -> [FuncDoc] -> ShowS genExports object docs = + nl. + comment.ss "* Constructors".nl. doVersionIfDefs [ (ss " ". ss (lowerCaseFirstChar (method_name constructor)). sc ',', doc) - | (constructor, doc) <- constructors object docs ++ methods object docs] + | (constructor, doc) <- constructors object docs]. + nl. + nl. + comment.ss "* Methods".nl. + doVersionIfDefs + [ (ss " ". ss (lowerCaseFirstChar (method_name method)). sc ',', doc) + | (method, doc) <- methods object docs] genTodoItems :: Object -> ShowS genTodoItems object = @@ -373,15 +502,15 @@ ss "TODO: the following varargs functions were not bound\n". lines (map (ss "-- * ".) varargsFunctions) -doVersionIfDefs :: [(ShowS, Maybe ApiDoc)] -> ShowS +doVersionIfDefs :: [(ShowS, Maybe FuncDoc)] -> ShowS doVersionIfDefs = lines . map (\group -> sinceVersion (snd (head group)) (lines (map fst group))) - . groupBy (\(_,a) (_,b) -> fmap doc_since a == fmap doc_since b) + . groupBy (\(_,a) (_,b) -> fmap funcdoc_since a == fmap funcdoc_since b) -sinceVersion :: Maybe ApiDoc -> ShowS -> ShowS -sinceVersion (Just (ApiDoc _ _ (Just (major:'.':minor:[])))) body = +sinceVersion :: Maybe FuncDoc -> ShowS -> ShowS +sinceVersion (Just (FuncDoc _ _ (Just (major:'.':minor:[])))) body = ss "#if GTK_CHECK_VERSION(". sc major. ss ",". sc minor. ss ",0)\n". body. ss "\n#endif" @@ -415,7 +544,8 @@ (Nothing, Just "Int", \body -> body. ss " (fromIntegral ". ss name. ss ")") -genMarshalParameter name "const-gchar*" = +genMarshalParameter name typeName | typeName == "const-gchar*" + || typeName == "const-char*" = (Nothing, Just "String", \body -> ss "withUTFString ". ss name. ss " $ \\". ss name. ss "Ptr ->". indent 1. body. sc ' '. ss name. ss "Ptr") @@ -483,7 +613,7 @@ --course a keyword in Haskell changeParamNames other = --change "gtk_foo_bar" to "gtkFooBar" lowerCaseFirstChar - . concatMap (upperCaseFirstChar $ "changeParamNames" ++ other) + . concatMap upperCaseFirstChar . filter (not.null) --to ignore tailing underscores . splitBy '_' $ other @@ -534,7 +664,7 @@ -- Read in the documentation xml file if supplied -- apiDoc <- if null docFile - then return [] + then return noApiDoc else do content <- readFile docFile return $ extractDocumentation (Xml.xmlParse docFile content) @@ -552,24 +682,28 @@ -- Write the result file(s) by substituting values into the template file -- mapM - (\object -> writeFile (outdir ++ object_name object ++ ".chs") $ + (\(namespace, object) -> + let apiDoc' = addVersionParagraphs namespace apiDoc in + writeFile (outdir ++ object_name object ++ ".chs") $ templateSubstitute template (\var -> case var of "YEAR" -> ss year "DATE" -> ss date "OBJECT_NAME" -> ss (object_name object) - "MODULE_DOCUMENTATION" -> ss "$MODULE_DOCUMENTATION" - "MODULE_TODO" -> genTodoItems object + "DESCRIPTION" -> ss (apidoc_summary apiDoc') + "DOCUMENTATION" -> genModuleDocumentation apiDoc' + "TODO" -> genTodoItems object "MODULE_NAME" -> ss (modPrefix ++ object_name object) - "MODULE_EXPORTS" -> genExports object apiDoc - "MODULE_IMPORTS" -> ss "$imports" + "EXPORTS" -> genExports object (apidoc_functions apiDoc') + "IMPORTS" -> ss "-- CHECKME: extra imports may be required\n" "CONTEXT_LIB" -> ss lib "CONTEXT_PREFIX" -> ss prefix - "MODULE_BODY" -> doVersionIfDefs (genConstructors object apiDoc - ++ genMethods object apiDoc) + "MODULE_BODY" -> doVersionIfDefs (genConstructors object (apidoc_functions apiDoc') + ++ genMethods object (apidoc_functions apiDoc')) _ -> ss "" - ) "") [ object | namespace <- api, - object <- namespace_objects namespace ] + ) "") [ (namespace, object) + | namespace <- api + , object <- namespace_objects namespace ] usage = do @@ -610,9 +744,8 @@ lowerCaseFirstChar :: String -> String lowerCaseFirstChar (c:cs) = toLower c : cs -upperCaseFirstChar :: String -> String -> String -upperCaseFirstChar _ (c:cs) = toUpper c : cs -upperCaseFirstChar dbgMesg cs = error $ "upperCaseFirstChar: " ++ dbgMesg ++ cs ++ " !!" +upperCaseFirstChar :: String -> String +upperCaseFirstChar (c:cs) = toUpper c : cs cat :: [ShowS] -> ShowS cat = foldl (.) id @@ -635,6 +768,7 @@ templateSubstitute :: String -> (String -> ShowS) -> ShowS templateSubstitute template varSubst = doSubst template where doSubst [] = id + doSubst ('\\':'@':cs) = sc '@' . doSubst cs doSubst ('@':cs) = let (var,_:cs') = span ('@'/=) cs in varSubst var . doSubst cs' doSubst (c:cs) = sc c . doSubst cs |
|
From: Duncan C. <dun...@us...> - 2005-01-06 01:02:31
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19876 Added Files: ApiGen.hs README Template.chs format-docs.xsl gapi2xml.pl gapi_pp.pl gen-all.sh Log Message: Add new tool for semi-automaticly generating .chs binding modules. --- NEW FILE: gapi_pp.pl --- #!/usr/bin/perl # # gapi_pp.pl : A source preprocessor for the extraction of API info from a # C library source directory. # # Authors: Mike Kestner <mke...@sp...> # Martin Willemoes Hansen <mw...@sy...> # # Copyright (c) 2001 Mike Kestner # Copyright (c) 2003 Martin Willemoes Hansen # Copyright (c) 2003 Novell, Inc. # # This program is free software; you can redistribute it and/or # modify it under the terms of version 2 of the GNU General Public # License as published by the Free Software Foundation. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public # License along with this program; if not, write to the # Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. $private_regex = "^#if.*(ENABLE_BACKEND|ENABLE_ENGINE)"; $eatit_regex = "^#if.*(__cplusplus|DEBUG|DISABLE_(DEPRECATED|COMPAT)|ENABLE_BROKEN|COMPILATION)"; $ignoreit_regex = '^\s+\*|#ident|#\s*include|#\s*else|#\s*endif|#\s*undef|G_(BEGIN|END)_DECLS|extern|GDKVAR|GTKVAR|GTKMAIN_C_VAR|GTKTYPEUTILS_VAR|VARIABLE|GTKTYPEBUILTIN'; foreach $arg (@ARGV) { if (-d $arg && -e $arg) { @hdrs = (@hdrs, `ls $arg/*.h`); @srcs = (@srcs, `ls $arg/*.c`); } elsif (-f $arg && -e $arg) { @hdrs = (@hdrs, $arg) if ($arg =~ /\.h$/); @srcs = (@srcs, $arg) if ($arg =~ /\.c$/); } else { die "unable to process arg: $arg"; } } foreach $fname (@hdrs) { if ($fname =~ /test|private|internals|gtktextlayout|gtkmarshalers/) { @privhdrs = (@privhdrs, $fname); next; } open(INFILE, $fname) || die "Could open $fname\n"; $braces = 0; $prepend = ""; while ($line = <INFILE>) { $braces++ if ($line =~ /{/ and $line !~ /}/); $braces-- if ($line =~ /}/ and $line !~ /{/); next if ($line =~ /$ignoreit_regex/); $line =~ s/\/\*.*?\*\///g; next if ($line !~ /\S/); $line = $prepend . $line; $prepend = ""; if ($line =~ /#\s*define\s+\w+\s+\"/) { $def = $line; while ($def !~ /\".*\"/) {$def .= ($line = <INFILE>);} print $def; } elsif ($line =~ /#\s*define\s+\w+\s*\D+/) { $def = $line; while ($line =~ /\\\n/) {$def .= ($line = <INFILE>);} if ($def =~ /_CHECK_\w*CAST|INSTANCE_GET_INTERFACE/) { $def =~ s/\\\n//g; print $def; } } elsif ($line =~ /^\s*\/\*/) { while ($line !~ /\*\//) {$line = <INFILE>;} } elsif ($line =~ /^#ifndef\s+\w+_H_*\b/) { while ($line !~ /#define/) {$line = <INFILE>;} } elsif ($line =~ /$private_regex/) { $nested = 0; while ($line = <INFILE>) { last if (!$nested && ($line =~ /#else|#endif/)); if ($line =~ /#if/) { $nested++; } elsif ($line =~ /#endif/) { $nested-- } next if ($line !~ /^struct/); print "private$line"; do { $line = <INFILE>; print $line; } until ($line =~ /^\}/); } } elsif ($line =~ /$eatit_regex/) { $nested = 0; while ($line = <INFILE>) { last if (!$nested && ($line =~ /#else|#endif/)); if ($line =~ /#if/) { $nested++; } elsif ($line =~ /#endif/) { $nested-- } } } elsif ($line =~ /^#\s*ifn?\s*\!?def/) { #warn "Ignored #if:\n$line"; } elsif ($line =~ /typedef struct\s*\{/) { my $first_line = $line; my @lines = (); $line = <INFILE>; while ($line !~ /^}\s*(\w+);/) { push @lines, $line; $line = <INFILE>; } $line =~ /^}\s*(\w+);/; my $name = $1; print "typedef struct _$name $name;\n"; print "struct _$name {\n"; foreach $line (@lines) { if ($line =~ /(\s*.+\;)/) { $field = $1; $field =~ s/(\w+) const/const $1/; print "$field\n"; } } print "};\n"; } elsif ($line =~ /^enum\s+\{/) { while ($line !~ /^};/) {$line = <INFILE>;} } elsif ($line =~ /(\s+)union\s*{/) { # this is a hack for now, but I need it for the fields to work $indent = $1; $do_print = 1; while ($line !~ /^$indent}\s*\w+;/) { $line = <INFILE>; next if ($line !~ /;/); print $line if $do_print; $do_print = 0; } } else { if ($braces or $line =~ /;/) { print $line; } else { $prepend = $line; $prepend =~ s/\n/ /g; } } } } foreach $fname (@srcs, @privhdrs) { open(INFILE, $fname) || die "Could open $fname\n"; if ($fname =~ /builtins_ids/) { while ($line = <INFILE>) { next if ($line !~ /\{/); chomp($line); $builtin = "BUILTIN" . $line; $builtin .= <INFILE>; print $builtin; } next; } while ($line = <INFILE>) { #next if ($line !~ /^(struct|\w+_class_init)|g_boxed_type_register_static/); next if ($line !~ /^(struct|\w+_class_init|\w+_base_init|\w+_get_type)/); if ($line =~ /^struct/) { # need some of these to parse out parent types print "private"; } $comment = 0; $begin = 0; $end = 0; do { # Following ifs strips out // and /* */ C comments if ($line =~ /\/\*/) { $comment = 1; $begin = 1; } if ($comment != 1) { $line =~ s/\/\/.*//; print $line; } if ($line =~ /\*\//) { $comment = 0; $end = 1; } if ($begin == 1 && $end == 1) { $line =~ s/\/\*.*\*\///; print $line; } $begin = 0; $end = 0; } until (($line = <INFILE>) =~ /^}/); print $line; } } --- NEW FILE: Template.chs --- -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget @OBJECT_NAME@ -- -- Author : [Insert your full name here] -- -- Created: @DATE@ -- -- Copyright (C) @YEAR@ [Insert your full name here] -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version. -- -- This library is distributed in the hope that it will be useful, -- 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. -- -- | @MODULE_DOCUMENTATION@ @MODULE_TODO@ -- module @MODULE_NAME@ ( @MODULE_EXPORTS@ ) where import Monad (liftM) import Foreign import Foreign.C @IMPORTS@ {#context lib="@CONTEXT_LIB@" prefix="@CONTEXT_PREFIX@" #} @MODULE_BODY@ --- NEW FILE: gen-all.sh --- #!/bin/bash DOCBOOKDIR=../apicoverage/tars/gtk+-2.4.13/docs/reference/gtk/xml HEADDERS=/usr/include/gtk-2.0/gtk/*.h mkdirhier doc api modules echo > modules/missing_docs for HEADDER in $HEADDERS do APIFILE=api/$(basename $HEADDER).xml DOCBOOKFRAG=$DOCBOOKDIR/$(basename ${HEADDER%.h}).xml DOCBOOKFILE=doc/$(basename ${HEADDER%.h}).docbook DOCFILE=doc/$(basename ${HEADDER%.h}).xml echo Processing $HEADDER ./gapi_pp.pl $HEADDER | ./gapi2xml.pl Gtk $APIFILE gtk+ >> /dev/null || exit # ./gapi_format_xml $APIFILE.tmp $APIFILE || exit rm $APIFILE.tmp if test -f $DOCBOOKFRAG; then cat <(echo \ '<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.1.2//EN" "http://www.oasis-open.org/docbook/xml/4.1.2/docbookx.dtd"> <book>') $DOCBOOKFRAG <(echo '</book>') \ > $DOCBOOKFILE || exit echo "xsltproc format-docs.xsl $DOCBOOKFILE > $DOCFILE" xsltproc format-docs.xsl $DOCBOOKFILE > $DOCFILE || exit echo ./ApiGen $APIFILE Template.chs --doc=$DOCFILE --outdir=modules ./ApiGen $APIFILE Template.chs --doc=$DOCFILE --outdir=modules || exit else echo ./ApiGen $APIFILE Template.chs --outdir=modules ./ApiGen $APIFILE Template.chs --outdir=modules || exit echo $HEADDER: could not find $DOCBOOKFRAG >> modules/missing_docs fi done --- NEW FILE: ApiGen.hs --- -- ApiGen: takes an xml description of a GObject-style API and produces a .chs -- binding module. --module Main (main) where import Prelude hiding (Enum, lines) import Monad (when) import Maybe (catMaybes) import Char (toLower, toUpper, isAlpha, isAlphaNum, isUpper) import List (isPrefixOf, groupBy, sortBy) import System (getArgs, exitWith, ExitCode(..)) import qualified Text.XML.HaXml as Xml import qualified Text.XML.HaXml.Parse as Xml import qualified Text.XML.HaXml.Escape as Xml import qualified System.Time ------------------------------------------------------------------------------- -- Types representing the content of the API XML file ------------------------------------------------------------------------------- type API = [NameSpace] data NameSpace = NameSpace { namespace_name :: String, namespace_library :: String, namespace_objects :: [Object], namespace_enums :: [Enum] } deriving Show data Enum = Enum { enum_name :: String, enum_cname :: String, enum_variety :: String, enum_members :: [Member] } deriving Show data Member = Member { member_name :: String, member_cname :: String, member_value :: String } deriving Show data Object = Object { object_name :: String, object_cname :: String, object_parent :: String, object_constructors :: [Constructor], object_methods :: [Method] } deriving Show data Constructor = Constructor { constructor_cname :: String, constructor_parameters :: [Parameter] } deriving Show data Parameter = Parameter { parameter_type :: String, parameter_name :: String, parameter_isArray :: Bool } | VarArgs deriving Show data Method = Method { method_name :: String, method_cname :: String, method_return_type :: String, method_parameters :: [Parameter] } deriving Show ------------------------------------------------------------------------------- -- extract functions to convert the api xml file to the internal representation ------------------------------------------------------------------------------- extractAPI :: Xml.Document -> API extractAPI (Xml.Document _ _ (Xml.Elem "api" [] namespaces)) = catMaybes (map extractNameSpace namespaces) extractNameSpace :: Xml.Content -> Maybe NameSpace extractNameSpace (Xml.CElem (Xml.Elem "namespace" [("name", Xml.AttValue name), ("library", Xml.AttValue lib)] content)) = Just $ NameSpace { namespace_name = Xml.verbatim name, namespace_library = Xml.verbatim lib, namespace_objects = catMaybes (map extractObject content), namespace_enums = [] } extractNameSpace _ = Nothing 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 { 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) } extractObject _ = Nothing extractMethod :: Xml.Content -> Maybe 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))) = Just $ Method { method_name = Xml.verbatim name, method_cname = Xml.verbatim cname, method_return_type = Xml.verbatim return_type, method_parameters = case content of [] -> [] [Xml.CElem (Xml.Elem "parameters" [] parameters)] -> map extractParameter parameters } extractMethod _ = Nothing extractParameter :: Xml.Content -> Parameter extractParameter (Xml.CElem (Xml.Elem "parameter" [("ellipsis", _)] [])) = VarArgs extractParameter (Xml.CElem (Xml.Elem "parameter" [("type", Xml.AttValue type_), ("name", Xml.AttValue name)] [])) = Parameter { parameter_type = Xml.verbatim type_, parameter_name = Xml.verbatim name, parameter_isArray = False } extractParameter (Xml.CElem (Xml.Elem "parameter" [("type", Xml.AttValue type_), ("array", _), ("name", Xml.AttValue name)] [])) = Parameter { parameter_type = Xml.verbatim type_, parameter_name = Xml.verbatim name, parameter_isArray = True } extractConstructor :: Xml.Content -> Maybe Constructor extractConstructor (Xml.CElem (Xml.Elem "constructor" [("cname", Xml.AttValue cname)] content)) = Just $ Constructor { constructor_cname = Xml.verbatim cname, constructor_parameters = case content of [] -> [] [Xml.CElem (Xml.Elem "parameters" [] parameters)] -> map extractParameter parameters } extractConstructor _ = Nothing ------------------------------------------------------------------------------- -- extract functions to convert the doc xml file to the internal representation ------------------------------------------------------------------------------- data ApiDoc = ApiDoc { doc_target :: String, -- C function name doc_paragraphs :: [DocPara], -- documentation markup doc_since :: Maybe String -- which version of the api the } -- function is avaliable from, eg "2.4" type DocPara = [DocParaSpan] data DocParaSpan = DocText String -- just simple text | DocFuncXRef String -- cross reference to a function name | DocTypeXRef String -- cross reference to a type name | DocOtherXRef String -- xref format not directly supported | DocEmphasis String -- emphasised text, usually italic | DocLiteral String -- some literal like numbers | DocArg String -- function argument names extractDocumentation :: Xml.Document -> [ApiDoc] extractDocumentation (Xml.Document _ _ (Xml.Elem "apidoc" [] functions)) = map extractDocFunc functions extractDocFunc :: Xml.Content -> ApiDoc extractDocFunc (Xml.CElem (Xml.Elem "function" [] [Xml.CElem (Xml.Elem "name" [] [Xml.CString _ name]) ,Xml.CElem (Xml.Elem "since" [] since') ,Xml.CElem (Xml.Elem "doc" [] paras)] )) = let since = case since' of [] -> Nothing [Xml.CString _ since] -> Just since in ApiDoc { doc_target = name, doc_paragraphs = map extractDocPara paras, doc_since = since } extractDocPara :: Xml.Content -> DocPara extractDocPara (Xml.CElem elem@(Xml.Elem "para" [] _)) = case Xml.xmlUnEscape Xml.stdXmlEscaper elem of (Xml.Elem _ [] spans) -> map extractDocParaSpan spans extractDocParaSpan :: Xml.Content -> DocParaSpan extractDocParaSpan (Xml.CString _ text) = DocText text extractDocParaSpan (Xml.CElem (Xml.Elem tag [] (CString _ text))) = case tag of "xref-func" -> DocFuncXRef text "xref-type" -> DocTypeXRef text "xref-other" -> DocOtherXRef text "emphasis" -> DocEmphasis text "literal" -> DocLiteral text "arg" -> DocArg text extractDocParaSpan other = error $ "extractDocParaSpan: " ++ Xml.verbatim other haddocFormatParas :: [DocPara] -> ShowS haddocFormatParas = ((ss "-- | ". drop 3).) . cat . map ((.(ss "--\n")) . cat . map (\line -> (ss "-- ").line.ss "\n") . map (sepBy " ") . wrapText 77 . words . concatMap haddocFormatSpan) haddocFormatSpan :: DocParaSpan -> String haddocFormatSpan (DocText text) = escapeHaddockSpecialChars text haddocFormatSpan (DocTypeXRef text) = "\"" ++ 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") = "@CHECKME: Nothing@" haddocFormatSpan (DocLiteral text) = "@" ++ text ++ "@" haddocFormatSpan (DocArg text) = "@" ++ text ++ "@" cFuncNameToHsName :: String -> String cFuncNameToHsName = lowerCaseFirstChar . stripKnownPrefixes . concatMap (upperCaseFirstChar "cFuncNameToHsName") . splitBy '_' . takeWhile ('('/=) escapeHaddockSpecialChars = escape where escape [] = [] escape (''':'s':cs) = ''' : 's' : escape cs --often don't need to escape escape (c:cs) | c == '/' || c == '`' || c == '"' || c == '@' || c == '<' || c == ''' = '\\': c : escape cs escape (c:cs) = c : escape cs -- wraps a list of words to lines of words wrapText :: Int -> [String] -> [[String]] wrapText width = wrap 3 [] where wrap :: Int -> [String] -> [String] -> [[String]] wrap col line (word:words) | col + length word + 1 > width = reverse line : wrap 0 [] (word:words) wrap col line (word:words) = wrap (col + length word + 1) (word:line) words wrap _ [] [] = [] wrap _ line [] = [reverse line] ------------------------------------------------------------------------------- -- Now lets actually generate some code fragments based on the api info ------------------------------------------------------------------------------- genFunction :: Object -> Method -> Maybe ApiDoc -> ShowS genFunction object method doc = formattedDoc. ss functionName. ss " :: ". functionType. nl. ss functionName. sc ' '. sepBy " " paramNames. ss " =". indent 1. body. nl where functionName = lowerCaseFirstChar (method_name method) (classConstraints', paramTypes', paramMarshalers) = unzip3 [ genMarshalParameter (changeParamNames (parameter_name p)) (parameter_type p) | p <- method_parameters method ] classConstraints = [ c | Just c <- classConstraints' ] paramTypes = [ c | Just c <- paramTypes' ] paramNames = [ changeParamNames (parameter_name p) | (Just _, p) <- zip paramTypes' (method_parameters method) ] (returnType, returnMarshaler) = genMarshalResult (method_return_type method) functionType = (case classConstraints of [] -> id [c] -> ss c. ss " => " cs -> sc '('. sepBy ", " classConstraints. ss ") => "). sepBy " -> " (paramTypes ++ [returnType]) body = foldl (\body marshaler -> marshaler body) call (paramMarshalers++[returnMarshaler]) call = ss "{# call ". ss (method_cname method). ss " #}" formattedDoc = case doc of Nothing -> ss "-- | \n-- \n" Just doc -> haddocFormatParas (doc_paragraphs doc) genMethods :: Object -> [ApiDoc] -> [(ShowS, Maybe ApiDoc)] genMethods object apiDoc = [ (genFunction object method doc, doc) | (method, doc) <- methods object apiDoc ] methods :: Object -> [ApiDoc] -> [(Method, Maybe ApiDoc)] methods object docs = map snd $ sortBy (\(i,_) (j,_) -> i `compare` j) [ case method_cname method `lookup` docmap of Nothing -> (0,(mungeMethod object method, Nothing)) (Just (doc, index)) -> (index,(mungeMethod object method, Just doc)) | method <- object_methods object , null [ () | VarArgs <- method_parameters method] ] --exclude VarArgs methods where docmap = [ (doc_target doc, (doc,index)) | (doc,index) <- zip docs [1..]] mungeMethod :: Object -> Method -> Method mungeMethod object method = let self = Parameter { parameter_type = object_cname object ++ "*", parameter_name = "obj", parameter_isArray = False } in method { method_name = object_name object ++ method_name method, method_parameters = self : method_parameters method } genConstructors :: Object -> [ApiDoc] -> [(ShowS, Maybe ApiDoc)] genConstructors object apiDoc = [ (genFunction object constructor doc, doc) | (constructor, doc) <- constructors object apiDoc ] constructors :: Object -> [ApiDoc] -> [(Method, Maybe ApiDoc)] constructors object docs = [ (mungeConstructor object constructor, constructor_cname constructor `lookup` docmap) | constructor <- object_constructors object , null [ () | VarArgs <- constructor_parameters constructor] ] where docmap = [ (doc_target doc, doc) | doc <- docs ] mungeConstructor :: Object -> Constructor -> Method mungeConstructor object constructor = Method { method_name = (object_name object++) . drop (length (object_cname object)) . concatMap (upperCaseFirstChar "mungeConstructor") . splitBy '_' . constructor_cname $ constructor, method_cname = constructor_cname constructor, method_return_type = object_cname object ++ "*", method_parameters = constructor_parameters constructor } genExports :: Object -> [ApiDoc] -> ShowS genExports object docs = doVersionIfDefs [ (ss " ". ss (lowerCaseFirstChar (method_name constructor)). sc ',', doc) | (constructor, doc) <- constructors object docs ++ methods object docs] genTodoItems :: Object -> ShowS genTodoItems object = let varargsFunctions = [ ss (constructor_cname constructor) | constructor <- object_constructors object , not $ null [ () | VarArgs <- constructor_parameters constructor] ] ++ [ ss (method_cname method) | method <- object_methods object , not $ null [ () | VarArgs <- method_parameters method] ] in if null varargsFunctions then id else nl. comment. nl. comment. ss "TODO: the following varargs functions were not bound\n". lines (map (ss "-- * ".) varargsFunctions) doVersionIfDefs :: [(ShowS, Maybe ApiDoc)] -> ShowS doVersionIfDefs = lines . map (\group -> sinceVersion (snd (head group)) (lines (map fst group))) . groupBy (\(_,a) (_,b) -> fmap doc_since a == fmap doc_since b) sinceVersion :: Maybe ApiDoc -> ShowS -> ShowS sinceVersion (Just (ApiDoc _ _ (Just (major:'.':minor:[])))) body = ss "#if GTK_CHECK_VERSION(". sc major. ss ",". sc minor. ss ",0)\n". body. ss "\n#endif" sinceVersion _ body = body splitBy :: Char -> String -> [String] splitBy sep str = case span (sep/=) str of (remainder,[]) -> [remainder] (word,_:remainder) -> word : splitBy sep remainder ------------------------------------------------------------------------------- -- Here's the interesting bit that generates the fragments of mashaling code ------------------------------------------------------------------------------- genMarshalParameter :: String -> --parameter name suggestion (will be unique) String -> --C type decleration for the parameter we will marshal (Maybe String, --parameter class constraints (or none) Maybe String, --parameter type (or none if the arg is not exposed) ShowS -> ShowS) --marshaling code (\body -> ... body ...) genMarshalParameter name "gboolean" = (Nothing, Just "Bool", \body -> body. ss " (fromBool ". ss name. ss ")") genMarshalParameter name typeName | typeName == "guint" --these two are unsigned types || typeName == "gint" || typeName == "gsize" --should they be Word or Int? || typeName == "gssize" = (Nothing, Just "Int", \body -> body. ss " (fromIntegral ". ss name. ss ")") genMarshalParameter name "const-gchar*" = (Nothing, Just "String", \body -> ss "withUTFString ". ss name. ss " $ \\". ss name. ss "Ptr ->". indent 1. body. sc ' '. ss name. ss "Ptr") genMarshalParameter name "GError**" = (Nothing, Nothing, \body -> ss "propagateGError $ \\". ss name. ss "Ptr ->". indent 1. body. sc ' '. ss name. ss "Ptr") genMarshalParameter name typeName | isUpper (head typeName) && last typeName == '*' && last (init typeName) /= '*' = --then assume it is an object let typeName' = stripKnownPrefixes (init typeName) in (Just $ typeName' ++ "Class " ++ name, Just name, \body -> body. ss " (to". ss typeName'. sc ' '. ss name. ss ")") genMarshalParameter name unknownType = (Nothing, Just $ "{-" ++ unknownType ++ "-}", \body -> body. ss " {-". ss name. ss "-}") -- Takes the type string and returns the Haskell Type and the marshaling code -- genMarshalResult :: 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) genMarshalResult "void" = ("IO ()", id) genMarshalResult "const-gchar*" = ("IO String", \body -> body. indent 1. ss ">>= peekUTFString") genMarshalResult "const-GSList*" = ("[{- element type -}]", \body -> body. indent 1. ss ">>= readGSList". indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})") genMarshalResult "GSList*" = ("[{- element type -}]", \body -> body. indent 1. ss ">>= fromGSList". indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})") genMarshalResult "GList*" = ("[{- element type -}]", \body -> body. indent 1. ss ">>= fromGList". indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})") genMarshalResult typeName | isUpper (head typeName) && last typeName == '*' && last (init typeName) /= '*' = --then assume it is an object let typeName' = stripKnownPrefixes (init typeName) in ("IO " ++ typeName', \body -> ss "makeNewGObject mk". ss typeName'. ss " $". indent 1. body) genMarshalResult unknownType = ("{-" ++ unknownType ++ "-}", id) stripKnownPrefixes :: String -> String stripKnownPrefixes ('G':'t':'k':remainder) = remainder stripKnownPrefixes ('G':'d':'k':remainder) = remainder stripKnownPrefixes ('P':'a':'n':'g':'o':remainder) = remainder stripKnownPrefixes other = other changeParamNames :: String -> String changeParamNames "type" = "type_" --this is a common variable name in C but of --course a keyword in Haskell changeParamNames other = --change "gtk_foo_bar" to "gtkFooBar" lowerCaseFirstChar . concatMap (upperCaseFirstChar $ "changeParamNames" ++ other) . filter (not.null) --to ignore tailing underscores . splitBy '_' $ other ------------------------------------------------------------------------------- -- Top level stuff ------------------------------------------------------------------------------- main = do args <- getArgs when (length args < 2) usage ----------------------------------------------------------------------------- -- Parse command line parameters -- let (apiFile: templateFile: rem) = args let docFile = case map (drop 6) (filter ("--doc=" `isPrefixOf`) rem) of [] -> "" (docFile:_) -> docFile let lib = case map (drop 6) (filter ("--lib=" `isPrefixOf`) rem) of [] -> "gtk" (lib:_) -> lib let prefix = case map (drop 9) (filter ("--prefix=" `isPrefixOf`) rem) of [] -> "gtk" (prefix:_) -> prefix let modPrefix = case map (drop 12) (filter ("--modprefix=" `isPrefixOf`) rem) of [] -> "" (modPrefix:_) -> modPrefix ++ "." let outdir = case map (drop 9) (filter ("--outdir=" `isPrefixOf`) rem) of [] -> "" (outdir:_) -> if last outdir == '/' then outdir else outdir ++ "/" ----------------------------------------------------------------------------- -- Read in the input files -- content <- if apiFile == "-" then getContents -- read stdin else readFile apiFile template <- readFile templateFile ----------------------------------------------------------------------------- -- Parse the contents of the xml api file -- let document = Xml.xmlParse apiFile content api = extractAPI document ----------------------------------------------------------------------------- -- Read in the documentation xml file if supplied -- apiDoc <- if null docFile then return [] else do content <- readFile docFile return $ extractDocumentation (Xml.xmlParse docFile content) ----------------------------------------------------------------------------- -- A few values that are used in the template -- time <- System.Time.getClockTime calendarTime <- System.Time.toCalendarTime time let day = show (System.Time.ctDay calendarTime) month = show (System.Time.ctMonth calendarTime) year = show (System.Time.ctYear calendarTime) date = day ++ " " ++ month ++ " " ++ year ----------------------------------------------------------------------------- -- Write the result file(s) by substituting values into the template file -- mapM (\object -> writeFile (outdir ++ object_name object ++ ".chs") $ templateSubstitute template (\var -> case var of "YEAR" -> ss year "DATE" -> ss date "OBJECT_NAME" -> ss (object_name object) "MODULE_DOCUMENTATION" -> ss "$MODULE_DOCUMENTATION" "MODULE_TODO" -> genTodoItems object "MODULE_NAME" -> ss (modPrefix ++ object_name object) "MODULE_EXPORTS" -> genExports object apiDoc "MODULE_IMPORTS" -> ss "$imports" "CONTEXT_LIB" -> ss lib "CONTEXT_PREFIX" -> ss prefix "MODULE_BODY" -> doVersionIfDefs (genConstructors object apiDoc ++ genMethods object apiDoc) _ -> ss "" ) "") [ object | namespace <- api, object <- namespace_objects namespace ] usage = do putStr "\nProgram to generate a .chs Haskell binding module from an xml\n\ \description of a GObject-style API. Usage:\n\ \ApiGen <xmlFile> <templateFile>\n\ \ {--doc=<docFile>} {--lib=<lib>} {--prefix=<prefix>}\n\ \ {--outdir=<outDir>} {--modprefix=<modPrefix>}\n\ \where\n\ \ <apiFile> an xml api file produced by gapi2xml\n\ \ <templateFile> is the name and path of the output template file\n\ \ <outDir> is the name and path of the output file\n\ \ <docFile> api doc file output from format-doc.xsl\n\ \ <lib> set the lib to use in the c2hs {#context #}\n\ \ declaration (the default is \"gtk\")\n\ \ <prefix> set the prefix to use in the c2hs {#context #}\n\ \ declaration (the default is \"gtk\")\n\ \ <modPrefix> specify module name prefix, eg if using\n\ \ hierarchical module names\n" exitWith $ ExitFailure 1 ------------------------------------------------------------------------------- -- Helper functions ------------------------------------------------------------------------------- ss = showString sc = showChar nl = sc '\n' indent :: Int -> ShowS indent c = ss ("\n"++replicate (2*c) ' ') comment :: ShowS comment = ss "-- " lowerCaseFirstChar :: String -> String lowerCaseFirstChar (c:cs) = toLower c : cs upperCaseFirstChar :: String -> String -> String upperCaseFirstChar _ (c:cs) = toUpper c : cs upperCaseFirstChar dbgMesg cs = error $ "upperCaseFirstChar: " ++ dbgMesg ++ cs ++ " !!" cat :: [ShowS] -> ShowS cat = foldl (.) id lines :: [ShowS] -> ShowS lines [] = id lines [x] = x lines (x:xs) = x. sc '\n'. lines xs sepBy :: String -> [String] -> ShowS sepBy s [] = id sepBy s [x] = ss x sepBy s (x:xs) = ss x. ss s. sepBy s xs sepBy' :: String -> [ShowS] -> ShowS sepBy' s [] = id sepBy' s [x] = x sepBy' s (x:xs) = x. ss s. sepBy' s xs templateSubstitute :: String -> (String -> ShowS) -> ShowS templateSubstitute template varSubst = doSubst template where doSubst [] = id doSubst ('@':cs) = let (var,_:cs') = span ('@'/=) cs in varSubst var . doSubst cs' doSubst (c:cs) = sc c . doSubst cs --- NEW FILE: README --- The tool in this directory are to semi-automatically generate binding modules complete with haddock format documentation for all gtk modules. With a little modification it should work for any other GObject-based api. It works by extracting an api description from the C headder files and extracting documentation from the docbook documentation produced by gtk-doc. It is semi-automatic in the sense that the resulting binding module will need some hand tweaking and it is not intended that this tool be used automatically as part of the build process. It is mainly a time saving tool to relieve much manual work involved in writing binding modules. Some things that may need to be edited by hand: * Add your name at the top for new modules! * Some type signatures and marshaling code eg for possibly NULL Strings you would want to change to use Maybe String also it is not possible to automatically determine the element type of GLists so this will have to be determined manually. * Some functions have multiple out parameters which would be better done in Haskell by returning a tuple (this may be possible to do automatically but currently it is not). * Documentation. This is converted directly from the C documentation so there are usually things that you would want to change to make things make sense in Haskell. Code samples should be converted for example. == For users: == At the moment you will need to edit the gen-all.sh script and adjust the DOCBOOKDIR and HEADDERS variables to your system. The HEADDERS variable should be a list of .h headder files to scan and generate bindings for. It is probably better to use the installed headder files since there are many private headder files in the gtk source directory. The DOCBOOKDIR should be a directory containing docbook xml files coresponding to the HEADDERS. The gen-all.sh script will look for an $FOO.xml file for every $FOO.h file in HEADDERS. To generate the docbook format documentation you will need to build (but not install) a version of gtk (preferably the same version as the .h files came from). The gtk+-$VER/docs/reference/gtk/xml directory is where the docbook files end up for gtk (there is also gdk and gtk-pixbuf). The documentation is optional. If no docbook xml file is found the binding file will still be generated but without any haddock documentation. When this is done just run ./gen-all.sh The final .chs binding files are put in the modules/ directory. Intermediate api description files and documentation files are left under api/ and doc/. == For hackers: == There are a few components to the system: There are a couple perl scripts written by the mono/gtk-sharp authors. These extract information from GObject-based .h files and generate xml descriptions. To read these files you may want to build the gapi_format_xml tool also from the gtk-sharp source tree. The xml files assume an object oreinted target language (C#) but it does preserve all the information ok. These scripts are GPL so should probably not be distributed in tarballs, just left in cvs. Besides they're just gtk2hs hacker tools. There is an XSLT program to extract per function documentation from docbook xml files into a more convenient format. It is pretty specific to the format of docbook document generated by gtk-doc (version 1.2). No doubt it will require changes if gtk-doc changes. The major component to the system is a Haskell program ApiGen.hs that reads in the api xml file and the documentation xml file and spits out .chs binding file(s) using the Template.chs file. The files are named the same as the object they bind. Some improvements that would be good: * Complete marshaling code for more types * Emit top level module documentation, including: - module summary / description - object heirarchy * Add a Haddock contents annotations (eg: constructors, methods, signals) * Emit signal and property bindings with documentation --- NEW FILE: format-docs.xsl --- <?xml version="1.0" encoding="UTF-8" standalone="yes"?> <xsl:transform xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0"> <xsl:output method="xml" indent="yes"/> <xsl:template match="link/function"> <xref-func><xsl:value-of select="."/></xref-func> </xsl:template> <xsl:template match="link/type"> <xref-type><xsl:value-of select="."/></xref-type> </xsl:template> <xsl:template match="xref"> <xref-other><xsl:value-of select="."/></xref-other> </xsl:template> <xsl:template match="emphasis"> <emphasis><xsl:value-of select="."/></emphasis> </xsl:template> <xsl:template match="literal"> <literal><xsl:value-of select="."/></literal> </xsl:template> <xsl:template match="parameter"> <arg><xsl:value-of select="."/></arg> </xsl:template> <xsl:template match="/"> <apidoc> <xsl:for-each select="/book/refentry/refsect1[title='Details']/refsect2[contains(title,' ()')]"> <function> <name><xsl:value-of select="indexterm/primary"/></name> <since> <xsl:value-of select="number(substring-after(para[starts-with(text(),'Since')], 'Since '))"/> </since> <doc> <xsl:for-each select="para[not(starts-with(text(),'Since')) and normalize-space(text())!='']"> <!--<xsl:copy-of select="."/>--> <para><xsl:apply-templates/></para> </xsl:for-each> </doc> </function> </xsl:for-each> </apidoc> </xsl:template> </xsl:transform> --- NEW FILE: gapi2xml.pl --- #!/usr/bin/perl # # gapi2xml.pl : Generates an XML representation of GObject based APIs. # # Author: Mike Kestner <mke...@sp...> # # Copyright (c) 2001-2003 Mike Kestner # Copyright (c) 2003-2004 Novell, Inc. # # This program is free software; you can redistribute it and/or # modify it under the terms of version 2 of the GNU General Public # License as published by the Free Software Foundation. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public # License along with this program; if not, write to the # Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. ############################################################## $debug=0; use XML::LibXML; if (!$ARGV[2]) { die "Usage: gapi_pp.pl <srcdir> | gapi2xml.pl <namespace> <outfile> <libname>\n"; } $ns = $ARGV[0]; $libname = $ARGV[2]; ############################################################## # Check if the filename provided exists. We parse existing files into # a tree and append the namespace to the root node. If the file doesn't # exist, we create a doc tree and root node to work with. ############################################################## if (-e $ARGV[1]) { #parse existing file and get root node. $doc = XML::LibXML->new->parse_file($ARGV[1]); $root = $doc->getDocumentElement(); } else { $doc = XML::LibXML::Document->new(); $root = $doc->createElement('api'); $doc->setDocumentElement($root); $warning_node = XML::LibXML::Comment->new ("\n\n This file was automatically generated.\n Please DO NOT MODIFY THIS FILE, modify .metadata files instead.\n\n"); $root->appendChild($warning_node); } $ns_elem = $doc->createElement('namespace'); $ns_elem->setAttribute('name', $ns); $ns_elem->setAttribute('library', $libname); $root->appendChild($ns_elem); ############################################################## # First we parse the input for typedefs, structs, enums, and class_init funcs # and put them into temporary hashes. ############################################################## while ($line = <STDIN>) { if ($line =~ /typedef\s+(struct\s+\w+\s+)\*+(\w+);/) { $ptrs{$2} = $1; } elsif ($line =~ /typedef\s+(struct\s+\w+)\s+(\w+);/) { next if ($2 =~ /Private$/); # fixme: siiigh $2 = "GdkDrawable" if ($1 eq "_GdkDrawable"); $types{$2} = $1; } elsif ($line =~ /typedef\s+struct/) { $sdef = $line; while ($line = <STDIN>) { $sdef .= $line; last if ($line =~ /^}/); } $sdef =~ s!/\*.*?(\*/|\n)!!g; $sdef =~ s/\n\s*//g; $types{$1} = $sdef if ($sdef =~ /.*\}\s*(\w+);/); } elsif ($line =~ /typedef\s+(unsigned\s+\w+)\s+(\**)(\w+);/) { $types{$3} = $1 . $2; } elsif ($line =~ /typedef\s+(\w+)\s+(\**)(\w+);/) { $types{$3} = $1 . $2; } elsif ($line =~ /typedef\s+enum\s+(\w+)\s+(\w+);/) { $etypes{$1} = $2; } elsif ($line =~ /^(typedef\s+)?\benum\b/) { $edef = $line; while ($line = <STDIN>) { $edef .= $line; last if ($line =~ /^}\s*(\w+)?;/); } $edef =~ s/\n\s*//g; $edef =~ s|/\*.*?\*/||g; if ($edef =~ /typedef.*}\s*(\w+);/) { $ename = $1; } elsif ($edef =~ /^enum\s+(\w+)\s*{/) { $ename = $1; } else { print "Unexpected enum format\n$edef"; next; } $edefs{$ename} = $edef; } elsif ($line =~ /typedef\s+\w+\s*\**\s*\(\*\s*(\w+)\)\s*\(/) { $fname = $1; $fdef = ""; while ($line !~ /;/) { $fdef .= $line; $line = <STDIN>; } $fdef .= $line; $fdef =~ s/\n\s+//g; $fpdefs{$fname} = $fdef; } elsif ($line =~ /^(private)?struct\s+(\w+)/) { next if ($line =~ /;/); $sname = $2; $sdef = $line; while ($line = <STDIN>) { $sdef .= $line; last if ($line =~ /^}/); } $sdef =~ s!/\*.*?(\*/|\n)!!g; $sdef =~ s/\n\s*//g; $sdefs{$sname} = $sdef; } elsif ($line =~ /^(\w+)_(class|base)_init\b/) { $class = StudlyCaps($1); $pedef = $line; while ($line = <STDIN>) { $pedef .= $line; last if ($line =~ /^}/); } $pedefs{lc($class)} = $pedef; } elsif ($line =~ /^(\w+)_get_type\b/) { $class = StudlyCaps($1); $pedef = $line; while ($line = <STDIN>) { $pedef .= $line; if ($line =~ /g_boxed_type_register_static/) { $boxdef = $line; while ($line !~ /;/) { $boxdef .= ($line = <STDIN>); } $boxdef =~ s/\n\s*//g; $boxdef =~ /\(\"(\w+)\"/; my $boxtype = $1; $boxtype =~ s/($ns)Type(\w+)/$ns$2/; $boxdefs{$boxtype} = $boxdef; } last if ($line =~ /^}/); } $typefuncs{lc($class)} = $pedef; } elsif ($line =~ /^(const|G_CONST_RETURN)?\s*\w+\s*\**\s*(\w+)\s*\(/) { $fname = $2; $fdef = ""; while ($line !~ /;/) { $fdef .= $line; $line = <STDIN>; } $fdef .= $line; $fdef =~ s/\n\s*//g; if ($fdef !~ /^_/) { $fdefs{$fname} = $fdef; } } elsif ($line =~ /CHECK_(\w*)CAST/) { $cast_macro = $line; while ($line =~ /\\$/) { $line = <STDIN>; $cast_macro .= $line; } $cast_macro =~ s/\\\n\s*//g; $cast_macro =~ s/\s+/ /g; 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 =~ /GTK_CHECK_CAST.*,\s*(\w+),\s*(\w+)/) { $objects{$1} = $2 . $objects{$1}; } elsif ($cast_macro =~ /GTK_CHECK_CLASS_CAST.*,\s*(\w+),\s*(\w+)/) { $objects{$1} .= ":$2"; } } elsif ($line =~ /INSTANCE_GET_INTERFACE.*,\s*(\w+),\s*(\w+)/) { $ifaces{$1} = $2; } elsif ($line =~ /^BUILTIN\s*\{\s*\"(\w+)\".*GTK_TYPE_BOXED/) { $boxdefs{$1} = $line; } elsif ($line =~ /^BUILTIN\s*\{\s*\"(\w+)\".*GTK_TYPE_(ENUM|FLAGS)/) { # ignoring these for now. } elsif ($line =~ /^\#define/) { my $test_ns = uc ($ns); if ($line =~ /\#define\s+(\w+)\s+\"(.*)\"/) { $defines{$1} = $2; } } else { print $line; } } ############################################################## # Produce the enum definitions. ############################################################## %enums = (); foreach $cname (sort(keys(%edefs))) { $ecnt++; $def = $edefs{$cname}; $cname = $etypes{$cname} if (exists($etypes{$cname})); $enums{lc($cname)} = $cname; $enum_elem = addNameElem($ns_elem, 'enum', $cname, $ns); if ($def =~ /=\s*1\s*<<\s*\d+/) { $enum_elem->setAttribute('type', "flags"); } else { $enum_elem->setAttribute('type', "enum"); } $def =~ /\{(.*)\}/; @vals = split(/,\s*/, $1); @v0 = split(/_/, $vals[0]); if (@vals > 1) { $done = 0; for ($idx = 0, $regex = ""; $idx < @v0; $idx++) { $regex .= ($v0[$idx] . "_"); foreach $val (@vals) { $done = 1 if ($val !~ /$regex/); } last if $done; } $common = join("_", @v0[0..$idx-1]); } else { $common = join("_", @v0[0..$#v0-1]); } foreach $val (@vals) { if ($val =~ /$common\_?(\w+)\s*=\s*(\-?\d+.*)/) { $name = $1; if ($2 =~ /1u?\s*<<\s*(\d+)/) { $enumval = "1 << $1"; } else { $enumval = $2; } } elsif ($val =~ /$common\_?(\w+)/) { $name = $1; $enumval = ""; } else { die "Unexpected enum value: $val for common value $common\n"; } $val_elem = addNameElem($enum_elem, 'member'); $val_elem->setAttribute('cname', "$common\_$name"); $val_elem->setAttribute('name', StudlyCaps(lc($name))); if ($enumval) { $val_elem->setAttribute('value', $enumval); } } } ############################################################## # Parse the callbacks. ############################################################## foreach $cbname (sort(keys(%fpdefs))) { next if ($cbname !~ /$ns/); $cbcnt++; $fdef = $cb = $fpdefs{$cbname}; $cb_elem = addNameElem($ns_elem, 'callback', $cbname, $ns); $cb =~ /typedef\s+(.*)\(.*\).*\((.*)\);/; $ret = $1; $params = $2; addReturnElem($cb_elem, $ret); if ($params && ($params ne "void")) { addParamsElem($cb_elem, split(/,/, $params)); } } ############################################################## # Parse the interfaces list. ############################################################## foreach $type (sort(keys(%ifaces))) { $iface = $ifaces{$type}; ($inst, $dontcare) = split(/:/, delete $objects{$type}); $initfunc = $pedefs{lc($inst)}; $ifacetype = delete $types{$iface}; delete $types{$inst}; $ifacecnt++; $iface_el = addNameElem($ns_elem, 'interface', $inst, $ns); $elem_table{lc($inst)} = $iface_el; $classdef = $sdefs{$1} if ($ifacetype =~ /struct\s+(\w+)/); if ($initfunc) { parseInitFunc($iface_el, $initfunc, 0); } else { warn "Don't have an init func for $inst.\n" if $debug; } } ############################################################## # Parse the classes by walking the objects list. ############################################################## foreach $type (sort(keys(%objects))) { ($inst, $class) = split(/:/, $objects{$type}); $class = $inst . "Class" if (!$class); $initfunc = $pedefs{lc($inst)}; $typefunc = $typefuncs{lc($inst)}; $insttype = delete $types{$inst}; $classtype = delete $types{$class}; $instdef = $classdef = ""; $instdef = $sdefs{$1} if ($insttype =~ /struct\s+(\w+)/); $classdef = $sdefs{$1} if ($classtype =~ /struct\s+(\w+)/); $instdef =~ s/\s+(\*+)/\1 /g; warn "Strange Class $inst\n" if (!$instdef && $debug); $classcnt++; $obj_el = addNameElem($ns_elem, 'object', $inst, $ns); $elem_table{lc($inst)} = $obj_el; # Extract parent and fields from the struct if ($instdef =~ /^struct/) { $instdef =~ /\{(.*)\}/; $fieldstr = $1; $fieldstr =~ s|/\*.*?\*/||g; @fields = split(/;/, $fieldstr); $fields[0] =~ /(\w+)/; $obj_el->setAttribute('parent', "$1"); addFieldElems($obj_el, @fields[1..$#fields]); } elsif ($instdef =~ /privatestruct/) { # just get the parent for private structs $instdef =~ /\{\s*(\w+)/; $obj_el->setAttribute('parent', "$1"); } # Get the props from the class_init func. if ($initfunc) { parseInitFunc($obj_el, $initfunc, 1); } else { warn "Don't have an init func for $inst.\n" if $debug; } # Get the interfaces from the class_init func. if ($typefunc) { parseTypeFunc($obj_el, $typefunc); } else { warn "Don't have a GetType func for $inst.\n" if $debug; } } ############################################################## # Parse the remaining types. ############################################################## foreach $key (sort (keys (%types))) { $lasttype = $type = $key; while ($type && ($types{$type} !~ /struct/)) { $lasttype = $type; $type = $types{$type}; } if ($types{$type} =~ /struct\s+(\w+)/) { $type = $1; if (exists($sdefs{$type})) { $def = $sdefs{$type}; } else { $def = "privatestruct"; } } elsif ($types{$type} =~ /struct/ && $type =~ /^$ns/) { $def = $types{$type}; } else { $elem = addNameElem($ns_elem, 'alias', $key, $ns); $elem->setAttribute('type', $lasttype); warn "alias $key to $lasttype\n" if $debug; next; } # fixme: hack if ($key eq "GdkBitmap") { $struct_el = addNameElem($ns_elem, 'object', $key, $ns); } elsif (exists($boxdefs{$key})) { $struct_el = addNameElem($ns_elem, 'boxed', $key, $ns); } else { $struct_el = addNameElem($ns_elem, 'struct', $key, $ns); } $elem_table{lc($key)} = $struct_el; $def =~ s/\s+/ /g; if ($def =~ /privatestruct/) { $struct_el->setAttribute('opaque', 'true'); } else { $def =~ /\{(.+)\}/; addFieldElems($struct_el, split(/;/, $1)); } } # really, _really_ opaque structs that aren't even defined in sources. Lovely. foreach $key (sort (keys (%ptrs))) { next if $ptrs{$key} !~ /struct\s+(\w+)/; $type = $1; $struct_el = addNameElem ($ns_elem, 'struct', $key, $ns); $struct_el->setAttribute('opaque', 'true'); $elem_table{lc($key)} = $struct_el; } addFuncElems(); addStaticFuncElems(); # This should probably be done in a more generic way foreach $define (sort (keys (%defines))) { next if $define !~ /[A-Z]_STOCK_/; if ($stocks{$ns}) { $stock_el = $stocks{$ns}; } else { $stock_el = addNameElem($ns_elem, "object", $ns . "Stock", $ns); $stocks{$ns} = $stock_el; } $string_el = addNameElem ($stock_el, "static-string", $define); $string_name = lc($define); $string_name =~ s/\w+_stock_//; $string_el->setAttribute('name', StudlyCaps($string_name)); $string_el->setAttribute('value', $defines{$define}); } ############################################################## # Output the tree ############################################################## if ($ARGV[1]) { open(XMLFILE, ">$ARGV[1]") || die "Couldn't open $ARGV[1] for writing.\n"; print XMLFILE $doc->toString(); close(XMLFILE); } else { print $doc->toString(); } ############################################################## # Generate a few stats from the parsed source. ############################################################## $scnt = keys(%sdefs); $fcnt = keys(%fdefs); $tcnt = keys(%types); print "structs: $scnt enums: $ecnt callbacks: $cbcnt\n"; print "funcs: $fcnt types: $tcnt classes: $classcnt\n"; print "props: $propcnt signals: $sigcnt\n\n"; sub addFieldElems { my ($parent, @fields) = @_; foreach $field (@fields) { next if ($field !~ /\S/); $field =~ s/\s+(\*+)/\1 /g; $field =~ s/(\w+)\s+const /const \1 /g; $field =~ s/const /const\-/g; $field =~ s/struct /struct\-/g; $field =~ s/.*\*\///g; next if ($field !~ /\S/); if ($field =~ /(\S+\s+\*?)\(\*\s*(.+)\)\s*\((.*)\)/) { $elem = addNameElem($parent, 'callback', $2); addReturnElem($elem, $1); addParamsElem($elem, $3); } elsif ($field =~ /(unsigned )?(\S+)\s+(.+)/) { my $type = $1 . $2; $symb = $3; foreach $tok (split (/,\s*/, $symb)) { if ($tok =~ /(\w+)\s*\[(.*)\]/) { $elem = addNameElem($parent, 'field', $1); $elem->setAttribute('array_len', "$2"); } elsif ($tok =~ /(\w+)\s*\:\s*(\d+)/) { $elem = addNameElem($parent, 'field', $1); $elem->setAttribute('bits', "$2"); } else { $elem = addNameElem($parent, 'field', $tok); } $elem->setAttribute('type', "$type"); } } else { die "$field\n"; } } } sub addFuncElems { my ($obj_el, $inst, $prefix); $fcnt = keys(%fdefs); foreach $mname (sort (keys (%fdefs))) { next if ($mname =~ /^_/); $obj_el = ""; $prefix = $mname; $prepend = undef; while ($prefix =~ /(\w+)_/) { $prefix = $key = $1; $key =~ s/_//g; # FIXME: lame Gdk API hack if ($key eq "gdkdraw") { $key = "gdkdrawable"; $prepend = "draw_"; } if (exists ($elem_table{$key})) { $prefix .= "_"; $obj_el = $elem_table{$key}; $inst = $key; last; } elsif (exists ($enums{$key}) && ($mname =~ /_get_type/)) { delete $fdefs{$mname}; last; } } next if (!$obj_el); $mdef = delete $fdefs{$mname}; if ($mname =~ /$prefix(new)/) { $el = addNameElem($obj_el, 'constructor', $mname); $drop_1st = 0; } else { $el = addNameElem($obj_el, 'method', $mname, $prefix, $prepend); $mdef =~ /(.*?)\w+\s*\(/; addReturnElem($el, $1); $mdef =~ /\(\s*(const)?\s*(\w+)/; if (lc($2) ne $inst) { $el->setAttribute("shared", "true"); $drop_1st = 0; } else { $drop_1st = 1; } } parseParms ($el, $mdef, $drop_1st); } } sub parseParms { my ($el, $mdef, $drop_1st) = @_; if (($mdef =~ /\((.*)\)/) && ($1 ne "void")) { @parms = (); $parm = ""; $pcnt = 0; foreach $char (split(//, $1)) { if ($char eq "(") { $pcnt++; } elsif ($char eq ")") { $pcnt--; } elsif (($pcnt == 0) && ($char eq ",")) { @parms = (@parms, $parm); $parm = ""; next; } $parm .= $char; } if ($parm) { @parms = (@parms, $parm); } # @parms = split(/,/, $1); ($dump, @parms) = @parms if $drop_1st; if (@parms > 0) { addParamsElem($el, @parms); } } } sub addStaticFuncElems { my ($global_el, $ns_prefix); @mnames = sort (keys (%fdefs)); $mcount = @mnames; return if ($mcount == 0); $ns_prefix = ""; $global_el = ""; for ($i = 0; $i < $mcount; $i++) { $mname = $mnames[$i]; $prefix = $mname; next if ($prefix =~ /^_/); if ($ns_prefix eq "") { my (@toks) = split(/_/, $prefix); for ($j = 0; $j < @toks; $j++) { if (join ("", @toks[0 .. $j]) eq lc($ns)) { $ns_prefix = join ("_", @toks[0 .. $j]); last; } } next if ($ns_prefix eq ""); } next if ($mname !~ /^$ns_prefix/); if ($mname =~ /($ns_prefix)_([a-zA-Z]+)_\w+/) { $classname = $2; $key = $prefix = $1 . "_" . $2 . "_"; $key =~ s/_//g; $cnt = 1; if (exists ($enums{$key})) { $cnt = 1; } elsif ($classname ne "set" && $classname ne "get" && $classname ne "scan" && $classname ne "find" && $classname ne "add" && $classname ne "remove" && $classname ne "free" && $classname ne "register" && $classname ne "execute" && $classname ne "show" && $classname ne "parse" && $classname ne "paint" && $classname ne "string") { while ($mnames[$i+$cnt] =~ /$prefix/) { $cnt++; } } if ($cnt == 1) { $mdef = delete $fdefs{$mname}; if (!$global_el) { $global_el = $doc->createElement('class'); $global_el->setAttribute('name', "Global"); $global_el->setAttribute('cname', $ns . "Global"); $ns_elem->appendChild($global_el); } $el = addNameElem($global_el, 'method', $mname, $ns_prefix); $mdef =~ /(.*?)\w+\s*\(/; addReturnElem($el, $1); $el->setAttribute("shared", "true"); parseParms ($el, $mdef, 0); next; } else { $class_el = $doc->createElement('class'); $class_el->setAttribute('name', StudlyCaps($classname)); $class_el->setAttribute('cname', StudlyCaps($prefix)); $ns_elem->appendChild($class_el); for ($j = 0; $j < $cnt; $j++) { $mdef = delete $fdefs{$mnames[$i+$j]}; $el = addNameElem($class_el, 'method', $mnames[$i+$j], $prefix); $mdef =~ /(.*?)\w+\s*\(/; addReturnElem($el, $1); $el->setAttribute("shared", "true"); parseParms ($el, $mdef, 0); } $i += ($cnt - 1); next; } } } } sub addNameElem { my ($node, $type, $cname, $prefix, $prepend) = @_; my $elem = $doc->createElement($type); $node->appendChild($elem); if ($prefix) { my $match; if ($cname =~ /$prefix(\w+)/) { $match = $1; } else { $match = $cname; } if ($prepend) { $name = $prepend . $match; } else { $name = $match; } $elem->setAttribute('name', StudlyCaps($name)); } if ($cname) { $elem->setAttribute('cname', $cname); } return $elem; } sub addParamsElem { my ($parent, @params) = @_; my $parms_elem = $doc->createElement('parameters'); $parent->appendChild($parms_elem); my $parm_num = 0; foreach $parm (@params) { $parm_num++; $parm =~ s/\s+(\*+)/\1 /g; $parm =~ s/(\w+)\s+const /const \1 /g; $parm =~ s/(\*+)\s*const\s+/\1 /g; $parm =~ s/const\s+/const-/g; if ($parm =~ /(.*)\(\s*\**\s*(\w+)\)\s+\((.*)\)/) { my $ret = $1; my $cbn = $2; my $params = $3; $cb_elem = addNameElem($parms_elem, 'callback', $cbn); addReturnElem($cb_elem, $ret); if ($params && ($params ne "void")) { addParamsElem($cb_elem, split(/,/, $params)); } next; } elsif ($parm =~ /\.\.\./) { $parm_elem = $doc->createElement('parameter'); $parms_elem->appendChild($parm_elem); $parm_elem->setAttribute('ellipsis', 'true'); next; } $parm_elem = $doc->createElement('parameter'); $parms_elem->appendChild($parm_elem); my $name = ""; if ($parm =~ /struct\s+(\S+)\s+(\S+)/) { $parm_elem->setAttribute('type', $1); $name = $2; }elsif ($parm =~ /(unsigned )?(\S+)\s+(\S+)/) { $parm_elem->setAttribute('type', $1 . $2); $name = $3; } elsif ($parm =~ /(\S+)/) { $parm_elem->setAttribute('type', $1); $name = "arg" . $parm_num; } if ($name =~ /(\w+)\[.*\]/) { $name = $1; $parm_elem->setAttribute('array', "true"); } $parm_elem->setAttribute('name', $name); } } sub addReturnElem { my ($parent, $ret) = @_; $ret =~ s/const|G_CONST_RETURN/const-/g; $ret =~ s/\s+//g; my $ret_elem = $doc->createElement('return-type'); $parent->appendChild($ret_elem); $ret_elem->setAttribute('type', $ret); return $ret_elem; } sub addPropElem { my ($spec, $node) = @_; my ($name, $mode, $docs); $spec =~ /g_param_spec_(\w+)\s*\((.*)\s*\)\s*\)/; my $type = $1; my @params = split(/,/, $2); $name = $params[0]; if ($defines{$name}) { $name = $defines{$name}; } else { $name =~ s/\s*\"//g; } $mode = $params[$#params]; if ($type =~ /boolean|float|double|^u?int|pointer/) { $type = "g$type"; } elsif ($type =~ /string/) { $type = "gchar*"; } elsif ($type =~ /boxed|object/) { $type = $params[$#params-1]; $type =~ s/TYPE_//; $type =~ s/\s+//g; $type = StudlyCaps(lc($type)); } elsif ($type =~ /enum|flags/) { $type = $params[$#params-2]; $type =~ s/TYPE_//; $type =~ s/\s+//g; $type = StudlyCaps(lc($type)); } $prop_elem = $doc->createElement('property'); $node->appendChild($prop_elem); $prop_elem->setAttribute('name', StudlyCaps($name)); $prop_elem->setAttribute('cname', $name); $prop_elem->setAttribute('type', $type); $prop_elem->setAttribute('readable', "true") if ($mode =~ /READ/); $prop_elem->setAttribute('writeable', "true") if ($mode =~ /WRIT/); $prop_elem->setAttribute('construct-only', "true") if ($mode =~ /CONS/); } sub parseTypeToken { my ($tok) = @_; if ($tok =~ /G_TYPE_(\w+)/) { my $type = $1; if ($type eq "NONE") { return "void"; } elsif ($type eq "INT") { return "gint32"; } elsif ($type eq "UINT") { return "guint32"; } elsif ($type eq "ENUM" || $type eq "FLAGS") { return "gint32"; } elsif ($type eq "STRING") { return "gchar*"; } elsif ($type eq "OBJECT") { return "GObject*"; } else { return "g" . lc ($type); } } else { $tok =~ s/_TYPE//; $tok =~ s/\|.*STATIC_SCOPE//; $tok =~ s/\s+//g; return StudlyCaps (lc($tok)); } } sub addSignalElem { my ($spec, $class, $node) = @_; $spec =~ s/\n\s*//g; $class =~ s/\n\s*//g; $sig_elem = $doc->createElement('signal'); $node->appendChild($sig_elem); if ($spec =~ /\(\"([\w\-]+)\"/) { $sig_elem->setAttribute('name', StudlyCaps($1)); $sig_elem->setAttribute('cname', $1); } $sig_elem->setAttribute('when', $1) if ($spec =~ /_RUN_(\w+)/); my $method = ""; if ($spec =~ /_OFFSET\s*\(\w+,\s*(\w+)\)/) { $method = $1; } else { @args = split(/,/, $spec); my $rettype = parseTypeToken ($args[7]); addReturnElem($sig_elem, $rettype); $parmcnt = $args[8]; $parmcnt =~ s/.*(\d+).*/\1/; $parms_elem = $doc->createElement('parameters'); $sig_elem->appendChild($parms_elem); $parm_elem = $doc->createElement('parameter'); $parms_elem->appendChild($parm_elem); $parm_elem->setAttribute('name', "inst"); $parm_elem->setAttribute('type', "$inst*"); for (my $idx = 0; $idx < $parmcnt; $idx++) { my $a... [truncated message content] |
|
From: Duncan C. <dun...@us...> - 2005-01-05 23:54:05
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2415/apiGen Log Message: Directory /cvsroot/gtk2hs/gtk2hs/tools/apiGen added to the repository |
|
From: Duncan C. <dun...@us...> - 2004-12-20 03:31:11
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/treeList In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31844/gtk/treeList Modified Files: TreeView.chs.pp Log Message: Make --disable-gnome and --disable-libglade work again. Do not #include<gtk/gtkversion.h> in config.h, instead define GTK_CHECK_VERSION macro directly. Also add hack to stop harmless warnings about clashing symbols. Use per-library / per-program search paths. Drop use of BUILDSOURCES. Index: TreeView.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/treeList/TreeView.chs.pp,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- TreeView.chs.pp 9 Dec 2004 18:26:02 -0000 1.2 +++ TreeView.chs.pp 20 Dec 2004 03:30:59 -0000 1.3 @@ -58,10 +58,6 @@ -- * set_scroll_adjustment makes sense if the user monitors the scroll bars -- *and* the scroll bars can be replaced anytime (the latter is odd) -- - -#include<gtk/gtkversion.h> --- Let's hope this file will always only contain macros. - module TreeView( TreeView, TreeViewClass, |
|
From: Duncan C. <dun...@us...> - 2004-12-20 03:31:11
|
Update of /cvsroot/gtk2hs/gtk2hs/mk In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31844/mk Modified Files: common.mk Log Message: Make --disable-gnome and --disable-libglade work again. Do not #include<gtk/gtkversion.h> in config.h, instead define GTK_CHECK_VERSION macro directly. Also add hack to stop harmless warnings about clashing symbols. Use per-library / per-program search paths. Drop use of BUILDSOURCES. Index: common.mk =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/mk/common.mk,v retrieving revision 1.46 retrieving revision 1.47 diff -u -d -r1.46 -r1.47 --- common.mk 17 Dec 2004 21:21:45 -0000 1.46 +++ common.mk 20 Dec 2004 03:30:59 -0000 1.47 @@ -5,10 +5,8 @@ EMPTY := SPACE := $(EMPTY) $(EMPTY) -COMMA := , -VPATH = $(subst $(SPACE),:,$(strip \ - $(if $(subst .,,$(srcdir)),$(addprefix $(srcdir)/,$(SOURCEDIRS)), \ - $(SOURCEDIRS)))) + +pkgVPATH = $(subst $(SPACE),:,$($(1)_SOURCESDIRS)) LINK = $(strip $(HC) -o $@ $(HCFLAGS) $($(NAME)_HCFLAGS) \ $(addprefix -package ,$($(NAME)_PACKAGEDEPS)) \ @@ -17,8 +15,7 @@ .hs.o: $(CONFIG_H) @echo Building for $(NAME) $(strip $(HC) -c $< -o $@ $(HCFLAGS) $($(NAME)_HCFLAGS) \ - $(call getVar,$<,HCFLAGS) -i$(VPATH) \ - $(addprefix -package ,$($(NAME)_PACKAGEDEPS)) \ + $(call getVar,$<,HCFLAGS) -i$(call pkgVPATH,$(NAME)) \ $(addprefix -package-name ,$(notdir $(basename $($(NAME)_PACKAGE)))) \ $(addprefix '-#include<,$(addsuffix >', $($(NAME)_HEADER))) \ $(AM_CPPFLAGS) $($(NAME)_CPPFLAGS)) @@ -35,15 +32,13 @@ depend: $($(NAME)_BUILDSOURCES) $(if $(word 2,$($(NAME)_HSFILES)),\ $(HC) -M $(addprefix -optdep,-f $(NAME).deps) \ - $($(NAME)_HCFLAGS) -i$(VPATH) \ + $($(NAME)_HCFLAGS) -i$(call pkgVPATH,$(NAME)) \ $(addprefix -package ,$($(NAME)_PACKAGEDEPS)) \ - $(addprefix '-\#include<,$(addsuffix >',$(CONFIG_H) \ - $($(NAME)_HEADER))) \ $(AM_CPPFLAGS) $(EXTRA_CPPFLAGS) $(CPPFLAGS) \ $($(NAME)_HSFILES)) .chs.dep : - $(CHSDEPEND) -i$(VPATH) $< + @$(CHSDEPEND) -i$(call pkgVPATH,$(NAME)) $< .hs.chi : @: @@ -72,6 +67,7 @@ $(strip $(C2HS) $(C2HS_FLAGS) \ +RTS $(HSTOOLFLAGS) $(PROFFLAGS) -RTS \ $(addprefix -C,$($(NAME)_CFLAGS) $($(NAME)_CPPFLAGS)) \ + --cppopts='-include "$(CONFIG_H)"' \ --precomp=$($(NAME)_PRECOMP) $($(NAME)_HEADER)) .chs.pp.chs: $(CONFIG_H) @@ -102,8 +98,7 @@ $(MAKE) $(AM_MAKEFLAGS) NAME="$(NAME)" $($(NAME)_PRECOMP); fi;) $(strip $(C2HS) $(C2HS_FLAGS) \ +RTS $(HSTOOLFLAGS) -RTS \ - -i$(VPATH) --precomp=$($(NAME)_PRECOMP) -o $@ $<) - $(CHSDEPEND) -i$(VPATH) $< + -i$(call pkgVPATH,$(NAME)) --precomp=$($(NAME)_PRECOMP) -o $@ $<) # installation of packages |
|
From: Duncan C. <dun...@us...> - 2004-12-20 03:31:08
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31844 Modified Files: ChangeLog configure.ac Makefile.am Log Message: Make --disable-gnome and --disable-libglade work again. Do not #include<gtk/gtkversion.h> in config.h, instead define GTK_CHECK_VERSION macro directly. Also add hack to stop harmless warnings about clashing symbols. Use per-library / per-program search paths. Drop use of BUILDSOURCES. Index: configure.ac =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/configure.ac,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- configure.ac 17 Dec 2004 21:21:38 -0000 1.13 +++ configure.ac 20 Dec 2004 03:30:58 -0000 1.14 @@ -32,7 +32,14 @@ AC_CANONICAL_HOST AM_CONFIG_HEADER(config.h) -AH_TOP([#include<gtk/gtkversion.h>]) +AH_TOP([ +/* Hack to suppress warnings that these symbols clash with + the ones from ghc's version of config.h */ +#undef /**/ PACKAGE_NAME +#undef /**/ PACKAGE_STRING +#undef /**/ PACKAGE_TARNAME +#undef /**/ PACKAGE_VERSION +]) dnl Checks for programs. AM_PROG_CC_C_O @@ -48,6 +55,7 @@ AC_PATH_PROG(SED,gnused) AC_PATH_PROG(SED,gsed) AC_PATH_PROG(SED,sed) +AC_PATH_PROG(CUT,cut) AC_PATH_PROG(TAR,tar) AC_PATH_PROG(TOUCH,touch) AC_PROG_RANLIB @@ -191,12 +199,12 @@ dnl Optimise Haskell by default and give sufficient space. if test -z "$HCFLAGS"; then - HCFLAGS=" -O -H180m " + HCFLAGS="-O -H180m" fi dnl Check whether to use a local package file. AC_ARG_WITH(pkgconf, - [ --with-pkgconf=FILE GHC package file to install packages], + [ --with-pkgconf=FILE GHC package file to install packages], [PKGCONF=$withval;],[PKGCONF=;]) dnl Check for pkg-config which holds information about all Gtk related @@ -240,6 +248,7 @@ [ENABLE_LIBGLADE=$enableval],[ENABLE_LIBGLADE=yes]) AC_MSG_RESULT($ENABLE_LIBGLADE) +AM_CONDITIONAL(ENABLE_LIBGLADE, test x$ENABLE_LIBGLADE = xyes) dnl Check if user wants the various gnome modules. Defaults to yes. AC_MSG_CHECKING([whether to build gnome bindings]) @@ -249,12 +258,17 @@ [ENABLE_GNOME=$enableval],[ENABLE_GNOME=yes]) AC_MSG_RESULT($ENABLE_GNOME) +AM_CONDITIONAL(ENABLE_GNOME, test x$ENABLE_GNOME = xyes) + +dnl Check if user wants the Mozilla's browser engine widget. Defaults to yes. +AC_MSG_CHECKING([whether to build mozembed bindings]) AC_ARG_ENABLE(mozilla, [ --disable-mozilla do not generate bindings for the Mozilla display widget], [ENABLE_MOZEMBED=$enableval],[ENABLE_MOZEMBED=yes]) AC_MSG_RESULT($ENABLE_MOZEMBED) +AM_CONDITIONAL(ENABLE_MOZEMBED, test x$ENABLE_MOZEMBED = xyes) dnl Check for the GTK&Co libraries. Use the special PKG_CHECK_MODULES dnl macro from the pkg-config program. @@ -277,6 +291,24 @@ dnl Haskell types for the available C types. CREATE_TYPES="$CREATE_TYPES `$PKG_CONFIG gtk+-2.0 --atleast-version=2.2 && echo gtk-2.2`" CREATE_TYPES="$CREATE_TYPES `$PKG_CONFIG gtk+-2.0 --atleast-version=2.4 && echo gtk-2.4`" +CREATE_TYPES="$CREATE_TYPES `$PKG_CONFIG gtk+-2.0 --atleast-version=2.6 && echo gtk-2.6`" + +dnl Also allow us to conditionally compile binding to the new Gtk+ APIs. +GTK_VERSION=`$PKG_CONFIG gtk+-2.0 --modversion` +GTK_MAJOR_VERSION=`echo $GTK_VERSION | $CUT -d. -f1` +GTK_MINOR_VERSION=`echo $GTK_VERSION | $CUT -d. -f2` +GTK_MICRO_VERSION=`echo $GTK_VERSION | $CUT -d. -f3` +AC_DEFINE_UNQUOTED(GTK_MAJOR_VERSION, ($GTK_MAJOR_VERSION), [Gtk major version number]) +AC_DEFINE_UNQUOTED(GTK_MINOR_VERSION, ($GTK_MINOR_VERSION), [Gtk minor version number]) +AC_DEFINE_UNQUOTED(GTK_MICRO_VERSION, ($GTK_MICRO_VERSION), [Gtk minor patch level]) +AH_BOTTOM([ +/* Allow code to be compiled differently for different versions of GTK+ */ +#define GTK_CHECK_VERSION(major,minor,micro) \ + (GTK_MAJOR_VERSION > (major) || \ + (GTK_MAJOR_VERSION == (major) && GTK_MINOR_VERSION > (minor)) || \ + (GTK_MAJOR_VERSION == (major) && GTK_MINOR_VERSION == (minor) && \ + GTK_MICRO_VERSION >= (micro))) +]) dnl The configuration program for GTK is kind of stupid in that it dnl lists directories which don't exist. ghc-pkg in ghc 5.04 or greater @@ -340,7 +372,7 @@ AC_SUBST(MOZEMBED_LIBEXTRA_CQ) AC_ARG_WITH(hidir, - [ --with-hidir=DIR specify install dir for .hi files], + [ --with-hidir=DIR specify install dir for .hi files], [hidir=$withval], [hidir=$libdir/hi]) AC_SUBST(hidir) @@ -487,17 +519,8 @@ AC_SUBST(C2HSFLAGS) AC_SUBST(EXTRA_HFILES) dnl Versionitis -dnl AC_SUBST(GTK_MAJOR_VERSION) -dnl AC_SUBST(GTK_MINOR_VERSION) -dnl AC_SUBST(GTK_MICRO_VERSION) -AC_SUBST(GTK_VERSION_2_2) -AC_SUBST(GTK_VERSION_2_4) -AC_SUBST(DISABLE_DEPRECATED) AC_SUBST(CREATE_TYPES) dnl Optional packages -dnl AC_SUBST(ENABLE_OPENGL) -AC_SUBST(ENABLE_LIBGLADE) -AC_SUBST(ENABLE_GNOME) AC_SUBST(SOURCEVIEW_CFLAGS) AC_SUBST(SOURCEVIEW_LIBS) AC_SUBST(LIBGLADE_CFLAGS) Index: Makefile.am =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v retrieving revision 1.28 retrieving revision 1.29 diff -u -d -r1.28 -r1.29 --- Makefile.am 18 Dec 2004 20:48:01 -0000 1.28 +++ Makefile.am 20 Dec 2004 03:30:58 -0000 1.29 @@ -7,21 +7,10 @@ $(GTK_CFLAGS) $(SOURCEVIEW_CFLAGS) \ $(LIBGLADE_CFLAGS) $(GCONF_CFLAGS) \ $(MOZEMBED_CFLAGS)) +nobase_hi_SCRIPTS = #hack 'til gtk uses it # Build c2hs before anything else. -SOURCEDIRS = gtk/general gtk/glib gtk/pango gtk/treeList gtk/multiline \ - gtk/gdk gtk/abstract gtk/display gtk/entry gtk/misc gtk/multiline \ - gtk/ornaments gtk/scrolling gtk/treeList gtk/selectors gtk/embedding \ - gtk/layout gtk/menuComboToolbar gtk/buttons gtk/windows \ - tools/hierarchyGen tools/callbackGen tools/apicoverage \ - tools/c2hs/base/admin tools/c2hs/base/errors \ - tools/c2hs/base/general tools/c2hs/base/graphs \ - tools/c2hs/base/state tools/c2hs/base/syms \ - tools/c2hs/base/syntax tools/c2hs/base/sysdep tools/c2hs/c \ - tools/c2hs/chs tools/c2hs/gen tools/c2hs/state tools/c2hs/toplevel \ - mogul glade gconf sourceview mozembed - EXTRA_DIST = \ tools/callbackGen/Signal.chs-boot1 \ tools/callbackGen/Signal.chs-boot2 \ @@ -39,13 +28,20 @@ HSC = hsc2hs # all packages and applications -lib_LIBRARIES = \ - libHSgtk.a \ - libHSmogul.a \ - libHSglade.a \ +lib_LIBRARIES = \ + libHSgtk.a \ + libHSmogul.a +if ENABLE_LIBGLADE +lib_LIBRARIES += libHSglade.a +endif +if ENABLE_GNOME +lib_LIBRARIES += \ libHSgconf.a \ - libHSsourceview.a \ - libHSmozembed.a + libHSsourceview.a +endif +if ENABLE_MOZEMBED +lib_LIBRARIES += libHSmozembed.a +endif noinst_PROGRAMS = \ tools/hierarchyGen/TypeGenerator \ @@ -68,6 +64,7 @@ tools_hierarchyGen_TypeGenerator_MAIN = \ $(tools_hierarchyGen_TypeGenerator_SOURCES) tools_hierarchyGen_TypeGenerator_PACKAGEDEPS = +tools_hierarchyGen_TypeGenerator_SOURCESDIRS = tools/hierarchyGen tools_hierarchyGen_TypeGenerator_SOURCES = \ tools/hierarchyGen/TypeGen.hs # Fix automake - the subdir-objects option doesn't work here. @@ -87,6 +84,7 @@ tools_callbackGen_HookGenerator_MAIN = \ $(tools_callbackGen_HookGenerator_SOURCES) tools_callbackGen_HookGenerator_PACKAGEDEPS = +tools_callbackGen_HookGenerator_SOURCESDIRS = tools/callbackGen tools_callbackGen_HookGenerator_SOURCES = \ tools/callbackGen/HookGenerator.hs am_tools_callbackGen_HookGenerator_OBJECTS = $(addsuffix .$(OBJEXT),\ @@ -114,6 +112,7 @@ tools_apicoverage_Exclude_MAIN = \ $(tools_apicoverage_Exclude_SOURCES) tools_apicoverage_Exclude_PACKAGEDEPS = +tools_apicoverage_Exclude_SOURCESDIRS = tools/apicoverage tools_apicoverage_Exclude_SOURCES = \ tools/apicoverage/Exclude.hs am_tools_apicoverage_Exclude_OBJECTS = $(addsuffix .$(OBJEXT),\ @@ -134,6 +133,13 @@ tools_c2hs_c2hsLocal_HEADER = tools_c2hs_c2hsLocal_HCFLAGS = +tools_c2hs_c2hsLocal_SOURCESDIRS = \ + tools/c2hs/base/admin tools/c2hs/base/errors \ + tools/c2hs/base/general tools/c2hs/base/graphs \ + tools/c2hs/base/state tools/c2hs/base/syms \ + tools/c2hs/base/syntax tools/c2hs/base/sysdep tools/c2hs/c \ + tools/c2hs/chs tools/c2hs/gen tools/c2hs/state tools/c2hs/toplevel + tools_c2hs_c2hsLocal_SOURCES = \ tools/c2hs/base/admin/BaseVersion.hs \ tools/c2hs/base/admin/Common.hs \ @@ -218,6 +224,12 @@ libHSgtk_a_CFLAGS = $(filter-out -I% -D%,$(GTK_CFLAGS)) libHSgtk_a_CPPFLAGS = $(filter -I% -D%,$(GTK_CFLAGS)) +libHSgtk_a_SOURCESDIRS = \ + gtk/glib gtk/general gtk/pango gtk/treeList gtk/multiline gtk/gdk \ + gtk/abstract gtk/display gtk/entry gtk/misc gtk/multiline \ + gtk/ornaments gtk/scrolling gtk/treeList gtk/selectors gtk/embedding \ + gtk/layout gtk/menuComboToolbar gtk/buttons gtk/windows + libHSgtk_a_SOURCES = \ gtk/general/Hierarchy.chs \ gtk/general/Signal.chs \ @@ -425,7 +437,9 @@ libHSmogul_a_LIBS = libHSmogul_a_HCFLAGS = libHSmogul_a_CFLAGS = -libHSmogul_a_CPPFLAGS = $(CPPFLAGS) +libHSmogul_a_CPPFLAGS = + +libHSmogul_a_SOURCESDIRS = $(libHSgtk_a_SOURCESDIRS) mogul libHSmogul_a_SOURCES = \ mogul/GetWidget.hs \ @@ -435,8 +449,6 @@ mogul/TreeList.hs \ mogul/WidgetTable.hs -libHSmogul_a_DEPENDENCIES = libHSgtk.a - am_libHSmogul_a_OBJECTS = \ $(addsuffix .$(OBJEXT),$(basename $(basename $(libHSmogul_a_SOURCES)))) @@ -458,6 +470,8 @@ # ################################################################################ +if ENABLE_LIBGLADE + libHSglade_a_NAME = libHSglade.a $(libHSglade_a_NAME) : NAME = libHSglade_a @@ -470,14 +484,14 @@ libHSglade_a_CFLAGS = $(filter-out -I% -D%,$(GTK_CFLAGS) $(LIBGLADE_CFLAGS)) libHSglade_a_CPPFLAGS = $(filter -I% -D%,$(GTK_CFLAGS) $(LIBGLADE_CFLAGS)) +libHSglade_a_SOURCESDIRS = $(libHSgtk_a_SOURCESDIRS) glade + libHSglade_a_SOURCES = \ glade/GladeType.chs \ glade/Glade.chs glade_GladeType_hs_HCFLAGS = -fglasgow-exts -libHSglade_a_DEPENDENCIES = libHSgtk.a - glade/GladeType.chs : $(srcdir)/tools/hierarchyGen/hierarchy.list \ $(srcdir)/tools/hierarchyGen/TypeGenerator \ $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template @@ -516,11 +530,15 @@ -include libHSglade_a.deps $(libHSglade_a_CHSFILES:.chs=.dep) endif +endif #ENABLE_LIBGLADE + # # gconf package # ################################################################################ +if ENABLE_GNOME + libHSgconf_a_NAME = libHSgconf.a $(libHSgconf_a_NAME) : NAME = libHSgconf_a @@ -533,14 +551,14 @@ libHSgconf_a_CFLAGS = $(filter-out -I% -D%,$(GTK_CFLAGS) $(GCONF_CFLAGS)) libHSgconf_a_CPPFLAGS = $(filter -I% -D%,$(GTK_CFLAGS) $(GCONF_CFLAGS)) +libHSgconf_a_SOURCESDIRS = $(libHSgtk_a_SOURCESDIRS) gconf + libHSgconf_a_SOURCES = \ gconf/System/Gnome/GConf/GConfType.chs \ gconf/System/Gnome/GConf/GConfValue.chs \ gconf/System/Gnome/GConf/GConfClient.chs \ gconf/System/Gnome/GConf.hs -libHSgconf_a_DEPENDENCIES = libHSgtk.a - gconf/System/Gnome/GConf/GConfType.chs : \ $(srcdir)/tools/hierarchyGen/hierarchy.list \ $(srcdir)/tools/hierarchyGen/TypeGenerator \ @@ -568,7 +586,7 @@ $(filter %.hs,$(libHSgconf_a_BUILDSOURCES)) \ $(filter %.hs,$(libHSgconf_a_SOURCES)) -nobase_hi_SCRIPTS = $(libHSgconf_a_HSFILES:.hs=.hi) +nobase_hi_SCRIPTS += $(libHSgconf_a_HSFILES:.hs=.hi) MOSTLYCLEANFILES += $(am_libHSgconf_a_OBJECTS) MOSTLYCLEANFILES += $(libHSgconf_a_HSFILES:.hs=.hi) @@ -585,11 +603,15 @@ -include libHSgconf_a.deps $(libHSgconf_a_CHSFILES:.chs=.dep) endif +endif #ENABLE_GNOME + # # sourceview package # ################################################################################ +if ENABLE_GNOME + libHSsourceview_a_NAME = libHSsourceview.a $(libHSsourceview_a_NAME) : NAME = libHSsourceview_a @@ -602,6 +624,8 @@ libHSsourceview_a_CFLAGS = $(filter-out -I% -D%,$(GTK_CFLAGS) $(SOURCEVIEW_CFLAGS)) libHSsourceview_a_CPPFLAGS = $(filter -I% -D%,$(GTK_CFLAGS) $(SOURCEVIEW_CFLAGS)) -Isourceview +libHSsourceview_a_SOURCESDIRS = $(libHSgtk_a_SOURCESDIRS) sourceview + libHSsourceview_a_SOURCES = \ sourceview/SourceViewType.chs \ sourceview/SourceBuffer.chs \ @@ -618,8 +642,6 @@ sourceview_SourceViewType_hs_HCFLAGS = -fglasgow-exts sourceview_SourceTagStyle_hs_HCFLAGS = -fglasgow-exts -libHSsourceview_a_DEPENDENCIES = libHSgtk.a - sourceview/SourceViewType.chs : \ $(srcdir)/tools/hierarchyGen/hierarchy.list \ $(srcdir)/tools/hierarchyGen/TypeGenerator \ @@ -660,11 +682,15 @@ -include libHSsourceview_a.deps $(libHSsourceview_a_CHSFILES:.chs=.dep) endif +endif #ENABLE_GNOME + # # mozembed package # ################################################################################ +if ENABLE_MOZEMBED + libHSmozembed_a_NAME = libHSmozembed.a $(libHSmozembed_a_NAME) : NAME = libHSmozembed_a @@ -677,13 +703,14 @@ libHSmozembed_a_CFLAGS = $(filter-out -I% -D%,$(GTK_CFLAGS) $(MOZEMBED_CFLAGS)) libHSmozembed_a_CPPFLAGS = $(filter -I% -D%,$(GTK_CFLAGS) $(MOZEMBED_CFLAGS)) +libHSmozembed_a_SOURCESDIRS = $(libHSgtk_a_SOURCESDIRS) mozembed + libHSmozembed_a_SOURCES = \ mozembed/Graphics/UI/Gtk/MozEmbedType.chs \ mozembed/Graphics/UI/Gtk/MozEmbed.chs mozembed_Graphics_UI_Gtk_MozEmbedType_hs_HCFLAGS = -fglasgow-exts -libHSmozembed_a_DEPENDENCIES = libHSgtk.a mozembed/Graphics/UI/Gtk/MozEmbedType.chs : \ $(srcdir)/tools/hierarchyGen/hierarchy.list \ @@ -726,12 +753,6 @@ -include libHSmozembed_a.deps $(libHSmozembed_a_CHSFILES:.chs=.dep) endif - -# All generated source files go here. -BUILDSOURCES = $(libHSgtk_a_BUILDSOURCES) \ - $(libHSglade_a_BUILDSOURCES) \ - $(libHSgconf_a_BUILDSOURCES) \ - $(libHSsourceview_a_BUILDSOURCES) \ - $(libHSmozembed_a_BUILDSOURCES) +endif #ENABLE_MOZEMBED include mk/common.mk Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.261 retrieving revision 1.262 diff -u -d -r1.261 -r1.262 --- ChangeLog 18 Dec 2004 20:48:07 -0000 1.261 +++ ChangeLog 20 Dec 2004 03:30:58 -0000 1.262 @@ -1,3 +1,29 @@ +2004-12-19 Duncan Coutts <du...@co...> + + * configure.ac: add support for conditionals in Makefile.am so that + --disable-gnome, --disable-libglade will work again. + Instead of doing #include<gtk/gtkversion.h> in config.h just define the + GTK_CHECK_VERSION in config.h. It's a simple macro and it means that + now config.h does not depend on any -I include paths so can be used in + any module. Also added hack to stop warnings about PACKAGE_* variables + clashing with the ones from ghc's version of config.h. + + * gtk/treeList/TreeView.chs.pp: do not #include<gtk/gtkversion.h>, + the GTK_CHECK_VERSION macro is now defined in config.h + + * mk/common.mk: include config.h when building .precomp files since + config.h has the *_DISABLE_DEPRECATED #defines which modify the gtk + headers. Also, use a per-library search path. Possibly controversial, + revert it if you don't like the idea. + + * Makefile.am: Use per-library / per-program search paths. Make the + glade, gconf, sourceview and mozembed packages build conditionally on + ENABLE_* variables set by ./configure --disable-*. Also, ditch the use + of BUILDSOURCES, having re-read the automake manual I concluded it's + not helpful. + + * tools/callbackGen/HookGenerator.hs: remove support for pre-5.04 ghc. + 2004-12-18 Duncan Coutts <du...@co...> * tools/c2hs/toplevel/Main.hs: remove performance debuging output when |
|
From: Duncan C. <dun...@us...> - 2004-12-20 03:26:04
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/callbackGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31660/tools/callbackGen Modified Files: HookGenerator.hs Log Message: Remove support for pre-5.04 ghc. Index: HookGenerator.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/callbackGen/HookGenerator.hs,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- HookGenerator.hs 17 Jul 2004 04:01:58 -0000 1.2 +++ HookGenerator.hs 20 Dec 2004 03:25:55 -0000 1.3 @@ -1,4 +1,3 @@ -{-# OPTIONS -cpp #-} -- HookGenerator.hs -*-haskell-*- -- Takes a type list of possible hooks from the GTK+ distribution and produces -- Haskell functions to connect to these callbacks. @@ -440,11 +439,7 @@ indent 1.mkRawtype sig. indent 0. (if fakeSignature bs sig then id else indent 0.ss "foreign". -#if __GLASGOW_HASKELL__>=504 ss " import ccall \"wrapper\" ").ss "mkHandler_".ident.ss " ::". -#else - ss " export dynamic ").ss "mkHandler_".ident.ss " ::". -#endif indent 1.ss "Tag_".ident.ss " -> ". indent 1.ss "IO (FunPtr ".ss "Tag_".ident.sc ')'. (if fakeSignature bs sig then |
|
From: Duncan C. <dun...@us...> - 2004-12-18 20:48:21
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21570 Modified Files: Makefile.am ChangeLog Log Message: Make the various 'clean' targets more thorough. Also get the .hi files to be installed for the other packages (mogul, glade, sourceview, gconf, mozembed). Index: Makefile.am =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v retrieving revision 1.27 retrieving revision 1.28 diff -u -d -r1.27 -r1.28 --- Makefile.am 17 Dec 2004 21:21:38 -0000 1.27 +++ Makefile.am 18 Dec 2004 20:48:01 -0000 1.28 @@ -1,11 +1,12 @@ AUTOMAKE_OPTIONS = foreign subdir-objects SUFFIXES = .chs.pp .chs .hsc .deps .dep -MOSTLYCLEANFILES = +MOSTLYCLEANFILES = *.deps.bak CLEANFILES = -DISTCLEANFILES = *.precomp +DISTCLEANFILES = */*.precomp CPPFLAGS += $(filter -I% -D%, \ $(GTK_CFLAGS) $(SOURCEVIEW_CFLAGS) \ - $(LIBGLADE_CFLAGS) $(GCONF_CFLAGS)) + $(LIBGLADE_CFLAGS) $(GCONF_CFLAGS) \ + $(MOZEMBED_CFLAGS)) # Build c2hs before anything else. @@ -19,8 +20,7 @@ tools/c2hs/base/state tools/c2hs/base/syms \ tools/c2hs/base/syntax tools/c2hs/base/sysdep tools/c2hs/c \ tools/c2hs/chs tools/c2hs/gen tools/c2hs/state tools/c2hs/toplevel \ - mogul glade gconf gconf/System/Gnome gconf/System/Gnome/GConf \ - sourceview mozembed + mogul glade gconf sourceview mozembed EXTRA_DIST = \ tools/callbackGen/Signal.chs-boot1 \ @@ -28,7 +28,8 @@ tools/callbackGen/gtkmarshal.list \ tools/checkDirs.sh \ tools/c2hs/toplevel/c2hs_config.h \ - tools/hierarchyGen/hierarchy.list + tools/hierarchyGen/hierarchy.list \ + tools/hierarchyGen/Hierarchy.chs.template # fixme: this should be in configure.ac: HSCPP = $(CPP) -x c -traditional-cpp -P @@ -73,13 +74,7 @@ am_tools_hierarchyGen_TypeGenerator_OBJECTS = $(addsuffix .$(OBJEXT),\ $(basename $(tools_hierarchyGen_TypeGenerator_SOURCES))) MOSTLYCLEANFILES+= $(am_tools_hierarchyGen_TypeGenerator_OBJECTS) - -gtk/general/Hierarchy.chs : $(srcdir)/tools/hierarchyGen/hierarchy.list \ - $(srcdir)/tools/hierarchyGen/TypeGenerator - $(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \ - $(srcdir)/tools/hierarchyGen/hierarchy.list \ - $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \ - $@ $(addprefix --tag=,$(CREATE_TYPES))) +MOSTLYCLEANFILES+= $(tools_hierarchyGen_TypeGenerator_SOURCES:.hs=.hi) # # HookGenerator Tool @@ -97,6 +92,7 @@ am_tools_callbackGen_HookGenerator_OBJECTS = $(addsuffix .$(OBJEXT),\ $(basename $(tools_callbackGen_HookGenerator_SOURCES))) MOSTLYCLEANFILES+= $(am_tools_callbackGen_HookGenerator_OBJECTS) +MOSTLYCLEANFILES+= $(tools_callbackGen_HookGenerator_SOURCES:.hs=.hi) gtk/general/Signal.chs : $(srcdir)/tools/callbackGen/Signal.chs-boot1 \ @@ -123,6 +119,7 @@ am_tools_apicoverage_Exclude_OBJECTS = $(addsuffix .$(OBJEXT),\ $(basename $(tools_apicoverage_Exclude_SOURCES))) MOSTLYCLEANFILES+= $(am_tools_apicoverage_Exclude_OBJECTS) +MOSTLYCLEANFILES+= $(tools_apicoverage_Exclude_SOURCES:.hs=.hi) # # c2hs interface generator @@ -134,7 +131,7 @@ tools_c2hs_c2hsLocal_MAIN = c2hs/toplevel/Main.hs tools_c2hs_c2hsLocal_PACKAGEDEPS = -tools_c2hs_c2hsLocal_HEADER = tools/c2hs/toplevel/c2hs_config.h +tools_c2hs_c2hsLocal_HEADER = tools_c2hs_c2hsLocal_HCFLAGS = tools_c2hs_c2hsLocal_SOURCES = \ @@ -188,7 +185,8 @@ tools/c2hs/toplevel/c2hs_config.c tools_c2hs_base_syntax_Parsers_hs_HCFLAGS = -fglasgow-exts -tools_c2hs_toplevel_C2HSConfig_hs_HCFLAGS = -fffi +tools_c2hs_toplevel_C2HSConfig_hs_HCFLAGS = -fffi -fvia-C \ + '-\#include<tools/c2hs/toplevel/c2hs_config.h>' tools_c2hs_c2hsLocal_HSFILES = \ $(filter %.hs,$(tools_c2hs_c2hsLocal_SOURCES)) @@ -199,7 +197,7 @@ MOSTLYCLEANFILES+= $(tools_c2hs_c2hsLocal_HSFILES:.hs=.hi) CLEANFILES+= $(tools_c2hs_c2hsLocal_BUILDSOURCES) DISTCLEANFILES+= tools_c2hs_c2hsLocal.deps -ifneq ($(MAKECMDGOALS),clean) +ifeq (,$(findstring clean,$(MAKECMDGOALS))) -include tools_c2hs_c2hsLocal.deps endif @@ -372,6 +370,13 @@ touch $(@:.o=.c) $(CC) -c -o $@ $(@:.o=.c) +gtk/general/Hierarchy.chs : $(srcdir)/tools/hierarchyGen/hierarchy.list \ + $(srcdir)/tools/hierarchyGen/TypeGenerator \ + $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template + $(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \ + $(srcdir)/tools/hierarchyGen/hierarchy.list \ + $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \ + $@ $(addprefix --tag=,$(CREATE_TYPES))) am_libHSgtk_a_OBJECTS = \ $(addsuffix .$(OBJEXT),$(basename $(basename $(libHSgtk_a_SOURCES)))) @@ -393,12 +398,17 @@ # add prefix nobase_ when changing to hierarchical module namespace hi_SCRIPTS = $(libHSgtk_a_HSFILES:.hs=.hi) -MOSTLYCLEANFILES+ = $(am_libHSgtk_a_OBJECTS) -MOSTLYCLEANFILES+ = $(libHSgtk_a_HSFILES:.hs=.hi) +MOSTLYCLEANFILES += $(am_libHSgtk_a_OBJECTS) +MOSTLYCLEANFILES += $(libHSgtk_a_HSFILES:.hs=.hi) +MOSTLYCLEANFILES += \ + $(libHSgtk_a_CHSFILES:.chs=.chi) \ + $(libHSgtk_a_CHSFILES:.chs=_stub.h) \ + $(libHSgtk_a_CHSFILES:.chs=_stub.o) \ + $(libHSgtk_a_CHSFILES:.chs=_stub.c) CLEANFILES+= $(libHSgtk_a_BUILDSOURCES) DISTCLEANFILES+= libHSgtk_a.deps $(libHSgtk_a_CHSFILES_HS:.hs=.dep) -ifneq ($(MAKECMDGOALS),clean) +ifeq (,$(findstring clean, $(MAKECMDGOALS))) -include libHSgtk_a.deps $(libHSgtk_a_CHSFILES_HS:.hs=.dep) endif @@ -433,11 +443,13 @@ libHSmogul_a_HSFILES = $(libHSmogul_a_SOURCES) .PRECIOUS: $(libHSmogul_a_HSFILES:.hs=hi) -MOSTLYCLEANFILES+ = $(am_libHSmogul_a_OBJECTS) -MOSTLYCLEANFILES+ = $(libHSmogul_a_HSFILES:.hs=.hi) +hi_SCRIPTS += $(libHSmogul_a_HSFILES:.hs=.hi) + +MOSTLYCLEANFILES += $(am_libHSmogul_a_OBJECTS) +MOSTLYCLEANFILES += $(libHSmogul_a_HSFILES:.hs=.hi) DISTCLEANFILES+= libHSmogul_a.deps -ifneq ($(MAKECMDGOALS),clean) +ifeq (,$(findstring clean, $(MAKECMDGOALS))) -include libHSmogul_a.deps endif @@ -467,7 +479,8 @@ libHSglade_a_DEPENDENCIES = libHSgtk.a glade/GladeType.chs : $(srcdir)/tools/hierarchyGen/hierarchy.list \ - $(srcdir)/tools/hierarchyGen/TypeGenerator + $(srcdir)/tools/hierarchyGen/TypeGenerator \ + $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template $(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \ $(srcdir)/tools/hierarchyGen/hierarchy.list \ $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \ @@ -491,12 +504,15 @@ $(filter %.hs,$(libHSglade_a_BUILDSOURCES)) \ $(filter %.hs,$(libHSglade_a_SOURCES)) +hi_SCRIPTS += $(libHSglade_a_HSFILES:.hs=.hi) + MOSTLYCLEANFILES += $(am_libHSglade_a_OBJECTS) MOSTLYCLEANFILES += $(libHSglade_a_HSFILES:.hs=.hi) +MOSTLYCLEANFILES += $(libHSglade_a_CHSFILES:.chs=.chi) CLEANFILES += $(libHSglade_a_BUILDSOURCES) DISTCLEANFILES+= libHSglade_a.deps $(libHSglade_a_CHSFILES_HS:.hs=.dep) -ifneq ($(MAKECMDGOALS),clean) +ifeq (,$(findstring clean, $(MAKECMDGOALS))) -include libHSglade_a.deps $(libHSglade_a_CHSFILES:.chs=.dep) endif @@ -527,7 +543,8 @@ gconf/System/Gnome/GConf/GConfType.chs : \ $(srcdir)/tools/hierarchyGen/hierarchy.list \ - $(srcdir)/tools/hierarchyGen/TypeGenerator + $(srcdir)/tools/hierarchyGen/TypeGenerator \ + $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template $(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \ $(srcdir)/tools/hierarchyGen/hierarchy.list \ $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \ @@ -551,13 +568,20 @@ $(filter %.hs,$(libHSgconf_a_BUILDSOURCES)) \ $(filter %.hs,$(libHSgconf_a_SOURCES)) +nobase_hi_SCRIPTS = $(libHSgconf_a_HSFILES:.hs=.hi) + MOSTLYCLEANFILES += $(am_libHSgconf_a_OBJECTS) MOSTLYCLEANFILES += $(libHSgconf_a_HSFILES:.hs=.hi) +MOSTLYCLEANFILES += \ + $(libHSgconf_a_CHSFILES:.chs=.chi) \ + $(libHSgconf_a_CHSFILES:.chs=_stub.h) \ + $(libHSgconf_a_CHSFILES:.chs=_stub.o) \ + $(libHSgconf_a_CHSFILES:.chs=_stub.c) CLEANFILES += $(libHSgconf_a_BUILDSOURCES) DISTCLEANFILES+= libHSgconf_a.deps $(libHSgconf_a_CHSFILES_HS:.hs=.dep) -ifneq ($(MAKECMDGOALS),clean) +ifeq (,$(findstring clean, $(MAKECMDGOALS))) -include libHSgconf_a.deps $(libHSgconf_a_CHSFILES:.chs=.dep) endif @@ -598,7 +622,8 @@ sourceview/SourceViewType.chs : \ $(srcdir)/tools/hierarchyGen/hierarchy.list \ - $(srcdir)/tools/hierarchyGen/TypeGenerator + $(srcdir)/tools/hierarchyGen/TypeGenerator \ + $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template $(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \ $(srcdir)/tools/hierarchyGen/hierarchy.list \ $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \ @@ -622,13 +647,16 @@ $(filter %.hs,$(libHSsourceview_a_BUILDSOURCES)) \ $(filter %.hs,$(libHSsourceview_a_SOURCES)) +hi_SCRIPTS += $(libHSsourceview_a_HSFILES:.hs=.hi) + MOSTLYCLEANFILES += $(am_libHSsourceview_a_OBJECTS) MOSTLYCLEANFILES += $(libHSsourceview_a_HSFILES:.hs=.hi) +MOSTLYCLEANFILES += $(libHSsourceview_a_CHSFILES:.chs=.chi) CLEANFILES += $(libHSsourceview_a_BUILDSOURCES) DISTCLEANFILES+= libHSsourceview_a.deps $(libHSsourceview_a_CHSFILES_HS:.hs=.dep) -ifneq ($(MAKECMDGOALS),clean) +ifeq (,$(findstring clean, $(MAKECMDGOALS))) -include libHSsourceview_a.deps $(libHSsourceview_a_CHSFILES:.chs=.dep) endif @@ -659,7 +687,8 @@ mozembed/Graphics/UI/Gtk/MozEmbedType.chs : \ $(srcdir)/tools/hierarchyGen/hierarchy.list \ - $(srcdir)/tools/hierarchyGen/TypeGenerator + $(srcdir)/tools/hierarchyGen/TypeGenerator \ + $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template $(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \ $(srcdir)/tools/hierarchyGen/hierarchy.list \ $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \ @@ -684,13 +713,16 @@ $(filter %.hs,$(libHSmozembed_a_BUILDSOURCES)) \ $(filter %.hs,$(libHSmozembed_a_SOURCES)) +nobase_hi_SCRIPTS += $(libHSmozembed_a_HSFILES:.hs=.hi) + MOSTLYCLEANFILES += $(am_libHSmozembed_a_OBJECTS) MOSTLYCLEANFILES += $(libHSmozembed_a_HSFILES:.hs=.hi) +MOSTLYCLEANFILES += $(libHSmozembed_a_CHSFILES:.chs=.chi) CLEANFILES += $(libHSmozembed_a_BUILDSOURCES) DISTCLEANFILES+= libHSmozembed_a.deps $(libHSmozembed_a_CHSFILES_HS:.hs=.dep) -ifneq ($(MAKECMDGOALS),clean) +ifeq (,$(findstring clean, $(MAKECMDGOALS))) -include libHSmozembed_a.deps $(libHSmozembed_a_CHSFILES:.chs=.dep) endif Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.260 retrieving revision 1.261 diff -u -d -r1.260 -r1.261 --- ChangeLog 17 Dec 2004 22:02:54 -0000 1.260 +++ ChangeLog 18 Dec 2004 20:48:07 -0000 1.261 @@ -1,3 +1,19 @@ +2004-12-18 Duncan Coutts <du...@co...> + + * tools/c2hs/toplevel/Main.hs: remove performance debuging output when + processing .chs files. Keep debugging output for generating .precomp + files to remind us how slow it is and to bug me to fix it! + + * mozembed/Graphics/UI/Gtk/MozEmbed.chs: tidy up module header. + + * mk/chsDepend.in: make chsDepend understand hierarchical modules names + and change the dependency of .hs files to be on the .chi files rather + than the .chs files. This is how it is done for .o and .hs files, that + is, the .o file depends on the .hi files. + + * Makefile.am: make the various 'clean' targets more thorough. Also + get the .hi files to be installed for the other packages. + 2004-12-17 Duncan Coutts <du...@co...> * mozembed/Graphics/UI/Gtk/MozEmbed.chs: new bindings to GtkMozEmbed |
2 messages has been excluded from this view by a project administrator.
