{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gtk.Objects.AccelGroup
    ( 

-- * Exported types
    AccelGroup(..)                          ,
    AccelGroupK                             ,
    toAccelGroup                            ,
    noAccelGroup                            ,


 -- * Methods
-- ** accelGroupActivate
    accelGroupActivate                      ,


-- ** accelGroupConnect
    accelGroupConnect                       ,


-- ** accelGroupConnectByPath
    accelGroupConnectByPath                 ,


-- ** accelGroupDisconnect
    accelGroupDisconnect                    ,


-- ** accelGroupDisconnectKey
    accelGroupDisconnectKey                 ,


-- ** accelGroupFind
    accelGroupFind                          ,


-- ** accelGroupFromAccelClosure
    accelGroupFromAccelClosure              ,


-- ** accelGroupGetIsLocked
    accelGroupGetIsLocked                   ,


-- ** accelGroupGetModifierMask
    accelGroupGetModifierMask               ,


-- ** accelGroupLock
    accelGroupLock                          ,


-- ** accelGroupNew
    accelGroupNew                           ,


-- ** accelGroupQuery
    accelGroupQuery                         ,


-- ** accelGroupUnlock
    accelGroupUnlock                        ,




 -- * Properties
-- ** IsLocked
    AccelGroupIsLockedPropertyInfo          ,
    getAccelGroupIsLocked                   ,


-- ** ModifierMask
    AccelGroupModifierMaskPropertyInfo      ,
    getAccelGroupModifierMask               ,




 -- * Signals
-- ** AccelActivate
    AccelGroupAccelActivateCallback         ,
    AccelGroupAccelActivateCallbackC        ,
    AccelGroupAccelActivateSignalInfo       ,
    accelGroupAccelActivateCallbackWrapper  ,
    accelGroupAccelActivateClosure          ,
    afterAccelGroupAccelActivate            ,
    mkAccelGroupAccelActivateCallback       ,
    noAccelGroupAccelActivateCallback       ,
    onAccelGroupAccelActivate               ,


-- ** AccelChanged
    AccelGroupAccelChangedCallback          ,
    AccelGroupAccelChangedCallbackC         ,
    AccelGroupAccelChangedSignalInfo        ,
    accelGroupAccelChangedCallbackWrapper   ,
    accelGroupAccelChangedClosure           ,
    afterAccelGroupAccelChanged             ,
    mkAccelGroupAccelChangedCallback        ,
    noAccelGroupAccelChangedCallback        ,
    onAccelGroupAccelChanged                ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gtk.Types
import GI.Gtk.Callbacks
import qualified GI.GObject as GObject
import qualified GI.Gdk as Gdk

newtype AccelGroup = AccelGroup (ForeignPtr AccelGroup)
foreign import ccall "gtk_accel_group_get_type"
    c_gtk_accel_group_get_type :: IO GType

type instance ParentTypes AccelGroup = AccelGroupParentTypes
type AccelGroupParentTypes = '[GObject.Object]

instance GObject AccelGroup where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_gtk_accel_group_get_type
    

class GObject o => AccelGroupK o
instance (GObject o, IsDescendantOf AccelGroup o) => AccelGroupK o

toAccelGroup :: AccelGroupK o => o -> IO AccelGroup
toAccelGroup = unsafeCastTo AccelGroup

noAccelGroup :: Maybe AccelGroup
noAccelGroup = Nothing

-- signal AccelGroup::accel-activate
type AccelGroupAccelActivateCallback =
    GObject.Object ->
    Word32 ->
    [Gdk.ModifierType] ->
    IO Bool

noAccelGroupAccelActivateCallback :: Maybe AccelGroupAccelActivateCallback
noAccelGroupAccelActivateCallback = Nothing

type AccelGroupAccelActivateCallbackC =
    Ptr () ->                               -- object
    Ptr GObject.Object ->
    Word32 ->
    CUInt ->
    Ptr () ->                               -- user_data
    IO CInt

foreign import ccall "wrapper"
    mkAccelGroupAccelActivateCallback :: AccelGroupAccelActivateCallbackC -> IO (FunPtr AccelGroupAccelActivateCallbackC)

accelGroupAccelActivateClosure :: AccelGroupAccelActivateCallback -> IO Closure
accelGroupAccelActivateClosure cb = newCClosure =<< mkAccelGroupAccelActivateCallback wrapped
    where wrapped = accelGroupAccelActivateCallbackWrapper cb

accelGroupAccelActivateCallbackWrapper ::
    AccelGroupAccelActivateCallback ->
    Ptr () ->
    Ptr GObject.Object ->
    Word32 ->
    CUInt ->
    Ptr () ->
    IO CInt
accelGroupAccelActivateCallbackWrapper _cb _ acceleratable keyval modifier _ = do
    acceleratable' <- (newObject GObject.Object) acceleratable
    let modifier' = wordToGFlags modifier
    result <- _cb  acceleratable' keyval modifier'
    let result' = (fromIntegral . fromEnum) result
    return result'

onAccelGroupAccelActivate :: (GObject a, MonadIO m) => a -> AccelGroupAccelActivateCallback -> m SignalHandlerId
onAccelGroupAccelActivate obj cb = liftIO $ connectAccelGroupAccelActivate obj cb SignalConnectBefore
afterAccelGroupAccelActivate :: (GObject a, MonadIO m) => a -> AccelGroupAccelActivateCallback -> m SignalHandlerId
afterAccelGroupAccelActivate obj cb = connectAccelGroupAccelActivate obj cb SignalConnectAfter

connectAccelGroupAccelActivate :: (GObject a, MonadIO m) =>
                                  a -> AccelGroupAccelActivateCallback -> SignalConnectMode -> m SignalHandlerId
connectAccelGroupAccelActivate obj cb after = liftIO $ do
    cb' <- mkAccelGroupAccelActivateCallback (accelGroupAccelActivateCallbackWrapper cb)
    connectSignalFunPtr obj "accel-activate" cb' after

-- signal AccelGroup::accel-changed
type AccelGroupAccelChangedCallback =
    Word32 ->
    [Gdk.ModifierType] ->
    Closure ->
    IO ()

noAccelGroupAccelChangedCallback :: Maybe AccelGroupAccelChangedCallback
noAccelGroupAccelChangedCallback = Nothing

type AccelGroupAccelChangedCallbackC =
    Ptr () ->                               -- object
    Word32 ->
    CUInt ->
    Ptr Closure ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkAccelGroupAccelChangedCallback :: AccelGroupAccelChangedCallbackC -> IO (FunPtr AccelGroupAccelChangedCallbackC)

accelGroupAccelChangedClosure :: AccelGroupAccelChangedCallback -> IO Closure
accelGroupAccelChangedClosure cb = newCClosure =<< mkAccelGroupAccelChangedCallback wrapped
    where wrapped = accelGroupAccelChangedCallbackWrapper cb

accelGroupAccelChangedCallbackWrapper ::
    AccelGroupAccelChangedCallback ->
    Ptr () ->
    Word32 ->
    CUInt ->
    Ptr Closure ->
    Ptr () ->
    IO ()
accelGroupAccelChangedCallbackWrapper _cb _ keyval modifier accel_closure _ = do
    let modifier' = wordToGFlags modifier
    accel_closure' <- (newBoxed Closure) accel_closure
    _cb  keyval modifier' accel_closure'

onAccelGroupAccelChanged :: (GObject a, MonadIO m) => a -> AccelGroupAccelChangedCallback -> m SignalHandlerId
onAccelGroupAccelChanged obj cb = liftIO $ connectAccelGroupAccelChanged obj cb SignalConnectBefore
afterAccelGroupAccelChanged :: (GObject a, MonadIO m) => a -> AccelGroupAccelChangedCallback -> m SignalHandlerId
afterAccelGroupAccelChanged obj cb = connectAccelGroupAccelChanged obj cb SignalConnectAfter

connectAccelGroupAccelChanged :: (GObject a, MonadIO m) =>
                                 a -> AccelGroupAccelChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectAccelGroupAccelChanged obj cb after = liftIO $ do
    cb' <- mkAccelGroupAccelChangedCallback (accelGroupAccelChangedCallbackWrapper cb)
    connectSignalFunPtr obj "accel-changed" cb' after

-- VVV Prop "is-locked"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]

getAccelGroupIsLocked :: (MonadIO m, AccelGroupK o) => o -> m Bool
getAccelGroupIsLocked obj = liftIO $ getObjectPropertyBool obj "is-locked"

data AccelGroupIsLockedPropertyInfo
instance AttrInfo AccelGroupIsLockedPropertyInfo where
    type AttrAllowedOps AccelGroupIsLockedPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint AccelGroupIsLockedPropertyInfo = (~) ()
    type AttrBaseTypeConstraint AccelGroupIsLockedPropertyInfo = AccelGroupK
    type AttrGetType AccelGroupIsLockedPropertyInfo = Bool
    type AttrLabel AccelGroupIsLockedPropertyInfo = "AccelGroup::is-locked"
    attrGet _ = getAccelGroupIsLocked
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "modifier-mask"
   -- Type: TInterface "Gdk" "ModifierType"
   -- Flags: [PropertyReadable]

getAccelGroupModifierMask :: (MonadIO m, AccelGroupK o) => o -> m [Gdk.ModifierType]
getAccelGroupModifierMask obj = liftIO $ getObjectPropertyFlags obj "modifier-mask"

data AccelGroupModifierMaskPropertyInfo
instance AttrInfo AccelGroupModifierMaskPropertyInfo where
    type AttrAllowedOps AccelGroupModifierMaskPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint AccelGroupModifierMaskPropertyInfo = (~) ()
    type AttrBaseTypeConstraint AccelGroupModifierMaskPropertyInfo = AccelGroupK
    type AttrGetType AccelGroupModifierMaskPropertyInfo = [Gdk.ModifierType]
    type AttrLabel AccelGroupModifierMaskPropertyInfo = "AccelGroup::modifier-mask"
    attrGet _ = getAccelGroupModifierMask
    attrSet _ = undefined
    attrConstruct _ = undefined

type instance AttributeList AccelGroup = AccelGroupAttributeList
type AccelGroupAttributeList = ('[ '("is-locked", AccelGroupIsLockedPropertyInfo), '("modifier-mask", AccelGroupModifierMaskPropertyInfo)] :: [(Symbol, *)])

data AccelGroupAccelActivateSignalInfo
instance SignalInfo AccelGroupAccelActivateSignalInfo where
    type HaskellCallbackType AccelGroupAccelActivateSignalInfo = AccelGroupAccelActivateCallback
    connectSignal _ = connectAccelGroupAccelActivate

data AccelGroupAccelChangedSignalInfo
instance SignalInfo AccelGroupAccelChangedSignalInfo where
    type HaskellCallbackType AccelGroupAccelChangedSignalInfo = AccelGroupAccelChangedCallback
    connectSignal _ = connectAccelGroupAccelChanged

type instance SignalList AccelGroup = AccelGroupSignalList
type AccelGroupSignalList = ('[ '("accel-activate", AccelGroupAccelActivateSignalInfo), '("accel-changed", AccelGroupAccelChangedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method AccelGroup::new
-- method type : Constructor
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "Gtk" "AccelGroup"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_new" gtk_accel_group_new :: 
    IO (Ptr AccelGroup)


accelGroupNew ::
    (MonadIO m) =>
    m AccelGroup
accelGroupNew  = liftIO $ do
    result <- gtk_accel_group_new
    checkUnexpectedReturnNULL "gtk_accel_group_new" result
    result' <- (wrapObject AccelGroup) result
    return result'

-- method AccelGroup::activate
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "acceleratable", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "acceleratable", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_activate" gtk_accel_group_activate :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    Word32 ->                               -- accel_quark : TBasicType TUInt32
    Ptr GObject.Object ->                   -- acceleratable : TInterface "GObject" "Object"
    Word32 ->                               -- accel_key : TBasicType TUInt32
    CUInt ->                                -- accel_mods : TInterface "Gdk" "ModifierType"
    IO CInt


accelGroupActivate ::
    (MonadIO m, AccelGroupK a, GObject.ObjectK b) =>
    a ->                                    -- _obj
    Word32 ->                               -- accel_quark
    b ->                                    -- acceleratable
    Word32 ->                               -- accel_key
    [Gdk.ModifierType] ->                   -- accel_mods
    m Bool
accelGroupActivate _obj accel_quark acceleratable accel_key accel_mods = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let acceleratable' = unsafeManagedPtrCastPtr acceleratable
    let accel_mods' = gflagsToWord accel_mods
    result <- gtk_accel_group_activate _obj' accel_quark acceleratable' accel_key accel_mods'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr acceleratable
    return result'

-- method AccelGroup::connect
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_flags", argType = TInterface "Gtk" "AccelFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_flags", argType = TInterface "Gtk" "AccelFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_connect" gtk_accel_group_connect :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    Word32 ->                               -- accel_key : TBasicType TUInt32
    CUInt ->                                -- accel_mods : TInterface "Gdk" "ModifierType"
    CUInt ->                                -- accel_flags : TInterface "Gtk" "AccelFlags"
    Ptr Closure ->                          -- closure : TInterface "GObject" "Closure"
    IO ()


accelGroupConnect ::
    (MonadIO m, AccelGroupK a) =>
    a ->                                    -- _obj
    Word32 ->                               -- accel_key
    [Gdk.ModifierType] ->                   -- accel_mods
    [AccelFlags] ->                         -- accel_flags
    Closure ->                              -- closure
    m ()
accelGroupConnect _obj accel_key accel_mods accel_flags closure = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let accel_mods' = gflagsToWord accel_mods
    let accel_flags' = gflagsToWord accel_flags
    let closure' = unsafeManagedPtrGetPtr closure
    gtk_accel_group_connect _obj' accel_key accel_mods' accel_flags' closure'
    touchManagedPtr _obj
    touchManagedPtr closure
    return ()

-- method AccelGroup::connect_by_path
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_connect_by_path" gtk_accel_group_connect_by_path :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    CString ->                              -- accel_path : TBasicType TUTF8
    Ptr Closure ->                          -- closure : TInterface "GObject" "Closure"
    IO ()


accelGroupConnectByPath ::
    (MonadIO m, AccelGroupK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- accel_path
    Closure ->                              -- closure
    m ()
accelGroupConnectByPath _obj accel_path closure = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    accel_path' <- textToCString accel_path
    let closure' = unsafeManagedPtrGetPtr closure
    gtk_accel_group_connect_by_path _obj' accel_path' closure'
    touchManagedPtr _obj
    touchManagedPtr closure
    freeMem accel_path'
    return ()

-- method AccelGroup::disconnect
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_disconnect" gtk_accel_group_disconnect :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    Ptr Closure ->                          -- closure : TInterface "GObject" "Closure"
    IO CInt


accelGroupDisconnect ::
    (MonadIO m, AccelGroupK a) =>
    a ->                                    -- _obj
    Maybe (Closure) ->                      -- closure
    m Bool
accelGroupDisconnect _obj closure = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeClosure <- case closure of
        Nothing -> return nullPtr
        Just jClosure -> do
            let jClosure' = unsafeManagedPtrGetPtr jClosure
            return jClosure'
    result <- gtk_accel_group_disconnect _obj' maybeClosure
    let result' = (/= 0) result
    touchManagedPtr _obj
    whenJust closure touchManagedPtr
    return result'

-- method AccelGroup::disconnect_key
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_disconnect_key" gtk_accel_group_disconnect_key :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    Word32 ->                               -- accel_key : TBasicType TUInt32
    CUInt ->                                -- accel_mods : TInterface "Gdk" "ModifierType"
    IO CInt


accelGroupDisconnectKey ::
    (MonadIO m, AccelGroupK a) =>
    a ->                                    -- _obj
    Word32 ->                               -- accel_key
    [Gdk.ModifierType] ->                   -- accel_mods
    m Bool
accelGroupDisconnectKey _obj accel_key accel_mods = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let accel_mods' = gflagsToWord accel_mods
    result <- gtk_accel_group_disconnect_key _obj' accel_key accel_mods'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method AccelGroup::find
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "find_func", argType = TInterface "Gtk" "AccelGroupFindFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "find_func", argType = TInterface "Gtk" "AccelGroupFindFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "AccelKey"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_find" gtk_accel_group_find :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    FunPtr AccelGroupFindFuncC ->           -- find_func : TInterface "Gtk" "AccelGroupFindFunc"
    Ptr () ->                               -- data : TBasicType TVoid
    IO (Ptr AccelKey)


accelGroupFind ::
    (MonadIO m, AccelGroupK a) =>
    a ->                                    -- _obj
    AccelGroupFindFunc ->                   -- find_func
    m AccelKey
accelGroupFind _obj find_func = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    find_func' <- mkAccelGroupFindFunc (accelGroupFindFuncWrapper Nothing find_func)
    let data_ = nullPtr
    result <- gtk_accel_group_find _obj' find_func' data_
    checkUnexpectedReturnNULL "gtk_accel_group_find" result
    result' <- (newPtr 12 AccelKey) result
    safeFreeFunPtr $ castFunPtrToPtr find_func'
    touchManagedPtr _obj
    return result'

-- method AccelGroup::get_is_locked
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_get_is_locked" gtk_accel_group_get_is_locked :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    IO CInt


accelGroupGetIsLocked ::
    (MonadIO m, AccelGroupK a) =>
    a ->                                    -- _obj
    m Bool
accelGroupGetIsLocked _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_accel_group_get_is_locked _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method AccelGroup::get_modifier_mask
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "ModifierType"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_get_modifier_mask" gtk_accel_group_get_modifier_mask :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    IO CUInt


accelGroupGetModifierMask ::
    (MonadIO m, AccelGroupK a) =>
    a ->                                    -- _obj
    m [Gdk.ModifierType]
accelGroupGetModifierMask _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_accel_group_get_modifier_mask _obj'
    let result' = wordToGFlags result
    touchManagedPtr _obj
    return result'

-- method AccelGroup::lock
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_lock" gtk_accel_group_lock :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    IO ()


accelGroupLock ::
    (MonadIO m, AccelGroupK a) =>
    a ->                                    -- _obj
    m ()
accelGroupLock _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_accel_group_lock _obj'
    touchManagedPtr _obj
    return ()

-- method AccelGroup::query
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_entries", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : [Arg {argName = "n_entries", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_key", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_mods", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TCArray False (-1) 3 (TInterface "Gtk" "AccelGroupEntry")
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_query" gtk_accel_group_query :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    Word32 ->                               -- accel_key : TBasicType TUInt32
    CUInt ->                                -- accel_mods : TInterface "Gdk" "ModifierType"
    Ptr Word32 ->                           -- n_entries : TBasicType TUInt32
    IO (Ptr AccelGroupEntry)


accelGroupQuery ::
    (MonadIO m, AccelGroupK a) =>
    a ->                                    -- _obj
    Word32 ->                               -- accel_key
    [Gdk.ModifierType] ->                   -- accel_mods
    m [AccelGroupEntry]
accelGroupQuery _obj accel_key accel_mods = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let accel_mods' = gflagsToWord accel_mods
    n_entries <- allocMem :: IO (Ptr Word32)
    result <- gtk_accel_group_query _obj' accel_key accel_mods' n_entries
    n_entries' <- peek n_entries
    checkUnexpectedReturnNULL "gtk_accel_group_query" result
    result' <- (unpackBlockArrayWithLength 32 n_entries') result
    result'' <- mapM (newPtr 32 AccelGroupEntry) result'
    touchManagedPtr _obj
    freeMem n_entries
    return result''

-- method AccelGroup::unlock
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "AccelGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_unlock" gtk_accel_group_unlock :: 
    Ptr AccelGroup ->                       -- _obj : TInterface "Gtk" "AccelGroup"
    IO ()


accelGroupUnlock ::
    (MonadIO m, AccelGroupK a) =>
    a ->                                    -- _obj
    m ()
accelGroupUnlock _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_accel_group_unlock _obj'
    touchManagedPtr _obj
    return ()

-- method AccelGroup::from_accel_closure
-- method type : MemberFunction
-- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "AccelGroup"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_group_from_accel_closure" gtk_accel_group_from_accel_closure :: 
    Ptr Closure ->                          -- closure : TInterface "GObject" "Closure"
    IO (Ptr AccelGroup)


accelGroupFromAccelClosure ::
    (MonadIO m) =>
    Closure ->                              -- closure
    m AccelGroup
accelGroupFromAccelClosure closure = liftIO $ do
    let closure' = unsafeManagedPtrGetPtr closure
    result <- gtk_accel_group_from_accel_closure closure'
    checkUnexpectedReturnNULL "gtk_accel_group_from_accel_closure" result
    result' <- (newObject AccelGroup) result
    touchManagedPtr closure
    return result'