gtk2hs-commit — Mailing list for Darcs commit messages.

[Gtk2hs-commit] gtk2hs ChangeLog,1.111,1.112 configure.in,1.30,1.31

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv18432

Modified Files:
	ChangeLog configure.in 
Log Message:
Docu.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.111
retrieving revision 1.112
diff -u -d -r1.111 -r1.112
--- ChangeLog	16 Nov 2003 13:30:55 -0000	1.111
+++ ChangeLog	16 Nov 2003 13:43:14 -0000	1.112
@@ -1,5 +1,8 @@
 2003-11-16 Axel Simon <A....@ke...>
 
+	* configure.in, INSTALL: Documentation updates. In particular, the
+	user has to do a make and then a make install.
+	
 	* configure.in: Force Unix library names when using ghc <6.0.
 
 	* c2hs/C/CParser.hs: Fix the parsing of __attribute__, necessary

Index: configure.in
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/configure.in,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- configure.in	16 Nov 2003 13:30:55 -0000	1.30
+++ configure.in	16 Nov 2003 13:43:14 -0000	1.31
@@ -567,5 +567,5 @@
   fi;
   echo "*                                                *"
 fi;
-echo "* Now do \"(g)make install\".                      *"
+echo "* Now do \"(g)make\" followed by \"(g)make install\" *"
 echo "**************************************************"

[Gtk2hs-commit] gtk2hs INSTALL,1.6,1.7

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv16281

Modified Files:
	INSTALL 
Log Message:
Change the installation docs for windows.


Index: INSTALL
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/INSTALL,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- INSTALL	15 Nov 2003 19:23:59 -0000	1.6
+++ INSTALL	16 Nov 2003 13:37:53 -0000	1.7
@@ -139,8 +139,7 @@
 Building on Window
 --------------------
 
-Install MSYS and MinGW (you might get away without MinGW, I haven't
-tried).  Download the following files from
+Install MSYS and MinGW.  Download the following files from
 http://www.gimp.org/~tml/gimp/win32/downloads.html : atk-1.4.0.zip,
 atk-dev-1.4.0.zip, gettext-runtime-0.12.1.bin.woe32.zip,
 glib-2.2.3.zip, glib-dev-2.2.3.zip, gtk+-2.2.4.zip,
@@ -149,12 +148,14 @@
 *separate* (1) directory from MinGW. Add the bin/ and the /lib
 directory to your path via the Control Panel (or right-clicking My
 Computer, Properties, Advanced). Make sure GHC is in your
-path. Proceed with the general instructions.
+path. Proceed with the general instructions. If you have the right to
+modify the global package file, then I recommend to install the
+library into the ghc directory by using configure's --prefix= option.
 
 (1) If you don't use a separate directory, GHC's local gcc might pick
 up libraries from MinGW, resulting in link errors or worse.
 
-Report problems to the Gtk2hs mailing list
+Please report problems to the Gtk2hs mailing list
 <gtk...@li...>.
 
 Have fun,

[Gtk2hs-commit] gtk2hs ChangeLog,1.110,1.111 configure.in,1.29,1.30

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv15348

Modified Files:
	ChangeLog configure.in 
Log Message:
Path mangeling, library names and parser fixes for Windows.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.110
retrieving revision 1.111
diff -u -d -r1.110 -r1.111
--- ChangeLog	16 Nov 2003 12:16:27 -0000	1.110
+++ ChangeLog	16 Nov 2003 13:30:55 -0000	1.111
@@ -1,5 +1,14 @@
 2003-11-16 Axel Simon <A....@ke...>
 
+	* configure.in: Force Unix library names when using ghc <6.0.
+
+	* c2hs/C/CParser.hs: Fix the parsing of __attribute__, necessary
+	for Windows.
+
+	* mk/library.mk: Uncomment the path mangeling. On Windows this
+	is still mandatory as /d/ has to be turned into d:/ when generating
+	package.conf files.
+
 	* mk/config.in, mk/library.mk, install-sh: Make sure the package
 	installs if the local install-sh script is used. Added different
 	variables for the install command, depending on what is installed.

Index: configure.in
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/configure.in,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -d -r1.29 -r1.30
--- configure.in	15 Nov 2003 10:34:41 -0000	1.29
+++ configure.in	16 Nov 2003 13:30:55 -0000	1.30
@@ -151,6 +151,15 @@
 ])
 AC_MSG_RESULT([$FOUR_WORD_CALLBACK])
 
