{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A binding set maintains a list of activatable key bindings.
-- A single binding set can match multiple types of widgets.
-- Similar to style contexts, can be matched by any information contained
-- in a widgets t'GI.Gtk.Structs.WidgetPath.WidgetPath'. When a binding within a set is matched upon
-- activation, an action signal is emitted on the target widget to carry out
-- the actual activation.

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

module GI.Gtk.Structs.BindingSet
    ( 

-- * Exported types
    BindingSet(..)                          ,
    newZeroBindingSet                       ,
    noBindingSet                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveBindingSetMethod                 ,
#endif


-- ** activate #method:activate#

#if defined(ENABLE_OVERLOADING)
    BindingSetActivateMethodInfo            ,
#endif
    bindingSetActivate                      ,


-- ** addPath #method:addPath#

#if defined(ENABLE_OVERLOADING)
    BindingSetAddPathMethodInfo             ,
#endif
    bindingSetAddPath                       ,


-- ** find #method:find#

    bindingSetFind                          ,




 -- * Properties
-- ** classBranchPspecs #attr:classBranchPspecs#
-- | unused

#if defined(ENABLE_OVERLOADING)
    bindingSet_classBranchPspecs            ,
#endif
    clearBindingSetClassBranchPspecs        ,
    getBindingSetClassBranchPspecs          ,
    setBindingSetClassBranchPspecs          ,


-- ** current #attr:current#
-- | implementation detail

#if defined(ENABLE_OVERLOADING)
    bindingSet_current                      ,
#endif
    clearBindingSetCurrent                  ,
    getBindingSetCurrent                    ,
    setBindingSetCurrent                    ,


-- ** entries #attr:entries#
-- | the key binding entries in this binding set

#if defined(ENABLE_OVERLOADING)
    bindingSet_entries                      ,
#endif
    clearBindingSetEntries                  ,
    getBindingSetEntries                    ,
    setBindingSetEntries                    ,


-- ** parsed #attr:parsed#
-- | whether this binding set stems from a CSS file and is reset upon theme changes

#if defined(ENABLE_OVERLOADING)
    bindingSet_parsed                       ,
#endif
    getBindingSetParsed                     ,
    setBindingSetParsed                     ,


-- ** priority #attr:priority#
-- | unused

#if defined(ENABLE_OVERLOADING)
    bindingSet_priority                     ,
#endif
    getBindingSetPriority                   ,
    setBindingSetPriority                   ,


-- ** setName #attr:setName#
-- | unique name of this binding set

#if defined(ENABLE_OVERLOADING)
    bindingSet_setName                      ,
#endif
    clearBindingSetSetName                  ,
    getBindingSetSetName                    ,
    setBindingSetSetName                    ,


-- ** widgetClassPspecs #attr:widgetClassPspecs#
-- | unused

#if defined(ENABLE_OVERLOADING)
    bindingSet_widgetClassPspecs            ,
#endif
    clearBindingSetWidgetClassPspecs        ,
    getBindingSetWidgetClassPspecs          ,
    setBindingSetWidgetClassPspecs          ,


-- ** widgetPathPspecs #attr:widgetPathPspecs#
-- | unused

#if defined(ENABLE_OVERLOADING)
    bindingSet_widgetPathPspecs             ,
#endif
    clearBindingSetWidgetPathPspecs         ,
    getBindingSetWidgetPathPspecs           ,
    setBindingSetWidgetPathPspecs           ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Structs.BindingEntry as Gtk.BindingEntry

-- | Memory-managed wrapper type.
newtype BindingSet = BindingSet (ManagedPtr BindingSet)
    deriving (BindingSet -> BindingSet -> Bool
(BindingSet -> BindingSet -> Bool)
-> (BindingSet -> BindingSet -> Bool) -> Eq BindingSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindingSet -> BindingSet -> Bool
$c/= :: BindingSet -> BindingSet -> Bool
== :: BindingSet -> BindingSet -> Bool
$c== :: BindingSet -> BindingSet -> Bool
Eq)
instance WrappedPtr BindingSet where
    wrappedPtrCalloc :: IO (Ptr BindingSet)
wrappedPtrCalloc = Int -> IO (Ptr BindingSet)
forall a. Int -> IO (Ptr a)
callocBytes 64
    wrappedPtrCopy :: BindingSet -> IO BindingSet
wrappedPtrCopy = \p :: BindingSet
p -> BindingSet -> (Ptr BindingSet -> IO BindingSet) -> IO BindingSet
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
p (Int -> Ptr BindingSet -> IO (Ptr BindingSet)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 64 (Ptr BindingSet -> IO (Ptr BindingSet))
-> (Ptr BindingSet -> IO BindingSet)
-> Ptr BindingSet
-> IO BindingSet
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr BindingSet -> BindingSet)
-> Ptr BindingSet -> IO BindingSet
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr BindingSet -> BindingSet
BindingSet)
    wrappedPtrFree :: Maybe (GDestroyNotify BindingSet)
wrappedPtrFree = GDestroyNotify BindingSet -> Maybe (GDestroyNotify BindingSet)
forall a. a -> Maybe a
Just GDestroyNotify BindingSet
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

-- | Construct a `BindingSet` struct initialized to zero.
newZeroBindingSet :: MonadIO m => m BindingSet
newZeroBindingSet :: m BindingSet
newZeroBindingSet = IO BindingSet -> m BindingSet
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BindingSet -> m BindingSet) -> IO BindingSet -> m BindingSet
forall a b. (a -> b) -> a -> b
$ IO (Ptr BindingSet)
forall a. WrappedPtr a => IO (Ptr a)
wrappedPtrCalloc IO (Ptr BindingSet)
-> (Ptr BindingSet -> IO BindingSet) -> IO BindingSet
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr BindingSet -> BindingSet)
-> Ptr BindingSet -> IO BindingSet
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr BindingSet -> BindingSet
BindingSet

