{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Container of key bindings. The t'GI.Clutter.Objects.BindingPool.BindingPool' struct is
-- private.
-- 
-- /Since: 1.0/

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

module GI.Clutter.Objects.BindingPool
    ( 

-- * Exported types
    BindingPool(..)                         ,
    IsBindingPool                           ,
    toBindingPool                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [activate]("GI.Clutter.Objects.BindingPool#g:method:activate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [blockAction]("GI.Clutter.Objects.BindingPool#g:method:blockAction"), [findAction]("GI.Clutter.Objects.BindingPool#g:method:findAction"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [installAction]("GI.Clutter.Objects.BindingPool#g:method:installAction"), [installClosure]("GI.Clutter.Objects.BindingPool#g:method:installClosure"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [overrideAction]("GI.Clutter.Objects.BindingPool#g:method:overrideAction"), [overrideClosure]("GI.Clutter.Objects.BindingPool#g:method:overrideClosure"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeAction]("GI.Clutter.Objects.BindingPool#g:method:removeAction"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unblockAction]("GI.Clutter.Objects.BindingPool#g:method:unblockAction"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveBindingPoolMethod                ,
#endif

-- ** activate #method:activate#

#if defined(ENABLE_OVERLOADING)
    BindingPoolActivateMethodInfo           ,
#endif
    bindingPoolActivate                     ,


-- ** blockAction #method:blockAction#

#if defined(ENABLE_OVERLOADING)
    BindingPoolBlockActionMethodInfo        ,
#endif
    bindingPoolBlockAction                  ,


-- ** find #method:find#

    bindingPoolFind                         ,


-- ** findAction #method:findAction#

#if defined(ENABLE_OVERLOADING)
    BindingPoolFindActionMethodInfo         ,
#endif
    bindingPoolFindAction                   ,


-- ** getForClass #method:getForClass#

    bindingPoolGetForClass                  ,


-- ** installAction #method:installAction#

#if defined(ENABLE_OVERLOADING)
    BindingPoolInstallActionMethodInfo      ,
#endif
    bindingPoolInstallAction                ,


-- ** installClosure #method:installClosure#

#if defined(ENABLE_OVERLOADING)
    BindingPoolInstallClosureMethodInfo     ,
#endif
    bindingPoolInstallClosure               ,


-- ** new #method:new#

    bindingPoolNew                          ,


-- ** overrideAction #method:overrideAction#

#if defined(ENABLE_OVERLOADING)
    BindingPoolOverrideActionMethodInfo     ,
#endif
    bindingPoolOverrideAction               ,


-- ** overrideClosure #method:overrideClosure#

#if defined(ENABLE_OVERLOADING)
    BindingPoolOverrideClosureMethodInfo    ,
#endif
    bindingPoolOverrideClosure              ,


-- ** removeAction #method:removeAction#

#if defined(ENABLE_OVERLOADING)
    BindingPoolRemoveActionMethodInfo       ,
#endif
    bindingPoolRemoveAction                 ,


-- ** unblockAction #method:unblockAction#

#if defined(ENABLE_OVERLOADING)
    BindingPoolUnblockActionMethodInfo      ,
#endif
    bindingPoolUnblockAction                ,




 -- * Properties


-- ** name #attr:name#
-- | The unique name of the t'GI.Clutter.Objects.BindingPool.BindingPool'.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    BindingPoolNamePropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    bindingPoolName                         ,
#endif
    constructBindingPoolName                ,
    getBindingPoolName                      ,




    ) 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.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 GHC.Records as R

import qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Flags as Clutter.Flags
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_binding_pool_get_type"
    c_clutter_binding_pool_get_type :: IO B.Types.GType

instance B.Types.TypedObject BindingPool where
    glibType :: IO GType
glibType = IO GType
c_clutter_binding_pool_get_type

instance B.Types.GObject BindingPool

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

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

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

-- | Convert 'BindingPool' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe BindingPool) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_binding_pool_get_type
    gvalueSet_ :: Ptr GValue -> Maybe BindingPool -> IO ()
gvalueSet_ Ptr GValue
gv Maybe BindingPool
P.Nothing = Ptr GValue -> Ptr BindingPool -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr BindingPool
forall a. Ptr a
FP.nullPtr :: FP.Ptr BindingPool)
    gvalueSet_ Ptr GValue
gv (P.Just BindingPool
obj) = BindingPool -> (Ptr BindingPool -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr BindingPool
obj (Ptr GValue -> Ptr BindingPool -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe BindingPool)
gvalueGet_ Ptr GValue
gv = do
        Ptr BindingPool
ptr <- Ptr GValue -> IO (Ptr BindingPool)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr BindingPool)
        if Ptr BindingPool
