{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Layout managers are delegate classes that handle the preferred size
-- and the allocation of a container widget.
-- 
-- You typically subclass t'GI.Gtk.Objects.LayoutManager.LayoutManager' if you want to implement a
-- layout policy for the children of a widget, or if you want to determine
-- the size of a widget depending on its contents.
-- 
-- Each t'GI.Gtk.Objects.Widget.Widget' can only have a t'GI.Gtk.Objects.LayoutManager.LayoutManager' instance associated to it
-- at any given time; it is possible, though, to replace the layout manager
-- instance using 'GI.Gtk.Objects.Widget.widgetSetLayoutManager'.
-- 
-- == Layout properties
-- 
-- A layout manager can expose properties for controlling the layout of
-- each child, by creating an object type derived from t'GI.Gtk.Objects.LayoutChild.LayoutChild'
-- and installing the properties on it as normal GObject properties.
-- 
-- Each t'GI.Gtk.Objects.LayoutChild.LayoutChild' instance storing the layout properties for a
-- specific child is created through the 'GI.Gtk.Objects.LayoutManager.layoutManagerGetLayoutChild'
-- method; a t'GI.Gtk.Objects.LayoutManager.LayoutManager' controls the creation of its t'GI.Gtk.Objects.LayoutChild.LayoutChild'
-- instances by overriding the GtkLayoutManagerClass.@/create_layout_child()/@
-- virtual function. The typical implementation should look like:
-- 
-- 
-- === /C code/
-- >
-- >static GtkLayoutChild *
-- >create_layout_child (GtkLayoutManager *manager,
-- >                     GtkWidget        *container,
-- >                     GtkWidget        *child)
-- >{
-- >  return g_object_new (your_layout_child_get_type (),
-- >                       "layout-manager", manager,
-- >                       "child-widget", child,
-- >                       NULL);
-- >}
-- 
-- 
-- The t'GI.Gtk.Objects.LayoutChild.LayoutChild':@/layout-manager/@ and t'GI.Gtk.Objects.LayoutChild.LayoutChild':@/child-widget/@ properties
-- on the newly created t'GI.Gtk.Objects.LayoutChild.LayoutChild' instance are mandatory. The
-- t'GI.Gtk.Objects.LayoutManager.LayoutManager' will cache the newly created t'GI.Gtk.Objects.LayoutChild.LayoutChild' instance until
-- the widget is removed from its parent, or the parent removes the layout
-- manager.
-- 
-- Each t'GI.Gtk.Objects.LayoutManager.LayoutManager' instance creating a t'GI.Gtk.Objects.LayoutChild.LayoutChild' should use
-- 'GI.Gtk.Objects.LayoutManager.layoutManagerGetLayoutChild' every time it needs to query the
-- layout properties; each t'GI.Gtk.Objects.LayoutChild.LayoutChild' instance should call
-- 'GI.Gtk.Objects.LayoutManager.layoutManagerLayoutChanged' every time a property is updated, in
-- order to queue a new size measuring and allocation.

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

module GI.Gtk.Objects.LayoutManager
    ( 

-- * Exported types
    LayoutManager(..)                       ,
    IsLayoutManager                         ,
    toLayoutManager                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveLayoutManagerMethod              ,
#endif


-- ** allocate #method:allocate#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerAllocateMethodInfo         ,
#endif
    layoutManagerAllocate                   ,


-- ** getLayoutChild #method:getLayoutChild#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerGetLayoutChildMethodInfo   ,
#endif
    layoutManagerGetLayoutChild             ,


-- ** getRequestMode #method:getRequestMode#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerGetRequestModeMethodInfo   ,
#endif
    layoutManagerGetRequestMode             ,


-- ** getWidget #method:getWidget#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerGetWidgetMethodInfo        ,
#endif
    layoutManagerGetWidget                  ,


-- ** layoutChanged #method:layoutChanged#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerLayoutChangedMethodInfo    ,
#endif
    layoutManagerLayoutChanged              ,


-- ** measure #method:measure#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerMeasureMethodInfo          ,
#endif
    layoutManagerMeasure                    ,




    ) 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.BasicTypes as B.Types
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 Control.Monad.IO.Class as MIO
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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutChild as Gtk.LayoutChild
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

-- | Memory-managed wrapper type.
newtype LayoutManager = LayoutManager (SP.ManagedPtr LayoutManager)
    deriving (LayoutManager -> LayoutManager -> Bool
(LayoutManager -> LayoutManager -> Bool)
-> (LayoutManager -> LayoutManager -> Bool) -> Eq LayoutManager
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutManager -> LayoutManager -> Bool
$c/= :: LayoutManager -> LayoutManager -> Bool
== :: LayoutManager -> LayoutManager -> Bool
$c== :: LayoutManager -> LayoutManager -> Bool
Eq)

instance SP.ManagedPtrNewtype LayoutManager where
    toManagedPtr :: LayoutManager -> ManagedPtr LayoutManager
toManagedPtr (LayoutManager ManagedPtr LayoutManager
p) = ManagedPtr LayoutManager
p

foreign import ccall "gtk_layout_manager_get_type"
    c_gtk_layout_manager_get_type :: IO B.Types.GType

instance B.Types.TypedObject LayoutManager where
    glibType :: IO GType
glibType = IO GType
c_gtk_layout_manager_get_type

instance B.Types.GObject LayoutManager

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

-- | Type class for types which can be safely cast to `LayoutManager`, for instance with `toLayoutManager`.
class (SP.GObject o, O.IsDescendantOf LayoutManager o) => IsLayoutManager o
instance (SP.GObject o, O.IsDescendantOf LayoutManager o) => IsLayoutManager o

instance O.HasParentTypes LayoutManager
type instance O.ParentTypes LayoutManager = '[GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveLayoutManagerMethod (t :: Symbol) (o :: *) :: * where
    ResolveLayoutManagerMethod "allocate" o = LayoutManagerAllocateMethodInfo
    ResolveLayoutManagerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveLayoutManagerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveLayoutManagerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveLayoutManagerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveLayoutManagerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveLayoutManagerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveLayoutManagerMethod "layoutChanged" o = LayoutManagerLayoutChangedMethodInfo
    ResolveLayoutManagerMethod "measure" o = LayoutManagerMeasureMethodInfo
    ResolveLayoutManagerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveLayoutManagerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveLayoutManagerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveLayoutManagerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveLayoutManagerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveLayoutManagerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveLayoutManagerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveLayoutManagerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveLayoutManagerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveLayoutManagerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveLayoutManagerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveLayoutManagerMethod "getLayoutChild" o = LayoutManagerGetLayoutChildMethodInfo
    ResolveLayoutManagerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveLayoutManagerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveLayoutManagerMethod "getRequestMode" o = LayoutManagerGetRequestModeMethodInfo
    ResolveLayoutManagerMethod "getWidget" o = LayoutManagerGetWidgetMethodInfo
    ResolveLayoutManagerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveLayoutManagerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveLayoutManagerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveLayoutManagerMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList LayoutManager
type instance O.AttributeList LayoutManager = LayoutManagerAttributeList
type LayoutManagerAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList LayoutManager = LayoutManagerSignalList
type LayoutManagerSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method LayoutManager::allocate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "LayoutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkLayoutManager"
--                 , 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 "the #GtkWidget using @manager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new width of the @widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new height of the @widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "baseline"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the baseline position of the @widget, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_layout_manager_allocate" gtk_layout_manager_allocate :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Gtk", name = "LayoutManager"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    Int32 ->                                -- baseline : TBasicType TInt
    IO ()

-- | This function assigns the given /@width@/, /@height@/, and /@baseline@/ to
-- a /@widget@/, and computes the position and sizes of the children of
-- the /@widget@/ using the layout management policy of /@manager@/.
layoutManagerAllocate ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@manager@/: a t'GI.Gtk.Objects.LayoutManager.LayoutManager'
    -> b
    -- ^ /@widget@/: the t'GI.Gtk.Objects.Widget.Widget' using /@manager@/
    -> Int32
    -- ^ /@width@/: the new width of the /@widget@/
    -> Int32
    -- ^ /@height@/: the new height of the /@widget@/
    -> Int32
    -- ^ /@baseline@/: the baseline position of the /@widget@/, or -1
    -> m ()
layoutManagerAllocate :: a -> b -> Int32 -> Int32 -> Int32 -> m ()
layoutManagerAllocate a
manager b
widget Int32
width Int32
height Int32
baseline = 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 LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    Ptr LayoutManager -> Ptr Widget -> Int32 -> Int32 -> Int32 -> IO ()
gtk_layout_manager_allocate Ptr LayoutManager
manager' Ptr Widget
widget' Int32
width Int32
height Int32
baseline
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    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 LayoutManagerAllocateMethodInfo
instance (signature ~ (b -> Int32 -> Int32 -> Int32 -> m ()), MonadIO m, IsLayoutManager a, Gtk.Widget.IsWidget b) => O.MethodInfo LayoutManagerAllocateMethodInfo a signature where
    overloadedMethod = layoutManagerAllocate

#endif

-- method LayoutManager::get_layout_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "LayoutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkLayoutManager"
--                 , 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 #GtkWidget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "LayoutChild" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_layout_manager_get_layout_child" gtk_layout_manager_get_layout_child :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Gtk", name = "LayoutManager"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO (Ptr Gtk.LayoutChild.LayoutChild)

-- | Retrieves a t'GI.Gtk.Objects.LayoutChild.LayoutChild' instance for the t'GI.Gtk.Objects.LayoutManager.LayoutManager', creating
-- one if necessary.
-- 
-- The /@child@/ widget must be a child of the widget using /@manager@/.
-- 
-- The t'GI.Gtk.Objects.LayoutChild.LayoutChild' instance is owned by the t'GI.Gtk.Objects.LayoutManager.LayoutManager', and is
-- guaranteed to exist as long as /@child@/ is a child of the t'GI.Gtk.Objects.Widget.Widget' using
-- the given t'GI.Gtk.Objects.LayoutManager.LayoutManager'.
layoutManagerGetLayoutChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@manager@/: a t'GI.Gtk.Objects.LayoutManager.LayoutManager'
    -> b
    -- ^ /@child@/: a t'GI.Gtk.Objects.Widget.Widget'
    -> m Gtk.LayoutChild.LayoutChild
    -- ^ __Returns:__ a t'GI.Gtk.Objects.LayoutChild.LayoutChild'
layoutManagerGetLayoutChild :: a -> b -> m LayoutChild
layoutManagerGetLayoutChild a
manager b
child = IO LayoutChild -> m LayoutChild
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LayoutChild -> m LayoutChild)
-> IO LayoutChild -> m LayoutChild
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr LayoutChild
result <- Ptr LayoutManager -> Ptr Widget -> IO (Ptr LayoutChild)
gtk_layout_manager_get_layout_child Ptr LayoutManager
manager' Ptr Widget
child'
    Text -> Ptr LayoutChild -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutManagerGetLayoutChild" Ptr LayoutChild
