Menu
▾
▴
[Gtk2hs-commit] gtk2hs/tools/apiGen ExcludeApi.hs,NONE,1.1 gtk.ignore,NONE,1.1 ApiGen.hs,1.15,1.16 CodeGen.hs,1.4,1.5 FormatDocs.hs,1.2,1.3 Makefile,1.8,1.9 ModuleScan.hs,1.2,1.3 glib-sources.xml,1.1,1.2
|
From: Duncan C. <dun...@us...> - 2005-02-17 13:51:47
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14480/tools/apiGen Modified Files: ApiGen.hs CodeGen.hs FormatDocs.hs Makefile ModuleScan.hs glib-sources.xml Added Files: ExcludeApi.hs gtk.ignore Log Message: Some more doc improvements Add the ability to exclude certain modules when scanning existing modules. This is useful so that we do not confuse some Gtk module with a Gdk or Pango module of the same name. Allow functions specified in a file to not have code generated for them. It uses the same format as the apicoverge tool's api.ignore files. Use this to exclude the *_get_type, *_valist and *_ref / *_unref funtions. Index: ModuleScan.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ModuleScan.hs,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- ModuleScan.hs 10 Feb 2005 02:58:01 -0000 1.2 +++ ModuleScan.hs 17 Feb 2005 13:51:35 -0000 1.3 @@ -50,21 +50,22 @@ main = do [path] <- getArgs - modules <- findModules path + modules <- findModules [] path modInfos <- mapM (\moduleName -> do ppExists <- doesFileExist (moduleName ++ ".chs.pp") if ppExists then scanModule (moduleName ++ ".chs.pp") else scanModule (moduleName ++ ".chs")) modules print modInfos -scanModules :: FilePath -> IO [ModuleInfo] -scanModules path = do - modules <- findModules path +scanModules :: FilePath -> [FilePath] -> IO [ModuleInfo] +scanModules path excludePaths = do + modules <- findModules excludePaths path mapM (\moduleName -> do ppExists <- doesFileExist (moduleName ++ ".chs.pp") if ppExists then scanModule (moduleName ++ ".chs.pp") else scanModule (moduleName ++ ".chs")) modules -findModules :: FilePath -> IO [FilePath] -findModules path = do +findModules :: [FilePath] -> FilePath -> IO [FilePath] +findModules excludePaths path | path `elem` excludePaths = return [] +findModules excludePaths path = do files <- getDirectoryContents path let (chsFiles, maybeDirs) = partition (\file -> ".chs" `isSuffixOf` file || ".chs.pp" `isSuffixOf` file) files @@ -84,7 +85,7 @@ else filterDirs ds mds in filterDirs [] [ path ++ "/" ++ maybeDir | maybeDir <- maybeDirs, maybeDir /= ".", maybeDir /= ".."] - subDirModules <- mapM findModules dirs + subDirModules <- mapM (findModules excludePaths) dirs return $ map ((path++"/")++) modules ++ concat subDirModules scanModule :: FilePath -> IO ModuleInfo Index: CodeGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- CodeGen.hs 15 Feb 2005 19:03:16 -0000 1.4 +++ CodeGen.hs 17 Feb 2005 13:51:34 -0000 1.5 @@ -148,7 +148,7 @@ in (index,(mungeMethod object method, doc, info)) | method <- object_methods object , null [ () | VarArgs <- method_parameters method] --exclude VarArgs methods - , not ("_get_type" `isSuffixOf` method_cname method && method_shared method) +-- , not ("_get_type" `isSuffixOf` method_cname method && method_shared method) , not (method_deprecated method && isNothing (lookup (method_cname method) infomap)) ] where docmap = [ (funcdoc_name doc, (doc,index)) | (doc,index) <- zip docs [1..] ] Index: FormatDocs.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/FormatDocs.hs,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- FormatDocs.hs 14 Feb 2005 02:10:49 -0000 1.2 +++ FormatDocs.hs 17 Feb 2005 13:51:35 -0000 1.3 @@ -24,7 +24,7 @@ import StringUtils import Maybe (isJust) -import Char (toLower, isUpper, isAlpha) +import Char (toLower, isUpper, isAlpha, isSpace) import qualified List (lines) import Data.FiniteMap @@ -137,13 +137,13 @@ haddocFormatSpan _ (DocText text) = escapeHaddockSpecialChars text haddocFormatSpan knownSymbols (DocTypeXRef text) = case lookupFM knownSymbols text of - Nothing -> "{" ++ text ++ ", FIXME: unknown type/value}" - Just (SymObjectType _) -> "\"" ++ stripKnownPrefixes text ++ "\"" - Just (SymEnumType _) -> "'" ++ stripKnownPrefixes text ++ "'" - Just SymEnumValue -> "'" ++ cConstNameToHsName text ++ "'" + Nothing | text == "TRUE" -> "@True@" + | text == "FALSE" -> "@False@" + | otherwise -> "{" ++ text ++ ", FIXME: unknown type/value}" + Just (SymObjectType _) -> "\"" ++ stripKnownPrefixes text ++ "\"" + Just (SymEnumType _) -> "'" ++ stripKnownPrefixes text ++ "'" + Just SymEnumValue -> "'" ++ cConstNameToHsName text ++ "'" _ -> "{" ++ text ++ ", FIXME: unknown type/value}" --TODO fill in the other cases --- | looksLikeConstant text = "'" ++ cConstNameToHsName text ++ "'" --- | otherwise = "\"" ++ stripKnownPrefixes text ++ "\"" haddocFormatSpan _ (DocFuncXRef text) = "'" ++ cFuncNameToHsName text ++ "'" haddocFormatSpan _ (DocOtherXRef text) = "'{FIXME: gtk-doc cross reference to:" ++ text ++ "}'" haddocFormatSpan _ (DocEmphasis text) = "/" ++ text ++ "/" @@ -151,9 +151,13 @@ haddocFormatSpan _ (DocLiteral "FALSE") = "@False@" --likely that something should be changed to a Maybe type if this is emitted: haddocFormatSpan _ (DocLiteral "NULL") = "{@NULL@, FIXME: this should probably be converted" - ++ " to a Maybe data type}" -haddocFormatSpan _ (DocLiteral text) = "@" ++ escapeHaddockSpecialChars text ++ "@" -haddocFormatSpan _ (DocArg text) = "@" ++ cParamNameToHsName text ++ "@" + ++ " to a Maybe data type}" +haddocFormatSpan knownSymbols (DocLiteral text) = + case lookupFM knownSymbols text of + Nothing -> "@" ++ escapeHaddockSpecialChars text ++ "@" + Just SymEnumValue -> "'" ++ cConstNameToHsName text ++ "'" + _ -> "{" ++ text ++ ", FIXME: unknown literal value}" --TODO fill in the other cases +haddocFormatSpan _ (DocArg text) = "@" ++ cParamNameToHsName text ++ "@" cFuncNameToHsName :: String -> String cFuncNameToHsName = @@ -187,7 +191,8 @@ escapeHaddockSpecialChars = escape where escape [] = [] - escape (''':'s':cs) = ''' : 's' : escape cs --often don't need to escape + escape (''':'s':s:cs) | isSpace s = ''' : 's' : ' ' : escape cs --often don't need to escape + escape (''':'t':s:cs) | isSpace s = ''' : 't' : ' ' : escape cs --eg it's & don't escape (c:cs) | c == '/' || c == '`' || c == '"' || c == '@' || c == '<' || c == ''' @@ -195,6 +200,7 @@ escape (c:cs) = c : escape cs mungeWord :: KnownSymbols -> String -> String +mungeWord knownSymbols ('G':'T':'K':[]) = "Gtk+" mungeWord knownSymbols ('G':'T':'K':'+':remainder) = "Gtk+" ++ remainder mungeWord knownSymbols word | word' == "TRUE" = "@True@" ++ remainder @@ -207,28 +213,4 @@ Just SymEnumValue -> "'" ++ cConstNameToHsName word' ++ "'" ++ remainder | otherwise = word where e = lookupFM knownSymbols word' - (word', remainder) = span (\c -> isAlpha c || c == '_') word -{- -mungeWord _ "GTK+" = "Gtk+" -mungeWord _ "GTK+," = "Gtk+," -mungeWord _ "GTK+." = "Gtk+." -mungeWord _ "TRUE" = "@True@" -mungeWord _ "FALSE" = "@False@" -mungeWord _ "TRUE," = "@True@," -mungeWord _ "FALSE," = "@False@," -mungeWord _ "NULL" = "{@NULL@, FIXME: this should probably be converted to a Maybe data type}" -mungeWord knownSymbols word | isJust e = case e of - Just (SymObjectType _) -> "\"" ++ stripKnownPrefixes word' ++ "\"" ++ remainder - Just (SymEnumType _) -> "'" ++ stripKnownPrefixes word' ++ "'" ++ remainder - Just SymEnumValue -> "'" ++ cConstNameToHsName word' ++ "'" ++ remainder - where e = lookupFM knownSymbols word' (word', remainder) = span (\c -> isAlpha c || c == '_') word -mungeWord _ word = word --} - --- eg C constants with names like GTK_UPDATE_DISCONTINUOUS -looksLikeConstant :: String -> Bool -looksLikeConstant ('G':'T':'K':'_':rest) = all (\c -> isUpper c || c == '_') rest -looksLikeConstant ('G':'D':'K':'_':rest) = all (\c -> isUpper c || c == '_') rest -looksLikeConstant ('P':'A':'N':'G':'O':'_':rest) = all (\c -> isUpper c || c == '_') rest -looksLikeConstant _ = False --- NEW FILE: gtk.ignore --- # all functions matching these regexps are ignored when generating modules always exclude _get_type$ always exclude _valist$ #these are sometimes bound if necessary but otherwise we can ignore them exclude _ref$ exclude _unref$ --- NEW FILE: ExcludeApi.hs --- module ExcludeApi ( parseFilterFile, matcher ) where import Char (isSpace) import Maybe (catMaybes, isJust) import List (isPrefixOf, intersperse) import System (getArgs) import Text.Regex data FilterSpec = Exclude String | NotExclude String -- override Exclude but not AlwaysExclude | AlwaysExclude String parseFilterFile :: String -> [FilterSpec] parseFilterFile = catMaybes . map parseLine . lines where parseLine [] = Nothing parseLine ('#':_) = Nothing parseLine line | "exclude " `isPrefixOf` line = Just $ Exclude $ trim $ drop 8 line | "do not exclude " `isPrefixOf` line = Just $ NotExclude $ trim $ drop 15 line | "always exclude " `isPrefixOf` line = Just $ AlwaysExclude $ trim $ drop 15 line parseLine line = error $ "cannot parse line: " ++ line trim = takeWhile (not . isSpace) . dropWhile isSpace matcher :: [FilterSpec] -> (String -> Bool) matcher spec = match where excludeRegex = mkRegex $ concat $ intersperse "|" [ regex | Exclude regex <- spec ] noExcludeRegex = mkRegex $ concat $ intersperse "|" [ regex | NotExclude regex <- spec ] alwaysExcludeRegex = mkRegex $ concat $ intersperse "|" [ regex | AlwaysExclude regex <- spec ] match line = not $ ((isJust $ matchRegex excludeRegex line) && (not $ isJust $ matchRegex noExcludeRegex line)) || (isJust $ matchRegex alwaysExcludeRegex line) Index: glib-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/glib-sources.xml,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- glib-sources.xml 14 Feb 2005 02:10:49 -0000 1.1 +++ glib-sources.xml 17 Feb 2005 13:51:35 -0000 1.2 @@ -2,14 +2,14 @@ <api filename="glib-api.xml"> <library name="gobject"> <namespace name="GObject"> - <dir>glib-2.4.8/gobject</dir> + <dir>glib/gobject</dir> <!-- exclude programs --> - <exclude>glib-2.4.8/gobject/glib-genmarshal.c</exclude> - <exclude>glib-2.4.8/gobject/gobject-query.c</exclude> - <exclude>glib-2.4.8/gobject/stamp-gmarshal.h</exclude> - <exclude>glib-2.4.8/gobject/testgobject.c</exclude> + <exclude>glib/gobject/glib-genmarshal.c</exclude> + <exclude>glib/gobject/gobject-query.c</exclude> + <exclude>glib/gobject/stamp-gmarshal.h</exclude> + <exclude>glib/gobject/testgobject.c</exclude> <!-- this file causes the gapi parser to go into a infinite loop --> - <exclude>glib-2.4.8/gobject/gvalue.h</exclude> + <exclude>glib/gobject/gvalue.h</exclude> </namespace> </library> </api> Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- ApiGen.hs 14 Feb 2005 02:10:48 -0000 1.15 +++ ApiGen.hs 17 Feb 2005 13:51:34 -0000 1.16 @@ -13,6 +13,7 @@ import CodeGen import StringUtils (ss, templateSubstitute, splitOn) import ModuleScan +import ExcludeApi import Monad (when, liftM) import List (isPrefixOf, intersperse) @@ -35,25 +36,27 @@ -- Parse command line parameters -- let (apiFile: templateFile: rem) = args - let docFile = case map (drop 6) (filter ("--doc=" `isPrefixOf`) rem) of + docFile = case map (drop 6) (filter ("--doc=" `isPrefixOf`) rem) of [] -> "" (docFile:_) -> docFile - let lib = case map (drop 6) (filter ("--lib=" `isPrefixOf`) rem) of + lib = case map (drop 6) (filter ("--lib=" `isPrefixOf`) rem) of [] -> "" (lib:_) -> lib - let prefix = case map (drop 9) (filter ("--prefix=" `isPrefixOf`) rem) of + prefix = case map (drop 9) (filter ("--prefix=" `isPrefixOf`) rem) of [] -> "" (prefix:_) -> prefix - let modPrefix = case map (drop 12) (filter ("--modprefix=" `isPrefixOf`) rem) of + modPrefix = case map (drop 12) (filter ("--modprefix=" `isPrefixOf`) rem) of [] -> "" (modPrefix:_) -> modPrefix - let outdir = case map (drop 9) (filter ("--outdir=" `isPrefixOf`) rem) of + 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) - let moduleRoot = case map (drop 14) (filter ("--scanmodules=" `isPrefixOf`) rem) of + includeApiFiles = map (drop 13) (filter ("--includeapi=" `isPrefixOf`) rem) + excludeApiFiles = map (drop 13) (filter ("--excludeapi=" `isPrefixOf`) rem) + moduleRoot = case map (drop 14) (filter ("--scanmodules=" `isPrefixOf`) rem) of [] -> "" (moduleRoot:_) -> moduleRoot + excludePaths = map (drop 14) (filter ("--excludescan=" `isPrefixOf`) rem) ----------------------------------------------------------------------------- -- Read in the input files @@ -92,11 +95,20 @@ -- modulesInfo <- if null moduleRoot then return [] - else scanModules moduleRoot + else scanModules moduleRoot excludePaths let moduleInfoMap = [ (module_name moduleInfo, moduleInfo) | moduleInfo <- modulesInfo ] ----------------------------------------------------------------------------- + -- Load up any api.exclude files supplied to filter out unwanted APIs + -- + excludeApiFilesContents <- mapM readFile excludeApiFiles + let filterSpecs = map parseFilterFile excludeApiFilesContents + okAPI :: String -> Bool --returns False to exclude the C function name + okAPI | null (concat filterSpecs) = const True + | otherwise = matcher (concat filterSpecs) + + ----------------------------------------------------------------------------- -- A few values that are used in the template -- time <- System.Time.getClockTime @@ -110,7 +122,12 @@ -- Write the result file(s) by substituting values into the template file -- mapM - (\(namespace, object, maybeModuleDoc, maybeModuleInfo) -> do + (\(namespace, object', maybeModuleDoc, maybeModuleInfo) -> do + let object = object' { + object_methods = [ method + | method <- object_methods object' + , okAPI (method_cname method) ] + } moduleDoc <- case maybeModuleDoc of Nothing -> do when (not (null apiDoc)) $ putStrLn ("Warning: no documentation found for module " @@ -175,7 +192,8 @@ \ApiGen <apiFile> <templateFile>\n\ \ {--doc=<docFile>} {--lib=<lib>} {--prefix=<prefix>}\n\ \ {--outdir=<outDir>} {--modprefix=<modPrefix>}\n\ - \ {--includeapi=<incApiFile>} {--scanmodules=<modulesRoot>}\n\ + \ {--includeapi=<incApiFile>} {--excludeapi=<exclApiFile>}\n\ + \ {--scanmodules=<modulesRoot>} {--excludescan=<excludePath>}\n\ \where\n\ \ <apiFile> an xml api file produced by gapi_parser.pl\n\ \ <templateFile> is the name and path of the output template file\n\ @@ -189,7 +207,12 @@ \ hierarchical module names\n\ \ <incApiFile> the api xml file for a parent api, for example Gtk\n\ \ uses types defined by Gdk and Pango.\n\ - \ <modulesRoot> the path to the existing modules.\n" + \ <exclApiFile> an 'api.ignore' file of regexps which can be used\n\ + \ to stop specific API bindings being generated.\n\ + \ <modulesRoot> the path to the existing modules.\n\ + \ <excludePath> path to existing modules that you do not want to\n\ + \ have scanned, perhaps because they are from a\n\ + \ different library than the one being generated.\n" exitWith $ ExitFailure 1 formatCopyrightDates :: String -> Either String (String, String) -> String Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- Makefile 17 Feb 2005 00:13:21 -0000 1.8 +++ Makefile 17 Feb 2005 13:51:35 -0000 1.9 @@ -33,6 +33,7 @@ ATK_VERSION = 1.6.1 GTK_VERSION = 2.4.14 GLADE_VERSION = 2.0.1 +CANVAS_VERSION = 2.4.0 DOWNLOADS = \ ftp://ftp.gtk.org/pub/gtk/v2.4/glib-$(GLIB_VERSION).tar.bz2 \ @@ -40,7 +41,7 @@ ftp://ftp.gtk.org/pub/gtk/v2.4/atk-$(ATK_VERSION).tar.bz2 \ ftp://ftp.gtk.org/pub/gtk/v2.4/gtk+-$(GTK_VERSION).tar.bz2 \ http://ftp.gnome.org/pub/GNOME/desktop/2.4/2.4.2/sources/libglade-$(GLADE_VERSION).tar.bz2\ - http://ftp.gnome.org/pub/GNOME/desktop/2.4/2.4.2/sources/libgnomecanvas-2.4.0.tar.bz2 + http://ftp.gnome.org/pub/GNOME/desktop/2.4/2.4.2/sources/libgnomecanvas-$(CANVAS_VERSION).tar.bz2 get-source-code: for i in $(DOWNLOADS); do \ @@ -82,8 +83,11 @@ ./ApiGen $< Template.chs --doc=gtk-docs.xml --outdir=$@ \ --includeapi=gdk-api.xml --includeapi=pango-api.xml \ --includeapi=atk-api.xml --includeapi=glib-api.xml \ + --excludeapi=gtk.ignore \ --modprefix=Graphics.UI.Gtk.{-Category-} \ - --scanmodules=../../gtk/Graphics/UI/Gtk + --scanmodules=../../gtk/Graphics/UI/Gtk \ + --excludescan=../../gtk/Graphics/UI/Gtk/Pango \ + --excludescan=../../gtk/Graphics/UI/Gtk/Gdk ################### @@ -145,3 +149,12 @@ gapi_format_xml : formatXml.c gcc `pkg-config --cflags --libs libxml-2.0 glib-2.0` $< -o $@ + +######################## +# +# other stuff +# +clean : + rm *.o *.hi ApiGen gapi_format_xml + rm *-api.xml *-docs.xml + |
