Menu
▾
▴
gtk2hs-commit — Mailing list for Darcs commit messages.
You can subscribe to this list here.
| 2003 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(4) |
Jun
|
Jul
(68) |
Aug
(4) |
Sep
|
Oct
(23) |
Nov
(95) |
Dec
(9) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2004 |
Jan
(3) |
Feb
|
Mar
|
Apr
(51) |
May
(81) |
Jun
(2) |
Jul
(86) |
Aug
(143) |
Sep
(3) |
Oct
(31) |
Nov
(63) |
Dec
(90) |
| 2005 |
Jan
(277) |
Feb
(157) |
Mar
(99) |
Apr
(195) |
May
(151) |
Jun
(148) |
Jul
(98) |
Aug
(123) |
Sep
(20) |
Oct
(174) |
Nov
(155) |
Dec
(26) |
| 2006 |
Jan
(51) |
Feb
(19) |
Mar
(16) |
Apr
(12) |
May
(5) |
Jun
|
Jul
(11) |
Aug
(7) |
Sep
(10) |
Oct
(31) |
Nov
(174) |
Dec
(56) |
| 2007 |
Jan
(45) |
Feb
(52) |
Mar
(10) |
Apr
(5) |
May
(47) |
Jun
(16) |
Jul
(80) |
Aug
(29) |
Sep
(14) |
Oct
(59) |
Nov
(46) |
Dec
(16) |
| 2008 |
Jan
(10) |
Feb
(1) |
Mar
|
Apr
|
May
(49) |
Jun
(26) |
Jul
(8) |
Aug
(4) |
Sep
(25) |
Oct
(53) |
Nov
(9) |
Dec
(1) |
| 2009 |
Jan
(66) |
Feb
(11) |
Mar
(1) |
Apr
(14) |
May
(8) |
Jun
(1) |
Jul
(2) |
Aug
(2) |
Sep
(9) |
Oct
(23) |
Nov
(35) |
Dec
|
| 2010 |
Jan
(7) |
Feb
(2) |
Mar
(39) |
Apr
(19) |
May
(161) |
Jun
(19) |
Jul
(32) |
Aug
(65) |
Sep
(113) |
Oct
(120) |
Nov
(2) |
Dec
|
| 2012 |
Jan
|
Feb
(5) |
Mar
(4) |
Apr
(7) |
May
(9) |
Jun
(14) |
Jul
(1) |
Aug
|
Sep
(1) |
Oct
(1) |
Nov
(12) |
Dec
(2) |
| 2013 |
Jan
(1) |
Feb
(17) |
Mar
(4) |
Apr
(4) |
May
(9) |
Jun
|
Jul
(8) |
Aug
|
Sep
(2) |
Oct
|
Nov
|
Dec
|
|
From: Duncan C. <dun...@us...> - 2005-03-26 00:11:56
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3333 Modified Files: ChangeLog Log Message: Documentation changes and code formatting changes. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.403 retrieving revision 1.404 diff -u -d -r1.403 -r1.404 --- ChangeLog 26 Mar 2005 00:10:55 -0000 1.403 +++ ChangeLog 26 Mar 2005 00:11:42 -0000 1.404 @@ -8,6 +8,10 @@ marshalers that are not currently used. This saves several 100k in a final striped program. Feel free to re-enable any of them at any time. + * gtk/Graphics/UI/Gtk/Windows/Dialog.chs, + gtk/Graphics/UI/Gtk/Windows/Window.chs.pp: documentation changes and + code formatting changes. + 2005-03-25 Duncan Coutts <du...@co...> * tools/apiGen/ModuleScan.hs: match up against existing .hs modules if |
|
From: Duncan C. <dun...@us...> - 2005-03-26 00:11:05
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/callbackGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2542/tools/callbackGen Modified Files: gtkmarshal.list Log Message: Comment out all the signal marshalers that are not currently used. This saves several 100k in a final striped program. Feel free to re-enable any of them at any time. Index: gtkmarshal.list =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/callbackGen/gtkmarshal.list,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- gtkmarshal.list 17 Dec 2004 21:21:45 -0000 1.4 +++ gtkmarshal.list 26 Mar 2005 00:10:55 -0000 1.5 @@ -21,80 +21,81 @@ # NONE deprecated alias for VOID # BOOL deprecated alias for BOOLEAN +# If you add a new signal type, please check that it actually works! +# If it is a Boxed type check that the reference counting is right. + BOOLEAN:BOXED BOOLEAN:BOXED,BOXED -BOOLEAN:ENUM -BOOLEAN:ENUM,INT -BOOLEAN:OBJECT,UINT,FLAGS -BOOLEAN:OBJECT,INT,INT,UINT -BOOLEAN:OBJECT,STRING,STRING,BOXED -BOOLEAN:OBJECT,BOXED -BOOLEAN:OBJECT,BOXED,BOXED -BOOLEAN:OBJECT,STRING,STRING -BOOLEAN:INT,INT +#BOOLEAN:ENUM +#BOOLEAN:ENUM,INT +#BOOLEAN:OBJECT,UINT,FLAGS +#BOOLEAN:OBJECT,INT,INT,UINT +#BOOLEAN:OBJECT,STRING,STRING,BOXED +#BOOLEAN:OBJECT,BOXED +#BOOLEAN:OBJECT,BOXED,BOXED +#BOOLEAN:OBJECT,STRING,STRING +#BOOLEAN:INT,INT BOOLEAN:INT,INT,INT -BOOLEAN:UINT +#BOOLEAN:UINT BOOLEAN:VOID BOOLEAN:BOOLEAN -BOOLEAN:NONE -BOOLEAN:BOOLEAN,BOOLEAN,BOOLEAN +#BOOLEAN:BOOLEAN,BOOLEAN,BOOLEAN ENUM:ENUM INT:POINTER -NONE:BOOLEAN -NONE:ENUM -NONE:INT -NONE:INT,BOOL -NONE:INT,INT -NONE:NONE -NONE:STRING,INT,POINTER -STRING:DOUBLE -VOID:DOUBLE VOID:BOOLEAN -VOID:BOOLEAN,BOOLEAN,BOOLEAN +#VOID:ENUM +VOID:INT +#VOID:INT,BOOL +VOID:INT,INT +VOID:VOID +#VOID:STRING,INT,POINTER +#STRING:DOUBLE +VOID:DOUBLE +#VOID:BOOLEAN,BOOLEAN,BOOLEAN VOID:BOXED VOID:BOXED,BOXED -VOID:BOXED,BOXED,POINTER +#VOID:BOXED,BOXED,POINTER VOID:BOXED,OBJECT -VOID:BOXED,STRING,INT +#VOID:BOXED,STRING,INT VOID:BOXED,UINT -VOID:BOXED,UINT,FLAGS -VOID:BOXED,UINT,UINT +#VOID:BOXED,UINT,FLAGS +#VOID:BOXED,UINT,UINT VOID:ENUM -VOID:ENUM,BOOLEAN -VOID:ENUM,ENUM -VOID:ENUM,FLOAT -VOID:ENUM,FLOAT,BOOLEAN +#VOID:ENUM,BOOLEAN +#VOID:ENUM,ENUM +#VOID:ENUM,FLOAT +#VOID:ENUM,FLOAT,BOOLEAN VOID:ENUM,INT VOID:ENUM,INT,BOOLEAN -VOID:INT -VOID:INT,INT -VOID:INT,INT,BOXED -VOID:INT,INT,INT +#VOID:INT +#VOID:INT,INT +#VOID:INT,INT,BOXED +#VOID:INT,INT,INT VOID:OBJECT -VOID:OBJECT,BOOLEAN +#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,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:OBJECT,UINT,FLAGS +#VOID:OBJECT,STRING,STRING +#VOID:OBJECT,UINT +#VOID:OBJECT,UINT,FLAGS VOID:POINTER -VOID:POINTER,INT -VOID:POINTER,BOOLEAN -VOID:POINTER,POINTER,POINTER -VOID:POINTER,UINT +#VOID:POINTER,INT +#VOID:POINTER,BOOLEAN +#VOID:POINTER,POINTER,POINTER +#VOID:POINTER,UINT VOID:STRING -VOID:STRING,STRING -VOID:STRING,INT,POINTER -VOID:STRING,UINT,FLAGS -VOID:UINT,FLAGS,BOXED -VOID:UINT,UINT +#VOID:STRING,STRING +#VOID:STRING,INT,POINTER +#VOID:STRING,UINT,FLAGS +#VOID:UINT,FLAGS,BOXED +#VOID:UINT,UINT VOID:UINT,STRING -VOID:UINT,BOXED,UINT,FLAGS,FLAGS -VOID:UINT,OBJECT,UINT,FLAGS,FLAGS -VOID:VOID +#VOID:UINT,BOXED,UINT,FLAGS,FLAGS +#VOID:UINT,OBJECT,UINT,FLAGS,FLAGS + # This marshaller is necessary to marshal a string with explicit length in a # callback "text-insert" in TextBuffer. VOID:BOXED,POINTER,INT |
|
From: Duncan C. <dun...@us...> - 2005-03-26 00:11:05
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2542 Modified Files: ChangeLog Log Message: Comment out all the signal marshalers that are not currently used. This saves several 100k in a final striped program. Feel free to re-enable any of them at any time. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.402 retrieving revision 1.403 diff -u -d -r1.402 -r1.403 --- ChangeLog 26 Mar 2005 00:09:23 -0000 1.402 +++ ChangeLog 26 Mar 2005 00:10:55 -0000 1.403 @@ -4,6 +4,10 @@ handler return type rather than (Num n, Integral n) => n since there's no need to be so general (and it breaks my new signals system!) + * tools/callbackGen/gtkmarshal.list: comment out all the signal + marshalers that are not currently used. This saves several 100k in a + final striped program. Feel free to re-enable any of them at any time. + 2005-03-25 Duncan Coutts <du...@co...> * tools/apiGen/ModuleScan.hs: match up against existing .hs modules if |
|
From: Duncan C. <dun...@us...> - 2005-03-26 00:09:37
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1970 Modified Files: ChangeLog Log Message: Use Int in the signal handler return type rather than (Num n, Integral n) => n since there's no need to be so general (and it breaks my new signals system!) Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.401 retrieving revision 1.402 diff -u -d -r1.401 -r1.402 --- ChangeLog 25 Mar 2005 19:44:16 -0000 1.401 +++ ChangeLog 26 Mar 2005 00:09:23 -0000 1.402 @@ -1,3 +1,9 @@ +2005-03-26 Duncan Coutts <du...@co...> + + * mozembed/Graphics/UI/Gtk/MozEmbed.chs: use Int in the signal + handler return type rather than (Num n, Integral n) => n since there's + no need to be so general (and it breaks my new signals system!) + 2005-03-25 Duncan Coutts <du...@co...> * tools/apiGen/ModuleScan.hs: match up against existing .hs modules if |
|
From: Duncan C. <dun...@us...> - 2005-03-26 00:09:35
|
Update of /cvsroot/gtk2hs/gtk2hs/mozembed/Graphics/UI/Gtk In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1970/mozembed/Graphics/UI/Gtk Modified Files: MozEmbed.chs Log Message: Use Int in the signal handler return type rather than (Num n, Integral n) => n since there's no need to be so general (and it breaks my new signals system!) Index: MozEmbed.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/mozembed/Graphics/UI/Gtk/MozEmbed.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- MozEmbed.chs 14 Jan 2005 19:04:50 -0000 1.4 +++ MozEmbed.chs 26 Mar 2005 00:09:27 -0000 1.5 @@ -248,8 +248,9 @@ onKeyDown, onKeyPress, onKeyUp, onMouseDown, onMouseUp, onMouseClick, onMouseDoubleClick, onMouseOver, onMouseOut - :: (Num n, Integral n, MozEmbedClass m) - => m -> (Ptr a -> IO n) -> IO (ConnectId m) + :: MozEmbedClass self => self + -> (Ptr a -> IO Int) + -> IO (ConnectId self) onKeyDown = connect_PTR__INT "dom_key_down" False onKeyPress = connect_PTR__INT "dom_key_press" False onKeyUp = connect_PTR__INT "dom_key_up" False |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:44:25
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12925 Modified Files: ChangeLog TODO Log Message: Add some more todo items. Index: TODO =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/TODO,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- TODO 26 Feb 2005 02:17:26 -0000 1.9 +++ TODO 25 Mar 2005 19:44:17 -0000 1.10 @@ -1,5 +1,36 @@ TODO for gtk2hs +24/3/2005 Duncan Coutts <du...@co...> + + * check the ref counting of BOXED obects in signal callbacks, eg Event + +23/3/2005 Duncan Coutts <du...@co...> + + * change gconf so it does not require -fallow-overlapping-instances + +22/3/2005 Duncan Coutts <du...@co...> + + * gtk/Graphics/UI/Gtk/Ornaments/Frame.chs: frameSetLabelAlign and + frameGetLabelAlign only get/set the horazontal alignment not the + verticle alighment too + +12/3/2005 Duncan Coutts <du...@co...> + + * glib timeouts and idle handlers: + move them to glib package but re-export from gtk package + make a newtype for priorities and add more of them + make the IO Bool arg be the last arg so you can say: + idleAdd priorityDefault $ do + ... + + add new menu toolbar API + + * refactor events interface. Problem with mem management (the region + is destroied after the event handler completes) so perhaps make event + structures abstract with accessor functions so for example the Region + can be copied (with a destructor). Or Axel suggested a different + signal, eg onExposeRegion + 8/12/2004 Duncan Coutts <du...@co...> * there sould be a rule to rebuild .chi files even if the corresponding Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.400 retrieving revision 1.401 diff -u -d -r1.400 -r1.401 --- ChangeLog 25 Mar 2005 19:31:16 -0000 1.400 +++ ChangeLog 25 Mar 2005 19:44:16 -0000 1.401 @@ -45,6 +45,8 @@ with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. + * TODO: add some more todo items + 2005-03-24 Duncan Coutts <du...@co...> * gtk/Graphics/UI/Gtk/Scrolling/HScrollbar.chs, |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:32:00
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/hello In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/hello Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/hello/Makefile,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- Makefile 19 Jan 2005 04:03:56 -0000 1.5 +++ Makefile 25 Mar 2005 19:31:19 -0000 1.6 @@ -4,9 +4,11 @@ PACKAGES = gtk $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:59
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/glade In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/glade Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/glade/Makefile,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- Makefile 19 Jan 2005 04:03:55 -0000 1.7 +++ Makefile 25 Mar 2005 19:31:19 -0000 1.8 @@ -4,9 +4,11 @@ PACKAGES = glade $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:59
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/mozembed In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/mozembed Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/mozembed/Makefile,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- Makefile 19 Jan 2005 04:03:56 -0000 1.3 +++ Makefile 25 Mar 2005 19:31:20 -0000 1.4 @@ -4,9 +4,11 @@ PACKAGES = mozembed $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:59
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/gconf In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/gconf Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/gconf/Makefile,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- Makefile 19 Jan 2005 04:03:54 -0000 1.3 +++ Makefile 25 Mar 2005 19:31:18 -0000 1.4 @@ -4,9 +4,11 @@ PACKAGES = gconf $(PROG) : $(SOURCES) - ghc --make $< -o $@ -fglasgow-exts -fallow-overlapping-instances $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ -fglasgow-exts -fallow-overlapping-instances $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:59
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/graphic In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/graphic Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/graphic/Makefile,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Makefile 19 Jan 2005 04:03:55 -0000 1.4 +++ Makefile 25 Mar 2005 19:31:19 -0000 1.5 @@ -4,9 +4,11 @@ PACKAGES = gtk $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:58
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/buttonbox In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/buttonbox Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/buttonbox/Makefile,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Makefile 19 Jan 2005 04:03:53 -0000 1.4 +++ Makefile 25 Mar 2005 19:31:17 -0000 1.5 @@ -4,9 +4,11 @@ PACKAGES = gtk $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:57
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/filechooser In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/filechooser Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/filechooser/Makefile,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Makefile 19 Jan 2005 04:03:54 -0000 1.4 +++ Makefile 25 Mar 2005 19:31:18 -0000 1.5 @@ -4,9 +4,11 @@ PACKAGES = glade $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:57
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280 Modified Files: ChangeLog Makefile.am Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile.am =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v retrieving revision 1.59 retrieving revision 1.60 diff -u -d -r1.59 -r1.60 --- Makefile.am 23 Mar 2005 19:34:51 -0000 1.59 +++ Makefile.am 25 Mar 2005 19:31:16 -0000 1.60 @@ -950,7 +950,7 @@ DEMOS += demo/filechooser endif if ENABLE_LIBGLADE -DEMOS += demo/glade +DEMOS += demo/glade demo/calc if HAVE_GTK_VERSION_2_4 DEMOS += demo/profileviewer endif @@ -964,7 +964,7 @@ # For the install check just make sure all the demo programs compile and link DEMO_MAKE_ARGS= $(if $(PKGCONF), HCFLAGS="-package-conf $(DESTDIR)$(PKGCONF)") \ - $(if $(GHCPKG_USE_AUTOLIBS),, HCNEEDSPACKAGE=yes) + $(if $(GHCPKG_USE_AUTOLIBS),, HCNEEDSPACKAGE=yes) HC=$(HC) installcheck-local: $(foreach DEMO,$(DEMOS),$(strip \ @@ -990,7 +990,8 @@ demo/sourceview/SourceViewTest.hs demo/sourceview/Makefile \ demo/sourceview/haskell.lang \ demo/treeList/ListTest.hs demo/treeList/Makefile \ - demo/unicode/Arabic.hs demo/unicode/Makefile + demo/unicode/Arabic.hs demo/unicode/Makefile \ + demo/calc/CalcModel.hs demo/calc/Calc.hs demo/calc/Makefile # # installing and registering packages with the Haskell compiler Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.399 retrieving revision 1.400 diff -u -d -r1.399 -r1.400 --- ChangeLog 25 Mar 2005 19:22:38 -0000 1.399 +++ ChangeLog 25 Mar 2005 19:31:16 -0000 1.400 @@ -33,6 +33,18 @@ idle priority. This is a knock-on change from fixing the priority constants in gtk/Graphics/UI/Gtk/General/Structs.hsc. + * demo/buttonbox/Makefile, demo/calc/Makefile, + demo/concurrent/Makefile, demo/filechooser/Makefile, + demo/gconf/Makefile, demo/glade/Makefile, demo/graphic/Makefile, + demo/hello/Makefile, demo/mozembed/Makefile, + demo/profileviewer/Makefile, demo/sourceview/Makefile, + demo/treeList/Makefile, demo/unicode/Makefile: add HC variable so that + the ghc version can be overridden, eg by make installcheck. + + * Makefile.am: add the calc demo to the distribution and have it built + with make isntallcheck. Override HC=$(HC) when making the demos so the + right version of ghc is used. + 2005-03-24 Duncan Coutts <du...@co...> * gtk/Graphics/UI/Gtk/Scrolling/HScrollbar.chs, |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:57
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/concurrent In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/concurrent Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/concurrent/Makefile,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Makefile 19 Jan 2005 04:03:53 -0000 1.4 +++ Makefile 25 Mar 2005 19:31:18 -0000 1.5 @@ -4,9 +4,11 @@ PACKAGES = gtk $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:56
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/calc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/calc Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/calc/Makefile,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- Makefile 28 Jan 2005 00:15:20 -0000 1.1 +++ Makefile 25 Mar 2005 19:31:17 -0000 1.2 @@ -4,9 +4,11 @@ PACKAGES = glade $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:31
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/unicode In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/unicode Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/unicode/Makefile,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Makefile 19 Jan 2005 04:03:58 -0000 1.4 +++ Makefile 25 Mar 2005 19:31:22 -0000 1.5 @@ -4,9 +4,11 @@ PACKAGES = gtk $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:30
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/treeList In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/treeList Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/treeList/Makefile,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Makefile 19 Jan 2005 04:03:57 -0000 1.4 +++ Makefile 25 Mar 2005 19:31:22 -0000 1.5 @@ -4,9 +4,11 @@ PACKAGES = mogul $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:30
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/sourceview In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/sourceview Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/sourceview/Makefile,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Makefile 19 Jan 2005 04:03:57 -0000 1.4 +++ Makefile 25 Mar 2005 19:31:21 -0000 1.5 @@ -4,9 +4,11 @@ PACKAGES = sourceview $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:31:29
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/profileviewer In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4280/demo/profileviewer Modified Files: Makefile Log Message: For all the demo Makefiles, add HC variable so that the ghc version can be overridden, eg by make installcheck. Makefile.am: add the calc demo to the distribution and have it built with make isntallcheck. Override HC=$(HC) when making the demos so the right version of ghc is used. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/profileviewer/Makefile,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Makefile 19 Jan 2005 04:03:56 -0000 1.4 +++ Makefile 25 Mar 2005 19:31:20 -0000 1.5 @@ -4,9 +4,11 @@ PACKAGES = glade mogul $(PROG) : $(SOURCES) - ghc --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) + $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS) HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES))) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) + +HC=ghc |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:22:47
|
Update of /cvsroot/gtk2hs/gtk2hs/demo/concurrent In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31244/demo/concurrent Modified Files: Progress.hs Log Message: Fix progress demo to use the right idle priority. This is a knock-on change from fixing the priority constants in gtk/Graphics/UI/Gtk/General/Structs.hsc. Index: Progress.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/demo/concurrent/Progress.hs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Progress.hs 16 Jan 2005 14:15:32 -0000 1.4 +++ Progress.hs 25 Mar 2005 19:22:39 -0000 1.5 @@ -20,7 +20,7 @@ boxPackStartDefaults contain pb widgetShowAll dia forkIO (doTask pb) - idleAdd (yield >> return True) priorityDefault + idleAdd (yield >> return True) priorityDefaultIdle dialogRun dia return () |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:22:47
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31244 Modified Files: ChangeLog Log Message: Fix progress demo to use the right idle priority. This is a knock-on change from fixing the priority constants in gtk/Graphics/UI/Gtk/General/Structs.hsc. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.398 retrieving revision 1.399 diff -u -d -r1.398 -r1.399 --- ChangeLog 25 Mar 2005 19:14:35 -0000 1.398 +++ ChangeLog 25 Mar 2005 19:22:38 -0000 1.399 @@ -29,6 +29,10 @@ * tools/apiGen/gobject-sources.xml: add gobject seperately. + * demo/concurrent/Progress.hs: Fix progress demo to use the right + idle priority. This is a knock-on change from fixing the priority + constants in gtk/Graphics/UI/Gtk/General/Structs.hsc. + 2005-03-24 Duncan Coutts <du...@co...> * gtk/Graphics/UI/Gtk/Scrolling/HScrollbar.chs, |
|
From: Duncan C. <dun...@us...> - 2005-03-25 19:15:23
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26330 Modified Files: ChangeLog Log Message: Various changes to the code generator: ModuleScan.hs: match up against existing .hs modules if there is no .chs or .chs.pp files. ApiGen.hs: minor knock-on change from above. MarshalFixup.hs: more fixup info. CodeGen.hs: pass whether the function is a constructor on to the marshaling functions. This allows them to add castPtr for constructors. Output the constructors in the same order as they occur in the original module (same as we do for functions). Change KnownSymbols map to include the full chaing of parents of each class rather than just a clasification of whether they inherit from GObject or GtkObject. For leaf classes, generate the properties with the specific type rather than it's corresponding typeclass. Marshal.hs: The KnownSymbols map change described above. Add castPtr for constructors and include the specific types that we are casting from and to, just for safty in case the code generator gets it wrong and disagrees with c2hs on types. Add marshaling for gunichar. Makefile: add gobject-api.xml to the --includeapi list so we don't need a special case for GObject in the code generator. glib-sources.xml: make this into glib not gobject. gobject-sources.xml: add gobject seperately. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.397 retrieving revision 1.398 diff -u -d -r1.397 -r1.398 --- ChangeLog 24 Mar 2005 17:30:50 -0000 1.397 +++ ChangeLog 25 Mar 2005 19:14:35 -0000 1.398 @@ -1,3 +1,34 @@ +2005-03-25 Duncan Coutts <du...@co...> + + * tools/apiGen/ModuleScan.hs: match up against existing .hs modules if + there is no .chs or .chs.pp files. + + * tools/apiGen/ApiGen.hs: minor knock-on change from above. + + * tools/apiGen/MarshalFixup.hs: more fixup info. + + * tools/apiGen/CodeGen.hs: pass whether the function is a constructor + on to the marshaling functions. This allows them to add castPtr for + constructors. Output the constructors in the same order as they occur + in the original module (same as we do for functions). Change + KnownSymbols map to include the full chaing of parents of each class + rather than just a clasification of whether they inherit from GObject + or GtkObject. For leaf classes, generate the properties with the + specific type rather than it's corresponding typeclass. + + * tools/apiGen/Marshal.hs: The KnownSymbols map change described + above. Add castPtr for constructors and include the specific types + that we are casting from and to, just for safty in case the code + generator gets it wrong and disagrees with c2hs on types. Add + marshaling for gunichar. + + * tools/apiGen/Makefile: add gobject-api.xml to the --includeapi list + so we don't need a special case for GObject in the code generator. + + * tools/apiGen/glib-sources.xml: make this into glib not gobject. + + * tools/apiGen/gobject-sources.xml: add gobject seperately. + 2005-03-24 Duncan Coutts <du...@co...> * gtk/Graphics/UI/Gtk/Scrolling/HScrollbar.chs, |
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26330/tools/apiGen Modified Files: ModuleScan.hs ApiGen.hs MarshalFixup.hs CodeGen.hs Marshal.hs Makefile glib-sources.xml Added Files: gobject-sources.xml Log Message: Various changes to the code generator: ModuleScan.hs: match up against existing .hs modules if there is no .chs or .chs.pp files. ApiGen.hs: minor knock-on change from above. MarshalFixup.hs: more fixup info. CodeGen.hs: pass whether the function is a constructor on to the marshaling functions. This allows them to add castPtr for constructors. Output the constructors in the same order as they occur in the original module (same as we do for functions). Change KnownSymbols map to include the full chaing of parents of each class rather than just a clasification of whether they inherit from GObject or GtkObject. For leaf classes, generate the properties with the specific type rather than it's corresponding typeclass. Marshal.hs: The KnownSymbols map change described above. Add castPtr for constructors and include the specific types that we are casting from and to, just for safty in case the code generator gets it wrong and disagrees with c2hs on types. Add marshaling for gunichar. Makefile: add gobject-api.xml to the --includeapi list so we don't need a special case for GObject in the code generator. glib-sources.xml: make this into glib not gobject. gobject-sources.xml: add gobject seperately. Index: Marshal.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Marshal.hs,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- Marshal.hs 4 Mar 2005 22:21:35 -0000 1.8 +++ Marshal.hs 25 Mar 2005 19:14:55 -0000 1.9 @@ -1,7 +1,6 @@ module Marshal ( KnownSymbols, CSymbol(..), - ObjectKind(..), EnumKind(..), genMarshalParameter, genMarshalResult, @@ -14,11 +13,12 @@ import StringUtils import Char (isUpper) +import Maybe (fromJust) import Data.FiniteMap type KnownSymbols = FiniteMap String CSymbol -data CSymbol = SymObjectType ObjectKind +data CSymbol = SymObjectType { sym_object_parents :: [String] } | SymEnumType EnumKind | SymEnumValue | SymStructType @@ -26,22 +26,14 @@ | SymClassType | SymTypeAlias | SymCallbackType - deriving Eq + deriving (Eq, Show) -data ObjectKind = GObjectKind | GtkObjectKind - deriving Eq data EnumKind = EnumKind | FlagsKind - deriving Eq + deriving (Eq, Show) symbolIsObject (Just (SymObjectType _)) = True symbolIsObject _ = False -symbolIsGObject (Just (SymObjectType GObjectKind)) = True -symbolIsGObject _ = False - -symbolIsGtkObject (Just (SymObjectType GtkObjectKind)) = True -symbolIsGtkObject _ = False - symbolIsEnum (Just (SymEnumType EnumKind)) = True symbolIsEnum _ = False @@ -89,6 +81,11 @@ \body -> body. indent 2. ss "(realToFrac ". ss name. ss ")") +genMarshalParameter _ _ name "gunichar" = + (Nothing, Just "Char", + \body -> body. + indent 2. ss "((fromIntegral . ord) ". ss name. ss ")") + genMarshalParameter _ funcName name typeName | typeName == "const-gchar*" || typeName == "const-char*" = if maybeNullParameter funcName name @@ -181,16 +178,18 @@ genMarshalResult :: KnownSymbols -> --a collection of types we know to be objects or enums String -> --function name (useful to lookup per-func fixup info) + Bool -> --is the function a constructor or ordinary method? String -> --C type decleration for the return value we will marshal (String, --Haskell return type ShowS -> ShowS) --marshaling code (\body -> ... body ...) -genMarshalResult _ _ "gboolean" = ("Bool", \body -> ss "liftM toBool $". indent 1. body) -genMarshalResult _ _ "gint" = ("Int", \body -> ss "liftM fromIntegral $". indent 1. body) -genMarshalResult _ _ "guint" = ("Int", \body -> ss "liftM fromIntegral $". indent 1. body) -genMarshalResult _ _ "gdouble" = ("Double", \body -> ss "liftM realToFrac $". indent 1. body) -genMarshalResult _ _ "gfloat" = ("Float", \body -> ss "liftM realToFrac $". indent 1. body) -genMarshalResult _ _ "void" = ("()", id) -genMarshalResult _ funcName "const-gchar*" = +genMarshalResult _ _ _ "gboolean" = ("Bool", \body -> ss "liftM toBool $". indent 1. body) +genMarshalResult _ _ _ "gint" = ("Int", \body -> ss "liftM fromIntegral $". indent 1. body) +genMarshalResult _ _ _ "guint" = ("Int", \body -> ss "liftM fromIntegral $". indent 1. body) +genMarshalResult _ _ _ "gdouble" = ("Double", \body -> ss "liftM realToFrac $". indent 1. body) +genMarshalResult _ _ _ "gfloat" = ("Float", \body -> ss "liftM realToFrac $". indent 1. body) +genMarshalResult _ _ _ "gunichar" = ("Char", \body -> ss "liftM (chr . fromIntegral) $". indent 1. body) +genMarshalResult _ _ _ "void" = ("()", id) +genMarshalResult _ funcName _ "const-gchar*" = if maybeNullResult funcName then ("(Maybe String)", \body -> body. @@ -198,7 +197,7 @@ else ("String", \body -> body. indent 1. ss ">>= peekUTFString") -genMarshalResult _ funcName "gchar*" = +genMarshalResult _ funcName _ "gchar*" = if maybeNullResult funcName then ("(Maybe String)", \body -> body. @@ -206,41 +205,51 @@ else ("String", \body -> body. indent 1. ss ">>= readUTFString") -genMarshalResult _ _ "const-GSList*" = +genMarshalResult _ _ _ "const-GSList*" = ("[{- element type -}]", \body -> body. indent 1. ss ">>= readGSList". indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})") -genMarshalResult _ _ "GSList*" = +genMarshalResult _ _ _ "GSList*" = ("[{- element type -}]", \body -> body. indent 1. ss ">>= fromGSList". indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})") -genMarshalResult _ _ "GList*" = +genMarshalResult _ _ _ "GList*" = ("[{- element type -}]", \body -> body. indent 1. ss ">>= fromGList". indent 1. ss ">>= mapM (\\elemPtr -> {-marshal elem-})") -genMarshalResult knownSymbols funcName typeName' +genMarshalResult knownSymbols funcName funcIsConstructor typeName' | isUpper (head typeName') && last typeName' == '*' && last typeName /= '*' && symbolIsObject typeKind = if maybeNullResult funcName then ("(Maybe " ++ shortTypeName ++ ")", - \body -> ss "maybeNull (" .ss constructor. ss " mk". ss shortTypeName. ss ") $". + \body -> ss "maybeNull (" .ss constructor. ss " mk". ss shortTypeName. ss ") $". cast. indent 1. body) else (shortTypeName, - \body -> ss constructor. ss " mk". ss shortTypeName. ss " $". + \body -> ss constructor. ss " mk". ss shortTypeName. ss " $". cast. indent 1. body) where typeName = init typeName' shortTypeName = stripKnownPrefixes typeName typeKind = lookupFM knownSymbols typeName - constructor | symbolIsGObject typeKind = "makeNewGObject" - | symbolIsGtkObject typeKind = "makeNewObject" - -genMarshalResult knownSymbols _ typeName + constructor | "GtkObject" `elem` sym_object_parents (fromJust typeKind) + = "makeNewObject" + | "GObject" `elem` sym_object_parents (fromJust typeKind) + = "makeNewGObject" + cast | funcIsConstructor + && constructorReturnType /= typeName = + indent 1. ss "liftM (castPtr :: Ptr ". ss (stripKnownPrefixes constructorReturnType). + ss " -> Ptr ". ss (stripKnownPrefixes typeName). ss ") $" + | otherwise = id + where constructorReturnType | "GtkWidget" `elem` sym_object_parents (fromJust typeKind) + = "GtkWidget" + | otherwise = typeName + +genMarshalResult knownSymbols _ _ typeName | isUpper (head typeName) && symbolIsEnum typeKind = (shortTypeName, @@ -249,7 +258,7 @@ where shortTypeName = stripKnownPrefixes typeName typeKind = lookupFM knownSymbols typeName -genMarshalResult knownSymbols _ typeName +genMarshalResult knownSymbols _ _ typeName | isUpper (head typeName) && symbolIsFlags typeKind = ("[" ++ shortTypeName ++ "]", @@ -258,7 +267,7 @@ where shortTypeName = stripKnownPrefixes typeName typeKind = lookupFM knownSymbols typeName -genMarshalResult _ _ unknownType = ("{-" ++ unknownType ++ "-}", id) +genMarshalResult _ _ _ unknownType = ("{-" ++ unknownType ++ "-}", id) -- Takes the type string and returns the Haskell Type and the GValue constructor -- Index: CodeGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- CodeGen.hs 6 Mar 2005 17:50:46 -0000 1.13 +++ CodeGen.hs 25 Mar 2005 19:14:55 -0000 1.14 @@ -13,7 +13,8 @@ import Marshal import StringUtils import ModuleScan -import MarshalFixup (stripKnownPrefixes, maybeNullParameter, maybeNullResult, fixCFunctionName) +import MarshalFixup (stripKnownPrefixes, maybeNullParameter, maybeNullResult, + fixCFunctionName, leafClass) import Prelude hiding (Enum, lines) import List (groupBy, sortBy, isPrefixOf, isSuffixOf, partition, find) @@ -25,8 +26,8 @@ ------------------------------------------------------------------------------- -- Now lets actually generate some code fragments based on the api info ------------------------------------------------------------------------------- -genFunction :: KnownSymbols -> Method -> Maybe FuncDoc -> Maybe MethodInfo -> ShowS -genFunction knownSymbols method doc info = +genFunction :: KnownSymbols -> Bool -> Method -> Maybe FuncDoc -> Maybe MethodInfo -> ShowS +genFunction knownSymbols isConstructor method doc info = formattedDoc. ss functionName. ss " :: ". functionType. nl. ss functionName. sc ' '. formattedParamNames. sc '='. @@ -46,7 +47,8 @@ | ((Just _, _), p) <- zip paramTypes' (method_parameters method) ] formattedParamNames = cat (map (\name -> ss name.sc ' ') paramNames) (returnType', returnMarshaler) = - genMarshalResult knownSymbols (method_cname method) (method_return_type method) + genMarshalResult knownSymbols (method_cname method) + isConstructor (method_return_type method) returnType = ("IO " ++ returnType', lookup "Returns" paramDocMap) functionType = (case classConstraints of [] -> id @@ -61,7 +63,7 @@ Just info -> methodinfo_unsafe info formattedDoc = haddocFormatDeclaration knownSymbols docNullsAllFixed funcdoc_paragraphs doc docNullsAllFixed = maybeNullResult (method_cname method) - || or [ maybeNullParameter (method_cname method) (parameter_name p) + || or [ maybeNullParameter (method_cname method) (cParamNameToHsName (parameter_name p)) | p <- method_parameters method ] paramDocMap = case doc of Nothing -> [] @@ -146,7 +148,7 @@ genMethods :: KnownSymbols -> Object -> [FuncDoc] -> [MethodInfo] -> [(ShowS, (Since, Deprecated))] genMethods knownSymbols object apiDoc methodInfo = - [ (genFunction knownSymbols method doc info, (maybe "" funcdoc_since doc, method_deprecated method)) + [ (genFunction knownSymbols False method doc info, (maybe "" funcdoc_since doc, method_deprecated method)) | (method, doc, info) <- methods object apiDoc methodInfo True] methods :: Object -> [FuncDoc] -> [MethodInfo] -> Bool -> [(Method, Maybe FuncDoc, Maybe MethodInfo)] @@ -186,18 +188,28 @@ genConstructors :: KnownSymbols -> Object -> [FuncDoc] -> [MethodInfo] -> [(ShowS, (Since, Deprecated))] genConstructors knownSymbols object apiDoc methodsInfo = - [ (genFunction knownSymbols constructor doc info, (maybe "" funcdoc_since doc, notDeprecated)) + [ (genFunction knownSymbols True constructor doc info, (maybe "" funcdoc_since doc, notDeprecated)) | (constructor, doc, info) <- constructors object apiDoc methodsInfo ] constructors :: Object -> [FuncDoc] -> [MethodInfo] -> [(Method, Maybe FuncDoc, Maybe MethodInfo)] constructors object docs methodsInfo = - [ (mungeConstructor object constructor - ,lookup (constructor_cname constructor) docmap - ,lookup (constructor_cname constructor) infomap) + map snd $ + sortBy (comparing fst) + [ let doc = lookup (constructor_cname constructor) docmap + (info,infoIndex)= case lookup (constructor_cname constructor) infomap of + Nothing -> (Nothing, endInfoIndex) + Just (info, index) -> (Just info, index) + in (infoIndex,(mungeConstructor object constructor, doc, info)) | constructor <- object_constructors object , null [ () | VarArgs <- constructor_parameters constructor] ] - where docmap = [ (funcdoc_name doc, doc) | doc <- docs ] - infomap = [ (methodinfo_cname info, info) | info <- methodsInfo ] + where docmap = [ (funcdoc_name doc, deleteReturnDoc doc) | doc <- docs ] + infomap = [ (methodinfo_cname info, (info,index)) + | (info,index) <- zip methodsInfo [1..] ] + endInfoIndex = length methodsInfo + -- the documentation for the constructor return value is almost + -- universally useless and pointless so remove it. + deleteReturnDoc doc = doc { funcdoc_params = [ p | p <- funcdoc_params doc + , paramdoc_name p /= "Returns" ] } mungeConstructor :: Object -> Constructor -> Method mungeConstructor object constructor = @@ -208,7 +220,7 @@ method_parameters = constructor_parameters constructor, method_shared = False, method_deprecated = False - } + } properties :: Object -> [PropDoc] -> [(Either Property (Method, Method), Maybe PropDoc)] properties object docs = @@ -267,7 +279,9 @@ genAtter :: KnownSymbols -> Object -> Maybe PropDoc -> String -> String -> String -> String -> ShowS genAtter knownSymbols object doc propertyName propertyType getter setter = formattedDoc. - ss propertyName. ss " :: Attr ". objectType. sc ' '. ss propertyType. nl. + (if leafClass (object_cname object) + then ss propertyName. ss " :: Attr ". objectType. sc ' '. ss propertyType. nl + else ss propertyName. ss " :: ". objectType. ss "Class self => Attr self ". ss propertyType. nl). ss propertyName. ss " = Attr ". indent 1. ss getter. indent 1. ss setter @@ -290,7 +304,7 @@ where --propertyName = cFuncNameToHsPropName (method_cname getterMethod) propertyName = lowerCaseFirstChar (object_name object ++ drop 3 (method_name getterMethod)) - (propertyType, _) = genMarshalResult knownSymbols (method_cname getterMethod) + (propertyType, _) = genMarshalResult knownSymbols (method_cname getterMethod) False (method_return_type getterMethod) getter = cFuncNameToHsName (method_cname getterMethod) setter = cFuncNameToHsName (method_cname setterMethod) @@ -389,7 +403,6 @@ | enum <- namespace_enums namespace ] ++ [ (object_cname object, objectKind object) | object <- namespace_objects namespace ] - ++ [ ("GObject", SymObjectType GObjectKind) ] ++ [ (member_cname member, SymEnumValue) | enum <- namespace_enums namespace , member <- enum_members enum ] @@ -399,14 +412,9 @@ -- find if an object inherits via GtkObject or directly from GObject where objectKind :: Object -> CSymbol - objectKind object = lookup (objectParents object) - where lookup [] = trace ( "Warning: " ++ object_name object - ++ " does not inherit from GObject! " - ++ show (objectParents object)) SymStructType - lookup ("GObject":os) = SymObjectType GObjectKind - lookup ("GtkObject":os) = SymObjectType GtkObjectKind - lookup ("GdkBitmap":os) = SymObjectType GObjectKind -- Hack! - lookup (_:os) = lookup os + objectKind object | "GObject" `elem` parents = SymObjectType parents + | otherwise = SymStructType + where parents = objectParents object objectParents :: Object -> [String] objectParents object = object_cname object : case object_parent object `lookup` objectMap of @@ -430,9 +438,13 @@ ,(ss " ".ss (object_name object).sc ',', defaultAttrs) ,(ss " ".ss (object_name object).ss "Class,", defaultAttrs) ,(ss " ".ss "castTo".ss (object_name object).sc ',', defaultAttrs)] - ++ sectionHeader "Constructors" - [ (ss " ". ss (cFuncNameToHsName (method_cname constructor)). sc ',' + ++ (sectionHeader "Constructors" + . map fst + . sortBy (comparing snd)) + [ let constructorName = cFuncNameToHsName (method_cname constructor) in + ((ss " ". ss constructorName. sc ',' ,(maybe "" funcdoc_since doc, notDeprecated)) + ,fromMaybe (maxBound::Int) (lookup constructorName exportIndexMap)) | (constructor, doc, _) <- constructors object (moduledoc_functions docs) []] ++ (sectionHeader "Methods" . map fst Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- ApiGen.hs 4 Mar 2005 22:21:35 -0000 1.20 +++ ApiGen.hs 25 Mar 2005 19:14:54 -0000 1.21 @@ -144,6 +144,7 @@ module_name = object_name object, module_prefix = modPrefix, module_needspreproc = False, + module_needsc2hs = True, module_filename = object_name object ++ ".chs", module_authors = ["[Insert your full name here]"], module_created = date, Index: ModuleScan.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ModuleScan.hs,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- ModuleScan.hs 4 Mar 2005 22:21:35 -0000 1.5 +++ ModuleScan.hs 25 Mar 2005 19:14:39 -0000 1.6 @@ -19,6 +19,7 @@ module_name :: String, module_prefix :: String, module_needspreproc :: Bool, + module_needsc2hs :: Bool, module_filename :: String, module_authors :: [String], module_created :: String, @@ -72,21 +73,28 @@ scanModules path excludePaths = do modules <- findModules excludePaths path mapM (\moduleName -> do ppExists <- doesFileExist (moduleName ++ ".chs.pp") - if ppExists then scanModule (moduleName ++ ".chs.pp") - else scanModule (moduleName ++ ".chs")) modules + chsExists <- doesFileExist (moduleName ++ ".chs") + if ppExists + then scanModule (moduleName ++ ".chs.pp") + else if chsExists + then scanModule (moduleName ++ ".chs") + else scanModule (moduleName ++ ".hs") + ) modules findModules :: [FilePath] -> FilePath -> IO [FilePath] findModules excludePaths path | path `elem` excludePaths = return [] findModules excludePaths path = do files <- getDirectoryContents path - let (chsFiles, maybeDirs) = partition (\file -> ".chs" `isSuffixOf` file - || ".chs.pp" `isSuffixOf` file) files + let (chsFiles, maybeDirs) = partition (\file -> ".chs.pp" `isSuffixOf` file + || ".chs" `isSuffixOf` file + || ".hs" `isSuffixOf` file) files modules = map head . group . sort . map extractModule $ chsFiles extractModule [] = [] + extractModule ('.':'h':'s':[]) = [] extractModule ('.':'c':'h':'s':[]) = [] extractModule ('.':'c':'h':'s':'.':'p':'p':[]) = [] extractModule (c:cs) = c : extractModule cs @@ -108,6 +116,7 @@ module_filename = moduleNameToFileName (module_name moduleInfo) (module_prefix moduleInfo) (module_needspreproc moduleInfo) + (module_needsc2hs moduleInfo) } scanModuleContent :: String -> String -> ModuleInfo @@ -120,6 +129,7 @@ module_name = head $ [ name | Module name prefix <- headerLines ] ++ [missing], module_prefix = head $ [ prefix | Module name prefix <- headerLines ] ++ [missing], module_needspreproc = ".chs.pp" `isSuffixOf` filename, + module_needsc2hs = ".chs" `isSuffixOf` filename, module_filename = "", module_authors = head $ [ authors | Authors authors <- headerLines ] ++ [[missing]], module_created = head $ [ created | Created created <- headerLines ] ++ [missing], @@ -136,9 +146,10 @@ } where missing = "{-missing-}" -moduleNameToFileName :: String -> String -> Bool -> String -moduleNameToFileName name prefix preproc = map dotToSlash prefix ++ "/" ++ name - ++ if preproc then ".chs.pp" else ".chs" +moduleNameToFileName :: String -> String -> Bool -> Bool -> String +moduleNameToFileName name prefix preproc c2hs = + map dotToSlash prefix ++ "/" ++ name + ++ if preproc then ".chs.pp" else if c2hs then ".chs" else ".hs" where dotToSlash '.' = '/' dotToSlash c = c Index: glib-sources.xml =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/glib-sources.xml,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- glib-sources.xml 17 Feb 2005 13:51:35 -0000 1.2 +++ glib-sources.xml 25 Mar 2005 19:14:55 -0000 1.3 @@ -1,15 +1,17 @@ <gapi-parser-input> <api filename="glib-api.xml"> - <library name="gobject"> - <namespace name="GObject"> - <dir>glib/gobject</dir> - <!-- exclude programs --> - <exclude>glib/gobject/glib-genmarshal.c</exclude> - <exclude>glib/gobject/gobject-query.c</exclude> - <exclude>glib/gobject/stamp-gmarshal.h</exclude> - <exclude>glib/gobject/testgobject.c</exclude> - <!-- this file causes the gapi parser to go into a infinite loop --> - <exclude>glib/gobject/gvalue.h</exclude> + <library name="glib"> + <namespace name="G"> + <dir>glib/glib</dir> + <!-- exclude huge static arrays --> + <exclude>glib/glib/gscanner.h</exclude> + <exclude>glib/glib/gunibreak.h</exclude> + <exclude>glib/glib/gunichartables.h</exclude> + <exclude>glib/glib/gunicomp.h</exclude> + <exclude>glib/glib/gunidecomp.h</exclude> + + <!-- this file causes the gapi parser to go into a infinite loop --> + <exclude>glib/glib/gbsearcharray.h</exclude> </namespace> </library> </api> --- NEW FILE: gobject-sources.xml --- <gapi-parser-input> <api filename="gobject-api.xml"> <library name="gobject"> <namespace name="GObject"> <dir>glib/gobject</dir> <!-- exclude programs --> <exclude>glib/gobject/glib-genmarshal.c</exclude> <exclude>glib/gobject/gobject-query.c</exclude> <exclude>glib/gobject/stamp-gmarshal.h</exclude> <exclude>glib/gobject/testgobject.c</exclude> <!-- this file causes the gapi parser to go into a infinite loop --> <exclude>glib/gobject/gvalue.h</exclude> </namespace> </library> </api> </gapi-parser-input> Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- Makefile 25 Feb 2005 01:32:11 -0000 1.10 +++ Makefile 25 Mar 2005 19:14:55 -0000 1.11 @@ -78,11 +78,13 @@ ./mkdocxml.sh $< | xsltproc format-docs.xsl - > $@ gtk-modules : gtk-api.xml gtk-docs.xml Template.chs ApiGen \ - gdk-api.xml pango-api.xml atk-api.xml glib-api.xml + gdk-api.xml pango-api.xml atk-api.xml \ + gobject-api.xml glib-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=glib-api.xml \ + --includeapi=atk-api.xml --includeapi=gobject-api.xml \ + --includeapi=glib-api.xml \ --excludeapi=gtk.ignore \ --modprefix=Graphics.UI.Gtk.{-Category-} \ --scanmodules=../../gtk/Graphics/UI/Gtk \ @@ -118,6 +120,27 @@ @mkdir -p $@ ./ApiGen $< Template.chs --doc=pango-docs.xml --outdir=$@ +################### +# +# Glib modules +# +# +glib-docs.xml : glib/docs/reference/glib/xml format-docs.xsl + ./mkdocxml.sh $< | xsltproc format-docs.xsl - > $@ + +## Note: this is currently pointless since the code generator only produces +## modules for 'object's and not 'class'es which is all glib contains. +glib-modules : glib-api.xml glib-docs.xml Template.chs ApiGen + @mkdir -p $@ + ./ApiGen $< Template.chs --doc=glib-docs.xml --outdir=$@ + +gobject-docs.xml : glib/docs/reference/gobject/xml format-docs.xsl + ./mkdocxml.sh $< | xsltproc format-docs.xsl - > $@ + +## Note: again this is mostly pointless +gobject-modules : gobject-api.xml gobject-docs.xml Template.chs ApiGen + @mkdir -p $@ + ./ApiGen $< Template.chs --doc=gobject-docs.xml --outdir=$@ ######################## # @@ -145,7 +168,8 @@ # ApiGen : ApiGen.hs Api.hs Docs.hs FormatDocs.hs \ Marshal.hs CodeGen.hs StringUtils.hs ModuleScan.hs MarshalFixup.hs - ghc --make $< -o $@ + $(HC) --make $< -o $@ +HC=ghc gapi_format_xml : formatXml.c gcc `pkg-config --cflags --libs libxml-2.0 glib-2.0` $< -o $@ Index: MarshalFixup.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/MarshalFixup.hs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- MarshalFixup.hs 27 Feb 2005 20:02:17 -0000 1.3 +++ MarshalFixup.hs 25 Mar 2005 19:14:55 -0000 1.4 @@ -28,6 +28,8 @@ fixCFunctionName "vbutton" = "VButton" fixCFunctionName "hpaned" = "HPaned" fixCFunctionName "vpaned" = "VPaned" +fixCFunctionName "hborder" = "HBorder" +fixCFunctionName "vborder" = "VBorder" fixCFunctionName "hseparator" = "HSeparator" fixCFunctionName "vseparator" = "VSeparator" fixCFunctionName "hscrollbar" = "HScrollbar" @@ -53,9 +55,14 @@ leafClass :: String -> Bool leafClass "GtkAdjustment" = True leafClass "GdkPixbuf" = True +leafClass "GtkImage" = True leafClass "GtkIconFactory" = True leafClass "GtkEntryCompletion" = True leafClass "GtkFileFilter" = True +leafClass "GtkUIManager" = True +leafClass "GtkRadioButton" = True +leafClass "GtkEventBox" = True +leafClass "GtkExpander" = True leafClass _ = False -- This is a table of fixup information. It lists function parameters that @@ -71,6 +78,11 @@ maybeNullParameter :: String -> String -> Bool maybeNullParameter "gtk_entry_completion_set_model" "model" = True maybeNullParameter "gtk_label_new" "str" = True +maybeNullParameter "gtk_about_dialog_set_license" "license" = True +maybeNullParameter "gtk_about_dialog_set_logo" "logo" = True +maybeNullParameter "gtk_about_dialog_set_logo_icon_name" "logo" = True +maybeNullParameter "gtk_layout_new" _ = True +maybeNullParameter "gtk_notebook_set_menu_label" "menuLabel" = True maybeNullParameter _ _ = False -- similarly for method return values/types. @@ -84,6 +96,12 @@ maybeNullResult "gtk_container_get_focus_vadjustment" = True maybeNullResult "gtk_paned_get_child1" = True maybeNullResult "gtk_paned_get_child2" = True +maybeNullResult "gtk_label_get_mnemonic_widget" = True +maybeNullResult "gtk_notebook_get_menu_label" = True +maybeNullResult "gtk_notebook_get_menu_label_text" = True +maybeNullResult "gtk_notebook_get_nth_page" = True +maybeNullResult "gtk_notebook_get_tab_label" = True +maybeNullResult "gtk_notebook_get_tab_label_text" = True maybeNullResult _ = False -- On win32 for glib/gtk 2.6 they changed the interpretation of functions that |
|
From: Duncan C. <dun...@us...> - 2005-03-24 17:31:10
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17311/gtk/Graphics/UI/Gtk/Layout Modified Files: Alignment.chs.pp AspectFrame.chs Expander.chs.pp Fixed.chs HBox.chs HButtonBox.chs HPaned.chs Layout.chs Notebook.chs.pp Table.chs VBox.chs VButtonBox.chs VPaned.chs Log Message: Documentation changes and code formatting changes. Index: Fixed.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/Fixed.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Fixed.chs 25 Feb 2005 22:53:41 -0000 1.4 +++ Fixed.chs 24 Mar 2005 17:30:59 -0000 1.5 @@ -27,7 +27,7 @@ -- A container which allows you to position widgets at fixed coordinates -- module Graphics.UI.Gtk.Layout.Fixed ( --- * Description +-- * Detail -- -- | The 'Fixed' widget is a container which can place child widgets at fixed -- positions and with fixed sizes, given in pixels. 'Fixed' performs no @@ -85,12 +85,16 @@ fixedPut, fixedMove, fixedSetHasWindow, - fixedGetHasWindow + fixedGetHasWindow, + +-- * Properties + fixedHasWindow ) where import Monad (liftM) import System.Glib.FFI +import System.Glib.Attributes (Attr(..)) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} @@ -103,40 +107,70 @@ -- | Creates a new 'Fixed' container. -- fixedNew :: IO Fixed -fixedNew = makeNewObject mkFixed $ liftM castPtr $ - {#call unsafe fixed_new#} +fixedNew = + makeNewObject mkFixed $ + liftM (castPtr :: Ptr Widget -> Ptr Fixed) $ + {# call unsafe fixed_new #} -------------------- -- Methods -- | Adds a widget to a 'Fixed' container at the given position. -- -fixedPut :: (FixedClass obj, WidgetClass widget) => obj - -> widget -> (Int, Int) -> IO () -fixedPut obj widget (x, y) = - {#call fixed_put#} (toFixed obj) (toWidget widget) - (fromIntegral x) (fromIntegral y) +fixedPut :: (FixedClass self, WidgetClass widget) => self + -> widget -- ^ @widget@ - the widget to add. + -> (Int, Int) -- ^ @(x,y)@ - the horizontal and vertical position to place + -- the widget at. + -> IO () +fixedPut self widget (x, y) = + {# call fixed_put #} + (toFixed self) + (toWidget widget) + (fromIntegral x) + (fromIntegral y) -- | Moves a child of a 'Fixed' container to the given position. -- -fixedMove :: (FixedClass obj, WidgetClass widget) => obj - -> widget -> (Int, Int) -> IO () -fixedMove obj widget (x, y) = - {#call fixed_move#} (toFixed obj) (toWidget widget) - (fromIntegral x) (fromIntegral y) +fixedMove :: (FixedClass self, WidgetClass widget) => self + -> widget -- ^ @widget@ - the child widget. + -> (Int, Int) -- ^ @(x,y)@ - the horizontal and vertical position to move the + -- widget to. + -> IO () +fixedMove self widget (x, y) = + {# call fixed_move #} + (toFixed self) + (toWidget widget) + (fromIntegral x) + (fromIntegral y) --- | Sets whether the 'Fixed' widget is created with a separate "DrawWindow" for +-- | Sets whether the 'Fixed' widget is created with a separate 'DrawWindow' for -- its window or not. (By default, it will be created with no separate --- "DrawWindow"). This function must be called while the widget is not realized, +-- 'DrawWindow'). This function must be called while the 'Fixed' is not realized, -- for instance, immediately after the window is created. -- -fixedSetHasWindow :: FixedClass obj => obj -> Bool -> IO () -fixedSetHasWindow obj hasWindow = - {#call fixed_set_has_window#} (toFixed obj) (fromBool hasWindow) +-- This function was added to provide an easy migration path for older +-- applications which may expect 'Fixed' to have a separate window. +-- +fixedSetHasWindow :: FixedClass self => self -> Bool -> IO () +fixedSetHasWindow self hasWindow = + {# call fixed_set_has_window #} + (toFixed self) + (fromBool hasWindow) --- | Gets whether the 'Fixed' container has its own "DrawWindow". See --- 'fixedSetHasWindow'. +-- | Gets whether the 'Fixed' has its own 'DrawWindow'. See 'fixedSetHasWindow'. -- -fixedGetHasWindow :: FixedClass obj => obj -> IO Bool -fixedGetHasWindow obj = liftM toBool $ - {#call unsafe fixed_get_has_window#} (toFixed obj) +fixedGetHasWindow :: FixedClass self => self -> IO Bool +fixedGetHasWindow self = + liftM toBool $ + {# call unsafe fixed_get_has_window #} + (toFixed self) + +-------------------- +-- Properties + +-- | \'hasWindow\' property. See 'fixedGetHasWindow' and 'fixedSetHasWindow' +-- +fixedHasWindow :: FixedClass self => Attr self Bool +fixedHasWindow = Attr + fixedGetHasWindow + fixedSetHasWindow Index: Notebook.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/Notebook.chs.pp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Notebook.chs.pp 13 Mar 2005 19:34:34 -0000 1.4 +++ Notebook.chs.pp 24 Mar 2005 17:31:00 -0000 1.5 @@ -29,10 +29,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A tabbed notebook container. +-- A tabbed notebook container -- module Graphics.UI.Gtk.Layout.Notebook ( --- * Description +-- * Detail -- -- | The 'Notebook' widget is a 'Container' whose children are pages that can [...1060 lines suppressed...] notebookGetShowBorder notebookSetShowBorder @@ -708,7 +882,7 @@ -- -- Default value: @False@ -- -notebookScrollable :: Attr Notebook Bool +notebookScrollable :: NotebookClass self => Attr self Bool notebookScrollable = Attr notebookGetScrollable notebookSetScrollable @@ -716,7 +890,7 @@ -- | \'currentPage\' property. See 'notebookGetCurrentPage' and -- 'notebookSetCurrentPage' -- -notebookCurrentPage :: Attr Notebook Int +notebookCurrentPage :: NotebookClass self => Attr self Int notebookCurrentPage = Attr notebookGetCurrentPage notebookSetCurrentPage Index: HButtonBox.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/HButtonBox.chs,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- HButtonBox.chs 25 Feb 2005 01:11:34 -0000 1.2 +++ HButtonBox.chs 24 Mar 2005 17:31:00 -0000 1.3 @@ -27,7 +27,7 @@ -- A container for arranging buttons horizontally -- module Graphics.UI.Gtk.Layout.HButtonBox ( --- * Description +-- * Detail -- -- | A button box should be used to provide a consistent layout of buttons -- throughout your application. The layout\/spacing can be altered by the @@ -78,8 +78,10 @@ -------------------- -- Constructors --- | +-- | Creates a new horizontal button box. -- hButtonBoxNew :: IO HButtonBox -hButtonBoxNew = makeNewObject mkHButtonBox $ - liftM castPtr {#call unsafe hbutton_box_new#} +hButtonBoxNew = + makeNewObject mkHButtonBox $ + liftM (castPtr :: Ptr Widget -> Ptr HButtonBox) $ + {# call unsafe hbutton_box_new #} Index: HBox.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/HBox.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- HBox.chs 25 Feb 2005 01:11:34 -0000 1.3 +++ HBox.chs 24 Mar 2005 17:30:59 -0000 1.4 @@ -24,11 +24,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- This is a special version of 'Box'. This widget shows its child --- widgets in a horizontal line. +-- A horizontal container box -- module Graphics.UI.Gtk.Layout.HBox ( --- * Description +-- * Detail -- -- | 'HBox' is a container that organizes child widgets into a single row. -- @@ -47,6 +46,7 @@ -- | +----'Box' -- | +----HBox -- | +----'Combo' +-- | +----'FileChooserButton' -- | +----'Statusbar' -- @ @@ -71,12 +71,17 @@ -------------------- -- Constructors --- | --- Create a container that shows several children horizontally. If --- @homogeneous@ --- is set all children will be allotted the same amount of space. There will be --- @spacing@ pixel between each two children. +-- | Creates a new 'HBox'. -- -hBoxNew :: Bool -> Int -> IO HBox -hBoxNew homogeneous spacing = makeNewObject mkHBox $ liftM castPtr $ - {#call unsafe hbox_new#} (fromBool homogeneous) (fromIntegral spacing) +hBoxNew :: + Bool -- ^ @homogeneous@ - @True@ if all children are to be given equal + -- space allotments. + -> Int -- ^ @spacing@ - the number of pixels to place by default between + -- children. + -> IO HBox +hBoxNew homogeneous spacing = + makeNewObject mkHBox $ + liftM (castPtr :: Ptr Widget -> Ptr HBox) $ + {# call unsafe hbox_new #} + (fromBool homogeneous) + (fromIntegral spacing) Index: AspectFrame.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/AspectFrame.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- AspectFrame.chs 25 Feb 2005 01:11:34 -0000 1.3 +++ AspectFrame.chs 24 Mar 2005 17:30:59 -0000 1.4 @@ -24,10 +24,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A frame that constrains its child to a particular aspect ratio. +-- A frame that constrains its child to a particular aspect ratio -- module Graphics.UI.Gtk.Layout.AspectFrame ( --- * Description +-- * Detail -- -- | The 'AspectFrame' is useful when you want pack a widget so that it can -- resize but always retains the same aspect ratio. For instance, one might be @@ -72,26 +72,49 @@ -------------------- -- Constructors --- | Create an AspectFrame widget. --- --- * If ratio is not given, the aspect ratio is taken from the child widget. +-- | Create a new 'AspectFrame'. -- --- * The frame may be augmented with a label which can be set by --- @frameSetLabel@. +-- The frame may be augmented with a label which can be set by @frameSetLabel@. -- -aspectFrameNew :: Float -> Float -> Maybe Float -> IO AspectFrame -aspectFrameNew xalign yalign ratio = makeNewObject mkAspectFrame $ - liftM castPtr $ {#call unsafe aspect_frame_new#} nullPtr (realToFrac xalign) - (realToFrac yalign) (maybe 0.0 realToFrac ratio) (fromBool $ isNothing ratio) +aspectFrameNew :: + Float -- ^ @xalign@ - Horizontal alignment of the child within + -- the allocation of the 'AspectFrame'. This ranges from 0.0 + -- (left aligned) to 1.0 (right aligned) + -> Float -- ^ @yalign@ - Vertical alignment of the child within the + -- allocation of the 'AspectFrame'. This ranges from 0.0 + -- (left aligned) to 1.0 (right aligned) + -> Maybe Float -- ^ @ratio@ - The desired aspect ratio. If @Nothing@ the + -- aspect ratio is taken from the requistion of the child. + -> IO AspectFrame +aspectFrameNew xalign yalign ratio = + makeNewObject mkAspectFrame $ + liftM (castPtr :: Ptr Widget -> Ptr AspectFrame) $ + {# call unsafe aspect_frame_new #} + nullPtr + (realToFrac xalign) + (realToFrac yalign) + (maybe 0.0 realToFrac ratio) + (fromBool $ isNothing ratio) -------------------- -- Methods --- | Change the space use behaviour of an --- 'AspectFrame'. +-- | Set parameters for an existing 'AspectFrame'. -- -aspectFrameSet :: AspectFrameClass af => af -> Float -> Float -> Maybe Float -> - IO () -aspectFrameSet af xalign yalign ratio = {#call aspect_frame_set#} - (toAspectFrame af) (realToFrac xalign) (realToFrac yalign) - (maybe 0.0 realToFrac ratio) (fromBool $ isNothing ratio) +aspectFrameSet :: AspectFrameClass self => self + -> Float -- ^ @xalign@ - Horizontal alignment of the child within the + -- allocation of the 'AspectFrame'. This ranges from 0.0 (left + -- aligned) to 1.0 (right aligned) + -> Float -- ^ @yalign@ - Vertical alignment of the child within the + -- allocation of the 'AspectFrame'. This ranges from 0.0 (left + -- aligned) to 1.0 (right aligned) + -> Maybe Float -- ^ @ratio@ - The desired aspect ratio. If @Nothing@ the + -- aspect ratio is taken from the requistion of the child. + -> IO () +aspectFrameSet self xalign yalign ratio = + {# call aspect_frame_set #} + (toAspectFrame self) + (realToFrac xalign) + (realToFrac yalign) + (maybe 0.0 realToFrac ratio) + (fromBool $ isNothing ratio) Index: Alignment.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/Alignment.chs.pp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- Alignment.chs.pp 25 Feb 2005 01:11:34 -0000 1.3 +++ Alignment.chs.pp 24 Mar 2005 17:30:59 -0000 1.4 @@ -27,7 +27,7 @@ -- A widget which controls the alignment and size of its child -- module Graphics.UI.Gtk.Layout.Alignment ( --- * Description +-- * Detail -- -- | The 'Alignment' widget controls the alignment and size of its child -- widget. It has four settings: xscale, yscale, xalign, and yalign. @@ -81,48 +81,103 @@ -------------------- -- Constructors --- | Create an alignment widget. This widget tells --- its child widget how to use the given space. +-- | Creates a new 'Alignment'. -- -alignmentNew :: Float -> Float -> Float -> Float -> IO Alignment -alignmentNew yscale xalign yalign xscale = makeNewObject mkAlignment $ - liftM castPtr $ {#call unsafe alignment_new#} (realToFrac xalign) - (realToFrac yalign) (realToFrac xscale) (realToFrac yscale) +alignmentNew :: + Float -- ^ @xalign@ - the horizontal alignment of the child widget, + -- from 0 (left) to 1 (right). + -> Float -- ^ @yalign@ - the vertical alignment of the child widget, + -- from 0 (top) to 1 (bottom). + -> Float -- ^ @xscale@ - the amount that the child widget expands + -- horizontally to fill up unused space, from 0 to 1. A value + -- of 0 indicates that the child widget should never expand. A + -- value of 1 indicates that the child widget will expand to + -- fill all of the space allocated for the 'Alignment'. + -> Float -- ^ @yscale@ - the amount that the child widget expands + -- vertically to fill up unused space, from 0 to 1. The values + -- are similar to @xscale@. + -> IO Alignment +alignmentNew xalign yalign xscale yscale = + makeNewObject mkAlignment $ + liftM (castPtr :: Ptr Widget -> Ptr Alignment) $ + {# call unsafe alignment_new #} + (realToFrac xalign) + (realToFrac yalign) + (realToFrac xscale) + (realToFrac yscale) -------------------- -- Methods --- | Change the space use behaviour of an 'Alignment'. +-- | Sets the 'Alignment' values. -- -alignmentSet :: AlignmentClass al => al -> Float -> Float -> Float -> Float -> - IO () -alignmentSet al xalign yalign xscale yscale = {#call alignment_set#} - (toAlignment al) (realToFrac xalign) (realToFrac yalign) - (realToFrac xscale) (realToFrac yscale) +alignmentSet :: AlignmentClass self => self + -> Float -- ^ @xalign@ - the horizontal alignment of the child widget, from 0 + -- (left) to 1 (right). + -> Float -- ^ @yalign@ - the vertical alignment of the child widget, from 0 + -- (top) to 1 (bottom). + -> Float -- ^ @xscale@ - the amount that the child widget expands + -- horizontally to fill up unused space, from 0 to 1. A value of 0 + -- indicates that the child widget should never expand. A value of 1 + -- indicates that the child widget will expand to fill all of the + -- space allocated for the 'Alignment'. + -> Float -- ^ @yscale@ - the amount that the child widget expands vertically + -- to fill up unused space, from 0 to 1. The values are similar to + -- @xscale@. + -> IO () +alignmentSet self xalign yalign xscale yscale = + {# call alignment_set #} + (toAlignment self) + (realToFrac xalign) + (realToFrac yalign) + (realToFrac xscale) + (realToFrac yscale) #if GTK_CHECK_VERSION(2,4,0) --- | Sets the padding on the different sides of the widget. +-- | Sets the padding on the different sides of the widget. The padding adds +-- blank space to the sides of the widget. For instance, this can be used to +-- indent the child widget towards the right by adding padding on the left. -- -alignmentSetPadding :: AlignmentClass al => al -> Int -> Int -> Int -> Int -> - IO () -alignmentSetPadding al top bottom left right = - {# call gtk_alignment_set_padding #} (toAlignment al) - (fromIntegral top) (fromIntegral bottom) - (fromIntegral left) (fromIntegral right) +-- * Available since Gtk version 2.4 +-- +alignmentSetPadding :: AlignmentClass self => self + -> Int -- ^ @paddingTop@ - the padding at the top of the widget + -> Int -- ^ @paddingBottom@ - the padding at the bottom of the widget + -> Int -- ^ @paddingLeft@ - the padding at the left of the widget + -> Int -- ^ @paddingRight@ - the padding at the right of the widget. + -> IO () +alignmentSetPadding self paddingTop paddingBottom paddingLeft paddingRight = + {# call gtk_alignment_set_padding #} + (toAlignment self) + (fromIntegral paddingTop) + (fromIntegral paddingBottom) + (fromIntegral paddingLeft) + (fromIntegral paddingRight) --- | Gets the padding on the different sides of the widget. +-- | Gets the padding on the different sides of the widget. See +-- 'alignmentSetPadding'. -- -alignmentGetPadding :: AlignmentClass al => al -> IO (Int, Int, Int, Int) -alignmentGetPadding al = - alloca $ \topPtr -> alloca $ \bottomPtr -> - alloca $ \leftPtr -> alloca $ \rightPtr -> do - {# call gtk_alignment_get_padding #} (toAlignment al) - topPtr bottomPtr leftPtr rightPtr +-- * Available since Gtk version 2.4 +-- +alignmentGetPadding :: AlignmentClass self => self + -> IO (Int, Int, Int, Int) -- ^ @(paddingTop, paddingBottom, paddingLeft, + -- paddingRight)@ - the padding at the top, + -- bottom, left and right of the widget. +alignmentGetPadding self = + alloca $ \topPtr -> + alloca $ \bottomPtr -> + alloca $ \leftPtr -> + alloca $ \rightPtr -> do + {# call gtk_alignment_get_padding #} + (toAlignment self) + topPtr + bottomPtr + leftPtr + rightPtr top <- peek topPtr bottom <- peek bottomPtr left <- peek leftPtr right <- peek rightPtr return (fromIntegral top, fromIntegral bottom ,fromIntegral left, fromIntegral right) - #endif Index: VPaned.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/VPaned.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- VPaned.chs 25 Feb 2005 01:11:34 -0000 1.3 +++ VPaned.chs 24 Mar 2005 17:31:00 -0000 1.4 @@ -24,10 +24,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A container with two panes arranged vertically. +-- A container with two panes arranged vertically -- module Graphics.UI.Gtk.Layout.VPaned ( --- * Description +-- * Detail -- -- | The VPaned widget is a container widget with two children arranged -- vertically. The division between the two panes is adjustable by the user by @@ -65,7 +65,10 @@ -------------------- -- Constructors --- | +-- | Create a new 'VPaned' -- vPanedNew :: IO VPaned -vPanedNew = makeNewObject mkVPaned $ liftM castPtr {#call unsafe vpaned_new#} +vPanedNew = + makeNewObject mkVPaned $ + liftM (castPtr :: Ptr Widget -> Ptr VPaned) $ + {# call unsafe vpaned_new #} Index: Layout.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/Layout.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Layout.chs 13 Mar 2005 19:34:34 -0000 1.4 +++ Layout.chs 24 Mar 2005 17:31:00 -0000 1.5 @@ -27,7 +27,7 @@ -- Infinite scrollable area containing child widgets and\/or custom drawing -- module Graphics.UI.Gtk.Layout.Layout ( --- * Description +-- * Detail -- -- | 'Layout' is similar to 'DrawingArea' in that it's a \"blank slate\" and -- doesn't do anything but paint a blank background by default. It's different @@ -87,81 +87,148 @@ -------------------- -- Constructors --- | Create a new layout widget. +-- | Creates a new 'Layout'. Unless you have a specific adjustment you'd like +-- the layout to use for scrolling, pass @Nothing@ for @hadjustment@ and +-- @vadjustment@. -- -layoutNew :: Maybe Adjustment -> Maybe Adjustment -> IO Layout -layoutNew vAdj hAdj = makeNewObject mkLayout $ liftM castPtr $ - {#call unsafe layout_new#} (fromMAdj hAdj) (fromMAdj vAdj) - where - fromMAdj :: Maybe Adjustment -> Adjustment - fromMAdj = fromMaybe $ mkAdjustment nullForeignPtr +layoutNew :: + Maybe Adjustment -- ^ @hadjustment@ - horizontal scroll adjustment, or + -- @Nothing@ + -> Maybe Adjustment -- ^ @vadjustment@ - vertical scroll adjustment, or + -- @Nothing@ + -> IO Layout +layoutNew hadjustment vadjustment = + makeNewObject mkLayout $ + liftM (castPtr :: Ptr Widget -> Ptr Layout) $ + {# call unsafe layout_new #} + (fromMaybe (Adjustment nullForeignPtr) hadjustment) + (fromMaybe (Adjustment nullForeignPtr) vadjustment) -------------------- -- Methods --- | Insert a widget into the layout container. +-- | Adds @childWidget@ to @layout@, at position @(x,y)@. @layout@ becomes +-- the new parent container of @childWidget@. -- -layoutPut :: (LayoutClass l, WidgetClass w) => l -> w -> Int -> Int -> IO () -layoutPut l widget x y = {#call layout_put#} (toLayout l) (toWidget widget) - (fromIntegral x) (fromIntegral y) +layoutPut :: (LayoutClass self, WidgetClass childWidget) => self + -> childWidget -- ^ @childWidget@ - child widget + -> Int -- ^ @x@ - X position of child widget + -> Int -- ^ @y@ - Y position of child widget + -> IO () +layoutPut self childWidget x y = + {# call layout_put #} + (toLayout self) + (toWidget childWidget) + (fromIntegral x) + (fromIntegral y) --- | Move an existing widget within the container. +-- | Moves a current child of @layout@ to a new position. -- -layoutMove :: (LayoutClass l, WidgetClass w) => l -> w -> Int -> Int -> IO () -layoutMove l widget x y = {#call layout_move#} (toLayout l) (toWidget widget) - (fromIntegral x) (fromIntegral y) +layoutMove :: (LayoutClass self, WidgetClass childWidget) => self + -> childWidget -- ^ @childWidget@ - a current child of @layout@ + -> Int -- ^ @x@ - X position to move to + -> Int -- ^ @y@ - Y position to move to + -> IO () +layoutMove self childWidget x y = + {# call layout_move #} + (toLayout self) + (toWidget childWidget) + (fromIntegral x) + (fromIntegral y) --- | Set the size of the layout widget. +-- | Sets the size of the scrollable area of the layout. -- -layoutSetSize :: LayoutClass l => l -> Int -> Int -> IO () -layoutSetSize l width height = {#call layout_set_size#} (toLayout l) - (fromIntegral width) (fromIntegral height) +layoutSetSize :: LayoutClass self => self + -> Int -- ^ @width@ - width of entire scrollable area + -> Int -- ^ @height@ - height of entire scrollable area + -> IO () +layoutSetSize self width height = + {# call layout_set_size #} + (toLayout self) + (fromIntegral width) + (fromIntegral height) --- | Get the size of the layout widget. +-- | Gets the size that has been set on the layout, and that determines the +-- total extents of the layout's scrollbar area. See 'layoutSetSize'. -- -layoutGetSize :: LayoutClass l => l -> IO (Int, Int) -layoutGetSize l = - alloca $ \widthPtr -> alloca $ \heightPtr -> do - {#call unsafe layout_get_size#} (toLayout l) widthPtr heightPtr +layoutGetSize :: LayoutClass self => self + -> IO (Int, Int) -- ^ @(width, height)@ +layoutGetSize self = + alloca $ \widthPtr -> + alloca $ \heightPtr -> do + {# call unsafe layout_get_size #} + (toLayout self) + widthPtr + heightPtr width <-peek widthPtr height <- peek heightPtr return (fromIntegral width, fromIntegral height) --- | Retrieve the horizontal 'Adjustment' object from the layout. +-- | This function should only be called after the layout has been placed in a +-- 'ScrolledWindow' or otherwise configured for scrolling. It returns the +-- 'Adjustment' used for communication between the horizontal scrollbar and +-- @layout@. -- -layoutGetHAdjustment :: LayoutClass l => l -> IO Adjustment -layoutGetHAdjustment l = makeNewObject mkAdjustment $ - {#call unsafe layout_get_hadjustment#} (toLayout l) +-- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details. +-- +layoutGetHAdjustment :: LayoutClass self => self + -> IO Adjustment -- ^ returns horizontal scroll adjustment +layoutGetHAdjustment self = + makeNewObject mkAdjustment $ + {# call unsafe layout_get_hadjustment #} + (toLayout self) --- | Retrieve the vertical 'Adjustment' object from the layout. +-- | This function should only be called after the layout has been placed in a +-- 'ScrolledWindow' or otherwise configured for scrolling. It returns the +-- 'Adjustment' used for communication between the vertical scrollbar and +-- @layout@. -- -layoutGetVAdjustment :: LayoutClass l => l -> IO Adjustment -layoutGetVAdjustment l = makeNewObject mkAdjustment $ - {#call unsafe layout_get_vadjustment#} (toLayout l) +-- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details. +-- +layoutGetVAdjustment :: LayoutClass self => self + -> IO Adjustment -- ^ returns vertical scroll adjustment +layoutGetVAdjustment self = + makeNewObject mkAdjustment $ + {# call unsafe layout_get_vadjustment #} + (toLayout self) --- | Set the horizontal adjustment object. +-- | Sets the horizontal scroll adjustment for the layout. -- -layoutSetHAdjustment :: LayoutClass l => l -> Adjustment -> IO () -layoutSetHAdjustment l adj = {#call layout_set_hadjustment#} (toLayout l) adj +-- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details. +-- +layoutSetHAdjustment :: LayoutClass self => self + -> Adjustment -- ^ @adjustment@ - new scroll adjustment + -> IO () +layoutSetHAdjustment self adjustment = + {# call layout_set_hadjustment #} + (toLayout self) + adjustment --- | Set the vertical adjustment object. +-- | Sets the vertical scroll adjustment for the layout. -- -layoutSetVAdjustment :: LayoutClass l => l -> Adjustment -> IO () -layoutSetVAdjustment l adj = {#call layout_set_vadjustment#} (toLayout l) adj +-- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details. +-- +layoutSetVAdjustment :: LayoutClass self => self + -> Adjustment -- ^ @adjustment@ - new scroll adjustment + -> IO () +layoutSetVAdjustment self adjustment = + {# call layout_set_vadjustment #} + (toLayout self) + adjustment -------------------- -- Properties -- | The 'Adjustment' for the horizontal position. -- -layoutHAdjustment :: Attr Layout Adjustment +layoutHAdjustment :: LayoutClass self => Attr self Adjustment layoutHAdjustment = Attr layoutGetHAdjustment layoutSetHAdjustment -- | The 'Adjustment' for the vertical position. -- -layoutVAdjustment :: Attr Layout Adjustment +layoutVAdjustment :: LayoutClass self => Attr self Adjustment layoutVAdjustment = Attr layoutGetVAdjustment layoutSetVAdjustment @@ -169,13 +236,10 @@ -------------------- -- Signals --- | In case the adjustments are --- replaced, this signal is emitted. +-- | In case the adjustments are replaced, this signal is emitted. -- -onSetScrollAdjustments, afterSetScrollAdjustments :: LayoutClass l => l ->(Adjustment -> Adjustment -> IO ()) -> - IO (ConnectId l) -onSetScrollAdjustments = - connect_OBJECT_OBJECT__NONE "set-scroll-adjustments" False -afterSetScrollAdjustments = - connect_OBJECT_OBJECT__NONE "set-scroll-adjustments" True - +onSetScrollAdjustments, afterSetScrollAdjustments :: LayoutClass self => self + -> (Adjustment -> Adjustment -> IO ()) + -> IO (ConnectId self) +onSetScrollAdjustments = connect_OBJECT_OBJECT__NONE "set-scroll-adjustments" False +afterSetScrollAdjustments = connect_OBJECT_OBJECT__NONE "set-scroll-adjustments" True Index: VBox.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/VBox.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- VBox.chs 25 Feb 2005 01:11:34 -0000 1.3 +++ VBox.chs 24 Mar 2005 17:31:00 -0000 1.4 @@ -24,11 +24,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- This is a special version of 'Box'. This widget shows its child widgets --- in a vertical line. +-- A vertical container box -- module Graphics.UI.Gtk.Layout.VBox ( --- * Description +-- * Detail -- -- | 'VBox' is a container that organizes child widgets into a single column. -- @@ -73,13 +72,17 @@ -------------------- -- Constructors --- | --- Create a container that shows several children vertically. --- --- * If @homogeneous@ --- is set all children will be allotted the same amount of space. There will be --- @spacing@ pixel between each two children. +-- | Creates a new 'VBox'. -- -vBoxNew :: Bool -> Int -> IO VBox -vBoxNew homogeneous spacing = makeNewObject mkVBox $ liftM castPtr $ - {#call unsafe vbox_new#} (fromBool homogeneous) (fromIntegral spacing) +vBoxNew :: + Bool -- ^ @homogeneous@ - @True@ if all children are to be given equal + -- space allotments. + -> Int -- ^ @spacing@ - the number of pixels to place by default between + -- children. + -> IO VBox +vBoxNew homogeneous spacing = + makeNewObject mkVBox $ + liftM (castPtr :: Ptr Widget -> Ptr VBox) $ + {# call unsafe vbox_new #} + (fromBool homogeneous) + (fromIntegral spacing) Index: Table.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/Table.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Table.chs 13 Mar 2005 19:34:34 -0000 1.4 +++ Table.chs 24 Mar 2005 17:31:00 -0000 1.5 @@ -27,7 +27,7 @@ -- The table widget is a container in which widgets can be aligned in cells. -- module Graphics.UI.Gtk.Layout.Table ( --- * Description +-- * Detail -- -- | The 'Table' functions allow the programmer to arrange widgets in rows and -- columns, making it easy to align many widgets next to each other, @@ -100,116 +100,218 @@ -------------------- -- Constructors --- | Create a new table with the specified dimensions. --- Set @homogeneous@ to True if all cells should be of the same size. +-- | Used to create a new table widget. An initial size must be given by +-- specifying how many rows and columns the table should have, although this +-- can be changed later with 'tableResize'. @rows@ and @columns@ must both be +-- in the range 0 .. 65535. -- -tableNew :: Int -> Int -> Bool -> IO Table -tableNew rows columns homogeneous = makeNewObject mkTable $ liftM castPtr $ - {#call unsafe table_new#} (fromIntegral rows) (fromIntegral columns) - (fromBool homogeneous) +tableNew :: + Int -- ^ @rows@ - The number of rows the new table should have. + -> Int -- ^ @columns@ - The number of columns the new table should have. + -> Bool -- ^ @homogeneous@ - If set to @True@, all table cells are + -- resized to the size of the cell containing the largest widget. + -> IO Table +tableNew rows columns homogeneous = + makeNewObject mkTable $ + liftM (castPtr :: Ptr Widget -> Ptr Table) $ + {# call unsafe table_new #} + (fromIntegral rows) + (fromIntegral columns) + (fromBool homogeneous) -------------------- -- Methods -- | Change the dimensions of an already existing table. -- -tableResize :: TableClass tb => tb -> Int -> Int -> IO () -tableResize tb rows columns = {#call table_resize#} (toTable tb) - (fromIntegral rows) (fromIntegral columns) +tableResize :: TableClass self => self + -> Int -- ^ @rows@ - The new number of rows. + -> Int -- ^ @columns@ - The new number of columns. + -> IO () +tableResize self rows columns = + {# call table_resize #} + (toTable self) + (fromIntegral rows) + (fromIntegral columns) --- | Put a new widget in the table container. The widget should span the cells --- (leftAttach,topAttach) to (rightAttach,bottomAttach). Further formatting --- options have to be specified. +-- | Adds a widget to a table. The number of \'cells\' that a widget will +-- occupy is specified by @leftAttach@, @rightAttach@, @topAttach@ and +-- @bottomAttach@. These each represent the leftmost, rightmost, uppermost and +-- lowest column and row numbers of the table. (Columns and rows are indexed +-- from zero). -- -tableAttach :: (TableClass tb, WidgetClass w) => tb -> w -> Int -> Int -> - Int -> Int -> [AttachOptions] -> [AttachOptions] -> Int -> - Int -> IO () -tableAttach tb child leftAttach rightAttach topAttach bottomAttach xoptions - yoptions xpadding ypadding = {#call table_attach#} (toTable tb) - (toWidget child) (fromIntegral leftAttach) (fromIntegral rightAttach) - (fromIntegral topAttach) (fromIntegral bottomAttach) - ((fromIntegral.fromFlags) xoptions) ((fromIntegral.fromFlags) yoptions) - (fromIntegral xpadding) (fromIntegral ypadding) +tableAttach :: (TableClass self, WidgetClass child) => self + -> child -- ^ @child@ - The widget to add. + -> Int -- ^ @leftAttach@ - the column number to attach the left + -- side of a child widget to. + -> Int -- ^ @rightAttach@ - the column number to attach the right + -- side of a child widget to. + -> Int -- ^ @topAttach@ - the row number to attach the top of a + -- child widget to. + -> Int -- ^ @bottomAttach@ - the row number to attach the bottom + -- of a child widget to. + -> [AttachOptions] -- ^ @xoptions@ - Used to specify the properties of the + -- child widget when the table is resized. + -> [AttachOptions] -- ^ @yoptions@ - The same as xoptions, except this field + -- determines behaviour of vertical resizing. + -> Int -- ^ @xpadding@ - An integer value specifying the padding + -- on the left and right of the widget being added to the + -- table. + -> Int -- ^ @ypadding@ - The amount of padding above and below + -- the child widget. + -> IO () +tableAttach self child leftAttach rightAttach topAttach bottomAttach xoptions + yoptions xpadding ypadding = + {# call table_attach #} + (toTable self) + (toWidget child) + (fromIntegral leftAttach) + (fromIntegral rightAttach) + (fromIntegral topAttach) + (fromIntegral bottomAttach) + ((fromIntegral . fromFlags) xoptions) + ((fromIntegral . fromFlags) yoptions) + (fromIntegral xpadding) + (fromIntegral ypadding) --- | Put a new widget in the table container. As opposed to 'tableAttach' this --- function assumes default values for the packing options. +-- | As there are many options associated with 'tableAttach', this convenience +-- function provides the programmer with a means to add children to a table +-- with identical padding and expansion options. The values used for the +-- 'AttachOptions' are @['Expand', 'Fill']@, and the padding is set to 0. -- -tableAttachDefaults :: (TableClass tb, WidgetClass w) => tb -> w -> Int -> - Int -> Int -> Int -> IO () -tableAttachDefaults tb child leftAttach rightAttach topAttach bottomAttach = - {#call table_attach_defaults#} (toTable tb) (toWidget child) - (fromIntegral leftAttach) (fromIntegral rightAttach) - (fromIntegral topAttach) (fromIntegral bottomAttach) +tableAttachDefaults :: (TableClass self, WidgetClass widget) => self + -> widget -- ^ @widget@ - The child widget to add. + -> Int -- ^ @leftAttach@ - The column number to attach the left side of + -- the child widget to. + -> Int -- ^ @rightAttach@ - The column number to attach the right side of + -- the child widget to. + -> Int -- ^ @topAttach@ - The row number to attach the top of the child + -- widget to. + -> Int -- ^ @bottomAttach@ - The row number to attach the bottom of the + -- child widget to. + -> IO () +tableAttachDefaults self widget leftAttach rightAttach topAttach bottomAttach = + {# call table_attach_defaults #} + (toTable self) + (toWidget widget) + (fromIntegral leftAttach) + (fromIntegral rightAttach) + (fromIntegral topAttach) + (fromIntegral bottomAttach) --- | Set the amount of space (in pixels) between the specified row and its --- neighbours. +-- | Changes the space between a given table row and its surrounding rows. -- -tableSetRowSpacing :: TableClass tb => tb - -> Int -- ^ Row number, indexed from 0 - -> Int -- ^ Spacing size in pixels - -> IO () -tableSetRowSpacing tb row space = {#call table_set_row_spacing#} - (toTable tb) (fromIntegral row) (fromIntegral space) +tableSetRowSpacing :: TableClass self => self + -> Int -- ^ @row@ - row number whose spacing will be changed. + -> Int -- ^ @spacing@ - number of pixels that the spacing should take up. + -> IO () +tableSetRowSpacing self row spacing = + {# call table_set_row_spacing #} + (toTable self) + (fromIntegral row) + (fromIntegral spacing) --- | Get the amount of space (in pixels) between the specified row and the --- next row. +-- | Gets the amount of space between row @row@, and row @row@ + 1. See +-- 'tableSetRowSpacing'. -- -tableGetRowSpacing :: TableClass tb => tb -> Int -> IO Int -tableGetRowSpacing tb row = liftM fromIntegral $ - {#call unsafe table_get_row_spacing#} (toTable tb) (fromIntegral row) +tableGetRowSpacing :: TableClass self => self + -> Int -- ^ @row@ - a row in the table, 0 indicates the first row + -> IO Int -- ^ returns the row spacing +tableGetRowSpacing self row = + liftM fromIntegral $ + {# call unsafe table_get_row_spacing #} + (toTable self) + (fromIntegral row) --- | Set the amount of space (in pixels) between the specified column and --- its neighbours. +-- | Alters the amount of space between a given table column and the adjacent +-- columns. -- -tableSetColSpacing :: TableClass tb => tb -> Int -> Int -> IO () -tableSetColSpacing tb col space = {#call table_set_col_spacing#} - (toTable tb) (fromIntegral col) (fromIntegral space) +tableSetColSpacing :: TableClass self => self + -> Int -- ^ @column@ - the column whose spacing should be changed. + -> Int -- ^ @spacing@ - number of pixels that the spacing should take up. + -> IO () +tableSetColSpacing self column spacing = + {# call table_set_col_spacing #} + (toTable self) + (fromIntegral column) + (fromIntegral spacing) --- | Get the amount of space (in pixels) between the specified column and the --- next column. +-- | Gets the amount of space between column @col@, and column @col@ + 1. See +-- 'tableSetColSpacing'. -- -tableGetColSpacing :: TableClass tb => tb -> Int -> IO Int -tableGetColSpacing tb col = liftM fromIntegral $ - {#call unsafe table_get_col_spacing#} (toTable tb) (fromIntegral col) +tableGetColSpacing :: TableClass self => self + -> Int -- ^ @column@ - a column in the table, 0 indicates the first column + -> IO Int -- ^ returns the column spacing +tableGetColSpacing self column = + liftM fromIntegral $ + {# call unsafe table_get_col_spacing #} + (toTable self) + (fromIntegral column) --- | Set the amount of space between any two rows. +-- | Sets the space between every row in @table@ equal to @spacing@. -- -tableSetRowSpacings :: TableClass tb => tb -> Int -> IO () -tableSetRowSpacings tb space = {#call table_set_row_spacings#} - (toTable tb) (fromIntegral space) +tableSetRowSpacings :: TableClass self => self + -> Int -- ^ @spacing@ - the number of pixels of space to place between + -- every row in the table. + -> IO () +tableSetRowSpacings self spacing = + {# call table_set_row_spacings #} + (toTable self) + (fromIntegral spacing) -- | Gets the default row spacing for the table. This is the spacing that will --- be used for newly added rows. +-- be used for newly added rows. (See 'tableSetRowSpacings') -- -tableGetDefaultRowSpacing :: TableClass tb => tb -> IO Int -tableGetDefaultRowSpacing tb = liftM fromIntegral $ - {#call unsafe table_get_default_row_spacing#} (toTable tb) +tableGetDefaultRowSpacing :: TableClass self => self + -> IO Int -- ^ returns the default row spacing +tableGetDefaultRowSpacing self = + liftM fromIntegral $ + {# call unsafe table_get_default_row_spacing #} + (toTable self) --- | Set the amount of space between any two columns. +-- | Sets the space between every column in @table@ equal to @spacing@. -- -tableSetColSpacings :: TableClass tb => tb -> Int -> IO () -tableSetColSpacings tb space = {#call table_set_col_spacings#} - (toTable tb) (fromIntegral space) +tableSetColSpacings :: TableClass self => self + -> Int -- ^ @spacing@ - the number of pixels of space to place between + -- every column in the table. + -> IO () +tableSetColSpacings self spacing = + {# call table_set_col_spacings #} + (toTable self) + (fromIntegral spacing) -- | Gets the default column spacing for the table. This is the spacing that --- will be used for newly added columns. +-- will be used for newly added columns. (See 'tableSetColSpacings') -- -tableGetDefaultColSpacing :: TableClass tb => tb -> IO Int -tableGetDefaultColSpacing tb = liftM fromIntegral $ - {#call unsafe table_get_default_col_spacing#} (toTable tb) +tableGetDefaultColSpacing :: TableClass self => self + -> IO Int -- ^ returns the default column spacing +tableGetDefaultColSpacing self = + liftM fromIntegral $ + {# call unsafe table_get_default_col_spacing #} + (toTable self) --- | Make all cells the same size. +-- | Changes the homogenous property of table cells, ie. whether all cells are +-- an equal size or not. -- -tableSetHomogeneous :: TableClass tb => tb -> Bool -> IO () -tableSetHomogeneous tb hom = - {#call table_set_homogeneous#} (toTable tb) (fromBool hom) +tableSetHomogeneous :: TableClass self => self + -> Bool -- ^ @homogeneous@ - Set to @True@ to ensure all table cells are the + -- same size. Set to @False@ if this is not your desired behaviour. + -> IO () +tableSetHomogeneous self homogeneous = + {# call table_set_homogeneous #} + (toTable self) + (fromBool homogeneous) -- | Returns whether the table cells are all constrained to the same width and --- height. +-- height. (See 'tableSetHomogenous') -- -tableGetHomogeneous :: TableClass tb => tb -> IO Bool -tableGetHomogeneous tb = - liftM toBool $ {#call unsafe table_get_homogeneous#} (toTable tb) +tableGetHomogeneous :: TableClass self => self + -> IO Bool -- ^ returns @True@ if the cells are all constrained to the same + -- size +tableGetHomogeneous self = + liftM toBool $ + {# call unsafe table_get_homogeneous #} + (toTable self) -------------------- -- Properties @@ -218,7 +320,7 @@ -- -- Default value: @False@ -- -tableHomogeneous :: Attr Table Bool +tableHomogeneous :: TableClass self => Attr self Bool tableHomogeneous = Attr tableGetHomogeneous tableSetHomogeneous Index: Expander.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/Expander.chs.pp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- Expander.chs.pp 13 Mar 2005 19:34:34 -0000 1.5 +++ Expander.chs.pp 24 Mar 2005 17:30:59 -0000 1.6 @@ -26,8 +26,10 @@ -- -- A container which can hide its child -- +-- * Module available since Gtk+ version 2.4 +-- module Graphics.UI.Gtk.Layout.Expander ( --- * Description +-- * Detail -- -- | A 'Expander' allows the user to hide or show its child by clicking on an -- expander triangle similar to the triangles used in a 'TreeView'. @@ -36,8 +38,6 @@ -- 'Bin'; you create the child widget and use 'containerAdd' to add it to the -- expander. When the expander is toggled, it will take care of showing and -- hiding the child automatically. --- --- * Module available since Gtk version 2.4 -- * Class Hierarchy -- | @@ -87,8 +87,6 @@ #endif ) where -#if GTK_CHECK_VERSION(2,4,0) - import Monad (liftM) import System.Glib.FFI @@ -100,74 +98,164 @@ {# context lib="gtk" prefix="gtk" #} +#if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors +-- | Creates a new expander using @label@ as the text of the label. +-- expanderNew :: String -> IO Expander -expanderNew label = - makeNewObject mkExpander $ liftM castPtr $ - withUTFString label $ \strPtr -> - {# call gtk_expander_new #} strPtr +expanderNew label = + makeNewObject mkExpander $ + liftM (castPtr :: Ptr Widget -> Ptr Expander) $ + withUTFString label $ \labelPtr -> + {# call gtk_expander_new #} + labelPtr -expanderNewWithMnemonic :: String -> IO Expander +-- | Creates a new expander using @label@ as the text of the label. If +-- characters in @label@ are preceded by an underscore, they are underlined. If +-- you need a literal underscore character in a label, use \'__\' (two +-- underscores). The first underlined character represents a keyboard +-- accelerator called a mnemonic. Pressing Alt and that key activates the +-- button. +-- +expanderNewWithMnemonic :: + String -- ^ @label@ - the text of the label with an underscore in + -- front of the mnemonic character + -> IO Expander expanderNewWithMnemonic label = - makeNewObject mkExpander $ liftM castPtr $ - withUTFString label $ \strPtr -> - {# call gtk_expander_new_with_mnemonic #} strPtr + makeNewObject mkExpander $ + liftM (castPtr :: Ptr Widget -> Ptr Expander) $ + withUTFString label $ \labelPtr -> + {# call gtk_expander_new_with_mnemonic #} + labelPtr -------------------- -- Methods +-- | Sets the state of the expander. Set to @True@, if you want the child +-- widget to be revealed, and @False@ if you want the child widget to be +-- hidden. +-- expanderSetExpanded :: Expander -> Bool -> IO () -expanderSetExpanded expander expanded = - {# call gtk_expander_set_expanded #} expander (fromBool expanded) +expanderSetExpanded self expanded = + {# call gtk_expander_set_expanded #} + self + (fromBool expanded) +-- | Queries a 'Expander' and returns its current state. Returns @True@ if the +-- child widget is revealed. +-- +-- See 'expanderSetExpanded'. +-- expanderGetExpanded :: Expander -> IO Bool -expanderGetExpanded expander = liftM toBool $ - {# call gtk_expander_get_expanded #} expander +expanderGetExpanded self = + liftM toBool $ + {# call gtk_expander_get_expanded #} + self -expanderSetSpacing :: Expander -> Int -> IO () -expanderSetSpacing expander spacing = - {# call gtk_expander_set_spacing #} expander (fromIntegral spacing) +-- | Sets the spacing field of @expander@, which is the number of pixels to +-- place between expander and the child. +-- +expanderSetSpacing :: Expander -> Int + -> IO () +expanderSetSpacing self spacing = + {# call gtk_expander_set_spacing #} + self + (fromIntegral spacing) -expanderGetSpacing :: Expander -> IO Int -expanderGetSpacing expander = liftM fromIntegral $ - {# call gtk_expander_get_spacing #} expander +-- | Gets the value set by 'expanderSetSpacing'. +-- +expanderGetSpacing :: Expander + -> IO Int -- ^ returns spacing between the expander and child. +expanderGetSpacing self = + liftM fromIntegral $ + {# call gtk_expander_get_spacing #} + self +-- | Sets the text of the label of the expander to @label@. +-- +-- This will also clear any previously set labels. +-- expanderSetLabel :: Expander -> String -> IO () -expanderSetLabel expander label = - withUTFString label $ \strPtr -> - {# call gtk_expander_set_label #} expander strPtr +expanderSetLabel self label = + withUTFString label $ \labelPtr -> + {# call gtk_expander_set_label #} + self + labelPtr +-- | Fetches the text from the label of the expander, as set by +-- 'expanderSetLabel'. +-- expanderGetLabel :: Expander -> IO String -expanderGetLabel expander = do - strPtr <- {# call gtk_expander_get_label #} expander - peekUTFString strPtr +expanderGetLabel self = + {# call gtk_expander_get_label #} + self + >>= peekUTFString -expanderSetUseUnderline :: Expander -> Bool -> IO () -expanderSetUseUnderline expander useUnderline = - {# call gtk_expander_set_use_underline #} expander (fromBool useUnderline) +-- | If true, an underline in the text of the expander label indicates the +-- next character should be used for the mnemonic accelerator key. +-- +expanderSetUseUnderline :: Expander + -> Bool -- ^ @useUnderline@ - @True@ if underlines in the text indicate + -- mnemonics + -> IO () +expanderSetUseUnderline self useUnderline = + {# call gtk_expander_set_use_underline #} + self + (fromBool useUnderline) -expanderGetUseUnderline :: Expander -> IO Bool -expanderGetUseUnderline expander = liftM toBool $ - {# call gtk_expander_get_use_underline #} expander +-- | Returns whether an embedded underline in the expander label indicates a +-- mnemonic. See 'expanderSetUseUnderline'. +-- +expanderGetUseUnderline :: Expander + -> IO Bool -- ^ returns @True@ if an embedded underline in the expander + -- label indicates the mnemonic accelerator keys. +expanderGetUseUnderline self = + liftM toBool $ + {# call gtk_expander_get_use_underline #} + self -expanderSetUseMarkup :: Expander -> Bool -> IO () -expanderSetUseMarkup expander useMarkup = - {# call gtk_expander_set_use_markup #} expander (fromBool useMarkup) +-- | Sets whether the text of the label contains markup in Pango's text markup +-- language. See 'labelSetMarkup'. +-- +expanderSetUseMarkup :: Expander + -> Bool -- ^ @useMarkup@ - @True@ if the label's text should be parsed + -- for markup + -> IO () +expanderSetUseMarkup self useMarkup = + {# call gtk_expander_set_use_markup #} + self + (fromBool useMarkup) +-- | Returns whether the label's text is interpreted as marked up with the +-- Pango text markup language. See 'expanderSetUseMarkup'. +-- expanderGetUseMarkup :: Expander -> IO Bool -expanderGetUseMarkup expander = liftM toBool $ - {# call gtk_expander_get_use_markup #} expander +expanderGetUseMarkup self = + liftM toBool $ + {# call gtk_expander_get_use_markup #} + self -expanderSetLabelWidget :: WidgetClass widget => Expander -> widget -> IO () -expanderSetLabelWidget expander widget = - {# call gtk_expander_set_label_widget #} expander (toWidget widget) +-- | Set the label widget for the expander. This is the widget that will +-- appear embedded alongside the expander arrow. +-- +expanderSetLabelWidget :: WidgetClass labelWidget => Expander + -> labelWidget -- ^ @labelWidget@ - the new label widget + -> IO () +expanderSetLabelWidget self labelWidget = + {# call gtk_expander_set_label_widget #} + self + (toWidget labelWidget) -expanderGetLabelWidget :: Expander -> IO Widget -expanderGetLabelWidget expander = - makeNewObject mkWidget $ - {# call gtk_expander_get_label_widget #} expander +-- | Retrieves the label widget for the frame. See 'expanderSetLabelWidget'. +-- +expanderGetLabelWidget :: Expander + -> IO Widget -- ^ returns the label widget +expanderGetLabelWidget self = + makeNewObject mkWidget $ + {# call gtk_expander_get_label_widget #} + self -------------------- -- Properties @@ -221,9 +309,9 @@ -------------------- -- Signals -onActivate :: Expander -> IO () -> IO (ConnectId Expander) -afterActivate :: Expander -> IO () -> IO (ConnectId Expander) +onActivate, afterActivate :: Expander + -> IO () + -> IO (ConnectId Expander) onActivate = connect_NONE__NONE "activate" False afterActivate = connect_NONE__NONE "activate" True - #endif Index: HPaned.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/HPaned.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- HPaned.chs 25 Feb 2005 01:11:34 -0000 1.3 +++ HPaned.chs 24 Mar 2005 17:31:00 -0000 1.4 @@ -24,10 +24,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A container with two panes arranged horizontally. +-- A container with two panes arranged horizontally -- module Graphics.UI.Gtk.Layout.HPaned ( --- * Description +-- * Detail -- -- | The HPaned widget is a container widget with two children arranged -- horizontally. The division between the two panes is adjustable by the user @@ -65,7 +65,10 @@ -------------------- -- Constructors --- | +-- | Create a new 'HPaned' -- hPanedNew :: IO HPaned -hPanedNew = makeNewObject mkHPaned $ liftM castPtr {#call unsafe hpaned_new#} +hPanedNew = + makeNewObject mkHPaned $ + liftM (castPtr :: Ptr Widget -> Ptr HPaned) $ + {# call unsafe hpaned_new #} Index: VButtonBox.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Layout/VButtonBox.chs,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- VButtonBox.chs 25 Feb 2005 01:11:34 -0000 1.2 +++ VButtonBox.chs 24 Mar 2005 17:31:00 -0000 1.3 @@ -27,7 +27,7 @@ -- A container for arranging buttons vertically -- module Graphics.UI.Gtk.Layout.VButtonBox ( --- * Description +-- * Detail -- -- | A button box should be used to provide a consistent layout of buttons -- throughout your application. The layout\/spacing can be altered by the @@ -78,8 +78,10 @@ -------------------- -- Constructors --- | +-- | Creates a new vertical button box. -- vButtonBoxNew :: IO VButtonBox -vButtonBoxNew = makeNewObject mkVButtonBox $ - liftM castPtr {#call unsafe vbutton_box_new#} +vButtonBoxNew = + makeNewObject mkVButtonBox $ + liftM (castPtr :: Ptr Widget -> Ptr VButtonBox) $ + {# call unsafe vbutton_box_new #} |
2 messages has been excluded from this view by a project administrator.
