gtk2hs-commit — Mailing list for Darcs commit messages.

[Gtk2hs-commit] gtk2hs ChangeLog,1.341,1.342 configure.ac,1.27,1.28

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10139

Modified Files:
	ChangeLog configure.ac 
Log Message:
More win32 build fixes. It now works ok for me so bump to 0.9.7.1_rc1

mk/common.mk: Add $(EXEEXT) when trying to build c2hsLocal
set HSTOOLFLAGS = -H350m -M400m for the release so more people can build ok.
On windows we require more meory for some reason so set
HSTOOLFLAGS = -H400m -M650m

configure.ac: Add $(EXEEXT) to C2HS name.
Do define WIN32 afterall since ghc does not define it (though gcc does).

Bumb the version to 0.9.7.1_rc1


Index: configure.ac
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/configure.ac,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- configure.ac	7 Feb 2005 00:04:27 -0000	1.27
+++ configure.ac	7 Feb 2005 15:39:48 -0000	1.28
@@ -21,7 +21,7 @@
 dnl Process this file with autoconf to produce a configure script.
 dnl ######################################################################
 
-AC_INIT(gtk2hs, 0.9.8_pre)
+AC_INIT(gtk2hs, 0.9.7.1_rc1)
 AM_INIT_AUTOMAKE
 
 dnl * We require autoconf version 2.50
@@ -116,6 +116,9 @@
   CREATE_TYPES=default;
 fi;
 
+if test "$WIN32" = "yes"; then
+  AC_DEFINE(WIN32, [], [Are we building on a Win32 system])
+fi
 AM_CONDITIONAL(WIN32, test "$WIN32" = "yes")
 
 dnl determine a temporary directory for c2hs
@@ -552,7 +555,7 @@
 if test $BUILT_IN_C2HS = yes; then
   AC_MSG_RESULT([built-in])
   dnl Use the local c2hs.
-  C2HS='$(TOP)/tools/c2hs/c2hsLocal';
+  C2HS='$(TOP)/tools/c2hs/c2hsLocal$(EXEEXT)';
 
   dnl These are the settings needed to compile c2hs.
   LEGACY_FFI=no;

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.341
retrieving revision 1.342
diff -u -d -r1.341 -r1.342
--- ChangeLog	7 Feb 2005 00:38:01 -0000	1.341
+++ ChangeLog	7 Feb 2005 15:39:47 -0000	1.342
@@ -14,6 +14,15 @@
 
 	* tools/apiGen/StringUtils.hs: add extra utility function.
 
+	* mk/common.mk: Add $(EXEEXT) when trying to build c2hsLocal. Set
+	HSTOOLFLAGS = -H350m -M400m for the release so more people can build
+	ok. On windows we need more memory for some reaons so set
+	HSTOOLFLAGS = -H400m -M650m 
+
+	* configure.ac: Add $(EXEEXT) to C2HS name. Do define WIN32 afterall
+	since ghc does not define it (though gcc does so it'll give a warning)
+	Bumb the version to 0.9.7.1_rc1
+
 2005-02-06 Duncan Coutts <du...@co...>
 
 	* configure.ac: win32 fixes. Do not define WIN32 on windows since it

[Gtk2hs-commit] gtk2hs/mk common.mk,1.54,1.55

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/mk
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10139/mk

Modified Files:
	common.mk 
Log Message:
More win32 build fixes. It now works ok for me so bump to 0.9.7.1_rc1

mk/common.mk: Add $(EXEEXT) when trying to build c2hsLocal
set HSTOOLFLAGS = -H350m -M400m for the release so more people can build ok.
On windows we require more meory for some reason so set
HSTOOLFLAGS = -H400m -M650m

configure.ac: Add $(EXEEXT) to C2HS name.
Do define WIN32 afterall since ghc does not define it (though gcc does).

Bumb the version to 0.9.7.1_rc1


Index: common.mk
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/mk/common.mk,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -d -r1.54 -r1.55
--- common.mk	23 Jan 2005 15:44:31 -0000	1.54
+++ common.mk	7 Feb 2005 15:39:49 -0000	1.55
@@ -27,7 +27,7 @@
 
 LINK = 	$(strip $(HC) -o $@ $(HCFLAGS) $($(PKG)_HCFLAGS) \
 	$(addprefix -package ,$($(PKG)_PACKAGEDEPS)) \
-	$(AM_LDFLAGS) $($(PKG)_LDFLAGS))
+	$(AM_LDFLAGS) $(LDFLAGS) $($(PKG)_LDFLAGS))
 
 #Using pattern rule here to prevent automake from understanding the rule
 #and falsely concluding that two source files will produce the same object
@@ -87,7 +87,13 @@
 # Same for .chi
 .PRECIOUS: %.chi
 
+if WIN32
+#It seems to take considerably more memory on win32. Not sure why.
 HSTOOLFLAGS = -H400m -M650m
+else
+#change this to -H350m -M400m for a release so more people can build ok
+HSTOOLFLAGS = -H350m -M400m
+endif
 
 .PHONY: debug
 debug	:
@@ -124,7 +130,7 @@
 	$(if $(subst no,,$(BUILT_IN_C2HS)),$(strip \
 	if test -x $(C2HS); then :; else \
 	  $(MAKE) $(AM_MAKEFLAGS) \
-	  tools/c2hs/c2hsLocal; fi;))
+	  tools/c2hs/c2hsLocal$(EXEEXT); fi;))
 	$(strip if test -f $($(PKG)_PRECOMP); then :; else \
 	  $(MAKE) $(AM_MAKEFLAGS) $($(PKG)_PRECOMP); fi;)
 	$(strip $(C2HS) $(C2HS_FLAGS) \

[Gtk2hs-commit] gtk2hs/tools/apiGen ModuleScan.hs,NONE,1.1 ApiGen.hs,1.12,1.13 Template.chs,1.5,1.6 Makefile,1.5,1.6 StringUtils.hs,1.1,1.2

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29496/tools/apiGen

Modified Files:
	ApiGen.hs Template.chs Makefile StringUtils.hs 
Added Files:
	ModuleScan.hs 
Log Message:
ModuleScan.hs: New module that scans the existing module source files to pick
out useful information so that we can use that information to improve the
generated modules. In particular it extracts module information like authors,
copyrights, dates, module imports and whether each C call is safe or unsafe.

ApiGen.hs: take advantage of the new ModuleScan information in the various
module headder fields. Add a new --scanmodules flag.

Template.chs: add author and copyright variable.

Makefile: use the new --scanmodules feature.

StringUtils.hs: add extra utility function.


Index: Template.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Template.chs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Template.chs	24 Jan 2005 01:39:28 -0000	1.5
+++ Template.chs	7 Feb 2005 00:38:02 -0000	1.6
@@ -1,11 +1,11 @@
 -- -*-haskell-*-
 --  GIMP Toolkit (GTK) Widget @OBJECT_NAME@
 --
---  Author : [Insert your full name here]
+--  Author : @AUTHORS@
 --
 --  Created: @DATE@
 --
---  Copyright (C) @YEAR@ [Insert your full name here]
+--  Copyright (C) @YEAR@ @COPYRIGHT@
 --
 --  This library is free software; you can redistribute it and/or
 --  modify it under the terms of the GNU Lesser General Public

Index: StringUtils.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/StringUtils.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- StringUtils.hs	5 Feb 2005 02:57:40 -0000	1.1
+++ StringUtils.hs	7 Feb 2005 00:38:02 -0000	1.2
@@ -2,6 +2,7 @@
 
 import Prelude hiding (lines)
 import Char   (toLower, toUpper, isSpace, isAlpha, isAlphaNum, isUpper)
+import List   (unfoldr)
 
 -------------------------------------------------------------------------------
 -- Helper functions
@@ -66,3 +67,10 @@
         wrap col line (word:words) = wrap (col + length word + 1) (word:line) words
         wrap _ []   [] = []
         wrap _ line [] = [reverse line]
+
+splitOn :: Eq a => a -> [a] -> [[a]]
+splitOn sep = 
+  unfoldr (\s -> case break (sep==) s of
+                   ([],_) -> Nothing
+                   (w,_:r) -> Just (w,r)
+                   (w,[]) -> Just (w,[]))

Index: Makefile
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Makefile	5 Feb 2005 03:02:06 -0000	1.5
+++ Makefile	7 Feb 2005 00:38:02 -0000	1.6
@@ -76,8 +76,10 @@
 		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 \
-	--modprefix=Graphics.UI.Gtk.{-Category-}
+	--includeapi=gdk-api.xml --includeapi=pango-api.xml \
+	--includeapi=atk-api.xml \
+	--modprefix=Graphics.UI.Gtk.{-Category-} \
+	--scanmodules=../../gtk/Graphics/UI/Gtk
 
 
 ###################
@@ -132,7 +134,7 @@
 #	tools
 #
 ApiGen : ApiGen.hs Api.hs Docs.hs FormatDocs.hs \
-	Marshal.hs CodeGen.hs StringUtils.hs 
+	Marshal.hs CodeGen.hs StringUtils.hs ModuleScan.hs
 	ghc --make $< -o $@
 
 gapi_format_xml : formatXml.c

Index: ApiGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- ApiGen.hs	5 Feb 2005 03:01:01 -0000	1.12
+++ ApiGen.hs	7 Feb 2005 00:38:02 -0000	1.13
@@ -11,11 +11,13 @@
 import Docs
 import FormatDocs
 import CodeGen
-import StringUtils (ss, templateSubstitute)
+import StringUtils (ss, templateSubstitute, splitOn)
+import ModuleScan
 
 import Monad  (when)
-import List   (isPrefixOf)
+import List   (isPrefixOf, intersperse)
 import System (getArgs, exitWith, ExitCode(..))
+import Directory (doesDirectoryExist, createDirectory)
 
 import qualified Text.XML.HaXml.Parse as Xml
 
@@ -44,11 +46,14 @@
                  (prefix:_) -> prefix
   let modPrefix = case map (drop 12) (filter ("--modprefix=" `isPrefixOf`)  rem) of
                     [] -> ""
-		    (modPrefix:_) -> modPrefix ++ "."
+		    (modPrefix:_) -> modPrefix
   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)
+  let moduleRoot = case map (drop 14) (filter ("--scanmodules=" `isPrefixOf`)  rem) of
+                     [] -> ""
+                     (moduleRoot:_) -> moduleRoot
 
   -----------------------------------------------------------------------------
   -- Read in the input files
@@ -83,6 +88,15 @@
                ++ [ (moduledoc_altname moduleDoc, moduleDoc) | moduleDoc <- apiDoc ]
 
   -----------------------------------------------------------------------------
+  -- Scan the existing modules if their root path is supplied
+  --
+  modulesInfo <- if null moduleRoot
+                   then return []
+                   else scanModules moduleRoot
+  let moduleInfoMap = [ (module_name moduleInfo, moduleInfo)
+                      | moduleInfo <- modulesInfo ]
+
+  -----------------------------------------------------------------------------
   -- A few values that are used in the template
   --
   time <- System.Time.getClockTime
@@ -96,31 +110,58 @@
   -- Write the result file(s) by substituting values into the template file
   --
   mapM 
