{- |
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.Gdk.Objects.Keymap
    ( 

-- * Exported types
    Keymap(..)                              ,
    KeymapK                                 ,
    toKeymap                                ,
    noKeymap                                ,


 -- * Methods
-- ** keymapAddVirtualModifiers
    keymapAddVirtualModifiers               ,


-- ** keymapGetCapsLockState
    keymapGetCapsLockState                  ,


-- ** keymapGetDefault
    keymapGetDefault                        ,


-- ** keymapGetDirection
    keymapGetDirection                      ,


-- ** keymapGetEntriesForKeycode
    keymapGetEntriesForKeycode              ,


-- ** keymapGetEntriesForKeyval
    keymapGetEntriesForKeyval               ,


-- ** keymapGetForDisplay
    keymapGetForDisplay                     ,


-- ** keymapGetModifierMask
    keymapGetModifierMask                   ,


-- ** keymapGetModifierState
    keymapGetModifierState                  ,


-- ** keymapGetNumLockState
    keymapGetNumLockState                   ,


-- ** keymapGetScrollLockState
    keymapGetScrollLockState                ,


-- ** keymapHaveBidiLayouts
    keymapHaveBidiLayouts                   ,


-- ** keymapLookupKey
    keymapLookupKey                         ,


-- ** keymapMapVirtualModifiers
    keymapMapVirtualModifiers               ,


-- ** keymapTranslateKeyboardState
    keymapTranslateKeyboardState            ,




 -- * Signals
-- ** DirectionChanged
    KeymapDirectionChangedCallback          ,
    KeymapDirectionChangedCallbackC         ,
    KeymapDirectionChangedSignalInfo        ,
    afterKeymapDirectionChanged             ,
    keymapDirectionChangedCallbackWrapper   ,
    keymapDirectionChangedClosure           ,
    mkKeymapDirectionChangedCallback        ,
    noKeymapDirectionChangedCallback        ,
    onKeymapDirectionChanged                ,


-- ** KeysChanged
    KeymapKeysChangedCallback               ,
    KeymapKeysChangedCallbackC              ,
    KeymapKeysChangedSignalInfo             ,
    afterKeymapKeysChanged                  ,
    keymapKeysChangedCallbackWrapper        ,
    keymapKeysChangedClosure                ,
    mkKeymapKeysChangedCallback             ,
    noKeymapKeysChangedCallback             ,
    onKeymapKeysChanged                     ,


-- ** StateChanged
    KeymapStateChangedCallback              ,
    KeymapStateChangedCallbackC             ,
    KeymapStateChangedSignalInfo            ,
    afterKeymapStateChanged                 ,
    keymapStateChangedCallbackWrapper       ,
    keymapStateChangedClosure               ,
    mkKeymapStateChangedCallback            ,
    noKeymapStateChangedCallback            ,
    onKeymapStateChanged                    ,




    ) 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.Gdk.Types
import GI.Gdk.Callbacks
import qualified GI.GObject as GObject
import qualified GI.Pango as Pango

newtype Keymap = Keymap (ForeignPtr Keymap)
foreign import ccall "gdk_keymap_get_type"
    c_gdk_keymap_get_type :: IO GType

type instance ParentTypes Keymap = KeymapParentTypes
type KeymapParentTypes = '[GObject.Object]

instance GObject Keymap where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_gdk_keymap_get_type
    

class GObject o => KeymapK o
instance (GObject o, IsDescendantOf Keymap o) => KeymapK o

toKeymap :: KeymapK o => o -> IO Keymap
toKeymap = unsafeCastTo Keymap

noKeymap :: Maybe Keymap
noKeymap = Nothing

-- signal Keymap::direction-changed
type KeymapDirectionChangedCallback =
    IO ()

noKeymapDirectionChangedCallback :: Maybe KeymapDirectionChangedCallback
noKeymapDirectionChangedCallback = Nothing

type KeymapDirectionChangedCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkKeymapDirectionChangedCallback :: KeymapDirectionChangedCallbackC -> IO (FunPtr KeymapDirectionChangedCallbackC)

keymapDirectionChangedClosure :: KeymapDirectionChangedCallback -> IO Closure
keymapDirectionChangedClosure cb = newCClosure =<< mkKeymapDirectionChangedCallback wrapped
    where wrapped = keymapDirectionChangedCallbackWrapper cb

keymapDirectionChangedCallbackWrapper ::
    KeymapDirectionChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
keymapDirectionChangedCallbackWrapper _cb _ _ = do
    _cb 

onKeymapDirectionChanged :: (GObject a, MonadIO m) => a -> KeymapDirectionChangedCallback -> m SignalHandlerId
onKeymapDirectionChanged obj cb = liftIO $ connectKeymapDirectionChanged obj cb SignalConnectBefore
afterKeymapDirectionChanged :: (GObject a, MonadIO m) => a -> KeymapDirectionChangedCallback -> m SignalHandlerId
afterKeymapDirectionChanged obj cb = connectKeymapDirectionChanged obj cb SignalConnectAfter

connectKeymapDirectionChanged :: (GObject a, MonadIO m) =>
                                 a -> KeymapDirectionChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectKeymapDirectionChanged obj cb after = liftIO $ do
    cb' <- mkKeymapDirectionChangedCallback (keymapDirectionChangedCallbackWrapper cb)
    connectSignalFunPtr obj "direction-changed" cb' after

-- signal Keymap::keys-changed
type KeymapKeysChangedCallback =
    IO ()

noKeymapKeysChangedCallback :: Maybe KeymapKeysChangedCallback
noKeymapKeysChangedCallback = Nothing

type KeymapKeysChangedCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkKeymapKeysChangedCallback :: KeymapKeysChangedCallbackC -> IO (FunPtr KeymapKeysChangedCallbackC)

keymapKeysChangedClosure :: KeymapKeysChangedCallback -> IO Closure
keymapKeysChangedClosure cb = newCClosure =<< mkKeymapKeysChangedCallback wrapped
    where wrapped = keymapKeysChangedCallbackWrapper cb

keymapKeysChangedCallbackWrapper ::
    KeymapKeysChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
keymapKeysChangedCallbackWrapper _cb _ _ = do
    _cb 

onKeymapKeysChanged :: (GObject a, MonadIO m) => a -> KeymapKeysChangedCallback -> m SignalHandlerId
onKeymapKeysChanged obj cb = liftIO $ connectKeymapKeysChanged obj cb SignalConnectBefore
afterKeymapKeysChanged :: (GObject a, MonadIO m) => a -> KeymapKeysChangedCallback -> m SignalHandlerId
afterKeymapKeysChanged obj cb = connectKeymapKeysChanged obj cb SignalConnectAfter

connectKeymapKeysChanged :: (GObject a, MonadIO m) =>
                            a -> KeymapKeysChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectKeymapKeysChanged obj cb after = liftIO $ do
    cb' <- mkKeymapKeysChangedCallback (keymapKeysChangedCallbackWrapper cb)
    connectSignalFunPtr obj "keys-changed" cb' after

-- signal Keymap::state-changed
type KeymapStateChangedCallback =
    IO ()

noKeymapStateChangedCallback :: Maybe KeymapStateChangedCallback
noKeymapStateChangedCallback = Nothing

type KeymapStateChangedCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkKeymapStateChangedCallback :: KeymapStateChangedCallbackC -> IO (FunPtr KeymapStateChangedCallbackC)

keymapStateChangedClosure :: KeymapStateChangedCallback -> IO Closure
keymapStateChangedClosure cb = newCClosure =<< mkKeymapStateChangedCallback wrapped
    where wrapped = keymapStateChangedCallbackWrapper cb

keymapStateChangedCallbackWrapper ::
    KeymapStateChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
keymapStateChangedCallbackWrapper _cb _ _ = do
    _cb 

onKeymapStateChanged :: (GObject a, MonadIO m) => a -> KeymapStateChangedCallback -> m SignalHandlerId
onKeymapStateChanged obj cb = liftIO $ connectKeymapStateChanged obj cb SignalConnectBefore
afterKeymapStateChanged :: (GObject a, MonadIO m) => a -> KeymapStateChangedCallback -> m SignalHandlerId
afterKeymapStateChanged obj cb = connectKeymapStateChanged obj cb SignalConnectAfter

connectKeymapStateChanged :: (GObject a, MonadIO m) =>
                             a -> KeymapStateChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectKeymapStateChanged obj cb after = liftIO $ do
    cb' <- mkKeymapStateChangedCallback (keymapStateChangedCallbackWrapper cb)
    connectSignalFunPtr obj "state-changed" cb' after

type instance AttributeList Keymap = KeymapAttributeList
type KeymapAttributeList = ('[ ] :: [(Symbol, *)])

data KeymapDirectionChangedSignalInfo
instance SignalInfo KeymapDirectionChangedSignalInfo where
    type HaskellCallbackType KeymapDirectionChangedSignalInfo = KeymapDirectionChangedCallback
    connectSignal _ = connectKeymapDirectionChanged

data KeymapKeysChangedSignalInfo
instance SignalInfo KeymapKeysChangedSignalInfo where
    type HaskellCallbackType KeymapKeysChangedSignalInfo = KeymapKeysChangedCallback
    connectSignal _ = connectKeymapKeysChanged

data KeymapStateChangedSignalInfo
instance SignalInfo KeymapStateChangedSignalInfo where
    type HaskellCallbackType KeymapStateChangedSignalInfo = KeymapStateChangedCallback
    connectSignal _ = connectKeymapStateChanged

type instance SignalList Keymap = KeymapSignalList
type KeymapSignalList = ('[ '("direction-changed", KeymapDirectionChangedSignalInfo), '("keys-changed", KeymapKeysChangedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("state-changed", KeymapStateChangedSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method Keymap::add_virtual_modifiers
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state", argType = TInterface "Gdk" "ModifierType", direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state", argType = TInterface "Gdk" "ModifierType", direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keymap_add_virtual_modifiers" gdk_keymap_add_virtual_modifiers :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    Ptr CUInt ->                            -- state : TInterface "Gdk" "ModifierType"
    IO ()


keymapAddVirtualModifiers ::
    (MonadIO m, KeymapK a) =>
    a ->                                    -- _obj
    [ModifierType] ->                       -- state
    m ([ModifierType])
keymapAddVirtualModifiers _obj state = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let state' = gflagsToWord state
    state'' <- allocMem :: IO (Ptr CUInt)
    poke state'' state'
    gdk_keymap_add_virtual_modifiers _obj' state''
    state''' <- peek state''
    let state'''' = wordToGFlags state'''
    touchManagedPtr _obj
    freeMem state''
    return state''''

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

foreign import ccall "gdk_keymap_get_caps_lock_state" gdk_keymap_get_caps_lock_state :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    IO CInt


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

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

foreign import ccall "gdk_keymap_get_direction" gdk_keymap_get_direction :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    IO CUInt


keymapGetDirection ::
    (MonadIO m, KeymapK a) =>
    a ->                                    -- _obj
    m Pango.Direction
keymapGetDirection _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_keymap_get_direction _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method Keymap::get_entries_for_keycode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hardware_keycode", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "keys", argType = TCArray False (-1) 4 (TInterface "Gdk" "KeymapKey"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "keyvals", argType = TCArray False (-1) 4 (TBasicType TUInt32), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "n_entries", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : [Arg {argName = "n_entries", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "n_entries", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hardware_keycode", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keymap_get_entries_for_keycode" gdk_keymap_get_entries_for_keycode :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    Word32 ->                               -- hardware_keycode : TBasicType TUInt32
    Ptr (Ptr KeymapKey) ->                  -- keys : TCArray False (-1) 4 (TInterface "Gdk" "KeymapKey")
    Ptr (Ptr Word32) ->                     -- keyvals : TCArray False (-1) 4 (TBasicType TUInt32)
    Ptr Int32 ->                            -- n_entries : TBasicType TInt32
    IO CInt


keymapGetEntriesForKeycode ::
    (MonadIO m, KeymapK a) =>
    a ->                                    -- _obj
    Word32 ->                               -- hardware_keycode
    m (Bool,[KeymapKey],[Word32])
keymapGetEntriesForKeycode _obj hardware_keycode = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    keys <- allocMem :: IO (Ptr (Ptr KeymapKey))
    keyvals <- allocMem :: IO (Ptr (Ptr Word32))
    n_entries <- allocMem :: IO (Ptr Int32)
    result <- gdk_keymap_get_entries_for_keycode _obj' hardware_keycode keys keyvals n_entries
    n_entries' <- peek n_entries
    let result' = (/= 0) result
    keys' <- peek keys
    keys'' <- (unpackBlockArrayWithLength 12 n_entries') keys'
    keys''' <- mapM (wrapPtr KeymapKey) keys''
    freeMem keys'
    keyvals' <- peek keyvals
    keyvals'' <- (unpackStorableArrayWithLength n_entries') keyvals'
    freeMem keyvals'
    touchManagedPtr _obj
    freeMem keys
    freeMem keyvals
    freeMem n_entries
    return (result', keys''', keyvals'')

-- method Keymap::get_entries_for_keyval
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "keyval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "keys", argType = TCArray False (-1) 3 (TInterface "Gdk" "KeymapKey"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "n_keys", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : [Arg {argName = "n_keys", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "keyval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keymap_get_entries_for_keyval" gdk_keymap_get_entries_for_keyval :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    Word32 ->                               -- keyval : TBasicType TUInt32
    Ptr (Ptr KeymapKey) ->                  -- keys : TCArray False (-1) 3 (TInterface "Gdk" "KeymapKey")
    Ptr Int32 ->                            -- n_keys : TBasicType TInt32
    IO CInt


keymapGetEntriesForKeyval ::
    (MonadIO m, KeymapK a) =>
    a ->                                    -- _obj
    Word32 ->                               -- keyval
    m (Bool,[KeymapKey])
keymapGetEntriesForKeyval _obj keyval = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    keys <- allocMem :: IO (Ptr (Ptr KeymapKey))
    n_keys <- allocMem :: IO (Ptr Int32)
    result <- gdk_keymap_get_entries_for_keyval _obj' keyval keys n_keys
    n_keys' <- peek n_keys
    let result' = (/= 0) result
    keys' <- peek keys
    keys'' <- (unpackBlockArrayWithLength 12 n_keys') keys'
    keys''' <- mapM (wrapPtr KeymapKey) keys''
    freeMem keys'
    touchManagedPtr _obj
    freeMem keys
    freeMem n_keys
    return (result', keys''')

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

foreign import ccall "gdk_keymap_get_modifier_mask" gdk_keymap_get_modifier_mask :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    CUInt ->                                -- intent : TInterface "Gdk" "ModifierIntent"
    IO CUInt


keymapGetModifierMask ::
    (MonadIO m, KeymapK a) =>
    a ->                                    -- _obj
    ModifierIntent ->                       -- intent
    m [ModifierType]
keymapGetModifierMask _obj intent = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let intent' = (fromIntegral . fromEnum) intent
    result <- gdk_keymap_get_modifier_mask _obj' intent'
    let result' = wordToGFlags result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gdk_keymap_get_modifier_state" gdk_keymap_get_modifier_state :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    IO Word32


keymapGetModifierState ::
    (MonadIO m, KeymapK a) =>
    a ->                                    -- _obj
    m Word32
keymapGetModifierState _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_keymap_get_modifier_state _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "gdk_keymap_get_num_lock_state" gdk_keymap_get_num_lock_state :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    IO CInt


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

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

foreign import ccall "gdk_keymap_get_scroll_lock_state" gdk_keymap_get_scroll_lock_state :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    IO CInt


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

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

foreign import ccall "gdk_keymap_have_bidi_layouts" gdk_keymap_have_bidi_layouts :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    IO CInt


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

-- method Keymap::lookup_key
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TInterface "Gdk" "KeymapKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TInterface "Gdk" "KeymapKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keymap_lookup_key" gdk_keymap_lookup_key :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    Ptr KeymapKey ->                        -- key : TInterface "Gdk" "KeymapKey"
    IO Word32


keymapLookupKey ::
    (MonadIO m, KeymapK a) =>
    a ->                                    -- _obj
    KeymapKey ->                            -- key
    m Word32
keymapLookupKey _obj key = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let key' = unsafeManagedPtrGetPtr key
    result <- gdk_keymap_lookup_key _obj' key'
    touchManagedPtr _obj
    touchManagedPtr key
    return result

-- method Keymap::map_virtual_modifiers
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state", argType = TInterface "Gdk" "ModifierType", direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state", argType = TInterface "Gdk" "ModifierType", direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keymap_map_virtual_modifiers" gdk_keymap_map_virtual_modifiers :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    Ptr CUInt ->                            -- state : TInterface "Gdk" "ModifierType"
    IO CInt


keymapMapVirtualModifiers ::
    (MonadIO m, KeymapK a) =>
    a ->                                    -- _obj
    [ModifierType] ->                       -- state
    m (Bool,[ModifierType])
keymapMapVirtualModifiers _obj state = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let state' = gflagsToWord state
    state'' <- allocMem :: IO (Ptr CUInt)
    poke state'' state'
    result <- gdk_keymap_map_virtual_modifiers _obj' state''
    let result' = (/= 0) result
    state''' <- peek state''
    let state'''' = wordToGFlags state'''
    touchManagedPtr _obj
    freeMem state''
    return (result', state'''')

-- method Keymap::translate_keyboard_state
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hardware_keycode", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "keyval", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "effective_group", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "level", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "consumed_modifiers", argType = TInterface "Gdk" "ModifierType", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Keymap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hardware_keycode", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state", argType = TInterface "Gdk" "ModifierType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keymap_translate_keyboard_state" gdk_keymap_translate_keyboard_state :: 
    Ptr Keymap ->                           -- _obj : TInterface "Gdk" "Keymap"
    Word32 ->                               -- hardware_keycode : TBasicType TUInt32
    CUInt ->                                -- state : TInterface "Gdk" "ModifierType"
    Int32 ->                                -- group : TBasicType TInt32
    Ptr Word32 ->                           -- keyval : TBasicType TUInt32
    Ptr Int32 ->                            -- effective_group : TBasicType TInt32
    Ptr Int32 ->                            -- level : TBasicType TInt32
    Ptr CUInt ->                            -- consumed_modifiers : TInterface "Gdk" "ModifierType"
    IO CInt


keymapTranslateKeyboardState ::
    (MonadIO m, KeymapK a) =>
    a ->                                    -- _obj
    Word32 ->                               -- hardware_keycode
    [ModifierType] ->                       -- state
    Int32 ->                                -- group
    m (Bool,Word32,Int32,Int32,[ModifierType])
keymapTranslateKeyboardState _obj hardware_keycode state group = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let state' = gflagsToWord state
    keyval <- allocMem :: IO (Ptr Word32)
    effective_group <- allocMem :: IO (Ptr Int32)
    level <- allocMem :: IO (Ptr Int32)
    consumed_modifiers <- allocMem :: IO (Ptr CUInt)
    result <- gdk_keymap_translate_keyboard_state _obj' hardware_keycode state' group keyval effective_group level consumed_modifiers
    let result' = (/= 0) result
    keyval' <- peek keyval
    effective_group' <- peek effective_group
    level' <- peek level
    consumed_modifiers' <- peek consumed_modifiers
    let consumed_modifiers'' = wordToGFlags consumed_modifiers'
    touchManagedPtr _obj
    freeMem keyval
    freeMem effective_group
    freeMem level
    freeMem consumed_modifiers
    return (result', keyval', effective_group', level', consumed_modifiers'')

-- method Keymap::get_default
-- method type : MemberFunction
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "Gdk" "Keymap"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keymap_get_default" gdk_keymap_get_default :: 
    IO (Ptr Keymap)


keymapGetDefault ::
    (MonadIO m) =>
    m Keymap
keymapGetDefault  = liftIO $ do
    result <- gdk_keymap_get_default
    checkUnexpectedReturnNULL "gdk_keymap_get_default" result
    result' <- (newObject Keymap) result
    return result'

-- method Keymap::get_for_display
-- method type : MemberFunction
-- Args : [Arg {argName = "display", argType = TInterface "Gdk" "Display", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "display", argType = TInterface "Gdk" "Display", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Keymap"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keymap_get_for_display" gdk_keymap_get_for_display :: 
    Ptr Display ->                          -- display : TInterface "Gdk" "Display"
    IO (Ptr Keymap)


keymapGetForDisplay ::
    (MonadIO m, DisplayK a) =>
    a ->                                    -- display
    m Keymap
keymapGetForDisplay display = liftIO $ do
    let display' = unsafeManagedPtrCastPtr display
    result <- gdk_keymap_get_for_display display'
    checkUnexpectedReturnNULL "gdk_keymap_get_for_display" result
    result' <- (newObject Keymap) result
    touchManagedPtr display
    return result'