{-# LINE 2 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Container
--
-- Author : Axel Simon
--
-- Created: 15 May 2001
--
-- Copyright (C) 1999-2005 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Base class for widgets which contain other widgets
--
module Graphics.UI.Gtk.Abstract.Container (
-- * Detail
--
-- | A Gtk+ user interface is constructed by nesting widgets inside widgets.
-- Container widgets are the inner nodes in the resulting tree of widgets: they
-- contain other widgets. So, for example, you might have a 'Window' containing
-- a 'Frame' containing a 'Label'. If you wanted an image instead of a textual
-- label inside the frame, you might replace the 'Label' widget with a 'Image'
-- widget.
--
-- There are two major kinds of container widgets in Gtk+. Both are
-- subclasses of the abstract 'Container' base class.
--
-- The first type of container widget has a single child widget and derives
-- from 'Bin'. These containers are decorators, which add some kind of
-- functionality to the child. For example, a 'Button' makes its child into a
-- clickable button; a 'Frame' draws a frame around its child and a 'Window'
-- places its child widget inside a top-level window.
--
-- The second type of container can have more than one child; its purpose is
-- to manage layout. This means that these containers assign sizes and
-- positions to their children. For example, a 'HBox' arranges its children in
-- a horizontal row, and a 'Table' arranges the widgets it contains in a
-- two-dimensional grid.
--
-- To fulfill its task, a layout container must negotiate the size
-- requirements with its parent and its children. This negotiation is carried
-- out in two phases, size requisition and size allocation.

-- ** Size Requisition
--
-- | The size requisition of a widget is it's desired width and height. This
-- is represented by a 'Requisition'.
--
-- How a widget determines its desired size depends on the widget. A
-- 'Label', for example, requests enough space to display all its text.
-- Container widgets generally base their size request on the requisitions of
-- their children.
--
-- The size requisition phase of the widget layout process operates
-- top-down. It starts at a top-level widget, typically a 'Window'. The
-- top-level widget asks its child for its size requisition by calling
-- 'widgetSizeRequest'. To determine its requisition, the child asks its own
-- children for their requisitions and so on. Finally, the top-level widget
-- will get a requisition back from its child.

-- ** Size Allocation
--
-- | When the top-level widget has determined how much space its child would
-- like to have, the second phase of the size negotiation, size allocation,
-- begins. Depending on its configuration (see 'windowSetResizable'), the
-- top-level widget may be able to expand in order to satisfy the size request
-- or it may have to ignore the size request and keep its fixed size. It then
-- tells its child widget how much space it gets by calling
-- 'widgetSizeAllocate'. The child widget divides the space among its children
-- and tells each child how much space it got, and so on. Under normal
-- circumstances, a 'Window' will always give its child the amount of space the
-- child requested.
--
-- A child's size allocation is represented by an 'Allocation'.
-- This contains not only a width and height, but also a
-- position (i.e. X and Y coordinates), so that containers can tell their
-- children not only how much space they have gotten, but also where they are
-- positioned inside the space available to the container.
--
-- Widgets are required to honor the size allocation they receive; a size
-- request is only a request, and widgets must be able to cope with any size.

-- ** Child attributes
--
-- | 'Container' introduces child attributes - these are object attributes
-- that are not specific to either the container or the contained widget, but
-- rather to their relation. Typical examples of child attributes are the
-- position or pack-type of a widget which is contained in a 'Box'.
--
-- The 'Container' class does not itself define any child attributes, they are
-- defined (and documented) by the various 'Container' subclasses.
--
-- Child attributes can be set or obtained in a similar way to ordinary
-- attributes. So ordinary attributes are set like so:
--
-- > set object [ attr := value ]
--
-- Whereas child attributes take the child object as a parameter:
--
-- > set container [ attr child := value ]
--
-- And similarly for getting a child attribute's value:
--
-- > value <- get container (attr child)
--

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----Container
-- | +----'Bin'
-- | +----'Box'
-- | +----'CList'
-- | +----'Fixed'
-- | +----'Paned'
-- | +----'IconView'
-- | +----'Layout'
-- | +----'List'
-- | +----'MenuShell'
-- | +----'Notebook'
-- | +----'Socket'
-- | +----'Table'
-- | +----'TextView'
-- | +----'Toolbar'
-- | +----'TreeView'
-- @

-- * Types
  Container,
  ContainerClass,
  castToContainer, gTypeContainer,
  toContainer,
  ContainerForeachCB,
  ResizeMode(..),

-- * Methods
  containerAdd,
  containerRemove,
  containerForeach,
  containerForall,
  containerGetChildren,
  containerSetFocusChild,
  containerSetFocusChain,
  containerGetFocusChain,
  containerUnsetFocusChain,
  containerSetFocusVAdjustment,
  containerGetFocusVAdjustment,
  containerSetFocusHAdjustment,
  containerGetFocusHAdjustment,
  containerResizeChildren,
  containerSetBorderWidth,
  containerGetBorderWidth,
  containerGetResizeMode,
  containerSetResizeMode,

-- * Attributes
  containerResizeMode,
  containerBorderWidth,
  containerChild,
  containerFocusHAdjustment,
  containerFocusVAdjustment,

-- * Signals
  add,
  checkResize,
  remove,
  setFocusChild,

-- * Deprecated
{-# LINE 196 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 205 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 206 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
import System.Glib.GList (fromGList, withGList)
import Graphics.UI.Gtk.General.Enums (ResizeMode(..))


{-# LINE 210 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}

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

-- | Adds @widget@ to the container. Typically used for simple containers such
-- as 'Window', 'Frame', or 'Button'; for more complicated layout containers
-- such as 'Box' or 'Table', this function will pick default packing parameters
-- that may not be correct. So consider functions such as 'boxPackStart' and
-- 'tableAttach' as an alternative to 'containerAdd' in those cases. A widget
-- may be added to only one container at a time; you can't place the same
-- widget inside two different containers.
--
containerAdd :: (ContainerClass self, WidgetClass widget) => self
 -> widget -- ^ @widget@ - a widget to be placed inside @container@
 -> IO ()
containerAdd :: forall self widget.
(ContainerClass self, WidgetClass widget) =>
self -> widget -> IO ()
containerAdd self
self widget
widget =
  (\(Container ForeignPtr Container
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Container -> Ptr Widget -> IO ()
gtk_container_add Ptr Container
argPtr1 Ptr Widget
argPtr2)
{-# LINE 227 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    (widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
widget)

-- | Removes @widget@ from @container@. @widget@ must be inside @container@.
--
containerRemove :: (ContainerClass self, WidgetClass widget) => self
 -> widget -- ^ @widget@ - a current child of @container@
 -> IO ()
containerRemove :: forall self widget.
(ContainerClass self, WidgetClass widget) =>
self -> widget -> IO ()
containerRemove self
self widget
widget =
  (\(Container ForeignPtr Container
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Container -> Ptr Widget -> IO ()
gtk_container_remove Ptr Container
argPtr1 Ptr Widget
argPtr2)
{-# LINE 237 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    (widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
widget)

-- | Maps @callback@ over each non-internal child of @container@. See
-- 'containerForall' for details on what constitutes an \"internal\" child.
-- Most applications should use 'containerForeach', rather than
-- 'containerForall'.
--
containerForeach :: ContainerClass self => self
 -> ContainerForeachCB
 -> IO ()
containerForeach :: forall self.
ContainerClass self =>
self -> (Widget -> IO ()) -> IO ()
containerForeach self
self Widget -> IO ()
fun = do
  Callback
fPtr <- (Ptr Widget -> Ptr () -> IO ()) -> IO Callback
mkContainerForeachFunc (\Ptr Widget
wPtr Ptr ()
_ -> do
    Widget
w <- (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
wPtr)
    Widget -> IO ()
fun Widget
w)
  (\(Container ForeignPtr Container
arg1) Callback
arg2 Ptr ()
arg3 -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> Callback -> Ptr () -> IO ()
gtk_container_foreach Ptr Container
argPtr1 Callback
arg2 Ptr ()
arg3)
{-# LINE 253 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    Callback
fPtr
    Ptr ()
forall a. Ptr a
nullPtr
  Callback -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr Callback
fPtr

-- | A function that is invoked for all widgets in a container.
type ContainerForeachCB = Widget -> IO ()
type Callback = FunPtr (((Ptr Widget) -> ((Ptr ()) -> (IO ()))))
{-# LINE 261 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}

foreign import ccall "wrapper" mkContainerForeachFunc ::
  (Ptr Widget -> Ptr () -> IO ()) -> IO Callback

-- | Maps @callback@ over each child of @container@, including children that
-- are considered \"internal\" (implementation details of the container).
-- \"Internal\" children generally weren't added by the user of the container,
-- but were added by the container implementation itself. Most applications
-- should use 'containerForeach', rather than 'containerForall'.
--
containerForall :: ContainerClass self => self
 -> ContainerForeachCB -- ^ @callback@ - a callback
 -> IO ()
containerForall :: forall self.
ContainerClass self =>
self -> (Widget -> IO ()) -> IO ()
containerForall self
self Widget -> IO ()
fun = do
  Callback
fPtr <- (Ptr Widget -> Ptr () -> IO ()) -> IO Callback
mkContainerForeachFunc (\Ptr Widget
wPtr Ptr ()
_ -> do
    Widget
w <- (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
wPtr)
    Widget -> IO ()
fun Widget
w)
  (\(Container ForeignPtr Container
arg1) Callback
arg2 Ptr ()
arg3 -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> Callback -> Ptr () -> IO ()
gtk_container_forall Ptr Container
argPtr1 Callback
arg2 Ptr ()
arg3)
{-# LINE 279 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    Callback
fPtr
    Ptr ()
forall a. Ptr a
nullPtr
  Callback -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr Callback
fPtr

-- | Returns the container's non-internal children. See 'containerForall' for
-- details on what constitutes an \"internal\" child.
--
containerGetChildren :: ContainerClass self => self
 -> IO [Widget]
containerGetChildren :: forall self. ContainerClass self => self -> IO [Widget]
containerGetChildren self
self = do
  Ptr ()
glist <- (\(Container ForeignPtr Container
arg1) -> ForeignPtr Container
-> (Ptr Container -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr Container -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> IO (Ptr ())
gtk_container_get_children Ptr Container
argPtr1) (self -> Container
forall o. ContainerClass o => o -> Container
toContainer self
self)
  [Ptr Widget]
widgetPtrs <- Ptr () -> IO [Ptr Widget]
forall a. Ptr () -> IO [Ptr a]
fromGList Ptr ()
glist
  (Ptr Widget -> IO Widget) -> [Ptr Widget] -> IO [Widget]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (IO (Ptr Widget) -> IO Widget)
-> (Ptr Widget -> IO (Ptr Widget)) -> Ptr Widget -> IO Widget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) [Ptr Widget]
widgetPtrs

-- | Give the focus to a specific child of the container.
--
containerSetFocusChild :: (ContainerClass self, WidgetClass child) => self
 -> child -- ^ @child@
 -> IO ()
containerSetFocusChild :: forall self widget.
(ContainerClass self, WidgetClass widget) =>
self -> widget -> IO ()
containerSetFocusChild self
self child
child =
  (\(Container ForeignPtr Container
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Container -> Ptr Widget -> IO ()
gtk_container_set_focus_child Ptr Container
argPtr1 Ptr Widget
argPtr2)
{-# LINE 301 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)

-- | Sets a focus chain, overriding the one computed automatically by Gtk+.
--
-- In principle each widget in the chain should be a descendant of the
-- container, but this is not enforced by this method, since it's allowed to
-- set the focus chain before you pack the widgets, or have a widget in the
-- chain that isn't always packed. The necessary checks are done when the focus
-- chain is actually traversed.
--
containerSetFocusChain :: ContainerClass self => self
 -> [Widget] -- ^ @focusableWidgets@ - the new focus chain.
 -> IO ()
containerSetFocusChain :: forall self. ContainerClass self => self -> [Widget] -> IO ()
containerSetFocusChain self
self [Widget]
chain =
  [ForeignPtr Widget] -> ([Ptr Widget] -> IO ()) -> IO ()
forall a b. [ForeignPtr a] -> ([Ptr a] -> IO b) -> IO b
withForeignPtrs ((Widget -> ForeignPtr Widget) -> [Widget] -> [ForeignPtr Widget]
forall a b. (a -> b) -> [a] -> [b]
map Widget -> ForeignPtr Widget
unWidget [Widget]
chain) (([Ptr Widget] -> IO ()) -> IO ())
-> ([Ptr Widget] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Ptr Widget]
wPtrs ->
  [Ptr Widget] -> (Ptr () -> IO ()) -> IO ()
forall a b. [Ptr a] -> (Ptr () -> IO b) -> IO b
withGList [Ptr Widget]
wPtrs ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ()
glist ->
  (\(Container ForeignPtr Container
arg1) Ptr ()
arg2 -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> Ptr () -> IO ()
gtk_container_set_focus_chain Ptr Container
argPtr1 Ptr ()
arg2)
{-# LINE 319 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    Ptr ()
glist

-- | Retrieves the focus chain of the container, if one has been set
-- explicitly. If no focus chain has been explicitly set, Gtk+ computes the
-- focus chain based on the positions of the children. In that case the
-- function returns @Nothing@.
--
containerGetFocusChain :: ContainerClass self => self
 -> IO (Maybe [Widget])
containerGetFocusChain :: forall self. ContainerClass self => self -> IO (Maybe [Widget])
containerGetFocusChain self
self =
  (Ptr (Ptr ()) -> IO (Maybe [Widget])) -> IO (Maybe [Widget])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO (Maybe [Widget])) -> IO (Maybe [Widget]))
-> (Ptr (Ptr ()) -> IO (Maybe [Widget])) -> IO (Maybe [Widget])
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
glistPtr -> do
  (\(Container ForeignPtr Container
arg1) Ptr (Ptr ())
arg2 -> ForeignPtr Container -> (Ptr Container -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO CInt) -> IO CInt)
-> (Ptr Container -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> Ptr (Ptr ()) -> IO CInt
gtk_container_get_focus_chain Ptr Container
argPtr1 Ptr (Ptr ())
arg2)
{-# LINE 332 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    Ptr (Ptr ())
glistPtr
  if Ptr (Ptr ())
glistPtr Ptr (Ptr ()) -> Ptr (Ptr ()) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (Ptr ())
forall a. Ptr a
nullPtr then Maybe [Widget] -> IO (Maybe [Widget])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Widget]
forall a. Maybe a
Nothing else ([Widget] -> Maybe [Widget]) -> IO [Widget] -> IO (Maybe [Widget])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Widget] -> Maybe [Widget]
forall a. a -> Maybe a
Just (IO [Widget] -> IO (Maybe [Widget]))
-> IO [Widget] -> IO (Maybe [Widget])
forall a b. (a -> b) -> a -> b
$ do
    Ptr ()
glist <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
glistPtr
    [Ptr Widget]
widgetPtrs <- Ptr () -> IO [Ptr Widget]
forall a. Ptr () -> IO [Ptr a]
fromGList Ptr ()
glist
    (Ptr Widget -> IO Widget) -> [Ptr Widget] -> IO [Widget]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (IO (Ptr Widget) -> IO Widget)
-> (Ptr Widget -> IO (Ptr Widget)) -> Ptr Widget -> IO Widget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) [Ptr Widget]
widgetPtrs

-- | Removes a focus chain explicitly set with 'containerSetFocusChain'.
--
containerUnsetFocusChain :: ContainerClass self => self -> IO ()
containerUnsetFocusChain :: forall self. ContainerClass self => self -> IO ()
containerUnsetFocusChain self
self =
  (\(Container ForeignPtr Container
arg1) -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> IO ()
gtk_container_unset_focus_chain Ptr Container
argPtr1)
{-# LINE 344 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)

-- | Hooks up an adjustment to focus handling in a container, so when a child
-- of the container is focused, the adjustment is scrolled to show that widget.
-- This function sets the vertical alignment. See
-- 'scrolledWindowGetVAdjustment' for a typical way of obtaining the adjustment
-- and 'containerSetFocusHAdjustment' for setting the horizontal adjustment.
--
-- The adjustments have to be in pixel units and in the same coordinate
-- system as the allocation for immediate children of the container.
--
containerSetFocusVAdjustment :: ContainerClass self => self
 -> Adjustment -- ^ @adjustment@ - an adjustment which should be adjusted when
               -- the focus is moved among the descendents of @container@
 -> IO ()
containerSetFocusVAdjustment :: forall self. ContainerClass self => self -> Adjustment -> IO ()
containerSetFocusVAdjustment self
self Adjustment
adjustment =
  (\(Container ForeignPtr Container
arg1) (Adjustment ForeignPtr Adjustment
arg2) -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg2 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr2 ->Ptr Container -> Ptr Adjustment -> IO ()
gtk_container_set_focus_vadjustment Ptr Container
argPtr1 Ptr Adjustment
argPtr2)
{-# LINE 361 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    Adjustment
adjustment

-- | Retrieves the vertical focus adjustment for the container. See
-- 'containerSetFocusVAdjustment'.
--
containerGetFocusVAdjustment :: ContainerClass self => self
 -> IO (Maybe Adjustment) -- ^ returns the vertical focus adjustment, or
                          -- @Nothing@ if none has been set.
containerGetFocusVAdjustment :: forall self. ContainerClass self => self -> IO (Maybe Adjustment)
containerGetFocusVAdjustment self
self =
  (IO (Ptr Adjustment) -> IO Adjustment)
-> IO (Ptr Adjustment) -> IO (Maybe Adjustment)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
forall {a}. (ForeignPtr Adjustment -> Adjustment, FinalizerPtr a)
mkAdjustment) (IO (Ptr Adjustment) -> IO (Maybe Adjustment))
-> IO (Ptr Adjustment) -> IO (Maybe Adjustment)
forall a b. (a -> b) -> a -> b
$
  (\(Container ForeignPtr Container
arg1) -> ForeignPtr Container
-> (Ptr Container -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment))
-> (Ptr Container -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> IO (Ptr Adjustment)
gtk_container_get_focus_vadjustment Ptr Container
argPtr1)
{-# LINE 373 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)

-- | Hooks up an adjustment to focus handling in a container, so when a child
-- of the container is focused, the adjustment is scrolled to show that widget.
-- This function sets the horizontal alignment. See
-- 'scrolledWindowGetHAdjustment' for a typical way of obtaining the adjustment
-- and 'containerSetFocusVAdjustment' for setting the vertical adjustment.
--
-- The adjustments have to be in pixel units and in the same coordinate
-- system as the allocation for immediate children of the container.
--
containerSetFocusHAdjustment :: ContainerClass self => self
 -> Adjustment -- ^ @adjustment@ - an adjustment which should be adjusted when
               -- the focus is moved among the descendents of @container@
 -> IO ()
containerSetFocusHAdjustment :: forall self. ContainerClass self => self -> Adjustment -> IO ()
containerSetFocusHAdjustment self
self Adjustment
adjustment =
  (\(Container ForeignPtr Container
arg1) (Adjustment ForeignPtr Adjustment
arg2) -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg2 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr2 ->Ptr Container -> Ptr Adjustment -> IO ()
gtk_container_set_focus_hadjustment Ptr Container
argPtr1 Ptr Adjustment
argPtr2)
{-# LINE 390 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    Adjustment
adjustment

-- | Retrieves the horizontal focus adjustment for the container. See
-- 'containerSetFocusHAdjustment'.
--
containerGetFocusHAdjustment :: ContainerClass self => self
 -> IO (Maybe Adjustment) -- ^ returns the horizontal focus adjustment, or
                          -- @Nothing@ if none has been set.
containerGetFocusHAdjustment :: forall self. ContainerClass self => self -> IO (Maybe Adjustment)
containerGetFocusHAdjustment self
self =
  (IO (Ptr Adjustment) -> IO Adjustment)
-> IO (Ptr Adjustment) -> IO (Maybe Adjustment)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
forall {a}. (ForeignPtr Adjustment -> Adjustment, FinalizerPtr a)
mkAdjustment) (IO (Ptr Adjustment) -> IO (Maybe Adjustment))
-> IO (Ptr Adjustment) -> IO (Maybe Adjustment)
forall a b. (a -> b) -> a -> b
$
  (\(Container ForeignPtr Container
arg1) -> ForeignPtr Container
-> (Ptr Container -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment))
-> (Ptr Container -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> IO (Ptr Adjustment)
gtk_container_get_focus_hadjustment Ptr Container
argPtr1)
{-# LINE 402 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)

-- | Make the container resize its children.
--
containerResizeChildren :: ContainerClass self => self -> IO ()
containerResizeChildren :: forall self. ContainerClass self => self -> IO ()
containerResizeChildren self
self =
  (\(Container ForeignPtr Container
arg1) -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> IO ()
gtk_container_resize_children Ptr Container
argPtr1)
{-# LINE 409 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)

-- | Sets the border width of the container.
--
-- The border width of a container is the amount of space to leave around
-- the outside of the container. The only exception to this is 'Window';
-- because toplevel windows can't leave space outside, they leave the space
-- inside. The border is added on all sides of the container. To add space to
-- only one side, one approach is to create a 'Alignment' widget, call
-- 'widgetSetSizeRequest' to give it a size, and place it on the side of the
-- container as a spacer.
--
containerSetBorderWidth :: ContainerClass self => self
 -> Int -- ^ @borderWidth@ - amount of blank space to leave /outside/ the
          -- container. Valid values are in the range 0-65535 pixels.
 -> IO ()
containerSetBorderWidth :: forall self. ContainerClass self => self -> Int -> IO ()
containerSetBorderWidth self
self Int
borderWidth =
  (\(Container ForeignPtr Container
arg1) CUInt
arg2 -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> CUInt -> IO ()
gtk_container_set_border_width Ptr Container
argPtr1 CUInt
arg2)
{-# LINE 427 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
borderWidth)

-- | Retrieves the border width of the container. See
-- 'containerSetBorderWidth'.
--
containerGetBorderWidth :: ContainerClass self => self
 -> IO Int -- ^ returns the current border width
containerGetBorderWidth :: forall self. ContainerClass self => self -> IO Int
containerGetBorderWidth self
self =
  (CUInt -> Int) -> IO CUInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(Container ForeignPtr Container
arg1) -> ForeignPtr Container -> (Ptr Container -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO CUInt) -> IO CUInt)
-> (Ptr Container -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> IO CUInt
gtk_container_get_border_width Ptr Container
argPtr1)
{-# LINE 438 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)

-- | Returns the resize mode for the container. See 'containerSetResizeMode'.
--
containerGetResizeMode :: ContainerClass self => self
 -> IO ResizeMode -- ^ returns the current resize mode
containerGetResizeMode :: forall self. ContainerClass self => self -> IO ResizeMode
containerGetResizeMode self
self =
  (CInt -> ResizeMode) -> IO CInt -> IO ResizeMode
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ResizeMode
forall a. Enum a => Int -> a
toEnum (Int -> ResizeMode) -> (CInt -> Int) -> CInt -> ResizeMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO ResizeMode) -> IO CInt -> IO ResizeMode
forall a b. (a -> b) -> a -> b
$
  (\(Container ForeignPtr Container
arg1) -> ForeignPtr Container -> (Ptr Container -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO CInt) -> IO CInt)
-> (Ptr Container -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> IO CInt
gtk_container_get_resize_mode Ptr Container
argPtr1)
{-# LINE 447 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)

-- | Sets the resize mode for the container.
--
-- The resize mode of a container determines whether a resize request will
-- be passed to the container's parent, queued for later execution or executed
-- immediately.
--
containerSetResizeMode :: ContainerClass self => self
 -> ResizeMode -- ^ @resizeMode@ - the new resize mode.
 -> IO ()
containerSetResizeMode :: forall self. ContainerClass self => self -> ResizeMode -> IO ()
containerSetResizeMode self
self ResizeMode
resizeMode =
  (\(Container ForeignPtr Container
arg1) CInt
arg2 -> ForeignPtr Container -> (Ptr Container -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Container
arg1 ((Ptr Container -> IO ()) -> IO ())
-> (Ptr Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Container
argPtr1 ->Ptr Container -> CInt -> IO ()
gtk_container_set_resize_mode Ptr Container
argPtr1 CInt
arg2)
{-# LINE 460 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}
    (toContainer self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ResizeMode -> Int) -> ResizeMode -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResizeMode -> Int
forall a. Enum a => a -> Int
fromEnum) ResizeMode
resizeMode)

--------------------
-- Attributes

-- | Specify how resize events are handled.
--
-- Default value: 'ResizeParent'
--
containerResizeMode :: ContainerClass self => Attr self ResizeMode
containerResizeMode :: forall self. ContainerClass self => Attr self ResizeMode
containerResizeMode = (self -> IO ResizeMode)
-> (self -> ResizeMode -> IO ())
-> ReadWriteAttr self ResizeMode ResizeMode
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO ResizeMode
forall self. ContainerClass self => self -> IO ResizeMode
containerGetResizeMode
  self -> ResizeMode -> IO ()
forall self. ContainerClass self => self -> ResizeMode -> IO ()
containerSetResizeMode

-- | The width of the empty border outside the containers children.
--
-- Allowed values: \<= @('maxBound' :: Int)@
--
-- Default value: 0
--
containerBorderWidth :: ContainerClass self => Attr self Int
containerBorderWidth :: forall self. ContainerClass self => Attr self Int
containerBorderWidth = (self -> IO Int)
-> (self -> Int -> IO ()) -> ReadWriteAttr self Int Int
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Int
forall self. ContainerClass self => self -> IO Int
containerGetBorderWidth
  self -> Int -> IO ()
forall self. ContainerClass self => self -> Int -> IO ()
containerSetBorderWidth

-- | Can be used to add a new child to the container.
--
containerChild :: (ContainerClass self, WidgetClass widget) => WriteAttr self widget
containerChild :: forall self widget.
(ContainerClass self, WidgetClass widget) =>
WriteAttr self widget
containerChild = String -> GType -> WriteAttr self widget
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
String -> GType -> WriteAttr gobj gobj'
writeAttrFromObjectProperty String
"child"
  GType
gtk_widget_get_type
{-# LINE 491 "./Graphics/UI/Gtk/Abstract/Container.chs" #-}

-- | \'focusHadjustment\' property. See 'containerGetFocusHAdjustment' and
-- 'containerSetFocusHAdjustment'
--
containerFocusHAdjustment :: ContainerClass self => ReadWriteAttr self (Maybe Adjustment) Adjustment
containerFocusHAdjustment :: forall self.
ContainerClass self =>
ReadWriteAttr self (Maybe Adjustment) Adjustment
containerFocusHAdjustment = (self -> IO (Maybe Adjustment))
-> (self -> Adjustment -> IO ())
-> ReadWriteAttr self (Maybe Adjustment) Adjustment
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO (Maybe Adjustment)
forall self. ContainerClass self => self -> IO (Maybe Adjustment)
containerGetFocusHAdjustment
  self -> Adjustment -> IO ()
forall self. ContainerClass self => self -> Adjustment -> IO ()
containerSetFocusHAdjustment

-- | \'focusVadjustment\' property. See 'containerGetFocusVAdjustment' and
-- 'containerSetFocusVAdjustment'
--
containerFocusVAdjustment :: ContainerClass self => ReadWriteAttr self (Maybe Adjustment) Adjustment
containerFocusVAdjustment :: forall self.
ContainerClass self =>
ReadWriteAttr self (Maybe Adjustment) Adjustment
containerFocusVAdjustment = (self -> IO (Maybe Adjustment))
-> (self -> Adjustment -> IO ())
-> ReadWriteAttr self (Maybe Adjustment) Adjustment
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO (Maybe Adjustment)
forall self. ContainerClass self => self -> IO (Maybe Adjustment)
containerGetFocusVAdjustment
  self -> Adjustment -> IO ()
forall self. ContainerClass self => self -> Adjustment -> IO ()
containerSetFocusVAdjustment

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

-- %hash c:26b d:af3f
-- | A widget was added to the container.
--
add :: ContainerClass self => Signal self (Widget -> IO ())
add :: forall self. ContainerClass self => Signal self (Widget -> IO ())
add = (Bool -> self -> (Widget -> IO ()) -> IO (ConnectId self))
-> Signal self (Widget -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> self -> (Widget -> IO ()) -> IO (ConnectId self)
forall a' obj.
(GObjectClass a', GObjectClass obj) =>
String -> Bool -> obj -> (a' -> IO ()) -> IO (ConnectId obj)
connect_OBJECT__NONE String
"add")

-- %hash c:f43a d:af3f
-- | A widget was removed from the container.
--
remove :: ContainerClass self => Signal self (Widget -> IO ())
remove :: forall self. ContainerClass self => Signal self (Widget -> IO ())
remove = (Bool -> self -> (Widget -> IO ()) -> IO (ConnectId self))
-> Signal self (Widget -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> self -> (Widget -> IO ()) -> IO (ConnectId self)
forall a' obj.
(GObjectClass a', GObjectClass obj) =>
String -> Bool -> obj -> (a' -> IO ()) -> IO (ConnectId obj)
connect_OBJECT__NONE String
"remove")

-- %hash c:21a9 d:af3f
-- | Emitted when widgets need to be queried again for their preferred size.
--
checkResize :: ContainerClass self => Signal self (IO ())
checkResize :: forall self. ContainerClass self => Signal self (IO ())
checkResize = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"check-resize")

-- %hash c:b3a d:af3f
-- | A widget in the container received or lost the input focus.
--
setFocusChild :: ContainerClass self => Signal self (Maybe Widget -> IO ())
setFocusChild :: forall self.
ContainerClass self =>
Signal self (Maybe Widget -> IO ())
setFocusChild = (Bool -> self -> (Maybe Widget -> IO ()) -> IO (ConnectId self))
-> Signal self (Maybe Widget -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String
-> Bool -> self -> (Maybe Widget -> IO ()) -> IO (ConnectId self)
forall a' obj.
(GObjectClass a', GObjectClass obj) =>
String -> Bool -> obj -> (Maybe a' -> IO ()) -> IO (ConnectId obj)
connect_MOBJECT__NONE String
"set-focus-child")

--------------------
-- Deprecated Signals

foreign import ccall safe "gtk_container_add"
  gtk_container_add :: ((Ptr Container) -> ((Ptr Widget) -> (IO ())))

foreign import ccall safe "gtk_container_remove"
  gtk_container_remove :: ((Ptr Container) -> ((Ptr Widget) -> (IO ())))

foreign import ccall safe "gtk_container_foreach"
  gtk_container_foreach :: ((Ptr Container) -> ((FunPtr ((Ptr Widget) -> ((Ptr ()) -> (IO ())))) -> ((Ptr ()) -> (IO ()))))

foreign import ccall safe "gtk_container_forall"
  gtk_container_forall :: ((Ptr Container) -> ((FunPtr ((Ptr Widget) -> ((Ptr ()) -> (IO ())))) -> ((Ptr ()) -> (IO ()))))

foreign import ccall safe "gtk_container_get_children"
  gtk_container_get_children :: ((Ptr Container) -> (IO (Ptr ())))

foreign import ccall safe "gtk_container_set_focus_child"
  gtk_container_set_focus_child :: ((Ptr Container) -> ((Ptr Widget) -> (IO ())))

foreign import ccall safe "gtk_container_set_focus_chain"
  gtk_container_set_focus_chain :: ((Ptr Container) -> ((Ptr ()) -> (IO ())))

foreign import ccall safe "gtk_container_get_focus_chain"
  gtk_container_get_focus_chain :: ((Ptr Container) -> ((Ptr (Ptr ())) -> (IO CInt)))

foreign import ccall safe "gtk_container_unset_focus_chain"
  gtk_container_unset_focus_chain :: ((Ptr Container) -> (IO ()))

foreign import ccall safe "gtk_container_set_focus_vadjustment"
  gtk_container_set_focus_vadjustment :: ((Ptr Container) -> ((Ptr Adjustment) -> (IO ())))

foreign import ccall unsafe "gtk_container_get_focus_vadjustment"
  gtk_container_get_focus_vadjustment :: ((Ptr Container) -> (IO (Ptr Adjustment)))

foreign import ccall safe "gtk_container_set_focus_hadjustment"
  gtk_container_set_focus_hadjustment :: ((Ptr Container) -> ((Ptr Adjustment) -> (IO ())))

foreign import ccall unsafe "gtk_container_get_focus_hadjustment"
  gtk_container_get_focus_hadjustment :: ((Ptr Container) -> (IO (Ptr Adjustment)))

foreign import ccall safe "gtk_container_resize_children"
  gtk_container_resize_children :: ((Ptr Container) -> (IO ()))

foreign import ccall safe "gtk_container_set_border_width"
  gtk_container_set_border_width :: ((Ptr Container) -> (CUInt -> (IO ())))

foreign import ccall unsafe "gtk_container_get_border_width"
  gtk_container_get_border_width :: ((Ptr Container) -> (IO CUInt))

foreign import ccall safe "gtk_container_get_resize_mode"
  gtk_container_get_resize_mode :: ((Ptr Container) -> (IO CInt))

foreign import ccall safe "gtk_container_set_resize_mode"
  gtk_container_set_resize_mode :: ((Ptr Container) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_widget_get_type"
  gtk_widget_get_type :: CULong