gtk2hs-commit — Mailing list for Darcs commit messages.

[Gtk2hs-commit] gtk2hs ChangeLog,1.435,1.436

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

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

Modified Files:
	ChangeLog 
Log Message:
Merge from generated modules. Code formatting and documentation changes.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.435
retrieving revision 1.436
diff -u -d -r1.435 -r1.436
--- ChangeLog	7 Apr 2005 00:13:58 -0000	1.435
+++ ChangeLog	7 Apr 2005 00:19:02 -0000	1.436
@@ -20,6 +20,10 @@
 	* gtk/Graphics/UI/Gtk/Display/Label.chs.pp: bind 10 more methods and a
 	few properties. Update docs to refer to PangoLayout rather than	Layout.
 
+	* gtk/Graphics/UI/Gtk/Embedding/Plug.chs,
+	gtk/Graphics/UI/Gtk/Embedding/Socket.chs: merge from generated
+	modules. Code formatting and documentation changes.
+
 2005-04-6 Duncan Coutts <du...@co...>
 
 	* tools/callbackGen/gtkmarshal.list: tidy up slightly, and add

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Buttons Button.chs.pp,1.6,1.7

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

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

Modified Files:
	Button.chs.pp 
Log Message:
Add bindings for a bunch of extra methods and properties.
Also, various doc changes.


Index: Button.chs.pp
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Buttons/Button.chs.pp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- Button.chs.pp	2 Apr 2005 19:08:00 -0000	1.6
+++ Button.chs.pp	7 Apr 2005 00:14:00 -0000	1.7
@@ -84,6 +84,10 @@
   buttonSetAlignment,
   buttonGetAlignment,
 #endif
+#if GTK_CHECK_VERSION(2,6,0)
+  buttonGetImage,
+  buttonSetImage,
+#endif
 
 -- * Properties
   buttonUseUnderline,
@@ -379,6 +383,30 @@
   return (realToFrac xalign, realToFrac yalign)
 #endif
 