instance tag ~ 'AttrSet => Constructible BindingSet tag where
    new :: (ManagedPtr BindingSet -> BindingSet)
-> [AttrOp BindingSet tag] -> m BindingSet
new _ attrs :: [AttrOp BindingSet tag]
attrs = do
        BindingSet
o <- m BindingSet
forall (m :: * -> *). MonadIO m => m BindingSet
newZeroBindingSet
        BindingSet -> [AttrOp BindingSet 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set BindingSet
o [AttrOp BindingSet tag]
[AttrOp BindingSet 'AttrSet]
attrs
        BindingSet -> m BindingSet
forall (m :: * -> *) a. Monad m => a -> m a
return BindingSet
o


-- | A convenience alias for `Nothing` :: `Maybe` `BindingSet`.
noBindingSet :: Maybe BindingSet
noBindingSet :: Maybe BindingSet
noBindingSet = Maybe BindingSet
forall a. Maybe a
Nothing

-- | Get the value of the “@set_name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindingSet #setName
-- @
getBindingSetSetName :: MonadIO m => BindingSet -> m (Maybe T.Text)
getBindingSetSetName :: BindingSet -> m (Maybe Text)
getBindingSetSetName s :: BindingSet
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ BindingSet
-> (Ptr BindingSet -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr BindingSet -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \val' :: CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@set_name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindingSet [ #setName 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindingSetSetName :: MonadIO m => BindingSet -> CString -> m ()
setBindingSetSetName :: BindingSet -> CString -> m ()
setBindingSetSetName s :: BindingSet
s val :: CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (CString
val :: CString)

-- | Set the value of the “@set_name@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #setName
-- @
clearBindingSetSetName :: MonadIO m => BindingSet -> m ()
clearBindingSetSetName :: BindingSet -> m ()
clearBindingSetSetName s :: BindingSet
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data BindingSetSetNameFieldInfo
instance AttrInfo BindingSetSetNameFieldInfo where
    type AttrBaseTypeConstraint BindingSetSetNameFieldInfo = (~) BindingSet
    type AttrAllowedOps BindingSetSetNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint BindingSetSetNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint BindingSetSetNameFieldInfo = (~)CString
    type AttrTransferType BindingSetSetNameFieldInfo = CString
    type AttrGetType BindingSetSetNameFieldInfo = Maybe T.Text
    type AttrLabel BindingSetSetNameFieldInfo = "set_name"
    type AttrOrigin BindingSetSetNameFieldInfo = BindingSet
    attrGet = getBindingSetSetName
    attrSet = setBindingSetSetName
    attrConstruct = undefined
    attrClear = clearBindingSetSetName
    attrTransfer _ v = do
        return v

bindingSet_setName :: AttrLabelProxy "setName"
bindingSet_setName = AttrLabelProxy

#endif


-- | Get the value of the “@priority@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindingSet #priority
-- @
getBindingSetPriority :: MonadIO m => BindingSet -> m Int32
getBindingSetPriority :: BindingSet -> m Int32
getBindingSetPriority s :: BindingSet
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO Int32) -> IO Int32)
-> (Ptr BindingSet -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@priority@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindingSet [ #priority 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindingSetPriority :: MonadIO m => BindingSet -> Int32 -> m ()
setBindingSetPriority :: BindingSet -> Int32 -> m ()
setBindingSetPriority s :: BindingSet
s val :: Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data BindingSetPriorityFieldInfo
instance AttrInfo BindingSetPriorityFieldInfo where
    type AttrBaseTypeConstraint BindingSetPriorityFieldInfo = (~) BindingSet
    type AttrAllowedOps BindingSetPriorityFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint BindingSetPriorityFieldInfo = (~) Int32
    type AttrTransferTypeConstraint BindingSetPriorityFieldInfo = (~)Int32
    type AttrTransferType BindingSetPriorityFieldInfo = Int32
    type AttrGetType BindingSetPriorityFieldInfo = Int32
    type AttrLabel BindingSetPriorityFieldInfo = "priority"
    type AttrOrigin BindingSetPriorityFieldInfo = BindingSet
    attrGet = getBindingSetPriority
    attrSet = setBindingSetPriority
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

bindingSet_priority :: AttrLabelProxy "priority"
bindingSet_priority = AttrLabelProxy

#endif


-- | Get the value of the “@widget_path_pspecs@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindingSet #widgetPathPspecs
-- @
getBindingSetWidgetPathPspecs :: MonadIO m => BindingSet -> m ([Ptr ()])
getBindingSetWidgetPathPspecs :: BindingSet -> m [Ptr ()]
getBindingSetWidgetPathPspecs s :: BindingSet
s = IO [Ptr ()] -> m [Ptr ()]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr ()] -> m [Ptr ()]) -> IO [Ptr ()] -> m [Ptr ()]
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO [Ptr ()]) -> IO [Ptr ()]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO [Ptr ()]) -> IO [Ptr ()])
-> (Ptr BindingSet -> IO [Ptr ()]) -> IO [Ptr ()]
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (GSList (Ptr ()))
val <- Ptr (Ptr (GSList (Ptr ()))) -> IO (Ptr (GSList (Ptr ())))
forall a. Storable a => Ptr a -> IO a
peek (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr (GSList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) :: IO (Ptr (GSList (Ptr ())))
    [Ptr ()]
val' <- Ptr (GSList (Ptr ())) -> IO [Ptr ()]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr ()))
val
    [Ptr ()] -> IO [Ptr ()]
forall (m :: * -> *) a. Monad m => a -> m a
return [Ptr ()]
val'

-- | Set the value of the “@widget_path_pspecs@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindingSet [ #widgetPathPspecs 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindingSetWidgetPathPspecs :: MonadIO m => BindingSet -> Ptr (GSList (Ptr ())) -> m ()
setBindingSetWidgetPathPspecs :: BindingSet -> Ptr (GSList (Ptr ())) -> m ()
setBindingSetWidgetPathPspecs s :: BindingSet
s val :: Ptr (GSList (Ptr ()))
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (Ptr (GSList (Ptr ()))) -> Ptr (GSList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr (GSList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) (Ptr (GSList (Ptr ()))
val :: Ptr (GSList (Ptr ())))

-- | Set the value of the “@widget_path_pspecs@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #widgetPathPspecs
-- @
clearBindingSetWidgetPathPspecs :: MonadIO m => BindingSet -> m ()
clearBindingSetWidgetPathPspecs :: BindingSet -> m ()
clearBindingSetWidgetPathPspecs s :: BindingSet
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (Ptr (GSList (Ptr ()))) -> Ptr (GSList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr (GSList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) (Ptr (GSList (Ptr ()))
forall a. Ptr a
FP.nullPtr :: Ptr (GSList (Ptr ())))

#if defined(ENABLE_OVERLOADING)
data BindingSetWidgetPathPspecsFieldInfo
instance AttrInfo BindingSetWidgetPathPspecsFieldInfo where
    type AttrBaseTypeConstraint BindingSetWidgetPathPspecsFieldInfo = (~) BindingSet
    type AttrAllowedOps BindingSetWidgetPathPspecsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint BindingSetWidgetPathPspecsFieldInfo = (~) (Ptr (GSList (Ptr ())))
    type AttrTransferTypeConstraint BindingSetWidgetPathPspecsFieldInfo = (~)(Ptr (GSList (Ptr ())))
    type AttrTransferType BindingSetWidgetPathPspecsFieldInfo = (Ptr (GSList (Ptr ())))
    type AttrGetType BindingSetWidgetPathPspecsFieldInfo = [Ptr ()]
    type AttrLabel BindingSetWidgetPathPspecsFieldInfo = "widget_path_pspecs"
    type AttrOrigin BindingSetWidgetPathPspecsFieldInfo = BindingSet
    attrGet = getBindingSetWidgetPathPspecs
    attrSet = setBindingSetWidgetPathPspecs
    attrConstruct = undefined
    attrClear = clearBindingSetWidgetPathPspecs
    attrTransfer _ v = do
        return v

bindingSet_widgetPathPspecs :: AttrLabelProxy "widgetPathPspecs"
bindingSet_widgetPathPspecs = AttrLabelProxy

#endif


-- | Get the value of the “@widget_class_pspecs@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindingSet #widgetClassPspecs
-- @
getBindingSetWidgetClassPspecs :: MonadIO m => BindingSet -> m ([Ptr ()])
getBindingSetWidgetClassPspecs :: BindingSet -> m [Ptr ()]
getBindingSetWidgetClassPspecs s :: BindingSet
s = IO [Ptr ()] -> m [Ptr ()]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr ()] -> m [Ptr ()]) -> IO [Ptr ()] -> m [Ptr ()]
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO [Ptr ()]) -> IO [Ptr ()]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO [Ptr ()]) -> IO [Ptr ()])
-> (Ptr BindingSet -> IO [Ptr ()]) -> IO [Ptr ()]
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (GSList (Ptr ()))
val <- Ptr (Ptr (GSList (Ptr ()))) -> IO (Ptr (GSList (Ptr ())))
forall a. Storable a => Ptr a -> IO a
peek (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr (GSList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) :: IO (Ptr (GSList (Ptr ())))
    [Ptr ()]
val' <- Ptr (GSList (Ptr ())) -> IO [Ptr ()]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr ()))
val
    [Ptr ()] -> IO [Ptr ()]
forall (m :: * -> *) a. Monad m => a -> m a
return [Ptr ()]
val'

-- | Set the value of the “@widget_class_pspecs@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindingSet [ #widgetClassPspecs 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindingSetWidgetClassPspecs :: MonadIO m => BindingSet -> Ptr (GSList (Ptr ())) -> m ()
setBindingSetWidgetClassPspecs :: BindingSet -> Ptr (GSList (Ptr ())) -> m ()
setBindingSetWidgetClassPspecs s :: BindingSet
s val :: Ptr (GSList (Ptr ()))
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (Ptr (GSList (Ptr ()))) -> Ptr (GSList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr (GSList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) (Ptr (GSList (Ptr ()))
val :: Ptr (GSList (Ptr ())))

-- | Set the value of the “@widget_class_pspecs@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #widgetClassPspecs
-- @
clearBindingSetWidgetClassPspecs :: MonadIO m => BindingSet -> m ()
clearBindingSetWidgetClassPspecs :: BindingSet -> m ()
clearBindingSetWidgetClassPspecs s :: BindingSet
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (Ptr (GSList (Ptr ()))) -> Ptr (GSList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr (GSList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) (Ptr (GSList (Ptr ()))
forall a. Ptr a
FP.nullPtr :: Ptr (GSList (Ptr ())))

#if defined(ENABLE_OVERLOADING)
data BindingSetWidgetClassPspecsFieldInfo
instance AttrInfo BindingSetWidgetClassPspecsFieldInfo where
    type AttrBaseTypeConstraint BindingSetWidgetClassPspecsFieldInfo = (~) BindingSet
    type AttrAllowedOps BindingSetWidgetClassPspecsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint BindingSetWidgetClassPspecsFieldInfo = (~) (Ptr (GSList (Ptr ())))
    type AttrTransferTypeConstraint BindingSetWidgetClassPspecsFieldInfo = (~)(Ptr (GSList (Ptr ())))
    type AttrTransferType BindingSetWidgetClassPspecsFieldInfo = (Ptr (GSList (Ptr ())))
    type AttrGetType BindingSetWidgetClassPspecsFieldInfo = [Ptr ()]
    type AttrLabel BindingSetWidgetClassPspecsFieldInfo = "widget_class_pspecs"
    type AttrOrigin BindingSetWidgetClassPspecsFieldInfo = BindingSet
    attrGet = getBindingSetWidgetClassPspecs
    attrSet = setBindingSetWidgetClassPspecs
    attrConstruct = undefined
    attrClear = clearBindingSetWidgetClassPspecs
    attrTransfer _ v = do
        return v

bindingSet_widgetClassPspecs :: AttrLabelProxy "widgetClassPspecs"
bindingSet_widgetClassPspecs = AttrLabelProxy

#endif


-- | Get the value of the “@class_branch_pspecs@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindingSet #classBranchPspecs
-- @
getBindingSetClassBranchPspecs :: MonadIO m => BindingSet -> m ([Ptr ()])
getBindingSetClassBranchPspecs :: BindingSet -> m [Ptr ()]
getBindingSetClassBranchPspecs s :: BindingSet
s = IO [Ptr ()] -> m [Ptr ()]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr ()] -> m [Ptr ()]) -> IO [Ptr ()] -> m [Ptr ()]
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO [Ptr ()]) -> IO [Ptr ()]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO [Ptr ()]) -> IO [Ptr ()])
-> (Ptr BindingSet -> IO [Ptr ()]) -> IO [Ptr ()]
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (GSList (Ptr ()))
val <- Ptr (Ptr (GSList (Ptr ()))) -> IO (Ptr (GSList (Ptr ())))
forall a. Storable a => Ptr a -> IO a
peek (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr (GSList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) :: IO (Ptr (GSList (Ptr ())))
    [Ptr ()]
val' <- Ptr (GSList (Ptr ())) -> IO [Ptr ()]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr ()))
val
    [Ptr ()] -> IO [Ptr ()]
forall (m :: * -> *) a. Monad m => a -> m a
return [Ptr ()]
val'

-- | Set the value of the “@class_branch_pspecs@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindingSet [ #classBranchPspecs 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindingSetClassBranchPspecs :: MonadIO m => BindingSet -> Ptr (GSList (Ptr ())) -> m ()
setBindingSetClassBranchPspecs :: BindingSet -> Ptr (GSList (Ptr ())) -> m ()
setBindingSetClassBranchPspecs s :: BindingSet
s val :: Ptr (GSList (Ptr ()))
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (Ptr (GSList (Ptr ()))) -> Ptr (GSList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr (GSList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) (Ptr (GSList (Ptr ()))
val :: Ptr (GSList (Ptr ())))

-- | Set the value of the “@class_branch_pspecs@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #classBranchPspecs
-- @
clearBindingSetClassBranchPspecs :: MonadIO m => BindingSet -> m ()
clearBindingSetClassBranchPspecs :: BindingSet -> m ()
clearBindingSetClassBranchPspecs s :: BindingSet
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (Ptr (GSList (Ptr ()))) -> Ptr (GSList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr (GSList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) (Ptr (GSList (Ptr ()))
forall a. Ptr a
FP.nullPtr :: Ptr (GSList (Ptr ())))

#if defined(ENABLE_OVERLOADING)
data BindingSetClassBranchPspecsFieldInfo
instance AttrInfo BindingSetClassBranchPspecsFieldInfo where
    type AttrBaseTypeConstraint BindingSetClassBranchPspecsFieldInfo = (~) BindingSet
    type AttrAllowedOps BindingSetClassBranchPspecsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint BindingSetClassBranchPspecsFieldInfo = (~) (Ptr (GSList (Ptr ())))
    type AttrTransferTypeConstraint BindingSetClassBranchPspecsFieldInfo = (~)(Ptr (GSList (Ptr ())))
    type AttrTransferType BindingSetClassBranchPspecsFieldInfo = (Ptr (GSList (Ptr ())))
    type AttrGetType BindingSetClassBranchPspecsFieldInfo = [Ptr ()]
    type AttrLabel BindingSetClassBranchPspecsFieldInfo = "class_branch_pspecs"
    type AttrOrigin BindingSetClassBranchPspecsFieldInfo = BindingSet
    attrGet = getBindingSetClassBranchPspecs
    attrSet = setBindingSetClassBranchPspecs
    attrConstruct = undefined
    attrClear = clearBindingSetClassBranchPspecs
    attrTransfer _ v = do
        return v

bindingSet_classBranchPspecs :: AttrLabelProxy "classBranchPspecs"
bindingSet_classBranchPspecs = AttrLabelProxy

#endif


-- | Get the value of the “@entries@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindingSet #entries
-- @
getBindingSetEntries :: MonadIO m => BindingSet -> m (Maybe Gtk.BindingEntry.BindingEntry)
getBindingSetEntries :: BindingSet -> m (Maybe BindingEntry)
getBindingSetEntries s :: BindingSet
s = IO (Maybe BindingEntry) -> m (Maybe BindingEntry)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BindingEntry) -> m (Maybe BindingEntry))
-> IO (Maybe BindingEntry) -> m (Maybe BindingEntry)
forall a b. (a -> b) -> a -> b
$ BindingSet
-> (Ptr BindingSet -> IO (Maybe BindingEntry))
-> IO (Maybe BindingEntry)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO (Maybe BindingEntry))
 -> IO (Maybe BindingEntry))