-    (\(namespace, object, maybeModuleDoc) -> do
+    (\(namespace, object, maybeModuleDoc, maybeModuleInfo) -> do
       moduleDoc <- case maybeModuleDoc of
                      Nothing -> do when (not (null apiDoc)) $
 		                     putStrLn ("Warning: no documentation found for module "
 			                    ++ show (object_name object))
 			           return noModuleDoc
 		     Just moduleDoc -> return $ addVersionParagraphs namespace moduleDoc
-      writeFile (outdir ++ object_name object ++ ".chs") $
+      moduleInfo <-
+            case maybeModuleInfo of
+              Just moduleInfo -> do mkDirHier outdir (splitOn '.' (module_prefix moduleInfo))
+                                    return moduleInfo
+              Nothing -> do
+                when (not (null moduleRoot)) $
+                  putStrLn ("Warning: no existing module found for module "
+	                  ++ show (object_name object))
+                return ModuleInfo {
+                    module_name              = object_name object,
+                    module_prefix            = modPrefix,
+                    module_needspreproc      = False,
+                    module_filename          = object_name object ++ ".chs",
+                    module_authors           = ["[Insert your full name here]"],
+                    module_created           = date,
+                    module_copyright_dates   = Left year,
+                    module_copyright_holders = ["[Insert your full name here]"],
+                    module_imports           = [],
+                    module_context_lib       = if null lib then namespace_library namespace else lib,
+                    module_context_prefix    = if null prefix then namespace_library namespace else prefix,
+                    module_methods           = []
+                  }
+      writeFile (outdir ++ module_filename moduleInfo) $
         templateSubstitute template (\var ->
           case var of
-	    "YEAR"           -> ss year
-	    "DATE"           -> ss date
-	    "OBJECT_NAME"    -> ss (object_name object)
-	    "DESCRIPTION"    -> ss (moduledoc_summary moduleDoc)
+	    "YEAR"           -> ss $ formatCopyrightDates year (module_copyright_dates moduleInfo)
+	    "DATE"           -> ss $ module_created moduleInfo
+	    "OBJECT_NAME"    -> ss $ module_name moduleInfo
+	    "AUTHORS"        -> ss $ concat $ intersperse ", " $ module_authors moduleInfo
+            "COPYRIGHT"      -> ss $ concat $ intersperse ", " $ module_copyright_holders moduleInfo
+            "DESCRIPTION"    -> ss (moduledoc_summary moduleDoc)
 	    "DOCUMENTATION"  -> genModuleDocumentation moduleDoc
 	    "TODO"           -> genTodoItems object
-	    "MODULE_NAME"    -> ss (modPrefix ++ object_name object)
+	    "MODULE_NAME"    -> ss $ module_prefix moduleInfo ++ "." ++ module_name moduleInfo
 	    "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)
-	    "CONTEXT_PREFIX" -> ss (if null prefix then namespace_library namespace else  prefix)
+	    "CONTEXT_LIB"    -> ss $ module_context_lib moduleInfo
+	    "CONTEXT_PREFIX" -> ss $ module_context_prefix  moduleInfo
 	    "MODULE_BODY"    -> genModuleBody knownTypes object moduleDoc
 	    _ -> ss "" ) ""
-    ) [ (namespace, object, lookup (object_cname object) apiDocMap)
+    ) [ (namespace
+        ,object
+        ,lookup (object_cname object) apiDocMap
+        ,lookup (object_name object) moduleInfoMap)
       | namespace <- api
       , object <- namespace_objects namespace ]
     
@@ -131,7 +172,7 @@
 	\ApiGen <apiFile> <templateFile>\n\
 	\         {--doc=<docFile>} {--lib=<lib>} {--prefix=<prefix>}\n\
 	\         {--outdir=<outDir>} {--modprefix=<modPrefix>}\n\
-	\         {--includeapi=<incApiFile>}\n\
+	\         {--includeapi=<incApiFile>} {--scanmodules=<modulesRoot>}\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\
@@ -144,5 +185,20 @@
 	\  <modPrefix>     specify module name prefix, eg if using\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.\n"
+	\                  uses types defined by Gdk and Pango.\n\
+        \  <modulesRoot>   the path to the existing modules.\n"
   exitWith $ ExitFailure 1
+
+formatCopyrightDates :: String -> Either String (String, String) -> String
+formatCopyrightDates currentYear (Left year) | year == currentYear = year
+                                             | otherwise = year ++ "-" ++ currentYear
+formatCopyrightDates currentYear (Right (from, to)) = from ++ "-" ++ currentYear
+
+mkDirHier :: String -> [String] -> IO ()
+mkDirHier base [] = return ()
+mkDirHier base (dir:dirs) = do
+  let dirPath = base ++ "/" ++ dir
+  exists <- doesDirectoryExist dirPath
+  when (not exists) $
+    createDirectory dirPath
+  mkDirHier dirPath dirs

--- NEW FILE: ModuleScan.hs ---
{-# OPTIONS -fglasgow-exts #-}

module ModuleScan (
  ModuleInfo(..),
  ModuleMethodInfo(..),
  scanModules
  ) where

import StringUtils (splitOn)

import Char (isSpace, isAlpha)
import List (intersperse, partition, isSuffixOf, group, sort)
import Prelude hiding (unwords)

import System (getArgs)
import Directory (getDirectoryContents, doesDirectoryExist, doesFileExist)

data ModuleInfo = ModuleInfo {
    module_name              :: String,
    module_prefix            :: String,
    module_needspreproc      :: Bool,
    module_filename          :: String,
    module_authors           :: [String],
    module_created           :: String,
    module_copyright_dates   :: Either String (String, String),
                                -- eg "2004" or "2004-2005"
    module_copyright_holders :: [String],
    module_imports           :: [(String, String)], -- mod name and the whole line
    module_context_lib       :: String,
    module_context_prefix    :: String,
    module_methods           :: [ModuleMethodInfo]
  } deriving Show

data ModuleMethodInfo = ModuleMethodInfo {
    module_method_cname :: String,
    module_method_unsafe :: Bool
  } deriving Show

data Line = None
          | Authors [String]
          | Created String
          | Copyright (Either String (String, String)) [String]
          | Module String String
          | Import String String
          | Context String String
          | CCall ModuleMethodInfo

usefulLine None = False
usefulLine _    = True

main = do
  [path] <- getArgs
  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
  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
  files <- getDirectoryContents path
  let (chsFiles, maybeDirs) = partition (\file -> ".chs" `isSuffixOf` file
                                            || ".chs.pp" `isSuffixOf` file) files
      modules = map head
              . group
              . sort
              . map extractModule
              $ chsFiles
      extractModule [] = []
      extractModule ('.':'c':'h':'s':[]) = []
      extractModule ('.':'c':'h':'s':'.':'p':'p':[]) = []
      extractModule (c:cs) = c : extractModule cs
  dirs <- let filterDirs ds [] = return (reverse ds)
              filterDirs ds (md:mds) = do
                isDir <- doesDirectoryExist md
                if isDir then filterDirs (md:ds) mds
                         else filterDirs     ds  mds
           in filterDirs [] [ path ++ "/" ++ maybeDir
                            | maybeDir <- maybeDirs, maybeDir /= ".", maybeDir /= ".."]
  subDirModules <- mapM findModules dirs
  return $ map ((path++"/")++) modules ++ concat subDirModules

scanModule :: FilePath -> IO ModuleInfo
scanModule file = do
  content <- readFile file
  let moduleInfo = scanModuleContent content file
  return moduleInfo {
      module_filename = moduleNameToFileName (module_name moduleInfo)
                                             (module_prefix moduleInfo)
                                             (module_needspreproc moduleInfo)
    }

scanModuleContent :: String -> String -> ModuleInfo
scanModuleContent content filename =
  let usefulLines = filter usefulLine [ scanLine line (tokenise line) | line <- lines content ] in
  ModuleInfo {
    module_name              = head $ [ name    | Module name prefix  <- usefulLines ] ++ [missing],
    module_prefix            = head $ [ prefix  | Module name prefix  <- usefulLines ] ++ [missing],
    module_needspreproc      = ".chs.pp" `isSuffixOf` filename,
    module_filename          = "",
    module_authors           = head $ [ authors | Authors authors     <- usefulLines ] ++ [[missing]],
    module_created           = head $ [ created | Created created     <- usefulLines ] ++ [missing],
    module_copyright_dates   = head $ [ dates   | Copyright dates _   <- usefulLines ] ++ [Left missing],
    module_copyright_holders = head $ [ authors | Copyright _ authors <- usefulLines ] ++ [[missing]],
    module_imports           = [ (name, line)   | Import name line    <- usefulLines ],
    module_context_lib       = head $ [ lib     | Context lib prefix  <- usefulLines ] ++ [missing],
    module_context_prefix    = head $ [ prefix  | Context lib prefix  <- usefulLines ] ++ [missing],
    module_methods           =        [ call    | CCall call  <- usefulLines ]
  }
  where missing = "{-missing-}"

moduleNameToFileName :: String -> String -> Bool -> String
moduleNameToFileName name prefix preproc  = map dotToSlash prefix ++ "/" ++ name
                                         ++ if preproc then ".chs.pp" else ".chs"
  where dotToSlash '.' = '/'
        dotToSlash  c  =  c

scanLine :: String -> [String] -> Line
scanLine _ ("--":"Author":":":author)   = scanAuthor author
scanLine _ ("--":"Created:":created)    = Created (unwords created)
scanLine _ ("--":"Copyright":"(":c:")":copyright) = scanCopyright copyright
scanLine _ ("module":moduleName)        = scanModuleName moduleName
scanLine _ ("{#":"context":context)     = scanContext context
scanLine line ("import":moduleName)      = scanImport line moduleName
scanLine line ("{#":"import":moduleName) = scanImport line moduleName
scanLine _ tokens | "{#" `elem` tokens  = scanCCall tokens

scanLine _ _ = None

scanAuthor :: [String] -> Line
scanAuthor = 
    Authors
  . map unwords
  . splitOn ","

scanCopyright :: [String] -> Line
scanCopyright (from:"..":to:name)         = Copyright (Right (from, to)) (map unwords $ splitOn "," name)
scanCopyright (from:"-":to:name)          = Copyright (Right (from, to)) (map unwords $ splitOn "," name)
scanCopyright ("[":from:"..":to:"]":name) = Copyright (Right (from, to)) (map unwords $ splitOn "," name)
scanCopyright (year:name)                 = Copyright (Left year)        (map unwords $ splitOn "," name)
scanCopyright line = error $ "scanCopyright: " ++ show line

scanModuleName :: [String] -> Line
scanModuleName line | ("(":moduleName:".":modulePrefix) <- reverse line =
  Module moduleName (concat (reverse modulePrefix))
scanModuleName line | ("where":")":_:"(":moduleName:".":modulePrefix) <- reverse line =
  Module moduleName (concat (reverse modulePrefix))
scanModuleName ("Graphics":".":"UI":".":"Gtk":".":"Gdk":".":"Enums":[]) = None
scanModuleName line = error $ "scanModuleName: " ++ show line

scanContext :: [String] -> Line
scanContext ("lib":"=\"":lib:"\"":"prefix":"=\"":prefix:"\"":"#}":[]) = Context lib prefix
scanContext ("lib":"=\"":lib:"\"":"prefix":"=\"":prefix:"\"#}":[])    = Context lib prefix
scanContext ("prefix":"=\"":prefix:"\"":"#}":[])                         = Context "" prefix
scanContext line = error $ "scanContext: " ++ show line

scanImport :: String -> [String] -> Line
scanImport line tokens = Import (concat $ takeWhile (\token -> isWord token || token == ".") tokens) line
  where isWord = all isAlpha

scanCCall :: [String] -> Line
scanCCall tokens =
  case takeWhile (\t -> t/="#}" && t/="#}."&& t/="#})") . tail . dropWhile (/="{#") $ tokens of
    ("call":"unsafe":cname:[]) -> CCall ModuleMethodInfo { module_method_cname = cname,
                                                           module_method_unsafe = True }
    ("call":         cname:[]) -> CCall ModuleMethodInfo { module_method_cname = cname,
                                                           module_method_unsafe = True }
    ("call":"fun":"unsafe":cname:[]) -> CCall ModuleMethodInfo { module_method_cname = cname,
                                                                 module_method_unsafe = True }
    ("fun":"pure":_)           -> None
    ("type":_)                 -> None
    ("pointer":_)              -> None
    ("pointer*":_)             -> None
    ("enum":_)                 -> None
    ("get":_)                  -> None
    ("sizeof":_)                  -> None
    tokens -> error $ "scanCCall: " ++ show tokens

tokenise :: String -> [String]
tokenise s = case dropWhile isSpace s of
               "" -> []
               s' -> case span isBoundary s' of
                       ("", s'') -> case break isSpaceOrBoundary s'' of
                                     (w,s''') -> w : tokenise s'''
                       (w, s'') -> w : tokenise s''
  where isBoundary c = c `elem` ".,[]{}#()-=\""
        isSpaceOrBoundary c = isSpace c || isBoundary c

unwords   :: [String] -> String
unwords []       =  ""
unwords [w]      = w
unwords (w:".":ws) = w ++ ". " ++ unwords ws
unwords (w:ws)   = w ++ ' ' : unwords ws

[Gtk2hs-commit] gtk2hs ChangeLog,1.340,1.341

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29496

Modified Files:
	ChangeLog 
Log Message:
ModuleScan.hs: New module that scans the existing module source files to pick
out useful information so that we can use that information to improve the
generated modules. In particular it extracts module information like authors,
copyrights, dates, module imports and whether each C call is safe or unsafe.

ApiGen.hs: take advantage of the new ModuleScan information in the various
module headder fields. Add a new --scanmodules flag.

Template.chs: add author and copyright variable.

Makefile: use the new --scanmodules feature.

StringUtils.hs: add extra utility function.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.340
retrieving revision 1.341
diff -u -d -r1.340 -r1.341
--- ChangeLog	7 Feb 2005 00:04:26 -0000	1.340
+++ ChangeLog	7 Feb 2005 00:38:01 -0000	1.341
@@ -1,3 +1,19 @@
+2005-02-07 Duncan Coutts <du...@co...>
+
+	* tools/apiGen/ModuleScan.hs: new module that scans the existing
+	module source files to pick out useful information so that we can
+	use that information to improve the generated modules.
+
+	* tools/apiGen/ApiGen.hs: take advantage of the new ModuleScan
+	information in the various module headder fields. Add a new
+	--scanmodules flag.
+
+	* tools/apiGen/Template.chs: add author and copyright variable.
+
+	* tools/apiGen/Makefile: use the new --scanmodules feature.
+
+	* tools/apiGen/StringUtils.hs: add extra utility function.
+
 2005-02-06 Duncan Coutts <du...@co...>
 
 	* configure.ac: win32 fixes. Do not define WIN32 on windows since it

[Gtk2hs-commit] gtk2hs ChangeLog,1.339,1.340 configure.ac,1.26,1.27 Makefile.am,1.45,1.46

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21618

Modified Files:
	ChangeLog configure.ac Makefile.am 
Log Message:
Various win32 fixes.

configure.ac: Do not define WIN32 on windows since it is already defined on
that platform.
Define a conditional so that Makefile.am can conditonally compile a few modules.
We no longer need to pass -fnative-struct to gcc on windows.

Makefile.am: Add $(EXEEXT) in a few places to so names of dependencies are
correct on windows.
Only compile the plug and socket modules on non-win32 platforms.

C2HSConfig.hs.in: comment out the @TMPDIR@ substitution since it causes
problems in windows and is not used anyway.

CParser.hs: make c2hs accept __attribute__'s on declerations of functions
returning pointer types. This is needed for some mingw header file (float.h).


Index: configure.ac
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/configure.ac,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- configure.ac	24 Jan 2005 16:06:18 -0000	1.26
+++ configure.ac	7 Feb 2005 00:04:27 -0000	1.27
@@ -21,7 +21,7 @@
 dnl Process this file with autoconf to produce a configure script.
 dnl ######################################################################
 
-AC_INIT(gtk2hs, 0.9.7)
+AC_INIT(gtk2hs, 0.9.8_pre)
 AM_INIT_AUTOMAKE
 
 dnl * We require autoconf version 2.50
@@ -108,7 +108,7 @@
     *mingw32* ) PATHSED=["s+/\([a-z]\)/+\1:/+"];;
     * ) PATHSED=["\#"];; 
   esac;
-  HSCFLAGS=" -C -optc-fnative-struct";
+  HSCFLAGS=; #we used to need "-C -optc-fnative-struct" but no longer it seems
   C2HSFLAGS=;
   dnl Where are we? (only used during configuration)
   TOP=`$PWD | $SED $PATHSED`;
@@ -116,9 +116,7 @@
   CREATE_TYPES=default;
 fi;
 
-if test "$WIN32" = "yes"; then
-  AC_DEFINE(WIN32, [], [Are we building on a Win32 system])
-fi
+AM_CONDITIONAL(WIN32, test "$WIN32" = "yes")
 
 dnl determine a temporary directory for c2hs
 TMPDIR="/tmp"

Index: Makefile.am
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -d -r1.45 -r1.46
--- Makefile.am	24 Jan 2005 14:59:39 -0000	1.45
+++ Makefile.am	7 Feb 2005 00:04:27 -0000	1.46
@@ -91,8 +91,8 @@
 	$(srcdir)/tools/callbackGen/Signal.chs-boot1 \
 	$(srcdir)/tools/callbackGen/Signal.chs-boot2 \
 	$(srcdir)/tools/callbackGen/gtkmarshal.list \
-	$(srcdir)/tools/callbackGen/HookGenerator
-	$(strip $(srcdir)/tools/callbackGen/HookGenerator $(MARSHALLDEFS) \
+	$(srcdir)/tools/callbackGen/HookGenerator$(EXEEXT)
+	$(strip $(srcdir)/tools/callbackGen/HookGenerator$(EXEEXT) $(MARSHALLDEFS) \
 	$(srcdir)/tools/callbackGen/ $@ \
 	$(if $(subst yes,,$(FOUR_WORD_CALLBACK)),--broken))
 
@@ -407,18 +407,27 @@
 	gtk/Graphics/UI/Gtk/Pango/Enums.chs.pp				\
 	gtk/Graphics/UI/Gtk/Pango/Layout.chs				\
 	gtk/Graphics/UI/Gtk/Pango/Rendering.chs.pp			\
-	gtk/Graphics/UI/Gtk/Embedding/Plug.chs				\
-	gtk/Graphics/UI/Gtk/Embedding/Socket.chs			\
 	gtk/Graphics/UI/Gtk/General/StockItems.hsc			\
 	gtk/Graphics/UI/Gtk/General/Structs.hsc				\
 	gtk/Graphics/UI/Gtk/Gdk/Events.hsc				\
-	gtk/Graphics/UI/Gtk/Embedding/Embedding.hsc			\
 	gtk/Graphics/UI/Gtk/Abstract/Scrollbar.hs			\
 	gtk/Graphics/UI/Gtk/Abstract/Separator.hs			\
 	gtk/Graphics/UI/Gtk/TreeList/CellRenderer.hs			\
 	gtk/Graphics/UI/Gtk/Gdk/DrawWindow.hs				\
 	gtk/Graphics/UI/Gtk/Pango/Markup.hs
 
+if !WIN32
+libHSgtk_a_SOURCES +=							\
+	gtk/Graphics/UI/Gtk/Embedding/Plug.chs				\
+	gtk/Graphics/UI/Gtk/Embedding/Socket.chs			\
+	gtk/Graphics/UI/Gtk/Embedding/Embedding.hsc
+endif
+
+EXTRA_libHSgtk_a_SOURCES =						\
+	gtk/Graphics/UI/Gtk/Embedding/Plug.chs				\
+	gtk/Graphics/UI/Gtk/Embedding/Socket.chs			\
+	gtk/Graphics/UI/Gtk/Embedding/Embedding.hsc
+
 html_HSFILES_PREPROC = gtk/Graphics/UI/Gtk.hs
 
 gtk_Graphics_UI_Gtk_hs_HCFLAGS			= -fno-warn-duplicate-exports	#FIXME
@@ -448,9 +457,9 @@
 
 gtk/Graphics/UI/Gtk/Types.chs : \
 	$(srcdir)/tools/hierarchyGen/hierarchy.list \
-	$(srcdir)/tools/hierarchyGen/TypeGenerator  \
+	$(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT)  \
 	$(srcdir)/tools/hierarchyGen/Hierarchy.chs.template
-	$(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \
+	$(strip $(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT) \
         $(srcdir)/tools/hierarchyGen/hierarchy.list \
         $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \
         $@ $(addprefix --tag=,$(CREATE_TYPES)) \
@@ -568,9 +577,9 @@
 glade_Graphics_UI_Gtk_Glade_Types_hs_HCFLAGS	= -fglasgow-exts
 
 glade/Graphics/UI/Gtk/Glade/Types.chs : $(srcdir)/tools/hierarchyGen/hierarchy.list \
-		      $(srcdir)/tools/hierarchyGen/TypeGenerator  \
+		      $(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT)  \
 		      $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template
-		      $(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \
+		      $(strip $(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT) \
 		      $(srcdir)/tools/hierarchyGen/hierarchy.list \
 		      $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \
 		      $@ --tag=libglade --lib=glade --prefix=glade \
@@ -645,9 +654,9 @@
 
 gconf/System/Gnome/GConf/Types.chs :			\
 	$(srcdir)/tools/hierarchyGen/hierarchy.list \
-	$(srcdir)/tools/hierarchyGen/TypeGenerator  \
+	$(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT)  \
 	$(srcdir)/tools/hierarchyGen/Hierarchy.chs.template
-	$(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \
+	$(strip $(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT) \
 	$(srcdir)/tools/hierarchyGen/hierarchy.list \
 	$(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \
 	$@ --tag=gconf --lib=gconf --prefix=gconf \
@@ -733,9 +742,9 @@
 
 sourceview/Graphics/UI/Gtk/SourceView/Types.chs :	\
 	$(srcdir)/tools/hierarchyGen/hierarchy.list \
-	$(srcdir)/tools/hierarchyGen/TypeGenerator  \
+	$(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT)  \
 	$(srcdir)/tools/hierarchyGen/Hierarchy.chs.template
-	$(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \
+	$(strip $(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT) \
 	$(srcdir)/tools/hierarchyGen/hierarchy.list \
 	$(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \
 	$@ --tag=sourceview --parentname=Graphics.UI.Gtk.Types \
@@ -806,9 +815,9 @@
 
 mozembed/Graphics/UI/Gtk/MozEmbed/Types.chs :	\
 	$(srcdir)/tools/hierarchyGen/hierarchy.list \
-	$(srcdir)/tools/hierarchyGen/TypeGenerator  \
+	$(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT)  \
 	$(srcdir)/tools/hierarchyGen/Hierarchy.chs.template
-	$(strip $(srcdir)/tools/hierarchyGen/TypeGenerator \
+	$(strip $(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT) \
 	$(srcdir)/tools/hierarchyGen/hierarchy.list \
 	$(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \
 	$@ --tag=mozembed --parentname=Graphics.UI.Gtk.Types \

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.339
retrieving revision 1.340
diff -u -d -r1.339 -r1.340
--- ChangeLog	5 Feb 2005 02:57:39 -0000	1.339
+++ ChangeLog	7 Feb 2005 00:04:26 -0000	1.340
@@ -1,3 +1,22 @@
+2005-02-06 Duncan Coutts <du...@co...>
+
+	* configure.ac: win32 fixes. Do not define WIN32 on windows since it
+	is already defined o that platform. Define a conditional so that
+	Makefile.am can conditonally compile a few modules. We no longer need
+	to pass -fnative-struct to gcc on windows.
+
+	* Makefile.am: win32 fixes. Add $(EXEEXT) in a few places to so names
+	of dependencies are correct on windows. Only compile the plug and
+	socket modules on non-win32 platforms.
+
+	* tools/c2hs/toplevel/C2HSConfig.hs.in: comment out the @TMPDIR@
+	substitution since it causes problems in windows and is not used
+	anyway.
+
+	* tools/c2hs/c/CParser.hs: make c2hs accept __attribute__'s on
+	declerations of functions returning pointer types. This is needed for
+	some mingw header file.
+
 2005-02-05 Duncan Coutts <du...@co...>
 
 	* tools/apiGen/ApiGen.hs: add support for interfaces, deal with

[Gtk2hs-commit] gtk2hs/tools/c2hs/c CParser.hs,1.2,1.3

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/c2hs/c
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21618/tools/c2hs/c

Modified Files:
	CParser.hs 
Log Message:
Various win32 fixes.

configure.ac: Do not define WIN32 on windows since it is already defined on
that platform.
Define a conditional so that Makefile.am can conditonally compile a few modules.
We no longer need to pass -fnative-struct to gcc on windows.

Makefile.am: Add $(EXEEXT) in a few places to so names of dependencies are
correct on windows.
Only compile the plug and socket modules on non-win32 platforms.

C2HSConfig.hs.in: comment out the @TMPDIR@ substitution since it causes
problems in windows and is not used anyway.

CParser.hs: make c2hs accept __attribute__'s on declerations of functions
returning pointer types. This is needed for some mingw header file (float.h).


Index: CParser.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/c2hs/c/CParser.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- CParser.hs	14 Jan 2005 00:18:32 -0000	1.2
+++ CParser.hs	7 Feb 2005 00:04:28 -0000	1.3
@@ -678,7 +678,7 @@
 --
 parseCDeclr :: CParser CDeclr
 parseCDeclr  =
-      (pointer `opt` id)
+      ((pointer *-> optMaybe parseGnuCAttr) `opt` id)
   *>  base
   *>  many (flip (.)) id (arrayType <|> newStyleFun <|> oldStyleFun)
   *-> list parseGnuCAttr			  -- ignore GCC's __attribute__

[Gtk2hs-commit] gtk2hs/tools/c2hs/toplevel C2HSConfig.hs.in,1.2,1.3

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/c2hs/toplevel
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21618/tools/c2hs/toplevel

Modified Files:
	C2HSConfig.hs.in 
Log Message:
Various win32 fixes.

configure.ac: Do not define WIN32 on windows since it is already defined on
that platform.
Define a conditional so that Makefile.am can conditonally compile a few modules.
We no longer need to pass -fnative-struct to gcc on windows.

Makefile.am: Add $(EXEEXT) in a few places to so names of dependencies are
correct on windows.
Only compile the plug and socket modules on non-win32 platforms.

C2HSConfig.hs.in: comment out the @TMPDIR@ substitution since it causes
problems in windows and is not used anyway.

CParser.hs: make c2hs accept __attribute__'s on declerations of functions
returning pointer types. This is needed for some mingw header file (float.h).


Index: C2HSConfig.hs.in
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/c2hs/toplevel/C2HSConfig.hs.in,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- C2HSConfig.hs.in	16 Jan 2005 21:31:22 -0000	1.2
+++ C2HSConfig.hs.in	7 Feb 2005 00:04:28 -0000	1.3
@@ -83,8 +83,10 @@
 -- possibly system-dependent location for temporary files
 --
 tmpdir :: String
-tmpdir = "@TMPDIR@"
-
+tmpdir = error "C2HSConfig.tmpdir" -- used to be: "@TMPDIR@"
+  -- tmpdir is unused and it causes problems on widows since it ends up with
+  -- the value "C:\TMP" which is not a valid string. It'd need to be "C:\\TMP"
+  -- so just remove the thing for now.
 
 -- parameters of the targeted C compiler
 -- -------------------------------------

[Gtk2hs-commit] gtk2hs/tools/apiGen Makefile,1.4,1.5

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32311/tools/apiGen

Modified Files:
	Makefile 
Log Message:
Update the Makefile with the new source files.
Also add a module prefix when generating gtk modules.


Index: Makefile
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- Makefile	28 Jan 2005 18:08:46 -0000	1.4
+++ Makefile	5 Feb 2005 03:02:06 -0000	1.5
@@ -76,7 +76,8 @@
 		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
+	--includeapi=gdk-api.xml --includeapi=pango-api.xml --includeapi=atk-api.xml \
+	--modprefix=Graphics.UI.Gtk.{-Category-}
 
 
 ###################
@@ -130,7 +131,8 @@
 #
 #	tools
 #
-ApiGen : ApiGen.hs
+ApiGen : ApiGen.hs Api.hs Docs.hs FormatDocs.hs \
+	Marshal.hs CodeGen.hs StringUtils.hs 
 	ghc --make $< -o $@
 
 gapi_format_xml : formatXml.c

[Gtk2hs-commit] gtk2hs/tools/apiGen ApiGen.hs,1.11,1.12

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32165/tools/apiGen

Modified Files:
	ApiGen.hs 
Log Message:
Split ApiGen.hs into several modules to make it easier to manage and understand.


Index: ApiGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- ApiGen.hs	5 Feb 2005 01:21:47 -0000	1.11
+++ ApiGen.hs	5 Feb 2005 03:01:01 -0000	1.12
@@ -2,1183 +2,25 @@
 -- binding module. Optionally it can be supplied with an xml documentation file
 -- in which case the .chs file will contain haddock-format documentation too.
 
--- If you want to teach ApiGen how to marshal new types, the function you want
--- to modify is either genMarshalParameter or genMarshalResult near the end of
--- this file.
+-- If you want to teach ApiGen how to marshal new types, the you want to modify
+-- either genMarshalParameter or genMarshalResult in the Marshal module.
 
 module Main (main) where
 
[...1213 lines suppressed...]
-lines [x]    = x
-lines (x:xs) = x. sc '\n'. lines xs
-
-sepBy :: String -> [String] -> ShowS
-sepBy s []     = id
-sepBy s [x]    = ss x
-sepBy s (x:xs) = ss x. ss s. sepBy s xs
-
-sepBy' :: String -> [ShowS] -> ShowS
-sepBy' s []     = id
-sepBy' s [x]    = x
-sepBy' s (x:xs) = x. ss s. sepBy' s xs
-
-templateSubstitute :: String -> (String -> ShowS) -> ShowS
-templateSubstitute template varSubst = doSubst template
-  where doSubst [] = id
-        doSubst ('\\':'@':cs) = sc '@' . doSubst cs
-        doSubst ('@':cs) = let (var,_:cs') = span ('@'/=) cs
-                            in varSubst var . doSubst cs'
-        doSubst (c:cs) = sc c . doSubst cs

[Gtk2hs-commit] gtk2hs/tools/apiGen Docs.hs,NONE,1.1 CodeGen.hs,NONE,1.1

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31623/tools/apiGen

Added Files:
	Docs.hs CodeGen.hs 
Log Message:
Split ApiGen.hs into several modules to make it easier to manage and understand.


--- NEW FILE: CodeGen.hs ---
module CodeGen (
  genModuleBody,
  genExports,
  genTodoItems,
  makeKnownTypesMap
  ) where

import Api
import Docs
import FormatDocs
import Marshal
import StringUtils

import Prelude hiding (Enum, lines)
import List   (groupBy, sortBy)

import Debug.Trace (trace)

-------------------------------------------------------------------------------
-- Now lets actually generate some code fragments based on the api info
-------------------------------------------------------------------------------
genFunction :: KnownTypes -> Method -> Maybe FuncDoc -> ShowS
genFunction knownTypes method doc =
  formattedDoc.
  ss functionName. ss " :: ". functionType. nl.
  ss functionName. sc ' '. sepBy " " paramNames. ss " =".
  indent 1. body

  where functionName = cFuncNameToHsName (method_cname method)
	(classConstraints', paramTypes', paramMarshalers) =
	  unzip3 [ case genMarshalParameter knownTypes
                          (changeIllegalNames (cParamNameToHsName (parameter_name p)))
	                  (parameter_type p) of
                     (c, ty, m) -> (c, (ty, parameter_name p), m)
		 | p <- method_parameters method ]
	classConstraints = [ c | Just c <- classConstraints' ]
	paramTypes = [ (paramType, lookup name paramDocMap)
                     | (Just paramType, name) <- paramTypes' ]
	paramNames = [ changeIllegalNames (cParamNameToHsName (parameter_name p))
		     | ((Just _, _), p) <- zip paramTypes' (method_parameters method) ]
	(returnType', returnMarshaler) =
		genMarshalResult knownTypes (method_return_type method)
        returnType = (returnType', lookup "Returns" paramDocMap)
	functionType = (case classConstraints of
	                  []  -> id
			  [c] -> ss c. ss " => "
			  cs  -> sc '('. sepBy ", " classConstraints. ss ") => ").
                       formatParamTypes (paramTypes ++ [returnType])
	body = foldl (\body marshaler -> marshaler body)
                     call (paramMarshalers++[returnMarshaler])
	call = ss "{# call ". ss (method_cname method). ss " #}"
        formattedDoc = case doc of
          Nothing  -> ss "-- | \n-- \n"
          Just doc -> ss "-- | ". haddocFormatParas (funcdoc_paragraphs doc). nl.
                      comment. nl
        paramDocMap = case doc of
          Nothing  -> []
          Just doc -> [ (paramdoc_name paramdoc
                        ,(if paramdoc_name paramdoc == "Returns"
                           then [DocText "returns "]
                           else [DocArg (paramdoc_name paramdoc)
                                ,DocText " - "]
                         ) ++ paramdoc_paragraph paramdoc)
                      | paramdoc <- funcdoc_params doc ]
        
        formatParamTypes :: [(String, Maybe [DocParaSpan])] -> ShowS
        formatParamTypes paramTypes = format True False paramTypes
                                             -- True to indicate first elem
                                             -- False to mean previous param had no doc
          where format _    _ []                   = id
                format True _ ((t,Nothing)    :ts) =               ss t.
                                                     format False False ts
                format True _ ((t,Just doc)   :ts) = ss "\n    ". ss t.
                                                     ss (replicate (columnIndent - length t) ' ').
                                                     ss " -- ^ ". formatDoc t doc.
                                                     format False True  ts
                format _ True  ((t, Nothing)  :ts) = ss "\n -> ". ss t.
                                                     format False False ts
                format _ False ((t, Nothing)  :ts) = ss   " -> ". ss t.
                                                     format False False ts
                format _ _     ((t, Just doc) :ts) = ss "\n -> ". ss t.
                                                     ss (replicate (columnIndent - length t) ' ').
                                                     ss " -- ^ ". formatDoc t doc.
                                                     format False True  ts
                formatDoc :: String -> [DocParaSpan] -> ShowS
                formatDoc typeName =
                    sepBy' ("\n" ++ replicate (columnIndent+5) ' ' ++  "-- ")
                  . map (sepBy " ")
                  . wrapText 3 (80 - columnIndent - 8)
                  . words
                  . concatMap haddocFormatSpan
                columnIndent = maximum [ length parmType | (parmType, _) <- paramTypes ]

genModuleBody :: KnownTypes -> Object -> ModuleDoc -> ShowS
genModuleBody knownTypes object apiDoc =
  doVersionIfDefs (sepBy' "\n\n") $
     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 = 
  [ (genFunction knownTypes method doc, maybe "" funcdoc_since doc)
  | (method, doc) <- methods object apiDoc ]

methods :: Object -> [FuncDoc] -> [(Method, Maybe FuncDoc)]
methods object docs =
  map snd $
  sortBy (\(i,_) (j,_) -> i `compare` j)
  [ case method_cname method `lookup` docmap of
      Nothing             -> (0,(mungeMethod object method, Nothing))
      (Just (doc, index)) -> (index,(mungeMethod object method, Just doc))
  | method <- object_methods object
  , null [ () | VarArgs <- method_parameters method] ] --exclude VarArgs methods
  where docmap = [ (funcdoc_name doc, (doc,index)) | (doc,index) <- zip docs [1..]]
        

mungeMethod :: Object -> Method -> Method
mungeMethod object method =
  let self = Parameter {
               parameter_type = object_cname object ++ "*",
               parameter_name = "self",
               parameter_isArray = False
             }
   in method {
        method_name = object_name object ++ method_name method,
        method_parameters = self : method_parameters method
      } 

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)]
constructors object docs =
  [ (mungeConstructor object constructor, constructor_cname constructor `lookup` docmap)
  | constructor <- object_constructors object
  , null [ () | VarArgs <- constructor_parameters constructor] ]
  where docmap = [ (funcdoc_name doc, doc) | doc <- docs ]

mungeConstructor :: Object -> Constructor -> Method
mungeConstructor object constructor =
  Method {
    method_name = cFuncNameToHsName (constructor_cname constructor),
    method_cname = constructor_cname constructor,
    method_return_type = object_cname object ++ "*",
    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 knownTypes object property doc, maybe "" propdoc_since doc)
  | (property, doc) <- properties object apiDoc ]

genProperty :: KnownTypes -> Object -> Property -> Maybe PropDoc -> ShowS
genProperty knownTypes object property doc = 
  formattedDoc.
  ss propertyName. ss " :: Attr ". objectType. sc ' '. ss propertyType. nl.
  ss propertyName. ss " = Attr ". 
  indent 1. getter.
  indent 1. setter
  where objectType = ss (object_name object)
        propertyName = cFuncNameToHsName (property_cname property)
        getter = ss "(\\obj -> do ". ss gvalueConstructor. ss " result <- objectGetProperty \"". ss (property_cname property). ss "\"".
                 indent 7. ss "return result"
        setter = ss "(\\obj val -> objectSetProperty obj \"". ss (property_cname property). ss "\" (". ss gvalueConstructor. ss " val))"
        formattedDoc = case doc of
          Nothing  -> ss "-- | \n-- \n"
          Just doc -> ss "-- | ". haddocFormatParas (propdoc_paragraphs doc). nl.
                      comment. nl
        (propertyType, gvalueConstructor) = genMarshalProperty knownTypes (property_type property)

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

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 ("GTypeModule":os) = GObjectKind -- GTypeModule is a GObject
                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 -> ModuleDoc -> 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 ','.
  (case [ (ss "  ". ss (cFuncNameToHsName (method_cname constructor)). sc ','
          ,maybe "" funcdoc_since doc)
        | (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 (moduledoc_functions docs)] of
     [] -> id
     cs -> nl.nl.comment.ss "* Methods".nl.
           doVersionIfDefs lines cs).
  (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.
           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.
           doVersionIfDefs lines cs)

genTodoItems :: Object -> ShowS
genTodoItems object =
  let varargsFunctions = 
        [ ss (constructor_cname constructor)
        | constructor <- object_constructors object
        , not $ null [ () | VarArgs <- constructor_parameters constructor] ]
       ++
        [ ss (method_cname method)
        | method <- object_methods object
        , not $ null [ () | VarArgs <- method_parameters method] ]
   in if null varargsFunctions
        then id
        else nl. comment. nl. comment.
             ss "TODO: the following varargs functions were not bound\n".
             lines (map (ss "-- * ".) varargsFunctions)

doVersionIfDefs :: ([ShowS] -> ShowS) -> [(ShowS, Since)] -> ShowS
doVersionIfDefs lines =
    lines
  . map (\group -> sinceVersion (snd (head group))
                                (lines (map fst group)))
  . groupBy (\(_,a) (_,b) -> a == b)
 
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"
sinceVersion _ body = body

--- NEW FILE: Docs.hs ---
module Docs (
  ApiDoc,
  ModuleDoc(..),
  noModuleDoc,
  DocSection(..),
  Since,
  FuncDoc(..),
  ParamDoc(..),
  PropDoc(..),
  SignalDoc(..),
  DocPara(..),
  DocParaSpan(..),
  extractDocumentation
  ) where

import qualified Text.XML.HaXml as Xml

-------------------------------------------------------------------------------
-- Types representing the content of the documentation XML file
-------------------------------------------------------------------------------
type ApiDoc = [ModuleDoc]

data ModuleDoc = ModuleDoc {
    moduledoc_name :: String,              -- these docs apply to this object
    moduledoc_altname :: String,           -- sometimes a better index entry
    moduledoc_summary :: String,           -- a one line summary
    moduledoc_description :: [DocPara],    -- the main description
    moduledoc_sections :: [DocSection],    -- any additional titled subsections
    moduledoc_hierarchy :: [DocParaSpan],  -- a tree of parent objects (as text)
    moduledoc_functions :: [FuncDoc],      -- documentation for each function
    moduledoc_properties :: [PropDoc],     -- documentation for each property
    moduledoc_signals :: [SignalDoc]       -- documentation for each signal
  }

noModuleDoc = ModuleDoc {
    moduledoc_name = "",
    moduledoc_altname = "",
    moduledoc_summary = "",
    moduledoc_description = [],
    moduledoc_sections = [],
    moduledoc_hierarchy = [],
    moduledoc_functions = [],
    moduledoc_properties = [],
    moduledoc_signals = []
  }

data DocSection = DocSection {
    section_title :: String,
    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 :: Since		-- which version of the api the
  }					-- function is available from, eg "2.4"

data ParamDoc = ParamDoc {
    paramdoc_name :: String,            -- parameter name or "Returns"
    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 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
  | DocParaTitle String                 -- a title to a subsection eg an example
  | DocParaDefItem [DocParaSpan] [DocParaSpan] -- a definition list item
  | DocParaListItem [DocParaSpan]       -- a itemisted list item

data DocParaSpan = DocText String       -- just simple text
                 | DocFuncXRef String   -- cross reference to a function name
                 | DocTypeXRef String   -- cross reference to a type name
                 | DocOtherXRef String  -- xref format not directly supported
                 | DocEmphasis String   -- emphasised text, usually italic
		 | DocLiteral String    -- some literal like numbers
		 | DocArg  String       -- function argument names


-------------------------------------------------------------------------------
-- extract functions to convert the doc xml file to the internal representation
-------------------------------------------------------------------------------
extractDocumentation :: Xml.Document -> ApiDoc
extractDocumentation (Xml.Document _ _ (Xml.Elem "apidoc" [] modules)) =
  map extractDocModule modules

extractDocModule :: Xml.Content -> ModuleDoc
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_signals = map extractDocSignal signals
  }

extractDocModuleinfo :: Xml.Content -> ModuleDoc
extractDocModuleinfo 
  (Xml.CElem (Xml.Elem "module-info" []
    [Xml.CElem (Xml.Elem "name" [] name)
    ,Xml.CElem (Xml.Elem "altname" [] altname)
    ,Xml.CElem (Xml.Elem "summary" [] summary)
    ,Xml.CElem (Xml.Elem "description" [] parasAndSections)
    ,Xml.CElem (Xml.Elem "object-hierarchy" [] objHierSpans)]
  )) = 
  let (paras, sections) = span (\elem ->
        case elem of
          Xml.CElem (Xml.Elem "section" _ _) -> False
          _ -> True) parasAndSections
   in ModuleDoc {
    moduledoc_name = Xml.verbatim name,
    moduledoc_altname = Xml.verbatim altname,
    moduledoc_summary = Xml.verbatim summary,
    moduledoc_description = concatMap extractDocPara paras,
    moduledoc_sections = map extractDocSection sections,
    moduledoc_hierarchy = map extractDocParaSpan objHierSpans,
    moduledoc_functions = undefined,
    moduledoc_properties = undefined,
    moduledoc_signals = undefined
  }

extractDocSection :: Xml.Content -> DocSection
extractDocSection
  (Xml.CElem (Xml.Elem "section" []
    (Xml.CElem (Xml.Elem "title" [] [Xml.CString _ title])
    :paras))) =
  DocSection {
    section_title = title,
    section_paras = concatMap extractDocPara paras
  }
extractDocSection other = error $ "extractDocSection: " ++ Xml.verbatim other

extractDocFunc :: Xml.Content -> FuncDoc
extractDocFunc
  (Xml.CElem (Xml.Elem "function" []
    [Xml.CElem (Xml.Elem "name" [] [Xml.CString _ name])
    ,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 FuncDoc {
        funcdoc_name = name,
	funcdoc_paragraphs = concatMap extractDocPara paras,
        funcdoc_params = map extractParamDoc params,
	funcdoc_since = since
      }

extractParamDoc :: Xml.Content -> ParamDoc
extractParamDoc 
  (Xml.CElem (Xml.Elem "param" []
    (Xml.CElem (Xml.Elem "name" [] [Xml.CString _ name])
    :spans))) =
  ParamDoc {
    paramdoc_name = name,
    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
      }

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
    (Xml.Elem _ [] spans) -> extractDocPara' spans
extractDocPara (Xml.CElem (Xml.Elem "programlisting" _ content)) =
  let listing = concat [ str | (Xml.CString _ str) <- content ] in
  [DocParaProgram listing]
extractDocPara (Xml.CElem (Xml.Elem "example" _
                 (Xml.CElem (Xml.Elem "title" [] [Xml.CString _ title])
                 :content) )) =
  [DocParaTitle title] ++ concatMap extractDocPara content 
extractDocPara other = error $ "extractDocPara: " ++ Xml.verbatim other

extractDocPara' :: [Xml.Content] -> [DocPara]
extractDocPara' = reconstructParas [] . map extractDocParaOrSpan
  where reconstructParas :: [DocParaSpan] -> [Either DocParaSpan DocPara] -> [DocPara]
        reconstructParas []    [] = []
        reconstructParas spans [] = [DocParaText (reverse spans)]
        reconstructParas spans (Left  span:rest) = reconstructParas (span:spans) rest
        reconstructParas []    (Right para:rest) = para : reconstructParas [] rest
        reconstructParas spans (Right para:rest) = DocParaText (reverse spans)
                                                 : para : reconstructParas [] rest

extractDocParaOrSpan :: Xml.Content -> Either DocParaSpan DocPara 
extractDocParaOrSpan (Xml.CElem (Xml.Elem "listitem" [] content)) =
  Right $ DocParaListItem (map extractDocParaSpan content)
extractDocParaOrSpan (Xml.CElem (Xml.Elem "definition" []
                       (Xml.CElem (Xml.Elem "term" [] term)
                       :content))) =
  Right $ DocParaDefItem (map extractDocParaSpan term) (map extractDocParaSpan content)
extractDocParaOrSpan (Xml.CElem (Xml.Elem "programlisting" _ content)) =
  let listing = concat [ str | (Xml.CString _ str) <- content ] in
  Right $ DocParaProgram listing
extractDocParaOrSpan content@(Xml.CElem   _  ) = Left $ extractDocParaSpan content
extractDocParaOrSpan content@(Xml.CString _ _) = Left $ extractDocParaSpan content
extractDocParaOrSpan other = error $ "extractDocParaOrSpan: " ++ Xml.verbatim other

extractDocParaSpan :: Xml.Content -> DocParaSpan
extractDocParaSpan (Xml.CString _ text) = DocText text
extractDocParaSpan (Xml.CElem (Xml.Elem tag [] content)) =
  let text = concat [ str | (Xml.CString _ str) <- content ] in
  case tag of
    "xref-func"  -> DocFuncXRef text
    "xref-type"  -> DocTypeXRef text
    "xref-other" -> DocOtherXRef text
    "emphasis"   -> DocEmphasis text
    "literal"    -> DocLiteral text
    "arg"        -> DocArg text
    other -> error $ "extractDocParaSpan: other tag " ++ tag

extractDocParaSpan other@(Xml.CRef (Xml.RefEntity entity)) = DocText (Xml.verbatim other)
extractDocParaSpan other = error $ "extractDocParaSpan: " ++ Xml.verbatim other

[Gtk2hs-commit] gtk2hs ChangeLog,1.338,1.339

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31423

Modified Files:
	ChangeLog 
Log Message:
Split ApiGen.hs into several modules to make it easier to manage and understand.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.338
retrieving revision 1.339
diff -u -d -r1.338 -r1.339
--- ChangeLog	5 Feb 2005 01:21:46 -0000	1.338
+++ ChangeLog	5 Feb 2005 02:57:39 -0000	1.339
@@ -1,11 +1,18 @@
 2005-02-05 Duncan Coutts <du...@co...>
 
-	* tools/apiGen/ApiGen.hs: addsupport for interfaces, deal with
+	* tools/apiGen/ApiGen.hs: add support for interfaces, deal with
 	examples in a more general way and improve the generation of
 	properties.
 
 	* tools/apiGen/format-docs.xsl: deal with another kind of table.
 
+	* tools/apiGen/ApiGen.hs, tools/apiGen/Api.hs, tools/apiGen/Docs.hs,
+	tools/apiGen/FormatDocs.hs, tools/apiGen/Marshal.hs,
+	tools/apiGen/CodeGen.hs, tools/apiGen/StringUtils.hs: split ApiGen.hs
+	into several modules to make it easier to manage and understand.
+
+	* tools/apiGen/Makefile: update the Makefile accordingly
+
 2005-02-04 Axel Simon <A....@ke...>
 
 	* gtk/Graphics/UI/Gtk/Display/Image.chs: Added imageSetFromPixbuf.

[Gtk2hs-commit] gtk2hs/tools/apiGen Api.hs,NONE,1.1 FormatDocs.hs,NONE,1.1 Marshal.hs,NONE,1.1 StringUtils.hs,NONE,1.1

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31423/tools/apiGen

Added Files:
	Api.hs FormatDocs.hs Marshal.hs StringUtils.hs 
Log Message:
Split ApiGen.hs into several modules to make it easier to manage and understand.


--- NEW FILE: StringUtils.hs ---
module StringUtils where

import Prelude hiding (lines)
import Char   (toLower, toUpper, isSpace, isAlpha, isAlphaNum, isUpper)

-------------------------------------------------------------------------------
-- Helper functions
-------------------------------------------------------------------------------

ss = showString
sc = showChar

nl = sc '\n'

indent :: Int -> ShowS
indent c = ss ("\n"++replicate (2*c) ' ')

comment :: ShowS
comment = ss "-- "

lowerCaseFirstChar :: String -> String
lowerCaseFirstChar (c:cs) = toLower c : cs

upperCaseFirstChar :: String -> String
upperCaseFirstChar (c:cs) = toUpper c : cs

cat :: [ShowS] -> ShowS
cat = foldl (.) id

lines :: [ShowS] -> ShowS
lines []     = id
lines [x]    = x
lines (x:xs) = x. sc '\n'. lines xs

sepBy :: String -> [String] -> ShowS
sepBy s []     = id
sepBy s [x]    = ss x
sepBy s (x:xs) = ss x. ss s. sepBy s xs

sepBy' :: String -> [ShowS] -> ShowS
sepBy' s []     = id
sepBy' s [x]    = x
sepBy' s (x:xs) = x. ss s. sepBy' s xs

templateSubstitute :: String -> (String -> ShowS) -> ShowS
templateSubstitute template varSubst = doSubst template
  where doSubst [] = id
        doSubst ('\\':'@':cs) = sc '@' . doSubst cs
        doSubst ('@':cs) = let (var,_:cs') = span ('@'/=) cs
                            in varSubst var . doSubst cs'
        doSubst (c:cs) = sc c . doSubst cs

splitBy :: Char -> String -> [String]
splitBy sep str =
  case span (sep/=) str of
    (remainder,[]) -> [remainder]
    (word,_:remainder) -> word : splitBy sep remainder

-- wraps a list of words to lines of words
wrapText :: Int -> Int -> [String] -> [[String]]
wrapText initialCol width = wrap initialCol []
  
  where wrap :: Int -> [String] -> [String] -> [[String]]
        wrap 0   []   (word:words) |       length word + 1 > width = wrap (length word) [word] words
        wrap col line (word:words) | col + length word + 1 > width = reverse line : wrap 0 [] (word:words)
        wrap col line (word:words) = wrap (col + length word + 1) (word:line) words
        wrap _ []   [] = []
        wrap _ line [] = [reverse line]

--- NEW FILE: Api.hs ---
module Api (
  API,
  NameSpace(..),
  Enum(..),
  Member(..),
  Object(..),
  Constructor(..),
  Parameter(..),
  Method(..),
  Property(..),
  Signal(..),
  extractAPI
  ) where

import Prelude hiding (Enum)
import Maybe  (catMaybes)

import qualified Text.XML.HaXml as Xml

-------------------------------------------------------------------------------
-- Types representing the content of the API XML file
-------------------------------------------------------------------------------
type API = [NameSpace]

data NameSpace = NameSpace {
    namespace_name :: String,
    namespace_library :: String,
    namespace_objects :: [Object],
    namespace_enums :: [Enum]
  } deriving Show

data Enum = Enum {
    enum_name :: String,
    enum_cname :: String,
    enum_variety :: String,
    enum_members :: [Member]
 } deriving Show

data Member = Member {
    member_name :: String,
    member_cname :: String,
    member_value :: String
  } deriving Show

data Object = Object {
    object_name :: String,
    object_cname :: String,
    object_parent :: String,
    object_constructors :: [Constructor],
    object_methods :: [Method],
    object_properties :: [Property],
    object_signals :: [Signal]
  } deriving Show

data Constructor = Constructor {
    constructor_cname :: String,
    constructor_parameters :: [Parameter]
  } deriving Show

data Parameter = Parameter {
    parameter_type :: String,
    parameter_name :: String,
    parameter_isArray :: Bool
  }
               | VarArgs
  deriving Show

data Method = Method {
    method_name :: String,
    method_cname :: String,
    method_return_type :: String,
    method_parameters :: [Parameter]
  } deriving Show

data Property = Property {
    property_name :: String,
    property_cname :: String,
    property_type :: String,
    property_readable :: Bool,
    property_writable :: Bool,
    property_constructonly :: Bool
  } deriving Show

data Signal = Signal {
    signal_name :: String,
    signal_cname :: String,
    signal_when :: String,
    signal_return_type :: String,
    signal_parameters :: [Parameter]    
  } deriving Show

-------------------------------------------------------------------------------
-- extract functions to convert the api xml file to the internal representation
-------------------------------------------------------------------------------
extractAPI :: Xml.Document -> API
extractAPI (Xml.Document _ _ (Xml.Elem "api" [] namespaces)) =
  catMaybes (map extractNameSpace namespaces)

extractNameSpace :: Xml.Content -> Maybe NameSpace
extractNameSpace (Xml.CElem (Xml.Elem "namespace"
                        [("name", Xml.AttValue name),
                         ("library", Xml.AttValue lib)] content)) =
  Just $ NameSpace {
    namespace_name = Xml.verbatim name,
    namespace_library = Xml.verbatim lib,
    namespace_objects = catMaybes (map extractObject content),
    namespace_enums = 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),
                      ("cname", Xml.AttValue cname),
                      ("parent", Xml.AttValue parent)] content)) =
  Just $ Object {
    object_name = Xml.verbatim name,
    object_cname = Xml.verbatim cname,
    object_parent = Xml.verbatim parent,
    object_constructors = catMaybes (map extractConstructor content),
    object_methods = catMaybes (map extractMethod content),
    object_properties = catMaybes (map extractProperty content),
    object_signals = catMaybes (map extractSignal content)
  }
extractObject (Xml.CElem (Xml.Elem "interface"
                     [("name", Xml.AttValue name),
                      ("cname", Xml.AttValue cname)] content)) =
  Just $ Object {
    object_name = Xml.verbatim name,
    object_cname = Xml.verbatim cname,
    object_parent = "GObject",
    object_constructors = catMaybes (map extractConstructor content),
    object_methods = catMaybes (map extractMethod content),
    object_properties = catMaybes (map extractProperty content),
    object_signals = catMaybes (map extractSignal content)
  }
extractObject _ = Nothing

extractMethod :: Xml.Content -> Maybe Method
extractMethod (Xml.CElem (Xml.Elem "method"
                     [("name", Xml.AttValue name),
                      ("cname", Xml.AttValue cname)]
                     (Xml.CElem (Xml.Elem "return-type"
                            [("type", Xml.AttValue return_type)] [])
                      :content))) =
  Just $ Method {
    method_name = Xml.verbatim name,
    method_cname = Xml.verbatim cname,
    method_return_type = Xml.verbatim return_type,
    method_parameters =
      case content of
        [] -> []
        [Xml.CElem (Xml.Elem "parameters" [] parameters)]
           -> map extractParameter parameters
  }
extractMethod _ = Nothing

extractParameter :: Xml.Content -> Parameter
extractParameter (Xml.CElem (Xml.Elem "parameter"
                        [("ellipsis", _)] [])) = VarArgs
extractParameter (Xml.CElem (Xml.Elem "parameter"
                        [("ellipsis", _)
                        ,("printf_format_args", _)] [])) = VarArgs
extractParameter (Xml.CElem (Xml.Elem "parameter"
                        [("type", Xml.AttValue type_),
                         ("name", Xml.AttValue name)] [])) =
  Parameter {
    parameter_type = Xml.verbatim type_,
    parameter_name = Xml.verbatim name,
    parameter_isArray = False
  }
extractParameter (Xml.CElem (Xml.Elem "parameter"
                        [("type", Xml.AttValue type_),
                         ("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 {
     parameter_type = Xml.verbatim type_,
     parameter_name = Xml.verbatim name,
     parameter_isArray = True
   }
extractParameter (Xml.CElem (Xml.Elem "callback"
                        [("cname", Xml.AttValue cname)] _)) =
   Parameter {
     parameter_type = "callback",
     parameter_name = Xml.verbatim cname,
     parameter_isArray = False
   }
  
extractConstructor :: Xml.Content -> Maybe Constructor
extractConstructor (Xml.CElem (Xml.Elem "constructor"
                     [("cname", Xml.AttValue cname)] content)) =
  Just $ Constructor {
    constructor_cname = Xml.verbatim cname,
    constructor_parameters =
      case content of
        [] -> []
        [Xml.CElem (Xml.Elem "parameters" [] parameters)]
           -> map extractParameter parameters
  }
extractConstructor _ = Nothing

extractProperty :: Xml.Content -> Maybe Property
extractProperty (Xml.CElem (Xml.Elem "property"
                     (("name", Xml.AttValue name):
                      ("cname", Xml.AttValue cname):
                      ("type", Xml.AttValue type_):others) [])) =
  Just $ Property {
    property_name = Xml.verbatim name,
    property_cname = Xml.verbatim cname,
    property_type = Xml.verbatim type_,
    property_readable = (not.null) [ () | ("readable", _) <- others],
    property_writable = (not.null) [ () | ("writable", _) <- others],
    property_constructonly  = (not.null) [ () | ("construct-only", _) <- others]
  }
extractProperty _ = Nothing

extractSignal :: Xml.Content -> Maybe Signal
extractSignal (Xml.CElem (Xml.Elem "signal"
                     (("name", Xml.AttValue name):
                      ("cname", Xml.AttValue cname):when)
                     (Xml.CElem (Xml.Elem "return-type"
                            [("type", Xml.AttValue return_type)] [])
                      :content))) =
  Just $ Signal {
    signal_name = Xml.verbatim name,
    signal_cname = Xml.verbatim cname,
    signal_when = case when of
                    [] -> ""
                    [("when", Xml.AttValue when)] -> Xml.verbatim when,
    signal_return_type = Xml.verbatim return_type,
    signal_parameters =
      case content of
        [] -> []
        [Xml.CElem (Xml.Elem "parameters" [] parameters)]
           -> map extractParameter parameters
  }
extractSignal _ = Nothing

--- NEW FILE: FormatDocs.hs ---
-- ApiGen: takes an xml description of a GObject-style API and produces a .chs
-- binding module. Optionally it can be supplied with an xml documentation file
-- in which case the .chs file will contain haddock-format documentation too.

-- If you want to teach ApiGen how to marshal new types, the function you want
-- to modify is either genMarshalParameter or genMarshalResult near the end of
-- this file.

module FormatDocs (
  genModuleDocumentation,
  cFuncNameToHsName,
  cParamNameToHsName,
  haddocFormatParas,
  haddocFormatSpan,
  changeIllegalNames,
  addVersionParagraphs
) where

import Api (NameSpace(namespace_name))
import Docs
import Marshal (stripKnownPrefixes)
import StringUtils

import qualified List (lines)

-------------------------------------------------------------------------------
-- Functions for formatting haddock documentation
-------------------------------------------------------------------------------

genModuleDocumentation :: ModuleDoc -> ShowS
genModuleDocumentation moduledoc =
  (if null (moduledoc_description moduledoc)
     then id
     else comment.ss "* Description".nl.
          comment.nl.
          comment.ss "| ".haddocFormatParas (moduledoc_description moduledoc).nl).
  (if null (moduledoc_sections moduledoc)
     then id
     else nl.comment.haddocFormatSections (moduledoc_sections moduledoc).nl.comment.nl).
  (if null (moduledoc_hierarchy moduledoc)
     then id
     else nl.comment.ss "* Class Hierarchy".nl.
          comment.ss "|".nl.
          comment.ss "@".nl.
          comment.ss "|  ".haddocFormatHierarchy (moduledoc_hierarchy moduledoc).nl.
          comment.ss "@".nl)

haddocFormatHierarchy :: [DocParaSpan] -> ShowS
haddocFormatHierarchy =
    sepBy "\n-- |"
  . Prelude.lines
  . concatMap haddocFormatSpan

addVersionParagraphs :: NameSpace -> ModuleDoc -> ModuleDoc
addVersionParagraphs namespace apiDoc =
  apiDoc {
    moduledoc_description = moduledoc_description apiDoc ++ moduleVersionParagraph,
    moduledoc_functions = functionVersionParagraphs moduleVersion (moduledoc_functions apiDoc)
  }
  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 " ++ funcdoc_since funcdoc
                        in [DocParaText [DocText line]]
                   }
              else funcdoc
          | funcdoc <- funcdocs ]
  
        moduleVersionParagraph =
          case moduleVersion of
            "" -> []
            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 :: String
        moduleVersion = case [ funcdoc_since funcdoc
                             | funcdoc <- moduledoc_functions apiDoc ] of
                          [] -> ""
                          versions -> minimum versions
  
haddocFormatSections :: [DocSection] -> ShowS
haddocFormatSections = 
    sepBy' "\n\n-- "
  . map (\section ->
         ss "** ". ss (section_title section). nl.
         comment.nl.
         comment.ss "| ".haddocFormatParas (section_paras section))

haddocFormatParas :: [DocPara] -> ShowS
haddocFormatParas =
    sepBy' "\n--\n-- "
  . map haddocFormatPara

haddocFormatPara :: DocPara -> ShowS
haddocFormatPara (DocParaText spans) = haddocFormatSpans 3 spans
haddocFormatPara (DocParaProgram prog) =
    ((ss "* FIXME: if the follwing is a C code example, port it to Haskell or remove it".nl.
      comment).)
  . sepBy "\n-- > "
  . List.lines
  $ prog
haddocFormatPara (DocParaTitle title) =
    ss "* ". ss title
haddocFormatPara (DocParaDefItem term spans) =
  let def = (unwords . words . escape . concatMap haddocFormatSpan) term in
  sc '['. ss def. ss "] ".
  haddocFormatSpans (length def + 6) spans
  where escape [] = []
        escape (']':cs) = '\\': ']' : escape cs --we must escape ] in def terms
        escape (c:cs)   =        c  : escape cs
haddocFormatPara (DocParaListItem spans) =
  ss "* ".
  haddocFormatSpans 5 spans

haddocFormatSpans :: Int -> [DocParaSpan] -> ShowS
haddocFormatSpans initialCol =
    sepBy' "\n-- "
  . map (sepBy " ")
  . wrapText initialCol 77
  . words
  . concatMap haddocFormatSpan

haddocFormatSpan :: DocParaSpan -> String
haddocFormatSpan (DocText text)    = escapeHaddockSpecialChars text
haddocFormatSpan (DocTypeXRef text)    = "\"" ++ stripKnownPrefixes text ++ "\""
haddocFormatSpan (DocFuncXRef text)    = "'" ++ cFuncNameToHsName text ++ "'"
haddocFormatSpan (DocOtherXRef text)    = "'{FIXME: gtk-doc cross reference to:" ++ text ++ "}'"
haddocFormatSpan (DocEmphasis text)  = "/" ++ text ++ "/"
haddocFormatSpan (DocLiteral "TRUE")  = "@True@"
haddocFormatSpan (DocLiteral "FALSE") = "@False@"
  --likely that something should be changed to a Maybe type if this is emitted:
haddocFormatSpan (DocLiteral "NULL")  = "{@NULL@, FIXME: this should probably be converted"
                                                     ++ " to a Maybe data type}"
haddocFormatSpan (DocLiteral text) = "@" ++ escapeHaddockSpecialChars text ++ "@"
haddocFormatSpan (DocArg  text)    = "@" ++ cParamNameToHsName text ++ "@"

cFuncNameToHsName :: String -> String
cFuncNameToHsName =
    lowerCaseFirstChar
  . stripKnownPrefixes
  . concatMap upperCaseFirstChar
  . filter (not.null) --to ignore leading underscores
  . splitBy '_'
  . takeWhile ('('/=)

cParamNameToHsName :: String -> String
cParamNameToHsName  =          --change "gtk_foo_bar" to "gtkFooBar"
    lowerCaseFirstChar
  . concatMap upperCaseFirstChar
  . filter (not.null) --to ignore tailing underscores
  . splitBy '_'

changeIllegalNames :: String -> String
changeIllegalNames "type" = "type_"  --this is a common variable name in C but of
                                     --course a keyword in Haskell
changeIllegalNames other = other

escapeHaddockSpecialChars = escape
  where escape [] = []
        escape (''':'s':cs) = ''' : 's' : escape cs --often don't need to escape
        escape (c:cs) | c == '/' || c == '`'
                     || c == '"' || c == '@'
                     || c == '<' || c == '''
                      = '\\': c : escape cs
        escape (c:cs) =       c : escape cs              

--- NEW FILE: Marshal.hs ---
module Marshal (
  KnownTypes,
  CTypeKind(..),
  stripKnownPrefixes,
  genMarshalParameter,
  genMarshalResult,
  genMarshalProperty
  ) where

import StringUtils
import Char (isUpper)

type KnownTypes = [(String, CTypeKind)]

data CTypeKind = GObjectKind
               | GtkObjectKind
               | EnumKind
               | FlagsKind
  deriving (Eq, Show)


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
stripKnownPrefixes ('G':'n':'o':'m':'e':remainder) = remainder
stripKnownPrefixes other = other

-------------------------------------------------------------------------------
-- Here's the interesting bit that generates the fragments of mashaling code
-------------------------------------------------------------------------------

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" =
	(Nothing, Just "Bool",
	\body -> body.
                 indent 2. ss " (fromBool ". ss name. ss ")")

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 "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.
                 indent 2. sc ' '. ss name. ss "Ptr")

genMarshalParameter _ name "GError**" =
	(Nothing, Nothing,
	\body -> ss "propagateGError $ \\". ss name. ss "Ptr ->".
	         indent 1. body.
                 indent 2. sc ' '. ss name. ss "Ptr")

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 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.
                 indent 2. ss " {-". ss name. ss "-}")

-- Takes the type string and returns the Haskell Type and the marshaling code
--
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*" =
  ("[{- element type -}]",
  \body -> body.
           indent 1. ss ">>= fromGSList".
           indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})")
genMarshalResult _ "GList*" =
  ("[{- element type -}]",
  \body -> body.
           indent 1. ss ">>= fromGList".
           indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})")

genMarshalResult 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 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)

genMarshalProperty :: KnownTypes -> String -> (String, String)
genMarshalProperty _ "gint"      = ("Int",    "GVint")
genMarshalProperty _ "guint"     = ("Int",    "GVuint")
genMarshalProperty _ "gfloat"    = ("Float",  "GVfloat")
genMarshalProperty _ "gdouble"   = ("Double", "GVdouble")
genMarshalProperty _ "gboolean"  = ("Bool",   "GVboolean")
genMarshalProperty _ "gchar*"    = ("String", "GVstring")

genMarshalProperty knownTypes typeName
            | isUpper (head typeName)
           && (typeKind == Just GObjectKind
           ||  typeKind == Just GtkObjectKind) =
  (shortTypeName, "GVobject")
  where shortTypeName = stripKnownPrefixes typeName
        typeKind = shortTypeName `lookup` knownTypes

genMarshalProperty knownTypes typeName
            | isUpper (head typeName)
           && typeKind == Just EnumKind =
  (shortTypeName, "GVenum")
  where shortTypeName = stripKnownPrefixes typeName
        typeKind = shortTypeName `lookup` knownTypes

genMarshalProperty knownTypes typeName
            | isUpper (head typeName)
           && typeKind == Just FlagsKind =
  (shortTypeName, "GVflags")
  where shortTypeName = stripKnownPrefixes typeName
        typeKind = shortTypeName `lookup` knownTypes

genMarshalProperty _ unknown = ("{-" ++ unknown ++ "-}", "{-" ++ unknown ++ "-}")

[Gtk2hs-commit] gtk2hs ChangeLog,1.337,1.338

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13323

Modified Files:
	ChangeLog 
Log Message:
Add support for interfaces.
Improve the generation of properties.
Deal with examples in a more general way.

format-docs.xsl: Deal with another kind of table in the documentation.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.337
retrieving revision 1.338
diff -u -d -r1.337 -r1.338
--- ChangeLog	4 Feb 2005 11:14:57 -0000	1.337
+++ ChangeLog	5 Feb 2005 01:21:46 -0000	1.338
@@ -1,3 +1,11 @@
+2005-02-05 Duncan Coutts <du...@co...>
+
+	* tools/apiGen/ApiGen.hs: addsupport for interfaces, deal with
+	examples in a more general way and improve the generation of
+	properties.
+
+	* tools/apiGen/format-docs.xsl: deal with another kind of table.
+
 2005-02-04 Axel Simon <A....@ke...>
 
 	* gtk/Graphics/UI/Gtk/Display/Image.chs: Added imageSetFromPixbuf.

[Gtk2hs-commit] gtk2hs/tools/apiGen ApiGen.hs,1.10,1.11 format-docs.xsl,1.9,1.10

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13323/tools/apiGen

Modified Files:
	ApiGen.hs format-docs.xsl 
Log Message:
Add support for interfaces.
Improve the generation of properties.
Deal with examples in a more general way.

format-docs.xsl: Deal with another kind of table in the documentation.


Index: format-docs.xsl
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/format-docs.xsl,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- format-docs.xsl	30 Jan 2005 19:49:11 -0000	1.9
+++ format-docs.xsl	5 Feb 2005 01:21:47 -0000	1.10
@@ -57,6 +57,21 @@
 <listitem><xsl:apply-templates/></listitem>
 </xsl:template>
 
+<xsl:template match="informaltable[tgroup/tbody/row]">
+<para><xsl:apply-templates/></para>
+</xsl:template>
+
+<xsl:template match="tgroup/tbody/row">
+<definition>
+	<term><xsl:apply-templates select="entry[1]"/></term>
+	<xsl:apply-templates select="entry[position()>1]"/>
+</definition>
+</xsl:template>
+
+<xsl:template match="keycombo">
+<xsl:value-of select="keycap[1]"/>-<xsl:value-of select="keycap[2]"/>
+</xsl:template>
+
 <xsl:template match="section | refsect2">
 <section>
 	<title><xsl:value-of select="title"/></title>
@@ -67,7 +82,7 @@
 <xsl:template match="example">
 <example>
 	<title><xsl:value-of select="title"/></title>
-	<xsl:apply-templates select="para | programlisting"/>
+	<xsl:apply-templates select="para | programlisting | informaltable"/>
 </example>
 </xsl:template>
 

Index: ApiGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- ApiGen.hs	30 Jan 2005 19:49:11 -0000	1.10
+++ ApiGen.hs	5 Feb 2005 01:21:47 -0000	1.11
@@ -156,6 +156,18 @@
     object_properties = catMaybes (map extractProperty content),
     object_signals = catMaybes (map extractSignal content)
   }
+extractObject (Xml.CElem (Xml.Elem "interface"
+                     [("name", Xml.AttValue name),
+                      ("cname", Xml.AttValue cname)] content)) =
+  Just $ Object {
+    object_name = Xml.verbatim name,
+    object_cname = Xml.verbatim cname,
+    object_parent = "GObject",
+    object_constructors = catMaybes (map extractConstructor content),
+    object_methods = catMaybes (map extractMethod content),
+    object_properties = catMaybes (map extractProperty content),
+    object_signals = catMaybes (map extractSignal content)
+  }
 extractObject _ = Nothing
 
 extractMethod :: Xml.Content -> Maybe Method
@@ -331,7 +343,7 @@
 data DocPara =
     DocParaText [DocParaSpan]           -- an ordinary word-wrapped paragraph
   | DocParaProgram String               -- a verbatum section
-  | DocParaExample String String        -- a verbatum section with a title
+  | DocParaTitle String                 -- a title to a subsection eg an example
   | DocParaDefItem [DocParaSpan] [DocParaSpan] -- a definition list item
   | DocParaListItem [DocParaSpan]       -- a itemisted list item
 
@@ -468,10 +480,9 @@
   let listing = concat [ str | (Xml.CString _ str) <- content ] in
   [DocParaProgram listing]
 extractDocPara (Xml.CElem (Xml.Elem "example" _
-                 [Xml.CElem (Xml.Elem "title" [] [Xml.CString _ title])
-                 ,(Xml.CElem (Xml.Elem "programlisting" _ content))])) =
-  let listing = concat [ str | (Xml.CString _ str) <- content ] in                 
-  [DocParaExample title listing]
+                 (Xml.CElem (Xml.Elem "title" [] [Xml.CString _ title])
+                 :content) )) =
+  [DocParaTitle title] ++ concatMap extractDocPara content 
 extractDocPara other = error $ "extractDocPara: " ++ Xml.verbatim other
 
 extractDocPara' :: [Xml.Content] -> [DocPara]
@@ -597,12 +608,8 @@
   . sepBy "\n-- > "
   . List.lines
   $ prog
-haddocFormatPara (DocParaExample title prog) =
-    ((ss "* ". ss title.nl.
-      comment).)
-  . sepBy "\n-- > "
-  . List.lines
-  $ prog
+haddocFormatPara (DocParaTitle title) =
+    ss "* ". ss title
 haddocFormatPara (DocParaDefItem term spans) =
   let def = (unwords . words . escape . concatMap haddocFormatSpan) term in
   sc '['. ss def. ss "] ".
@@ -829,25 +836,27 @@
 
 genProperties :: KnownTypes -> Object -> [PropDoc] -> [(ShowS, Since)]
 genProperties knownTypes object apiDoc = 
-  [ (genProperty object property doc, maybe "" propdoc_since doc)
+  [ (genProperty knownTypes object property doc, maybe "" propdoc_since doc)
   | (property, doc) <- properties object apiDoc ]
 
-genProperty :: Object -> Property -> Maybe PropDoc -> ShowS
-genProperty object property doc = 
+genProperty :: KnownTypes -> Object -> Property -> Maybe PropDoc -> ShowS
+genProperty knownTypes object property doc = 
   formattedDoc.
-  ss propertyName. ss " :: Attr ". objectType. sc ' '.propertyType. nl.
+  ss propertyName. ss " :: Attr ". objectType. sc ' '. ss 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-})"
+--        propertyType = ss "{- ". ss (property_type property). ss " -}"
+        getter = ss "(\\obj -> do ". ss gvalueConstructor. ss " result <- objectGetProperty \"". ss (property_cname property). ss "\"".
+                 indent 7. ss "return result"
+        setter = ss "(\\obj val -> objectSetProperty obj \"". ss (property_cname property). ss "\" (". ss gvalueConstructor. ss " val))"
         formattedDoc = case doc of
           Nothing  -> ss "-- | \n-- \n"
           Just doc -> ss "-- | ". haddocFormatParas (propdoc_paragraphs doc). nl.
                       comment. nl
+        (propertyType, gvalueConstructor) = genMarshalProperty knownTypes (property_type property)
 
 signals :: Object -> [SignalDoc] -> [(Signal, Maybe SignalDoc)]
 signals object docs =
@@ -1138,6 +1147,38 @@
 
 genMarshalResult _ unknownType = ("{-" ++ unknownType ++ "-}", id)
 
+genMarshalProperty :: KnownTypes -> String -> (String, String)
+genMarshalProperty _ "gint"      = ("Int",    "GVint")
+genMarshalProperty _ "guint"     = ("Int",    "GVuint")
+genMarshalProperty _ "gfloat"    = ("Float",  "GVfloat")
+genMarshalProperty _ "gdouble"   = ("Double", "GVdouble")
+genMarshalProperty _ "gboolean"  = ("Bool",   "GVboolean")
+genMarshalProperty _ "gchar*"    = ("String", "GVstring")
+
+genMarshalProperty knownTypes typeName
+            | isUpper (head typeName)
+           && (typeKind == Just GObjectKind
+           ||  typeKind == Just GtkObjectKind) =
+  (shortTypeName, "GVobject")
+  where shortTypeName = stripKnownPrefixes typeName
+        typeKind = shortTypeName `lookup` knownTypes
+
+genMarshalProperty knownTypes typeName
+            | isUpper (head typeName)
+           && typeKind == Just EnumKind =
+  (shortTypeName, "GVenum")
+  where shortTypeName = stripKnownPrefixes typeName
+        typeKind = shortTypeName `lookup` knownTypes
+
+genMarshalProperty knownTypes typeName
+            | isUpper (head typeName)
+           && typeKind == Just FlagsKind =
+  (shortTypeName, "GVflags")
+  where shortTypeName = stripKnownPrefixes typeName
+        typeKind = shortTypeName `lookup` knownTypes
+
+genMarshalProperty _ unknown = ("{-" ++ unknown ++ "-}", "{-" ++ unknown ++ "-}")
+
 -------------------------------------------------------------------------------
 -- Top level stuff
 -------------------------------------------------------------------------------
@@ -1261,7 +1302,7 @@
 	\  <modPrefix>     specify module name prefix, eg if using\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."
+	\                  uses types defined by Gdk and Pango.\n"
   exitWith $ ExitFailure 1
 
 

[Gtk2hs-commit] gtk2hs ChangeLog,1.336,1.337

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26947

Modified Files:
	ChangeLog 
Log Message:
Added imageSetFromPixbuf


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.336
retrieving revision 1.337
diff -u -d -r1.336 -r1.337
--- ChangeLog	3 Feb 2005 01:48:37 -0000	1.336
+++ ChangeLog	4 Feb 2005 11:14:57 -0000	1.337
@@ -1,4 +1,8 @@
-2005-02-3 Duncan Coutts <du...@co...>
+2005-02-04 Axel Simon <A....@ke...>
+
+	* gtk/Graphics/UI/Gtk/Display/Image.chs: Added imageSetFromPixbuf.
+	
+2005-02-03 Duncan Coutts <du...@co...>
 
 	* demo/calc/CalcModel.hs: fix a bug in formatting numbers for display.
 	I was stripping off trailing 0's too enthusiasticly.

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Display Image.chs,1.1,1.2

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Display
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26947/gtk/Graphics/UI/Gtk/Display

Modified Files:
	Image.chs 
Log Message:
Added imageSetFromPixbuf


Index: Image.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Display/Image.chs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Image.chs	8 Jan 2005 15:14:30 -0000	1.1
+++ Image.chs	4 Feb 2005 11:14:56 -0000	1.2
@@ -49,6 +49,7 @@
   iconSizeDialog,
   imageNewFromStock,
   imageGetPixbuf,
+  imageSetFromPixbuf,
   imageNewFromPixbuf
   ) where
 
@@ -90,6 +91,11 @@
   {#call unsafe image_get_pixbuf#} img
 
 
+-- | Overwrite the current content of the 'Image' with a new 'Pixbuf'.
+--
+imageSetFromPixbuf :: Image -> Pixbuf -> IO ()
+imageSetFromPixbuf img pb = {#call unsafe gtk_image_set_from_pixbuf#} img pb
+
 -- | Create an 'Image' from a 
 -- 'Pixbuf'.
 --

[Gtk2hs-commit] gtk2hs ChangeLog,1.335,1.336

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1987

Modified Files:
	ChangeLog 
Log Message:
Fix a bug in formatting numbers for display. I was stripping off trailing 0's
too enthusiasticly.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.335
retrieving revision 1.336
diff -u -d -r1.335 -r1.336
--- ChangeLog	31 Jan 2005 21:18:19 -0000	1.335
+++ ChangeLog	3 Feb 2005 01:48:37 -0000	1.336
@@ -1,3 +1,8 @@
+2005-02-3 Duncan Coutts <du...@co...>
+
+	* demo/calc/CalcModel.hs: fix a bug in formatting numbers for display.
+	I was stripping off trailing 0's too enthusiasticly.
+
 2005-01-31 Duncan Coutts <du...@co...>
 
 	* demo/glade/simple.glade: remove libgnome requirement, it was

[Gtk2hs-commit] gtk2hs/demo/calc CalcModel.hs,1.1,1.2

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/demo/calc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1987/demo/calc

Modified Files:
	CalcModel.hs 
Log Message:
Fix a bug in formatting numbers for display. I was stripping off trailing 0's
too enthusiasticly.


Index: CalcModel.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/demo/calc/CalcModel.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- CalcModel.hs	28 Jan 2005 00:15:20 -0000	1.1
+++ CalcModel.hs	3 Feb 2005 01:48:37 -0000	1.2
@@ -113,13 +113,15 @@
 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 "")
-
+showNumber num =
+  if '.' `elem` numStr then stripTrailingZeros numStr
+                       else numStr
+  where numStr = showGFloat precision num ""
+        stripTrailingZeros =
+            reverse
+          . (\str -> if head str == '.' then tail str else str)
+          . dropWhile (\c -> c=='0')
+          . reverse
 
 testProg :: IO ()
 testProg = do

[Gtk2hs-commit] gtk2hs/demo/glade simple.glade,1.1,1.2

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/demo/glade
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29970/demo/glade

Modified Files:
	simple.glade 
Log Message:
Remove libgnome requirement, it was unnecesary.


Index: simple.glade
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/demo/glade/simple.glade,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- simple.glade	11 Dec 2003 22:48:24 -0000	1.1
+++ simple.glade	31 Jan 2005 21:18:25 -0000	1.2
@@ -2,7 +2,6 @@
 <!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">
 
 <glade-interface>
-<requires lib="gnome"/>
 
 <widget class="GtkWindow" id="window1">
   <property name="visible">True</property>

[Gtk2hs-commit] gtk2hs ChangeLog,1.334,1.335

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29970

Modified Files:
	ChangeLog 
Log Message:
Remove libgnome requirement, it was unnecesary.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.334
retrieving revision 1.335
diff -u -d -r1.334 -r1.335
--- ChangeLog	31 Jan 2005 00:01:48 -0000	1.334
+++ ChangeLog	31 Jan 2005 21:18:19 -0000	1.335
@@ -1,3 +1,8 @@
+2005-01-31 Duncan Coutts <du...@co...>
+
+	* demo/glade/simple.glade: remove libgnome requirement, it was
+	unnecesary.
+
 2005-01-30 Duncan Coutts <du...@co...>
 
 	* tools/apiGen/ApiGen.hs: first go at generating signals including

[Gtk2hs-commit] gtk2hs ChangeLog,1.333,1.334

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132

Modified Files:
	ChangeLog 
Log Message:
Remove the directories where the old non-hierarchical modules used to live.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.333
retrieving revision 1.334
diff -u -d -r1.333 -r1.334
--- ChangeLog	30 Jan 2005 19:49:10 -0000	1.333
+++ ChangeLog	31 Jan 2005 00:01:48 -0000	1.334
@@ -6,6 +6,12 @@
 	* tools/apiGen/format-docs.xsl: extract signal documentation, and
 	adjust for new formatting of property documentation.
 
+	* gtk/abstract, gtk/buttons, gtk/display, gtk/embedding, gtk/entry,
+	gtk/gdk, gtk/general, gtk/glib, gtk/layout, gtk/menuComboToolbar,
+	gtk/misc, gtk/multiline, gtk/ornaments, gtk/pango, gtk/scrolling,
+	gtk/selectors, gtk/signals, gtk/treeList, gtk/typehier, gtk/windows:
+	remove directories where the non-hierarchical modules used to live.
+
 2005-01-28 Duncan Coutts <du...@co...>
 
 	* tools/apiGen/Makefile: use sed to do the patching rather than an

[Gtk2hs-commit] gtk2hs/gtk/windows Dialog.chs,1.6,NONE FileChooserDialog.chs.pp,1.1,NONE FileSel.chs,1.7,NONE Window.chs.pp,1.1,NONE api.ignore,1.2,NONE

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/windows
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/windows

Removed Files:
	Dialog.chs FileChooserDialog.chs.pp FileSel.chs Window.chs.pp 
	api.ignore 
Log Message:
Remove the directories where the old non-hierarchical modules used to live.


--- Dialog.chs DELETED ---

--- Window.chs.pp DELETED ---

--- FileChooserDialog.chs.pp DELETED ---

--- FileSel.chs DELETED ---

--- api.ignore DELETED ---

[Gtk2hs-commit] gtk2hs/gtk/treeList CellRenderer.hs,1.7,NONE CellRendererPixbuf.chs,1.8,NONE CellRendererText.chs,1.11,NONE CellRendererToggle.chs,1.9,NONE ListStore.chs.pp,1.1,NONE StoreValue.hsc,1.8,NONE TreeModel.chs.pp,1.1,NONE TreeModelSort.chs,1.4,NONE TreeSelection.chs,1.12,NONE TreeStore.chs.pp,1.1,NONE TreeView.chs.pp,1.3,NONE TreeViewColumn.chs,1.9,NONE api.ignore,1.4,NONE

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/treeList
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/treeList

Removed Files:
	CellRenderer.hs CellRendererPixbuf.chs CellRendererText.chs 
	CellRendererToggle.chs ListStore.chs.pp StoreValue.hsc 
	TreeModel.chs.pp TreeModelSort.chs TreeSelection.chs 
	TreeStore.chs.pp TreeView.chs.pp TreeViewColumn.chs api.ignore 
Log Message:
Remove the directories where the old non-hierarchical modules used to live.


--- TreeStore.chs.pp DELETED ---

--- ListStore.chs.pp DELETED ---

--- TreeSelection.chs DELETED ---

--- CellRendererPixbuf.chs DELETED ---

--- CellRendererToggle.chs DELETED ---

--- api.ignore DELETED ---

--- TreeViewColumn.chs DELETED ---

--- CellRendererText.chs DELETED ---

--- TreeModelSort.chs DELETED ---

--- TreeView.chs.pp DELETED ---

--- CellRenderer.hs DELETED ---

--- StoreValue.hsc DELETED ---

--- TreeModel.chs.pp DELETED ---

[Gtk2hs-commit] gtk2hs/gtk/selectors ColorSelection.chs,1.1,NONE ColorSelectionDialog.chs,1.1,NONE FontSelection.chs,1.1,NONE FontSelectionDialog.chs,1.1,NONE api.ignore,1.1,NONE

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/selectors
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/selectors

Removed Files:
	ColorSelection.chs ColorSelectionDialog.chs FontSelection.chs 
	FontSelectionDialog.chs api.ignore 
Log Message:
Remove the directories where the old non-hierarchical modules used to live.


--- FontSelection.chs DELETED ---

--- FontSelectionDialog.chs DELETED ---

--- ColorSelectionDialog.chs DELETED ---

--- ColorSelection.chs DELETED ---

--- api.ignore DELETED ---

[Gtk2hs-commit] gtk2hs/gtk/scrolling HScrollbar.chs,1.6,NONE ScrolledWindow.chs,1.8,NONE VScrollbar.chs,1.6,NONE

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/scrolling
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31132/gtk/scrolling

Removed Files:
	HScrollbar.chs ScrolledWindow.chs VScrollbar.chs 
Log Message:
Remove the directories where the old non-hierarchical modules used to live.


--- VScrollbar.chs DELETED ---

--- ScrolledWindow.chs DELETED ---

--- HScrollbar.chs DELETED ---