ptr Ptr BindingPool -> Ptr BindingPool -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr BindingPool
forall a. Ptr a
FP.nullPtr
        then BindingPool -> Maybe BindingPool
forall a. a -> Maybe a
P.Just (BindingPool -> Maybe BindingPool)
-> IO BindingPool -> IO (Maybe BindingPool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr BindingPool -> BindingPool)
-> Ptr BindingPool -> IO BindingPool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr BindingPool -> BindingPool
BindingPool Ptr BindingPool
ptr
        else Maybe BindingPool -> IO (Maybe BindingPool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BindingPool
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveBindingPoolMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveBindingPoolMethod "activate" o = BindingPoolActivateMethodInfo
    ResolveBindingPoolMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBindingPoolMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBindingPoolMethod "blockAction" o = BindingPoolBlockActionMethodInfo
    ResolveBindingPoolMethod "findAction" o = BindingPoolFindActionMethodInfo
    ResolveBindingPoolMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBindingPoolMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBindingPoolMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBindingPoolMethod "installAction" o = BindingPoolInstallActionMethodInfo
    ResolveBindingPoolMethod "installClosure" o = BindingPoolInstallClosureMethodInfo
    ResolveBindingPoolMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBindingPoolMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBindingPoolMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBindingPoolMethod "overrideAction" o = BindingPoolOverrideActionMethodInfo
    ResolveBindingPoolMethod "overrideClosure" o = BindingPoolOverrideClosureMethodInfo
    ResolveBindingPoolMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBindingPoolMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBindingPoolMethod "removeAction" o = BindingPoolRemoveActionMethodInfo
    ResolveBindingPoolMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBindingPoolMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBindingPoolMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBindingPoolMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBindingPoolMethod "unblockAction" o = BindingPoolUnblockActionMethodInfo
    ResolveBindingPoolMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBindingPoolMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBindingPoolMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBindingPoolMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBindingPoolMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBindingPoolMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBindingPoolMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBindingPoolMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBindingPoolMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveBindingPoolMethod t BindingPool, O.OverloadedMethod info BindingPool p, R.HasField t BindingPool p) => R.HasField t BindingPool p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveBindingPoolMethod t BindingPool, O.OverloadedMethodInfo info BindingPool) => OL.IsLabel t (O.MethodProxy info BindingPool) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindingPool #name
-- @
getBindingPoolName :: (MonadIO m, IsBindingPool o) => o -> m (Maybe T.Text)
getBindingPoolName :: forall (m :: * -> *) o.
(MonadIO m, IsBindingPool o) =>
o -> m (Maybe Text)
getBindingPoolName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"name"

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBindingPoolName :: (IsBindingPool o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructBindingPoolName :: forall o (m :: * -> *).
(IsBindingPool o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructBindingPoolName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data BindingPoolNamePropertyInfo
instance AttrInfo BindingPoolNamePropertyInfo where
    type AttrAllowedOps BindingPoolNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint BindingPoolNamePropertyInfo = IsBindingPool
    type AttrSetTypeConstraint BindingPoolNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint BindingPoolNamePropertyInfo = (~) T.Text
    type AttrTransferType BindingPoolNamePropertyInfo = T.Text
    type AttrGetType BindingPoolNamePropertyInfo = (Maybe T.Text)
    type AttrLabel BindingPoolNamePropertyInfo = "name"
    type AttrOrigin BindingPoolNamePropertyInfo = BindingPool
    attrGet = getBindingPoolName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructBindingPoolName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindingPool.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BindingPool.html#g:attr:name"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BindingPool
type instance O.AttributeList BindingPool = BindingPoolAttributeList
type BindingPoolAttributeList = ('[ '("name", BindingPoolNamePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
bindingPoolName :: AttrLabelProxy "name"
bindingPoolName = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList BindingPool = BindingPoolSignalList
type BindingPoolSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method BindingPool::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the binding pool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "BindingPool" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_new" clutter_binding_pool_new :: 
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr BindingPool)

-- | Creates a new t'GI.Clutter.Objects.BindingPool.BindingPool' that can be used to store
-- key bindings for an actor. The /@name@/ must be a unique identifier
-- for the binding pool, so that 'GI.Clutter.Objects.BindingPool.bindingPoolFind' will
-- be able to return the correct binding pool.
-- 
-- /Since: 1.0/
bindingPoolNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the name of the binding pool
    -> m BindingPool
    -- ^ __Returns:__ the newly created binding pool with the given
    --   name. Use 'GI.GObject.Objects.Object.objectUnref' when done.
bindingPoolNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m BindingPool
bindingPoolNew Text
name = IO BindingPool -> m BindingPool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BindingPool -> m BindingPool)
-> IO BindingPool -> m BindingPool
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BindingPool
result <- CString -> IO (Ptr BindingPool)
clutter_binding_pool_new CString
name'
    Text -> Ptr BindingPool -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bindingPoolNew" Ptr BindingPool
result
    BindingPool
result' <- ((ManagedPtr BindingPool -> BindingPool)
-> Ptr BindingPool -> IO BindingPool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BindingPool -> BindingPool
BindingPool) Ptr BindingPool
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    BindingPool -> IO BindingPool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BindingPool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BindingPool::activate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindingPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindingPool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_val"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the key symbol" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "bitmask for the modifiers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gobject"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_activate" clutter_binding_pool_activate :: 
    Ptr BindingPool ->                      -- pool : TInterface (Name {namespace = "Clutter", name = "BindingPool"})
    Word32 ->                               -- key_val : TBasicType TUInt
    CUInt ->                                -- modifiers : TInterface (Name {namespace = "Clutter", name = "ModifierType"})
    Ptr GObject.Object.Object ->            -- gobject : TInterface (Name {namespace = "GObject", name = "Object"})
    IO CInt

-- | Activates the callback associated to the action that is
-- bound to the /@keyVal@/ and /@modifiers@/ pair.
-- 
-- The callback has the following signature:
-- 
-- >
-- >  void (* callback) (GObject             *gobject,
-- >                     const gchar         *action_name,
-- >                     guint                key_val,
-- >                     ClutterModifierType  modifiers,
-- >                     gpointer             user_data);
-- 
-- 
-- Where the t'GI.GObject.Objects.Object.Object' instance is /@gobject@/ and the user data
-- is the one passed when installing the action with
-- 'GI.Clutter.Objects.BindingPool.bindingPoolInstallAction'.
-- 
-- If the action bound to the /@keyVal@/, /@modifiers@/ pair has been
-- blocked using 'GI.Clutter.Objects.BindingPool.bindingPoolBlockAction', the callback
-- will not be invoked, and this function will return 'P.False'.
-- 
-- /Since: 1.0/
bindingPoolActivate ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingPool a, GObject.Object.IsObject b) =>
    a
    -- ^ /@pool@/: a t'GI.Clutter.Objects.BindingPool.BindingPool'
    -> Word32
    -- ^ /@keyVal@/: the key symbol
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: bitmask for the modifiers
    -> b
    -- ^ /@gobject@/: a t'GI.GObject.Objects.Object.Object'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if an action was found and was activated