-> (Ptr BindingSet -> IO (Maybe BindingEntry))
-> IO (Maybe BindingEntry)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr BindingEntry
val <- Ptr (Ptr BindingEntry) -> IO (Ptr BindingEntry)
forall a. Storable a => Ptr a -> IO a
peek (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr BindingEntry)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) :: IO (Ptr Gtk.BindingEntry.BindingEntry)
    Maybe BindingEntry
result <- Ptr BindingEntry
-> (Ptr BindingEntry -> IO BindingEntry) -> IO (Maybe BindingEntry)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr BindingEntry
val ((Ptr BindingEntry -> IO BindingEntry) -> IO (Maybe BindingEntry))
-> (Ptr BindingEntry -> IO BindingEntry) -> IO (Maybe BindingEntry)
forall a b. (a -> b) -> a -> b
$ \val' :: Ptr BindingEntry
val' -> do
        BindingEntry
val'' <- ((ManagedPtr BindingEntry -> BindingEntry)
-> Ptr BindingEntry -> IO BindingEntry
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr BindingEntry -> BindingEntry
Gtk.BindingEntry.BindingEntry) Ptr BindingEntry
val'
        BindingEntry -> IO BindingEntry
forall (m :: * -> *) a. Monad m => a -> m a
return BindingEntry
val''
    Maybe BindingEntry -> IO (Maybe BindingEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BindingEntry
result

-- | Set the value of the “@entries@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindingSet [ #entries 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindingSetEntries :: MonadIO m => BindingSet -> Ptr Gtk.BindingEntry.BindingEntry -> m ()
setBindingSetEntries :: BindingSet -> Ptr BindingEntry -> m ()
setBindingSetEntries s :: BindingSet
s val :: Ptr BindingEntry
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (Ptr BindingEntry) -> Ptr BindingEntry -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr BindingEntry)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) (Ptr BindingEntry
val :: Ptr Gtk.BindingEntry.BindingEntry)