result
    LayoutChild
result' <- ((ManagedPtr LayoutChild -> LayoutChild)
-> Ptr LayoutChild -> IO LayoutChild
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr LayoutChild -> LayoutChild
Gtk.LayoutChild.LayoutChild) Ptr LayoutChild
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    LayoutChild -> IO LayoutChild
forall (m :: * -> *) a. Monad m => a -> m a
return LayoutChild
result'

#if defined(ENABLE_OVERLOADING)
data LayoutManagerGetLayoutChildMethodInfo
instance (signature ~ (b -> m Gtk.LayoutChild.LayoutChild), MonadIO m, IsLayoutManager a, Gtk.Widget.IsWidget b) => O.MethodInfo LayoutManagerGetLayoutChildMethodInfo a signature where
    overloadedMethod = layoutManagerGetLayoutChild

#endif

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

foreign import ccall "gtk_layout_manager_get_request_mode" gtk_layout_manager_get_request_mode :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Gtk", name = "LayoutManager"})
    IO CUInt

-- | Retrieves the request mode of /@manager@/.
layoutManagerGetRequestMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a) =>
    a
    -- ^ /@manager@/: a t'GI.Gtk.Objects.LayoutManager.LayoutManager'
    -> m Gtk.Enums.SizeRequestMode
    -- ^ __Returns:__ a t'GI.Gtk.Enums.SizeRequestMode'