bindingPoolActivate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBindingPool a, IsObject b) =>
a -> Word32 -> [ModifierType] -> b -> m Bool
bindingPoolActivate a
pool Word32
keyVal [ModifierType]
modifiers b
gobject = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingPool
pool' <- a -> IO (Ptr BindingPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    let modifiers' :: CUInt
modifiers' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
modifiers
    Ptr Object
gobject' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
gobject
    CInt
result <- Ptr BindingPool -> Word32 -> CUInt -> Ptr Object -> IO CInt
clutter_binding_pool_activate Ptr BindingPool
pool' Word32
keyVal CUInt
modifiers' Ptr Object
gobject'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
gobject
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BindingPoolActivateMethodInfo
instance (signature ~ (Word32 -> [Clutter.Flags.ModifierType] -> b -> m Bool), MonadIO m, IsBindingPool a, GObject.Object.IsObject b) => O.OverloadedMethod BindingPoolActivateMethodInfo a signature where
    overloadedMethod = bindingPoolActivate

instance O.OverloadedMethodInfo BindingPoolActivateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindingPool.bindingPoolActivate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BindingPool.html#v:bindingPoolActivate"
        })


#endif

-- method BindingPool::block_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindingPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindingPool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an action name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_block_action" clutter_binding_pool_block_action :: 
    Ptr BindingPool ->                      -- pool : TInterface (Name {namespace = "Clutter", name = "BindingPool"})
    CString ->                              -- action_name : TBasicType TUTF8
    IO ()

-- | Blocks all the actions with name /@actionName@/ inside /@pool@/.
-- 
-- /Since: 1.0/
bindingPoolBlockAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Clutter.Objects.BindingPool.BindingPool'
    -> T.Text
    -- ^ /@actionName@/: an action name
    -> m ()
bindingPoolBlockAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindingPool a) =>
a -> Text -> m ()
bindingPoolBlockAction a
pool Text
actionName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingPool
pool' <- a -> IO (Ptr BindingPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    CString
actionName' <- Text -> IO CString
textToCString Text
actionName
    Ptr BindingPool -> CString -> IO ()
clutter_binding_pool_block_action Ptr BindingPool
pool' CString
actionName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
actionName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingPoolBlockActionMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsBindingPool a) => O.OverloadedMethod BindingPoolBlockActionMethodInfo a signature where
    overloadedMethod = bindingPoolBlockAction