-- | Set the value of the “@entries@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #entries
-- @
clearBindingSetEntries :: MonadIO m => BindingSet -> m ()
clearBindingSetEntries :: BindingSet -> m ()
clearBindingSetEntries s :: BindingSet
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (Ptr BindingEntry) -> Ptr BindingEntry -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr BindingEntry)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) (Ptr BindingEntry
forall a. Ptr a
FP.nullPtr :: Ptr Gtk.BindingEntry.BindingEntry)

#if defined(ENABLE_OVERLOADING)
data BindingSetEntriesFieldInfo
instance AttrInfo BindingSetEntriesFieldInfo where
    type AttrBaseTypeConstraint BindingSetEntriesFieldInfo = (~) BindingSet
    type AttrAllowedOps BindingSetEntriesFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint BindingSetEntriesFieldInfo = (~) (Ptr Gtk.BindingEntry.BindingEntry)
    type AttrTransferTypeConstraint BindingSetEntriesFieldInfo = (~)(Ptr Gtk.BindingEntry.BindingEntry)
    type AttrTransferType BindingSetEntriesFieldInfo = (Ptr Gtk.BindingEntry.BindingEntry)
    type AttrGetType BindingSetEntriesFieldInfo = Maybe Gtk.BindingEntry.BindingEntry
    type AttrLabel BindingSetEntriesFieldInfo = "entries"
    type AttrOrigin BindingSetEntriesFieldInfo = BindingSet
    attrGet = getBindingSetEntries
    attrSet = setBindingSetEntries
    attrConstruct = undefined
    attrClear = clearBindingSetEntries
    attrTransfer _ v = do
        return v

