gtk2hs-commit — Mailing list for Darcs commit messages.

[Gtk2hs-commit] gtk2hs/gtk/buttons Button.chs,1.4,1.5 CheckButton.chs,1.3,1.4 RadioButton.chs,1.4,1.5 ToggleButton.chs,1.3,1.4

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

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

Modified Files:
	Button.chs CheckButton.chs RadioButton.chs ToggleButton.chs 
Log Message:
initial haddockification


Index: RadioButton.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/buttons/RadioButton.chs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- RadioButton.chs	9 Jul 2003 22:42:43 -0000	1.4
+++ RadioButton.chs	23 May 2004 15:48:35 -0000	1.5
@@ -1,5 +1,5 @@
 -- -*-haskell-*-
---  GIMP Toolkit (GTK) @entry Widget RadioButton@
+--  GIMP Toolkit (GTK) Widget RadioButton
 --
 --  Author : Axel Simon
 --          
@@ -19,19 +19,17 @@
 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 --  GNU General Public License for more details.
 --
--- @description@ --------------------------------------------------------------
---
--- * A radio group is a set of check buttons where only one button can be 
---   checked.
+-- |
 --
--- @documentation@ ------------------------------------------------------------
+-- A radio group is a set of check buttons where only one button can be 
+-- checked.
 --
 -- * Each radio button has to be associated with a group. Generating a new
 --   radio button makes up a new group. Other group members can be added by
 --   generating radio buttons with the function 
---   @ref method radioButtonNewJoinGroup@.
+--   'radioButtonNewJoinGroup'.
 --
--- @todo@ ---------------------------------------------------------------------
+-- TODO
 --
 -- * No function that directly accesses the group is bound. This is due to the
 --   difficulties assuring that these groups are valid as the group is a plain
@@ -58,14 +56,14 @@
 
 -- methods
 