instance O.OverloadedMethodInfo BindingPoolBlockActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindingPool.bindingPoolBlockAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BindingPool.html#v:bindingPoolBlockAction"
        })


#endif

-- method BindingPool::find_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindingPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindingPool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_val"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a key symbol" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a bitmask for the modifiers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_find_action" clutter_binding_pool_find_action :: 
    Ptr BindingPool ->                      -- pool : TInterface (Name {namespace = "Clutter", name = "BindingPool"})
    Word32 ->                               -- key_val : TBasicType TUInt
    CUInt ->                                -- modifiers : TInterface (Name {namespace = "Clutter", name = "ModifierType"})
    IO CString

-- | Retrieves the name of the action matching the given key symbol
-- and modifiers bitmask.
-- 
-- /Since: 1.0/
bindingPoolFindAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Clutter.Objects.BindingPool.BindingPool'
    -> Word32
    -- ^ /@keyVal@/: a key symbol
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: a bitmask for the modifiers
    -> m T.Text
    -- ^ __Returns:__ the name of the action, if found, or 'P.Nothing'. The
    --   returned string is owned by the binding pool and should never
    --   be modified or freed
bindingPoolFindAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindingPool a) =>
a -> Word32 -> [ModifierType] -> m Text
bindingPoolFindAction a
pool Word32
keyVal [ModifierType]
modifiers = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingPool
pool' <- a -> IO (Ptr BindingPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    let modifiers' :: CUInt
modifiers' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
modifiers
    CString
result <- Ptr BindingPool -> Word32 -> CUInt -> IO CString
clutter_binding_pool_find_action Ptr BindingPool
pool' Word32
keyVal CUInt
modifiers'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bindingPoolFindAction" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BindingPoolFindActionMethodInfo
instance (signature ~ (Word32 -> [Clutter.Flags.ModifierType] -> m T.Text), MonadIO m, IsBindingPool a) => O.OverloadedMethod BindingPoolFindActionMethodInfo a signature where
    overloadedMethod = bindingPoolFindAction

instance O.OverloadedMethodInfo BindingPoolFindActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindingPool.bindingPoolFindAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BindingPool.html#v:bindingPoolFindAction"
        })


#endif

-- method BindingPool::install_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindingPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindingPool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_val"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "key symbol" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "bitmask of modifiers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface
--                 Name { namespace = "Clutter" , name = "BindingActionFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "function to be called\n  when the action is activated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 5
--           , argDestroy = 6
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "function to be called when the action is removed\n  from the pool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_install_action" clutter_binding_pool_install_action :: 
    Ptr BindingPool ->                      -- pool : TInterface (Name {namespace = "Clutter", name = "BindingPool"})
    CString ->                              -- action_name : TBasicType TUTF8
    Word32 ->                               -- key_val : TBasicType TUInt
    CUInt ->                                -- modifiers : TInterface (Name {namespace = "Clutter", name = "ModifierType"})
    FunPtr Clutter.Callbacks.C_BindingActionFunc -> -- callback : TInterface (Name {namespace = "Clutter", name = "BindingActionFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Installs a new action inside a t'GI.Clutter.Objects.BindingPool.BindingPool'. The action
-- is bound to /@keyVal@/ and /@modifiers@/.
-- 
-- The same action name can be used for multiple /@keyVal@/, /@modifiers@/
-- pairs.
-- 
-- When an action has been activated using 'GI.Clutter.Objects.BindingPool.bindingPoolActivate'
-- the passed /@callback@/ will be invoked (with /@data@/).
-- 
-- Actions can be blocked with 'GI.Clutter.Objects.BindingPool.bindingPoolBlockAction'
-- and then unblocked using 'GI.Clutter.Objects.BindingPool.bindingPoolUnblockAction'.
-- 
-- /Since: 1.0/
bindingPoolInstallAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Clutter.Objects.BindingPool.BindingPool'
    -> T.Text
    -- ^ /@actionName@/: the name of the action
    -> Word32
    -- ^ /@keyVal@/: key symbol
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: bitmask of modifiers
    -> Clutter.Callbacks.BindingActionFunc
    -- ^ /@callback@/: function to be called
    --   when the action is activated
    -> m ()
bindingPoolInstallAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindingPool a) =>
a -> Text -> Word32 -> [ModifierType] -> BindingActionFunc -> m ()
bindingPoolInstallAction a
pool Text
actionName Word32
keyVal [ModifierType]
modifiers BindingActionFunc
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingPool
pool' <- a -> IO (Ptr BindingPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    CString
actionName' <- Text -> IO CString
textToCString Text
actionName
    let modifiers' :: CUInt
modifiers' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
modifiers
    FunPtr C_BindingActionFunc
callback' <- C_BindingActionFunc -> IO (FunPtr C_BindingActionFunc)
Clutter.Callbacks.mk_BindingActionFunc (Maybe (Ptr (FunPtr C_BindingActionFunc))
-> BindingActionFunc_WithClosures -> C_BindingActionFunc
Clutter.Callbacks.wrap_BindingActionFunc Maybe (Ptr (FunPtr C_BindingActionFunc))
forall a. Maybe a
Nothing (BindingActionFunc -> BindingActionFunc_WithClosures
Clutter.Callbacks.drop_closures_BindingActionFunc BindingActionFunc
callback))
    let data_ :: Ptr ()
data_ = FunPtr C_BindingActionFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_BindingActionFunc
callback'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr BindingPool
-> CString
-> Word32
-> CUInt
-> FunPtr C_BindingActionFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
clutter_binding_pool_install_action Ptr BindingPool
pool' CString
actionName' Word32
keyVal CUInt
modifiers' FunPtr C_BindingActionFunc
callback' Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
actionName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingPoolInstallActionMethodInfo
instance (signature ~ (T.Text -> Word32 -> [Clutter.Flags.ModifierType] -> Clutter.Callbacks.BindingActionFunc -> m ()), MonadIO m, IsBindingPool a) => O.OverloadedMethod BindingPoolInstallActionMethodInfo a signature where
    overloadedMethod = bindingPoolInstallAction

instance O.OverloadedMethodInfo BindingPoolInstallActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindingPool.bindingPoolInstallAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BindingPool.html#v:bindingPoolInstallAction"
        })


