{- |
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.IMContext
    ( 

-- * Exported types
    IMContext(..)                           ,
    IMContextK                              ,
    toIMContext                             ,
    noIMContext                             ,


 -- * Methods
-- ** iMContextDeleteSurrounding
    iMContextDeleteSurrounding              ,


-- ** iMContextFilterKeypress
    iMContextFilterKeypress                 ,


-- ** iMContextFocusIn
    iMContextFocusIn                        ,


-- ** iMContextFocusOut
    iMContextFocusOut                       ,


-- ** iMContextGetPreeditString
    iMContextGetPreeditString               ,


-- ** iMContextGetSurrounding
    iMContextGetSurrounding                 ,


-- ** iMContextReset
    iMContextReset                          ,


-- ** iMContextSetClientWindow
    iMContextSetClientWindow                ,


-- ** iMContextSetCursorLocation
    iMContextSetCursorLocation              ,


-- ** iMContextSetSurrounding
    iMContextSetSurrounding                 ,


-- ** iMContextSetUsePreedit
    iMContextSetUsePreedit                  ,




 -- * Properties
-- ** InputHints
    IMContextInputHintsPropertyInfo         ,
    constructIMContextInputHints            ,
    getIMContextInputHints                  ,
    setIMContextInputHints                  ,


-- ** InputPurpose
    IMContextInputPurposePropertyInfo       ,
    constructIMContextInputPurpose          ,
    getIMContextInputPurpose                ,
    setIMContextInputPurpose                ,




 -- * Signals
-- ** Commit
    IMContextCommitCallback                 ,
    IMContextCommitCallbackC                ,
    IMContextCommitSignalInfo               ,
    afterIMContextCommit                    ,
    iMContextCommitCallbackWrapper          ,
    iMContextCommitClosure                  ,
    mkIMContextCommitCallback               ,
    noIMContextCommitCallback               ,
    onIMContextCommit                       ,


-- ** DeleteSurrounding
    IMContextDeleteSurroundingCallback      ,
    IMContextDeleteSurroundingCallbackC     ,
    IMContextDeleteSurroundingSignalInfo    ,
    afterIMContextDeleteSurrounding         ,
    iMContextDeleteSurroundingCallbackWrapper,
    iMContextDeleteSurroundingClosure       ,
    mkIMContextDeleteSurroundingCallback    ,
    noIMContextDeleteSurroundingCallback    ,
    onIMContextDeleteSurrounding            ,


-- ** PreeditChanged
    IMContextPreeditChangedCallback         ,
    IMContextPreeditChangedCallbackC        ,
    IMContextPreeditChangedSignalInfo       ,
    afterIMContextPreeditChanged            ,
    iMContextPreeditChangedCallbackWrapper  ,
    iMContextPreeditChangedClosure          ,
    mkIMContextPreeditChangedCallback       ,
    noIMContextPreeditChangedCallback       ,
    onIMContextPreeditChanged               ,


-- ** PreeditEnd
    IMContextPreeditEndCallback             ,
    IMContextPreeditEndCallbackC            ,
    IMContextPreeditEndSignalInfo           ,
    afterIMContextPreeditEnd                ,
    iMContextPreeditEndCallbackWrapper      ,
    iMContextPreeditEndClosure              ,
    mkIMContextPreeditEndCallback           ,
    noIMContextPreeditEndCallback           ,
    onIMContextPreeditEnd                   ,


-- ** PreeditStart
    IMContextPreeditStartCallback           ,
    IMContextPreeditStartCallbackC          ,
    IMContextPreeditStartSignalInfo         ,
    afterIMContextPreeditStart              ,
    iMContextPreeditStartCallbackWrapper    ,
    iMContextPreeditStartClosure            ,
    mkIMContextPreeditStartCallback         ,
    noIMContextPreeditStartCallback         ,
    onIMContextPreeditStart                 ,


-- ** RetrieveSurrounding
    IMContextRetrieveSurroundingCallback    ,
    IMContextRetrieveSurroundingCallbackC   ,
    IMContextRetrieveSurroundingSignalInfo  ,
    afterIMContextRetrieveSurrounding       ,
    iMContextRetrieveSurroundingCallbackWrapper,
    iMContextRetrieveSurroundingClosure     ,
    mkIMContextRetrieveSurroundingCallback  ,
    noIMContextRetrieveSurroundingCallback  ,
    onIMContextRetrieveSurrounding          ,




    ) 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
import qualified GI.Pango as Pango

newtype IMContext = IMContext (ForeignPtr IMContext)
foreign import ccall "gtk_im_context_get_type"
    c_gtk_im_context_get_type :: IO GType

type instance ParentTypes IMContext = IMContextParentTypes
type IMContextParentTypes = '[GObject.Object]

instance GObject IMContext where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_gtk_im_context_get_type
    

class GObject o => IMContextK o
instance (GObject o, IsDescendantOf IMContext o) => IMContextK o

toIMContext :: IMContextK o => o -> IO IMContext
toIMContext = unsafeCastTo IMContext

noIMContext :: Maybe IMContext
noIMContext = Nothing

-- signal IMContext::commit
type IMContextCommitCallback =
    T.Text ->
    IO ()

noIMContextCommitCallback :: Maybe IMContextCommitCallback
noIMContextCommitCallback = Nothing

type IMContextCommitCallbackC =
    Ptr () ->                               -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkIMContextCommitCallback :: IMContextCommitCallbackC -> IO (FunPtr IMContextCommitCallbackC)

iMContextCommitClosure :: IMContextCommitCallback -> IO Closure
iMContextCommitClosure cb = newCClosure =<< mkIMContextCommitCallback wrapped
    where wrapped = iMContextCommitCallbackWrapper cb

iMContextCommitCallbackWrapper ::
    IMContextCommitCallback ->
    Ptr () ->
    CString ->
    Ptr () ->
    IO ()
iMContextCommitCallbackWrapper _cb _ str _ = do
    str' <- cstringToText str
    _cb  str'

onIMContextCommit :: (GObject a, MonadIO m) => a -> IMContextCommitCallback -> m SignalHandlerId
onIMContextCommit obj cb = liftIO $ connectIMContextCommit obj cb SignalConnectBefore
afterIMContextCommit :: (GObject a, MonadIO m) => a -> IMContextCommitCallback -> m SignalHandlerId
afterIMContextCommit obj cb = connectIMContextCommit obj cb SignalConnectAfter

connectIMContextCommit :: (GObject a, MonadIO m) =>
                          a -> IMContextCommitCallback -> SignalConnectMode -> m SignalHandlerId
connectIMContextCommit obj cb after = liftIO $ do
    cb' <- mkIMContextCommitCallback (iMContextCommitCallbackWrapper cb)
    connectSignalFunPtr obj "commit" cb' after

-- signal IMContext::delete-surrounding
type IMContextDeleteSurroundingCallback =
    Int32 ->
    Int32 ->
    IO Bool

noIMContextDeleteSurroundingCallback :: Maybe IMContextDeleteSurroundingCallback
noIMContextDeleteSurroundingCallback = Nothing

type IMContextDeleteSurroundingCallbackC =
    Ptr () ->                               -- object
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO CInt

foreign import ccall "wrapper"
    mkIMContextDeleteSurroundingCallback :: IMContextDeleteSurroundingCallbackC -> IO (FunPtr IMContextDeleteSurroundingCallbackC)

iMContextDeleteSurroundingClosure :: IMContextDeleteSurroundingCallback -> IO Closure
iMContextDeleteSurroundingClosure cb = newCClosure =<< mkIMContextDeleteSurroundingCallback wrapped
    where wrapped = iMContextDeleteSurroundingCallbackWrapper cb

iMContextDeleteSurroundingCallbackWrapper ::
    IMContextDeleteSurroundingCallback ->
    Ptr () ->
    Int32 ->
    Int32 ->
    Ptr () ->
    IO CInt
iMContextDeleteSurroundingCallbackWrapper _cb _ offset n_chars _ = do
    result <- _cb  offset n_chars
    let result' = (fromIntegral . fromEnum) result
    return result'

onIMContextDeleteSurrounding :: (GObject a, MonadIO m) => a -> IMContextDeleteSurroundingCallback -> m SignalHandlerId
onIMContextDeleteSurrounding obj cb = liftIO $ connectIMContextDeleteSurrounding obj cb SignalConnectBefore
afterIMContextDeleteSurrounding :: (GObject a, MonadIO m) => a -> IMContextDeleteSurroundingCallback -> m SignalHandlerId
afterIMContextDeleteSurrounding obj cb = connectIMContextDeleteSurrounding obj cb SignalConnectAfter

connectIMContextDeleteSurrounding :: (GObject a, MonadIO m) =>
                                     a -> IMContextDeleteSurroundingCallback -> SignalConnectMode -> m SignalHandlerId
connectIMContextDeleteSurrounding obj cb after = liftIO $ do
    cb' <- mkIMContextDeleteSurroundingCallback (iMContextDeleteSurroundingCallbackWrapper cb)
    connectSignalFunPtr obj "delete-surrounding" cb' after

-- signal IMContext::preedit-changed
type IMContextPreeditChangedCallback =
    IO ()

noIMContextPreeditChangedCallback :: Maybe IMContextPreeditChangedCallback
noIMContextPreeditChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkIMContextPreeditChangedCallback :: IMContextPreeditChangedCallbackC -> IO (FunPtr IMContextPreeditChangedCallbackC)

iMContextPreeditChangedClosure :: IMContextPreeditChangedCallback -> IO Closure
iMContextPreeditChangedClosure cb = newCClosure =<< mkIMContextPreeditChangedCallback wrapped
    where wrapped = iMContextPreeditChangedCallbackWrapper cb

iMContextPreeditChangedCallbackWrapper ::
    IMContextPreeditChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
iMContextPreeditChangedCallbackWrapper _cb _ _ = do
    _cb 

onIMContextPreeditChanged :: (GObject a, MonadIO m) => a -> IMContextPreeditChangedCallback -> m SignalHandlerId
onIMContextPreeditChanged obj cb = liftIO $ connectIMContextPreeditChanged obj cb SignalConnectBefore
afterIMContextPreeditChanged :: (GObject a, MonadIO m) => a -> IMContextPreeditChangedCallback -> m SignalHandlerId
afterIMContextPreeditChanged obj cb = connectIMContextPreeditChanged obj cb SignalConnectAfter

connectIMContextPreeditChanged :: (GObject a, MonadIO m) =>
                                  a -> IMContextPreeditChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectIMContextPreeditChanged obj cb after = liftIO $ do
    cb' <- mkIMContextPreeditChangedCallback (iMContextPreeditChangedCallbackWrapper cb)
    connectSignalFunPtr obj "preedit-changed" cb' after

-- signal IMContext::preedit-end
type IMContextPreeditEndCallback =
    IO ()

noIMContextPreeditEndCallback :: Maybe IMContextPreeditEndCallback
noIMContextPreeditEndCallback = Nothing

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

foreign import ccall "wrapper"
    mkIMContextPreeditEndCallback :: IMContextPreeditEndCallbackC -> IO (FunPtr IMContextPreeditEndCallbackC)

iMContextPreeditEndClosure :: IMContextPreeditEndCallback -> IO Closure
iMContextPreeditEndClosure cb = newCClosure =<< mkIMContextPreeditEndCallback wrapped
    where wrapped = iMContextPreeditEndCallbackWrapper cb

iMContextPreeditEndCallbackWrapper ::
    IMContextPreeditEndCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
iMContextPreeditEndCallbackWrapper _cb _ _ = do
    _cb 

onIMContextPreeditEnd :: (GObject a, MonadIO m) => a -> IMContextPreeditEndCallback -> m SignalHandlerId
onIMContextPreeditEnd obj cb = liftIO $ connectIMContextPreeditEnd obj cb SignalConnectBefore
afterIMContextPreeditEnd :: (GObject a, MonadIO m) => a -> IMContextPreeditEndCallback -> m SignalHandlerId
afterIMContextPreeditEnd obj cb = connectIMContextPreeditEnd obj cb SignalConnectAfter

connectIMContextPreeditEnd :: (GObject a, MonadIO m) =>
                              a -> IMContextPreeditEndCallback -> SignalConnectMode -> m SignalHandlerId
connectIMContextPreeditEnd obj cb after = liftIO $ do
    cb' <- mkIMContextPreeditEndCallback (iMContextPreeditEndCallbackWrapper cb)
    connectSignalFunPtr obj "preedit-end" cb' after

-- signal IMContext::preedit-start
type IMContextPreeditStartCallback =
    IO ()

noIMContextPreeditStartCallback :: Maybe IMContextPreeditStartCallback
noIMContextPreeditStartCallback = Nothing

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

foreign import ccall "wrapper"
    mkIMContextPreeditStartCallback :: IMContextPreeditStartCallbackC -> IO (FunPtr IMContextPreeditStartCallbackC)

iMContextPreeditStartClosure :: IMContextPreeditStartCallback -> IO Closure
iMContextPreeditStartClosure cb = newCClosure =<< mkIMContextPreeditStartCallback wrapped
    where wrapped = iMContextPreeditStartCallbackWrapper cb

iMContextPreeditStartCallbackWrapper ::
    IMContextPreeditStartCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
iMContextPreeditStartCallbackWrapper _cb _ _ = do
    _cb 

onIMContextPreeditStart :: (GObject a, MonadIO m) => a -> IMContextPreeditStartCallback -> m SignalHandlerId
onIMContextPreeditStart obj cb = liftIO $ connectIMContextPreeditStart obj cb SignalConnectBefore
afterIMContextPreeditStart :: (GObject a, MonadIO m) => a -> IMContextPreeditStartCallback -> m SignalHandlerId
afterIMContextPreeditStart obj cb = connectIMContextPreeditStart obj cb SignalConnectAfter

connectIMContextPreeditStart :: (GObject a, MonadIO m) =>
                                a -> IMContextPreeditStartCallback -> SignalConnectMode -> m SignalHandlerId
connectIMContextPreeditStart obj cb after = liftIO $ do
    cb' <- mkIMContextPreeditStartCallback (iMContextPreeditStartCallbackWrapper cb)
    connectSignalFunPtr obj "preedit-start" cb' after

-- signal IMContext::retrieve-surrounding
type IMContextRetrieveSurroundingCallback =
    IO Bool

noIMContextRetrieveSurroundingCallback :: Maybe IMContextRetrieveSurroundingCallback
noIMContextRetrieveSurroundingCallback = Nothing

type IMContextRetrieveSurroundingCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO CInt

foreign import ccall "wrapper"
    mkIMContextRetrieveSurroundingCallback :: IMContextRetrieveSurroundingCallbackC -> IO (FunPtr IMContextRetrieveSurroundingCallbackC)

iMContextRetrieveSurroundingClosure :: IMContextRetrieveSurroundingCallback -> IO Closure
iMContextRetrieveSurroundingClosure cb = newCClosure =<< mkIMContextRetrieveSurroundingCallback wrapped
    where wrapped = iMContextRetrieveSurroundingCallbackWrapper cb

iMContextRetrieveSurroundingCallbackWrapper ::
    IMContextRetrieveSurroundingCallback ->
    Ptr () ->
    Ptr () ->
    IO CInt
iMContextRetrieveSurroundingCallbackWrapper _cb _ _ = do
    result <- _cb 
    let result' = (fromIntegral . fromEnum) result
    return result'

onIMContextRetrieveSurrounding :: (GObject a, MonadIO m) => a -> IMContextRetrieveSurroundingCallback -> m SignalHandlerId
onIMContextRetrieveSurrounding obj cb = liftIO $ connectIMContextRetrieveSurrounding obj cb SignalConnectBefore
afterIMContextRetrieveSurrounding :: (GObject a, MonadIO m) => a -> IMContextRetrieveSurroundingCallback -> m SignalHandlerId
afterIMContextRetrieveSurrounding obj cb = connectIMContextRetrieveSurrounding obj cb SignalConnectAfter

connectIMContextRetrieveSurrounding :: (GObject a, MonadIO m) =>
                                       a -> IMContextRetrieveSurroundingCallback -> SignalConnectMode -> m SignalHandlerId
connectIMContextRetrieveSurrounding obj cb after = liftIO $ do
    cb' <- mkIMContextRetrieveSurroundingCallback (iMContextRetrieveSurroundingCallbackWrapper cb)
    connectSignalFunPtr obj "retrieve-surrounding" cb' after

-- VVV Prop "input-hints"
   -- Type: TInterface "Gtk" "InputHints"
   -- Flags: [PropertyReadable,PropertyWritable]

getIMContextInputHints :: (MonadIO m, IMContextK o) => o -> m [InputHints]
getIMContextInputHints obj = liftIO $ getObjectPropertyFlags obj "input-hints"

setIMContextInputHints :: (MonadIO m, IMContextK o) => o -> [InputHints] -> m ()
setIMContextInputHints obj val = liftIO $ setObjectPropertyFlags obj "input-hints" val

constructIMContextInputHints :: [InputHints] -> IO ([Char], GValue)
constructIMContextInputHints val = constructObjectPropertyFlags "input-hints" val

data IMContextInputHintsPropertyInfo
instance AttrInfo IMContextInputHintsPropertyInfo where
    type AttrAllowedOps IMContextInputHintsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint IMContextInputHintsPropertyInfo = (~) [InputHints]
    type AttrBaseTypeConstraint IMContextInputHintsPropertyInfo = IMContextK
    type AttrGetType IMContextInputHintsPropertyInfo = [InputHints]
    type AttrLabel IMContextInputHintsPropertyInfo = "IMContext::input-hints"
    attrGet _ = getIMContextInputHints
    attrSet _ = setIMContextInputHints
    attrConstruct _ = constructIMContextInputHints

-- VVV Prop "input-purpose"
   -- Type: TInterface "Gtk" "InputPurpose"
   -- Flags: [PropertyReadable,PropertyWritable]

getIMContextInputPurpose :: (MonadIO m, IMContextK o) => o -> m InputPurpose
getIMContextInputPurpose obj = liftIO $ getObjectPropertyEnum obj "input-purpose"

setIMContextInputPurpose :: (MonadIO m, IMContextK o) => o -> InputPurpose -> m ()
setIMContextInputPurpose obj val = liftIO $ setObjectPropertyEnum obj "input-purpose" val

constructIMContextInputPurpose :: InputPurpose -> IO ([Char], GValue)
constructIMContextInputPurpose val = constructObjectPropertyEnum "input-purpose" val

data IMContextInputPurposePropertyInfo
instance AttrInfo IMContextInputPurposePropertyInfo where
    type AttrAllowedOps IMContextInputPurposePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint IMContextInputPurposePropertyInfo = (~) InputPurpose
    type AttrBaseTypeConstraint IMContextInputPurposePropertyInfo = IMContextK
    type AttrGetType IMContextInputPurposePropertyInfo = InputPurpose
    type AttrLabel IMContextInputPurposePropertyInfo = "IMContext::input-purpose"
    attrGet _ = getIMContextInputPurpose
    attrSet _ = setIMContextInputPurpose
    attrConstruct _ = constructIMContextInputPurpose

type instance AttributeList IMContext = IMContextAttributeList
type IMContextAttributeList = ('[ '("input-hints", IMContextInputHintsPropertyInfo), '("input-purpose", IMContextInputPurposePropertyInfo)] :: [(Symbol, *)])

data IMContextCommitSignalInfo
instance SignalInfo IMContextCommitSignalInfo where
    type HaskellCallbackType IMContextCommitSignalInfo = IMContextCommitCallback
    connectSignal _ = connectIMContextCommit

data IMContextDeleteSurroundingSignalInfo
instance SignalInfo IMContextDeleteSurroundingSignalInfo where
    type HaskellCallbackType IMContextDeleteSurroundingSignalInfo = IMContextDeleteSurroundingCallback
    connectSignal _ = connectIMContextDeleteSurrounding

data IMContextPreeditChangedSignalInfo
instance SignalInfo IMContextPreeditChangedSignalInfo where
    type HaskellCallbackType IMContextPreeditChangedSignalInfo = IMContextPreeditChangedCallback
    connectSignal _ = connectIMContextPreeditChanged

data IMContextPreeditEndSignalInfo
instance SignalInfo IMContextPreeditEndSignalInfo where
    type HaskellCallbackType IMContextPreeditEndSignalInfo = IMContextPreeditEndCallback
    connectSignal _ = connectIMContextPreeditEnd

data IMContextPreeditStartSignalInfo
instance SignalInfo IMContextPreeditStartSignalInfo where
    type HaskellCallbackType IMContextPreeditStartSignalInfo = IMContextPreeditStartCallback
    connectSignal _ = connectIMContextPreeditStart

data IMContextRetrieveSurroundingSignalInfo
instance SignalInfo IMContextRetrieveSurroundingSignalInfo where
    type HaskellCallbackType IMContextRetrieveSurroundingSignalInfo = IMContextRetrieveSurroundingCallback
    connectSignal _ = connectIMContextRetrieveSurrounding

type instance SignalList IMContext = IMContextSignalList
type IMContextSignalList = ('[ '("commit", IMContextCommitSignalInfo), '("delete-surrounding", IMContextDeleteSurroundingSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("preedit-changed", IMContextPreeditChangedSignalInfo), '("preedit-end", IMContextPreeditEndSignalInfo), '("preedit-start", IMContextPreeditStartSignalInfo), '("retrieve-surrounding", IMContextRetrieveSurroundingSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method IMContext::delete_surrounding
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "IMContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_chars", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "IMContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_chars", 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 "gtk_im_context_delete_surrounding" gtk_im_context_delete_surrounding :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    Int32 ->                                -- offset : TBasicType TInt32
    Int32 ->                                -- n_chars : TBasicType TInt32
    IO CInt


iMContextDeleteSurrounding ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- offset
    Int32 ->                                -- n_chars
    m Bool
iMContextDeleteSurrounding _obj offset n_chars = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_im_context_delete_surrounding _obj' offset n_chars
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_im_context_filter_keypress" gtk_im_context_filter_keypress :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    Ptr Gdk.EventKey ->                     -- event : TInterface "Gdk" "EventKey"
    IO CInt


iMContextFilterKeypress ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    Gdk.EventKey ->                         -- event
    m Bool
iMContextFilterKeypress _obj event = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let event' = unsafeManagedPtrGetPtr event
    result <- gtk_im_context_filter_keypress _obj' event'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr event
    return result'

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

foreign import ccall "gtk_im_context_focus_in" gtk_im_context_focus_in :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    IO ()


iMContextFocusIn ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    m ()
iMContextFocusIn _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_im_context_focus_in _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_im_context_focus_out" gtk_im_context_focus_out :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    IO ()


iMContextFocusOut ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    m ()
iMContextFocusOut _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_im_context_focus_out _obj'
    touchManagedPtr _obj
    return ()

-- method IMContext::get_preedit_string
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "IMContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "attrs", argType = TInterface "Pango" "AttrList", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cursor_pos", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "IMContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_im_context_get_preedit_string" gtk_im_context_get_preedit_string :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    Ptr CString ->                          -- str : TBasicType TUTF8
    Ptr (Ptr Pango.AttrList) ->             -- attrs : TInterface "Pango" "AttrList"
    Ptr Int32 ->                            -- cursor_pos : TBasicType TInt32
    IO ()


iMContextGetPreeditString ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    m (T.Text,Pango.AttrList,Int32)
iMContextGetPreeditString _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    str <- allocMem :: IO (Ptr CString)
    attrs <- allocMem :: IO (Ptr (Ptr Pango.AttrList))
    cursor_pos <- allocMem :: IO (Ptr Int32)
    gtk_im_context_get_preedit_string _obj' str attrs cursor_pos
    str' <- peek str
    str'' <- cstringToText str'
    freeMem str'
    attrs' <- peek attrs
    attrs'' <- (wrapBoxed Pango.AttrList) attrs'
    cursor_pos' <- peek cursor_pos
    touchManagedPtr _obj
    freeMem str
    freeMem attrs
    freeMem cursor_pos
    return (str'', attrs'', cursor_pos')

-- method IMContext::get_surrounding
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "IMContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cursor_index", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "IMContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_im_context_get_surrounding" gtk_im_context_get_surrounding :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    Ptr CString ->                          -- text : TBasicType TUTF8
    Ptr Int32 ->                            -- cursor_index : TBasicType TInt32
    IO CInt


iMContextGetSurrounding ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    m (Bool,T.Text,Int32)
iMContextGetSurrounding _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    text <- allocMem :: IO (Ptr CString)
    cursor_index <- allocMem :: IO (Ptr Int32)
    result <- gtk_im_context_get_surrounding _obj' text cursor_index
    let result' = (/= 0) result
    text' <- peek text
    text'' <- cstringToText text'
    freeMem text'
    cursor_index' <- peek cursor_index
    touchManagedPtr _obj
    freeMem text
    freeMem cursor_index
    return (result', text'', cursor_index')

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

foreign import ccall "gtk_im_context_reset" gtk_im_context_reset :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    IO ()


iMContextReset ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    m ()
iMContextReset _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_im_context_reset _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_im_context_set_client_window" gtk_im_context_set_client_window :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    Ptr Gdk.Window ->                       -- window : TInterface "Gdk" "Window"
    IO ()


iMContextSetClientWindow ::
    (MonadIO m, IMContextK a, Gdk.WindowK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- window
    m ()
iMContextSetClientWindow _obj window = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeWindow <- case window of
        Nothing -> return nullPtr
        Just jWindow -> do
            let jWindow' = unsafeManagedPtrCastPtr jWindow
            return jWindow'
    gtk_im_context_set_client_window _obj' maybeWindow
    touchManagedPtr _obj
    whenJust window touchManagedPtr
    return ()

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

foreign import ccall "gtk_im_context_set_cursor_location" gtk_im_context_set_cursor_location :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    Ptr Gdk.Rectangle ->                    -- area : TInterface "Gdk" "Rectangle"
    IO ()


iMContextSetCursorLocation ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    Gdk.Rectangle ->                        -- area
    m ()
iMContextSetCursorLocation _obj area = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let area' = unsafeManagedPtrGetPtr area
    gtk_im_context_set_cursor_location _obj' area'
    touchManagedPtr _obj
    touchManagedPtr area
    return ()

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

foreign import ccall "gtk_im_context_set_surrounding" gtk_im_context_set_surrounding :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    CString ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- len : TBasicType TInt32
    Int32 ->                                -- cursor_index : TBasicType TInt32
    IO ()


iMContextSetSurrounding ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- text
    Int32 ->                                -- len
    Int32 ->                                -- cursor_index
    m ()
iMContextSetSurrounding _obj text len cursor_index = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    text' <- textToCString text
    gtk_im_context_set_surrounding _obj' text' len cursor_index
    touchManagedPtr _obj
    freeMem text'
    return ()

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

foreign import ccall "gtk_im_context_set_use_preedit" gtk_im_context_set_use_preedit :: 
    Ptr IMContext ->                        -- _obj : TInterface "Gtk" "IMContext"
    CInt ->                                 -- use_preedit : TBasicType TBoolean
    IO ()


iMContextSetUsePreedit ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- use_preedit
    m ()
iMContextSetUsePreedit _obj use_preedit = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let use_preedit' = (fromIntegral . fromEnum) use_preedit
    gtk_im_context_set_use_preedit _obj' use_preedit'
    touchManagedPtr _obj
    return ()