bindingSet_entries :: AttrLabelProxy "entries"
bindingSet_entries = AttrLabelProxy

#endif


-- | Get the value of the “@current@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindingSet #current
-- @
getBindingSetCurrent :: MonadIO m => BindingSet -> m (Maybe Gtk.BindingEntry.BindingEntry)
getBindingSetCurrent :: BindingSet -> m (Maybe BindingEntry)
getBindingSetCurrent s :: BindingSet
s = IO (Maybe BindingEntry) -> m (Maybe BindingEntry)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BindingEntry) -> m (Maybe BindingEntry))
-> IO (Maybe BindingEntry) -> m (Maybe BindingEntry)
forall a b. (a -> b) -> a -> b
$ BindingSet
-> (Ptr BindingSet -> IO (Maybe BindingEntry))
-> IO (Maybe BindingEntry)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO (Maybe BindingEntry))
 -> IO (Maybe BindingEntry))
-> (Ptr BindingSet -> IO (Maybe BindingEntry))
-> IO (Maybe BindingEntry)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr BindingEntry
val <- Ptr (Ptr BindingEntry) -> IO (Ptr BindingEntry)
forall a. Storable a => Ptr a -> IO a
peek (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr BindingEntry)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48) :: IO (Ptr Gtk.BindingEntry.BindingEntry)
    Maybe BindingEntry