#endif

-- method BindingPool::install_closure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindingPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindingPool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_val"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "key symbol" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "bitmask of modifiers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "closure"
--           , argType = TGClosure Nothing
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GClosure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_install_closure" clutter_binding_pool_install_closure :: 
    Ptr BindingPool ->                      -- pool : TInterface (Name {namespace = "Clutter", name = "BindingPool"})
    CString ->                              -- action_name : TBasicType TUTF8
    Word32 ->                               -- key_val : TBasicType TUInt
    CUInt ->                                -- modifiers : TInterface (Name {namespace = "Clutter", name = "ModifierType"})
    Ptr (GClosure ()) ->                    -- closure : TGClosure Nothing
    IO ()

-- | A t'GI.GObject.Structs.Closure.Closure' variant of 'GI.Clutter.Objects.BindingPool.bindingPoolInstallAction'.
-- 
-- Installs a new action inside a t'GI.Clutter.Objects.BindingPool.BindingPool'. The action
-- is bound to /@keyVal@/ and /@modifiers@/.
-- 
-- The same action name can be used for multiple /@keyVal@/, /@modifiers@/
-- pairs.
-- 
-- When an action has been activated using 'GI.Clutter.Objects.BindingPool.bindingPoolActivate'
-- the passed /@closure@/ will be invoked.
-- 
-- Actions can be blocked with 'GI.Clutter.Objects.BindingPool.bindingPoolBlockAction'
-- and then unblocked using 'GI.Clutter.Objects.BindingPool.bindingPoolUnblockAction'.
-- 
-- /Since: 1.0/
bindingPoolInstallClosure ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Clutter.Objects.BindingPool.BindingPool'
    -> T.Text
    -- ^ /@actionName@/: the name of the action
    -> Word32
    -- ^ /@keyVal@/: key symbol
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: bitmask of modifiers
    -> GClosure b
    -- ^ /@closure@/: a t'GI.GObject.Structs.Closure.Closure'
    -> m ()
bindingPoolInstallClosure :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBindingPool a) =>
a -> Text -> Word32 -> [ModifierType] -> GClosure b -> m ()
bindingPoolInstallClosure a
pool Text
actionName Word32
keyVal [ModifierType]
modifiers GClosure b
closure = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingPool
pool' <- a -> IO (Ptr BindingPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    CString
actionName' <- Text -> IO CString
textToCString Text
actionName
    let modifiers' :: CUInt
modifiers' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
modifiers
    Ptr (GClosure ())
closure' <- GClosure b -> IO (Ptr (GClosure ()))
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr GClosure b
closure
    Ptr BindingPool
-> CString -> Word32 -> CUInt -> Ptr (GClosure ()) -> IO ()
clutter_binding_pool_install_closure Ptr BindingPool
pool' CString
actionName' Word32
keyVal CUInt
modifiers' Ptr (GClosure ())
closure'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    GClosure b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GClosure b
closure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
actionName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingPoolInstallClosureMethodInfo
instance (signature ~ (T.Text -> Word32 -> [Clutter.Flags.ModifierType] -> GClosure b -> m ()), MonadIO m, IsBindingPool a) => O.OverloadedMethod BindingPoolInstallClosureMethodInfo a signature where
    overloadedMethod = bindingPoolInstallClosure