layoutManagerGetRequestMode :: a -> m SizeRequestMode
layoutManagerGetRequestMode a
manager = IO SizeRequestMode -> m SizeRequestMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SizeRequestMode -> m SizeRequestMode)
-> IO SizeRequestMode -> m SizeRequestMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    CUInt
result <- Ptr LayoutManager -> IO CUInt
gtk_layout_manager_get_request_mode Ptr LayoutManager
manager'
    let result' :: SizeRequestMode
result' = (Int -> SizeRequestMode
forall a. Enum a => Int -> a
toEnum (Int -> SizeRequestMode)
-> (CUInt -> Int) -> CUInt -> SizeRequestMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    SizeRequestMode -> IO SizeRequestMode
forall (m :: * -> *) a. Monad m => a -> m a
return SizeRequestMode
result'

#if defined(ENABLE_OVERLOADING)
data LayoutManagerGetRequestModeMethodInfo
instance (signature ~ (m Gtk.Enums.SizeRequestMode), MonadIO m, IsLayoutManager a) => O.MethodInfo LayoutManagerGetRequestModeMethodInfo a signature where
    overloadedMethod = layoutManagerGetRequestMode

#endif

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

foreign import ccall "gtk_layout_manager_get_widget" gtk_layout_manager_get_widget :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Gtk", name = "LayoutManager"})
    IO (Ptr Gtk.Widget.Widget)