result <- Ptr BindingEntry
-> (Ptr BindingEntry -> IO BindingEntry) -> IO (Maybe BindingEntry)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr BindingEntry
val ((Ptr BindingEntry -> IO BindingEntry) -> IO (Maybe BindingEntry))
-> (Ptr BindingEntry -> IO BindingEntry) -> IO (Maybe BindingEntry)
forall a b. (a -> b) -> a -> b
$ \val' :: Ptr BindingEntry
val' -> do
        BindingEntry
val'' <- ((ManagedPtr BindingEntry -> BindingEntry)
-> Ptr BindingEntry -> IO BindingEntry
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr BindingEntry -> BindingEntry
Gtk.BindingEntry.BindingEntry) Ptr BindingEntry
val'
        BindingEntry -> IO BindingEntry
forall (m :: * -> *) a. Monad m => a -> m a
return BindingEntry
val''
    Maybe BindingEntry -> IO (Maybe BindingEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BindingEntry
result

-- | Set the value of the “@current@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindingSet [ #current 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindingSetCurrent :: MonadIO m => BindingSet -> Ptr Gtk.BindingEntry.BindingEntry -> m ()
setBindingSetCurrent :: BindingSet -> Ptr BindingEntry -> m ()
setBindingSetCurrent s :: BindingSet
s val :: Ptr BindingEntry
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (Ptr BindingEntry) -> Ptr BindingEntry -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr BindingEntry)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48) (Ptr BindingEntry
val :: Ptr Gtk.BindingEntry.BindingEntry)

-- | Set the value of the “@current@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #current
-- @
clearBindingSetCurrent :: MonadIO m => BindingSet -> m ()
clearBindingSetCurrent :: BindingSet -> m ()
clearBindingSetCurrent s :: BindingSet
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr (Ptr BindingEntry) -> Ptr BindingEntry -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr (Ptr BindingEntry)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48) (Ptr BindingEntry
forall a. Ptr a
FP.nullPtr :: Ptr Gtk.BindingEntry.BindingEntry)

#if defined(ENABLE_OVERLOADING)
data BindingSetCurrentFieldInfo
instance AttrInfo BindingSetCurrentFieldInfo where
    type AttrBaseTypeConstraint BindingSetCurrentFieldInfo = (~) BindingSet
    type AttrAllowedOps BindingSetCurrentFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint BindingSetCurrentFieldInfo = (~) (Ptr Gtk.BindingEntry.BindingEntry)
    type AttrTransferTypeConstraint BindingSetCurrentFieldInfo = (~)(Ptr Gtk.BindingEntry.BindingEntry)
    type AttrTransferType BindingSetCurrentFieldInfo = (Ptr Gtk.BindingEntry.BindingEntry)
    type AttrGetType BindingSetCurrentFieldInfo = Maybe Gtk.BindingEntry.BindingEntry
    type AttrLabel BindingSetCurrentFieldInfo = "current"
    type AttrOrigin BindingSetCurrentFieldInfo = BindingSet
    attrGet = getBindingSetCurrent
    attrSet = setBindingSetCurrent
    attrConstruct = undefined
    attrClear = clearBindingSetCurrent
    attrTransfer _ v = do
        return v