--- @constructor radioButtonNew@ Create a new RadioButton widget with a new
+-- | Create a new RadioButton widget with a new
 -- group.
 --
 radioButtonNew :: IO RadioButton
 radioButtonNew  = makeNewObject mkRadioButton $ liftM castPtr $
   {#call unsafe radio_button_new#} nullPtr
 
--- @method radioButtonNewWithLabel@ Like @ref type RadioButton@ but shows a
+-- | Like 'RadioButton' but shows a
 -- label to the right of the button.
 --
 radioButtonNewWithLabel :: String -> IO RadioButton
@@ -73,7 +71,7 @@
   makeNewObject mkRadioButton $ liftM castPtr $
   {#call unsafe radio_button_new_with_label#} nullPtr strPtr
 
--- @method radioButtonNewJoinGroup@ Creates a new RadioButton and attaches it
+-- | Creates a new RadioButton and attaches it
 -- to the group of another radio button.
 --
 -- * This function corresponds to gtk_radio_button_new_from_widget. The new
@@ -84,7 +82,7 @@
 radioButtonNewJoinGroup rb = makeNewObject mkRadioButton $ liftM castPtr $
   {#call radio_button_new_from_widget#} rb
 
--- @method radioButtonNewJoinGroupWithLabel@ Create a new RadioButton with a
+-- | Create a new RadioButton with a
 -- label and group.
 --
 radioButtonNewJoinGroupWithLabel :: RadioButton -> String -> IO RadioButton

Index: CheckButton.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/buttons/CheckButton.chs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- CheckButton.chs	9 Jul 2003 22:42:43 -0000	1.3
+++ CheckButton.chs	23 May 2004 15:48:35 -0000	1.4
@@ -1,5 +1,5 @@
 -- -*-haskell-*-
---  GIMP Toolkit (GTK) @entry Widget CheckButton@
+--  GIMP Toolkit (GTK) Widget CheckButton
 --
 --  Author : Axel Simon
 --          
@@ -19,13 +19,8 @@
 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 --  GNU General Public License for more details.
 --
--- @description@ --------------------------------------------------------------
---
---
--- @documentation@ ------------------------------------------------------------
---
+-- |
 --
--- @todo@ ---------------------------------------------------------------------
 
 module CheckButton(
   CheckButton,
@@ -47,13 +42,13 @@
 
 -- methods
 
--- @constructor checkButtonNew@ Create a new button with a check field.
+-- | Create a new button with a check field.
 --
 checkButtonNew :: IO CheckButton
 checkButtonNew  = makeNewObject mkCheckButton $ 
   liftM castPtr {#call unsafe check_button_new#}
 
--- @method checkButtonNewWithLabel@ Create a new CheckButton with a text to
+-- | Create a new CheckButton with a text to
 -- the right of it.
 --
 checkButtonNewWithLabel :: String -> IO CheckButton
@@ -61,10 +56,10 @@
   makeNewObject mkCheckButton $ liftM castPtr $
   {#call unsafe check_button_new_with_label#} strPtr)
 
--- @method checkButtonNewWithMnemonic@ Create a checkButton with an
+-- | Create a checkButton with an
 -- accelerator key.
 --
--- * Like @ref method checkButtonNewWithLabel@ but turns every underscore in
+-- * Like 'checkButtonNewWithLabel' but turns every underscore in
 --   the label to a underlined character.
 --
 checkButtonNewWithMnemonic :: String -> IO CheckButton

Index: ToggleButton.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/buttons/ToggleButton.chs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- ToggleButton.chs	9 Jul 2003 22:42:43 -0000	1.3
+++ ToggleButton.chs	23 May 2004 15:48:35 -0000	1.4
@@ -1,5 +1,5 @@
 -- -*-haskell-*-
---  GIMP Toolkit (GTK) @entry Widget ToggleButton@
+--  GIMP Toolkit (GTK) Widget ToggleButton
 --
 --  Author : Axel Simon
 --          
@@ -19,15 +19,11 @@
 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 --  GNU General Public License for more details.
 --
--- @description@ --------------------------------------------------------------
---
--- * A ToggleButton is the base class for all buttons that have an inherit
---   state.
---
--- @documentation@ ------------------------------------------------------------
+-- |
 --
+-- A ToggleButton is the base class for all buttons that have an inherit
+-- state.
 --
--- @todo@ ---------------------------------------------------------------------
 
 module ToggleButton(
   ToggleButton,
@@ -56,14 +52,14 @@
 
 -- methods
 
--- @constructor toggleButtonNew@ Create a new ToggleButton widget.
+-- | Create a new ToggleButton widget.
 --
 toggleButtonNew :: IO ToggleButton
 toggleButtonNew  = makeNewObject mkToggleButton $ liftM castPtr 
   {#call unsafe toggle_button_new#}
 
 
--- @method toggleButtonNewWithLabel@ Create a toggleButton with a label in it.
+-- | Create a toggleButton with a label in it.
 --
 toggleButtonNewWithLabel :: String -> IO ToggleButton
 toggleButtonNewWithLabel lbl = withUTFString lbl (\strPtr ->
@@ -71,20 +67,20 @@
   {#call unsafe toggle_button_new_with_label#} strPtr)
 
 
--- @method toggleButtonSetMode@ Determines whether or not the toggle button is
+-- | Determines whether or not the toggle button is
 -- drawn on screen. Set to True of the button should be invisible.
 --
 toggleButtonSetMode :: ToggleButtonClass tb => tb -> Bool -> IO ()
 toggleButtonSetMode tb invisible =
   {#call toggle_button_set_mode#} (toToggleButton tb) (fromBool invisible)
 
--- @method toggleButtonToggled@ Emit the @ref method toggled@ signal on the
+-- | Emit the 'toggled' signal on the
 -- button.
 --
 toggleButtonToggled :: ToggleButtonClass tb => tb -> IO ()
 toggleButtonToggled tb = {#call toggle_button_toggled#} (toToggleButton tb)
 
--- @method toggleButtonGetActive@ Retrieve the current state of the button.
+-- | Retrieve the current state of the button.
 -- Returns True if the button is depressed.
 --
 toggleButtonGetActive :: ToggleButtonClass tb => tb -> IO Bool
@@ -98,9 +94,9 @@
 toggleButtonSetActive active tb = 
   {#call toggle_button_set_active#} (toToggleButton tb) (fromBool active)
 
--- @method toggleButtonGetInconsistent@ Retrieve the inconsistent flag of the
+-- | Retrieve the inconsistent flag of the
 -- button. An inconsistent state only visually affects the button. It will be
--- displayed in an "in-between" state.
+-- displayed in an \"in-between\" state.
 --
 toggleButtonGetInconsistent :: ToggleButtonClass tb => tb -> IO Bool
 toggleButtonGetInconsistent tb = liftM toBool $
@@ -115,7 +111,7 @@
 -- signals
 
 
--- @signal connectToToggled@ Whenever the state of the button is changed, the
+-- | Whenever the state of the button is changed, the
 -- toggled signal is emitted.
 --
 onToggled, afterToggled :: ButtonClass b => b -> IO () -> IO (ConnectId b)

Index: Button.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/buttons/Button.chs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- Button.chs	9 Jul 2003 22:42:43 -0000	1.4
+++ Button.chs	23 May 2004 15:48:35 -0000	1.5
@@ -1,5 +1,5 @@
 -- -*-haskell-*-
---  GIMP Toolkit (GTK) @entry Widget Button@
+--  GIMP Toolkit (GTK) Widget Button
 --
 --  Author : Axel Simon
 --          
@@ -19,13 +19,8 @@
 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 --  GNU General Public License for more details.
 --
--- @description@ --------------------------------------------------------------
---
---
--- @documentation@ ------------------------------------------------------------
---
+-- |
 --
--- @todo@ ---------------------------------------------------------------------
 
 module Button(
   Button,
@@ -75,22 +70,22 @@
 
 -- methods
 
--- @constructor buttonNew@ Create a new Button widget.
+-- | Create a new Button widget.
 --
 buttonNew :: IO Button
 buttonNew  = makeNewObject mkButton $ liftM castPtr {#call unsafe button_new#}
 
 
--- @constructor buttonNewWithLabel@ Create a button with a label in it.
+-- | Create a button with a label in it.
 --
 buttonNewWithLabel :: String -> IO Button
 buttonNewWithLabel lbl = withUTFString lbl (\strPtr ->
   makeNewObject mkButton $ liftM castPtr $
   {#call unsafe button_new_with_label#} strPtr)
 
--- @constructor buttonNewWithMnemonic@ Create a button with an accelerator key.
+-- | Create a button with an accelerator key.
 --
--- * Like @ref constructor buttonNewWithLabel@ but turns every underscore in the
+-- * Like 'buttonNewWithLabel' but turns every underscore in the
 --   label to a underlined character which then acts as a mnemonic (keyboard
 --   shortcut).
 --
@@ -99,7 +94,7 @@
   makeNewObject mkButton $ liftM castPtr $ 
   {#call unsafe button_new_with_mnemonic#} strPtr)
 
--- @constructor buttonNewFromStock@ Create a stock (predefined appearance) button.
+-- | Create a stock (predefined appearance) button.
 --
 buttonNewFromStock :: String -> IO Button
 buttonNewFromStock stockId = withUTFString stockId (\strPtr -> 
@@ -107,65 +102,65 @@
   throwIfNull "buttonNewFromStock: Invalid stock identifier." $ 
   {#call unsafe button_new_from_stock#} strPtr)
 
--- @method buttonPressed@ Depress the button, i.e. emit the pressed signal.
+-- | Depress the button, i.e. emit the pressed signal.
 --
 buttonPressed :: ButtonClass b => b -> IO ()
 buttonPressed b = {#call button_pressed#} (toButton b)
 
--- @method buttonReleased@ Release the button, i.e. emit the released signal.
+-- | Release the button, i.e. emit the released signal.
 --
 buttonReleased :: ButtonClass b => b -> IO ()
 buttonReleased b = {#call button_released#} (toButton b)
 
--- @method buttonClicked@ Emit the clicked signal on the button.
+-- | Emit the clicked signal on the button.
 --
--- * This is similar to calling @ref method buttonPressed@ and
---   @ref method buttonReleased@ in sequence.
+-- * This is similar to calling 'buttonPressed' and
+--   'buttonReleased' in sequence.
 --
 buttonClicked :: ButtonClass b => b -> IO ()
 buttonClicked b = {#call button_clicked#} (toButton b)
 
--- @method buttonEnter@ Emit the cursor enters signal to the button.
+-- | Emit the cursor enters signal to the button.
 --
 buttonEnter :: ButtonClass b => b -> IO ()
 buttonEnter b = {#call button_enter#} (toButton b)
 
--- @method buttonLeave@ Emit the cursor leaves signal to the button.
+-- | Emit the cursor leaves signal to the button.
 --
 buttonLeave :: ButtonClass b => b -> IO ()
 buttonLeave b = {#call button_leave#} (toButton b)
 
--- @method buttonSetRelief@ Set the style of the button edges.
+-- | Set the style of the button edges.
 --
 buttonSetRelief :: ButtonClass b => b -> ReliefStyle -> IO ()
 buttonSetRelief b rs = 
   {#call button_set_relief#} (toButton b) ((fromIntegral.fromEnum) rs)
 
--- @method buttonGetRelief@ Get the current relief style.
+-- | Get the current relief style.
 --
 buttonGetRelief :: ButtonClass b => b -> IO ReliefStyle
 buttonGetRelief b = liftM (toEnum.fromIntegral) $
   {#call unsafe button_get_relief#} (toButton b)
 
--- @method buttonSetLabel@ Set the text of the button.
+-- | Set the text of the button.
 --
 buttonSetLabel :: ButtonClass b => b -> String -> IO ()
 buttonSetLabel b lbl = withUTFString lbl $ \strPtr ->
   {#call button_set_label#} (toButton b) strPtr
 
--- @method buttonGetLabel@ Get the current text on the button.
+-- | Get the current text on the button.
 --
 -- * The method returns the empty string in case the button does not have
---   a label (e.g. it was created with @ref method buttonNew@.
+--   a label (e.g. it was created with 'buttonNew'.
 --
 buttonGetLabel :: ButtonClass b => b -> IO String
 buttonGetLabel b = do
   strPtr <- {#call unsafe button_get_label#} (toButton b)
   if strPtr==nullPtr then return "" else peekUTFString strPtr
 
--- @method buttonSetUseStock@ Set if the label is a stock identifier.
+-- | Set if the label is a stock identifier.
 --
--- * Setting this property to @literal True@ will make the button lookup
+-- * Setting this property to @True@ will make the button lookup
 --   its label in the table of stock items. If there is a match, the button
 --   will use the stock item instead of the label.  You need to set this
 --   flag before you change the label.
@@ -174,13 +169,13 @@
 buttonSetUseStock b flag = 
   {#call button_set_use_stock#} (toButton b) (fromBool flag)
 
--- @method buttonGetUseStock@ Get the current flag for stock lookups.
+-- | Get the current flag for stock lookups.
 --
 buttonGetUseStock :: ButtonClass b => b -> IO Bool
 buttonGetUseStock b = liftM toBool $
   {#call unsafe button_get_use_stock#} (toButton b)
 
--- @method buttonSetUseUnderline@ Set if the label has accelerators.
+-- | Set if the label has accelerators.
 --
 -- * Setting this property will make the button join any underline character
 --   into the following letter and inserting this letter as a keyboard
@@ -190,7 +185,7 @@
 buttonSetUseUnderline b flag = 
   {#call button_set_use_underline#} (toButton b) (fromBool flag)
 
--- @method buttonGetUseUnderline@ Query if the underlines are mnemonics.
+-- | Query if the underlines are mnemonics.
 --
 buttonGetUseUnderline :: ButtonClass b => b -> IO Bool
 buttonGetUseUnderline b = liftM toBool $
@@ -199,41 +194,41 @@
 
 -- signals
 
--- @signal connectToButtonActivate@ The button has been depressed (but not
--- necessarily released yet). See @ref arg clicked@ signal.
+-- | The button has been depressed (but not
+-- necessarily released yet). See @clicked@ signal.
 --
 onButtonActivate, afterButtonActivate :: ButtonClass b => b -> IO () ->
                                          IO (ConnectId b)
 onButtonActivate = connect_NONE__NONE "activate"  False
 afterButtonActivate = connect_NONE__NONE "activate"  True
 
--- @signal connectToClicked@ The button was clicked. This is only emitted if
+-- | The button was clicked. This is only emitted if
 -- the mouse cursor was over the button when it was released.
 --
 onClicked, afterClicked :: ButtonClass b => b -> IO () -> IO (ConnectId b)
 onClicked = connect_NONE__NONE "clicked" False
 afterClicked = connect_NONE__NONE "clicked" True
 
--- @signal connectToEnter@ The cursor enters the button box.
+-- | The cursor enters the button box.
 --
 onEnter, afterEnter :: ButtonClass b => b -> IO () -> IO (ConnectId b)
 onEnter = connect_NONE__NONE "enter" False
 afterEnter = connect_NONE__NONE "enter" True
 
--- @signal connectToLeave@ The cursor leaves the button box.
+-- | The cursor leaves the button box.
 --
 onLeave, afterLeave :: ButtonClass b => b -> IO () -> IO (ConnectId b)
 onLeave = connect_NONE__NONE "leave" False
 afterLeave = connect_NONE__NONE "leave" True
 
--- @signal connectToPressed@ The button is pressed.
+-- | The button is pressed.
 --
 onPressed, afterPressed :: ButtonClass b => b -> IO () -> IO (ConnectId b)
 onPressed = connect_NONE__NONE "pressed" False
 afterPressed = connect_NONE__NONE "pressed" True
 
 
--- @signal connectToReleased@ The button is released.
+-- | The button is released.
 --
 onReleased, afterReleased :: ButtonClass b => b -> IO () -> IO (ConnectId b)
 onReleased = connect_NONE__NONE "released" False

[Gtk2hs-commit] gtk2hs ChangeLog,1.154,1.155

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

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

Modified Files:
	ChangeLog 
Log Message:
initial haddockification


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.154
retrieving revision 1.155
diff -u -d -r1.154 -r1.155
--- ChangeLog	23 May 2004 15:46:03 -0000	1.154
+++ ChangeLog	23 May 2004 15:48:35 -0000	1.155
@@ -8,6 +8,10 @@
 	gtk/abstract/Scrollbar.hs, gtk/abstract/Separator.hs,
 	gtk/abstract/Widget.chs: initial haddockification
 
+	* gtk/buttons/Button.chs, gtk/buttons/CheckButton.chs,
+	gtk/buttons/RadioButton.chs, gtk/buttons/ToggleButton.chs:
+	initial haddockification
+
 2004-05-21 Duncan Coutts <du...@co...>
 
 	* gtk/abstract/FileChooser.chs, gtk/abstract/Widget.chs:

[Gtk2hs-commit] gtk2hs ChangeLog,1.153,1.154

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

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

Modified Files:
	ChangeLog 
Log Message:
initial haddockification


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.153
retrieving revision 1.154
diff -u -d -r1.153 -r1.154
--- ChangeLog	21 May 2004 14:00:35 -0000	1.153
+++ ChangeLog	23 May 2004 15:46:03 -0000	1.154
@@ -1,3 +1,13 @@
+2004-05-23 Duncan Coutts <du...@co...>
+
+	* gtk/abstract/Bin.chs, gtk/abstract/Box.chs,
+	gtk/abstract/ButtonBox.chs, gtk/abstract/Container.chs,
+	gtk/abstract/FileChooser.chs, gtk/abstract/Misc.chs,
+	gtk/abstract/Object.chs, gtk/abstract/Paned.chs,
+	gtk/abstract/Range.chs, gtk/abstract/Scale.chs,
+	gtk/abstract/Scrollbar.hs, gtk/abstract/Separator.hs,
+	gtk/abstract/Widget.chs: initial haddockification
+
 2004-05-21 Duncan Coutts <du...@co...>
 
 	* gtk/abstract/FileChooser.chs, gtk/abstract/Widget.chs:

[Gtk2hs-commit] FASD project: Online survey launched

[<ben...@id...>]

Dear Open Source developer

I am doing a research project on "Fun and Software Development" in which I kindly invite you to participate.
You will find the online survey under http://fasd.ethz.ch/qsf/. The questionnaire consists of 53 questions and you will need about 15 minutes to complete it.

With the FASD project (Fun and Software Development) we want to define the motivational significance of fun when software developers decide to engage in Open Source projects. What is special about our research project is that a similar survey is planned with software developers in commercial firms. This procedure allows the immediate comparison between the involved individuals and the conditions of production of these two development models. Thus we hope to obtain substantial new insights to the phenomenon of Open Source Development.


With many thanks for your participation,
Benno Luthiger


PS:
The results of the survey will be published under http://www.isu.unizh.ch/fuehrung/blprojects/FASD/.
We have set up the mailing list fa...@we... for this study. Please see http://fasd.ethz.ch/qsf/mailinglist_en.html for registration to this mailing list.

_______________________________________________________________________

Benno Luthiger
Swiss Federal Institute of Technology Zurich
8092 Zurich

Mail: benno.luthiger(at)id.ethz.ch
_______________________________________________________________________

[Gtk2hs-commit] gtk2hs ChangeLog,1.152,1.153

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

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

Modified Files:
	ChangeLog 
Log Message:
document module as being depreciated as of gtk 2.4


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.152
retrieving revision 1.153
diff -u -d -r1.152 -r1.153
--- ChangeLog	21 May 2004 13:26:33 -0000	1.152
+++ ChangeLog	21 May 2004 14:00:35 -0000	1.153
@@ -3,6 +3,8 @@
 	* gtk/abstract/FileChooser.chs, gtk/abstract/Widget.chs:
 	more minor doc fixes
 
+	* gtk/windows/FileSel.chs: document as depreciated as of gtk 2.4
+
 2004-05-20 Duncan Coutts <du...@co...>
 
 	* gtk/gdk/Pixbuf.chs, gtk/general/Structs.hsc,

[Gtk2hs-commit] gtk2hs/gtk/windows FileSel.chs,1.5,1.6

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

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

Modified Files:
	FileSel.chs 
Log Message:
document module as being depreciated as of gtk 2.4


Index: FileSel.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/windows/FileSel.chs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- FileSel.chs	9 Jul 2003 22:42:46 -0000	1.5
+++ FileSel.chs	21 May 2004 14:00:33 -0000	1.6
@@ -27,6 +27,7 @@
 --
 --- DOCU ----------------------------------------------------------------------
 --
+--  As of gtk 2.4 this module has been deprecated in favour of FileChooser
 --
 --- TODO ----------------------------------------------------------------------
 --

[Gtk2hs-commit] gtk2hs/gtk/abstract FileChooser.chs,1.2,1.3 Widget.chs,1.12,1.13

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

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

Modified Files:
	FileChooser.chs Widget.chs 
Log Message:
minor doc fixes


Index: FileChooser.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/abstract/FileChooser.chs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- FileChooser.chs	2 May 2004 13:20:01 -0000	1.2
+++ FileChooser.chs	21 May 2004 13:26:33 -0000	1.3
@@ -1,4 +1,4 @@
--- |GIMP Toolkit (GTK) Binding for Haskell: binding to GConf   -*-haskell-*-
+-- GIMP Toolkit (GTK) Binding for Haskell: binding to GConf   -*-haskell-*-
 --    for storing and retrieving configuartion information
 --
 --  Author : Duncan Coutts
@@ -16,7 +16,7 @@
 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 --  Library General Public License for more details.
 --
---- Description ---------------------------------------------------------------
+-- description ---------------------------------------------------------------
 --
 --  Language: Haskell 98 Binding Module
 --

Index: Widget.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/abstract/Widget.chs,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- Widget.chs	9 Jul 2003 22:42:43 -0000	1.12
+++ Widget.chs	21 May 2004 13:26:33 -0000	1.13
@@ -365,13 +365,13 @@
 -- Accelerator handling.
 
 -- Lock accelerators.
--- *  
+--
 --widgetLockAccelerators :: WidgetClass w => w -> IO ()
 --widgetLockAccelerators = {#call unsafe widget_lock_accelerators#}.toWidget
 
 
 -- Unlock accelerators.
--- * 
+--
 --widgetUnlockAccelerators :: WidgetClass w => w -> IO ()
 --widgetUnlockAccelerators = {#call widget_unlock_accelerators#}.toWidget
 

[Gtk2hs-commit] gtk2hs ChangeLog,1.151,1.152

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

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

Modified Files:
	ChangeLog 
Log Message:
minor doc fixes


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.151
retrieving revision 1.152
diff -u -d -r1.151 -r1.152
--- ChangeLog	20 May 2004 16:42:17 -0000	1.151
+++ ChangeLog	21 May 2004 13:26:33 -0000	1.152
@@ -1,3 +1,8 @@
+2004-05-21 Duncan Coutts <du...@co...>
+
+	* gtk/abstract/FileChooser.chs, gtk/abstract/Widget.chs:
+	more minor doc fixes
+
 2004-05-20 Duncan Coutts <du...@co...>
 
 	* gtk/gdk/Pixbuf.chs, gtk/general/Structs.hsc,

[Gtk2hs-commit] gtk2hs/gtk/gdk Pixbuf.chs,1.5,1.6

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

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

Modified Files:
	Pixbuf.chs 
Log Message:
haddock fix


Index: Pixbuf.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/gdk/Pixbuf.chs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Pixbuf.chs	9 Jul 2003 22:42:44 -0000	1.5
+++ Pixbuf.chs	20 May 2004 16:53:58 -0000	1.6
@@ -286,7 +286,7 @@
 --   gdk-pixbuf-csource --raw --extern --name=my_image myimage.png >> my_image.c
 --   @ on it. Write a header file @literal my_image.h@ containing @prog
 --   #include <gdk/gdk.h>
---   extern guint8 my_image[];
+--   extern guint8 my_image\[\];
 --   @ and save it in the current directory.
 --   The created file can be compiled with @prog
 --   cc -c my_image.c `pkg-config --cflags gdk-2.0`

[Gtk2hs-commit] gtk2hs ChangeLog,1.150,1.151

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

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

Modified Files:
	ChangeLog 
Log Message:
minor doc changes in preperation for 'haddock'ification
change bits that trip up haddock


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.150
retrieving revision 1.151
diff -u -d -r1.150 -r1.151
--- ChangeLog	17 May 2004 00:13:56 -0000	1.150
+++ ChangeLog	20 May 2004 16:42:17 -0000	1.151
@@ -1,3 +1,12 @@
+2004-05-20 Duncan Coutts <du...@co...>
+
+	* gtk/gdk/Pixbuf.chs, gtk/general/Structs.hsc,
+	gtk/treeList/TreeModel.chs: minor doc fixes in preperation for
+	'haddock'ification
+
+	* c2hs/chs/CHS.hs: make c2hs emit a haddock-compatible headder
+	remove **'s which confuse haddock
+
 2004-05-17 Duncan Coutts <du...@co...>
 
 	* demo/sourceview/haskell.lang: updated syntax highlighting

[Gtk2hs-commit] gtk2hs/c2hs/chs CHS.hs,1.3,1.4

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

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

Modified Files:
	CHS.hs 
Log Message:
minor doc changes in preperation for 'haddock'ification
change bits that trip up haddock


Index: CHS.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/c2hs/chs/CHS.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- CHS.hs	21 Jan 2003 15:53:24 -0000	1.3
+++ CHS.hs	20 May 2004 16:42:17 -0000	1.4
@@ -418,7 +418,7 @@
   where
     contents version kind = 
       "-- GENERATED by " ++ version ++ " " ++ kind ++ "\n\
-      \-- ** Edit the orignal .chs file instead!\n\n"
+      \-- Edit the orignal .chs file instead!\n\n"
       ++ showCHSModule mod pureHaskell
 
 -- convert a CHS module into a string

[Gtk2hs-commit] gtk2hs/gtk/treeList TreeModel.chs,1.10,1.11

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

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

Modified Files:
	TreeModel.chs 
Log Message:
minor doc changes in preperation for 'haddock'ification
change bits that trip up haddock


Index: TreeModel.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/treeList/TreeModel.chs,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- TreeModel.chs	9 Jul 2003 22:42:46 -0000	1.10
+++ TreeModel.chs	20 May 2004 16:42:16 -0000	1.11
@@ -25,12 +25,12 @@
 -- * A @ref data TreeModel@ is the abstract base class for 
 --   @ref data TreeStore@ and @ref data ListStore@.
 --
---- @documentation@ -----------------------------------------------------------
+-- @documentation@ -----------------------------------------------------------
 --
 -- * Most functions are defined in the latter two classes. This module
 --   provides the @ref data TreeIter@ and @ref data TreePath@ objects.
 --
---- @todo@ --------------------------------------------------------------------
+-- @todo@ --------------------------------------------------------------------
 --
 --
 module TreeModel(

[Gtk2hs-commit] gtk2hs/gtk/general Structs.hsc,1.21,1.22

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

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

Modified Files:
	Structs.hsc 
Log Message:
minor doc changes in preperation for 'haddock'ification
change bits that trip up haddock


Index: Structs.hsc
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/general/Structs.hsc,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- Structs.hsc	30 Apr 2004 20:32:44 -0000	1.21
+++ Structs.hsc	20 May 2004 16:42:16 -0000	1.22
@@ -547,7 +547,7 @@
 
 -- Query the XID field of the socket widget. This value needs to be
 -- sent to the Plug widget of the other application.
--- *  
+--
 --socketGetXID :: Socket -> IO XID
 --socketGetXID socket = do
 --  winPtr <- throwIfNull "socketGetXID: the socket widget is not realized" $

[Gtk2hs-commit] gtk2hs ChangeLog,1.149,1.150

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

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

Modified Files:
	ChangeLog 
Log Message:
updated syntax highlighting


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.149
retrieving revision 1.150
diff -u -d -r1.149 -r1.150
--- ChangeLog	14 May 2004 18:06:16 -0000	1.149
+++ ChangeLog	17 May 2004 00:13:56 -0000	1.150
@@ -1,4 +1,8 @@
-2004-05-6 Duncan Coutts <du...@co...>
+2004-05-17 Duncan Coutts <du...@co...>
+
+	* demo/sourceview/haskell.lang: updated syntax highlighting
+
+2004-05-14 Duncan Coutts <du...@co...>
 
 	* demo/profileviewer/ProfileViewer.hs,
 	demo/profileviewer/ParseProfile.hs,

[Gtk2hs-commit] gtk2hs/demo/sourceview haskell.lang,1.1,1.2

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

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

Modified Files:
	haskell.lang 
Log Message:
updated syntax highlighting


Index: haskell.lang
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/demo/sourceview/haskell.lang,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- haskell.lang	11 Nov 2003 12:24:35 -0000	1.1
+++ haskell.lang	17 May 2004 00:13:56 -0000	1.2
@@ -13,29 +13,43 @@
         	<end-regex>-\}</end-regex>
 	</block-comment>
 
-	<pattern-item _name = "Type or Constructor" style = "Data Type">
-		<regex>\b[A-Z][0-9a-zA-Z]*&apos;*</regex>
+	<syntax-item _name = "Pragma" style = "Preprocessor">
+		<start-regex>\{-#</start-regex>
+	        <end-regex>#-\}</end-regex>
+	</syntax-item>
+
+	<pattern-item _name = "Data Type or Constructor" style = "Data Type">
+		<regex>\b[A-Z][0-9a-zA-Z._]*(&apos;|#)*</regex>
 	</pattern-item>
-<!--
-	<pattern-item _name = "Variable" style = "Variable">
-		<regex>\b[a-z][0-9a-zA-Z]*&apos;*</regex>
-        </pattern-item>
--->
-	<pattern-item _name = "Keysymbols" style = "Data Type">
-		<regex>(::|-&gt;|&lt;-|=&gt;|=)</regex>
+
+	<pattern-item _name = "Keysymbols" style = "Keyword">
+		<regex>::|-&gt;|&lt;-|=&gt;|=|\||\\|@|~|\.\.</regex>
 	</pattern-item>
 <!--
-        <pattern-item _name = "Operators" style = "Data Type">
-		<regex>[:*$+]+</regex>
+	<pattern-item _name = "Operators" style = "Operators">
+                <regex>[:!#$%&amp;*+./&gt;=&lt;?@\\^|~\-]+</regex>
 	</pattern-item>
--->				
+
+	<keyword-list _name="Keysymbols" style = "Keyword">
+		<keyword>::</keyword>
+		<keyword>-&gt;</keyword>
+		<keyword>&lt;-</keyword>
+		<keyword>=&gt;</keyword>
+		<keyword>=</keyword>
+		<keyword>|</keyword>`
+		<keyword>\</keyword>
+		<keyword>@</keyword>
+		<keyword>~</keyword>
+		<keyword>..</keyword>
+	</keyword-list>
+-->
 	<string _name = "String" style = "String" end-at-line-end = "true">
 		<start-regex>&quot;</start-regex>
 		<end-regex>&quot;</end-regex>
 	</string>
 
 	<string _name = "Character Constant" style = "String" end-at-line-end = "true">
-		<start-regex>[^A-Za-z]&apos;</start-regex>
+		<start-regex>[^A-Za-z0-9]&apos;</start-regex>
 		<end-regex>&apos;</end-regex>
 	</string>
 
@@ -43,40 +57,58 @@
 		<regex>\b[0-9]\b</regex>
 	</pattern-item>
 
-	<pattern-item _name = "Floating Point Number" style = "Floating Point">
-		<regex>\b([0-9]+[Ee][-]?[0-9]+|([0-9]*\.[0-9]+|[0-9]+\.)([Ee][-]?[0-9]+)?)</regex>
+	<pattern-item _name = "Floating Point Number" style = "Floating point">
+		<regex>\b([0-9]+.[0-9]+([eE][+-]?[0-9])?|[0-9][eE][+-]?[0-9])</regex>
 	</pattern-item>
 
+	<pattern-item _name = "Octal Number" style = "Base-N Integer">
+                <regex>\b[oO][0-7]+\b</regex>
+        </pattern-item>
+
 	<pattern-item _name = "Hex Number" style = "Base-N Integer">
 		<regex>\b0[xX][0-9a-fA-F]+\b</regex>
 	</pattern-item>
 
 	<keyword-list _name = "Keywords" style = "Keyword" case-sensitive="true">
-		<keyword>type</keyword>
-		<keyword>data</keyword>
-		<keyword>let</keyword>
-		<keyword>in</keyword>
-		<keyword>case</keyword>
-		<keyword>of</keyword>
-		<keyword>module</keyword>
-		<keyword>class</keyword>
-		<keyword>where</keyword>
-		<keyword>instance</keyword>
-		<keyword>import</keyword>
-		<keyword>qualified</keyword>
-		<keyword>as</keyword>
-		<keyword>do</keyword>
-		<keyword>deriving</keyword>
+                <keyword>as</keyword>
+                <keyword>case</keyword>
+	        <keyword>class</keyword>
+                <keyword>data</keyword>
+                <keyword>deriving</keyword>
+                <keyword>do</keyword>
+                <keyword>else</keyword>
+                <keyword>forall</keyword> <!-- GHC extension -->
+                <keyword>hiding</keyword>
+                <keyword>if</keyword>
+                <keyword>import</keyword>
+                <keyword>in</keyword>
+                <keyword>infix</keyword>
+                <keyword>infixl</keyword>
+                <keyword>infixr</keyword>
+                <keyword>instance</keyword>
+                <keyword>let</keyword>
+                <keyword>module</keyword>
+                <keyword>newtype</keyword>
+                <keyword>of</keyword>
+                <keyword>qualified</keyword>
+                <keyword>then</keyword>
+                <keyword>where</keyword>
+                <keyword>with</keyword> <!-- GHC extension -->
+	</keyword-list>
+
+	<keyword-list _name = "Preprocessor Definitions" style = "Preprocessor" case-sensitive="true"
+		match-empty-string-at-beginning = "false"
+		match-empty-string-at-end = "true"
+		beginning-regex = "^[ \t]*#[ \t]*">
 		<keyword>if</keyword>
-		<keyword>then</keyword>
+		<keyword>ifdef</keyword>
+		<keyword>ifndef</keyword>
 		<keyword>else</keyword>
-		<keyword>newtype</keyword>
-		<keyword>hiding</keyword>
-		<keyword>infix</keyword>
-		<keyword>infixl</keyword>
-		<keyword>infixr</keyword>
-		<keyword>with</keyword>
-		<keyword>forall</keyword>
+		<keyword>elif</keyword>
+		<keyword>define</keyword>
+		<keyword>endif</keyword>
+		<keyword>undef</keyword>
+		<keyword>error</keyword>
 	</keyword-list>
 
 </language>

[Gtk2hs-commit] gtk2hs ChangeLog,1.148,1.149

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

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

Modified Files:
	ChangeLog 
Log Message:
new demo, a viewer for ghc's time-profile log files


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.148
retrieving revision 1.149
diff -u -d -r1.148 -r1.149
--- ChangeLog	7 May 2004 16:44:26 -0000	1.148
+++ ChangeLog	14 May 2004 18:06:16 -0000	1.149
@@ -1,5 +1,14 @@
 2004-05-6 Duncan Coutts <du...@co...>
 
+	* demo/profileviewer/ProfileViewer.hs,
+	demo/profileviewer/ParseProfile.hs,
+	demo/profileviewer/ProfileViewer.glade,
+	demo/profileviewer/ProfileViewer.gladep,
+	demo/profileviewer/Makefile: new demo, a viewer for ghc's
+	time-profile log files
+
+2004-05-6 Duncan Coutts <du...@co...>
+
 	* gtk/glib/GParameter.hsc: new marshaling support module needed
 	for GObject.objectNew
 

[Gtk2hs-commit] gtk2hs/demo/profileviewer ProfileViewer.hs,NONE,1.1 ParseProfile.hs,NONE,1.1 ProfileViewer.glade,NONE,1.1 ProfileViewer.gladep,NONE,1.1 Makefile,NONE,1.1

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

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

Added Files:
	ProfileViewer.hs ParseProfile.hs ProfileViewer.glade 
	ProfileViewer.gladep Makefile 
Log Message:
new demo, a viewer for ghc's time-profile log files


--- NEW FILE: ProfileViewer.gladep ---
<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
<!DOCTYPE glade-project SYSTEM "http://glade.gnome.org/glade-project-2.0.dtd">

<glade-project>
  <name>ProfileViewer</name>
  <program_name>profileviewer</program_name>
  <gnome_support>FALSE</gnome_support>
</glade-project>

--- NEW FILE: ParseProfile.hs ---
-- Copyright (c) 2004 Duncan Coutts
-- This library is liscenced under the GNU General Public License version 2
-- or (at your option) any later version.

-- This is a not-terribly-clever parser for ghc's time profile log files.

module ParseProfile (
  Profile(..),
  ProfileNode(..),
  parseProfileFile,
  pruneOnThreshold
) where

import Char
import Maybe (catMaybes)

data Profile = Profile {
    title :: String,
    command :: String,
    totalTime :: Float,
    totalAlloc :: Integer,   --can be several GB
    breakdown :: ProfileNode
  }

data ProfileNode = ProfileNode {
    costCentre :: String,
    moduleName :: String,
    entries :: !Int,
    individualTime  :: !Int, --scaled by 10
    individualAlloc :: !Int, --scaled by 10
    inheritedTime   :: !Int, --scaled by 10
    inheritedAlloc  :: !Int, --scaled by 10
    children :: [ProfileNode]
  }

pruneOnThreshold :: Int -> ProfileNode -> Maybe ProfileNode
pruneOnThreshold threshold node
  | inheritedTime node >= threshold
 || inheritedAlloc node >= threshold =
    let children' = catMaybes $ map (pruneOnThreshold threshold) (children node)
     in Just $ node { children = children' }
  | otherwise = Nothing


parseProfileFile :: String -> IO Profile
parseProfileFile filename = do
  content <- readFile filename
  let (titleLine:_:commandLine:_:timeLine:allocLine:theRest) = lines content
      profileDetail = dropWhile (\line -> take 4 line /= "MAIN") theRest
  return $ Profile {
      title = dropWhile isSpace titleLine,
      command = dropWhile isSpace commandLine,
      totalTime = read $ words timeLine !! 3,
      totalAlloc = read $ filter (/=',') $ words allocLine !! 3,
      breakdown = parseProfile profileDetail
    }

-- intermediate form
data ProfileEntry = ProfileEntry {
    depth :: !Int,
    ecostCentre :: String,
    emoduleName :: String,
    eentries :: !Int,
    eindividualTime  :: !Int, --scaled by 10
    eindividualAlloc :: !Int, --scaled by 10
    einheritedTime   :: !Int, --scaled by 10
    einheritedAlloc  :: !Int  --scaled by 10
  }

parseProfile :: [String] -> ProfileNode
parseProfile file =
  case (profileEntriesToProfile [] 0 . map parseProfileEntry) file of
    ([profile],[]) -> profile
    _ -> error "multiple top level entries"

parseProfileEntry :: String -> ProfileEntry
parseProfileEntry line =
  let depth = length (takeWhile (==' ') line)
   in case words line of
        [costCentre, moduleName, _, entries,
         individualTime, individualAlloc,
         inheritedTime, inheritedAlloc] ->
          ProfileEntry {
            depth = depth,
            ecostCentre = costCentre,
            emoduleName = moduleName,
            eentries = read entries,
            eindividualTime  = floor $ (read individualTime) * 10,
            eindividualAlloc = floor $ (read individualAlloc) * 10,
            einheritedTime  = floor $ (read inheritedTime) * 10,
            einheritedAlloc = floor $ (read inheritedAlloc) * 10 
          }
        _ -> error $ "bad profile line:\n\t" ++ line

profileEntriesToProfile :: [ProfileNode] -> Int -> [ProfileEntry] -> ([ProfileNode], [ProfileEntry])
profileEntriesToProfile acum curDepth [] = (acum, [])
profileEntriesToProfile acum curDepth (entry:entries)
  | depth entry == curDepth =
     let (children, remaining) = profileEntriesToProfile
                                   [] (depth entry + 1) entries
         curNode = ProfileNode {
             costCentre = ecostCentre entry,
             moduleName = emoduleName entry,
             entries    = eentries entry,
             individualTime  = eindividualTime entry,
             individualAlloc = eindividualAlloc entry,
             inheritedTime  = einheritedTime entry,
             inheritedAlloc = einheritedAlloc entry,
             children = children
           }
      in profileEntriesToProfile (curNode:acum) (depth entry) remaining
  | depth entry < curDepth = (acum, entry:entries)  --we're done for this level
  | otherwise = error "bad indentation in file"

--- NEW FILE: ProfileViewer.glade ---
<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">

<glade-interface>

<widget class="GtkWindow" id="mainWindow">
  <property name="visible">True</property>
  <property name="title" translatable="yes">GHC timing profile viewer</property>
  <property name="type">GTK_WINDOW_TOPLEVEL</property>
  <property name="window_position">GTK_WIN_POS_NONE</property>
  <property name="modal">False</property>
  <property name="default_width">650</property>
  <property name="default_height">400</property>
  <property name="resizable">True</property>
  <property name="destroy_with_parent">False</property>

  <child>
    <widget class="GtkVBox" id="vbox1">
      <property name="visible">True</property>
      <property name="homogeneous">False</property>
      <property name="spacing">0</property>

      <child>
	<widget class="GtkMenuBar" id="menubar1">
	  <property name="visible">True</property>

	  <child>
	    <widget class="GtkMenuItem" id="menuitem1">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">_File</property>
	      <property name="use_underline">True</property>

	      <child>
		<widget class="GtkMenu" id="menuitem1_menu">

		  <child>
		    <widget class="GtkImageMenuItem" id="openMenuItem">
		      <property name="visible">True</property>
		      <property name="label">gtk-open</property>
		      <property name="use_stock">True</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkMenuItem" id="separatormenuitem1">
		      <property name="visible">True</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkImageMenuItem" id="quitMenuItem">
		      <property name="visible">True</property>
		      <property name="label">gtk-quit</property>
		      <property name="use_stock">True</property>
		    </widget>
		  </child>
		</widget>
	      </child>
	    </widget>
	  </child>

	  <child>
	    <widget class="GtkMenuItem" id="view1">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">_View</property>
	      <property name="use_underline">True</property>

	      <child>
		<widget class="GtkMenu" id="view1_menu">

		  <child>
		    <widget class="GtkRadioMenuItem" id="allEntries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">All entries</property>
		      <property name="use_underline">True</property>
		      <property name="active">True</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="0.1%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 0.1% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="0.5%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 0.5% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="1%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 1% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="5%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 5% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="10%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 10% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="50%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 50% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>
		</widget>
	      </child>
	    </widget>
	  </child>

	  <child>
	    <widget class="GtkMenuItem" id="menuitem4">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">_Help</property>
	      <property name="use_underline">True</property>

	      <child>
		<widget class="GtkMenu" id="menuitem4_menu">

		  <child>
		    <widget class="GtkMenuItem" id="aboutMenuItem">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">_About</property>
		      <property name="use_underline">True</property>
		    </widget>
		  </child>
		</widget>
	      </child>
	    </widget>
	  </child>
	</widget>
	<packing>
	  <property name="padding">0</property>
	  <property name="expand">False</property>
	  <property name="fill">False</property>
	</packing>
      </child>

      <child>
	<widget class="GtkTable" id="table1">
	  <property name="border_width">5</property>
	  <property name="visible">True</property>
	  <property name="n_rows">4</property>
	  <property name="n_columns">2</property>
	  <property name="homogeneous">False</property>
	  <property name="row_spacing">2</property>
	  <property name="column_spacing">10</property>

	  <child>
	    <widget class="GtkLabel" id="label4">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">&lt;b&gt;Total time&lt;/b&gt;</property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">True</property>
	      <property name="justify">GTK_JUSTIFY_RIGHT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">False</property>
	      <property name="xalign">1</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">0</property>
	      <property name="right_attach">1</property>
	      <property name="top_attach">2</property>
	      <property name="bottom_attach">3</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="label4">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">&lt;b&gt;Total alloc&lt;/b&gt;</property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">True</property>
	      <property name="justify">GTK_JUSTIFY_LEFT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">False</property>
	      <property name="xalign">1</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">0</property>
	      <property name="right_attach">1</property>
	      <property name="top_attach">3</property>
	      <property name="bottom_attach">4</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="titleLabel">
	      <property name="visible">True</property>
	      <property name="can_focus">True</property>
	      <property name="label" translatable="yes"></property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">False</property>
	      <property name="justify">GTK_JUSTIFY_LEFT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">True</property>
	      <property name="xalign">0</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">1</property>
	      <property name="right_attach">2</property>
	      <property name="top_attach">0</property>
	      <property name="bottom_attach">1</property>
	      <property name="x_options">expand|shrink|fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="totalTimeLabel">
	      <property name="visible">True</property>
	      <property name="can_focus">True</property>
	      <property name="label" translatable="yes"></property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">False</property>
	      <property name="justify">GTK_JUSTIFY_LEFT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">True</property>
	      <property name="xalign">0</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">1</property>
	      <property name="right_attach">2</property>
	      <property name="top_attach">2</property>
	      <property name="bottom_attach">3</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="totalAllocLabel">
	      <property name="visible">True</property>
	      <property name="can_focus">True</property>
	      <property name="label" translatable="yes"></property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">False</property>
	      <property name="justify">GTK_JUSTIFY_LEFT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">True</property>
	      <property name="xalign">0</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">1</property>
	      <property name="right_attach">2</property>
	      <property name="top_attach">3</property>
	      <property name="bottom_attach">4</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="label11">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">&lt;b&gt;Report&lt;/b&gt;</property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">True</property>
	      <property name="justify">GTK_JUSTIFY_RIGHT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">False</property>
	      <property name="xalign">1</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">0</property>
	      <property name="right_attach">1</property>
	      <property name="top_attach">0</property>
	      <property name="bottom_attach">1</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="label12">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">&lt;b&gt;Command&lt;/b&gt;</property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">True</property>
	      <property name="justify">GTK_JUSTIFY_RIGHT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">False</property>
	      <property name="xalign">1</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">0</property>
	      <property name="right_attach">1</property>
	      <property name="top_attach">1</property>
	      <property name="bottom_attach">2</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="commandLabel">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes"></property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">False</property>
	      <property name="justify">GTK_JUSTIFY_LEFT</property>
	      <property name="wrap">True</property>
	      <property name="selectable">False</property>
	      <property name="xalign">0</property>
	      <property name="yalign">0</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">1</property>
	      <property name="right_attach">2</property>
	      <property name="top_attach">1</property>
	      <property name="bottom_attach">2</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>
	</widget>
	<packing>
	  <property name="padding">0</property>
	  <property name="expand">False</property>
	  <property name="fill">False</property>
	</packing>
      </child>

      <child>
	<widget class="GtkScrolledWindow" id="scrolledwindow1">
	  <property name="visible">True</property>
	  <property name="can_focus">True</property>
	  <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
	  <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
	  <property name="shadow_type">GTK_SHADOW_NONE</property>
	  <property name="window_placement">GTK_CORNER_TOP_LEFT</property>

	  <child>
	    <widget class="GtkTreeView" id="mainView">
	      <property name="visible">True</property>
	      <property name="can_focus">True</property>
	      <property name="headers_visible">True</property>
	      <property name="rules_hint">True</property>
	      <property name="reorderable">False</property>
	      <property name="enable_search">True</property>
	    </widget>
	  </child>
	</widget>
	<packing>
	  <property name="padding">0</property>
	  <property name="expand">True</property>
	  <property name="fill">True</property>
	</packing>
      </child>

      <child>
	<widget class="GtkStatusbar" id="statusbar">
	  <property name="visible">True</property>
	  <property name="has_resize_grip">True</property>
	</widget>
	<packing>
	  <property name="padding">0</property>
	  <property name="expand">False</property>
	  <property name="fill">False</property>
	</packing>
      </child>
    </widget>
  </child>
</widget>

</glade-interface>

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

include $(TOP)/mk/config.mk

MAIN = ProfileViewer.hs

APPNAME = viewProfile

NEEDPACKAGES = gtk2 mogul glade

include $(TOP)/mk/common.mk

--- NEW FILE: ProfileViewer.hs ---
-- Copyright (c) 2004 Duncan Coutts
-- This program is liscenced under the GNU General Public License version 2
-- or (at your option) any later version.

-- This is a slightly larger demo that combines use of glade, the file chooser
-- dialog, program state (IORefs) and use of the mogul tree view wrapper
-- interface. 

-- The program is a simple viewer for the log files that ghc produces when you
-- do time profiling. The parser is not very clever so loading large files can
-- take several seconds.

-- TODO: The gui will appear to hang when loading files. We should use threads
-- to keep the gui responsive.

module Main where

import Gtk
import Mogul
import Glade

import ParseProfile

import Maybe (isJust, fromJust)
import Monad (when)
import List  (unfoldr, intersperse)
import Data.IORef

main :: IO ()
main = do
  -- our global state
  thresholdVar <- newIORef 0        --current cuttoff/threshhold value
  profileVar <- newIORef Nothing    --holds the current profile data structure
  
  -- initialisation stuff
  initGUI

  dialogXmlM <- xmlNew "ProfileViewer.glade"
  let dialogXml = case dialogXmlM of
        (Just dialogXml) -> dialogXml
        Nothing -> error $ "can't find the glade file \"ProfileViewer.glade\""
                        ++ "in the current directory"

  -- get a handle on a various objects from the glade file
  mainWindow <- xmlGetWidget dialogXml castToWindow "mainWindow"
  mainWindow `onDestroy` mainQuit

  mainView <- xmlGetWidget dialogXml castToTreeView "mainView"

  titleLabel <- xmlGetWidget dialogXml castToLabel "titleLabel"
  commandLabel <- xmlGetWidget dialogXml castToLabel "commandLabel"
  totalTimeLabel <- xmlGetWidget dialogXml castToLabel "totalTimeLabel"
  totalAllocLabel <- xmlGetWidget dialogXml castToLabel "totalAllocLabel"
  
  -- create the tree model
  skel <- emptyTreeSkel
  
  let createTextColumn name = do
        (attr, _, set) <- treeSkelAddAttribute skel cellText
        column <- newTreeViewColumn
        column `treeViewColumnSetTitle` name
        mainView `treeViewAppendColumn` column
        renderer <- treeViewColumnNewText column True True
        renderer `treeViewColumnAssociate` [attr]
        return set

  -- create the various columns in both the model and view
  setCostCentre <- createTextColumn "Cost Centre"
  setModule     <- createTextColumn "Module"
  setEntries    <- createTextColumn "Entries"
  setIndiTime   <- createTextColumn "Individual %time"
  setIndiAlloc  <- createTextColumn "Individual %alloc"
  setInhTime    <- createTextColumn "Inherited %time"
  setInhAlloc   <- createTextColumn "Inherited %alloc"

  store <- newTreeStore skel
  mainView `treeViewSetModel` store

  -- this action clears the tree model and then populates it with the
  -- profile contained in the profileVar, taking into account the current
  -- threshold value kept in the thresholdVar 
  let repopulateTreeStore = do
        profile <- readIORef profileVar
        when (isJust profile)
             (repopulateTreeStore' $ fromJust profile)
      repopulateTreeStore' profile = do
        treeStoreClear store
        titleLabel `labelSetText` (title profile)
        commandLabel `labelSetText` (command profile)
        totalTimeLabel `labelSetText` (show (totalTime profile) ++ " sec")
        totalAllocLabel `labelSetText` (formatNumber (totalAlloc profile) ++ " bytes")
        
	threshold <- readIORef thresholdVar
        let node = if threshold > 0
                     then pruneOnThreshold threshold (breakdown profile)
                     else Just (breakdown profile)
        when (isJust node)
             (addProfileNode Nothing (fromJust node))

      addProfileNode :: Maybe TreeIter -> ProfileNode -> IO ()
      addProfileNode parentNode profile = do
        iter <- treeStoreAppend store parentNode
        setCostCentre iter (costCentre profile)
        setModule     iter (moduleName profile)
        setEntries    iter (show $ entries profile)
        setIndiTime   iter (show $ fromIntegral (individualTime profile) / 10)
        setIndiAlloc  iter (show $ fromIntegral (individualAlloc profile)/ 10)
        setInhTime    iter (show $ fromIntegral (inheritedTime profile)  / 10)
        setInhAlloc   iter (show $ fromIntegral (inheritedAlloc profile) / 10)
	return iter
        mapM_ (addProfileNode (Just iter)) (children profile)

  -- associate actions with the menus
  
  -- the open menu item, opens a file dialog and then loads and displays
  -- the the profile (unless the user cancleled the dialog)
  openMenuItem <- xmlGetWidget dialogXml castToMenuItem "openMenuItem"
  openMenuItem `onActivateLeaf` do
    filename <- openFileDialog mainWindow
    when (isJust filename)
         (do profile <- parseProfileFile (fromJust filename)
	     writeIORef profileVar (Just profile)
             repopulateTreeStore)

  quitMenuItem <- xmlGetWidget dialogXml castToMenuItem "quitMenuItem"
  quitMenuItem `onActivateLeaf` mainQuit
  
  -- each menu item in the "View" menu sets the thresholdVar and re-displays
  -- the current profile
  let doThresholdMenuItem threshold itemName = do
        menuItem <- xmlGetWidget dialogXml castToMenuItem itemName
        menuItem `onActivateLeaf` do writeIORef thresholdVar threshold
	                             repopulateTreeStore
  mapM_ (uncurry doThresholdMenuItem)
    [(0, "allEntries"), (1, "0.1%Entries"), (5, "0.5%Entries"), (10, "1%Entries"),
     (50, "5%Entries"), (100, "10%Entries"), (500, "50%Entries")]

  -- The final step is to display the main window and run the main loop
  widgetShowAll mainWindow
  mainGUI


-- display a standard file open dialog
openFileDialog :: Window -> IO (Maybe String)
openFileDialog parentWindow = do
  dialog <- fileChooserDialogNew
              (Just "Open Profile... ")
              (Just parentWindow)
	      FileChooserActionOpen
	      [("gtk-cancel", ResponseCancel)
	      ,("gtk-open", ResponseAccept)]
  widgetShow dialog
  dialogRun dialog
  widgetHide dialog
  fileChooserGetFilename dialog
 
-- just to display a number using thousand seperators
-- eg "3,456,235,596"
formatNumber :: Integer -> String
formatNumber =
  reverse . concat . intersperse ","
  . unfoldr (\l -> case splitAt 3 l of
                     ([], _) -> Nothing
                     p       -> Just p)
  . reverse . show

[Gtk2hs-commit] gtk2hs/demo/profileviewer - New directory

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

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

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/demo/profileviewer added to the repository

[Gtk2hs-commit] gtk2hs ChangeLog,1.147,1.148

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

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

Modified Files:
	ChangeLog 
Log Message:
whitespace fix to help calcuating deps of .chs files


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.147
retrieving revision 1.148
diff -u -d -r1.147 -r1.148
--- ChangeLog	7 May 2004 16:40:18 -0000	1.147
+++ ChangeLog	7 May 2004 16:44:26 -0000	1.148
@@ -10,6 +10,9 @@
 
 	* Makefile: enable building filechooser demo
 
+	* gtk/windows/FileChooserDialog.chs: whitespace fix, to help in
+	calculating depandancies of .chs files
+
 2004-05-4 Duncan Coutts <du...@co...>
 
 	* configure.in, Makefile, mk/config.mk.in: allow libglade to be

[Gtk2hs-commit] gtk2hs/gtk/windows FileChooserDialog.chs,1.1,1.2

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

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

Modified Files:
	FileChooserDialog.chs 
Log Message:
whitespace fix to help calcuating deps of .chs files


Index: FileChooserDialog.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/windows/FileChooserDialog.chs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- FileChooserDialog.chs	30 Apr 2004 20:52:41 -0000	1.1
+++ FileChooserDialog.chs	7 May 2004 16:44:26 -0000	1.2
@@ -38,7 +38,7 @@
 import Maybe (isJust, fromJust)
 import FFI
 {#import Hierarchy#}
-{#import FileChooser #}
+{#import FileChooser#}
 import GObject (objectNew)
 import Object (makeNewObject)
 import Window

[Gtk2hs-commit] gtk2hs/gtk/glib GParameter.hsc,NONE,1.1 GObject.chs,1.6,1.7

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

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

Modified Files:
	GObject.chs 
Added Files:
	GParameter.hsc 
Log Message:
add GObject.objectNew, required for FileChooserDialog and re-enable building
FileChooserDialog and the associated demo


--- NEW FILE: GParameter.hsc ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry GParameter@
--
--  Author : Duncan Coutts
--          
--  Created: 29 March 2004
--
--  Version $Revision: 1.1 $ from $Date: 2004/05/07 16:40:00 $
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
-- Storable instance for GParameter, used by objectNew
--

module GParameter (
  GParameter(..)
  ) where

import FFI
import GValue
--import StoreValue

#include <glib-object.h>

--newtype GParameter = GParameter (String, GenericValue)
newtype GParameter = GParameter (String, GValue)

instance Storable GParameter where
  sizeOf    _ = #const sizeof(GParameter)
  alignment _ = #{const __alignof__(GParameter)}
  poke ptr (GParameter (name, value)) = do
    strPtr <- newCString name
    #{poke GParameter, name}  ptr strPtr
--    poke (#{ptr GParameter, value} ptr) value
    #{poke GParameter, value} ptr value

Index: GObject.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/glib/GObject.chs,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- GObject.chs	9 Jul 2003 22:42:44 -0000	1.6
+++ GObject.chs	7 May 2004 16:40:00 -0000	1.7
@@ -29,6 +29,7 @@
 --
 -- @todo@ ---------------------------------------------------------------------
 module GObject(
+  objectNew,
   objectRef,
   objectUnref,
   makeNewGObject,
@@ -39,13 +40,29 @@
   ) where
 
 
+import Monad (liftM)
 import FFI
-import LocalData(newIORef, readIORef, writeIORef)
-import Hierarchy(GObjectClass, toGObject, unGObject)
-{#import GValue#}
+import LocalData (newIORef, readIORef, writeIORef)
+import Hierarchy (GObjectClass, GObject(..),
+                  mkGObject, toGObject, unGObject)
+import GValue (GValue)
+import GType  (GType)
+import GParameter
 
 {# context lib="glib" prefix="g" #}
 
+{# pointer *GParameter as GParm -> GParameter #}
+
+-- construct a new object (should rairly be used directly)
+--
+objectNew :: GType -> [(String, GValue)] -> IO (Ptr GObject)
+objectNew objType parameters =
+  liftM castPtr $ --caller must makeNewGObject as we don't know
+                  --if it this a GObject or a GtkObject
+  withArray (map GParameter parameters) $ \paramArrayPtr ->
+  {# call g_object_newv #} objType
+  (fromIntegral $ length parameters) paramArrayPtr
+
 -- increase the reference counter of an object
 --
 objectRef :: GObjectClass obj => Ptr obj -> IO ()

[Gtk2hs-commit] gtk2hs/gtk/general Gtk.hs,1.23,1.24

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

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

Modified Files:
	Gtk.hs 
Log Message:
add GObject.objectNew, required for FileChooserDialog and re-enable building
FileChooserDialog and the associated demo


Index: Gtk.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/general/Gtk.hs,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- Gtk.hs	30 Apr 2004 21:00:08 -0000	1.23
+++ Gtk.hs	7 May 2004 16:40:00 -0000	1.24
@@ -62,7 +62,7 @@
   module FileSel,
 #if GTK_CHECK_VERSION(2,4,0)
   module FileChooser,
---  module FileChooserDialog,
+  module FileChooserDialog,
   module FileChooserWidget,
 #endif
   module Window,
@@ -208,7 +208,7 @@
 import FileSel
 #if GTK_CHECK_VERSION(2,4,0)
 import FileChooser
---import FileChooserDialog
+import FileChooserDialog
 import FileChooserWidget
 #endif
 import Window

[Gtk2hs-commit] gtk2hs Makefile,1.27,1.28 ChangeLog,1.146,1.147

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

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

Modified Files:
	Makefile ChangeLog 
Log Message:
add GObject.objectNew, required for FileChooserDialog and re-enable building
FileChooserDialog and the associated demo


Index: Makefile
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- Makefile	5 May 2004 16:16:19 -0000	1.27
+++ Makefile	7 May 2004 16:40:01 -0000	1.28
@@ -29,7 +29,7 @@
 MAKE_LIBS += mogul
 
 MAKE_APPS  = demo/concurrent demo/treeList demo/graphic demo/unicode \
-	     demo/hello demo/buttonbox
+	     demo/hello demo/buttonbox demo/filechooser
 
 ifeq ($(strip $(ENABLE_LIBGLADE)),yes)
 MAKE_APPS += demo/glade

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.146
retrieving revision 1.147
diff -u -d -r1.146 -r1.147
--- ChangeLog	5 May 2004 17:11:56 -0000	1.146
+++ ChangeLog	7 May 2004 16:40:18 -0000	1.147
@@ -1,3 +1,15 @@
+2004-05-6 Duncan Coutts <du...@co...>
+
+	* gtk/glib/GParameter.hsc: new marshaling support module needed
+	for GObject.objectNew
+
+	* gtk/glib/GObject.chs: added constructor objectNew, this is
+	needed for FileChooserDialog
+
+	* gtk/general/Gtk.hs: re-enable building FileChooserDialog
+
+	* Makefile: enable building filechooser demo
+
 2004-05-4 Duncan Coutts <du...@co...>
 
 	* configure.in, Makefile, mk/config.mk.in: allow libglade to be

[Gtk2hs-commit] gtk2hs/tools/hierarchyGen TypeGen.hs,1.5,1.6

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

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

Modified Files:
	TypeGen.hs 
Log Message:
remove class methods from GObjectClass. Use unsafeCoerce instead.


Index: TypeGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/hierarchyGen/TypeGen.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- TypeGen.hs	27 Apr 2004 17:59:37 -0000	1.5
+++ TypeGen.hs	5 May 2004 17:11:54 -0000	1.6
@@ -178,12 +178,14 @@
   indent 0.
   indent 0.ss "import FFI	(ForeignPtr, castForeignPtr, foreignPtrToPtr,".  ss " CULong)".
   indent 0.ss "import GType    (typeInstanceIsA)".
+  indent 0.ss "import GHC.Base (unsafeCoerce#)".
   -- this is a very bad hack to get the definition of the ancestors whenever
   -- these are not created in this file
   (if fname/="Hierarchy" then indent 0.ss "{#import Hierarchy#}" else id).
   indent 0.
   indent 0.ss "{#context lib=\"".ss lib.ss "\" prefix=\"".ss prefix.ss "\" #}".
   indent 0.
+  indent 0.ss "castToGObject :: GObjectClass obj => obj -> obj".
   indent 0.ss "castToGObject = id".
   indent 0.
   indent 0.ss "-- The usage of foreignPtrToPtr should be safe as the evaluation will only be".
@@ -250,31 +252,18 @@
   indent 0.ss "un".ss name.ss " (".ss name.ss " o) = o".
   indent 0.
   (if null parents
-  then
-    indent 0.ss "class ".ss name.ss "Class o where".
-    indent 1.ss "to".ss name.ss "   :: o -> ".ss name.
-    indent 1.ss "from".ss name.ss " :: ".ss name.ss " -> o".
-    indent 0.
-    indent 0.ss "instance ".ss name.ss "Class ".ss name.ss " where".
-    indent 1.ss "to".ss name.ss "   = id".
-    indent 1.ss "from".ss name.ss " = id"
-  else
-    indent 0.ss "class ".ss (head parents).ss "Class o => ".ss name.ss "Class o".
-    indent 0.ss "to".ss name.ss "   :: ".ss name.ss "Class o => o -> ".ss name.
-    indent 0.ss "to".ss name.ss "   = from".ss (last parents).ss " . to".ss (last parents).
-    indent 0.ss "from".ss name.ss " :: ".ss name.ss "Class o => ".ss name.ss " -> o".
-    indent 0.ss "from".ss name.ss " = from".ss (last parents).ss " . to".ss (last parents).
-    indent 0.
-    makeInstance name (name:parents)).
+     then indent 0.ss "class ".ss name.ss "Class o"
+     else indent 0.ss "class ".ss (head parents).ss "Class o => ".ss name.ss "Class o").
+  indent 0.ss "to".ss name.ss "   :: ".ss name.ss "Class o => o -> ".ss name.
+  indent 0.ss "to".ss name.ss "   = unsafeCoerce#".
+  indent 0.ss "from".ss name.ss " :: ".ss name.ss "Class o => ".ss name.ss " -> o".
+  indent 0.ss "from".ss name.ss " = unsafeCoerce#".
+  indent 0.
+  makeInstance name (name:parents).
   indent 0
 
 makeInstance :: String -> [String] -> ShowS
-makeInstance name [par] =
-  indent 0.
-  indent 0.ss "instance ".ss par.ss "Class ".ss name.ss " where".
-  indent 1.ss "to".ss par.ss "   = mk".ss par.ss ".castForeignPtr.un".ss name.
-  indent 1.ss "from".ss par.ss " = mk".ss name.ss ".castForeignPtr.un".ss par.
-  indent 0
+makeInstance name [] = indent 0
 makeInstance name (par:ents) =
   indent 0.ss "instance ".ss par.ss "Class ".ss name.
   makeInstance name ents

[Gtk2hs-commit] gtk2hs ChangeLog,1.145,1.146

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

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

Modified Files:
	ChangeLog 
Log Message:
remove class methods from GObjectClass. Use unsafeCoerce instead.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.145
retrieving revision 1.146
diff -u -d -r1.145 -r1.146
--- ChangeLog	5 May 2004 16:16:19 -0000	1.145
+++ ChangeLog	5 May 2004 17:11:56 -0000	1.146
@@ -3,6 +3,9 @@
 	* configure.in, Makefile, mk/config.mk.in: allow libglade to be
 	built without the gnome modules.
 
+	* tools/hierarchyGen/TypeGen.hs: remove class methods from
+	GObjectClass. Use unsafeCoerce instead.
+
 2004-05-2 Duncan Coutts <du...@co...>
 
 	* gtk/treeList/TreeStore.chs: added method treeStoreClear