-- | Retrieves the t'GI.Gtk.Objects.Widget.Widget' using the given t'GI.Gtk.Objects.LayoutManager.LayoutManager'.
layoutManagerGetWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a) =>
    a
    -- ^ /@manager@/: a t'GI.Gtk.Objects.LayoutManager.LayoutManager'
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ a t'GI.Gtk.Objects.Widget.Widget'
layoutManagerGetWidget :: a -> m (Maybe Widget)
layoutManagerGetWidget a
manager = IO (Maybe Widget) -> m (Maybe Widget)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Widget
result <- Ptr LayoutManager -> IO (Ptr Widget)
gtk_layout_manager_get_widget Ptr LayoutManager
manager'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((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'
        Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    Maybe Widget -> IO (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data LayoutManagerGetWidgetMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsLayoutManager a) => O.MethodInfo LayoutManagerGetWidgetMethodInfo a signature where
    overloadedMethod = layoutManagerGetWidget

#endif

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

foreign import ccall "gtk_layout_manager_layout_changed" gtk_layout_manager_layout_changed :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Gtk", name = "LayoutManager"})
    IO ()

-- | Queues a resize on the t'GI.Gtk.Objects.Widget.Widget' using /@manager@/, if any.
-- 
-- This function should be called by subclasses of t'GI.Gtk.Objects.LayoutManager.LayoutManager' in
-- response to changes to their layout management policies.
layoutManagerLayoutChanged ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a) =>
    a
    -- ^ /@manager@/: a t'GI.Gtk.Objects.LayoutManager.LayoutManager'
    -> m ()
layoutManagerLayoutChanged :: a -> m ()
layoutManagerLayoutChanged a
manager = 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 LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr LayoutManager -> IO ()
gtk_layout_manager_layout_changed Ptr LayoutManager
manager'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LayoutManagerLayoutChangedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsLayoutManager a) => O.MethodInfo LayoutManagerLayoutChangedMethodInfo a signature where
    overloadedMethod = layoutManagerLayoutChanged

#endif