+-- | Gets the widget that is currenty set as the image of the button. This may
+-- have been explicitly set by 'buttonSetImage' or constructed by
+-- 'buttonNewFromStock'.
+--
+buttonGetImage :: ButtonClass self => self
+ -> IO (Maybe Widget) -- ^  a 'Widget' or @Nothing@ in case there is no image
+buttonGetImage self =
+  maybeNull (makeNewObject mkWidget) $
+  {# call gtk_button_get_image #}
+    (toButton self)
+
+-- | Set the image of the button to the given widget. Note that it depends on
+-- the \"gtk-button-images\" setting whether the image will be displayed or not.
+--
+-- * Available since Gtk+ version 2.6
+--
+buttonSetImage :: (ButtonClass self, WidgetClass image) => self
+ -> image -- ^  a widget to set as the image for the button
+ -> IO ()
+buttonSetImage self image =
+  {# call gtk_button_set_image #}
+    (toButton self)
+    (toWidget image)
+
 --------------------
 -- Properties
 

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Abstract Paned.chs.pp,1.7,1.8 Range.chs,1.8,1.9 Scrollbar.hs,1.3,1.4 Widget.chs.pp,1.1,1.2

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

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

Modified Files:
	Paned.chs.pp Range.chs Scrollbar.hs Widget.chs.pp 
Log Message:
Add bindings for a bunch of extra methods and properties.
Also, various doc changes.


Index: Range.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Range.chs,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- Range.chs	2 Apr 2005 19:02:23 -0000	1.8
+++ Range.chs	7 Apr 2005 00:13:59 -0000	1.9
@@ -24,7 +24,7 @@
 -- Stability   : provisional
 -- Portability : portable (depends on GHC)
 --
--- Base class for widgets which visualize an 'Adjustment'
+-- Base class for widgets which visualize an adjustment
 --
 module Graphics.UI.Gtk.Abstract.Range (
 -- * Description
@@ -61,10 +61,6 @@
   rangeSetIncrements,
   rangeSetRange,
   ScrollType(..),
-  rangeSetIncrements,
-  rangeSetRange,
-  rangeSetValue,
-  rangeGetValue,
 
 -- * Properties
   rangeUpdatePolicy,
@@ -77,6 +73,8 @@
   afterMoveSlider,
   onAdjustBounds,
   afterAdjustBounds,
+--  onValueChanged,
+--  afterValueChanged,
   ) where
 
 import Monad	(liftM)

Index: Widget.chs.pp
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Widget.chs.pp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Widget.chs.pp	6 Apr 2005 22:20:02 -0000	1.1
+++ Widget.chs.pp	7 Apr 2005 00:13:59 -0000	1.2
@@ -23,19 +23,12 @@
 --
 -- unimplemented methods that seem to be useful in user programs:
 --      widgetSizeRequest, widgetAddAccelerator, widgetRemoveAccelerator,
---	widgetAcceleratorSignal, widgetIntersect, widgetGrabDefault,
---	widgetGetPointer, widgetPath, widgetClassPath, getCompositeName,
---	widgetSetCompositeName,
---	widgetModifyStyle, widgetGetModifierStyle, widgetModifyFg,
---	widgetModifyBG, widgetModifyText, widgetModifyBase, widgetModifyFont,
+--	widgetAcceleratorSignal, widgetGrabDefault,
 --	widgetPango*, widgetSetAdjustments
 --
 -- implement the following methods in GtkWindow object:
 --      widget_set_uposition, widget_set_usize
 --
--- implement the following methods in GtkDrawingArea object:
---      widgetRegionIntersect
---
 -- |
 -- Maintainer  : gtk...@li...
 -- Stability   : provisional
@@ -44,7 +37,7 @@
 -- Base class for all widgets
 --
 module Graphics.UI.Gtk.Abstract.Widget (
--- * Description
+-- * Detail
 -- 
 -- | 'Widget' introduces style properties - these are basically object
 -- properties that are stored not on the object, but in the style object
@@ -59,9 +52,10 @@
 -- |  'GObject'
 -- |   +----'Object'
 -- |         +----Widget
--- |               +----'Misc'
 -- |               +----'Container'
+-- |               +----'Misc'
 -- |               +----'Calendar'
+-- |               +----'CellView'
 -- |               +----'DrawingArea'
 -- |               +----'Entry'
 -- |               +----'Ruler'
@@ -93,6 +87,8 @@
   widgetCreateLayout,		-- Drawing text.
   widgetQueueDraw,		-- Functions to be used with DrawingArea.
   widgetHasIntersection,
+  widgetIntersect,
+  widgetRegionIntersect,
   widgetActivate,		-- Manipulate widget state.
   widgetSetSensitivity,
   widgetSetSizeRequest,
@@ -110,6 +106,30 @@
   widgetQueueDrawArea,
   widgetSetDoubleBuffered,
   widgetSetRedrawOnAllocate,
+  widgetGetPointer,
+  widgetPath,
+  widgetClassPath,
+  widgetGetCompositeName,
+  widgetSetCompositeName,
+  widgetModifyStyle,
+  widgetGetModifierStyle,
+  widgetModifyFg,
+  widgetModifyBg,
+  widgetModifyText,
+  widgetModifyBase,
+  widgetModifyFont,
+  widgetGetParentWindow,
+  widgetSetExtensionEvents,
+  widgetGetExtensionEvents,
+  widgetGetEvents,
+  widgetTranslateCoordinates,
+  widgetSetDefaultDirection,
+  widgetGetDefaultDirection,
+  widgetCreatePangoContext,
+  widgetGetPangoContext,
+  widgetRenderIcon,
+  widgetGetParent,
+  widgetGetSizeRequest,
 
 -- * Properties
   widgetExtensionEvents,
@@ -189,6 +209,7 @@
   ) where
 
 import Monad	(liftM, unless)
+import Maybe	(fromMaybe)
 
 import System.Glib.FFI
 import System.Glib.UTFString
@@ -198,10 +219,13 @@
 {#import Graphics.UI.Gtk.Types#}
 {#import Graphics.UI.Gtk.Signals#}
 import Graphics.UI.Gtk.Gdk.Enums
-import Graphics.UI.Gtk.General.Structs	(Allocation, Rectangle(..), Requisition(..),
-					 widgetGetState, widgetGetSavedState)
+{#import Graphics.UI.Gtk.Gdk.Region#}	(Region(..), makeNewRegion)
+import Graphics.UI.Gtk.General.Structs	(Allocation, Rectangle(..)
+					,Requisition(..), Color, IconSize,
+					,widgetGetState, widgetGetSavedState)
 import Graphics.UI.Gtk.Gdk.Events	(Event(..), marshalEvent)
 import Graphics.UI.Gtk.General.Enums	(StateType(..), TextDirection(..))
+{#import Graphics.UI.Gtk.Pango.Types#}	(FontDescription(FontDescription))
 
 {# context lib="gtk" prefix="gtk" #}
 
@@ -319,12 +343,49 @@
  -> IO Bool   -- ^ returns @True@ if there was an intersection
 widgetHasIntersection self area = 
   liftM toBool $
-  withObject area $ \areaPtr ->
+  with area $ \areaPtr ->
   {# call unsafe widget_intersect #}
     (toWidget self)
     (castPtr areaPtr)
     (castPtr nullPtr)
 
+-- | Computes the intersection of a widget's area and @area@, returning the
+-- intersection, and returns @Nothing@ if there was no intersection.
+--
+widgetIntersect :: WidgetClass self => self
+ -> Rectangle -- ^ @area@ - a rectangle
+ -> IO (Maybe Rectangle) -- ^ returns the intersection or @Nothing@
+widgetIntersect self area =
+  with area $ \areaPtr ->
+  alloca $ \intersectionPtr -> do
+  hasIntersection <- {# call unsafe widget_intersect #}
+    (toWidget self)
+    (castPtr areaPtr)
+    (castPtr intersectionPtr)
+  if (toBool hasIntersection)
+    then liftM Just $ peek intersectionPtr
+    else return Nothing
+
+-- | Computes the intersection of a widget's area and @region@, returning
+-- the intersection. The result may be empty, use 'regionEmpty' to check.
+--
+widgetRegionIntersect :: WidgetClass self => self
+ -> Region    -- ^ @region@ - a 'Region' in the same coordinate system as the
+              -- widget's allocation. That is, relative to the widget's
+              -- 'DrawWindow' for 'NoWindow' widgets; relative to the parent
+              -- 'DrawWindow' of the widget's 'DrawWindow' for widgets with
+              -- their own 'DrawWindow'.
+ -> IO Region -- ^ returns A region holding the intersection of the widget and
+              --  @region@. The coordinates of the return value are relative to
+              -- the widget's 'DrawWindow' for 'NoWindow' widgets, and relative
+              --  to the parent 'DrawWindow' of the widget's 'DrawWindow' for
+              -- widgets with their own 'DrawWindow'.
+widgetRegionIntersect self region = do
+  intersectionPtr <- {# call gtk_widget_region_intersect #}
+    (toWidget self)
+    region
+  makeNewRegion intersectionPtr
+
 -- Manipulate widget state.
 
 -- | For widgets that can be \"activated\" (buttons, menu items, etc.) this
@@ -388,6 +449,26 @@
     (fromIntegral width)
     (fromIntegral height)
 
+-- | Gets the size request that was explicitly set for the widget using
+-- 'widgetSetSizeRequest'. A value of -1 for @width@ or @height@
+-- indicates that that dimension has not been set explicitly and the natural
+-- requisition of the widget will be used intead. See 'widgetSetSizeRequest'.
+-- To get the size a widget will actually use, call 'widgetSizeRequest' instead
+-- of this function.
+--
+widgetGetSizeRequest :: WidgetClass self => self
+ -> IO (Int, Int) -- ^ @(width, height)@
+widgetGetSizeRequest self =
+  alloca $ \widthPtr ->
+  alloca $ \heightPtr -> do
+  {# call gtk_widget_get_size_request #}
+    (toWidget self)
+    widthPtr
+    heightPtr
+  width <- peek widthPtr
+  height <- peek heightPtr
+  return (fromIntegral width, fromIntegral height)
+
 -- | Determines if the widget is the focus widget within its toplevel.
 --
 widgetIsFocus :: WidgetClass self => self
@@ -435,8 +516,7 @@
 -- | Retrieves the name of a widget. See 'widgetSetName' for the significance
 -- of widget names.
 --
-widgetGetName :: WidgetClass self => self
- -> IO String
+widgetGetName :: WidgetClass self => self -> IO String
 widgetGetName self =
   {# call unsafe widget_get_name #}
     (toWidget self)
@@ -530,9 +610,7 @@
 -- If the direction is set to 'TextDirNone', then the value set by
 -- 'widgetSetDefaultDirection' will be used.
 --
-widgetSetDirection :: WidgetClass self => self
- -> TextDirection
- -> IO ()
+widgetSetDirection :: WidgetClass self => self -> TextDirection -> IO ()
 widgetSetDirection self dir =
   {# call widget_set_direction #}
     (toWidget self)
@@ -541,8 +619,7 @@
 -- | Gets the reading direction for a particular widget. See
 -- 'widgetSetDirection'.
 --
-widgetGetDirection :: WidgetClass self => self
- -> IO TextDirection
+widgetGetDirection :: WidgetClass self => self -> IO TextDirection
 widgetGetDirection self =
   liftM (toEnum . fromIntegral) $
   {# call widget_get_direction #}
@@ -625,6 +702,351 @@
     (toWidget self)
     (fromBool redrawOnAllocate)
 
+-- | Gets the widget's parent window.
+--
+widgetGetParentWindow :: WidgetClass self => self -> IO DrawWindow
+widgetGetParentWindow self =
+  makeNewGObject mkDrawWindow $
+  {# call gtk_widget_get_parent_window #}
+    (toWidget self)
+
+-- | Obtains the location of the mouse pointer in widget coordinates. Widget
+-- coordinates are a bit odd; for historical reasons, they are defined as
+-- 'widgetGetParentWindow' coordinates for widgets that are not 'NoWindow' widgets,
+-- and are relative to the widget's allocation's (x,y) for
+-- widgets that are 'NoWindow' widgets.
+--
+widgetGetPointer :: WidgetClass self => self
+ -> IO (Int, Int) -- ^ @(x, y)@ - X Y coordinate
+widgetGetPointer self =
+  alloca $ \xPtr ->
+  alloca $ \yPtr ->
+  {# call gtk_widget_get_pointer #}
+    (toWidget self)
+    xPtr
+    yPtr
+  >>
+  peek xPtr >>= \x ->
+  peek yPtr >>= \y ->
+  return (fromIntegral x, fromIntegral y)
+
+-- | Translate coordinates relative to @srcWidget@'s allocation to coordinates
+-- relative to @destWidget@'s allocations. In order to perform this operation,
+-- both widgets must be realized, and must share a common toplevel.
+--
+widgetTranslateCoordinates :: (WidgetClass self, WidgetClass destWidget) =>
+    self                -- ^ @srcWidget@ - a 'Widget'
+ -> destWidget          -- ^ @destWidget@ - a 'Widget'
+ -> Int                 -- ^ @srcX@ - X position relative to @srcWidget@
+ -> Int                 -- ^ @srcY@ - Y position relative to @srcWidget@
+ -> IO (Maybe (Int, Int)) -- ^ @Just (destX, destY)@ - X and Y position
+                        -- relative to @destWidget@. Returns @Nothing@ if
+                        -- either widget was not realized, or there was no
+                        -- common ancestor.
+widgetTranslateCoordinates self destWidget srcX srcY =
+  alloca $ \destXPtr ->
+  alloca $ \destYPtr -> do
+  worked <- {# call gtk_widget_translate_coordinates #}
+    (toWidget self)
+    (toWidget destWidget)
+    (fromIntegral srcX)
+    (fromIntegral srcY)
+    destXPtr
+    destYPtr
+  if (toBool worked)
+    then do destX <- peek destXPtr
+            destY <- peek destYPtr
+            return (Just (fromIntegral destX, fromIntegral destY))
+    else return Nothing
+
+-- | Obtains the full path to the widget. The path is simply the name of a
+-- widget and all its parents in the container hierarchy, separated by periods.
+-- The name of a widget comes from 'widgetGetName'. Paths are used to apply
+-- styles to a widget in gtkrc configuration files. Widget names are the type
+-- of the widget by default (e.g. \"GtkButton\") or can be set to an
+-- application-specific value with 'widgetSetName'. By setting the name of a
+-- widget, you allow users or theme authors to apply styles to that specific
+-- widget in their gtkrc file. Also returns the path in reverse
+-- order, i.e. starting with the widget's name instead of starting with the
+-- name of the widget's outermost ancestor.
+--
+widgetPath :: WidgetClass self => self
+ -> IO (Int, String, String) -- ^ @(pathLength, path, pathReversed)@ - length
+                             -- of the path, path string and reverse path
+                             -- string
+widgetPath self =
+  alloca $ \pathLengthPtr ->
+  alloca $ \pathPtr ->
+  alloca $ \pathReversedPtr ->
+  {# call gtk_widget_path #}
+    (toWidget self)
+    pathLengthPtr
+    pathPtr
+    pathReversedPtr
+  >>
+  peek pathLengthPtr >>= \pathLength ->
+  peek pathPtr >>= readUTFString >>= \path ->
+  peek pathReversedPtr >>= readUTFString >>= \pathReversed ->
+  return (fromIntegral pathLength, path, pathReversed)
+
+-- | Same as 'widgetPath', but always uses the name of a widget's type, never
+-- uses a custom name set with 'widgetSetName'.
+--
+widgetClassPath :: WidgetClass self => self
+ -> IO (Int, String, String) -- ^ @(pathLength, path, pathReversed)@ - length
+                             -- of the path, path string and reverse path
+                             -- string
+widgetClassPath self =
+  alloca $ \pathLengthPtr ->
+  alloca $ \pathPtr ->
+  alloca $ \pathReversedPtr ->
+  {# call gtk_widget_class_path #}
+    (toWidget self)
+    pathLengthPtr
+    pathPtr
+    pathReversedPtr
+  >>
+  peek pathLengthPtr >>= \pathLength ->
+  peek pathPtr >>= readUTFString >>= \path ->
+  peek pathReversedPtr >>= readUTFString >>= \pathReversed ->
+  return (fromIntegral pathLength, path, pathReversed)
+
+-- | Obtains the composite name of a widget.
+--
+widgetGetCompositeName :: WidgetClass self => self
+ -> IO (Maybe String) -- ^ returns the composite name of @widget@, or
+                      -- @Nothing@ if @widget@ is not a composite child.
+widgetGetCompositeName self =
+  {# call gtk_widget_get_composite_name #}
+    (toWidget self)
+  >>= maybePeek peekUTFString
+
+-- | Sets a widgets composite name. The widget must be a composite child of
+-- its parent; see 'widgetPushCompositeChild'.
+--
+widgetSetCompositeName :: WidgetClass self => self
+ -> String -- ^ @name@ - the name to set.
+ -> IO ()
+widgetSetCompositeName self name =
+  withUTFString name $ \namePtr ->
+  {# call gtk_widget_set_composite_name #}
+    (toWidget self)
+    namePtr
+
+-- | Returns the parent container of @widget@.
+--
+widgetGetParent :: WidgetClass self => self
+ -> IO Widget -- ^ returns the parent container of @widget@, or {@NULL@,
+              -- FIXME: this should probably be converted to a Maybe data type}
+widgetGetParent self =
+  makeNewObject mkWidget $
+  {# call gtk_widget_get_parent #}
+    (toWidget self)
+
+-- | Sets the default reading direction for widgets where the direction has
+-- not been explicitly set by 'widgetSetDirection'.
+--
+widgetSetDefaultDirection :: 
+    TextDirection -- ^ @dir@ - the new default direction. This cannot be
+                  -- 'TextDirNone'.
+ -> IO ()
+widgetSetDefaultDirection dir =
+  {# call gtk_widget_set_default_direction #}
+    ((fromIntegral . fromEnum) dir)
+
+-- | Obtains the current default reading direction. See
+-- 'widgetSetDefaultDirection'.
+--
+widgetGetDefaultDirection :: IO TextDirection
+widgetGetDefaultDirection =
+  liftM (toEnum . fromIntegral) $
+  {# call gtk_widget_get_default_direction #}
+
+-- | Modifies style values on the widget. Modifications made using this
+-- technique take precedence over style values set via an RC file, however,
+-- they will be overriden if a style is explicitely set on the widget using
+-- 'widgetSetStyle'. The 'RcStyle' structure is designed so each field can
+-- either be set or unset, so it is possible, using this function, to modify
+-- some style values and leave the others unchanged.
+--
+-- Note that modifications made with this function are not cumulative with
+-- previous calls to 'widgetModifyStyle' or with such functions as
+-- 'widgetModifyFg'. If you wish to retain previous values, you must first call
+-- 'widgetGetModifierStyle', make your modifications to the returned style,
+-- then call 'widgetModifyStyle' with that style. On the other hand, if you
+-- first call 'widgetModifyStyle', subsequent calls to such functions
+-- 'widgetModifyFg' will have a cumulative effect with the initial
+-- modifications.
+--
+widgetModifyStyle :: (WidgetClass self, RcStyleClass style) => self
+ -> style -- ^ @style@ - the 'RcStyle' holding the style modifications
+ -> IO ()
+widgetModifyStyle self style =
+  {# call gtk_widget_modify_style #}
+    (toWidget self)
+    (toRcStyle style)
+
+-- | Returns the current modifier style for the widget. (As set by
+-- 'widgetModifyStyle'.) If no style has previously set, a new 'RcStyle' will
+-- be created with all values unset, and set as the modifier style for the
+-- widget. If you make changes to this rc style, you must call
+-- 'widgetModifyStyle', passing in the returned rc style, to make sure that
+-- your changes take effect.
+--
+-- Caution: passing the style back to 'widgetModifyStyle' will normally end
+-- up destroying it, because 'widgetModifyStyle' copies the passed-in style and
+-- sets the copy as the new modifier style, thus dropping any reference to the
+-- old modifier style. Add a reference to the modifier style if you want to
+-- keep it alive.
+--
+widgetGetModifierStyle :: WidgetClass self => self -> IO RcStyle
+widgetGetModifierStyle self =
+  makeNewGObject mkRcStyle $
+  {# call gtk_widget_get_modifier_style #}
+    (toWidget self)
+
+-- | Sets the foreground color for a widget in a particular state. All other
+-- style values are left untouched. See also 'widgetModifyStyle'.
+--
+widgetModifyFg :: WidgetClass self => self
+ -> StateType -- ^ @state@ - the state for which to set the foreground color.
+ -> Color     -- ^ @color@ - the color to assign (does not need to be
+              -- allocated), or @Nothing@ to undo the effect of previous calls
+              -- to of 'widgetModifyFg'.
+ -> IO ()
+widgetModifyFg self state color =
+  with color $ \colorPtr ->
+  {# call gtk_widget_modify_fg #}
+    (toWidget self)
+    ((fromIntegral . fromEnum) state)
+    (castPtr colorPtr)
+
+-- | Sets the background color for a widget in a particular state. All other
+-- style values are left untouched. See also 'widgetModifyStyle'.
+--
+widgetModifyBg :: WidgetClass self => self
+ -> StateType -- ^ @state@ - the state for which to set the background color.
+ -> Color     -- ^ @color@ - the color to assign (does not need to be
+              -- allocated), or @Nothing@ to undo the effect of previous calls
+              -- to of 'widgetModifyBg'.
+ -> IO ()
+widgetModifyBg self state color =
+  with color $ \colorPtr ->
+  {# call gtk_widget_modify_bg #}
+    (toWidget self)
+    ((fromIntegral . fromEnum) state)
+    (castPtr colorPtr)
+
+-- | Sets the text color for a widget in a particular state. All other style
+-- values are left untouched. The text color is the foreground color used along
+-- with the base color (see 'widgetModifyBase') for widgets such as 'Entry' and
+-- 'TextView'. See also 'widgetModifyStyle'.
+--
+widgetModifyText :: WidgetClass self => self
+ -> StateType -- ^ @state@ - the state for which to set the text color.
+ -> Color     -- ^ @color@ - the color to assign (does not need to be
+              -- allocated), or @Nothing@ to undo the effect of previous calls
+              -- to of 'widgetModifyText'.
+ -> IO ()
+widgetModifyText self state color =
+  with color $ \colorPtr ->
+  {# call gtk_widget_modify_text #}
+    (toWidget self)
+    ((fromIntegral . fromEnum) state)
+    (castPtr colorPtr)
+
+-- | Sets the base color for a widget in a particular state. All other style
+-- values are left untouched. The base color is the background color used along
+-- with the text color (see 'widgetModifyText') for widgets such as 'Entry' and
+-- 'TextView'. See also 'widgetModifyStyle'.
+--
+widgetModifyBase :: WidgetClass self => self
+ -> StateType -- ^ @state@ - the state for which to set the base color.
+ -> Color     -- ^ @color@ - the color to assign (does not need to be
+              -- allocated), or @Nothing@ to undo the effect of previous calls
+              -- to of 'widgetModifyBase'.
+ -> IO ()
+widgetModifyBase self state color =
+  with color $ \colorPtr ->
+  {# call gtk_widget_modify_base #}
+    (toWidget self)
+    ((fromIntegral . fromEnum) state)
+    (castPtr colorPtr)
+
+-- | Sets the font to use for a widget. All other style values are left
+-- untouched. See also 'widgetModifyStyle'.
+--
+widgetModifyFont :: WidgetClass self => self
+ -> Maybe FontDescription -- ^ @fontDesc@ - the font description to use, or
+                          -- @Nothing@ to undo the effect of previous calls to
+                          -- 'widgetModifyFont'.
+ -> IO ()
+widgetModifyFont self fontDesc =
+  {# call gtk_widget_modify_font #}
+    (toWidget self)
+    (fromMaybe (FontDescription nullForeignPtr) fontDesc)
+
+-- | Creates a new 'Context' with the appropriate colormap, font description,
+-- and base direction for drawing text for this widget. See also
+-- 'widgetGetPangoContext'.
+--
+widgetCreatePangoContext :: WidgetClass self => self
+ -> IO PangoContext -- ^ returns the new 'PangoContext'
+widgetCreatePangoContext self =
+  makeNewGObject mkPangoContext $
+  {# call gtk_widget_create_pango_context #}
+    (toWidget self)
+
+-- | Gets a 'Context' with the appropriate colormap, font description and base
+-- direction for this widget. Unlike the context returned by
+-- 'widgetCreatePangoContext', this context is owned by the widget (it can be
+-- used until the screen for the widget changes or the widget is removed from
+-- its toplevel), and will be updated to match any changes to the widget's
+-- attributes.
+--
+-- If you create and keep a 'PangoLayout' using this context, you must deal
+-- with changes to the context by calling 'layoutContextChanged' on the layout
+-- in response to the ::style-set and ::direction-changed signals for the
+-- widget.
+--
+widgetGetPangoContext :: WidgetClass self => self
+ -> IO PangoContext -- ^ returns the 'PangoContext' for the widget.
+widgetGetPangoContext self =
+  makeNewGObject mkPangoContext $
+  {# call gtk_widget_get_pango_context #}
+    (toWidget self)
+
+-- | A convenience function that uses the theme engine and RC file settings
+-- for @widget@ to look up @stockId@ and render it to a pixbuf. @stockId@
+-- should be a stock icon ID such as {GTK_STOCK_OPEN, FIXME: unknown
+-- type/value} or {GTK_STOCK_OK, FIXME: unknown type/value}. @size@ should be a
+-- size such as 'IconSizeMenu'. @detail@ should be a string that identifies the
+-- widget or code doing the rendering, so that theme engines can special-case
+-- rendering for that widget or code.
+--
+-- The pixels in the returned 'Pixbuf' are shared with the rest of the
+-- application and should not be modified. The pixbuf should be freed after use
+-- with 'gObjectUnref'.
+--
+widgetRenderIcon :: WidgetClass self => self
+ -> String    -- ^ @stockId@ - a stock ID
+ -> IconSize  -- ^ @size@ - a stock size. A size of (GtkIconSize)-1 means
+              -- render at the size of the source and don't scale (if there are
+              -- multiple source sizes, Gtk+ picks one of the available sizes).
+ -> String    -- ^ @detail@ - render detail to pass to theme engine
+ -> IO Pixbuf -- ^ returns a new pixbuf, or {@NULL@, FIXME: this should
+              -- probably be converted to a Maybe data type} if the stock ID
+              -- wasn't known
+widgetRenderIcon self stockId size detail =
+  makeNewGObject mkPixbuf $
+  withUTFString detail $ \detailPtr ->
+  withUTFString stockId $ \stockIdPtr ->
+  {# call gtk_widget_render_icon #}
+    (toWidget self)
+    stockIdPtr
+    ((fromIntegral . fromEnum) size)
+    detailPtr
+
 --------------------
 -- Properties
 

Index: Paned.chs.pp
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Paned.chs.pp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- Paned.chs.pp	2 Apr 2005 19:02:22 -0000	1.7
+++ Paned.chs.pp	7 Apr 2005 00:13:59 -0000	1.8
@@ -83,7 +83,21 @@
 #endif
 
 -- * Properties
-  panedPosition
+  panedPosition,
+
+-- * Signals
+  onCycleChildFocus,
+  afterCycleChildFocus,
+  onToggleHandleFocus,
+  afterToggleHandleFocus,
+  onMoveHandle,
+  afterMoveHandle,
+  onCycleHandleFocus,
+  afterCycleHandleFocus,
+  onAcceptPosition,
+  afterAcceptPosition,
+  onCancelPosition,
+  afterCancelPosition,
   ) where
 
 import Monad	(liftM)
@@ -93,6 +107,7 @@
 import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
 {#import Graphics.UI.Gtk.Types#}
 {#import Graphics.UI.Gtk.Signals#}
+import Graphics.UI.Gtk.General.Enums	(ScrollType)
 
 {# context lib="gtk" prefix="gtk" #}
 
@@ -209,3 +224,54 @@
 panedPosition = Attr 
   panedGetPosition
   panedSetPosition
+
+--------------------
+-- Signals
+
+-- | 
+--
+onCycleChildFocus, afterCycleChildFocus :: PanedClass self => self
+ -> (Bool -> IO Bool)
+ -> IO (ConnectId self)
+onCycleChildFocus = connect_BOOL__BOOL "cycle_child_focus" False
+afterCycleChildFocus = connect_BOOL__BOOL "cycle_child_focus" True
+
+-- | 
+--
+onToggleHandleFocus, afterToggleHandleFocus :: PanedClass self => self
+ -> IO Bool
+ -> IO (ConnectId self)
+onToggleHandleFocus = connect_NONE__BOOL "toggle_handle_focus" False
+afterToggleHandleFocus = connect_NONE__BOOL "toggle_handle_focus" True
+
+-- | 
+--
+onMoveHandle, afterMoveHandle :: PanedClass self => self
+ -> (ScrollType -> IO Bool)
+ -> IO (ConnectId self)
+onMoveHandle = connect_ENUM__BOOL "move_handle" False
+afterMoveHandle = connect_ENUM__BOOL "move_handle" True
+
+-- | 
+--
+onCycleHandleFocus, afterCycleHandleFocus :: PanedClass self => self
+ -> (Bool -> IO Bool)
+ -> IO (ConnectId self)
+onCycleHandleFocus = connect_BOOL__BOOL "cycle_handle_focus" False
+afterCycleHandleFocus = connect_BOOL__BOOL "cycle_handle_focus" True
+
+-- | 
+--
+onAcceptPosition, afterAcceptPosition :: PanedClass self => self
+ -> IO Bool
+ -> IO (ConnectId self)
+onAcceptPosition = connect_NONE__BOOL "accept_position" False
+afterAcceptPosition = connect_NONE__BOOL "accept_position" True
+
+-- | 
+--
+onCancelPosition, afterCancelPosition :: PanedClass self => self
+ -> IO Bool
+ -> IO (ConnectId self)
+onCancelPosition = connect_NONE__BOOL "cancel_position" False
+afterCancelPosition = connect_NONE__BOOL "cancel_position" True

Index: Scrollbar.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Scrollbar.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- Scrollbar.hs	14 Mar 2005 23:55:07 -0000	1.3
+++ Scrollbar.hs	7 Apr 2005 00:13:59 -0000	1.4
@@ -31,6 +31,15 @@
 -- 
 -- | The 'Scrollbar' widget is an abstract base class for 'HScrollbar' and
 -- 'VScrollbar'. It is not very useful in itself.
+--
+-- The position of the thumb in a scrollbar is controlled by the scroll
+-- adjustments. See 'Adjustment' for the fields in an adjustment - for
+-- 'Scrollbar', the \"value\" field represents the position of the scrollbar,
+-- which must be between the \"lower\" field and \"upper - page_size.\" The
+-- \"page_size\" field represents the size of the visible scrollable area. The
+-- \"step_increment\" and \"page_increment\" fields are used when the user asks
+-- to step down (using the small stepper arrows) or page down (using for
+-- example the PageDown key).
 
 -- * Class Hierarchy
 -- |

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

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

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

Modified Files:
	Image.chs.pp Label.chs.pp 
Log Message:
Add bindings for a bunch of extra methods and properties.
Also, various doc changes.


Index: Image.chs.pp
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Display/Image.chs.pp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- Image.chs.pp	2 Apr 2005 19:38:29 -0000	1.6
+++ Image.chs.pp	7 Apr 2005 00:14:01 -0000	1.7
@@ -39,7 +39,7 @@
 -- A widget displaying an image
 --
 module Graphics.UI.Gtk.Display.Image (
--- * Description
+-- * Detail
 -- 
 -- | The 'Image' widget displays an image. Various kinds of object can be
 -- displayed as an image; most typically, you would load a 'Pixbuf' (\"pixel
@@ -58,7 +58,7 @@
 -- 'Image' is a subclass of 'Misc', which implies that you can align it
 -- (center, left, right) and add padding to it, using 'Misc' methods.
 --
--- 'Image' is a \"no window\" widget (has no \"Gdk Window\" of its own), so by
+-- 'Image' is a \"no window\" widget (has no 'DrawWindow' of its own), so by
 -- default does not receive events. If you want to receive events on the image,
 -- such as button clicks, place the image inside a 'EventBox', then connect to
 -- the event signals on the event box.
@@ -95,10 +95,21 @@
   imageNewFromFile,
   imageNewFromPixbuf,
   imageNewFromStock,
+  imageNew,
+#if GTK_CHECK_VERSION(2,6,0)
+  imageNewFromIconName,
+#endif
 
 -- * Methods
   imageGetPixbuf,
   imageSetFromPixbuf,
+  imageSetFromFile,
+  imageSetFromStock,
+#if GTK_CHECK_VERSION(2,6,0)
+  imageSetFromIconName,
+  imageSetPixelSize,
+  imageGetPixelSize,
+#endif
 
 -- * Icon Sizes
   IconSize,
@@ -107,12 +118,18 @@
   iconSizeLargeToolbar,
   iconSizeButton,
   iconSizeDialog,
+
+-- * Properties
+#if GTK_CHECK_VERSION(2,6,0)
+  imagePixelSize,
+#endif
   ) where
 
 import Monad	(liftM)
 
 import System.Glib.FFI
 import System.Glib.UTFString
+import System.Glib.Attributes		(Attr(..))
 import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
 import System.Glib.GObject		(makeNewGObject)
 {#import Graphics.UI.Gtk.Types#}
@@ -179,6 +196,34 @@
     stockIdPtr
     (fromIntegral size)
 
+-- | Creates a new empty 'Image' widget.
+--
+imageNew :: IO Image
+imageNew =
+  makeNewObject mkImage $
+  liftM (castPtr :: Ptr Widget -> Ptr Image) $
+  {# call gtk_image_new #}
+
+#if GTK_CHECK_VERSION(2,6,0)
+-- | Creates a 'Image' displaying an icon from the current icon theme. If the
+-- icon name isn't known, a \"broken image\" icon will be displayed instead. If
+-- the current icon theme is changed, the icon will be updated appropriately.
+--
+-- * Available since Gtk+ version 2.6
+--
+imageNewFromIconName :: 
+    String   -- ^ @iconName@ - an icon name
+ -> IconSize -- ^ @size@ - a stock icon size
+ -> IO Image
+imageNewFromIconName iconName size =
+  makeNewObject mkImage $
+  liftM (castPtr :: Ptr Widget -> Ptr Image) $
+  withUTFString iconName $ \iconNamePtr ->
+  {# call gtk_image_new_from_icon_name #}
+    iconNamePtr
+    ((fromIntegral . fromEnum) size)
+#endif
+
 --------------------
 -- Methods
 
@@ -199,3 +244,83 @@
   {# call unsafe gtk_image_set_from_pixbuf #}
     self
     pixbuf
+
+-- | See 'imageNewFromFile' for details.
+--
+imageSetFromFile :: Image -> FilePath -> IO ()
+imageSetFromFile self filename =
+  withUTFString filename $ \filenamePtr ->
+  {# call gtk_image_set_from_file #}
+    self
+    filenamePtr
+
+-- | See 'imageNewFromStock' for details.
+--
+imageSetFromStock :: Image
+ -> String   -- ^ @stockId@ - a stock icon name
+ -> IconSize -- ^ @size@ - a stock icon size
+ -> IO ()
+imageSetFromStock self stockId size =
+  withUTFString stockId $ \stockIdPtr ->
+  {# call gtk_image_set_from_stock #}
+    self
+    stockIdPtr
+    ((fromIntegral . fromEnum) size)
+
+#if GTK_CHECK_VERSION(2,6,0)
+-- | See 'imageNewFromIconName' for details.
+--
+-- * Available since Gtk+ version 2.6
+--
+imageSetFromIconName :: Image
+ -> String   -- ^ @iconName@ - an icon name
+ -> IconSize -- ^ @size@ - an icon size
+ -> IO ()
+imageSetFromIconName self iconName size =
+  withUTFString iconName $ \iconNamePtr ->
+  {# call gtk_image_set_from_icon_name #}
+    self
+    iconNamePtr
+    ((fromIntegral . fromEnum) size)
+
+-- | Sets the pixel size to use for named icons. If the pixel size is set to a
+-- @value \/= -1@, it is used instead of the icon size set by
+-- 'imageSetFromIconName'.
+--
+-- * Available since Gtk+ version 2.6
+--
+imageSetPixelSize :: Image
+ -> Int   -- ^ @pixelSize@ - the new pixel size
+ -> IO ()
+imageSetPixelSize self pixelSize =
+  {# call gtk_image_set_pixel_size #}
+    self
+    (fromIntegral pixelSize)
+
+-- | Gets the pixel size used for named icons.
+--
+-- * Available since Gtk+ version 2.6
+--
+imageGetPixelSize :: Image -> IO Int
+imageGetPixelSize self =
+  liftM fromIntegral $
+  {# call gtk_image_get_pixel_size #}
+    self
+#endif
+
+--------------------
+-- Properties
+
+#if GTK_CHECK_VERSION(2,6,0)
+-- | The pixel-size property can be used to specify a fixed size overriding
+-- the icon-size property for images of type 'ImageIconName'.
+--
+-- Allowed values: >= -1
+--
+-- Default value: -1
+--
+imagePixelSize :: Attr Image Int
+imagePixelSize = Attr 
+  imageGetPixelSize
+  imageSetPixelSize
+#endif

Index: Label.chs.pp
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Display/Label.chs.pp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Label.chs.pp	6 Apr 2005 22:20:02 -0000	1.1
+++ Label.chs.pp	7 Apr 2005 00:14:01 -0000	1.2
@@ -149,13 +149,32 @@
   labelSelectRegion,
   labelGetSelectionBounds,
   labelGetLayoutOffsets,
+#if GTK_CHECK_VERSION(2,6,0)
+  labelSetEllipsize,
+  labelGetEllipsize,
+  labelSetWidthChars,
+  labelGetWidthChars,
+  labelSetMaxWidthChars,
+  labelGetMaxWidthChars,
+  labelSetSingleLineMode,
+  labelGetSingleLineMode,
+  labelSetAngle,
+  labelGetAngle,
+#endif
 
 -- * Properties
   labelUseMarkup,
   labelUseUnderline,
   labelJustify,
   labelSelectable,
-  labelLineWrap
+#if GTK_CHECK_VERSION(2,6,0)
+  labelEllipsize,
+  labelWidthChars,
+  labelSingleLineMode,
+  labelAngle,
+  labelMaxWidthChars,
+#endif
+  labelLineWrap,
   ) where
 
 import Monad	(liftM)
@@ -169,6 +188,7 @@
 {#import Graphics.UI.Gtk.Signals#}
 import Graphics.UI.Gtk.General.Enums	(Justification(..))
 import Graphics.UI.Gtk.Pango.Markup
+import Graphics.UI.Gtk.Pango.Enums	(EllipsizeMode)
 
 {# context lib="gtk" prefix="gtk" #}
 
@@ -304,12 +324,11 @@
   {# call unsafe label_get_justify #}
     (toLabel self)
 
--- | Gets the 'Layout' used to display the label. The layout is useful to e.g.
--- convert text positions to pixel positions, in combination with
+-- | Gets the 'PangoLayout' used to display the label. The layout is useful to
+-- e.g. convert text positions to pixel positions, in combination with
 -- 'labelGetLayoutOffsets'.
 --
-labelGetLayout :: LabelClass self => self
- -> IO PangoLayout -- ^ returns the 'Layout' for this label
+labelGetLayout :: LabelClass self => self -> IO PangoLayout
 labelGetLayout self =
   makeNewGObject mkPangoLayout $
   {# call unsafe label_get_layout #}
@@ -338,10 +357,10 @@
   {# call unsafe label_get_line_wrap #}
     (toLabel self)
 
--- | Obtains the coordinates where the label will draw the 'Layout'
+-- | Obtains the coordinates where the label will draw the 'PangoLayout'
 -- representing the text in the label; useful to convert mouse events into
--- coordinates inside the 'Layout', e.g. to take some action if some part of
--- the label is clicked. Of course you will need to create a 'EventBox' to
+-- coordinates inside the 'PangoLayout', e.g. to take some action if some part
+-- of the label is clicked. Of course you will need to create a 'EventBox' to
 -- receive the events, and pack the label inside it, since labels are a
 -- \'NoWindow\' widget.
 --
@@ -531,6 +550,130 @@
     (toLabel self)
     strPtr
 
+#if GTK_CHECK_VERSION(2,6,0)
+-- | Sets the mode used to ellipsize (add an ellipsis: \"...\") to the text if
+-- there is not enough space to render the entire string.
+--
+-- * Available since Gtk+ version 2.6
+--
+labelSetEllipsize :: LabelClass self => self
+ -> EllipsizeMode -- ^ @mode@ - a 'EllipsizeMode'
+ -> IO ()
+labelSetEllipsize self mode =
+  {# call gtk_label_set_ellipsize #}
+    (toLabel self)
+    ((fromIntegral . fromEnum) mode)
+
+-- | Sets the desired width in characters of @label@ to @nChars@.
+--
+-- * Available since Gtk+ version 2.6
+--
+labelSetWidthChars :: LabelClass self => self
+ -> Int   -- ^ @nChars@ - the new desired width, in characters.
+ -> IO ()
+labelSetWidthChars self nChars =
+  {# call gtk_label_set_width_chars #}
+    (toLabel self)
+    (fromIntegral nChars)
+
+-- | Sets the desired maximum width in characters of @label@ to @nChars@.
+--
+-- * Available since Gtk+ version 2.6
+--
+labelSetMaxWidthChars :: LabelClass self => self
+ -> Int   -- ^ @nChars@ - the new desired maximum width, in characters.
+ -> IO ()
+labelSetMaxWidthChars self nChars =
+  {# call gtk_label_set_max_width_chars #}
+    (toLabel self)
+    (fromIntegral nChars)
+
+-- | Returns the ellipsizing position of the label. See 'labelSetEllipsize'.
+--
+-- * Available since Gtk+ version 2.6
+--
+labelGetEllipsize :: LabelClass self => self
+ -> IO EllipsizeMode -- ^ returns 'EllipsizeMode'
+labelGetEllipsize self =
+  liftM (toEnum . fromIntegral) $
+  {# call gtk_label_get_ellipsize #}
+    (toLabel self)
+
+-- | Retrieves the desired width of @label@, in characters. See
+-- 'labelSetWidthChars'.
+--
+-- * Available since Gtk+ version 2.6
+--
+labelGetWidthChars :: LabelClass self => self
+ -> IO Int -- ^ returns the width of the label in characters.
+labelGetWidthChars self =
+  liftM fromIntegral $
+  {# call gtk_label_get_width_chars #}
+    (toLabel self)
+
+-- | Retrieves the desired maximum width of @label@, in characters. See
+-- 'labelSetWidthChars'.
+--
+-- * Available since Gtk+ version 2.6
+--
+labelGetMaxWidthChars :: LabelClass self => self
+ -> IO Int -- ^ returns the maximum width of the label in characters.
+labelGetMaxWidthChars self =
+  liftM fromIntegral $
+  {# call gtk_label_get_max_width_chars #}
+    (toLabel self)
+
+-- | Returns whether the label is in single line mode.
+--
+-- * Available since Gtk+ version 2.6
+--
+labelGetSingleLineMode :: LabelClass self => self
+ -> IO Bool -- ^ returns @True@ when the label is in single line mode.
+labelGetSingleLineMode self =
+  liftM toBool $
+  {# call gtk_label_get_single_line_mode #}
+    (toLabel self)
+
+-- | Gets the angle of rotation for the label. See gtk_label_set_angle.
+--
+-- * Available since Gtk+ version 2.6
+--
+labelGetAngle :: LabelClass self => self
+ -> IO Double -- ^ returns the angle of rotation for the label
+labelGetAngle self =
+  liftM realToFrac $
+  {# call gtk_label_get_angle #}
+    (toLabel self)
+
+-- | Sets whether the label is in single line mode.
+--
+-- * Available since Gtk+ version 2.6
+--
+labelSetSingleLineMode :: LabelClass self => self
+ -> Bool  -- ^ @singleLineMode@ - @True@ if the label should be in single line
+          -- mode
+ -> IO ()
+labelSetSingleLineMode self singleLineMode =
+  {# call gtk_label_set_single_line_mode #}
+    (toLabel self)
+    (fromBool singleLineMode)
+
+-- | Sets the angle of rotation for the label. An angle of 90 reads from from
+-- bottom to top, an angle of 270, from top to bottom. The angle setting for
+-- the label is ignored if the label is selectable, wrapped, or ellipsized.
+--
+-- * Available since Gtk+ version 2.6
+--
+labelSetAngle :: LabelClass self => self
+ -> Double -- ^ @angle@ - the angle that the baseline of the label makes with
+           -- the horizontal, in degrees, measured counterclockwise
+ -> IO ()
+labelSetAngle self angle =
+  {# call gtk_label_set_angle #}
+    (toLabel self)
+    (realToFrac angle)
+#endif
+
 --------------------
 -- Properties
 
@@ -573,6 +716,76 @@
   labelGetSelectable
   labelSetSelectable
 
+#if GTK_CHECK_VERSION(2,6,0)
+-- | The preferred place to ellipsize the string, if the label does not have
+-- enough room to display the entire string, specified as a 'EllisizeMode'.
+--
+-- Note that setting this property to a value other than 'EllipsizeNone' has
+-- the side-effect that the label requests only enough space to display the
+-- ellipsis \"...\". In particular, this means that ellipsizing labels don't
+-- work well in notebook tabs, unless the tab's tab-expand property is set to
+-- @True@. Other means to set a label's width are 'widgetSetSizeRequest' and
+-- 'labelSetWidthChars'.
+--
+-- Default value: 'EllipsizeNone'
+--
+labelEllipsize :: LabelClass self => Attr self EllipsizeMode
+labelEllipsize = Attr 
+  labelGetEllipsize
+  labelSetEllipsize
+
+-- | The desired width of the label, in characters. If this property is set to
+-- -1, the width will be calculated automatically, otherwise the label will
+-- request either 3 characters or the property value, whichever is greater. If
+-- the width-chars property is set to a positive value, then the
+-- max-width-chars property is ignored.
+--
+-- Allowed values: >= -1
+--
+-- Default value: -1
+--
+labelWidthChars :: LabelClass self => Attr self Int
+labelWidthChars = Attr 
+  labelGetWidthChars
+  labelSetWidthChars
+
+-- | 
+--
+labelSingleLineMode :: LabelClass self => Attr self Bool
+labelSingleLineMode = Attr 
+  labelGetSingleLineMode
+  labelSetSingleLineMode
+
+-- | The angle that the baseline of the label makes with the horizontal, in
+-- degrees, measured counterclockwise. An angle of 90 reads from from bottom to
+-- top, an angle of 270, from top to bottom. Ignored if the label is
+-- selectable, wrapped, or ellipsized.
+--
+-- Allowed values: [0,360]
+--
+-- Default value: 0
+--
+labelAngle :: LabelClass self => Attr self Double
+labelAngle = Attr 
+  labelGetAngle
+  labelSetAngle
+
+-- | The desired maximum width of the label, in characters. If this property
+-- is set to -1, the width will be calculated automatically, otherwise the
+-- label will request space for no more than the requested number of
+-- characters. If the width-chars property is set to a positive value, then the
+-- max-width-chars property is ignored.
+--
+-- Allowed values: >= -1
+--
+-- Default value: -1
+--
+labelMaxWidthChars :: LabelClass self => Attr self Int
+labelMaxWidthChars = Attr 
+  labelGetMaxWidthChars
+  labelSetMaxWidthChars
+#endif
+
 -- | \'lineWrap\' property. See 'labelGetLineWrap' and 'labelSetLineWrap'
 --
 labelLineWrap :: LabelClass self => Attr self Bool

[Gtk2hs-commit] gtk2hs ChangeLog,1.434,1.435

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

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

Modified Files:
	ChangeLog 
Log Message:
Add bindings for a bunch of extra methods and properties.
Also, various doc changes.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.434
retrieving revision 1.435
diff -u -d -r1.434 -r1.435
--- ChangeLog	6 Apr 2005 22:20:01 -0000	1.434
+++ ChangeLog	7 Apr 2005 00:13:58 -0000	1.435
@@ -1,3 +1,25 @@
+2005-04-7 Duncan Coutts <du...@co...>
+
+	* gtk/Graphics/UI/Gtk/Abstract/Paned.chs.pp: add several new signals
+
+	* gtk/Graphics/UI/Gtk/Abstract/Range.chs: tidy up header and export
+	list. Unfortunately, we cannot export onValueChanged at the moment
+	since it clashes with the same signals from another module.
+
+	* gtk/Graphics/UI/Gtk/Abstract/Scrollbar.hs: add extra module level
+	documentation.
+
+	* gtk/Graphics/UI/Gtk/Abstract/Widget.chs.pp: bind 26 extra functions.
+	Update TODO list and other minor changes.
+
+	* gtk/Graphics/UI/Gtk/Buttons/Button.chs.pp: bind two new functions.
+
+	* gtk/Graphics/UI/Gtk/Display/Image.chs.pp: bind a few more functions
+	and a property.
+
+	* gtk/Graphics/UI/Gtk/Display/Label.chs.pp: bind 10 more methods and a
+	few properties. Update docs to refer to PangoLayout rather than	Layout.
+
 2005-04-6 Duncan Coutts <du...@co...>
 
 	* tools/callbackGen/gtkmarshal.list: tidy up slightly, and add

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Multiline TextBuffer.chs.pp,NONE,1.1 TextView.chs.pp,NONE,1.1 TextBuffer.chs,1.6,NONE TextView.chs,1.6,NONE

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

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

Added Files:
	TextBuffer.chs.pp TextView.chs.pp 
Removed Files:
	TextBuffer.chs TextView.chs 
Log Message:
Rename several modules to .pp (without changing module content) in preparation
for adding new functions from later Gtk+ versions.


--- TextView.chs DELETED ---

--- NEW FILE: TextBuffer.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) TextBuffer
--
--  Author : Axel Simon
--
--  Created: 23 February 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/04/06 22:20:03 $
--
--  Copyright (C) 2001-2005 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library 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
--  Lesser General Public License for more details.
--
-- TODO
--
-- The functionality of inserting widgets (child anchors) is not implemented
--   since there will probably some changes before the final release. The
--   following functions are not bound:
--     gtk_text_buffer_insert_child_anchor
--     gtk_text_buffer_create_child_anchor
--     gtk_text_buffer_get_iter_at_anchor
--     connectToInsertChildAnchor
--     
-- Check 'textBufferGetInsert', in case there is no cursor in 
--   the editor,
--   is there a mark called \"insert\"? If not, the function needs to return
--   Maybe TextMark. The same holds for 
--   'textBufferGetSelectionBound'.
--
-- If Clipboards are bound, then these functions need to be bound as well:
--     gtk_text_buffer_paste_clipboard
--     gtk_text_buffer_copy_clipboard
--     gtk_text_buffer_cut_clipboard
--     gtk_text_buffer_add_selection_clipboard
--     gtk_text_buffer_remove_selection_clipboard
--
-- NOTES
--
-- The following convenience functions are omitted: 
--     gtk_text_buffer_insert_with_tags
--     gtk_text_buffer_insert_with_tags_by_name
--     gtk_text_buffer_create_tag
--     gtk_text_buffer_get_bounds
--     gtk_text_buffer_get_selection_bounds
--
-- The following functions do not make sense due to Haskell's wide character
--   representation of Unicode:
--     gtk_text_buffer_get_iter_at_line_index
--
-- The function gtk_text_buffer_get_selection_bounds is only used to test
--   if there is a selection  (see 'textBufferHasSelection').
--
-- |
-- Maintainer  : gtk...@li...
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Stores attributed text for display in a 'TextView'
--
module Graphics.UI.Gtk.Multiline.TextBuffer (
-- * Description
-- 
-- | You may wish to begin by reading the text widget conceptual overview
-- which gives an overview of all the objects and data types related to the
-- text widget and how they work together.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----TextBuffer
-- @

-- * Types
  TextBuffer,
  TextBufferClass,
  castToTextBuffer,

-- * Constructors
  textBufferNew,

-- * Methods
  textBufferGetLineCount,
  textBufferGetCharCount,
  textBufferGetTagTable,
  textBufferInsert,
  textBufferInsertAtCursor,
  textBufferInsertInteractive,
  textBufferInsertInteractiveAtCursor,
  textBufferInsertRange,
  textBufferInsertRangeInteractive,
  textBufferDelete,
  textBufferDeleteInteractive,
  textBufferSetText,
  textBufferGetText,
  textBufferGetSlice,
  textBufferInsertPixbuf,
  textBufferCreateMark,
  textBufferMoveMark,
  textBufferMoveMarkByName,
  textBufferDeleteMark,
  textBufferDeleteMarkByName,
  textBufferGetMark,
  textBufferGetInsert,
  textBufferGetSelectionBound,
  textBufferPlaceCursor,
  textBufferApplyTag,
  textBufferRemoveTag,
  textBufferApplyTagByName,
  textBufferRemoveTagByName,
  textBufferRemoveAllTags,
  textBufferGetIterAtLineOffset,
  textBufferGetIterAtOffset,
  textBufferGetIterAtLine,
  textBufferGetIterAtMark,
  textBufferGetStartIter,
  textBufferGetEndIter,
  textBufferGetModified,
  textBufferSetModified,
  textBufferDeleteSelection,
  textBufferHasSelection,
  textBufferBeginUserAction,
  textBufferEndUserAction,

-- * Properties
  textBufferModified,

-- * Signals
  onApplyTag,
  afterApplyTag,
  onBeginUserAction,
  afterBeginUserAction,
  onBufferChanged,
  afterBufferChanged,
  onDeleteRange,
  afterDeleteRange,
  onEndUserAction,
  afterEndUserAction,
  onInsertPixbuf,
  afterInsertPixbuf,
  onInsertText,
  afterInsertText,
  onMarkDeleted,
  afterMarkDeleted,
  onMarkSet,
  afterMarkSet,
  onModifiedChanged,
  afterModifiedChanged,
  onRemoveTag,
  afterRemoveTag
  ) where

import Monad	(liftM)
import Maybe	(fromMaybe)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes			(Attr(..))
import System.Glib.GObject			(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.Multiline.TextIter#}
import Graphics.UI.Gtk.Multiline.TextMark	(TextMark, MarkName)
import Graphics.UI.Gtk.Multiline.TextTag	(TextTag, TagName)

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

--------------------
-- Constructors

-- | Creates a new text buffer.
--
textBufferNew :: TextTagTableClass table => 
    Maybe table   -- ^ @table@ - a tag table, or @Nothing@ to create a new one
 -> IO TextBuffer
textBufferNew table =
  makeNewGObject mkTextBuffer $
  {# call unsafe text_buffer_new #}
    (maybe (TextTagTable nullForeignPtr) toTextTagTable table)

--------------------
-- Methods

-- | Obtains the number of lines in the buffer. This value is cached, so the
-- function is very fast.
--
textBufferGetLineCount :: TextBufferClass self => self -> IO Int
textBufferGetLineCount self =
  liftM fromIntegral $
  {# call unsafe text_buffer_get_line_count #}
    (toTextBuffer self)

-- | Gets the number of characters in the buffer. The character count is
-- cached, so this function is very fast.
--
textBufferGetCharCount :: TextBufferClass self => self -> IO Int
textBufferGetCharCount self =
  liftM fromIntegral $
  {# call unsafe text_buffer_get_char_count #}
    (toTextBuffer self)

-- | Get the 'TextTagTable' associated with this buffer.
--
textBufferGetTagTable :: TextBufferClass self => self -> IO TextTagTable
textBufferGetTagTable self =
  makeNewGObject mkTextTagTable $
  {# call unsafe text_buffer_get_tag_table #}
    (toTextBuffer self)

-- | Inserts @text@ at position @iter@. Emits the
-- \"insert_text\" signal; insertion actually occurs in the default handler for
-- the signal. @iter@ is invalidated when insertion occurs (because the buffer
-- contents change).
--
textBufferInsert :: TextBufferClass self => self
 -> TextIter -- ^ @iter@ - a position in the buffer
 -> String   -- ^ @text@ - text to insert
 -> IO ()
textBufferInsert self iter text =
  withUTFStringLen text $ \(textPtr, len) ->
  {# call text_buffer_insert #}
    (toTextBuffer self)
    iter
    textPtr
    (fromIntegral len)

-- | Simply calls 'textBufferInsert', using the current cursor position as the
-- insertion point.
--
textBufferInsertAtCursor :: TextBufferClass self => self -> String -> IO ()
textBufferInsertAtCursor self text =
  withUTFStringLen text $ \(textPtr, len) ->
  {# call text_buffer_insert_at_cursor #}
    (toTextBuffer self)
    textPtr
    (fromIntegral len)

-- | Like 'textBufferInsert', but the insertion will not occur if @iter@ is at
-- a non-editable location in the buffer. Usually you want to prevent
-- insertions at ineditable locations if the insertion results from a user
-- action (is interactive).
--
-- If no tag is at the specified position, use the default value @def@ to
-- decide if the text should be inserted. This value could be set to the result
-- of 'textViewGetEditable'.
--
textBufferInsertInteractive :: TextBufferClass self => self
 -> TextIter -- ^ @iter@ - a position in @buffer@
 -> String   -- ^ @text@ - the text to insert
 -> Bool     -- ^ @defaultEditable@ - default editability of buffer
 -> IO Bool  -- ^ returns whether text was actually inserted
textBufferInsertInteractive self iter text defaultEditable =
  liftM toBool $
  withUTFStringLen text $ \(textPtr, len) ->
  {# call text_buffer_insert_interactive #}
    (toTextBuffer self)
    iter
    textPtr
    (fromIntegral len)
    (fromBool defaultEditable)

-- | Calls 'textBufferInsertInteractive' at the cursor position.
--
textBufferInsertInteractiveAtCursor :: TextBufferClass self => self
 -> String  -- ^ @text@ - the text to insert
 -> Bool    -- ^ @defaultEditable@ - default editability of buffer
 -> IO Bool -- ^ returns whether text was actually inserted
textBufferInsertInteractiveAtCursor self text defaultEditable =
  liftM toBool $
  withUTFStringLen text $ \(textPtr, len) ->
  {# call text_buffer_insert_interactive_at_cursor #}
    (toTextBuffer self)
    textPtr
    (fromIntegral len)
    (fromBool defaultEditable)

-- | Copies text, tags, and pixbufs between @start@ and @end@ (the order of
-- @start@ and @end@ doesn't matter) and inserts the copy at @iter@. Used
-- instead of simply getting\/inserting text because it preserves images and
-- tags. If @start@ and @end@ are in a different buffer from @buffer@, the two
-- buffers must share the same tag table.
--
-- Implemented via emissions of the insert-text and apply-tag signals, so
-- expect those.
--
textBufferInsertRange :: TextBufferClass self => self
 -> TextIter -- ^ @iter@ - a position in the buffer
 -> TextIter -- ^ @start@ - a position in a 'TextBuffer'
 -> TextIter -- ^ @end@ - another position in the same buffer as @start@
 -> IO ()
textBufferInsertRange self iter start end =
  {# call text_buffer_insert_range #}
    (toTextBuffer self)
    iter
    start
    end

-- | Same as 'textBufferInsertRange', but does nothing if the insertion point
-- isn't editable. The @defaultEditable@ parameter indicates whether the text
-- is editable at @iter@ if no tags enclosing @iter@ affect editability.
-- Typically the result of 'textViewGetEditable' is appropriate here.
--
textBufferInsertRangeInteractive :: TextBufferClass self => self
 -> TextIter -- ^ @iter@ - a position in the buffer
 -> TextIter -- ^ @start@ - a position in a 'TextBuffer'
 -> TextIter -- ^ @end@ - another position in the same buffer as @start@
 -> Bool     -- ^ @defaultEditable@ - default editability of the buffer
 -> IO Bool  -- ^ returns whether an insertion was possible at @iter@
textBufferInsertRangeInteractive self iter start end defaultEditable =
  liftM toBool $
  {# call text_buffer_insert_range_interactive #}
    (toTextBuffer self)
    iter
    start
    end
    (fromBool defaultEditable)

-- | Deletes text between @start@ and @end@. The order of @start@ and @end@ is
-- not actually relevant; 'textBufferDelete' will reorder them. This function
-- actually emits the \"delete_range\" signal, and the default handler of that
-- signal deletes the text. Because the buffer is modified, all outstanding
-- iterators become invalid after calling this function; however, the @start@
-- and @end@ will be re-initialized to point to the location where text was
-- deleted.
--
textBufferDelete :: TextBufferClass self => self
 -> TextIter -- ^ @start@ - a position in @buffer@
 -> TextIter -- ^ @end@ - another position in @buffer@
 -> IO ()
textBufferDelete self start end =
  {# call text_buffer_delete #}
    (toTextBuffer self)
    start
    end

-- | Deletes all /editable/ text in the given range. Calls 'textBufferDelete'
-- for each editable sub-range of [@start@,@end@). @start@ and @end@ are
-- revalidated to point to the location of the last deleted range, or left
-- untouched if no text was deleted.
--
textBufferDeleteInteractive :: TextBufferClass self => self
 -> TextIter -- ^ @startIter@ - start of range to delete
 -> TextIter -- ^ @endIter@ - end of range
 -> Bool     -- ^ @defaultEditable@ - whether the buffer is editable by
             -- default
 -> IO Bool  -- ^ returns whether some text was actually deleted
textBufferDeleteInteractive self startIter endIter defaultEditable =
  liftM toBool $
  {# call text_buffer_delete_interactive #}
    (toTextBuffer self)
    startIter
    endIter
    (fromBool defaultEditable)

-- | Deletes current contents of @buffer@, and inserts @text@ instead.
--
textBufferSetText :: TextBufferClass self => self
 -> String -- ^ @text@ - text to insert
 -> IO ()
textBufferSetText self text =
  withUTFStringLen text $ \(textPtr, len) ->
  {# call text_buffer_set_text #}
    (toTextBuffer self)
    textPtr
    (fromIntegral len)

-- | Returns the text in the range [@start@,@end@). Excludes undisplayed text
-- (text marked with tags that set the invisibility attribute) if
-- @includeHiddenChars@ is @False@. Does not include characters representing
-- embedded images, so character indexes into the returned string do
-- /not/ correspond to character indexes into the buffer. Contrast
-- with 'textBufferGetSlice'.
--
textBufferGetText :: TextBufferClass self => self
 -> TextIter  -- ^ @start@ - start of a range
 -> TextIter  -- ^ @end@ - end of a range
 -> Bool      -- ^ @includeHiddenChars@ - whether to include invisible text
 -> IO String
textBufferGetText self start end includeHiddenChars =
  {# call unsafe text_buffer_get_text #}
    (toTextBuffer self)
    start
    end
    (fromBool includeHiddenChars)
  >>= readUTFString

-- | Returns the text in the range [@start@,@end@). Excludes undisplayed text
-- (text marked with tags that set the invisibility attribute) if
-- @includeHiddenChars@ is @False@. The returned string includes a
-- @(chr 0xFFFC)@ character whenever the buffer contains embedded images, so
-- character indexes into the returned string /do/ correspond to
-- character indexes into the buffer. Contrast with 'textBufferGetText'. Note
-- that @(chr 0xFFFC)@ can occur in normal text as well, so it is not a reliable
-- indicator that a pixbuf or widget is in the buffer.
--
textBufferGetSlice :: TextBufferClass self => self
 -> TextIter  -- ^ @start@ - start of a range
 -> TextIter  -- ^ @end@ - end of a range
 -> Bool      -- ^ @includeHiddenChars@ - whether to include invisible text
 -> IO String
textBufferGetSlice self start end includeHiddenChars =
  {# call unsafe text_buffer_get_slice #}
    (toTextBuffer self)
    start
    end
    (fromBool includeHiddenChars)
  >>= readUTFString

-- | Inserts an image into the text buffer at @iter@. The image will be
-- counted as one character in character counts, and when obtaining the buffer
-- contents as a string, will be represented by the Unicode \"object
-- replacement character\" @(chr 0xFFFC)@. Note that the \"slice\" variants for
-- obtaining portions of the buffer as a string include this character for
-- pixbufs, but the \"text\" variants do not. e.g. see 'textBufferGetSlice' and
-- 'textBufferGetText'.
--
textBufferInsertPixbuf :: TextBufferClass self => self
 -> TextIter -- ^ @iter@ - location to insert the pixbuf
 -> Pixbuf   -- ^ @pixbuf@ - a 'Pixbuf'
 -> IO ()
textBufferInsertPixbuf self iter pixbuf =
  {# call text_buffer_insert_pixbuf #}
    (toTextBuffer self)
    iter
    pixbuf

-- | Creates a mark at position @where@. If @markName@ is @Nothing@, the mark
-- is anonymous; otherwise, the mark can be retrieved by name using
-- 'textBufferGetMark'. If a mark has left gravity, and text is inserted at the
-- mark's current location, the mark will be moved to the left of the
-- newly-inserted text. If the mark has right gravity (@leftGravity@ =
-- @False@), the mark will end up on the right of newly-inserted text. The
-- standard left-to-right cursor is a mark with right gravity (when you type,
-- the cursor stays on the right side of the text you're typing).
--
-- Emits the \"mark_set\" signal as notification of the mark's initial
-- placement.
--
textBufferCreateMark :: TextBufferClass self => self
 -> Maybe MarkName -- ^ @markName@ - name for mark, or @Nothing@
 -> TextIter     -- ^ @where@ - location to place mark
 -> Bool         -- ^ @leftGravity@ - whether the mark has left gravity
 -> IO TextMark  -- ^ returns the new 'TextMark' object
textBufferCreateMark self markName where_ leftGravity =
  makeNewGObject mkTextMark $
  maybeWith withUTFString markName $ \markNamePtr ->
  {# call unsafe text_buffer_create_mark #}
    (toTextBuffer self)
    markNamePtr
    where_
    (fromBool leftGravity)

-- | Moves @mark@ to the new location @where@. Emits the \"mark_set\" signal
-- as notification of the move.
--
textBufferMoveMark :: (TextBufferClass self, TextMarkClass mark) => self
 -> mark     -- ^ @mark@ - a 'TextMark'
 -> TextIter -- ^ @where@ - new location for @mark@ in the buffer
 -> IO ()
textBufferMoveMark self mark where_ =
  {# call text_buffer_move_mark #}
    (toTextBuffer self)
    (toTextMark mark)
    where_

-- | Moves the mark named @name@ (which must exist) to location @where@. See
-- 'textBufferMoveMark' for details.
--
textBufferMoveMarkByName :: TextBufferClass self => self
 -> MarkName   -- ^ @name@ - name of a mark
 -> TextIter -- ^ @where@ - new location for mark
 -> IO ()
textBufferMoveMarkByName self name where_ =
  withUTFString name $ \namePtr ->
  {# call text_buffer_move_mark_by_name #}
    (toTextBuffer self)
    namePtr
    where_

-- | Deletes @mark@, so that it's no longer located anywhere in the buffer.
-- Most operations on @mark@ become invalid. There is no way to undelete a
-- mark. 'textMarkGetDeleted' will return @True@ after this function has been
-- called on a mark; 'textMarkGetDeleted' indicates that a mark no longer
-- belongs to a buffer. The \"mark_deleted\" signal will be emitted as
-- notification after the mark is deleted.
--
textBufferDeleteMark :: (TextBufferClass self, TextMarkClass mark) => self
 -> mark  -- ^ @mark@ - a 'TextMark' in the buffer
 -> IO ()
textBufferDeleteMark self mark =
  {# call text_buffer_delete_mark #}
    (toTextBuffer self)
    (toTextMark mark)

-- | Deletes the mark named @name@; the mark must exist. See
-- 'textBufferDeleteMark' for details.
--
textBufferDeleteMarkByName :: TextBufferClass self => self
 -> MarkName -- ^ @name@ - name of a mark in @buffer@
 -> IO ()
textBufferDeleteMarkByName self name =
  withUTFString name $ \namePtr ->
  {# call text_buffer_delete_mark_by_name #}
    (toTextBuffer self)
    namePtr

-- | Returns the mark named @name@ in the buffer, or @Nothing@ if no such
-- mark exists in the buffer.
--
textBufferGetMark :: TextBufferClass self => self
 -> MarkName            -- ^ @name@ - a mark name
 -> IO (Maybe TextMark) -- ^ returns a 'TextMark', or @Nothing@
textBufferGetMark self name =
  maybeNull (makeNewGObject mkTextMark) $
  withUTFString name $ \namePtr ->
  {# call unsafe text_buffer_get_mark #}
    (toTextBuffer self)
    namePtr

-- | Returns the mark that represents the cursor (insertion point). Equivalent
-- to calling @liftM fromJust $ textBufferGetMark \"insert\"@, but very
-- slightly more efficient, and involves less typing.
--
textBufferGetInsert :: TextBufferClass self => self -> IO TextMark
textBufferGetInsert self =
  makeNewGObject mkTextMark $
  {# call unsafe text_buffer_get_insert #}
    (toTextBuffer self)

-- | Returns the mark that represents the selection bound. Equivalent to
-- calling @liftM fromJust $ textBufferGetMark \"selection_bound\"@, but
-- very slightly more efficient, and involves less typing.
--
-- The currently-selected text in @buffer@ is the region between the
-- \"selection_bound\" and \"insert\" marks. If \"selection_bound\" and
-- \"insert\" are in the same place, then there is no current selection.
-- 'textBufferGetSelectionBounds' is another convenient function for handling
-- the selection, if you just want to know whether there's a selection and what
-- its bounds are.
--
textBufferGetSelectionBound :: TextBufferClass self => self -> IO TextMark
textBufferGetSelectionBound self =
  makeNewGObject mkTextMark $
  {# call unsafe text_buffer_get_selection_bound #}
    (toTextBuffer self)

-- | This function moves the \"insert\" and \"selection_bound\" marks
-- simultaneously. If you move them to the same place in two steps with
-- 'textBufferMoveMark', you will temporarily select a region in between their
-- old and new locations, which can be pretty inefficient since the
-- temporarily-selected region will force stuff to be recalculated. This
-- function moves them as a unit, which can be optimized.
--
textBufferPlaceCursor :: TextBufferClass self => self
 -> TextIter -- ^ @where@ - where to put the cursor
 -> IO ()
textBufferPlaceCursor self where_ =
  {# call text_buffer_place_cursor #}
    (toTextBuffer self)
    where_

-- | Emits the \"apply_tag\" signal on the buffer. The default handler for the
-- signal applies @tag@ to the given range. @start@ and @end@ do not have to be
-- in order.
--
textBufferApplyTag :: (TextBufferClass self, TextTagClass tag) => self
 -> tag      -- ^ @tag@ - a 'TextTag'
 -> TextIter -- ^ @start@ - one bound of range to be tagged
 -> TextIter -- ^ @end@ - other bound of range to be tagged
 -> IO ()
textBufferApplyTag self tag start end =
  {# call text_buffer_apply_tag #}
    (toTextBuffer self)
    (toTextTag tag)
    start
    end

-- | Emits the \"remove_tag\" signal. The default handler for the signal
-- removes all occurrences of @tag@ from the given range. @start@ and @end@
-- don't have to be in order.
--
textBufferRemoveTag :: (TextBufferClass self, TextTagClass tag) => self
 -> tag      -- ^ @tag@ - a 'TextTag'
 -> TextIter -- ^ @start@ - one bound of range to be untagged
 -> TextIter -- ^ @end@ - other bound of range to be untagged
 -> IO ()
textBufferRemoveTag self tag start end =
  {# call text_buffer_remove_tag #}
    (toTextBuffer self)
    (toTextTag tag)
    start
    end

-- | Calls 'textTagTableLookup' on the buffer's tag table to get a 'TextTag',
-- then calls 'textBufferApplyTag'.
--
textBufferApplyTagByName :: TextBufferClass self => self
 -> TagName  -- ^ @name@ - name of a named 'TextTag'
 -> TextIter -- ^ @start@ - one bound of range to be tagged
 -> TextIter -- ^ @end@ - other bound of range to be tagged
 -> IO ()
textBufferApplyTagByName self name start end =
  withUTFString name $ \namePtr ->
  {# call text_buffer_apply_tag_by_name #}
    (toTextBuffer self)
    namePtr
    start
    end

-- | Calls 'textTagTableLookup' on the buffer's tag table to get a 'TextTag',
-- then calls 'textBufferRemoveTag'.
--
textBufferRemoveTagByName :: TextBufferClass self => self
 -> TagName  -- ^ @name@ - name of a 'TextTag'
 -> TextIter -- ^ @start@ - one bound of range to be untagged
 -> TextIter -- ^ @end@ - other bound of range to be untagged
 -> IO ()
textBufferRemoveTagByName self name start end =
  withUTFString name $ \namePtr ->
  {# call text_buffer_remove_tag_by_name #}
    (toTextBuffer self)
    namePtr
    start
    end

-- | Removes all tags in the range between @start@ and @end@. Be careful with
-- this function; it could remove tags added in code unrelated to the code
-- you\'re currently writing. That is, using this function is probably a bad
-- idea if you have two or more unrelated code sections that add tags.
--
textBufferRemoveAllTags :: TextBufferClass self => self
 -> TextIter -- ^ @start@ - one bound of range to be untagged
 -> TextIter -- ^ @end@ - other bound of range to be untagged
 -> IO ()
textBufferRemoveAllTags self start end =
  {# call text_buffer_remove_all_tags #}
    (toTextBuffer self)
    start
    end

-- | Obtains an iterator pointing to @charOffset@ within the given line. The
-- @charOffset@ must exist, offsets off the end of the line are not allowed.
--
textBufferGetIterAtLineOffset :: TextBufferClass self => self
 -> Int      -- ^ @lineNumber@ - line number counting from 0
 -> Int      -- ^ @charOffset@ - char offset from start of line
 -> IO TextIter
textBufferGetIterAtLineOffset self lineNumber charOffset = do
  iter <- makeEmptyTextIter
  {# call unsafe text_buffer_get_iter_at_line_offset #}
    (toTextBuffer self)
    iter
    (fromIntegral lineNumber)
    (fromIntegral charOffset)
  return iter

-- | Creates an iterator pointing to a position @charOffset@ chars from the
-- start of the entire buffer. If @charOffset@ is -1 or greater than the number
-- of characters in the buffer, the end iterator is returned, that is the
-- iterator one past the last valid character in the buffer.
--
textBufferGetIterAtOffset :: TextBufferClass self => self
 -> Int      -- ^ @charOffset@ - char offset from start of buffer (counting
             -- from 0) or -1
 -> IO TextIter
textBufferGetIterAtOffset self charOffset = do
  iter <- makeEmptyTextIter
  {# call unsafe text_buffer_get_iter_at_offset #}
    (toTextBuffer self)
    iter
    (fromIntegral charOffset)
  return iter
  
-- | Create an iterator at a specific line.
--
textBufferGetIterAtLine :: TextBufferClass self =>
    Int      -- ^ @lineNumber@ - line number counting from 0
 -> self
 -> IO TextIter
textBufferGetIterAtLine lineNumber self = do
  iter <- makeEmptyTextIter
  {# call unsafe text_buffer_get_iter_at_line #}
    (toTextBuffer self)
    iter
    (fromIntegral lineNumber)
  return iter


-- | Create an iterator from a mark.
--
textBufferGetIterAtMark :: (TextBufferClass self, TextMarkClass mark) => self
 -> mark     -- ^ @mark@ - a 'TextMark' in the buffer
 -> IO TextIter
textBufferGetIterAtMark self mark = do
  iter <- makeEmptyTextIter
  {# call unsafe text_buffer_get_iter_at_mark #}
    (toTextBuffer self)
    iter
    (toTextMark mark)
  return iter


-- | Create an iterator at the first position in the text buffer. This is
-- the same as using 'textBufferGetIterAtOffset' to get the iter at character
-- offset 0.
--
textBufferGetStartIter :: TextBufferClass self => self -> IO TextIter
textBufferGetStartIter self = do
  iter <- makeEmptyTextIter
  {# call unsafe text_buffer_get_start_iter #}
    (toTextBuffer self)
    iter
  return iter

-- | Returns the \"end iterator,\" one past the last valid
-- character in the text buffer. If dereferenced with 'textIterGetChar', the
-- end iterator has a character value of 0. The entire buffer lies in the range
-- from the first position in the buffer (call 'textBufferGetStartIter' to get
-- character position 0) to the end iterator.
--
textBufferGetEndIter :: TextBufferClass self => self -> IO TextIter
textBufferGetEndIter self = do
  iter <- makeEmptyTextIter
  {# call unsafe text_buffer_get_end_iter #}
    (toTextBuffer self)
    iter
  return iter

-- | Indicates whether the buffer has been modified since the last call to
-- 'textBufferSetModified' set the modification flag to @False@. Used for
-- example to enable a \"save\" function in a text editor.
--
-- It is often more convenient to use 'onModifiedChanged'.
--
textBufferGetModified :: TextBufferClass self => self
 -> IO Bool -- ^ returns @True@ if the buffer has been modified
textBufferGetModified self =
  liftM toBool $
  {# call unsafe text_buffer_get_modified #}
    (toTextBuffer self)

-- | Used to keep track of whether the buffer has been modified since the last
-- time it was saved. Whenever the buffer is saved to disk, call
-- @'textBufferSetModified' buffer False@. When the buffer is
-- modified, it will automatically toggled on the modified bit again. When the
-- modified bit flips, the buffer emits a \"modified_changed\" signal.
--
textBufferSetModified :: TextBufferClass self => self -> Bool -> IO ()
textBufferSetModified self setting =
  {# call text_buffer_set_modified #}
    (toTextBuffer self)
    (fromBool setting)

-- | Deletes the range between the \"insert\" and \"selection_bound\" marks,
-- that is, the currently-selected text. If @interactive@ is @True@, the
-- editability of the selection will be considered (users can't delete
-- uneditable text).
--
textBufferDeleteSelection :: TextBufferClass self => self
 -> Bool    -- ^ @interactive@ - whether the deletion is caused by user
            -- interaction
 -> Bool    -- ^ @defaultEditable@ - whether the buffer is editable by default
 -> IO Bool -- ^ returns whether there was a non-empty selection to delete
textBufferDeleteSelection self interactive defaultEditable =
  liftM toBool $
  {# call text_buffer_delete_selection #}
    (toTextBuffer self)
    (fromBool interactive)
    (fromBool defaultEditable)

-- | Check if a selection exists.
--
textBufferHasSelection :: TextBufferClass self => self -> IO Bool
textBufferHasSelection self =
  liftM toBool $
  {# call unsafe text_buffer_get_selection_bounds #}
    (toTextBuffer self)
    (TextIter nullForeignPtr)
    (TextIter nullForeignPtr)

-- | Called to indicate that the buffer operations between here and a call to
-- 'textBufferEndUserAction' are part of a single user-visible operation. The
-- operations between 'textBufferBeginUserAction' and 'textBufferEndUserAction'
-- can then be grouped when creating an undo stack. 'TextBuffer' maintains a
-- count of calls to 'textBufferBeginUserAction' that have not been closed with
-- a call to 'textBufferEndUserAction', and emits the \"begin_user_action\" and
-- \"end_user_action\" signals only for the outermost pair of calls. This
-- allows you to build user actions from other user actions.
--
-- The \"interactive\" buffer mutation functions, such as
-- 'textBufferInsertInteractive', automatically call begin\/end user action
-- around the buffer operations they perform, so there's no need to add extra
-- calls if you user action consists solely of a single call to one of those
-- functions.
--
textBufferBeginUserAction :: TextBufferClass self => self -> IO ()
textBufferBeginUserAction self =
  {# call text_buffer_begin_user_action #}
    (toTextBuffer self)

-- | Should be paired with a call to 'textBufferBeginUserAction'. See that
-- function for a full explanation.
--
textBufferEndUserAction :: TextBufferClass self => self -> IO ()
textBufferEndUserAction self =
  {# call text_buffer_end_user_action #}
    (toTextBuffer self)

--------------------
-- Properties

-- | \'modified\' property. See 'textBufferGetModified' and
-- 'textBufferSetModified'
--
textBufferModified :: TextBufferClass self => Attr self Bool
textBufferModified = Attr 
  textBufferGetModified
  textBufferSetModified

--------------------
-- Signals

-- | A 'TextTag' was applied to a region of text.
--
onApplyTag, afterApplyTag :: TextBufferClass self => self
 -> (TextTag -> TextIter -> TextIter -> IO ())
 -> IO (ConnectId self)
onApplyTag = connect_OBJECT_BOXED_BOXED__NONE "apply-tag" 
  mkTextIter mkTextIter False
afterApplyTag = connect_OBJECT_BOXED_BOXED__NONE "apply-tag" 
  mkTextIter mkTextIter True

-- | A new atomic user action is started.
--
-- * Together with 'connectToEndUserAction' these signals can be
--   used to build an undo stack.
--
onBeginUserAction, afterBeginUserAction :: TextBufferClass self => self
 -> IO ()
 -> IO (ConnectId self)
onBeginUserAction = connect_NONE__NONE "begin_user_action" False
afterBeginUserAction = connect_NONE__NONE "begin_user_action" True

--- renamed from Changed to BufferChanged, since the former conflicts with TreeSelection
-- | Emitted when the contents of the buffer change.
--
onBufferChanged, afterBufferChanged :: TextBufferClass self => self
 -> IO ()
 -> IO (ConnectId self)
onBufferChanged = connect_NONE__NONE "changed" False
afterBufferChanged = connect_NONE__NONE "changed" True

-- | A range of text is about to be deleted.
--
onDeleteRange, afterDeleteRange :: TextBufferClass self => self
 -> (TextIter -> TextIter -> IO ())
 -> IO (ConnectId self)
onDeleteRange = connect_BOXED_BOXED__NONE "delete_range"
  mkTextIter mkTextIter False
afterDeleteRange = connect_BOXED_BOXED__NONE "delete_range"
  mkTextIter mkTextIter True

-- | An atomic action has ended.
--
-- * see 'connectToBeginUserAction'
--
onEndUserAction, afterEndUserAction :: TextBufferClass self => self
 -> IO ()
 -> IO (ConnectId self)
onEndUserAction = connect_NONE__NONE "end_user_action" False
afterEndUserAction = connect_NONE__NONE "end_user_action" True

-- | A widgets is inserted into the buffer.
--connectToInsertChildAnchor :: TextBufferClass self =>
-- (TextIter -> TextChildAnchor -> IO ()) -> ConnectAfter -> self -> 
--  IO (ConnectId self)
--connectToInsertChildAnchor = connect_BOXED_OBJECT__NONE "insert_child_anchor"
--  mkTextIter

-- | A 'Pixbuf' is inserted into the
-- buffer.
--
onInsertPixbuf, afterInsertPixbuf :: TextBufferClass self => self
 -> (TextIter -> Pixbuf -> IO ())
 -> IO (ConnectId self)
onInsertPixbuf = connect_BOXED_OBJECT__NONE "insert_pixbuf" mkTextIter False
afterInsertPixbuf = connect_BOXED_OBJECT__NONE "insert_pixbuf" mkTextIter True

-- | Some text was inserted.
--
onInsertText, afterInsertText :: TextBufferClass self => self
 -> (TextIter -> String -> IO ())
 -> IO (ConnectId self)
onInsertText self user = 
  connect_BOXED_PTR_INT__NONE "insert_text" mkTextIter False self $
    \iter strP strLen -> do
      str <- peekUTFStringLen (strP,strLen)
      user iter str 
afterInsertText self user = 
  connect_BOXED_PTR_INT__NONE "insert_text" mkTextIter True self $
    \iter strP strLen -> do
      str <- peekUTFStringLen (strP,strLen)
      user iter str 

-- | A 'TextMark' within the buffer was deleted.
--
onMarkDeleted, afterMarkDeleted :: TextBufferClass self => self
 -> (TextMark -> IO ())
 -> IO (ConnectId self)
onMarkDeleted = connect_OBJECT__NONE "mark_deleted" False
afterMarkDeleted = connect_OBJECT__NONE "mark_deleted" True

-- | A 'TextMark' was inserted into the buffer.
--
onMarkSet, afterMarkSet :: TextBufferClass self => self ->
                           (TextIter -> TextMark -> IO ()) ->
                           IO (ConnectId self)
onMarkSet = connect_BOXED_OBJECT__NONE "mark_set" mkTextIter False
afterMarkSet = connect_BOXED_OBJECT__NONE "mark_set" mkTextIter True

-- | The textbuffer has changed.
--
onModifiedChanged, afterModifiedChanged :: TextBufferClass self => self
 -> IO ()
 -> IO (ConnectId self)
onModifiedChanged = connect_NONE__NONE "modified_changed" False
afterModifiedChanged = connect_NONE__NONE "modified_changed" True

-- | A 'TextTag' was removed.
--
onRemoveTag, afterRemoveTag :: TextBufferClass self => self
 -> (TextTag -> TextIter -> TextIter -> IO ())
 -> IO (ConnectId self)
onRemoveTag = connect_OBJECT_BOXED_BOXED__NONE "remove_tag" 
  mkTextIter mkTextIter False
afterRemoveTag = connect_OBJECT_BOXED_BOXED__NONE "remove_tag" 
  mkTextIter mkTextIter True


--- NEW FILE: TextView.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget TextView
--
--  Author : Axel Simon
--
--  Created: 23 February 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/04/06 22:20:03 $
--
--  Copyright (C) 2002-2005 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library 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
[...1138 lines suppressed...]
 -> (Adjustment -> Adjustment -> IO ())
 -> IO (ConnectId self)
onSetScrollAdjustments = 
  connect_OBJECT_OBJECT__NONE "set_scroll_adjustments" False
afterSetScrollAdjustments = 
  connect_OBJECT_OBJECT__NONE "set_scroll_adjustments" True

-- | Insert\/Overwrite mode has changed.
--
-- * This signal is emitted when the 'TextView' changes from
--   inserting mode to overwriting mode and vice versa. 
--
-- * The action itself happens when the 'TextView' processes this
--   signal.
--
onToggleOverwrite, afterToggleOverwrite :: TextViewClass self => self
 -> IO ()
 -> IO (ConnectId self)
onToggleOverwrite = connect_NONE__NONE "toggle_overwrite" False
afterToggleOverwrite = connect_NONE__NONE "toggle_overwrite" True

--- TextBuffer.chs DELETED ---

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Abstract Widget.chs.pp,NONE,1.1 Widget.chs,1.7,NONE

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

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

Added Files:
	Widget.chs.pp 
Removed Files:
	Widget.chs 
Log Message:
Rename several modules to .pp (without changing module content) in preparation
for adding new functions from later Gtk+ versions.


--- NEW FILE: Widget.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Widget
--
--  Author : Axel Simon
--
--  Created: 27 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/04/06 22:20:02 $
--
--  Copyright (C) 2001-2005 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library 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
--  Lesser General Public License for more details.
--
-- TODO
--
-- unimplemented methods that seem to be useful in user programs:
--      widgetSizeRequest, widgetAddAccelerator, widgetRemoveAccelerator,
--	widgetAcceleratorSignal, widgetIntersect, widgetGrabDefault,
--	widgetGetPointer, widgetPath, widgetClassPath, getCompositeName,
--	widgetSetCompositeName,
--	widgetModifyStyle, widgetGetModifierStyle, widgetModifyFg,
--	widgetModifyBG, widgetModifyText, widgetModifyBase, widgetModifyFont,
--	widgetPango*, widgetSetAdjustments
--
-- implement the following methods in GtkWindow object:
--      widget_set_uposition, widget_set_usize
--
-- implement the following methods in GtkDrawingArea object:
--      widgetRegionIntersect
--
-- |
-- Maintainer  : gtk...@li...
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Base class for all widgets
--
module Graphics.UI.Gtk.Abstract.Widget (
-- * Description
-- 
-- | 'Widget' introduces style properties - these are basically object
-- properties that are stored not on the object, but in the style object
-- associated to the widget. Style properties are set in resource files. This
-- mechanism is used for configuring such things as the location of the
-- scrollbar arrows through the theme, giving theme authors more control over
-- the look of applications without the need to write a theme engine in C.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----Widget
-- |               +----'Misc'
-- |               +----'Container'
-- |               +----'Calendar'
-- |               +----'DrawingArea'
-- |               +----'Entry'
-- |               +----'Ruler'
-- |               +----'Range'
-- |               +----'Separator'
-- |               +----'Invisible'
-- |               +----'OldEditable'
-- |               +----'Preview'
-- |               +----'Progress'
-- @

-- * Types
  Widget,
  WidgetClass,
  castToWidget,
  Allocation,
  Requisition(..),
  Rectangle(..),

-- * Methods
  widgetGetState,
  widgetGetSavedState,
  widgetShow,			-- Showing and hiding a widget.
  widgetShowNow,
  widgetHide,
  widgetShowAll,
  widgetHideAll,
  widgetDestroy,
  widgetCreateLayout,		-- Drawing text.
  widgetQueueDraw,		-- Functions to be used with DrawingArea.
  widgetHasIntersection,
  widgetActivate,		-- Manipulate widget state.
  widgetSetSensitivity,
  widgetSetSizeRequest,
  widgetIsFocus,
  widgetGrabFocus,
  widgetSetAppPaintable,
  widgetSetName,		-- Naming, Themes
  widgetGetName,
  widgetGetToplevel,		-- Widget browsing.
  widgetIsAncestor,
  widgetReparent,
  TextDirection(..),
  widgetSetDirection,		-- General Setup.
  widgetGetDirection,
  widgetQueueDrawArea,
  widgetSetDoubleBuffered,
  widgetSetRedrawOnAllocate,

-- * Properties
  widgetExtensionEvents,
  widgetDirection,

-- * Signals
  Event(..),
  onButtonPress,
  afterButtonPress,
  onButtonRelease,
  afterButtonRelease,
  onClient,
  afterClient,
  onConfigure,
  afterConfigure,
  onDelete,
  afterDelete,
  onDestroyEvent,		-- you probably want onDestroy
  afterDestroyEvent,
  onDirectionChanged,
  afterDirectionChanged,
  onEnterNotify,
  afterEnterNotify,
  onLeaveNotify,
  afterLeaveNotify,
  onExpose,
  afterExpose,
  onFocusIn,
  afterFocusIn,
  onFocusOut,
  afterFocusOut,
  onGrabFocus,
  afterGrabFocus,
  onDestroy,
  afterDestroy,
  onHide,
  afterHide,
  onHierarchyChanged,
  afterHierarchyChanged,
  onKeyPress,
  afterKeyPress,
  onKeyRelease,
  afterKeyRelease,
  onMnemonicActivate,
  afterMnemonicActivate,
  onMotionNotify,
  afterMotionNotify,
  onParentSet,
  afterParentSet,
  onPopupMenu,
  afterPopupMenu,
  onProximityIn,
  afterProximityIn,
  onProximityOut,
  afterProximityOut,
  onRealize,
  afterRealize,
  onScroll,
  afterScroll,
  onShow,
  afterShow,
  onSizeAllocate,
  afterSizeAllocate,
  onSizeRequest,
  afterSizeRequest,
  StateType(..),
  onStateChanged,
  afterStateChanged,
  onUnmap,
  afterUnmap,
  onUnrealize,
  afterUnrealize,
  onVisibilityNotify,
  afterVisibilityNotify,
  onWindowState,
  afterWindowState
  ) where

import Monad	(liftM, unless)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes		(Attr(..))
import System.Glib.GObject		(makeNewGObject)
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.Gdk.Enums
import Graphics.UI.Gtk.General.Structs	(Allocation, Rectangle(..), Requisition(..),
					 widgetGetState, widgetGetSavedState)
import Graphics.UI.Gtk.Gdk.Events	(Event(..), marshalEvent)
import Graphics.UI.Gtk.General.Enums	(StateType(..), TextDirection(..))

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

--------------------
-- Methods

-- | Flags a widget to be displayed. Any widget that isn't shown will not
-- appear on the screen. If you want to show all the widgets in a container,
-- it's easier to call 'widgetShowAll' on the container, instead of
-- individually showing the widgets.
--
-- Remember that you have to show the containers containing a widget, in
-- addition to the widget itself, before it will appear onscreen.
--
-- When a toplevel container is shown, it is immediately realized and
-- mapped; other shown widgets are realized and mapped when their toplevel
-- container is realized and mapped.
--
widgetShow :: WidgetClass self => self -> IO ()
widgetShow self =
  {# call widget_show #}
    (toWidget self)

-- | Shows a widget. If the widget is an unmapped toplevel widget (i.e. a
-- 'Window' that has not yet been shown), enter the main loop and wait for the
-- window to actually be mapped. Be careful; because the main loop is running,
-- anything can happen during this function.
--
widgetShowNow :: WidgetClass self => self -> IO ()
widgetShowNow self =
  {# call widget_show_now #}
    (toWidget self)

-- | Reverses the effects of 'widgetShow', causing the widget to be hidden
-- (invisible to the user).
--
widgetHide :: WidgetClass self => self -> IO ()
widgetHide self =
  {# call widget_hide #}
    (toWidget self)

-- | Recursively shows a widget, and any child widgets (if the widget is a
-- container).
--
widgetShowAll :: WidgetClass self => self -> IO ()
widgetShowAll self =
  {# call widget_show_all #}
    (toWidget self)

-- | Recursively hides a widget and any child widgets.
--
widgetHideAll :: WidgetClass self => self -> IO ()
widgetHideAll self =
  {# call widget_hide_all #}
    (toWidget self)

-- | Destroys a widget. Equivalent to 'objectDestroy'.
--
-- When a widget is destroyed it will be removed from the screen and
-- unrealized. When a widget is destroyed, it will break any references it
-- holds to other objects.If the widget is inside a container, the widget will
-- be removed from the container. The widget will be garbage collected
-- (finalized) time after your last reference to the widget dissapears.
--
-- In most cases, only toplevel widgets (windows) require explicit
-- destruction, because when you destroy a toplevel its children will be
-- destroyed as well.
--
widgetDestroy :: WidgetClass self => self -> IO ()
widgetDestroy self =
  {# call widget_destroy #}
    (toWidget self)

-- Functions to be used with DrawingArea.

-- | Prepare text for display.
--
-- The 'PangoLayout' represents the rendered text. It can be shown on screen
-- by calling 'drawLayout'.
--
-- The returned 'Layout' shares the same font information ('Context') as this
-- widget. If this information changes, the 'Layout' should change. The
-- following code ensures that the displayed text always reflects the widget's
-- settings:
--
-- > l <- widgetCreateLayout w "My Text."
-- > let update = do
-- >                layoutContextChanged l
-- > 		    -- update the Drawables which show this layout
-- > w `onDirectionChanged` update
-- > w `onStyleChanged` update
--
widgetCreateLayout :: WidgetClass self => self
 -> String    -- ^ @text@ - text to set on the layout
 -> IO PangoLayout
widgetCreateLayout self text =
  makeNewGObject mkPangoLayout $
  withUTFString text $ \textPtr ->
  {# call unsafe widget_create_pango_layout #}
    (toWidget self)
    textPtr

-- | Send a redraw request to a widget. Equivalent to calling
-- 'widgetQueueDrawArea' for the entire area of a widget.
--
widgetQueueDraw :: WidgetClass self => self -> IO ()
widgetQueueDraw self =
  {# call widget_queue_draw #}
    (toWidget self)

-- | Check if the widget intersects with a given area.
--
widgetHasIntersection :: WidgetClass self => self
 -> Rectangle -- ^ @area@ - a rectangle
 -> IO Bool   -- ^ returns @True@ if there was an intersection
widgetHasIntersection self area = 
  liftM toBool $
  withObject area $ \areaPtr ->
  {# call unsafe widget_intersect #}
    (toWidget self)
    (castPtr areaPtr)
    (castPtr nullPtr)

-- Manipulate widget state.

-- | For widgets that can be \"activated\" (buttons, menu items, etc.) this
-- function activates them. Activation is what happens when you press Enter on
-- a widget during key navigation. If @widget@ isn't activatable, the function
-- returns @False@.
--
widgetActivate :: WidgetClass self => self
 -> IO Bool -- ^ returns @True@ if the widget was activatable
widgetActivate self =
  liftM toBool $
  {# call widget_activate #}
    (toWidget self)

-- | Sets the sensitivity of a widget. A widget is sensitive if the user can
-- interact with it. Insensitive widgets are \"grayed out\" and the user can't
-- interact with them. Insensitive widgets are known as \"inactive\",
-- \"disabled\", or \"ghosted\" in some other toolkits.
--
widgetSetSensitivity :: WidgetClass self => self
 -> Bool  -- ^ @sensitive@ - @True@ to make the widget sensitive
 -> IO ()
widgetSetSensitivity self sensitive =
  {# call widget_set_sensitive #}
    (toWidget self)
    (fromBool sensitive)

-- | Sets the minimum size of a widget; that is, the widget's size request
-- will be @width@ by @height@. You can use this function to force a widget to
-- be either larger or smaller than it normally would be.
--
-- In most cases, 'windowSetDefaultSize' is a better choice for toplevel
-- windows than this function; setting the default size will still allow users
-- to shrink the window. Setting the size request will force them to leave the
-- window at least as large as the size request. When dealing with window
-- sizes, 'windowSetGeometryHints' can be a useful function as well.
--
-- Note the inherent danger of setting any fixed size - themes, translations
-- into other languages, different fonts, and user action can all change the
-- appropriate size for a given widget. So, it's basically impossible to
-- hardcode a size that will always be correct.
--
-- The size request of a widget is the smallest size a widget can accept
-- while still functioning well and drawing itself correctly. However in some
-- strange cases a widget may be allocated less than its requested size, and in
-- many cases a widget may be allocated more space than it requested.
--
-- If the size request in a given direction is -1 (unset), then the
-- \"natural\" size request of the widget will be used instead.
--
-- Widgets can't actually be allocated a size less than 1 by 1, but you can
-- pass 0,0 to this function to mean \"as small as possible.\"
--
widgetSetSizeRequest :: WidgetClass self => self
 -> Int   -- ^ @width@ - width @widget@ should request, or -1 to unset
 -> Int   -- ^ @height@ - height @widget@ should request, or -1 to unset
 -> IO ()
widgetSetSizeRequest self width height =
  {# call widget_set_size_request #}
    (toWidget self)
    (fromIntegral width)
    (fromIntegral height)

-- | Determines if the widget is the focus widget within its toplevel.
--
widgetIsFocus :: WidgetClass self => self
 -> IO Bool -- ^ returns @True@ if the widget is the focus widget.
widgetIsFocus self =
  liftM toBool $
  {# call unsafe widget_is_focus #}
    (toWidget self)

-- | Causes the widget to have the keyboard focus for the 'Window' it's inside.
-- The widget must be a focusable widget, such as a 'Entry'; something like
-- 'Frame' won't work. (More precisely, it must have the 'CanFocus' flag set.)
--
widgetGrabFocus :: WidgetClass self => self -> IO ()
widgetGrabFocus self =
  {# call widget_grab_focus #}
    (toWidget self)

-- | Sets some weired flag in the widget.
--
widgetSetAppPaintable :: WidgetClass self => self
 -> Bool  -- ^ @appPaintable@ -
 -> IO ()
widgetSetAppPaintable self appPaintable =
  {# call widget_set_app_paintable #}
    (toWidget self)
    (fromBool appPaintable)

-- | Widgets can be named, which allows you to refer to them from a gtkrc
-- file. You can apply a style to widgets with a particular name in the gtkrc
-- file. See the documentation for gtkrc files.
--
-- Note that widget names are separated by periods in paths (see
-- 'widgetPath'), so names with embedded periods may cause confusion.
--
widgetSetName :: WidgetClass self => self
 -> String -- ^ @name@ - name for the widget
 -> IO ()
widgetSetName self name =
  withUTFString name $ \namePtr ->
  {# call widget_set_name #}
    (toWidget self)
    namePtr

-- | Retrieves the name of a widget. See 'widgetSetName' for the significance
-- of widget names.
--
widgetGetName :: WidgetClass self => self
 -> IO String
widgetGetName self =
  {# call unsafe widget_get_name #}
    (toWidget self)
  >>= peekUTFString

-- | Enable event signals.
--
widgetAddEvents :: WidgetClass self => self -> [EventMask] -> IO ()
widgetAddEvents self events =
  {# call widget_add_events #}
    (toWidget self)
    (fromIntegral $ fromFlags events)

-- | Get enabled event signals. These are the events that the widget will
-- receive.
--
widgetGetEvents :: WidgetClass self => self -> IO [EventMask]
widgetGetEvents self =
  liftM (toFlags . fromIntegral) $
  {# call unsafe widget_get_events #}
    (toWidget self)

-- | Sets the extension events.
--
widgetSetExtensionEvents :: WidgetClass self => self
 -> [ExtensionMode]
 -> IO ()
widgetSetExtensionEvents self mode =
  {# call widget_set_extension_events #}
    (toWidget self)
    ((fromIntegral . fromFlags) mode)

-- | Retrieves the extension events the widget will receive; see
-- 'inputSetExtensionEvents'.
--
widgetGetExtensionEvents :: WidgetClass self => self
 -> IO [ExtensionMode]
widgetGetExtensionEvents self =
  liftM (toFlags . fromIntegral) $
  {# call widget_get_extension_events #}
    (toWidget self)

-- Widget browsing.

-- | This function returns the topmost widget in the container hierarchy
-- @widget@ is a part of. If @widget@ has no parent widgets, it will be
-- returned as the topmost widget.
--
widgetGetToplevel :: WidgetClass self => 
    self      -- ^ @widget@ - the widget in question
 -> IO Widget -- ^ returns the topmost ancestor of @widget@, or @widget@
              -- itself if there's no ancestor.
widgetGetToplevel self =
  makeNewObject mkWidget $
  {# call unsafe widget_get_toplevel #}
    (toWidget self)

-- | Determines whether @widget@ is somewhere inside @ancestor@, possibly with
-- intermediate containers.
--
widgetIsAncestor :: (WidgetClass self, WidgetClass ancestor) =>
    self     -- ^ @widget@ - the widget in question
 -> ancestor -- ^ @ancestor@ - another 'Widget'
 -> IO Bool  -- ^ returns @True@ if @ancestor@ contains @widget@ as a child,
             -- grandchild, great grandchild, etc.
widgetIsAncestor self ancestor =
  liftM toBool $
  {# call unsafe widget_is_ancestor #}
    (toWidget self)
    (toWidget ancestor)

-- | Moves a widget from one 'Container' to another.
--
widgetReparent :: (WidgetClass self, WidgetClass newParent) => self
 -> newParent -- ^ @newParent@ - a 'Container' to move the widget into
 -> IO ()
widgetReparent self newParent =
  {# call widget_reparent #}
    (toWidget self)
    (toWidget newParent)

-- | Sets the reading direction on a particular widget. This direction
-- controls the primary direction for widgets containing text, and also the
-- direction in which the children of a container are packed. The ability to
-- set the direction is present in order so that correct localization into
-- languages with right-to-left reading directions can be done. Generally,
-- applications will let the default reading direction present, except for
-- containers where the containers are arranged in an order that is explicitely
-- visual rather than logical (such as buttons for text justification).
--
-- If the direction is set to 'TextDirNone', then the value set by
-- 'widgetSetDefaultDirection' will be used.
--
widgetSetDirection :: WidgetClass self => self
 -> TextDirection
 -> IO ()
widgetSetDirection self dir =
  {# call widget_set_direction #}
    (toWidget self)
    ((fromIntegral . fromEnum) dir)

-- | Gets the reading direction for a particular widget. See
-- 'widgetSetDirection'.
--
widgetGetDirection :: WidgetClass self => self
 -> IO TextDirection
widgetGetDirection self =
  liftM (toEnum . fromIntegral) $
  {# call widget_get_direction #}
    (toWidget self)

-- | Invalidates the rectangular area of @widget@ defined by @x@, @y@, @width@
-- and @height@ by calling 'windowInvalidateRect' on the widget's window and
-- all its child windows. Once the main loop becomes idle (after the current
-- batch of events has been processed, roughly), the window will receive expose
-- events for the union of all regions that have been invalidated.
--
-- Normally you would only use this function in widget implementations. You
-- might also use it, or 'windowInvalidateRect' directly, to schedule a redraw
-- of a 'DrawingArea' or some portion thereof.
--
-- Frequently you can just call 'windowInvalidateRect' or
-- 'windowInvalidateRegion' instead of this function. Those functions will
-- invalidate only a single window, instead of the widget and all its children.
--
-- The advantage of adding to the invalidated region compared to simply
-- drawing immediately is efficiency; using an invalid region ensures that you
-- only have to redraw one time.
--
widgetQueueDrawArea :: WidgetClass self => self
 -> Int   -- ^ @x@ - x coordinate of upper-left corner of rectangle to redraw
 -> Int   -- ^ @y@ - y coordinate of upper-left corner of rectangle to redraw
 -> Int   -- ^ @width@ - width of region to draw
 -> Int   -- ^ @height@ - height of region to draw
 -> IO ()
widgetQueueDrawArea self x y width height =
  {# call gtk_widget_queue_draw_area #}
    (toWidget self)
    (fromIntegral x)
    (fromIntegral y)
    (fromIntegral width)
    (fromIntegral height)

-- | Widgets are double buffered by default; you can use this function to turn
-- off the buffering. \"Double buffered\" simply means that
-- 'windowBeginPaintRegion' and 'windowEndPaint' are called automatically
-- around expose events sent to the widget. 'windowBeginPaint' diverts all
-- drawing to a widget's window to an offscreen buffer, and 'windowEndPaint'
-- draws the buffer to the screen. The result is that users see the window
-- update in one smooth step, and don't see individual graphics primitives
-- being rendered.
--
-- In very simple terms, double buffered widgets don't flicker, so you would
-- only use this function to turn off double buffering if you had special needs
-- and really knew what you were doing.
--
widgetSetDoubleBuffered :: WidgetClass self => self
 -> Bool  -- ^ @doubleBuffered@ - @True@ to double-buffer a widget
 -> IO ()
widgetSetDoubleBuffered self doubleBuffered =
  {# call gtk_widget_set_double_buffered #}
    (toWidget self)
    (fromBool doubleBuffered)

-- | Sets whether when a widgets size allocation changes, the entire widget
-- is queued for drawing. By default, this setting is @True@ and the entire
-- widget is redrawn on every size change. If your widget leaves the upper left
-- unchanged when made bigger, turning this setting on will improve
-- performance.
--
-- Note that for \"no window\" widgets setting this flag to @False@ turns off
-- all allocation on resizing: the widget will not even redraw if its position
-- changes; this is to allow containers that don't draw anything to avoid
-- excess invalidations. If you set this flag on a \"no window\" widget that
-- /does/ draw its window, you are responsible for invalidating both
-- the old and new allocation of the widget when the widget is moved and
-- responsible for invalidating regions newly when the widget increases size.
--
widgetSetRedrawOnAllocate :: WidgetClass self => self
 -> Bool  -- ^ @redrawOnAllocate@ - if @True@, the entire widget will be
          -- redrawn when it is allocated to a new size. Otherwise, only the
          -- new portion of the widget will be redrawn.
 -> IO ()
widgetSetRedrawOnAllocate self redrawOnAllocate =
  {# call gtk_widget_set_redraw_on_allocate #}
    (toWidget self)
    (fromBool redrawOnAllocate)

--------------------
-- Properties

-- | The mask that decides what kind of extension events this widget gets.
--
-- Default value: 'ExtensionEventsNone'
--
widgetExtensionEvents :: Attr Widget [ExtensionMode]
widgetExtensionEvents = Attr 
  widgetGetExtensionEvents
  widgetSetExtensionEvents

-- | \'direction\' property. See 'widgetGetDirection' and 'widgetSetDirection'
--
widgetDirection :: Attr Widget TextDirection
widgetDirection = Attr 
  widgetGetDirection
  widgetSetDirection

--------------------
-- Signals

-- Because there are so many similar signals (those that take an Event and
-- return a Bool) we will abstract out the skeleton. As some of these events
-- are emitted at a high rate often a bit has to be set to enable emission.
event :: WidgetClass w => SignalName -> [EventMask] ->
  ConnectAfter -> w -> (Event -> IO Bool) -> IO (ConnectId w)
event name eMask after obj fun = do
  id <- connect_BOXED__BOOL name marshalEvent after obj fun
  widgetAddEvents obj eMask
  return id

-- | A Button was pressed.
--
-- * This widget is part of a button which was just pressed. The event passed
--   to the user function is a 'Button' event.
--
onButtonPress, afterButtonPress :: WidgetClass w => w -> (Event -> IO Bool) ->
                                   IO (ConnectId w)
onButtonPress = event "button_press_event" [ButtonPressMask] False
afterButtonPress = event "button_press_event" [ButtonPressMask] True

-- | A Button was released.
--
onButtonRelease, afterButtonRelease :: WidgetClass w => w ->
                                       (Event -> IO Bool) -> IO (ConnectId w)
onButtonRelease = event "button_release_event" [ButtonReleaseMask] False
afterButtonRelease = event "button_release_event" [ButtonReleaseMask] True

-- | 
--
onClient, afterClient :: WidgetClass w => w -> (Event -> IO Bool) ->
                         IO (ConnectId w)
onClient = event "client_event" [] False
afterClient = event "client_event" [] True

-- | The widget's status has changed.
--
onConfigure, afterConfigure :: WidgetClass w => w -> (Event -> IO Bool) ->
                               IO (ConnectId w)
onConfigure = event "configure_event" []  False
afterConfigure = event "configure_event" []  True

-- | This signal is emitted when the close icon on the
-- surrounding window is pressed. The default action is to emit the
-- @\"destroy\"@ signal.
--
onDelete, afterDelete :: WidgetClass w => w -> (Event -> IO Bool) ->
                         IO (ConnectId w)
onDelete = event "delete_event" [] False
afterDelete = event "delete_event" [] True

-- | The widget will be destroyed.
--
-- * The widget received a destroy event from the window manager.
--
onDestroyEvent, afterDestroyEvent :: WidgetClass w => 
				     w -> (Event -> IO Bool) ->
				     IO (ConnectId w)
onDestroyEvent = event "destroy_event" [] False
afterDestroyEvent = event "destroy_event" [] True

-- | The default text direction was changed.
--
onDirectionChanged, afterDirectionChanged :: WidgetClass w => w ->
                                             (Event -> IO Bool) ->
                                             IO (ConnectId w)
onDirectionChanged = event "direction_changed" [] False
afterDirectionChanged = event "direction_changed" [] True

-- | Mouse cursor entered widget.
--
onEnterNotify, afterEnterNotify :: WidgetClass w => w -> (Event -> IO Bool) ->
                                   IO (ConnectId w)
onEnterNotify = event "enter_notify_event" [EnterNotifyMask] False
afterEnterNotify = event "enter_notify_event" [EnterNotifyMask] True

-- | Mouse cursor leaves widget.
--
onLeaveNotify, afterLeaveNotify :: WidgetClass w => w -> (Event -> IO Bool) ->
                                   IO (ConnectId w)
onLeaveNotify = event "leave_notify_event" [LeaveNotifyMask] False
afterLeaveNotify = event "leave_notify_event" [LeaveNotifyMask] True

-- | Instructs the widget to redraw.
--
onExpose, afterExpose :: WidgetClass w => w -> (Event -> IO Bool) ->
                         IO (ConnectId w)
onExpose = event "expose_event" [] False
afterExpose = event "expose_event" [] True

-- | Widget gains input focus.
--
onFocusIn, afterFocusIn :: WidgetClass w => w -> (Event -> IO Bool) ->
                           IO (ConnectId w)
onFocusIn = event "focus_in_event" [FocusChangeMask] False
afterFocusIn = event "focus_in_event" [FocusChangeMask] True

-- | Widget looses input focus.
--
onFocusOut, afterFocusOut :: WidgetClass w => w -> (Event -> IO Bool) ->
                             IO (ConnectId w)
onFocusOut = event "focus_out_event" [FocusChangeMask] False
afterFocusOut = event "focus_out_event" [FocusChangeMask] True

-- | The widget is about to receive all events.
--
-- * It is possible to redirect all input events to one widget to force the
--   user to use only this widget. Such a situation is initiated by
--   'addGrab'.
--
onGrabFocus, afterGrabFocus :: WidgetClass w => w -> IO () ->
                               IO (ConnectId w)
onGrabFocus = connect_NONE__NONE  "grab_focus" False
afterGrabFocus = connect_NONE__NONE "grab_focus" True

-- | The widget will be destroyed.
--
-- * This is the last signal this widget will receive.
--
onDestroy, afterDestroy :: WidgetClass w => w -> (IO ()) ->
                           IO (ConnectId w)
onDestroy = connect_NONE__NONE "destroy" False
afterDestroy = connect_NONE__NONE "destroy" True

-- | The widget was asked to hide itself.
--
-- * This signal is emitted each time 'widgetHide' is called. Use
--   'connectToUnmap' when your application needs to be informed
--   when the widget is actually removed from screen.
--
onHide, afterHide :: WidgetClass w => w -> IO () -> IO (ConnectId w)
onHide = connect_NONE__NONE "hide" False
afterHide = connect_NONE__NONE "hide" True

-- | The toplevel window changed.
--
-- * When a subtree of widgets is removed or added from a tree with a toplevel
--   window this signal is emitted. It is emitted on each widget in the
--   detached or attached subtree.
--
onHierarchyChanged, afterHierarchyChanged :: WidgetClass w => w -> IO () ->
                                             IO (ConnectId w)
onHierarchyChanged = connect_NONE__NONE "hierarchy_changed" False
afterHierarchyChanged = connect_NONE__NONE "hierarchy_changed" True

-- | A key was pressed.
--
onKeyPress, afterKeyPress :: WidgetClass w => w -> (Event -> IO Bool) ->
                             IO (ConnectId w)
onKeyPress = event "key_press_event" [KeyPressMask] False
afterKeyPress = event "key_press_event" [KeyPressMask] True

-- | A key was released.
--
onKeyRelease, afterKeyRelease :: WidgetClass w => w -> (Event -> IO Bool) ->
                                 IO (ConnectId w)
onKeyRelease = event "key_release_event" [KeyReleaseMask] False
afterKeyRelease = event "key_release_event" [KeyReleaseMask] True

-- | 
--
onMnemonicActivate, afterMnemonicActivate :: WidgetClass w => w ->
                                             (Bool -> IO Bool) ->
                                             IO (ConnectId w)
onMnemonicActivate = connect_BOOL__BOOL "mnemonic_activate" False
afterMnemonicActivate = connect_BOOL__BOOL "mnemonic_activate" True

-- | Track mouse movements.
--
-- * If @hint@ is False, a callback for every movement of the mouse is
--   generated. To avoid a backlog of mouse messages, it is usually sufficient
--   to sent @hint@ to True, generating only one event. The
--   application now has to state that it is ready for the next message by
--   calling 'drawWindowGetPointer'.
--
onMotionNotify, afterMotionNotify :: WidgetClass w => w -> Bool ->
                                     (Event -> IO Bool) -> 
                                     IO (ConnectId w)
onMotionNotify w hint = event "motion_notify_event" 
  (if hint then [PointerMotionHintMask] else [PointerMotionMask]) False w
afterMotionNotify w hint = event "motion_notify_event" 
  (if hint then [PointerMotionHintMask] else [PointerMotionMask]) True w

-- | 
--
onParentSet, afterParentSet :: (WidgetClass w, WidgetClass old) => w ->
                               (old -> IO ()) -> IO (ConnectId w)
onParentSet = connect_OBJECT__NONE "parent_set"  False
afterParentSet = connect_OBJECT__NONE "parent_set"  True

-- | 
--
onPopupMenu, afterPopupMenu :: WidgetClass w => w -> IO () -> IO (ConnectId w)
onPopupMenu = connect_NONE__NONE "popup_menu" False
afterPopupMenu = connect_NONE__NONE "popup_menu" True

-- | The input device became active.
--
-- * This event indicates that a pen of a graphics tablet or similar device is
--   now touching the tablet.
--
onProximityIn, afterProximityIn :: WidgetClass w => w -> (Event -> IO Bool) ->
                                   IO (ConnectId w)
onProximityIn = event "proximity_in_event" [ProximityInMask] False
afterProximityIn = event "proximity_in_event" [ProximityInMask] True

-- | The input device became inactive.
--
-- * The pen was removed from the graphics tablet's surface.
--
onProximityOut, afterProximityOut :: WidgetClass w => w ->
                                     (Event -> IO Bool) -> IO (ConnectId w)
onProximityOut = event "proximity_out_event" [ProximityOutMask] False
afterProximityOut = event "proximity_out_event" [ProximityOutMask] True

-- | This widget's drawing area is about to be
-- destroyed.
--
onRealize, afterRealize :: WidgetClass w => w -> IO () -> IO (ConnectId w)
onRealize = connect_NONE__NONE "realize" False
afterRealize = connect_NONE__NONE "realize" True

-- | The mouse wheel has turned.
--
-- * The 'Event' is always 'Scroll'.
--
onScroll, afterScroll :: WidgetClass w => w -> (Event -> IO Bool) ->
                         IO (ConnectId w)
onScroll = event "scroll_event" [ScrollMask] False
afterScroll = event "scroll_event" [ScrollMask] True

-- | The widget was asked to show itself.
--
-- * This signal is emitted each time 'widgetShow' is called. Use
--   'connectToMap' when your application needs to be informed when
--   the widget is actually shown.
--
onShow, afterShow :: WidgetClass w => w -> IO () -> IO (ConnectId w)
onShow = connect_NONE__NONE "show" False
afterShow = connect_NONE__NONE "show" True

-- | Inform widget about the size it has.
--
-- * After querying a widget for the size it wants to have (through emitting
--   the @\"sizeRequest\"@ signal) a container will emit this signal to
--   inform the widget about the real size it should occupy.
--
onSizeAllocate, afterSizeAllocate :: WidgetClass w => w ->
                                     (Allocation -> IO ()) -> IO (ConnectId w)
onSizeAllocate = connect_BOXED__NONE "size_allocate" peek False
afterSizeAllocate = connect_BOXED__NONE "size_allocate" peek True

-- | Query the widget for the size it likes to
-- have.
--
-- * A parent container emits this signal to its child to query the needed
--   height and width of the child. There is not guarantee that the widget
--   will actually get this area.
--
onSizeRequest, afterSizeRequest :: WidgetClass w => w -> (IO Requisition) ->
                                   IO (ConnectId w)
onSizeRequest w fun = connect_PTR__NONE "size_request" False w (\rqPtr -> do
  req <- fun
  unless (rqPtr==nullPtr) $ poke rqPtr req)
afterSizeRequest w fun = connect_PTR__NONE "size_request" True w (\rqPtr -> do
  req <- fun
  unless (rqPtr==nullPtr) $ poke rqPtr req) 

-- | 
--
onStateChanged, afterStateChanged :: WidgetClass w => w ->
                                     (StateType -> IO ()) -> IO (ConnectId w)
onStateChanged = connect_ENUM__NONE "state_changed" False
afterStateChanged = connect_ENUM__NONE "state_changed" True

-- | The widget was removed from screen.
--
onUnmap, afterUnmap :: WidgetClass w => w -> IO () -> IO (ConnectId w)
onUnmap = connect_NONE__NONE "unmap" False
afterUnmap = connect_NONE__NONE "unmap" True

-- | This widget's drawing area is about to be
-- destroyed.
--
onUnrealize, afterUnrealize :: WidgetClass w => w -> IO () -> IO (ConnectId w)
onUnrealize = connect_NONE__NONE "unrealize" False
afterUnrealize = connect_NONE__NONE "unrealize" True

-- | 
--
onVisibilityNotify, afterVisibilityNotify :: WidgetClass w => w ->
                                             (Event -> IO Bool) ->
                                             IO (ConnectId w)
onVisibilityNotify = 
  event "visibility_notify_event" [VisibilityNotifyMask] False
afterVisibilityNotify = 
  event "visibility_notify_event" [VisibilityNotifyMask] True

-- | 
--
onWindowState, afterWindowState :: WidgetClass w => w -> (Event -> IO Bool) ->
                                   IO (ConnectId w)
onWindowState = event "window_state_event" [] False
afterWindowState = event "window_state_event" [] True


--- Widget.chs DELETED ---

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar MenuShell.chs.pp,NONE,1.1 MenuShell.chs,1.4,NONE

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

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

Added Files:
	MenuShell.chs.pp 
Removed Files:
	MenuShell.chs 
Log Message:
Rename several modules to .pp (without changing module content) in preparation
for adding new functions from later Gtk+ versions.


--- MenuShell.chs DELETED ---

--- NEW FILE: MenuShell.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget MenuShell
--
--  Author : Axel Simon
--
--  Created: 21 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/04/06 22:20:02 $
--
--  Copyright (C) 1999-2005 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library 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
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk...@li...
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- A base class for menu objects
--
module Graphics.UI.Gtk.MenuComboToolbar.MenuShell (
-- * Detail
-- 
-- | A 'MenuShell' is the abstract base class used to derive the 'Menu' and
-- 'MenuBar' subclasses.
--
-- A 'MenuShell' is a container of 'MenuItem' objects arranged in a list
-- which can be navigated, selected, and activated by the user to perform
-- application functions. A 'MenuItem' can have a submenu associated with it,
-- allowing for nested hierarchical menus.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----'Container'
-- |                     +----MenuShell
-- |                           +----'MenuBar'
-- |                           +----'Menu'
-- @

-- * Types
  MenuShell,
  MenuShellClass,
  castToMenuShell,

-- * Methods
  menuShellAppend,
  menuShellPrepend,
  menuShellInsert,
  menuShellDeactivate,
  menuShellSelectItem,
  menuShellDeselect,

-- * Signals
  onActivateCurrent,
  afterActivateCurrent,
  onCancel,
  afterCancel,
  onDeactivated,
  afterDeactivated,
  MenuDirectionType(..),
  onMoveCurrent,
  afterMoveCurrent,
  onSelectionDone,
  afterSelectionDone
  ) where

import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums	(MenuDirectionType(..))

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

--------------------
-- Methods

-- | Adds a new 'MenuItem' to the end of the menu shell's item list.
--
menuShellAppend :: (MenuShellClass self, MenuItemClass child) => self
 -> child -- ^ @child@ - The 'MenuItem' to add.
 -> IO ()
menuShellAppend self child =
  {# call menu_shell_append #}
    (toMenuShell self)
    (toWidget child)

-- | Adds a new 'MenuItem' to the beginning of the menu shell's item list.
--
menuShellPrepend :: (MenuShellClass self, MenuItemClass child) => self
 -> child -- ^ @child@ - The 'MenuItem' to add.
 -> IO ()
menuShellPrepend self child =
  {# call menu_shell_prepend #}
    (toMenuShell self)
    (toWidget child)

-- | Adds a new 'MenuItem' to the menu shell's item list at the position
-- indicated by @position@.
--
menuShellInsert :: (MenuShellClass self, MenuItemClass child) => self
 -> child -- ^ @child@ - The 'MenuItem' to add.
 -> Int   -- ^ @position@ - The position in the item list where @child@ is
          -- added. Positions are numbered from 0 to n-1.
 -> IO ()
menuShellInsert self child position =
  {# call menu_shell_insert #}
    (toMenuShell self)
    (toWidget child)
    (fromIntegral position)

-- | Deactivates the menu shell. Typically this results in the menu shell
-- being erased from the screen.
--
menuShellDeactivate :: MenuShellClass self => self -> IO ()
menuShellDeactivate self =
  {# call menu_shell_deactivate #}
    (toMenuShell self)

-- | Activates the menu item within the menu shell. If the menu was deactivated
-- and @forceDeactivate@ is set, the previously deactivated menu is reactivated.
--
menuShellActivateItem :: (MenuShellClass self, MenuItemClass menuItem) => self
 -> menuItem -- ^ @menuItem@ - The 'MenuItem' to activate.
 -> Bool     -- ^ @forceDeactivate@ - If @True@, force the deactivation of the
             -- menu shell after the menu item is activated.
 -> IO ()
menuShellActivateItem self menuItem forceDeactivate =
  {# call menu_shell_activate_item #}
    (toMenuShell self)
    (toWidget menuItem)
    (fromBool forceDeactivate)

-- | Selects the menu item from the menu shell.
--
menuShellSelectItem :: (MenuShellClass self, MenuItemClass menuItem) => self
 -> menuItem -- ^ @menuItem@ - The 'MenuItem' to select.
 -> IO ()
menuShellSelectItem self menuItem =
  {# call menu_shell_select_item #}
    (toMenuShell self)
    (toWidget menuItem)

-- | Deselects the currently selected item from the menu shell, if any.
--
menuShellDeselect :: MenuShellClass self => self -> IO ()
menuShellDeselect self =
  {# call menu_shell_deselect #}
    (toMenuShell self)

--------------------
-- Signals

-- | This signal is called if an item is
-- activated. The boolean flag @hide@ is True whenever the menu will
-- behidden after this action.
--
onActivateCurrent, afterActivateCurrent :: MenuShellClass self => self
 -> (Bool -> IO ())
 -> IO (ConnectId self)
onActivateCurrent = connect_BOOL__NONE "activate-current" False
afterActivateCurrent = connect_BOOL__NONE "activate-current" True

-- | This signal will be emitted when a selection is
-- aborted and thus does not lead to an activation. This is in contrast to the
-- @selection@ done signal which is always emitted.
--
onCancel, afterCancel :: MenuShellClass self => self
 -> IO ()
 -> IO (ConnectId self)
onCancel = connect_NONE__NONE "cancel" False
afterCancel = connect_NONE__NONE "cancel" True

-- | This signal is sent whenever the menu shell
-- is deactivated (hidden).
--
onDeactivated, afterDeactivated :: MenuShellClass self => self
 -> IO ()
 -> IO (ConnectId self)
onDeactivated = connect_NONE__NONE "deactivate" False
afterDeactivated = connect_NONE__NONE "deactivate" True

-- | This signal is emitted for each move the
-- cursor makes.
--
onMoveCurrent, afterMoveCurrent :: MenuShellClass self => self
 -> (MenuDirectionType -> IO ())
 -> IO (ConnectId self)
onMoveCurrent = connect_ENUM__NONE "move-current" False
afterMoveCurrent = connect_ENUM__NONE "move-current" True

-- | This signal is emitted when the user
-- finished using the menu. Note that this signal is emitted even if no menu
-- item was activated.
--
onSelectionDone, afterSelectionDone :: MenuShellClass self => self
 -> IO ()
 -> IO (ConnectId self)
onSelectionDone = connect_NONE__NONE "selection-done" False
afterSelectionDone = connect_NONE__NONE "selection-done" True

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Display Label.chs.pp,NONE,1.1 Label.chs,1.7,NONE

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

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

Added Files:
	Label.chs.pp 
Removed Files:
	Label.chs 
Log Message:
Rename several modules to .pp (without changing module content) in preparation
for adding new functions from later Gtk+ versions.


--- Label.chs DELETED ---

--- NEW FILE: Label.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Label
--
--  Author : Manuel M. T. Chakravarty, Axel Simon
--
--  Created: 2 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/04/06 22:20:02 $
--
--  Copyright (C) 1999-2005 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library 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
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk...@li...
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- A widget that displays a small to medium amount of text
--
module Graphics.UI.Gtk.Display.Label (
-- * Detail
-- 
-- | The 'Label' widget displays a small amount of text. As the name implies,
-- most labels are used to label another widget such as a 'Button', a
-- 'MenuItem', or a 'OptionMenu'.

-- ** Mnemonics
-- 
-- | Labels may contain mnemonics. Mnemonics are underlined characters in the
-- label, used for keyboard navigation. Mnemonics are created by providing a
-- string with an underscore before the mnemonic character, such as
-- @\"_File\"@, to the functions 'labelNewWithMnemonic' or
-- 'labelSetTextWithMnemonic'.
--
-- Mnemonics automatically activate any activatable widget the label is
-- inside, such as a 'Button'; if the label is not inside the mnemonic's target
-- widget, you have to tell the label about the target using
-- 'labelSetMnemonicWidget'. Here's a simple example where the label is inside
-- a button: There's a convenience function to create buttons with a mnemonic
-- label already inside: To create a mnemonic for a widget alongside the label,
-- such as a 'Entry', you have to point the label at the entry with
-- 'labelSetMnemonicWidget':
-- 
-- >   -- Pressing Alt+H will activate this button
-- >   button <- buttonNew
-- >   label <- labelNewWithMnemonic "_Hello"
-- >   containerAdd button label
--
-- >   -- Pressing Alt+H will activate this button
-- >   button <- buttonNewWithMnemonic "_Hello"
--
-- >   -- Pressing Alt+H will focus the entry
-- >   entry <- entryNew
-- >   label <- labelNewWithMnemonic "_Hello"
-- >   labelSetMnemonicWidget label entry

-- ** Markup (styled text)
-- 
-- | To make it easy to format text in a label (changing colors, fonts, etc.),
-- label text can be provided in a simple markup format. Here's how to create a
-- label with a small font: (See complete documentation of available tags in
-- the Pango manual.)
--
-- >   label <- labelNew Nothing
-- >   labelSetMarkup label "<small>Small text</small>"
--
-- The markup passed to 'labelSetMarkup' must be valid; for example, literal
-- \<\/>\/& characters must be escaped as @\"&lt;\"@, @\"&gt;\"@, and
-- @\"&amp;@\". If you pass
-- text obtained from the user, file, or a network to 'labelSetMarkup', you\'ll
-- want to escape it with 'gMarkupEscapeText'.

-- ** Selectable labels
-- 
-- | Labels can be made selectable with 'labelSetSelectable'. Selectable
-- labels allow the user to copy the label contents to the clipboard. Only
-- labels that contain useful-to-copy information - such as error messages -
-- should be made selectable.

-- ** Text layout
-- 
-- | A label can contain any number of paragraphs, but will have performance
-- problems if it contains more than a small number. Paragraphs are separated
-- by newlines or other paragraph separators understood by Pango.
--
-- Labels can automatically wrap text if you call 'labelSetLineWrap'.
--
-- 'labelSetJustify' sets how the lines in a label align with one another.
-- If you want to set how the label as a whole aligns in its available space,
-- see 'miscSetAlignment'.
-- 

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----'Misc'
-- |                     +----Label
-- |                           +----'AccelLabel'
-- |                           +----'TipsQuery'
-- @

-- * Types
  Label,
  LabelClass,
  castToLabel,

-- * Constructors
  labelNew,
  labelNewWithMnemonic,

-- * Methods
  labelSetText,
  labelSetLabel,
  labelSetTextWithMnemonic,
  labelSetMarkup,
  labelSetMarkupWithMnemonic,
  labelSetMnemonicWidget,
  labelGetMnemonicWidget,
  KeyVal,
  labelGetMnemonicKeyval,
  labelSetUseMarkup,
  labelGetUseMarkup,
  labelSetUseUnderline,
  labelGetUseUnderline,
  labelGetText,
  labelGetLabel,
--  labelSetAttributes,
  labelSetPattern,
  Justification(..),
  labelSetJustify,
  labelGetJustify,
  labelGetLayout,
  labelSetLineWrap,
  labelGetLineWrap,
  labelSetSelectable,
  labelGetSelectable,
  labelSelectRegion,
  labelGetSelectionBounds,
  labelGetLayoutOffsets,

-- * Properties
  labelUseMarkup,
  labelUseUnderline,
  labelJustify,
  labelSelectable,
  labelLineWrap
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes		(Attr(..))
import System.Glib.GObject		(makeNewGObject)
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums	(Justification(..))
import Graphics.UI.Gtk.Pango.Markup

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

--------------------
-- Constructors

-- | Creates a new label with the given text inside it. You can pass @Nothing@
-- to get an empty label widget.
--
labelNew :: Maybe String -> IO Label
labelNew str =
  makeNewObject mkLabel $
  liftM (castPtr :: Ptr Widget -> Ptr Label) $
  maybeWith withUTFString str $ \strPtr ->
  {# call label_new #}
    strPtr

-- | Creates a new 'Label', containing the text in @str@.
--
-- If characters in @str@ 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. The mnemonic key can be used to
-- activate another widget, chosen automatically, or explicitly using
-- 'labelSetMnemonicWidget'.
--
-- If 'labelSetMnemonicWidget' is not called, then the first activatable
-- ancestor of the 'Label' will be chosen as the mnemonic widget. For instance,
-- if the label is inside a button or menu item, the button or menu item will
-- automatically become the mnemonic widget and be activated by the mnemonic.
--
labelNewWithMnemonic :: 
    String   -- ^ @str@ - The text of the label, with an underscore in front
             -- of the mnemonic character
 -> IO Label
labelNewWithMnemonic str =
  makeNewObject mkLabel $
  liftM (castPtr :: Ptr Widget -> Ptr Label) $
  withUTFString str $ \strPtr ->
  {# call label_new_with_mnemonic #}
    strPtr

--------------------
-- Methods

-- | Sets the text within the 'Label' widget. It overwrites any text that was
-- there before.
--
-- This will also clear any previously set mnemonic accelerators.
--
labelSetText :: LabelClass self => self -> String -> IO ()
labelSetText self str =
  withUTFString str $ \strPtr ->
  {# call label_set_text #}
    (toLabel self)
    strPtr

-- | Sets the text of the label. The label is interpreted as including
-- embedded underlines and\/or Pango markup depending on the markup and
-- underline properties.
--
labelSetLabel :: LabelClass self => self -> String -> IO ()
labelSetLabel self str =
  withUTFString str $ \strPtr ->
  {# call label_set_label #}
    (toLabel self)
    strPtr

{-
-- | Set the text attributes.
--
-- labelSetAttributes :: LabelClass l => PangoAttrList -> IO ()
-}

-- | Parses @str@ which is marked up with the Pango text markup language,
-- setting the label's text and attribute list based on the parse results. If
-- the @str@ is external data, you may need to escape it.
--
labelSetMarkup :: LabelClass self => self
 -> Markup -- ^ @str@ - a markup string (see Pango markup format)
 -> IO ()
labelSetMarkup self str =
  withUTFString str $ \strPtr ->
  {# call label_set_markup #}
    (toLabel self)
    strPtr

-- | Parses @str@ which is marked up with the Pango text markup language,
-- setting the label's text and attribute list based on the parse results. If
-- characters in @str@ are preceded by an underscore, they are underlined
-- indicating that they represent a keyboard accelerator called a mnemonic.
--
-- The mnemonic key can be used to activate another widget, chosen
-- automatically, or explicitly using 'labelSetMnemonicWidget'.
--
labelSetMarkupWithMnemonic :: LabelClass self => self
 -> Markup -- ^ @str@ - a markup string (see Pango markup format)
 -> IO ()
labelSetMarkupWithMnemonic self str =
  withUTFString str $ \strPtr ->
  {# call label_set_markup_with_mnemonic #}
    (toLabel self)
    strPtr

-- | Underline parts of the text, odd indices of the list represent underlined
-- parts.
--
labelSetPattern :: LabelClass l => l -> [Int] -> IO ()
labelSetPattern self list =
  withUTFString str $
  {# call label_set_pattern #}
    (toLabel self)
  where
    str = concat $ zipWith replicate list (cycle ['_',' '])

-- | Sets the alignment of the lines in the text of the label relative to each
-- other. 'JustifyLeft' is the default value when the widget is first created
-- with 'labelNew'. If you instead want to set the alignment of the label as a
-- whole, use 'miscSetAlignment' instead. 'labelSetJustify' has no effect on
-- labels containing only a single line.
--
labelSetJustify :: LabelClass self => self -> Justification -> IO ()
labelSetJustify self jtype =
  {# call label_set_justify #}
    (toLabel self)
    ((fromIntegral . fromEnum) jtype)

-- | Returns the justification of the label. See 'labelSetJustify'.
--
labelGetJustify :: LabelClass self => self -> IO Justification
labelGetJustify self =
  liftM (toEnum . fromIntegral) $
  {# call unsafe label_get_justify #}
    (toLabel self)

-- | Gets the 'Layout' used to display the label. The layout is useful to e.g.
-- convert text positions to pixel positions, in combination with
-- 'labelGetLayoutOffsets'.
--
labelGetLayout :: LabelClass self => self
 -> IO PangoLayout -- ^ returns the 'Layout' for this label
labelGetLayout self =
  makeNewGObject mkPangoLayout $
  {# call unsafe label_get_layout #}
    (toLabel self)

-- | Toggles line wrapping within the 'Label' widget. @True@ makes it break
-- lines if text exceeds the widget's size. @False@ lets the text get cut off
-- by the edge of the widget if it exceeds the widget size.
--
labelSetLineWrap :: LabelClass self => self
 -> Bool  -- ^ @wrap@ - the setting
 -> IO ()
labelSetLineWrap self wrap =
  {# call label_set_line_wrap #}
    (toLabel self)
    (fromBool wrap)

-- | Returns whether lines in the label are automatically wrapped. See
-- 'labelSetLineWrap'.
--
labelGetLineWrap :: LabelClass self => self
 -> IO Bool -- ^ returns @True@ if the lines of the label are automatically
            -- wrapped.
labelGetLineWrap self =
  liftM toBool $
  {# call unsafe label_get_line_wrap #}
    (toLabel self)

-- | Obtains the coordinates where the label will draw the 'Layout'
-- representing the text in the label; useful to convert mouse events into
-- coordinates inside the 'Layout', e.g. to take some action if some part of
-- the label is clicked. Of course you will need to create a 'EventBox' to
-- receive the events, and pack the label inside it, since labels are a
-- \'NoWindow\' widget.
--
labelGetLayoutOffsets :: LabelClass self => self -> IO (Int, Int)
labelGetLayoutOffsets self =
  alloca $ \xPtr ->
  alloca $ \yPtr -> do
  {# call unsafe label_get_layout_offsets #}
    (toLabel self)
    xPtr
    yPtr
  x <- peek xPtr
  y <- peek yPtr
  return (fromIntegral x, fromIntegral y)

-- | KeyVal is a synonym for a hot key number.
--
type KeyVal = {#type guint#}

-- | If the label has been set so that it has an mnemonic key this function
-- returns the keyval used for the mnemonic accelerator.
--
labelGetMnemonicKeyval :: LabelClass self => self -> IO KeyVal
labelGetMnemonicKeyval self =
  {# call unsafe label_get_mnemonic_keyval #}
    (toLabel self)

-- | Gets whether the text selectable.
--
labelGetSelectable :: LabelClass self => self
 -> IO Bool -- ^ returns @True@ if the user can copy text from the label
labelGetSelectable self =
  liftM toBool $
  {# call unsafe label_get_selectable #}
    (toLabel self)

-- | Sets whether the text of the label contains markup in Pango's text markup
-- language. See 'labelSetMarkup'.
--
labelSetUseMarkup :: LabelClass self => self
 -> Bool  -- ^ @setting@ - @True@ if the label's text should be parsed for
          -- markup.
 -> IO ()
labelSetUseMarkup self setting =
  {# call label_set_use_markup #}
    (toLabel self)
    (fromBool setting)

-- | Returns whether the label's text is interpreted as marked up with the
-- Pango text markup language. See 'labelSetUseMarkup'.
--
labelGetUseMarkup :: LabelClass self => self
 -> IO Bool -- ^ returns @True@ if the label's text will be parsed for markup.
labelGetUseMarkup self =
  liftM toBool $
  {# call unsafe label_get_use_markup #}
    (toLabel self)

-- | If @True@, an underline in the text indicates the next character should be
-- used for the mnemonic accelerator key.
--
labelSetUseUnderline :: LabelClass self => self -> Bool -> IO ()
labelSetUseUnderline self useUnderline =
  {# call label_set_use_underline #}
    (toLabel self)
    (fromBool useUnderline)

-- | Returns whether an embedded underline in the label indicates a mnemonic.
-- See 'labelSetUseUnderline'.
--
labelGetUseUnderline :: LabelClass self => self -> IO Bool
labelGetUseUnderline self =
  liftM toBool $
  {# call unsafe label_get_use_underline #}
    (toLabel self)

-- | Gets the text from a label widget, as displayed on the screen. This
-- does not include any embedded underlines indicating mnemonics or Pango
-- markup. (See 'labelGetLabel')
--
labelGetText :: LabelClass self => self -> IO String
labelGetText self =
  {# call unsafe label_get_text #}
    (toLabel self)
  >>= peekUTFString

-- | Gets the text from a label widget including any embedded underlines
-- indicating mnemonics and Pango markup. (See 'labelGetText').
--
labelGetLabel :: LabelClass self => self -> IO String
labelGetLabel self =
  {# call unsafe label_get_label #}
    (toLabel self)
  >>= peekUTFString

-- | Selects a range of characters in the label, if the label is selectable.
-- See 'labelSetSelectable'. If the label is not selectable, this function has
-- no effect. If @startOffset@ or @endOffset@ are -1, then the end of the label
-- will be substituted.
--
labelSelectRegion :: LabelClass self => self
 -> Int   -- ^ @startOffset@ - start offset
 -> Int   -- ^ @endOffset@ - end offset
 -> IO ()
labelSelectRegion self startOffset endOffset =
  {# call label_select_region #}
    (toLabel self)
    (fromIntegral startOffset)
    (fromIntegral endOffset)

-- | Gets the selected range of characters in the label, if any. If there is
-- a range selected the result is the start and end of the selection as
-- character offsets.
--
labelGetSelectionBounds :: LabelClass self => self
 -> IO (Maybe (Int, Int))
labelGetSelectionBounds self =
  alloca $ \startPtr ->
  alloca $ \endPtr -> do
  isSelection <-
    liftM toBool $
    {# call unsafe label_get_selection_bounds #}
    (toLabel self)
    startPtr
    endPtr
  if isSelection
    then do start <- peek startPtr
            end <- peek endPtr
	    return $ Just $ (fromIntegral start, fromIntegral end)
    else return Nothing

-- | If the label has been set so that it has an mnemonic key (using i.e.
-- 'labelSetMarkupWithMnemonic', 'labelSetTextWithMnemonic',
-- 'labelNewWithMnemonic' or the \"use_underline\" property) the label can be
-- associated with a widget that is the target of the mnemonic. When the label
-- is inside a widget (like a 'Button' or a 'Notebook' tab) it is automatically
-- associated with the correct widget, but sometimes (i.e. when the target is a
-- 'Entry' next to the label) you need to set it explicitly using this
-- function.
--
-- The target widget will be accelerated by emitting \"mnemonic_activate\"
-- on it. The default handler for this signal will activate the widget if there
-- are no mnemonic collisions and toggle focus between the colliding widgets
-- otherwise.
--
labelSetMnemonicWidget :: (LabelClass self, WidgetClass widget) => self
 -> widget -- ^ @widget@ - the target 'Widget'
 -> IO ()
labelSetMnemonicWidget self widget =
  {# call unsafe label_set_mnemonic_widget #}
    (toLabel self)
    (toWidget widget)

-- | Retrieves the target of the mnemonic (keyboard shortcut) of this label.
-- See 'labelSetMnemonicWidget'.
--
labelGetMnemonicWidget :: LabelClass self => self
 -> IO (Maybe Widget) -- ^ returns the target of the label's mnemonic, or
                      -- @Nothing@ if none has been set and the default
                      -- algorithm will be used.
labelGetMnemonicWidget self =
  maybeNull (makeNewObject mkWidget) $
  {# call unsafe label_get_mnemonic_widget #}
    (toLabel self)

-- | Selectable labels allow the user to select text from the label, for
-- copy-and-paste.
--
labelSetSelectable :: LabelClass self => self
 -> Bool  -- ^ @setting@ - @True@ to allow selecting text in the label
 -> IO ()
labelSetSelectable self setting =
  {# call unsafe label_set_selectable #}
    (toLabel self)
    (fromBool setting)

-- | Sets the label's text from the given string. If characters in the string are
-- preceded by an underscore, they are underlined indicating that they
-- represent a keyboard accelerator called a mnemonic. The mnemonic key can be
-- used to activate another widget, chosen automatically, or explicitly using
-- 'labelSetMnemonicWidget'.
--
labelSetTextWithMnemonic :: LabelClass self => self -> String -> IO ()
labelSetTextWithMnemonic self str =
  withUTFString str $ \strPtr ->
  {# call label_set_text_with_mnemonic #}
    (toLabel self)
    strPtr

--------------------
-- Properties

-- | The text of the label includes XML markup. See pango_parse_markup().
--
-- Default value: @False@
--
labelUseMarkup :: LabelClass self => Attr self Bool
labelUseMarkup = Attr 
  labelGetUseMarkup
  labelSetUseMarkup

-- | If set, an underline in the text indicates the next character should be
-- used for the mnemonic accelerator key.
--
-- Default value: @False@
--
labelUseUnderline :: LabelClass self => Attr self Bool
labelUseUnderline = Attr 
  labelGetUseUnderline
  labelSetUseUnderline

-- | The alignment of the lines in the text of the label relative to each
-- other. This does NOT affect the alignment of the label within its
-- allocation. See 'Misc'::xalign for that.
--
-- Default value: 'JustifyLeft'
--
labelJustify :: LabelClass self => Attr self Justification
labelJustify = Attr 
  labelGetJustify
  labelSetJustify

-- | Whether the label text can be selected with the mouse.
--
-- Default value: @False@
--
labelSelectable :: LabelClass self => Attr self Bool
labelSelectable = Attr 
  labelGetSelectable
  labelSetSelectable

-- | \'lineWrap\' property. See 'labelGetLineWrap' and 'labelSetLineWrap'
--
labelLineWrap :: LabelClass self => Attr self Bool
labelLineWrap = Attr 
  labelGetLineWrap
  labelSetLineWrap

[Gtk2hs-commit] gtk2hs ChangeLog,1.433,1.434

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

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

Modified Files:
	ChangeLog 
Log Message:
Rename several modules to .pp (without changing module content) in preparation
for adding new functions from later Gtk+ versions.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.433
retrieving revision 1.434
diff -u -d -r1.433 -r1.434
--- ChangeLog	6 Apr 2005 22:03:57 -0000	1.433
+++ ChangeLog	6 Apr 2005 22:20:01 -0000	1.434
@@ -84,6 +84,20 @@
 	* tools/apiGen/gtk.ignore: ignore more internal functions that we do
 	not want to bind.
 
+	* Makefile.am,
+	gtk/Graphics/UI/Gtk/Abstract/Widget.chs,
+	gtk/Graphics/UI/Gtk/Abstract/Widget.chs.pp,
+	gtk/Graphics/UI/Gtk/Display/Label.chs,
+	gtk/Graphics/UI/Gtk/Display/Label.chs.pp,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuShell.chs,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuShell.chs.pp,
+	gtk/Graphics/UI/Gtk/Multiline/TextBuffer.chs,
+	gtk/Graphics/UI/Gtk/Multiline/TextBuffer.chs.pp,
+	gtk/Graphics/UI/Gtk/Multiline/TextView.chs,
+	gtk/Graphics/UI/Gtk/Multiline/TextView.chs.pp: rename several modules
+	to .pp (without changing module content) in preparation for adding new
+	functions from later Gtk+ versions.
+
 2005-04-5 Duncan Coutts <du...@co...>
 
 	* glib/System/Glib/UTFString.hs: add some extra functions for

[Gtk2hs-commit] gtk2hs ChangeLog,1.432,1.433

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

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

Modified Files:
	ChangeLog 
Log Message:
More ApiGen updates:

ApiGen.hs, Template.chs: fix rcs tags.

CodeGen.hs: minor bug fixes.

FormatDocs.hs: rename a function. Allow us to fix when a module is available
	from since the mechanism we use to detect this does not always work.

Marshal.hs: rename a function. Add marshaling support for GdkColor and improve
	support for GtkTreePath.

MarshalFixup.hs: add fixup info for the version when a module is available
	from. Generalise stripKnownPrefixes to cTypeNameToHSType so we can
	deal with the naming of GdkWindow -> DrawWindow and PangoLayout remains
	PangoLayout rather than having the Pango prefix stripped off. Add many
	more cases to the other fixup tables.

gtk.ignore: ignore more internal functions that we do not want to bind.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.432
retrieving revision 1.433
diff -u -d -r1.432 -r1.433
--- ChangeLog	6 Apr 2005 21:36:48 -0000	1.432
+++ ChangeLog	6 Apr 2005 22:03:57 -0000	1.433
@@ -63,6 +63,27 @@
 	* tools/apicoverage/gtk.ignore: ignore the _utf8 variants that exist
 	for some functions.
 
+	* tools/apiGen/ApiGen.hs, tools/apiGen/Template.chs: fix rcs tags.
+
+	* tools/apiGen/CodeGen.hs: minor bug fixes.
+
+	* tools/apiGen/FormatDocs.hs: rename a function. Allow us to fix when
+	a module is available from since the mechanism we use to detect this
+	does not always work.
+
+	* tools/apiGen/Marshal.hs: rename a function. Add marshaling support
+	for GdkColor and improve support for GtkTreePath.
+
+	* tools/apiGen/MarshalFixup.hs: add fixup info for the version when a
+	module is available from. Generalise stripKnownPrefixes to
+	cTypeNameToHSType so we can deal with the naming of
+	GdkWindow -> DrawWindow and PangoLayout remains PangoLayout rather
+	than having the Pango prefix stripped off. Add many more cases to the
+	other fixup tables.
+
+	* tools/apiGen/gtk.ignore: ignore more internal functions that we do
+	not want to bind.
+
 2005-04-5 Duncan Coutts <du...@co...>
 
 	* glib/System/Glib/UTFString.hs: add some extra functions for

[Gtk2hs-commit] gtk2hs/tools/apiGen ApiGen.hs,1.22,1.23 Template.chs,1.10,1.11 CodeGen.hs,1.16,1.17 FormatDocs.hs,1.9,1.10 Marshal.hs,1.10,1.11 MarshalFixup.hs,1.5,1.6 gtk.ignore,1.2,1.3

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

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

Modified Files:
	ApiGen.hs Template.chs CodeGen.hs FormatDocs.hs Marshal.hs 
	MarshalFixup.hs gtk.ignore 
Log Message:
More ApiGen updates:

ApiGen.hs, Template.chs: fix rcs tags.

CodeGen.hs: minor bug fixes.

FormatDocs.hs: rename a function. Allow us to fix when a module is available
	from since the mechanism we use to detect this does not always work.

Marshal.hs: rename a function. Add marshaling support for GdkColor and improve
	support for GtkTreePath.

MarshalFixup.hs: add fixup info for the version when a module is available
	from. Generalise stripKnownPrefixes to cTypeNameToHSType so we can
	deal with the naming of GdkWindow -> DrawWindow and PangoLayout remains
	PangoLayout rather than having the Pango prefix stripped off. Add many
	more cases to the other fixup tables.

gtk.ignore: ignore more internal functions that we do not want to bind.


Index: Template.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Template.chs,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- Template.chs	1 Apr 2005 22:55:22 -0000	1.10
+++ Template.chs	6 Apr 2005 22:03:59 -0000	1.11
@@ -5,7 +5,7 @@
 --
 --  Created: @DATE@
 --
---  Version $Revision$ from $Date$
+--  Version @RCS_VERSION@ from @RCS_TIMESTAMP@
 --
 --  Copyright (C) @YEAR@ @COPYRIGHT@
 --

Index: Marshal.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Marshal.hs,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- Marshal.hs	31 Mar 2005 16:39:19 -0000	1.10
+++ Marshal.hs	6 Apr 2005 22:03:59 -0000	1.11
@@ -147,7 +147,7 @@
       \body -> body.
                indent 2. implementation)
   where typeName = init typeName'
-        shortTypeName = stripKnownPrefixes typeName
+        shortTypeName = cTypeNameToHSType typeName
         typeKind = lookupFM knownSymbols typeName
 
 -- Enums -------------------------------
@@ -157,7 +157,7 @@
 	(Nothing, InParam shortTypeName,
 	\body -> body.
                  indent 2. ss "((fromIntegral . fromEnum) ". ss name. ss ")")
-  where shortTypeName = stripKnownPrefixes typeName
+  where shortTypeName = cTypeNameToHSType typeName
         typeKind = lookupFM knownSymbols typeName
 
 -- Flags -------------------------------
@@ -167,7 +167,7 @@
 	(Nothing, InParam ("[" ++ shortTypeName ++ "]"),
 	\body -> body.
                  indent 2. ss "((fromIntegral . fromFlags) ". ss name. ss ")")
-  where shortTypeName = stripKnownPrefixes typeName
+  where shortTypeName = cTypeNameToHSType typeName
         typeKind = lookupFM knownSymbols typeName
 
 genMarshalParameter _ _ name textIter | textIter == "const-GtkTextIter*"
@@ -181,11 +181,22 @@
 	\body -> body.
                  indent 2. ss name)
 
-genMarshalParameter _ _ name "GtkTreePath*" =
-	(Nothing, InParam "TreePath",
-	\body -> ss "withTreePath ". ss name. ss " $ \\". ss name. ss " ->".
+genMarshalParameter _ funcName name "GtkTreePath*" =
+  if maybeNullParameter funcName name
+    then (Nothing, InParam "Maybe TreePath",
+	 \body -> ss "maybeWith withTreePath ". ss name. ss " $ \\". ss name. ss " ->".
+		  indent 1. body.
+                  indent 2. ss name)
+    else (Nothing, InParam "TreePath",
+	 \body -> ss "withTreePath ". ss name. ss " $ \\". ss name. ss " ->".
+		  indent 1. body.
+                  indent 2. ss name)
+
+genMarshalParameter _ _ name "const-GdkColor*" =
+	(Nothing, InParam "Color",
+	\body -> ss "with ". ss name. ss " $ \\". ss name. ss "Ptr ->".
 		 indent 1. body.
-                 indent 2. ss name)
+                 indent 2. ss name. ss "Ptr")
 
 -- Out parameters -------------------------------
 
@@ -216,6 +227,11 @@
 	\body -> body.
                  indent 2. ss name. ss "Ptr")
 
+genMarshalParameter _ _ name "GdkColor*" =
+	(Nothing, OutParam "Color",
+	\body -> body.
+                 indent 2. ss name. ss "Ptr")
+
 -- Catch all case -------------------------------
 genMarshalParameter _ _ name unknownType =
 	(Nothing, InParam $ "{-" ++ unknownType ++ "-}",
@@ -241,6 +257,9 @@
 genMarshalOutParameter "String"  name = (ss "alloca $ \\". ss name. ss "Ptr ->". indent 1
                                         ,indent 1. ss "peek ". ss name. ss "Ptr >>= readUTFString >>= \\". ss name. ss " ->"
                                         ,ss name)
+genMarshalOutParameter "Color"  name = (ss "alloca $ \\". ss name. ss "Ptr ->". indent 1
+                                        ,indent 1. ss "peek ". ss name. ss "Ptr >>= \\". ss name. ss " ->"
+                                        ,ss name)
 
 genMarshalOutParameter paramType name = (id, id, ss name)
 
@@ -309,7 +328,7 @@
          \body -> ss constructor. ss " mk". ss shortTypeName. ss " $". cast.
                   indent 1. body)
   where typeName = init typeName'
-        shortTypeName = stripKnownPrefixes typeName
+        shortTypeName = cTypeNameToHSType typeName
         typeKind = lookupFM knownSymbols typeName
         constructor | "GtkObject" `elem` sym_object_parents (fromJust typeKind)
                                 = "makeNewObject"
@@ -317,8 +336,8 @@
                                 = "makeNewGObject"
         cast | funcIsConstructor
             && constructorReturnType /= typeName = 
-            indent 1. ss "liftM (castPtr :: Ptr ". ss (stripKnownPrefixes constructorReturnType).
-                                    ss " -> Ptr ". ss (stripKnownPrefixes typeName). ss ") $"
+            indent 1. ss "liftM (castPtr :: Ptr ". ss (cTypeNameToHSType constructorReturnType).
+                                    ss " -> Ptr ". ss (cTypeNameToHSType typeName). ss ") $"
              | otherwise = id
           where constructorReturnType | "GtkWidget" `elem` sym_object_parents (fromJust typeKind)
                                                   = "GtkWidget"
@@ -330,7 +349,7 @@
   (shortTypeName,
   \body -> ss "liftM (toEnum . fromIntegral) $".
            indent 1. body)
-  where shortTypeName = stripKnownPrefixes typeName
+  where shortTypeName = cTypeNameToHSType typeName
         typeKind = lookupFM knownSymbols typeName
 
 genMarshalResult knownSymbols _ _ typeName
@@ -339,7 +358,7 @@
   ("[" ++ shortTypeName ++ "]",
   \body -> ss "liftM (toFlags . fromIntegral) $".
            indent 1. body)
-  where shortTypeName = stripKnownPrefixes typeName
+  where shortTypeName = cTypeNameToHSType typeName
         typeKind = lookupFM knownSymbols typeName
 
 genMarshalResult _ _ _ unknownType = ("{-" ++ unknownType ++ "-}", id)
@@ -358,21 +377,21 @@
             | isUpper (head typeName)
            && symbolIsObject typeKind =
   (shortTypeName, "GVobject")
-  where shortTypeName = stripKnownPrefixes typeName
+  where shortTypeName = cTypeNameToHSType typeName
         typeKind = lookupFM knownSymbols typeName
 
 genMarshalProperty knownSymbols typeName
             | isUpper (head typeName)
            && symbolIsEnum typeKind =
   (shortTypeName, "GVenum")
-  where shortTypeName = stripKnownPrefixes typeName
+  where shortTypeName = cTypeNameToHSType typeName
         typeKind = lookupFM knownSymbols typeName
 
 genMarshalProperty knownSymbols typeName
             | isUpper (head typeName)
            && symbolIsFlags typeKind =
   (shortTypeName, "GVflags")
-  where shortTypeName = stripKnownPrefixes typeName
+  where shortTypeName = cTypeNameToHSType typeName
         typeKind = lookupFM knownSymbols typeName
 
 genMarshalProperty _ unknown = ("{-" ++ unknown ++ "-}", "{-" ++ unknown ++ "-}")
@@ -395,14 +414,14 @@
 convertSignalType _ "gchar*"   = ("STRING", "String")
 convertSignalType _ "const-gchar*" = ("STRING", "String")
 convertSignalType knownSymbols typeName
-  | symbolIsEnum   typeKind    = ("ENUM",  stripKnownPrefixes typeName)
-  | symbolIsFlags  typeKind    = ("FLAGS", stripKnownPrefixes typeName)
+  | symbolIsEnum   typeKind    = ("ENUM",  cTypeNameToHSType typeName)
+  | symbolIsFlags  typeKind    = ("FLAGS", cTypeNameToHSType typeName)
   where typeKind = lookupFM knownSymbols typeName
 convertSignalType knownSymbols typeName@(_:_)
     | last typeName == '*'
-   && symbolIsBoxed  typeKind  = ("BOXED",  stripKnownPrefixes (init typeName))
+   && symbolIsBoxed  typeKind  = ("BOXED",  cTypeNameToHSType (init typeName))
     | last typeName == '*'
-   && symbolIsObject typeKind  = ("OBJECT", stripKnownPrefixes (init typeName))
+   && symbolIsObject typeKind  = ("OBJECT", cTypeNameToHSType (init typeName))
   where typeKind = lookupFM knownSymbols (init typeName)
 convertSignalType _ typeName   =  ("{-" ++ typeName ++ "-}", "{-" ++ typeName ++ "-}")
 

Index: CodeGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- CodeGen.hs	1 Apr 2005 22:55:22 -0000	1.16
+++ CodeGen.hs	6 Apr 2005 22:03:59 -0000	1.17
@@ -13,7 +13,7 @@
 import Marshal
 import StringUtils
 import ModuleScan
-import MarshalFixup (stripKnownPrefixes, maybeNullParameter, maybeNullResult,
+import MarshalFixup (cTypeNameToHSType, maybeNullParameter, maybeNullResult,
                      fixCFunctionName, leafClass, nukeParameterDocumentation)
 
 import Prelude hiding (Enum, lines)
@@ -94,8 +94,9 @@
                                 ,DocText " - "]
                          ) ++ paramdoc_paragraph paramdoc)
                       | paramdoc <- funcdoc_params doc
-		      , not (nukeParameterDocumentation (method_cname method)
-                                                        (paramdoc_name paramdoc))]
+		      , not $ nukeParameterDocumentation
+                                (method_cname method)
+                                (cParamNameToHsName (paramdoc_name paramdoc)) ]
         
         formatParamTypes :: [(String, Maybe [DocParaSpan])] -> ShowS
         formatParamTypes paramTypes = format True False paramTypes
@@ -207,8 +208,8 @@
                   | (doc,index) <- zip docs [1..] ]
         infomap = [ (methodinfo_cname info, (info,index))
                   | (info,index) <- zip methodsInfo [1..] ]
-        endDocIndex = length docs
-        endInfoIndex = length methodsInfo
+        endDocIndex = length docs + 1
+        endInfoIndex = length methodsInfo + 1
 
 mungeMethod :: Object -> Method -> Method
 mungeMethod object method =
@@ -243,7 +244,7 @@
   where docmap  = [ (funcdoc_name doc, deleteReturnDoc doc) | doc <- docs ]
         infomap = [ (methodinfo_cname info, (info,index))
                   | (info,index) <- zip methodsInfo [1..] ]
-        endInfoIndex = length methodsInfo          
+        endInfoIndex = length methodsInfo + 1
         -- 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
@@ -422,7 +423,7 @@
   | implement <- object_implements object ] 
 
 genImplement object implements =
-  ss "instance ".ss (stripKnownPrefixes implements). ss "Class ". ss (object_name object)
+  ss "instance ".ss (cTypeNameToHSType implements). ss "Class ". ss (object_name object)
 
 canonicalSignalName :: String -> String
 canonicalSignalName = map dashToUnderscore

Index: FormatDocs.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/FormatDocs.hs,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- FormatDocs.hs	1 Mar 2005 21:20:45 -0000	1.9
+++ FormatDocs.hs	6 Apr 2005 22:03:59 -0000	1.10
@@ -23,7 +23,8 @@
 import Api (NameSpace(..), Object(..), Method(..))
 import Docs
 import Marshal (KnownSymbols, CSymbol(..))
-import MarshalFixup (stripKnownPrefixes, knownMiscType, fixCFunctionName)
+import MarshalFixup (cTypeNameToHSType, knownMiscType, fixCFunctionName
+                    ,fixModuleAvailableSince)
 import StringUtils
 
 import Maybe (isJust)
@@ -68,7 +69,7 @@
 
 haddocTweakHierarchy :: String -> String
 haddocTweakHierarchy ('+':'-':'-':'-':'-':cs@(c:_)) | c /= ''' =
-  case span isAlpha cs of (word, rest) -> "+----" ++ stripKnownPrefixes word ++ rest
+  case span isAlpha cs of (word, rest) -> "+----" ++ cTypeNameToHSType word ++ rest
 haddocTweakHierarchy (c:cs) = c : haddocTweakHierarchy cs
 haddocTweakHierarchy [] = []
 
@@ -85,7 +86,8 @@
           [ if funcdoc_since funcdoc > baseVersion
               then funcdoc {
                      funcdoc_paragraphs = funcdoc_paragraphs funcdoc ++
-                       let line = "Available since " ++ namespace_name namespace
+                       let line = "Available since " ++ (let name = namespace_name namespace
+                                                          in if name == "Gtk" then "Gtk+" else name)
                               ++ " version " ++ funcdoc_since funcdoc
                         in [DocParaListItem [DocText line]]
                    }
@@ -116,10 +118,12 @@
         -- figure out if the whole module appeared in some version of gtk later 
         -- than the original version
         moduleVersion :: String
-        moduleVersion = case [ funcdoc_since funcdoc
-                             | funcdoc <- moduledoc_functions apiDoc ] of
-                          [] -> ""
-                          versions -> minimum versions
+        moduleVersion | null fixed = case [ funcdoc_since funcdoc
+                                          | funcdoc <- moduledoc_functions apiDoc ] of
+                                       [] -> ""
+                                       versions -> minimum versions
+                      | otherwise = fixed
+          where fixed = fixModuleAvailableSince (moduledoc_name apiDoc)
 
         moduleDeprecatedParagraph =
           if maybe False object_deprecated object
@@ -183,12 +187,12 @@
     Nothing | text == "TRUE"  -> "@True@"
             | text == "FALSE"          -> "@False@"
             | otherwise                -> "{" ++ text ++ ", FIXME: unknown type/value}"
-    Just (SymObjectType _)             -> "'" ++ stripKnownPrefixes text ++ "'"
-    Just (SymEnumType _)               -> "'" ++ stripKnownPrefixes text ++ "'"
+    Just (SymObjectType _)             -> "'" ++ cTypeNameToHSType text ++ "'"
+    Just (SymEnumType _)               -> "'" ++ cTypeNameToHSType text ++ "'"
     Just SymEnumValue                  -> "'" ++ cConstNameToHsName text ++ "'"
     Just SymStructType                 -> "{" ++ text ++ ", FIXME: struct type}"
     Just SymBoxedType                  -> if knownMiscType text
-                                            then "'" ++ stripKnownPrefixes text ++ "'"
+                                            then "'" ++ cTypeNameToHSType text ++ "'"
                                             else "{" ++ text ++ ", FIXME: boxed type}"
     Just SymClassType                  -> "{" ++ text ++ ", FIXME: class type}"
     Just SymTypeAlias                  -> "{" ++ text ++ ", FIXME: type alias}"
@@ -207,14 +211,14 @@
   case lookupFM knownSymbols text of
     Nothing                            -> "@" ++ escapeHaddockSpecialChars text ++ "@"
     Just SymEnumValue                  -> "'" ++ cConstNameToHsName text ++ "'"
-    Just (SymObjectType _)             -> "'" ++ stripKnownPrefixes text ++ "'"
+    Just (SymObjectType _)             -> "'" ++ cTypeNameToHSType text ++ "'"
     _ -> "{" ++ text ++ ", FIXME: unknown literal value}" --TODO fill in the other cases
 haddocFormatSpan _ _ (DocArg  text)       = "@" ++ cParamNameToHsName text ++ "@"
 
 cFuncNameToHsName :: String -> String
 cFuncNameToHsName =
     lowerCaseFirstChar
-  . stripKnownPrefixes
+  . cTypeNameToHSType
   . toStudlyCapsWithFixups
   . takeWhile ('('/=)
 
@@ -225,7 +229,7 @@
 
 cConstNameToHsName :: String -> String
 cConstNameToHsName  =          --change "GTK_UPDATE_DISCONTINUOUS" to "UpdateDiscontinuous"
-    stripKnownPrefixes
+    cTypeNameToHSType
   . toStudlyCaps
   . map toLower
 
@@ -243,8 +247,8 @@
   . splitBy '_'
 
 changeIllegalNames :: String -> String
-changeIllegalNames "type" = "type_"  --this is a common variable name in C but of
-                                     --course a keyword in Haskell
+changeIllegalNames "type" = "type_"   --these are common variable names in C but
+changeIllegalNames "where" = "where_" --of course are keywords in Haskell
 changeIllegalNames other = other
 
 escapeHaddockSpecialChars = escape
@@ -269,12 +273,12 @@
                                          ++ "be converted to a Maybe data type}" ++ remainder
                  | word' == "G_MAXINT"   = "@('maxBound' :: Int)@" ++ remainder
                  | isJust e = case e of
-                                Just (SymObjectType _) -> "'" ++ stripKnownPrefixes word' ++ "'" ++ remainder
-                                Just (SymEnumType _)   -> "'" ++ stripKnownPrefixes word' ++ "'" ++ remainder
+                                Just (SymObjectType _) -> "'" ++ cTypeNameToHSType word' ++ "'" ++ remainder
+                                Just (SymEnumType _)   -> "'" ++ cTypeNameToHSType word' ++ "'" ++ remainder
                                 Just SymEnumValue      -> "'" ++ cConstNameToHsName word' ++ "'" ++ remainder
                                 Just SymStructType     -> "{" ++ word' ++ ", FIXME: struct type}"
                                 Just SymBoxedType      -> if knownMiscType word'
-                                                            then "'" ++ stripKnownPrefixes word' ++ "'"
+                                                            then "'" ++ cTypeNameToHSType word' ++ "'"
                                                             else "{" ++ word' ++ ", FIXME: boxed type}"
                                 Just SymClassType      -> "{" ++ word' ++ ", FIXME: class type}"
                                 Just SymTypeAlias      -> "{" ++ word' ++ ", FIXME: type alias}"

Index: ApiGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- ApiGen.hs	1 Apr 2005 22:55:22 -0000	1.22
+++ ApiGen.hs	6 Apr 2005 22:03:58 -0000	1.23
@@ -166,8 +166,8 @@
 	    "OBJECT_KIND"    -> ss $ if object_isinterface object then "Interface" else "Widget"
 	    "OBJECT_NAME"    -> ss $ module_name moduleInfo
 	    "AUTHORS"        -> ss $ concat $ intersperse ", " $ module_authors moduleInfo
-	    "RCS_VERSION"    -> ss $ module_rcs_version moduleInfo
-	    "RCS_TIMESTAMP"  -> ss $ module_rcs_timestamp moduleInfo
+	    "RCS_VERSION"    -> ss "$Revision$"
+	    "RCS_TIMESTAMP"  -> ss "$Date$"
             "COPYRIGHT"      -> ss $ concat $ intersperse ", " $ module_copyright_holders moduleInfo
             "DESCRIPTION"    -> haddocFormatParas knownTypes False (moduledoc_summary moduleDoc)
 	    "DOCUMENTATION"  -> genModuleDocumentation knownTypes moduleDoc

Index: gtk.ignore
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gtk.ignore,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- gtk.ignore	27 Mar 2005 12:59:06 -0000	1.2
+++ gtk.ignore	6 Apr 2005 22:03:59 -0000	1.3
@@ -31,3 +31,14 @@
 exclude gtk_widget_hide_on_delete
 exclude gtk_widget_destroyed
 
+#these function is mostly intended for use by accessibility technologies
+exclude gtk_combo_box_get_popup_accessible
+
+#internal or unnecessary GtkAaccelLabel methods
+exclude gtk_accel_label_get_accel_width
+exclude gtk_accel_label_refetch
+exclude gtk_accel_label_set_accel_closure
+
+#internal FileFilter methods
+exclude gtk_file_filter_get_needed
+exclude gtk_file_filter_filter

Index: MarshalFixup.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/MarshalFixup.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- MarshalFixup.hs	1 Apr 2005 22:55:22 -0000	1.5
+++ MarshalFixup.hs	6 Apr 2005 22:03:59 -0000	1.6
@@ -5,13 +5,15 @@
 
 module MarshalFixup where
 
-stripKnownPrefixes :: String -> String
-stripKnownPrefixes ('A':'t':'k':remainder) = remainder
-stripKnownPrefixes ('G':'t':'k':remainder) = remainder
-stripKnownPrefixes ('G':'d':'k':remainder) = remainder
-stripKnownPrefixes ('P':'a':'n':'g':'o':remainder) = remainder
-stripKnownPrefixes ('G':'n':'o':'m':'e':remainder) = remainder
-stripKnownPrefixes other = other
+cTypeNameToHSType :: String -> String
+cTypeNameToHSType ('A':'t':'k':remainder) = remainder
+cTypeNameToHSType ('G':'t':'k':remainder) = remainder
+cTypeNameToHSType "GdkWindow" = "DrawWindow"
+cTypeNameToHSType ('G':'d':'k':remainder) = remainder
+cTypeNameToHSType "PangoLayout" = "PangoLayout"
+cTypeNameToHSType ('P':'a':'n':'g':'o':remainder) = remainder
+cTypeNameToHSType ('G':'n':'o':'m':'e':remainder) = remainder
+cTypeNameToHSType other = other
 
 -- some special cases for when converting "gtk_foo_bar" to "GtkFooBar"
 -- eg instead of doing gtk_hadjustment -> GtkHadjustment
@@ -34,8 +36,20 @@
 fixCFunctionName "vseparator" = "VSeparator"
 fixCFunctionName "hscrollbar" = "HScrollbar"
 fixCFunctionName "vscrollbar" = "VScrollbar"
+fixCFunctionName "uri" = "URI"
+fixCFunctionName "uris" = "URIs"
 fixCFunctionName other = other
 
+-- In some cases the way we work out the minimum version of the module doesn't
+-- work (since the docs sometimes miss marking the version of some functions)
+-- So to fix it just specify here the version of the library from which the
+-- module is available.
+fixModuleAvailableSince "GtkComboBox" = "2.4"
+fixModuleAvailableSince "GtkFileChooser" = "2.4"
+fixModuleAvailableSince "GtkCellView" = "2.6"
+fixModuleAvailableSince "GtkIconView" = "2.6"
+fixModuleAvailableSince _ = ""
+
 -- These are ones we have bound and so we can make documentation references to
 -- them. Otherwise we generate FIXME messages in the docs.
 knownMiscType :: String -> Bool
@@ -58,11 +72,16 @@
 leafClass "GtkImage"      = True
 leafClass "GtkIconFactory"  = True
 leafClass "GtkEntryCompletion" = True
-leafClass "GtkFileFilter" = True
+leafClass "GtkFileFilter"   = True
 leafClass "GtkUIManager"    = True
 leafClass "GtkRadioButton"  = True
 leafClass "GtkEventBox"     = True
 leafClass "GtkExpander"     = True
+leafClass "GtkAccelGroup"   = True
+leafClass "GdkScreen"       = True
+leafClass "GtkTooltips"     = True
+leafClass "GtkTextChildAnchor" = True
+leafClass "GdkWindow"       = True
 leafClass _ = False
 
 -- This is a table of fixup information. It lists function parameters that
@@ -76,13 +95,27 @@
 -- out which function doc NULLs correspond to which parameters).
 --
 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_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 "gtk_layout_new" _				= True
+maybeNullParameter "gtk_notebook_set_menu_label" "menuLabel"	= True
+maybeNullParameter "gtk_scrolled_window_new" "hadjustment"	= True
+maybeNullParameter "gtk_scrolled_window_new" "vadjustment"	= True
+maybeNullParameter "gtk_combo_box_set_model" "model"		= True
+maybeNullParameter "gtk_menu_set_screen" "screen"		= True
+maybeNullParameter "gtk_menu_item_set_accel_path" "accelPath"	= True
+maybeNullParameter "gtk_toolbar_set_drop_highlight_item" "toolItem"	= True
+maybeNullParameter "gtk_text_buffer_new" "table"		= True
+maybeNullParameter "gtk_text_buffer_create_mark" "markName"	= True
+maybeNullParameter "gtk_cell_view_set_displayed_row" "path"	= True
+maybeNullParameter "gtk_about_dialog_set_logo_icon_name" "iconName"	= True
+maybeNullParameter "gtk_widget_modify_fg" "color"		= True
+maybeNullParameter "gtk_widget_modify_bg" "color"		= True
+maybeNullParameter "gtk_widget_modify_text" "color"		= True
+maybeNullParameter "gtk_widget_modify_base" "color"		= True
 maybeNullParameter _ _ = False
 
 -- similarly for method return values/types.
@@ -102,60 +135,251 @@
 maybeNullResult "gtk_notebook_get_nth_page" = True
 maybeNullResult "gtk_notebook_get_tab_label" = True
 maybeNullResult "gtk_notebook_get_tab_label_text" = True
+maybeNullResult "gtk_combo_box_get_model" = True
+maybeNullResult "gtk_image_menu_item_get_image" = True
+maybeNullResult "gtk_menu_get_title" = True
+maybeNullResult "gtk_menu_item_get_submenu" = True
+maybeNullResult "gtk_tool_item_retrieve_proxy_menu_item" = True
+maybeNullResult "gtk_tool_item_get_proxy_menu_item" = True
+maybeNullResult "gtk_toolbar_get_nth_item" = True
+maybeNullResult "gtk_file_chooser_get_filename" = True
+maybeNullResult "gtk_file_chooser_get_current_folder" = True
+maybeNullResult "gtk_file_chooser_get_uri" = True
+maybeNullResult "gtk_file_chooser_get_preview_widget" = True
+maybeNullResult "gtk_file_chooser_get_preview_filename" = True
+maybeNullResult "gtk_file_chooser_get_preview_uri" = True
+maybeNullResult "gtk_file_chooser_get_extra_widget" = True
+maybeNullResult "gtk_file_chooser_get_filter" = True
+maybeNullResult "gtk_font_selection_get_font_name" = True
+maybeNullResult "gtk_font_selection_dialog_get_font_name" = True
+maybeNullResult "gtk_text_mark_get_name" = True
+maybeNullResult "gtk_text_mark_get_buffer" = True
+maybeNullResult "gtk_text_tag_table_lookup" = True
+maybeNullResult "gtk_text_buffer_get_mark" = True
+maybeNullResult "gtk_text_view_get_window" = True
+maybeNullResult "gtk_icon_view_get_path_at_pos" = True
+maybeNullResult "gtk_combo_box_get_active_text" = True
+maybeNullResult "gtk_scale_get_layout" = True
+maybeNullResult "gtk_button_get_image" = True
+maybeNullResult "gtk_image_get_animation" = True
+maybeNullResult "gtk_window_get_transient_for" = True
+maybeNullResult "gtk_window_get_role" = True
+maybeNullResult "gtk_window_get_title" = True
+maybeNullResult "gtk_widget_render_icon" = True
+maybeNullResult "gtk_widget_get_composite_name" = True
 maybeNullResult _ = False
 
 -- Often the documentation for parameters or the return value of functions
 -- that is included in the gtk-doc docs are just pointless. So this table
 -- lists the function and parameter names for which we do not want to use the
 -- gtk-doc documentation.
-nukeParameterDocumentation :: String -> String -> Bool
-nukeParameterDocumentation "gtk_button_box_get_layout" "Returns"	= True
-nukeParameterDocumentation "gtk_button_set_label" "label"		= True
-nukeParameterDocumentation "gtk_button_get_label" "Returns" 		= True
-nukeParameterDocumentation "gtk_toggle_button_get_active" "Returns"	= True
-nukeParameterDocumentation "gtk_image_new_from_file" "filename"		= True
-nukeParameterDocumentation "gtk_image_new_from_pixbuf" "pixbuf"		= True
-nukeParameterDocumentation "gtk_label_new" "str"			= True
-nukeParameterDocumentation "gtk_label_set_text" "str"			= True
-nukeParameterDocumentation "gtk_label_set_label" "str"			= True
-nukeParameterDocumentation "gtk_label_set_justify" "jtype"		= True
-nukeParameterDocumentation "gtk_label_get_justify" "Returns"		= True
-nukeParameterDocumentation "gtk_label_set_use_underline" "setting"	= True
-nukeParameterDocumentation "gtk_label_get_use_underline" "Returns"	= True
-nukeParameterDocumentation "gtk_label_get_text" "Returns"		= True
-nukeParameterDocumentation "gtk_label_get_label" "Returns"		= True
-nukeParameterDocumentation "gtk_label_set_text_with_mnemonic" "str"	= True
-nukeParameterDocumentation "gtk_progress_bar_set_text" "text"		= True
-nukeParameterDocumentation "gtk_progress_bar_get_orientation" "Returns"	= True
-nukeParameterDocumentation "gtk_progress_bar_set_orientation" "orientation"	= True
-nukeParameterDocumentation "gtk_statusbar_set_has_resize_grip" "setting"	= True
-nukeParameterDocumentation "gtk_statusbar_get_has_resize_grip" "Returns"	= True	
-nukeParameterDocumentation "gtk_editable_get_editable" "Returns"	= True
-nukeParameterDocumentation "gtk_entry_set_text" "text"			= True
-nukeParameterDocumentation "gtk_entry_get_text" "Returns"		= True
-nukeParameterDocumentation "gtk_entry_append_text" "text"		= True
-nukeParameterDocumentation "gtk_entry_prepend_text" "text"		= True
-nukeParameterDocumentation "gtk_entry_set_invisible_char" "ch"		= True
-nukeParameterDocumentation "gtk_entry_set_has_frame" "setting"		= True
-nukeParameterDocumentation "gtk_entry_set_completion" "completion"	= True
-nukeParameterDocumentation "spin_button_get_value" "Returns"		= True
-nukeParameterDocumentation "spin_button_get_value_as_int" "Returns"	= True
-nukeParameterDocumentation "spin_button_set_value" "value"		= True
-nukeParameterDocumentation "gtk_expander_new" "label"			= True
-nukeParameterDocumentation "gtk_expander_set_expanded" "expanded"	= True
-nukeParameterDocumentation "gtk_expander_get_expanded" "Returns"	= True
-nukeParameterDocumentation "gtk_expander_set_spacing" "spacing"		= True
-nukeParameterDocumentation "gtk_expander_set_label" "label"		= True
-nukeParameterDocumentation "gtk_expander_get_label" "Returns"		= True
-nukeParameterDocumentation "gtk_expander_get_use_markup" "Returns"	= True
-nukeParameterDocumentation "gtk_fixed_set_has_window" "hasWindow"	= True
-nukeParameterDocumentation "gtk_fixed_get_has_window" "Returns"		= True
-nukeParameterDocumentation "gtk_notebook_get_n_pages" "Returns"		= True
-nukeParameterDocumentation "gtk_adjustment_set_value" "value"		= True
-nukeParameterDocumentation "gtk_adjustment_get_value" "Returns"		= True
-nukeParameterDocumentation "gtk_arrow_new" "arrowType"			= True
-nukeParameterDocumentation "gtk_arrow_new" "shadowType"			= True
-nukeParameterDocumentation _ _ = False
+nukeParamDoc :: String -> String -> Bool
+nukeParamDoc "gtk_button_box_get_layout" "returns"		= True
+nukeParamDoc "gtk_button_set_label" "label"			= True
+nukeParamDoc "gtk_button_get_label" "returns" 			= True
+nukeParamDoc "gtk_toggle_button_get_active" "returns"		= True
+nukeParamDoc "gtk_image_new_from_file" "filename"		= True
+nukeParamDoc "gtk_image_new_from_pixbuf" "pixbuf"		= True
+nukeParamDoc "gtk_label_new" "str"				= True
+nukeParamDoc "gtk_label_set_text" "str"				= True
+nukeParamDoc "gtk_label_set_label" "str"			= True
+nukeParamDoc "gtk_label_set_justify" "jtype"			= True
+nukeParamDoc "gtk_label_get_justify" "returns"			= True
+nukeParamDoc "gtk_label_set_use_underline" "setting"		= True
+nukeParamDoc "gtk_label_get_use_underline" "returns"		= True
+nukeParamDoc "gtk_label_get_layout" "returns"			= True
+nukeParamDoc "gtk_label_get_text" "returns"			= True
+nukeParamDoc "gtk_label_get_label" "returns"			= True
+nukeParamDoc "gtk_label_set_text_with_mnemonic" "str"		= True
+nukeParamDoc "gtk_progress_bar_set_text" "text"			= True
+nukeParamDoc "gtk_progress_bar_get_orientation" "returns"	= True
+nukeParamDoc "gtk_progress_bar_set_orientation" "orientation"	= True
+nukeParamDoc "gtk_statusbar_set_has_resize_grip" "setting"	= True
+nukeParamDoc "gtk_statusbar_get_has_resize_grip" "returns"	= True	
+nukeParamDoc "gtk_editable_get_editable" "returns"		= True
+nukeParamDoc "gtk_entry_set_text" "text"			= True
+nukeParamDoc "gtk_entry_get_text" "returns"			= True
+nukeParamDoc "gtk_entry_append_text" "text"			= True
+nukeParamDoc "gtk_entry_prepend_text" "text"			= True
+nukeParamDoc "gtk_entry_set_invisible_char" "ch"		= True
+nukeParamDoc "gtk_entry_set_has_frame" "setting"		= True
+nukeParamDoc "gtk_entry_set_completion" "completion"		= True
+nukeParamDoc "gtk_spin_button_get_value" "returns"		= True
+nukeParamDoc "gtk_spin_button_get_value_as_int" "returns"	= True
+nukeParamDoc "gtk_spin_button_set_value" "value"		= True
+nukeParamDoc "gtk_expander_new" "label"				= True
+nukeParamDoc "gtk_expander_set_expanded" "expanded"		= True
+nukeParamDoc "gtk_expander_get_expanded" "returns"		= True
+nukeParamDoc "gtk_expander_set_spacing" "spacing"		= True
+nukeParamDoc "gtk_expander_set_label" "label"			= True
+nukeParamDoc "gtk_expander_get_label" "returns"			= True
+nukeParamDoc "gtk_expander_get_use_markup" "returns"		= True
+nukeParamDoc "gtk_fixed_set_has_window" "hasWindow"		= True
+nukeParamDoc "gtk_fixed_get_has_window" "returns"		= True
+nukeParamDoc "gtk_notebook_get_n_pages" "returns"		= True
+nukeParamDoc "gtk_adjustment_set_value" "value"			= True
+nukeParamDoc "gtk_adjustment_get_value" "returns"		= True
+nukeParamDoc "gtk_arrow_new" "arrowType"			= True
+nukeParamDoc "gtk_arrow_new" "shadowType"			= True
+nukeParamDoc "gtk_arrow_set" "arrowType"			= True
+nukeParamDoc "gtk_arrow_set" "shadowType"			= True
+nukeParamDoc "gtk_calendar_set_display_options" "flags"		= True
+nukeParamDoc "gtk_calendar_display_options" "flags"		= True
+nukeParamDoc "gtk_calendar_get_display_options" "returns"	= True
+nukeParamDoc "gtk_event_box_set_visible_window" "visibleWindow"	= True
+nukeParamDoc "gtk_event_box_get_visible_window" "returns"	= True
+nukeParamDoc "gtk_event_box_set_above_child" "aboveChild"	= True
+nukeParamDoc "gtk_event_box_get_above_child" "returns"		= True
+nukeParamDoc "gtk_handle_box_set_shadow_type" "type"		= True
+nukeParamDoc "gtk_viewport_get_hadjustment" "returns"		= True
+nukeParamDoc "gtk_viewport_get_vadjustment" "returns"		= True
+nukeParamDoc "gtk_viewport_set_hadjustment" "adjustment"	= True
+nukeParamDoc "gtk_viewport_set_vadjustment" "adjustment"	= True
+nukeParamDoc "gtk_frame_set_label_widget" "labelWidget"		= True
+nukeParamDoc "gtk_frame_set_shadow_type" "type"			= True
+nukeParamDoc "gtk_frame_get_shadow_type" "returns"		= True
+nukeParamDoc "gtk_scrolled_window_get_hadjustment" "returns"	= True
+nukeParamDoc "gtk_scrolled_window_get_vadjustment" "returns"	= True
+nukeParamDoc "gtk_scrolled_window_get_placement" "returns"	= True
+nukeParamDoc "gtk_scrolled_window_set_shadow_type" "type"	= True
+nukeParamDoc "gtk_scrolled_window_get_shadow_type" "returns"	= True
+nukeParamDoc "gtk_scrolled_window_set_hadjustment" "hadjustment"= True
+nukeParamDoc "gtk_scrolled_window_set_vadjustment" "hadjustment"= True
+nukeParamDoc "gtk_window_set_title" "title"			= True
+nukeParamDoc "gtk_window_set_resizable" "resizable"		= True
+nukeParamDoc "gtk_window_set_position" "position"		= True
+nukeParamDoc "gtk_window_set_destroy_with_parent" "setting"	= True
+nukeParamDoc "gtk_window_set_decorated" "setting"		= True
+nukeParamDoc "gtk_color_selection_is_adjusting" "returns"	= True
+nukeParamDoc "gtk_check_menu_item_set_active" "isActive"	= True
+nukeParamDoc "gtk_check_menu_item_get_active" "returns"		= True
+nukeParamDoc "gtk_check_menu_item_set_inconsistent" "setting"	= True
+nukeParamDoc "gtk_check_menu_item_get_inconsistent" "returns"	= True
+nukeParamDoc "gtk_check_menu_item_set_draw_as_radio" "drawAsRadio"	= True
+nukeParamDoc "gtk_check_menu_item_get_draw_as_radio" "returns"	= True
+nukeParamDoc "gtk_combo_set_use_arrows" "val"			= True
+nukeParamDoc "gtk_combo_set_use_arrows_always" "val"		= True
+nukeParamDoc "gtk_combo_set_case_sensitive" "val"		= True
+nukeParamDoc "gtk_combo_box_set_wrap_width" "width"		= True
+nukeParamDoc "gtk_combo_box_set_row_span_column" "rowSpan"	= True
+nukeParamDoc "gtk_combo_box_set_column_span_column" "columnSpan"= True
+nukeParamDoc "gtk_combo_box_set_model" "model"			= True
+nukeParamDoc "gtk_combo_box_append_text" "text"			= True
+nukeParamDoc "gtk_combo_box_prepend_text" "text"		= True
+nukeParamDoc "gtk_menu_set_title" "title"			= True
+nukeParamDoc "gtk_menu_item_set_submenu" "submenu"		= True
+nukeParamDoc "gtk_menu_item_get_right_justified" "returns"	= True
+nukeParamDoc "gtk_option_menu_get_menu" "returns"		= True
+nukeParamDoc "gtk_option_menu_set_menu" "menu"			= True
+nukeParamDoc "gtk_tool_item_get_homogeneous" "returns"		= True
+nukeParamDoc "gtk_tool_item_set_expand" "expand"		= True
+nukeParamDoc "gtk_tool_item_get_expand" "returns"		= True
+nukeParamDoc "gtk_tool_item_set_use_drag_window" "useDragWindow"= True
+nukeParamDoc "gtk_tool_item_get_use_drag_window" "returns"	= True
+nukeParamDoc "gtk_tool_item_set_visible_horizontal" "visibleHorizontal"	= True
+nukeParamDoc "gtk_tool_item_get_visible_horizontal" "returns"	= True
+nukeParamDoc "gtk_tool_item_set_visible_vertical" "visibleVertical"	= True
+nukeParamDoc "gtk_tool_item_get_visible_vertical" "returns"	= True
+nukeParamDoc "gtk_tool_item_set_is_important" "isImportant"	= True
+nukeParamDoc "gtk_tool_item_get_icon_size" "returns"		= True
+nukeParamDoc "gtk_tool_item_get_orientation" "returns"		= True
+nukeParamDoc "gtk_tool_item_get_toolbar_style" "returns"	= True
+nukeParamDoc "gtk_tool_item_get_relief_style" "returns"		= True
+nukeParamDoc "gtk_tool_item_get_is_important" "returns"		= True
+nukeParamDoc "gtk_tool_item_retrieve_proxy_menu_item" "returns"	= True
+nukeParamDoc "gtk_toolbar_set_orientation" "orientation"	= True
+nukeParamDoc "gtk_toolbar_get_orientation" "returns"		= True
+nukeParamDoc "gtk_toolbar_set_style" "style"			= True
+nukeParamDoc "gtk_toolbar_get_style" "returns"			= True
+nukeParamDoc "gtk_toolbar_get_tooltips" "returns"		= True
+nukeParamDoc "gtk_toolbar_get_icon_size" "returns"		= True
+nukeParamDoc "gtk_toolbar_get_n_items" "returns"		= True
+nukeParamDoc "gtk_toolbar_set_show_arrow" "showArrow"		= True
+nukeParamDoc "gtk_toolbar_get_show_arrow" "returns"		= True
+nukeParamDoc "gtk_toolbar_get_relief_style" "returns"		= True
+nukeParamDoc "gtk_toolbar_set_icon_size" "iconSize"		= True
+nukeParamDoc "gtk_file_chooser_get_action" "returns"		= True
+nukeParamDoc "gtk_file_chooser_set_local_only" "localOnly"	= True
+nukeParamDoc "gtk_file_chooser_get_local_only" "returns"	= True
+nukeParamDoc "gtk_file_chooser_set_select_multiple" "selectMultiple"	= True
+nukeParamDoc "gtk_file_chooser_get_select_multiple" "returns"	= True
+nukeParamDoc "gtk_file_chooser_get_filenames" "returns"		= True
+nukeParamDoc "gtk_file_chooser_add_filter" "filter"		= True
+nukeParamDoc "gtk_file_chooser_remove_filter" "filter"		= True
+nukeParamDoc "gtk_file_chooser_set_filter" "filter"		= True
+nukeParamDoc "gtk_file_chooser_add_shortcut_folder" "returns"	= True
+nukeParamDoc "gtk_file_chooser_remove_shortcut_folder" "returns"= True
+nukeParamDoc "gtk_file_chooser_add_shortcut_folder_uri" "returns"	= True
+nukeParamDoc "gtk_file_chooser_remove_shortcut_folder_uri" "returns"	= True
+nukeParamDoc "gtk_file_chooser_get_uris" "returns"		= True
+nukeParamDoc "gtk_file_chooser_list_filters" "returns"		= True
+nukeParamDoc "gtk_file_chooser_list_shortcut_folders" "returns"	= True
+nukeParamDoc "gtk_file_chooser_list_shortcut_folder_uris" "returns"	= True
+nukeParamDoc "gtk_font_selection_get_preview_text" "returns"	= True
+nukeParamDoc "gtk_font_selection_set_preview_text" "text"	= True
+nukeParamDoc "gtk_font_selection_dialog_get_preview_text" "returns"	= True
+nukeParamDoc "gtk_font_selection_dialog_set_preview_text" "text"	= True
+nukeParamDoc "gtk_text_mark_get_name" "returns"			= True
+nukeParamDoc "gtk_text_mark_get_buffer" "returns"		= True
+nukeParamDoc "gtk_text_mark_get_visible" "returns"		= True
+nukeParamDoc "gtk_text_mark_get_deleted" "returns"		= True
+nukeParamDoc "gtk_text_mark_set_visible" "setting"		= True
+nukeParamDoc "gtk_text_mark_get_left_gravity" "returns"		= True
+nukeParamDoc "gtk_text_tag_new" "name"				= True
+nukeParamDoc "gtk_text_tag_get_priority" "returns"		= True
+nukeParamDoc "gtk_text_tag_set_priority" "priority"		= True
+nukeParamDoc "gtk_text_tag_table_add" "tag"			= True
+nukeParamDoc "gtk_text_tag_table_remove" "tag"			= True
+nukeParamDoc "gtk_text_tag_table_get_size" "returns"		= True
+nukeParamDoc "gtk_text_buffer_get_line_count" "returns"		= True
+nukeParamDoc "gtk_text_buffer_get_char_count" "returns"		= True
+nukeParamDoc "gtk_text_buffer_get_tag_table" "returns"		= True
+nukeParamDoc "gtk_text_buffer_get_text" "returns"		= True
+nukeParamDoc "gtk_text_buffer_get_slice" "returns"		= True
+nukeParamDoc "gtk_text_buffer_insert_at_cursor" "text"		= True
+nukeParamDoc "gtk_text_buffer_insert_at_cursor" "len"		= True
+nukeParamDoc "gtk_text_buffer_get_insert" "returns"		= True
+nukeParamDoc "gtk_text_buffer_get_selection_bound" "returns"	= True
+nukeParamDoc "gtk_text_buffer_set_modified" "setting"		= True
+nukeParamDoc "gtk_text_buffer_get_end_iter" "iter"		= True
+nukeParamDoc "gtk_text_view_new_with_buffer" "buffer"		= True
+nukeParamDoc "gtk_text_view_set_buffer" "buffer"		= True
+nukeParamDoc "gtk_text_view_get_buffer" "returns"		= True
+nukeParamDoc "gtk_text_view_get_iter_location" "iter"		= True
+nukeParamDoc "gtk_text_view_get_iter_location" "location"	= True
+nukeParamDoc "gtk_text_view_set_wrap_mode" "wrapMode"		= True
+nukeParamDoc "gtk_text_view_get_wrap_mode" "returns"		= True
+nukeParamDoc "gtk_text_view_set_editable" "setting"		= True
+nukeParamDoc "gtk_text_view_get_editable" "returns"		= True
+nukeParamDoc "gtk_text_view_set_cursor_visible" "setting"	= True
+nukeParamDoc "gtk_text_view_get_cursor_visible" "returns"  	= True
+nukeParamDoc "gtk_text_view_set_pixels_above_lines" "pixelsAboveLines"	= True
+nukeParamDoc "gtk_text_view_get_pixels_above_lines" "returns"	= True
+nukeParamDoc "gtk_text_view_set_pixels_below_lines" "pixelsBelowLines"	= True
+nukeParamDoc "gtk_text_view_get_pixels_below_lines" "returns"	= True
+nukeParamDoc "gtk_text_view_set_pixels_inside_wrap" "pixelsInsideWrap"	= True
+nukeParamDoc "gtk_text_view_get_pixels_inside_wrap" "returns"	= True
+nukeParamDoc "gtk_text_view_set_justification" "justification"	= True
+nukeParamDoc "gtk_text_view_get_justification" "returns"	= True
+nukeParamDoc "gtk_text_view_get_default_attributes" "returns"	= True
+nukeParamDoc "gtk_color_button_get_color" "color"		= True
+nukeParamDoc "gtk_combo_box_get_wrap_width" "returns"		= True
+nukeParamDoc "gtk_combo_box_get_row_span_column" "returns"	= True
+nukeParamDoc "gtk_combo_box_get_column_span_column" "returns"	= True
+nukeParamDoc "gtk_combo_box_get_active_text" "returns"		= True
+nukeParamDoc "gtk_combo_box_get_add_tearoffs" "returns"		= True
+nukeParamDoc "gtk_combo_box_set_focus_on_click" "returns"	= True
+nukeParamDoc "gtk_image_get_pixel_size" "returns"		= True
+nukeParamDoc "gtk_image_set_from_file" "filename"		= True
+nukeParamDoc "gtk_progress_bar_set_ellipsize" "mode"		= True
+nukeParamDoc "gtk_progress_bar_get_ellipsize" "returns"		= True
+nukeParamDoc "gtk_widget_get_modifier_style" "returns"		= True
+nukeParamDoc "gtk_widget_get_default_direction" "returns"	= True
+nukeParamDoc "gtk_widget_get_direction" "returns"		= True
+nukeParamDoc "gtk_widget_set_direction" "dir"			= True
+nukeParamDoc "gtk_widget_get_name" "returns"			= True
+nukeParamDoc _ _ = False
+nukeParameterDocumentation = nukeParamDoc
 
 -- On win32 for glib/gtk 2.6 they changed the interpretation of functions that
 -- take or return system file names (as opposed to user displayable

[Gtk2hs-commit] gtk2hs/tools/apicoverage Makefile,1.6,1.7 gtk.ignore,1.3,1.4

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

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

Modified Files:
	Makefile gtk.ignore 
Log Message:
Makefile: cure bit rot in apicoverage tool

gtk.ignore: ignore the _utf8 variants that exist for some functions.


Index: Makefile
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apicoverage/Makefile,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- Makefile	27 Mar 2005 12:59:06 -0000	1.6
+++ Makefile	6 Apr 2005 21:36:48 -0000	1.7
@@ -14,10 +14,11 @@
 	  --directory-prefix=tars
 
 gtk.def : tars/gtk+-$(GTK_VERSION).tar.bz2
-	tar --file tars/gtk+-$(GTK_VERSION).tar.bz2 -j --get gtk+-$(GTK_VERSION)/gtk/gtk.def -O > gtk.def
-	sed -i 's:\(\t\|EXPORTS\)::' gtk.def
+	tar --file tars/gtk+-$(GTK_VERSION).tar.bz2 -j \
+	    --get gtk+-$(GTK_VERSION)/gtk/gtk.def -O \
+	| sed 's:\(\t\|EXPORTS\)::' | cut -d' ' -f 1 | sort > gtk.def
 
-GTK_CHS_FILES = $(shell find ../../gtk -name '*.chs')
+GTK_CHS_FILES = $(shell find ../../gtk -name '*.chs' -o -name '*.chs.pp')
 
 gtk.coverage : $(GTK_CHS_FILES)
 	grep -h 'foreign import ccall \(safe \|unsafe \)\?" \?&\?.*"' \
@@ -72,5 +73,9 @@
 	awk '$$1 == "<" { print $$2 }' | \
 	awk -F _ '{ printf("%s_%s_%s\n", $$1, $$2, $$3) }' | uniq -c | sort -n
 
+full: gtk.def.filtered gtk.coverage.filtered
+	@diff gtk.def.filtered gtk.coverage.filtered | \
+	awk '$$1 == "<" { print $$2 }' | sort
+
 debug:
 	@echo GTK_IGNORE_FILES = $(GTK_IGNORE_FILES)

Index: gtk.ignore
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apicoverage/gtk.ignore,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- gtk.ignore	3 Aug 2004 02:40:13 -0000	1.3
+++ gtk.ignore	6 Apr 2005 21:36:48 -0000	1.4
@@ -65,6 +65,10 @@
 exclude gtk_input_dialog
 
 
+#we do not need to count the _utf8 variants too
+exclude _utf8$
+
+
 #low level
 exclude gtk_marshal
 exclude gtk_false

[Gtk2hs-commit] gtk2hs ChangeLog,1.431,1.432

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

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

Modified Files:
	ChangeLog 
Log Message:
Makefile: cure bit rot in apicoverage tool

gtk.ignore: ignore the _utf8 variants that exist for some functions.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.431
retrieving revision 1.432
diff -u -d -r1.431 -r1.432
--- ChangeLog	6 Apr 2005 21:32:42 -0000	1.431
+++ ChangeLog	6 Apr 2005 21:36:48 -0000	1.432
@@ -58,6 +58,11 @@
 	* tools/callbackGen/gtkmarshal.list: remove the marhsaler that was
 	only needed by gconf.
 
+	* tools/apicoverage/Makefile: cure bit rot in apicoverage tool
+
+	* tools/apicoverage/gtk.ignore: ignore the _utf8 variants that exist
+	for some functions.
+
 2005-04-5 Duncan Coutts <du...@co...>
 
 	* glib/System/Glib/UTFString.hs: add some extra functions for

[Gtk2hs-commit] gtk2hs/tools/callbackGen gtkmarshal.list,1.6,1.7

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

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

Modified Files:
	gtkmarshal.list 
Log Message:
Remove the marhsaler that was only needed by gconf.


Index: gtkmarshal.list
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/callbackGen/gtkmarshal.list,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- gtkmarshal.list	6 Apr 2005 20:14:22 -0000	1.6
+++ gtkmarshal.list	6 Apr 2005 21:32:42 -0000	1.7
@@ -103,7 +103,5 @@
 VOID:INT,BOOLEAN
 # This is for the "edited" signal in CellRendererText:
 VOID:POINTER,STRING
-# This is for the GConfClient value_changed signal
-VOID:STRING,POINTER
 # This is for GtkMozEmbed
 BOOLEAN:STRING

[Gtk2hs-commit] gtk2hs ChangeLog,1.430,1.431

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

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

Modified Files:
	ChangeLog 
Log Message:
Remove the marhsaler that was only needed by gconf.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.430
retrieving revision 1.431
diff -u -d -r1.430 -r1.431
--- ChangeLog	6 Apr 2005 21:27:39 -0000	1.430
+++ ChangeLog	6 Apr 2005 21:32:42 -0000	1.431
@@ -55,6 +55,9 @@
 	* configure.ac: change the gconf flags so that they inherit from glib
 	rather than gtk.
 
+	* tools/callbackGen/gtkmarshal.list: remove the marhsaler that was
+	only needed by gconf.
+
 2005-04-5 Duncan Coutts <du...@co...>
 
 	* glib/System/Glib/UTFString.hs: add some extra functions for

[Gtk2hs-commit] gtk2hs ChangeLog,1.429,1.430 Makefile.am,1.64,1.65 configure.ac,1.36,1.37

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

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

Modified Files:
	ChangeLog Makefile.am configure.ac 
Log Message:
Make the gconf package depend only on glib not on gtk. The only dependency
previously was on the Signals module from the gtk package, so use a local
Signals module instead with just the one marshaler that is needed:

marshal.list: add local marshal list that contains the callback types that
	gconf needs.

Makefile.am: generate a Signals module for the gconf package. Also make it
	inherit it's build settings from glib rather than gtk.

GConfClient.chs: import local Signals module so that we can eliminate the
	dependency of the gconf package on the gtk package.

gconf.cabal.in, gconf.pkg.in: change the dep from gtk to glib.

configure.ac: change the gconf flags so that they inherit from glib rather
	than gtk.


Index: configure.ac
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/configure.ac,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -d -r1.36 -r1.37
--- configure.ac	6 Apr 2005 21:10:42 -0000	1.36
+++ configure.ac	6 Apr 2005 21:27:39 -0000	1.37
@@ -401,8 +401,8 @@
 LIBGLADE_CFLAGS=`CFLAGS="$GLIB_CFLAGS $GTK_CFLAGS" SED=$SED GREP=$GREP tools/checkDirs.sh $LIBGLADE_CFLAGS`;
 LIBGLADE_LIBS=`LDFLAGS="$GLIB_LIBS $GTK_LIBS" SED=$SED GREP=$GREP tools/checkDirs.sh $LIBGLADE_LIBS`;
 
-GCONF_CFLAGS=`CFLAGS="$GLIB_CFLAGS $GTK_CFLAGS" SED=$SED GREP=$GREP tools/checkDirs.sh $GCONF_CFLAGS`;
-GCONF_LIBS=`LDFLAGS="$GLIB_LIBS $GTK_LIBS" SED=$SED GREP=$GREP tools/checkDirs.sh $GCONF_LIBS`;
+GCONF_CFLAGS=`CFLAGS="$GLIB_CFLAGS" SED=$SED GREP=$GREP tools/checkDirs.sh $GCONF_CFLAGS`;
+GCONF_LIBS=`LDFLAGS="$GLIB_LIBS" SED=$SED GREP=$GREP tools/checkDirs.sh $GCONF_LIBS`;
 
 MOZEMBED_CFLAGS=`CFLAGS="$GLIB_CFLAGS $GTK_CFLAGS" tools/checkDirs.sh $MOZEMBED_CFLAGS`;
 MOZEMBED_LIBS=`LDFLAGS="$GLIB_LIBS $GTK_LIBS" SED=$SED GREP=$GREP tools/checkDirs.sh $MOZEMBED_LIBS`;

Index: Makefile.am
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -d -r1.64 -r1.65
--- Makefile.am	6 Apr 2005 21:10:42 -0000	1.64
+++ Makefile.am	6 Apr 2005 21:27:39 -0000	1.65
@@ -674,17 +674,18 @@
 libHSgconf_a_PACKAGEDEPS	= 
 libHSgconf_a_HEADER 		= gconf/gconf-client.h
 libHSgconf_a_PRECOMP		= gconf/gconf.precomp
-libHSgconf_a_LIBS		= $(GLIB_LIBS) $(GTK_LIBS) $(GCONF_LIBS)
+libHSgconf_a_LIBS		= $(GLIB_LIBS) $(GCONF_LIBS)
 libHSgconf_a_HCFLAGS		= -fglasgow-exts -fallow-overlapping-instances \
                                    $(if $(USE_CABAL),-ignore-package glib)
-libHSgconf_a_CFLAGS		= $(filter-out -I% -D%,$(GLIB_CFLAGS) $(GTK_CFLAGS) $(GCONF_CFLAGS))
-libHSgconf_a_CPPFLAGS		= $(filter -I% -D%,$(GLIB_CFLAGS) $(GTK_CFLAGS) $(GCONF_CFLAGS))
+libHSgconf_a_CFLAGS		= $(filter-out -I% -D%,$(GLIB_CFLAGS) $(GCONF_CFLAGS))
+libHSgconf_a_CPPFLAGS		= $(filter -I% -D%,$(GLIB_CFLAGS) $(GCONF_CFLAGS))
 
-libHSgconf_a_SOURCESDIRS = $(libHSgtk_a_SOURCESDIRS) gconf
-gconf/libHSgconf_a.deps	: gtk/libHSgtk_a.deps
+libHSgconf_a_SOURCESDIRS = $(libHSglib_a_SOURCESDIRS) gconf
+gconf/libHSgconf_a.deps	: glib/libHSglib_a.deps
 
 libHSgconf_a_GENERATEDSOURCES =				\
-	gconf/System/Gnome/GConf/Types.chs
+	gconf/System/Gnome/GConf/Types.chs		\
+	gconf/System/Gnome/GConf/Signals.chs
 
 nodist_libHSgconf_a_SOURCES = $(libHSgconf_a_GENERATEDSOURCES)
 
@@ -708,6 +709,15 @@
 	$@ --tag=gconf --lib=gconf --prefix=gconf \
 	--modname=System.Gnome.GConf.Types --parentname=System.Glib.GObject)
 
+gconf/System/Gnome/GConf/Signals.chs : \
+	$(srcdir)/tools/callbackGen/Signal.chs.template \
+	$(srcdir)/gconf/System/Gnome/GConf/marshal.list \
+	$(srcdir)/tools/callbackGen/HookGenerator$(EXEEXT)
+	$(strip $(srcdir)/tools/callbackGen/HookGenerator$(EXEEXT) \
+	$(srcdir)/gconf/System/Gnome/GConf/marshal.list \
+	$(srcdir)/tools/callbackGen/Signal.chs.template $@ \
+	System.Gnome.GConf.Signals)
+
 libHSgconf_a_ALLSOURCES = $(libHSgconf_a_SOURCES) $(nodist_libHSgconf_a_SOURCES)
 
 am_libHSgconf_a_OBJECTS = \
@@ -742,7 +752,6 @@
 DISTCLEANFILES+= gconf/libHSgconf_a.deps $(libHSgconf_a_CHSFILES_HS:.hs=.dep)
 
 $(libHSgconf_a_CHSFILES:.chs=.dep) :	\
-	$(libHSgtk_a_GENERATEDSOURCES)	\
 	$(libHSgconf_a_GENERATEDSOURCES)
 -include $(libHSgconf_a_CHSFILES:.chs=.dep) gconf/libHSgconf_a.deps
 

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.429
retrieving revision 1.430
diff -u -d -r1.429 -r1.430
--- ChangeLog	6 Apr 2005 21:10:42 -0000	1.429
+++ ChangeLog	6 Apr 2005 21:27:39 -0000	1.430
@@ -39,6 +39,22 @@
 	since it is no longer relevant. Also remove support for providing an
 	alternate gtkmarshal.list file since it it is not used.
 
+	* gconf/System/Gnome/GConf/marshal.list: add local marshal list that
+	contains the callback types that gconf needs.
+
+	* Makefile.am: generate a Signals module for the gconf package. Also
+	make it inherit it's build settings from glib rather than gtk.
+
+	* gconf/System/Gnome/GConf/GConfClient.chs: import local Signals
+	module so that we can eliminate the dependency of the gconf package on
+	gtk package.
+
+	* gconf/gconf.cabal.in, gconf/gconf.pkg.in: change the dep from gtk to
+	glib.
+
+	* configure.ac: change the gconf flags so that they inherit from glib
+	rather than gtk.
+
 2005-04-5 Duncan Coutts <du...@co...>
 
 	* glib/System/Glib/UTFString.hs: add some extra functions for

[Gtk2hs-commit] gtk2hs/gconf gconf.cabal.in,1.1,1.2 gconf.pkg.in,1.4,1.5

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

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

Modified Files:
	gconf.cabal.in gconf.pkg.in 
Log Message:
Make the gconf package depend only on glib not on gtk. The only dependency
previously was on the Signals module from the gtk package, so use a local
Signals module instead with just the one marshaler that is needed:

marshal.list: add local marshal list that contains the callback types that
	gconf needs.

Makefile.am: generate a Signals module for the gconf package. Also make it
	inherit it's build settings from glib rather than gtk.

GConfClient.chs: import local Signals module so that we can eliminate the
	dependency of the gconf package on the gtk package.

gconf.cabal.in, gconf.pkg.in: change the dep from gtk to glib.

configure.ac: change the gconf flags so that they inherit from glib rather
	than gtk.


Index: gconf.pkg.in
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gconf/gconf.pkg.in,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- gconf.pkg.in	16 Jan 2005 21:44:15 -0000	1.4
+++ gconf.pkg.in	6 Apr 2005 21:27:40 -0000	1.5
@@ -8,7 +8,7 @@
      extra_libraries = [@GCONF_LIBS_CQ@],
      include_dirs    = [@GCONF_CFLAGS_CQ@],
      c_includes      = ["gconf/gconf-client.h"],
-     package_deps    = ["gtk"],
+     package_deps    = ["glib"],
      extra_ghc_opts  = [],
      extra_cc_opts   = [],
      extra_ld_opts   = [@GCONF_LIBEXTRA_CQ@]

Index: gconf.cabal.in
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gconf/gconf.cabal.in,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- gconf.cabal.in	23 Mar 2005 17:08:57 -0000	1.1
+++ gconf.cabal.in	6 Apr 2005 21:27:40 -0000	1.2
@@ -13,5 +13,5 @@
 extra-libraries: @GCONF_LIBS_CQ@
 include-dirs: @GCONF_CFLAGS_CQ@
 includes: gconf/gconf-client.h
-depends: gtk-@PACKAGE_VERSION@
+depends: glib-@PACKAGE_VERSION@
 extra-ld-opts: @GCONF_LIBEXTRA_CQ@

[Gtk2hs-commit] gtk2hs/gconf/System/Gnome/GConf marshal.list,NONE,1.1 GConfClient.chs,1.8,1.9

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

Update of /cvsroot/gtk2hs/gtk2hs/gconf/System/Gnome/GConf
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27051/gconf/System/Gnome/GConf

Modified Files:
	GConfClient.chs 
Added Files:
	marshal.list 
Log Message:
Make the gconf package depend only on glib not on gtk. The only dependency
previously was on the Signals module from the gtk package, so use a local
Signals module instead with just the one marshaler that is needed:

marshal.list: add local marshal list that contains the callback types that
	gconf needs.

Makefile.am: generate a Signals module for the gconf package. Also make it
	inherit it's build settings from glib rather than gtk.

GConfClient.chs: import local Signals module so that we can eliminate the
	dependency of the gconf package on the gtk package.

gconf.cabal.in, gconf.pkg.in: change the dep from gtk to glib.

configure.ac: change the gconf flags so that they inherit from glib rather
	than gtk.


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

# 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.

# This is for the GConfClient value_changed signal
VOID:STRING,POINTER

Index: GConfClient.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gconf/System/Gnome/GConf/GConfClient.chs,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- GConfClient.chs	14 Jan 2005 19:04:51 -0000	1.8
+++ GConfClient.chs	6 Apr 2005 21:27:40 -0000	1.9
@@ -94,7 +94,7 @@
 import System.Glib.GList
 import System.Glib.GError   (GErrorDomain, GErrorClass(..), propagateGError)
 import System.Glib.GObject  (makeNewGObject)
-{#import Graphics.UI.Gtk.Signals#}
+{#import System.Gnome.GConf.Signals#}
 {#import System.Gnome.GConf.Types#}
 {#import System.Gnome.GConf.GConfValue#}
 

[Gtk2hs-commit] gtk2hs ChangeLog,1.428,1.429 Makefile.am,1.63,1.64 configure.ac,1.35,1.36

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

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

Modified Files:
	ChangeLog Makefile.am configure.ac 
Log Message:
Makefile.am: change the way gtk/Graphics/UI/Gtk/Signals.chs is built. The
	template file and the module name are now explictly specified.
Also, the module no longer has any foreign "wrapper" imports so there is no
	longer any Signals_stub.o file.

configure.ac: remove the check for the four word callback issue since it is no
	longer relevant.
Also remove support for providing an alternate gtkmarshal.list file since it it
	is not used.


Index: configure.ac
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/configure.ac,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -d -r1.35 -r1.36
--- configure.ac	6 Apr 2005 20:36:10 -0000	1.35
+++ configure.ac	6 Apr 2005 21:10:42 -0000	1.36
@@ -148,17 +148,6 @@
 GHC_LIBDIR=`$GHC --print-libdir`
 GHC_INCLUDEDIR=$GHC_LIBDIR/include
 
-dnl Check if the ghc compiler can generate dynamic callbacks with more than
-dnl 4 words worth of arguments. Hopefully one day the compiler will support
-dnl this.
-AC_MSG_CHECKING([broken dynamic callbacks])
-FOUR_WORD_CALLBACK=no
-GTKHS_PROG_CHECK_VERSION($GHC_VERSION, -lt, 9.9.9, [
-  if test $host_cpu = sparc; then FOUR_WORD_CALLBACK=yes; fi
-  dnl TODO: is this only on Sparc Solaris or on all Sparc (ie Linux too)?
-])
-AC_MSG_RESULT([$FOUR_WORD_CALLBACK])
-
 dnl From ghc 6 onwards, ghc-pkg has the "auto libs" feature which means
 dnl users do not have to specify the -package flag most of the time.
 dnl All our packages support this mode now.
@@ -496,19 +485,6 @@
   CREATE_TYPES="deprecated $CREATE_TYPES";
 fi;
 
-dnl Have a special marshall list (available in the source tree of Gtk+ under
-dnl gtk/gtkmarshal.list)
-
-AC_MSG_CHECKING(marshal list)
-AC_ARG_WITH(mlist, 
-	    [  --with-mlist=GTK-SOURCE use special marshall list from GTK+ sources],
-	    [MARSHALLDEFS=$withval;
-	     AC_MSG_RESULT($withval)],
-	    [MARSHALLDEFS='tools/callbackGen/gtkmarshal.list';
-	     AC_MSG_RESULT(built-in)])
-
-
-
 dnl c2hs Dilemma.
 dnl Check if the user supplied a specific C->Haskell installation or wants to
 dnl use the version in the current search path (--with-c2hs-config=yes). 
@@ -617,7 +593,6 @@
 AC_SUBST(GHC_INCLUDEDIR)
 AC_SUBST(BUILT_IN_C2HS)
 AC_SUBST(MULTIPLE_CHS)
-AC_SUBST(FOUR_WORD_CALLBACK)
 AC_SUBST(PKGCONF)
 AC_SUBST(USE_CABAL)
 AC_SUBST(PKGEXT)
@@ -625,7 +600,6 @@
 AC_SUBST(C2HS)
 AC_SUBST(HSC2HS)
 AC_SUBST(HSCPP)
-AC_SUBST(MARSHALLDEFS)
 AC_SUBST(VERSION)
 dnl Platform specific flags 
 AC_SUBST(HSCFLAGS)

Index: Makefile.am
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -d -r1.63 -r1.64
--- Makefile.am	6 Apr 2005 20:36:09 -0000	1.63
+++ Makefile.am	6 Apr 2005 21:10:42 -0000	1.64
@@ -87,15 +87,6 @@
 MOSTLYCLEANFILES+= $(am_tools_callbackGen_HookGenerator_OBJECTS)
 MOSTLYCLEANFILES+= $(tools_callbackGen_HookGenerator_SOURCES:.hs=.hi)
 
-
-gtk/Graphics/UI/Gtk/Signals.chs : \
-	$(srcdir)/tools/callbackGen/Signal.chs.template \
-	$(srcdir)/tools/callbackGen/gtkmarshal.list \
-	$(srcdir)/tools/callbackGen/HookGenerator$(EXEEXT)
-	$(strip $(srcdir)/tools/callbackGen/HookGenerator$(EXEEXT) $(MARSHALLDEFS) \
-	$(srcdir)/tools/callbackGen/ $@ \
-	$(if $(subst yes,,$(FOUR_WORD_CALLBACK)),--broken))
-
 #
 #	API Coverage Tool
 #
@@ -259,7 +250,8 @@
 	$(CC) -c $< -o $@ $(GLIB_CFLAGS) -I$(GHC_INCLUDEDIR) 	\
 	-Wall -Wextra -Werror -Wno-unused-parameter
 
-am_libHSglib_a_OBJECTS = $(libHSglib_a_HSFILES:.hs=.$(OBJEXT))
+am_libHSglib_a_OBJECTS = \
+	$(addsuffix .$(OBJEXT),$(basename $(basename $(libHSglib_a_SOURCES))))
 
 libHSglib_a_CHSPPFILES = $(filter %.chs.pp,$(libHSglib_a_SOURCES))
 libHSglib_a_CHSFILES = \
@@ -479,7 +471,6 @@
         gtk/Graphics/UI/Gtk/Multiline/TextTagTable_stub.o		\
 	gtk/Graphics/UI/Gtk/General/General_stub.o			\
         gtk/Graphics/UI/Gtk/TreeList/TreeModel_stub.o			\
-	gtk/Graphics/UI/Gtk/Signals_stub.o	        		\
         gtk/Graphics/UI/Gtk/TreeList/TreeSelection_stub.o		\
         gtk/Graphics/UI/Gtk/TreeList/TreeView_stub.o			\
 	gtk/Graphics/UI/Gtk/TreeList/IconView_stub.o			\
@@ -502,6 +493,15 @@
 	--modname=Graphics.UI.Gtk.Types \
         --parentname=System.Glib.GObject)
 
+gtk/Graphics/UI/Gtk/Signals.chs : \
+	$(srcdir)/tools/callbackGen/Signal.chs.template \
+	$(srcdir)/tools/callbackGen/gtkmarshal.list \
+	$(srcdir)/tools/callbackGen/HookGenerator$(EXEEXT)
+	$(strip $(srcdir)/tools/callbackGen/HookGenerator$(EXEEXT) \
+	$(srcdir)/tools/callbackGen/gtkmarshal.list \
+	$(srcdir)/tools/callbackGen/Signal.chs.template $@ \
+	Graphics.UI.Gtk.Signals)
+
 libHSgtk_a_ALLSOURCES = $(libHSgtk_a_SOURCES) $(nodist_libHSgtk_a_SOURCES)
 
 am_libHSgtk_a_OBJECTS = \

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.428
retrieving revision 1.429
diff -u -d -r1.428 -r1.429
--- ChangeLog	6 Apr 2005 20:46:59 -0000	1.428
+++ ChangeLog	6 Apr 2005 21:10:42 -0000	1.429
@@ -30,6 +30,15 @@
 	global Signals module. The code dealing with the Sparc 4 word marshaling
 	restriction has been dropped as it is no longer a problem.
 
+	* Makefile.am: change the way gtk/Graphics/UI/Gtk/Signals.chs is
+	built. The template file and the module name are now explictly
+	specified. Also, the module no longer has any foreign "wrapper"
+	imports so there is no longer any Signals_stub.o file.
+	
+	* configure.ac: remove the check for the four word callback issue
+	since it is no longer relevant. Also remove support for providing an
+	alternate gtkmarshal.list file since it it is not used.
+
 2005-04-5 Duncan Coutts <du...@co...>
 
 	* glib/System/Glib/UTFString.hs: add some extra functions for

[Gtk2hs-commit] gtk2hs ChangeLog,1.427,1.428

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

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

Modified Files:
	ChangeLog 
Log Message:
Modify the callback marshaler code generator to generate marshalers that use
	the new GClosure-based marshaling system.

Change the signals template so that it imports the System.Glib.Signals code
	rather than defining everything locally.

Also parameterise by the module name so we can have more than a single global
	Signals module.

The code dealing with the Sparc 4 word marshaling restriction has been dropped
	as it is no longer a problem.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.427
retrieving revision 1.428
diff -u -d -r1.427 -r1.428
--- ChangeLog	6 Apr 2005 20:36:09 -0000	1.427
+++ ChangeLog	6 Apr 2005 20:46:59 -0000	1.428
@@ -21,6 +21,15 @@
 	* configure.ac: provide GHC_INCLUDEDIR, which is bascially just 
 	`$GHC --print-libdir`/include
 
+	* tools/callbackGen/HookGenerator.hs,
+	tools/callbackGen/Signal.chs.template: modify the callback marshaler
+	code generator to generate marshalers that use the new GClosure-based
+	marshaling system. Change the signals template so that it import the
+	System.Glib.Signals code rather than defining everything locally. Also
+	parameterise by the module name so we can have more than a single
+	global Signals module. The code dealing with the Sparc 4 word marshaling
+	restriction has been dropped as it is no longer a problem.
+
 2005-04-5 Duncan Coutts <du...@co...>
 
 	* glib/System/Glib/UTFString.hs: add some extra functions for

[Gtk2hs-commit] gtk2hs/tools/callbackGen HookGenerator.hs,1.5,1.6 Signal.chs.template,1.1,1.2

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

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

Modified Files:
	HookGenerator.hs Signal.chs.template 
Log Message:
Modify the callback marshaler code generator to generate marshalers that use
	the new GClosure-based marshaling system.

Change the signals template so that it imports the System.Glib.Signals code
	rather than defining everything locally.

Also parameterise by the module name so we can have more than a single global
	Signals module.

The code dealing with the Sparc 4 word marshaling restriction has been dropped
	as it is no longer a problem.


Index: Signal.chs.template
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/callbackGen/Signal.chs.template,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Signal.chs.template	23 Mar 2005 19:34:55 -0000	1.1
+++ Signal.chs.template	6 Apr 2005 20:47:00 -0000	1.2
@@ -1,4 +1,3 @@
-{-# OPTIONS -cpp #-}
 -- -*-haskell-*-
 -- -------------------- automatically generated file - do not edit ------------
 --  Callback installers for the GIMP Toolkit (GTK) Binding for Haskell
@@ -23,74 +22,39 @@
 --
 -- #hide
 
--- |
---    These functions are used to connect signals to widgets. They are auto-
---    matically created through HookGenerator.hs which takes a list of possible
---    function signatures that are included in the GTK sources 
---    (gtkmarshal.list).
---
---  * The object system in the second version of GTK is based on GObject from
---    GLIB. This base class is rather primitive in that it only implements
---    ref and unref methods (and others that are not interesting to us). If
---    the marshall list mentions OBJECT it refers to an instance of this 
---    GObject which is automatically wrapped with a ref and unref call.
---    Structures which are not derived from GObject have to be passed as
---    BOXED which gives the signal connect function a possiblity to do the
---    conversion into a proper ForeignPtr type. In special cases the signal
---    connect function use a PTR type which will then be mangled in the
---    user function directly. The latter is needed if a signal delivers a
---    pointer to a string and its length in a separate integer.
---
--- TODO
+-- | These functions are used to connect signals to widgets. They are auto-
+-- matically created through HookGenerator.hs which takes a list of possible
+-- function signatures that are included in the GTK sources (gtkmarshal.list).
 --
---  * Check if we need all prototypes mentioned in gtkmarshal.list.
+-- The object system in the second version of GTK is based on GObject from
+-- GLIB. This base class is rather primitive in that it only implements
+-- ref and unref methods (and others that are not interesting to us). If
+-- the marshall list mentions OBJECT it refers to an instance of this 
+-- GObject which is automatically wrapped with a ref and unref call.
+-- Structures which are not derived from GObject have to be passed as
+-- BOXED which gives the signal connect function a possiblity to do the
+-- conversion into a proper ForeignPtr type. In special cases the signal
+-- connect function use a PTR type which will then be mangled in the
+-- user function directly. The latter is needed if a signal delivers a
+-- pointer to a string and its length in a separate integer.
 --
-module Graphics.UI.Gtk.Signals (
+module @MODULE_NAME@ (
+  module System.Glib.Signals,
 
-  @MODULE_EXPORTS@SignalName,
-  ConnectAfter,
-  ConnectId,
-  disconnect
+  @MODULE_EXPORTS@
   ) where
 
 import Monad	(liftM)
-import Data.IORef
 
 import System.Glib.FFI
-import System.Glib.GError   (failOnGError)
-{#import System.Glib.GObject#} hiding (mkFunPtrDestructor)
+import System.Glib.UTFString   (peekUTFString, newUTFString)
+import System.Glib.GError      (failOnGError)
+{#import System.Glib.Signals#}
+{#import System.Glib.GObject#}
 
 {#context lib="gtk" prefix="gtk" #}
 
 
--- Specify if the handler is to run before (False) or after (True) the
--- default handler.
-
-type ConnectAfter = Bool
-
-type SignalName = String
-
-data GObjectClass o => ConnectId o = ConnectID {#type gulong#} o
-
-{#pointer GClosureNotify#}
-
-foreign import ccall "wrapper" mkDestructor :: IO () -> IO GClosureNotify
-
-mkFunPtrDestructor :: FunPtr a -> IO GClosureNotify
-mkFunPtrDestructor hPtr = do
-  dRef <- newIORef nullFunPtr
-  dPtr <- mkDestructor $ do
-    freeHaskellFunPtr hPtr
-    dPtr <- readIORef dRef
-    freeHaskellFunPtr dPtr
-  writeIORef dRef dPtr
-  return dPtr
-
-disconnect :: GObjectClass obj => ConnectId obj -> IO ()
-disconnect (ConnectID handler obj) =
-  withForeignPtr  ((unGObject.toGObject) obj) $ \objPtr ->
-  {#call unsafe g_signal_handler_disconnect#} (castPtr objPtr) handler
-
 -- Here are the generators that turn a Haskell function into
 -- a C function pointer. The fist Argument is always the widget,
 -- the last one is the user g_pointer. Both are ignored.

Index: HookGenerator.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/callbackGen/HookGenerator.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- HookGenerator.hs	23 Mar 2005 19:34:56 -0000	1.5
+++ HookGenerator.hs	6 Apr 2005 20:47:00 -0000	1.6
@@ -32,38 +32,6 @@
 type Signatures = [Signature]
 
 -------------------------------------------------------------------------------
--- Handle broken Solaris
--------------------------------------------------------------------------------
-
--- If this type of arguement is True then we are compiling for
--- Sparc Solaris for which ghc does not know how to generate dynamic callbacks
--- with more than four arguments.
-type BrokenSolaris = Bool
-
--- Each callback is given a pointer to the object is was emitted from.
--- We need to take this into account when we talk about 4 arguments.
-fakeSignature :: BrokenSolaris -> Signature -> Bool
-fakeSignature brokenSolaris (_,args) = brokenSolaris &&
-				       sum (map sizeOf args) > 3
-  where
-    sizeOf Tunit   = 0
-    sizeOf Tbool   = 1
-    sizeOf Tchar   = 1
-    sizeOf Tuchar  = 1
-    sizeOf Tint    = 1
-    sizeOf Tuint   = 1
-    sizeOf Tlong   = 2
-    sizeOf Tulong  = 1
-    sizeOf Tenum   = 1
-    sizeOf Tflags  = 1
-    sizeOf Tfloat  = 2
-    sizeOf Tdouble = 4
-    sizeOf Tstring = 1
-    sizeOf Tboxed  = 1
-    sizeOf Tptr	   = 1
-    sizeOf Tobject = 1
-
--------------------------------------------------------------------------------
 -- Parsing
 -------------------------------------------------------------------------------
      
@@ -150,8 +118,8 @@
 identifier :: Types -> ShowS
 identifier Tunit    = ss "NONE"
 identifier Tbool    = ss "BOOL"
-identifier Tchar    = ss "BYTE"
-identifier Tuchar   = ss "UBYTE"
+identifier Tchar    = ss "CHAR"
+identifier Tuchar   = ss "UCHAR"
 identifier Tint	    = ss "INT"
 identifier Tuint    = ss "WORD"
 identifier Tlong    = ss "LONG"
@@ -168,17 +136,17 @@
 -- The monomorphic type which is used to export the function signature.
 rawtype :: Types -> ShowS
 rawtype Tunit    = ss "()"
-rawtype Tbool    = ss "{#type gboolean#}"
-rawtype Tchar    = ss "{#type gchar#}"
-rawtype Tuchar   = ss "{#type guchar#}"
-rawtype Tint	 = ss "{#type gint#}"
-rawtype Tuint    = ss "{#type guint#}"
-rawtype Tlong    = ss "{#type glong#}"
-rawtype Tulong   = ss "{#type gulong#}"
-rawtype Tenum    = ss "{#type gint#}"
-rawtype Tflags   = ss "{#type guint#}"
-rawtype Tfloat   = ss "{#type gfloat#}"
-rawtype Tdouble  = ss "{#type gdouble#}"
+rawtype Tbool    = ss "Bool"
+rawtype Tchar    = ss "Char"
+rawtype Tuchar   = ss "Char"
+rawtype Tint	 = ss "Int"
+rawtype Tuint    = ss "Word"
+rawtype Tlong    = ss "Int"
+rawtype Tulong   = ss "Word"
+rawtype Tenum    = ss "Int"
+rawtype Tflags   = ss "Word"
+rawtype Tfloat   = ss "Float"
+rawtype Tdouble  = ss "Double"
 rawtype Tstring  = ss "CString"
 rawtype Tboxed   = ss "Ptr ()"
 rawtype Tptr	 = ss "Ptr ()"
@@ -187,18 +155,18 @@
 -- The possibly polymorphic type which 
 usertype :: Types -> [Char] -> (ShowS,[Char])
 usertype Tunit	  cs = (ss "()",cs)
-usertype Tbool	  cs = (ss "Bool",cs)
-usertype Tchar	  cs = (ss "Char",cs)
-usertype Tuchar	  cs = (ss "Int",cs)
-usertype Tint	  (c:cs) = (sc c,cs) 
-usertype Tuint	  (c:cs) = (sc c,cs)
-usertype Tlong	  cs = (ss "Integer",cs)
-usertype Tulong	  cs = (ss "Integer",cs)
+usertype Tbool	  (c:cs) = (ss "Bool",cs)
+usertype Tchar	  (c:cs) = (ss "Char",cs)
+usertype Tuchar	  (c:cs) = (ss "Char",cs)
+usertype Tint	  (c:cs) = (ss "Int",cs) 
+usertype Tuint	  (c:cs) = (ss "Word",cs)
+usertype Tlong	  (c:cs) = (ss "Int",cs)
+usertype Tulong	  (c:cs) = (ss "Int",cs)
 usertype Tenum	  (c:cs) = (sc c,cs)
 usertype Tflags   cs = usertype Tenum cs
-usertype Tfloat	  cs = (ss "Float",cs)
-usertype Tdouble  cs = (ss "Double",cs)
-usertype Tstring  cs = (ss "String",cs)
+usertype Tfloat	  (c:cs) = (ss "Float",cs)
+usertype Tdouble  (c:cs) = (ss "Double",cs)
+usertype Tstring  (c:cs) = (ss "String",cs)
 usertype Tboxed   (c:cs) = (sc c,cs)
 usertype Tptr	  (c:cs) = (ss "Ptr ".sc c,cs)
 usertype Tobject  (c:cs) = (sc c.sc '\'',cs)
@@ -210,16 +178,10 @@
 --   to the context. Grrr.
 --
 context :: [Types] -> [Char] -> [ShowS]
-context (Tint:ts)     (c:cs) = ss "Num ".sc c.ss ", Integral ".sc c: 
-			       context ts cs
-context (Tuint:ts)    (c:cs) = ss "Num ".sc c: context ts cs
 context (Tenum:ts)    (c:cs) = ss "Enum ".sc c: context ts cs
-context (Tflags:ts)   cs     = context (Tenum:ts) cs
-context (Tboxed:ts)   (c:cs) = context ts cs
-context (Tptr:ts)     (c:cs) = --ss "Storable ".sc c:
-			       context ts cs
+context (Tflags:ts)   (c:cs) = ss "Flags ".sc c: context ts cs
 context (Tobject:ts)  (c:cs) = ss "GObjectClass ".sc c.sc '\'': context ts cs
-context (_:ts)	      cs     = context ts cs
+context (_:ts)	      (c:cs) = context ts cs
 context []	      _	     = []
 
 
@@ -229,32 +191,19 @@
 marshType (Tenum:ts)	(c:cs) = marshType ts cs
 marshType (Tflags:ts)	cs     = marshType (Tenum:ts) cs
 marshType (Tboxed:ts)	(c:cs) = ss "(Ptr ".sc c.ss " -> IO ".
-				 sc c.ss ") ->":
+				 sc c.ss ") -> ":
 				 marshType ts cs
 marshType (Tptr:ts)	(c:cs) = marshType ts cs
 marshType (Tobject:ts)	(c:cs) = marshType ts cs
-marshType (_:ts)        cs     = marshType ts cs
+marshType (_:ts)        (c:cs) = marshType ts cs
 marshType []		_      = []
 
-tyVarMapping :: [Types] -> [Char]
-tyVarMapping ts = tvm ts 'a'
-  where
-    tvm (Tint:ts)      c = c:tvm ts (succ c)
-    tvm (Tuint:ts)     c = c:tvm ts (succ c)	
-    tvm (Tenum:ts)     c = c:tvm ts (succ c)
-    tvm (Tflags:ts)    c = c:tvm ts (succ c)
-    tvm (Tboxed:ts)    c = c:tvm ts (succ c)
-    tvm (Tptr:ts)      c = c:tvm ts (succ c)
-    tvm (Tobject:ts)   c = c:tvm ts (succ c)
-    tvm (_:ts)	       c = c:tvm ts c
-    tvm _	       c = [] 
-
 -- arguments for user defined marshalling
 
 type ArgNo = Int
 
 marshArg :: Types -> ArgNo -> ShowS
-marshArg Tboxed   c = indent 1.ss "boxedPre".shows c.sc ' '
+marshArg Tboxed   c = ss "boxedPre".shows c.sc ' '
 marshArg _	  _ = id
 
 -- generate a name for every passed argument,
@@ -280,54 +229,40 @@
 -- describe marshalling between the data passed from the registered function
 -- to the user supplied Haskell function
 
-marshExec :: Types -> (Char,ArgNo) -> ShowS
-marshExec Tbool	   (c,n) = indent 4.ss "let bool".shows n.
-		    ss "' = toBool bool".shows n
-marshExec Tchar	   (c,n) = indent 4.ss "let char".shows n.
-		    ss "' = (toEnum.fromEnum) char".shows n
-marshExec Tuchar   (c,n) = indent 4.ss "let char".shows n.
-		    ss "' = (toEnum.fromEnum) char".shows n
-marshExec Tint	   (c,n) = indent 4.ss "let int".shows n.
-		    ss "' = fromIntegral int".shows n
-marshExec Tuint	   (c,n) = indent 4.ss "let int".shows n.
-		    ss "' = fromIntegral int".shows n
-marshExec Tlong	   (c,n) = indent 4.ss "let long".shows n.
-		    ss "' = toInteger long".shows n
-marshExec Tulong   (c,n) = indent 4.ss "let long".shows n.
-		    ss "' = toInteger long".shows n
-marshExec Tenum	   (c,n) = indent 4.ss "let enum".shows n.
-		    ss "' = (toEnum.fromEnum) enum".shows n
-marshExec Tflags   (c,n) = indent 4.ss "let flags".shows n.
-		    ss "' = (toEnum.fromEnum) flags".shows n
-marshExec Tfloat   (c,n) = indent 4.ss "let float".shows n.
-		    ss "' = (fromRational.toRational) float".shows n
-marshExec Tdouble   (c,n) = indent 4.ss "let double".shows n.
-		    ss "' = (fromRational.toRational) double".shows n
-marshExec Tstring  (c,n) = indent 4.ss "str".shows n.
-		    ss "' <- peekCString str".shows n
-marshExec Tboxed   (c,n) = indent 4.ss "box".shows n.ss "' <- boxedPre".
-		    shows n.ss " $ castPtr box".shows n
-marshExec Tptr	   (c,n) = indent 4.ss "let ptr".shows n.ss "' = castPtr ptr".
-		    shows n
-marshExec Tobject  (c,n) = indent 4.ss "objectRef obj".shows n.
-		    indent 4.ss "obj".shows n.
-		    ss "' <- liftM (fromGObject.mkGObject) $".
-		    indent 5.ss "newForeignPtr obj".shows n.
-		    ss " (objectUnref obj".shows n.sc ')'
-marshExec _	   _     = id
+marshExec :: Types -> ShowS -> Int -> (ShowS -> ShowS)
+marshExec Tbool	  arg _ body = body. sc ' '. arg
+marshExec Tchar	  arg _ body = body. sc ' '. arg
+marshExec Tuchar  arg _ body = body. sc ' '. arg
+marshExec Tint	  arg _ body = body. sc ' '. arg
+marshExec Tuint	  arg _ body = body. sc ' '. arg
+marshExec Tlong	  arg _ body = body. sc ' '. arg
+marshExec Tulong  arg _ body = body. sc ' '. arg
+marshExec Tenum	  arg _ body = body. ss " (toEnum ". arg. sc ')'
+marshExec Tflags  arg _ body = body. ss " (toFlags ". arg. sc ')'
+marshExec Tfloat  arg _ body = body. sc ' '. arg
+marshExec Tdouble arg _ body = body. sc ' '. arg
+marshExec Tstring arg _ body = indent 5. ss "peekUTFString ". arg. ss " >>= \\". arg. ss "\' ->".
+                               body. sc ' '. arg. sc '\''
+marshExec Tboxed  arg n body = indent 5. ss "boxedPre". ss (show n). ss " (castPtr ". arg. ss ") >>= \\". arg. ss "\' ->".
+                               body. sc ' '. arg. sc '\''
+marshExec Tptr	  arg _ body = body. ss " (castPtr ". arg. sc ')'
+marshExec Tobject arg _ body = indent 5.ss "makeNewGObject mkGObject (return ". arg. ss ") >>= \\". arg. ss "\' ->".
+                               body. ss " (fromGObject ". arg. ss "\')"
+--marshExec _	  _   _ = id
 
-marshRet :: Types -> ShowS
-marshRet Tunit	  = ss "id"
-marshRet Tbool	  = ss "fromBool"
-marshRet Tint	  = ss "fromIntegral"
-marshRet Tuint	  = ss "fromIntegral"
-marshRet Tlong	  = ss "fromIntegral"
-marshRet Tulong	  = ss "fromIntegral"
-marshRet Tenum	  = ss "(toEnum.fromEnum)"
-marshRet Tflags	  = ss "fromFlags"
-marshRet Tfloat	  = ss "(toRational.fromRational)"
-marshRet Tdouble  = ss "(toRational.fromRational)"
-marshRet _  = ss "(error \"Signal handlers cannot return structured types.\")"
+marshRet :: Types -> (ShowS -> ShowS)
+marshRet Tunit	 body = body
+marshRet Tbool	 body = body
+marshRet Tint	 body = body
+marshRet Tuint	 body = body
+marshRet Tlong	 body = body
+marshRet Tulong	 body = body
+marshRet Tenum	 body = indent 5. ss "liftM fromEnum $ ". body
+marshRet Tflags	 body = indent 5. ss "liftM fromFlags $ ". body
+marshRet Tfloat	 body = body
+marshRet Tdouble body = body
+marshRet Tstring body = body. indent 5. ss ">>= newUTFString"
+marshRet _       _    = error "Signal handlers cannot return structured types."
 
 -------------------------------------------------------------------------------
 -- generation of parameterized fragments
@@ -355,11 +290,13 @@
 mkMarshArg :: Signature -> [ShowS]
 mkMarshArg (ret,ts) = zipWith marshArg (ts++[ret]) [1..]
 
-mkArg sig = foldl (.) id $ mkMarshArg sig
+mkArg sig = foldl (.) (sc ' ') $ mkMarshArg sig
 
 mkMarshExec :: Signature -> ShowS
-mkMarshExec (_,ts) = foldl (.) id $ 
-		     zipWith marshExec ts (zip (tyVarMapping ts) [1..])
+mkMarshExec (ret,ts) = foldl (\body marshaler -> marshaler body) (indent 5.ss "user")
+                             (paramMarshalers++[returnMarshaler])
+  where paramMarshalers = [ marshExec t (nameArg t n) n | (t,n) <- zip ts [1..] ]
+        returnMarshaler = marshRet ret
 
 mkIdentifier :: Signature -> ShowS
 mkIdentifier (ret,[]) = identifier Tunit . ss "__".identifier ret
@@ -369,18 +306,18 @@
 mkRawtype :: Signature -> ShowS
 mkRawtype (ret,ts) = 
   foldl (.) id (map (\ty -> rawtype ty.ss " -> ") ts).
-  ss "IO (".rawtype ret.sc ')'
+  (case ret of
+      Tboxed  -> ss "IO (".rawtype ret.sc ')'
+      Tptr    -> ss "IO (".rawtype ret.sc ')'
+      Tobject -> ss "IO (".rawtype ret.sc ')'
+      _       -> ss "IO ".rawtype ret)
 
 mkLambdaArgs :: Signature -> ShowS
 mkLambdaArgs (_,ts) = foldl (.) id $ 
 		      zipWith (\a b -> nameArg a b.sc ' ') ts [1..]
 
-mkFuncArgs :: Signature -> ShowS
-mkFuncArgs (_,ts) = foldl (.) id $ 
-		    zipWith (\a b -> sc ' '.nameArg a b.sc '\'') ts [1..]
-
-mkMarshRet :: Signature -> ShowS
-mkMarshRet (ret,_) = marshRet ret
+--mkMarshRet :: Signature -> ShowS
+--mkMarshRet (ret,_) = marshRet ret
 
 -------------------------------------------------------------------------------
 -- start of code generation
@@ -389,35 +326,31 @@
 
 usage = do
  putStr $ "Program to generate callback hook for Gtk signals. Usage:\n"++
-   "HookGenerator <signatureFile> <bootPath> <outFile> [--broken]\n"++
+   "HookGenerator <signatureFile> <templateFile> <outFile> <moduleName>\n"++
    "where\n"++
    "  <signatureFile> is gtkmarshal.list from the the source Gtk+ tree\n"++
-   "  <bootPath>      the path where Signal.chs-boot? file can be found\n"++
+   "  <templateFile>  the name and path of the Signal.chs.template file\n"++
    "  <outFile>	      is the name and path of the output file.\n"++
-   "  --broken	      do not ask for callbacks with more than 4 words\n"
+   "  <moduleName>    the module name for <outFile>\n"
  exitWith $ ExitFailure 1
 
 main = do
   args <- getArgs
-  if (length args<3 || length args>4) then usage else do
-    let (br,[typesFile, bootPath, outFile]) = partition (=="--broken") args
-    let bootPath' = case reverse bootPath of
-	              [] -> "./"
-		      ('/':_) -> bootPath
-		      ('\\':_) -> bootPath
-		      _ -> bootPath++"/"
-    generateHooks typesFile bootPath' outFile (not (null br))
+  if (length args /= 4) then usage else do
+    let [typesFile, templateFile, outFile, outModuleName] = args
+    generateHooks typesFile templateFile outFile outModuleName
 
-generateHooks :: String -> String -> String -> BrokenSolaris -> IO ()
-generateHooks typesFile bootPath outFile brokenSolaris = do
+generateHooks :: String -> String -> String -> String -> IO ()
+generateHooks typesFile templateFile outFile outModuleName = do
     content <- readFile typesFile
     let sigs = parseSignatures content
-    template <- readFile (bootPath++"Signal.chs.template")
+    template <- readFile templateFile
     writeFile outFile $
       templateSubstitute template (\var ->
         case var of
+	  "MODULE_NAME"    -> ss outModuleName
           "MODULE_EXPORTS" -> genExport sigs
-          "MODULE_BODY"    -> foldl (.) id (map (generate brokenSolaris) sigs)
+          "MODULE_BODY"    -> foldl (.) id (map generate sigs)
           _ -> error var 
       ) ""
 
@@ -438,43 +371,19 @@
   where
     mkId sig = ss "connect_".mkIdentifier sig.sc ','.indent 1
 
-generate :: BrokenSolaris -> Signature -> ShowS
-generate bs sig = let ident = mkIdentifier sig in
-  indent 0.ss "type Tag_".ident.ss " = Ptr () -> ".
-  indent 1.mkRawtype sig.
-  indent 0.
-  (if fakeSignature bs sig then id else indent 0.ss "foreign".
-    ss " import ccall \"wrapper\" ").ss "mkHandler_".ident.ss " ::".
-  indent 1.ss "Tag_".ident.ss " -> ".
-  indent 1.ss "IO (FunPtr ".ss "Tag_".ident.sc ')'.
-  (if fakeSignature bs sig then 
-  indent 0.ss "mkHandler_".ident.ss " _ =".
-  indent 1.ss "error \"Callbacks of signature ".ident.ss "\\n\\".
-  indent 1.ss "\\are not supported on this architecture.\"" else id).
-  indent 0.
+generate :: Signature -> ShowS
+generate sig = let ident = mkIdentifier sig in
   indent 0.ss "connect_".ident.ss " :: ".
   indent 1.mkContext sig.ss " SignalName ->".
   mkType sig.
   indent 1.ss "ConnectAfter -> obj ->".
   indent 1.mkUserType sig.ss " ->".
   indent 1.ss "IO (ConnectId obj)".
-  indent 0.ss "connect_".ident.ss " signal".
-  mkArg sig.
-  indent 1.ss "after obj user =".
-  indent 1.ss "do".
-  indent 2.ss "hPtr <- mkHandler_".ident.
-  indent 3.ss "(\\_ ".mkLambdaArgs sig.ss "-> failOnGError $ do".
+  indent 0.ss "connect_".ident.ss " signal". mkArg sig. ss "after obj user =".
+  indent 1.ss "connectGeneric signal after obj action".
+  indent 1.ss "where action :: Ptr GObject -> ".mkRawtype sig.
+  indent 1.ss "      action _ ".mkLambdaArgs sig. sc '='.
+  indent 5.ss "failOnGError $".
   mkMarshExec sig.
-  indent 4.ss "liftM ".mkMarshRet sig.ss " $".
-  indent 5.ss "user".mkFuncArgs sig.
-  indent 3.sc ')'.
-  indent 2.ss "dPtr <- mkFunPtrDestructor hPtr".
-  indent 2.ss "sigId <- withCString signal $ \\nPtr ->".
-  indent 3.ss "withForeignPtr ((unGObject.toGObject) obj) $ \\objPtr ->".
-  indent 4.ss "{#call unsafe g_signal_connect_data#} (castPtr objPtr)".
-  indent 5.ss "nPtr (castFunPtr hPtr) nullPtr dPtr (fromBool after)".
-  indent 2.ss "return $ ConnectID sigId obj".
+--  indent 5.mkMarshRet sig. ss "user"
   indent 0
-
-
-

[Gtk2hs-commit] gtk2hs ChangeLog,1.426,1.427 Makefile.am,1.62,1.63 configure.ac,1.34,1.35

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

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

Modified Files:
	ChangeLog Makefile.am configure.ac 
Log Message:
Makefile.am: build support for new marshalign modules. We need GHC_INCLUDEDIR
so we can get at the GHC rts headder files.

configure.ac: provide GHC_INCLUDEDIR, which is bascially just
`$GHC --print-libdir`/include


Index: configure.ac
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/configure.ac,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -d -r1.34 -r1.35
--- configure.ac	23 Mar 2005 17:08:57 -0000	1.34
+++ configure.ac	6 Apr 2005 20:36:10 -0000	1.35
@@ -143,6 +143,11 @@
 AC_DEFINE_UNQUOTED(__GLASGOW_HASKELL__, $GHC_VERSION_NUMBER,
 	[Version number of GHC.])
 
+# Get ghc's lib and include dirs. We need the include dir since the HSGClosure
+# implementation needs to #include GHC's <Rts.h>
+GHC_LIBDIR=`$GHC --print-libdir`
+GHC_INCLUDEDIR=$GHC_LIBDIR/include
+
 dnl Check if the ghc compiler can generate dynamic callbacks with more than
 dnl 4 words worth of arguments. Hopefully one day the compiler will support
 dnl this.
@@ -609,6 +614,7 @@
 	    [GHC_DOCDIR=$withval])
 
 dnl Needed substitution.
+AC_SUBST(GHC_INCLUDEDIR)
 AC_SUBST(BUILT_IN_C2HS)
 AC_SUBST(MULTIPLE_CHS)
 AC_SUBST(FOUR_WORD_CALLBACK)

Index: Makefile.am
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -d -r1.62 -r1.63
--- Makefile.am	5 Apr 2005 18:38:22 -0000	1.62
+++ Makefile.am	6 Apr 2005 20:36:09 -0000	1.63
@@ -12,7 +12,8 @@
 	tools/hierarchyGen/hierarchy.list	\
 	tools/hierarchyGen/Hierarchy.chs.template \
 	sourceview/sourceview.h			\
-	gtk/wingtk.h
+	gtk/wingtk.h				\
+        glib/System/Glib/hsgclosure.h
 
 # There are no other files in these dirs and tar excludes empty dirs
 dist-hook:
@@ -237,16 +238,27 @@
 	glib/System/Glib/GObject.chs.pp		\
 	glib/System/Glib/Attributes.hs		\
 	glib/System/Glib/GError.chs.pp		\
-	glib/System/Glib/GList.chs
+	glib/System/Glib/GList.chs              \
+	glib/System/Glib/Signals.chs            \
+	glib/System/Glib/hsgclosure.c
 
-html_HSFILES_EXCLUDE = glib/System/Glib/FFI.hs
+html_HSFILES_EXCLUDE =				\
+	glib/System/Glib/FFI.hs			\
+	glib/System/Glib/Signals.hs
 
 glib_System_Glib_Types_hs_HCFLAGS	= -fglasgow-exts
 glib_System_Glib_GError_hs_HCFLAGS	= -fglasgow-exts
+glib_System_Glib_Signals_hs_HCFLAGS	= '-\#include"hsgclosure.h"'
 
 libHSglib_a_LIBADD =	\
 	glib/System/Glib/GObject_stub.o
 
+# Special CFLAGS for building the closure implementation since it needs
+# to #include <Rts.h> from GHC's include directory.
+glib/System/Glib/hsgclosure.o : glib/System/Glib/hsgclosure.c
+	$(CC) -c $< -o $@ $(GLIB_CFLAGS) -I$(GHC_INCLUDEDIR) 	\
+	-Wall -Wextra -Werror -Wno-unused-parameter
+
 am_libHSglib_a_OBJECTS = $(libHSglib_a_HSFILES:.hs=.$(OBJEXT))
 
 libHSglib_a_CHSPPFILES = $(filter %.chs.pp,$(libHSglib_a_SOURCES))

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.426
retrieving revision 1.427
diff -u -d -r1.426 -r1.427
--- ChangeLog	6 Apr 2005 20:31:27 -0000	1.426
+++ ChangeLog	6 Apr 2005 20:36:09 -0000	1.427
@@ -15,6 +15,12 @@
 	marshaling code. Basically adds connectGeneric which is used by all
 	the per-type marshaling functions.
 
+	* Makefile.am: build support for new marshalign modules. We need
+	GHC_INCLUDEDIR so we can get at the GHC rts headder files.
+
+	* configure.ac: provide GHC_INCLUDEDIR, which is bascially just 
+	`$GHC --print-libdir`/include
+
 2005-04-5 Duncan Coutts <du...@co...>
 
 	* glib/System/Glib/UTFString.hs: add some extra functions for

[Gtk2hs-commit] gtk2hs ChangeLog,1.425,1.426

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

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

Modified Files:
	ChangeLog 
Log Message:
Add Haskell-side interface to the new marshaling code. Basically adds
connectGeneric which is used by all the per-type marshaling functions.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.425
retrieving revision 1.426
diff -u -d -r1.425 -r1.426
--- ChangeLog	6 Apr 2005 20:20:15 -0000	1.425
+++ ChangeLog	6 Apr 2005 20:31:27 -0000	1.426
@@ -11,6 +11,10 @@
 	uses GHC's public rts api to invoke Haskell callbacks, passing
 	parameters of the appropriate types.
 
+	* glib/System/Glib/Signals.chs: add Haskell-side interface to the new
+	marshaling code. Basically adds connectGeneric which is used by all
+	the per-type marshaling functions.
+
 2005-04-5 Duncan Coutts <du...@co...>
 
 	* glib/System/Glib/UTFString.hs: add some extra functions for

[Gtk2hs-commit] gtk2hs/glib/System/Glib Signals.chs,NONE,1.1

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

Update of /cvsroot/gtk2hs/gtk2hs/glib/System/Glib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21793/glib/System/Glib

Added Files:
	Signals.chs 
Log Message:
Add Haskell-side interface to the new marshaling code. Basically adds
connectGeneric which is used by all the per-type marshaling functions.


--- NEW FILE: Signals.chs ---
-- -*-haskell-*-
--  Callback installers for the GIMP Toolkit (GTK) Binding for Haskell
--
--  Author : Axel Simon
--          
--  Created: 1 July 2000
--
--  Version $Revision: 1.1 $ from $Date: 2005/04/06 20:31:28 $
--
--  Copyright (c) 2000 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
-- #hide

-- |  The object system in the second version of GTK is based on GObject from
--    GLIB. This base class is rather primitive in that it only implements
--    ref and unref methods (and others that are not interesting to us). If
--    the marshall list mentions OBJECT it refers to an instance of this 
--    GObject which is automatically wrapped with a ref and unref call.
--    Structures which are not derived from GObject have to be passed as
--    BOXED which gives the signal connect function a possiblity to do the
--    conversion into a proper ForeignPtr type. In special cases the signal
--    connect function use a PTR type which will then be mangled in the
--    user function directly. The latter is needed if a signal delivers a
--    pointer to a string and its length in a separate integer.
--
module System.Glib.Signals (
  SignalName,
  ConnectAfter,
  ConnectId,
  connectGeneric,
  disconnect
  ) where

import System.Glib.FFI
import System.Glib.UTFString   (peekUTFString, newUTFString)
import System.Glib.GError      (failOnGError)
{#import System.Glib.GObject#}

{#context lib="glib" prefix="g" #}


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

type ConnectAfter = Bool

type SignalName = String

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

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

{# pointer *GClosure newtype #}

connectGeneric :: GObjectClass obj =>
    SignalName
 -> ConnectAfter
 -> obj
 -> handler
 -> IO (ConnectId obj)
connectGeneric signal after obj user = do
  sptr <- newStablePtr user
  gclosurePtr <- hsg_closure_new sptr
  sigId <- 
    withCString signal $ \signalPtr -> 
    withForeignPtr ((unGObject.toGObject) obj) $ \objPtr ->
    {# call g_signal_connect_closure #}
      (castPtr objPtr)
      signalPtr
      (GClosure gclosurePtr)
      (fromBool after)
  return $ ConnectID sigId obj

foreign import ccall unsafe "hsg_closure_new"
  hsg_closure_new :: StablePtr a -> IO (Ptr GClosure)