instance O.OverloadedMethodInfo BindingPoolInstallClosureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindingPool.bindingPoolInstallClosure",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BindingPool.html#v:bindingPoolInstallClosure"
        })


#endif

-- method BindingPool::override_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindingPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindingPool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_val"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "key symbol" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "bitmask of modifiers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface
--                 Name { namespace = "Clutter" , name = "BindingActionFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "function to be called when the action is activated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 4
--           , argDestroy = 5
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "function to be called when the action is removed\n  from the pool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_override_action" clutter_binding_pool_override_action :: 
    Ptr BindingPool ->                      -- pool : TInterface (Name {namespace = "Clutter", name = "BindingPool"})
    Word32 ->                               -- key_val : TBasicType TUInt
    CUInt ->                                -- modifiers : TInterface (Name {namespace = "Clutter", name = "ModifierType"})
    FunPtr Clutter.Callbacks.C_BindingActionFunc -> -- callback : TInterface (Name {namespace = "Clutter", name = "BindingActionFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Allows overriding the action for /@keyVal@/ and /@modifiers@/ inside a
-- t'GI.Clutter.Objects.BindingPool.BindingPool'. See 'GI.Clutter.Objects.BindingPool.bindingPoolInstallAction'.
-- 
-- When an action has been activated using 'GI.Clutter.Objects.BindingPool.bindingPoolActivate'
-- the passed /@callback@/ will be invoked (with /@data@/).
-- 
-- Actions can be blocked with 'GI.Clutter.Objects.BindingPool.bindingPoolBlockAction'
-- and then unblocked using 'GI.Clutter.Objects.BindingPool.bindingPoolUnblockAction'.
-- 
-- /Since: 1.0/
bindingPoolOverrideAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Clutter.Objects.BindingPool.BindingPool'
    -> Word32
    -- ^ /@keyVal@/: key symbol
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: bitmask of modifiers
    -> Clutter.Callbacks.BindingActionFunc
    -- ^ /@callback@/: function to be called when the action is activated
    -> m ()
bindingPoolOverrideAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindingPool a) =>
a -> Word32 -> [ModifierType] -> BindingActionFunc -> m ()
bindingPoolOverrideAction a
pool Word32
keyVal [ModifierType]
modifiers BindingActionFunc
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingPool
pool' <- a -> IO (Ptr BindingPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    let modifiers' :: CUInt
modifiers' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
modifiers
    FunPtr C_BindingActionFunc
callback' <- C_BindingActionFunc -> IO (FunPtr C_BindingActionFunc)
Clutter.Callbacks.mk_BindingActionFunc (Maybe (Ptr (FunPtr C_BindingActionFunc))
-> BindingActionFunc_WithClosures -> C_BindingActionFunc
Clutter.Callbacks.wrap_BindingActionFunc Maybe (Ptr (FunPtr C_BindingActionFunc))
forall a. Maybe a
Nothing (BindingActionFunc -> BindingActionFunc_WithClosures
Clutter.Callbacks.drop_closures_BindingActionFunc BindingActionFunc
callback))
    let data_ :: Ptr ()
data_ = FunPtr C_BindingActionFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_BindingActionFunc
callback'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr BindingPool
-> Word32
-> CUInt
-> FunPtr C_BindingActionFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
clutter_binding_pool_override_action Ptr BindingPool
pool' Word32
keyVal CUInt
modifiers' FunPtr C_BindingActionFunc
callback' Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingPoolOverrideActionMethodInfo
instance (signature ~ (Word32 -> [Clutter.Flags.ModifierType] -> Clutter.Callbacks.BindingActionFunc -> m ()), MonadIO m, IsBindingPool a) => O.OverloadedMethod BindingPoolOverrideActionMethodInfo a signature where
    overloadedMethod = bindingPoolOverrideAction

instance O.OverloadedMethodInfo BindingPoolOverrideActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindingPool.bindingPoolOverrideAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BindingPool.html#v:bindingPoolOverrideAction"
        })


#endif

-- method BindingPool::override_closure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindingPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindingPool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_val"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "key symbol" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "bitmask of modifiers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "closure"
--           , argType = TGClosure Nothing
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GClosure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_override_closure" clutter_binding_pool_override_closure :: 
    Ptr BindingPool ->                      -- pool : TInterface (Name {namespace = "Clutter", name = "BindingPool"})
    Word32 ->                               -- key_val : TBasicType TUInt
    CUInt ->                                -- modifiers : TInterface (Name {namespace = "Clutter", name = "ModifierType"})
    Ptr (GClosure ()) ->                    -- closure : TGClosure Nothing
    IO ()

