{- |
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
import qualified GI.Cairo as Cairo

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 "cairo" "RectangleInt", 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 "cairo" "RectangleInt", 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 Cairo.RectangleInt ->               -- area : TInterface "cairo" "RectangleInt"
    IO ()


iMContextSetCursorLocation ::
    (MonadIO m, IMContextK a) =>
    a ->                                    -- _obj
    Cairo.RectangleInt ->                   -- 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 ()