{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- 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 t'GI.Gtk.Objects.Window.Window'
-- containing a t'GI.Gtk.Objects.Frame.Frame' containing a t'GI.Gtk.Objects.Label.Label'. If you wanted an image instead
-- of a textual label inside the frame, you might replace the t'GI.Gtk.Objects.Label.Label' widget
-- with a t'GI.Gtk.Objects.Image.Image' widget.
-- 
-- There are two major kinds of container widgets in GTK. Both are subclasses
-- of the abstract GtkContainer base class.
-- 
-- The first type of container widget has a single child widget and derives
-- from t'GI.Gtk.Objects.Bin.Bin'. These containers are decorators, which
-- add some kind of functionality to the child. For example, a t'GI.Gtk.Objects.Button.Button' makes
-- its child into a clickable button; a t'GI.Gtk.Objects.Frame.Frame' draws a frame around its child
-- and a t'GI.Gtk.Objects.Window.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 horizontal t'GI.Gtk.Objects.Box.Box' arranges its
-- children in a horizontal row, and a t'GI.Gtk.Objects.Grid.Grid' arranges the widgets it contains
-- in a two-dimensional grid.
-- 
-- For implementations of t'GI.Gtk.Objects.Container.Container' the virtual method t'GI.Gtk.Structs.ContainerClass.ContainerClass'.@/forall/@()
-- is always required, since it\'s used for drawing and other internal operations
-- on the children.
-- If the t'GI.Gtk.Objects.Container.Container' implementation expect to have non internal children
-- it\'s needed to implement both t'GI.Gtk.Structs.ContainerClass.ContainerClass'.@/add/@() and t'GI.Gtk.Structs.ContainerClass.ContainerClass'.@/remove/@().
-- If the GtkContainer implementation has internal children, they should be added
-- with 'GI.Gtk.Objects.Widget.widgetSetParent' on @/init()/@ and removed with 'GI.Gtk.Objects.Widget.widgetUnparent'
-- in the t'GI.Gtk.Structs.WidgetClass.WidgetClass'.@/destroy/@() implementation.
-- 
-- See more about implementing custom widgets at https:\/\/wiki.gnome.org\/HowDoI\/CustomWidgets

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gtk.Objects.Container
    ( 

-- * Exported types
    Container(..)                           ,
    IsContainer                             ,
    toContainer                             ,
    noContainer                             ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveContainerMethod                  ,
#endif


-- ** add #method:add#

#if defined(ENABLE_OVERLOADING)
    ContainerAddMethodInfo                  ,
#endif
    containerAdd                            ,


-- ** childType #method:childType#

#if defined(ENABLE_OVERLOADING)
    ContainerChildTypeMethodInfo            ,
#endif
    containerChildType                      ,


-- ** forall #method:forall#

#if defined(ENABLE_OVERLOADING)
    ContainerForallMethodInfo               ,
#endif
    containerForall                         ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    ContainerForeachMethodInfo              ,
#endif
    containerForeach                        ,


-- ** getChildren #method:getChildren#

#if defined(ENABLE_OVERLOADING)
    ContainerGetChildrenMethodInfo          ,
#endif
    containerGetChildren                    ,


-- ** getFocusHadjustment #method:getFocusHadjustment#

#if defined(ENABLE_OVERLOADING)
    ContainerGetFocusHadjustmentMethodInfo  ,
#endif
    containerGetFocusHadjustment            ,


-- ** getFocusVadjustment #method:getFocusVadjustment#

#if defined(ENABLE_OVERLOADING)
    ContainerGetFocusVadjustmentMethodInfo  ,
#endif
    containerGetFocusVadjustment            ,


-- ** getPathForChild #method:getPathForChild#

#if defined(ENABLE_OVERLOADING)
    ContainerGetPathForChildMethodInfo      ,
#endif
    containerGetPathForChild                ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    ContainerRemoveMethodInfo               ,
#endif
    containerRemove                         ,


-- ** setFocusHadjustment #method:setFocusHadjustment#

#if defined(ENABLE_OVERLOADING)
    ContainerSetFocusHadjustmentMethodInfo  ,
#endif
    containerSetFocusHadjustment            ,


-- ** setFocusVadjustment #method:setFocusVadjustment#

#if defined(ENABLE_OVERLOADING)
    ContainerSetFocusVadjustmentMethodInfo  ,
#endif
    containerSetFocusVadjustment            ,




 -- * Signals
-- ** add #signal:add#

    C_ContainerAddCallback                  ,
    ContainerAddCallback                    ,
#if defined(ENABLE_OVERLOADING)
    ContainerAddSignalInfo                  ,
#endif
    afterContainerAdd                       ,
    genClosure_ContainerAdd                 ,
    mk_ContainerAddCallback                 ,
    noContainerAddCallback                  ,
    onContainerAdd                          ,
    wrap_ContainerAddCallback               ,


-- ** remove #signal:remove#

    C_ContainerRemoveCallback               ,
    ContainerRemoveCallback                 ,
#if defined(ENABLE_OVERLOADING)
    ContainerRemoveSignalInfo               ,
#endif
    afterContainerRemove                    ,
    genClosure_ContainerRemove              ,
    mk_ContainerRemoveCallback              ,
    noContainerRemoveCallback               ,
    onContainerRemove                       ,
    wrap_ContainerRemoveCallback            ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Adjustment as Gtk.Adjustment
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.Gtk.Structs.WidgetPath as Gtk.WidgetPath

-- | Memory-managed wrapper type.
newtype Container = Container (ManagedPtr Container)
    deriving (Container -> Container -> Bool
(Container -> Container -> Bool)
-> (Container -> Container -> Bool) -> Eq Container
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Container -> Container -> Bool
$c/= :: Container -> Container -> Bool
== :: Container -> Container -> Bool
$c== :: Container -> Container -> Bool
Eq)
foreign import ccall "gtk_container_get_type"
    c_gtk_container_get_type :: IO GType

instance GObject Container where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_container_get_type
    

-- | Convert 'Container' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Container where
    toGValue :: Container -> IO GValue
toGValue o :: Container
o = do
        GType
gtype <- IO GType
c_gtk_container_get_type
        Container -> (Ptr Container -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Container
o (GType
-> (GValue -> Ptr Container -> IO ()) -> Ptr Container -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Container -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Container
fromGValue gv :: GValue
gv = do
        Ptr Container
ptr <- GValue -> IO (Ptr Container)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Container)
        (ManagedPtr Container -> Container)
-> Ptr Container -> IO Container
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Container -> Container
Container Ptr Container
ptr
        
    

-- | Type class for types which can be safely cast to `Container`, for instance with `toContainer`.
class (GObject o, O.IsDescendantOf Container o) => IsContainer o
instance (GObject o, O.IsDescendantOf Container o) => IsContainer o

instance O.HasParentTypes Container
type instance O.ParentTypes Container = '[Gtk.Widget.Widget, GObject.Object.Object, Atk.ImplementorIface.ImplementorIface, Gtk.Buildable.Buildable]

-- | Cast to `Container`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toContainer :: (MonadIO m, IsContainer o) => o -> m Container
toContainer :: o -> m Container
toContainer = IO Container -> m Container
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Container -> m Container)
-> (o -> IO Container) -> o -> m Container
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Container -> Container) -> o -> IO Container
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Container -> Container
Container

-- | A convenience alias for `Nothing` :: `Maybe` `Container`.
noContainer :: Maybe Container
noContainer :: Maybe Container
noContainer = Maybe Container
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveContainerMethod (t :: Symbol) (o :: *) :: * where
    ResolveContainerMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveContainerMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveContainerMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveContainerMethod "add" o = ContainerAddMethodInfo
    ResolveContainerMethod "addAccelerator" o = Gtk.Widget.WidgetAddAcceleratorMethodInfo
    ResolveContainerMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveContainerMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveContainerMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveContainerMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveContainerMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveContainerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveContainerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveContainerMethod "canActivateAccel" o = Gtk.Widget.WidgetCanActivateAccelMethodInfo
    ResolveContainerMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveContainerMethod "childType" o = ContainerChildTypeMethodInfo
    ResolveContainerMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveContainerMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveContainerMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveContainerMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveContainerMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveContainerMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveContainerMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveContainerMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveContainerMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveContainerMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveContainerMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveContainerMethod "destroy" o = Gtk.Widget.WidgetDestroyMethodInfo
    ResolveContainerMethod "destroyed" o = Gtk.Widget.WidgetDestroyedMethodInfo
    ResolveContainerMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveContainerMethod "dragBegin" o = Gtk.Widget.WidgetDragBeginMethodInfo
    ResolveContainerMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveContainerMethod "dragDestAddImageTargets" o = Gtk.Widget.WidgetDragDestAddImageTargetsMethodInfo
    ResolveContainerMethod "dragDestAddTextTargets" o = Gtk.Widget.WidgetDragDestAddTextTargetsMethodInfo
    ResolveContainerMethod "dragDestAddUriTargets" o = Gtk.Widget.WidgetDragDestAddUriTargetsMethodInfo
    ResolveContainerMethod "dragDestFindTarget" o = Gtk.Widget.WidgetDragDestFindTargetMethodInfo
    ResolveContainerMethod "dragDestGetTargetList" o = Gtk.Widget.WidgetDragDestGetTargetListMethodInfo
    ResolveContainerMethod "dragDestGetTrackMotion" o = Gtk.Widget.WidgetDragDestGetTrackMotionMethodInfo
    ResolveContainerMethod "dragDestSet" o = Gtk.Widget.WidgetDragDestSetMethodInfo
    ResolveContainerMethod "dragDestSetTargetList" o = Gtk.Widget.WidgetDragDestSetTargetListMethodInfo
    ResolveContainerMethod "dragDestSetTrackMotion" o = Gtk.Widget.WidgetDragDestSetTrackMotionMethodInfo
    ResolveContainerMethod "dragDestUnset" o = Gtk.Widget.WidgetDragDestUnsetMethodInfo
    ResolveContainerMethod "dragGetData" o = Gtk.Widget.WidgetDragGetDataMethodInfo
    ResolveContainerMethod "dragHighlight" o = Gtk.Widget.WidgetDragHighlightMethodInfo
    ResolveContainerMethod "dragSourceAddImageTargets" o = Gtk.Widget.WidgetDragSourceAddImageTargetsMethodInfo
    ResolveContainerMethod "dragSourceAddTextTargets" o = Gtk.Widget.WidgetDragSourceAddTextTargetsMethodInfo
    ResolveContainerMethod "dragSourceAddUriTargets" o = Gtk.Widget.WidgetDragSourceAddUriTargetsMethodInfo
    ResolveContainerMethod "dragSourceGetTargetList" o = Gtk.Widget.WidgetDragSourceGetTargetListMethodInfo
    ResolveContainerMethod "dragSourceSet" o = Gtk.Widget.WidgetDragSourceSetMethodInfo
    ResolveContainerMethod "dragSourceSetIconGicon" o = Gtk.Widget.WidgetDragSourceSetIconGiconMethodInfo
    ResolveContainerMethod "dragSourceSetIconName" o = Gtk.Widget.WidgetDragSourceSetIconNameMethodInfo
    ResolveContainerMethod "dragSourceSetIconPaintable" o = Gtk.Widget.WidgetDragSourceSetIconPaintableMethodInfo
    ResolveContainerMethod "dragSourceSetTargetList" o = Gtk.Widget.WidgetDragSourceSetTargetListMethodInfo
    ResolveContainerMethod "dragSourceUnset" o = Gtk.Widget.WidgetDragSourceUnsetMethodInfo
    ResolveContainerMethod "dragUnhighlight" o = Gtk.Widget.WidgetDragUnhighlightMethodInfo
    ResolveContainerMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveContainerMethod "event" o = Gtk.Widget.WidgetEventMethodInfo
    ResolveContainerMethod "forall" o = ContainerForallMethodInfo
    ResolveContainerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveContainerMethod "foreach" o = ContainerForeachMethodInfo
    ResolveContainerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveContainerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveContainerMethod "grabAdd" o = Gtk.Widget.WidgetGrabAddMethodInfo
    ResolveContainerMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveContainerMethod "grabRemove" o = Gtk.Widget.WidgetGrabRemoveMethodInfo
    ResolveContainerMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveContainerMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveContainerMethod "hasGrab" o = Gtk.Widget.WidgetHasGrabMethodInfo
    ResolveContainerMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveContainerMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveContainerMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveContainerMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveContainerMethod "inputShapeCombineRegion" o = Gtk.Widget.WidgetInputShapeCombineRegionMethodInfo
    ResolveContainerMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveContainerMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveContainerMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveContainerMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveContainerMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveContainerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveContainerMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveContainerMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveContainerMethod "isToplevel" o = Gtk.Widget.WidgetIsToplevelMethodInfo
    ResolveContainerMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveContainerMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveContainerMethod "listAccelClosures" o = Gtk.Widget.WidgetListAccelClosuresMethodInfo
    ResolveContainerMethod "listActionPrefixes" o = Gtk.Widget.WidgetListActionPrefixesMethodInfo
    ResolveContainerMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveContainerMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveContainerMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveContainerMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveContainerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveContainerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveContainerMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveContainerMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveContainerMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveContainerMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveContainerMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveContainerMethod "queueComputeExpand" o = Gtk.Widget.WidgetQueueComputeExpandMethodInfo
    ResolveContainerMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveContainerMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveContainerMethod "queueResizeNoRedraw" o = Gtk.Widget.WidgetQueueResizeNoRedrawMethodInfo
    ResolveContainerMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveContainerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveContainerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveContainerMethod "registerSurface" o = Gtk.Widget.WidgetRegisterSurfaceMethodInfo
    ResolveContainerMethod "remove" o = ContainerRemoveMethodInfo
    ResolveContainerMethod "removeAccelerator" o = Gtk.Widget.WidgetRemoveAcceleratorMethodInfo
    ResolveContainerMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveContainerMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveContainerMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveContainerMethod "resetStyle" o = Gtk.Widget.WidgetResetStyleMethodInfo
    ResolveContainerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveContainerMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveContainerMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveContainerMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveContainerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveContainerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveContainerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveContainerMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveContainerMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveContainerMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveContainerMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveContainerMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveContainerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveContainerMethod "unregisterSurface" o = Gtk.Widget.WidgetUnregisterSurfaceMethodInfo
    ResolveContainerMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveContainerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveContainerMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveContainerMethod "getActionGroup" o = Gtk.Widget.WidgetGetActionGroupMethodInfo
    ResolveContainerMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveContainerMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveContainerMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveContainerMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveContainerMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveContainerMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveContainerMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveContainerMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveContainerMethod "getChildren" o = ContainerGetChildrenMethodInfo
    ResolveContainerMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveContainerMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveContainerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveContainerMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveContainerMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveContainerMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveContainerMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveContainerMethod "getFocusHadjustment" o = ContainerGetFocusHadjustmentMethodInfo
    ResolveContainerMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveContainerMethod "getFocusVadjustment" o = ContainerGetFocusVadjustmentMethodInfo
    ResolveContainerMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveContainerMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveContainerMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveContainerMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveContainerMethod "getHasSurface" o = Gtk.Widget.WidgetGetHasSurfaceMethodInfo
    ResolveContainerMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveContainerMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveContainerMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveContainerMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveContainerMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveContainerMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveContainerMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveContainerMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveContainerMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveContainerMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveContainerMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveContainerMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveContainerMethod "getModifierMask" o = Gtk.Widget.WidgetGetModifierMaskMethodInfo
    ResolveContainerMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveContainerMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveContainerMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveContainerMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveContainerMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveContainerMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveContainerMethod "getPath" o = Gtk.Widget.WidgetGetPathMethodInfo
    ResolveContainerMethod "getPathForChild" o = ContainerGetPathForChildMethodInfo
    ResolveContainerMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveContainerMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveContainerMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveContainerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveContainerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveContainerMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveContainerMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveContainerMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveContainerMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveContainerMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveContainerMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveContainerMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveContainerMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveContainerMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveContainerMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveContainerMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveContainerMethod "getSurface" o = Gtk.Widget.WidgetGetSurfaceMethodInfo
    ResolveContainerMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveContainerMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveContainerMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveContainerMethod "getTooltipWindow" o = Gtk.Widget.WidgetGetTooltipWindowMethodInfo
    ResolveContainerMethod "getToplevel" o = Gtk.Widget.WidgetGetToplevelMethodInfo
    ResolveContainerMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveContainerMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveContainerMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveContainerMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveContainerMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveContainerMethod "setAccelPath" o = Gtk.Widget.WidgetSetAccelPathMethodInfo
    ResolveContainerMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveContainerMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveContainerMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveContainerMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveContainerMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveContainerMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveContainerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveContainerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveContainerMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveContainerMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveContainerMethod "setFocusHadjustment" o = ContainerSetFocusHadjustmentMethodInfo
    ResolveContainerMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveContainerMethod "setFocusVadjustment" o = ContainerSetFocusVadjustmentMethodInfo
    ResolveContainerMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveContainerMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveContainerMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveContainerMethod "setHasSurface" o = Gtk.Widget.WidgetSetHasSurfaceMethodInfo
    ResolveContainerMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveContainerMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveContainerMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveContainerMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveContainerMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveContainerMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveContainerMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveContainerMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveContainerMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveContainerMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveContainerMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveContainerMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveContainerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveContainerMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveContainerMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveContainerMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveContainerMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveContainerMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveContainerMethod "setSurface" o = Gtk.Widget.WidgetSetSurfaceMethodInfo
    ResolveContainerMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveContainerMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveContainerMethod "setTooltipWindow" o = Gtk.Widget.WidgetSetTooltipWindowMethodInfo
    ResolveContainerMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveContainerMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveContainerMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveContainerMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveContainerMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveContainerMethod t Container, O.MethodInfo info Container p) => OL.IsLabel t (Container -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- signal Container::add
-- | /No description available in the introspection data./
type ContainerAddCallback =
    Gtk.Widget.Widget
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ContainerAddCallback`@.
noContainerAddCallback :: Maybe ContainerAddCallback
noContainerAddCallback :: Maybe ContainerAddCallback
noContainerAddCallback = Maybe ContainerAddCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ContainerAddCallback =
    Ptr () ->                               -- object
    Ptr Gtk.Widget.Widget ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ContainerAddCallback`.
foreign import ccall "wrapper"
    mk_ContainerAddCallback :: C_ContainerAddCallback -> IO (FunPtr C_ContainerAddCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_ContainerAdd :: MonadIO m => ContainerAddCallback -> m (GClosure C_ContainerAddCallback)
genClosure_ContainerAdd :: ContainerAddCallback -> m (GClosure C_ContainerAddCallback)
genClosure_ContainerAdd cb :: ContainerAddCallback
cb = IO (GClosure C_ContainerAddCallback)
-> m (GClosure C_ContainerAddCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ContainerAddCallback)
 -> m (GClosure C_ContainerAddCallback))
-> IO (GClosure C_ContainerAddCallback)
-> m (GClosure C_ContainerAddCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ContainerAddCallback
cb' = ContainerAddCallback -> C_ContainerAddCallback
wrap_ContainerAddCallback ContainerAddCallback
cb
    C_ContainerAddCallback -> IO (FunPtr C_ContainerAddCallback)
mk_ContainerAddCallback C_ContainerAddCallback
cb' IO (FunPtr C_ContainerAddCallback)
-> (FunPtr C_ContainerAddCallback
    -> IO (GClosure C_ContainerAddCallback))
-> IO (GClosure C_ContainerAddCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ContainerAddCallback
-> IO (GClosure C_ContainerAddCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ContainerAddCallback` into a `C_ContainerAddCallback`.
wrap_ContainerAddCallback ::
    ContainerAddCallback ->
    C_ContainerAddCallback
wrap_ContainerAddCallback :: ContainerAddCallback -> C_ContainerAddCallback
wrap_ContainerAddCallback _cb :: ContainerAddCallback
_cb _ object :: Ptr Widget
object _ = do
    Widget
object' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
object
    ContainerAddCallback
_cb  Widget
object'


-- | Connect a signal handler for the [add](#signal:add) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' container #add callback
-- @
-- 
-- 
onContainerAdd :: (IsContainer a, MonadIO m) => a -> ContainerAddCallback -> m SignalHandlerId
onContainerAdd :: a -> ContainerAddCallback -> m SignalHandlerId
onContainerAdd obj :: a
obj cb :: ContainerAddCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ContainerAddCallback
cb' = ContainerAddCallback -> C_ContainerAddCallback
wrap_ContainerAddCallback ContainerAddCallback
cb
    FunPtr C_ContainerAddCallback
cb'' <- C_ContainerAddCallback -> IO (FunPtr C_ContainerAddCallback)
mk_ContainerAddCallback C_ContainerAddCallback
cb'
    a
-> Text
-> FunPtr C_ContainerAddCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "add" FunPtr C_ContainerAddCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [add](#signal:add) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' container #add callback
-- @
-- 
-- 
afterContainerAdd :: (IsContainer a, MonadIO m) => a -> ContainerAddCallback -> m SignalHandlerId
afterContainerAdd :: a -> ContainerAddCallback -> m SignalHandlerId
afterContainerAdd obj :: a
obj cb :: ContainerAddCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ContainerAddCallback
cb' = ContainerAddCallback -> C_ContainerAddCallback
wrap_ContainerAddCallback ContainerAddCallback
cb
    FunPtr C_ContainerAddCallback
cb'' <- C_ContainerAddCallback -> IO (FunPtr C_ContainerAddCallback)
mk_ContainerAddCallback C_ContainerAddCallback
cb'
    a
-> Text
-> FunPtr C_ContainerAddCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "add" FunPtr C_ContainerAddCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ContainerAddSignalInfo
instance SignalInfo ContainerAddSignalInfo where
    type HaskellCallbackType ContainerAddSignalInfo = ContainerAddCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ContainerAddCallback cb
        cb'' <- mk_ContainerAddCallback cb'
        connectSignalFunPtr obj "add" cb'' connectMode detail

#endif

-- signal Container::remove
-- | /No description available in the introspection data./
type ContainerRemoveCallback =
    Gtk.Widget.Widget
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ContainerRemoveCallback`@.
noContainerRemoveCallback :: Maybe ContainerRemoveCallback
noContainerRemoveCallback :: Maybe ContainerAddCallback
noContainerRemoveCallback = Maybe ContainerAddCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ContainerRemoveCallback =
    Ptr () ->                               -- object
    Ptr Gtk.Widget.Widget ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ContainerRemoveCallback`.
foreign import ccall "wrapper"
    mk_ContainerRemoveCallback :: C_ContainerRemoveCallback -> IO (FunPtr C_ContainerRemoveCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_ContainerRemove :: MonadIO m => ContainerRemoveCallback -> m (GClosure C_ContainerRemoveCallback)
genClosure_ContainerRemove :: ContainerAddCallback -> m (GClosure C_ContainerAddCallback)
genClosure_ContainerRemove cb :: ContainerAddCallback
cb = IO (GClosure C_ContainerAddCallback)
-> m (GClosure C_ContainerAddCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ContainerAddCallback)
 -> m (GClosure C_ContainerAddCallback))
-> IO (GClosure C_ContainerAddCallback)
-> m (GClosure C_ContainerAddCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ContainerAddCallback
cb' = ContainerAddCallback -> C_ContainerAddCallback
wrap_ContainerRemoveCallback ContainerAddCallback
cb
    C_ContainerAddCallback -> IO (FunPtr C_ContainerAddCallback)
mk_ContainerRemoveCallback C_ContainerAddCallback
cb' IO (FunPtr C_ContainerAddCallback)
-> (FunPtr C_ContainerAddCallback
    -> IO (GClosure C_ContainerAddCallback))
-> IO (GClosure C_ContainerAddCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ContainerAddCallback
-> IO (GClosure C_ContainerAddCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ContainerRemoveCallback` into a `C_ContainerRemoveCallback`.
wrap_ContainerRemoveCallback ::
    ContainerRemoveCallback ->
    C_ContainerRemoveCallback
wrap_ContainerRemoveCallback :: ContainerAddCallback -> C_ContainerAddCallback
wrap_ContainerRemoveCallback _cb :: ContainerAddCallback
_cb _ object :: Ptr Widget
object _ = do
    Widget
object' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
object
    ContainerAddCallback
_cb  Widget
object'


-- | Connect a signal handler for the [remove](#signal:remove) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' container #remove callback
-- @
-- 
-- 
onContainerRemove :: (IsContainer a, MonadIO m) => a -> ContainerRemoveCallback -> m SignalHandlerId
onContainerRemove :: a -> ContainerAddCallback -> m SignalHandlerId
onContainerRemove obj :: a
obj cb :: ContainerAddCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ContainerAddCallback
cb' = ContainerAddCallback -> C_ContainerAddCallback
wrap_ContainerRemoveCallback ContainerAddCallback
cb
    FunPtr C_ContainerAddCallback
cb'' <- C_ContainerAddCallback -> IO (FunPtr C_ContainerAddCallback)
mk_ContainerRemoveCallback C_ContainerAddCallback
cb'
    a
-> Text
-> FunPtr C_ContainerAddCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "remove" FunPtr C_ContainerAddCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [remove](#signal:remove) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' container #remove callback
-- @
-- 
-- 
afterContainerRemove :: (IsContainer a, MonadIO m) => a -> ContainerRemoveCallback -> m SignalHandlerId
afterContainerRemove :: a -> ContainerAddCallback -> m SignalHandlerId
afterContainerRemove obj :: a
obj cb :: ContainerAddCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ContainerAddCallback
cb' = ContainerAddCallback -> C_ContainerAddCallback
wrap_ContainerRemoveCallback ContainerAddCallback
cb
    FunPtr C_ContainerAddCallback
cb'' <- C_ContainerAddCallback -> IO (FunPtr C_ContainerAddCallback)
mk_ContainerRemoveCallback C_ContainerAddCallback
cb'
    a
-> Text
-> FunPtr C_ContainerAddCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "remove" FunPtr C_ContainerAddCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ContainerRemoveSignalInfo
instance SignalInfo ContainerRemoveSignalInfo where
    type HaskellCallbackType ContainerRemoveSignalInfo = ContainerRemoveCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ContainerRemoveCallback cb
        cb'' <- mk_ContainerRemoveCallback cb'
        connectSignalFunPtr obj "remove" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Container
type instance O.AttributeList Container = ContainerAttributeList
type ContainerAttributeList = ('[ '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("expand", Gtk.Widget.WidgetExpandPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("isFocus", Gtk.Widget.WidgetIsFocusPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("margin", Gtk.Widget.WidgetMarginPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("surface", Gtk.Widget.WidgetSurfacePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Container = ContainerSignalList
type ContainerSignalList = ('[ '("accelClosuresChanged", Gtk.Widget.WidgetAccelClosuresChangedSignalInfo), '("add", ContainerAddSignalInfo), '("canActivateAccel", Gtk.Widget.WidgetCanActivateAccelSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("dragBegin", Gtk.Widget.WidgetDragBeginSignalInfo), '("dragDataDelete", Gtk.Widget.WidgetDragDataDeleteSignalInfo), '("dragDataGet", Gtk.Widget.WidgetDragDataGetSignalInfo), '("dragDataReceived", Gtk.Widget.WidgetDragDataReceivedSignalInfo), '("dragDrop", Gtk.Widget.WidgetDragDropSignalInfo), '("dragEnd", Gtk.Widget.WidgetDragEndSignalInfo), '("dragFailed", Gtk.Widget.WidgetDragFailedSignalInfo), '("dragLeave", Gtk.Widget.WidgetDragLeaveSignalInfo), '("dragMotion", Gtk.Widget.WidgetDragMotionSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("popupMenu", Gtk.Widget.WidgetPopupMenuSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("remove", ContainerRemoveSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("sizeAllocate", Gtk.Widget.WidgetSizeAllocateSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("styleUpdated", Gtk.Widget.WidgetStyleUpdatedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

-- method Container::add
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a widget to be placed inside @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_add" gtk_container_add :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Adds /@widget@/ to /@container@/. Typically used for simple containers
-- such as t'GI.Gtk.Objects.Window.Window', t'GI.Gtk.Objects.Frame.Frame', or t'GI.Gtk.Objects.Button.Button'; for more complicated
-- layout containers such t'GI.Gtk.Objects.Grid.Grid', this function will
-- pick default packing parameters that may not be correct.  So
-- consider functions such as 'GI.Gtk.Objects.Grid.gridAttach' as an alternative
-- to 'GI.Gtk.Objects.Container.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.
-- 
-- Note that some containers, such as t'GI.Gtk.Objects.ScrolledWindow.ScrolledWindow' or t'GI.Gtk.Objects.ListBox.ListBox',
-- may add intermediate children between the added widget and the
-- container.
containerAdd ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> b
    -- ^ /@widget@/: a widget to be placed inside /@container@/
    -> m ()
containerAdd :: a -> b -> m ()
containerAdd container :: a
container widget :: b
widget = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    Ptr Container -> Ptr Widget -> IO ()
gtk_container_add Ptr Container
container' Ptr Widget
widget'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerAddMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContainer a, Gtk.Widget.IsWidget b) => O.MethodInfo ContainerAddMethodInfo a signature where
    overloadedMethod = containerAdd

#endif

-- method Container::child_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_child_type" gtk_container_child_type :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    IO CGType

-- | Returns the type of the children supported by the container.
-- 
-- Note that this may return @/G_TYPE_NONE/@ to indicate that no more
-- children can be added, e.g. for a t'GI.Gtk.Objects.Paned.Paned' which already has two
-- children.
containerChildType ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> m GType
    -- ^ __Returns:__ a t'GType'
containerChildType :: a -> m GType
containerChildType container :: a
container = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CGType
result <- Ptr Container -> IO CGType
gtk_container_child_type Ptr Container
container'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data ContainerChildTypeMethodInfo
instance (signature ~ (m GType), MonadIO m, IsContainer a) => O.MethodInfo ContainerChildTypeMethodInfo a signature where
    overloadedMethod = containerChildType

#endif

-- method Container::forall
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback user data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_forall" gtk_container_forall :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    FunPtr Gtk.Callbacks.C_Callback ->      -- callback : TInterface (Name {namespace = "Gtk", name = "Callback"})
    Ptr () ->                               -- callback_data : TBasicType TPtr
    IO ()

-- | Invokes /@callback@/ on each direct 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 'GI.Gtk.Objects.Container.containerForeach', rather
-- than 'GI.Gtk.Objects.Container.containerForall'.
containerForall ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> Gtk.Callbacks.Callback
    -- ^ /@callback@/: a callback
    -> m ()
containerForall :: a -> ContainerAddCallback -> m ()
containerForall container :: a
container callback :: ContainerAddCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    FunPtr C_Callback
callback' <- C_Callback -> IO (FunPtr C_Callback)
Gtk.Callbacks.mk_Callback (Maybe (Ptr (FunPtr C_Callback))
-> Callback_WithClosures -> C_Callback
Gtk.Callbacks.wrap_Callback Maybe (Ptr (FunPtr C_Callback))
forall a. Maybe a
Nothing (ContainerAddCallback -> Callback_WithClosures
Gtk.Callbacks.drop_closures_Callback ContainerAddCallback
callback))
    let callbackData :: Ptr a
callbackData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Container -> FunPtr C_Callback -> Ptr () -> IO ()
gtk_container_forall Ptr Container
container' FunPtr C_Callback
callback' Ptr ()
forall a. Ptr a
callbackData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_Callback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_Callback
callback'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerForallMethodInfo
instance (signature ~ (Gtk.Callbacks.Callback -> m ()), MonadIO m, IsContainer a) => O.MethodInfo ContainerForallMethodInfo a signature where
    overloadedMethod = containerForall

#endif

-- method Container::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback user data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_foreach" gtk_container_foreach :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    FunPtr Gtk.Callbacks.C_Callback ->      -- callback : TInterface (Name {namespace = "Gtk", name = "Callback"})
    Ptr () ->                               -- callback_data : TBasicType TPtr
    IO ()

-- | Invokes /@callback@/ on each non-internal child of /@container@/.
-- See 'GI.Gtk.Objects.Container.containerForall' for details on what constitutes
-- an “internal” child. For all practical purposes, this function
-- should iterate over precisely those child widgets that were
-- added to the container by the application with explicit @/add()/@
-- calls.
-- 
-- It is permissible to remove the child from the /@callback@/ handler.
-- 
-- Most applications should use 'GI.Gtk.Objects.Container.containerForeach',
-- rather than 'GI.Gtk.Objects.Container.containerForall'.
containerForeach ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> Gtk.Callbacks.Callback
    -- ^ /@callback@/: a callback
    -> m ()
containerForeach :: a -> ContainerAddCallback -> m ()
containerForeach container :: a
container callback :: ContainerAddCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    FunPtr C_Callback
callback' <- C_Callback -> IO (FunPtr C_Callback)
Gtk.Callbacks.mk_Callback (Maybe (Ptr (FunPtr C_Callback))
-> Callback_WithClosures -> C_Callback
Gtk.Callbacks.wrap_Callback Maybe (Ptr (FunPtr C_Callback))
forall a. Maybe a
Nothing (ContainerAddCallback -> Callback_WithClosures
Gtk.Callbacks.drop_closures_Callback ContainerAddCallback
callback))
    let callbackData :: Ptr a
callbackData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Container -> FunPtr C_Callback -> Ptr () -> IO ()
gtk_container_foreach Ptr Container
container' FunPtr C_Callback
callback' Ptr ()
forall a. Ptr a
callbackData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_Callback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_Callback
callback'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerForeachMethodInfo
instance (signature ~ (Gtk.Callbacks.Callback -> m ()), MonadIO m, IsContainer a) => O.MethodInfo ContainerForeachMethodInfo a signature where
    overloadedMethod = containerForeach

#endif

-- method Container::get_children
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Gtk" , name = "Widget" }))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_get_children" gtk_container_get_children :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    IO (Ptr (GList (Ptr Gtk.Widget.Widget)))

-- | Returns the container’s non-internal children. See
-- 'GI.Gtk.Objects.Container.containerForall' for details on what constitutes an \"internal\" child.
containerGetChildren ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> m [Gtk.Widget.Widget]
    -- ^ __Returns:__ a newly-allocated list of the container’s non-internal children.
containerGetChildren :: a -> m [Widget]
containerGetChildren container :: a
container = IO [Widget] -> m [Widget]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Widget] -> m [Widget]) -> IO [Widget] -> m [Widget]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr (GList (Ptr Widget))
result <- Ptr Container -> IO (Ptr (GList (Ptr Widget)))
gtk_container_get_children Ptr Container
container'
    [Ptr Widget]
result' <- Ptr (GList (Ptr Widget)) -> IO [Ptr Widget]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Widget))
result
    [Widget]
result'' <- (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)
mapM ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) [Ptr Widget]
result'
    Ptr (GList (Ptr Widget)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Widget))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    [Widget] -> IO [Widget]
forall (m :: * -> *) a. Monad m => a -> m a
return [Widget]
result''

#if defined(ENABLE_OVERLOADING)
data ContainerGetChildrenMethodInfo
instance (signature ~ (m [Gtk.Widget.Widget]), MonadIO m, IsContainer a) => O.MethodInfo ContainerGetChildrenMethodInfo a signature where
    overloadedMethod = containerGetChildren

#endif

-- method Container::get_focus_hadjustment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Adjustment" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_get_focus_hadjustment" gtk_container_get_focus_hadjustment :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    IO (Ptr Gtk.Adjustment.Adjustment)

-- | Retrieves the horizontal focus adjustment for the container. See
-- gtk_container_set_focus_hadjustment ().
containerGetFocusHadjustment ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> m (Maybe Gtk.Adjustment.Adjustment)
    -- ^ __Returns:__ the horizontal focus adjustment, or 'P.Nothing' if
    --   none has been set.
containerGetFocusHadjustment :: a -> m (Maybe Adjustment)
containerGetFocusHadjustment container :: a
container = IO (Maybe Adjustment) -> m (Maybe Adjustment)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Adjustment) -> m (Maybe Adjustment))
-> IO (Maybe Adjustment) -> m (Maybe Adjustment)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Adjustment
result <- Ptr Container -> IO (Ptr Adjustment)
gtk_container_get_focus_hadjustment Ptr Container
container'
    Maybe Adjustment
maybeResult <- Ptr Adjustment
-> (Ptr Adjustment -> IO Adjustment) -> IO (Maybe Adjustment)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Adjustment
result ((Ptr Adjustment -> IO Adjustment) -> IO (Maybe Adjustment))
-> (Ptr Adjustment -> IO Adjustment) -> IO (Maybe Adjustment)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Adjustment
result' -> do
        Adjustment
result'' <- ((ManagedPtr Adjustment -> Adjustment)
-> Ptr Adjustment -> IO Adjustment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Adjustment -> Adjustment
Gtk.Adjustment.Adjustment) Ptr Adjustment
result'
        Adjustment -> IO Adjustment
forall (m :: * -> *) a. Monad m => a -> m a
return Adjustment
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    Maybe Adjustment -> IO (Maybe Adjustment)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Adjustment
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContainerGetFocusHadjustmentMethodInfo
instance (signature ~ (m (Maybe Gtk.Adjustment.Adjustment)), MonadIO m, IsContainer a) => O.MethodInfo ContainerGetFocusHadjustmentMethodInfo a signature where
    overloadedMethod = containerGetFocusHadjustment

#endif

-- method Container::get_focus_vadjustment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Adjustment" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_get_focus_vadjustment" gtk_container_get_focus_vadjustment :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    IO (Ptr Gtk.Adjustment.Adjustment)

-- | Retrieves the vertical focus adjustment for the container. See
-- 'GI.Gtk.Objects.Container.containerSetFocusVadjustment'.
containerGetFocusVadjustment ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> m (Maybe Gtk.Adjustment.Adjustment)
    -- ^ __Returns:__ the vertical focus adjustment, or
    --   'P.Nothing' if none has been set.
containerGetFocusVadjustment :: a -> m (Maybe Adjustment)
containerGetFocusVadjustment container :: a
container = IO (Maybe Adjustment) -> m (Maybe Adjustment)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Adjustment) -> m (Maybe Adjustment))
-> IO (Maybe Adjustment) -> m (Maybe Adjustment)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Adjustment
result <- Ptr Container -> IO (Ptr Adjustment)
gtk_container_get_focus_vadjustment Ptr Container
container'
    Maybe Adjustment
maybeResult <- Ptr Adjustment
-> (Ptr Adjustment -> IO Adjustment) -> IO (Maybe Adjustment)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Adjustment
result ((Ptr Adjustment -> IO Adjustment) -> IO (Maybe Adjustment))
-> (Ptr Adjustment -> IO Adjustment) -> IO (Maybe Adjustment)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Adjustment
result' -> do
        Adjustment
result'' <- ((ManagedPtr Adjustment -> Adjustment)
-> Ptr Adjustment -> IO Adjustment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Adjustment -> Adjustment
Gtk.Adjustment.Adjustment) Ptr Adjustment
result'
        Adjustment -> IO Adjustment
forall (m :: * -> *) a. Monad m => a -> m a
return Adjustment
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    Maybe Adjustment -> IO (Maybe Adjustment)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Adjustment
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContainerGetFocusVadjustmentMethodInfo
instance (signature ~ (m (Maybe Gtk.Adjustment.Adjustment)), MonadIO m, IsContainer a) => O.MethodInfo ContainerGetFocusVadjustmentMethodInfo a signature where
    overloadedMethod = containerGetFocusVadjustment

#endif

-- method Container::get_path_for_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a child of @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "WidgetPath" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_get_path_for_child" gtk_container_get_path_for_child :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO (Ptr Gtk.WidgetPath.WidgetPath)

-- | Returns a newly created widget path representing all the widget hierarchy
-- from the toplevel down to and including /@child@/.
containerGetPathForChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> b
    -- ^ /@child@/: a child of /@container@/
    -> m Gtk.WidgetPath.WidgetPath
    -- ^ __Returns:__ A newly created t'GI.Gtk.Structs.WidgetPath.WidgetPath'
containerGetPathForChild :: a -> b -> m WidgetPath
containerGetPathForChild container :: a
container child :: b
child = IO WidgetPath -> m WidgetPath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WidgetPath -> m WidgetPath) -> IO WidgetPath -> m WidgetPath
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr WidgetPath
result <- Ptr Container -> Ptr Widget -> IO (Ptr WidgetPath)
gtk_container_get_path_for_child Ptr Container
container' Ptr Widget
child'
    Text -> Ptr WidgetPath -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "containerGetPathForChild" Ptr WidgetPath
result
    WidgetPath
result' <- ((ManagedPtr WidgetPath -> WidgetPath)
-> Ptr WidgetPath -> IO WidgetPath
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr WidgetPath -> WidgetPath
Gtk.WidgetPath.WidgetPath) Ptr WidgetPath
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    WidgetPath -> IO WidgetPath
forall (m :: * -> *) a. Monad m => a -> m a
return WidgetPath
result'

#if defined(ENABLE_OVERLOADING)
data ContainerGetPathForChildMethodInfo
instance (signature ~ (b -> m Gtk.WidgetPath.WidgetPath), MonadIO m, IsContainer a, Gtk.Widget.IsWidget b) => O.MethodInfo ContainerGetPathForChildMethodInfo a signature where
    overloadedMethod = containerGetPathForChild

#endif

-- method Container::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a current child of @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_remove" gtk_container_remove :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Removes /@widget@/ from /@container@/. /@widget@/ must be inside /@container@/.
-- Note that /@container@/ will own a reference to /@widget@/, and that this
-- may be the last reference held; so removing a widget from its
-- container can destroy that widget. If you want to use /@widget@/
-- again, you need to add a reference to it before removing it from
-- a container, using 'GI.GObject.Objects.Object.objectRef'. If you don’t want to use /@widget@/
-- again it’s usually more efficient to simply destroy it directly
-- using 'GI.Gtk.Objects.Widget.widgetDestroy' since this will remove it from the
-- container and help break any circular reference count cycles.
containerRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> b
    -- ^ /@widget@/: a current child of /@container@/
    -> m ()
containerRemove :: a -> b -> m ()
containerRemove container :: a
container widget :: b
widget = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    Ptr Container -> Ptr Widget -> IO ()
gtk_container_remove Ptr Container
container' Ptr Widget
widget'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerRemoveMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContainer a, Gtk.Widget.IsWidget b) => O.MethodInfo ContainerRemoveMethodInfo a signature where
    overloadedMethod = containerRemove

#endif

-- method Container::set_focus_hadjustment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an adjustment which should be adjusted when the focus is\n  moved among the descendents of @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_set_focus_hadjustment" gtk_container_set_focus_hadjustment :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    Ptr Gtk.Adjustment.Adjustment ->        -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO ()

-- | 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 'GI.Gtk.Objects.ScrolledWindow.scrolledWindowGetHadjustment' for a typical way of obtaining
-- the adjustment and 'GI.Gtk.Objects.Container.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 ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Gtk.Adjustment.IsAdjustment b) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> b
    -- ^ /@adjustment@/: an adjustment which should be adjusted when the focus is
    --   moved among the descendents of /@container@/
    -> m ()
containerSetFocusHadjustment :: a -> b -> m ()
containerSetFocusHadjustment container :: a
container adjustment :: b
adjustment = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Adjustment
adjustment' <- b -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
adjustment
    Ptr Container -> Ptr Adjustment -> IO ()
gtk_container_set_focus_hadjustment Ptr Container
container' Ptr Adjustment
adjustment'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerSetFocusHadjustmentMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContainer a, Gtk.Adjustment.IsAdjustment b) => O.MethodInfo ContainerSetFocusHadjustmentMethodInfo a signature where
    overloadedMethod = containerSetFocusHadjustment

#endif

-- method Container::set_focus_vadjustment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkContainer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an adjustment which should be adjusted when the focus\n  is moved among the descendents of @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_set_focus_vadjustment" gtk_container_set_focus_vadjustment :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    Ptr Gtk.Adjustment.Adjustment ->        -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO ()

-- | 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
-- 'GI.Gtk.Objects.ScrolledWindow.scrolledWindowGetVadjustment' for a typical way of obtaining
-- the adjustment and 'GI.Gtk.Objects.Container.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 ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Gtk.Adjustment.IsAdjustment b) =>
    a
    -- ^ /@container@/: a t'GI.Gtk.Objects.Container.Container'
    -> b
    -- ^ /@adjustment@/: an adjustment which should be adjusted when the focus
    --   is moved among the descendents of /@container@/
    -> m ()
containerSetFocusVadjustment :: a -> b -> m ()
containerSetFocusVadjustment container :: a
container adjustment :: b
adjustment = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Adjustment
adjustment' <- b -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
adjustment
    Ptr Container -> Ptr Adjustment -> IO ()
gtk_container_set_focus_vadjustment Ptr Container
container' Ptr Adjustment
adjustment'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerSetFocusVadjustmentMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContainer a, Gtk.Adjustment.IsAdjustment b) => O.MethodInfo ContainerSetFocusVadjustmentMethodInfo a signature where
    overloadedMethod = containerSetFocusVadjustment

#endif