gtk2hs-commit — Mailing list for Darcs commit messages.

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Layout AspectFrame.chs,NONE,1.1 Fixed.chs,NONE,1.1 HBox.chs,NONE,1.1 HButtonBox.chs,NONE,1.1 HPaned.chs,NONE,1.1

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

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

Added Files:
	AspectFrame.chs Fixed.chs HBox.chs HButtonBox.chs HPaned.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: HPaned.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget HPaned
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:23:11 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--

module Graphics.UI.Gtk.Layout.HPaned (
  HPaned,
  HPanedClass,
  castToHPaned,
  hPanedNew
  ) 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#}

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

-- methods

-- | 
--
hPanedNew :: IO HPaned
hPanedNew = makeNewObject mkHPaned $ liftM castPtr {#call unsafe hpaned_new#}

--- NEW FILE: AspectFrame.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget AspectFrame
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:23:11 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- A frame that constrains its child to a particular aspect ratio.
--
-- * The 'AspectFrame' is useful when you want pack a widget so 
--   that it can 
--   resize but always retains the same aspect ratio. For instance, one might
--   be drawing a small preview of a larger image. 'AspectFrame'
--   derives from
--   'Frame', so it can draw a label and a frame around the child. 
--   The frame
--   will be \"shrink-wrapped\" to the size of the child.
--

module Graphics.UI.Gtk.Layout.AspectFrame (
  AspectFrame,
  AspectFrameClass,
  castToAspectFrame,
  aspectFrameNew,
  aspectFrameSet
  ) where

import Monad	(liftM)
import Maybe	(isNothing)

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

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

-- methods

-- | Create an AspectFrame widget.
--
-- * If ratio is not given, the aspect ratio is taken from the child widget.
--
-- * The frame may be augmented with a label which can be set by
--   @frameSetLabel@.
--
aspectFrameNew :: Float -> Float -> Maybe Float -> IO AspectFrame
aspectFrameNew xalign yalign ratio = makeNewObject mkAspectFrame $
  liftM castPtr $ {#call unsafe aspect_frame_new#} nullPtr (realToFrac xalign) 
  (realToFrac yalign) (maybe 0.0 realToFrac ratio) (fromBool $ isNothing ratio)


-- | Change the space use behaviour of an
-- 'AspectFrame'.
--
aspectFrameSet :: AspectFrameClass af => af -> Float -> Float -> Maybe Float ->
                  IO ()
aspectFrameSet af xalign yalign ratio = {#call aspect_frame_set#} 
  (toAspectFrame af) (realToFrac xalign) (realToFrac yalign) 
  (maybe 0.0 realToFrac ratio) (fromBool $ isNothing ratio)

--- NEW FILE: HBox.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget HBox
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:23:11 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This is a special version of 'Box'. This widget shows its child 
-- widgets in a horizontal line.
--

module Graphics.UI.Gtk.Layout.HBox (
  HBox,
  HBoxClass,
  castToHBox,
  hBoxNew
  ) 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#}

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

-- methods

-- | 
-- Create a container that shows several children horizontally. If 
-- @homogeneous@
-- is set all children will be allotted the same amount of space. There will be
-- @spacing@ pixel between each two children.
--
hBoxNew :: Bool -> Int -> IO HBox
hBoxNew homogeneous spacing = makeNewObject mkHBox $ liftM castPtr $
  {#call unsafe hbox_new#} (fromBool homogeneous) (fromIntegral spacing)


--

--- NEW FILE: Fixed.chs ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Fixed
--
--  Author : Duncan Coutts
--  Created: 2 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--  documentation Copyright (c) 1995..2000 the GTK+ Team
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- The 'Fixed' widget is a container which can place child widgets at fixed
-- positions and with fixed sizes, given in pixels. 'Fixed' performs no
-- automatic layout management.
--
-- For most applications, you should not use this container! It keeps you from
-- having to learn about the other GTK+ containers, but it results in broken
-- applications.
--
-- * Themes, which may change widget sizes.
--
-- * Fonts other than the one you used to write the app will of course change
-- the size of widgets containing text; keep in mind that users may use a larger
-- font because of difficulty reading the default, or they may be using Windows
-- or the framebuffer port of GTK+, where different fonts are available.
--
-- * Translation of text into other languages changes its size. Also, display of
-- non-English text will use a different font in many cases. 
--
-- In addition, the fixed widget can't properly be mirrored in right-to-left
-- languages such as Hebrew and Arabic. i.e. normally GTK+ will flip the
-- interface to put labels to the right of the thing they label, but it can't do
-- that with 'Fixed'. So your application will not be usable in right-to-left
-- languages.
--
-- Finally, fixed positioning makes it kind of annoying to add\/remove GUI
-- elements, since you have to reposition all the other elements. This is a
-- long-term maintenance problem for your application.
--
-- If you know none of these things are an issue for your application, and
-- prefer the simplicity of 'Fixed', by all means use the widget. But you should
-- be aware of the tradeoffs. 
--

module Graphics.UI.Gtk.Layout.Fixed  (
  fixedNew,
  fixedPut,
  fixedMove,
  fixedSetHasWindow,
  fixedGetHasWindow
  ) 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#}

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


-- | Creates a new 'Fixed' container.
--
fixedNew :: IO Fixed
fixedNew = makeNewObject mkFixed $ liftM castPtr $
  {#call unsafe fixed_new#}

-- | Adds a widget to a 'Fixed' container at the given position.
--
fixedPut :: (FixedClass obj, WidgetClass widget) => obj
         -> widget -> (Int, Int) -> IO ()
fixedPut obj widget (x, y) =
  {#call fixed_put#} (toFixed obj) (toWidget widget)
    (fromIntegral x) (fromIntegral y)

-- | Moves a child of a 'Fixed' container to the given position.
--
fixedMove :: (FixedClass obj, WidgetClass widget) => obj
         -> widget -> (Int, Int) -> IO ()
fixedMove obj widget (x, y) =
  {#call fixed_move#} (toFixed obj) (toWidget widget)
    (fromIntegral x) (fromIntegral y)

-- | Sets whether the 'Fixed' widget is created with a separate "DrawWindow" for
-- its window or not. (By default, it will be created with no separate
-- "DrawWindow"). This function must be called while the widget is not realized,
-- for instance, immediately after the window is created.
--
fixedSetHasWindow :: FixedClass obj => obj -> Bool -> IO ()
fixedSetHasWindow obj hasWindow =
  {#call fixed_set_has_window#} (toFixed obj) (fromBool hasWindow)

-- | Gets whether the 'Fixed' container has its own "DrawWindow". See
-- 'fixedSetHasWindow'.
--
fixedGetHasWindow :: FixedClass obj => obj -> IO Bool
fixedGetHasWindow obj = liftM toBool $
  {#call unsafe fixed_get_has_window#} (toFixed obj)

--- NEW FILE: HButtonBox.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget HButtonBox
--
--  Author : Matthew Walton
--          
--  Created: 29 April 2004
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:23:11 $
--
--  Copyright (c) 2004 Matthew Walton
--
--  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.
--
-- |
--

module Graphics.UI.Gtk.Layout.HButtonBox (
  HButtonBox,
  HButtonBoxClass,
  castToHButtonBox,
  hButtonBoxNew
  ) 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#}

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

--methods

-- | 
--
hButtonBoxNew :: IO HButtonBox
hButtonBoxNew = makeNewObject mkHButtonBox $
  liftM castPtr {#call unsafe hbutton_box_new#}

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Layout Alignment.chs.pp,NONE,1.1 Expander.chs.pp,NONE,1.1 Notebook.chs.pp,NONE,1.1

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

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

Added Files:
	Alignment.chs.pp Expander.chs.pp Notebook.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Expander.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Expander
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- An Expander allows the user to hide or show its child by clicking on an
-- expander triangle similar to the triangles used in a TreeView.
--
-- Normally you use an expander as you would use any other descendant of GtkBin
-- you create the child widget and use containerAdd to add it to the expander.
-- When the expander is toggled, it will take care of showing and hiding the
-- child automatically.
--
-- * Added in GTK+ 2.4
--
module Graphics.UI.Gtk.Layout.Expander  (
#if GTK_CHECK_VERSION(2,4,0)
  Expander,
  ExpanderClass,
  expanderNew,
  expanderNewWithMnemonic,
  expanderSetExpanded,
  expanderGetExpanded,
  expanderSetSpacing,
  expanderGetSpacing,
  expanderSetLabel,
  expanderGetLabel,
  expanderSetUseUnderline,
  expanderGetUseUnderline,
  expanderSetUseMarkup,
  expanderGetUseMarkup,
  expanderSetLabelWidget,
  expanderGetLabelWidget,
  onActivate,
  afterActivate
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object
{#import Graphics.UI.Gtk.Types#}
import Graphics.UI.Gtk.Signals

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

expanderNew :: String -> IO Expander
expanderNew label = 
 makeNewObject mkExpander $ liftM castPtr $
 withUTFString label $ \strPtr ->
 {# call gtk_expander_new #} strPtr

expanderNewWithMnemonic :: String -> IO Expander
expanderNewWithMnemonic label =
 makeNewObject mkExpander $ liftM castPtr $
 withUTFString label $ \strPtr -> 
 {# call gtk_expander_new_with_mnemonic #} strPtr

expanderSetExpanded :: Expander -> Bool -> IO ()
expanderSetExpanded expander expanded = 
 {# call gtk_expander_set_expanded #} expander (fromBool expanded)

expanderGetExpanded :: Expander -> IO Bool
expanderGetExpanded expander = liftM toBool $
 {# call gtk_expander_get_expanded #} expander

expanderSetSpacing :: Expander -> Int -> IO ()
expanderSetSpacing expander spacing = 
 {# call gtk_expander_set_spacing #} expander (fromIntegral spacing)

expanderGetSpacing :: Expander -> IO Int
expanderGetSpacing expander = liftM fromIntegral $
 {# call gtk_expander_get_spacing #} expander

expanderSetLabel :: Expander -> String -> IO ()
expanderSetLabel expander label =
 withUTFString label $ \strPtr ->
 {# call gtk_expander_set_label #} expander strPtr

expanderGetLabel :: Expander -> IO String
expanderGetLabel expander = do
 strPtr <- {# call gtk_expander_get_label #} expander
 peekUTFString strPtr

expanderSetUseUnderline :: Expander -> Bool -> IO ()
expanderSetUseUnderline expander useUnderline = 
 {# call gtk_expander_set_use_underline #} expander (fromBool useUnderline)

expanderGetUseUnderline :: Expander -> IO Bool
expanderGetUseUnderline expander = liftM toBool $
 {# call gtk_expander_get_use_underline #} expander

expanderSetUseMarkup :: Expander -> Bool -> IO ()
expanderSetUseMarkup expander useMarkup = 
 {# call gtk_expander_set_use_markup #} expander (fromBool useMarkup)

expanderGetUseMarkup :: Expander -> IO Bool
expanderGetUseMarkup expander = liftM toBool $
 {# call gtk_expander_get_use_markup #} expander

expanderSetLabelWidget :: WidgetClass widget => Expander -> widget -> IO ()
expanderSetLabelWidget expander widget = 
 {# call gtk_expander_set_label_widget #} expander (toWidget widget)

expanderGetLabelWidget :: Expander -> IO Widget
expanderGetLabelWidget expander = 
 makeNewObject mkWidget $
 {# call gtk_expander_get_label_widget #} expander

onActivate :: Expander -> IO () -> IO (ConnectId Expander)
afterActivate :: Expander -> IO () -> IO (ConnectId Expander)
onActivate = connect_NONE__NONE "activate" False
afterActivate = connect_NONE__NONE "activate" True

#endif

--- NEW FILE: Alignment.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Alignment
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:22:09 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
module Graphics.UI.Gtk.Layout.Alignment (
  Alignment,
  AlignmentClass,
  castToAlignment,
  alignmentNew,
  alignmentSet
#if GTK_CHECK_VERSION(2,4,0)
 ,alignmentSetPadding,
  alignmentGetPadding
#endif
  ) 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#}

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

-- methods

-- | Create an alignment widget. This widget tells
-- its child widget how to use the given space.
--
alignmentNew :: Float -> Float -> Float -> Float -> IO Alignment
alignmentNew yscale xalign yalign xscale = makeNewObject mkAlignment $
  liftM castPtr $ {#call unsafe alignment_new#} (realToFrac xalign) 
  (realToFrac yalign) (realToFrac xscale) (realToFrac yscale)


-- | Change the space use behaviour of an 'Alignment'.
--
alignmentSet :: AlignmentClass al => al -> Float -> Float -> Float -> Float ->
                IO ()
alignmentSet al xalign yalign xscale yscale = {#call alignment_set#}
  (toAlignment al) (realToFrac xalign) (realToFrac yalign)
  (realToFrac xscale) (realToFrac yscale)

#if GTK_CHECK_VERSION(2,4,0)
-- | Sets the padding on the different sides of the widget.
--
alignmentSetPadding :: AlignmentClass al => al -> Int -> Int -> Int -> Int ->
                       IO ()
alignmentSetPadding al top bottom left right =
  {# call gtk_alignment_set_padding #} (toAlignment al)
    (fromIntegral top) (fromIntegral bottom)
    (fromIntegral left) (fromIntegral right)

-- | Gets the padding on the different sides of the widget.
--
alignmentGetPadding :: AlignmentClass al => al -> IO (Int, Int, Int, Int)
alignmentGetPadding al =
  alloca $ \topPtr -> alloca $ \bottomPtr ->
  alloca $ \leftPtr -> alloca $ \rightPtr -> do
  {# call gtk_alignment_get_padding #} (toAlignment al)
    topPtr bottomPtr leftPtr rightPtr
  top    <- peek topPtr
  bottom <- peek bottomPtr
  left   <- peek leftPtr
  right  <- peek rightPtr
  return (fromIntegral top, fromIntegral bottom
         ,fromIntegral left, fromIntegral right)
  
#endif

--- NEW FILE: Notebook.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Notebook
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:22:09 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This widget can display several pages of widgets. Each page can be selected
-- by a tab at the top of the widget. It is useful in dialogs where a lot of
-- information has to be displayed.
--
-- TODO
--
-- * The signals focus-tab and select-page are not bound because it is unclear
--   what they mean. As far as I can see they are not emitted anywhere.
--
module Graphics.UI.Gtk.Layout.Notebook (
  Notebook,
  NotebookClass,
  castToNotebook,
  notebookNew,
  notebookAppendPage,
  notebookAppendPageMenu,
  notebookPrependPage,
  notebookPrependPageMenu,
  notebookInsertPage,
  notebookInsertPageMenu,
  notebookRemovePage,
  notebookPageNum,
  notebookSetCurrentPage,
  notebookNextPage,
  notebookPrevPage,
  notebookReorderChild,
  PositionType(..),
  notebookSetTabPos,
  notebookGetTabPos,
  notebookSetShowTabs,
  notebookGetShowTabs,
  notebookSetShowBorder,
  notebookSetScrollable,
  notebookGetScrollable,
#ifndef DISABLE_DEPRECATED
  notebookSetTabBorder,
  notebookSetTabHBorder,
  notebookSetTabVBorder,
#endif
  notebookSetPopup,
  notebookGetCurrentPage,
  notebookSetMenuLabel,
  notebookGetMenuLabel,
  notebookSetMenuLabelText,
  notebookGetMenuLabelText,
  notebookGetNthPage,
#if GTK_CHECK_VERSION(2,2,0)
  notebookGetNPages,
#endif
  notebookGetTabLabel,
  notebookGetTabLabelText,
  Packing(..), PackType(..),
  notebookQueryTabLabelPacking,
  notebookSetTabLabelPacking,
#ifndef DISABLE_DEPRECATED
  notebookSetHomogeneousTabs,
#endif
  notebookSetTabLabel,
  notebookSetTabLabelText,
  onSwitchPage,
  afterSwitchPage
  ) where

import Monad	(liftM)
import Maybe	(maybe)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.Display.Label	(labelNew)
import Graphics.UI.Gtk.General.Enums	(Packing(..), PackType(..), PositionType(..))

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

-- methods

-- | Create a new notebook.
--
notebookNew :: IO Notebook
notebookNew  = makeNewObject mkNotebook $ 
  liftM castPtr {#call unsafe notebook_new#}

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the right of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookAppendPageMenu'.
--
-- * Returns index (starting from 0) of the appended page in the notebook, or -1
-- if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookAppendPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO Int
notebookAppendPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  liftM fromIntegral $
    {#call notebook_append_page#} (toNotebook nb) (toWidget child) 
      (toWidget tab)

#else
-- | Insert a new tab to the right of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context popup menu is enabled, this name will also appear in the menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookAppendPageMenu'.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later.
--
notebookAppendPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO ()
notebookAppendPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  {#call notebook_append_page#} (toNotebook nb) (toWidget child) (toWidget tab)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the right of the existing tabs.
--
-- Like 'notebookAppendPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * Returns the index (starting from 0) of the appended page in the notebook,
-- or -1 if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookAppendPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO Int
notebookAppendPageMenu nb child tabWidget menuWidget = liftM fromIntegral $
  {#call notebook_append_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)

#else
-- | Insert a new tab to the right of the existing tabs.
--
-- Like 'notebookAppendPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later
--
notebookAppendPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO ()
notebookAppendPageMenu nb child tabWidget menuWidget =
  {#call notebook_append_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the left of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookPrependPageMenu'.
--
-- * Returns index (starting from 0) of the prepended page in the notebook, or -1
-- if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookPrependPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO Int
notebookPrependPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  liftM fromIntegral $
    {#call notebook_prepend_page#} (toNotebook nb) (toWidget child) 
      (toWidget tab)

#else
-- | Insert a new tab to the left of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context popup menu is enabled, this name will also appear in the menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookPrependPageMenu'.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later.
--
notebookPrependPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO ()
notebookPrependPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  {#call notebook_prepend_page#} (toNotebook nb) (toWidget child) 
    (toWidget tab)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the left of the existing tabs.
--
-- Like 'notebookPrependPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * Returns the index (starting from 0) of the prepended page in the notebook,
-- or -1 if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookPrependPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO Int
notebookPrependPageMenu nb child tabWidget menuWidget = liftM fromIntegral $
  {#call notebook_prepend_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)

#else
-- | Insert a new tab to the left of the existing tabs.
--
-- Like 'notebookPrependPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later
--
notebookPrependPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO ()
notebookPrependPageMenu nb child tabWidget menuWidget =
  {#call notebook_prepend_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookInsertPageMenu'.
--
-- * Returns index (starting from 0) of the inserted page in the notebook, or -1
-- if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookInsertPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child  -- ^ Widget to use as the contents of the page
                   -> String -- ^ Label for the page.
                   -> Int    -- ^ Position for the new page.
                   -> IO Int
notebookInsertPage nb child tabLabel pos = do
  tab <- labelNew (Just tabLabel)
  liftM fromIntegral $
    {#call notebook_insert_page#} (toNotebook nb) (toWidget child) 
      (toWidget tab) (fromIntegral pos)

#else
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookInsertPageMenu'.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later.
--
notebookInsertPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child  -- ^ Widget to use as the contents of the page
                   -> String -- ^ Label for the page.
                   -> Int    -- ^ Position for the new page.
                   -> IO ()
notebookInsertPage nb child tabLabel pos = do
  tab <- labelNew (Just tabLabel)
  {#call notebook_insert_page#} (toNotebook nb) (toWidget child) 
    (toWidget tab) (fromIntegral pos)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- Like 'notebookInsertPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * Returns the index (starting from 0) of the inserted page in the notebook,
-- or -1 if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookInsertPageMenu ::(NotebookClass nb, WidgetClass child, 
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> Int    -- ^ Position for the new page.
  -> IO Int
notebookInsertPageMenu nb child tabWidget menuWidget pos = liftM fromIntegral $
  {#call notebook_insert_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget) (fromIntegral pos)

#else
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- Like 'notebookInsertPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later
--
notebookInsertPageMenu ::(NotebookClass nb, WidgetClass child, 
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> Int    -- ^ Position for the new page.
  -> IO ()
notebookInsertPageMenu nb child tabWidget menuWidget pos =
  {#call notebook_insert_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget) (fromIntegral pos)
#endif

-- | Remove a specific page from the notebook, counting from 0.
--
notebookRemovePage :: NotebookClass nb => nb -> Int -> IO ()
notebookRemovePage nb pos = 
  {#call notebook_remove_page#} (toNotebook nb) (fromIntegral pos)

-- | Query the page the child widget is contained in.
--
-- * The function returns the page number if the child was found, Nothing
--   otherwise.
--
notebookPageNum :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                   IO (Maybe Int)
notebookPageNum nb child = 
  liftM (\page -> if page==(-1) then Nothing else Just (fromIntegral page)) $
  {#call unsafe notebook_page_num#} (toNotebook nb) (toWidget child)

-- | Move to the specified page of the notebook.
--
-- * If the position is out of range (e.g. negative) select the last page.
--
notebookSetCurrentPage :: NotebookClass nb => nb -> Int -> IO ()
notebookSetCurrentPage nb pos =
  {#call notebook_set_current_page#} (toNotebook nb) (fromIntegral pos)

-- | Move to the right neighbour of the current page.
--
-- * Nothing happens if there is no such page.
--
notebookNextPage :: NotebookClass nb => nb -> IO ()
notebookNextPage nb = {#call notebook_next_page#} (toNotebook nb)

-- | Move to the left neighbour of the current page.
--
-- * Nothing happens if there is no such page.
--
notebookPrevPage :: NotebookClass nb => nb -> IO ()
notebookPrevPage nb = {#call notebook_prev_page#} (toNotebook nb)

-- | Move a page withing the notebook.
--
notebookReorderChild :: (NotebookClass nb, WidgetClass w) => nb -> w -> Int ->
                        IO ()
notebookReorderChild nb child pos = {#call notebook_reorder_child#}
  (toNotebook nb) (toWidget child) (fromIntegral pos)

-- | Specify at which border the tabs should be drawn.
--
notebookSetTabPos :: NotebookClass nb => nb -> PositionType -> IO ()
notebookSetTabPos nb pt = {#call notebook_set_tab_pos#}
  (toNotebook nb) ((fromIntegral.fromEnum) pt)

-- | Gets the edge at which the tabs for switching pages in the notebook are
-- drawn.
--
notebookGetTabPos :: NotebookClass nb => nb -> IO PositionType
notebookGetTabPos nb = liftM (toEnum.fromIntegral) $
  {#call unsafe notebook_get_tab_pos#} (toNotebook nb)

-- | Show or hide the tabs of a notebook.
--
notebookSetShowTabs :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetShowTabs nb showTabs = {#call notebook_set_show_tabs#}
  (toNotebook nb) (fromBool showTabs)

-- | Returns whether the tabs of the notebook are shown.
--
notebookGetShowTabs :: NotebookClass nb => nb -> IO Bool
notebookGetShowTabs nb =
  liftM toBool $ {#call unsafe notebook_get_show_tabs#} (toNotebook nb)

-- | In case the tabs are not shown, specify whether to draw a border around
-- the notebook.
--
notebookSetShowBorder :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetShowBorder nb showBorder = {#call notebook_set_show_border#}
  (toNotebook nb) (fromBool showBorder)

-- | Returns whether a bevel will be drawn around the notebook pages.
--
notebookGetShowBorder :: NotebookClass nb => nb -> IO Bool
notebookGetShowBorder nb =
  liftM toBool $ {#call unsafe notebook_get_show_border#} (toNotebook nb)

-- | Set whether scroll bars will be added in case the notebook has too many
-- tabs to fit the widget size.
--
notebookSetScrollable :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetScrollable nb scrollable = {#call unsafe notebook_set_scrollable#}
  (toNotebook nb) (fromBool scrollable)

-- | Returns whether the tab label area has arrows for scrolling.
--
notebookGetScrollable :: NotebookClass nb => nb -> IO Bool
notebookGetScrollable nb = liftM toBool $
  {#call unsafe notebook_get_scrollable#} (toNotebook nb)

#ifndef DISABLE_DEPRECATED
-- | Set the width of the borders of the tab labels.
--
-- * Sets both vertical and horizontal widths.
--
notebookSetTabBorder :: NotebookClass nb => nb -> Int -> IO ()
notebookSetTabBorder nb width = {#call notebook_set_tab_border#}
  (toNotebook nb) (fromIntegral width)

-- | Set the width of the borders of the tab labels.
--
-- * Sets horizontal widths.
--
notebookSetTabHBorder :: NotebookClass nb => nb -> Int -> IO ()
notebookSetTabHBorder nb width = {#call notebook_set_tab_hborder#}
  (toNotebook nb) (fromIntegral width)

-- | Set the width of the borders of the tab labels.
--
-- * Sets vertical widths.
--
notebookSetTabVBorder :: NotebookClass nb => nb -> Int -> IO ()
notebookSetTabVBorder nb width = {#call notebook_set_tab_vborder#}
  (toNotebook nb) (fromIntegral width)
#endif

-- | Enable or disable context menus with all tabs in it.
--
notebookSetPopup :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetPopup nb enable = (if enable 
  then {#call notebook_popup_enable#} else {#call notebook_popup_disable#})
  (toNotebook nb)

-- | Query the currently selected page.
--
-- * Returns -1 if notebook has no pages.
--
notebookGetCurrentPage :: NotebookClass nb => nb -> IO Int
notebookGetCurrentPage nb = liftM fromIntegral $
  {#call unsafe notebook_get_current_page#} (toNotebook nb)

-- | Changes the menu label for the page containing the given child widget.
--
notebookSetMenuLabel :: (NotebookClass nb, WidgetClass ch, WidgetClass label)
                     => nb -> ch -> Maybe label -> IO ()
notebookSetMenuLabel nb child label =
  {#call notebook_set_menu_label#} (toNotebook nb) (toWidget child)
    (maybe (Widget nullForeignPtr) toWidget label)

-- | Extract the menu label from the given @child@.
--
-- * Returns Nothing if @child@ was not found.
--
notebookGetMenuLabel :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                        IO (Maybe Label)
notebookGetMenuLabel nb child = do
  wPtr <- {#call unsafe notebook_get_menu_label#} 
    (toNotebook nb) (toWidget child)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkLabel $ return $ castPtr wPtr

-- | Creates a new label and sets it as the menu label of the given child
-- widget.
--
notebookSetMenuLabelText :: (NotebookClass nb, WidgetClass ch)
                         => nb -> ch -> String -> IO ()
notebookSetMenuLabelText nb child label =
  withUTFString label $ \labelPtr ->
  {#call notebook_set_menu_label_text#} (toNotebook nb)
    (toWidget child) labelPtr

-- | Retrieves the text of the menu label for the page containing the given
-- child widget.
--
notebookGetMenuLabelText :: (NotebookClass nb, WidgetClass ch)
                         => nb -> ch -> IO (Maybe String)
notebookGetMenuLabelText nb child = do
  labelPtr <- {#call unsafe notebook_get_menu_label_text#} (toNotebook nb)
    (toWidget child)
  maybePeek peekUTFString labelPtr

-- | Retrieve the child widget at the given position (starting from 0).
--
-- * Returns Nothing if the index is out of bounds.
--
notebookGetNthPage :: NotebookClass nb => nb -> Int -> IO (Maybe Widget)
notebookGetNthPage nb pos = do
  wPtr <- {#call unsafe notebook_get_nth_page#} 
    (toNotebook nb) (fromIntegral pos)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget $ return wPtr

#if GTK_CHECK_VERSION(2,2,0)

-- | Get the number of pages in a notebook.
--
-- * Only available in Gtk 2.2 and higher.
--
notebookGetNPages :: NotebookClass nb => nb -> IO Int
notebookGetNPages nb = liftM fromIntegral $
  {#call unsafe notebook_get_n_pages#} (toNotebook nb)

#endif

-- | Extract the tab label from the given @child@.
--
-- * Nothing is returned if no tab label has specifically been set for the
-- child.
--
notebookGetTabLabel :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                       IO (Maybe Widget)
notebookGetTabLabel nb child = do
  wPtr <- {#call unsafe notebook_get_tab_label#} 
    (toNotebook nb) (toWidget child)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget $ return wPtr

-- | Retrieves the text of the tab label for the page containing the given child
-- widget.
--
notebookGetTabLabelText :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                       IO (Maybe String)
notebookGetTabLabelText nb child = do
  labelPtr <- {#call unsafe notebook_get_tab_label_text#} (toNotebook nb)
    (toWidget child)
  maybePeek peekUTFString labelPtr

-- | Query the packing attributes of the given child.
--
notebookQueryTabLabelPacking :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                                IO (Packing,PackType)
notebookQueryTabLabelPacking nb child = 
  alloca $ \expPtr -> alloca $ \fillPtr -> alloca $ \packPtr -> do
    {#call unsafe notebook_query_tab_label_packing#} (toNotebook nb)
      (toWidget child) expPtr fillPtr packPtr
    expand <- liftM toBool $ peek expPtr
    fill <- liftM toBool $ peek fillPtr
    pt <- liftM (toEnum.fromIntegral) $ peek packPtr
    return (if fill then PackGrow else 
             (if expand then PackRepel else PackNatural),
	    pt)

-- | Set the packing attributes of the given child.
--
notebookSetTabLabelPacking :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                              Packing -> PackType -> IO ()
notebookSetTabLabelPacking nb child pack pt = 
  {#call notebook_set_tab_label_packing#} (toNotebook nb) (toWidget child)
    (fromBool $ pack/=PackNatural) (fromBool $ pack==PackGrow) 
    ((fromIntegral.fromEnum) pt)

#ifndef DISABLE_DEPRECATED
-- | Sets whether the tabs must have all the same size or not.
--
notebookSetHomogeneousTabs :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetHomogeneousTabs nb hom = {#call notebook_set_homogeneous_tabs#}
  (toNotebook nb) (fromBool hom)
#endif

-- | Set a new tab label for a given page.
--
notebookSetTabLabel :: (NotebookClass nb, WidgetClass ch, WidgetClass tab) => 
                       nb -> ch -> tab -> IO ()
notebookSetTabLabel nb child tab = {#call notebook_set_tab_label#}
  (toNotebook nb) (toWidget child) (toWidget tab)

-- | Creates a new label and sets it as the tab label for the given page.
--
notebookSetTabLabelText :: (NotebookClass nb, WidgetClass ch) => 
                       nb -> ch -> String -> IO ()
notebookSetTabLabelText nb child label =
  withUTFString label $ \labelPtr ->
  {#call notebook_set_tab_label_text#} (toNotebook nb) (toWidget child) labelPtr


-- signals

-- | This signal is emitted when a new page is
-- selected.
--
onSwitchPage, afterSwitchPage :: NotebookClass nb => nb -> (Int -> IO ()) ->
                                 IO (ConnectId nb)
onSwitchPage nb fun = connect_BOXED_WORD__NONE "switch-page" 
		      (const $ return ()) False nb 
		      (\_ page -> fun (fromIntegral page))
afterSwitchPage nb fun = connect_BOXED_WORD__NONE "switch-page" 
			 (const $ return ()) True nb 
			 (\_ page -> fun (fromIntegral page))


 

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/General Enums.chs.pp,NONE,1.1 IconFactory.chs.pp,NONE,1.1

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

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

Added Files:
	Enums.chs.pp IconFactory.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: IconFactory.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) IconFactory
--
--  Author : Axel Simon
--          
--  Created: 24 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:20:54 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This module provides access to IconFactory, IconSet and IconSource.
--
-- TODO
--
-- * The following functions are not bound:
--   iconFactoryLookup, iconFactoryLookupDefault
--   It is not a good idea to lookup an IconSet directly. If an Icon needs to
--   be displayed it happends always in the context of a widget. The best
--   practice is to get the widgets Style and call styleLookupIconSet.
--
module Graphics.UI.Gtk.General.IconFactory (
  IconFactory,
  iconFactoryNew,
  iconFactoryAdd,
  iconFactoryAddDefault,
  iconFactoryLookup,
  iconFactoryLookupDefault,
  iconFactoryRemoveDefault,
  IconSet,
  iconSetNew,
  iconSetNewFromPixbuf,
  iconSetAddSource,
  iconSetRenderIcon,
  iconSetGetSizes,
  IconSource,
  iconSourceNew,
  TextDirection(..),
  iconSourceGetDirection,
  iconSourceSetDirection,
  iconSourceResetDirection,
  iconSourceGetFilename,
  iconSourceSetFilename,
  iconSourceGetPixbuf,
  iconSourceSetPixbuf,
  iconSourceGetSize,
  iconSourceSetSize,
  iconSourceResetSize,
  StateType(..),
  iconSourceGetState,
  iconSourceSetState,
  iconSourceResetState,
  IconSize,
  iconSizeMenu,
  iconSizeSmallToolbar,
  iconSizeLargeToolbar,
  iconSizeButton,
  iconSizeDialog,
  iconSizeCheck,
  iconSizeRegister,
  iconSizeRegisterAlias,
  iconSizeFromName,
  iconSizeGetName
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject		(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums	(TextDirection(..), StateType(..))
import Graphics.UI.Gtk.General.Structs	(IconSize, iconSizeInvalid,
					 iconSizeMenu, iconSizeSmallToolbar,
					 iconSizeLargeToolbar, iconSizeButton,
					 iconSizeDialog)

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

{#pointer *IconSource foreign newtype#}

{#pointer *IconSet foreign newtype#}

-- methods


-- | Add an IconSet to an IconFactory.
--
-- * In order to use the new stock object, the factory as to be added to the
--   default factories by iconFactoryAddDefault.
--
iconFactoryAdd :: IconFactory -> String -> IconSet -> IO ()
iconFactoryAdd i stockId iconSet = withUTFString stockId $ \strPtr ->
  {#call unsafe icon_factory_add#} i strPtr iconSet

-- | Add all entries of the IconFactory to the
-- applications stock object database.
--
iconFactoryAddDefault :: IconFactory -> IO ()
iconFactoryAddDefault  = {#call unsafe icon_factory_add_default#}

-- | Looks up the stock id in the icon factory, returning an icon set if found,
-- otherwise Nothing.
--
-- * For display to the user, you should use 'styleLookupIconSet' on the "Style"
-- for the widget that will display the icon, instead of using this function
-- directly, so that themes are taken into account.
--
iconFactoryLookup :: IconFactory -> String -> IO (Maybe IconSet)
iconFactoryLookup i stockId =
  withUTFString stockId $ \strPtr -> do
  iconSetPtr <- {#call unsafe icon_factory_lookup#} i strPtr
  if iconSetPtr == nullPtr then return Nothing else liftM (Just . IconSet) $
    newForeignPtr iconSetPtr (icon_set_unref iconSetPtr)

-- | Looks for an icon in the list of default icon factories.
--
-- * For display to the user, you should use 'styleLookupIconSet' on the "Style"
-- for the widget that will display the icon, instead of using this function
-- directly, so that themes are taken into account.
--
iconFactoryLookupDefault :: String -> IO (Maybe IconSet)
iconFactoryLookupDefault stockId =
  withUTFString stockId $ \strPtr -> do
  iconSetPtr <- {#call unsafe icon_factory_lookup_default#} strPtr
  if iconSetPtr == nullPtr then return Nothing else liftM (Just . IconSet) $
    newForeignPtr iconSetPtr (icon_set_unref iconSetPtr)

-- | Create a new IconFactory.
--
-- * An application should create a new 'IconFactory' and add all
--   needed icons.
--   By calling 'iconFactoryAddDefault' these icons become
--   available as stock objects and can easily be displayed by
--   'Image'. Furthermore, a theme can override the icons defined by
--   the application.
--
iconFactoryNew :: IO IconFactory
iconFactoryNew  = makeNewGObject mkIconFactory {#call unsafe icon_factory_new#}

-- | Remove an IconFactory from the
-- application's stock database.
--
iconFactoryRemoveDefault :: IconFactory -> IO ()
iconFactoryRemoveDefault  = {#call unsafe icon_factory_remove_default#}

-- | Add an 'IconSource' (an Icon with
-- attributes) to an 'IconSet'.
--
-- * If an icon is looked up in the IconSet @set@ the best matching
--   IconSource will be taken. It is therefore advisable to add a default
--   (wildcarded) icon, than can be used if no exact match is found.
--
iconSetAddSource :: IconSet -> IconSource -> IO ()
iconSetAddSource set source = {#call unsafe icon_set_add_source#} set source

iconSetRenderIcon :: WidgetClass widget => IconSet
                  -> TextDirection
                  -> StateType
                  -> IconSize
                  -> widget
                  -> IO Pixbuf
iconSetRenderIcon set dir state size widget = makeNewGObject mkPixbuf $
  {#call icon_set_render_icon#} set (Style nullForeignPtr)
    ((fromIntegral.fromEnum) dir) ((fromIntegral.fromEnum) state)
    ((fromIntegral.fromEnum) size) (toWidget widget) nullPtr

-- | Create a new IconSet.
--
-- * Each icon in an application is contained in an 'IconSet'. The
--   'IconSet' contains several variants ('IconSource's) to
--   accomodate for different sizes and states.
--
iconSetNew :: IO IconSet
iconSetNew  = do
  isPtr <- {#call unsafe icon_set_new#}
  liftM IconSet $ newForeignPtr isPtr (icon_set_unref isPtr)

-- | Creates a new 'IconSet' with the given pixbuf as the default\/fallback
-- source image. If you don't add any additional "IconSource" to the icon set,
-- all variants of the icon will be created from the pixbuf, using scaling,
-- pixelation, etc. as required to adjust the icon size or make the icon look
-- insensitive\/prelighted.
--
iconSetNewFromPixbuf :: Pixbuf -> IO IconSet
iconSetNewFromPixbuf pixbuf = do
  isPtr <- {#call unsafe icon_set_new_from_pixbuf#} pixbuf
  liftM IconSet $ newForeignPtr isPtr (icon_set_unref isPtr)

-- | Obtains a list of icon sizes this icon set can render.
--
iconSetGetSizes :: IconSet -> IO [IconSize]
iconSetGetSizes set =
  alloca $ \sizesArrPtr -> alloca $ \lenPtr -> do
  {#call unsafe icon_set_get_sizes#} set sizesArrPtr lenPtr
  len <- peek lenPtr
  sizesArr <- peek sizesArrPtr
  list <- peekArray (fromIntegral len) sizesArr
  {#call unsafe g_free#} (castPtr sizesArr)
  return $ map (toEnum.fromIntegral) list

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_icon_set_unref"
  icon_set_unref' :: FinalizerPtr IconSet

icon_set_unref :: Ptr IconSet -> FinalizerPtr IconSet
icon_set_unref _ = icon_set_unref'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_icon_set_unref"
  icon_set_unref :: Ptr IconSet -> IO ()

#else

foreign import ccall "gtk_icon_set_unref" unsafe
  icon_set_unref :: Ptr IconSet -> IO ()

#endif


-- | Check if a given IconSize is registered.
--
-- * Useful if your application expects a theme to install a set with a
--   specific size. You can test if this actually happend and use another size
--   if not.
--
iconSizeCheck :: IconSize -> IO Bool
iconSizeCheck size = liftM toBool $
  {#call icon_size_lookup#} (fromIntegral size) nullPtr nullPtr

-- | Register a new IconSize.
--
iconSizeRegister :: Int -> String -> Int -> IO IconSize
iconSizeRegister height name width = liftM fromIntegral $
  withUTFString name $ \strPtr -> {#call unsafe icon_size_register#} 
  strPtr (fromIntegral width) (fromIntegral height)

-- | Register an additional alias for a name.
--
iconSizeRegisterAlias :: IconSize -> String -> IO ()
iconSizeRegisterAlias target alias = withUTFString alias $ \strPtr ->
  {#call unsafe icon_size_register_alias#} strPtr (fromIntegral target)

-- | Lookup an IconSize by name.
--
-- * This fixed value 'iconSizeInvalid' is returned if the name was
--   not found.
--
iconSizeFromName :: String -> IO IconSize
iconSizeFromName name = liftM fromIntegral $
  withUTFString name {#call unsafe icon_size_from_name#}

-- | Lookup the name of an IconSize.
--
-- * Returns @Nothing@ if the name was not found.
--
iconSizeGetName :: IconSize -> IO (Maybe String)
iconSizeGetName size = do
  strPtr <- {#call unsafe icon_size_get_name#} (fromIntegral size)
  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr

-- | Retrieve the 'TextDirection' of
-- this IconSource.
--
-- * @Nothing@ is returned if no explicit direction was set.
--
iconSourceGetDirection :: IconSource -> IO (Maybe TextDirection)
iconSourceGetDirection is = do
  res <- {#call icon_source_get_direction_wildcarded#} is
  if (toBool res) then return Nothing else liftM (Just .toEnum.fromIntegral) $
    {#call unsafe icon_source_get_direction#} is

-- | Retrieve the filename this IconSource was
-- based on.
--
-- * Returns @Nothing@ if the IconSource was generated by a Pixbuf.
--
iconSourceGetFilename :: IconSource -> IO (Maybe String)
iconSourceGetFilename is = do
  strPtr <- {#call unsafe icon_source_get_filename#} is
  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr

-- | Retrieve the 'IconSize' of this
-- IconSource.
--
-- * @Nothing@ is returned if no explicit size was set (i.e. this
--   'IconSource' matches all sizes).
--
iconSourceGetSize :: IconSource -> IO (Maybe IconSize)
iconSourceGetSize is = do
  res <- {#call unsafe icon_source_get_size_wildcarded#} is
  if (toBool res) then return Nothing else liftM (Just .fromIntegral) $
    {#call unsafe icon_source_get_size#} is

-- | Retrieve the 'StateType' of this
-- 'IconSource'.
--
-- * @Nothing@ is returned if the 'IconSource' matches all 
--   states.
--
iconSourceGetState :: IconSource -> IO (Maybe StateType)
iconSourceGetState is = do
  res <- {#call unsafe icon_source_get_state_wildcarded#} is
  if (toBool res) then return Nothing else liftM (Just .toEnum.fromIntegral) $
    {#call unsafe icon_source_get_state#} is

-- | Create a new IconSource.
--
-- * An IconSource is a single image that is usually added to an IconSet. Next
--   to the image it contains information about which state, text direction
--   and size it should apply.
--
iconSourceNew :: IO IconSource
iconSourceNew  = do
  isPtr <- {#call unsafe icon_source_new#}
  liftM IconSource $ newForeignPtr isPtr (icon_source_free isPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_icon_source_free"
  icon_source_free' :: FinalizerPtr IconSource

icon_source_free :: Ptr IconSource -> FinalizerPtr IconSource
icon_source_free _ = icon_source_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_icon_source_free"
  icon_source_free :: Ptr IconSource -> IO ()

#else

foreign import ccall "gtk_icon_source_free" unsafe
  icon_source_free :: Ptr IconSource -> IO ()

#endif


-- | Mark this 'IconSource' that it
-- should only apply to the specified 'TextDirection'.
--
iconSourceSetDirection :: IconSource -> TextDirection -> IO ()
iconSourceSetDirection is td = do
  {#call unsafe icon_source_set_direction_wildcarded#} is (fromBool False)
  {#call unsafe icon_source_set_direction#} is ((fromIntegral.fromEnum) td)

-- | Reset the specific
-- 'TextDirection' set with 'iconSourceSetDirection'.
--
iconSourceResetDirection is =
  {#call unsafe icon_source_set_direction_wildcarded#} is (fromBool True)

-- | Load an icon picture from this filename.
--
iconSourceSetFilename :: IconSource -> FilePath -> IO ()
iconSourceSetFilename is name = 
  withUTFString name $ {#call unsafe icon_source_set_filename#} is

-- | Retrieves the source pixbuf, or Nothing if none is set.
--
iconSourceGetPixbuf :: IconSource -> IO (Maybe Pixbuf)
iconSourceGetPixbuf is = do
  pixbufPtr <- {#call unsafe icon_source_get_pixbuf#} is
  if pixbufPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkPixbuf (return pixbufPtr)

-- | Sets a pixbuf to use as a base image when creating icon variants for
-- 'IconSet'.
--
iconSourceSetPixbuf :: IconSource -> Pixbuf -> IO ()
iconSourceSetPixbuf is pb = do
  {#call icon_source_set_pixbuf#} is pb

-- | Set this 'IconSource' to a specific
-- size.
--
iconSourceSetSize :: IconSource -> IconSize -> IO ()
iconSourceSetSize is size = do
  {#call unsafe icon_source_set_size_wildcarded#} is (fromBool False)
  {#call unsafe icon_source_set_size#} is (fromIntegral size)

-- | Reset the 'IconSize' of this
-- 'IconSource' so that is matches anything.
--
iconSourceResetSize :: IconSource -> IO ()
iconSourceResetSize is = 
  {#call unsafe icon_source_set_size_wildcarded#} is (fromBool True)

-- | Mark this icon to be used only with this
-- specific state.
--
iconSourceSetState :: IconSource -> StateType -> IO ()
iconSourceSetState is state = do
  {#call unsafe icon_source_set_state_wildcarded#} is (fromBool False)
  {#call unsafe icon_source_set_state#} is ((fromIntegral.fromEnum) state)

-- | Reset the 'StateType' of this
-- 'IconSource' so that is matches anything.
--
iconSourceResetState :: IconSource -> IO ()
iconSourceResetState is = 
  {#call unsafe icon_source_set_state_wildcarded#} is (fromBool True)





--- NEW FILE: Enums.chs.pp ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Enumerations
--
--  Author : Axel Simon, Manuel Chakravarty
--  Created: 13 Januar 1999
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:20:54 $
--
--  Copyright (c) [1999..2001] Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- General enumeration types.
--
-- TODO
--
--  * Documentation
--
module Graphics.UI.Gtk.General.Enums (
  AccelFlags(..),
  ArrowType(..),
  AttachOptions(..),
  Button(..),
  ButtonBoxStyle(..),
  CalendarDisplayOptions(..),
  Click(..),
  CornerType(..),
  CurveType(..),
  DeleteType(..),
  DirectionType(..),
  Justification(..),
#ifndef DISABLE_DEPRECATED
  MatchType(..),
#endif
  MenuDirectionType(..),
  MetricType(..),
  MovementStep(..),
  Orientation(..),
  Packing(..),
  PackType(..),
  PathPriorityType(..),
  PathType(..),
  PolicyType(..),
  PositionType(..),
  ProgressBarOrientation(..),
  ReliefStyle(..),
  ResizeMode(..),
  ScrollType(..),
  SelectionMode(..),
  ShadowType(..),
  StateType(..),
#ifndef DISABLE_DEPRECATED
  SubmenuDirection(..),
  SubmenuPlacement(..),
#endif
  SpinButtonUpdatePolicy(..),
  SpinType(..),
  TextDirection(..),
  TextSearchFlags(..),
  TextWindowType(..),
  ToolbarStyle(..),
  TreeViewColumnSizing(..),
  --TroughType(..),
  UpdateType(..),
  Visibility(..),
  WindowPosition(..),
  WindowType(..),
  WrapMode(..), 
  SortType(..),
  module Graphics.UI.Gtk.Gdk.Enums
  ) where

import Graphics.UI.Gtk.Gdk.Enums

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


-- | State of an accelerator
--
{#enum AccelFlags {underscoreToCase} deriving(Bounded)#}

instance Flags AccelFlags

-- | Arrow directions for the arrow widget
--
{#enum ArrowType {underscoreToCase}#}

-- | Child widget attach options for table containers
--
{#enum AttachOptions {underscoreToCase} deriving(Bounded)#}

instance Flags AttachOptions

-- | Button number
--
data Button = LeftButton
	    | MiddleButton
	    | RightButton
	    | WheelUp
	    | WheelDown
	    | OtherButton

instance Enum Button where
  toEnum 1 = LeftButton
  toEnum 2 = MiddleButton
  toEnum 3 = RightButton
  toEnum 4 = WheelUp
  toEnum 5 = WheelDown
  toEnum _ = OtherButton
  fromEnum LeftButton   = 1
  fromEnum MiddleButton = 2
  fromEnum RightButton  = 3
  fromEnum WheelUp	= 4
  fromEnum WheelDown	= 5
  fromEnum OtherButton	= 6

-- | Dictate the style that a ButtonBox uses to align it contents
--
{#enum ButtonBoxStyle {underscoreToCase}#}

-- | Specify which items of a calendar should be displayed.
--
{#enum CalendarDisplayOptions {underscoreToCase} deriving(Bounded)#}

instance Flags CalendarDisplayOptions

-- | Type of mouse click
--
data Click = SingleClick
	   | DoubleClick
	   | TripleClick
	   | ReleaseClick

-- | Specifies in which corner a child widget should be placed
--
{#enum CornerType {underscoreToCase}#}

-- | Specifies how curves in the gamma widget (?) are drawn
--
{#enum CurveType {underscoreToCase}#}

-- | Editing option
--
{#enum DeleteType {underscoreToCase}#}

-- | Editing direction
--
{#enum DirectionType {underscoreToCase}#}

-- | Justification for label and maybe other widgets (text?)
--
{#enum Justification {underscoreToCase}#}

#ifndef DISABLE_DEPRECATED
-- | Some kind of string search options
--
{#enum MatchType {underscoreToCase}#}
#endif

-- | From where was a menu item entered?
--
{#enum MenuDirectionType {underscoreToCase}#}

-- | Units of measure
--
{#enum MetricType {underscoreToCase}#}

-- | Movement in text widget
--
{#enum MovementStep {underscoreToCase}#}

-- | Orientation is good
--
{#enum Orientation {underscoreToCase}#}

-- | Packing parameters of a widget
--
data Packing = PackRepel
	     | PackGrow
	     | PackNatural
	     deriving (Enum,Eq)

-- | Packing of widgets at start or end in a box
--
{#enum PackType {underscoreToCase}#}

-- | Priorities
--
{#enum PathPriorityType {underscoreToCase}#}

-- | Widget identification path
--
{#enum PathType {underscoreToCase}#}

-- | Scrollbar policy types (for scrolled windows)
--
{#enum PolicyType {underscoreToCase}#}

-- | Position a scale's value is drawn relative to the
-- trough
--
{#enum PositionType {underscoreToCase}#}

-- | Is the ProgressBar horizontally or vertically
-- directed?
--
{#enum ProgressBarOrientation {underscoreToCase}#}

-- | I don't have a clue.
--
{#enum ReliefStyle {underscoreToCase}#}

-- | Resize mode, for containers
--
-- * 'ResizeParent' Pass resize request to the parent
--
-- * 'ResizeQueue' Queue resizes on this widget
--
-- * 'ResizeImmediate' Perform the resizes now
--
{#enum ResizeMode {underscoreToCase}#}

-- | Scrolling type
--
{#enum ScrollType {underscoreToCase}#}

-- | Mode in which selections can be performed
--
-- * There is a deprecated entry SelectionExtended which should have the same
--   value as SelectionMultiple. C2HS chokes on that construct.
--
data SelectionMode = SelectionNone
                   | SelectionSingle
                   | SelectionBrowse
                   | SelectionMultiple
                   deriving (Enum)
-- {#enum SelectionMode {underscoreToCase}#}

-- | Shadow types
--
{#enum ShadowType {underscoreToCase}#}

-- | Widget states
--
{#enum StateType {underscoreToCase}#}

#ifndef DISABLE_DEPRECATED
-- | Submenu direction policies
--
{#enum SubmenuDirection {underscoreToCase}#}

-- | Submenu placement policies
--
{#enum SubmenuPlacement {underscoreToCase}#}
#endif

-- | Whether to clamp or ignore illegal values.
--
{#enum SpinButtonUpdatePolicy {underscoreToCase}#}

-- | Spin a SpinButton with the following method.
--
{#enum SpinType {underscoreToCase}#}

-- | Is the text written from left to right or the awkward way?
--
{#enum TextDirection {underscoreToCase}#}

-- | Specify the way the search function for 'TextBuffer' works.
--
{#enum TextSearchFlags {underscoreToCase} deriving(Bounded)#}

instance Flags TextSearchFlags

-- | The window type for coordinate translation.
--
{#enum TextWindowType {underscoreToCase}#}

-- | Where to place the toolbar?
--
{#enum ToolbarStyle {underscoreToCase}#}

-- | Wether columns of a tree or list widget can be resized.
--
{#enum TreeViewColumnSizing {underscoreToCase}#}

-- hm... text editing?
--{#enum TroughType {underscoreToCase}#}


-- | Updating types for range widgets (determines when the
-- @\"connectToValueChanged\"@ signal is emitted by the widget)
--
{#enum UpdateType {underscoreToCase}#}

-- | Visibility
--
{#enum Visibility {underscoreToCase}#}

-- | Window position types
--
{#enum WindowPosition {underscoreToCase}#}

-- | Interaction of a window with window manager
--
{#enum WindowType {underscoreToCase}#}

-- | Determine how lines are wrapped in a 'TextView'.
--
{#enum WrapMode {underscoreToCase}#}

-- Sort in ascending or descending order (used in CList widget)
--
{#enum SortType {underscoreToCase}#}

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/General StockItems.hsc,NONE,1.1 General.chs,NONE,1.1

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

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

Added Files:
	StockItems.hsc General.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: StockItems.hsc ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) StockItems
--
--  Author : Axel Simon
--          
--  Created: 24 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:20:28 $
--
--  Copyright (c) 1999..2003 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.
--
-- |
--
-- A StockItem is a resource that is know throughout Gtk.
--
-- * Defining you own
--   'IconSet's as 'StockItem's will make it possible for 
--   Gtk to choose
--   the most appropriate sizes and enables themes to override your built in
--   icons. A couple of constants are defined here as well. They are useful 
--   in accessing Gtk's predefined items.
--
-- * The StockItem structure is completely marshaled to haskell. It is 
--   possible to marshal all strings lazily because the string pointers are
--   valid throughout the lifetime of the application. The only drawback it
--   that a stock item that is replaced by the another item with the same
--   name will never be freed. This deficiency is built into Gtk however.
--

module Graphics.UI.Gtk.General.StockItems (
  StockItem(StockItem),
  StockId,
  siStockId,
  siLabel,
  siModifier,
  siKeyval,
  siTransDom,
  stockAddItem,
  stockLookupItem,
  stockListIds,
  stockAdd,
  stockApply,
  stockBold,
  stockCancel,
  stockCDROM,
  stockClear,
  stockClose,
  stockColorPicker,
  stockConvert,
  stockCopy,
  stockCut,
  stockDelete,
  stockDialogError,
  stockDialogInfo,
  stockDialogQuestion,
  stockDialogWarning,
  stockDnd,
  stockDndMultiple,
  stockExecute,
  stockFind,
  stockFindAndRelpace,
  stockFloppy,
  stockGotoBottom,
  stockGotoFirst,
  stockGotoLast,
  stockGotoTop,
  stockGoBack,
  stockGoDown,
  stockGoForward,
  stockGoUp,
  stockHelp,
  stockHome,
  stockIndex,
  stockItalic,
  stockJumpTo,
  stockJustifyCenter,
  stockJustifyFill,
  stockJustifyLeft,
  stockJustifyRight,
  stockMissingImage,
  stockNew,
  stockNo,
  stockOk,
  stockOpen,
  stockPaste,
  stockPreferences,
  stockPrint,
  stockPrintPreview,
  stockProperties,
  stockQuit,
  stockRedo,
  stockRefresh,
  stockRemove,
  stockRevertToSaved,
  stockSave,
  stockSaveAs,
  stockSelectColor,
  stockSelectFont,
  stockSortAscending,
  stockSortDescending,
  stockSpellCheck,
  stockStop,
  stockStrikethrough,
  stockUndelete,
  stockUnderline,
  stockUndo,
  stockYes,
  stockZoom100,
  stockZoomFit,
  stockZoomIn,
  stockZoomOut
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.FFI	(unsafePerformIO)	-- to read CStrings lazyly
import System.Glib.GList	(GSList, fromGSListRev)
import Graphics.UI.Gtk.Gdk.Events	(Modifier)

#include <gtk/gtk.h>

-- |  A synonym for a standard button or icon.
--
type StockId = String

-- The StockItem structure.
--
-- * Although the structure itself is allocated dynamically, its contents
--   are not. All string pointers are constant throughout the lifetime of
--   the application. We do not need to marshal these Strings to Haskell if
--   they are not needed.
--
data StockItem = StockItem {
  siStockId :: StockId,
  siLabel   :: String,
  siModifier:: Modifier,
  siKeyval  :: Integer,
  siTransDom:: String }

instance Storable StockItem where
  sizeOf _	= #const sizeof(GtkStockItem)
  alignment _	= alignment (undefined::CString)
  peek siPtr	= do
    (stockId    :: CString) <- #{peek GtkStockItem, stock_id} siPtr
    (label	:: CString) <- #{peek GtkStockItem, label} siPtr
    (modifier	:: #type GdkModifierType)
		            <- #{peek GtkStockItem, modifier} siPtr
    (keyval	:: #type guint)
			    <- #{peek GtkStockItem, keyval} siPtr
    (transDom	:: CString) <- #{peek GtkStockItem, translation_domain} siPtr
    return $ StockItem {
      siStockId  = unsafePerformIO $ peekUTFString' stockId,
      siLabel	 = unsafePerformIO $ peekUTFString' label,
      -- &%!?$ c2hs and hsc should agree on types
      siModifier = fromIntegral modifier, 
      siKeyval	 = fromIntegral keyval,
      siTransDom = unsafePerformIO $ peekUTFString' transDom }
    where
      peekUTFString' :: CString -> IO String
      peekUTFString' strPtr | strPtr==nullPtr = return ""
			  | otherwise	    = peekUTFString strPtr

  poke siPtr (StockItem {
    siStockId = stockId,
    siLabel   = label,
    siModifier= modifier,
    siKeyval  = keyval,
    siTransDom= transDom }) = do
    stockIdPtr <- newUTFString stockId
    #{poke GtkStockItem, stock_id} siPtr stockIdPtr
    labelPtr   <- newUTFString label
    #{poke GtkStockItem, label}	   siPtr labelPtr
    #{poke GtkStockItem, modifier} siPtr 
      ((fromIntegral modifier)::#{type GdkModifierType})
    #{poke GtkStockItem, keyval}   siPtr ((fromIntegral keyval)::#{type guint})
    transDomPtr<- newUTFString transDom
    #{poke GtkStockItem, translation_domain} siPtr transDomPtr


-- | Add new stock items to Gtk.
--

-- Using stock_add_static would be possible if we used g_malloc to reserve
-- space since the allocated space might actually be freed when another
-- stock item with the same name is added.
stockAddItem :: [StockItem] -> IO ()
stockAddItem [] = return ()
stockAddItem sis = let items = length sis in do
  allocaArray items $ \aPtr -> do
  pokeArray aPtr sis
  stock_add aPtr (fromIntegral items)

-- | Lookup an item in stock.
--
stockLookupItem :: StockId -> IO (Maybe StockItem)
stockLookupItem stockId = 
  alloca $ \siPtr ->
  withUTFString stockId $ \strPtr -> do
  res <- stock_lookup strPtr siPtr
  if (toBool res) then liftM Just $ peek siPtr else return Nothing

-- | Produce a list of all known stock identifiers.
--
-- * Retrieve a list of all known stock identifiers. These can either be
--   added by 'stockAddItem' or by adding items to a
--   'IconFactory'.
--
-- * The list is sorted alphabetically (sorting is not Unicode aware).
--
stockListIds :: IO [StockId]
stockListIds = do
  lPtr <- stock_list_ids
  sPtrs <- fromGSListRev lPtr
  res <- mapM peekUTFString sPtrs
  mapM_ g_free sPtrs
  return res

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "gtk_stock_add"
  stock_add :: Ptr StockItem -> #{type guint} -> IO ()

foreign import ccall unsafe "gtk_stock_lookup"
  stock_lookup :: CString -> Ptr StockItem -> IO #type gboolean

foreign import ccall unsafe "gtk_stock_list_ids"
  stock_list_ids :: IO GSList

foreign import ccall unsafe "g_free"
  g_free :: Ptr a -> IO ()

#else

foreign import ccall "gtk_stock_add" unsafe 
  stock_add :: Ptr StockItem -> #{type guint} -> IO ()

foreign import ccall "gtk_stock_lookup" unsafe
  stock_lookup :: CString -> Ptr StockItem -> IO #type gboolean

foreign import ccall "gtk_stock_list_ids" unsafe
  stock_list_ids :: IO GSList

foreign import ccall "g_free" unsafe
  g_free :: Ptr a -> IO ()

#endif
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
#if GTK_CHECK_VERSION(2,2,0)
-- | Standard icon and menu entry.
--
-- * This icon is only available in Gtk 2.2 or higher.
--
#endif
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.
-- | Standard icon and menu entry.


stockAdd,
  stockApply,
  stockBold,
  stockCancel,
  stockCDROM,
  stockClear,
  stockClose,
#if GTK_CHECK_VERSION(2,2,0)
  stockColorPicker,
#endif
  stockConvert,
  stockCopy,
  stockCut,
  stockDelete,
  stockDialogError,
  stockDialogInfo,
  stockDialogQuestion,
  stockDialogWarning,
  stockDnd,
  stockDndMultiple,
  stockExecute,
  stockFind,
  stockFindAndRelpace,
  stockFloppy,
  stockGotoBottom,
  stockGotoFirst,
  stockGotoLast,
  stockGotoTop,
  stockGoBack,
  stockGoDown,
  stockGoForward,
  stockGoUp,
  stockHelp,
  stockHome,
  stockIndex,
  stockItalic,
  stockJumpTo,
  stockJustifyCenter,
  stockJustifyFill,
  stockJustifyLeft,
  stockJustifyRight,
  stockMissingImage,
  stockNew,
  stockNo,
  stockOk,
  stockOpen,
  stockPaste,
  stockPreferences,
  stockPrint,
  stockPrintPreview,
  stockProperties,
  stockQuit,
  stockRedo,
  stockRefresh,
  stockRemove,
  stockRevertToSaved,
  stockSave,
  stockSaveAs,
  stockSelectColor,
  stockSelectFont,
  stockSortAscending,
  stockSortDescending,
  stockSpellCheck,
  stockStop,
  stockStrikethrough,
  stockUndelete,
  stockUnderline,
  stockUndo,
  stockYes,
  stockZoom100,
  stockZoomFit,
  stockZoomIn,
  stockZoomOut :: StockId

stockAdd		= #{const_str GTK_STOCK_ADD}
stockApply		= #{const_str GTK_STOCK_APPLY}
stockBold		= #{const_str GTK_STOCK_BOLD}
stockCancel		= #{const_str GTK_STOCK_CANCEL}
stockCDROM		= #{const_str GTK_STOCK_CDROM}
stockClear		= #{const_str GTK_STOCK_CLEAR}
stockClose		= #{const_str GTK_STOCK_CLOSE}
#if GTK_CHECK_VERSION(2,2,0)
stockColorPicker	= #{const_str GTK_STOCK_COLOR_PICKER}
#else
stockColorPicker        = stockMissingImage
#endif
stockConvert		= #{const_str GTK_STOCK_CONVERT}
stockCopy		= #{const_str GTK_STOCK_COPY}
stockCut		= #{const_str GTK_STOCK_CUT}
stockDelete		= #{const_str GTK_STOCK_DELETE}
stockDialogError	= #{const_str GTK_STOCK_DIALOG_ERROR}
stockDialogInfo		= #{const_str GTK_STOCK_DIALOG_INFO}
stockDialogQuestion	= #{const_str GTK_STOCK_DIALOG_QUESTION}
stockDialogWarning	= #{const_str GTK_STOCK_DIALOG_WARNING}
stockDnd		= #{const_str GTK_STOCK_DND}
stockDndMultiple	= #{const_str GTK_STOCK_DND_MULTIPLE}
stockExecute		= #{const_str GTK_STOCK_EXECUTE}
stockFind		= #{const_str GTK_STOCK_FIND}
stockFindAndRelpace	= #{const_str GTK_STOCK_FIND_AND_REPLACE}
stockFloppy		= #{const_str GTK_STOCK_FLOPPY}
stockGotoBottom		= #{const_str GTK_STOCK_GOTO_BOTTOM}
stockGotoFirst		= #{const_str GTK_STOCK_GOTO_FIRST}
stockGotoLast		= #{const_str GTK_STOCK_GOTO_LAST}
stockGotoTop		= #{const_str GTK_STOCK_GOTO_TOP}
stockGoBack		= #{const_str GTK_STOCK_GO_BACK}
stockGoDown		= #{const_str GTK_STOCK_GO_DOWN}
stockGoForward		= #{const_str GTK_STOCK_GO_FORWARD}
stockGoUp		= #{const_str GTK_STOCK_GO_UP}
stockHelp		= #{const_str GTK_STOCK_HELP}
stockHome		= #{const_str GTK_STOCK_HOME}
stockIndex		= #{const_str GTK_STOCK_INDEX}
stockItalic		= #{const_str GTK_STOCK_ITALIC}
stockJumpTo		= #{const_str GTK_STOCK_JUMP_TO}
stockJustifyCenter	= #{const_str GTK_STOCK_JUSTIFY_CENTER}
stockJustifyFill	= #{const_str GTK_STOCK_JUSTIFY_FILL}
stockJustifyLeft	= #{const_str GTK_STOCK_JUSTIFY_LEFT}
stockJustifyRight	= #{const_str GTK_STOCK_JUSTIFY_RIGHT}
stockMissingImage	= #{const_str GTK_STOCK_MISSING_IMAGE}
stockNew		= #{const_str GTK_STOCK_NEW}
stockNo			= #{const_str GTK_STOCK_NO}
stockOk			= #{const_str GTK_STOCK_OK}
stockOpen		= #{const_str GTK_STOCK_OPEN}
stockPaste		= #{const_str GTK_STOCK_PASTE}
stockPreferences	= #{const_str GTK_STOCK_PREFERENCES}
stockPrint		= #{const_str GTK_STOCK_PRINT}
stockPrintPreview	= #{const_str GTK_STOCK_PRINT_PREVIEW}
stockProperties		= #{const_str GTK_STOCK_PROPERTIES}
stockQuit		= #{const_str GTK_STOCK_QUIT}
stockRedo		= #{const_str GTK_STOCK_REDO}
stockRefresh		= #{const_str GTK_STOCK_REFRESH}
stockRemove		= #{const_str GTK_STOCK_REMOVE}
stockRevertToSaved	= #{const_str GTK_STOCK_REVERT_TO_SAVED}
stockSave		= #{const_str GTK_STOCK_SAVE}
stockSaveAs		= #{const_str GTK_STOCK_SAVE_AS}
stockSelectColor	= #{const_str GTK_STOCK_SELECT_COLOR}
stockSelectFont		= #{const_str GTK_STOCK_SELECT_FONT}
stockSortAscending	= #{const_str GTK_STOCK_SORT_ASCENDING}
stockSortDescending	= #{const_str GTK_STOCK_SORT_DESCENDING}
stockSpellCheck		= #{const_str GTK_STOCK_SPELL_CHECK}
stockStop		= #{const_str GTK_STOCK_STOP}
stockStrikethrough	= #{const_str GTK_STOCK_STRIKETHROUGH}
stockUndelete		= #{const_str GTK_STOCK_UNDELETE}
stockUnderline		= #{const_str GTK_STOCK_UNDERLINE}
stockUndo		= #{const_str GTK_STOCK_UNDO}
stockYes		= #{const_str GTK_STOCK_YES}
stockZoom100		= #{const_str GTK_STOCK_ZOOM_100}
stockZoomFit		= #{const_str GTK_STOCK_ZOOM_FIT}
stockZoomIn		= #{const_str GTK_STOCK_ZOOM_IN}
stockZoomOut		= #{const_str GTK_STOCK_ZOOM_OUT}





--- NEW FILE: General.chs ---
{-# OPTIONS -cpp #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) General
--
--  Author : Axel Simon
--	     Manuel M. T. Chakravarty
--
--  Created: 8 December 1998
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:20:28 $
--
--  Copyright (c) [2000..2002] 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.
--
-- |
--
-- TODO
-- 
--  * quitAddDestroy, quitAdd, quitRemove, inputAdd, inputRemove
--
module Graphics.UI.Gtk.General.General (
--  getDefaultLanguage,
  initGUI,
  eventsPending,
  mainGUI,
  mainLevel,
  mainQuit,
  mainIteration,
  mainIterationDo,
  grabAdd,
  grabGetCurrent,
  grabRemove,
  mkDestructor,
  DestroyNotify,
  priorityLow,
  priorityDefault,
  priorityHigh,
  timeoutAdd,
  timeoutRemove,
  idleAdd,
  idleRemove,
  HandlerId
  ) where

import System   (getProgName, getArgs, ExitCode(ExitSuccess, ExitFailure))
import Monad	(liftM, mapM)
import Data.IORef	 (newIORef, readIORef, writeIORef)
import Control.Exception (ioError, Exception(ErrorCall))

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}	 
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums    (InputCondition(..))
import Graphics.UI.Gtk.General.Structs	(priorityLow, priorityDefault, priorityHigh)

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

{-
-- | Retreive the current language.
-- * This function returns a String which's pointer can be used later on for
--   comarisions.
--
--getDefaultLanguage :: IO String
--getDefaultLanguage = do
--  strPtr <- {#call unsafe get_default_language#}
--  str <- peekUTFString strPtr
--  destruct strPtr
--  return str
-}

-- | Initialize the GUI binding.
--
-- * This function initialized the GUI toolkit and parses all Gtk
--   specific arguments. The remaining arguments are returned. If the
--   initialization of the toolkit fails for whatever reason, an exception
--   is thrown.
--
-- * Throws: @ErrorCall "Cannot initialize GUI."@
--
initGUI :: IO [String]
initGUI = do
  prog <- getProgName
  args <- getArgs
  let allArgs = (prog:args)
      argc    = length allArgs
  withMany withUTFString allArgs $ \addrs  ->
    withArray	       addrs   $ \argv ->
    withObject	       argv    $ \argvp ->
    withObject	       argc    $ \argcp -> do 
      res <- {#call unsafe init_check#} (castPtr argcp) (castPtr argvp)
      if (toBool res) then do
        argc'   <- peek argcp
        argv'   <- peek argvp
        _:addrs'  <- peekArray argc' argv'  -- drop the program name
        mapM peekUTFString addrs'
        else error "Cannot initialize GUI."

-- | Inquire the number of events pending on the event
-- queue
--
eventsPending :: IO Int
eventsPending  = liftM fromIntegral {#call unsafe events_pending#}

-- | Run GTK+'s main event loop.
--
mainGUI :: IO ()
mainGUI  = {#call main#}

-- | Inquire the main loop level.
--
-- * Callbacks that take more time to process can call 
--   'loopIteration' to keep the GUI responsive. Each time
--   the main loop is restarted this way, the main loop counter is
--   increased. This function returns this counter.
--
mainLevel :: IO Int
mainLevel  = liftM (toEnum.fromEnum) {#call unsafe main_level#}

-- | Exit the main event loop.
--
mainQuit :: IO ()
mainQuit  = {#call main_quit#}

-- | Process an event, block if necessary.
--
-- * Returns @True@ if the 'loopQuit' was called while
--   processing the event.
--
mainIteration :: IO Bool
mainIteration  = liftM toBool {#call main_iteration#}

-- | Process a single event.
--
-- * Called with @True@, this function behaves as
--   'loopIteration' in that it waits until an event is available
--   for processing. The function will return immediately, if passed
--   @False@.
--
-- * Returns @True@ if the 'loopQuit' was called while
--   processing the event.
--

--
mainIterationDo :: Bool -> IO Bool
mainIterationDo blocking = 
  liftM toBool $ {#call main_iteration_do#} (fromBool blocking)

-- | add a grab widget
--
grabAdd :: WidgetClass wd => wd -> IO ()
grabAdd  = {#call grab_add#} . toWidget

-- | inquire current grab widget
--
grabGetCurrent :: IO (Maybe Widget)
grabGetCurrent  = do
  wPtr <- {#call grab_get_current#}
  if (wPtr==nullPtr) then return Nothing else 
    liftM Just $ makeNewObject mkWidget (return wPtr)

-- | remove a grab widget
--
grabRemove :: WidgetClass w => w -> IO ()
grabRemove  = {#call grab_remove#} . toWidget

{#pointer GSourceFunc as Function#}

{#pointer GDestroyNotify as DestroyNotify#}

foreign import ccall "wrapper" mkHandler :: IO {#type gint#} -> IO Function

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

type HandlerId = {#type guint#}

-- Turn a function into a function pointer and a destructor pointer.
--
makeCallback :: IO {#type gint#} -> IO (Function, DestroyNotify)
makeCallback fun = do
  funPtr <- mkHandler fun
  dRef <- newIORef nullFunPtr
  dPtr <- mkDestructor $ do
    freeHaskellFunPtr funPtr
    dPtr <- readIORef dRef
    freeHaskellFunPtr dPtr
  writeIORef dRef dPtr
  return (funPtr, dPtr)

-- | Register a function that is to be called after
-- @interval@ ms have been elapsed.
--
-- * If the function returns @False@ it will be removed.
--
timeoutAdd :: IO Bool -> Int -> IO HandlerId
timeoutAdd fun msec = do
  (funPtr, dPtr) <- makeCallback (liftM fromBool fun)
  {#call unsafe g_timeout_add_full#} (fromIntegral priorityDefault)
    (fromIntegral msec) funPtr nullPtr dPtr

-- | Remove a previously added timeout handler by its
-- 'TimeoutId'.
--
timeoutRemove :: HandlerId -> IO ()
timeoutRemove id = {#call unsafe g_source_remove#} id >> return ()

-- | Add a callback that is called whenever the system is
-- idle.
--
-- * A priority can be specified via an integer. This should usually be
--   'priorityDefault'.
--
-- * If the function returns @False@ it will be removed.
--
idleAdd :: IO Bool -> Int -> IO HandlerId
idleAdd fun pri = do
  (funPtr, dPtr) <- makeCallback (liftM fromBool fun)
  {#call unsafe g_idle_add_full#} (fromIntegral pri) funPtr
    nullPtr dPtr

-- | Remove a previously added idle handler by its
-- 'TimeoutId'.
--
idleRemove :: HandlerId -> IO ()
idleRemove id = {#call unsafe g_source_remove#} id >> return ()

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/General Structs.hsc,NONE,1.1 Style.chs,NONE,1.1

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

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

Added Files:
	Structs.hsc Style.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Style.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Styles
--
--  Author : Axel Simon
--          
--  Created: 13 February 2003
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:19:35 $
--
--  Copyright (c) 1999..2003 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.
--
-- |
--
-- Customization of widgets.
--
-- * Styles are attached to widgets and determine how particular parts are
--   drawn and with what color. Thus they are should be seen as mandatory 
--   when one implements a new
--   custom widgets via 'DrawingArea'. Although the parameterized
--   drawing function don't have to be used, it is
--   strongly advisable (and more robust)
--   to make use of the predefined graphics contexts for the different
--   states of a widget (retrieved by 'widgetGetState').
--
-- * When creating complicated objects in 'DrawingArea' the predefined
--   graphics contexts and the single font in the canvas 
--   might not be enough to customize the rendering process. 
--   gtk_rc_get_style_by_paths is the solution for this.
--
--
-- TODO
--
-- * It seems sensible to treat Styles as read only. The only way to modify
--   a style should be for the programmer to apply the RcStyle patches directly
--   to the widget.
--
-- * Bind the draw... functions, they might be useful.
--
module Graphics.UI.Gtk.General.Style (
  Style,
  StyleClass,
  styleGetForeground,
  styleGetBackground,
  styleGetLight,
  styleGetMiddle,
  styleGetDark,
  styleGetText,
  styleGetBase,
  styleGetAntiAliasing
  ) where

import Monad		(liftM)


{#import System.Glib.GObject#}	(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
import Graphics.UI.Gtk.General.Enums		(StateType)
import Graphics.UI.Gtk.General.Structs		(styleGetForeground,
			 styleGetBackground,
			 styleGetLight,
			 styleGetMiddle,
			 styleGetDark,
			 styleGetText,
			 styleGetBase,
			 styleGetAntiAliasing)


--- NEW FILE: Structs.hsc ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Structures
--
--  Author : Axel Simon
--          
--  Created: 2 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:19:35 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
module Graphics.UI.Gtk.General.Structs (
  Point,
  Rectangle(..),
  Color(..),
  GCValues(..),
#if __GLASGOW_HASKELL__<600
  foreground,
  background,
  function,
  fill,
  tile,
  stipple,
  clipMask,
  subwindowMode,
  tsXOrigin,
  tsYOrigin,
  clipXOrigin,
  clipYOrigin,
  graphicsExposure,
  lineWidth,
  lineStyle,
  capStyle,
  joinStyle,
#endif
  pokeGCValues,
  newGCValues,
  widgetGetState,
  widgetGetSavedState,
  Allocation,
  Requisition(..),
  treeIterSize,
  textIterSize,
  inputError,
  dialogGetUpper,
  dialogGetActionArea,
  fileSelectionGetButtons,
  ResponseId(..),
  fromResponse,
  toResponse,
  --XID,
  --socketGetXID,
  --socketHasPlug,
#ifndef DISABLE_DEPRECATED
  toolbarChildButton,
  toolbarChildToggleButton,
  toolbarChildRadioButton,
#endif
  IconSize,
  iconSizeInvalid,
  iconSizeMenu,
  iconSizeSmallToolbar,
  iconSizeLargeToolbar,
  iconSizeButton,
  iconSizeDialog,
#ifndef DISABLE_DEPRECATED
  comboGetList,
#endif
  priorityLow,
  priorityDefault,
  priorityHigh,
  drawingAreaGetDrawWindow,
  drawingAreaGetSize,
  pangoScale,
  styleGetForeground,
  styleGetBackground,
  styleGetLight,
  styleGetMiddle,
  styleGetDark,
  styleGetText,
  styleGetBase,
  styleGetAntiAliasing,
  ) where

import Monad		(liftM)
import Data.IORef
import Control.Exception
import Data.Bits        (testBit)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import System.Glib.GObject		(makeNewGObject)
import Graphics.UI.Gtk.Types
import Graphics.UI.Gtk.Gdk.Enums	(Function, Fill, SubwindowMode,
					 LineStyle, CapStyle, JoinStyle)
import Graphics.UI.Gtk.General.Enums	(StateType)

-- | Represents the x and y coordinate of a point.
--
type Point = (Int, Int)

-- | Rectangle
--
-- * for Events
--
-- * Specifies x, y, width and height
--
data Rectangle = Rectangle Int Int Int Int

instance Storable Rectangle where
  sizeOf _ = #{const sizeof(GdkRectangle)}
  alignment _ = alignment (undefined:: #type gint)
  peek ptr = do
    (x_	     ::#type gint)	<- #{peek GdkRectangle, x} ptr
    (y_	     ::#type gint)	<- #{peek GdkRectangle, y} ptr
    (width_  ::#type gint)	<- #{peek GdkRectangle, width} ptr
    (height_ ::#type gint)	<- #{peek GdkRectangle, height} ptr
    return $ Rectangle (fromIntegral x_) (fromIntegral y_) 
		       (fromIntegral width_) (fromIntegral height_)
  poke ptr (Rectangle x y width height) = do
    #{poke GdkRectangle, x} ptr ((fromIntegral x)::#type gint)
    #{poke GdkRectangle, y} ptr ((fromIntegral y)::#type gint)
    #{poke GdkRectangle, width} ptr ((fromIntegral width)::#type gint)
    #{poke GdkRectangle, height} ptr ((fromIntegral height)::#type gint)

-- | Color
--
-- * Specifies a color with three integer values for red, green and blue.
--   All values range from 0 (least intense) to 65535 (highest intensity).
--
data Color = Color (#type guint16) (#type guint16) (#type guint16)

instance Storable Color where
  sizeOf _ = #{const sizeof(GdkColor)}
  alignment _ = alignment (undefined::#type guint32)
  peek ptr = do
    red	   <- #{peek GdkColor, red} ptr
    green  <- #{peek GdkColor, green} ptr
    blue   <- #{peek GdkColor, blue} ptr
    return $ Color red green blue
  poke ptr (Color red green blue) = do
    #{poke GdkColor, pixel} ptr (0::#{type gint32})
    #{poke GdkColor, red}   ptr red
    #{poke GdkColor, green} ptr green
    #{poke GdkColor, blue}  ptr blue
    cPtr <- gdkColormapGetSystem
    gdkColormapAllocColor cPtr ptr 0 1
    return ()

#if __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gdk_colormap_get_system"
  gdkColormapGetSystem :: IO (Ptr ())

foreign import ccall unsafe "gdk_colormap_alloc_color"
  gdkColormapAllocColor :: Ptr () -> Ptr Color -> CInt -> CInt -> IO CInt

#else

foreign import ccall "gdk_colormap_get_system" unsafe
  gdkColormapGetSystem :: IO (Ptr ())

foreign import ccall "gdk_colormap_alloc_color" unsafe
  gdkColormapAllocColor :: Ptr () -> Ptr Color -> CInt -> CInt -> IO CInt

#endif

-- entry GC

-- | Intermediate data structure for 'GC's.
--
-- * If @graphicsExposure@ is set then copying portions into a
--   drawable will generate an @\"exposure\"@ event, even if the
--   destination area is not currently visible.
--
data GCValues = GCValues {
  foreground :: Color,
  background :: Color,
  function   :: Function,
  fill       :: Fill,
  tile       :: Maybe Pixmap,
  stipple    :: Maybe Pixmap,
  clipMask   :: Maybe Pixmap,
  subwindowMode :: SubwindowMode,
  tsXOrigin  :: Int,
  tsYOrigin  :: Int,
  clipXOrigin:: Int,
  clipYOrigin:: Int,
  graphicsExposure :: Bool,
  lineWidth  :: Int,
  lineStyle  :: LineStyle,
  capStyle   :: CapStyle,
  joinStyle  :: JoinStyle
  }

instance Storable GCValues where
  sizeOf _ = #{const sizeof(GdkGCValues)}
  alignment _ = alignment (undefined::Color)
  peek ptr = do
    foreground_ <- peek (#{ptr GdkGCValues, foreground} ptr)
    background_ <- peek (#{ptr GdkGCValues, background} ptr)
    (function_	:: #{type GdkFunction}) <- #{peek GdkGCValues, function} ptr
    (fill_	:: #{type GdkFill}) <- #{peek GdkGCValues, fill} ptr
    tile_	<- do
		     pPtr <- #{peek GdkGCValues, tile} ptr
		     if (pPtr==nullPtr) then return Nothing else
		       liftM Just $ makeNewGObject mkPixmap $ return pPtr
    stipple_	<- do
		     pPtr <- #{peek GdkGCValues, stipple} ptr
		     if (pPtr==nullPtr) then return Nothing else
		       liftM Just $ makeNewGObject mkPixmap $ return pPtr
    clipMask_	<- do
		     pPtr <- #{peek GdkGCValues, clip_mask} ptr
		     if (pPtr==nullPtr) then return Nothing else
		       liftM Just $ makeNewGObject mkPixmap $ return pPtr
    (subwindow_	:: #{type GdkSubwindowMode}) 
		<- #{peek GdkGCValues, subwindow_mode} ptr
    (tsXOrigin_	:: #{type gint}) 
		<- #{peek GdkGCValues, ts_x_origin} ptr
    (tsYOrigin_	:: #{type gint}) 
		<- #{peek GdkGCValues, ts_y_origin} ptr
    (clipXOrigin_:: #{type gint}) 
		<- #{peek GdkGCValues, clip_x_origin} ptr
    (clipYOrigin_:: #{type gint}) 
		<- #{peek GdkGCValues, clip_y_origin} ptr
    (graphics_	:: #{type gint})
		<- #{peek GdkGCValues, graphics_exposures} ptr
    (lineWidth_	:: #{type gint})
		<- #{peek GdkGCValues, line_width} ptr
    (lineStyle_	:: #{type GdkLineStyle}) 
		<- #{peek GdkGCValues, line_style} ptr
    (capStyle_	:: #{type GdkCapStyle}) 
		<- #{peek GdkGCValues, cap_style} ptr
    (joinStyle_	:: #{type GdkJoinStyle}) 
		<- #{peek GdkGCValues, join_style} ptr
    return $ GCValues {
      foreground = foreground_,
      background = background_,
      function   = (toEnum.fromIntegral) function_,
      fill       = (toEnum.fromIntegral) fill_,
      tile       = tile_,
      stipple    = stipple_,
      clipMask   = clipMask_,
      subwindowMode = (toEnum.fromIntegral) subwindow_,
      tsXOrigin  = fromIntegral tsXOrigin_,
      tsYOrigin  = fromIntegral tsYOrigin_,
      clipXOrigin= fromIntegral clipXOrigin_,
      clipYOrigin= fromIntegral clipYOrigin_,
      graphicsExposure = toBool graphics_,
      lineWidth  = fromIntegral lineWidth_,
      lineStyle  = (toEnum.fromIntegral) lineStyle_,
      capStyle   = (toEnum.fromIntegral) capStyle_,
      joinStyle  = (toEnum.fromIntegral) joinStyle_
    }

pokeGCValues :: Ptr GCValues -> GCValues -> IO CInt
pokeGCValues ptr (GCValues {
    foreground = foreground_,
    background = background_,
    function   = function_,
    fill       = fill_,
    tile       = tile_,
    stipple    = stipple_,
    clipMask   = clipMask_,
    subwindowMode = subwindow_,
    tsXOrigin  = tsXOrigin_,
    tsYOrigin  = tsYOrigin_,
    clipXOrigin= clipXOrigin_,
    clipYOrigin= clipYOrigin_,
    graphicsExposure = graphics_,
    lineWidth  = lineWidth_,
    lineStyle  = lineStyle_,
    capStyle   = capStyle_,
    joinStyle  = joinStyle_
  }) = do
    r <- newIORef 0
    add r #{const GDK_GC_FOREGROUND } $ 
      poke (#{ptr GdkGCValues, foreground} ptr) foreground_
    add r #{const GDK_GC_BACKGROUND } $ 
      poke (#{ptr GdkGCValues, background} ptr) background_
    add r #{const GDK_GC_FUNCTION } $ 
      #{poke GdkGCValues, function} ptr 
      (fromIntegral (fromEnum function_):: #{type GdkFunction})
    add r #{const GDK_GC_FILL } $
      #{poke GdkGCValues, fill} ptr 
      (fromIntegral (fromEnum fill_):: #{type GdkFill})
    add r #{const GDK_GC_TILE} $
      #{poke GdkGCValues, tile} ptr $
        maybe nullPtr (foreignPtrToPtr.unPixmap) tile_
    add r #{const GDK_GC_STIPPLE} $
      #{poke GdkGCValues, stipple} ptr $
        maybe nullPtr (foreignPtrToPtr.unPixmap) stipple_
    add r #{const GDK_GC_CLIP_MASK } $
      #{poke GdkGCValues, clip_mask} ptr $
        maybe nullPtr (foreignPtrToPtr.unPixmap) clipMask_
    add r #{const GDK_GC_SUBWINDOW } $
      #{poke GdkGCValues, subwindow_mode} ptr
      (fromIntegral (fromEnum subwindow_):: #{type GdkSubwindowMode})
    add r #{const GDK_GC_TS_X_ORIGIN } $
      #{poke GdkGCValues, ts_x_origin } ptr
      (fromIntegral tsXOrigin_:: #{type gint})
    add r #{const GDK_GC_TS_Y_ORIGIN } $
      #{poke GdkGCValues, ts_y_origin } ptr
      (fromIntegral tsYOrigin_:: #{type gint})
    add r #{const GDK_GC_CLIP_X_ORIGIN } $ 
      #{poke GdkGCValues, clip_x_origin } ptr
      (fromIntegral clipXOrigin_:: #{type gint})
    add r #{const GDK_GC_CLIP_Y_ORIGIN } $
      #{poke GdkGCValues, clip_y_origin } ptr
      (fromIntegral clipYOrigin_:: #{type gint})
    add r #{const GDK_GC_EXPOSURES } $
      #{poke GdkGCValues, graphics_exposures } ptr
      (fromBool graphics_:: #{type gint})
    add r #{const GDK_GC_LINE_WIDTH } $
      #{poke GdkGCValues, line_width } ptr
      (fromIntegral lineWidth_:: #{type gint})
    add r #{const GDK_GC_LINE_STYLE } $
      #{poke GdkGCValues, line_style } ptr
      (fromIntegral (fromEnum lineStyle_):: #{type GdkLineStyle})
    add r #{const GDK_GC_CAP_STYLE } $ 
      #{poke GdkGCValues, cap_style } ptr
      (fromIntegral (fromEnum capStyle_):: #{type GdkCapStyle})
    add r #{const GDK_GC_JOIN_STYLE } $ 
      #{poke GdkGCValues, join_style } ptr
      (fromIntegral (fromEnum joinStyle_):: #{type GdkJoinStyle})
    readIORef r
  where
    add :: IORef CInt -> CInt -> IO () -> IO ()
    add r mVal act = handle (const $ return ()) $ do
      act
      modifyIORef r (\val -> val+mVal)

-- constant newGCValues An empty record of 'GCValues'.
--
-- * Use this value instead of the constructor to avoid compiler wanings
--   about uninitialized fields.
--
newGCValues :: GCValues
newGCValues = GCValues {
    foreground = undefined,
    background = undefined,
    function   = undefined,
    fill       = undefined,
    tile       = undefined,
    stipple    = undefined,
    clipMask   = undefined,
    subwindowMode = undefined,
    tsXOrigin  = undefined,
    tsYOrigin  = undefined,
    clipXOrigin= undefined,
    clipYOrigin= undefined,
    graphicsExposure = undefined,
    lineWidth  = undefined,
    lineStyle  = undefined,
    capStyle   = undefined,
    joinStyle  = undefined
  }

-- Widget related methods

-- | Retrieve the current state of the widget.
--
-- * The state refers to different modes of user interaction, see
--   'StateType' for more information.
--
widgetGetState :: WidgetClass w => w -> IO StateType
widgetGetState w = liftM toEnum $ withForeignPtr ((unWidget.toWidget) w) $
  \ptr -> #{peek GtkWidget,state} ptr

-- | Retrieve the current state of the widget.
--
-- * If a widget is turned insensitive, the previous state is stored in
--   a specific location. This function retrieves this previous state.
--
widgetGetSavedState :: WidgetClass w => w -> IO StateType
widgetGetSavedState w = liftM toEnum $ withForeignPtr ((unWidget.toWidget) w) $
  \ptr -> #{peek GtkWidget,saved_state} ptr


-- | Allocation
--
-- * for Widget's size_allocate signal
--
type Allocation = Rectangle


-- | Requisition
--
-- * for Widget's size_request
--
data Requisition = Requisition Int Int

instance Storable Requisition where
  sizeOf _ = #{const sizeof(GtkRequisition)}
  alignment _ = alignment (undefined::#type gint)
  peek ptr = do
    (width_  ::#type gint)	<- #{peek GtkRequisition, width} ptr
    (height_ ::#type gint)	<- #{peek GtkRequisition, width} ptr
    return $ Requisition (fromIntegral width_) (fromIntegral height_)
  poke ptr (Requisition width height) = do
    #{poke GtkRequisition, width} ptr ((fromIntegral width)::#type gint)
    #{poke GtkRequisition, height} ptr ((fromIntegral height)::#type gint)


-- SpinButton related mothods

-- If an invalid input has been put into a SpinButton the input function may
-- reject this value by returning this value.
inputError :: #{type gint}
inputError = #{const GTK_INPUT_ERROR}


-- The TreeIter struct is not used by itself. But we have to allocate space
-- for it in module TreeModel.
treeIterSize :: Int
treeIterSize = #{const sizeof(GtkTreeIter)}


-- The TextIter struct can be a local variable in a C program. We have to
-- store it on the heap.
--
textIterSize :: Int
textIterSize = #{const sizeof(GtkTextIter)}

-- Dialog related methods

-- | Get the upper part of a dialog.
--
-- * The upper part of a dialog window consists of a 'VBox'.
--   Add the required widgets into this box.
--
dialogGetUpper :: DialogClass dc => dc -> IO VBox
dialogGetUpper dc = makeNewObject mkVBox $ liftM castPtr $
  withForeignPtr ((unDialog.toDialog) dc) #{peek GtkDialog, vbox}

-- | Extract the action area of a dialog box.
--
-- * This
-- is useful to add some special widgets that cannot be added with
-- dialogAddActionWidget.
--
dialogGetActionArea :: DialogClass dc => dc -> IO HBox
dialogGetActionArea dc = makeNewObject mkHBox $ liftM castPtr $
  withForeignPtr ((unDialog.toDialog) dc) #{peek GtkDialog, action_area} 

-- | Some constructors that can be used as response
-- numbers for dialogs.
--
data ResponseId

  -- | GTK returns this if a response widget has no @response_id@,
  --   or if the dialog gets programmatically hidden or destroyed.
  = ResponseNone

  -- | GTK won't return these unless you pass them in as
  --   the response for an action widget. They are for your convenience.
  | ResponseReject
  | ResponseAccept -- ^ (as above)

  -- | If the dialog is deleted.
  | ResponseDeleteEvent

  -- | \"Ok\" was pressed.
  --
  -- * This value is returned from the \"Ok\" stock dialog button.
  | ResponseOk

  -- | \"Cancel\" was pressed.
  --
  -- * These value is returned from the \"Cancel\" stock dialog button.
  | ResponseCancel

  -- | \"Close\" was pressed.
  --
  -- * This value is returned from the \"Close\" stock dialog button.
	| ResponseClose

  -- | \"Yes\" was pressed.
  --
  -- * This value is returned from the \"Yes\" stock dialog button.
  | ResponseYes

  -- | \"No\" was pressed.
  --
  -- * This value is returned from the \"No\" stock dialog button.
  | ResponseNo

  -- | \"Apply\" was pressed.
  --
  -- * This value is returned from the \"Apply\" stock dialog button.
	| ResponseApply

  -- |  \"Help\" was pressed.
  --
  -- * This value is returned from the \"Help\" stock dialog button.
  | ResponseHelp

  -- | A user-defined response
  --
  -- * This value is returned from a user defined button
  | ResponseUser Int
  deriving Show

fromResponse :: Integral a => ResponseId -> a
fromResponse ResponseNone = -1
fromResponse ResponseReject = -2
fromResponse ResponseAccept = -3
fromResponse ResponseDeleteEvent = -4
fromResponse ResponseOk = -5
fromResponse ResponseCancel = -6
fromResponse ResponseClose = -7
fromResponse ResponseYes = -8
fromResponse ResponseNo = -9
fromResponse ResponseApply = -10
fromResponse ResponseHelp = -11
fromResponse (ResponseUser i) | i > 0 = fromIntegral i

toResponse :: Integral a => a -> ResponseId
toResponse (-1) = ResponseNone
toResponse (-2) = ResponseReject
toResponse (-3) = ResponseAccept
toResponse (-4) = ResponseDeleteEvent
toResponse (-5) = ResponseOk
toResponse (-6) = ResponseCancel
toResponse (-7) = ResponseClose
toResponse (-8) = ResponseYes
toResponse (-9) = ResponseNo
toResponse (-10) = ResponseApply
toResponse (-11) = ResponseHelp
toResponse i | i > 0  = ResponseUser $ fromIntegral i

-- include<gdk/gdkx.h>

type XID = CUInt	-- unfortunately hsc and c2hs do not agree on the type
			-- of NativeWindow (Word32 vs. CUInt)

-- Query the XID field of the socket widget. This value needs to be
-- sent to the Plug widget of the other application.
--
--socketGetXID :: Socket -> IO XID
--socketGetXID socket = do
--  winPtr <- throwIfNull "socketGetXID: the socket widget is not realized" $
--    withForeignPtr (unSocket socket) #{peek GtkWidget, window}
--  implPtr <- throwIfNull "socketGetXID: no Drawable defined" $
--    #{peek GdkWindowObject, impl} winPtr
--  #{peek GdkDrawableImplX11, xid} implPtr


-- Test if a Plug is connected to the socket.
-- 
--socketHasPlug :: Socket -> IO Bool
--socketHasPlug socket = do
--  plugPtr <- withForeignPtr (unSocket socket) #{peek GtkSocket, plug_window}
--  return (plugPtr/=nullPtr)

#ifndef DISABLE_DEPRECATED
-- Static values for different Toolbar widgets.
--
-- * c2hs and hsc should agree on types!
--
toolbarChildButton, toolbarChildToggleButton, toolbarChildRadioButton ::
  CInt -- \#type GtkToolbarChildType
toolbarChildButton       = #const GTK_TOOLBAR_CHILD_BUTTON
toolbarChildToggleButton = #const GTK_TOOLBAR_CHILD_TOGGLEBUTTON
toolbarChildRadioButton  = #const GTK_TOOLBAR_CHILD_RADIOBUTTON
#endif

-- IconSize is an enumeration in Gtk that can be extended by the user by adding
-- new names for sizes.
type IconSize = Int

iconSizeInvalid      :: IconSize
iconSizeInvalid      = #const GTK_ICON_SIZE_INVALID
iconSizeMenu	     :: IconSize
iconSizeMenu	     = #const GTK_ICON_SIZE_MENU
iconSizeSmallToolbar :: IconSize
iconSizeSmallToolbar = #const GTK_ICON_SIZE_SMALL_TOOLBAR
iconSizeLargeToolbar :: IconSize
iconSizeLargeToolbar = #const GTK_ICON_SIZE_LARGE_TOOLBAR
iconSizeButton	     :: IconSize
iconSizeButton	     = #const GTK_ICON_SIZE_BUTTON
iconSizeDialog	     :: IconSize
iconSizeDialog	     = #const GTK_ICON_SIZE_DIALOG

-- entry Widget Combo

#ifndef DISABLE_DEPRECATED
-- | Extract the List container from a 'Combo' box.
--
comboGetList :: Combo -> IO List
comboGetList c = withForeignPtr (unCombo c) $ \cPtr ->
  makeNewObject mkList $ #{peek GtkCombo, list} cPtr
#endif

-- General related constants

-- | For installing idle callbacks: Priorities.
--
priorityHigh :: Int
priorityHigh  = #const G_PRIORITY_HIGH_IDLE

priorityDefault :: Int
priorityDefault = #const G_PRIORITY_DEFAULT_IDLE

priorityLow :: Int
priorityLow	= #const G_PRIORITY_LOW


-- FileSelection related methods

-- | Extract the buttons of a fileselection.
--
fileSelectionGetButtons :: FileSelectionClass fsel => fsel -> 
			   IO (Button, Button)
fileSelectionGetButtons fsel =
    do
    ok <- butPtrToButton #{peek GtkFileSelection, ok_button}
    cancel <- butPtrToButton #{peek GtkFileSelection, cancel_button}
    return (ok,cancel)
  where
  butPtrToButton bp = makeNewObject mkButton $ liftM castPtr $
      withForeignPtr ((unFileSelection . toFileSelection) fsel) bp

-- DrawingArea related methods

-- | Retrieves the 'Drawable' part.
--
drawingAreaGetDrawWindow :: DrawingArea -> IO DrawWindow
drawingAreaGetDrawWindow da = makeNewGObject mkDrawWindow $
  withForeignPtr (unDrawingArea da) $ 
  \da' -> liftM castPtr $ #{peek GtkWidget, window} da'

-- | Returns the current size.
--
-- * This information may be out of date if the use is resizing the window.
--
drawingAreaGetSize :: DrawingArea -> IO (Int, Int)
drawingAreaGetSize da = withForeignPtr (unDrawingArea da) $ \wPtr -> do
    (width :: #{type gint}) <- #{peek GtkAllocation, width} 
			       (#{ptr GtkWidget, allocation} wPtr)
    (height :: #{type gint}) <- #{peek GtkAllocation, height}
				(#{ptr GtkWidget, allocation} wPtr)
    return (fromIntegral width, fromIntegral height)


-- PangoLayout related constant

-- | Internal unit of measuring sizes.
--
-- * The ref constant pangoScale constant represents the scale between
--   dimensions used for distances in text rendering and device units. (The
--   definition of device units is dependent on the output device; it will
--   typically be pixels for a screen, and points for a printer.)  When
--   setting font sizes, device units are always considered to be points
--   (as in \"12 point font\"), rather than pixels.
--
pangoScale :: Integer
pangoScale = #const PANGO_SCALE


-- Styles related methods

-- helper function to index into an array: hsc2hs turns a pointer
index :: Int -> Ptr GC -> IO (Ptr GC)
index off ptr = return 
  (castPtr (advancePtr ((castPtr ptr)::Ptr (Ptr GC)) off)::Ptr GC)

-- | Retrieve the 'GC' for the foreground
-- color.
--
-- * The parameter @state@ determines for which widget
--   state (one of 'StateType') the 'GC' should be recieved.
--   Use 'widgetGetState' to determine the current state of the
--   widget.
--
styleGetForeground :: StateType -> Style -> IO GC
styleGetForeground ty st = withForeignPtr (unStyle st) $ \stPtr ->
  makeNewGObject mkGC (index (fromEnum ty) (#{ptr GtkStyle, fg_gc} stPtr))

-- | Retrieve the 'GC' for the background
-- color.
--
-- * The parameter @state@ determines for which widget
--   state (one of 'StateType') the 'GC' should be recieved.
--   Use 'widgetGetState' to determine the current state of the
--   widget.
--
styleGetBackground :: StateType -> Style -> IO GC
styleGetBackground ty st = withForeignPtr (unStyle st) $ \stPtr ->
  makeNewGObject mkGC (index (fromEnum ty) (#{ptr GtkStyle, bg_gc} stPtr))

-- | Retrieve the 'GC' for a light
-- color.
--
-- * The parameter @state@ determines for which widget
--   state (one of 'StateType') the 'GC' should be recieved.
--   Use 'widgetGetState' to determine the current state of the
--   widget.
--
styleGetLight :: StateType -> Style -> IO GC
styleGetLight ty st = withForeignPtr (unStyle st) $ \stPtr ->
  makeNewGObject mkGC (index (fromEnum ty) (#{ptr GtkStyle, light_gc} stPtr))

-- | Retrieve the 'GC' for a middle
-- color.
--
-- * The parameter @state@ determines for which widget
--   state (one of 'StateType') the 'GC' should be recieved.
--   Use 'widgetGetState' to determine the current state of the
--   widget.
--
styleGetMiddle :: StateType -> Style -> IO GC
styleGetMiddle ty st = withForeignPtr (unStyle st) $ \stPtr ->
  makeNewGObject mkGC (index (fromEnum ty) (#{ptr GtkStyle, mid_gc} stPtr))

-- | Retrieve the 'GC' for a dark
-- color.
--
-- * The parameter @state@ determines for which widget
--   state (one of 'StateType') the 'GC' should be recieved.
--   Use 'widgetGetState' to determine the current state of the
--   widget.
--
styleGetDark :: StateType -> Style -> IO GC
styleGetDark ty st = withForeignPtr (unStyle st) $ \stPtr ->
  makeNewGObject mkGC (index (fromEnum ty) (#{ptr GtkStyle, dark_gc} stPtr))

-- | Retrieve the 'GC' for the text
-- color.
--
-- * The parameter @state@ determines for which widget
--   state (one of 'StateType') the 'GC' should be recieved.
--   Use 'widgetGetState' to determine the current state of the
--   widget.
--
styleGetText :: StateType -> Style -> IO GC
styleGetText ty st = withForeignPtr (unStyle st) $ \stPtr ->
  makeNewGObject mkGC (index (fromEnum ty) (#{ptr GtkStyle, text_gc} stPtr))

-- | Retrieve the 'GC' for the base
-- color.
--
-- * The base color is the standard text background of a widget.
--
-- * The parameter @state@ determines for which widget
--   state (one of 'StateType') the 'GC' should be recieved.
--   Use 'widgetGetState' to determine the current state of the
--   widget.
--
styleGetBase :: StateType -> Style -> IO GC
styleGetBase ty st = withForeignPtr (unStyle st) $ \stPtr ->
  makeNewGObject mkGC (index (fromEnum ty) (#{ptr GtkStyle, base_gc} stPtr))

-- | Retrieve the 'GC' for drawing
-- anti-aliased text.
--
-- * The anti-aliasing color is the color which is used when the rendering
--   of a character does not make it clear if a certain pixel shoud be set
--   or not. This color is between the text and the base color.
--
-- * The parameter @state@ determines for which widget
--   state (one of 'StateType') the 'GC' should be recieved.
--   Use 'widgetGetState' to determine the current state of the
--   widget.
--
styleGetAntiAliasing :: StateType -> Style -> IO GC
styleGetAntiAliasing ty st = withForeignPtr (unStyle st) $ \stPtr ->
  makeNewGObject mkGC (index (fromEnum ty) (#{ptr GtkStyle, text_aa_gc} stPtr))

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Gdk DrawWindow.hs,NONE,1.1 Region.chs.pp,NONE,1.1 Drawable.chs.pp,NONE,1.1

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

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

Added Files:
	DrawWindow.hs Region.chs.pp Drawable.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Drawable.chs.pp ---
{-# OPTIONS -cpp #-}
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Drawable
--
--  Author : Axel Simon
--  Created: 22 September 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:18:36 $
--
--  Copyright (c) 2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- Drawing primitives.
--
-- * This module defines drawing primitives that can operate on 
--   'DrawWindow's, 'Pixmap's and 'Bitmap's.
--
-- TODO
--
-- * if gdk_visuals are implemented, do: get_visual
--
-- * if gdk_colormaps are implemented, do: set_colormap, get_colormap
--
-- * add draw_glyphs if we are desparate
--
module Graphics.UI.Gtk.Gdk.Drawable (
  Drawable,
  DrawableClass,
  castToDrawable,
  drawableGetDepth,
  drawableGetSize,
  drawableGetClipRegion,
  drawableGetVisibleRegion,
  Point,
  drawPoint,
  drawPoints,
  drawLine,
  drawLines,
#if GTK_CHECK_VERSION(2,2,0)
  Dither(..),
  drawPixbuf,
#endif
  drawSegments,
  drawRectangle,
  drawArc,
  drawPolygon,
  drawLayoutLine,
  drawLayoutLineWithColors,
  drawLayout,
  drawLayoutWithColors,
  drawDrawable) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.GObject		(makeNewGObject)
import Graphics.UI.Gtk.General.Structs	(Point, Color)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Gdk.Region#}	(Region, makeNewRegion)
{#import Graphics.UI.Gtk.Pango.Types#}
import Graphics.UI.Gtk.Gdk.Enums	(Dither(..))

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

-- methods

-- | Get the size of pixels.
--
-- * Returns the number of bits which are use to store information on each
--   pixels in this 'Drawable'.
--
drawableGetDepth :: DrawableClass d => d -> IO Int
drawableGetDepth d = liftM fromIntegral $ 
		     {#call unsafe drawable_get_depth#} (toDrawable d)

-- | Retrieve the size of the 'Drawable'.
--
-- * The result might not be up-to-date if there are still resizing messages
--   to be processed.
--
drawableGetSize :: DrawableClass d => d -> IO (Int, Int)
drawableGetSize d = alloca $ \wPtr -> alloca $ \hPtr -> do
  {#call unsafe drawable_get_size#} (toDrawable d) wPtr hPtr
  (w::{#type gint#}) <- peek wPtr
  (h::{#type gint#}) <- peek hPtr
  return (fromIntegral w, fromIntegral h)

-- | Determine where not to draw.
--
-- * Computes the region of a drawable that potentially can be written
--   to by drawing primitives. This region will not take into account the
--   clip region for the GC, and may also not take into account other
--   factors such as if the window is obscured by other windows, but no
--   area outside of this region will be affected by drawing primitives.
--
drawableGetClipRegion :: DrawableClass d => d -> IO Region
drawableGetClipRegion d = do
  rPtr <- {#call unsafe drawable_get_clip_region#} (toDrawable d)
  makeNewRegion rPtr

-- | Determine what not to redraw.
--
-- * Computes the region of a drawable that is potentially visible.
-- This does not necessarily take into account if the window is obscured
-- by other windows, but no area outside of this region is visible.
--
drawableGetVisibleRegion :: DrawableClass d => d -> IO Region
drawableGetVisibleRegion d = do
  rPtr <- {#call unsafe drawable_get_visible_region#} (toDrawable d)
  makeNewRegion rPtr

-- | Draw a point into a 'Drawable'.
--
drawPoint :: DrawableClass d => d -> GC -> Point -> IO ()
drawPoint d gc (x,y) = {#call unsafe draw_point#} (toDrawable d)
  (toGC gc) (fromIntegral x) (fromIntegral y)


-- | Draw several points into a 'Drawable'.
--
-- * This function is more efficient than calling 'drawPoint' on
--   several points.
--
drawPoints :: DrawableClass d => d -> GC -> [Point] -> IO ()
drawPoints d gc []     = return ()
drawPoints d gc points = 
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_points#} (toDrawable d)
    (toGC gc) (castPtr aPtr) (fromIntegral (length points))

-- | Draw a line into a 'Drawable'.
--
-- * The parameters are x1, y1, x2, y2.
--
-- * Drawing several separate lines can be done more efficiently by
--   'drawSegments'.
--
drawLine :: DrawableClass d => d -> GC -> Point -> Point -> IO ()
drawLine d gc (x1,y1) (x2,y2) = {#call unsafe draw_line#} (toDrawable d)
  (toGC gc) (fromIntegral x1) (fromIntegral y1) (fromIntegral x2) 
  (fromIntegral y2)

-- | Draw several lines.
--
-- * The function uses the current line width, dashing and especially the
--   joining specification in the graphics context (in contrast to
--   'drawSegments'.
--
drawLines :: DrawableClass d => d -> GC -> [Point] -> IO ()
drawLines d gc []     = return ()
drawLines d gc points =
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_lines#} (toDrawable d)
    (toGC gc) (castPtr aPtr) (fromIntegral (length points))

#if GTK_CHECK_VERSION(2,2,0)
-- | Render a 'Pixbuf'.
--
-- * Renders a rectangular portion of a 'Pixbuf' to a
--   'Drawable'. The @srcX@, @srcY@,
--   @srcWidth@ and @srcHeight@ specify what part of the
--   'Pixbuf' should be rendered. The latter two values may be
--   @-1@ in which case the width and height are taken from
--   @pb@. The image is placed at @destX@, @destY@.
--   If you render parts of an image at a time, set @ditherX@ and
--   @ditherY@ to the origin of the image you are rendering.
--
-- * Since 2.2.
--
drawPixbuf :: DrawableClass d => d -> GC -> Pixbuf -> Int -> Int ->
				 Int -> Int -> Int -> Int -> Dither ->
				 Int -> Int -> IO ()
drawPixbuf d gc pb srcX srcY destX destY srcWidth srcHeight dither
  xDither yDither = {#call unsafe draw_pixbuf#} (toDrawable d)
    gc pb (fromIntegral srcX) (fromIntegral srcY) (fromIntegral destX)
    (fromIntegral destY) (fromIntegral srcWidth) (fromIntegral srcHeight)
    ((fromIntegral . fromEnum) dither) (fromIntegral xDither)
    (fromIntegral yDither)

#endif

-- | Draw several unconnected lines.
--
-- * This method draws several unrelated lines.
--
drawSegments :: DrawableClass d => d -> GC -> [(Point,Point)] -> IO ()
drawSegments d gc []  = return ()
drawSegments d gc pps = withArray (concatMap (\((x1,y1),(x2,y2)) -> 
  [fromIntegral x1, fromIntegral y1, fromIntegral x2, fromIntegral y2])
  pps) $ \(aPtr :: Ptr {#type gint#}) ->
    {#call unsafe draw_segments#} (toDrawable d) (toGC gc)
    (castPtr aPtr) (fromIntegral (length pps))

-- | Draw a rectangular object.
--
-- * Draws a rectangular outline or filled rectangle, using the
--   foreground color and other attributes of the 'GC'.
--
-- * A rectangle drawn filled is 1 pixel smaller in both dimensions
--   than a rectangle outlined. Calling 'drawRectangle' w gc
--   True 0 0 20 20 results in a filled rectangle 20 pixels wide and 20
--   pixels high. Calling 'drawRectangle' d gc False 0 0 20 20
--   results in an outlined rectangle with corners at (0, 0), (0, 20), (20,
--   20), and (20, 0), which makes it 21 pixels wide and 21 pixels high.
--
drawRectangle :: DrawableClass d => d -> GC -> Bool -> Int -> Int ->
				       Int -> Int -> IO ()
drawRectangle d gc filled x y width height = {#call unsafe draw_rectangle#}
  (toDrawable d) (toGC gc) (fromBool filled) (fromIntegral x)
  (fromIntegral y) (fromIntegral width) (fromIntegral height)

-- | Draws an arc or a filled 'pie slice'.
--
-- * The arc is defined by the bounding rectangle of the entire
--   ellipse, and the start and end angles of the part of the ellipse to be
--   drawn.
--
-- * The starting angle @aStart@ is relative to the 3 o'clock
--   position, counter-clockwise, in 1\/64ths of a degree. @aEnd@
--   is measured similarly, but relative to @aStart@.
--
drawArc :: DrawableClass d => d -> GC -> Bool -> Int -> Int ->
				 Int -> Int -> Int -> Int -> IO ()
drawArc d gc filled x y width height aStart aEnd =
  {#call unsafe draw_arc#} (toDrawable d) (toGC gc) (fromBool filled)
  (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height)
  (fromIntegral aStart) (fromIntegral aEnd)

-- | Draws an outlined or filled polygon.
--
-- * The polygon is closed automatically, connecting the last point to
--   the first point if necessary.
--
drawPolygon :: DrawableClass d => d -> GC -> Bool -> [Point] -> IO ()
drawPolygon _ _ _ [] = return ()
drawPolygon d gc filled points = 
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr::Ptr {#type gint#}) -> {#call unsafe draw_polygon#} (toDrawable d)
  (toGC gc) (fromBool filled) (castPtr aPtr) (fromIntegral (length points))

-- | Draw a single line of text.
--
-- * The @x@ coordinate specifies the start of the string,
--   the @y@ coordinate specifies the base line.
--
drawLayoutLine :: DrawableClass d => d -> GC -> Int -> Int -> LayoutLine ->
				     IO ()
drawLayoutLine d gc x y text =
  {#call unsafe draw_layout_line#} (toDrawable d) (toGC gc)
    (fromIntegral x) (fromIntegral y) text

-- | Draw a single line of text.
--
-- * The @x@ coordinate specifies the start of the string,
--   the @y@ coordinate specifies the base line.
--
-- * If both colors are @Nothing@ this function will behave like
--   'drawLayoutLine' in that it uses the default colors from
--   the graphics context.
--
drawLayoutLineWithColors :: DrawableClass d => d -> GC -> Int -> Int ->
			    LayoutLine -> Maybe Color -> Maybe Color -> IO ()
drawLayoutLineWithColors d gc x y text foreground background = let
    withMB :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
    withMB Nothing f = f nullPtr
    withMB (Just x) f = with x f
  in
    withMB foreground $ \fPtr -> withMB background $ \bPtr ->
    {#call unsafe draw_layout_line_with_colors#} (toDrawable d) (toGC gc)
      (fromIntegral x) (fromIntegral y) text (castPtr fPtr) (castPtr bPtr)


-- | Draw a paragraph of text.
--
-- * The @x@ and @y@ values specify the upper left
--   point of the layout. 
--
drawLayout :: DrawableClass d => d -> GC -> Int -> Int -> PangoLayout -> IO ()
drawLayout d gc x y text =
  {#call unsafe draw_layout#} (toDrawable d) (toGC gc)
    (fromIntegral x) (fromIntegral y) (toPangoLayout text)

-- | Draw a paragraph of text.
--
-- * The @x@ and @y@ values specify the upper left
--   point of the layout. 
--
-- * If both colors are @Nothing@ this function will behave like
--   'drawLayout' in that it uses the default colors from
--   the graphics context.
--
drawLayoutWithColors :: DrawableClass d => d -> GC -> Int -> Int ->
			PangoLayout -> Maybe Color -> Maybe Color -> IO ()
drawLayoutWithColors d gc x y text foreground background = let
    withMB :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
    withMB Nothing f = f nullPtr
    withMB (Just x) f = with x f
  in
    withMB foreground $ \fPtr -> withMB background $ \bPtr ->
    {#call unsafe draw_layout_with_colors#} (toDrawable d) (toGC gc)
      (fromIntegral x) (fromIntegral y) (toPangoLayout text)
      (castPtr fPtr) (castPtr bPtr)


-- | Copies another 'Drawable'.
--
-- * Copies the (width,height) region of the @src@ at coordinates
--   (@xSrc@, @ySrc@) to coordinates (@xDest@,
--   @yDest@) in the @dest@. The @width@ and\/or
--   @height@ may be given as -1, in which case the entire source
--   drawable will be copied.
--
-- * Most fields in @gc@ are not used for this operation, but
--   notably the clip mask or clip region will be honored.  The source and
--   destination drawables must have the same visual and colormap, or
--   errors will result. (On X11, failure to match visual\/colormap results
--   in a BadMatch error from the X server.)  A common cause of this
--   problem is an attempt to draw a bitmap to a color drawable. The way to
--   draw a bitmap is to set the bitmap as a clip mask on your
--   'GC', then use 'drawRectangle' to draw a 
--   rectangle clipped to the bitmap.
--
drawDrawable :: (DrawableClass src, DrawableClass dest) => 
		dest -> GC -> src -> Int -> Int -> Int -> Int -> 
		Int -> Int -> IO ()
drawDrawable dest gc src xSrc ySrc xDest yDest width height =
  {#call unsafe draw_drawable#} (toDrawable dest) (toGC gc)
  (toDrawable src)
  (fromIntegral xSrc) (fromIntegral ySrc) (fromIntegral xDest)
  (fromIntegral yDest) (fromIntegral width) (fromIntegral height)



--- NEW FILE: DrawWindow.hs ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) DrawWindow
--
--  Author : Axel Simon
--  Created: 5 November 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:18:36 $
--
--  Copyright (c) 2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- A primitive window.
--
--  * This abstract type represents an on-screen window. Since it is derived
--    from 'Drawable', all methods defined there can be used.
--
--  * Every widget usually has a 'DrawWindow' into which it draws its
--    content. 'DrawWindow's become useful when the user creates
--    custom widgets using the 'DrawingArea' skeleton.
--
-- TODO
--
--  * This abstract type corresponds to a @gdk_window@. There seems to be no
--    functions of interest that operate on @gdk_window@s.
--
module Graphics.UI.Gtk.Gdk.DrawWindow (
  DrawWindow,
  DrawWindowClass
  ) where

import Graphics.UI.Gtk.Types



--- NEW FILE: Region.chs.pp ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Region
--
--  Author : Axel Simon
--  Created: 22 September 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:18:36 $
--
--  Copyright (c) 2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- A set of rectangles describing areas to be redrawn.
--
-- * Regions consist of a set of non-overlapping rectangles. They are used to
--   specify the area of a window which needs updating.
--
-- TODO
--
-- * The Span functions and callbacks are not implemented since retrieving
--   a set of rectangles and working on them within Haskell seems to be easier.
--
module Graphics.UI.Gtk.Gdk.Region (
  makeNewRegion,
  Region(Region),
  regionNew,
  FillRule(..),
  regionPolygon,
  regionCopy,
  regionRectangle,
  regionGetClipbox,
  regionGetRectangles,
  regionEmpty,
  regionEqual,
  regionPointIn,
  OverlapType(..),
  regionRectIn,
  regionOffset,
  regionShrink,
  regionUnionWithRect,
  regionIntersect,
  regionUnion,
  regionSubtract,
  regionXor) where

import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.General.Structs	(Point, Rectangle(..))
import Graphics.UI.Gtk.Gdk.Enums	(FillRule(..), OverlapType(..))

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

{#pointer *GdkRegion as Region foreign newtype #}

-- Construct a region from a pointer.
--
makeNewRegion :: Ptr Region -> IO Region
makeNewRegion rPtr = do
  region <- newForeignPtr rPtr (region_destroy rPtr)
  return (Region region)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gdk_region_destroy"
  region_destroy' :: FinalizerPtr Region

region_destroy :: Ptr Region -> FinalizerPtr Region
region_destroy _ = region_destroy'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gdk_region_destroy"
  region_destroy :: Ptr Region -> IO ()

#else

foreign import ccall "gdk_region_destroy" unsafe
  region_destroy :: Ptr Region -> IO ()

#endif


-- | Create an empty region.
--
regionNew :: IO Region
regionNew = do
  rPtr <- {#call unsafe region_new#}
  makeNewRegion rPtr

-- | Convert a polygon into a 'Region'.
--
regionPolygon :: [Point] -> FillRule -> IO Region
regionPolygon points rule =
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr :: Ptr {#type gint#}) -> do
    rPtr <- {#call unsafe region_polygon#} (castPtr aPtr) 
	    (fromIntegral (length points)) ((fromIntegral.fromEnum) rule)
    makeNewRegion rPtr

-- | Copy a 'Region'.
--
regionCopy :: Region -> IO Region
regionCopy r = do
  rPtr <- {#call unsafe region_copy#} r
  makeNewRegion rPtr

-- | Convert a rectangle to a 'Region'.
--
regionRectangle :: Rectangle -> IO Region
regionRectangle rect = withObject rect $ \rectPtr -> do
  regPtr <- {#call unsafe region_rectangle#} (castPtr rectPtr)
  makeNewRegion regPtr

-- | Smallest rectangle including the 
-- 'Region'.
--
regionGetClipbox :: Region -> IO Rectangle
regionGetClipbox r = alloca $ \rPtr -> do
  {#call unsafe region_get_clipbox#} r (castPtr rPtr)
  peek rPtr

-- | Turn the 'Region' into its rectangles.
--
-- * A 'Region' is a set of horizontal bands. Each band
--   consists of one or more rectangles of the same height. No rectangles
--   in a band touch.
--
regionGetRectangles :: Region -> IO [Rectangle]
regionGetRectangles r = 
  alloca $ \(aPtr :: Ptr Rectangle) -> 
  alloca $ \(iPtr :: Ptr {#type gint#}) -> do
    {#call unsafe region_get_rectangles#} r (castPtr aPtr) iPtr
    size <- peek iPtr
    regs <- peekArray (fromIntegral size) aPtr
    {#call unsafe g_free#} (castPtr aPtr)
    return regs

-- | Test if a 'Region' is empty.
--
regionEmpty :: Region -> IO Bool
regionEmpty r = liftM toBool $ {#call unsafe region_empty#} r

-- | Compares two 'Region's for equality.
--
regionEqual :: Region -> Region -> IO Bool
regionEqual r1 r2 = liftM toBool $ {#call unsafe region_equal#} r1 r2

-- | Checks if a point it is within a region.
--
regionPointIn :: Region -> Point -> IO Bool
regionPointIn r (x,y) = liftM toBool $ 
  {#call unsafe region_point_in#} r (fromIntegral x) (fromIntegral y)

-- | Check if a rectangle is within a region.
--
regionRectIn :: Region -> Rectangle -> IO OverlapType
regionRectIn reg rect = liftM (toEnum.fromIntegral) $ withObject rect $
  \rPtr -> {#call unsafe region_rect_in#} reg (castPtr rPtr)

-- | Move a region.
--
regionOffset :: Region -> Int -> Int -> IO ()
regionOffset r dx dy = 
  {#call unsafe region_offset#} r (fromIntegral dx) (fromIntegral dy)

-- | Move a region.
--
-- * Positive values shrink the region, negative values expand it.
--
regionShrink :: Region -> Int -> Int -> IO ()
regionShrink r dx dy = 
  {#call unsafe region_shrink#} r (fromIntegral dx) (fromIntegral dy)

-- | Updates the region to include the rectangle.
--
regionUnionWithRect :: Region -> Rectangle -> IO ()
regionUnionWithRect reg rect = withObject rect $ \rPtr ->
  {#call unsafe region_union_with_rect#} reg (castPtr rPtr)

-- | Intersects one region with another.
--
-- * Changes @reg1@ to include the common areas of @reg1@
--   and @reg2@.
--
regionIntersect :: Region -> Region -> IO ()
regionIntersect reg1 reg2 = {#call unsafe region_intersect#} reg1 reg2

-- | Unions one region with another.
--
-- * Changes @reg1@ to include @reg1@ and @reg2@.
--
regionUnion :: Region -> Region -> IO ()
regionUnion reg1 reg2 = {#call unsafe region_union#} reg1 reg2

-- | Removes pars of a 'Region'.
--
-- * Reduces the region @reg1@ so that is does not include any areas
--   of @reg2@.
--
regionSubtract :: Region -> Region -> IO ()
regionSubtract reg1 reg2 = {#call unsafe region_subtract#} reg1 reg2

-- | XORs two 'Region's.
--
-- * The exclusive or of two regions contains all areas which were not
--   overlapping. In other words, it is the union of the regions minus
--   their intersections.
--
regionXor :: Region -> Region -> IO ()
regionXor reg1 reg2 = {#call unsafe region_xor#} reg1 reg2

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Gdk Keys.chs,NONE,1.1 Gdk.chs,NONE,1.1 GC.chs,NONE,1.1 Enums.chs,NONE,1.1

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

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

Added Files:
	Keys.chs Gdk.chs GC.chs Enums.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: GC.chs ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) GC
--
--  Author : Axel Simon
--  Created: 28 September 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:18:00 $
--
--  Copyright (c) 2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- Graphics contexts.
--
-- * This module Graphics.UI.Gtk.Gdk.supplies graphics contexts  (GCs) which are a convenient way
--   to pass attributes to drawing functions.
--
module Graphics.UI.Gtk.Gdk.GC (
  GC,
  GCClass,
  castToGC,
  gcNew,
  GCValues(GCValues),
  newGCValues,
  Color(..),
  foreground,
  background,
  Function(..),
  function,
  Fill(..),
  fill,
  tile,
  stipple,
  clipMask,
  SubwindowMode(..),
  subwindowMode,
  tsXOrigin,
  tsYOrigin,
  clipXOrigin,
  clipYOrigin,
  graphicsExposure,
  lineWidth,
  LineStyle(..),
  lineStyle,
  CapStyle(..),
  capStyle,
  JoinStyle(..),
  joinStyle,
  gcNewWithValues,
  gcSetValues,
  gcGetValues,
  gcSetClipRectangle,
  gcSetClipRegion,
  gcSetDashes) where

import Monad	(liftM, when)
import Maybe	(fromJust, isJust)
import Control.Exception (handle)

import System.Glib.FFI
import System.Glib.GObject		(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
import Graphics.UI.Gtk.General.Structs
import Graphics.UI.Gtk.General.Enums	(Function(..), Fill(..), SubwindowMode(..), LineStyle(..), 
					 CapStyle(..), JoinStyle(..))
{#import Graphics.UI.Gtk.Gdk.Region#}	(Region(Region))

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

-- | Create an empty graphics context.
--
gcNew :: DrawableClass d => d -> IO GC
gcNew d = do
  gcPtr <- {#call unsafe gc_new#} (toDrawable d)
  if (gcPtr==nullPtr) then return (error "gcNew: null graphics context.")
		      else makeNewGObject mkGC (return gcPtr)


-- | Creates a graphics context with specific values.
--
gcNewWithValues :: DrawableClass d => d -> GCValues -> IO GC
gcNewWithValues d gcv = allocaBytes (sizeOf gcv) $ \vPtr -> do
  mask <- pokeGCValues vPtr gcv
  gc <- makeNewGObject mkGC $ {#call unsafe gc_new_with_values#} 
    (toDrawable d) (castPtr vPtr) mask
  handle (const $ return ()) $ when (isJust (tile gcv)) $ 
    touchForeignPtr ((unPixmap.fromJust.tile) gcv)
  handle (const $ return ()) $ when (isJust (stipple gcv)) $ 
    touchForeignPtr ((unPixmap.fromJust.stipple) gcv)
  handle (const $ return ()) $ when (isJust (clipMask gcv)) $ 
    touchForeignPtr ((unPixmap.fromJust.clipMask) gcv)
  return gc

-- | Change some of the values of a graphics context.
--
gcSetValues :: GC -> GCValues -> IO ()
gcSetValues gc gcv = allocaBytes (sizeOf gcv) $ \vPtr -> do
  mask <- pokeGCValues vPtr gcv
  gc <- {#call unsafe gc_set_values#} gc (castPtr vPtr) mask
  handle (const $ return ()) $ when (isJust (tile gcv)) $ 
    touchForeignPtr ((unPixmap.fromJust.tile) gcv)
  handle (const $ return ()) $ when (isJust (stipple gcv)) $ 
    touchForeignPtr ((unPixmap.fromJust.stipple) gcv)
  handle (const $ return ()) $ when (isJust (clipMask gcv)) $ 
    touchForeignPtr ((unPixmap.fromJust.clipMask) gcv)
  return gc

-- | Retrieve the values in a graphics context.
--
gcGetValues :: GC -> IO GCValues
gcGetValues gc = alloca $ \vPtr -> do
  {#call unsafe gc_get_values#} gc (castPtr vPtr)
  peek vPtr

-- | Set a clipping rectangle.
--
-- * All drawing operations are restricted to this rectangle. This rectangle
--   is interpreted relative to the clip origin.
--
gcSetClipRectangle :: GC -> Rectangle -> IO ()
gcSetClipRectangle gc r = withObject r $ \rPtr ->
  {#call unsafe gc_set_clip_rectangle#} gc (castPtr rPtr)

-- | Set a clipping region.
--
-- * All drawing operations are restricted to this region. This region
--   is interpreted relative to the clip origin.
--
gcSetClipRegion :: GC -> Region -> IO ()
gcSetClipRegion = {#call unsafe gc_set_clip_region#}

-- | Specify the pattern with which lines are drawn.
--
-- *  Every tuple in the list contains an even and an odd segment. Even
--    segments are drawn normally, whereby the 'lineStyle'
--    member of the graphics context defines if odd segements are drawn
--    or not. A @phase@ argument greater than 0 will drop
--    @phase@ pixels before starting to draw.
--
gcSetDashes :: GC -> Int -> [(Int,Int)] -> IO ()
gcSetDashes gc phase onOffList = do
  let onOff :: [{#type gint8#}]
      onOff = concatMap (\(on,off) -> [fromIntegral on, fromIntegral off]) 
	      onOffList
  withArray onOff $ \aPtr ->
    {#call unsafe gc_set_dashes#} gc (fromIntegral phase) aPtr
    (fromIntegral (length onOff))

--- NEW FILE: Enums.chs ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Enumerations
--
--  Author : Manuel M. T. Chakravarty, Axel Simon
--  Created: 13 Januar 1999
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:18:00 $
--
--  Copyright (c) [1999..2001] Manuel M. T. Chakravarty
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- General enumeration types.
--
module Graphics.UI.Gtk.Gdk.Enums (
  CapStyle(..),
  CrossingMode(..),
  Dither(..),
  EventMask(..),
  ExtensionMode(..),
  Fill(..),
  FillRule(..),
  Function(..),
  InputCondition(..),
  JoinStyle(..),
  LineStyle(..),
  NotifyType(..),
  OverlapType(..),
  ScrollDirection(..),
  SubwindowMode(..),
  VisibilityState(..),
  WindowState(..),
  Flags(fromFlags,toFlags)
  ) where

import Data.Bits ((.|.))

class  (Enum a, Bounded a) => Flags a where
  fromFlags ::  [a] -> Int
  toFlags   ::  Int -> [a]

  fromFlags is = orNum 0 is
    where
      orNum n []     = n
      orNum n (i:is) = orNum (n .|. fromEnum i) is
  toFlags n = andNum n minBound
    where
      andNum n (m::a) = (if (n .|. fromEnum m) == n then (m:) else id)
        (if fromEnum m==fromEnum (maxBound::a) then [] else andNum n (succ m))

{#context lib="libgdk" prefix ="gdk"#}

-- | Specify the how the ends of a line is drawn.
--
{#enum CapStyle {underscoreToCase}#}

-- | provide additionl information if cursor crosses a
-- window
--
{#enum CrossingMode {underscoreToCase}#}

-- | Specify how to dither colors onto the screen.
--
{#enum RgbDither as Dither {underscoreToCase}#}

-- | specify which events a widget will emit signals on
--
{#enum EventMask {underscoreToCase} deriving (Bounded)#}

instance Flags EventMask

-- | specify which input extension a widget desires
--
{#enum ExtensionMode {underscoreToCase} deriving(Bounded)#}

instance Flags ExtensionMode

-- | How objects are filled.
--
{#enum Fill {underscoreToCase}#}

-- | Determine how bitmap operations are carried out.
--
{#enum Function {underscoreToCase}#}

-- | Specify how to interpret a polygon.
--
-- * The flag determines what happens if a polygon has overlapping areas.
--
{#enum FillRule {underscoreToCase}#}

-- | Specify on what file condition a callback should be
-- done.
--
{#enum InputCondition {underscoreToCase} deriving(Bounded) #}

instance Flags InputCondition

-- | Determines how adjacent line ends are drawn.
--
{#enum JoinStyle {underscoreToCase}#}

-- | Determines if a line is solid or dashed.
--
{#enum LineStyle {underscoreToCase}#}

-- dunno
--
{#enum NotifyType {underscoreToCase}#}

-- | How a rectangle is contained in a 'Region'.
--
{#enum OverlapType {underscoreToCase}#}

-- | in which direction was scrolled?
--
{#enum ScrollDirection {underscoreToCase}#}

-- | Determine if child widget may be overdrawn.
--
{#enum SubwindowMode {underscoreToCase}#}

-- | visibility of a window
--
{#enum VisibilityState {underscoreToCase,
			VISIBILITY_PARTIAL as VisibilityPartialObscured}#}

-- | the state a GDK window is in
--
{#enum WindowState {underscoreToCase} deriving (Bounded)#}

instance Flags WindowState

--- NEW FILE: Keys.chs ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Keys
--
--  Author : Jens Petersen
--  Created: 24 May 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:18:00 $
--
--  Copyright (c) 2002 Jens Petersen
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- Gdk keyval functions.
--
-- TODO
--
--  * Documentation
--
module Graphics.UI.Gtk.Gdk.Keys (
  keyvalName,
  keyvalFromName
  ) where


import System.Glib.FFI

{#context lib="libgdk" prefix ="gdk"#}

{#fun pure keyval_name as ^ {fromIntegral `Integer'} -> `Maybe String'
    maybePeekUTFString#}
  where
  maybePeekUTFString = unsafePerformIO . (maybePeek peekCString)
--   maybePeekUTFString = maybePeek peekCString

{#fun pure keyval_from_name as ^ {`String'} -> `Integer' fromIntegral#}


--- NEW FILE: Gdk.chs ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Gdk
--
--  Author : Jens Petersen <pet...@ha...>
--  Created: 2003-06-06
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:18:00 $
--
--  Copyright (c) 2003 Jens-Ulrik Holger Petersen
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- Gdk general functions.
--
-- TODO
--
--  * Documentation
--
module Graphics.UI.Gtk.Gdk.Gdk (beep) where

{#context lib="libgdk" prefix ="gdk"#}

beep :: IO ()
beep = {#call beep#}

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Gdk Events.hsc,NONE,1.1 Pixbuf.chs,NONE,1.1

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

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

Added Files:
	Events.hsc Pixbuf.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Pixbuf.chs ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Pixbuf
--
--  Author : Vincenzo Ciancia, Axel Simon
--  Created: 26 March 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:17:26 $
--
--  Copyright (c) 2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- 'Pixbuf's are bitmap images in memory.
--
-- * A Pixbuf is used to represent images. It contains information
--   about the image's pixel data, its color space, bits per sample, width
--   and height, and the rowstride or number of bytes between rows.
--
-- * This module contains functions to scale and crop
--   'Pixbuf's and to scale and crop a 'Pixbuf' and 
--   compose the result with an existing image.
--
-- TODO
--
-- * if there is a portable way of modifying external arrays in Haskell do:
--	gdk_pixbuf_get_pixels, gdk_pixbuf_new_from_data, everything in
--	Inline data, 
--
-- * if anybody writes an image manipulation program, do the checker board
--   functions: gdk_pixbuf_composite_color_simple and
--   gdk_pixbuf_composite_color. Moreover, do: pixbuf_saturate_and_pixelate
--
-- * the animation functions
--
-- * pixbuf loader
--
-- * module interface
--
-- * rendering function for Bitmaps and Pixmaps when the latter are added
--
module Graphics.UI.Gtk.Gdk.Pixbuf (
  Pixbuf,
  PixbufClass,
  PixbufError(..),
  Colorspace(..),
  pixbufGetColorSpace,
  pixbufGetNChannels,
  pixbufGetHasAlpha,
  pixbufGetBitsPerSample,
  pixbufGetWidth,
  pixbufGetHeight,
  pixbufGetRowstride,
  pixbufGetOption,
  pixbufNewFromFile,
  ImageType,
  pixbufGetFormats,
  pixbufSave,
  pixbufNew,
  pixbufNewFromXPMData,
  InlineImage,
  pixbufNewFromInline,
  pixbufNewSubpixbuf,
  pixbufCopy,
  InterpType(..),
  pixbufScaleSimple,
  pixbufScale,
  pixbufComposite,
  pixbufAddAlpha,
  pixbufCopyArea,
  pixbufFill,
  pixbufGetFromDrawable
  ) where

import Monad (liftM)
import Control.Exception(bracket)
import Data.Bits        ((.|.), shiftL)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject
{#import Graphics.UI.Gtk.Types#}
import Graphics.UI.Gtk.General.Structs		(Rectangle(..))
import System.Glib.GError	(GError(..), GErrorClass(..), GErrorDomain,
				checkGError, checkGErrorWithCont)

{#context prefix="gdk" #}

-- | Error codes for loading image files.
--
{#enum PixbufError {underscoreToCase} #}


-- | Enumerate all supported color spaces.
--
-- * Only RGB is supported right now.
--
{#enum Colorspace {underscoreToCase} #}

-- | Queries the color space of a pixbuf.
--
pixbufGetColorSpace :: Pixbuf -> IO Colorspace
pixbufGetColorSpace pb = liftM (toEnum . fromIntegral) $
  {#call unsafe pixbuf_get_colorspace#} pb

-- | Queries the number of colors for each pixel.
--
pixbufGetNChannels :: Pixbuf -> IO Int
pixbufGetNChannels pb = liftM fromIntegral $
  {#call unsafe pixbuf_get_n_channels#} pb

-- | Query if the image has an alpha channel.
--
-- * The alpha channel determines the opaqueness of the pixel.
--
pixbufGetHasAlpha :: Pixbuf -> IO Bool
pixbufGetHasAlpha pb =
  liftM toBool $ {#call unsafe pixbuf_get_has_alpha#} pb

-- | Queries the number of bits for each color.
--
-- * Each pixel is has a number of cannels for each pixel, each channel
--   has this many bits.
--
pixbufGetBitsPerSample :: Pixbuf -> IO Int
pixbufGetBitsPerSample pb = liftM fromIntegral $
  {#call unsafe pixbuf_get_bits_per_sample#} pb

-- | Queries the width of this image.
--
pixbufGetWidth :: Pixbuf -> IO Int
pixbufGetWidth pb = liftM fromIntegral $
  {#call unsafe pixbuf_get_width#} pb

-- | Queries the height of this image.
--
pixbufGetHeight :: Pixbuf -> IO Int
pixbufGetHeight pb = liftM fromIntegral $
  {#call unsafe pixbuf_get_height#} pb

-- | Queries the rowstride of this image.
--
-- * Queries the rowstride of a pixbuf, which is the number of bytes between
--   rows. Use this value to caculate the offset to a certain row.
--
pixbufGetRowstride :: Pixbuf -> IO Int
pixbufGetRowstride pb = liftM fromIntegral $
  {#call unsafe pixbuf_get_rowstride#} pb

-- | Returns an attribut of an image.
--
-- * Looks up if some information was stored under the @key@ when
--   this image was saved.
--
pixbufGetOption :: Pixbuf -> String -> IO (Maybe String)
pixbufGetOption pb key = withUTFString key $ \strPtr -> do
  resPtr <- {#call unsafe pixbuf_get_option#} pb strPtr
  if (resPtr==nullPtr) then return Nothing else
    liftM Just $ peekUTFString resPtr

-- helper functions
pixbufErrorDomain :: GErrorDomain
pixbufErrorDomain = unsafePerformIO {#call unsafe pixbuf_error_quark#}

instance GErrorClass PixbufError where
  gerrorDomain _ = pixbufErrorDomain

handlePixbufError :: GError -> IO (PixbufError,String)
handlePixbufError (GError dom code msg)
  | dom == pixbufErrorDomain = return (toEnum code, msg)
  | otherwise                = fail msg


-- | Load an image synchonously.
--
-- * Use this function to load only small images as this call will block.
--
-- * The function will return @Left (err,msg)@ where @err@
--   is the error code and @msg@ is a human readable description
--   of the error. If an error occurs which is not captured by any of
--   those in 'PixbufError', an exception is thrown.
--
pixbufNewFromFile :: FilePath -> IO (Either (PixbufError,String) Pixbuf)
pixbufNewFromFile fname = 
  checkGErrorWithCont
    (\errPtrPtr -> 
     withUTFString fname $ \strPtr ->
     {#call unsafe pixbuf_new_from_file#} strPtr errPtrPtr)
    (\gerror -> liftM Left $ handlePixbufError gerror)
    (\pbPtr -> liftM Right $ makeNewGObject mkPixbuf (return pbPtr))

-- | A string representing an image file format.
--
type ImageType = String

-- constant pixbufGetFormats A list of valid image file formats.
--
pixbufGetFormats :: [ImageType]

pixbufGetFormats = ["png","bmp","wbmp", "gif","ico","ani","jpeg","pnm",
		    "ras","tiff","xpm","xbm","tga"]

-- | Save an image to disk.
--
-- * The function takes a list of key - value pairs to specify
--   either how an image is saved or to actually save this additional
--   data with the image. JPEG images can be saved with a \"quality\"
--   parameter; its value should be in the range [0,100]. Text chunks
--   can be attached to PNG images by specifying parameters of the form
--   \"tEXt::key\", where key is an ASCII string of length 1-79.
--   The values are Unicode strings.
--
-- * The function returns @Nothing@ if writing was successful.
--   Otherwise the error code and a description is returned or,
--   if the error is not captured by one of the error codes in
--   'PixbufError', an exception is thrown.
--
pixbufSave :: Pixbuf -> FilePath -> ImageType -> [(String, String)] ->
	      IO (Maybe (PixbufError, String))
pixbufSave pb fname iType options =
  let (keys, values) = unzip options in
  let optLen = length keys in
  checkGError (\errPtrPtr ->
    withUTFString fname $ \fnPtr ->
    withUTFString iType $ \tyPtr ->
    allocaArray0 optLen $ \keysPtr ->
    allocaArray optLen $ \valuesPtr -> do
      keyPtrs <- mapM newUTFString keys
      valuePtrs <- mapM newUTFString values
      pokeArray keysPtr keyPtrs
      pokeArray valuesPtr valuePtrs
      {#call unsafe pixbuf_savev#} pb fnPtr tyPtr keysPtr valuesPtr errPtrPtr
      mapM_ free keyPtrs
      mapM_ free valuePtrs
      return Nothing)
  (\gerror -> liftM Just $ handlePixbufError gerror)

-- | Create a new image in memory.
--
-- * Creates a new pixbuf structure and allocates a buffer for
--   it. Note that the buffer is not cleared initially.
--
pixbufNew :: Colorspace -> Bool -> Int -> Int -> Int -> IO Pixbuf
pixbufNew colorspace hasAlpha bitsPerSample width height =
  makeNewGObject mkPixbuf $ 
    {#call pixbuf_new#} ((fromIntegral . fromEnum) colorspace)
      (fromBool hasAlpha) (fromIntegral bitsPerSample) (fromIntegral width)
      (fromIntegral height)

-- | Create a new image from a String.
--
-- * Creates a new pixbuf from a string description.
--
pixbufNewFromXPMData :: [String] -> IO Pixbuf
pixbufNewFromXPMData s =
  bracket (mapM newUTFString s) (mapM free) $ \strPtrs ->
    withArray0 nullPtr strPtrs $ \strsPtr ->
      makeNewGObject mkPixbuf $ {#call pixbuf_new_from_xpm_data#} strsPtr

-- | A dymmy type for inline picture data.
--
-- * This dummy type is used to declare pointers to image data
--   that is embedded in the executable. See
--   'pixbufNewFromInline' for an example.
--
data InlineImage = InlineImage

-- | Create a new image from a static pointer.
--
-- * Like 'pixbufNewFromXPMData', this function allows to
--   include images in the final binary program. The method used by this
--   function uses a binary representation and therefore needs less space
--   in the final executable. Save the image you want to include as
--   @png@ and run: 
--   @echo #include \"my_image.h\" > my_image.c@
--   gdk-pixbuf-csource --raw --extern --name=my_image myimage.png >> my_image.c
--    on it. Write a header file @my_image.h@ containing:
--   @#include <gdk\/gdk.h>
--   extern guint8 my_image\[\];@
--    and save it in the current directory.
--   The created file can be compiled with: 
--   @cc -c my_image.c \`pkg-config --cflags gdk-2.0\`@
--    into an object file which must be linked into your Haskell program by
--   specifying @my_image.o@ and @"-#include my_image.h"@ on
--   the command line of GHC.
--   Within you application you delcare a pointer to this image: 
--   @foreign label \"my_image\" myImage :: Ptr InlineImage@
--    Calling 'pixbufNewFromInline' with this pointer will
--   return the image in the object file. Creating the C file with
--   the @--raw@ flag will result in a non-compressed image in the
--   object file. The advantage is that the picture will not be
--   copied when this function is called.
--
--
pixbufNewFromInline :: Ptr InlineImage -> IO Pixbuf
pixbufNewFromInline iPtr = alloca $ \errPtrPtr -> do
  pbPtr <- {#call unsafe pixbuf_new_from_inline#} (-1) (castPtr iPtr)
    (fromBool False) (castPtr errPtrPtr)
  if pbPtr/=nullPtr then makeNewGObject mkPixbuf (return pbPtr)
    else do
      errPtr <- peek errPtrPtr
      (GError dom code msg) <- peek errPtr
      error msg

-- | Create a restricted view of an image.
--
-- * This function returns a 'Pixbuf' object which shares
--   the image of the original one but only shows a part of it.
--   Modifying either buffer will affect the other.
--
-- * This function throw an exception if the requested bounds are invalid.
--
pixbufNewSubpixbuf :: Pixbuf -> Int -> Int -> Int -> Int -> IO Pixbuf
pixbufNewSubpixbuf pb srcX srcY height width =
  makeNewGObject mkPixbuf $ do
    pbPtr <- {#call unsafe pixbuf_new_subpixbuf#} pb
      (fromIntegral srcX) (fromIntegral srcY)
      (fromIntegral height) (fromIntegral width)
    if pbPtr==nullPtr then error "pixbufNewSubpixbuf: invalid bounds"
      else return pbPtr

-- | Create a deep copy of an image.
--
pixbufCopy :: Pixbuf -> IO Pixbuf
pixbufCopy pb = makeNewGObject mkPixbuf $ {#call unsafe pixbuf_copy#} pb


-- | How an image is scaled.
--
-- [@InterpNearest@] Nearest neighbor sampling; this is the
--   fastest and lowest quality mode. Quality is normally unacceptable when
--   scaling down, but may be OK when scaling up.
--
-- [@InterpTiles@] This is an accurate simulation of the
--   PostScript image operator without any interpolation enabled. Each
--   pixel is rendered as a tiny parallelogram of solid color, the edges of
--   which are implemented with antialiasing. It resembles nearest neighbor
--   for enlargement, and bilinear for reduction.
--
-- [@InterpBilinear@] Best quality\/speed balance; use this
--   mode by default. Bilinear interpolation. For enlargement, it is
--   equivalent to point-sampling the ideal bilinear-interpolated
--   image. For reduction, it is equivalent to laying down small tiles and
--   integrating over the coverage area.
--
-- [@InterpHyper@] This is the slowest and highest quality
--   reconstruction function. It is derived from the hyperbolic filters in
--   Wolberg's \"Digital Image Warping\", and is formally defined as the
--   hyperbolic-filter sampling the ideal hyperbolic-filter interpolated
--   image (the filter is designed to be idempotent for 1:1 pixel mapping).
--
{#enum InterpType {underscoreToCase} #}

-- | Scale an image.
--
-- * Creates a new 'GdkPixbuf' containing a copy of 
--   @src@ scaled to the given measures. Leaves @src@
--   unaffected. 
--
-- * @interp@ affects the quality and speed of the scaling function.
--   'InterpNearest' is the fastest option but yields very poor quality
--   when scaling down. 'InterpBilinear' is a good trade-off between
--   speed and quality and should thus be used as a default.
--
pixbufScaleSimple :: Pixbuf -> Int -> Int -> InterpType -> IO Pixbuf
pixbufScaleSimple pb width height interp =
    makeNewGObject mkPixbuf $ liftM castPtr $ 
	{#call pixbuf_scale_simple#} (toPixbuf pb) 
	(fromIntegral width) (fromIntegral height)
	(fromIntegral $ fromEnum interp)

-- | Copy a scaled image part to another image.
--
-- * This function is the generic version of 'pixbufScaleSimple'.
--   It scales @src@ by @scaleX@ and @scaleY@ and
--   translate the image by @offsetX@ and @offsetY@. Whatever
--   is in the intersection with the rectangle @destX@,
--   @destY@, @destWidth@, @destHeight@ will be
--   rendered into @dest@.
--
-- * The rectangle in the destination is simply overwritten. Use
--   'pixbufComposite' if you need to blend the source
--   image onto the destination.
--
pixbufScale :: Pixbuf -> Pixbuf -> Int -> Int -> Int -> Int ->
	       Double -> Double -> Double -> Double -> InterpType -> IO ()
pixbufScale src dest destX destY destWidth destHeight offsetX offsetY
            scaleX scaleY interp = {#call unsafe pixbuf_scale#} src dest
  (fromIntegral destX) (fromIntegral destY) (fromIntegral destHeight)
  (fromIntegral destWidth) (realToFrac offsetX) (realToFrac offsetY)
  (realToFrac scaleX) (realToFrac scaleY)
  ((fromIntegral . fromEnum) interp)

-- | Blend a scaled image part onto another image.
--
-- * This function is similar to 'pixbufScale' but allows the
--   original image to \"shine through\". The @alpha@ value determines
--   how opaque the source image is. Passing @0@ is
--   equivalent to not calling this function at all, passing
--   @255@ has the
--   same effect as calling 'pixbufScale'.
--
pixbufComposite :: Pixbuf -> Pixbuf -> Int -> Int -> Int -> Int ->
		   Double -> Double -> Double -> Double -> InterpType ->
	       	   Word8 -> IO ()
pixbufComposite src dest destX destY destWidth destHeight
  offsetX offsetY scaleX scaleY interp alpha =
  {#call unsafe pixbuf_composite#} src dest
  (fromIntegral destX) (fromIntegral destY) (fromIntegral destHeight)
  (fromIntegral destWidth) (realToFrac offsetX) (realToFrac offsetY)
  (realToFrac scaleX) (realToFrac scaleY)
  ((fromIntegral . fromEnum) interp) (fromIntegral alpha)

-- | Add an opacity layer to the 'Pixbuf'.
--
-- * This function returns a copy of the given @src@
--   'Pixbuf', leaving @src@ unmodified.
--   The new 'Pixbuf' has an alpha (opacity)
--   channel which defaults to @255@ (fully opaque pixels)
--   unless @src@ already had an alpha channel in which case
--   the original values are kept.
--   Passing in a color triple @(r,g,b)@ makes all
--   pixels that have this color fully transparent
--   (opacity of @0@). The pixel color itself remains unchanged
--   during this substitution.
--
pixbufAddAlpha :: Pixbuf -> Maybe (Word8, Word8, Word8) -> IO Pixbuf
pixbufAddAlpha pb Nothing = makeNewGObject mkPixbuf $
  {#call unsafe pixbuf_add_alpha#} pb (fromBool False) 0 0 0
pixbufAddAlpha pb (Just (r,g,b)) = makeNewGObject mkPixbuf $
  {#call unsafe pixbuf_add_alpha#} pb (fromBool True)
    (fromIntegral r) (fromIntegral g) (fromIntegral b)

-- | Copy a rectangular portion into another
-- 'Pixbuf'.
--
-- * The source 'Pixbuf' remains unchanged. Converion between
--   different formats is done automatically.
--
pixbufCopyArea :: Pixbuf -> Int -> Int -> Int -> Int ->
		  Pixbuf -> Int -> Int -> IO ()
pixbufCopyArea src srcX srcY srcWidth srcHeight dest destX destY =
  {#call unsafe pixbuf_copy_area#} src (fromIntegral srcX)
    (fromIntegral srcY) (fromIntegral srcHeight) (fromIntegral srcWidth)
    dest (fromIntegral destX) (fromIntegral destY)

-- | Fills a 'Pixbuf' with a color.
--
-- * The passed-in color is a quadruple consisting of the red, green, blue
--   and alpha component of the pixel. If the 'Pixbuf' does not
--   have an alpha channel, the alpha value is ignored.
--
pixbufFill :: Pixbuf -> Word8 -> Word8 -> Word8 -> Word8 -> IO ()
pixbufFill pb red green blue alpha = {#call unsafe pixbuf_fill#} pb
  ((fromIntegral red)   `shiftL` 24 .|.
   (fromIntegral green) `shiftL` 16 .|.
   (fromIntegral blue)  `shiftL`  8 .|.
   (fromIntegral alpha))

-- | Take a screenshot of a 'Drawable'.
--
-- * This function creates a 'Pixbuf' and fills it with the image
--   currently in the 'Drawable' (which might be invalid if the
--   window is obscured or minimized). Note that this transfers data from
--   the server to the client on X Windows.
--
-- * This function will return a 'Pixbuf' with no alpha channel
--   containing the part of the 'Drawable' specified by the
--   rectangle. The function will return @Nothing@ if the window
--   is not currently visible.
--
pixbufGetFromDrawable :: DrawableClass d => d -> Rectangle -> IO (Maybe Pixbuf)
pixbufGetFromDrawable d (Rectangle x y width height) = do
  pbPtr <- {#call unsafe pixbuf_get_from_drawable#} 
    (mkPixbuf nullForeignPtr) (toDrawable d) (mkColormap nullForeignPtr)
    (fromIntegral x) (fromIntegral y) 0 0
    (fromIntegral width) (fromIntegral height)
  if pbPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkPixbuf (return pbPtr)

--- NEW FILE: Events.hsc ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Datastructure
--
--  Author : Axel Simon
--          
--  Created: 27 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:17:26 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--

module Graphics.UI.Gtk.Gdk.Events (
  Modifier,		-- a mask of control keys
  -- tests for a specific control key
  hasShift,
  hasLock, 
  hasControl, 
  hasMod1, 
  hasMod2, 
  hasMod3, 
  hasMod4, 
  hasMod5,
  hasButLeft, 
  hasButRight, 
  hasButMiddle,
  Event(..),		-- information in event callbacks from Gdk
  -- selector functions
#if __GLASGOW_HASKELL__<600
  sent,			-- True if this is event does not come from user input
  area,			-- Rectangle which is to be exposed, etc.
  count,		-- number of upcoming events
  time,			-- running number of event
  x,y,			-- floating point coordinates within widget
  xRoot, yRoot,		-- dto., relative to parent widget
  modif,		-- the modifier keys that were active
  isHint,		-- True if this is a hint in the X Windows meaning
  button,		-- Button number which triggered event
  keyval,		-- key code (see gdk/gdkkeysyms.h)
  len,			-- length of string that a key generated
  str,			-- the string a key generated
  cMode,		-- crossing mode
  nType,		-- notify type
  inFocus,		-- True if event is generated for entering widget
  xPar, yPar,		-- new integral values for position relative to parent
  width, height,	-- new size of a widget
  visible,		-- state of visibility
  wMask, wState,	-- new (?possible? and) real state of a window
#endif
  marshalEvent,		-- convert a pointer to an event data structure
  -- used data structures
  VisibilityState(..),
  CrossingMode(..),
  NotifyType(..),
  WindowState(..),
  ScrollDirection(..),
  Button(..),
  Click(..),
  Rectangle(..)
  ) where

import Data.Bits ((.&.))

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Gdk.Enums	(VisibilityState(..),
					 CrossingMode(..),
					 NotifyType(..),
					 WindowState(..),
					 ScrollDirection(..))
import Graphics.UI.Gtk.General.Enums	(Button(..), Click(..))
import Graphics.UI.Gtk.General.Structs	(Rectangle(..))

#include <gdk/gdk.h>


-- | modifier key flags
--
type Modifier = #{type guint}

hasShift, hasLock, hasControl, hasMod1, hasMod2, hasMod3, hasMod4, hasMod5,
  hasButLeft, hasButRight, hasButMiddle :: Modifier -> Bool
hasShift     x = (x .&. #{const GDK_SHIFT_MASK}) /= 0
hasLock	     x = (x .&. #{const GDK_LOCK_MASK}) /= 0
hasControl   x = (x .&. #{const GDK_CONTROL_MASK}) /= 0
hasMod1	     x = (x .&. #{const GDK_MOD1_MASK}) /= 0
hasMod2	     x = (x .&. #{const GDK_MOD2_MASK}) /= 0
hasMod3	     x = (x .&. #{const GDK_MOD3_MASK}) /= 0
hasMod4	     x = (x .&. #{const GDK_MOD4_MASK}) /= 0
hasMod5	     x = (x .&. #{const GDK_MOD5_MASK}) /= 0
hasButLeft   x = (x .&. #{const GDK_BUTTON1_MASK}) /= 0
hasButRight  x = (x .&. #{const GDK_BUTTON3_MASK}) /= 0
hasButMiddle x = (x .&. #{const GDK_BUTTON2_MASK}) /= 0


data Event
  = Event {
    sent	:: Bool }    
  | Expose {
    sent	:: Bool,
    area	:: Rectangle,
    count	:: Int }
  | Motion {
    sent	:: Bool,
    time	:: Integer,
    x,y		:: Double,
    modif	:: Modifier,
    isHint	:: Bool,
    xRoot,
    yRoot	:: Double } 
  | Button {
    sent	:: Bool,
    click	:: Click,
    time	:: Integer,
    x,y		:: Double,
    modif	:: Modifier,
    button	:: Button,
    xRoot,
    yRoot	:: Double }
  | Key {
    release	:: Bool,
    sent	:: Bool,
    time	:: Integer,
    modif	:: Modifier,
    keyval	:: Integer,
    len		:: Int,
    str		:: String }
  | Crossing {
    sent	:: Bool,
    time	:: Integer,
    x,y		:: Double,
    xRoot,
    yRoot	:: Double,
    cMode	:: CrossingMode,
    nType	:: NotifyType,
    modif	:: Modifier}
  | Focus {
    sent	:: Bool,
    inFocus	:: Bool}
  | Configure {
    sent	:: Bool,
    xPar	:: Int,
    yPar	:: Int,
    width	:: Int,
    height	:: Int}
  | Property {
    sent	:: Bool,
    time	:: Integer}
  | Visibility {
    sent	:: Bool,
    visible	:: VisibilityState }
  | Scroll {
    sent	:: Bool,
    time	:: Integer,
    x,y		:: Double,
    direc	:: ScrollDirection,
    xRoot,
    yRoot	:: Double}
  | WindowState {
    sent	:: Bool,
    wMask	:: WindowState,
    wState	:: WindowState} 

marshalEvent :: Ptr Event -> IO Event
marshalEvent ptr = do
  (eType::#type GdkEventType) <- #{peek GdkEventAny,type} ptr
  (case eType of
    #{const GDK_EXPOSE}		-> marshExpose
    #{const GDK_MOTION_NOTIFY}	-> marshMotion
    #{const GDK_BUTTON_PRESS}	-> marshButton SingleClick
    #{const GDK_2BUTTON_PRESS}  -> marshButton DoubleClick
    #{const GDK_3BUTTON_PRESS}	-> marshButton TripleClick
    #{const GDK_BUTTON_RELEASE}	-> marshButton ReleaseClick
    #{const GDK_KEY_PRESS}	-> marshKey False
    #{const GDK_KEY_RELEASE}	-> marshKey True
    #{const GDK_ENTER_NOTIFY}	-> marshCrossing
    #{const GDK_FOCUS_CHANGE}	-> marshFocus
    #{const GDK_CONFIGURE}	-> marshConfigure
    #{const GDK_PROPERTY_NOTIFY}-> marshProperty
    #{const GDK_SELECTION_CLEAR}-> marshSelection
    #{const GDK_SELECTION_REQUEST}-> marshSelection
    #{const GDK_SELECTION_NOTIFY}-> marshSelection
    #{const GDK_PROXIMITY_IN}   -> marshProximity True
    #{const GDK_PROXIMITY_OUT}	-> marshProximity False
    #{const GDK_DRAG_ENTER}	-> marshDND
    #{const GDK_DRAG_LEAVE}	-> marshDND
    #{const GDK_DRAG_MOTION}	-> marshDND
    #{const GDK_DRAG_STATUS}	-> marshDND
    #{const GDK_DROP_START}	-> marshDND
    #{const GDK_DROP_FINISHED}	-> marshDND
    #{const GDK_CLIENT_EVENT}	-> marshClient
    #{const GDK_VISIBILITY_NOTIFY}-> marshVisibility
    #{const GDK_NO_EXPOSE}	-> marshNoExpose
    #{const GDK_SCROLL}		-> marshScroll
    #{const GDK_WINDOW_STATE}	-> marshWindowState
    #{const GDK_SETTING}	-> marshSetting
    _				-> marshAny
    ) ptr

marshAny ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventAny, send_event} ptr
  return $ Event {
    sent   = toBool sent_ }

marshExpose ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventExpose, send_event} ptr
  (area_   ::Rectangle)		<- #{peek GdkEventExpose, area} ptr
  (count_  ::#type gint)	<- #{peek GdkEventExpose, count} ptr
  return $ Expose {
    sent   = toBool sent_,
    area   = area_,
    count  = fromIntegral count_}

marshMotion ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventMotion, send_event} ptr
  (time_   ::#type guint32)	<- #{peek GdkEventMotion, time} ptr
  (x_	   ::#type gdouble)	<- #{peek GdkEventMotion, x} ptr
  (y_	   ::#type gdouble)	<- #{peek GdkEventMotion, y} ptr
  (modif_  ::#type guint)	<- #{peek GdkEventMotion, state} ptr
  (isHint_ ::#type gint16)	<- #{peek GdkEventMotion, is_hint} ptr
  (xRoot_  ::#type gdouble)	<- #{peek GdkEventMotion, x_root} ptr
  (yRoot_  ::#type gdouble)	<- #{peek GdkEventMotion, y_root} ptr
  return $ Motion {
    sent   = toBool sent_,
    time   = fromIntegral time_,
    x	   = (fromRational.toRational) x_,
    y	   = (fromRational.toRational) y_,
    modif  = fromIntegral modif_,
    isHint = toBool isHint_,
    xRoot  = (fromRational.toRational) xRoot_,
    yRoot  = (fromRational.toRational) yRoot_}

marshButton but ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventButton, send_event} ptr
  (time_   ::#type guint32)	<- #{peek GdkEventButton, time} ptr
  (x_	   ::#type gdouble)	<- #{peek GdkEventButton, x} ptr
  (y_	   ::#type gdouble)	<- #{peek GdkEventButton, y} ptr
  (modif_  ::#type guint)	<- #{peek GdkEventButton, state} ptr
  (button_ ::#type guint)	<- #{peek GdkEventButton, button} ptr
  (xRoot_  ::#type gdouble)	<- #{peek GdkEventButton, x_root} ptr
  (yRoot_  ::#type gdouble)	<- #{peek GdkEventButton, y_root} ptr
  return $ Button {
    click  = but,
    sent   = toBool sent_,
    time   = fromIntegral time_,
    x	   = (fromRational.toRational) x_,
    y	   = (fromRational.toRational) y_,
    modif  = fromIntegral modif_,
    button = (toEnum.fromIntegral) button_,
    xRoot  = (fromRational.toRational) xRoot_,
    yRoot  = (fromRational.toRational) yRoot_}


marshKey up ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventKey, send_event} ptr
  (time_   ::#type guint32)	<- #{peek GdkEventKey, time} ptr
  (modif_  ::#type guint)	<- #{peek GdkEventKey, state} ptr
  (keyval_ ::#type guint)	<- #{peek GdkEventKey, keyval} ptr
  (string_ ::CString)		<- #{peek GdkEventKey, string} ptr
  str_				<- peekUTFString string_
  (length_ ::#type gint)	<- #{peek GdkEventKey, length} ptr
  return $ Key {
    release = up,
    sent = toBool sent_,
    time   = fromIntegral time_,
    modif  = fromIntegral modif_,
    keyval = fromIntegral keyval_,
    len	   = fromIntegral length_,
    str	   = str_}

marshCrossing ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventCrossing, send_event} ptr
  (time_   ::#type guint32)	<- #{peek GdkEventCrossing, time} ptr
  (x_	   ::#type gdouble)	<- #{peek GdkEventCrossing, x} ptr
  (y_	   ::#type gdouble)	<- #{peek GdkEventCrossing, y} ptr
  (modif_  ::#type guint)	<- #{peek GdkEventCrossing, state} ptr
  (xRoot_  ::#type gdouble)	<- #{peek GdkEventCrossing, x_root} ptr
  (yRoot_  ::#type gdouble)	<- #{peek GdkEventCrossing, y_root} ptr
  (cMode_  ::#type GdkCrossingMode) 
				<- #{peek GdkEventCrossing, mode} ptr
  (nType_  ::#type GdkNotifyType)
				<- #{peek GdkEventCrossing, detail} ptr  
  (modif_  ::#type guint)	<- #{peek GdkEventCrossing, state} ptr
  return $ Crossing {
    sent   = toBool sent_,
    time   = fromIntegral time_,
    x	   = (fromRational.toRational) x_,
    y	   = (fromRational.toRational) y_,
    xRoot  = (fromRational.toRational) xRoot_,
    yRoot  = (fromRational.toRational) yRoot_,
    cMode  = (toEnum.fromIntegral) cMode_,
    nType  = (toEnum.fromIntegral) nType_,
    modif  = fromIntegral modif_}


marshFocus ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventFocus, send_event} ptr
  (inFocus_::#type gint16)	<- #{peek GdkEventFocus, in} ptr
  return $ Focus {
    sent   = toBool sent_,
    inFocus= toBool inFocus_}

marshConfigure ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventConfigure, send_event} ptr
  (xPar_   ::#type gint)	<- #{peek GdkEventConfigure, x} ptr
  (yPar_   ::#type gint)	<- #{peek GdkEventConfigure, y} ptr
  (width_  ::#type gint)	<- #{peek GdkEventConfigure, width} ptr
  (height_ ::#type gint)	<- #{peek GdkEventConfigure, height} ptr
  return $ Configure {
    sent   = toBool sent_,
    xPar   = fromIntegral xPar_,
    yPar   = fromIntegral yPar_,
    width  = fromIntegral width_,
    height = fromIntegral height_}

marshProperty ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventProperty, send_event} ptr
  (time_   ::#type guint32)	<- #{peek GdkEventProperty, time} ptr
  return $ Property {
    sent   = toBool sent_,
    time   = fromIntegral time_}

marshSelection = marshAny

marshProximity _ = marshAny

marshDND = marshAny

-- this should be changed (i.e. implemented)
marshClient = marshAny

marshVisibility ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventVisibility, send_event} ptr
  (state_  ::#type GdkVisibilityState)
				<- #{peek GdkEventVisibility, state} ptr
  return $ Visibility {
    sent   = toBool sent_,
    visible= (toEnum.fromIntegral) state_}


marshNoExpose = marshAny

marshScroll ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventScroll, send_event} ptr
  (time_   ::#type guint32)	<- #{peek GdkEventScroll, time} ptr
  (x_	  ::#type gdouble)	<- #{peek GdkEventScroll, x} ptr
  (y_	  ::#type gdouble)	<- #{peek GdkEventScroll, y} ptr
  (direc_  ::#type GdkScrollDirection)
				<- #{peek GdkEventScroll, direction} ptr
  (xRoot_  ::#type gdouble)	<- #{peek GdkEventScroll, x_root} ptr
  (yRoot_  ::#type gdouble)	<- #{peek GdkEventScroll, y_root} ptr
  return $ Scroll {
    sent   = toBool sent_,
    time   = fromIntegral time_,
    x	   = (fromRational.toRational) x_,
    y	   = (fromRational.toRational) y_,
    direc  = (toEnum.fromIntegral) direc_,
    xRoot  = (fromRational.toRational) xRoot_,
    yRoot  = (fromRational.toRational) yRoot_}


marshWindowState ptr = do
  (sent_   ::#type gint8)	<- #{peek GdkEventWindowState, send_event} ptr
  (wMask_  ::#type GdkWindowState)
			<- #{peek GdkEventWindowState, changed_mask} ptr
  (wState_ ::#type GdkWindowState)
			<- #{peek GdkEventWindowState, new_window_state} ptr
  return $ WindowState {
    sent   = toBool sent_,
    wMask  = (toEnum.fromIntegral) wMask_,
    wState = (toEnum.fromIntegral) wState_}

-- what event might this type be?
marshSetting = marshAny

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Entry Editable.chs.pp,NONE,1.1 Entry.chs.pp,NONE,1.1 EntryCompletion.chs.pp,NONE,1.1

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

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

Added Files:
	Editable.chs.pp Entry.chs.pp EntryCompletion.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Entry.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Entry
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:16:34 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- * This widget lets the user enter a single line of text.
--
-- * TODO
--
-- * A couple of signals are not bound because I could not figure out what
--   they mean. Some of them do not seem to be emitted at all.
--
module Graphics.UI.Gtk.Entry.Entry (
  Entry,
  EntryClass,
  castToEntry,
  entryNew,
  entrySetText,
  entryGetText,
#ifndef DISABLE_DEPRECATED
  entryAppendText,
  entryPrependText,
#endif
  entrySetVisibility,
  entryGetVisibility,
  entrySetInvisibleChar,
  entryGetInvisibleChar,
  entrySetMaxLength,
  entryGetActivatesDefault,
  entrySetActivatesDefault,
  entryGetHasFrame,
  entrySetHasFrame,
  entryGetWidthChars,
  entrySetWidthChars,
#if GTK_CHECK_VERSION(2,4,0)
  entrySetAlignment,
  entryGetAlignment,
  entrySetCompletion,
  entryGetCompletion,
#endif
  onEntryActivate,
  afterEntryActivate,
  onCopyClipboard,
  afterCopyClipboard,
  onCutClipboard,
  afterCutClipboard,
  onPasteClipboard,
  afterPasteClipboard,
  onInsertAtCursor,
  afterInsertAtCursor,
  onToggleOverwrite,
  afterToggleOverwrite
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import System.Glib.GObject (makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Char	(ord, chr)

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

-- GtkEntry implements the GtkEditable interface
instance EditableClass Entry

-- methods

-- | Create a new 'Entry' widget.
--
entryNew :: IO Entry
entryNew  = makeNewObject mkEntry $ liftM castPtr $ {#call unsafe entry_new#}

-- | Set the text of the 'Entry' widget.
--
entrySetText :: EntryClass ec => ec -> String -> IO ()
entrySetText ec str = withUTFString str $ {#call entry_set_text#} (toEntry ec)

-- | Get the text of the 'Entry' widget.
--
entryGetText :: EntryClass ec => ec -> IO String
entryGetText ec = {#call entry_get_text#} (toEntry ec) >>= peekUTFString

#ifndef DISABLE_DEPRECATED
-- | Append to the text of the 'Entry' widget.
--
entryAppendText :: EntryClass ec => ec -> String -> IO ()
entryAppendText ec str = 
  withUTFString str $ {#call entry_append_text#} (toEntry ec)

-- | Prepend the text of the 'Entry' widget.
--
entryPrependText :: EntryClass ec => ec -> String -> IO ()
entryPrependText ec str = 
  withUTFString str $ {#call entry_prepend_text#} (toEntry ec)
#endif

-- | Set whether to use password mode (display stars instead of the text).
--
-- * The replacement character can be changed with 'entrySetInvisibleChar'.
--
entrySetVisibility :: EntryClass ec => ec -> Bool -> IO ()
entrySetVisibility ec visible =
  {#call entry_set_visibility#} (toEntry ec) (fromBool visible)

-- | Get whether widget is in password mode.
--
entryGetVisibility :: EntryClass ec => ec -> IO Bool
entryGetVisibility ec =
  liftM toBool $ {#call entry_get_visibility#} (toEntry ec)

-- | Set the replacement character for invisible text.
--
entrySetInvisibleChar :: EntryClass ec => ec -> Char -> IO ()
entrySetInvisibleChar ec ch =
  {#call unsafe entry_set_invisible_char#} (toEntry ec) ((fromIntegral.ord) ch)

-- | Get the current replacement character for invisible text,
-- or 0 if not in password mode.
--
entryGetInvisibleChar :: EntryClass ec => ec -> IO Char
entryGetInvisibleChar ec = liftM (chr.fromIntegral) $
  {#call unsafe entry_get_invisible_char#} (toEntry ec)

-- | Sets a maximum length the text may grow to.
--
-- * A negative number resets the restriction.
--
entrySetMaxLength :: EntryClass ec => ec -> Int -> IO ()
entrySetMaxLength ec max = 
  {#call entry_set_max_length#} (toEntry ec) (fromIntegral max)

-- | Gets a maximum length the text is allowed to grow to.
--
entryGetMaxLength :: EntryClass ec => ec -> IO Int
entryGetMaxLength ec =
  liftM fromIntegral $ {#call unsafe entry_get_max_length#} (toEntry ec)

-- | Query whether pressing return will activate the default widget.
--
entryGetActivatesDefault :: EntryClass ec => ec -> IO Bool
entryGetActivatesDefault ec = liftM toBool $
  {#call unsafe entry_get_activates_default#} (toEntry ec)

-- | Specify if pressing return will activate
-- the default widget.
--
-- * This setting is useful in 'Dialog' boxes where enter should press
--   the default button.
--
entrySetActivatesDefault :: EntryClass ec => ec -> Bool -> IO ()
entrySetActivatesDefault ec setting = {#call entry_set_activates_default#}
  (toEntry ec) (fromBool setting)

-- | Query if the text 'Entry' is displayed with a frame around it.
--
entryGetHasFrame :: EntryClass ec => ec -> IO Bool
entryGetHasFrame ec = liftM toBool $
  {#call unsafe entry_get_has_frame#} (toEntry ec)

-- | Specifies whehter the 'Entry' should be in an etched-in frame.
--
entrySetHasFrame :: EntryClass ec => ec -> Bool -> IO ()
entrySetHasFrame ec setting = {#call entry_set_has_frame#}
  (toEntry ec) (fromBool setting)

-- | Retrieve the number of characters the widget should ask for.
--
entryGetWidthChars :: EntryClass ec => ec -> IO Int
entryGetWidthChars ec = liftM fromIntegral $ 
  {#call unsafe entry_get_width_chars#} (toEntry ec)

-- | Specifies how large the 'Entry' should be in characters.
--
-- * This setting is only considered when the widget formulates its size
--   request. Make sure that it is not mapped (shown) before you change this
--   value.
--
entrySetWidthChars :: EntryClass ec => ec -> Int -> IO ()
entrySetWidthChars ec setting = {#call entry_set_width_chars#}
  (toEntry ec) (fromIntegral setting)

#if GTK_CHECK_VERSION(2,4,0)
-- | Sets the alignment for the contents of the entry. This controls the
-- horizontal positioning of the contents when the displayed text is shorter
-- than the width of the entry.
--
-- * Since gtk 2.4
--
entrySetAlignment :: EntryClass ec => ec -> Float -> IO ()
entrySetAlignment ec xalign =
  {#call entry_set_alignment#} (toEntry ec) (realToFrac xalign)

-- | Gets the value set by 'entrySetAlignment'.
--
-- * Since gtk 2.4
--
entryGetAlignment :: EntryClass ec => ec -> IO Float
entryGetAlignment ec =
  liftM realToFrac $ {#call unsafe entry_get_alignment#} (toEntry ec)

-- | Sets the auxiliary completion object to use with the entry. All further
-- configuration of the completion mechanism is done on completion using the
-- "EntryCompletion" API.
--
-- * Since gtk 2.4
--
entrySetCompletion :: EntryClass ec => ec -> EntryCompletion -> IO ()
entrySetCompletion ec completion = {#call gtk_entry_set_completion#}
  (toEntry ec) completion

-- | Returns the auxiliary completion object currently in use by the entry.
--
-- * Since gtk 2.4
--
entryGetCompletion :: EntryClass ec => ec -> IO EntryCompletion
entryGetCompletion ec =
  makeNewGObject mkEntryCompletion $
  {#call gtk_entry_get_completion#} (toEntry ec)
#endif


-- signals

-- | Emitted when the user presses return within
-- the 'Entry' field.
--
onEntryActivate, afterEntryActivate :: EntryClass ec => ec -> IO () ->
                                       IO (ConnectId ec)
onEntryActivate = connect_NONE__NONE "activate" False
afterEntryActivate = connect_NONE__NONE "activate" True

-- | Emitted when the settings of the
-- 'Entry' widget changes.
--
onEntryChanged, afterEntryChanged :: EntryClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onEntryChanged = connect_NONE__NONE "changed" False
afterEntryChanged = connect_NONE__NONE "changed" True

-- | Emitted when the current selection has been
-- copied to the clipboard.
--
onCopyClipboard, afterCopyClipboard :: EntryClass ec => ec -> IO () ->
                                       IO (ConnectId ec)
onCopyClipboard = connect_NONE__NONE "copy_clipboard" False
afterCopyClipboard = connect_NONE__NONE "copy_clipboard" True

-- | Emitted when the current selection has been
-- cut to the clipboard.
--
onCutClipboard, afterCutClipboard :: EntryClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onCutClipboard = connect_NONE__NONE "cut_clipboard" False
afterCutClipboard = connect_NONE__NONE "cut_clipboard" True

-- | Emitted when the current selection has
-- been pasted from the clipboard.
--
onPasteClipboard, afterPasteClipboard :: EntryClass ec => ec -> IO () ->
                                         IO (ConnectId ec)
onPasteClipboard = connect_NONE__NONE "paste_clipboard" False
afterPasteClipboard = connect_NONE__NONE "paste_clipboard" True

-- | Emitted when a piece of text is deleted from
-- the 'Entry'.
--
onDeleteText, afterDeleteText :: EntryClass ec => ec ->
                                 (Int -> Int -> IO ()) -> IO (ConnectId ec)
onDeleteText = connect_INT_INT__NONE "delete_text" False
afterDeleteText = connect_INT_INT__NONE "delete_text" True

-- | Emitted when a piece of text is inserted
-- at the cursor position.
--
onInsertAtCursor, afterInsertAtCursor :: EntryClass ec => ec ->
                                         (String -> IO ()) ->
                                         IO (ConnectId ec)
onInsertAtCursor = connect_STRING__NONE "insert_at_cursor" False
afterInsertAtCursor = connect_STRING__NONE "insert_at_cursor" True

-- | Emitted when the user changes from
-- overwriting to inserting.
--
onToggleOverwrite, afterToggleOverwrite :: EntryClass ec => ec -> IO () ->
                                           IO (ConnectId ec)
onToggleOverwrite = connect_NONE__NONE "toggle_overwrite" False
afterToggleOverwrite = connect_NONE__NONE "toggle_overwrite" True

--- NEW FILE: Editable.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Interface Editable
--
--  Author : Axel Simon, Duncan Coutts
--          
--  Created: 30 July 2004
--  split off from Entry.chs
--
--  Copyright (c) 1999..2002 Axel Simon
--  modified 2004 Duncan Coutts
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
-- |
--
-- * This is an interface for simple single-line text editing widgets. It is
--   implemented by "Entry" and "SpinButton".
--
-- * TODO
--
-- * Find out if \"insert-text\" signal is useful and how to bind it. It is
--   tricky because it has an in-out parameter.
--
module Graphics.UI.Gtk.Entry.Editable (
  -- * Data types
  Editable,
  EditableClass,
  castToEditable,

  -- * Methods
  editableSelectRegion,
  editableGetSelectionBounds,
  editableInsertText,
  editableDeleteText,
  editableGetChars,
  editableCutClipboard,
  editableCopyClipboard,
  editablePasteClipboard,
  editableDeleteSelection,
  editableSetEditable,
  editableGetEditable,
  editableSetPosition,
  editableGetPosition,
  
  -- * Signals
  onEditableChanged,
  afterEditableChanged,
  onDeleteText,
  afterDeleteText,
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import System.Glib.GObject (makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}

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

-- | Select a span of text.
--
-- * A negative @end@ position will make the selection extend to the
--   end of the buffer.
--
-- * Calling this function with @start@=1 and @end@=4 it will
--   mark \"ask\" in the string \"Haskell\". (FIXME: verify)
--
editableSelectRegion :: EditableClass ed => ed -> Int -> Int -> IO ()
editableSelectRegion ed start end =
  {#call editable_select_region#} (toEditable ed)
    (fromIntegral start) (fromIntegral end)

-- | Get the span of the current selection.
--
-- * The returned tuple is not ordered. The second index represents the
--   position of the cursor. The first index is the other end of the
--   selection. If both numbers are equal there is in fact no selection.
--
editableGetSelectionBounds :: EditableClass ed => ed -> IO (Int,Int)
editableGetSelectionBounds ed = alloca $ \startPtr -> alloca $ \endPtr -> do
  {#call unsafe editable_get_selection_bounds#} (toEditable ed) startPtr endPtr
  start <- liftM fromIntegral $ peek startPtr
  end	<- liftM fromIntegral $ peek endPtr
  return (start,end)

-- | Insert new text at the specified position.
--
-- * If the position is invalid the text will be inserted at the end of the
--   buffer. The returned value reflects the actual insertion point.
--
editableInsertText :: EditableClass ed => ed -> String -> Int -> IO Int
editableInsertText ed str pos = withObject (fromIntegral pos) $ \posPtr ->
  withUTFStringLen str $ \(strPtr,len) -> do
    {#call editable_insert_text#} (toEditable ed) strPtr (fromIntegral len) 
      posPtr
    liftM fromIntegral $ peek posPtr

-- | Delete a given range of text.
--
-- * If the @end@ position is invalid, it is set to the lenght of the
--   buffer.
--
-- * @start@ is restricted to 0..@end@.
--
editableDeleteText :: EditableClass ed => ed -> Int -> Int -> IO ()
editableDeleteText ed start end = {#call editable_delete_text#} (toEditable ed)
  (fromIntegral start) (fromIntegral end)

-- | Retrieve a range of characters.
--
-- * Set @end@ to a negative value to reach the end of the buffer.
--
editableGetChars :: EditableClass ed => ed -> Int -> Int -> IO String
editableGetChars ed start end = do
  strPtr <- {#call unsafe editable_get_chars#} (toEditable ed) 
    (fromIntegral start) (fromIntegral end)
  str <- peekUTFString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return str

-- | Cut the selected characters to the Clipboard.
--
editableCutClipboard :: EditableClass ed => ed -> IO ()
editableCutClipboard  = {#call editable_cut_clipboard#}.toEditable

-- | Copy the selected characters to the Clipboard.
--
editableCopyClipboard :: EditableClass ed => ed -> IO ()
editableCopyClipboard  = {#call editable_copy_clipboard#}.toEditable

-- | Paste the selected characters to the
-- Clipboard.
--
editablePasteClipboard :: EditableClass ed => ed -> IO ()
editablePasteClipboard  = {#call editable_paste_clipboard#}.toEditable

-- | Delete the current selection.
--
editableDeleteSelection :: EditableClass ed => ed -> IO ()
editableDeleteSelection  = {#call editable_delete_selection#}.toEditable

-- | Set the cursor to a specific position.
--
editableSetPosition :: EditableClass ed => ed -> Int -> IO ()
editableSetPosition ed pos = 
  {#call editable_set_position#} (toEditable ed) (fromIntegral pos)

-- | Get the current cursor position.
--
editableGetPosition :: EditableClass ed => ed -> IO Int
editableGetPosition ed = liftM fromIntegral $
  {#call unsafe editable_get_position#} (toEditable ed)

-- | Make the widget insensitive.
--
-- * Called with False will make the text uneditable.
--
editableSetEditable :: EditableClass ed => ed -> Bool -> IO ()
editableSetEditable ed isEditable = {#call editable_set_editable#}
  (toEditable ed) (fromBool isEditable)

-- | Retrieves whether the text is editable.
--
editableGetEditable :: EditableClass ed => ed -> IO Bool
editableGetEditable ed =
  liftM toBool $ {#call editable_get_editable#} (toEditable ed)
  

-- signals

-- | Emitted when the settings of the 'Editable' widget changes.
--
onEditableChanged, afterEditableChanged :: EditableClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onEditableChanged = connect_NONE__NONE "changed" False
afterEditableChanged = connect_NONE__NONE "changed" True

-- | Emitted when a piece of text is deleted from the 'Editable' widget.
--
onDeleteText, afterDeleteText :: EditableClass ec => ec ->
                                 (Int -> Int -> IO ()) -> IO (ConnectId ec)
onDeleteText = connect_INT_INT__NONE "delete_text" False
afterDeleteText = connect_INT_INT__NONE "delete_text" True


--- NEW FILE: EntryCompletion.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget EntryCompletion
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- Completion functionality for the Entry widget.
--
-- * Added in GTK+ 2.4
--
module Graphics.UI.Gtk.Entry.EntryCompletion  (
#if GTK_CHECK_VERSION(2,4,0)
  EntryCompletion,
  EntryCompletionClass,
  entryCompletionNew,
  entryCompletionGetEntry,
  entryCompletionSetModel,
  entryCompletionGetModel,
  entryCompletionSetMatchFunc,
  entryCompletionSetMinimumKeyLength,
  entryCompletionGetMinimumKeyLength,
  entryCompletionComplete,
  entryCompletionInsertActionText,
  entryCompletionInsertActionMarkup,
  entryCompletionDeleteAction,
  entryCompletionSetTextColumn
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad	(liftM)
import Data.IORef (newIORef, readIORef, writeIORef)

import System.Glib.FFI
import System.Glib.UTFString
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.TreeList.TreeModel#} (TreeIter, createTreeIter)

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

entryCompletionNew :: IO EntryCompletion
entryCompletionNew =
  makeNewGObject mkEntryCompletion $ liftM castPtr $
  {# call gtk_entry_completion_new #}

entryCompletionGetEntry :: EntryCompletion -> IO (Maybe Entry)
entryCompletionGetEntry ec = do
  entryPtr <- {# call gtk_entry_completion_get_entry #} ec
  if entryPtr == nullPtr
    then return Nothing
    else liftM Just $ makeNewObject mkEntry $ return (castPtr entryPtr)

entryCompletionSetModel :: EntryCompletion ->  TreeModel -> IO ()
entryCompletionSetModel ec tm =
  {# call gtk_entry_completion_set_model #} ec tm

entryCompletionGetModel :: EntryCompletion -> IO TreeModel
entryCompletionGetModel ec =
  makeNewGObject mkTreeModel $
  {# call gtk_entry_completion_get_model #} ec

entryCompletionSetMatchFunc :: EntryCompletion -> (String -> TreeIter -> IO ()) -> IO ()
entryCompletionSetMatchFunc ec handler =
  connect_GtkEntryCompletionMatchFunc ec handler

entryCompletionSetMinimumKeyLength :: EntryCompletion -> Int -> IO ()
entryCompletionSetMinimumKeyLength ec minLength =
  {# call gtk_entry_completion_set_minimum_key_length #} ec
    (fromIntegral minLength)

entryCompletionGetMinimumKeyLength :: EntryCompletion -> IO Int
entryCompletionGetMinimumKeyLength ec =
  liftM fromIntegral $
  {# call gtk_entry_completion_get_minimum_key_length #} ec

entryCompletionComplete :: EntryCompletion -> IO ()
entryCompletionComplete ec =
  {# call gtk_entry_completion_complete #} ec

entryCompletionInsertActionText :: EntryCompletion -> Int -> String -> IO ()
entryCompletionInsertActionText ec index text =
  withUTFString text $ \strPtr ->
  {# call gtk_entry_completion_insert_action_text #} ec
    (fromIntegral index) strPtr

entryCompletionInsertActionMarkup :: EntryCompletion -> Int -> String -> IO ()
entryCompletionInsertActionMarkup ec index markup =
  withUTFString markup $ \strPtr ->
  {# call gtk_entry_completion_insert_action_markup #} ec
    (fromIntegral index) strPtr 

entryCompletionDeleteAction :: EntryCompletion -> Int -> IO ()
entryCompletionDeleteAction ec index =
  {# call gtk_entry_completion_delete_action #} ec (fromIntegral index)

entryCompletionSetTextColumn :: EntryCompletion -> Int -> IO ()
entryCompletionSetTextColumn ec column =
  {# call gtk_entry_completion_set_text_column #} ec (fromIntegral column)


-------------------------------------------------
-- Callback stuff for entryCompletionSetMatchFunc
--
{#pointer GDestroyNotify#}

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

type GtkEntryCompletionMatchFunc =
  Ptr EntryCompletion -> --GtkEntryCompletion *completion
  Ptr CChar ->           --const gchar *key
  Ptr TreeIter ->        --GtkTreeIter *iter
  Ptr () ->              --gpointer user_data
  IO ()

foreign import ccall "wrapper" mkHandler_GtkEntryCompletionMatchFunc ::
  GtkEntryCompletionMatchFunc -> 
  IO (FunPtr GtkEntryCompletionMatchFunc)

connect_GtkEntryCompletionMatchFunc :: EntryCompletion ->
                                       (String -> TreeIter -> IO ()) ->
                                       IO ()
connect_GtkEntryCompletionMatchFunc ec user = do
  hPtr <- mkHandler_GtkEntryCompletionMatchFunc
    (\_ keyPtr iterPtr _ -> do key <- peekUTFString keyPtr
                               iter <- createTreeIter iterPtr
                               user key iter)
  dRef <- newIORef nullFunPtr
  dPtr <- mkDestructor $ do
    freeHaskellFunPtr hPtr
    dPtr <- readIORef dRef
    freeHaskellFunPtr dPtr
  writeIORef dRef dPtr
  {# call gtk_entry_completion_set_match_func #} ec
    (castFunPtr hPtr) nullPtr dPtr
#endif

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Entry HScale.chs,NONE,1.1 SpinButton.chs,NONE,1.1 VScale.chs,NONE,1.1

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

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

Added Files:
	HScale.chs SpinButton.chs VScale.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: VScale.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget VScale
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:16:18 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- * The user may enter a value by moving the handle on the scale.
--
--
--
-- * TODO

module Graphics.UI.Gtk.Entry.VScale (
  VScale,
  VScaleClass,
  castToVScale,
  vScaleNew,
  vScaleNewWithRange
  ) 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#}

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

-- methods

-- | Create a new VScale widget.
--
vScaleNew :: Adjustment -> IO VScale
vScaleNew adj = makeNewObject mkVScale $ liftM castPtr $
  {#call unsafe vscale_new#} adj

-- | Create a new VScale widget with @min@, @max@ and @step@ values rather than
-- an "Adjustment" object.
--
vScaleNewWithRange :: Double -- ^ Minimum value
                   -> Double -- ^ Maximum value
                   -> Double -- ^ Step increment (tick size) used with keyboard
                             --   shortcuts. Must be nonzero.
                   -> IO VScale
vScaleNewWithRange min max step =
  makeNewObject mkVScale $ liftM castPtr $
  {#call unsafe vscale_new_with_range#} (realToFrac min) (realToFrac max)
    (realToFrac step)

--- NEW FILE: SpinButton.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget SpinButton
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:16:18 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- A spin button provides the possiblity to enter a numeric value without using
-- the keyboard.
--

module Graphics.UI.Gtk.Entry.SpinButton (
  SpinButton,
  SpinButtonClass,
  castToSpinButton,
  spinButtonNew,
  spinButtonNewWithRange,
  spinButtonConfigure,
  spinButtonSetAdjustment,
  spinButtonGetAdjustment,
  spinButtonSetDigits,
  spinButtonGetDigits,
  spinButtonSetIncrements,
  spinButtonGetIncrements,
  spinButtonSetRange,
  spinButtonGetRange,
  spinButtonGetValue,
  spinButtonGetValueAsInt,
  spinButtonSetValue,
  SpinButtonUpdatePolicy(..),
  spinButtonSetUpdatePolicy,
  spinButtonGetUpdatePolicy,
  spinButtonSetNumeric,
  spinButtonGetNumeric,
  SpinType(..),
  spinButtonSpin,
  spinButtonSetWrap,
  spinButtonGetWrap,
  spinButtonSetSnapToTicks,
  spinButtonGetSnapToTicks,
  spinButtonUpdate,
  onInput,
  afterInput,
  onOutput,
  afterOutput,
  onValueSpinned,
  afterValueSpinned
  ) 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.Structs	(inputError)
import Graphics.UI.Gtk.General.Enums	(SpinButtonUpdatePolicy(..), SpinType(..))

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

-- GtkSpinbutton implements the GtkEditable interface
instance EditableClass SpinButton

-- methods

-- | Create a new SpinButton.
--
-- * @climbRate@ is the amount by which the value is changed each time
--   the up\/down buttons are pressed.
--
-- * @digits@ is the number of shown digits. Set to 0 to work with
--   integer values.
--
spinButtonNew :: Adjustment -> Double -> Int -> IO SpinButton
spinButtonNew adj climbRate digits = makeNewObject mkSpinButton $ 
  liftM castPtr $ {#call unsafe spin_button_new#} adj (realToFrac climbRate)
  (fromIntegral digits)

-- | Create a new SpinButton with a restricted
-- range.
--
-- * This is a convenience function because the user does not have to create
--   an Adjustment first. Page increments are set to 10 * @step@.
--
spinButtonNewWithRange :: Double -> Double -> Double -> IO SpinButton
spinButtonNewWithRange min max step = makeNewObject mkSpinButton $
  liftM castPtr $ {#call unsafe spin_button_new_with_range#}
  (realToFrac min) (realToFrac max) (realToFrac step)

-- | Change the settings of a SpinButton.
--
spinButtonConfigure :: SpinButtonClass sb => sb -> Adjustment -> Double ->
                       Int -> IO ()
spinButtonConfigure sb adj climbRate digits = {#call spin_button_configure#}
  (toSpinButton sb) adj (realToFrac climbRate) (fromIntegral digits)

-- | Attach a new Adjustment object to the
-- SpinButton.
--
spinButtonSetAdjustment :: SpinButtonClass sb => sb -> Adjustment -> IO ()
spinButtonSetAdjustment sb adj = {#call spin_button_set_adjustment#}
  (toSpinButton sb) adj

-- | Retrieve the Adjustment object that is
-- currently controlling the SpinButton.
--
spinButtonGetAdjustment :: SpinButtonClass sb => sb -> IO Adjustment
spinButtonGetAdjustment sb = makeNewObject mkAdjustment $
  {#call unsafe spin_button_get_adjustment#} (toSpinButton sb)

-- | Sets the number of shown digits.
--
spinButtonSetDigits :: SpinButtonClass sb => sb -> Int -> IO ()
spinButtonSetDigits sb digits = {#call spin_button_set_digits#} 
  (toSpinButton sb) (fromIntegral digits)

-- | Gets the number of digits shown.
--
spinButtonGetDigits :: SpinButtonClass sb => sb -> IO Int
spinButtonGetDigits sb = liftM fromIntegral $
  {#call spin_button_get_digits#} (toSpinButton sb)

-- | Sets the increment for up\/down buttons.
--
spinButtonSetIncrements :: SpinButtonClass sb => sb -> Double -> Double ->
                           IO ()
spinButtonSetIncrements sb step page = {#call spin_button_set_increments#}
  (toSpinButton sb) (realToFrac step) (realToFrac page)

-- | Sets the increment for up\/down buttons.
--
spinButtonGetIncrements :: SpinButtonClass sb => sb -> IO (Double, Double)
spinButtonGetIncrements sb =
  alloca $ \stepPtr -> alloca $ \pagePtr -> do
  {#call unsafe spin_button_get_increments#} (toSpinButton sb) stepPtr pagePtr
  step <- peek stepPtr
  page <- peek pagePtr
  return (realToFrac step, realToFrac page)

-- | Set the maximal allowable range for the spinbutton.
--
spinButtonSetRange :: SpinButtonClass sb => sb -> Double -> Double -> IO ()
spinButtonSetRange sb min max = {#call spin_button_set_range#}
  (toSpinButton sb) (realToFrac min) (realToFrac max)

-- | Get the maximal allowable range for the spinbutton.
--
spinButtonGetRange :: SpinButtonClass sb => sb -> IO (Double, Double)
spinButtonGetRange sb =
  alloca $ \minPtr -> alloca $ \maxPtr -> do
  {#call unsafe spin_button_get_range#} (toSpinButton sb) minPtr maxPtr
  min <- peek minPtr
  max <- peek maxPtr
  return (realToFrac min, realToFrac max)

-- | Retrieve the current value as a floating point
-- value.
--
spinButtonGetValue :: SpinButtonClass sb => sb -> IO Double
spinButtonGetValue sb = liftM realToFrac $
  {#call unsafe spin_button_get_value#} (toSpinButton sb)

-- | Retrieve the current value as integral
-- value.
--
spinButtonGetValueAsInt :: SpinButtonClass sb => sb -> IO Int
spinButtonGetValueAsInt sb = liftM fromIntegral $
  {#call unsafe spin_button_get_value_as_int#} (toSpinButton sb)

-- | Set the value of the SpinButton.
--
spinButtonSetValue :: SpinButtonClass sb => sb -> Double -> IO ()
spinButtonSetValue sb value = {#call spin_button_set_value#}
  (toSpinButton sb) (realToFrac value)

-- | Whether the an out-of-range value set by 'spinButtonSetValue' is clamped to
-- the limits or simply ignored.
--
spinButtonSetUpdatePolicy :: SpinButtonClass sb => sb ->
                             SpinButtonUpdatePolicy -> IO ()
spinButtonSetUpdatePolicy sb up = {#call spin_button_set_update_policy#}
  (toSpinButton sb) ((fromIntegral.fromEnum) up)

-- | Gets the update behavior of a spin button. See 'spinButtonSetUpdatePolicy'.
--
spinButtonGetUpdatePolicy :: SpinButtonClass sb => sb
                          -> IO SpinButtonUpdatePolicy
spinButtonGetUpdatePolicy sb = liftM (toEnum.fromIntegral) $
  {#call unsafe spin_button_get_update_policy#} (toSpinButton sb)

-- | Sets the flag that determines if non-numeric text can be typed into the
-- spin button.
--
spinButtonSetNumeric :: SpinButtonClass sb => sb -> Bool -> IO ()
spinButtonSetNumeric sb numeric = {#call spin_button_set_numeric#}
  (toSpinButton sb) (fromBool numeric)

-- | Returns whether non-numeric text can be typed into the spin button.
--
spinButtonGetNumeric :: SpinButtonClass sb => sb -> IO Bool
spinButtonGetNumeric sb =
  liftM toBool $ {#call unsafe spin_button_get_numeric#} (toSpinButton sb)

-- | Increment or decrement the current value of the SpinButton.
--
spinButtonSpin :: SpinButtonClass sb => sb -> SpinType -> Double -> IO ()
spinButtonSpin sb st offset = {#call spin_button_spin#} (toSpinButton sb)
  ((fromIntegral.fromEnum) st) (realToFrac offset)

-- | Sets the flag that determines if a spin button value wraps around to the
-- opposite limit when the upper or lower limit of the range is exceeded.
--
spinButtonSetWrap :: SpinButtonClass sb => sb -> Bool -> IO ()
spinButtonSetWrap sb wrap = {#call spin_button_set_wrap#} (toSpinButton sb)
  (fromBool wrap)

-- | Returns whether the spin button's value wraps around to the opposite limit
-- when the upper or lower limit of the range is exceeded.
--
spinButtonGetWrap :: SpinButtonClass sb => sb -> IO Bool
spinButtonGetWrap sb =
  liftM toBool $ {#call spin_button_get_wrap#} (toSpinButton sb)

-- | Sets the policy as to whether values are corrected to the nearest step
-- increment when a spin button is activated after providing an invalid value.
--
spinButtonSetSnapToTicks :: SpinButtonClass sb => sb -> Bool -> IO ()
spinButtonSetSnapToTicks sb snapToTicks = 
  {#call spin_button_set_snap_to_ticks#} (toSpinButton sb) 
  (fromBool snapToTicks)

-- | Returns whether the values are corrected to the nearest step.
--
spinButtonGetSnapToTicks :: SpinButtonClass sb => sb -> IO Bool
spinButtonGetSnapToTicks sb = liftM toBool $
  {#call unsafe spin_button_get_snap_to_ticks#} (toSpinButton sb)

-- | Force an update of the SpinButton.
--
spinButtonUpdate :: SpinButtonClass sb => sb -> IO ()
spinButtonUpdate sb = {#call spin_button_update#} (toSpinButton sb)

-- signals

-- | Install a custom input handler.
--
-- * This signal is called upon each time the value of the SpinButton is set
--   by spinButtonSetValue. The function can return Nothing if the value is no
--   good.
--
onInput, afterInput :: SpinButtonClass sb => sb -> (IO (Maybe Double)) ->
                       IO (ConnectId sb)
onInput sb user = connect_PTR__INT "input" False sb $ \dPtr -> do
  mVal <- user
  case mVal of
    (Just val) -> do
      poke dPtr ((realToFrac val)::{#type gdouble#})
      return 0
    Nothing -> return (toInteger inputError)
afterInput sb user = connect_PTR__INT "input" True sb $ \dPtr -> do
  mVal <- user
  case mVal of
    (Just val) -> do
      poke dPtr ((realToFrac val)::{#type gdouble#})
      return 0
    Nothing -> return (toInteger inputError)

-- | Install a custom output handler.
--
-- * This handler makes it possible to query the current value and to render
--   something completely different to the screen using entrySetText. The
--   return value must be False in order to let the default output routine run
--   after this signal returns.
--
onOutput, afterOutput :: SpinButtonClass sb => sb -> IO Bool ->
                         IO (ConnectId sb)
onOutput = connect_NONE__BOOL "output" False
afterOutput = connect_NONE__BOOL "output" True

-- | The value of the spin button has changed.
--
onValueSpinned, afterValueSpinned :: SpinButtonClass sb => sb -> IO () ->
                                     IO (ConnectId sb)
onValueSpinned = connect_NONE__NONE "value-changed" False
afterValueSpinned = connect_NONE__NONE "value-changed" True


--- NEW FILE: HScale.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget HScale
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:16:18 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- * The user may enter a value by moving the handle on the scale.
--
--
--
-- * TODO

module Graphics.UI.Gtk.Entry.HScale (
  HScale,
  HScaleClass,
  castToHScale,
  hScaleNew,
  hScaleNewWithRange
  ) 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#}

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

-- methods

-- | Create a new HScale widget.
--
hScaleNew :: Adjustment -> IO HScale
hScaleNew adj = makeNewObject mkHScale $ liftM castPtr $
  {#call unsafe hscale_new#} adj

-- | Create a new HScale widget with @min@, @max@ and @step@ values rather than
-- an "Adjustment" object.
--
hScaleNewWithRange :: Double -- ^ Minimum value 
                   -> Double -- ^ Maximum value
                   -> Double -- ^ Step increment (tick size) used with keyboard
		             --   shortcuts. Must be nonzero.
                   -> IO HScale
hScaleNewWithRange min max step =
  makeNewObject mkHScale $ liftM castPtr $
  {#call unsafe hscale_new_with_range#} (realToFrac min) (realToFrac max)
    (realToFrac step)

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Embedding Embedding.hsc,NONE,1.1 Plug.chs,NONE,1.1 Socket.chs,NONE,1.1

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

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

Added Files:
	Embedding.hsc Plug.chs Socket.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Embedding.hsc ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Socket
--
--  Author : Axel Simon
--          
--  Created: 20 January 2003
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:15:19 $
--
--  Copyright (c) 1999..2003 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.
--
-- |
--
-- TODO
--
-- * NativeWindowId is a CUInt for c2hs and a Word32 for hsc2hs. I used
--   fromIntegral to make it work, but it doesn't feel right.
--
module Graphics.UI.Gtk.Embedding.Embedding (
  socketHasPlug,
  NativeWindowId
  ) where

import Control.Exception

import System.Glib.FFI
import Graphics.UI.Gtk.Types

#include<gtk/gtk.h>

-- | The identifer of a window to be embedded.
--
type NativeWindowId = #type GdkNativeWindow

-- | Test if a Plug is connected to the socket.
-- 
socketHasPlug :: SocketClass s => s -> IO Bool
socketHasPlug socket = do
  plugPtr <- withForeignPtr (unSocket (toSocket socket))
	     #{peek GtkSocket, plug_window}
  return (plugPtr/=nullPtr)


--- NEW FILE: Plug.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Plug
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:15:19 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- Plug is a window that is to be attached to the window of another
-- application. If you have managed to receive the 'XID' from
-- the inviting application you can construct the Plug and add your widgets
-- to it.
--

module Graphics.UI.Gtk.Embedding.Plug (
  Plug,
  PlugClass,
  castToPlug,
  NativeWindowId,
  plugNew,
  plugGetId
  ) where

import Monad	(liftM)
import Maybe	(fromMaybe)

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.Embedding.Embedding (NativeWindowId)

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

-- methods

-- | Create a new 'Window' to hold another
-- application.
--
-- * The Plug may be constructed with a 'NativeWindowId'. In this
--   the foreign application will immediatly appear in this 'Plug'
--   once it is shown. If @Nothing@ is passed for @nmw@ a
--   'NativeWindowId' can be extracted from this 'Plug'
--   and be passed to the application which is to be embedded.
--
plugNew :: Maybe NativeWindowId -> IO Plug
plugNew mnw = makeNewObject mkPlug $ liftM castPtr $
  {#call unsafe plug_new#} (fromIntegral (fromMaybe 0 mnw))

-- | Retrieve the 'NativeWindowId'.
--
-- * The result should be passed to the application which is to be embedded.
--   See 'plugNew'.
--
plugGetId :: PlugClass p => p -> IO NativeWindowId
plugGetId p = liftM fromIntegral $ {#call unsafe plug_get_id#} (toPlug p)

-- | This plug received another application.
--
onEmbedded, afterEmbedded :: PlugClass p => p -> IO () -> IO (ConnectId p)
onEmbedded = connect_NONE__NONE "embedded" False
afterEmbedded = connect_NONE__NONE "embedded" True


--- NEW FILE: Socket.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Socket
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:15:19 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This widget provides the possibility that other application display their
-- widgets within this application.
--
-- * After creation of the Socket, you may retrieve the 
--   'NativeWindow' of the socket. 
--   For this to work, the socket must at least be realized (e.g. shown).
--
-- * The application has to make sure the 'Socket'
--   is not destroyed while the
--   other application tries to connect. If the 'NativeWindow' was 
--   transmitted, the
--   inviting application can check with 'socketHasPlug' if the 
--   plug has
--   already connected.
--

module Graphics.UI.Gtk.Embedding.Socket (
  Socket,
  SocketClass,
  castToSocket,
  NativeWindowId,
  socketNew,
  socketHasPlug,
  socketAddId,
  socketGetId,
  onPlugAdded,
  afterPlugAdded,
  onPlugRemoved,
  afterPlugRemoved
  ) 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.Embedding.Embedding	(NativeWindowId, socketHasPlug)

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

-- methods

-- | Create a 'Container' for embedding.
--
-- * 'Socket' is a 'Container' for foreign applications
--   that support the XEMBED protocol. To connect two applications the
--   'NativeWindowId' has to be passed either from this socket
--   to the other application's 'Plug' or vice versa.
--
socketNew :: IO Socket
socketNew = makeNewObject mkSocket $ liftM castPtr {#call unsafe socket_new#}

-- | Insert another application into this socket.
--
-- * Inserts the other application into this plug. The
--   'NativeWindowId' comes from the other application.
--
-- * The 'Socket' must have already be added into a toplevel
--   window before you can make this call.
--
socketAddId :: SocketClass s => s -> NativeWindowId -> IO ()
socketAddId soc nwi = {#call unsafe socket_add_id#} (toSocket soc) 
		      (fromIntegral nwi)

-- | Prepare to insert this application into another.
--
-- * The extracted 'NativeWindowId' can be passed to another
--   application which can then embed this socket 'Container'.
--
socketGetId :: SocketClass s => s -> IO NativeWindowId
socketGetId soc = liftM fromIntegral $
		  {#call unsafe socket_get_id#} (toSocket soc)

-- | This socket was added into another application.
--
onPlugAdded, afterPlugAdded :: SocketClass s => s -> IO () -> IO (ConnectId s)
onPlugAdded = connect_NONE__NONE "plug-added" False
afterPlugAdded = connect_NONE__NONE "plug-added" True

-- | This socket was removed from another
-- application.
--
onPlugRemoved, afterPlugRemoved :: SocketClass s => s -> IO () -> 
							 IO (ConnectId s)
onPlugRemoved = connect_NONE__NONE "plug-removed" False
afterPlugRemoved = connect_NONE__NONE "plug-removed" True

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Display AccelLabel.chs,NONE,1.1 Image.chs,NONE,1.1 Label.chs,NONE,1.1 ProgressBar.chs,NONE,1.1 Statusbar.chs,NONE,1.1

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

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

Added Files:
	AccelLabel.chs Image.chs Label.chs ProgressBar.chs 
	Statusbar.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Image.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Image
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:14:30 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This widget displays an image.
--
--
-- * Because Haskell is not the best language to modify large images directly
--   only functions are bound that allow loading images from disc or by stock
--   names.
--
-- * Another function for extracting the 'Pixbuf' is added for 
--   'CellRenderer'.
--
-- TODO
--
-- * Figure out what other functions are useful within Haskell. Maybe we should
--   support loading Pixmaps without exposing them.
--
module Graphics.UI.Gtk.Display.Image (
  Image,
  ImageClass,
  castToImage,
  imageNewFromFile,
  IconSize,
  iconSizeMenu,
  iconSizeSmallToolbar,
  iconSizeLargeToolbar,
  iconSizeButton,
  iconSizeDialog,
  imageNewFromStock,
  imageGetPixbuf,
  imageNewFromPixbuf
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import System.Glib.GObject		(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs	(IconSize, iconSizeInvalid, iconSizeMenu,
					 iconSizeSmallToolbar, iconSizeLargeToolbar,
					 iconSizeButton, iconSizeDialog)

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

-- methods

-- | Create an image by loading a file.
--
imageNewFromFile :: FilePath -> IO Image
imageNewFromFile path = makeNewObject mkImage $ liftM castPtr $ 
  withUTFString path {#call unsafe image_new_from_file#}

-- | Create a set of images by specifying a stock
-- object.
--
imageNewFromStock :: String -> IconSize -> IO Image
imageNewFromStock stock ic = withUTFString stock $ \strPtr -> 
  makeNewObject mkImage $ liftM castPtr $ {#call unsafe image_new_from_stock#}
  strPtr (fromIntegral ic)

-- | Extract the Pixbuf from the 'Image'.
--
imageGetPixbuf :: Image -> IO Pixbuf
imageGetPixbuf img = makeNewGObject mkPixbuf $ liftM castPtr $
  throwIfNull "Image.imageGetPixbuf: The image contains no Pixbuf object." $
  {#call unsafe image_get_pixbuf#} img


-- | Create an 'Image' from a 
-- 'Pixbuf'.
--
imageNewFromPixbuf :: Pixbuf -> IO Image
imageNewFromPixbuf pbuf = makeNewObject mkImage $ liftM castPtr $
  {#call unsafe image_new_from_pixbuf#} pbuf

--- NEW FILE: ProgressBar.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget ProgressBar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:14:30 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- The ProgressBar provides a means for an application to keep the user
-- patient while some time intensive task is going on.
--

module Graphics.UI.Gtk.Display.ProgressBar (
  ProgressBar,
  ProgressBarClass,
  castToProgressBar,
  progressBarNew,
  progressBarPulse,
  progressBarSetText,
  progressBarSetFraction,
  progressBarSetPulseStep,
  progressBarGetFraction,
  progressBarGetPulseStep,
  progressBarGetText,
  ProgressBarOrientation(..),
  progressBarSetOrientation,
  progressBarGetOrientation
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new ProgreeBar.
--
progressBarNew :: IO ProgressBar
progressBarNew  = makeNewObject mkProgressBar $ liftM castPtr $
  {#call unsafe progress_bar_new#}

-- | Indicates that some progress is made, but you
-- don't know how much. Causes the progress bar to enter \`activity mode',
-- where a block bounces back and forth. Each call to
-- 'progressBarPulse' causes the block to move on by a little bit
-- (the amount of movement per pulse is determined by
-- 'progressBarSetPulseStep').
--
progressBarPulse :: ProgressBarClass pb => pb -> IO ()
progressBarPulse pb = {#call unsafe progress_bar_pulse#} (toProgressBar pb)

-- | Causes the given @text@ to appear
-- superimposed on the progress bar.
--
progressBarSetText :: ProgressBarClass pb => pb -> String -> IO ()
progressBarSetText pb text = withUTFString text $
  {#call unsafe progress_bar_set_text#} (toProgressBar pb)

-- | Causes the progress bar to \`fill in' the
-- given fraction of the bar. The fraction should be between 0.0 and 1.0,
-- inclusive.
--
progressBarSetFraction :: ProgressBarClass pb => pb -> Double -> IO ()
progressBarSetFraction pb fraction = {#call unsafe progress_bar_set_fraction#}
  (toProgressBar pb) (realToFrac fraction)

-- | Sets the fraction of total progress bar
-- length to move the bouncing block for each call to progressBarPulse.
--
-- * The @fraction@ parameter must be between 0.0 and 1.0.
--
progressBarSetPulseStep :: ProgressBarClass pb => pb -> Double -> IO ()
progressBarSetPulseStep pb fraction = 
  {#call unsafe progress_bar_set_pulse_step#} (toProgressBar pb) 
  (realToFrac fraction)

-- | Returns the current fraction of the task
-- that has been completed.
--
progressBarGetFraction :: ProgressBarClass pb => pb -> IO Double
progressBarGetFraction pb = liftM realToFrac $ 
  {#call unsafe progress_bar_get_fraction#} (toProgressBar pb)

-- | Returns the current pulseStep of the task
-- that has been completed.
--
progressBarGetPulseStep :: ProgressBarClass pb => pb -> IO Double
progressBarGetPulseStep pb = liftM realToFrac $ 
  {#call unsafe progress_bar_get_pulse_step#} (toProgressBar pb)


-- | Retrieve the text displayed superimposed on the
-- ProgressBar.
--
-- * Returns Nothing if no text was set.
--
progressBarGetText :: ProgressBarClass pb => pb -> IO (Maybe String)
progressBarGetText pb = do
  strPtr <- {#call unsafe progress_bar_get_text#} (toProgressBar pb)
  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr

-- | Causes the progress bar to switch to a
-- different orientation (left-to-right, right-to-left, top-to-bottom, or
-- bottom-to-top).
--
progressBarSetOrientation :: ProgressBarClass pb => pb ->
                             ProgressBarOrientation -> IO ()
progressBarSetOrientation pb orientation = 
  {#call progress_bar_set_orientation#} (toProgressBar pb)
  ((fromIntegral.fromEnum) orientation)

-- | Retrieve the current ProgressBar
-- orientation.
--
progressBarGetOrientation :: ProgressBarClass pb => pb ->
                             IO ProgressBarOrientation
progressBarGetOrientation pb = liftM (toEnum.fromIntegral) $
  {#call unsafe progress_bar_get_orientation#} (toProgressBar pb)



--- NEW FILE: Statusbar.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget StatusBar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:14:30 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- Report messages of minor importance to the user.
--
-- * A Statusbar is usually placed along the bottom of an application's main
--   Window. It may provide a regular commentary of the application's status 
--   (as is usually the case in a web browser, for example), or may be used to
--   simply output a message when the status changes, (when an upload is 
--   complete in an FTP client, for example).
--
-- * Status bars in Gtk+ maintain a stack of messages. The message at the top
--   of the each bar's stack is the one that will currently be displayed.
--   Any messages added to a statusbar's stack must specify a ContextId that
--   is used to uniquely identify the source of a message. This ContextId can
--   be generated by statusbarGetContextId, given a message and the statusbar
--   that it will be added to. Note that messages are stored in a stack, and
--   when choosing which message to display, the stack structure is adhered
--   to, regardless of the context identifier of a message.
--   Messages are added to the bar's stack with statusbarPush. The message at
--   the top of the stack can be removed using statusbarPop. A message can be
--   removed from anywhere in the stack if it's MessageId was recorded at the
--   time it was added. This is done using statusbarRemove.
--

module Graphics.UI.Gtk.Display.Statusbar (
  Statusbar,
  StatusbarClass,
  castToStatusbar,
  statusbarNew,
  statusbarGetContextId,
  statusbarPush,
  statusbarPop,
  statusbarRemove,
  statusbarSetHasResizeGrip,
  statusbarGetHasResizeGrip,
  onTextPopped,
  afterTextPopped,
  onTextPushed,
  afterTextPushed
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new Statusbar.
--
statusbarNew :: IO Statusbar
statusbarNew  = makeNewObject mkStatusbar $ 
  liftM castPtr {#call unsafe statusbar_new#}

type ContextId = {#type guint#}

-- | Given a context description, this function
-- returns a ContextId. This id can be used to later remove entries form the
-- Statusbar.
--
statusbarGetContextId :: StatusbarClass sb => sb -> String -> IO ContextId
statusbarGetContextId sb description = withUTFString description $
  {#call unsafe statusbar_get_context_id#} (toStatusbar sb)


type MessageId = {#type guint#}

-- | Push a new message on the Statusbar stack. It will
-- be displayed as long as it is on top of the stack.
--
statusbarPush :: StatusbarClass sb => sb -> ContextId -> String -> IO MessageId
statusbarPush sb context msg = withUTFString msg $ {#call statusbar_push#}
  (toStatusbar sb) context

-- | Pops the topmost message that has the correct
-- context.
--
statusbarPop :: StatusbarClass sb => sb -> ContextId -> IO ()
statusbarPop sb context = {#call statusbar_pop#} (toStatusbar sb) context

-- | Remove an entry within the stack.
--
statusbarRemove :: StatusbarClass sb => sb -> ContextId -> MessageId -> IO ()
statusbarRemove sb context message = {#call statusbar_remove#} (toStatusbar sb)
  context message

-- | Toggle the displaying of a resize grip.
--
statusbarSetHasResizeGrip :: StatusbarClass sb => sb -> Bool -> IO ()
statusbarSetHasResizeGrip sb set = {#call statusbar_set_has_resize_grip#}
  (toStatusbar sb) (fromBool set)

-- | Query the displaying of the resize grip.
--
statusbarGetHasResizeGrip :: StatusbarClass sb => sb -> IO Bool
statusbarGetHasResizeGrip sb = liftM toBool $
  {#call unsafe statusbar_get_has_resize_grip#} (toStatusbar sb)

-- signals

-- | Called if a message is removed.
--
onTextPopped, afterTextPopped :: StatusbarClass sb => sb ->
                                 (ContextId -> String -> IO ()) ->
                                 IO (ConnectId sb)
onTextPopped = connect_WORD_STRING__NONE "text-popped" False
afterTextPopped = connect_WORD_STRING__NONE "text-popped" True

-- | Called if a message is pushed on top of the
-- stack.
--
onTextPushed, afterTextPushed :: StatusbarClass sb => sb ->
                                 (ContextId -> String -> IO ()) ->
                                 IO (ConnectId sb)
onTextPushed = connect_WORD_STRING__NONE "text-pushed" False
afterTextPushed = connect_WORD_STRING__NONE "text-pushed" True


--- NEW FILE: AccelLabel.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget AccelLabel
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:14:30 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This widget is a special version of 'Label'. It displays an 
-- accelerator key next to the Label.
--
-- * The key name is not explicitly set but taken from the key that
--   is associated with the activation of another widget.
--

module Graphics.UI.Gtk.Display.AccelLabel (
  AccelLabel,
  AccelLabelClass,
  castToAccelLabel,
  accelLabelNew,
  accelLabelSetAccelWidget,
  accelLabelGetAccelWidget
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new label with an accelerator key.
--
accelLabelNew :: String -> IO AccelLabel
accelLabelNew str = withUTFString str $ \strPtr -> makeNewObject mkAccelLabel $ 
  liftM castPtr $ {#call unsafe accel_label_new#} strPtr

-- | Set the key name from the activation
-- signal of another widget.
--
accelLabelSetAccelWidget :: (AccelLabelClass acl, WidgetClass w) => acl -> w ->
                            IO ()
accelLabelSetAccelWidget acl w = {#call accel_label_set_accel_widget#}
  (toAccelLabel acl) (toWidget w)

-- | Fetches the widget monitored by this accelerator label, or Nothing if it
-- has not bee set.
--
accelLabelGetAccelWidget :: AccelLabelClass acl => acl -> IO (Maybe Widget)
accelLabelGetAccelWidget acl = do
  wPtr <- {#call unsafe accel_label_get_accel_widget#} (toAccelLabel acl)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget (return wPtr)

--- NEW FILE: Label.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Label
--
--  Author : Manuel M. T. Chakravarty,
--	     Axel Simon
--          
--  Created: 2 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:14:30 $
--
--  Copyright (c) 1999..2002 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.
--
-- | A label is a piece of static text in a user interface.
--
module Graphics.UI.Gtk.Display.Label (
  Label,
  LabelClass,
  castToLabel,
  labelNew,
  labelNewWithMnemonic,
  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
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
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" #}


-- methods

-- | Create a new label widget.
--
labelNew :: Maybe String -> IO Label
labelNew str = makeNewObject mkLabel $ liftM castPtr $
  case str of
    Nothing    -> {#call label_new#} nullPtr
    (Just str) -> withUTFString str {#call label_new#}

-- | Set the text the label widget shows. 
--
labelSetText :: LabelClass l => l -> String -> IO ()
labelSetText l str =
  withUTFString str $ {#call label_set_text#} (toLabel l)

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

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

-- | Set the label to a markup string.
--
labelSetMarkup :: LabelClass l => l -> Markup -> IO ()
labelSetMarkup l str =
  withUTFString str $ {#call label_set_markup#} (toLabel l)

-- | Set the label to a markup string and interpret keyboard accelerators.
--
labelSetMarkupWithMnemonic :: LabelClass l => l -> Markup -> IO ()
labelSetMarkupWithMnemonic l str =
  withUTFString str $ {#call label_set_markup_with_mnemonic#} (toLabel l)

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

-- | Set the justification of the label.
--
labelSetJustify :: LabelClass l => l -> Justification -> IO ()
labelSetJustify l j = 
  {#call label_set_justify#} (toLabel l) ((fromIntegral.fromEnum) j)

-- | Get the justification of the label.
--
labelGetJustify :: LabelClass l => l -> IO Justification
labelGetJustify l =
  liftM (toEnum.fromIntegral) $ {#call unsafe label_get_justify#} (toLabel l)

-- | Gets the "PangoLayout" used to display the label.
--
labelGetLayout :: LabelClass l => l -> IO PangoLayout
labelGetLayout l =
  makeNewGObject mkPangoLayout $ {#call unsafe label_get_layout#} (toLabel l)

-- | Set wether lines should be wrapped (@True@) or truncated (@False@).
--
labelSetLineWrap :: LabelClass l => l -> Bool -> IO ()
labelSetLineWrap l w = {#call label_set_line_wrap#} (toLabel l) (fromBool w)

-- | Returns whether lines in the label are automatically wrapped.
--
labelGetLineWrap :: LabelClass l => l -> IO Bool
labelGetLineWrap l = liftM toBool $
  {#call unsafe label_get_line_wrap#} (toLabel l)

-- | Get starting cooridinates of text rendering.
--
labelGetLayoutOffsets :: LabelClass l => l -> IO (Int,Int)
labelGetLayoutOffsets l =
  alloca (\xPtr ->
    alloca (\yPtr -> do
      {#call unsafe label_get_layout_offsets#} (toLabel l) 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#}

-- | Get the keyval for the underlined character in the label.
--
labelGetMnemonicKeyval :: LabelClass l => l -> IO KeyVal
labelGetMnemonicKeyval l = 
  {#call unsafe label_get_mnemonic_keyval#} (toLabel l)

-- | Get whether the text selectable.
--
labelGetSelectable :: LabelClass l => l -> IO Bool
labelGetSelectable l = liftM toBool $ 
  {#call unsafe label_get_selectable#} (toLabel l)

-- | Sets whether the text of the label contains markup in Pango's text markup
-- language.
--
labelSetUseMarkup :: LabelClass l => l -> Bool -> IO ()
labelSetUseMarkup l useMarkup =
  {#call label_set_use_markup#} (toLabel l) (fromBool useMarkup)

-- | Returns whether the label's text is interpreted as marked up with the
-- Pango text markup language.
--
labelGetUseMarkup :: LabelClass l => l -> IO Bool
labelGetUseMarkup l = liftM toBool $
  {#call unsafe label_get_use_markup#} (toLabel l)

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

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

-- | Get the text stored in the label. This does not include any embedded
-- underlines indicating mnemonics or Pango markup.
--
labelGetText :: LabelClass l => l -> IO String
labelGetText l = {#call unsafe label_get_text#} (toLabel l) >>= peekUTFString

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

-- | Create a new label widget with accelerator key.
--
-- * Each underscore in @str@ is converted into an underlined character in the
--   label. Entering this character will activate the label widget or any other
--   widget set with 'labelSetMnemonicWidget'.
--
labelNewWithMnemonic :: String -> IO Label
labelNewWithMnemonic str = makeNewObject mkLabel $ liftM castPtr $
  withUTFString str {#call label_new_with_mnemonic#}

-- | Select a region in the label.
--
labelSelectRegion :: LabelClass l => l -> Int -> Int -> IO ()
labelSelectRegion l start end = {#call label_select_region#} (toLabel l) 
  (fromIntegral start) (fromIntegral end)

-- | 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 l => l -> IO (Maybe (Int, Int))
labelGetSelectionBounds l =
  alloca $ \startPtr -> alloca $ \endPtr -> do
  isSelection <-
    {#call unsafe label_get_selection_bounds#} (toLabel l) startPtr endPtr
  if toBool isSelection
    then do start <- peek startPtr
            end <- peek endPtr
	    return $ Just $ (fromIntegral start, fromIntegral end)
    else return Nothing

-- | Set an explicit widget for which to emit the \"mnemonic_activate\" signal
-- if an underlined character is pressed.
--
labelSetMnemonicWidget :: (LabelClass l, WidgetClass w) => l -> w -> IO ()
labelSetMnemonicWidget l w = 
  {#call unsafe label_set_mnemonic_widget#} (toLabel l) (toWidget w)

-- | Retrieves the target of the mnemonic (keyboard shortcut) of this label,
-- or Nothing if none has been set and the default algorithm will be used.
--
labelGetMnemonicWidget :: LabelClass l => l -> IO (Maybe Widget)
labelGetMnemonicWidget l = do
  widgetPtr <- {#call unsafe label_get_mnemonic_widget#} (toLabel l)
  if widgetPtr == nullPtr
    then return Nothing
    else liftM Just $ makeNewObject mkWidget (return widgetPtr)

-- | Make a label text selectable.
--
labelSetSelectable :: LabelClass l => l -> Bool -> IO ()
labelSetSelectable l s =
  {#call unsafe label_set_selectable#} (toLabel l) (fromBool s)

-- | Set the label to a markup string and interpret keyboard accelerators.
--
labelSetTextWithMnemonic :: LabelClass l => l -> String -> IO ()
labelSetTextWithMnemonic l str =
  withUTFString str $ {#call label_set_text_with_mnemonic#} (toLabel l)

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Buttons RadioButton.chs,NONE,1.1 ToggleButton.chs,NONE,1.1

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

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

Added Files:
	RadioButton.chs ToggleButton.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: RadioButton.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget RadioButton
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:13:20 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- A radio group is a set of check buttons where only one button can be 
-- checked.
--
-- * Each radio button has to be associated with a group. Generating a new
--   radio button makes up a new group. Other group members can be added by
--   generating radio buttons with the function 
--   'radioButtonNewJoinGroup'.
--
-- TODO
--
-- * No function that directly accesses the group is bound. This is due to the
--   difficulties assuring that these groups are valid as the group is a plain
--   GSList from Glib.
--
module Graphics.UI.Gtk.Buttons.RadioButton (
  RadioButton,
  RadioButtonClass,
  castToRadioButton,
  radioButtonNew,
  radioButtonNewWithLabel,
  radioButtonNewWithMnemonic,
  radioButtonNewJoinGroup,
  radioButtonNewJoinGroupWithLabel,
  radioButtonNewJoinGroupWithMnemonic,

  -- * Compatibilty aliases
  radioButtonNewFromWidget,
  radioButtonNewWithLabelFromWidget,
  radioButtonNewWithMnemonicFromWidget
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new RadioButton widget with a new group.
--
radioButtonNew :: IO RadioButton
radioButtonNew  = makeNewObject mkRadioButton $ liftM castPtr $
  {#call unsafe radio_button_new#} nullPtr

-- | Like 'radioButtonNew' but shows a label to the right of the button.
--
radioButtonNewWithLabel :: String -> IO RadioButton
radioButtonNewWithLabel lbl = withUTFString lbl $ \strPtr -> 
  makeNewObject mkRadioButton $ liftM castPtr $
  {#call unsafe radio_button_new_with_label#} nullPtr strPtr

-- | Like 'radioButtonNew' but shows a label to the right of the button.
-- Underscores in the label string indicate the mnemonic for the menu item.
--
radioButtonNewWithMnemonic :: String -> IO RadioButton
radioButtonNewWithMnemonic lbl = withUTFString lbl $ \strPtr -> 
  makeNewObject mkRadioButton $ liftM castPtr $
  {#call unsafe radio_button_new_with_mnemonic#} nullPtr strPtr

-- | Creates a new RadioButton and attaches it to the group of another radio
-- button.
--
-- * This function corresponds to gtk_radio_button_new_from_widget. The new
--   name makes more sense because we do not handle any other grouping
--   mechanism.
--
radioButtonNewJoinGroup :: RadioButton -> IO RadioButton
radioButtonNewJoinGroup rb = makeNewObject mkRadioButton $ liftM castPtr $
  {#call radio_button_new_from_widget#} rb

-- | Create a new RadioButton with a label and group.
--
radioButtonNewJoinGroupWithLabel :: RadioButton -> String -> IO RadioButton
radioButtonNewJoinGroupWithLabel rb lbl = withUTFString lbl $ \strPtr ->
  makeNewObject mkRadioButton $ liftM castPtr $
  {#call radio_button_new_with_label_from_widget#} rb strPtr

-- | Create a new RadioButton with a label and group. Underscores in the label
-- string indicate the mnemonic for the menu item.
--
radioButtonNewJoinGroupWithMnemonic :: RadioButton -> String -> IO RadioButton
radioButtonNewJoinGroupWithMnemonic rb lbl = withUTFString lbl $ \strPtr ->
  makeNewObject mkRadioButton $ liftM castPtr $
  {#call radio_button_new_with_mnemonic_from_widget#} rb strPtr


-- | Alias for 'radioButtonNewJoinGroup'.
radioButtonNewFromWidget = radioButtonNewJoinGroup

-- | Alias for 'radioButtonNewJoinGroupWithLabel'.
radioButtonNewWithLabelFromWidget = radioButtonNewJoinGroupWithLabel

-- | Alias for 'radioButtonNewJoinGroupWithMnemonic'.
radioButtonNewWithMnemonicFromWidget = radioButtonNewJoinGroupWithMnemonic

--- NEW FILE: ToggleButton.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget ToggleButton
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:13:20 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- A ToggleButton is the base class for all buttons that have an inherit
-- state.
--

module Graphics.UI.Gtk.Buttons.ToggleButton (
  ToggleButton,
  ToggleButtonClass,
  castToToggleButton,
  toggleButtonNew,
  toggleButtonNewWithLabel,
  toggleButtonNewWithMnemonic,
  toggleButtonSetMode,
  toggleButtonGetMode,
  toggleButtonToggled,
  toggleButtonGetActive,
  toggleButtonSetActive,
  toggleButtonGetInconsistent,
  toggleButtonSetInconsistent,
  onToggled,
  afterToggled
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new ToggleButton widget.
--
toggleButtonNew :: IO ToggleButton
toggleButtonNew  = makeNewObject mkToggleButton $ liftM castPtr 
  {#call unsafe toggle_button_new#}


-- | Create a ToggleButton with a label in it.
--
toggleButtonNewWithLabel :: String -> IO ToggleButton
toggleButtonNewWithLabel lbl = withUTFString lbl (\strPtr ->
  makeNewObject mkToggleButton $ liftM castPtr $
  {#call unsafe toggle_button_new_with_label#} strPtr)

-- | Create a ToggleButton with a label in it. Underscores in label indicate the
-- mnemonic for the button.
--
toggleButtonNewWithMnemonic :: String -> IO ToggleButton
toggleButtonNewWithMnemonic lbl = withUTFString lbl (\strPtr ->
  makeNewObject mkToggleButton $ liftM castPtr $
  {#call unsafe toggle_button_new_with_mnemonic#} strPtr)

-- | Sets whether the button is displayed as a separate indicator and label.
-- You can call this function on a "CheckButton" or a "RadioButton" with @False@
-- to make the button look like a normal button.
--
toggleButtonSetMode :: ToggleButtonClass tb => tb -> Bool -> IO ()
toggleButtonSetMode tb mode =
  {#call toggle_button_set_mode#} (toToggleButton tb) (fromBool mode)

-- | Retrieves whether the button is displayed as a separate indicator and
-- label.
--
toggleButtonGetMode :: ToggleButtonClass tb => tb -> IO Bool
toggleButtonGetMode tb =
  liftM toBool $ {#call unsafe toggle_button_get_mode#} (toToggleButton tb)

-- | Emit the 'toggled' signal on the button.
--
toggleButtonToggled :: ToggleButtonClass tb => tb -> IO ()
toggleButtonToggled tb = {#call toggle_button_toggled#} (toToggleButton tb)

-- | Retrieve the current state of the button. Returns True if the button is
-- depressed.
--
toggleButtonGetActive :: ToggleButtonClass tb => tb -> IO Bool
toggleButtonGetActive tb = liftM toBool $
  {#call unsafe toggle_button_get_active#} (toToggleButton tb)

-- | Sets the state of the ToggleButton. True means the button should be
-- depressed.
--
toggleButtonSetActive :: ToggleButtonClass tb => Bool -> tb -> IO ()
toggleButtonSetActive active tb = 
  {#call toggle_button_set_active#} (toToggleButton tb) (fromBool active)

-- | Retrieve the inconsistent flag of the button. An inconsistent state only
-- visually affects the button. It will be displayed in an \"in-between\" state.
--
toggleButtonGetInconsistent :: ToggleButtonClass tb => tb -> IO Bool
toggleButtonGetInconsistent tb = liftM toBool $
  {#call unsafe toggle_button_get_inconsistent#} (toToggleButton tb)

-- | Sets the inconsistent flag of the ToggleButton.
--
toggleButtonSetInconsistent :: ToggleButtonClass tb => Bool -> tb -> IO ()
toggleButtonSetInconsistent incon tb = 
  {#call toggle_button_set_inconsistent#} (toToggleButton tb) (fromBool incon)

-- signals


-- | Whenever the state of the button is changed, the toggled signal is emitted.
--
onToggled, afterToggled :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onToggled = connect_NONE__NONE "toggled" False
afterToggled = connect_NONE__NONE "toggled" True

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Buttons Button.chs.pp,NONE,1.1 CheckButton.chs,NONE,1.1

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

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

Added Files:
	Button.chs.pp CheckButton.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: CheckButton.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget CheckButton
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:12:55 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--

module Graphics.UI.Gtk.Buttons.CheckButton (
  CheckButton,
  CheckButtonClass,
  castToCheckButton,
  checkButtonNew,
  checkButtonNewWithLabel,
  checkButtonNewWithMnemonic
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new button with a check field.
--
checkButtonNew :: IO CheckButton
checkButtonNew  = makeNewObject mkCheckButton $ 
  liftM castPtr {#call unsafe check_button_new#}

-- | Create a new CheckButton with a text to
-- the right of it.
--
checkButtonNewWithLabel :: String -> IO CheckButton
checkButtonNewWithLabel lbl = withUTFString lbl (\strPtr ->
  makeNewObject mkCheckButton $ liftM castPtr $
  {#call unsafe check_button_new_with_label#} strPtr)

-- | Create a checkButton with an
-- accelerator key.
--
-- * Like 'checkButtonNewWithLabel' but turns every underscore in
--   the label to a underlined character.
--
checkButtonNewWithMnemonic :: String -> IO CheckButton
checkButtonNewWithMnemonic lbl = withUTFString lbl (\strPtr ->
  makeNewObject mkCheckButton $ liftM castPtr $ 
  {#call unsafe check_button_new_with_mnemonic#} strPtr)



--- NEW FILE: Button.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Button
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:12:55 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
module Graphics.UI.Gtk.Buttons.Button (
  Button,
  ButtonClass,
  castToButton,
  buttonNew,
  buttonNewWithLabel,
  buttonNewWithMnemonic,
  buttonNewFromStock,
  buttonPressed,
  buttonReleased,
  buttonClicked,
  buttonEnter,
  buttonLeave,
  ReliefStyle(..),
  buttonSetRelief,
  buttonGetRelief,
  buttonSetLabel,
  buttonGetLabel,
  buttonSetUseStock,
  buttonGetUseStock,
  buttonSetUseUnderline,
  buttonGetUseUnderline,
#if GTK_CHECK_VERSION(2,4,0)
  buttonSetFocusOnClick,
  buttonGetFocusOnClick,
  buttonSetAlignment,
  buttonGetAlignment,
#endif
  onButtonActivate,
  afterButtonActivate,
  onClicked,
  afterClicked,
  onEnter,
  afterEnter,
  onLeave,
  afterLeave,
  onPressed,
  afterPressed,
  onReleased,
  afterReleased
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new Button widget.
--
buttonNew :: IO Button
buttonNew  = makeNewObject mkButton $ liftM castPtr {#call unsafe button_new#}


-- | Create a button with a label in it.
--
buttonNewWithLabel :: String -> IO Button
buttonNewWithLabel lbl = withUTFString lbl (\strPtr ->
  makeNewObject mkButton $ liftM castPtr $
  {#call unsafe button_new_with_label#} strPtr)

-- | Create a button with an accelerator key.
--
-- * Like 'buttonNewWithLabel' but turns every underscore in the
--   label to a underlined character which then acts as a mnemonic (keyboard
--   shortcut).
--
buttonNewWithMnemonic :: String -> IO Button
buttonNewWithMnemonic lbl = withUTFString lbl (\strPtr ->
  makeNewObject mkButton $ liftM castPtr $ 
  {#call unsafe button_new_with_mnemonic#} strPtr)

-- | Create a stock (predefined appearance) button.
--
buttonNewFromStock :: String -> IO Button
buttonNewFromStock stockId = withUTFString stockId (\strPtr -> 
  makeNewObject mkButton $ liftM castPtr $
  throwIfNull "buttonNewFromStock: Invalid stock identifier." $ 
  {#call unsafe button_new_from_stock#} strPtr)

-- | Depress the button, i.e. emit the pressed signal.
--
buttonPressed :: ButtonClass b => b -> IO ()
buttonPressed b = {#call button_pressed#} (toButton b)

-- | Release the button, i.e. emit the released signal.
--
buttonReleased :: ButtonClass b => b -> IO ()
buttonReleased b = {#call button_released#} (toButton b)

-- | Emit the clicked signal on the button.
--
-- * This is similar to calling 'buttonPressed' and
--   'buttonReleased' in sequence.
--
buttonClicked :: ButtonClass b => b -> IO ()
buttonClicked b = {#call button_clicked#} (toButton b)

-- | Emit the cursor enters signal to the button.
--
buttonEnter :: ButtonClass b => b -> IO ()
buttonEnter b = {#call button_enter#} (toButton b)

-- | Emit the cursor leaves signal to the button.
--
buttonLeave :: ButtonClass b => b -> IO ()
buttonLeave b = {#call button_leave#} (toButton b)

-- | Set the style of the button edges.
--
buttonSetRelief :: ButtonClass b => b -> ReliefStyle -> IO ()
buttonSetRelief b rs = 
  {#call button_set_relief#} (toButton b) ((fromIntegral.fromEnum) rs)

-- | Get the current relief style.
--
buttonGetRelief :: ButtonClass b => b -> IO ReliefStyle
buttonGetRelief b = liftM (toEnum.fromIntegral) $
  {#call unsafe button_get_relief#} (toButton b)

-- | Set the text of the button.
--
buttonSetLabel :: ButtonClass b => b -> String -> IO ()
buttonSetLabel b lbl = withUTFString lbl $ \strPtr ->
  {#call button_set_label#} (toButton b) strPtr

-- | Get the current text on the button.
--
-- * The method returns the empty string in case the button does not have
--   a label (e.g. it was created with 'buttonNew'.
--
buttonGetLabel :: ButtonClass b => b -> IO String
buttonGetLabel b = do
  strPtr <- {#call unsafe button_get_label#} (toButton b)
  if strPtr==nullPtr then return "" else peekUTFString strPtr

-- | Set if the label is a stock identifier.
--
-- * Setting this property to @True@ will make the button lookup
--   its label in the table of stock items. If there is a match, the button
--   will use the stock item instead of the label.  You need to set this
--   flag before you change the label.
--
buttonSetUseStock :: ButtonClass b => b -> Bool -> IO ()
buttonSetUseStock b flag = 
  {#call button_set_use_stock#} (toButton b) (fromBool flag)

-- | Get the current flag for stock lookups.
--
buttonGetUseStock :: ButtonClass b => b -> IO Bool
buttonGetUseStock b = liftM toBool $
  {#call unsafe button_get_use_stock#} (toButton b)

-- | Set if the label has accelerators.
--
-- * Setting this property will make the button join any underline character
--   into the following letter and inserting this letter as a keyboard
--   shortcut. You need to set this flag before you change the label.
--
buttonSetUseUnderline :: ButtonClass b => b -> Bool -> IO ()
buttonSetUseUnderline b flag = 
  {#call button_set_use_underline#} (toButton b) (fromBool flag)

-- | Query if the underlines are mnemonics.
--
buttonGetUseUnderline :: ButtonClass b => b -> IO Bool
buttonGetUseUnderline b = liftM toBool $
  {#call unsafe button_get_use_underline#} (toButton b)

#if GTK_CHECK_VERSION(2,4,0)
-- | Sets whether the button will grab focus when it is clicked with the mouse.
--
buttonSetFocusOnClick :: ButtonClass b => b -> Bool -> IO ()
buttonSetFocusOnClick b focus =
  {#call unsafe button_set_focus_on_click#} (toButton b) (fromBool focus)

-- | Gets whether the button grabs focus when it is clicked with the mouse.
--
buttonGetFocusOnClick :: ButtonClass b => b -> IO Bool
buttonGetFocusOnClick b = liftM toBool $
  {#call unsafe button_get_focus_on_click#} (toButton b)

-- | Sets the alignment of the child. This has no effect unless the child
--   derives from "Misc" "Aligment".
--
buttonSetAlignment :: ButtonClass b => b -> (Float, Float) -> IO ()
buttonSetAlignment b (xalign, yalign) =
  {#call unsafe button_set_alignment#} (toButton b)
    (realToFrac xalign) (realToFrac yalign)

-- | Gets the alignment of the child in the button.
--
buttonGetAlignment :: ButtonClass b => b -> IO (Float, Float)
buttonGetAlignment b =
  alloca $ \xalignPtr -> alloca $ \yalignPtr -> do
  {#call unsafe button_get_alignment#} (toButton b) xalignPtr yalignPtr
  xalign <- peek xalignPtr
  yalign <- peek yalignPtr
  return (realToFrac xalign, realToFrac yalign)
#endif


-- signals

-- | The button has been depressed (but not
-- necessarily released yet). See @clicked@ signal.
--
onButtonActivate, afterButtonActivate :: ButtonClass b => b -> IO () ->
                                         IO (ConnectId b)
onButtonActivate = connect_NONE__NONE "activate"  False
afterButtonActivate = connect_NONE__NONE "activate"  True

-- | The button was clicked. This is only emitted if
-- the mouse cursor was over the button when it was released.
--
onClicked, afterClicked :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onClicked = connect_NONE__NONE "clicked" False
afterClicked = connect_NONE__NONE "clicked" True

-- | The cursor enters the button box.
--
onEnter, afterEnter :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onEnter = connect_NONE__NONE "enter" False
afterEnter = connect_NONE__NONE "enter" True

-- | The cursor leaves the button box.
--
onLeave, afterLeave :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onLeave = connect_NONE__NONE "leave" False
afterLeave = connect_NONE__NONE "leave" True

-- | The button is pressed.
--
onPressed, afterPressed :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onPressed = connect_NONE__NONE "pressed" False
afterPressed = connect_NONE__NONE "pressed" True


-- | The button is released.
--
onReleased, afterReleased :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onReleased = connect_NONE__NONE "released" False
afterReleased = connect_NONE__NONE "released" True

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Abstract ButtonBox.chs.pp,NONE,1.1 Object.chs.pp,NONE,1.1 Paned.chs.pp,NONE,1.1 Scrollbar.hs,NONE,1.1 Separator.hs,NONE,1.1

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

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

Added Files:
	ButtonBox.chs.pp Object.chs.pp Paned.chs.pp Scrollbar.hs 
	Separator.hs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Paned.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Paned
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:11:46 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This abstract widget provides a division line with a handle that can be
-- used by the user to divide the given space between two widgets. The two
-- concrete implementations are HPaned and VPaned.
--
module Graphics.UI.Gtk.Abstract.Paned (
  Paned,
  PanedClass,
  castToPaned,
  panedAdd1,
  panedAdd2,
  panedPack1,
  panedPack2,
  panedSetPosition,
  panedGetPosition
#if GTK_CHECK_VERSION(2,4,0)
 ,panedGetChild1,
  panedGetChild2
#endif
  ) 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#}

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

-- methods

-- | Add a widget to the first (top or left) area.
--
-- * The widget does not expand if 'Paned' expands. It does not shrink either.
--
panedAdd1 :: (PanedClass p, WidgetClass w) => p -> w -> IO ()
panedAdd1 p w = {#call paned_add1#} (toPaned p) (toWidget w)

-- | Add a widget to the second (bottom or right) area.
--
-- * The widget does not expand if 'Paned' expands. But it does shrink.
--
panedAdd2 :: (PanedClass p, WidgetClass w) => p -> w -> IO ()
panedAdd2 p w = {#call paned_add2#} (toPaned p) (toWidget w)

-- | Add a widget to the first area and specify its resizing behaviour.
--
panedPack1 :: (PanedClass p, WidgetClass w) => p -> w -> Bool -> Bool -> IO ()
panedPack1 p w expand shrink = {#call paned_pack1#} 
  (toPaned p) (toWidget w) (fromBool expand) (fromBool shrink)

-- | Add a widget to the second area and specify its resizing behaviour.
--
panedPack2 :: (PanedClass p, WidgetClass w) => p -> w -> Bool -> Bool -> IO ()
panedPack2 p w expand shrink = {#call paned_pack2#} 
  (toPaned p) (toWidget w) (fromBool expand) (fromBool shrink)

-- | Set the gutter to the specified @position@ (in pixels).
--
panedSetPosition :: PanedClass p => p -> Int -> IO ()
panedSetPosition p position = 
  {#call paned_set_position#} (toPaned p) (fromIntegral position)

-- | Get the gutter position (in pixels).
--
panedGetPosition :: PanedClass p => p -> IO Int
panedGetPosition p = liftM fromIntegral $
  {#call unsafe paned_get_position#} (toPaned p)

#if GTK_CHECK_VERSION(2,4,0)
-- | Obtains the first child of the paned widget.
--
panedGetChild1 :: PanedClass p => p -> IO Widget
panedGetChild1 p =
  makeNewObject mkWidget $ {#call unsafe paned_get_child1#} (toPaned p)

-- | Obtains the second child of the paned widget.
--
panedGetChild2 :: PanedClass p => p -> IO Widget
panedGetChild2 p =
  makeNewObject mkWidget $ {#call unsafe paned_get_child2#} (toPaned p)
#endif

--- NEW FILE: ButtonBox.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget ButtonBox
--
--  Author : Matthew Walton
--          
--  Created: 28 April 2004
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:11:46 $
--
--  Copyright (c) 2004 Matthew Walton
--
--  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.
--
-- |
--
module Graphics.UI.Gtk.Abstract.ButtonBox (
  ButtonBox,
  ButtonBoxClass,
  castToButtonBox,
  buttonBoxGetLayout,
  buttonBoxSetLayout,
  buttonBoxSetChildSecondary,
#if GTK_CHECK_VERSION(2,4,0)
  buttonBoxGetChildSecondary
#endif
  ) 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 (ButtonBoxStyle)

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

-- methods

-- | Retrieve the method being used to
-- arrange the buttons in the button box
--
buttonBoxGetLayout :: ButtonBoxClass b => b -> IO ButtonBoxStyle
buttonBoxGetLayout b = liftM (toEnum . fromIntegral) $
  {#call gtk_button_box_get_layout#} (toButtonBox b)

#if GTK_CHECK_VERSION(2,4,0)
-- | Returns whether child should appear
-- in a secondary group of children
--
-- * Since Gtk 2.4.
buttonBoxGetChildSecondary :: (ButtonBoxClass b, WidgetClass w) => b -> w -> IO Bool
buttonBoxGetChildSecondary b w = liftM toBool $
  {#call gtk_button_box_get_child_secondary#} (toButtonBox b) (toWidget w)
#endif

-- | Changes the way buttons are arranged in their container
--
buttonBoxSetLayout :: ButtonBoxClass b => b -> ButtonBoxStyle -> IO ()
buttonBoxSetLayout b l =
  {#call gtk_button_box_set_layout#} (toButtonBox b)
    ((fromIntegral . fromEnum) l)

-- | Sets whether child should appear in a secondary
-- group of children. A typical use of a secondary child is the help button in a dialog.
--
-- * This group appears after the other children if the style is 'ButtonboxStart',
-- 'ButtonboxSpread' or 'ButtonboxEdge', and before the the other children if the
-- style is 'ButtonboxEnd'. For horizontal button boxes, the definition of before\/after
-- depends on direction of the widget (see 'widgetSetDirection'). If the style is
-- 'buttonBoxStart' or 'buttonBoxEnd', then the secondary children are aligned at
-- the other end of the button box from the main children. For the other styles,
-- they appear immediately next to the main children.
--
buttonBoxSetChildSecondary :: (ButtonBoxClass b, WidgetClass w) => b -> w -> Bool -> IO ()
buttonBoxSetChildSecondary b w s =
  {#call gtk_button_box_set_child_secondary #} (toButtonBox b) (toWidget w)
    (fromBool s)

--- NEW FILE: Object.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Object
--
--  Author : Axel Simon
--          
--  Created: 9 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:11:46 $
--
--  Copyright (c) 2001 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.
--
-- |
--
-- Widget representation
--
-- * Each widget is a represented as a purely abstract data type. It can only 
--   be accessed through and the special access functions that are defined
--   in each widget file.
--
module Graphics.UI.Gtk.Abstract.Object (
  Object,
  ObjectClass,
  castToObject,
  objectSink,
  makeNewObject,
  objectSetProperty,
  objectGetProperty
  ) where

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject		(objectRef, objectUnref)
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.Types#}
{#import System.Glib.GValue#}
import System.Glib.StoreValue

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

-- methods

-- turn the initial floating state to sunk
--
-- * The floating\/sunk concept of a GTK object is not very useful to us.
--   The following procedure circumvents the whole subject and ensures 
--   proper cleanup:
--     on creation:      objectRef, objectSink
--     on finalization:  objectUnref
--
-- * This function cannot be bound by c2hs because it is not possible to
--   override the pointer hook.
objectSink :: ObjectClass obj => Ptr obj -> IO ()
objectSink = object_sink.castPtr

#if __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_object_sink"
  object_sink :: Ptr Object -> IO ()

#else

foreign import ccall "gtk_object_sink" unsafe 
  object_sink :: Ptr Object -> IO ()

#endif

-- This is a convenience function to generate a new widget. It adds the
-- finalizer with the method described under objectSink.
--
-- * The constr argument is the contructor of the specific object.
--
makeNewObject :: ObjectClass obj => 
  (ForeignPtr obj -> obj) -> IO (Ptr obj) -> IO obj
makeNewObject constr generator = do
  objPtr <- generator
  objectRef objPtr
  obj <- newForeignPtr objPtr (objectUnref objPtr)
  objectSink objPtr
  return $ constr obj


-- Sets a specific attribute of this object.
--
-- * Most attributes in a widget can be set and retrieved by passing the
--   name (as a string) and the value to special set\/get functions. These
--   are undocumented because each derived objects implements custom (and
--   welltyped) set and get functions for most attributes.
--
objectSetProperty :: GObjectClass gobj => gobj -> String -> GenericValue -> 
					  IO ()
objectSetProperty obj prop val = alloca $ \vaPtr -> withUTFString prop $ 
  \sPtr -> poke vaPtr val >> {#call unsafe g_object_set_property#} 
  (toGObject obj) sPtr vaPtr >> valueUnset vaPtr
  

-- Gets a specific attribute of this object.
--
-- * See 'objectSetProperty'.
--
objectGetProperty :: GObjectClass gobj => gobj -> String -> 
					IO GenericValue
objectGetProperty obj prop = alloca $ \vaPtr -> withUTFString prop $ \str -> do
  {#call unsafe g_object_get_property#} (toGObject obj) str vaPtr
  res <- peek vaPtr
  valueUnset vaPtr
  return res


--- NEW FILE: Separator.hs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Separator
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:11:47 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This widget is the base class for HSeparator and VSeparator.
--

module Graphics.UI.Gtk.Abstract.Separator (
  Separator,
  SeparatorClass
  ) where

import Graphics.UI.Gtk.Types (Separator, SeparatorClass)

-- well this widget is very abstract!

--- NEW FILE: Scrollbar.hs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Scrollbar
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:11:46 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This is the abstract base class for HScrollbar and VScrollbar.
--

module Graphics.UI.Gtk.Abstract.Scrollbar (
  Scrollbar,
  ScrollbarClass
  ) where

import Graphics.UI.Gtk.Types (Scrollbar, ScrollbarClass)

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Abstract Scale.chs,NONE,1.1 Range.chs,NONE,1.1 Misc.chs,NONE,1.1 Box.chs,NONE,1.1 Bin.chs,NONE,1.1

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

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

Added Files:
	Scale.chs Range.chs Misc.chs Box.chs Bin.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Misc.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Misc
--
--  Author : Manuel M. T. Chakravarty,
--	     Axel Simon
--          
--  Created: 2 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:10:43 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--

module Graphics.UI.Gtk.Abstract.Misc (
  Misc,
  MiscClass,
  castToMisc,
  miscSetAlignment,
  miscGetAlignment,
  miscSetPadding,
  miscGetPadding
  ) where

import Monad	(liftM)
import System.Glib.FFI


{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}

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

-- Misc type declaration

-- methods

-- | Set the alignment of the widget.
--
miscSetAlignment :: MiscClass m => m -> Double -> Double -> IO ()
miscSetAlignment misc xalign yalign =  {#call misc_set_alignment#} 
  (toMisc misc) (realToFrac xalign) (realToFrac yalign) 
    
-- | Get the alignment of the widget.
--
miscGetAlignment :: MiscClass m => m -> IO (Double, Double)
miscGetAlignment misc = 
  alloca $ \xalignPtr -> alloca $ \yalignPtr -> do
  {#call unsafe misc_get_alignment#} (toMisc misc) xalignPtr yalignPtr
  xalign <- peek xalignPtr
  yalign <- peek yalignPtr
  return (realToFrac xalign, realToFrac yalign)

-- | Set the amount of space to add around the widget.
--
miscSetPadding :: MiscClass m => m -> Int -> Int -> IO ()
miscSetPadding misc xpad ypad = {#call misc_set_padding#} 
  (toMisc misc) (fromIntegral xpad) (fromIntegral ypad) 

-- | Get the amount of space added around the widget.
--
miscGetPadding :: MiscClass m => m -> IO (Int, Int)
miscGetPadding misc =
  alloca $ \xpadPtr -> alloca $ \ypadPtr -> do
  {#call unsafe misc_get_padding#} (toMisc misc) xpadPtr ypadPtr
  xpad <- peek xpadPtr
  ypad <- peek ypadPtr
  return (fromIntegral xpad, fromIntegral ypad)


--- NEW FILE: Range.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Range
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:10:42 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- An abstract base class to handle widgets that represent some value range.
--
-- * For signals regarding a change in the range or increments, refer to
--   'Adjustment' which is contained in the 'Range' object.
--
module Graphics.UI.Gtk.Abstract.Range (
  Range,
  RangeClass,
  castToRange,
  rangeGetAdjustment,
  rangeSetAdjustment,
  UpdateType(..),
  rangeGetUpdatePolicy,
  rangeSetUpdatePolicy,
  rangeGetInverted,
  rangeSetInverted,
  rangeGetValue,
  rangeSetValue,
  rangeSetIncrements,
  rangeSetRange,
  ScrollType(..),
  rangeSetIncrements,
  rangeSetRange,
  rangeSetValue,
  rangeGetValue,
  onMoveSlider,
  afterMoveSlider
  ) 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	(UpdateType(..), ScrollType(..))

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

-- methods

-- | Extract the 'Adjustment' object.
--
rangeGetAdjustment :: RangeClass r => r -> IO Adjustment
rangeGetAdjustment r = makeNewObject mkAdjustment $
  {#call unsafe range_get_adjustment#} (toRange r)

-- | Insert a new 'Adjustment' object.
--
rangeSetAdjustment :: RangeClass r => r -> Adjustment -> IO ()
rangeSetAdjustment r adj = {#call range_set_adjustment#} (toRange r) adj

-- | Get the update policy for the range widget.
--
rangeGetUpdatePolicy :: RangeClass r => r -> IO UpdateType
rangeGetUpdatePolicy r = liftM (toEnum.fromIntegral) $
  {#call unsafe range_get_update_policy#} (toRange r)

-- | Set how the internal 'Adjustment' object is updated.
--
-- * The value of 'UpdateType' determines how frequently value-changed 
--   signals are emitted on the internal 'Adjustment' object.
--
rangeSetUpdatePolicy :: RangeClass r => r -> UpdateType -> IO ()
rangeSetUpdatePolicy r up = {#call range_set_update_policy#}
  (toRange r) ((fromIntegral.fromEnum) up)

-- | Get the inverted flag (determines if the range is reversed).
--
rangeGetInverted :: RangeClass r => r -> IO Bool
rangeGetInverted r = 
  liftM toBool $ {#call unsafe range_get_inverted#} (toRange r)

-- | Set the inverted flag.
--
rangeSetInverted :: RangeClass r => r -> Bool -> IO ()
rangeSetInverted r inv = {#call range_set_inverted#} (toRange r) (fromBool inv)

-- | Gets the current value of the range.
--
rangeGetValue :: RangeClass r => r -> IO Double
rangeGetValue r = liftM realToFrac $
  {#call unsafe range_get_value#} (toRange r)

-- | Sets the current value of the range. The range emits the \"value_changed\"
-- signal if the value changes.
--
-- * If the value is outside the minimum or maximum range values, it will be
-- clamped to fit inside them.
--
rangeSetValue :: RangeClass r => r -> Double -> IO ()
rangeSetValue r value =
  {#call range_set_value#} (toRange r) (realToFrac value)

-- | Sets the step and page sizes for the range. 
-- The step size is used when the
-- user clicks the "Scrollbar" arrows or moves "Scale" via arrow keys. The
-- page size is used for example when moving via Page Up or Page Down keys.
--
rangeSetIncrements :: RangeClass r => r
                   -> Double  -- ^ step size
                   -> Double  -- ^ page size
                   -> IO ()
rangeSetIncrements r step page =
 {#call range_set_increments#} (toRange r) (realToFrac step) (realToFrac page)

-- | Sets the allowable values in the 'Range', and clamps the range value to be
-- between min and max.
--
rangeSetRange :: RangeClass r => r
              -> Double  -- ^ min
              -> Double  -- ^ max
              -> IO ()
rangeSetRange r min max =
 {#call range_set_range#} (toRange r) (realToFrac min) (realToFrac max)

-- signals

-- | The slide has moved. The arguments give
-- detailed information what happend.
--
onMoveSlider, afterMoveSlider :: RangeClass r => r -> (ScrollType -> IO ()) ->
                                 IO (ConnectId r)
onMoveSlider = connect_ENUM__NONE "move-slider" False
afterMoveSlider = connect_ENUM__NONE "move-slider" True

--- NEW FILE: Bin.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Bin
--
--  Author : Duncan Coutts
--          
--  Created: 25 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
-- |
--
-- This abstract widget implements a container with just one child.
--
module Graphics.UI.Gtk.Abstract.Bin  (
  Bin,
  BinClass,
  binGetChild
) where

import System.Glib.FFI

import Graphics.UI.Gtk.Abstract.Object  (makeNewObject)
{#import Graphics.UI.Gtk.Types#}

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

binGetChild :: BinClass bin => bin -> IO Widget
binGetChild bin =
  makeNewObject mkWidget $ {# call gtk_bin_get_child #} (toBin bin)

--- NEW FILE: Box.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Box
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:10:43 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This abstract container class is instatiated by using HBox or VBox. It 
-- supplies all methods to add and remove children.
--

module Graphics.UI.Gtk.Abstract.Box (
  Box,
  BoxClass,
  castToBox,
  Packing(..),
  boxPackStart,
  boxPackEnd,
  boxPackStartDefaults,
  boxPackEndDefaults,
  boxGetHomogeneous,
  boxSetHomogeneous,
  boxGetSpacing,
  boxSetSpacing,
  boxReorderChild,
  boxQueryChildPacking,
  boxSetChildPacking
  ) 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	(PackType(..), Packing(..))

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

-- methods


-- | Insert a widget at the beginning of the box
-- container.
--
-- * The 'Packing' parameter determines how the child behaves in the
--   horizontal or vertical way in an HBox or VBox, respectively.
--   'PackNatural' means the child is as big as it reqests. It will
--   move to the left in an 'HBox' or to the top in an
--   'VBox' if there is more space availble.
--   All children
--   that have choosen 'PackRepel' for @p@ will be padded 
--   on both sides with
--   additional space. 'PackGrow' will increase the size of the
--   so that is covers the available space.
--
boxPackStart :: (BoxClass b, WidgetClass w) => b -> w -> Packing -> Int ->
                IO ()
boxPackStart b w p pad = {#call box_pack_start#} (toBox b) (toWidget w)
  (fromBool $ p/=PackNatural) (fromBool $ p==PackGrow) (fromIntegral pad)

-- | Insert a widget at the end of the box container.
--
-- * See 'boxPackStart'. The option 'Natural' will
--   move a child to the right in an 'HBox' or to the bottom in an
--   'VBox' if there is more space availble.
--
boxPackEnd :: (BoxClass b, WidgetClass w) => b -> w -> Packing -> Int -> IO ()
boxPackEnd b w p pad = {#call box_pack_end#} (toBox b) (toWidget w)
  (fromBool $ p/=PackNatural) (fromBool $ p==PackGrow) (fromIntegral pad)


-- | Like 'boxPackStart' but uses the
-- default parameters 'PackRepel' and 0 for padding.
--
boxPackStartDefaults :: (BoxClass b, WidgetClass w) => b -> w -> IO ()
boxPackStartDefaults b w = 
  {#call box_pack_start_defaults#} (toBox b) (toWidget w)

-- | Like 'boxPackEnd' but uses the
-- default parameters 'PackRepel' and 0 for padding.
--
boxPackEndDefaults :: (BoxClass b, WidgetClass w) => b -> w -> IO ()
boxPackEndDefaults b w = 
  {#call box_pack_end_defaults#} (toBox b) (toWidget w)

-- | Set if all children should be spread homogeneous
-- within the box.
--
boxSetHomogeneous :: BoxClass b => b -> Bool -> IO ()
boxSetHomogeneous b homo = 
  {#call box_set_homogeneous#} (toBox b) (fromBool homo)

-- | Get whether the box is homogeneous.
--
boxGetHomogeneous :: BoxClass b => b -> IO Bool
boxGetHomogeneous b =
  liftM toBool $ {#call box_get_homogeneous#} (toBox b)

-- | Set the standard spacing between two children.
--
-- * This space is in addition to the padding parameter that is given for each
--   child.
--
boxSetSpacing :: BoxClass b => b -> Int -> IO ()
boxSetSpacing b spacing =
  {#call box_set_spacing#} (toBox b) (fromIntegral spacing)

-- | Move @child@ to a new @position@
-- (counted from 0) in the box.
--
boxReorderChild :: (BoxClass b, WidgetClass w) => b -> w -> Int -> IO ()
boxReorderChild b w position = 
  {#call box_reorder_child#} (toBox b) (toWidget w) (fromIntegral position)

-- | Query the packing parameter of a child.
--
-- * Returns information on the behaviour if free space is available 
-- (in 'Packing'), the additional padding for this widget and
-- if the widget
-- was inserted at the start or end of the container ('PackType').
--
boxQueryChildPacking :: (BoxClass b, WidgetClass w) => b -> w ->
                        IO (Packing,Int,PackType)
boxQueryChildPacking b w = alloca $ \expandPtr -> alloca $ \fillPtr ->
  alloca $ \paddingPtr -> alloca $ \packPtr -> do
    {#call unsafe box_query_child_packing#} (toBox b) (toWidget w)
      expandPtr fillPtr paddingPtr packPtr
    expand  <- liftM toBool $ peek expandPtr
    fill    <- liftM toBool $ peek fillPtr
    padding <- liftM fromIntegral $ peek paddingPtr
    pack    <- liftM (toEnum.fromIntegral) $ peek packPtr
    return (if fill then PackGrow else 
            (if expand then PackRepel else PackNatural),
	    padding,pack)

-- | Set the packing parameter of a child.
--
boxSetChildPacking :: (BoxClass b, WidgetClass w) => b -> w -> Packing ->
                      Int -> PackType -> IO ()
boxSetChildPacking b w pack pad pt = {#call box_set_child_packing#} (toBox b) 
  (toWidget w) (fromBool $ pack/=PackNatural) (fromBool $ pack==PackGrow) 
  (fromIntegral pad) ((fromIntegral.fromEnum) pt)


-- | Retrieves the standard spacing between widgets.
--
boxGetSpacing :: BoxClass b => b -> IO Int
boxGetSpacing b = 
  liftM fromIntegral $ {#call unsafe box_get_spacing#} (toBox b)





--- NEW FILE: Scale.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Scale
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:10:42 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This is the abstract base class for HScale and VScale. It implements the
-- management of an adjustable value.
--

module Graphics.UI.Gtk.Abstract.Scale (
  Scale,
  ScaleClass,
  castToScale,
  scaleSetDigits,
  scaleGetDigits,
  scaleSetDrawValue,
  scaleGetDrawValue,
  PositionType(..),
  scaleSetValuePos,
  scaleGetValuePos
  ) 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	(PositionType(..))

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

-- methods

-- | Set the number of displayed digits after the comma.
--
scaleSetDigits :: ScaleClass s => s -> Int -> IO ()
scaleSetDigits s prec = 
  {#call scale_set_digits#} (toScale s) (fromIntegral prec)

-- | Get the number of displayed digits after the comma.
--
scaleGetDigits :: ScaleClass s => s -> IO Int
scaleGetDigits s =
  liftM fromIntegral $ {#call unsafe scale_get_digits#} (toScale s)

-- | Specify if the current value is to be drawn next to the slider.
--
scaleSetDrawValue :: ScaleClass s => s -> Bool -> IO ()
scaleSetDrawValue s draw =
  {#call scale_set_draw_value#} (toScale s) (fromBool draw)

-- | Returns whether the current value is drawn next to the slider.
--
scaleGetDrawValue :: ScaleClass s => s -> IO Bool
scaleGetDrawValue s =
  liftM toBool $ {#call unsafe scale_get_draw_value#} (toScale s)

-- | Specify where the value is to be displayed (relative to the slider).
--
scaleSetValuePos :: ScaleClass s => s -> PositionType -> IO ()
scaleSetValuePos s pos =
  {#call scale_set_value_pos#} (toScale s) ((fromIntegral.fromEnum) pos)

-- | Gets the position in which the current value is displayed.
--
scaleGetValuePos :: ScaleClass s => s -> IO PositionType
scaleGetValuePos s =
  liftM (toEnum.fromIntegral) $ {#call unsafe scale_get_value_pos#} (toScale s)

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

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

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

Added Files:
	Widget.chs Container.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Widget.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Widget
--
--  Author : Axel Simon
--          
--  Created: 27 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:08:47 $
--
--  Copyright (c) 2001 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.
--
-- |
--
--  Widget is the base class of all widgets. It provides the methods to
--  attach and detach signals.
--
--  * This modules reexports everything a normal widget needs from GObject
--    and Object.
--
-- 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:
--      widgetQueueDrawArea, widgetSetDoubleBufferd, widgetRegionIntersect
--
module Graphics.UI.Gtk.Abstract.Widget (
  Widget,
  WidgetClass,
  castToWidget,
  Allocation,
  Requisition(..),
  Rectangle(..),
  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,
--  widgetLockAccelerators,
--  widgetUnlockAccelerators,
  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 Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import System.Glib.GObject		(makeNewGObject)
{#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

-- | Queue a show request.
--
-- * 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. Note 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 w => w -> IO ()
widgetShow  = {#call widget_show#}.toWidget

-- | Queue a show event and wait for it to be executed.
--
-- * 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 w => w -> IO ()
widgetShowNow  = {#call widget_show_now#}.toWidget

-- | Queue a hide request.
--
-- * Reverses the effects of 'widgetShow', causing the widget to be
--   hidden (make invisible to the user).
--
widgetHide :: WidgetClass w => w -> IO ()
widgetHide  = {#call widget_hide#}.toWidget

-- | Show this and all child widgets.
--
widgetShowAll :: WidgetClass w => w -> IO ()
widgetShowAll  = {#call widget_show_all#}.toWidget

-- | Hide this and all child widgets.
--
widgetHideAll :: WidgetClass w => w -> IO ()
widgetHideAll  = {#call widget_hide_all#}.toWidget

-- | Destroy a widget.
--
-- * The 'widgetDestroy' function is used to shutdown an object,
--   i.e. a widget will be removed from the screen and unrealized. Resources
--   will be freed when all references are released.
--
widgetDestroy :: WidgetClass obj => obj -> IO ()
widgetDestroy  = {#call widget_destroy#}.toWidget

-- Functions to be used with DrawingArea.

-- | Prepare text for display.
--
-- * The 'Layout' 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 obj => obj -> String -> IO PangoLayout
widgetCreateLayout obj txt = withUTFString txt $
  \strPtr -> makeNewGObject mkPangoLayout
    ({#call unsafe widget_create_pango_layout#} (toWidget obj) strPtr)
  
-- | Send a redraw request to a widget.
--
widgetQueueDraw :: WidgetClass w => w -> IO ()
widgetQueueDraw  = {#call widget_queue_draw#}.toWidget

-- | Check if the widget intersects with a given
-- area.
--
widgetHasIntersection :: WidgetClass w => w -> Rectangle -> IO Bool
widgetHasIntersection w r = 
  liftM toBool $
  withObject r $ \r' ->
  {#call unsafe widget_intersect#} (toWidget w) (castPtr r') (castPtr nullPtr)

-- Manipulate widget state.

-- | Activate the widget (e.g. clicking a button).
--
widgetActivate :: WidgetClass w => w -> IO Bool
widgetActivate w = liftM toBool $ {#call widget_activate#} (toWidget w)

-- | Set the widgets sensitivity (Grayed or
-- Usable).
--
widgetSetSensitivity :: WidgetClass w => w -> Bool -> IO ()
widgetSetSensitivity w b = 
  {#call widget_set_sensitive#} (toWidget w) (fromBool b)

-- | Sets the minimum size of a widget.
--
widgetSetSizeRequest :: WidgetClass w => w -> Int -> Int -> IO ()
widgetSetSizeRequest w width height =
  {#call widget_set_size_request#} (toWidget w) (fromIntegral width) (fromIntegral height)

-- | Set and query the input focus of a widget.
--
widgetIsFocus :: WidgetClass w => w -> IO Bool
widgetIsFocus w = liftM toBool $ 
  {#call unsafe widget_is_focus#} (toWidget w)

widgetGrabFocus :: WidgetClass w => w -> IO ()
widgetGrabFocus = {#call widget_grab_focus#}.toWidget

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

-- | Set the name of a widget.
--
widgetSetName :: WidgetClass w => w -> String -> IO ()
widgetSetName w name = 
  withUTFString name ({#call widget_set_name#} (toWidget w))

-- | Get the name of a widget.
--
widgetGetName :: WidgetClass w => w -> IO String
widgetGetName w = {#call unsafe widget_get_name#} (toWidget w) >>= 
		  peekUTFString

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

-- | Get enabled event signals.
--
widgetGetEvents :: WidgetClass w => w -> IO [EventMask]
widgetGetEvents w = liftM (toFlags.fromIntegral) $ 
  {#call unsafe widget_get_events#} (toWidget w)

-- | Set extension events.
--
widgetSetExtensionEvents :: WidgetClass w => w -> [ExtensionMode] -> IO ()
widgetSetExtensionEvents w em = 
  {#call widget_set_extension_events#} (toWidget w) 
    (fromIntegral $ fromFlags em)

-- | Get extension events.
--
widgetGetExtensionEvents :: WidgetClass w => w -> IO [ExtensionMode]
widgetGetExtensionEvents w = liftM (toFlags.fromIntegral) $ 
  {#call widget_get_extension_events#} (toWidget w)

-- Widget browsing.

-- | Retrieves the topmost widget in this tree.
--
widgetGetToplevel :: WidgetClass w => w -> IO Widget
widgetGetToplevel w = makeNewObject mkWidget $
  {#call unsafe widget_get_toplevel#} (toWidget w)

-- | Return True if the second widget is (possibly
-- indirectly) held by the first.
--
widgetIsAncestor :: (WidgetClass w, WidgetClass anc) => anc -> w -> IO Bool
widgetIsAncestor anc w = liftM toBool $  
 {#call unsafe widget_is_ancestor#} (toWidget w) (toWidget anc)

-- | Move a widget to a new parent.
--
widgetReparent :: (WidgetClass w, WidgetClass par) => w -> par -> IO ()
widgetReparent w par = 
  {#call widget_reparent#} (toWidget w) (toWidget par)

-- | Setting packaging and writing direction.
--
widgetSetDirection :: WidgetClass w => w -> TextDirection -> IO ()
widgetSetDirection w td = 
  {#call widget_set_direction#} (toWidget w) ((fromIntegral.fromEnum) td)

-- | Retrieve the default direction of text writing.
--
widgetGetDirection :: WidgetClass w => w -> IO TextDirection
widgetGetDirection w = liftM (toEnum.fromIntegral) $ 
  {#call widget_get_direction#} (toWidget w)

-- Accelerator handling.

-- Lock accelerators.
--
--widgetLockAccelerators :: WidgetClass w => w -> IO ()
--widgetLockAccelerators = {#call unsafe widget_lock_accelerators#}.toWidget


-- Unlock accelerators.
--
--widgetUnlockAccelerators :: WidgetClass w => w -> IO ()
--widgetUnlockAccelerators = {#call widget_unlock_accelerators#}.toWidget




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


--- NEW FILE: Container.chs ---
{-# OPTIONS -cpp #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Container
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:08:47 $
--
--  Copyright (c) 1999..2002 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.
--
-- |
--
-- This abstract widget implements the basis for turning serveral widgets
-- into one compound widget.
--

module Graphics.UI.Gtk.Abstract.Container (
  Container,
  ContainerClass,
  castToContainer,
  containerAdd,
  containerRemove,
  containerForeach,
  containerGetChildren,
  DirectionType(..),
  containerSetFocusChild,
  containerSetFocusChain,
  containerGetFocusChain,
  containerUnsetFocusChain,
  containerSetFocusVAdjustment,
  containerGetFocusVAdjustment,
  containerSetFocusHAdjustment,
  containerGetFocusHAdjustment,
  containerResizeChildren,
  containerSetBorderWidth,
  containerGetBorderWidth,
  containerChildSetProperty,
  containerChildGetProperty,
  onAdd,
  afterAdd,
  onCheckResize,
  afterCheckResize,
  onFocus,
  afterFocus,
  onRemove,
  afterRemove,
  onSetFocusChild,
  afterSetFocusChild
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject		(objectRef, objectUnref)
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import System.Glib.GList		(fromGList, toGList)
{#import System.Glib.GValue#}		(GValue, GenericValue, valueUnset)
import Graphics.UI.Gtk.General.Enums	(DirectionType(..))


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

-- methods

-- | Add a widget to the container.
--
-- * Only useful for simple
-- containers like Window. Use boxPackStart or tableAttach in other cases. A
-- widget may not be added to more than one container.
--
containerAdd :: (ContainerClass c, WidgetClass w) => c -> w -> IO ()
containerAdd con widget = 
  {#call container_add#} (toContainer con) (toWidget widget)


-- | Removes a present widget from the container.
--
containerRemove :: (ContainerClass c, WidgetClass w) => c -> w -> IO ()
containerRemove con widget =
  {#call container_remove#} (toContainer con) (toWidget widget)


-- | Do something for each widget in the container.
--
containerForeach :: ContainerClass c => c -> ContainerForeachCB -> IO ()
containerForeach con fun = do
  fPtr <- mkContainerForeachFunc (\wPtr _ -> do
    objectRef wPtr
    w <- liftM mkWidget $ newForeignPtr wPtr (objectUnref wPtr)
    fun w)
  {#call container_foreach#} (toContainer con) fPtr nullPtr
  freeHaskellFunPtr fPtr

type ContainerForeachCB = Widget -> IO ()
{#pointer Callback#}

foreign import ccall "wrapper" mkContainerForeachFunc ::
  (Ptr Widget -> Ptr () -> IO ()) -> IO Callback

-- | Returns the the container's children.
--
containerGetChildren :: ContainerClass c => c -> IO [Widget]
containerGetChildren con = do
  glist <- {#call container_get_children#} (toContainer con)
  widgetPtrs <- fromGList glist
  mapM (makeNewObject mkWidget . return) widgetPtrs

-- | Give the focus to a specific child of the
-- container.
--
containerSetFocusChild :: (ContainerClass c, WidgetClass w) => c -> w -> IO ()
containerSetFocusChild con widget =
  {#call container_set_focus_child#} (toContainer con) (toWidget widget)

-- | Sets a focus chain, overriding the one computed automatically by GTK+.
--
containerSetFocusChain :: ContainerClass c => c -> [Widget] -> IO ()
containerSetFocusChain con chain =
  let wForeignPtrs = map (\w -> case toWidget w of Widget ptr -> ptr) chain in
  withForeignPtrs wForeignPtrs $ \wPtrs -> do
  glist <- toGList wPtrs
  {#call container_set_focus_chain#} (toContainer con) glist

withForeignPtrs :: [ForeignPtr a] -> ([Ptr a] -> IO b) -> IO b
withForeignPtrs = withForeignPtrs' []
  where withForeignPtrs' accum []     cont = cont (reverse accum)
        withForeignPtrs' accum (p:ps) cont = withForeignPtr p $ \p' ->
                                             withForeignPtrs' (p':accum) ps cont

-- | Retrieves the focus chain of the container, if one has been set explicitly.
--
containerGetFocusChain :: ContainerClass c => c -> IO (Maybe [Widget])
containerGetFocusChain con =
  alloca $ \glistPtr -> do
  {#call container_get_focus_chain#} (toContainer con) glistPtr
  if glistPtr == nullPtr then return Nothing else liftM Just $ do
    glist <- peek glistPtr
    widgetPtrs <- fromGList glist
    mapM (makeNewObject mkWidget . return) widgetPtrs

-- | Removes a focus chain explicitly set with 'containerSetFocusChain'.
--
containerUnsetFocusChain :: ContainerClass c => c -> IO ()
containerUnsetFocusChain con =
  {#call container_unset_focus_chain#} (toContainer con)

-- | Install an adjustment widget that is queried when focus is changed.
--
containerSetFocusVAdjustment :: (ContainerClass c, AdjustmentClass a) => c ->
                                a -> IO ()
containerSetFocusVAdjustment con adj =
  {#call container_set_focus_vadjustment#} (toContainer con) (toAdjustment adj)

-- | Retrieves the vertical focus adjustment for the container, or Nothing if
-- none has been set.
--
containerGetFocusVAdjustment :: ContainerClass c => c -> IO (Maybe Adjustment)
containerGetFocusVAdjustment con = do
  aPtr <- {#call unsafe container_get_focus_vadjustment#} (toContainer con)
  if aPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkAdjustment (return aPtr)

-- | Install an adjustment widget that is queried when focus is changed.
--
containerSetFocusHAdjustment :: (ContainerClass c, AdjustmentClass a) => c ->
                                a -> IO ()
containerSetFocusHAdjustment con adj =
  {#call container_set_focus_hadjustment#} (toContainer con) (toAdjustment adj)

-- | Retrieves the horizontal focus adjustment for the container, or Nothing if
-- none has been set.
--
containerGetFocusHAdjustment :: ContainerClass c => c -> IO (Maybe Adjustment)
containerGetFocusHAdjustment con = do
  aPtr <- {#call unsafe container_get_focus_hadjustment#} (toContainer con)
  if aPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkAdjustment (return aPtr)

-- | Make the container resize its children.
--
containerResizeChildren :: ContainerClass c => c -> IO ()
containerResizeChildren con =
  {#call container_resize_children#} (toContainer con)

-- | Set the amount of empty space around the outside of the container.
--
-- The border width of a container is the amount of space to leave around the
-- outside of the container. The border is added on all sides of the container.
--
containerSetBorderWidth :: ContainerClass c => c -> Int -> IO ()
containerSetBorderWidth con width =
  {#call container_set_border_width#} (toContainer con) (fromIntegral width)

-- | Retrieves the border width of the container. See 'containerSetBorderWidth'.
--
containerGetBorderWidth :: ContainerClass c => c -> IO Int
containerGetBorderWidth con = liftM fromIntegral $
  {#call unsafe container_get_border_width#} (toContainer con)

-- TODO add doc on what child properties are

-- | Sets a child property for child and container.
--
containerChildSetProperty :: (ContainerClass c, WidgetClass widget) => c
                          -> widget       -- ^ Chile widget
                          -> String       -- ^ Property name
                          -> GenericValue -- ^ Property value
                          -> IO ()
containerChildSetProperty con child prop val =
  alloca $ \valPtr ->
  withUTFString prop $ \strPtr -> do
  poke valPtr val
  {#call container_child_set_property#} (toContainer con)
    (toWidget child) strPtr valPtr

-- | Gets the value of a child property for the given child and container.
--
containerChildGetProperty :: (ContainerClass c, WidgetClass widget) => c
                          -> widget  -- ^ Child widget
                          -> String  -- ^ Property name
                          -> IO GenericValue
containerChildGetProperty con child prop =
  alloca $ \valPtr ->
  withUTFString prop $ \strPtr -> do
  {#call unsafe container_child_get_property#} (toContainer con)
    (toWidget child) strPtr valPtr
  res <- peek valPtr
  valueUnset valPtr
  return res

-- signals

-- | This signal is called each time a new widget is added
-- to this container.
--
onAdd, afterAdd :: ContainerClass con => con -> (Widget -> IO ()) ->
                   IO (ConnectId con)
onAdd = connect_OBJECT__NONE "add" False
afterAdd = connect_OBJECT__NONE "add" True

-- | This signal is called when the widget is
-- resized.
--
onCheckResize, afterCheckResize :: ContainerClass con => con -> (IO ()) ->
                                   IO (ConnectId con)
onCheckResize = connect_NONE__NONE "check-resize" False
afterCheckResize = connect_NONE__NONE "check-resize" True

-- | This signal is called if the container receives the
-- input focus.
--
onFocus, afterFocus :: ContainerClass con => con ->
                       (DirectionType -> IO DirectionType) ->
                       IO (ConnectId con)
onFocus = connect_ENUM__ENUM "focus" False
afterFocus = connect_ENUM__ENUM "focus" True

-- | This signal is called for each widget that is
-- removed from the container.
--
onRemove, afterRemove :: ContainerClass con => con -> (Widget -> IO ()) ->
                         IO (ConnectId con)
onRemove = connect_OBJECT__NONE "remove" False
afterRemove = connect_OBJECT__NONE "remove" True


-- | This signal is called if a child in the
-- container receives the input focus.
--
onSetFocusChild, afterSetFocusChild :: ContainerClass con => con ->
                                       (Widget -> IO ()) -> IO (ConnectId con)
onSetFocusChild = connect_OBJECT__NONE "set-focus-child" False
afterSetFocusChild = connect_OBJECT__NONE "set-focus-child" True

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI Gtk.hs,NONE,1.1

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

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

Added Files:
	Gtk.hs 
Log Message:
commit the grand hierarchical namespace conversion. If it all goes wrong,
revert back to the tag 'pre-hierarchical-names-conversion'.


--- NEW FILE: Gtk.hs ---
{-# OPTIONS -cpp #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK)
--
--  Author : Axel Simon
--          
--  Created: 9 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:05:14 $
--
--  Copyright (c) 2001 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.
--
-- |
--
-- This module gathers all publicly available functions from the Gtk binding.
--
-- * Everything that is marked as deprecated, vanishing or useless for
--   applications is not bound.
--
--
-- * The following modules are not bound:
--   DialogMessage : has only one variadic function which cannot be bound.
--		     The same functionality can be simulated with Dialog.
--   Item :	     The only child of this abstract class is MenuItem. The
--		     three signals Item defines are therefore bound in 
--		     MenuItem.
--
-- TODO
--
-- * Every module that is commented out and not mentioned above.
--
#include <config.h>

module Graphics.UI.Gtk (
  -- * General things, initialization
  module Graphics.UI.Gtk.General.General,
  module Graphics.UI.Gtk.General.IconFactory,
  module Graphics.UI.Gtk.General.StockItems,
  module Graphics.UI.Gtk.Gdk.Keys,
  module Graphics.UI.Gtk.General.Style,
  module Graphics.UI.Gtk.Gdk.Drawable,
  module Graphics.UI.Gtk.Gdk.DrawWindow,
  module Graphics.UI.Gtk.Gdk.Region,
  module Graphics.UI.Gtk.Gdk.GC,
  module Graphics.UI.Gtk.Gdk.Pixbuf,
  module Graphics.UI.Gtk.Gdk.Gdk,
  -- * Windows
  module Graphics.UI.Gtk.Windows.Window,
  module Graphics.UI.Gtk.Windows.Dialog,
  module Graphics.UI.Gtk.Windows.FileSel,
  -- * Display widgets,
  module Graphics.UI.Gtk.Display.AccelLabel,
  module Graphics.UI.Gtk.Display.Image,
  module Graphics.UI.Gtk.Display.Label,
  module Graphics.UI.Gtk.Display.ProgressBar,
  module Graphics.UI.Gtk.Display.Statusbar,
  -- * Buttons and toggles
  module Graphics.UI.Gtk.Buttons.Button,
  module Graphics.UI.Gtk.Buttons.CheckButton,
  module Graphics.UI.Gtk.Buttons.RadioButton,
  module Graphics.UI.Gtk.Buttons.ToggleButton,
  -- * Numeric\/text data entry
  module Graphics.UI.Gtk.Entry.Editable,
  module Graphics.UI.Gtk.Entry.Entry,
  module Graphics.UI.Gtk.Entry.EntryCompletion,
  module Graphics.UI.Gtk.Entry.HScale,
  module Graphics.UI.Gtk.Entry.VScale,
  module Graphics.UI.Gtk.Entry.SpinButton,
  -- * Multiline text editor
  module Graphics.UI.Gtk.Multiline.TextIter,
  module Graphics.UI.Gtk.Multiline.TextMark,
  module Graphics.UI.Gtk.Multiline.TextBuffer,
  module Graphics.UI.Gtk.Multiline.TextTag,
  module Graphics.UI.Gtk.Multiline.TextTagTable,
  module Graphics.UI.Gtk.Multiline.TextView,
  -- * Tree and list widget
  module Graphics.UI.Gtk.TreeList.TreeModel,
  module Graphics.UI.Gtk.TreeList.TreeSelection,
  module Graphics.UI.Gtk.TreeList.TreeViewColumn,
  module Graphics.UI.Gtk.TreeList.TreeView,
--  module TreeSortable,
  module Graphics.UI.Gtk.TreeList.TreeModelSort,
  module Graphics.UI.Gtk.TreeList.CellRenderer,
--  module CellEditable,
  module Graphics.UI.Gtk.TreeList.CellRendererPixbuf,
  module Graphics.UI.Gtk.TreeList.CellRendererText,
  module Graphics.UI.Gtk.TreeList.CellRendererToggle,
  module Graphics.UI.Gtk.TreeList.ListStore,
  module Graphics.UI.Gtk.TreeList.TreeStore,
  -- * Menus, combo box, toolbar
  module Graphics.UI.Gtk.MenuComboToolbar.CheckMenuItem,
  module Graphics.UI.Gtk.MenuComboToolbar.Combo,
  module Graphics.UI.Gtk.MenuComboToolbar.ComboBox,
  module Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry,
  module Graphics.UI.Gtk.MenuComboToolbar.Menu,
  module Graphics.UI.Gtk.MenuComboToolbar.MenuBar,
  module Graphics.UI.Gtk.MenuComboToolbar.MenuItem,
  module Graphics.UI.Gtk.MenuComboToolbar.MenuShell,
  module Graphics.UI.Gtk.MenuComboToolbar.OptionMenu,
  module Graphics.UI.Gtk.MenuComboToolbar.ImageMenuItem,
  module Graphics.UI.Gtk.MenuComboToolbar.RadioMenuItem,
  module Graphics.UI.Gtk.MenuComboToolbar.TearoffMenuItem,
  module Graphics.UI.Gtk.MenuComboToolbar.Toolbar,
  module Graphics.UI.Gtk.MenuComboToolbar.ToolItem,
  -- * Selectors (file/font/color)
  module Graphics.UI.Gtk.Selectors.ColorSelection,
  module Graphics.UI.Gtk.Selectors.ColorSelectionDialog,
--  module FileSelection,
  module Graphics.UI.Gtk.Selectors.FontSelection,
  module Graphics.UI.Gtk.Selectors.FontSelectionDialog,
--  module InputDialog,
  -- ** File chooser
  module Graphics.UI.Gtk.Selectors.FileChooser,
  module Graphics.UI.Gtk.Selectors.FileChooserDialog,
  module Graphics.UI.Gtk.Selectors.FileChooserWidget,
  -- * Layout containers
  module Graphics.UI.Gtk.Layout.Alignment,
  module Graphics.UI.Gtk.Layout.AspectFrame,
  module Graphics.UI.Gtk.Layout.HBox,
  module Graphics.UI.Gtk.Layout.HButtonBox,
  module Graphics.UI.Gtk.Layout.Fixed,
  module Graphics.UI.Gtk.Layout.HPaned,
  module Graphics.UI.Gtk.Layout.Layout,
  module Graphics.UI.Gtk.Layout.Notebook,
  module Graphics.UI.Gtk.Layout.Expander,
  module Graphics.UI.Gtk.Layout.Table,
  module Graphics.UI.Gtk.Layout.VBox,
  module Graphics.UI.Gtk.Layout.VButtonBox,
  module Graphics.UI.Gtk.Layout.VPaned,
  -- * Ornaments
  module Graphics.UI.Gtk.Ornaments.Frame,
  module Graphics.UI.Gtk.Ornaments.HSeparator,
  module Graphics.UI.Gtk.Ornaments.VSeparator,
  -- * Scrolling
  module Graphics.UI.Gtk.Scrolling.HScrollbar,
  module Graphics.UI.Gtk.Scrolling.ScrolledWindow,
  module Graphics.UI.Gtk.Scrolling.VScrollbar,
  -- * Miscellaneous
  module Graphics.UI.Gtk.Misc.Adjustment,
  module Graphics.UI.Gtk.Misc.GArrow,
  module Graphics.UI.Gtk.Misc.Calendar,
  module Graphics.UI.Gtk.Misc.DrawingArea,
  module Graphics.UI.Gtk.Misc.EventBox,
  module Graphics.UI.Gtk.Misc.HandleBox,
--  module IMContext,
--  module IMMulticontext,
  module Graphics.UI.Gtk.Misc.SizeGroup,
  module Graphics.UI.Gtk.Misc.Tooltips,
  module Graphics.UI.Gtk.Misc.Viewport,
  -- * Abstract base classes
  module Graphics.UI.Gtk.Abstract.Box,
  module Graphics.UI.Gtk.Abstract.Container,
  module Graphics.UI.Gtk.Abstract.Bin,
  module Graphics.UI.Gtk.Abstract.Misc,
  module Graphics.UI.Gtk.Abstract.Object,
  module Graphics.UI.Gtk.Abstract.Paned,
  module Graphics.UI.Gtk.Abstract.Range,
  module Graphics.UI.Gtk.Abstract.Scale,
  module Graphics.UI.Gtk.Abstract.Scrollbar,
  module Graphics.UI.Gtk.Abstract.Separator,
  module Graphics.UI.Gtk.Abstract.Widget,
#ifndef WIN32
  -- * Cross-process embedding
  module Graphics.UI.Gtk.Embedding.Plug,
  module Graphics.UI.Gtk.Embedding.Socket,
#endif
  -- * Non-widgets
  module Graphics.UI.Gtk.Types,
  module Graphics.UI.Gtk.Signals,

  -- * Pango text layout modules
  module Graphics.UI.Gtk.Pango.Markup,
  module Graphics.UI.Gtk.Pango.Layout,
  module Graphics.UI.Gtk.Pango.Rendering
  ) where

-- general things, initialization
import Graphics.UI.Gtk.General.General
import Graphics.UI.Gtk.General.IconFactory
import Graphics.UI.Gtk.General.StockItems
import Graphics.UI.Gtk.Gdk.Keys
import Graphics.UI.Gtk.General.Style
import Graphics.UI.Gtk.Gdk.Drawable
import Graphics.UI.Gtk.Gdk.DrawWindow
import Graphics.UI.Gtk.Gdk.Region		hiding (makeNewRegion)
import Graphics.UI.Gtk.Gdk.GC
import Graphics.UI.Gtk.Gdk.Pixbuf
import Graphics.UI.Gtk.Gdk.Gdk
-- windows
import Graphics.UI.Gtk.Windows.Dialog
import Graphics.UI.Gtk.Windows.FileSel
import Graphics.UI.Gtk.Windows.Window
--import WindowGroup
-- display widgets
import Graphics.UI.Gtk.Display.AccelLabel
import Graphics.UI.Gtk.Display.Image
import Graphics.UI.Gtk.Display.Label
import Graphics.UI.Gtk.Display.ProgressBar
import Graphics.UI.Gtk.Display.Statusbar
-- buttons and toggles
import Graphics.UI.Gtk.Buttons.Button
import Graphics.UI.Gtk.Buttons.CheckButton
import Graphics.UI.Gtk.Buttons.RadioButton
import Graphics.UI.Gtk.Buttons.ToggleButton
-- numeric\/text data entry
import Graphics.UI.Gtk.Entry.Editable
import Graphics.UI.Gtk.Entry.Entry
import Graphics.UI.Gtk.Entry.EntryCompletion
import Graphics.UI.Gtk.Entry.HScale
import Graphics.UI.Gtk.Entry.VScale
import Graphics.UI.Gtk.Entry.SpinButton
-- multiline text editor
import Graphics.UI.Gtk.Multiline.TextIter
import Graphics.UI.Gtk.Multiline.TextMark
import Graphics.UI.Gtk.Multiline.TextBuffer
import Graphics.UI.Gtk.Multiline.TextTag
import Graphics.UI.Gtk.Multiline.TextTagTable
import qualified Graphics.UI.Gtk.Multiline.TextView
import Graphics.UI.Gtk.Multiline.TextView hiding (afterSetScrollAdjustments,
		onSetScrollAdjustments, afterCopyClipboard, onCopyClipboard,
		afterCutClipboard, onCutClipboard, afterInsertAtCursor,
		onInsertAtCursor, afterPasteClipboard, onPasteClipboard,
		afterToggleOverwrite, onToggleOverwrite)
-- tree and list widget
import Graphics.UI.Gtk.TreeList.TreeModel hiding (createTreeIter,
		 createTreePath, gtk_tree_model_get_iter_from_string)
import Graphics.UI.Gtk.TreeList.TreeSelection
import Graphics.UI.Gtk.TreeList.TreeViewColumn
import Graphics.UI.Gtk.TreeList.TreeView
--import TreeSortable
import Graphics.UI.Gtk.TreeList.TreeModelSort
import Graphics.UI.Gtk.TreeList.CellRenderer
--import CellEditable
import Graphics.UI.Gtk.TreeList.CellRendererPixbuf
import Graphics.UI.Gtk.TreeList.CellRendererText
import Graphics.UI.Gtk.TreeList.CellRendererToggle
import Graphics.UI.Gtk.TreeList.ListStore
import Graphics.UI.Gtk.TreeList.TreeStore
-- menus, combo box, toolbar
import Graphics.UI.Gtk.MenuComboToolbar.Combo
import Graphics.UI.Gtk.MenuComboToolbar.ComboBox
import Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry
-- import ItemFactory
import Graphics.UI.Gtk.MenuComboToolbar.Menu
import Graphics.UI.Gtk.MenuComboToolbar.MenuBar
import Graphics.UI.Gtk.MenuComboToolbar.MenuItem
import Graphics.UI.Gtk.MenuComboToolbar.MenuShell
import Graphics.UI.Gtk.MenuComboToolbar.OptionMenu
import Graphics.UI.Gtk.MenuComboToolbar.ImageMenuItem
import Graphics.UI.Gtk.MenuComboToolbar.RadioMenuItem
import Graphics.UI.Gtk.MenuComboToolbar.CheckMenuItem
import Graphics.UI.Gtk.MenuComboToolbar.TearoffMenuItem
import Graphics.UI.Gtk.MenuComboToolbar.Toolbar
import Graphics.UI.Gtk.MenuComboToolbar.ToolItem
-- selectors (file\/font\/color\/input device)
import Graphics.UI.Gtk.Selectors.ColorSelection
import Graphics.UI.Gtk.Selectors.ColorSelectionDialog
--import FileSelection
import Graphics.UI.Gtk.Selectors.FileChooser
import Graphics.UI.Gtk.Selectors.FileChooserDialog
import Graphics.UI.Gtk.Selectors.FileChooserWidget
import Graphics.UI.Gtk.Selectors.FontSelection
import Graphics.UI.Gtk.Selectors.FontSelectionDialog
--import InputDialog
-- layout containers
import Graphics.UI.Gtk.Layout.Alignment
import Graphics.UI.Gtk.Layout.AspectFrame
import Graphics.UI.Gtk.Layout.HBox
import Graphics.UI.Gtk.Layout.VBox
import Graphics.UI.Gtk.Layout.HButtonBox
import Graphics.UI.Gtk.Layout.VButtonBox
import Graphics.UI.Gtk.Layout.Fixed
import Graphics.UI.Gtk.Layout.HPaned
import Graphics.UI.Gtk.Layout.VPaned
import Graphics.UI.Gtk.Layout.Layout
import Graphics.UI.Gtk.Layout.Notebook
import Graphics.UI.Gtk.Layout.Expander
import Graphics.UI.Gtk.Layout.Table
-- ornaments
import Graphics.UI.Gtk.Ornaments.Frame
import Graphics.UI.Gtk.Ornaments.HSeparator
import Graphics.UI.Gtk.Ornaments.VSeparator
-- scrolling
import Graphics.UI.Gtk.Scrolling.HScrollbar
import Graphics.UI.Gtk.Scrolling.VScrollbar
import Graphics.UI.Gtk.Scrolling.ScrolledWindow
-- miscellaneous
import Graphics.UI.Gtk.Misc.Adjustment
import Graphics.UI.Gtk.Misc.GArrow
import Graphics.UI.Gtk.Misc.Calendar
import Graphics.UI.Gtk.Misc.DrawingArea
import Graphics.UI.Gtk.Misc.EventBox
import Graphics.UI.Gtk.Misc.HandleBox
--import IMContext
--import IMContextSimple
--import IMMulitcontext
import Graphics.UI.Gtk.Misc.SizeGroup
import Graphics.UI.Gtk.Misc.Tooltips
import Graphics.UI.Gtk.Misc.Viewport
--import Accessible
-- abstract base classes
import Graphics.UI.Gtk.Abstract.Box
import Graphics.UI.Gtk.Abstract.ButtonBox
import Graphics.UI.Gtk.Abstract.Container
import Graphics.UI.Gtk.Abstract.Bin
import Graphics.UI.Gtk.Abstract.Misc
import Graphics.UI.Gtk.Abstract.Object
import Graphics.UI.Gtk.Abstract.Paned
import Graphics.UI.Gtk.Abstract.Range
import Graphics.UI.Gtk.Abstract.Scale
import Graphics.UI.Gtk.Abstract.Scrollbar
import Graphics.UI.Gtk.Abstract.Separator
import Graphics.UI.Gtk.Abstract.Widget
#ifndef WIN32
-- cross-process embedding
import Graphics.UI.Gtk.Embedding.Plug
import Graphics.UI.Gtk.Embedding.Socket
#endif

-- non widgets
import Graphics.UI.Gtk.Types		(toCellRenderer)
import Graphics.UI.Gtk.Signals	(ConnectId, disconnect)

-- pango modules
import Graphics.UI.Gtk.Pango.Markup
import Graphics.UI.Gtk.Pango.Layout
import Graphics.UI.Gtk.Pango.Rendering

[Gtk2hs-commit] gtk2hs ChangeLog,1.264,1.265

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

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

Modified Files:
	ChangeLog 
Log Message:
commit the grand hierarchical namespace conversion. If it all goes wrong,
revert back to the tag 'pre-hierarchical-names-conversion'.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.264
retrieving revision 1.265
diff -u -d -r1.264 -r1.265
--- ChangeLog	8 Jan 2005 07:37:10 -0000	1.264
+++ ChangeLog	8 Jan 2005 15:05:12 -0000	1.265
@@ -1,3 +1,22 @@
+2005-01-08 Duncan Coutts <du...@co...>
+
+	* gtk/Graphics/UI/Gtk.hs: commit the grand hierarchical namespace
+	conversion. If it all goes wrong, revert back to the tag
+	'pre-hierarchical-names-conversion'.
+
+	* gtk/Graphics/UI/Gtk/Abstract/Bin.chs,
+	gtk/Graphics/UI/Gtk/Abstract/Box.chs,
+	gtk/Graphics/UI/Gtk/Abstract/ButtonBox.chs.pp,
+	gtk/Graphics/UI/Gtk/Abstract/Container.chs,
+	gtk/Graphics/UI/Gtk/Abstract/Misc.chs,
+	gtk/Graphics/UI/Gtk/Abstract/Object.chs.pp,
+	gtk/Graphics/UI/Gtk/Abstract/Paned.chs.pp,
+	gtk/Graphics/UI/Gtk/Abstract/Range.chs,
+	gtk/Graphics/UI/Gtk/Abstract/Scale.chs,
+	gtk/Graphics/UI/Gtk/Abstract/Scrollbar.hs,
+	gtk/Graphics/UI/Gtk/Abstract/Separator.hs,
+	gtk/Graphics/UI/Gtk/Abstract/Widget.chs: add abstract category
+
 2005-01-07 Duncan Coutts <du...@co...>
 
 	* tools/apiGen/ApiGen.hs: several documentation improvements, add

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Windows - New directory

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

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

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Windows added to the repository

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/TreeList - New directory

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

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

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/TreeList added to the repository

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Scrolling - New directory

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

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

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Scrolling added to the repository

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Selectors - New directory

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

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

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Selectors added to the repository

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Pango - New directory

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

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

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Pango added to the repository

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Ornaments - New directory

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

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

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Ornaments added to the repository