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-31 00:02:40
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/pango In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/pango Removed Files: Description.chs Markup.hs PangoEnums.chs PangoLayout.chs PangoTypes.chs.pp Rendering.chs Log Message: Remove the directories where the old non-hierarchical modules used to live. --- Description.chs DELETED --- --- Markup.hs DELETED --- --- PangoTypes.chs.pp DELETED --- --- PangoEnums.chs DELETED --- --- PangoLayout.chs DELETED --- --- Rendering.chs DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-31 00:02:38
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/ornaments In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/ornaments Removed Files: Frame.chs HSeparator.chs VSeparator.chs Log Message: Remove the directories where the old non-hierarchical modules used to live. --- Frame.chs DELETED --- --- HSeparator.chs DELETED --- --- VSeparator.chs DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-31 00:02:37
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/multiline In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/multiline Removed Files: TextBuffer.chs TextIter.chs.pp TextMark.chs TextTag.chs.pp TextTagTable.chs TextView.chs Log Message: Remove the directories where the old non-hierarchical modules used to live. --- TextMark.chs DELETED --- --- TextTagTable.chs DELETED --- --- TextView.chs DELETED --- --- TextIter.chs.pp DELETED --- --- TextTag.chs.pp DELETED --- --- TextBuffer.chs DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-31 00:02:36
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/misc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/misc Removed Files: Adjustment.chs Calendar.chs.pp DrawingArea.chs EventBox.chs.pp FileChooserWidget.chs.pp GArrow.chs HandleBox.chs SizeGroup.chs Tooltips.chs.pp Viewport.chs api.ignore Log Message: Remove the directories where the old non-hierarchical modules used to live. --- Adjustment.chs DELETED --- --- HandleBox.chs DELETED --- --- DrawingArea.chs DELETED --- --- Calendar.chs.pp DELETED --- --- api.ignore DELETED --- --- FileChooserWidget.chs.pp DELETED --- --- Viewport.chs DELETED --- --- GArrow.chs DELETED --- --- EventBox.chs.pp DELETED --- --- Tooltips.chs.pp DELETED --- --- SizeGroup.chs DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-31 00:02:32
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/menuComboToolbar In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/menuComboToolbar Removed Files: CheckMenuItem.chs.pp Combo.chs.pp ComboBox.chs.pp ComboBoxEntry.chs.pp ImageMenuItem.chs Menu.chs.pp MenuBar.chs MenuItem.chs MenuShell.chs OptionMenu.chs.pp RadioMenuItem.chs TearoffMenuItem.chs ToolItem.chs.pp Toolbar.chs.pp api.ignore Log Message: Remove the directories where the old non-hierarchical modules used to live. --- Menu.chs.pp DELETED --- --- ToolItem.chs.pp DELETED --- --- RadioMenuItem.chs DELETED --- --- MenuBar.chs DELETED --- --- Combo.chs.pp DELETED --- --- CheckMenuItem.chs.pp DELETED --- --- Toolbar.chs.pp DELETED --- --- api.ignore DELETED --- --- OptionMenu.chs.pp DELETED --- --- ComboBoxEntry.chs.pp DELETED --- --- TearoffMenuItem.chs DELETED --- --- MenuItem.chs DELETED --- --- ComboBox.chs.pp DELETED --- --- MenuShell.chs DELETED --- --- ImageMenuItem.chs DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-31 00:02:31
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/layout In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/layout Removed Files: Alignment.chs.pp AspectFrame.chs Expander.chs.pp Fixed.chs HBox.chs HButtonBox.chs HPaned.chs Layout.chs Notebook.chs.pp Table.chs VBox.chs VButtonBox.chs VPaned.chs api.ignore Log Message: Remove the directories where the old non-hierarchical modules used to live. --- Fixed.chs DELETED --- --- Notebook.chs.pp DELETED --- --- HButtonBox.chs DELETED --- --- HBox.chs DELETED --- --- api.ignore DELETED --- --- Alignment.chs.pp DELETED --- --- Expander.chs.pp DELETED --- --- Layout.chs DELETED --- --- VBox.chs DELETED --- --- AspectFrame.chs DELETED --- --- Table.chs DELETED --- --- VPaned.chs DELETED --- --- HPaned.chs DELETED --- --- VButtonBox.chs DELETED --- |
Update of /cvsroot/gtk2hs/gtk2hs/gtk/general In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/general Removed Files: Enums.chs.pp FFI.hs General.chs Gtk.hs IconFactory.chs.pp StockItems.hsc Structs.hsc Style.chs api.ignore Log Message: Remove the directories where the old non-hierarchical modules used to live. --- Style.chs DELETED --- --- StockItems.hsc DELETED --- --- IconFactory.chs.pp DELETED --- --- FFI.hs DELETED --- --- Enums.chs.pp DELETED --- --- General.chs DELETED --- --- Structs.hsc DELETED --- --- Gtk.hs DELETED --- --- api.ignore DELETED --- |
Update of /cvsroot/gtk2hs/gtk2hs/gtk/gdk In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/gdk Removed Files: DrawWindow.hs Drawable.chs.pp Events.hsc GC.chs Gdk.chs GdkEnums.chs Keys.chs Pixbuf.chs Region.chs.pp Log Message: Remove the directories where the old non-hierarchical modules used to live. --- DrawWindow.hs DELETED --- --- GC.chs DELETED --- --- Gdk.chs DELETED --- --- Keys.chs DELETED --- --- Drawable.chs.pp DELETED --- --- GdkEnums.chs DELETED --- --- Region.chs.pp DELETED --- --- Pixbuf.chs DELETED --- --- Events.hsc DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-31 00:02:06
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/entry In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/entry Removed Files: Editable.chs.pp Entry.chs.pp EntryCompletion.chs.pp HScale.chs SpinButton.chs VScale.chs api.ignore Log Message: Remove the directories where the old non-hierarchical modules used to live. --- SpinButton.chs DELETED --- --- Editable.chs.pp DELETED --- --- HScale.chs DELETED --- --- Entry.chs.pp DELETED --- --- VScale.chs DELETED --- --- EntryCompletion.chs.pp DELETED --- --- api.ignore DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-31 00:02:05
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/embedding In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/embedding Removed Files: Embedding.hsc Plug.chs Socket.chs api.ignore Log Message: Remove the directories where the old non-hierarchical modules used to live. --- Embedding.hsc DELETED --- --- Plug.chs DELETED --- --- api.ignore DELETED --- --- Socket.chs DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-31 00:02:04
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/buttons In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/buttons Removed Files: Button.chs.pp CheckButton.chs RadioButton.chs ToggleButton.chs api.ignore Log Message: Remove the directories where the old non-hierarchical modules used to live. --- RadioButton.chs DELETED --- --- CheckButton.chs DELETED --- --- ToggleButton.chs DELETED --- --- api.ignore DELETED --- --- Button.chs.pp DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-31 00:02:04
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/display In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/display Removed Files: AccelLabel.chs Image.chs Label.chs ProgressBar.chs Statusbar.chs api.ignore Log Message: Remove the directories where the old non-hierarchical modules used to live. --- Statusbar.chs DELETED --- --- AccelLabel.chs DELETED --- --- Label.chs DELETED --- --- Image.chs DELETED --- --- ProgressBar.chs DELETED --- --- api.ignore DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-31 00:02:00
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/abstract In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/abstract Removed Files: Bin.chs Box.chs ButtonBox.chs.pp Container.chs FileChooser.chs.pp Misc.chs Object.chs.pp Paned.chs.pp Range.chs Scale.chs Scrollbar.hs Separator.hs Widget.chs api.ignore Log Message: Remove the directories where the old non-hierarchical modules used to live. --- Object.chs.pp DELETED --- --- Scrollbar.hs DELETED --- --- Paned.chs.pp DELETED --- --- Widget.chs DELETED --- --- FileChooser.chs.pp DELETED --- --- api.ignore DELETED --- --- Range.chs DELETED --- --- Box.chs DELETED --- --- ButtonBox.chs.pp DELETED --- --- Separator.hs DELETED --- --- Misc.chs DELETED --- --- Scale.chs DELETED --- --- Container.chs DELETED --- --- Bin.chs DELETED --- |
|
From: Duncan C. <dun...@us...> - 2005-01-30 19:49:21
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2537 Modified Files: ChangeLog Log Message: First go at generating signals including documentation. Ignore virstual methods as they are internal. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.332 retrieving revision 1.333 diff -u -d -r1.332 -r1.333 --- ChangeLog 28 Jan 2005 00:15:18 -0000 1.332 +++ ChangeLog 30 Jan 2005 19:49:10 -0000 1.333 @@ -1,4 +1,18 @@ -2005-01-26 Duncan Coutts <du...@co...> +2005-01-30 Duncan Coutts <du...@co...> + + * tools/apiGen/ApiGen.hs: first go at generating signals including + documentation. Ignore virstual methods as they are internal. + + * tools/apiGen/format-docs.xsl: extract signal documentation, and + adjust for new formatting of property documentation. + +2005-01-28 Duncan Coutts <du...@co...> + + * tools/apiGen/Makefile: use sed to do the patching rather than an + external patch file (which I'd never added to cvs anyway). This time + it should work for other people "out of the box". + +2005-01-27 Duncan Coutts <du...@co...> * tools/apiGen/gapi2xml.pl, tools/apiGen/gapi_parser.pl, tools/apiGen/gapi_pp.pl: sync up with the latest version of these tools |
|
From: Duncan C. <dun...@us...> - 2005-01-30 19:49:21
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2537/tools/apiGen Modified Files: ApiGen.hs format-docs.xsl Log Message: First go at generating signals including documentation. Ignore virstual methods as they are internal. Index: format-docs.xsl =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/format-docs.xsl,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- format-docs.xsl 26 Jan 2005 12:13:28 -0000 1.8 +++ format-docs.xsl 30 Jan 2005 19:49:11 -0000 1.9 @@ -81,6 +81,7 @@ <apidoc> <xsl:for-each select="book"> <module> + <!-- top level module information --> <module-info> <name><xsl:value-of select="refentry/refnamediv/refname"/></name> <altname><xsl:value-of select="refentry/refsynopsisdiv/anchor/@id"/></altname> @@ -104,6 +105,7 @@ </xsl:for-each> </object-hierarchy> </module-info> + <!-- Function documentation --> <xsl:for-each select="refentry/refsect1[title='Details']/refsect2[contains(title,' ()')]"> <function> <name><xsl:value-of select="indexterm/primary"/></name> @@ -123,6 +125,8 @@ </params> </function> </xsl:for-each> + <!-- Properties documentation --> +<!-- <xsl:for-each select="refentry/refsect1[title='Properties']/variablelist/varlistentry"> <property> <name><xsl:value-of select="term/literal"/></name> @@ -134,6 +138,39 @@ </doc> </property> </xsl:for-each> +--> + <!-- Properties documentation (new formatting) --> + <xsl:for-each select="refentry/refsect1[title='Properties']/refsect2"> + <property> + <name><xsl:value-of select="substring-before(substring-after(title,'"'),'"')"/></name> + <since> + <xsl:value-of select="normalize-space(substring-after(para[starts-with(text(),'Since')], 'Since'))"/> + </since> + <doc> + <xsl:apply-templates select="para[not(starts-with(text(),'Since')) and normalize-space(text())!='']"/> + </doc> + </property> + </xsl:for-each> + <!-- Signals documentation --> + <xsl:for-each select="refentry/refsect1[title='Signals']/refsect2"> + <signal> + <name><xsl:value-of select="substring-before(substring-after(title,'"'),'"')"/></name> + <since> + <xsl:value-of select="normalize-space(substring-after(para[starts-with(text(),'Since')], 'Since'))"/> + </since> + <doc> + <xsl:apply-templates select="para[not(starts-with(text(),'Since')) and normalize-space(text())!='']"/> + </doc> + <params> + <xsl:for-each select="variablelist/varlistentry"> + <param> + <name><xsl:value-of select="term/parameter"/></name> + <xsl:apply-templates select="listitem/simpara"/> + </param> + </xsl:for-each> + </params> + </signal> + </xsl:for-each> </module> </xsl:for-each> </apidoc> Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- ApiGen.hs 27 Jan 2005 23:10:14 -0000 1.9 +++ ApiGen.hs 30 Jan 2005 19:49:11 -0000 1.10 @@ -159,13 +159,12 @@ extractObject _ = Nothing extractMethod :: Xml.Content -> Maybe Method -extractMethod (Xml.CElem (Xml.Elem method +extractMethod (Xml.CElem (Xml.Elem "method" [("name", Xml.AttValue name), ("cname", Xml.AttValue cname)] (Xml.CElem (Xml.Elem "return-type" [("type", Xml.AttValue return_type)] []) - :content))) | method == "method" - || method == "virtual_method" = + :content))) = Just $ Method { method_name = Xml.verbatim name, method_cname = Xml.verbatim cname, @@ -281,7 +280,8 @@ moduledoc_sections :: [DocSection], -- any additional titled subsections moduledoc_hierarchy :: [DocParaSpan], -- a tree of parent objects (as text) moduledoc_functions :: [FuncDoc], -- documentation for each function - moduledoc_properties :: [PropDoc] -- documentation for each property + moduledoc_properties :: [PropDoc], -- documentation for each property + moduledoc_signals :: [SignalDoc] -- documentation for each signal } noModuleDoc = ModuleDoc { @@ -292,7 +292,8 @@ moduledoc_sections = [], moduledoc_hierarchy = [], moduledoc_functions = [], - moduledoc_properties = [] + moduledoc_properties = [], + moduledoc_signals = [] } data DocSection = DocSection { @@ -320,6 +321,13 @@ propdoc_since :: Since -- which version of the api the } -- function is available from, eg "2.4" +data SignalDoc = SignalDoc { + signaldoc_name :: String, -- C signal name + signaldoc_paragraphs :: [DocPara], -- documentation markup + signaldoc_params :: [ParamDoc], -- parameter documentation + signaldoc_since :: Since -- which version of the api the + } -- function is available from, eg "2.4" + data DocPara = DocParaText [DocParaSpan] -- an ordinary word-wrapped paragraph | DocParaProgram String -- a verbatum section @@ -347,9 +355,11 @@ extractDocModule (Xml.CElem (Xml.Elem "module" [] (moduleinfo:rest))) = let functions = [ e | e@(Xml.CElem (Xml.Elem "function" _ _)) <- rest ] properties = [ e | e@(Xml.CElem (Xml.Elem "property" _ _)) <- rest ] + signals = [ e | e@(Xml.CElem (Xml.Elem "signal" _ _)) <- rest ] in (extractDocModuleinfo moduleinfo) { moduledoc_functions = map extractDocFunc functions, - moduledoc_properties = map extractDocProp properties + moduledoc_properties = map extractDocProp properties, + moduledoc_signals = map extractDocSignal signals } extractDocModuleinfo :: Xml.Content -> ModuleDoc @@ -373,7 +383,8 @@ moduledoc_sections = map extractDocSection sections, moduledoc_hierarchy = map extractDocParaSpan objHierSpans, moduledoc_functions = undefined, - moduledoc_properties = undefined + moduledoc_properties = undefined, + moduledoc_signals = undefined } extractDocSection :: Xml.Content -> DocSection @@ -431,6 +442,24 @@ propdoc_since = since } +extractDocSignal :: Xml.Content -> SignalDoc +extractDocSignal + (Xml.CElem (Xml.Elem "signal" [] + [Xml.CElem (Xml.Elem "name" [] [Xml.CString _ name]) + ,Xml.CElem (Xml.Elem "since" [] since') + ,Xml.CElem (Xml.Elem "doc" [] paras) + ,Xml.CElem (Xml.Elem "params" [] params)] + )) = + let since = case since' of + [] -> "" + [Xml.CString _ since] -> since + in SignalDoc { + signaldoc_name = name, + signaldoc_paragraphs = concatMap extractDocPara paras, + signaldoc_params = map extractParamDoc params, + signaldoc_since = since + } + extractDocPara :: Xml.Content -> [DocPara] extractDocPara (Xml.CElem elem@(Xml.Elem "para" [] _)) = case Xml.xmlUnEscape Xml.stdXmlEscaper elem of @@ -563,7 +592,7 @@ haddocFormatPara :: DocPara -> ShowS haddocFormatPara (DocParaText spans) = haddocFormatSpans 3 spans haddocFormatPara (DocParaProgram prog) = - ((ss "* FIXME: port the follwing code example from C to Haskell or remove it".nl. + ((ss "* FIXME: if the follwing is a C code example, port it to Haskell or remove it".nl. comment).) . sepBy "\n-- > " . List.lines @@ -737,6 +766,7 @@ genConstructors knownTypes object (moduledoc_functions apiDoc) ++ genMethods knownTypes object (moduledoc_functions apiDoc) ++ genProperties knownTypes object (moduledoc_properties apiDoc) + ++ genSignals knownTypes object (moduledoc_signals apiDoc) genMethods :: KnownTypes -> Object -> [FuncDoc] -> [(ShowS, Since)] genMethods knownTypes object apiDoc = @@ -819,6 +849,36 @@ Just doc -> ss "-- | ". haddocFormatParas (propdoc_paragraphs doc). nl. comment. nl +signals :: Object -> [SignalDoc] -> [(Signal, Maybe SignalDoc)] +signals object docs = + [ (signal, map dashToUnderscore (signal_cname signal) `lookup` docmap) + | signal <- object_signals object ] + where docmap = [ (map dashToUnderscore (signaldoc_name doc), doc) + | doc <- docs ] + dashToUnderscore '-' = '_' + dashToUnderscore c = c + +genSignals :: KnownTypes -> Object -> [SignalDoc] -> [(ShowS, Since)] +genSignals knownTypes object apiDoc = + [ (genSignal object signal doc, maybe "" signaldoc_since doc) + | (signal, doc) <- signals object apiDoc ] + +genSignal :: Object -> Signal -> Maybe SignalDoc -> ShowS +genSignal object property doc = + formattedDoc. + ss "on". signalName. ss ", after". signalName. ss " :: ". nl. + ss "on". signalName. ss " = connect_{-type-}". connectType. sc ' '. signalCName. ss " False". nl. + ss "after". signalName. ss " = connect_{-type-}". connectType. sc ' '. signalCName. ss " True". nl + + where connectType = id + signalName = ss (upperCaseFirstChar (cFuncNameToHsName (signal_cname property))) + signalCName = sc '"'. ss (signal_cname property). sc '"' + formattedDoc = case doc of + Nothing -> ss "-- | \n-- \n" + Just doc -> ss "-- | ". haddocFormatParas (signaldoc_paragraphs doc). nl. + comment. nl + + -- We would like to be able to look up a type name and find out if it is a -- known class or enum so we can marshal it properly type KnownTypes = [(String, CTypeKind)] @@ -861,7 +921,7 @@ | namespace <- api , object <- namespace_objects namespace ] -genExports :: Object -> [FuncDoc] -> ShowS +genExports :: Object -> ModuleDoc -> ShowS genExports object docs = comment.ss "* Types". indent 1.ss (object_name object).sc ','. @@ -869,26 +929,30 @@ indent 1.ss "castTo".ss (object_name object).sc ','. (case [ (ss " ". ss (cFuncNameToHsName (method_cname constructor)). sc ',' ,maybe "" funcdoc_since doc) - | (constructor, doc) <- constructors object docs] of + | (constructor, doc) <- constructors object (moduledoc_functions docs)] of [] -> id cs -> nl.nl.comment.ss "* Constructors".nl. doVersionIfDefs lines cs). (case [ (ss " ". ss (cFuncNameToHsName (method_cname method)). sc ',' ,maybe "" funcdoc_since doc) - | (method, doc) <- methods object docs] of + | (method, doc) <- methods object (moduledoc_functions docs)] of [] -> id cs -> nl.nl.comment.ss "* Methods".nl. doVersionIfDefs lines cs). - (case [ ss " ". ss (cFuncNameToHsName (property_cname property)). sc ',' - | property {-, doc-} <- object_properties object {-docs-}] of + (case [ (ss " ". ss (cFuncNameToHsName (property_cname property)). sc ',' + ,maybe "" propdoc_since doc) + | (property, doc) <- properties object (moduledoc_properties docs)] of [] -> id cs -> nl.nl.comment.ss "* Properties".nl. - lines cs). - (case [ ss " ". ss (cFuncNameToHsName (signal_cname signal)). sc ',' - | signal {-, doc-} <- object_signals object {-docs-}] of + doVersionIfDefs lines cs). + (case [ let signalName = (upperCaseFirstChar . cFuncNameToHsName . signal_cname) signal in + (ss " on". ss signalName. sc ','.nl. + ss " after". ss signalName. sc ',' + ,maybe "" signaldoc_since doc) + | (signal, doc) <- signals object (moduledoc_signals docs)] of [] -> id cs -> nl.nl.comment.ss "* Signals".nl. - lines cs) + doVersionIfDefs lines cs) genTodoItems :: Object -> ShowS genTodoItems object = @@ -1166,7 +1230,7 @@ "DOCUMENTATION" -> genModuleDocumentation moduleDoc "TODO" -> genTodoItems object "MODULE_NAME" -> ss (modPrefix ++ object_name object) - "EXPORTS" -> genExports object (moduledoc_functions moduleDoc) + "EXPORTS" -> genExports object moduleDoc "IMPORTS" -> ss $ "{#import Graphics.UI.Gtk.Types#}\n" ++ "-- CHECKME: extra imports may be required\n" "CONTEXT_LIB" -> ss (if null lib then namespace_library namespace else lib) |
|
From: Duncan C. <dun...@us...> - 2005-01-28 20:37:51
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15018/tools/apiGen Modified Files: Makefile Log Message: use sed to do the patching rather than an external patch file (which I'd never added to cvs anyway). This time it should work for other people "out of the box". Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- Makefile 27 Jan 2005 23:10:15 -0000 1.3 +++ Makefile 28 Jan 2005 18:08:46 -0000 1.4 @@ -48,8 +48,7 @@ done; # following fixes borrowed from Gtk# ln -f -s gtkfilechooserprivate.h gtk+-$(GTK_VERSION)/gtk/gtkfilechooserpriv.h - patch -p0 atk-1.6.1/atk/atkhyperlink.h < atkhyperlink.patch - + sed -i 's:( \*link_activated):(\* link_activated):' atk-1.6.1/atk/atkhyperlink.h ############################# # |
|
From: Duncan C. <dun...@us...> - 2005-01-28 00:16:07
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5080 Modified Files: ChangeLog Log Message: Add a simple calculator demo. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.331 retrieving revision 1.332 diff -u -d -r1.331 -r1.332 --- ChangeLog 27 Jan 2005 23:10:13 -0000 1.331 +++ ChangeLog 28 Jan 2005 00:15:18 -0000 1.332 @@ -13,6 +13,9 @@ tools/apiGen/Makefile : use later versions of Gtk+ and related libs, now at 2.4.14 rather than 2.2.2. + * demo/calc/Calc.hs, demo/calc/CalcModel.hs, demo/calc/Makefile + demo/calc/calc.glade: add a simple calculator demo. + 2005-01-26 Duncan Coutts <du...@co...> * tools/apiGen/ApiGen.hs: Several marshaling improvements. Extract |
|
From: Duncan C. <dun...@us...> - 2005-01-28 00:15:33
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/calc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5080/demo/calc Added Files: Calc.hs CalcModel.hs Makefile calc.glade Log Message: Add a simple calculator demo. --- NEW FILE: calc.glade --- <?xml version="1.0" standalone="no"?> <!--*- mode: xml -*--> <!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd"> <glade-interface> <widget class="GtkWindow" id="calcwindow"> <property name="border_width">4</property> <property name="visible">True</property> <property name="title" translatable="yes">Calculator</property> <property name="type">GTK_WINDOW_TOPLEVEL</property> <property name="window_position">GTK_WIN_POS_CENTER</property> <property name="modal">False</property> <property name="resizable">True</property> <property name="destroy_with_parent">False</property> <child> <widget class="GtkVBox" id="vbox1"> <property name="visible">True</property> <property name="homogeneous">False</property> <property name="spacing">4</property> <child> <widget class="GtkLabel" id="display"> <property name="visible">True</property> <property name="label" translatable="yes"><big>0</big></property> <property name="use_underline">False</property> <property name="use_markup">True</property> <property name="justify">GTK_JUSTIFY_RIGHT</property> <property name="wrap">False</property> <property name="selectable">False</property> <property name="xalign">1</property> <property name="yalign">0.5</property> <property name="xpad">0</property> <property name="ypad">0</property> </widget> <packing> <property name="padding">0</property> <property name="expand">False</property> <property name="fill">False</property> </packing> </child> <child> <widget class="GtkTable" id="table1"> <property name="visible">True</property> <property name="n_rows">5</property> <property name="n_columns">4</property> <property name="homogeneous">True</property> <property name="row_spacing">4</property> <property name="column_spacing">4</property> <child> <widget class="GtkButton" id="decimal"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">.</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="period" modifiers="0" signal="clicked"/> <accelerator key="KP_Decimal" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">2</property> <property name="right_attach">3</property> <property name="top_attach">4</property> <property name="bottom_attach">5</property> </packing> </child> <child> <widget class="GtkButton" id="num-0"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">0</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="0" modifiers="0" signal="clicked"/> <accelerator key="KP_0" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">0</property> <property name="right_attach">2</property> <property name="top_attach">4</property> <property name="bottom_attach">5</property> </packing> </child> <child> <widget class="GtkButton" id="num-1"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">1</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="1" modifiers="0" signal="clicked"/> <accelerator key="KP_1" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">0</property> <property name="right_attach">1</property> <property name="top_attach">3</property> <property name="bottom_attach">4</property> </packing> </child> <child> <widget class="GtkButton" id="num-2"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">2</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="2" modifiers="0" signal="clicked"/> <accelerator key="KP_2" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">1</property> <property name="right_attach">2</property> <property name="top_attach">3</property> <property name="bottom_attach">4</property> </packing> </child> <child> <widget class="GtkButton" id="num-4"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">4</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="4" modifiers="0" signal="clicked"/> <accelerator key="KP_4" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">0</property> <property name="right_attach">1</property> <property name="top_attach">2</property> <property name="bottom_attach">3</property> </packing> </child> <child> <widget class="GtkButton" id="num-5"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">5</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="5" modifiers="0" signal="clicked"/> <accelerator key="KP_5" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">1</property> <property name="right_attach">2</property> <property name="top_attach">2</property> <property name="bottom_attach">3</property> </packing> </child> <child> <widget class="GtkButton" id="num-7"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">7</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="7" modifiers="0" signal="clicked"/> <accelerator key="KP_7" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">0</property> <property name="right_attach">1</property> <property name="top_attach">1</property> <property name="bottom_attach">2</property> </packing> </child> <child> <widget class="GtkButton" id="num-8"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">8</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="8" modifiers="0" signal="clicked"/> <accelerator key="KP_8" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">1</property> <property name="right_attach">2</property> <property name="top_attach">1</property> <property name="bottom_attach">2</property> </packing> </child> <child> <widget class="GtkButton" id="num-3"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">3</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="3" modifiers="0" signal="clicked"/> <accelerator key="KP_3" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">2</property> <property name="right_attach">3</property> <property name="top_attach">3</property> <property name="bottom_attach">4</property> </packing> </child> <child> <widget class="GtkButton" id="num-6"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">6</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="6" modifiers="0" signal="clicked"/> <accelerator key="KP_6" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">2</property> <property name="right_attach">3</property> <property name="top_attach">2</property> <property name="bottom_attach">3</property> </packing> </child> <child> <widget class="GtkButton" id="num-9"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">9</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="9" modifiers="0" signal="clicked"/> <accelerator key="KP_9" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">2</property> <property name="right_attach">3</property> <property name="top_attach">1</property> <property name="bottom_attach">2</property> </packing> </child> <child> <widget class="GtkButton" id="op-divide"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">÷</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="KP_Divide" modifiers="0" signal="clicked"/> <accelerator key="slash" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">1</property> <property name="right_attach">2</property> <property name="top_attach">0</property> <property name="bottom_attach">1</property> </packing> </child> <child> <widget class="GtkButton" id="op-times"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">Ã</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="KP_Multiply" modifiers="0" signal="clicked"/> <accelerator key="asterisk" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">2</property> <property name="right_attach">3</property> <property name="top_attach">0</property> <property name="bottom_attach">1</property> </packing> </child> <child> <widget class="GtkButton" id="op-minus"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">-</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="minus" modifiers="0" signal="clicked"/> <accelerator key="KP_Subtract" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">3</property> <property name="right_attach">4</property> <property name="top_attach">0</property> <property name="bottom_attach">1</property> </packing> </child> <child> <widget class="GtkButton" id="op-plus"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">+</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="plus" modifiers="0" signal="clicked"/> <accelerator key="KP_Add" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">3</property> <property name="right_attach">4</property> <property name="top_attach">1</property> <property name="bottom_attach">3</property> </packing> </child> <child> <widget class="GtkButton" id="equals"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">=</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="equal" modifiers="0" signal="clicked"/> <accelerator key="Return" modifiers="0" signal="clicked"/> <accelerator key="KP_Equal" modifiers="0" signal="clicked"/> <accelerator key="KP_Enter" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">3</property> <property name="right_attach">4</property> <property name="top_attach">3</property> <property name="bottom_attach">5</property> </packing> </child> <child> <widget class="GtkButton" id="clear"> <property name="width_request">45</property> <property name="height_request">40</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="label" translatable="yes">AC</property> <property name="use_underline">True</property> <property name="relief">GTK_RELIEF_NORMAL</property> <accelerator key="Delete" modifiers="0" signal="clicked"/> <accelerator key="BackSpace" modifiers="0" signal="clicked"/> </widget> <packing> <property name="left_attach">0</property> <property name="right_attach">1</property> <property name="top_attach">0</property> <property name="bottom_attach">1</property> <property name="x_options">fill</property> <property name="y_options"></property> </packing> </child> </widget> <packing> <property name="padding">0</property> <property name="expand">True</property> <property name="fill">True</property> </packing> </child> </widget> </child> </widget> </glade-interface> --- NEW FILE: CalcModel.hs --- -- A simple push button calcualtor without operator precedence module CalcModel ( Number, Calc, BinOp, plus, minus, times, divide, clearCalc, enterDigit, enterDecimalPoint, enterBinOp, evaluate ) where import Char (isDigit) import Monad (when) import Numeric (showGFloat) -- we could change this to rational type Number = Double data Calc = Calc { number :: [Digit], operator :: BinOp, total :: Number, resetOnNum :: Bool -- a state flag, after pressing '=', if we enter an } -- operator then we're carrying on the previous -- calculation, otherwise we should start a new one. data Digit = Digit Int -- in range [0..9] | DecimalPoint deriving Eq data BinOp = BinOp (Number -> Number -> Number) plus, minus, times, divide :: BinOp plus = BinOp (+) minus = BinOp (-) times = BinOp (*) divide = BinOp (/) clearCalc :: Calc clearCalc = Calc { number = [], operator = plus, total = 0, resetOnNum = True } -- Maybe for the case when the operation makes no sense enterDigit :: Int -> Calc -> Maybe (String, Calc) enterDigit digit calc | digit `elem` [0..9] && not (number calc == [] && digit == 0) = let newNumber = number calc ++ [Digit digit] in if resetOnNum calc then Just (show newNumber, calc { number = newNumber, total = 0, resetOnNum = False }) else Just (show newNumber, calc { number = newNumber }) | otherwise = Nothing enterDecimalPoint :: Calc -> Maybe (String, Calc) enterDecimalPoint calc | DecimalPoint `notElem` number calc = let newNumber = number calc ++ [DecimalPoint] in if resetOnNum calc then Just (show newNumber, calc { number = newNumber, total = 0, resetOnNum = False }) else Just (show newNumber, calc { number = newNumber }) | otherwise = Nothing enterBinOp :: BinOp -> Calc -> Maybe (String, Calc) enterBinOp binop calc = let newTotal = (case operator calc of BinOp op -> op) (total calc) (digitsToNumber (number calc)) in Just (showNumber newTotal, Calc { number = [], operator = binop, total = newTotal, resetOnNum = False }) evaluate :: Calc -> Maybe (String, Calc) evaluate calc = let newTotal = (case operator calc of BinOp op -> op) (total calc) (digitsToNumber (number calc)) in Just (showNumber newTotal, Calc { number = [], operator = plus, total = newTotal, resetOnNum = True }) instance Show Digit where show (Digit n) = show n show DecimalPoint = "." showList = showString . concatMap show digitsToNumber :: [Digit] -> Number digitsToNumber [] = 0 digitsToNumber digits@(DecimalPoint:_) = digitsToNumber (Digit 0:digits) digitsToNumber digits | last digits == DecimalPoint = digitsToNumber (init digits) | otherwise = read (show digits) --CHEAT! precision = Just 5 --digits of precision, or Nothing for as much as possible showNumber :: Number -> String showNumber = (\num -> if num == [] then "0" else num) . reverse . dropWhile (\c -> c=='0' || c=='.') --strip trailing 0's . reverse . (\num -> showGFloat precision num "") testProg :: IO () testProg = do evalLoop clearCalc where evalLoop :: Calc -> IO () evalLoop calc = do putStr "calc> " line <- getLine when (line /= "q") $ do result <- case line of [digit] | isDigit digit -> return $ enterDigit (read [digit]) calc "." -> return $ enterDecimalPoint calc "+" -> return $ enterBinOp plus calc "-" -> return $ enterBinOp minus calc "*" -> return $ enterBinOp times calc "/" -> return $ enterBinOp divide calc "=" -> return $ evaluate calc "c" -> return $ Just ("0",clearCalc) _ -> do putStrLn "invalid input" return Nothing case result of Nothing -> evalLoop calc Just (display, calc') -> do putStrLn display evalLoop calc' --- NEW FILE: Makefile --- PROG = calc SOURCES = Calc.hs CalcModel.hs PACKAGES = glade $(PROG) : $(SOURCES) ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) --- NEW FILE: Calc.hs --- module Main where import Graphics.UI.Gtk import Graphics.UI.Gtk.Glade import Data.IORef import qualified CalcModel as Calc main = do initGUI -- load up the glade file calcXmlM <- xmlNew "calc.glade" let calcXml = case calcXmlM of (Just calcXml) -> calcXml Nothing -> error "can't find the glade file \"calc.glade\" \ \in the current directory" -- get a handle on a some widgets from the glade file window <- xmlGetWidget calcXml castToWindow "calcwindow" display <- xmlGetWidget calcXml castToLabel "display" -- a list of the names of the buttons and the actions associated with them let buttonNamesAndOperations = numbericButtons ++ otherButtons numbericButtons = [ ("num-" ++ show n, Calc.enterDigit n) | n <- [0..9] ] otherButtons = [("decimal", Calc.enterDecimalPoint) ,("op-plus", Calc.enterBinOp Calc.plus) ,("op-minus", Calc.enterBinOp Calc.minus) ,("op-times", Calc.enterBinOp Calc.times) ,("op-divide", Calc.enterBinOp Calc.divide) ,("equals", Calc.evaluate) ,("clear", \_ -> Just ("0", Calc.clearCalc))] -- action to do when a button corresponding to a calculator operation gets -- pressed: we update the calculator state and display the new result. -- These calculator operations can return Nothing for when the operation -- makes no sense, we do nothing in this case. calcRef <- newIORef Calc.clearCalc let calcOperation operation = do calc <- readIORef calcRef case operation calc of Nothing -> return () Just (result, calc') -> do display `labelSetLabel` ("<big>" ++ result ++ "</big>") writeIORef calcRef calc' -- get a reference to a button from the glade file and attach the -- handler for when the button is pressed connectButtonToOperation name operation = do button <- xmlGetWidget calcXml castToButton name button `onClicked` calcOperation operation -- connect up all the buttons with their actions. mapM_ (uncurry connectButtonToOperation) buttonNamesAndOperations -- make the program exit when the main window is closed window `onDestroy` mainQuit -- show everything and run the main loop widgetShowAll window mainGUI |
|
From: Duncan C. <dun...@us...> - 2005-01-27 23:59:07
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/calc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32123/calc Log Message: Directory /cvsroot/gtk2hs/gtk2hs/demo/calc added to the repository |
|
From: Duncan C. <dun...@us...> - 2005-01-27 23:10:47
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20648 Modified Files: ChangeLog Log Message: Sync up with the latest version of the gapi tools from the mono/gtk# project. Minor updates to the ApiGen necessary to work with the updated gapi tools. Use later versions of Gtk+ and related libs, now at 2.4.14 rather than 2.2.2. This should now all build easily for other people. It's now all automated and does not require configuring / building gtk+ docs etc (so no problems with not having the very latest version of glib/gtk etc installed on your machine). Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.330 retrieving revision 1.331 diff -u -d -r1.330 -r1.331 --- ChangeLog 26 Jan 2005 12:13:27 -0000 1.330 +++ ChangeLog 27 Jan 2005 23:10:13 -0000 1.331 @@ -1,5 +1,20 @@ 2005-01-26 Duncan Coutts <du...@co...> + * tools/apiGen/gapi2xml.pl, tools/apiGen/gapi_parser.pl, + tools/apiGen/gapi_pp.pl: sync up with the latest version of these tools + from the mono/gtk# project. + + * tools/apiGen/ApiGen.hs: minor updates necessary to work with the + updated gapi tools. + + * tools/apiGen/atk-sources.xml, tools/apiGen/gdk-sources.xml + tools/apiGen/glade-sources.xml, tools/apiGen/gnomecanvas-sources.xml + tools/apiGen/gtk-sources.xml, tools/apiGen/pango-sources.xml, + tools/apiGen/Makefile : use later versions of Gtk+ and related libs, + now at 2.4.14 rather than 2.2.2. + +2005-01-26 Duncan Coutts <du...@co...> + * tools/apiGen/ApiGen.hs: Several marshaling improvements. Extract enums from the api file. Produce a list of objects and enums and use it when deciding how to marshal types. Marshal floats and doubles, |
|
From: Duncan C. <dun...@us...> - 2005-01-27 23:10:27
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20648/tools/apiGen Modified Files: ApiGen.hs Makefile atk-sources.xml gapi2xml.pl gapi_pp.pl gdk-sources.xml glade-sources.xml gnomecanvas-sources.xml gtk-sources.xml pango-sources.xml Log Message: Sync up with the latest version of the gapi tools from the mono/gtk# project. Minor updates to the ApiGen necessary to work with the updated gapi tools. Use later versions of Gtk+ and related libs, now at 2.4.14 rather than 2.2.2. This should now all build easily for other people. It's now all automated and does not require configuring / building gtk+ docs etc (so no problems with not having the very latest version of glib/gtk etc installed on your machine). Index: gapi_pp.pl =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gapi_pp.pl,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- gapi_pp.pl 6 Jan 2005 01:02:22 -0000 1.1 +++ gapi_pp.pl 27 Jan 2005 23:10:15 -0000 1.2 @@ -8,7 +8,7 @@ # # Copyright (c) 2001 Mike Kestner # Copyright (c) 2003 Martin Willemoes Hansen -# Copyright (c) 2003 Novell, Inc. +# 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 @@ -25,8 +25,8 @@ # 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'; +$eatit_regex = "^#if.*(__cplusplus|DEBUG|DISABLE_COMPAT|ENABLE_BROKEN)"; +$ignoreit_regex = '^\s+\*|#ident|#error|#\s*include|#\s*else|#\s*undef|G_(BEGIN|END)_DECLS|GDKVAR|GTKVAR|GTKMAIN_C_VAR|GTKTYPEUTILS_VAR|VARIABLE|GTKTYPEBUILTIN'; foreach $arg (@ARGV) { if (-d $arg && -e $arg) { @@ -50,6 +50,8 @@ open(INFILE, $fname) || die "Could open $fname\n"; $braces = 0; + $deprecated = -1; + $ifdeflevel = 0; $prepend = ""; while ($line = <INFILE>) { $braces++ if ($line =~ /{/ and $line !~ /}/); @@ -57,8 +59,8 @@ next if ($line =~ /$ignoreit_regex/); - $line =~ s/\/\*.*?\*\///g; - + $line =~ s/\/\*[^<].*?\*\///g; + next if ($line !~ /\S/); $line = $prepend . $line; @@ -75,10 +77,10 @@ $def =~ s/\\\n//g; print $def; } - } elsif ($line =~ /^\s*\/\*/) { + } elsif ($line =~ /^\s*\/\*[^<]/) { while ($line !~ /\*\//) {$line = <INFILE>;} - } elsif ($line =~ /^#ifndef\s+\w+_H_*\b/) { - while ($line !~ /#define/) {$line = <INFILE>;} + } elsif ($line =~ /^extern/) { + while ($line !~ /;/) {$line = <INFILE>;} } elsif ($line =~ /$private_regex/) { $nested = 0; while ($line = <INFILE>) { @@ -107,7 +109,19 @@ } } } elsif ($line =~ /^#\s*ifn?\s*\!?def/) { - #warn "Ignored #if:\n$line"; + $ifdeflevel++; + #print "#ifn?def ($ifdeflevel): $line\n"; + if ($line =~ /#ifndef.*DISABLE_DEPRECATED/) { + $deprecated = $ifdeflevel; + } elsif ($line =~ /#if !defined.*DISABLE_DEPRECATED/) { + $deprecated = $ifdeflevel; + } + } elsif ($line =~ /^#\s*endif/) { + #print "#endif ($ifdeflevel): $line\n"; + if ($deprecated == $ifdeflevel) { + $deprecated = -1; + } + $ifdeflevel--; } elsif ($line =~ /typedef struct\s*\{/) { my $first_line = $line; my @lines = (); @@ -130,6 +144,9 @@ print "};\n"; } elsif ($line =~ /^enum\s+\{/) { while ($line !~ /^};/) {$line = <INFILE>;} + } elsif ($line =~ /^(typedef\s+)?union/) { + next if ($line =~ /^typedef\s+union\s+\w+\s+\w+;/); + 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; @@ -141,8 +158,12 @@ $do_print = 0; } } else { - if ($braces or $line =~ /;/) { - print $line; + if ($braces or $line =~ /;|\/\*/) { + if ($deprecated == -1) { + print $line; + } else { + print "deprecated$line"; + } } else { $prepend = $line; $prepend =~ s/\n/ /g; @@ -168,12 +189,15 @@ } 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)/); + next if ($line !~ /^(struct|\w+_class_init|\w+_base_init|\w+_get_type\b)/); if ($line =~ /^struct/) { # need some of these to parse out parent types print "private"; + if ($line =~ /;/) { + print $line; + next; + } } $comment = 0; Index: gapi2xml.pl =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gapi2xml.pl,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- gapi2xml.pl 6 Jan 2005 01:02:22 -0000 1.1 +++ gapi2xml.pl 27 Jan 2005 23:10:15 -0000 1.2 @@ -84,18 +84,18 @@ $types{$3} = $1 . $2; } elsif ($line =~ /typedef\s+enum\s+(\w+)\s+(\w+);/) { $etypes{$1} = $2; - } elsif ($line =~ /^(typedef\s+)?\benum\b/) { + } elsif ($line =~ /^((deprecated)?typedef\s+)?\benum\b/) { $edef = $line; while ($line = <STDIN>) { $edef .= $line; - last if ($line =~ /^}\s*(\w+)?;/); + last if ($line =~ /^(deprecated)?}\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; + } elsif ($edef =~ /^(deprecated)?enum\s+(\w+)\s*{/) { + $ename = $2; } else { print "Unexpected enum format\n$edef"; next; @@ -111,15 +111,15 @@ $fdef .= $line; $fdef =~ s/\n\s+//g; $fpdefs{$fname} = $fdef; - } elsif ($line =~ /^(private)?struct\s+(\w+)/) { + } elsif ($line =~ /^(private|deprecated)?struct\s+(\w+)/) { next if ($line =~ /;/); $sname = $2; $sdef = $line; while ($line = <STDIN>) { $sdef .= $line; - last if ($line =~ /^}/); + last if ($line =~ /^(deprecated)?}/); } - $sdef =~ s!/\*.*?(\*/|\n)!!g; + $sdef =~ s!/\*[^<].*?(\*/|\n)!!g; $sdef =~ s/\n\s*//g; $sdefs{$sname} = $sdef; } elsif ($line =~ /^(\w+)_(class|base)_init\b/) { @@ -149,8 +149,8 @@ last if ($line =~ /^}/); } $typefuncs{lc($class)} = $pedef; - } elsif ($line =~ /^(const|G_CONST_RETURN)?\s*\w+\s*\**\s*(\w+)\s*\(/) { - $fname = $2; + } elsif ($line =~ /^(deprecated)?(const|G_CONST_RETURN)?\s*(struct\s+)?\w+\s*\**\s*(\w+)\s*\(/) { + $fname = $4; $fdef = ""; while ($line !~ /;/) { $fdef .= $line; @@ -186,12 +186,14 @@ $boxdefs{$1} = $line; } elsif ($line =~ /^BUILTIN\s*\{\s*\"(\w+)\".*GTK_TYPE_(ENUM|FLAGS)/) { # ignoring these for now. - } elsif ($line =~ /^\#define/) { + } elsif ($line =~ /^(deprecated)?\#define/) { my $test_ns = uc ($ns); - if ($line =~ /\#define\s+(\w+)\s+\"(.*)\"/) { + if ($line =~ /^deprecated\#define\s+(\w+)\s+\"(.*)\"/) { + $defines{"deprecated$1"} = $2; + } elsif ($line =~ /\#define\s+(\w+)\s+\"(.*)\"/) { $defines{$1} = $2; } - } else { + } elsif ($line !~ /\/\*/) { print $line; } } @@ -207,6 +209,10 @@ $cname = $etypes{$cname} if (exists($etypes{$cname})); $enums{lc($cname)} = $cname; $enum_elem = addNameElem($ns_elem, 'enum', $cname, $ns); + if ($def =~ /^deprecated/) { + $enum_elem->setAttribute("deprecated", "1"); + $def =~ s/deprecated//g; + } if ($def =~ /=\s*1\s*<<\s*\d+/) { $enum_elem->setAttribute('type', "flags"); } else { @@ -214,6 +220,7 @@ } $def =~ /\{(.*)\}/; @vals = split(/,\s*/, $1); + $vals[0] =~ s/^\s+//; @v0 = split(/_/, $vals[0]); if (@vals > 1) { $done = 0; @@ -257,7 +264,7 @@ ############################################################## foreach $cbname (sort(keys(%fpdefs))) { - next if ($cbname !~ /$ns/); + next if ($cbname =~ /^_/); $cbcnt++; $fdef = $cb = $fpdefs{$cbname}; $cb_elem = addNameElem($ns_elem, 'callback', $cbname, $ns); @@ -289,9 +296,10 @@ $classdef = $sdefs{$1} if ($ifacetype =~ /struct\s+(\w+)/); if ($initfunc) { - parseInitFunc($iface_el, $initfunc, 0); + parseInitFunc($iface_el, $initfunc); } else { warn "Don't have an init func for $inst.\n" if $debug; + addVirtualMethods ($classdef, $iface_el); } } @@ -312,7 +320,8 @@ $instdef = $classdef = ""; $instdef = $sdefs{$1} if ($insttype =~ /struct\s+(\w+)/); $classdef = $sdefs{$1} if ($classtype =~ /struct\s+(\w+)/); - $instdef =~ s/\s+(\*+)/\1 /g; + $classdef =~ s/deprecated//g; + $instdef =~ s/\s+(\*+)([^\/])/\1 \2/g; warn "Strange Class $inst\n" if (!$instdef && $debug); $classcnt++; @@ -320,15 +329,21 @@ $elem_table{lc($inst)} = $obj_el; + # Check if the object is deprecated + if ($instdef =~ /^deprecatedstruct/) { + $obj_el->setAttribute("deprecated", "1"); + $instdef =~ s/deprecated//g; + } + # Extract parent and fields from the struct if ($instdef =~ /^struct/) { $instdef =~ /\{(.*)\}/; $fieldstr = $1; - $fieldstr =~ s|/\*.*?\*/||g; + $fieldstr =~ s|/\*[^<].*?\*/||g; @fields = split(/;/, $fieldstr); - $fields[0] =~ /(\w+)/; - $obj_el->setAttribute('parent', "$1"); - addFieldElems($obj_el, @fields[1..$#fields]); + addFieldElems($obj_el, 'private', @fields); + $obj_el->setAttribute('parent', $obj_el->firstChild->getAttribute('type')); + $obj_el->removeChild($obj_el->firstChild); } elsif ($instdef =~ /privatestruct/) { # just get the parent for private structs $instdef =~ /\{\s*(\w+)/; @@ -337,7 +352,7 @@ # Get the props from the class_init func. if ($initfunc) { - parseInitFunc($obj_el, $initfunc, 1); + parseInitFunc($obj_el, $initfunc); } else { warn "Don't have an init func for $inst.\n" if $debug; } @@ -388,6 +403,11 @@ $struct_el = addNameElem($ns_elem, 'struct', $key, $ns); } + if ($def =~ /^deprecated/) { + $struct_el->setAttribute("deprecated", "1"); + $def =~ s/deprecated//g; + } + $elem_table{lc($key)} = $struct_el; $def =~ s/\s+/ /g; @@ -395,7 +415,7 @@ $struct_el->setAttribute('opaque', 'true'); } else { $def =~ /\{(.+)\}/; - addFieldElems($struct_el, split(/;/, $1)); + addFieldElems($struct_el, 'public', split(/;/, $1)); } } @@ -447,13 +467,18 @@ $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"; +print "props: $propcnt childprops: $childpropcnt signals: $sigcnt\n\n"; sub addFieldElems { - my ($parent, @fields) = @_; + my ($parent, $defaultaccess, @fields) = @_; + my $access = $defaultaccess; foreach $field (@fields) { + if ($field =~ m!^/\*< (public|private) >.*\*/(.*)$!) { + $access = $1; + $field = $2; + } next if ($field !~ /\S/); $field =~ s/\s+(\*+)/\1 /g; $field =~ s/(\w+)\s+const /const \1 /g; @@ -461,7 +486,7 @@ $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); @@ -470,15 +495,19 @@ my $type = $1 . $2; $symb = $3; foreach $tok (split (/,\s*/, $symb)) { if ($tok =~ /(\w+)\s*\[(.*)\]/) { - $elem = addNameElem($parent, 'field', $1); + $elem = addNameElem($parent, 'field', $1, ""); $elem->setAttribute('array_len', "$2"); } elsif ($tok =~ /(\w+)\s*\:\s*(\d+)/) { - $elem = addNameElem($parent, 'field', $1); + $elem = addNameElem($parent, 'field', $1, ""); $elem->setAttribute('bits', "$2"); } else { - $elem = addNameElem($parent, 'field', $tok); + $elem = addNameElem($parent, 'field', $tok, ""); } $elem->setAttribute('type', "$type"); + + if ($access ne $defaultaccess) { + $elem->setAttribute('access', "$access"); + } } } else { die "$field\n"; @@ -518,12 +547,20 @@ next if (!$obj_el); $mdef = delete $fdefs{$mname}; - + if ($mname =~ /$prefix(new)/) { - $el = addNameElem($obj_el, 'constructor', $mname); + $el = addNameElem($obj_el, 'constructor', $mname); + if ($mdef =~ /^deprecated/) { + $el->setAttribute("deprecated", "1"); + $mdef =~ s/deprecated//g; + } $drop_1st = 0; } else { $el = addNameElem($obj_el, 'method', $mname, $prefix, $prepend); + if ($mdef =~ /^deprecated/) { + $el->setAttribute("deprecated", "1"); + $mdef =~ s/deprecated//g; + } $mdef =~ /(.*?)\w+\s*\(/; addReturnElem($el, $1); $mdef =~ /\(\s*(const)?\s*(\w+)/; @@ -544,6 +581,13 @@ { my ($el, $mdef, $drop_1st) = @_; + $fmt_args = 0; + + if ($mdef =~ /G_GNUC_PRINTF.*\((\d+,\s*\d+)\s*\)/) { + $fmt_args = $1; + $mdef =~ s/\s*G_GNUC_PRINTF.*\)//; + } + if (($mdef =~ /\((.*)\)/) && ($1 ne "void")) { @parms = (); $parm = ""; @@ -569,6 +613,15 @@ if (@parms > 0) { addParamsElem($el, @parms); } + + if ($fmt_args != 0) { + $fmt_args =~ /(\d+),\s*(\d+)/; + $fmt = $1; $args = $2; + ($params_el, @junk) = $el->getElementsByTagName ("parameters"); + (@params) = $params_el->getElementsByTagName ("parameter"); + $params[$fmt-1]->setAttribute ("printf_format", "true"); + $params[$args-1]->setAttribute ("printf_format_args", "true"); + } } } @@ -619,7 +672,7 @@ } if ($cnt == 1) { $mdef = delete $fdefs{$mname}; - + if (!$global_el) { $global_el = $doc->createElement('class'); $global_el->setAttribute('name', "Global"); @@ -627,6 +680,10 @@ $ns_elem->appendChild($global_el); } $el = addNameElem($global_el, 'method', $mname, $ns_prefix); + if ($mdef =~ /^deprecated/) { + $el->setAttribute("deprecated", "1"); + $mdef =~ s/deprecated//g; + } $mdef =~ /(.*?)\w+\s*\(/; addReturnElem($el, $1); $el->setAttribute("shared", "true"); @@ -640,8 +697,12 @@ for ($j = 0; $j < $cnt; $j++) { $mdef = delete $fdefs{$mnames[$i+$j]}; - + $el = addNameElem($class_el, 'method', $mnames[$i+$j], $prefix); + if ($mdef =~ /^deprecated/) { + $el->setAttribute("deprecated", "1"); + $mdef =~ s/deprecated//g; + } $mdef =~ /(.*?)\w+\s*\(/; addReturnElem($el, $1); $el->setAttribute("shared", "true"); @@ -660,7 +721,7 @@ my $elem = $doc->createElement($type); $node->appendChild($elem); - if ($prefix) { + if (defined $prefix) { my $match; if ($cname =~ /$prefix(\w+)/) { $match = $1; @@ -742,7 +803,7 @@ sub addPropElem { - my ($spec, $node) = @_; + my ($spec, $node, $is_child) = @_; my ($name, $mode, $docs); $spec =~ /g_param_spec_(\w+)\s*\((.*)\s*\)\s*\)/; my $type = $1; @@ -757,7 +818,7 @@ $mode = $params[$#params]; - if ($type =~ /boolean|float|double|^u?int|pointer/) { + if ($type =~ /boolean|float|double|^u?int|pointer|unichar/) { $type = "g$type"; } elsif ($type =~ /string/) { $type = "gchar*"; @@ -773,7 +834,7 @@ $type = StudlyCaps(lc($type)); } - $prop_elem = $doc->createElement('property'); + $prop_elem = $doc->createElement($is_child ? "childprop" : "property"); $node->appendChild($prop_elem); $prop_elem->setAttribute('name', StudlyCaps($name)); $prop_elem->setAttribute('cname', $name); @@ -852,13 +913,13 @@ return $class; } - if ($class =~ /;\s*(G_CONST_RETURN)?\s*(\S+\s*\**)\s*\(\*\s*$method\)\s*\((.*?)\);/) { + if ($class =~ /;\s*(G_CONST_RETURN\s+)?(\w+\s*\**)\s*\(\*\s*$method\)\s*\((.*?)\);/) { $ret = $2; $parms = $3; addReturnElem($sig_elem, $ret); if ($parms && ($parms ne "void")) { addParamsElem($sig_elem, split(/,/, $parms)); } - $class =~ s/;\s*(G_CONST_RETURN)?\s*\S+\s*\**\s*\(\*\s*$method\)\s*\(.*?\);/;/; + $class =~ s/;\s*(G_CONST_RETURN\s+)?\w+\s*\**\s*\(\*\s*$method\)\s*\(.*?\);/;/; } else { die "$method $class"; } @@ -870,9 +931,10 @@ { my ($class, $node) = @_; $class =~ s/\n\s*//g; + $class =~ s/\/\*.*?\*\///g; - while ($class =~ /;\s*(\S+\s*\**)\s*\(\*\s*(\w+)\)\s*\((.*?)\);/) { - $ret = $1; $cname = $2; $parms = $3; + while ($class =~ /;\s*(G_CONST_RETURN\s+)?(\S+\s*\**)\s*\(\*\s*(\w+)\)\s*\((.*?)\);/) { + $ret = $1 . $2; $cname = $3; $parms = $4; if ($cname !~ /reserved/) { $vm_elem = $doc->createElement('virtual_method'); $node->appendChild($vm_elem); @@ -883,7 +945,7 @@ addParamsElem($vm_elem, split(/,/, $parms)); } } - $class =~ s/;\s*\S+\s*\**\s*\(\*\s*\w+\)\s*\(.*?\);//; + $class =~ s/;\s*(G_CONST_RETURN\s+)?\S+\s*\**\s*\(\*\s*\w+\)\s*\(.*?\);/;/; } } @@ -902,7 +964,7 @@ sub parseInitFunc { - my ($obj_el, $initfunc, $is_obj) = @_; + my ($obj_el, $initfunc) = @_; my @init_lines = split (/\n/, $initfunc); @@ -918,8 +980,15 @@ do { $prop .= $init_lines[++$linenum]; } until ($init_lines[$linenum] =~ /\)\s*;/); - addPropElem ($prop, $obj_el); + addPropElem ($prop, $obj_el, 0); $propcnt++; + } elsif ($line =~ /gtk_container_class_install_child_property/) { + my $prop = $line; + do { + $prop .= $init_lines[++$linenum]; + } until ($init_lines[$linenum] =~ /\)\s*;/); + addPropElem ($prop, $obj_el, 1); + $childpropcnt++; } elsif ($line =~ /\bg.*_signal_new/) { my $sig = $line; do { @@ -931,9 +1000,7 @@ $linenum++; } - if ($is_obj) { - addVirtualMethods ($classdef, $obj_el); - } + addVirtualMethods ($classdef, $obj_el); } sub parseTypeFunc Index: pango-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/pango-sources.xml,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- pango-sources.xml 26 Jan 2005 12:13:28 -0000 1.2 +++ pango-sources.xml 27 Jan 2005 23:10:15 -0000 1.3 @@ -2,16 +2,16 @@ <api filename="pango-api.xml"> <library name="pango"> <namespace name="Pango"> - <dir>pango-1.2.3/pango</dir> - <exclude>pango-1.2.3/pango/pangox-fontcache.c</exclude> - <exclude>pango-1.2.3/pango/pangox-fontmap.c</exclude> - <exclude>pango-1.2.3/pango/pangox-private.h</exclude> - <exclude>pango-1.2.3/pango/pangox.h</exclude> - <exclude>pango-1.2.3/pango/pangox.c</exclude> - <exclude>pango-1.2.3/pango/pangoxft.h</exclude> - <exclude>pango-1.2.3/pango/pangoxft-font.h</exclude> - <exclude>pango-1.2.3/pango/pangoxft-fontmap.h</exclude> - <exclude>pango-1.2.3/pango/pangoxft-private.h</exclude> + <dir>pango-1.4.1/pango</dir> + <exclude>pango-1.4.1/pango/pangox-fontcache.c</exclude> + <exclude>pango-1.4.1/pango/pangox-fontmap.c</exclude> + <exclude>pango-1.4.1/pango/pangox-private.h</exclude> + <exclude>pango-1.4.1/pango/pangox.h</exclude> + <exclude>pango-1.4.1/pango/pangox.c</exclude> + <exclude>pango-1.4.1/pango/pangoxft.h</exclude> + <exclude>pango-1.4.1/pango/pangoxft-font.h</exclude> + <exclude>pango-1.4.1/pango/pangoxft-fontmap.h</exclude> + <exclude>pango-1.4.1/pango/pangoxft-private.h</exclude> </namespace> </library> </api> Index: glade-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/glade-sources.xml,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- glade-sources.xml 26 Jan 2005 12:13:28 -0000 1.2 +++ glade-sources.xml 27 Jan 2005 23:10:15 -0000 1.3 @@ -2,7 +2,7 @@ <api filename="glade-api.xml"> <library name="glade"> <namespace name="Glade"> - <dir>libglade-2.0.0/glade</dir> + <dir>libglade-2.3.6/glade</dir> </namespace> </library> </api> Index: gtk-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gtk-sources.xml,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- gtk-sources.xml 26 Jan 2005 12:13:28 -0000 1.2 +++ gtk-sources.xml 27 Jan 2005 23:10:15 -0000 1.3 @@ -2,7 +2,74 @@ <api filename="gtk-api.xml"> <library name="gtk"> <namespace name="Gtk"> - <dir>gtk+-2.2.2/gtk</dir> + <dir>gtk+-2.4.14/gtk</dir> + <!-- Internal stuff --> + <exclude>gtk+-2.4.14/gtk/gtkfilechooserdefault.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilechooserdefault.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilechooserentry.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilechooserentry.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilechooserutils.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilechooserutils.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilesystem.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilesystem.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilesystemmodel.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilesystemmodel.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilesystemunix.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilesystemunix.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilesystemwin32.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkfilesystemwin32.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkiconcache.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkiconcache.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkiconthemeparser.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkpathbar.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkpathbar.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkrbtree.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkrbtree.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtksequence.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtksequence.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtktextbtree.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtktextbtree.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtktextsegment.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtktextsegment.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtktexttypes.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtktexttypes.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtktextutil.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtktextutil.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkthemes.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkthemes.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtktreedatalist.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtktreedatalist.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkwindow-decorate.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkwindow-decorate.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkxembed.h</exclude> + <exclude>gtk+-2.4.14/gtk/xembed.h</exclude> + <!-- Exclude all pre gtk+-2.2 deprecated widgets --> + <!-- on second thoughts don't exclude them + <exclude>gtk+-2.4.14/gtk/gtkclist.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkclist.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkctree.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkctree.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtklist.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtklist.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtklistitem.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtklistitem.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkoldeditable.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkoldeditable.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkpixmap.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkpixmap.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkpreview.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkpreview.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtkprogress.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtkprogress.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtktext.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtktext.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtktipsquery.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtktipsquery.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtktree.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtktree.h</exclude> + <exclude>gtk+-2.4.14/gtk/gtktreeitem.c</exclude> + <exclude>gtk+-2.4.14/gtk/gtktreeitem.h</exclude> + --> </namespace> </library> </api> Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- Makefile 26 Jan 2005 12:13:28 -0000 1.2 +++ Makefile 27 Jan 2005 23:10:15 -0000 1.3 @@ -9,21 +9,16 @@ @echo " other options. However, you may wish to first edit this" @echo " Makefile to change which versions of the source code you get." @echo - @echo "make prep-gtk-docs" - @echo " This configures and compiles gtk+ and builds the DocBook xml" - @echo " files necessary for the next stage. You should only have to" - @echo " do this once." - @echo @echo "make gtk-modules" @echo " This generates all the Gtk modules by processing the source" @echo " code and the DocBook documentation. The .chs modules are all" @echo " put into the subdirectory gtk-modules. You need to have" - @echo " downloaded the source and built the docs before doing this." + @echo " downloaded the source and before doing this." @echo @echo "make gdk-modules" @echo " as above but for Gdk" @echo - @echo "make prep-pango-docs pango-modules" + @echo "make pango-modules" @echo " as above but for Pango" @echo @echo "make glade-modules" @@ -33,19 +28,27 @@ # # source code # -PANGO_VERSION = 1.2.3 -GTK_VERSION = 2.2.2 -GLADE_VERSION = 2.0.0 +GLIB_VERSION = 2.4.8 +PANGO_VERSION = 1.4.1 +ATK_VERSION = 1.6.1 +GTK_VERSION = 2.4.14 +GLADE_VERSION = 2.3.6 DOWNLOADS = \ - http://ftp.gnome.org/pub/GNOME/desktop/2.2/2.2.2/sources/pango-$(PANGO_VERSION).tar.gz \ - http://ftp.gnome.org/pub/GNOME/desktop/2.2/2.2.2/sources/gtk+-$(GTK_VERSION).tar.gz \ - http://ftp.gnome.org/pub/GNOME/desktop/2.0/2.0.0/sources/libglade-$(GLADE_VERSION).tar.gz + ftp://ftp.gtk.org/pub/gtk/v2.4/glib-$(GLIB_VERSION).tar.gz \ + ftp://ftp.gtk.org/pub/gtk/v2.4/pango-$(PANGO_VERSION).tar.gz \ + ftp://ftp.gtk.org/pub/gtk/v2.4/atk-$(ATK_VERSION).tar.gz \ + ftp://ftp.gtk.org/pub/gtk/v2.4/gtk+-$(GTK_VERSION).tar.gz \ + http://ftp.gnome.org/pub/GNOME/desktop/2.6/2.6.2/sources/libglade-$(GLADE_VERSION).tar.gz\ + http://ftp.gnome.org/pub/GNOME/desktop/2.6/2.6.2/sources/libgnomecanvas-2.6.1.1.tar.gz get-source-code: for i in $(DOWNLOADS); do \ wget $$i --output-document=- | tar -xz ; \ done; + # following fixes borrowed from Gtk# + ln -f -s gtkfilechooserprivate.h gtk+-$(GTK_VERSION)/gtk/gtkfilechooserpriv.h + patch -p0 atk-1.6.1/atk/atkhyperlink.h < atkhyperlink.patch ############################# @@ -64,13 +67,14 @@ # # Gtk modules # -prep-gtk-docs : gtk+-$(GTK_VERSION) - cd $< && ./configure --enable-gtk-doc && make +#prep-gtk-docs : gtk+-$(GTK_VERSION) +# cd $< && ./configure --enable-gtk-doc && make gtk-docs.xml : gtk+-$(GTK_VERSION)/docs/reference/gtk/xml format-docs.xsl ./mkdocxml.sh $< | xsltproc format-docs.xsl - > $@ -gtk-modules : gtk-api.xml gtk-docs.xml Template.chs ApiGen gdk-api.xml pango-api.xml +gtk-modules : gtk-api.xml gtk-docs.xml Template.chs ApiGen \ + gdk-api.xml pango-api.xml atk-api.xml @mkdir -p $@ ./ApiGen $< Template.chs --doc=gtk-docs.xml --outdir=$@ \ --includeapi=gdk-api.xml --includeapi=pango-api.xml --includeapi=atk-api.xml @@ -94,8 +98,8 @@ # # Pango modules # -prep-pango-docs : pango-$(PANGO_VERSION) - cd $< && ./configure --enable-gtk-doc && make +#prep-pango-docs : pango-$(PANGO_VERSION) +# cd $< && ./configure --enable-gtk-doc && make pango-docs.xml : pango-$(PANGO_VERSION)/docs/xml format-docs.xsl ./mkdocxml.sh $< | xsltproc format-docs.xsl - > $@ Index: gnomecanvas-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gnomecanvas-sources.xml,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- gnomecanvas-sources.xml 26 Jan 2005 12:13:28 -0000 1.1 +++ gnomecanvas-sources.xml 27 Jan 2005 23:10:15 -0000 1.2 @@ -2,7 +2,7 @@ <api filename="gnomecanvas-api.xml"> <library name="gnomecanvas"> <namespace name="Gnome"> - <dir>libgnomecanvas-2.2.1/libgnomecanvas</dir> + <dir>libgnomecanvas-2.6.0/libgnomecanvas</dir> </namespace> </library> </api> Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- ApiGen.hs 26 Jan 2005 12:05:09 -0000 1.8 +++ ApiGen.hs 27 Jan 2005 23:10:14 -0000 1.9 @@ -182,6 +182,9 @@ extractParameter (Xml.CElem (Xml.Elem "parameter" [("ellipsis", _)] [])) = VarArgs extractParameter (Xml.CElem (Xml.Elem "parameter" + [("ellipsis", _) + ,("printf_format_args", _)] [])) = VarArgs +extractParameter (Xml.CElem (Xml.Elem "parameter" [("type", Xml.AttValue type_), ("name", Xml.AttValue name)] [])) = Parameter { @@ -191,6 +194,15 @@ } extractParameter (Xml.CElem (Xml.Elem "parameter" [("type", Xml.AttValue type_), + ("name", Xml.AttValue name), + ("printf_format" ,_)] [])) = + 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 { @@ -600,10 +612,12 @@ lowerCaseFirstChar . stripKnownPrefixes . concatMap upperCaseFirstChar + . filter (not.null) --to ignore leading underscores . splitBy '_' . takeWhile ('('/=) stripKnownPrefixes :: String -> String +stripKnownPrefixes ('A':'t':'k':remainder) = remainder stripKnownPrefixes ('G':'t':'k':remainder) = remainder stripKnownPrefixes ('G':'d':'k':remainder) = remainder stripKnownPrefixes ('P':'a':'n':'g':'o':remainder) = remainder @@ -833,6 +847,7 @@ where lookup [] = trace ( "Warning: " ++ object_name object ++ " does not inherit from GObject! " ++ show (objectParents object)) GObjectKind + lookup ("GTypeModule":os) = GObjectKind -- GTypeModule is a GObject lookup ("GObject":os) = GObjectKind lookup ("GtkObject":os) = GtkObjectKind lookup (_:os) = lookup os Index: gdk-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gdk-sources.xml,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- gdk-sources.xml 26 Jan 2005 12:13:28 -0000 1.2 +++ gdk-sources.xml 27 Jan 2005 23:10:15 -0000 1.3 @@ -2,12 +2,12 @@ <api filename="gdk-api.xml"> <library name="gdk"> <namespace name="Gdk"> - <dir>gtk+-2.2.2/gdk</dir> + <dir>gtk+-2.4.14/gdk</dir> </namespace> </library> <library name="gdk_pixbuf"> <namespace name="Gdk"> - <dir>gtk+-2.2.2/gdk-pixbuf</dir> + <dir>gtk+-2.4.14/gdk-pixbuf</dir> </namespace> </library> </api> Index: atk-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/atk-sources.xml,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- atk-sources.xml 26 Jan 2005 12:13:28 -0000 1.1 +++ atk-sources.xml 27 Jan 2005 23:10:15 -0000 1.2 @@ -2,7 +2,7 @@ <api filename="atk-api.xml"> <library name="atk"> <namespace name="Atk"> - <dir>atk-1.2.4/atk</dir> + <dir>atk-1.6.1/atk</dir> </namespace> </library> </api> |
|
From: Duncan C. <dun...@us...> - 2005-01-26 12:13:38
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16204/tools/apiGen Modified Files: Makefile README format-docs.xsl gdk-sources.xml glade-sources.xml gtk-sources.xml pango-sources.xml Added Files: atk-sources.xml gnomecanvas-sources.xml Log Message: format-docs.xsl: Extract documentation of properties. Makefile: include parent api files to scan for types. README: note some todo items. *-sources.xml: add and update sources spec files. Index: README =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/README,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- README 24 Jan 2005 01:54:03 -0000 1.3 +++ README 26 Jan 2005 12:13:28 -0000 1.4 @@ -57,3 +57,7 @@ Some improvements that would be good: * Complete marshaling code for more types * Emit signal and property bindings with documentation + * Deal with Enums, Flags, and Interfaces properly + - make objects instances of interfaces they implement + - make a note of structs and boxed types + - allow import of parent api files for reference to known types Index: gtk-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gtk-sources.xml,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- gtk-sources.xml 24 Jan 2005 01:40:09 -0000 1.1 +++ gtk-sources.xml 26 Jan 2005 12:13:28 -0000 1.2 @@ -1,6 +1,6 @@ <gapi-parser-input> <api filename="gtk-api.xml"> - <library name="libgtk"> + <library name="gtk"> <namespace name="Gtk"> <dir>gtk+-2.2.2/gtk</dir> </namespace> Index: gdk-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gdk-sources.xml,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- gdk-sources.xml 24 Jan 2005 01:40:09 -0000 1.1 +++ gdk-sources.xml 26 Jan 2005 12:13:28 -0000 1.2 @@ -1,11 +1,11 @@ <gapi-parser-input> <api filename="gdk-api.xml"> - <library name="libgdk"> + <library name="gdk"> <namespace name="Gdk"> <dir>gtk+-2.2.2/gdk</dir> </namespace> </library> - <library name="libgdk-pixbuf"> + <library name="gdk_pixbuf"> <namespace name="Gdk"> <dir>gtk+-2.2.2/gdk-pixbuf</dir> </namespace> Index: pango-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/pango-sources.xml,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- pango-sources.xml 24 Jan 2005 01:40:09 -0000 1.1 +++ pango-sources.xml 26 Jan 2005 12:13:28 -0000 1.2 @@ -1,6 +1,6 @@ <gapi-parser-input> <api filename="pango-api.xml"> - <library name="libpango"> + <library name="pango"> <namespace name="Pango"> <dir>pango-1.2.3/pango</dir> <exclude>pango-1.2.3/pango/pangox-fontcache.c</exclude> --- NEW FILE: atk-sources.xml --- <gapi-parser-input> <api filename="atk-api.xml"> <library name="atk"> <namespace name="Atk"> <dir>atk-1.2.4/atk</dir> </namespace> </library> </api> </gapi-parser-input> Index: glade-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/glade-sources.xml,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- glade-sources.xml 24 Jan 2005 01:40:09 -0000 1.1 +++ glade-sources.xml 26 Jan 2005 12:13:28 -0000 1.2 @@ -1,6 +1,6 @@ <gapi-parser-input> <api filename="glade-api.xml"> - <library name="libglade"> + <library name="glade"> <namespace name="Glade"> <dir>libglade-2.0.0/glade</dir> </namespace> Index: format-docs.xsl =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/format-docs.xsl,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- format-docs.xsl 25 Jan 2005 18:19:37 -0000 1.7 +++ format-docs.xsl 26 Jan 2005 12:13:28 -0000 1.8 @@ -123,6 +123,17 @@ </params> </function> </xsl:for-each> + <xsl:for-each select="refentry/refsect1[title='Properties']/variablelist/varlistentry"> + <property> + <name><xsl:value-of select="term/literal"/></name> + <since> + <xsl:value-of select="normalize-space(substring-after(listitem/para[starts-with(text(),'Since')], 'Since'))"/> + </since> + <doc> + <xsl:apply-templates select="listitem/para[not(starts-with(text(),'Since')) and normalize-space(text())!='']"/> + </doc> + </property> + </xsl:for-each> </module> </xsl:for-each> </apidoc> Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- Makefile 24 Jan 2005 01:35:51 -0000 1.1 +++ Makefile 26 Jan 2005 12:13:28 -0000 1.2 @@ -26,7 +26,7 @@ @echo "make prep-pango-docs pango-modules" @echo " as above but for Pango" @echo - @echo "make prep-glade-docs glade-modules" + @echo "make glade-modules" @echo " as above but for libglade" ######################## @@ -67,12 +67,13 @@ prep-gtk-docs : gtk+-$(GTK_VERSION) cd $< && ./configure --enable-gtk-doc && make -gtk-docs.xml : gtk+-$(GTK_VERSION)/docs/reference/gtk/xml +gtk-docs.xml : gtk+-$(GTK_VERSION)/docs/reference/gtk/xml format-docs.xsl ./mkdocxml.sh $< | xsltproc format-docs.xsl - > $@ -gtk-modules : gtk-api.xml gtk-docs.xml Template.chs ApiGen +gtk-modules : gtk-api.xml gtk-docs.xml Template.chs ApiGen gdk-api.xml pango-api.xml @mkdir -p $@ - ./ApiGen $< Template.chs --doc=gtk-docs.xml --outdir=$@ + ./ApiGen $< Template.chs --doc=gtk-docs.xml --outdir=$@ \ + --includeapi=gdk-api.xml --includeapi=pango-api.xml --includeapi=atk-api.xml ################### @@ -80,7 +81,8 @@ # Gdk modules # gdk-docs.xml : gtk+-$(GTK_VERSION)/docs/reference/gdk/xml \ - gtk+-$(GTK_VERSION)/docs/reference/gdk-pixbuf/xml + gtk+-$(GTK_VERSION)/docs/reference/gdk-pixbuf/xml \ + format-docs.xsl ./mkdocxml.sh $< | xsltproc format-docs.xsl - > $@ gdk-modules : gdk-api.xml gdk-docs.xml Template.chs ApiGen @@ -95,7 +97,7 @@ prep-pango-docs : pango-$(PANGO_VERSION) cd $< && ./configure --enable-gtk-doc && make -pango-docs.xml : pango-$(PANGO_VERSION)/docs/xml +pango-docs.xml : pango-$(PANGO_VERSION)/docs/xml format-docs.xsl ./mkdocxml.sh $< | xsltproc format-docs.xsl - > $@ pango-modules : pango-api.xml pango-docs.xml Template.chs ApiGen @@ -107,9 +109,6 @@ # # libglade modules # -prep-glade-docs : libglade-$(GLADE_VERSION) - cd $< && ./configure --enable-gtk-doc && make - glade-modules : glade-api.xml Template.chs ApiGen @mkdir -p $@ ./ApiGen $< Template.chs --outdir=$@ @@ -117,6 +116,15 @@ ######################## # +# gnomecanvas modules +# +gnomecanvas-modules : gnomecanvas-api.xml Template.chs ApiGen + @mkdir -p $@ + ./ApiGen $< Template.chs --outdir=$@ + + +######################## +# # tools # ApiGen : ApiGen.hs --- NEW FILE: gnomecanvas-sources.xml --- <gapi-parser-input> <api filename="gnomecanvas-api.xml"> <library name="gnomecanvas"> <namespace name="Gnome"> <dir>libgnomecanvas-2.2.1/libgnomecanvas</dir> </namespace> </library> </api> </gapi-parser-input> |
|
From: Duncan C. <dun...@us...> - 2005-01-26 12:13:37
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16204 Modified Files: ChangeLog Log Message: format-docs.xsl: Extract documentation of properties. Makefile: include parent api files to scan for types. README: note some todo items. *-sources.xml: add and update sources spec files. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.329 retrieving revision 1.330 diff -u -d -r1.329 -r1.330 --- ChangeLog 26 Jan 2005 12:05:08 -0000 1.329 +++ ChangeLog 26 Jan 2005 12:13:27 -0000 1.330 @@ -7,6 +7,17 @@ documentation of properties. Initial go at producing property definitions. + * tools/apiGen/format-docs.xsl: extract documentation of properties. + + * tools/apiGen/Makefile: include parent api files to scan for types. + + * tools/apiGen/README: note some todo items. + + * tools/apiGen/atk-sources.xml, tools/apiGen/gdk-sources.xml + tools/apiGen/glade-sources.xml, tools/apiGen/gnomecanvas-sources.xml + tools/apiGen/gtk-sources.xml, tools/apiGen/pango-sources.xml: add and + update sources spec files. + 2005-01-25 Duncan Coutts <du...@co...> * tools/apiGen/format-docs.xsl: deal with another kind of list and |
|
From: Duncan C. <dun...@us...> - 2005-01-26 12:05:35
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14670/tools/apiGen Modified Files: ApiGen.hs Log Message: Several marshaling improvements. Extract enums from the api file. Produce a list of objects and enums and use it when deciding how to marshal types. Marshal floats and doubles, flags and enums. Distinguish between GObjects and GtkObjects. Extract documentation of properties. Initial go at producing property definitions. Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- ApiGen.hs 25 Jan 2005 18:19:38 -0000 1.7 +++ ApiGen.hs 26 Jan 2005 12:05:09 -0000 1.8 @@ -11,9 +11,9 @@ import Prelude hiding (Enum, lines) import qualified Prelude (lines) import Monad (when) -import Maybe (catMaybes, fromJust) +import Maybe (catMaybes) import Char (toLower, toUpper, isSpace, isAlpha, isAlphaNum, isUpper) -import List (isPrefixOf, groupBy, sortBy) +import List (isPrefixOf, groupBy, sortBy, unfoldr) import qualified List (lines) import System (getArgs, exitWith, ExitCode(..)) @@ -23,6 +23,8 @@ import qualified System.Time +import Debug.Trace (trace) + ------------------------------------------------------------------------------- -- Types representing the content of the API XML file ------------------------------------------------------------------------------- @@ -110,10 +112,36 @@ namespace_name = Xml.verbatim name, namespace_library = Xml.verbatim lib, namespace_objects = catMaybes (map extractObject content), - namespace_enums = [] + namespace_enums = catMaybes (map extractEnum content) } extractNameSpace _ = Nothing +extractEnum :: Xml.Content -> Maybe Enum +extractEnum (Xml.CElem (Xml.Elem "enum" + [("name", Xml.AttValue name), + ("cname", Xml.AttValue cname), + ("type", Xml.AttValue variety)] members)) = + Just $ Enum { + enum_name = Xml.verbatim name, + enum_cname = Xml.verbatim cname, + enum_variety = Xml.verbatim variety, + enum_members = map extractEnumMember members + } +extractEnum _ = Nothing + +extractEnumMember :: Xml.Content -> Member +extractEnumMember (Xml.CElem (Xml.Elem "enum" + (("name", Xml.AttValue name): + ("cname", Xml.AttValue cname):value) [])) = + Member { + member_name = Xml.verbatim name, + member_cname = Xml.verbatim cname, + member_value = + case value of + [] -> "" + [("cname", Xml.AttValue value)] -> Xml.verbatim value + } + extractObject :: Xml.Content -> Maybe Object extractObject (Xml.CElem (Xml.Elem "object" [("name", Xml.AttValue name), @@ -240,7 +268,8 @@ moduledoc_description :: [DocPara], -- the main description moduledoc_sections :: [DocSection], -- any additional titled subsections moduledoc_hierarchy :: [DocParaSpan], -- a tree of parent objects (as text) - moduledoc_functions :: [FuncDoc] -- documentation for each function + moduledoc_functions :: [FuncDoc], -- documentation for each function + moduledoc_properties :: [PropDoc] -- documentation for each property } noModuleDoc = ModuleDoc { @@ -250,7 +279,8 @@ moduledoc_description = [], moduledoc_sections = [], moduledoc_hierarchy = [], - moduledoc_functions = [] + moduledoc_functions = [], + moduledoc_properties = [] } data DocSection = DocSection { @@ -258,11 +288,13 @@ section_paras :: [DocPara] } +type Since = String + data FuncDoc = FuncDoc { funcdoc_name :: String, -- C function name funcdoc_paragraphs :: [DocPara], -- documentation markup funcdoc_params :: [ParamDoc], -- parameter documentation - funcdoc_since :: Maybe String -- which version of the api the + funcdoc_since :: Since -- which version of the api the } -- function is available from, eg "2.4" data ParamDoc = ParamDoc { @@ -270,6 +302,12 @@ paramdoc_paragraph :: [DocParaSpan] -- a simple paragraph } +data PropDoc = PropDoc { + propdoc_name :: String, -- property name + propdoc_paragraphs :: [DocPara], -- documentation markup + propdoc_since :: Since -- which version of the api the + } -- function is available from, eg "2.4" + data DocPara = DocParaText [DocParaSpan] -- an ordinary word-wrapped paragraph | DocParaProgram String -- a verbatum section @@ -294,9 +332,12 @@ map extractDocModule modules extractDocModule :: Xml.Content -> ModuleDoc -extractDocModule (Xml.CElem (Xml.Elem "module" [] (moduleinfo:functions))) = - (extractDocModuleinfo moduleinfo) { - moduledoc_functions = map extractDocFunc functions +extractDocModule (Xml.CElem (Xml.Elem "module" [] (moduleinfo:rest))) = + let functions = [ e | e@(Xml.CElem (Xml.Elem "function" _ _)) <- rest ] + properties = [ e | e@(Xml.CElem (Xml.Elem "property" _ _)) <- rest ] + in (extractDocModuleinfo moduleinfo) { + moduledoc_functions = map extractDocFunc functions, + moduledoc_properties = map extractDocProp properties } extractDocModuleinfo :: Xml.Content -> ModuleDoc @@ -319,7 +360,8 @@ moduledoc_description = concatMap extractDocPara paras, moduledoc_sections = map extractDocSection sections, moduledoc_hierarchy = map extractDocParaSpan objHierSpans, - moduledoc_functions = undefined + moduledoc_functions = undefined, + moduledoc_properties = undefined } extractDocSection :: Xml.Content -> DocSection @@ -342,14 +384,14 @@ ,Xml.CElem (Xml.Elem "params" [] params)] )) = let since = case since' of - [] -> Nothing - [Xml.CString _ since] -> Just since + [] -> "" + [Xml.CString _ since] -> since in FuncDoc { - funcdoc_name = name, - funcdoc_paragraphs = concatMap extractDocPara paras, - funcdoc_params = map extractParamDoc params, - funcdoc_since = since - } + funcdoc_name = name, + funcdoc_paragraphs = concatMap extractDocPara paras, + funcdoc_params = map extractParamDoc params, + funcdoc_since = since + } extractParamDoc :: Xml.Content -> ParamDoc extractParamDoc @@ -361,6 +403,22 @@ paramdoc_paragraph = map extractDocParaSpan spans } +extractDocProp :: Xml.Content -> PropDoc +extractDocProp + (Xml.CElem (Xml.Elem "property" [] + [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 + [] -> "" + [Xml.CString _ since] -> since + in PropDoc { + propdoc_name = name, + propdoc_paragraphs = concatMap extractDocPara paras, + propdoc_since = since + } + extractDocPara :: Xml.Content -> [DocPara] extractDocPara (Xml.CElem elem@(Xml.Elem "para" [] _)) = case Xml.xmlUnEscape Xml.stdXmlEscaper elem of @@ -428,11 +486,7 @@ comment.ss "| ".haddocFormatParas (moduledoc_description moduledoc).nl). (if null (moduledoc_sections moduledoc) then id - else nl.comment.haddocFormatSections (moduledoc_sections moduledoc).nl.comment) - -- Getting decent formatting for the class hierarchy does not seem to be - -- possible with the available haddock markup. So disabling for now. - -- - .nl. + else nl.comment.haddocFormatSections (moduledoc_sections moduledoc).nl.comment.nl). (if null (moduledoc_hierarchy moduledoc) then id else nl.comment.ss "* Class Hierarchy".nl. @@ -453,13 +507,13 @@ moduledoc_description = moduledoc_description apiDoc ++ moduleVersionParagraph, moduledoc_functions = functionVersionParagraphs moduleVersion (moduledoc_functions apiDoc) } - where functionVersionParagraphs :: Maybe String -> [FuncDoc] -> [FuncDoc] + where functionVersionParagraphs :: String -> [FuncDoc] -> [FuncDoc] functionVersionParagraphs baseVersion funcdocs = [ if funcdoc_since funcdoc > baseVersion then funcdoc { funcdoc_paragraphs = funcdoc_paragraphs funcdoc ++ let line = "* Available since " ++ namespace_name namespace - ++ " version " ++ fromJust (funcdoc_since funcdoc) + ++ " version " ++ funcdoc_since funcdoc in [DocParaText [DocText line]] } else funcdoc @@ -467,18 +521,18 @@ moduleVersionParagraph = case moduleVersion of - Nothing -> [] - Just since -> + "" -> [] + since -> let line = "* Module available since " ++ namespace_name namespace ++ " version " ++ since in [DocParaText [DocText line]] -- figure out if the whole module appeared in some version of gtk later -- than the original version - moduleVersion :: Maybe String + moduleVersion :: String moduleVersion = case [ funcdoc_since funcdoc | funcdoc <- moduledoc_functions apiDoc ] of - [] -> Nothing + [] -> "" versions -> minimum versions haddocFormatSections :: [DocSection] -> ShowS @@ -553,6 +607,7 @@ stripKnownPrefixes ('G':'t':'k':remainder) = remainder stripKnownPrefixes ('G':'d':'k':remainder) = remainder stripKnownPrefixes ('P':'a':'n':'g':'o':remainder) = remainder +stripKnownPrefixes ('G':'n':'o':'m':'e':remainder) = remainder stripKnownPrefixes other = other cParamNameToHsName :: String -> String @@ -590,8 +645,8 @@ ------------------------------------------------------------------------------- -- Now lets actually generate some code fragments based on the api info ------------------------------------------------------------------------------- -genFunction :: Object -> Method -> Maybe FuncDoc -> ShowS -genFunction object method doc = +genFunction :: KnownTypes -> Method -> Maybe FuncDoc -> ShowS +genFunction knownTypes method doc = formattedDoc. ss functionName. ss " :: ". functionType. nl. ss functionName. sc ' '. sepBy " " paramNames. ss " =". @@ -599,7 +654,7 @@ where functionName = cFuncNameToHsName (method_cname method) (classConstraints', paramTypes', paramMarshalers) = - unzip3 [ case genMarshalParameter + unzip3 [ case genMarshalParameter knownTypes (changeIllegalNames (cParamNameToHsName (parameter_name p))) (parameter_type p) of (c, ty, m) -> (c, (ty, parameter_name p), m) @@ -610,7 +665,7 @@ paramNames = [ changeIllegalNames (cParamNameToHsName (parameter_name p)) | ((Just _, _), p) <- zip paramTypes' (method_parameters method) ] (returnType', returnMarshaler) = - genMarshalResult (method_return_type method) + genMarshalResult knownTypes (method_return_type method) returnType = (returnType', lookup "Returns" paramDocMap) functionType = (case classConstraints of [] -> id @@ -662,15 +717,16 @@ . concatMap haddocFormatSpan columnIndent = maximum [ length parmType | (parmType, _) <- paramTypes ] -genModuleBody :: Object -> ModuleDoc -> ShowS -genModuleBody object apiDoc = +genModuleBody :: KnownTypes -> Object -> ModuleDoc -> ShowS +genModuleBody knownTypes object apiDoc = doVersionIfDefs (sepBy' "\n\n") $ - genConstructors object (moduledoc_functions apiDoc) - ++ genMethods object (moduledoc_functions apiDoc) + genConstructors knownTypes object (moduledoc_functions apiDoc) + ++ genMethods knownTypes object (moduledoc_functions apiDoc) + ++ genProperties knownTypes object (moduledoc_properties apiDoc) -genMethods :: Object -> [FuncDoc] -> [(ShowS, Maybe FuncDoc)] -genMethods object apiDoc = - [ (genFunction object method doc, doc) +genMethods :: KnownTypes -> Object -> [FuncDoc] -> [(ShowS, Since)] +genMethods knownTypes object apiDoc = + [ (genFunction knownTypes method doc, maybe "" funcdoc_since doc) | (method, doc) <- methods object apiDoc ] methods :: Object -> [FuncDoc] -> [(Method, Maybe FuncDoc)] @@ -697,9 +753,9 @@ method_parameters = self : method_parameters method } -genConstructors :: Object -> [FuncDoc] -> [(ShowS, Maybe FuncDoc)] -genConstructors object apiDoc = - [ (genFunction object constructor doc, doc) +genConstructors :: KnownTypes -> Object -> [FuncDoc] -> [(ShowS, Since)] +genConstructors knownTypes object apiDoc = + [ (genFunction knownTypes constructor doc, maybe "" funcdoc_since doc) | (constructor, doc) <- constructors object apiDoc ] constructors :: Object -> [FuncDoc] -> [(Method, Maybe FuncDoc)] @@ -718,23 +774,106 @@ method_parameters = constructor_parameters constructor } +properties :: Object -> [PropDoc] -> [(Property, Maybe PropDoc)] +properties object docs = + [ (property, property_cname property `lookup` docmap) + | property <- object_properties object ] + where docmap = [ (map dashToUnderscore (propdoc_name doc), doc) + | doc <- docs ] + dashToUnderscore '-' = '_' + dashToUnderscore c = c + +genProperties :: KnownTypes -> Object -> [PropDoc] -> [(ShowS, Since)] +genProperties knownTypes object apiDoc = + [ (genProperty object property doc, maybe "" propdoc_since doc) + | (property, doc) <- properties object apiDoc ] + +genProperty :: Object -> Property -> Maybe PropDoc -> ShowS +genProperty object property doc = + formattedDoc. + ss propertyName. ss " :: Attr ". objectType. sc ' '.propertyType. nl. + ss propertyName. ss " = Attr ". + indent 1. getter. + indent 1. setter + where objectType = ss (object_name object) + propertyName = cFuncNameToHsName (property_cname property) + propertyType = ss "{- ". ss (property_type property). ss " -}" + getter = ss "(\\obj -> {-unmarshal result-} objectGetProperty \"". ss (property_cname property). ss "\")" + setter = ss "(\\obj val -> objectSetProperty obj \"". ss (property_cname property). ss "\" {- marshal val-})" + formattedDoc = case doc of + Nothing -> ss "-- | \n-- \n" + Just doc -> ss "-- | ". haddocFormatParas (propdoc_paragraphs doc). nl. + comment. nl + +-- We would like to be able to look up a type name and find out if it is a +-- known class or enum so we can marshal it properly +type KnownTypes = [(String, CTypeKind)] + +data CTypeKind = GObjectKind + | GtkObjectKind + | EnumKind + | FlagsKind + deriving (Eq, Show) + +makeKnownTypesMap :: API -> KnownTypes +makeKnownTypesMap api = + concat + [ [ (enum_name enum + ,case enum_variety enum of + "enum" -> EnumKind + "flags" -> FlagsKind) + | enum <- namespace_enums namespace ] + ++ [ (object_name object, objectKind object) + | object <- namespace_objects namespace ] + | namespace <- api ] + + -- find if an object inherits via GtkObject or directly from GObject + where objectKind :: Object -> CTypeKind + objectKind object = lookup (objectParents object) + where lookup [] = trace ( "Warning: " ++ object_name object + ++ " does not inherit from GObject! " + ++ show (objectParents object)) GObjectKind + lookup ("GObject":os) = GObjectKind + lookup ("GtkObject":os) = GtkObjectKind + lookup (_:os) = lookup os + objectParents :: Object -> [String] + objectParents object = object_cname object : + case object_parent object `lookup` objectMap of + Nothing -> [object_parent object] + Just parent -> objectParents parent + objectMap :: [(String, Object)] + objectMap = [ (object_cname object, object) + | namespace <- api + , object <- namespace_objects namespace ] + genExports :: Object -> [FuncDoc] -> ShowS genExports object docs = comment.ss "* Types". indent 1.ss (object_name object).sc ','. indent 1.ss (object_name object).ss "Class,". - indent 1.ss "castTo".ss (object_name object).sc ','.nl. - nl. - (case [ (ss " ". ss (cFuncNameToHsName (method_cname constructor)). sc ',', doc) + indent 1.ss "castTo".ss (object_name object).sc ','. + (case [ (ss " ". ss (cFuncNameToHsName (method_cname constructor)). sc ',' + ,maybe "" funcdoc_since doc) | (constructor, doc) <- constructors object docs] of [] -> id - cs -> comment.ss "* Constructors".nl. - doVersionIfDefs lines cs.nl.nl). - (case [ (ss " ". ss (cFuncNameToHsName (method_cname method)). sc ',', doc) + cs -> nl.nl.comment.ss "* Constructors".nl. + doVersionIfDefs lines cs). + (case [ (ss " ". ss (cFuncNameToHsName (method_cname method)). sc ',' + ,maybe "" funcdoc_since doc) | (method, doc) <- methods object docs] of [] -> id - cs -> comment.ss "* Methods".nl. - doVersionIfDefs lines cs) + cs -> nl.nl.comment.ss "* Methods".nl. + doVersionIfDefs lines cs). + (case [ ss " ". ss (cFuncNameToHsName (property_cname property)). sc ',' + | property {-, doc-} <- object_properties object {-docs-}] of + [] -> id + cs -> nl.nl.comment.ss "* Properties".nl. + lines cs). + (case [ ss " ". ss (cFuncNameToHsName (signal_cname signal)). sc ',' + | signal {-, doc-} <- object_signals object {-docs-}] of + [] -> id + cs -> nl.nl.comment.ss "* Signals".nl. + lines cs) genTodoItems :: Object -> ShowS genTodoItems object = @@ -752,15 +891,15 @@ ss "TODO: the following varargs functions were not bound\n". lines (map (ss "-- * ".) varargsFunctions) -doVersionIfDefs :: ([ShowS] -> ShowS) -> [(ShowS, Maybe FuncDoc)] -> ShowS +doVersionIfDefs :: ([ShowS] -> ShowS) -> [(ShowS, Since)] -> ShowS doVersionIfDefs lines = lines . map (\group -> sinceVersion (snd (head group)) (lines (map fst group))) - . groupBy (\(_,a) (_,b) -> fmap funcdoc_since a == fmap funcdoc_since b) + . groupBy (\(_,a) (_,b) -> a == b) -sinceVersion :: Maybe FuncDoc -> ShowS -> ShowS -sinceVersion (Just (FuncDoc _ _ _ (Just (major:'.':minor:[])))) body = +sinceVersion :: Since -> ShowS -> ShowS +sinceVersion [major,'.',minor] body = ss "#if GTK_CHECK_VERSION(". sc major. ss ",". sc minor. ss ",0)\n". body. ss "\n#endif" @@ -777,83 +916,148 @@ ------------------------------------------------------------------------------- genMarshalParameter :: + KnownTypes -> --a collection of types we know to be objects or enums String -> --parameter name suggestion (will be unique) String -> --C type decleration for the parameter we will marshal (Maybe String, --parameter class constraints (or none) Maybe String, --parameter type (or none if the arg is not exposed) ShowS -> ShowS) --marshaling code (\body -> ... body ...) -genMarshalParameter name "gboolean" = +genMarshalParameter _ name "gboolean" = (Nothing, Just "Bool", - \body -> body. ss " (fromBool ". ss name. ss ")") + \body -> body. + indent 2. 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" = +genMarshalParameter _ name typeName + | typeName == "guint" --these two are unsigned types + || typeName == "gint" + || typeName == "int" + || typeName == "gsize" --should they be Word or Int? + || typeName == "gssize" = (Nothing, Just "Int", \body -> body. indent 2. ss " (fromIntegral ". ss name. ss ")") -genMarshalParameter name typeName | typeName == "const-gchar*" - || typeName == "const-char*" = +genMarshalParameter _ name "gdouble" = + (Nothing, Just "Double", + \body -> body. + indent 2. ss " (realToFrac ". ss name. ss ")") + +genMarshalParameter _ name "gfloat" = + (Nothing, Just "Float", + \body -> body. + indent 2. ss " (realToFrac ". ss name. ss ")") + +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") + indent 1. body. + indent 2. sc ' '. ss name. ss "Ptr") -genMarshalParameter name "GError**" = +genMarshalParameter _ name "GError**" = (Nothing, Nothing, \body -> ss "propagateGError $ \\". ss name. ss "Ptr ->". - indent 1. body. sc ' '. ss name. ss "Ptr") + indent 1. body. + indent 2. 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 knownTypes name typeName' + | isUpper (head typeName') + && last typeName' == '*' + && last typeName /= '*' + && (typeKind == Just GObjectKind + || typeKind == Just GtkObjectKind) = + (Just $ shortTypeName ++ "Class " ++ name, Just name, + \body -> body. + indent 2. ss " (to". ss shortTypeName. sc ' '. ss name. ss ")") + where typeName = init typeName' + shortTypeName = stripKnownPrefixes typeName + typeKind = shortTypeName `lookup` knownTypes -genMarshalParameter name unknownType = +genMarshalParameter knownTypes name typeName + | isUpper (head typeName) + && typeKind == Just EnumKind = + (Nothing, Just shortTypeName, + \body -> body. + indent 2. ss " ((fromIntegral . fromEnum) ". ss name. ss ")") + where shortTypeName = stripKnownPrefixes typeName + typeKind = shortTypeName `lookup` knownTypes + +genMarshalParameter knownTypes name typeName + | isUpper (head typeName) + && typeKind == Just FlagsKind = + (Nothing, Just shortTypeName, + \body -> body. + indent 2. ss " ((fromIntegral . fromFlags) ". ss name. ss ")") + where shortTypeName = stripKnownPrefixes typeName + typeKind = shortTypeName `lookup` knownTypes + +genMarshalParameter _ name unknownType = (Nothing, Just $ "{-" ++ unknownType ++ "-}", - \body -> body. ss " {-". ss name. ss "-}") + \body -> body. + indent 2. 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 "gchar*" = ("IO String", \body -> body. - indent 1. ss ">>= readUTFString") -genMarshalResult "const-GSList*" = +genMarshalResult :: KnownTypes -> 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 _ "gchar*" = ("IO String", \body -> body. + indent 1. ss ">>= readUTFString") +genMarshalResult _ "const-GSList*" = ("[{- element type -}]", \body -> body. indent 1. ss ">>= readGSList". indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})") -genMarshalResult "GSList*" = +genMarshalResult _ "GSList*" = ("[{- element type -}]", \body -> body. indent 1. ss ">>= fromGSList". indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})") -genMarshalResult "GList*" = +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 " $". +genMarshalResult knownTypes typeName' + | isUpper (head typeName') + && last typeName' == '*' + && last typeName /= '*' + && (typeKind == Just GObjectKind + || typeKind == Just GtkObjectKind) = + ("IO " ++ shortTypeName, + \body -> ss constructor. ss " mk". ss shortTypeName. ss " $". + indent 1. body) + where typeName = init typeName' + shortTypeName = stripKnownPrefixes typeName + typeKind = shortTypeName `lookup` knownTypes + constructor | typeKind == Just GObjectKind = "makeNewGObject" + | typeKind == Just GtkObjectKind = "makeNewObject" + +genMarshalResult knownTypes typeName + | isUpper (head typeName) + && typeKind == Just EnumKind = + ("IO " ++ shortTypeName, + \body -> ss "liftM (toEnum . fromIntegral) $". indent 1. body) + where shortTypeName = stripKnownPrefixes typeName + typeKind = shortTypeName `lookup` knownTypes -genMarshalResult unknownType = ("{-" ++ unknownType ++ "-}", id) +genMarshalResult knownTypes typeName + | isUpper (head typeName) + && typeKind == Just FlagsKind = + ("IO " ++ shortTypeName, + \body -> ss "liftM (toFlags . fromIntegral) $". + indent 1. body) + where shortTypeName = stripKnownPrefixes typeName + typeKind = shortTypeName `lookup` knownTypes + +genMarshalResult _ unknownType = ("{-" ++ unknownType ++ "-}", id) ------------------------------------------------------------------------------- -- Top level stuff @@ -882,6 +1086,7 @@ let outdir = case map (drop 9) (filter ("--outdir=" `isPrefixOf`) rem) of [] -> "" (outdir:_) -> if last outdir == '/' then outdir else outdir ++ "/" + let includeApiFiles = map (drop 13) (filter ("--includeapi=" `isPrefixOf`) rem) ----------------------------------------------------------------------------- -- Read in the input files @@ -890,12 +1095,20 @@ then getContents -- read stdin else readFile apiFile template <- readFile templateFile + + includeApiFilesContents <- mapM readFile includeApiFiles ----------------------------------------------------------------------------- -- Parse the contents of the xml api file -- let document = Xml.xmlParse apiFile content api = extractAPI document + + -- For example whe processing Gtk we'd like to know about the types + -- included from Gdk and Pango + includeApi = [ extractAPI (Xml.xmlParse apiFile content) + | (apiFile, content) <- zip includeApiFiles includeApiFilesContents] + knownTypes = makeKnownTypesMap (api ++ concat includeApi) ----------------------------------------------------------------------------- -- Read in the documentation xml file if supplied @@ -943,7 +1156,7 @@ ++ "-- CHECKME: extra imports may be required\n" "CONTEXT_LIB" -> ss (if null lib then namespace_library namespace else lib) "CONTEXT_PREFIX" -> ss (if null prefix then namespace_library namespace else prefix) - "MODULE_BODY" -> genModuleBody object moduleDoc + "MODULE_BODY" -> genModuleBody knownTypes object moduleDoc _ -> ss "" ) "" ) [ (namespace, object, lookup (object_cname object) apiDocMap) | namespace <- api @@ -953,11 +1166,12 @@ 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\ + \ApiGen <apiFile> <templateFile>\n\ \ {--doc=<docFile>} {--lib=<lib>} {--prefix=<prefix>}\n\ \ {--outdir=<outDir>} {--modprefix=<modPrefix>}\n\ + \ {--includeapi=<incApiFile>}\n\ \where\n\ - \ <apiFile> an xml api file produced by gapi2xml\n\ + \ <apiFile> an xml api file produced by gapi_parser.pl\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\ @@ -966,7 +1180,9 @@ \ <prefix> set the prefix to use in the c2hs {#context #}\n\ \ declaration (the default is taken from the api file)\n\ \ <modPrefix> specify module name prefix, eg if using\n\ - \ hierarchical module names\n" + \ hierarchical module names\n\ + \ <incApiFile> the api xml file for a parent api, for example Gtk\n\ + \ uses types defined by Gdk and Pango." exitWith $ ExitFailure 1 |
|
From: Duncan C. <dun...@us...> - 2005-01-26 12:05:18
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14670 Modified Files: ChangeLog Log Message: Several marshaling improvements. Extract enums from the api file. Produce a list of objects and enums and use it when deciding how to marshal types. Marshal floats and doubles, flags and enums. Distinguish between GObjects and GtkObjects. Extract documentation of properties. Initial go at producing property definitions. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.328 retrieving revision 1.329 diff -u -d -r1.328 -r1.329 --- ChangeLog 25 Jan 2005 18:19:35 -0000 1.328 +++ ChangeLog 26 Jan 2005 12:05:08 -0000 1.329 @@ -1,3 +1,12 @@ +2005-01-26 Duncan Coutts <du...@co...> + + * tools/apiGen/ApiGen.hs: Several marshaling improvements. Extract + enums from the api file. Produce a list of objects and enums and use + it when deciding how to marshal types. Marshal floats and doubles, + flags and enums. Distinguish between GObjects and GtkObjects. Extract + documentation of properties. Initial go at producing property + definitions. + 2005-01-25 Duncan Coutts <du...@co...> * tools/apiGen/format-docs.xsl: deal with another kind of list and |
2 messages has been excluded from this view by a project administrator.
