{- |
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.Atk.Interfaces.Text
    ( 

-- * Exported types
    Text(..)                                ,
    noText                                  ,
    TextK                                   ,


 -- * Methods
-- ** textAddSelection
    textAddSelection                        ,


-- ** textGetBoundedRanges
    textGetBoundedRanges                    ,


-- ** textGetCaretOffset
    textGetCaretOffset                      ,


-- ** textGetCharacterAtOffset
    textGetCharacterAtOffset                ,


-- ** textGetCharacterCount
    textGetCharacterCount                   ,


-- ** textGetCharacterExtents
    textGetCharacterExtents                 ,


-- ** textGetDefaultAttributes
    textGetDefaultAttributes                ,


-- ** textGetNSelections
    textGetNSelections                      ,


-- ** textGetOffsetAtPoint
    textGetOffsetAtPoint                    ,


-- ** textGetRangeExtents
    textGetRangeExtents                     ,


-- ** textGetRunAttributes
    textGetRunAttributes                    ,


-- ** textGetSelection
    textGetSelection                        ,


-- ** textGetStringAtOffset
    textGetStringAtOffset                   ,


-- ** textGetText
    textGetText                             ,


-- ** textGetTextAfterOffset
    textGetTextAfterOffset                  ,


-- ** textGetTextAtOffset
    textGetTextAtOffset                     ,


-- ** textGetTextBeforeOffset
    textGetTextBeforeOffset                 ,


-- ** textRemoveSelection
    textRemoveSelection                     ,


-- ** textSetCaretOffset
    textSetCaretOffset                      ,


-- ** textSetSelection
    textSetSelection                        ,




 -- * Signals
-- ** TextAttributesChanged
    TextTextAttributesChangedCallback       ,
    TextTextAttributesChangedCallbackC      ,
    TextTextAttributesChangedSignalInfo     ,
    afterTextTextAttributesChanged          ,
    mkTextTextAttributesChangedCallback     ,
    noTextTextAttributesChangedCallback     ,
    onTextTextAttributesChanged             ,
    textTextAttributesChangedCallbackWrapper,
    textTextAttributesChangedClosure        ,


-- ** TextCaretMoved
    TextTextCaretMovedCallback              ,
    TextTextCaretMovedCallbackC             ,
    TextTextCaretMovedSignalInfo            ,
    afterTextTextCaretMoved                 ,
    mkTextTextCaretMovedCallback            ,
    noTextTextCaretMovedCallback            ,
    onTextTextCaretMoved                    ,
    textTextCaretMovedCallbackWrapper       ,
    textTextCaretMovedClosure               ,


-- ** TextChanged
    TextTextChangedCallback                 ,
    TextTextChangedCallbackC                ,
    TextTextChangedSignalInfo               ,
    afterTextTextChanged                    ,
    mkTextTextChangedCallback               ,
    noTextTextChangedCallback               ,
    onTextTextChanged                       ,
    textTextChangedCallbackWrapper          ,
    textTextChangedClosure                  ,


-- ** TextInsert
    TextTextInsertCallback                  ,
    TextTextInsertCallbackC                 ,
    TextTextInsertSignalInfo                ,
    afterTextTextInsert                     ,
    mkTextTextInsertCallback                ,
    noTextTextInsertCallback                ,
    onTextTextInsert                        ,
    textTextInsertCallbackWrapper           ,
    textTextInsertClosure                   ,


-- ** TextRemove
    TextTextRemoveCallback                  ,
    TextTextRemoveCallbackC                 ,
    TextTextRemoveSignalInfo                ,
    afterTextTextRemove                     ,
    mkTextTextRemoveCallback                ,
    noTextTextRemoveCallback                ,
    onTextTextRemove                        ,
    textTextRemoveCallbackWrapper           ,
    textTextRemoveClosure                   ,


-- ** TextSelectionChanged
    TextTextSelectionChangedCallback        ,
    TextTextSelectionChangedCallbackC       ,
    TextTextSelectionChangedSignalInfo      ,
    afterTextTextSelectionChanged           ,
    mkTextTextSelectionChangedCallback      ,
    noTextTextSelectionChangedCallback      ,
    onTextTextSelectionChanged              ,
    textTextSelectionChangedCallbackWrapper ,
    textTextSelectionChangedClosure         ,




    ) 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.Atk.Types
import GI.Atk.Callbacks

-- interface Text 

newtype Text = Text (ForeignPtr Text)
noText :: Maybe Text
noText = Nothing

-- signal Text::text-attributes-changed
type TextTextAttributesChangedCallback =
    IO ()

noTextTextAttributesChangedCallback :: Maybe TextTextAttributesChangedCallback
noTextTextAttributesChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTextTextAttributesChangedCallback :: TextTextAttributesChangedCallbackC -> IO (FunPtr TextTextAttributesChangedCallbackC)

textTextAttributesChangedClosure :: TextTextAttributesChangedCallback -> IO Closure
textTextAttributesChangedClosure cb = newCClosure =<< mkTextTextAttributesChangedCallback wrapped
    where wrapped = textTextAttributesChangedCallbackWrapper cb

textTextAttributesChangedCallbackWrapper ::
    TextTextAttributesChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
textTextAttributesChangedCallbackWrapper _cb _ _ = do
    _cb 

onTextTextAttributesChanged :: (GObject a, MonadIO m) => a -> TextTextAttributesChangedCallback -> m SignalHandlerId
onTextTextAttributesChanged obj cb = liftIO $ connectTextTextAttributesChanged obj cb SignalConnectBefore
afterTextTextAttributesChanged :: (GObject a, MonadIO m) => a -> TextTextAttributesChangedCallback -> m SignalHandlerId
afterTextTextAttributesChanged obj cb = connectTextTextAttributesChanged obj cb SignalConnectAfter

connectTextTextAttributesChanged :: (GObject a, MonadIO m) =>
                                    a -> TextTextAttributesChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTextTextAttributesChanged obj cb after = liftIO $ do
    cb' <- mkTextTextAttributesChangedCallback (textTextAttributesChangedCallbackWrapper cb)
    connectSignalFunPtr obj "text-attributes-changed" cb' after

-- signal Text::text-caret-moved
type TextTextCaretMovedCallback =
    Int32 ->
    IO ()

noTextTextCaretMovedCallback :: Maybe TextTextCaretMovedCallback
noTextTextCaretMovedCallback = Nothing

type TextTextCaretMovedCallbackC =
    Ptr () ->                               -- object
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextTextCaretMovedCallback :: TextTextCaretMovedCallbackC -> IO (FunPtr TextTextCaretMovedCallbackC)

textTextCaretMovedClosure :: TextTextCaretMovedCallback -> IO Closure
textTextCaretMovedClosure cb = newCClosure =<< mkTextTextCaretMovedCallback wrapped
    where wrapped = textTextCaretMovedCallbackWrapper cb

textTextCaretMovedCallbackWrapper ::
    TextTextCaretMovedCallback ->
    Ptr () ->
    Int32 ->
    Ptr () ->
    IO ()
textTextCaretMovedCallbackWrapper _cb _ arg1 _ = do
    _cb  arg1

onTextTextCaretMoved :: (GObject a, MonadIO m) => a -> TextTextCaretMovedCallback -> m SignalHandlerId
onTextTextCaretMoved obj cb = liftIO $ connectTextTextCaretMoved obj cb SignalConnectBefore
afterTextTextCaretMoved :: (GObject a, MonadIO m) => a -> TextTextCaretMovedCallback -> m SignalHandlerId
afterTextTextCaretMoved obj cb = connectTextTextCaretMoved obj cb SignalConnectAfter

connectTextTextCaretMoved :: (GObject a, MonadIO m) =>
                             a -> TextTextCaretMovedCallback -> SignalConnectMode -> m SignalHandlerId
connectTextTextCaretMoved obj cb after = liftIO $ do
    cb' <- mkTextTextCaretMovedCallback (textTextCaretMovedCallbackWrapper cb)
    connectSignalFunPtr obj "text-caret-moved" cb' after

-- signal Text::text-changed
type TextTextChangedCallback =
    Int32 ->
    Int32 ->
    IO ()

noTextTextChangedCallback :: Maybe TextTextChangedCallback
noTextTextChangedCallback = Nothing

type TextTextChangedCallbackC =
    Ptr () ->                               -- object
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextTextChangedCallback :: TextTextChangedCallbackC -> IO (FunPtr TextTextChangedCallbackC)

textTextChangedClosure :: TextTextChangedCallback -> IO Closure
textTextChangedClosure cb = newCClosure =<< mkTextTextChangedCallback wrapped
    where wrapped = textTextChangedCallbackWrapper cb

textTextChangedCallbackWrapper ::
    TextTextChangedCallback ->
    Ptr () ->
    Int32 ->
    Int32 ->
    Ptr () ->
    IO ()
textTextChangedCallbackWrapper _cb _ arg1 arg2 _ = do
    _cb  arg1 arg2

onTextTextChanged :: (GObject a, MonadIO m) => a -> TextTextChangedCallback -> m SignalHandlerId
onTextTextChanged obj cb = liftIO $ connectTextTextChanged obj cb SignalConnectBefore
afterTextTextChanged :: (GObject a, MonadIO m) => a -> TextTextChangedCallback -> m SignalHandlerId
afterTextTextChanged obj cb = connectTextTextChanged obj cb SignalConnectAfter

connectTextTextChanged :: (GObject a, MonadIO m) =>
                          a -> TextTextChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTextTextChanged obj cb after = liftIO $ do
    cb' <- mkTextTextChangedCallback (textTextChangedCallbackWrapper cb)
    connectSignalFunPtr obj "text-changed" cb' after

-- signal Text::text-insert
type TextTextInsertCallback =
    Int32 ->
    Int32 ->
    T.Text ->
    IO ()

noTextTextInsertCallback :: Maybe TextTextInsertCallback
noTextTextInsertCallback = Nothing

type TextTextInsertCallbackC =
    Ptr () ->                               -- object
    Int32 ->
    Int32 ->
    CString ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextTextInsertCallback :: TextTextInsertCallbackC -> IO (FunPtr TextTextInsertCallbackC)

textTextInsertClosure :: TextTextInsertCallback -> IO Closure
textTextInsertClosure cb = newCClosure =<< mkTextTextInsertCallback wrapped
    where wrapped = textTextInsertCallbackWrapper cb

textTextInsertCallbackWrapper ::
    TextTextInsertCallback ->
    Ptr () ->
    Int32 ->
    Int32 ->
    CString ->
    Ptr () ->
    IO ()
textTextInsertCallbackWrapper _cb _ arg1 arg2 arg3 _ = do
    arg3' <- cstringToText arg3
    _cb  arg1 arg2 arg3'

onTextTextInsert :: (GObject a, MonadIO m) => a -> TextTextInsertCallback -> m SignalHandlerId
onTextTextInsert obj cb = liftIO $ connectTextTextInsert obj cb SignalConnectBefore
afterTextTextInsert :: (GObject a, MonadIO m) => a -> TextTextInsertCallback -> m SignalHandlerId
afterTextTextInsert obj cb = connectTextTextInsert obj cb SignalConnectAfter

connectTextTextInsert :: (GObject a, MonadIO m) =>
                         a -> TextTextInsertCallback -> SignalConnectMode -> m SignalHandlerId
connectTextTextInsert obj cb after = liftIO $ do
    cb' <- mkTextTextInsertCallback (textTextInsertCallbackWrapper cb)
    connectSignalFunPtr obj "text-insert" cb' after

-- signal Text::text-remove
type TextTextRemoveCallback =
    Int32 ->
    Int32 ->
    T.Text ->
    IO ()

noTextTextRemoveCallback :: Maybe TextTextRemoveCallback
noTextTextRemoveCallback = Nothing

type TextTextRemoveCallbackC =
    Ptr () ->                               -- object
    Int32 ->
    Int32 ->
    CString ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextTextRemoveCallback :: TextTextRemoveCallbackC -> IO (FunPtr TextTextRemoveCallbackC)

textTextRemoveClosure :: TextTextRemoveCallback -> IO Closure
textTextRemoveClosure cb = newCClosure =<< mkTextTextRemoveCallback wrapped
    where wrapped = textTextRemoveCallbackWrapper cb

textTextRemoveCallbackWrapper ::
    TextTextRemoveCallback ->
    Ptr () ->
    Int32 ->
    Int32 ->
    CString ->
    Ptr () ->
    IO ()
textTextRemoveCallbackWrapper _cb _ arg1 arg2 arg3 _ = do
    arg3' <- cstringToText arg3
    _cb  arg1 arg2 arg3'

onTextTextRemove :: (GObject a, MonadIO m) => a -> TextTextRemoveCallback -> m SignalHandlerId
onTextTextRemove obj cb = liftIO $ connectTextTextRemove obj cb SignalConnectBefore
afterTextTextRemove :: (GObject a, MonadIO m) => a -> TextTextRemoveCallback -> m SignalHandlerId
afterTextTextRemove obj cb = connectTextTextRemove obj cb SignalConnectAfter

connectTextTextRemove :: (GObject a, MonadIO m) =>
                         a -> TextTextRemoveCallback -> SignalConnectMode -> m SignalHandlerId
connectTextTextRemove obj cb after = liftIO $ do
    cb' <- mkTextTextRemoveCallback (textTextRemoveCallbackWrapper cb)
    connectSignalFunPtr obj "text-remove" cb' after

-- signal Text::text-selection-changed
type TextTextSelectionChangedCallback =
    IO ()

noTextTextSelectionChangedCallback :: Maybe TextTextSelectionChangedCallback
noTextTextSelectionChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTextTextSelectionChangedCallback :: TextTextSelectionChangedCallbackC -> IO (FunPtr TextTextSelectionChangedCallbackC)

textTextSelectionChangedClosure :: TextTextSelectionChangedCallback -> IO Closure
textTextSelectionChangedClosure cb = newCClosure =<< mkTextTextSelectionChangedCallback wrapped
    where wrapped = textTextSelectionChangedCallbackWrapper cb

textTextSelectionChangedCallbackWrapper ::
    TextTextSelectionChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
textTextSelectionChangedCallbackWrapper _cb _ _ = do
    _cb 

onTextTextSelectionChanged :: (GObject a, MonadIO m) => a -> TextTextSelectionChangedCallback -> m SignalHandlerId
onTextTextSelectionChanged obj cb = liftIO $ connectTextTextSelectionChanged obj cb SignalConnectBefore
afterTextTextSelectionChanged :: (GObject a, MonadIO m) => a -> TextTextSelectionChangedCallback -> m SignalHandlerId
afterTextTextSelectionChanged obj cb = connectTextTextSelectionChanged obj cb SignalConnectAfter

connectTextTextSelectionChanged :: (GObject a, MonadIO m) =>
                                   a -> TextTextSelectionChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTextTextSelectionChanged obj cb after = liftIO $ do
    cb' <- mkTextTextSelectionChangedCallback (textTextSelectionChangedCallbackWrapper cb)
    connectSignalFunPtr obj "text-selection-changed" cb' after

type instance AttributeList Text = TextAttributeList
type TextAttributeList = ('[ ] :: [(Symbol, *)])

data TextTextAttributesChangedSignalInfo
instance SignalInfo TextTextAttributesChangedSignalInfo where
    type HaskellCallbackType TextTextAttributesChangedSignalInfo = TextTextAttributesChangedCallback
    connectSignal _ = connectTextTextAttributesChanged

data TextTextCaretMovedSignalInfo
instance SignalInfo TextTextCaretMovedSignalInfo where
    type HaskellCallbackType TextTextCaretMovedSignalInfo = TextTextCaretMovedCallback
    connectSignal _ = connectTextTextCaretMoved

data TextTextChangedSignalInfo
instance SignalInfo TextTextChangedSignalInfo where
    type HaskellCallbackType TextTextChangedSignalInfo = TextTextChangedCallback
    connectSignal _ = connectTextTextChanged

data TextTextInsertSignalInfo
instance SignalInfo TextTextInsertSignalInfo where
    type HaskellCallbackType TextTextInsertSignalInfo = TextTextInsertCallback
    connectSignal _ = connectTextTextInsert

data TextTextRemoveSignalInfo
instance SignalInfo TextTextRemoveSignalInfo where
    type HaskellCallbackType TextTextRemoveSignalInfo = TextTextRemoveCallback
    connectSignal _ = connectTextTextRemove

data TextTextSelectionChangedSignalInfo
instance SignalInfo TextTextSelectionChangedSignalInfo where
    type HaskellCallbackType TextTextSelectionChangedSignalInfo = TextTextSelectionChangedCallback
    connectSignal _ = connectTextTextSelectionChanged

type instance SignalList Text = TextSignalList
type TextSignalList = ('[ '("text-attributes-changed", TextTextAttributesChangedSignalInfo), '("text-caret-moved", TextTextCaretMovedSignalInfo), '("text-changed", TextTextChangedSignalInfo), '("text-insert", TextTextInsertSignalInfo), '("text-remove", TextTextRemoveSignalInfo), '("text-selection-changed", TextTextSelectionChangedSignalInfo)] :: [(Symbol, *)])

class ForeignPtrNewtype a => TextK a
instance (ForeignPtrNewtype o, IsDescendantOf Text o) => TextK o
type instance ParentTypes Text = TextParentTypes
type TextParentTypes = '[]

-- method Text::add_selection
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_offset", 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 "atk_text_add_selection" atk_text_add_selection :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- start_offset : TBasicType TInt32
    Int32 ->                                -- end_offset : TBasicType TInt32
    IO CInt


textAddSelection ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- start_offset
    Int32 ->                                -- end_offset
    m Bool
textAddSelection _obj start_offset end_offset = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- atk_text_add_selection _obj' start_offset end_offset
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Text::get_bounded_ranges
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rect", argType = TInterface "Atk" "TextRectangle", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "coord_type", argType = TInterface "Atk" "CoordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x_clip_type", argType = TInterface "Atk" "TextClipType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y_clip_type", argType = TInterface "Atk" "TextClipType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rect", argType = TInterface "Atk" "TextRectangle", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "coord_type", argType = TInterface "Atk" "CoordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x_clip_type", argType = TInterface "Atk" "TextClipType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y_clip_type", argType = TInterface "Atk" "TextClipType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TCArray True (-1) (-1) (TInterface "Atk" "TextRange")
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_bounded_ranges" atk_text_get_bounded_ranges :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Ptr TextRectangle ->                    -- rect : TInterface "Atk" "TextRectangle"
    CUInt ->                                -- coord_type : TInterface "Atk" "CoordType"
    CUInt ->                                -- x_clip_type : TInterface "Atk" "TextClipType"
    CUInt ->                                -- y_clip_type : TInterface "Atk" "TextClipType"
    IO (Ptr (Ptr TextRange))


textGetBoundedRanges ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    TextRectangle ->                        -- rect
    CoordType ->                            -- coord_type
    TextClipType ->                         -- x_clip_type
    TextClipType ->                         -- y_clip_type
    m [TextRange]
textGetBoundedRanges _obj rect coord_type x_clip_type y_clip_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let rect' = unsafeManagedPtrGetPtr rect
    let coord_type' = (fromIntegral . fromEnum) coord_type
    let x_clip_type' = (fromIntegral . fromEnum) x_clip_type
    let y_clip_type' = (fromIntegral . fromEnum) y_clip_type
    result <- atk_text_get_bounded_ranges _obj' rect' coord_type' x_clip_type' y_clip_type'
    checkUnexpectedReturnNULL "atk_text_get_bounded_ranges" result
    result' <- unpackZeroTerminatedPtrArray result
    result'' <- mapM (wrapBoxed TextRange) result'
    freeMem result
    touchManagedPtr _obj
    touchManagedPtr rect
    return result''

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

foreign import ccall "atk_text_get_caret_offset" atk_text_get_caret_offset :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    IO Int32


textGetCaretOffset ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    m Int32
textGetCaretOffset _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- atk_text_get_caret_offset _obj'
    touchManagedPtr _obj
    return result

-- method Text::get_character_at_offset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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}]
-- returnType : TBasicType TUniChar
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_character_at_offset" atk_text_get_character_at_offset :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- offset : TBasicType TInt32
    IO CInt


textGetCharacterAtOffset ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- offset
    m Char
textGetCharacterAtOffset _obj offset = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- atk_text_get_character_at_offset _obj' offset
    let result' = (chr . fromIntegral) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "atk_text_get_character_count" atk_text_get_character_count :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    IO Int32


textGetCharacterCount ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    m Int32
textGetCharacterCount _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- atk_text_get_character_count _obj'
    touchManagedPtr _obj
    return result

-- method Text::get_character_extents
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "coords", argType = TInterface "Atk" "CoordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "coords", argType = TInterface "Atk" "CoordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_character_extents" atk_text_get_character_extents :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- offset : TBasicType TInt32
    Int32 ->                                -- x : TBasicType TInt32
    Int32 ->                                -- y : TBasicType TInt32
    Int32 ->                                -- width : TBasicType TInt32
    Int32 ->                                -- height : TBasicType TInt32
    CUInt ->                                -- coords : TInterface "Atk" "CoordType"
    IO ()


textGetCharacterExtents ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- offset
    Int32 ->                                -- x
    Int32 ->                                -- y
    Int32 ->                                -- width
    Int32 ->                                -- height
    CoordType ->                            -- coords
    m ()
textGetCharacterExtents _obj offset x y width height coords = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let coords' = (fromIntegral . fromEnum) coords
    atk_text_get_character_extents _obj' offset x y width height coords'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "atk_text_get_default_attributes" atk_text_get_default_attributes :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    IO (Ptr (GSList (Ptr ())))


textGetDefaultAttributes ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    m [Ptr ()]
textGetDefaultAttributes _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- atk_text_get_default_attributes _obj'
    checkUnexpectedReturnNULL "atk_text_get_default_attributes" result
    result' <- unpackGSList result
    g_slist_free result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "atk_text_get_n_selections" atk_text_get_n_selections :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    IO Int32


textGetNSelections ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    m Int32
textGetNSelections _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- atk_text_get_n_selections _obj'
    touchManagedPtr _obj
    return result

-- method Text::get_offset_at_point
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "coords", argType = TInterface "Atk" "CoordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "coords", argType = TInterface "Atk" "CoordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_offset_at_point" atk_text_get_offset_at_point :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- x : TBasicType TInt32
    Int32 ->                                -- y : TBasicType TInt32
    CUInt ->                                -- coords : TInterface "Atk" "CoordType"
    IO Int32


textGetOffsetAtPoint ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- x
    Int32 ->                                -- y
    CoordType ->                            -- coords
    m Int32
textGetOffsetAtPoint _obj x y coords = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let coords' = (fromIntegral . fromEnum) coords
    result <- atk_text_get_offset_at_point _obj' x y coords'
    touchManagedPtr _obj
    return result

-- method Text::get_range_extents
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "coord_type", argType = TInterface "Atk" "CoordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rect", argType = TInterface "Atk" "TextRectangle", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "coord_type", argType = TInterface "Atk" "CoordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rect", argType = TInterface "Atk" "TextRectangle", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_range_extents" atk_text_get_range_extents :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- start_offset : TBasicType TInt32
    Int32 ->                                -- end_offset : TBasicType TInt32
    CUInt ->                                -- coord_type : TInterface "Atk" "CoordType"
    Ptr TextRectangle ->                    -- rect : TInterface "Atk" "TextRectangle"
    IO ()


textGetRangeExtents ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- start_offset
    Int32 ->                                -- end_offset
    CoordType ->                            -- coord_type
    TextRectangle ->                        -- rect
    m ()
textGetRangeExtents _obj start_offset end_offset coord_type rect = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let coord_type' = (fromIntegral . fromEnum) coord_type
    let rect' = unsafeManagedPtrGetPtr rect
    atk_text_get_range_extents _obj' start_offset end_offset coord_type' rect'
    touchManagedPtr _obj
    touchManagedPtr rect
    return ()

-- method Text::get_run_attributes
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "start_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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}]
-- returnType : TGSList (TBasicType TVoid)
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_run_attributes" atk_text_get_run_attributes :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- offset : TBasicType TInt32
    Ptr Int32 ->                            -- start_offset : TBasicType TInt32
    Ptr Int32 ->                            -- end_offset : TBasicType TInt32
    IO (Ptr (GSList (Ptr ())))


textGetRunAttributes ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- offset
    m ([Ptr ()],Int32,Int32)
textGetRunAttributes _obj offset = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    start_offset <- allocMem :: IO (Ptr Int32)
    end_offset <- allocMem :: IO (Ptr Int32)
    result <- atk_text_get_run_attributes _obj' offset start_offset end_offset
    checkUnexpectedReturnNULL "atk_text_get_run_attributes" result
    result' <- unpackGSList result
    g_slist_free result
    start_offset' <- peek start_offset
    end_offset' <- peek end_offset
    touchManagedPtr _obj
    freeMem start_offset
    freeMem end_offset
    return (result', start_offset', end_offset')

-- method Text::get_selection
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "selection_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "selection_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_selection" atk_text_get_selection :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- selection_num : TBasicType TInt32
    Ptr Int32 ->                            -- start_offset : TBasicType TInt32
    Ptr Int32 ->                            -- end_offset : TBasicType TInt32
    IO CString


textGetSelection ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- selection_num
    m (T.Text,Int32,Int32)
textGetSelection _obj selection_num = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    start_offset <- allocMem :: IO (Ptr Int32)
    end_offset <- allocMem :: IO (Ptr Int32)
    result <- atk_text_get_selection _obj' selection_num start_offset end_offset
    checkUnexpectedReturnNULL "atk_text_get_selection" result
    result' <- cstringToText result
    freeMem result
    start_offset' <- peek start_offset
    end_offset' <- peek end_offset
    touchManagedPtr _obj
    freeMem start_offset
    freeMem end_offset
    return (result', start_offset', end_offset')

-- method Text::get_string_at_offset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "granularity", argType = TInterface "Atk" "TextGranularity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "granularity", argType = TInterface "Atk" "TextGranularity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_string_at_offset" atk_text_get_string_at_offset :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- offset : TBasicType TInt32
    CUInt ->                                -- granularity : TInterface "Atk" "TextGranularity"
    Ptr Int32 ->                            -- start_offset : TBasicType TInt32
    Ptr Int32 ->                            -- end_offset : TBasicType TInt32
    IO CString


textGetStringAtOffset ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- offset
    TextGranularity ->                      -- granularity
    m (T.Text,Int32,Int32)
textGetStringAtOffset _obj offset granularity = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let granularity' = (fromIntegral . fromEnum) granularity
    start_offset <- allocMem :: IO (Ptr Int32)
    end_offset <- allocMem :: IO (Ptr Int32)
    result <- atk_text_get_string_at_offset _obj' offset granularity' start_offset end_offset
    checkUnexpectedReturnNULL "atk_text_get_string_at_offset" result
    result' <- cstringToText result
    freeMem result
    start_offset' <- peek start_offset
    end_offset' <- peek end_offset
    touchManagedPtr _obj
    freeMem start_offset
    freeMem end_offset
    return (result', start_offset', end_offset')

-- method Text::get_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_text" atk_text_get_text :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- start_offset : TBasicType TInt32
    Int32 ->                                -- end_offset : TBasicType TInt32
    IO CString


textGetText ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- start_offset
    Int32 ->                                -- end_offset
    m T.Text
textGetText _obj start_offset end_offset = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- atk_text_get_text _obj' start_offset end_offset
    checkUnexpectedReturnNULL "atk_text_get_text" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method Text::get_text_after_offset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "boundary_type", argType = TInterface "Atk" "TextBoundary", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "boundary_type", argType = TInterface "Atk" "TextBoundary", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_text_after_offset" atk_text_get_text_after_offset :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- offset : TBasicType TInt32
    CUInt ->                                -- boundary_type : TInterface "Atk" "TextBoundary"
    Ptr Int32 ->                            -- start_offset : TBasicType TInt32
    Ptr Int32 ->                            -- end_offset : TBasicType TInt32
    IO CString

{-# DEPRECATED textGetTextAfterOffset ["(Since version 2.9.3)","Please use atk_text_get_string_at_offset() instead."]#-}
textGetTextAfterOffset ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- offset
    TextBoundary ->                         -- boundary_type
    m (T.Text,Int32,Int32)
textGetTextAfterOffset _obj offset boundary_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let boundary_type' = (fromIntegral . fromEnum) boundary_type
    start_offset <- allocMem :: IO (Ptr Int32)
    end_offset <- allocMem :: IO (Ptr Int32)
    result <- atk_text_get_text_after_offset _obj' offset boundary_type' start_offset end_offset
    checkUnexpectedReturnNULL "atk_text_get_text_after_offset" result
    result' <- cstringToText result
    freeMem result
    start_offset' <- peek start_offset
    end_offset' <- peek end_offset
    touchManagedPtr _obj
    freeMem start_offset
    freeMem end_offset
    return (result', start_offset', end_offset')

-- method Text::get_text_at_offset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "boundary_type", argType = TInterface "Atk" "TextBoundary", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "boundary_type", argType = TInterface "Atk" "TextBoundary", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_text_at_offset" atk_text_get_text_at_offset :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- offset : TBasicType TInt32
    CUInt ->                                -- boundary_type : TInterface "Atk" "TextBoundary"
    Ptr Int32 ->                            -- start_offset : TBasicType TInt32
    Ptr Int32 ->                            -- end_offset : TBasicType TInt32
    IO CString

{-# DEPRECATED textGetTextAtOffset ["This method is deprecated since ATK version","2.9.4. Please use atk_text_get_string_at_offset() instead."]#-}
textGetTextAtOffset ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- offset
    TextBoundary ->                         -- boundary_type
    m (T.Text,Int32,Int32)
textGetTextAtOffset _obj offset boundary_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let boundary_type' = (fromIntegral . fromEnum) boundary_type
    start_offset <- allocMem :: IO (Ptr Int32)
    end_offset <- allocMem :: IO (Ptr Int32)
    result <- atk_text_get_text_at_offset _obj' offset boundary_type' start_offset end_offset
    checkUnexpectedReturnNULL "atk_text_get_text_at_offset" result
    result' <- cstringToText result
    freeMem result
    start_offset' <- peek start_offset
    end_offset' <- peek end_offset
    touchManagedPtr _obj
    freeMem start_offset
    freeMem end_offset
    return (result', start_offset', end_offset')

-- method Text::get_text_before_offset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "boundary_type", argType = TInterface "Atk" "TextBoundary", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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 = "boundary_type", argType = TInterface "Atk" "TextBoundary", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_get_text_before_offset" atk_text_get_text_before_offset :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- offset : TBasicType TInt32
    CUInt ->                                -- boundary_type : TInterface "Atk" "TextBoundary"
    Ptr Int32 ->                            -- start_offset : TBasicType TInt32
    Ptr Int32 ->                            -- end_offset : TBasicType TInt32
    IO CString

{-# DEPRECATED textGetTextBeforeOffset ["(Since version 2.9.3)","Please use atk_text_get_string_at_offset() instead."]#-}
textGetTextBeforeOffset ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- offset
    TextBoundary ->                         -- boundary_type
    m (T.Text,Int32,Int32)
textGetTextBeforeOffset _obj offset boundary_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let boundary_type' = (fromIntegral . fromEnum) boundary_type
    start_offset <- allocMem :: IO (Ptr Int32)
    end_offset <- allocMem :: IO (Ptr Int32)
    result <- atk_text_get_text_before_offset _obj' offset boundary_type' start_offset end_offset
    checkUnexpectedReturnNULL "atk_text_get_text_before_offset" result
    result' <- cstringToText result
    freeMem result
    start_offset' <- peek start_offset
    end_offset' <- peek end_offset
    touchManagedPtr _obj
    freeMem start_offset
    freeMem end_offset
    return (result', start_offset', end_offset')

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


textRemoveSelection ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- selection_num
    m Bool
textRemoveSelection _obj selection_num = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- atk_text_remove_selection _obj' selection_num
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Text::set_caret_offset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", 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}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "atk_text_set_caret_offset" atk_text_set_caret_offset :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- offset : TBasicType TInt32
    IO CInt


textSetCaretOffset ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- offset
    m Bool
textSetCaretOffset _obj offset = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- atk_text_set_caret_offset _obj' offset
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Text::set_selection
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "selection_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Atk" "Text", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "selection_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_offset", 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 "atk_text_set_selection" atk_text_set_selection :: 
    Ptr Text ->                             -- _obj : TInterface "Atk" "Text"
    Int32 ->                                -- selection_num : TBasicType TInt32
    Int32 ->                                -- start_offset : TBasicType TInt32
    Int32 ->                                -- end_offset : TBasicType TInt32
    IO CInt


textSetSelection ::
    (MonadIO m, TextK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- selection_num
    Int32 ->                                -- start_offset
    Int32 ->                                -- end_offset
    m Bool
textSetSelection _obj selection_num start_offset end_offset = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- atk_text_set_selection _obj' selection_num start_offset end_offset
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'