+dnl ghc-pkg 5 searches for libxxx.a, even on Windows. Hence, we need to
+dnl create libraries with these names instead of the windows names.
+GTKHS_PROG_CHECK_VERSION($GHC_VERSION, -lt, 6.0.0, [
+  SLSUFFIX=".a";
+  SLPREFIX="lib";
+  DLSUFFIX=".so";
+  DLPREFIX="lib";
+])
+
 dnl Check if this ghc uses the new hierachical module system. If so, we don't
 dnl need to depend on the "lang" or "data" package (which don't exist anymore).
 AC_MSG_CHECKING([new module system])

[Gtk2hs-commit] gtk2hs/mk common.mk,1.26,1.27

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

Update of /cvsroot/gtk2hs/gtk2hs/mk
In directory sc8-pr-cvs1:/tmp/cvs-serv15348/mk

Modified Files:
	common.mk 
Log Message:
Path mangeling, library names and parser fixes for Windows.


Index: common.mk
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/mk/common.mk,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- common.mk	11 Nov 2003 12:04:26 -0000	1.26
+++ common.mk	16 Nov 2003 13:30:55 -0000	1.27
@@ -25,10 +25,10 @@
 INST_INCLDIR		?= $(INST_HIDIR)
 INST_BINDIR		?= $(addsuffix $(INSTALLDIROK),$(bindir))
 
-#INST_HIDIR		:= $(shell echo $(INST_HIDIR) | $(SEDPIPE))
-#INST_LIBDIR		:= $(shell echo $(INST_LIBDIR) | $(SEDPIPE))
-#INST_INCLDIR		:= $(shell echo $(INST_INCLDIR) | $(SEDPIPE))
-#INST_BINDIR		:= $(shell echo $(INST_BINDIR) | $(SEDPIPE))
+INST_HIDIR		:= $(shell echo $(INST_HIDIR) | $(SEDPIPE))
+INST_LIBDIR		:= $(shell echo $(INST_LIBDIR) | $(SEDPIPE))
+INST_INCLDIR		:= $(shell echo $(INST_INCLDIR) | $(SEDPIPE))
+INST_BINDIR		:= $(shell echo $(INST_BINDIR) | $(SEDPIPE))
 
 # these values are used for building a library in-place
 INPL_HIDIR		:= $(sort $(patsubst %/.,%,$(patsubst %/,%,\

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

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

Update of /cvsroot/gtk2hs/gtk2hs/c2hs/c
In directory sc8-pr-cvs1:/tmp/cvs-serv15348/c2hs/c

Modified Files:
	CParser.hs 
Log Message:
Path mangeling, library names and parser fixes for Windows.


Index: CParser.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/c2hs/c/CParser.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- CParser.hs	18 Jan 2003 17:53:59 -0000	1.3
+++ CParser.hs	16 Nov 2003 13:30:55 -0000	1.4
@@ -346,10 +346,11 @@
 --
 parseCDecl :: CParser CDecl
 parseCDecl  = 
-  list (
       ctoken_ (CTokGnuC GnuCExtTok) `opt` ()      -- ignore GCC's __extension__
-  -*> parseCDeclSpec 
-  *-> optMaybe parseGnuCAttr			  -- ignore GCC's __attribute__
+  -*> optMaybe parseGnuCAttr
+  -*> list (
+        parseCDeclSpec *-> 
+	optMaybe parseGnuCAttr			  -- ignore GCC's __attribute__
   )*> seplist comma_ parseCInitDecl *-> semic_
   `actionAttrs`
     (\(specs, declrs) -> 
@@ -532,7 +533,7 @@
 --
 parseCDeclr :: CParser CDeclr
 parseCDeclr  =
-      (pointer `opt` id)
+      ((pointer *-> optMaybe parseGnuCAttr) `opt` id)
   *>  base
   *>  many (flip (.)) id (arrayType <|> newStyleFun <|> oldStyleFun)
   *-> optMaybe parseGnuCAttr			  -- ignore GCC's __attribute__

[Gtk2hs-commit] gtk2hs ChangeLog,1.109,1.110 install-sh,1.1.1.1,1.2

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv4401

Modified Files:
	ChangeLog install-sh 
Log Message:
Make install should really work with the local install-sh script! Now it does.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -d -r1.109 -r1.110
--- ChangeLog	16 Nov 2003 11:13:34 -0000	1.109
+++ ChangeLog	16 Nov 2003 12:16:27 -0000	1.110
@@ -1,5 +1,10 @@
 2003-11-16 Axel Simon <A....@ke...>
 
+	* mk/config.in, mk/library.mk, install-sh: Make sure the package
+	installs if the local install-sh script is used. Added different
+	variables for the install command, depending on what is installed.
+	Updated install-sh with a newer version.
+	
 	* gtk/layout/Notebook.chs: The function notebookGetNPages does not
 	exist in Gtk 2.0. Do not bind it in this case.
 	

Index: install-sh
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/install-sh,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -d -r1.1.1.1 -r1.2
--- install-sh	24 Mar 2002 21:56:19 -0000	1.1.1.1
+++ install-sh	16 Nov 2003 12:16:29 -0000	1.2
@@ -109,7 +109,7 @@
 	echo "install:	no input file specified"
 	exit 1
 else
-	true
+	:
 fi
 
 if [ x"$dir_arg" != x ]; then
@@ -120,7 +120,7 @@
 		instcmd=:
 		chmodcmd=""
 	else
-		instcmd=mkdir
+		instcmd=$mkdirprog
 	fi
 else
 
@@ -130,7 +130,7 @@
 
 	if [ -f $src -o -d $src ]
 	then
-		true
+		:
 	else
 		echo "install:  $src does not exist"
 		exit 1
@@ -141,7 +141,7 @@
 		echo "install:	no destination specified"
 		exit 1
 	else
-		true
+		:
 	fi
 
 # If destination is a directory, append the input filename; if your system
@@ -151,7 +151,7 @@
 	then
 		dst="$dst"/`basename $src`
 	else
-		true
+		:
 	fi
 fi
 
@@ -163,8 +163,8 @@
 
 # Skip lots of stat calls in the usual case.
 if [ ! -d "$dstdir" ]; then
-defaultIFS='	
-'
+defaultIFS='
+	'
 IFS="${IFS-${defaultIFS}}"
 
 oIFS="${IFS}"
@@ -183,7 +183,7 @@
         then
 		$mkdirprog "${pathcomp}"
 	else
-		true
+		:
 	fi
 
 	pathcomp="${pathcomp}/"
@@ -194,10 +194,10 @@
 then
 	$doit $instcmd $dst &&
 
-	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
-	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
-	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
-	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
+	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else : ; fi &&
+	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else : ; fi &&
+	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else : ; fi &&
+	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else : ; fi
 else
 
 # If we're going to rename the final executable, determine the name now.
@@ -216,7 +216,7 @@
 	then
 		dstfile=`basename $dst`
 	else
-		true
+		:
 	fi
 
 # Make a temp file name in the proper directory.
@@ -235,10 +235,10 @@
 # ignore errors from any of these, just make sure not to ignore
 # errors from the above "$doit $instcmd $src $dsttmp" command.
 
-	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
-	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
-	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
-	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
+	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else :;fi &&
+	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else :;fi &&
+	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else :;fi &&
+	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else :;fi &&
 
 # Now rename the file to the real destination.
 

[Gtk2hs-commit] gtk2hs/mk config.mk.in,1.20,1.21 library.mk,1.20,1.21

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

Update of /cvsroot/gtk2hs/gtk2hs/mk
In directory sc8-pr-cvs1:/tmp/cvs-serv4401/mk

Modified Files:
	config.mk.in library.mk 
Log Message:
Make install should really work with the local install-sh script! Now it does.


Index: config.mk.in
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/mk/config.mk.in,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- config.mk.in	11 Nov 2003 12:04:56 -0000	1.20
+++ config.mk.in	16 Nov 2003 12:16:29 -0000	1.21
@@ -13,6 +13,9 @@
 TAR		= @TAR@
 TOUCH		= @TOUCH@
 INSTALL		= @INSTALL@
+INSTALL_PROGRAM	= @INSTALL_PROGRAM@
+INSTALL_DATA	= @INSTALL_DATA@
+INSTALL_DIR	= @INSTALL@ -d
 CPP		= @CPP@
 CC		= @CC@
 

Index: library.mk
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/mk/library.mk,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- library.mk	11 Nov 2003 12:06:00 -0000	1.20
+++ library.mk	16 Nov 2003 12:16:30 -0000	1.21
@@ -53,20 +53,20 @@
 	fi
 
 installdirs :
-	$(INSTALL) -d $(DESTDIR)$(INST_LIBDIR) $(DESTDIR)$(INST_HIDIR) $(DESTDIR)$(INST_INCLDIR)
+	$(INSTALL_DIR) $(DESTDIR)$(INST_LIBDIR) $(DESTDIR)$(INST_HIDIR) $(DESTDIR)$(INST_INCLDIR)
 
 install-without-pkg : $(TARGETOK) installdirs installfiles
 
 install : install-without-pkg install-pkg
 
 installfiles : $(PACKAGENAME).conf
-	$(INSTALL) -m644 $(ALLHSFILES:.hs=.hi) $(DESTDIR)$(INST_HIDIR)
-	$(INSTALL) -m644 $(TARGETOK) $(DESTDIR)$(INST_LIBDIR)
+	$(INSTALL_DATA) $(ALLHSFILES:.hs=.hi) $(DESTDIR)$(INST_HIDIR)
+	$(INSTALL_DATA) $(TARGETOK) $(DESTDIR)$(INST_LIBDIR)
 	$(TOUCH) -r $(TARGETOK) $(DESTDIR)$(INST_LIBDIR)/$(TARGETOK)
 ifneq ($(strip $(STUBHFILES) $(EXTRA_HFILESOK)),)
-	$(INSTALL) -m644 $(STUBHFILES) $(EXTRA_HFILESOK) $(DESTDIR)$(INST_INCLDIR)
+	$(INSTALL_DATA) $(STUBHFILES) $(EXTRA_HFILESOK) $(DESTDIR)$(INST_INCLDIR)
 endif
-	$(INSTALL) -m644 $(PACKAGENAME).conf $(DESTDIR)$(INST_LIBDIR)
+	$(INSTALL_DATA) $(PACKAGENAME).conf $(DESTDIR)$(INST_LIBDIR)
 
 $(PACKAGENAME).conf :
 	@echo Package {\

[Gtk2hs-commit] gtk2hs/gtk/layout Notebook.chs,1.5,1.6

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

Update of /cvsroot/gtk2hs/gtk2hs/gtk/layout
In directory sc8-pr-cvs1:/tmp/cvs-serv28714/gtk/layout

Modified Files:
	Notebook.chs 
Log Message:
Make compile with Gtk 2.0.


Index: Notebook.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/layout/Notebook.chs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Notebook.chs	9 Jul 2003 22:42:44 -0000	1.5
+++ Notebook.chs	16 Nov 2003 11:13:35 -0000	1.6
@@ -1,3 +1,4 @@
+{-# OPTIONS -cpp #-}
 -- -*-haskell-*-
 --  GIMP Toolkit (GTK) @entry Widget Notebook@
 --
@@ -39,6 +40,7 @@
 -- * The signals focus-tab and select-page are not bound because it is unclear
 --   what they mean. As far as I can see they are not emitted anywhere.
 --
+#include<gtk/gtkversion.h>
 module Notebook(
   Notebook,
   NotebookClass,
@@ -68,7 +70,9 @@
   notebookGetCurrentPage,
   notebookGetMenuLabel,
   notebookGetNthPage,
+#if GTK_CHECK_VERSION(2,2,0)
   notebookGetNPages,
+#endif
   notebookGetTabLabel,
   Packing(..), PackType(..),
   notebookQueryTabLabelPacking,
@@ -322,11 +326,17 @@
   if wPtr==nullPtr then return Nothing else liftM Just $
     makeNewObject mkWidget $ return wPtr
 
+#if GTK_CHECK_VERSION(2,2,0)
+
 -- @method notebookGetNPages@ Get the number of pages in a notebook.
 --
+-- * Only available in Gtk 2.2 and higher.
+--
 notebookGetNPages :: NotebookClass nb => nb -> IO Int
 notebookGetNPages nb = liftM fromIntegral $
   {#call unsafe notebook_get_n_pages#} (toNotebook nb)
+
+#endif
 
 -- @method notebookGetTabLabel@ Extract the tab label from the given
 -- @ref arg child@.

[Gtk2hs-commit] gtk2hs ChangeLog,1.108,1.109

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv28714

Modified Files:
	ChangeLog 
Log Message:
Make compile with Gtk 2.0.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.108
retrieving revision 1.109
diff -u -d -r1.108 -r1.109
--- ChangeLog	15 Nov 2003 19:23:59 -0000	1.108
+++ ChangeLog	16 Nov 2003 11:13:34 -0000	1.109
@@ -1,4 +1,9 @@
-2003-11-07 Axel Simon <A....@ke...>
+2003-11-16 Axel Simon <A....@ke...>
+
+	* gtk/layout/Notebook.chs: The function notebookGetNPages does not
+	exist in Gtk 2.0. Do not bind it in this case.
+	
+2003-11-15 Axel Simon <A....@ke...>
 
 	* INSTALL: Add instructions for Windows.
 	

[Gtk2hs-commit] gtk2hs ChangeLog,1.107,1.108 INSTALL,1.5,1.6

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv21555

Modified Files:
	ChangeLog INSTALL 
Log Message:
Add instructions for Windows.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.107
retrieving revision 1.108
diff -u -d -r1.107 -r1.108
--- ChangeLog	15 Nov 2003 11:39:07 -0000	1.107
+++ ChangeLog	15 Nov 2003 19:23:59 -0000	1.108
@@ -1,5 +1,7 @@
 2003-11-07 Axel Simon <A....@ke...>
 
+	* INSTALL: Add instructions for Windows.
+	
 	* Makefile: Only build Sourceview if ENABLE_SOURCEVIEW is set.
 	
 	* mk/recurse.mk: Add a distclean goal that removes the

Index: INSTALL
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/INSTALL,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- INSTALL	19 Dec 2002 18:13:31 -0000	1.5
+++ INSTALL	15 Nov 2003 19:23:59 -0000	1.6
@@ -1,17 +1,18 @@
 gtk2hs: A binding of Gtk Version 2 for the programming language Haskell
 
-This binding makes functions from the following libraries available:
- * glib-2.0.0
- * atk-1.0.0
- * pango-1.0.0
- * gtk+-2.0.0
+The library currently wraps most functions for GUI programming from
+the gtk 2.0 libraries. Furthermore there is support for the Pixbuf
+functions and the SourceView widget.
 
-Furthermore the GHC Haskell compiler, version 5.02 or greater, is
-required. The library cannot be used with GHCi at the moment due to some
-linking problems which we haven't quite figured out.
+The GHC Haskell compiler, version 5.02 or greater, is required. Some
+callback (those with more than 4 words of arguments...) cannot be used
+on Solaris due to a limitation in GHC. Gtk2hs has been compiled
+successfully on FreeBSD, Linux, Solaris, Darwin and Windows (MinGW).
 
-INSTALLATION
-------------
+Building
+--------
+
+If you build on Windows, read "Building on Windows" first.
 
 The following assumes that the sources are in ~/gtk2hs.
 1. Produce a configure file.
@@ -134,6 +135,24 @@
   path where the GTK dynamic libraries live. It is a bug in the 5.02
   distribution of GHC that hsc2hs does not stop here. Delete Foo.hs
   before you do a second attempt.
+
+Building on Window
+--------------------
+
+Install MSYS and MinGW (you might get away without MinGW, I haven't
+tried).  Download the following files from
+http://www.gimp.org/~tml/gimp/win32/downloads.html : atk-1.4.0.zip,
+atk-dev-1.4.0.zip, gettext-runtime-0.12.1.bin.woe32.zip,
+glib-2.2.3.zip, glib-dev-2.2.3.zip, gtk+-2.2.4.zip,
+gtk+-dev-2.2.4.zip, libiconv-1.9.1.bin.woe32.zip, pango-1.2.5.zip,
+pango-dev-1.2.5.zip, pkgconfig-0.15.zip. Unpack these files in a
+*separate* (1) directory from MinGW. Add the bin/ and the /lib
+directory to your path via the Control Panel (or right-clicking My
+Computer, Properties, Advanced). Make sure GHC is in your
+path. Proceed with the general instructions.
+
+(1) If you don't use a separate directory, GHC's local gcc might pick
+up libraries from MinGW, resulting in link errors or worse.
 
 Report problems to the Gtk2hs mailing list
 <gtk...@li...>.

[Gtk2hs-commit] gtk2hs Makefile,1.22,1.23

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv12378

Modified Files:
	Makefile 
Log Message:
Only build the sourceview example if ENABLE_SOURCEVIEW is yes.


Index: Makefile
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- Makefile	15 Nov 2003 11:39:07 -0000	1.22
+++ Makefile	15 Nov 2003 11:51:44 -0000	1.23
@@ -25,7 +25,12 @@
 MAKE_LIBS += mogul
 
 MAKE_APPS  = demo/concurrent demo/treeList demo/graphic demo/unicode \
-	     demo/hello demo/sourceview
+	     demo/hello 
+
+ifeq ($(strip $(ENABLE_SOURCEVIEW)),yes)
+MAKE_APPS += demo/sourceview
+endif
+
 
 EXTRA_TARFILES = $(strip AUTHORS COPYING.LIB ChangeLog INSTALL Makefile \
 			 TODO VERSION aclocal.m4 acinclude.m4 \

[Gtk2hs-commit] gtk2hs ChangeLog,1.106,1.107 Makefile,1.21,1.22

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv10779

Modified Files:
	ChangeLog Makefile 
Log Message:
Only build soureview if the configure script finds the library.
Stop on error in recursive build.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.106
retrieving revision 1.107
diff -u -d -r1.106 -r1.107
--- ChangeLog	15 Nov 2003 11:17:03 -0000	1.106
+++ ChangeLog	15 Nov 2003 11:39:07 -0000	1.107
@@ -1,7 +1,10 @@
 2003-11-07 Axel Simon <A....@ke...>
 
+	* Makefile: Only build Sourceview if ENABLE_SOURCEVIEW is set.
+	
 	* mk/recurse.mk: Add a distclean goal that removes the
-	localpackage.conf file.
+	localpackage.conf file. Make the build stop if there is an error
+	in one of the subdirectories.
 
 	* gtk/treeView/TreeSelection.chs: Remove a deprecated warning.
 	

Index: Makefile
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- Makefile	15 Nov 2003 10:34:41 -0000	1.21
+++ Makefile	15 Nov 2003 11:39:07 -0000	1.22
@@ -16,7 +16,13 @@
 MAKE_DOCS  =  gendoc doc
 endif
 
-MAKE_LIBS  = gtk sourceview mogul
+MAKE_LIBS  = gtk 
+
+ifeq ($(strip $(ENABLE_SOURCEVIEW)),yes)
+MAKE_LIBS += sourceview
+endif
+
+MAKE_LIBS += mogul
 
 MAKE_APPS  = demo/concurrent demo/treeList demo/graphic demo/unicode \
 	     demo/hello demo/sourceview

[Gtk2hs-commit] gtk2hs/mk recurse.mk,1.4,1.5

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

Update of /cvsroot/gtk2hs/gtk2hs/mk
In directory sc8-pr-cvs1:/tmp/cvs-serv10779/mk

Modified Files:
	recurse.mk 
Log Message:
Only build soureview if the configure script finds the library.
Stop on error in recursive build.


Index: recurse.mk
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/mk/recurse.mk,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- recurse.mk	15 Nov 2003 11:17:04 -0000	1.4
+++ recurse.mk	15 Nov 2003 11:39:07 -0000	1.5
@@ -34,4 +34,4 @@
 uninstall : make-uninstall
 
 make-% :
-	for dir in $(MAKE_GOALS); do $(MAKE) $* -C$$dir ; done;
+	for dir in $(MAKE_GOALS); do $(MAKE) $* -C$$dir || exit 1; done;

[Gtk2hs-commit] gtk2hs/gtk/treeList TreeSelection.chs,1.7,1.8

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

Update of /cvsroot/gtk2hs/gtk2hs/gtk/treeList
In directory sc8-pr-cvs1:/tmp/cvs-serv7363/gtk/treeList

Modified Files:
	TreeSelection.chs 
Log Message:
Added a distclean target. Eliminated a warning in TreeSelection.chs.


Index: TreeSelection.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/treeList/TreeSelection.chs,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- TreeSelection.chs	9 Jul 2003 22:42:46 -0000	1.7
+++ TreeSelection.chs	15 Nov 2003 11:17:04 -0000	1.8
@@ -146,7 +146,7 @@
                                 TreeSelectionForeachCB -> IO ()
 treeSelectionSelectedForeach ts fun = do
   fPtr <- mkTreeSelectionForeachFunc (\_ ti _ -> do
-    -- make a deep copy of the iterator. This make it possible to store this
+    -- make a deep copy of the iterator. This makes it possible to store this
     -- iterator in Haskell land somewhere. The TreeModel parameter is not
     -- passed to the function due to performance reasons. But since it is
     -- a constant member of Selection this does not matter.
@@ -164,9 +164,17 @@
 type TreeSelectionForeachCB = TreeIter -> IO ()
 {#pointer TreeSelectionForeachFunc#}
 
+#if __GLASGOW_HASKELL__>=600
+
+foreign import ccall "wrapper"  mkTreeSelectionForeachFunc ::
+  (Ptr () -> Ptr TreeIter -> Ptr () -> IO ()) -> IO TreeSelectionForeachFunc
+
+#else
+
 foreign export dynamic mkTreeSelectionForeachFunc ::
   (Ptr () -> Ptr TreeIter -> Ptr () -> IO ()) -> IO TreeSelectionForeachFunc
 
+#endif
 
 -- @method treeSelectionSelectPath@ Select a specific item by TreePath.
 --

[Gtk2hs-commit] gtk2hs ChangeLog,1.105,1.106

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv7363

Modified Files:
	ChangeLog 
Log Message:
Added a distclean target. Eliminated a warning in TreeSelection.chs.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.105
retrieving revision 1.106
diff -u -d -r1.105 -r1.106
--- ChangeLog	15 Nov 2003 10:34:41 -0000	1.105
+++ ChangeLog	15 Nov 2003 11:17:03 -0000	1.106
@@ -1,5 +1,10 @@
 2003-11-07 Axel Simon <A....@ke...>
 
+	* mk/recurse.mk: Add a distclean goal that removes the
+	localpackage.conf file.
+
+	* gtk/treeView/TreeSelection.chs: Remove a deprecated warning.
+	
 	* configure.in: Closed a case expression. Simplified and corrected
 	the search for XML catalog files.
 

[Gtk2hs-commit] gtk2hs/gtk Makefile,1.25,1.26

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

Update of /cvsroot/gtk2hs/gtk2hs/gtk
In directory sc8-pr-cvs1:/tmp/cvs-serv7363/gtk

Modified Files:
	Makefile 
Log Message:
Added a distclean target. Eliminated a warning in TreeSelection.chs.


Index: Makefile
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Makefile,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- Makefile	15 Nov 2003 10:34:41 -0000	1.25
+++ Makefile	15 Nov 2003 11:17:03 -0000	1.26
@@ -6,10 +6,6 @@
 	  misc multiline ornaments scrolling \
 	  treeList windows gdk glib pango ../compat
 
-ifeq ($(ENABLE_OPENGL),yes)
-SUBDIRS += glext
-endif
-
 ifeq ($(WIN32),yes)
 EXTRA_HFILES	= $(TOP)/gtk/wingtk.h
 SUBSYSTEM	= windows

[Gtk2hs-commit] gtk2hs/mk recurse.mk,1.3,1.4

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

Update of /cvsroot/gtk2hs/gtk2hs/mk
In directory sc8-pr-cvs1:/tmp/cvs-serv7363/mk

Modified Files:
	recurse.mk 
Log Message:
Added a distclean target. Eliminated a warning in TreeSelection.chs.


Index: recurse.mk
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/mk/recurse.mk,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- recurse.mk	11 Nov 2003 12:06:41 -0000	1.3
+++ recurse.mk	15 Nov 2003 11:17:04 -0000	1.4
@@ -20,6 +20,10 @@
 clean : MAKE_GOALS=$(MAKE_TOOLS) $(MAKE_LIBS) $(MAKE_DOCS) $(MAKE_APPS) $(MAKE_VERB)
 clean : make-clean
 
+distclean : MAKE_GOALS=$(MAKE_TOOLS) $(MAKE_LIBS) $(MAKE_DOCS) $(MAKE_APPS) $(MAKE_VERB)
+distclean : make-distclean
+	$(RM) $(LOCALPKGCONF) $(LOCALPKGCONF).old
+
 install : MAKE_GOALS=$(MAKE_LIBS) $(MAKE_APPS)
 install : make-install
 

[Gtk2hs-commit] gtk2hs ChangeLog,1.104,1.105 Makefile,1.20,1.21 configure.in,1.28,1.29

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv1701

Modified Files:
	ChangeLog Makefile configure.in 
Log Message:
Added an esac in configure, corrected the search for XML catalogs.
Change signals/ to callbackGen/.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -d -r1.104 -r1.105
--- ChangeLog	15 Nov 2003 09:48:21 -0000	1.104
+++ ChangeLog	15 Nov 2003 10:34:41 -0000	1.105
@@ -1,5 +1,11 @@
 2003-11-07 Axel Simon <A....@ke...>
 
+	* configure.in: Closed a case expression. Simplified and corrected
+	the search for XML catalog files.
+
+	* gtk/Makefile, sourceview/Makefile: Make them use the tools in
+	tools/callbackGen and tools/hierarchyGen.
+	
 	* tools/typehier, tools/signals, tools/hierarchyGen,
 	tools/callbackGen: Moved this files to a different
 	directory. Reason: Everytime I remove the two directories typehier

Index: Makefile
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- Makefile	11 Nov 2003 12:01:21 -0000	1.20
+++ Makefile	15 Nov 2003 10:34:41 -0000	1.21
@@ -2,7 +2,7 @@
 
 include $(TOP)/mk/config.mk
 
-MAKE_TOOLS = tools/typehier tools/signals
+MAKE_TOOLS = tools/hierarchyGen tools/callbackGen
 
 ifeq ($(strip $(BUILT_IN_C2HS)),no)
 MAKE_VERB  += c2hs

Index: configure.in
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/configure.in,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- configure.in	11 Nov 2003 12:02:04 -0000	1.28
+++ configure.in	15 Nov 2003 10:34:41 -0000	1.29
@@ -297,7 +297,7 @@
 	    [  --with-mlist=GTK-SOURCE use special marshall list from GTK+ sources],
 	    [MARSHALLDEFS=$withval;
 	     AC_MSG_RESULT($withval)],
-	    [MARSHALLDEFS=$TOP/tools/signals/gtkmarshal.list;
+	    [MARSHALLDEFS=$TOP/tools/callbackGen/gtkmarshal.list;
 	     AC_MSG_RESULT(built-in)])
 
 
@@ -378,6 +378,7 @@
           ** Download from \"http://www.cse.unsw.edu.au/~chak/haskell/c2hs/\". **]))
       dnl C->Haskell configuration.
       } ;;
+  esac;
 fi
 
 # Read the version file
@@ -397,16 +398,12 @@
   FOUNDTRANSLATOR=no;
 fi
 
+XML_CATALOG_FILES=/usr/local/share/xml/catalog:/usr/share/xml/catalog;
 AC_ARG_WITH(catalog,
   [  --with-catalog=catalog  an XML catalog file pointing to DocBook],
-  [XML_CATALOG_FILES=$withval;], 
-  [if test -z $XML_CATALOG_FILES; then
-    case "$target" in
-	*freebsd*) XML_CATALOG_FILES=/usr/local/share/xml/catalog;;
-	*) XML_CATALOG_FILES=/usr/share/xml/catalog;;
-    esac
-  fi])
-AC_MSG_CHECKING([files XML catalog])
+  [XML_CATALOG_FILES=$withval:$XML_CATALOG_FILES])
+
+AC_MSG_CHECKING([for XML catalog])
 OLDIFS=$IFS;
 IFS=:;
 FOUNDCATALOG=no;

[Gtk2hs-commit] gtk2hs/gtk Makefile,1.24,1.25

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

Update of /cvsroot/gtk2hs/gtk2hs/gtk
In directory sc8-pr-cvs1:/tmp/cvs-serv1701/gtk

Modified Files:
	Makefile 
Log Message:
Added an esac in configure, corrected the search for XML catalogs.
Change signals/ to callbackGen/.


Index: Makefile
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Makefile,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -d -r1.24 -r1.25
--- Makefile	7 Nov 2003 15:30:40 -0000	1.24
+++ Makefile	15 Nov 2003 10:34:41 -0000	1.25
@@ -198,10 +198,10 @@
 ENABLEBROKEN	=
 endif
 
-general/Signal.chs : $(TOP)/tools/signals/Signal.chs-boot1 \
-		     $(TOP)/tools/signals/Signal.chs-boot2
-	$(strip $(TOP)/tools/signals/HookGenerator $(MARSHALLDEFS) \
-	$(TOP)/tools/signals/ general/Signal.chs $(ENABLEBROKEN))
+general/Signal.chs : $(TOP)/tools/callbackGen/Signal.chs-boot1 \
+		     $(TOP)/tools/callbackGen/Signal.chs-boot2
+	$(strip $(TOP)/tools/callbackGen/HookGenerator $(MARSHALLDEFS) \
+	$(TOP)/tools/callbackGen/ general/Signal.chs $(ENABLEBROKEN))
 
 EXTRA_CHSFILES	+=  general/Hierarchy.chs
 
@@ -211,9 +211,9 @@
 CREATE_TYPES = plugNsocket default
 endif
 
-general/Hierarchy.chs : $(TOP)/tools/typehier/hierarchy.list
-	$(strip $(TOP)/tools/typehier/TypeGenerator \
-	$(TOP)/tools/typehier/hierarchy.list \
+general/Hierarchy.chs : $(TOP)/tools/hierarchyGen/hierarchy.list
+	$(strip $(TOP)/tools/hierarchyGen/TypeGenerator \
+	$(TOP)/tools/hierarchyGen/hierarchy.list \
 	general/Hierarchy.chs $(addprefix --tag=,$(CREATE_TYPES)))
 
 include $(TOP)/mk/common.mk

[Gtk2hs-commit] gtk2hs/sourceview Makefile,1.5,1.6

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

Update of /cvsroot/gtk2hs/gtk2hs/sourceview
In directory sc8-pr-cvs1:/tmp/cvs-serv1701/sourceview

Modified Files:
	Makefile 
Log Message:
Added an esac in configure, corrected the search for XML catalogs.
Change signals/ to callbackGen/.


Index: Makefile
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/sourceview/Makefile,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Makefile	11 Nov 2003 12:07:16 -0000	1.5
+++ Makefile	15 Nov 2003 10:34:42 -0000	1.6
@@ -46,9 +46,9 @@
 EXTRA_CLEANFILES+= SourceViewType.chs
 NEEDCHI = SourceViewType
 
-SourceViewType.chs : ../tools/typehier/hierarchy.list
-	$(strip ../tools/typehier/TypeGenerator \
-	../tools/typehier/hierarchy.list \
+SourceViewType.chs : ../tools/hierarchyGen/hierarchy.list
+	$(strip ../tools/hierarchyGen/TypeGenerator \
+	../tools/hierarchyGen/hierarchy.list \
 	SourceViewType.chs \
 	$(addprefix --tag=,$(TYPE_TAGS)))
 

[Gtk2hs-commit] gtk2hs/gtk/typehier .cvsignore,1.2,NONE Makefile,1.1.1.1,NONE TypeGenerator.hs,1.8,NONE hierarchy.list,1.8,NONE

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

Update of /cvsroot/gtk2hs/gtk2hs/gtk/typehier
In directory sc8-pr-cvs1:/tmp/cvs-serv27664/gtk/typehier

Removed Files:
	.cvsignore Makefile TypeGenerator.hs hierarchy.list 
Log Message:
Again, remove the stale files.


--- .cvsignore DELETED ---

--- Makefile DELETED ---

--- TypeGenerator.hs DELETED ---

--- hierarchy.list DELETED ---

[Gtk2hs-commit] gtk2hs/gtk/signals .cvsignore,1.2,NONE HookGenerator.hs,1.4,NONE Makefile,1.1.1.1,NONE Signal.chs-boot1,1.2,NONE Signal.chs-boot2,1.4,NONE gtkmarshal.list,1.3,NONE

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

Update of /cvsroot/gtk2hs/gtk2hs/gtk/signals
In directory sc8-pr-cvs1:/tmp/cvs-serv27664/gtk/signals

Removed Files:
	.cvsignore HookGenerator.hs Makefile Signal.chs-boot1 
	Signal.chs-boot2 gtkmarshal.list 
Log Message:
Again, remove the stale files.


--- .cvsignore DELETED ---

--- HookGenerator.hs DELETED ---

--- Makefile DELETED ---

--- Signal.chs-boot1 DELETED ---

--- Signal.chs-boot2 DELETED ---

--- gtkmarshal.list DELETED ---

[Gtk2hs-commit] gtk2hs ChangeLog,1.103,1.104

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1:/tmp/cvs-serv27170

Modified Files:
	ChangeLog 
Log Message:
Again, trying to remove the stale directories in gtk/.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.103
retrieving revision 1.104
diff -u -d -r1.103 -r1.104
--- ChangeLog	15 Nov 2003 09:17:58 -0000	1.103
+++ ChangeLog	15 Nov 2003 09:48:21 -0000	1.104
@@ -1,7 +1,12 @@
 2003-11-07 Axel Simon <A....@ke...>
 
-	* tools/typehier/TypeGen.hs: Renamed file to sort out CVS problem.
+	* tools/typehier, tools/signals, tools/hierarchyGen,
+	tools/callbackGen: Moved this files to a different
+	directory. Reason: Everytime I remove the two directories typehier
+	and signals from gtk/, CVS removes them from tools.
 	
+	* tools/typehier/TypeGen.hs: Renamed file to sort out CVS problem.
+
 2003-11-11  Jens Petersen  <pet...@ha...>
 
 	* demo/sourceview: New directory for import of sourceview demo

[Gtk2hs-commit] gtk2hs/tools/hierarchyGen Makefile,NONE,1.1 TypeGen.hs,NONE,1.1 hierarchy.list,NONE,1.1

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

Update of /cvsroot/gtk2hs/gtk2hs/tools/hierarchyGen
In directory sc8-pr-cvs1:/tmp/cvs-serv26936/hierarchyGen

Added Files:
	Makefile TypeGen.hs hierarchy.list 
Log Message:
Another attempt to move the files.


--- NEW FILE: Makefile ---
TOP = ../..

include $(TOP)/mk/config.mk

APPNAME = TypeGenerator

MAIN = TypeGen.hs

EXTRA_TARFILES	+= hierarchy.list

include $(TOP)/mk/common.mk


--- NEW FILE: TypeGen.hs ---
-- TypeGenerator.hs
-- Takes a hierarchical list of all objects in GTK+ and produces
-- Haskell class that reflect this hierarchy.
module Main(main) where

import Char(showLitChar, isAlpha, isAlphaNum, isSpace, toLower, isUpper)
import List(nub, isPrefixOf)
import Maybe(catMaybes, fromMaybe)
import Monad(when)
import System(getArgs, exitWith, ExitCode(..))

-- The current object and its inheritence relationship is defined by all
-- ancestors and their column position.
type ObjectSpec = [(Int,String)]

-- This is a mapping from a type name to a) the type name in Haskell and
-- b) the GTK blah_get_type function.
type TypeQuery  = Maybe (String, (String, String))

-- A Tag is a string restricting the generation of type entries to
-- those lines that have the appropriate "if <tag>" at the end.
type Tag = String

data ParserState = ParserState {
  line		:: Int,
  col	        :: Int,
  hierObjs	:: ObjectSpec,
  onlyTags	:: [Tag]
  }

freshParserState :: [Tag] -> ParserState
freshParserState = ParserState 1 1 []

-- The parser returns a list of ObjectSpec and possibly a special type query
-- function. Each ObjectSpec describes one object with all its parents.

pFreshLine :: ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFreshLine ps input = pFL ps input
  where
    pFL ps ('#':rem)		= pFL ps (dropWhile ((/=) '\n') rem)
    pFL ps ('\n':rem)	 	= pFL (ps {line = line ps+1, col=1}) rem
    pFL ps (' ':rem)		= pFL (ps {col=col ps+1}) rem
    pFL ps ('\t':rem)		= pFL (ps {col=col ps+8}) rem
    pFL ps ('G':'t':'k':rem) 	= pGetObject ps rem
    pFL ps []			= []
    pFL ps all			= pGetObject ps all

pGetObject :: ParserState -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ps@ParserState { onlyTags=tags } txt = 
  (if readTag `elem` tags then (:) (spec, specialQuery) else id) $
  pFreshLine (ps { hierObjs=spec}) (dropWhile ((/=) '\n') rem'')
  where
    isBlank     c = c==' ' || c=='\t'
    isAlphaNum_ c = isAlphaNum c || c=='_'
    (origName,rem) = span isAlphaNum txt
    (name,specialQuery,rem') = case (dropWhile isBlank rem) of
      ('a':'s':r) ->
        let (tyName,r') = span isAlphaNum_ (dropWhile isBlank r) in
          case (dropWhile isBlank r') of
	    (',':r) ->
	      let (tyQuery,r') = span isAlphaNum_ (dropWhile isBlank r) in
	        (tyName, Just (tyName, (origName, tyQuery)), r')
	    r -> error ("line "++show (line ps)++
		        ": Expected a comma, found:"++take 5 r)
      r -> (origName, Nothing, r)
    parents = dropWhile (\(c,_) -> c>=col ps) (hierObjs ps)
    spec = (col ps,name):parents
    (readTag, rem'') = case (dropWhile isBlank rem) of
      ('i':'f':r) -> span isAlphaNum_ (dropWhile isBlank r)
      r -> ("default",r)


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

ss = showString
sc = showChar

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

-------------------------------------------------------------------------------
-- start of code generation
-------------------------------------------------------------------------------


main = do
  args <- getArgs
  when (length args<2) usage
  let (hierFile: goalFile: rem) = args
  let tags = map (drop 6) (filter ("--tag=" `isPrefixOf`)  rem)
  content <- readFile hierFile
  let (objs, specialQueries) = unzip $
				 pFreshLine (freshParserState tags) content
  let bareFName = reverse . 
		  takeWhile isAlphaNum .
		  drop 1 .
		  dropWhile isAlpha .
		  reverse		     
  writeFile goalFile $
    generate (bareFName goalFile)
      (map (map snd) objs) (catMaybes specialQueries) ""


usage = do
 putStr "\nProgram to generate Gtk's object hierarchy in Haskell. Usage:\n\
	\TypeGenerator <hierFile> <outFile> {--tag=<tag>}\n\
	\where\n\
	\  <hierFile>	   a list of all possible objects, the hierarchy is\n\
	\		   taken from the indentation\n\
	\  <outFile>	   is the name and path of the output file\n\
	\  <tag>           generate entries that have the tag <tag>\n\
	\		   specify `default' for types without tags\n"
 exitWith $ ExitFailure 1



-------------------------------------------------------------------------------
-- generate dynamic fragments
-------------------------------------------------------------------------------

generate :: String -> [[String]] -> [(String, (String, String))] -> ShowS
generate fname objs typeTable = 
  let fillCol str = ss $ replicate 
		    (maximum (map (length.head) objs)-length str) ' ' 
  in
           ss "-- -*-haskell-*-".
  indent 0.ss "-- ******************** automatically generated file - do not edit **********".
  indent 0.ss "--  Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell".
  indent 0.ss "--".
  indent 0.ss "--  Author : Axel Simon".
  indent 0.ss "--".
  indent 0.ss "--  Copyright (c) 2001-2003 Axel Simon".
  indent 0.ss "--".
  indent 0.ss "--  This file is free software; you can redistribute it and/or modify".
  indent 0.ss "--  it under the terms of the GNU General Public License as published by".
  indent 0.ss "--  the Free Software Foundation; either version 2 of the License, or".
  indent 0.ss "--  (at your option) any later version.".
  indent 0.ss "--".
  indent 0.ss "--  This file is distributed in the hope that it will be useful,".
  indent 0.ss "--  but WITHOUT ANY WARRANTY; without even the implied warranty of".
  indent 0.ss "--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the".
  indent 0.ss "--  GNU General Public License for more details.".
  indent 0.ss "--".
  indent 0.ss "--- @description@ -------------------------------------------------------------".
  indent 0.ss "--".
  indent 0.ss "--  * This file reflects the Gtk object hierarchy in terms of Haskell classes.".
  indent 0.ss "--".
  indent 0.ss "--- @documentation@ -----------------------------------------------------------".
  indent 0.ss "--".
  indent 0.ss "--".
  indent 0.ss "--- @todo@ --------------------------------------------------------------------".
  indent 0.ss "--".
  indent 0.ss "--".
  indent 0.ss "module ".ss fname.sc '('.
--  indent 1.ss "ObjectTag(..)".
  foldl (\s1 s2 -> s1.ss ", ".s2) id (map (\(n:_) -> 
		indent 1.ss n.ss "(".ss n.ss "), ".ss n.ss "Class(..),".
		indent 1.ss "mk".ss n.ss ", un".ss n.sc ','.
		indent 1.ss "castTo".ss n) objs).
  indent 1.ss ") where".
  indent 0.
  indent 0.ss "import FFI	(ForeignPtr, castForeignPtr, foreignPtrToPtr,".  ss " CULong)".
  indent 0.ss "import GType    (typeInstanceIsA)".
  -- this is a very bad hack to get the definition of the ancestors whenever
  -- these are not created in this file
  (if fname/="Hierarchy" then indent 0.ss "{#import Hierarchy#}" else id).
  indent 0.
  indent 0.ss "{#context lib=\"gtk\" prefix=\"gtk\" #}".
  indent 0.
  indent 0.ss "castToGObject = id".
  indent 0.
  indent 0.ss "-- The usage of foreignPtrToPtr should be safe as the evaluation will only be".
  indent 0.ss "-- forced if the object is used afterwards".
  indent 0.
  foldl (.) id (map (makeUpcast typeTable) objs).
  indent 0.
--  indent 0.ss "data ObjectTag  ".makeTypeTags '=' (map head objs).
--  indent 0.
--  indent 0.ss "instance Ord ObjectTag where".
--  foldl (.) id (map (makeOrd fillCol) objs).
--  indent 1.ss "compare ".ss "_   ".fillCol "_".ss " _   ".fillCol "_".
--    ss " = LT".
--  indent 0.
  indent 0.
  foldl (.) id (map (makeClass typeTable) objs)

makeTypeTags :: Char -> [String] -> ShowS
makeTypeTags c [] = ss "deriving Eq"
makeTypeTags c (obj:ects) = sc c.sc ' '.ss obj.ss "Tag".indent 8.
			    makeTypeTags '|' ects

makeUpcast table [obj]	   = id -- no casting for GObject
makeUpcast table (obj:_:_) = 
  indent 0.ss "castTo".ss obj.ss " :: GObjectClass obj => obj -> ".ss obj.
  indent 0.ss "castTo".ss obj.ss " obj =".
  indent 1.ss "if typeInstanceIsA ((foreignPtrToPtr.castForeignPtr.unGObject.toGObject) obj)".
  indent 2.ss "{#call fun unsafe ".
    ss (maybe ("gtk"++c2u True obj++"_get_type") snd (lookup obj table)).
    ss "#} then".
  indent 3.ss "(fromGObject.toGObject) obj else".
  indent 4.ss "error \"Cannot cast object to ".ss obj.ss ".\"".
  indent 0
  where
    -- case to underscore translation: the boolean arg specifies whether
    -- the first uppercase letter X is to be replaced by _x (True) or by x.
    --
    -- translation:	HButtonBox -> hbutton_box
    c2u :: Bool -> String -> String
    c2u True  (x:xs) | isUpper x = '_':toLower x:c2u False xs
    c2u False (x:xs) | isUpper x = toLower x:c2u True xs
    c2u _     (x:xs) | otherwise = x:c2u True xs
    c2u _     []		 = []

makeOrd fill []          = id
makeOrd fill (obj:preds) = indent 1.ss "compare ".ss obj.ss "Tag ".
			   fill obj.ss obj.ss "Tag".fill obj.
			   ss " = EQ".makeGT obj preds
  where
    makeGT obj []	= id
    makeGT obj (pr:eds) = indent 1.ss "compare ".ss obj.ss "Tag ".
			  fill obj.ss pr.ss "Tag".fill pr.
			  ss " = GT".makeGT obj eds

makeClass :: [(String,(String, String))] -> [String] -> ShowS
makeClass table (name:parents) =
  indent 0.ss "-- ".ss (replicate (75-length name) '*').sc ' '.ss name.
  indent 0.
  indent 0.ss "{#pointer *".
  maybe (ss name) (\s -> ss (fst s).ss " as ".ss name) (lookup name table).
  ss " foreign newtype #}".
  indent 0.
  indent 0.ss "mk".ss name.ss " = ".ss name.
  indent 0.ss "un".ss name.ss " (".ss name.ss " o) = o".
  indent 0.
  indent 0.ss "class ".
    (if not (null parents) then ss (head parents).ss "Class o => " else id).
	   ss name.ss "Class o where".
  indent 1.ss "to".ss name.ss "   :: o -> ".ss name.
  indent 1.ss "from".ss name.ss " :: ".ss name.ss " -> o".
  indent 0.
  indent 0.ss "instance ".ss name.ss "Class ".ss name.ss " where".
  indent 1.ss "to".ss name.ss "   = id".
  indent 1.ss "from".ss name.ss " = id".
  indent 0.
  makeInstance name parents.
  indent 0

makeInstance :: String -> [String] -> ShowS
makeInstance name []         = id
makeInstance name (par:ents) =
  indent 0.ss "instance ".ss par.ss "Class ".ss name.ss " where".
  indent 1.ss "to".ss par.ss "   = mk".ss par.ss ".castForeignPtr.un".ss name.
  indent 1.ss "from".ss par.ss " = mk".ss name.ss ".castForeignPtr.un".ss par.
  indent 0.
  makeInstance name ents

 
  

--- NEW FILE: hierarchy.list ---
# This list is the result of a copy-and-paste from the GtkObject hierarchy
# html documentation. Deprecated widgets are uncommented. Some additional
# object have been defined at the end of the copied list.

# The Gtk prefix of every object is removed, the other prefixes are
# kept.  The indentation implies the object hierarchy. In case the
# type query function cannot be derived from the name or the type name
# is different, an alternative name and type query function can be
# specified by appending `as typename, <query_func>'.  In case this
# function is not specified, the <name> is converted to
# gtk_<name'>_get_type where <name'> is <name> where each upperscore
# letter is converted to an underscore and lowerletter. The underscore
# is omitted if an upperscore letter preceeded: GtkHButtonBox ->
# gtk_hbutton_box_get_type. The generation of a type can be
# conditional by appending `if <tag>'. Such types are only produces if
# --only=<tag> is given on the command line of TypeGenerator.
    GObject 
        GdkDrawable 			as Drawable, gdk_drawable_get_type
            GdkWindow		as DrawWindow, gdk_window_object_get_type
#            GdkDrawableImplX11
#                GdkWindowImplX11
            GdkPixmap			as Pixmap, gdk_pixmap_get_type
        GdkColormap			as Colormap, gdk_colormap_get_type
        GtkSettings
        GtkTextBuffer
            GtkSourceBuffer	if sourceview
        GtkTextTag
            GtkSourceTag	if sourceview
        GtkTextTagTable
            GtkSourceTagTable	if sourceview
        GtkStyle
        GdkDragContext		as DragContext, gdk_drag_context_get_type
        GdkPixbuf			as Pixbuf, gdk_pixbuf_get_type
        GtkTextChildAnchor
        GtkTextMark
        GtkObject
            GtkWidget
                GtkMisc
                    GtkLabel
                        GtkAccelLabel
                        GtkTipsQuery
                    GtkArrow
                    GtkImage
                GtkContainer
                    GtkBin
                        GtkAlignment
                        GtkFrame
                            GtkAspectFrame
                        GtkButton
                            GtkToggleButton
                                GtkCheckButton
                                    GtkRadioButton
                            GtkOptionMenu
                        GtkItem
                            GtkMenuItem
                                GtkCheckMenuItem
                                    GtkRadioMenuItem
                                GtkTearoffMenuItem
                                GtkImageMenuItem
                            GtkListItem
#			    GtkTreeItem
                        GtkWindow
                            GtkDialog
                                GtkColorSelectionDialog
                                GtkFileSelection
                                GtkFontSelectionDialog
                                GtkInputDialog
                                GtkMessageDialog
                            GtkPlug	if plugNsocket
                        GtkEventBox
                        GtkHandleBox
                        GtkScrolledWindow
                        GtkViewport
                    GtkBox
                        GtkButtonBox
                            GtkHButtonBox
                            GtkVButtonBox
                        GtkVBox
                            GtkColorSelection
                            GtkFontSelection
                            GtkGammaCurve
                        GtkHBox
                            GtkCombo
                            GtkStatusbar
                    GtkCList
                        GtkCTree
                    GtkFixed
                    GtkPaned
                        GtkHPaned
                        GtkVPaned
                    GtkLayout
                    GtkList
                    GtkMenuShell
                        GtkMenu
                        GtkMenuBar
                    GtkNotebook
#                    GtkPacker
                    GtkSocket		if plugNsocket
                    GtkTable
                    GtkTextView
                        GtkSourceView	if sourceview
                    GtkToolbar
                    GtkTreeView
                GtkCalendar
                GtkDrawingArea
                    GtkCurve
                GtkEntry
                    GtkSpinButton
                GtkRuler
                    GtkHRuler
                    GtkVRuler
                GtkRange
                    GtkScale
                        GtkHScale
                        GtkVScale
                    GtkScrollbar
                        GtkHScrollbar
                        GtkVScrollbar
                GtkSeparator
                    GtkHSeparator
                    GtkVSeparator
                GtkInvisible
#                GtkOldEditable
#                    GtkText
                GtkPreview
# Progress is deprecated, ProgressBar contains everything necessary
#                GtkProgress
                GtkProgressBar
            GtkAdjustment
            GtkIMContext
                GtkIMMulticontext
            GtkItemFactory
            GtkTooltips

# These object were added by hand because they do not show up in the hierarchy
# chart.
# These are derived from GtkObject:
	    GtkTreeViewColumn
	    GtkCellRenderer
		GtkCellRendererPixbuf
		GtkCellRendererText
#		    GtkCellRendererTextPixbuf
		GtkCellRendererToggle
# These are derived from GObject:
        GtkTreeSelection
        GtkTreeModel
            GtkTreeStore
            GtkListStore
	GtkTreeModelSort
	GtkIconFactory
        GtkSourceLanguage		if sourceview
        GtkSourceLanguagesManager	if sourceview
# This now became a GObject in version 2:
	GdkGC				as GC, gdk_gc_get_type
# These are Pango structures
	PangoContext		as PangoContext, pango_context_get_type
	PangoLayout		as PangoLayout, pango_layout_get_type
	PangoFont		as Font, pango_font_get_type
	PangoFontFamily		as FontFamiliy, pango_font_family_get_type
	PangoFontFace		as FontFace, pango_font_face_get_type
	PangoFontMap		as FontMap, pango_font_face_get_type
	PangoFontset		as FontSet, pango_fontset_get_type
# This type is only available for PANGO_ENABLE_BACKEND compiled source
#	    PangoFontsetSimple	as FontSetSimple, pango_fontset_simple_get_type

[Gtk2hs-commit] gtk2hs/tools/callbackGen HookGenerator.hs,NONE,1.1 Makefile,NONE,1.1 Signal.chs-boot1,NONE,1.1 Signal.chs-boot2,NONE,1.1 gtkmarshal.list,NONE,1.1

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

Update of /cvsroot/gtk2hs/gtk2hs/tools/callbackGen
In directory sc8-pr-cvs1:/tmp/cvs-serv26936/callbackGen

Added Files:
	HookGenerator.hs Makefile Signal.chs-boot1 Signal.chs-boot2 
	gtkmarshal.list 
Log Message:
Another attempt to move the files.


--- NEW FILE: HookGenerator.hs ---
{-# OPTIONS -cpp #-}
-- HookGenerator.hs -*-haskell-*-
-- Takes a type list of possible hooks from the GTK+ distribution and produces
-- Haskell functions to connect to these callbacks.
module Main(main) where

import Char(showLitChar)
import List(nub, partition)
import Maybe(catMaybes)
import System(getArgs, exitWith, ExitCode(..))

-- Define all possible data types the GTK will supply in callbacks.
--
data Types = Tunit		-- ()
	   | Tbool		-- Bool
	   | Tchar
	   | Tuchar
	   | Tint		-- Int
	   | Tuint
	   | Tlong
	   | Tulong
	   | Tenum
	   | Tflags
	   | Tfloat
	   | Tdouble
	   | Tstring
	   | Tboxed  		-- a struct which is passed by value
	   | Tptr		-- pointer
	   | Tobject		-- foreign with GObjectClass context
	   deriving Eq

type Signature = (Types,[Types])
type Signatures = [Signature]

-------------------------------------------------------------------------------
-- Handle broken Solaris
-------------------------------------------------------------------------------

-- If this type of arguement is True then we are compiling for
-- Sparc Solaris for which ghc does not know how to generate dynamic callbacks
-- with more than four arguments.
type BrokenSolaris = Bool

-- Each callback is given a pointer to the object is was emitted from.
-- We need to take this into account when we talk about 4 arguments.
fakeSignature :: BrokenSolaris -> Signature -> Bool
fakeSignature brokenSolaris (_,args) = brokenSolaris &&
				       sum (map sizeOf args) > 3
  where
    sizeOf Tunit   = 0
    sizeOf Tbool   = 1
    sizeOf Tchar   = 1
    sizeOf Tuchar  = 1
    sizeOf Tint    = 1
    sizeOf Tuint   = 1
    sizeOf Tlong   = 2
    sizeOf Tulong  = 1
    sizeOf Tenum   = 1
    sizeOf Tflags  = 1
    sizeOf Tfloat  = 2
    sizeOf Tdouble = 4
    sizeOf Tstring = 1
    sizeOf Tboxed  = 1
    sizeOf Tptr	   = 1
    sizeOf Tobject = 1

-------------------------------------------------------------------------------
-- Parsing
-------------------------------------------------------------------------------
     
parseSignatures :: String -> Signatures
parseSignatures content = (nub.parseSig 1.scan) content

data Token = TokColon
	   | TokType Types
	   | TokComma
	   | TokEOL

instance Show Token where
  showsPrec _ TokColon = shows ":"
  showsPrec _ (TokType _) = shows "<type>"
  showsPrec _ TokComma = shows ","
  showsPrec _ TokEOL = shows "<EOL>"

parseSig :: Int -> [Token] -> Signatures
parseSig l [] = []
parseSig l (TokEOL: rem) = parseSig (l+1) rem
parseSig l (TokType ret: TokColon: TokType Tunit:rem) =
  (ret,[]):parseSig l rem
parseSig l (TokType ret: TokColon: rem) =
  let (args,rem') = parseArg l rem in
  (ret,args): parseSig (l+1) rem'
parseSig l rem = error ("parse error on line "++show l++
		       ": expected type and colon, found\n"++
		       concatMap show (take 5 rem))

parseArg :: Int -> [Token] -> ([Types],[Token])
parseArg l [TokType ty] = ([ty],[])
parseArg l (TokType ty: TokEOL:rem) = ([ty],rem)
parseArg l (TokType ty: TokComma:rem) =
  let (args,rem') = parseArg l rem in
  (ty:args, rem')
parseArg l rem = error ("parse error on line "++show l++": expected type"++
                        " followed by comma or EOL, found\n "++ 
		       concatMap show (take 5 rem))

scan :: String -> [Token]
scan "" = []
scan ('#':xs) = (scan.dropWhile (/='\n'))  xs
scan ('\n':xs) = TokEOL:scan xs
scan (' ':xs) = scan xs
scan ('\t':xs) = scan xs
scan (':':xs) = TokColon:scan xs
scan (',':xs) = TokComma:scan xs
scan ('V':'O':'I':'D':xs) = TokType Tunit:scan xs
scan ('B':'O':'O':'L':'E':'A':'N':xs) = TokType Tbool:scan xs
scan ('C':'H':'A':'R':xs) = TokType Tchar:scan xs
scan ('U':'C':'H':'A':'R':xs) = TokType Tuchar:scan xs
scan ('I':'N':'T':xs) = TokType Tint:scan xs
scan ('U':'I':'N':'T':xs) = TokType Tuint:scan xs
scan ('L':'O':'N':'G':xs) = TokType Tuint:scan xs
scan ('U':'L':'O':'N':'G':xs) = TokType Tulong:scan xs
scan ('E':'N':'U':'M':xs) = TokType Tenum:scan xs
scan ('F':'L':'A':'G':'S':xs) = TokType Tflags:scan xs
scan ('F':'L':'O':'A':'T':xs) = TokType Tfloat:scan xs
scan ('D':'O':'U':'B':'L':'E':xs) = TokType Tdouble:scan xs
scan ('S':'T':'R':'I':'N':'G':xs) = TokType Tstring:scan xs
scan ('B':'O':'X':'E':'D':xs) = TokType Tboxed:scan xs
scan ('P':'O':'I':'N':'T':'E':'R':xs) = TokType Tptr:scan xs
scan ('O':'B':'J':'E':'C':'T':xs) = TokType Tobject:scan xs
scan ('N':'O':'N':'E':xs) = TokType Tunit:scan xs
scan ('B':'O':'O':'L':xs) = TokType Tbool:scan xs
scan str = error ("Invalid character in input file:\n"++
	   concatMap ((flip showLitChar) "") (take 5 str))


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

ss = showString
sc = showChar

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

-------------------------------------------------------------------------------
-- Tables of code fragments
-------------------------------------------------------------------------------

identifier :: Types -> ShowS
identifier Tunit    = ss "NONE"
identifier Tbool    = ss "BOOL"
identifier Tchar    = ss "BYTE"
identifier Tuchar   = ss "UBYTE"
identifier Tint	    = ss "INT"
identifier Tuint    = ss "WORD"
identifier Tlong    = ss "LONG"
identifier Tulong   = ss "ULONG"
identifier Tenum    = ss "ENUM"
identifier Tflags   = ss "FLAGS"
identifier Tfloat   = ss "FLOAT"
identifier Tdouble  = ss "DOUBLE"
identifier Tstring  = ss "STRING"
identifier Tboxed   = ss "BOXED"
identifier Tptr	    = ss "PTR"
identifier Tobject  = ss "OBJECT"

-- The monomorphic type which is used to export the function signature.
rawtype :: Types -> ShowS
rawtype Tunit    = ss "()"
rawtype Tbool    = ss "{#type gboolean#}"
rawtype Tchar    = ss "{#type gchar#}"
rawtype Tuchar   = ss "{#type guchar#}"
rawtype Tint	 = ss "{#type gint#}"
rawtype Tuint    = ss "{#type guint#}"
rawtype Tlong    = ss "{#type glong#}"
rawtype Tulong   = ss "{#type gulong#}"
rawtype Tenum    = ss "{#type gint#}"
rawtype Tflags   = ss "{#type guint#}"
rawtype Tfloat   = ss "{#type gfloat#}"
rawtype Tdouble  = ss "{#type gdouble#}"
rawtype Tstring  = ss "CString"
rawtype Tboxed   = ss "Ptr ()"
rawtype Tptr	 = ss "Ptr ()"
rawtype Tobject  = ss "Ptr GObject"

-- The possibly polymorphic type which 
usertype :: Types -> [Char] -> (ShowS,[Char])
usertype Tunit	  cs = (ss "()",cs)
usertype Tbool	  cs = (ss "Bool",cs)
usertype Tchar	  cs = (ss "Char",cs)
usertype Tuchar	  cs = (ss "Int",cs)
usertype Tint	  (c:cs) = (sc c,cs) 
usertype Tuint	  (c:cs) = (sc c,cs)
usertype Tlong	  cs = (ss "Integer",cs)
usertype Tulong	  cs = (ss "Integer",cs)
usertype Tenum	  (c:cs) = (sc c,cs)
usertype Tflags   cs = usertype Tenum cs
usertype Tfloat	  cs = (ss "Float",cs)
usertype Tdouble  cs = (ss "Double",cs)
usertype Tstring  cs = (ss "String",cs)
usertype Tboxed   (c:cs) = (sc c,cs)
usertype Tptr	  (c:cs) = (ss "Ptr ".sc c,cs)
usertype Tobject  (c:cs) = (sc c.sc '\'',cs)


-- type declaration: only consume variables when they are needed
--
-- * Tint is used as return value as well. Therefore Integral has to be added
--   to the context. Grrr.
--
context :: [Types] -> [Char] -> [ShowS]
context (Tint:ts)     (c:cs) = ss "Num ".sc c.ss ", Integral ".sc c: 
			       context ts cs
context (Tuint:ts)    (c:cs) = ss "Num ".sc c: context ts cs
context (Tenum:ts)    (c:cs) = ss "Enum ".sc c: context ts cs
context (Tflags:ts)   cs     = context (Tenum:ts) cs
context (Tboxed:ts)   (c:cs) = context ts cs
context (Tptr:ts)     (c:cs) = --ss "Storable ".sc c:
			       context ts cs
context (Tobject:ts)  (c:cs) = ss "GObjectClass ".sc c.sc '\'': context ts cs
context (_:ts)	      cs     = context ts cs
context []	      _	     = []


marshType :: [Types] -> [Char] -> [ShowS]
marshType (Tint:ts)     (c:cs) = marshType ts cs
marshType (Tuint:ts)	(c:cs) = marshType ts cs
marshType (Tenum:ts)	(c:cs) = marshType ts cs
marshType (Tflags:ts)	cs     = marshType (Tenum:ts) cs
marshType (Tboxed:ts)	(c:cs) = ss "(Ptr ".sc c.ss " -> IO ".
				 sc c.ss ") ->":
				 marshType ts cs
marshType (Tptr:ts)	(c:cs) = marshType ts cs
marshType (Tobject:ts)	(c:cs) = marshType ts cs
marshType (_:ts)        cs     = marshType ts cs
marshType []		_      = []

tyVarMapping :: [Types] -> [Char]
tyVarMapping ts = tvm ts 'a'
  where
    tvm (Tint:ts)      c = c:tvm ts (succ c)
    tvm (Tuint:ts)     c = c:tvm ts (succ c)	
    tvm (Tenum:ts)     c = c:tvm ts (succ c)
    tvm (Tflags:ts)    c = c:tvm ts (succ c)
    tvm (Tboxed:ts)    c = c:tvm ts (succ c)
    tvm (Tptr:ts)      c = c:tvm ts (succ c)
    tvm (Tobject:ts)   c = c:tvm ts (succ c)
    tvm (_:ts)	       c = c:tvm ts c
    tvm _	       c = [] 

-- arguments for user defined marshalling

type ArgNo = Int

marshArg :: Types -> ArgNo -> ShowS
marshArg Tboxed   c = indent 1.ss "boxedPre".shows c.sc ' '
marshArg _	  _ = id

-- generate a name for every passed argument,
nameArg :: Types -> ArgNo -> ShowS
nameArg Tunit	 _ = id
nameArg Tbool	 c = ss "bool".shows c
nameArg Tchar    c = ss "char".shows c
nameArg Tuchar   c = ss "char".shows c
nameArg Tint	 c = ss "int".shows c
nameArg Tuint	 c = ss "int".shows c
nameArg Tlong	 c = ss "long".shows c
nameArg Tulong	 c = ss "long".shows c
nameArg Tenum	 c = ss "enum".shows c
nameArg Tflags	 c = ss "flags".shows c
nameArg Tfloat	 c = ss "float".shows c
nameArg Tdouble	 c = ss "double".shows c
nameArg Tstring	 c = ss "str".shows c
nameArg Tboxed   c = ss "box".shows c
nameArg Tptr     c = ss "ptr".shows c
nameArg Tobject  c = ss "obj".shows c


-- describe marshalling between the data passed from the registered function
-- to the user supplied Haskell function

marshExec :: Types -> (Char,ArgNo) -> ShowS
marshExec Tbool	   (c,n) = indent 4.ss "let bool".shows n.
		    ss "' = toBool bool".shows n
marshExec Tchar	   (c,n) = indent 4.ss "let char".shows n.
		    ss "' = (toEnum.fromEnum) char".shows n
marshExec Tuchar   (c,n) = indent 4.ss "let char".shows n.
		    ss "' = (toEnum.fromEnum) char".shows n
marshExec Tint	   (c,n) = indent 4.ss "let int".shows n.
		    ss "' = fromIntegral int".shows n
marshExec Tuint	   (c,n) = indent 4.ss "let int".shows n.
		    ss "' = fromIntegral int".shows n
marshExec Tlong	   (c,n) = indent 4.ss "let long".shows n.
		    ss "' = toInteger long".shows n
marshExec Tulong   (c,n) = indent 4.ss "let long".shows n.
		    ss "' = toInteger long".shows n
marshExec Tenum	   (c,n) = indent 4.ss "let enum".shows n.
		    ss "' = (toEnum.fromEnum) enum".shows n
marshExec Tflags   (c,n) = indent 4.ss "let flags".shows n.
		    ss "' = (toEnum.fromEnum) flags".shows n
marshExec Tfloat   (c,n) = indent 4.ss "let float".shows n.
		    ss "' = (fromRational.toRational) float".shows n
marshExec Tdouble   (c,n) = indent 4.ss "let double".shows n.
		    ss "' = (fromRational.toRational) double".shows n
marshExec Tstring  (c,n) = indent 4.ss "str".shows n.
		    ss "' <- peekCString str".shows n
marshExec Tboxed   (c,n) = indent 4.ss "box".shows n.ss "' <- boxedPre".
		    shows n.ss " $ castPtr box".shows n
marshExec Tptr	   (c,n) = indent 4.ss "let ptr".shows n.ss "' = castPtr ptr".
		    shows n
marshExec Tobject  (c,n) = indent 4.ss "objectRef obj".shows n.
		    indent 4.ss "obj".shows n.
		    ss "' <- liftM (fromGObject.mkGObject) $".
		    indent 5.ss "newForeignPtr obj".shows n.
		    ss " (objectUnref obj".shows n.sc ')'
marshExec _	   _     = id

marshRet :: Types -> ShowS
marshRet Tunit	  = ss "id"
marshRet Tbool	  = ss "fromBool"
marshRet Tint	  = ss "fromIntegral"
marshRet Tuint	  = ss "fromIntegral"
marshRet Tlong	  = ss "fromIntegral"
marshRet Tulong	  = ss "fromIntegral"
marshRet Tenum	  = ss "(toEnum.fromEnum)"
marshRet Tflags	  = ss "fromFlags"
marshRet Tfloat	  = ss "(toRational.fromRational)"
marshRet Tdouble  = ss "(toRational.fromRational)"
marshRet _  = ss "(error \"Signal handlers cannot return structured types.\")"

-------------------------------------------------------------------------------
-- generation of parameterized fragments
-------------------------------------------------------------------------------

mkUserType :: Signature -> ShowS
mkUserType (ret,ts) = let
  (str,cs) = foldl (\(str,cs) t -> 
	    let (str',cs') = usertype t cs in (str.str'.ss " -> ",cs'))
	    (sc '(',['a'..]) ts
  (str',_) = usertype ret cs
  in str.ss "IO ".str'.sc ')'

mkContext :: Signature -> ShowS
mkContext (ret,ts) = let ctxts = context (ts++[ret]) ['a'..] in
  if null ctxts then ss "GObjectClass obj =>" else sc '('.
    foldl1 (\a b -> a.ss ", ".b) ctxts.ss ", GObjectClass obj) =>"

mkMarshType :: Signature -> [ShowS]
mkMarshType (ret,ts) = marshType (ts++[ret]) ['a'..]
  
mkType sig = let types = mkMarshType sig in
  if null types then id else foldl (.) (indent 1) types

mkMarshArg :: Signature -> [ShowS]
mkMarshArg (ret,ts) = zipWith marshArg (ts++[ret]) [1..]

mkArg sig = foldl (.) id $ mkMarshArg sig

mkMarshExec :: Signature -> ShowS
mkMarshExec (_,ts) = foldl (.) id $ 
		     zipWith marshExec ts (zip (tyVarMapping ts) [1..])

mkIdentifier :: Signature -> ShowS
mkIdentifier (ret,[]) = identifier Tunit . ss "__".identifier ret
mkIdentifier (ret,ts) = foldl1 (\a b -> a.sc '_'.b) (map identifier ts).
			ss "__".identifier ret

mkRawtype :: Signature -> ShowS
mkRawtype (ret,ts) = 
  foldl (.) id (map (\ty -> rawtype ty.ss " -> ") ts).
  ss "IO (".rawtype ret.sc ')'

mkLambdaArgs :: Signature -> ShowS
mkLambdaArgs (_,ts) = foldl (.) id $ 
		      zipWith (\a b -> nameArg a b.sc ' ') ts [1..]

mkFuncArgs :: Signature -> ShowS
mkFuncArgs (_,ts) = foldl (.) id $ 
		    zipWith (\a b -> sc ' '.nameArg a b.sc '\'') ts [1..]

mkMarshRet :: Signature -> ShowS
mkMarshRet (ret,_) = marshRet ret

-------------------------------------------------------------------------------
-- start of code generation
-------------------------------------------------------------------------------


usage = do
 putStr $ "Program to generate callback hook for Gtk signals. Usage:\n"++
   "HookGenerator <signatureFile> <bootPath> <outFile> [--broken]\n"++
   "where\n"++
   "  <signatureFile> is gtkmarshal.list from the the source Gtk+ tree\n"++
   "  <bootPath>      the path where Signal.chs-boot? file can be found\n"++
   "  <outFile>	      is the name and path of the output file.\n"++
   "  --broken	      do not ask for callbacks with more than 4 words\n"
 exitWith $ ExitFailure 1

main = do
  args <- getArgs
  if (length args<3 || length args>4) then usage else do
    let (br,[typesFile, bootPath, outFile]) = partition (=="--broken") args
    let bootPath' = case reverse bootPath of
	              [] -> "./"
		      ('/':_) -> bootPath
		      ('\\':_) -> bootPath
		      _ -> bootPath++"/"
    generateHooks typesFile bootPath' outFile (not (null br))

generateHooks :: String -> String -> String -> BrokenSolaris -> IO ()
generateHooks typesFile bootPath outFile brokenSolaris = do
    content <- readFile typesFile
    let sigs = parseSignatures content
    boot1 <- readFile (bootPath++"Signal.chs-boot1")
    boot2 <- readFile (bootPath++"Signal.chs-boot2")
    let result = ss boot1. 
		 genExport sigs.
		 ss boot2.
		 foldl (.) id (map (generate brokenSolaris) sigs)
    writeFile outFile (result "")

    



-------------------------------------------------------------------------------
-- generate dynamic fragments
-------------------------------------------------------------------------------

genExport :: Signatures -> ShowS
genExport sigs = foldl (.) id (map mkId sigs)
  where
    mkId sig = ss "connect_".mkIdentifier sig.sc ','.indent 1

generate :: BrokenSolaris -> Signature -> ShowS
generate bs sig = let ident = mkIdentifier sig in
  indent 0.ss "type Tag_".ident.ss " = Ptr () -> ".
  indent 1.mkRawtype sig.
  indent 0.
  (if fakeSignature bs sig then id else indent 0.ss "foreign".
#if __GLASGOW_HASKELL__>=504
    ss " import ccall \"wrapper\" ").ss "mkHandler_".ident.ss " ::".
#else
    ss " export dynamic ").ss "mkHandler_".ident.ss " ::".
#endif
  indent 1.ss "Tag_".ident.ss " -> ".
  indent 1.ss "IO (FunPtr ".ss "Tag_".ident.sc ')'.
  (if fakeSignature bs sig then 
  indent 0.ss "mkHandler_".ident.ss " _ =".
  indent 1.ss "error \"Callbacks of signature ".ident.ss "\\n\\".
  indent 1.ss "\\are not supported on this architecture.\"" else id).
  indent 0.
  indent 0.ss "connect_".ident.ss " :: ".
  indent 1.mkContext sig.ss " SignalName ->".
  mkType sig.
  indent 1.ss "ConnectAfter -> obj ->".
  indent 1.mkUserType sig.ss " ->".
  indent 1.ss "IO (ConnectId obj)".
  indent 0.ss "connect_".ident.ss " signal".
  mkArg sig.
  indent 1.ss "after obj user =".
  indent 1.ss "do".
  indent 2.ss "hPtr <- mkHandler_".ident.
  indent 3.ss "(\\_ ".mkLambdaArgs sig.ss "-> do".
  mkMarshExec sig.
  indent 4.ss "liftM ".mkMarshRet sig.ss " $".
  indent 5.ss "user".mkFuncArgs sig.
  indent 3.sc ')'.
  indent 2.ss "dRef <- newIORef nullFunPtr".
  indent 2.ss "dPtr <- mkDestructor $ do".
  indent 3.ss "freeHaskellFunPtr hPtr".
  indent 3.ss "dPtr <- readIORef dRef".
  indent 3.ss "freeHaskellFunPtr dPtr".
  indent 2.ss "writeIORef dRef dPtr".
  indent 2.ss "sigId <- withCString signal $ \\nPtr ->".
  indent 3.ss "withForeignPtr ((unGObject.toGObject) obj) $ \\objPtr ->".
  indent 4.ss "{#call unsafe g_signal_connect_data#} (castPtr objPtr)".
  indent 5.ss "nPtr (castFunPtr hPtr) nullPtr dPtr (fromBool after)".
  indent 2.ss "return $ ConnectID sigId obj".
  indent 0




--- NEW FILE: Makefile ---
TOP = ../..

include $(TOP)/mk/config.mk

APPNAME = HookGenerator

EXTRA_TARFILES	+= gtkmarshal.list Signal.chs-boot1 Signal.chs-boot2

include $(TOP)/mk/common.mk


--- NEW FILE: Signal.chs-boot1 ---
{-# OPTIONS -cpp #-}
-- -*-haskell-*-
-- ******************** automatically generated file - do not edit ************
--  Callback installers for the GIMP Toolkit (GTK) Binding for Haskell
--
--  Author : Axel Simon
--          
--  Created: 1 July 2000
--
--  Version $Revision: 1.1 $ from $Date: 2003/11/15 09:46:20 $
--
--  Copyright (c) 2000 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  * These functions are used to connect signals to widgets. They are auto-
--    matically created through HookGenerator.hs which takes a list of possible
--    function signatures that are included in the GTK sources 
--    (gtkmarshal.list).
--
--- DOCU ----------------------------------------------------------------------
--
--  * The object system in the second version of GTK is based on GObject from
--    GLIB. This base class is rather primitive in that it only implements
--    ref and unref methods (and others that are not interesting to us). If
--    the marshall list mentions OBJECT it refers to an instance of this 
--    GObject which is automatically wrapped with a ref and unref call.
--    Structures which are not derived from GObject have to be passed as
--    BOXED which gives the signal connect function a possiblity to do the
--    conversion into a proper ForeignPtr type. In special cases the signal
--    connect function use a PTR type which will then be mangled in the
--    user function directly. The latter is needed if a signal delivers a
--    pointer to a string and its length in a separate integer.
--
--- TODO ----------------------------------------------------------------------
--
--  * Check if we need all prototypes mentioned in gtkmarshal.list.
--
module Signal(
  
--- NEW FILE: Signal.chs-boot2 ---
SignalName,
  ConnectAfter,
  ConnectId,
  disconnect
  ) where

import Monad	(liftM)
import FFI
import LocalData
import GObject	(objectRef, objectUnref)
{#import Hierarchy#}

{#context lib="gtk" prefix="gtk" #}


-- Specify if the handler is to run before (False) or after (True) the
-- default handler.

type ConnectAfter = Bool

type SignalName = String

data GObjectClass o => ConnectId o = ConnectID {#type gulong#} o

{#pointer GClosureNotify#}

#if __GLASGOW_HASKELL__>=600

foreign import ccall "wrapper" mkDestructor :: IO () -> IO GClosureNotify

#else

foreign export dynamic mkDestructor :: IO () -> IO GClosureNotify

#endif

disconnect :: GObjectClass obj => ConnectId obj -> IO ()
disconnect (ConnectID handler obj) =
  withForeignPtr  ((unGObject.toGObject) obj) $ \objPtr ->
  {#call unsafe g_signal_handler_disconnect#} (castPtr objPtr) handler

-- Here are the generators that turn a Haskell function into
-- a C function pointer. The fist Argument is always the widget,
-- the last one is the user g_pointer. Both are ignored.


--- NEW FILE: gtkmarshal.list ---
# see glib-genmarshal(1) for a detailed description of the file format,
# possible parameter types are:
#   VOID        indicates   no   return   type,  or  no  extra
#               parameters. if VOID is used as  the  parameter
#               list, no additional parameters may be present.
#   BOOLEAN     for boolean types (gboolean)
#   CHAR        for signed char types (gchar)
#   UCHAR       for unsigned char types (guchar)
#   INT         for signed integer types (gint)
#   UINT        for unsigned integer types (guint)
#   LONG        for signed long integer types (glong)
#   ULONG       for unsigned long integer types (gulong)
#   ENUM        for enumeration types (gint)
#   FLAGS       for flag enumeration types (guint)
#   FLOAT       for single-precision float types (gfloat)
#   DOUBLE      for double-precision float types (gdouble)
#   STRING      for string types (gchar*)
#   BOXED       for boxed (anonymous but reference counted) types (GBoxed*)
#   POINTER     for anonymous pointer types (gpointer)
#   OBJECT      for GObject or derived types (GObject*)
#   NONE        deprecated alias for VOID
#   BOOL        deprecated alias for BOOLEAN

BOOLEAN:BOXED
BOOLEAN:BOXED,BOXED
BOOLEAN:OBJECT,INT,INT,UINT
BOOLEAN:OBJECT,STRING,STRING,BOXED
BOOLEAN:OBJECT,BOXED,BOXED
BOOLEAN:VOID
BOOLEAN:BOOLEAN
ENUM:ENUM
NONE:ENUM,ENUM
INT:POINTER
NONE:BOOL
NONE:INT
NONE:INT,INT
NONE:NONE
NONE:POINTER
NONE:STRING,INT,POINTER
VOID:BOOLEAN
VOID:BOXED
VOID:BOXED,BOXED
VOID:BOXED,BOXED,BOXED,BOXED
VOID:BOXED,BOXED,POINTER
VOID:BOXED,POINTER
VOID:BOXED,OBJECT
VOID:BOXED,STRING,INT
VOID:BOXED,UINT
VOID:BOXED,UINT,FLAGS
VOID:BOXED,UINT,UINT
VOID:ENUM
VOID:ENUM,FLOAT
VOID:ENUM,FLOAT,BOOL
VOID:ENUM,INT
VOID:ENUM,INT,BOOLEAN
VOID:INT
VOID:INT,INT
VOID:INT,INT,BOXED
VOID:INT,INT,INT
VOID:OBJECT
VOID:OBJECT,BOOLEAN
VOID:OBJECT,BOXED,BOXED
VOID:OBJECT,BOXED,UINT,UINT
VOID:OBJECT,INT,INT
VOID:OBJECT,INT,INT,BOXED,UINT,UINT
VOID:OBJECT,OBJECT
VOID:OBJECT,STRING,STRING
VOID:OBJECT,UINT
VOID:POINTER
VOID:POINTER,INT
VOID:POINTER,POINTER,POINTER
VOID:POINTER,UINT
VOID:STRING
VOID:STRING,INT,POINTER
VOID:UINT,BOXED,UINT,FLAGS,FLAGS
VOID:UINT,STRING
VOID:VOID
# This marshaller is necessary to marshal a string with explicit length in a
# callback "text-insert" in TextBuffer.
VOID:BOXED,POINTER,INT
# This one is needed in TextView:
VOID:INT,BOOL
# This is for the "edited" signal in CellRendererText:
VOID:POINTER,STRING