bindingSet_current :: AttrLabelProxy "current"
bindingSet_current = AttrLabelProxy

#endif


-- | Get the value of the “@parsed@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindingSet #parsed
-- @
getBindingSetParsed :: MonadIO m => BindingSet -> m Word32
getBindingSetParsed :: BindingSet -> m Word32
getBindingSetParsed s :: BindingSet
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO Word32) -> IO Word32)
-> (Ptr BindingSet -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@parsed@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindingSet [ #parsed 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindingSetParsed :: MonadIO m => BindingSet -> Word32 -> m ()
setBindingSetParsed :: BindingSet -> Word32 -> m ()
setBindingSetParsed s :: BindingSet
s val :: Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BindingSet -> (Ptr BindingSet -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BindingSet
s ((Ptr BindingSet -> IO ()) -> IO ())
-> (Ptr BindingSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BindingSet
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BindingSet
ptr Ptr BindingSet -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data BindingSetParsedFieldInfo
instance AttrInfo BindingSetParsedFieldInfo where
    type AttrBaseTypeConstraint BindingSetParsedFieldInfo = (~) BindingSet
    type AttrAllowedOps BindingSetParsedFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint BindingSetParsedFieldInfo = (~) Word32
    type AttrTransferTypeConstraint BindingSetParsedFieldInfo = (~)Word32
    type AttrTransferType BindingSetParsedFieldInfo = Word32
    type AttrGetType BindingSetParsedFieldInfo = Word32
    type AttrLabel BindingSetParsedFieldInfo = "parsed"
    type AttrOrigin BindingSetParsedFieldInfo = BindingSet
    attrGet = getBindingSetParsed
    attrSet = setBindingSetParsed
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

bindingSet_parsed :: AttrLabelProxy "parsed"
bindingSet_parsed = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BindingSet
type instance O.AttributeList BindingSet = BindingSetAttributeList
type BindingSetAttributeList = ('[ '("setName", BindingSetSetNameFieldInfo), '("priority", BindingSetPriorityFieldInfo), '("widgetPathPspecs", BindingSetWidgetPathPspecsFieldInfo), '("widgetClassPspecs", BindingSetWidgetClassPspecsFieldInfo), '("classBranchPspecs", BindingSetClassBranchPspecsFieldInfo), '("entries", BindingSetEntriesFieldInfo), '("current", BindingSetCurrentFieldInfo), '("parsed", BindingSetParsedFieldInfo)] :: [(Symbol, *)])
#endif

-- method BindingSet::activate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "binding_set"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "BindingSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkBindingSet set to activate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "key value of the binding"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "key modifier of the binding"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "object to activate when binding found"
--                 , 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 "gtk_binding_set_activate" gtk_binding_set_activate :: 
    Ptr BindingSet ->                       -- binding_set : TInterface (Name {namespace = "Gtk", name = "BindingSet"})
    Word32 ->                               -- keyval : TBasicType TUInt
    CUInt ->                                -- modifiers : TInterface (Name {namespace = "Gdk", name = "ModifierType"})
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    IO CInt

-- | Find a key binding matching /@keyval@/ and /@modifiers@/ within
-- /@bindingSet@/ and activate the binding on /@object@/.
bindingSetActivate ::
    (B.CallStack.HasCallStack, MonadIO m, GObject.Object.IsObject a) =>
    BindingSet
    -- ^ /@bindingSet@/: a t'GI.Gtk.Structs.BindingSet.BindingSet' set to activate
    -> Word32
    -- ^ /@keyval@/: key value of the binding
    -> [Gdk.Flags.ModifierType]
    -- ^ /@modifiers@/: key modifier of the binding
    -> a
    -- ^ /@object@/: object to activate when binding found
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a binding was found and activated
bindingSetActivate :: BindingSet -> Word32 -> [ModifierType] -> a -> m Bool
bindingSetActivate bindingSet :: BindingSet
bindingSet keyval :: Word32
keyval modifiers :: [ModifierType]
modifiers object :: a
object = IO Bool -> m Bool
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 BindingSet
bindingSet' <- BindingSet -> IO (Ptr BindingSet)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BindingSet
bindingSet
    let modifiers' :: CUInt
modifiers' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
modifiers
    Ptr Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    CInt
result <- Ptr BindingSet -> Word32 -> CUInt -> Ptr Object -> IO CInt
gtk_binding_set_activate Ptr BindingSet
bindingSet' Word32
keyval CUInt
modifiers' Ptr Object
object'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    BindingSet -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BindingSet
bindingSet
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BindingSetActivateMethodInfo
instance (signature ~ (Word32 -> [Gdk.Flags.ModifierType] -> a -> m Bool), MonadIO m, GObject.Object.IsObject a) => O.MethodInfo BindingSetActivateMethodInfo BindingSet signature where
    overloadedMethod = bindingSetActivate

#endif

-- method BindingSet::add_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "binding_set"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "BindingSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkBindingSet to add a path to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path_type"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PathType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "path type the pattern applies to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path_pattern"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the actual match pattern"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PathPriorityType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "binding priority" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_binding_set_add_path" gtk_binding_set_add_path :: 
    Ptr BindingSet ->                       -- binding_set : TInterface (Name {namespace = "Gtk", name = "BindingSet"})
    CUInt ->                                -- path_type : TInterface (Name {namespace = "Gtk", name = "PathType"})
    CString ->                              -- path_pattern : TBasicType TUTF8
    CUInt ->                                -- priority : TInterface (Name {namespace = "Gtk", name = "PathPriorityType"})
    IO ()

{-# DEPRECATED bindingSetAddPath ["(Since version 3.0)"] #-}
-- | This function was used internally by the GtkRC parsing mechanism
-- to assign match patterns to t'GI.Gtk.Structs.BindingSet.BindingSet' structures.
-- 
-- In GTK+ 3, these match patterns are unused.
bindingSetAddPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BindingSet
    -- ^ /@bindingSet@/: a t'GI.Gtk.Structs.BindingSet.BindingSet' to add a path to
    -> Gtk.Enums.PathType
    -- ^ /@pathType@/: path type the pattern applies to
    -> T.Text
    -- ^ /@pathPattern@/: the actual match pattern
    -> Gtk.Enums.PathPriorityType
    -- ^ /@priority@/: binding priority
    -> m ()
bindingSetAddPath :: BindingSet -> PathType -> Text -> PathPriorityType -> m ()
bindingSetAddPath bindingSet :: BindingSet
bindingSet pathType :: PathType
pathType pathPattern :: Text
pathPattern priority :: PathPriorityType
priority = 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 BindingSet
bindingSet' <- BindingSet -> IO (Ptr BindingSet)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BindingSet
bindingSet
    let pathType' :: CUInt
pathType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PathType -> Int) -> PathType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathType -> Int
forall a. Enum a => a -> Int
fromEnum) PathType
pathType
    CString
pathPattern' <- Text -> IO CString
textToCString Text
pathPattern
    let priority' :: CUInt
priority' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (PathPriorityType -> Int) -> PathPriorityType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathPriorityType -> Int
forall a. Enum a => a -> Int
fromEnum) PathPriorityType
priority
    Ptr BindingSet -> CUInt -> CString -> CUInt -> IO ()
gtk_binding_set_add_path Ptr BindingSet
bindingSet' CUInt
pathType' CString
pathPattern' CUInt
priority'
    BindingSet -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BindingSet
bindingSet
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pathPattern'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingSetAddPathMethodInfo
instance (signature ~ (Gtk.Enums.PathType -> T.Text -> Gtk.Enums.PathPriorityType -> m ()), MonadIO m) => O.MethodInfo BindingSetAddPathMethodInfo BindingSet signature where
    overloadedMethod = bindingSetAddPath

#endif

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

foreign import ccall "gtk_binding_set_find" gtk_binding_set_find :: 
    CString ->                              -- set_name : TBasicType TUTF8
    IO (Ptr BindingSet)

-- | Find a binding set by its globally unique name.
-- 
-- The /@setName@/ can either be a name used for @/gtk_binding_set_new()/@
-- or the type name of a class used in @/gtk_binding_set_by_class()/@.
bindingSetFind ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@setName@/: unique binding set name
    -> m (Maybe BindingSet)
    -- ^ __Returns:__ 'P.Nothing' or the specified binding set
bindingSetFind :: Text -> m (Maybe BindingSet)
bindingSetFind setName :: Text
setName = IO (Maybe BindingSet) -> m (Maybe BindingSet)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BindingSet) -> m (Maybe BindingSet))
-> IO (Maybe BindingSet) -> m (Maybe BindingSet)
forall a b. (a -> b) -> a -> b
$ do
    CString
setName' <- Text -> IO CString
textToCString Text
setName
    Ptr BindingSet
result <- CString -> IO (Ptr BindingSet)
gtk_binding_set_find CString
setName'
    Maybe BindingSet
maybeResult <- Ptr BindingSet
-> (Ptr BindingSet -> IO BindingSet) -> IO (Maybe BindingSet)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BindingSet
result ((Ptr BindingSet -> IO BindingSet) -> IO (Maybe BindingSet))
-> (Ptr BindingSet -> IO BindingSet) -> IO (Maybe BindingSet)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr BindingSet
result' -> do
        BindingSet
result'' <- ((ManagedPtr BindingSet -> BindingSet)
-> Ptr BindingSet -> IO BindingSet
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr BindingSet -> BindingSet
BindingSet) Ptr BindingSet
result'
        BindingSet -> IO BindingSet
forall (m :: * -> *) a. Monad m => a -> m a
return BindingSet
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
setName'
    Maybe BindingSet -> IO (Maybe BindingSet)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BindingSet
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBindingSetMethod (t :: Symbol) (o :: *) :: * where
    ResolveBindingSetMethod "activate" o = BindingSetActivateMethodInfo
    ResolveBindingSetMethod "addPath" o = BindingSetAddPathMethodInfo
    ResolveBindingSetMethod l o = O.MethodResolutionFailed l o

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

#endif