-- method LayoutManager::measure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "LayoutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkLayoutManager"
--                 , 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 "the #GtkWidget using @manager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "orientation"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Orientation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the orientation to measure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "for_size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Size for the opposite of @orientation; for instance, if\n  the @orientation is %GTK_ORIENTATION_HORIZONTAL, this is the height\n  of the widget; if the @orientation is %GTK_ORIENTATION_VERTICAL, this\n  is the width of the widget. This allows to measure the height for the\n  given width, and the width for the given height. Use -1 if the size\n  is not known"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "minimum"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the minimum size for the given size and\n  orientation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "natural"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the natural, or preferred size for the\n  given size and orientation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "minimum_baseline"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the baseline position for the\n  minimum size"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "natural_baseline"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the baseline position for the\n  natural size"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_layout_manager_measure" gtk_layout_manager_measure :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Gtk", name = "LayoutManager"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    CUInt ->                                -- orientation : TInterface (Name {namespace = "Gtk", name = "Orientation"})
    Int32 ->                                -- for_size : TBasicType TInt
    Ptr Int32 ->                            -- minimum : TBasicType TInt
    Ptr Int32 ->                            -- natural : TBasicType TInt
    Ptr Int32 ->                            -- minimum_baseline : TBasicType TInt
    Ptr Int32 ->                            -- natural_baseline : TBasicType TInt
    IO ()

-- | Measures the size of the /@widget@/ using /@manager@/, for the
-- given /@orientation@/ and size.
-- 
-- See [GtkWidget\'s geometry management section][geometry-management] for
-- more details.
layoutManagerMeasure ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@manager@/: a t'GI.Gtk.Objects.LayoutManager.LayoutManager'
    -> b
    -- ^ /@widget@/: the t'GI.Gtk.Objects.Widget.Widget' using /@manager@/
    -> Gtk.Enums.Orientation
    -- ^ /@orientation@/: the orientation to measure
    -> Int32
    -- ^ /@forSize@/: Size for the opposite of /@orientation@/; for instance, if
    --   the /@orientation@/ is 'GI.Gtk.Enums.OrientationHorizontal', this is the height
    --   of the widget; if the /@orientation@/ is 'GI.Gtk.Enums.OrientationVertical', this
    --   is the width of the widget. This allows to measure the height for the
    --   given width, and the width for the given height. Use -1 if the size
    --   is not known
    -> m ((Int32, Int32, Int32, Int32))
layoutManagerMeasure :: a -> b -> Orientation -> Int32 -> m (Int32, Int32, Int32, Int32)
layoutManagerMeasure a
manager b
widget Orientation
orientation Int32
forSize = IO (Int32, Int32, Int32, Int32) -> m (Int32, Int32, Int32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32, Int32, Int32) -> m (Int32, Int32, Int32, Int32))
-> IO (Int32, Int32, Int32, Int32)
-> m (Int32, Int32, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    let orientation' :: CUInt
orientation' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Orientation -> Int) -> Orientation -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Orientation -> Int
forall a. Enum a => a -> Int
fromEnum) Orientation
orientation
    Ptr Int32
minimum <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
natural <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
minimumBaseline <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
naturalBaseline <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr LayoutManager
-> Ptr Widget
-> CUInt
-> Int32
-> Ptr Int32
-> Ptr Int32
-> Ptr Int32
-> Ptr Int32
-> IO ()
gtk_layout_manager_measure Ptr LayoutManager
manager' Ptr Widget
widget' CUInt
orientation' Int32
forSize Ptr Int32
minimum Ptr Int32
natural Ptr Int32
minimumBaseline Ptr Int32
naturalBaseline
    Int32
minimum' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
minimum
    Int32
natural' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
natural
    Int32
minimumBaseline' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
minimumBaseline
    Int32
naturalBaseline' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
naturalBaseline
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
minimum
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
natural
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
minimumBaseline
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
naturalBaseline
    (Int32, Int32, Int32, Int32) -> IO (Int32, Int32, Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
minimum', Int32
natural', Int32
minimumBaseline', Int32
naturalBaseline')

#if defined(ENABLE_OVERLOADING)
data LayoutManagerMeasureMethodInfo
instance (signature ~ (b -> Gtk.Enums.Orientation -> Int32 -> m ((Int32, Int32, Int32, Int32))), MonadIO m, IsLayoutManager a, Gtk.Widget.IsWidget b) => O.MethodInfo LayoutManagerMeasureMethodInfo a signature where
    overloadedMethod = layoutManagerMeasure

#endif