-- | A t'GI.GObject.Structs.Closure.Closure' variant of 'GI.Clutter.Objects.BindingPool.bindingPoolOverrideAction'.
-- 
-- Allows overriding the action for /@keyVal@/ and /@modifiers@/ inside a
-- t'GI.Clutter.Objects.BindingPool.BindingPool'. See 'GI.Clutter.Objects.BindingPool.bindingPoolInstallClosure'.
-- 
-- When an action has been activated using 'GI.Clutter.Objects.BindingPool.bindingPoolActivate'
-- the passed /@callback@/ will be invoked (with /@data@/).
-- 
-- Actions can be blocked with 'GI.Clutter.Objects.BindingPool.bindingPoolBlockAction'
-- and then unblocked using 'GI.Clutter.Objects.BindingPool.bindingPoolUnblockAction'.
-- 
-- /Since: 1.0/
bindingPoolOverrideClosure ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Clutter.Objects.BindingPool.BindingPool'
    -> Word32
    -- ^ /@keyVal@/: key symbol
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: bitmask of modifiers
    -> GClosure b
    -- ^ /@closure@/: a t'GI.GObject.Structs.Closure.Closure'
    -> m ()
bindingPoolOverrideClosure :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBindingPool a) =>
a -> Word32 -> [ModifierType] -> GClosure b -> m ()
bindingPoolOverrideClosure a
pool Word32
keyVal [ModifierType]
modifiers GClosure b
closure = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingPool
pool' <- a -> IO (Ptr BindingPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    let modifiers' :: CUInt
modifiers' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
modifiers
    Ptr (GClosure ())
closure' <- GClosure b -> IO (Ptr (GClosure ()))
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr GClosure b
closure
    Ptr BindingPool -> Word32 -> CUInt -> Ptr (GClosure ()) -> IO ()
clutter_binding_pool_override_closure Ptr BindingPool
pool' Word32
keyVal CUInt
modifiers' Ptr (GClosure ())
closure'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    GClosure b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GClosure b
closure
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingPoolOverrideClosureMethodInfo
instance (signature ~ (Word32 -> [Clutter.Flags.ModifierType] -> GClosure b -> m ()), MonadIO m, IsBindingPool a) => O.OverloadedMethod BindingPoolOverrideClosureMethodInfo a signature where
    overloadedMethod = bindingPoolOverrideClosure

instance O.OverloadedMethodInfo BindingPoolOverrideClosureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindingPool.bindingPoolOverrideClosure",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BindingPool.html#v:bindingPoolOverrideClosure"
        })


#endif

-- method BindingPool::remove_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindingPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindingPool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_val"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a key symbol" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a bitmask for the modifiers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_remove_action" clutter_binding_pool_remove_action :: 
    Ptr BindingPool ->                      -- pool : TInterface (Name {namespace = "Clutter", name = "BindingPool"})
    Word32 ->                               -- key_val : TBasicType TUInt
    CUInt ->                                -- modifiers : TInterface (Name {namespace = "Clutter", name = "ModifierType"})
    IO ()

-- | Removes the action matching the given /@keyVal@/, /@modifiers@/ pair,
-- if any exists.
-- 
-- /Since: 1.0/
bindingPoolRemoveAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Clutter.Objects.BindingPool.BindingPool'
    -> Word32
    -- ^ /@keyVal@/: a key symbol
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: a bitmask for the modifiers
    -> m ()
bindingPoolRemoveAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindingPool a) =>
a -> Word32 -> [ModifierType] -> m ()
bindingPoolRemoveAction a
pool Word32
keyVal [ModifierType]
modifiers = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingPool
pool' <- a -> IO (Ptr BindingPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    let modifiers' :: CUInt
modifiers' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
modifiers
    Ptr BindingPool -> Word32 -> CUInt -> IO ()
clutter_binding_pool_remove_action Ptr BindingPool
pool' Word32
keyVal CUInt
modifiers'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingPoolRemoveActionMethodInfo
instance (signature ~ (Word32 -> [Clutter.Flags.ModifierType] -> m ()), MonadIO m, IsBindingPool a) => O.OverloadedMethod BindingPoolRemoveActionMethodInfo a signature where
    overloadedMethod = bindingPoolRemoveAction

instance O.OverloadedMethodInfo BindingPoolRemoveActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindingPool.bindingPoolRemoveAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BindingPool.html#v:bindingPoolRemoveAction"
        })


#endif

-- method BindingPool::unblock_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindingPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindingPool"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an action name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_unblock_action" clutter_binding_pool_unblock_action :: 
    Ptr BindingPool ->                      -- pool : TInterface (Name {namespace = "Clutter", name = "BindingPool"})
    CString ->                              -- action_name : TBasicType TUTF8
    IO ()

-- | Unblockes all the actions with name /@actionName@/ inside /@pool@/.
-- 
-- Unblocking an action does not cause the callback bound to it to
-- be invoked in case 'GI.Clutter.Objects.BindingPool.bindingPoolActivate' was called on
-- an action previously blocked with 'GI.Clutter.Objects.BindingPool.bindingPoolBlockAction'.
-- 
-- /Since: 1.0/
bindingPoolUnblockAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Clutter.Objects.BindingPool.BindingPool'
    -> T.Text
    -- ^ /@actionName@/: an action name
    -> m ()
bindingPoolUnblockAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindingPool a) =>
a -> Text -> m ()
bindingPoolUnblockAction a
pool Text
actionName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingPool
pool' <- a -> IO (Ptr BindingPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    CString
actionName' <- Text -> IO CString
textToCString Text
actionName
    Ptr BindingPool -> CString -> IO ()
clutter_binding_pool_unblock_action Ptr BindingPool
pool' CString
actionName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
actionName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingPoolUnblockActionMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsBindingPool a) => O.OverloadedMethod BindingPoolUnblockActionMethodInfo a signature where
    overloadedMethod = bindingPoolUnblockAction

instance O.OverloadedMethodInfo BindingPoolUnblockActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindingPool.bindingPoolUnblockAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BindingPool.html#v:bindingPoolUnblockAction"
        })


#endif

-- method BindingPool::find
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the binding pool to find"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "BindingPool" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_find" clutter_binding_pool_find :: 
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr BindingPool)

-- | Finds the t'GI.Clutter.Objects.BindingPool.BindingPool' with /@name@/.
-- 
-- /Since: 1.0/
bindingPoolFind ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the name of the binding pool to find
    -> m BindingPool
    -- ^ __Returns:__ a pointer to the t'GI.Clutter.Objects.BindingPool.BindingPool', or 'P.Nothing'
bindingPoolFind :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m BindingPool
bindingPoolFind Text
name = IO BindingPool -> m BindingPool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BindingPool -> m BindingPool)
-> IO BindingPool -> m BindingPool
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BindingPool
result <- CString -> IO (Ptr BindingPool)
clutter_binding_pool_find CString
name'
    Text -> Ptr BindingPool -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bindingPoolFind" Ptr BindingPool
result
    BindingPool
result' <- ((ManagedPtr BindingPool -> BindingPool)
-> Ptr BindingPool -> IO BindingPool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr BindingPool -> BindingPool
BindingPool) Ptr BindingPool
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    BindingPool -> IO BindingPool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BindingPool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BindingPool::get_for_class
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "klass"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GObjectClass pointer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "BindingPool" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_binding_pool_get_for_class" clutter_binding_pool_get_for_class :: 
    Ptr () ->                               -- klass : TBasicType TPtr
    IO (Ptr BindingPool)

-- | Retrieves the t'GI.Clutter.Objects.BindingPool.BindingPool' for the given t'GI.GObject.Objects.Object.Object' class
-- and, eventually, creates it. This function is a wrapper around
-- 'GI.Clutter.Objects.BindingPool.bindingPoolNew' and uses the class type name as the
-- unique name for the binding pool.
-- 
-- Calling this function multiple times will return the same
-- t'GI.Clutter.Objects.BindingPool.BindingPool'.
-- 
-- A binding pool for a class can also be retrieved using
-- 'GI.Clutter.Objects.BindingPool.bindingPoolFind' with the class type name:
-- 
-- >
-- >  pool = clutter_binding_pool_find (G_OBJECT_TYPE_NAME (instance));
-- 
-- 
-- /Since: 1.0/
bindingPoolGetForClass ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@klass@/: a t'GI.GObject.Structs.ObjectClass.ObjectClass' pointer
    -> m BindingPool
    -- ^ __Returns:__ the binding pool for the given class.
    --   The returned t'GI.Clutter.Objects.BindingPool.BindingPool' is owned by Clutter and should not
    --   be freed directly
bindingPoolGetForClass :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> m BindingPool
bindingPoolGetForClass Ptr ()
klass = IO BindingPool -> m BindingPool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BindingPool -> m BindingPool)
-> IO BindingPool -> m BindingPool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingPool
result <- Ptr () -> IO (Ptr BindingPool)
clutter_binding_pool_get_for_class Ptr ()
klass
    Text -> Ptr BindingPool -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bindingPoolGetForClass" Ptr BindingPool
result
    BindingPool
result' <- ((ManagedPtr BindingPool -> BindingPool)
-> Ptr BindingPool -> IO BindingPool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr BindingPool -> BindingPool
BindingPool) Ptr BindingPool
result
    BindingPool -> IO BindingPool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BindingPool
result'

#if defined(ENABLE_OVERLOADING)
#endif